emailrelay-set-from.pl

#!/usr/bin/env perl
#
# SPDX-FileCopyrightText: 2026 Graeme Walker <graeme_walker@users.sourceforge.net>
# SPDX-License-Identifier: FSFAP
#
# Copyright (c) 2026 Graeme Walker <graeme_walker@users.sourceforge.net>
#
# Copying and distribution of this file, with or without modification,
# are permitted in any medium without royalty provided the copyright
# notice and this notice are preserved.  This file is offered as-is,
# without any warranty.
# ===
#
# emailrelay-set-from.pl
#
# An example E-MailRelay filter script that edits the
# content originator headers (ie. From, Sender and Reply-To)
# in the content file to a fixed value.
#
# This does not set the envelope-from field in the envelope
# file by default. If the remote server expects the SMTP
# MAIL-FROM address to match the "From:" header then set
# $edit_envelope to 1.
#
# See also: emailrelay-set-from.js, RFC-2822
#

use strict ;
use IO::File ;
$SIG{__DIE__} = sub { (my $e = join(" ",@_)) =~ s/\n/ /g ; print "<<error: $e>>\n" ; exit 99 } ;

my $edit_envelope = 0 ; # <= set to 1 to also update the envelope-from address

# originator fields (RFC-2822 3.6.2)
my $new_from = 'noreply@example.com' ; # <= edit this
my $new_sender = '' ;
my $new_reply_to = $new_from ;

my $content = $ARGV[0] or die "usage error\n" ;
my $envelope = $ARGV[1] or die "usage error\n" ;

my $in = new IO::File( $content , "r" ) or die ;
my $out = new IO::File( "$content.tmp" , "w" ) or die ;
my $in_body = undef ;
my $in_edit = undef ;
while(<$in>)
{
    if( $in_body )
    {
            print $out $_ ;
    }
    else
    {
            chomp( my $line = $_ ) ;
            $line =~ s/\r$// ;

            $in_body = 1 if ( $line eq "" ) ;
            my $is_from = ( $line =~ m/^From:/i ) ;
            my $is_sender = ( $line =~ m/^Sender:/i ) ;
            my $is_reply_to = ( $line =~ m/^Reply-To:/i ) ;

            if( $in_body )
            {
                    print $out "\r\n" ;
            }
            elsif( $is_from && defined($new_from) )
            {
                    $in_edit = 1 ;
                    print $out "From: $new_from\r\n" ;
            }
            elsif( $is_sender && defined($new_sender) )
            {
                    $in_edit = 1 ;
                    print $out "Sender: $new_sender\r\n" unless $new_sender eq "" ;
            }
            elsif( $is_reply_to && defined($new_reply_to) )
            {
                    $in_edit = 1 ;
                    print $out "Reply-To: $new_reply_to\r\n" ;
            }
            elsif( $in_edit && $line =~ m/^[ \t]/ ) # original header was folded
            {
            }
            else
            {
                    $in_edit = undef ;
                    print $out $line , "\r\n" ;
            }
    }
}
$out->close() or die ;
rename( "$content.tmp" , $content ) or die ;

if( $edit_envelope )
{
    my $etext ;
    {
            my $fh = new IO::File( $envelope , "r" ) or die "cannot read envelope file [$envelope]" ;
            local $/ = undef ;
            $etext = <$fh> ;
    }
    ( $etext =~ m/X-MailRelay-/ ) or die ;
    $etext =~ s/X-MailRelay-From:.*/X-MailRelay-From: $new_from\r/m ;
    {
            my $fh = new IO::File( $envelope , "w" ) or die "cannot write envelope file [$envelope]" ;
            print $fh $etext ;
            $fh->close() or die ;
    }
}

exit 0 ;