What changes do I have to make?

What changes do I have to make on this Unix perl source code
to make it run
on Windows TIA Steve

--------------------
#!/usr/bin/perl -w
# Salter single-threaded email address salter

# (c) 2003-2007 Julian Haight,      http://www.julianhaight.
com/
# All Rights Reserved under GPL:    http://www.gnu.or
g/licenses/gpl.txt
# Current version available here:   http://www.julianh
aight.com/salter

my($VERSION) = 'V1.5';

# Version history

# 30 Jan 07 V1.5
# add dkim and domain keys signing

# 3/2/05 V1.4
# add more verbose status reporting

# 2/10/05 V1.3
# fixed bug related to unavailable smtp/regex

# 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 . '/.salter'); 
my($MAPFN) = "$CONFIG/map.txt";
my($EOL) = "1512";
my($debug) = 0;
my($SMTPTO) = 10; # 10 second timeout
my($DKIMSELECT) = 'mail';

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	        youexample.com         salty.you.example.com
remap	        otherexample.com       foo.example.com

# to set your identity per-recipient (email or part)
# -  use workplace address for work recipients
hardwire        workplace.example.com  youworkplace.example.com
# -  use mailing list subscription address when posting to
list.
hardwire        list1ml.example.com    listsubaddrexample.com

# if present for salted domain,
# salter will sign with dkim, using dkim selector
"mail"
dkim.salty.you.example.com             
~/.salter/dkim_priv_key
dkim.foo.example.com                   
~/.salter/dkim_priv_key
dkim.example.com                       
~/.salter/dkim_priv_key

# 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 connectionn";
	($cliport, $cliip) = (sockaddr_in($cliaddr));
	CLI->autoflush(1);
	if ($_ = proxyIt(*CLI)) {
	    print STDERR "<< 550 Proxy error:
$_n";
	}
    }
}

sub proxyIt {
   my($CLI) = _;
   my($cmds, $head, $body, $cmd, $msgid);
   $body = '';
   $cmds = ''; 
   unless ($config) {
       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 so, so
complicated$EOL";
	   print $CLI "250 Buffering$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) || ($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;
   if ($head =~ m/message-id: (S+)/i) { $msgid = $1; }
   print "Accepted message $msgidn";
   deliverAll($cmds, $head, $body);
   return undef();
}

sub deliverAll {
    my($cmds, $head, $body) = _;
    my($recipmap, $message, $line, $remap, $recip, $sender,

       $sremap, $sremap_dom, $cmd, $val, $S,
       recips, $from);
    while ($cmds =~ m/([^:n]*):
?<?([^>n]*[^s>])?>?/g) {
	$cmd = lc($1); $val = $2;
	if ($cmd eq 'mail from') {
	    $sender = $val;
	} elsif ($cmd eq 'rcpt to') {
	    $recip = $val;
	    $remap = getRecipMapping($recip);
	    push({$recipmap->{$remap}}, $recip);
	}
    }
    while ($_ = smtpOpen(*S)) {
	print STDERR "Cannot open smtp: $_,
sleeping..n";
	sleep(3);
    }
    foreach $remap (keys(%{$recipmap})) {
	$message = 'X-Mailer-Addon: Salter ' . $VERSION . 
	    ' http://www.julianh
aight.com/salter' . $EOL . $head;
	$_ = $recipmap->{$remap};
	$sremap = $sender;
	(recips) = ($_);
	foreach $from (keys(%remap)) {
	    if ($remap =~ m//) {
		unless ($config) {
		    $message = replace($message, $from, $remap);
		}
		$sremap = replace($sremap, $from, $remap);
	    } else {
		unless ($config) {
		    $message = replace($message, $from, 
				       $remap . '' . $remap{$from});
		}
		$sremap = replace($sremap, $from, 
				  $remap . '' . $remap{$from});
	    }
	}
	unless ($sremap) {
	    print STDERR "sender $sender not
remappedn";
	    $sremap = $sender;
	}
	$message .= $EOL . $body;

	if ($sremap =~ m/(.*)$/) {
	    $sremap_dom = $1;
	}
	if ( $config{ 'dkim.' . $sremap_dom } ) {
	    $message = signDkim($message, $sremap_dom);
	}
	if (($_ = smtpEnvelope(*S, $sremap, recips)) ||
	    ($_ = smtpData(*S, $message))) {
	    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 -> recipsn";
	}
    }
    smtpClose(*S);
}

sub signDkim {
    require Mail:KIM::Sig
ner;
    
    my($dkim, $message, $domain, $sig, $sigtxt, $dktxt);
    ($message, $domain) = _;
    if (!-e $config{'dkim.' . $domain}) {
	print STDERR "dkim private key for $domain is
missingn";
	return $message;
    }
    $dkim = new Mail:KIM::Sig
ner
	(Algorithm => 'rsa-sha1',
	 Domain => $domain,
	 Selector => $DKIMSELECT,
	 Method => 'relaxed',
	 KeyFile => $config{'dkim.' . $domain});
    $dkim -> PRINT($message);
    $dkim->finish_body();
    $sig = $dkim->signature();

    
    $sigtxt = $sig->as_string();

    $dktxt = $sigtxt;
#    $dktxt = $sigtxt = replace($sigtxt, ' ', $EOL .
"t");
    $dktxt = replace(replace($dktxt, 'c=relaxed',
'c=nofws'), 
		     'DKIM-Signature', 'DomainKey-Signature');
    $dktxt =~ s/bh=S+s*//;
    return $sigtxt . $EOL . $dktxt . $EOL . $message;
#    return $sigtxt . $EOL . $message;
}

sub signDomainKeys {
    require Mail:omainKey
s;
    my($dk, $key, $head, $body, $message, $domain);
    ($message, $domain) = _;

    $dk = new Mail:omainKey
s::Message;
    if ($_ = index($message, $EOL . $EOL) >=0) {
	$head = substr($message, 0, $_);
	$body = substr($message, $_);
    } else {
	print STDERR "Cannot find head/body split for
DomainKeysn";
    }
    $dk->load(HeadString => $head,
	      BodyReference => $body);
    $key = load Mail::domainKeys::Key::Private
	(File => $config{'dkim.' . $domain});
    $dk->sign(Method=>'simple',
	      Selector=>$DKIMSELECT);
}

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 $addrn";
#    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 = $randn";
    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
$MAPFNn";
    } 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: $textn";
    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:
$textn";
    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 ivkoviccsi.com
# 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))[4];
    
    my $save_w = $^W;
    local $/;
    $/ = "1512";
    
    $proto = (getprotobyname('tcp'))[2];
    unless (defined($smtpaddr)) {
	return ("smtpOpen: smtp host unknown:'" .
$config . "'");
    }
    # 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,
$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 "12") && ($lc ne
"15")) {
	    print $fh "15";
	}
	$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, "1512.")) !~
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 . "1512");
	if ($debug) { errlog(">> $cmd"); }
    }
    while (defined($resp = <$fh>) && ($resp !~
m/^(d+)s/)) {
	if ($debug) { errlog("<. $resp"); }
    }
    chomp($resp);
    if ($debug) { errlog("<< $resp"); }
    return $resp;
}

1;


_______________________________________________
Perl-Win32-Users mailing list
Perl-Win32-Userslistserv.ActiveState.com
To unsubscribe: http:/
/listserv.ActiveState.com/mailman/mysubs