C
Caduceus
Hi:
I'm trying to run this perl script called "salter" on activestates komodo.
I hope to use it with Mozilla Thunderbird. I've read Learning Perl, another
perl book, went to perl.com, perl.org, pm.org, and cpan.com but nothing
seems to help. I will show you the script. Any help will be appreciated.
TIA Steve
------------------------------
#!/usr/bin/perl -w
# Salter single-threaded email address salter
# (c) 2003, 2004 Julian Haight, http://www.julianhaight.com/
# All Rights Reserved under GPL: http://www.gnu.org/licenses/gpl.txt
# Current version available here: http://www.julianhaight.com/salter
# Version history
# 7/19/04 V1.2
# added stripsender feature
# fixed missing newline between header & body
# 3/26/04 V1.1
# cleaned up smtp sending code, added envonly mode, added version
# 3/12/04
# give each recipient their own, permanent random virtual sender
# move config to user-dir, not /etc.
# 9/29/03 - changed to use only lowercase-alpha, avoid spam filters
# Also, added final response after quit (worked without for pine, but not
moz)
use strict; use Socket; use FileHandle; use Digest::MD5;
my($CONFIG) = ($ENV{HOME} . '/.salter');
my($MAPFN) = "$CONFIG/map.txt";
my($EOL) = "\015\012";
my($debug) = 0;
my($SMTPTO) = 10; # 10 second timeout
my($VERSION) = 'V1.2';
my($SAMP) = '
# here is a sample config file:
listenport 2525
listenip 127.0.0.1
sendport 25
sendip your_isps_mailserver.example.com
maxclient 5
# 1 for unsafe but fast!, 0 for slow & steady (not yet available)
buffermode 1
# 1 remaps only envelope, not header, good if you want to filter bad bounces
envonly 0
# 1 strips sender field (for pine or whatever)
stripsender 1
# From this address To random @ this domain!
# ----------------- ------------------------
remap (e-mail address removed) salty.you.example.com
remap (e-mail address removed) foo.example.com
# to set your identity per-recipient (email or part)
# - use workplace address for work recipients
hardwire workplace.example.com (e-mail address removed)
# - use mailing list subscription address when posting to list.
hardwire (e-mail address removed) (e-mail address removed)
# end sample config!
';
my(%config, %remap, %map, %hardwire);
unless (-e $CONFIG) { mkdir($CONFIG); }
readConfig(); # read the config file into %config
readMap();
listenLoop(); # work 'til you die!
exit 0;
# listen for one connection at a time, and call the proxy for each one.
# die if there are errors
sub listenLoop {
my($cliaddr, $cliip, $cliport);
socket(SOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp')) ||
die "Socket: $!";
setsockopt(SOCK, SOL_SOCKET, SO_REUSEADDR, pack('l', 1)) ||
die "Setsockopt: $!";
bind(SOCK, sockaddr_in($config{'listenport'},
inet_aton($config{'listenip'}))) ||
die "bind: $!";
listen(SOCK, $config{'maxclient'}) ||
die "listen: $!";
while ($cliaddr = accept(CLI, SOCK)) {
# print STDERR "got connection\n";
($cliport, $cliip) = (sockaddr_in($cliaddr));
CLI->autoflush(1);
if ($_ = proxyIt(\*CLI)) {
print STDERR "<< 550 Proxy error: $_\n";
print CLI "550 Proxy error: $_\n";
}
close CLI;
}
}
sub proxyIt {
my($CLI) = @_;
my($cmds, $head, $body, $cmd);
$cmds = '';
unless ($config{buffered}) {
print $CLI "500 No safe delivery mode yet, sorry!$EOL";
close($CLI);
die "No safe mode yet, sorry!";
}
# read smtp
print $CLI "220 localhost SMTP pretender: salter $VERSION $EOL";
while ($cmd = <$CLI>) {
$cmds .= $cmd || '';
if (lc($cmd) eq "data$EOL") { last; }
if (lc(substr($cmd, 0, 4)) eq 'ehlo') {
print $CLI "451 EHLO is soo complicated$EOL";
} else {
print $CLI "250 Buffering$EOL";
}
}
print $CLI "354 Ready for data$EOL";
# read head
while ($cmd = <$CLI>) {
if ($cmd eq $EOL) { last; }
if ((!$config{stripsender}) || ($cmd !~ m/^sender:/i)) {
$head .= $cmd;
}
}
# read body
while ($cmd = <$CLI>) {
if ($cmd eq ".$EOL") { last; }
$body .= $cmd;
}
while ($CLI && print $CLI "250 Buffering$EOL") {
$cmd = <$CLI>;
$cmds .= $cmd;
if (lc($cmd) eq "quit$EOL") { last; }
}
print $CLI "221 Bye bye, hopefully it'll work!$EOL";
close $CLI;
deliverAll($cmds, $head, $body);
}
sub deliverAll {
my($cmds, $head, $body) = @_;
my($recipmap, $message, $line, $remap, $recip, $sender,
$sremap, $cmd, $val, $S,
@recips, $from);
# print STDERR "Deliverall:\n$cmds\n==\n$head\n--\n$body\n++\n";
while ($cmds =~ m/([^:\n]*): ?\<?([^\>\n]*[^\s\>])?\>?/g) {
$cmd = lc($1); $val = $2;
# print "cmd: $cmd = $val\n";
if ($cmd eq 'mail from') {
$sender = $val;
} elsif ($cmd eq 'rcpt to') {
$recip = $val;
$remap = getRecipMapping($recip);
# print STDERR "remap $recip to $remap\n";
push(@{$recipmap->{$remap}}, $recip);
}
}
# print STDERR "Done w/commands\n";
while ($_ = smtpOpen(*S)) {
print STDERR "Cannot open smtp: $_, sleeping..\n";
sleep(3);
}
# print STDERR "Smtp open\n";
foreach $remap (keys(%{$recipmap})) {
$message = 'X-Mailer-Addon: Salter ' . $VERSION .
' http://www.julianhaight.com/salter' . $EOL . $head;
$_ = $recipmap->{$remap};
$sremap = $sender;
(@recips) = (@$_);
foreach $from (keys(%remap)) {
if ($remap =~ m/\@/) {
#print "For @recips, $from -> $remap\n";
unless ($config{envonly}) {
$message = replace($message, $from, $remap);
}
$sremap = replace($sremap, $from, $remap);
} else {
unless ($config{envonly}) {
$message = replace($message, $from,
$remap . '@' . $remap{$from});
}
$sremap = replace($sremap, $from,
$remap . '@' . $remap{$from});
}
}
# print "Sending\n$message\n\n";
unless ($sremap) {
print STDERR "sender $sender not remapped\n";
$sremap = $sender;
}
$message .= $EOL . $body;
if (($_ = smtpEnvelope(\*S, $sremap, @recips)) ||
($_ = smtpData(\*S, $message))) {
# die "Error during delivery: $_";
print STDERR ("Failed to send: $_ saving in $CONFIG/failed.txt");
open (SAVE, ">>$CONFIG/failed.txt");
print SAVE $message;
close(SAVE);
# } else {
# print "Message delivered: $sremap -> @recips\n";
}
}
}
sub randSecret {
my($len) = @_;
my($char, $pass, $i);
for ($i=0; $i < $len; $i++) {
$char = int(rand() * 26);
$char += 97;
$pass .= pack('c', $char);
}
return $pass;
}
sub readConfig {
my($line);
my($fn) = "$CONFIG/salter.conf";
unless (-e $fn) {
print STDERR "Salter not configured. Please create $fn. Sample:
$SAMP
";
exit 1;
}
open (CONFIG, $fn) || die "$fn $!";
while ($line = <CONFIG>) {
if ($line =~ m/^([^\#;\s]\S+)\s*(\S+)\s*(\S*).*$/) {
if ($1 eq 'remap') {
$remap{$2} = $3;
} elsif ($1 eq 'hardwire') {
$hardwire{$2} = $3;
} else {
$config{$1} = $2;
}
}
}
print STDERR "Listening on $config{'listenip'}:$config{'listenport'}
Outbound on $config{'sendip'}:$config{'sendport'}\n";
}
sub getSenderMapping {
my($addr) = lc(@_);
return $remap{$addr}
}
sub getRecipMapping {
my($addr) = lc($_[0]);
my(@parts, $part);
# exact match
if ($part = $hardwire{$addr}) {
return $part;
}
# domain match
(@parts) = (getDomParts($addr));
while (@parts) {
if ($part = $hardwire{join('.', @parts)}) {
return $part;
}
pop(@parts);
}
# default randomizer
return getMapping($addr);
}
sub getDomParts {
my($addr) = @_;
my($dom, @parts);
# print "getDomParts $addr\n";
# print hexDump($addr) . "\n";
if ($addr =~ m/[^\@]*\@(.*)/) {
# if ($addr =~ m/^\s*[^\@\s]+\@([^\@\s]+)\s*$/) {
$dom = $1;
(@parts) = (split(/\./, $dom));
}
# print STDERR "parts: @parts ($dom)\n";
return (@parts);
}
sub getMapping {
my($addr) = @_;
my($hash) = Digest::MD5::md5_base64($addr);
my($rand);
unless ($rand = $map{$hash}) {
$map{$hash} = ($rand = randSecret(16));
writeMap($hash, $rand);
}
# print "getMapping $addr = $rand\n";
return ($rand);}
sub writeMap {
open(MAP, ">>$MAPFN") || return 1;
print MAP join(' ', @_) . "\n";
close(MAP);
}
sub readMap {
my($line);
my($key, $val);
unless (-e $MAPFN) {
print STDERR "Starting hashed recip map in $MAPFN\n";
} elsif (open (MAP, $MAPFN)) {
while (($key, $val) = split(' ', <MAP>)) {
chop($map{$key} = $val);
}
} else {
die "Error opening $MAPFN for read: $!";
}
close(MAP);
}
sub replace {
my($text, $old, $new) = @_;
my($loc, $len);
# print "text: $text\n";
if (index($new, $old) >= 0) { return $text; }
$len = length($old);
$loc = index($text, $old);
while ($loc >= 0) {
$text = substr($text, 0, $loc) . $new . substr($text, $loc + $len);
$loc = index($text, $old);
}
# print "replaced $old with $new in text: $text\n";
return $text;
}
sub errlog {
print STDERR "@_\n";
}
sub hexDump {
my($string) = @_;
my($size) = 15;
my($char, $rval, $hex, $str, $asc);
foreach $char (split('', $string)) {
$asc = unpack('C', $char);
if (($asc < 32) || ($asc > 176)) {
$char = '?';
$hex .= sprintf('%.2x<', $asc);
} else {
$hex .= sprintf('%.2x ', $asc);
}
$str .= $char;
if (length($str) >= $size) {
$rval .= $hex . $str . "\n";
$hex = ''; $str = '';
}
}
if ($hex) {
$hex .= (' ' x (($size*3) - length($hex)));
$rval .= $hex . $str . "\n"
}
$rval = substr($rval, 0, length($rval)-1);
return $rval;
}
# (C) 2002, 2003 Julian Haight. All rights reserved
# original sendmail 1.21 by Christian Mallwitz.
# Modified and 'modulized' by (e-mail address removed)
# totally mangled by julian
# adapted for salter 3/13/04
sub smtpSend {
my($message, $fromaddr, @recips) = @_;
unless ($message) {
errlog ("Refusing to send empty email $fromaddr -> @recips");
return undef();
} if ($debug) { errlog("trying smtpSend"); }
# now, isn't that pretty?
if (($_ = smtpOpen(\*S)) ||
($_ = smtpEnvelope(\*S, $fromaddr, @recips)) ||
($_ = smtpData(\*S, $message)) ||
($_ = smtpClose(\*S))) {
return ("smtpSend:" . $_);
} else {
return undef();
}
}
sub smtpOpen {
my($fh) = @_;
my($k, $proto, $smtpaddr);
($smtpaddr) = (gethostbyname($config{sendip}))[4];
my $save_w = $^W;
local $/;
$/ = "\015\012";
$proto = (getprotobyname('tcp'))[2];
unless (defined($smtpaddr)) {
return ("smtpOpen: smtp host unknown:'" . $config{sendip} . "'");
}
# open socket and start mail session
if (!socket($fh, AF_INET, SOCK_STREAM, $proto)) {
return ("smtpOpen: socket failed ( $! )");
}
# connect
if (!connect($fh, pack('Sna4x8', AF_INET, $config{sendport},
$smtpaddr))) {
if ($! eq 'Interrupted system call') {
return "smtpOpen: timeout after $SMTPTO seconds during connect";
} else {
return ("smtpOpen: connect to smtp server failed ($!)");
}
}
my($oldfh) = select($fh); $| = 1; select($oldfh);
if (($_ = smtpExchange($fh)) !~ m/^[23]/) {
return ("smtpOpen: smtpsend connection error from smtp server
($_)");
}
if (($_ = smtpExchange($fh, "HELO Salter" . $VERSION)) !~ m/^[23]/) {
return ("smtpOpen: smtpsend HELO error ($_)");
}
return undef();
}
sub smtpEnvelope {
my($fh, $from, @recips) = @_;
if (($_ = smtpFrom($fh, $from)) || ($_ = smtpTo($fh, @recips))) {
return "smtpEnvelope ($from, @recips): $_";
}
return undef();
}
sub smtpFrom {
my($fh, $from) = @_;
if (($_ = smtpExchange($fh, "MAIL FROM: <$from>")) !~ m/^[23]/) {
return ("smtpFrom: mail From $from: error ($_)");
}
return undef();
}
sub smtpTo {
my($fh, @recips) = @_;
my($to);
unless (@recips) { return ("No recipient!") }
foreach $to (@recips) {
unless ($to) {
errlog("Null recipient in smtpTo, skipping");
next;
}
if (($_ = smtpExchange($fh, "RCPT TO: <$to>")) !~ m/^[23]/) {
return ("smtpTo rcpt to:$to ($_)");
}
}
return undef();
}
sub smtpData {
my($fh, $data) = @_;
$data =~ s/^\./\.\./gm; # handle . as first character
if ($_ = smtpBeginData($fh)) { return $_; }
smtpOutput($fh, $data);
if ($debug) { errlog("Wrote " . length($data) . " bytes of data"); }
return smtpEnd($fh);
}
sub smtpOutput {
my($fh, $data) = @_;
my($i, $c, $lc);
for ($i = 0; $i < length($data); $i++) {
$c = substr($data, $i, 1);
if (($c eq "\012") && ($lc ne "\015")) {
print $fh "\015";
}
$lc = $c;
print $fh $c;
}
}
sub smtpBeginData {
my($fh) = @_;
if (($_ = smtpExchange($fh, "DATA")) !~ m/^[23]/) {
return ("smtpBeginData: Cannot send data ($_)");
}
return undef();
}
sub smtpRset {
my($fh) = @_;
if (($_ = smtpExchange($fh, "RSET")) !~ m/^[23]/) {
return ("smtpRset: Cannot rset smtp ($_)");
}
return undef();
}
sub smtpEnd {
my($fh) = @_;
if (($_ = smtpExchange($fh, "\015\012.")) !~ m/^[23]/) {
return ("smtpEnd: message transmission failed: $_");
}
return undef();
}
sub smtpClose {
my($fh) = @_;
my($code) = smtpExchange($fh, "QUIT");
close $fh;
if ($code !~ m/^[23]/) {
return ("smtpClose: cannot quit: $_");
} else {
return undef();
}
}
sub smtpExchange {
my($fh, $cmd) = @_;
my($resp);
if ($cmd) {
print $fh ($cmd . "\015\012");
if ($debug) { errlog(">> $cmd"); }
}
while (($resp = <$fh>) !~ m/^(\d+)\s/) {
if ($debug) { errlog("<. $resp"); }
}
chomp($resp);
if ($debug) { errlog("<< $resp"); }
return $resp;
}
1;
I'm trying to run this perl script called "salter" on activestates komodo.
I hope to use it with Mozilla Thunderbird. I've read Learning Perl, another
perl book, went to perl.com, perl.org, pm.org, and cpan.com but nothing
seems to help. I will show you the script. Any help will be appreciated.
TIA Steve
------------------------------
#!/usr/bin/perl -w
# Salter single-threaded email address salter
# (c) 2003, 2004 Julian Haight, http://www.julianhaight.com/
# All Rights Reserved under GPL: http://www.gnu.org/licenses/gpl.txt
# Current version available here: http://www.julianhaight.com/salter
# Version history
# 7/19/04 V1.2
# added stripsender feature
# fixed missing newline between header & body
# 3/26/04 V1.1
# cleaned up smtp sending code, added envonly mode, added version
# 3/12/04
# give each recipient their own, permanent random virtual sender
# move config to user-dir, not /etc.
# 9/29/03 - changed to use only lowercase-alpha, avoid spam filters
# Also, added final response after quit (worked without for pine, but not
moz)
use strict; use Socket; use FileHandle; use Digest::MD5;
my($CONFIG) = ($ENV{HOME} . '/.salter');
my($MAPFN) = "$CONFIG/map.txt";
my($EOL) = "\015\012";
my($debug) = 0;
my($SMTPTO) = 10; # 10 second timeout
my($VERSION) = 'V1.2';
my($SAMP) = '
# here is a sample config file:
listenport 2525
listenip 127.0.0.1
sendport 25
sendip your_isps_mailserver.example.com
maxclient 5
# 1 for unsafe but fast!, 0 for slow & steady (not yet available)
buffermode 1
# 1 remaps only envelope, not header, good if you want to filter bad bounces
envonly 0
# 1 strips sender field (for pine or whatever)
stripsender 1
# From this address To random @ this domain!
# ----------------- ------------------------
remap (e-mail address removed) salty.you.example.com
remap (e-mail address removed) foo.example.com
# to set your identity per-recipient (email or part)
# - use workplace address for work recipients
hardwire workplace.example.com (e-mail address removed)
# - use mailing list subscription address when posting to list.
hardwire (e-mail address removed) (e-mail address removed)
# end sample config!
';
my(%config, %remap, %map, %hardwire);
unless (-e $CONFIG) { mkdir($CONFIG); }
readConfig(); # read the config file into %config
readMap();
listenLoop(); # work 'til you die!
exit 0;
# listen for one connection at a time, and call the proxy for each one.
# die if there are errors
sub listenLoop {
my($cliaddr, $cliip, $cliport);
socket(SOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp')) ||
die "Socket: $!";
setsockopt(SOCK, SOL_SOCKET, SO_REUSEADDR, pack('l', 1)) ||
die "Setsockopt: $!";
bind(SOCK, sockaddr_in($config{'listenport'},
inet_aton($config{'listenip'}))) ||
die "bind: $!";
listen(SOCK, $config{'maxclient'}) ||
die "listen: $!";
while ($cliaddr = accept(CLI, SOCK)) {
# print STDERR "got connection\n";
($cliport, $cliip) = (sockaddr_in($cliaddr));
CLI->autoflush(1);
if ($_ = proxyIt(\*CLI)) {
print STDERR "<< 550 Proxy error: $_\n";
print CLI "550 Proxy error: $_\n";
}
close CLI;
}
}
sub proxyIt {
my($CLI) = @_;
my($cmds, $head, $body, $cmd);
$cmds = '';
unless ($config{buffered}) {
print $CLI "500 No safe delivery mode yet, sorry!$EOL";
close($CLI);
die "No safe mode yet, sorry!";
}
# read smtp
print $CLI "220 localhost SMTP pretender: salter $VERSION $EOL";
while ($cmd = <$CLI>) {
$cmds .= $cmd || '';
if (lc($cmd) eq "data$EOL") { last; }
if (lc(substr($cmd, 0, 4)) eq 'ehlo') {
print $CLI "451 EHLO is soo complicated$EOL";
} else {
print $CLI "250 Buffering$EOL";
}
}
print $CLI "354 Ready for data$EOL";
# read head
while ($cmd = <$CLI>) {
if ($cmd eq $EOL) { last; }
if ((!$config{stripsender}) || ($cmd !~ m/^sender:/i)) {
$head .= $cmd;
}
}
# read body
while ($cmd = <$CLI>) {
if ($cmd eq ".$EOL") { last; }
$body .= $cmd;
}
while ($CLI && print $CLI "250 Buffering$EOL") {
$cmd = <$CLI>;
$cmds .= $cmd;
if (lc($cmd) eq "quit$EOL") { last; }
}
print $CLI "221 Bye bye, hopefully it'll work!$EOL";
close $CLI;
deliverAll($cmds, $head, $body);
}
sub deliverAll {
my($cmds, $head, $body) = @_;
my($recipmap, $message, $line, $remap, $recip, $sender,
$sremap, $cmd, $val, $S,
@recips, $from);
# print STDERR "Deliverall:\n$cmds\n==\n$head\n--\n$body\n++\n";
while ($cmds =~ m/([^:\n]*): ?\<?([^\>\n]*[^\s\>])?\>?/g) {
$cmd = lc($1); $val = $2;
# print "cmd: $cmd = $val\n";
if ($cmd eq 'mail from') {
$sender = $val;
} elsif ($cmd eq 'rcpt to') {
$recip = $val;
$remap = getRecipMapping($recip);
# print STDERR "remap $recip to $remap\n";
push(@{$recipmap->{$remap}}, $recip);
}
}
# print STDERR "Done w/commands\n";
while ($_ = smtpOpen(*S)) {
print STDERR "Cannot open smtp: $_, sleeping..\n";
sleep(3);
}
# print STDERR "Smtp open\n";
foreach $remap (keys(%{$recipmap})) {
$message = 'X-Mailer-Addon: Salter ' . $VERSION .
' http://www.julianhaight.com/salter' . $EOL . $head;
$_ = $recipmap->{$remap};
$sremap = $sender;
(@recips) = (@$_);
foreach $from (keys(%remap)) {
if ($remap =~ m/\@/) {
#print "For @recips, $from -> $remap\n";
unless ($config{envonly}) {
$message = replace($message, $from, $remap);
}
$sremap = replace($sremap, $from, $remap);
} else {
unless ($config{envonly}) {
$message = replace($message, $from,
$remap . '@' . $remap{$from});
}
$sremap = replace($sremap, $from,
$remap . '@' . $remap{$from});
}
}
# print "Sending\n$message\n\n";
unless ($sremap) {
print STDERR "sender $sender not remapped\n";
$sremap = $sender;
}
$message .= $EOL . $body;
if (($_ = smtpEnvelope(\*S, $sremap, @recips)) ||
($_ = smtpData(\*S, $message))) {
# die "Error during delivery: $_";
print STDERR ("Failed to send: $_ saving in $CONFIG/failed.txt");
open (SAVE, ">>$CONFIG/failed.txt");
print SAVE $message;
close(SAVE);
# } else {
# print "Message delivered: $sremap -> @recips\n";
}
}
}
sub randSecret {
my($len) = @_;
my($char, $pass, $i);
for ($i=0; $i < $len; $i++) {
$char = int(rand() * 26);
$char += 97;
$pass .= pack('c', $char);
}
return $pass;
}
sub readConfig {
my($line);
my($fn) = "$CONFIG/salter.conf";
unless (-e $fn) {
print STDERR "Salter not configured. Please create $fn. Sample:
$SAMP
";
exit 1;
}
open (CONFIG, $fn) || die "$fn $!";
while ($line = <CONFIG>) {
if ($line =~ m/^([^\#;\s]\S+)\s*(\S+)\s*(\S*).*$/) {
if ($1 eq 'remap') {
$remap{$2} = $3;
} elsif ($1 eq 'hardwire') {
$hardwire{$2} = $3;
} else {
$config{$1} = $2;
}
}
}
print STDERR "Listening on $config{'listenip'}:$config{'listenport'}
Outbound on $config{'sendip'}:$config{'sendport'}\n";
}
sub getSenderMapping {
my($addr) = lc(@_);
return $remap{$addr}
}
sub getRecipMapping {
my($addr) = lc($_[0]);
my(@parts, $part);
# exact match
if ($part = $hardwire{$addr}) {
return $part;
}
# domain match
(@parts) = (getDomParts($addr));
while (@parts) {
if ($part = $hardwire{join('.', @parts)}) {
return $part;
}
pop(@parts);
}
# default randomizer
return getMapping($addr);
}
sub getDomParts {
my($addr) = @_;
my($dom, @parts);
# print "getDomParts $addr\n";
# print hexDump($addr) . "\n";
if ($addr =~ m/[^\@]*\@(.*)/) {
# if ($addr =~ m/^\s*[^\@\s]+\@([^\@\s]+)\s*$/) {
$dom = $1;
(@parts) = (split(/\./, $dom));
}
# print STDERR "parts: @parts ($dom)\n";
return (@parts);
}
sub getMapping {
my($addr) = @_;
my($hash) = Digest::MD5::md5_base64($addr);
my($rand);
unless ($rand = $map{$hash}) {
$map{$hash} = ($rand = randSecret(16));
writeMap($hash, $rand);
}
# print "getMapping $addr = $rand\n";
return ($rand);}
sub writeMap {
open(MAP, ">>$MAPFN") || return 1;
print MAP join(' ', @_) . "\n";
close(MAP);
}
sub readMap {
my($line);
my($key, $val);
unless (-e $MAPFN) {
print STDERR "Starting hashed recip map in $MAPFN\n";
} elsif (open (MAP, $MAPFN)) {
while (($key, $val) = split(' ', <MAP>)) {
chop($map{$key} = $val);
}
} else {
die "Error opening $MAPFN for read: $!";
}
close(MAP);
}
sub replace {
my($text, $old, $new) = @_;
my($loc, $len);
# print "text: $text\n";
if (index($new, $old) >= 0) { return $text; }
$len = length($old);
$loc = index($text, $old);
while ($loc >= 0) {
$text = substr($text, 0, $loc) . $new . substr($text, $loc + $len);
$loc = index($text, $old);
}
# print "replaced $old with $new in text: $text\n";
return $text;
}
sub errlog {
print STDERR "@_\n";
}
sub hexDump {
my($string) = @_;
my($size) = 15;
my($char, $rval, $hex, $str, $asc);
foreach $char (split('', $string)) {
$asc = unpack('C', $char);
if (($asc < 32) || ($asc > 176)) {
$char = '?';
$hex .= sprintf('%.2x<', $asc);
} else {
$hex .= sprintf('%.2x ', $asc);
}
$str .= $char;
if (length($str) >= $size) {
$rval .= $hex . $str . "\n";
$hex = ''; $str = '';
}
}
if ($hex) {
$hex .= (' ' x (($size*3) - length($hex)));
$rval .= $hex . $str . "\n"
}
$rval = substr($rval, 0, length($rval)-1);
return $rval;
}
# (C) 2002, 2003 Julian Haight. All rights reserved
# original sendmail 1.21 by Christian Mallwitz.
# Modified and 'modulized' by (e-mail address removed)
# totally mangled by julian
# adapted for salter 3/13/04
sub smtpSend {
my($message, $fromaddr, @recips) = @_;
unless ($message) {
errlog ("Refusing to send empty email $fromaddr -> @recips");
return undef();
} if ($debug) { errlog("trying smtpSend"); }
# now, isn't that pretty?
if (($_ = smtpOpen(\*S)) ||
($_ = smtpEnvelope(\*S, $fromaddr, @recips)) ||
($_ = smtpData(\*S, $message)) ||
($_ = smtpClose(\*S))) {
return ("smtpSend:" . $_);
} else {
return undef();
}
}
sub smtpOpen {
my($fh) = @_;
my($k, $proto, $smtpaddr);
($smtpaddr) = (gethostbyname($config{sendip}))[4];
my $save_w = $^W;
local $/;
$/ = "\015\012";
$proto = (getprotobyname('tcp'))[2];
unless (defined($smtpaddr)) {
return ("smtpOpen: smtp host unknown:'" . $config{sendip} . "'");
}
# open socket and start mail session
if (!socket($fh, AF_INET, SOCK_STREAM, $proto)) {
return ("smtpOpen: socket failed ( $! )");
}
# connect
if (!connect($fh, pack('Sna4x8', AF_INET, $config{sendport},
$smtpaddr))) {
if ($! eq 'Interrupted system call') {
return "smtpOpen: timeout after $SMTPTO seconds during connect";
} else {
return ("smtpOpen: connect to smtp server failed ($!)");
}
}
my($oldfh) = select($fh); $| = 1; select($oldfh);
if (($_ = smtpExchange($fh)) !~ m/^[23]/) {
return ("smtpOpen: smtpsend connection error from smtp server
($_)");
}
if (($_ = smtpExchange($fh, "HELO Salter" . $VERSION)) !~ m/^[23]/) {
return ("smtpOpen: smtpsend HELO error ($_)");
}
return undef();
}
sub smtpEnvelope {
my($fh, $from, @recips) = @_;
if (($_ = smtpFrom($fh, $from)) || ($_ = smtpTo($fh, @recips))) {
return "smtpEnvelope ($from, @recips): $_";
}
return undef();
}
sub smtpFrom {
my($fh, $from) = @_;
if (($_ = smtpExchange($fh, "MAIL FROM: <$from>")) !~ m/^[23]/) {
return ("smtpFrom: mail From $from: error ($_)");
}
return undef();
}
sub smtpTo {
my($fh, @recips) = @_;
my($to);
unless (@recips) { return ("No recipient!") }
foreach $to (@recips) {
unless ($to) {
errlog("Null recipient in smtpTo, skipping");
next;
}
if (($_ = smtpExchange($fh, "RCPT TO: <$to>")) !~ m/^[23]/) {
return ("smtpTo rcpt to:$to ($_)");
}
}
return undef();
}
sub smtpData {
my($fh, $data) = @_;
$data =~ s/^\./\.\./gm; # handle . as first character
if ($_ = smtpBeginData($fh)) { return $_; }
smtpOutput($fh, $data);
if ($debug) { errlog("Wrote " . length($data) . " bytes of data"); }
return smtpEnd($fh);
}
sub smtpOutput {
my($fh, $data) = @_;
my($i, $c, $lc);
for ($i = 0; $i < length($data); $i++) {
$c = substr($data, $i, 1);
if (($c eq "\012") && ($lc ne "\015")) {
print $fh "\015";
}
$lc = $c;
print $fh $c;
}
}
sub smtpBeginData {
my($fh) = @_;
if (($_ = smtpExchange($fh, "DATA")) !~ m/^[23]/) {
return ("smtpBeginData: Cannot send data ($_)");
}
return undef();
}
sub smtpRset {
my($fh) = @_;
if (($_ = smtpExchange($fh, "RSET")) !~ m/^[23]/) {
return ("smtpRset: Cannot rset smtp ($_)");
}
return undef();
}
sub smtpEnd {
my($fh) = @_;
if (($_ = smtpExchange($fh, "\015\012.")) !~ m/^[23]/) {
return ("smtpEnd: message transmission failed: $_");
}
return undef();
}
sub smtpClose {
my($fh) = @_;
my($code) = smtpExchange($fh, "QUIT");
close $fh;
if ($code !~ m/^[23]/) {
return ("smtpClose: cannot quit: $_");
} else {
return undef();
}
}
sub smtpExchange {
my($fh, $cmd) = @_;
my($resp);
if ($cmd) {
print $fh ($cmd . "\015\012");
if ($debug) { errlog(">> $cmd"); }
}
while (($resp = <$fh>) !~ m/^(\d+)\s/) {
if ($debug) { errlog("<. $resp"); }
}
chomp($resp);
if ($debug) { errlog("<< $resp"); }
return $resp;
}
1;