This is my program that patches sendmail. Do *not* use this to replace
sendmail. It requires sendmail (or something else) to be running as an
smtp server. What I do is edit my ~/.pinerc (or /etc/pine.conf) file to:
sendmail-path=/path/to/sendmail.alias
That works with pine. You can do the same with mutt and a few other
mailers.
for mutt:
set sendmail="/usr/bin/sendmail.alias -oem -oi"
in /etc/Muttrc or ~/.muttrc
This may still have some problem with sending mail *to* vsnl or maybe
that's some other problem. I haven't been able to figure it out yet. I
can send mail to my iname and earthcorp addresses that forward to vsnl and
that arrives properly. It's only if I send directly to vsnl. I can still
send mail to vsnl manually (if I telnet to my local smtp server and tell
it that I am iname.com, but pine still has a problem.) If anybody figures
it out, tell me.
NOTE: You can copy this mail asis (with full headers and everything) run
it directly. Perl will ignore everything before the shebang line and
everything after the doubleunderscore END doubleunderscore line. Just
check for line wrapping first though, cause this email client may cause
some trouble there.
This program will go up on my homepage sometime tonight I guess.
Philip
#!/usr/bin/perl -w
# Copyright (c) 2000, Philip Tellis
#
# Distributed under GPL
#
# The GPL will be in the complete package at
# http://members.xoom.com/philip3/downloads/
#
use strict;
use Socket;
my %aliases;
my %header;
my $EOL = "\015\012";
open ALIASES, "/etc/mail/outgoing.aliases" or die "Could not open aliases file: $!";
while(<ALIASES>) {
chomp;
my($local, $real) = split /:/;
$aliases{$local} = $real;
}
close ALIASES or warn "Could not close aliases file: $!";
my $header;
my @rcpts;
my $fromemail;
{
local $/ = '';
$header = <>;
$header =~ s/\n\s+/ /g;
%header = ("UNIX_FROM_LINE", split /^([-\w]+):\s*/m, $header);
$header =~ s/^Bcc:\s*.+\n//im;
$header{To} = $header{to} || $header{To} || '';
$header{Cc} = $header{cc} || $header{Cc} || '';
$header{Bcc} = $header{bcc} || $header{Bcc} || '';
my @to = split /,/, $header{To};
my @cc = split /,/, $header{Cc};
my @bcc = split /,/, $header{Bcc};
my $fromname;
($fromname, $fromemail) = &parseaddress($header{From});
if ($aliases{$fromemail}) {
$header =~ s/^From:(.*?)$fromemail/From:$1$aliases{$fromemail}/m;
$fromemail = $aliases{$fromemail};
}
foreach (@to, @cc, @bcc) {
my ($name, $email) = &parseaddress($_);
push @rcpts, $email;
}
}
&connectsocket; # you can pass the ip/fqdn of your mail server here, or
# leave it blank for localhost. Pass the port as second
# argument or leave it blank for 25
&smtpauthenticate($fromemail, @rcpts);
$header =~ s/\r\n/$EOL/eg;
$header =~ s/[\r\n]/$EOL/eg;
print MAIL $header;
print MAIL "$EOL$EOL";
while(<>) {
chomp;
print MAIL "$_$EOL";
}
print MAIL ".$EOL";
my $reply;
while( ($reply = <MAIL>) =~ /^\d\d\d-/ ) {}
die "Server did not respond with 250 on end DATA: $reply" if $reply !~ /^250/;
print MAIL "QUIT$EOL";
while( ($reply = <MAIL>) =~ /^\d\d\d-/ ) {}
die "Server did not respond with 221 on QUIT: $reply" if $reply !~ /^221/;
close MAIL or warn "Could not close smtp socket properly: $!";
sub parseaddress {
my $addrline = shift || die "No address to parse";
my ($name, $email);
if ($addrline =~ /^(.*?)<(.+?\@.+?)>/) {
$name=$1;
$email=$2;
}
elsif ($addrline =~ /^(.+?\@.+?)$/) {
$name='';
$email=$1;
}
return ($name, $email);
}
sub connectsocket {
my $mailserver = shift || "localhost";
my $port = shift || 25;
my $iaddr = inet_aton($mailserver) or die "Could not resolve $mailserver: $!";
my $paddr = sockaddr_in($port, $iaddr);
my $proto = getprotobyname('tcp');
socket(MAIL, PF_INET, SOCK_STREAM, $proto) or die "Could not open client tcp
socket: $!";
connect(MAIL, $paddr) or die "Could not connect socket to server:
$mailserver:$port: $!";
select MAIL; $|=1; select STDOUT;
my $reply;
while( ($reply = <MAIL>) =~ /^\d\d\d-/ ) {}
do {
close MAIL or warn "Could not close socket with $mailserver: $!";
die "Server did not respond with 220 on connect: $reply";
} if $reply !~ /^220/;
}
sub smtpauthenticate {
my ($from, @rcpts) = @_;
my ($user, $domain) = split /\@/, $from;
my $reply;
print MAIL "HELO $domain$EOL";
while ( ($reply = <MAIL>) =~ /^\d\d\d-/ ) {}
die "Server did not respond with 250 for HELO: $reply" if ($reply !~ /^250/);
print MAIL "MAIL FROM: $from$EOL";
while ( ($reply = <MAIL>) =~ /^\d\d\d-/ ) {}
die "Server did not respond with 250 for MAIL FROM: $reply" if ($reply !~ /^250/);
my $valrcpt=0;
foreach my $rcpt (@rcpts) {
print MAIL "RCPT TO: $rcpt$EOL";
while ( ($reply = <MAIL>) =~ /^\d\d\d-/ ) {}
warn "Server did not respond with 250 for RCPT TO:$rcpt : $reply" if ($reply
!~ /^250/);
$valrcpt = 1 if $reply =~ /^250/;
}
die "No recipients accepted" if !$valrcpt;
print MAIL "DATA$EOL";
while ( ($reply = <MAIL>) =~ /^\d\d\d-/ ) {}
die "Server did not respond with 354 for DATA: $reply" if ($reply !~ /^354/);
}
__END__
=========================================================
Federal grants are offered for... research into the recreation
potential of interplanetary space travel for the culturally disadvantaged.
To subscribe / unsubscribe goto the site www.ilug-bom.org ., click on the mailing list
button and fill the appropriate information
and submit. For any other queries contact the ML maintener
