in reply to Re: sendmail.pl - a Sendmail replacement
in thread sendmail.pl - a Sendmail replacement


Thank you for your improvements. The way of concatenation
is great. Use of splice or list of slice like you suggested
doesn't make sense to the logic of the script, though this
is a cool function. The reduction of regexes don't work IMHO
see for the remark in the new code posted at the bottom.
I do see the sense of leading comment blocks, too :)

Let's take a look for the improvements of the new coded file:

update 20011108


I renewed the code because of errors concerning header-
entries of an applikation. So I tried another way to handle
header in my script's logic.
The old code placed here in this reply, was replaced by the
new version.
#!/usr/bin/perl -w use strict; ###################################################################### +#### # + # # sendmail, a perl-replacement for the original, it just collects the + # # data, and sends them to the specified eMailserver. + # # diposition to enable mailing for servers, who don't have a dinosaur +:) # # + # # No smtp after pop possible with this script! + # # No commands the original knows are recognized! + # # + # # put it to /usr/lib/sendmail, the standard place for the original or + # # the place it is expected. + # # + # # This version was designed to meet the proposals of RFC733 concerning + # # the order of header information. + # # + # # Version: 1.01 + # # dor : 20011110 + # # Author : Sascha Wuestemann + # # email : sascha.wuestemann@epost.de + # # + # ###################################################################### +#### # Requirement: # module which does the mailing # has to be installed use Net::SMTP; # fetch incoming data from stdin or being piped to us my @textdata = <STDIN>; ############################ # # # user setting start here: # # the mailserver, which delivers mail my $mailhost = ""; # the user, who is allowed to use the mailserver # and gets errormessages, too my $maileruser = "\@"; # file, where to pipe all mailcontent at. # use only for debugging! # if used by cgi, webserver's user needs # rights to write there. my $hclf; #$hclf = "/tmp/sendmail.log"; my $mdebug; # don't debug the module on stdout $mdebug = 0; # debug the module on stdout, default "1" # higher values are possible but not useful #$mdebug = 1; # user settings stop here! # # # ############################ if ($hclf) { open (GUN,">>$hclf") || die "cant write to $hclf"; print GUN scalar localtime() . "\n@textdata\n##################### +##############\n"; close (GUN) || warn "cant close $hclf"; } # make a copy of income data to work with my @workrow = @textdata; # order as suggested at RFC733: my $mail_date; my $mail_from; my $mail_reply_to; my $mail_subject; # sender done by module # no reply_to for sender possible because of module my $mail_to; my $mail_cc; my $mail_bcc; # several more headers may follow, # but are unimportant for the module and done by it, too my $i=0; my @j; foreach(@textdata[0..6]){ # case insensitive is required here, # some clients even don't care about order of the keywords... # matched value may be null if headerkeyword was given but no value if ($_ =~ /^date\s*:\s*(.*)/i) { $mail_date = $1; push @j,$i; } if ($_ =~ /^from\s*:\s*(.*)/i) { $mail_from = $1; push @j,$i; } if ($_ =~ /^reply-to\s*:\s*(.*)/i) { $mail_reply_to= $1; push @j,$i; } if ($_ =~ /^subject\s*:\s*(.*)/i) { $mail_subject = $1; push @j,$i; } if ($_ =~ /^to\s*:\s*(.*)/i) { $mail_to = $1; push @j,$i; } if ($_ =~ /^cc\s*:\s*(.*)/i) { $mail_cc = $1; push @j,$i; } if ($_ =~ /^bcc\s*:\s*(.*)/i) { $mail_bcc = $1; push @j,$i; } $i++; } # sort found headers reverse to get a working slice order my @sorted_j = sort {$b <=> $a} @j; foreach $i (@sorted_j) { if ($i ne 0) { splice(@workrow, $i, 1); } else { shift @workrow; } } my $mail_text; # case, if mail is undeliverable # if so, alarm defined $maileruser if (! $mail_to) { my $whereat = `/bin/uname -n`; chomp $whereat; $mail_to = $maileruser; $mail_from = "perlsendmail <$maileruser>"; $mail_subject = "perlsendmail has found an error at $whereat!"; $mail_text = @textdata; } # if ok, init remaining vars else { # catch empty sender,subject and date if ( (! $mail_from) and ($ENV{USER}) ) { $mail_from = $ENV{USER}; } else { $mail_from = $maileruser; } # some clients don't give a real mailaddress # if so extend it to one if hostname matches, else use dummy value, # replace dummy value "domain.arg" to a real value, if nescessary if (!($mail_from=~/\@/)){ $ENV{HOSTNAME} =~ /\.(.+)/; if ($1) { $mail_from="$mail_from\@$1" } else { $mail_from="$mail_from\@domain.arg" } } if (! $mail_subject) { $mail_subject = "\n" ; } if (! $mail_date) { $mail_date = scalar localtime(); } unshift @workrow,"Cc: $mail_cc\n" if $mail_cc; unshift @workrow,"To: $mail_to\n"; unshift @workrow,"Subject: $mail_subject\n"; unshift @workrow,"Reply-to: $mail_reply_to\n" if $mail_reply_to; unshift @workrow,"From: $mail_from\n"; unshift @workrow,"Date: $mail_date\n"; # remaining elements might be other keywords followed by bodytext foreach (@workrow) { $mail_text .= $_; } } chomp $mail_from; chomp $mail_to; chomp $mail_subject; chomp $mail_cc if $mail_cc; chomp $mail_bcc if $mail_bcc; my $smtp = Net::SMTP->new("$mailhost", Debug => $mdebug, ); $smtp->mail("$mail_from"); $smtp->to("$mail_to"); $smtp->cc("$mail_cc") if $mail_cc; $smtp->bcc("$mail_bcc") if $mail_bcc; $smtp->data(); $smtp->datasend("$mail_text"); $smtp->dataend(); $smtp->quit;

--

there are no silly questions
killerhippy