#!/usr/bin/perl -w use strict; use IO::Socket; use Net::DNS; use MIME::Lite; sub mail_run; sub send_letter($$$$); my ($msg, $resp, $from_addr, $subject); my $debug; my ($child_count, $kid_pid); my $conn_id; my $sim_delivery = 30; $| = 1; $debug = 0; while (my $arg = shift) { if ($arg eq '-d') { $debug = 1 } elsif ($arg eq '-s') { $sim_delivery = shift or die "You must specify the number of simultaneous deliveries!\n" } } for ($child_count = 0; $child_count < $sim_delivery; $child_count++) { if (!defined($kid_pid = fork())) { die "Couldn't fork!\n"; } elsif ($kid_pid) { # I'm the daddy - don't do nothin, yet } else { mail_run; exit; } } while ($child_count > 0) { wait; $child_count--; } sub snd { my $sock = shift; my $msg = shift; my $len = length($msg); if ($debug) {print $conn_id . ": sent: $msg\n"} $msg = pack('N', $len) . $msg; syswrite($sock, $msg, length($msg)); } sub rcv { my $sock = shift; my $buf; my ($bytes_read, $total_read, $bytes_to_read); $bytes_read = sysread($sock, $buf, 4); if ($! || ($bytes_read != 4)) { return undef; } else { $bytes_to_read = unpack('N',$buf); $total_read = 0; my $buf2 = $buf = undef; while ($total_read < $bytes_to_read) { $bytes_read = sysread($sock, $buf, $bytes_to_read - $total_read); $buf2 .= $buf; $total_read += $bytes_read; } $buf = $buf2; } return $buf; } sub mail_run { my $stop; my $server = IO::Socket::INET->new( Proto => 'tcp', PeerAddr => 'localhost', PeerPort => 6900 ); $server->autoflush(); $_ = rcv($server); ($conn_id) = /HELO (.*)/; if ($debug) {print "$conn_id: Connected to server\n"} $stop = 0; while (!$stop) { if (!defined $msg) { if ($debug) {print "$conn_id: Getting message\n"} snd($server,"get_msg"); $msg = rcv($server); if (!defined $msg || $msg =~ /^FIN/) { snd($server,"quit"); $stop = 1; } else { ($from_addr, $subject, $msg) = split("\n", $msg, 3); } } else { if ($debug) {print "$conn_id: Requesting next address\n"} snd($server,"next_addr"); $server->flush(); if ($debug) {print "$conn_id: Request sent...waiting\n"} $resp = rcv($server); $resp =~ s/[\r|\n]//g; if ($debug) {print "$conn_id: server said: $resp\n"} if ($resp eq 'FIN') { if ($debug) {print "$conn_id: Getting message\n"} snd($server,"get_msg"); $msg = rcv($server); if (!defined $msg || $msg eq 'FIN') { if ($debug) {print "$conn_id: server said: FIN (msg)\n"} snd($server,"quit"); $stop = 1; } else { ($from_addr, $subject, $msg) = split("\n", $msg, 3); } } else { if ($debug) { print "$conn_id: From: $from_addr\nTo: $resp\nSubject: $subject\n"; sleep 2; } else { if (send_letter($from_addr, $resp, $subject, $msg)) { snd($server,"succ_addr $resp"); } else { snd($server,"fail_addr $resp"); } $resp = rcv($server); } } } } } sub send_letter($$$$) { my $from_addr = shift; my $to_addr = shift; my $subject = shift; my $body = shift; my $username = undef; my $domain = undef; my $success = 0; ###################### # add email validation ###################### if ( $to_addr =~ /\@/ ) { ($username, $domain) = split /\@/, $to_addr; my $msg = MIME::Lite->new( From => $from_addr, To => $to_addr, Subject => $subject, Data => $body, Type => 'text/html' ); my $res = Net::DNS::Resolver->new(); my @mx = mx($res, $domain); my $i = 0; my $num_mx = @mx; while ($i < $num_mx && !$success) { # print "\n$to_addr: ", $mx[$i]->exchange; eval('$msg->send_by_smtp($mx[$i]->exchange, Timeout=>60)'); if ( !$@ ) { $success = 1 } $i++; } } return $success; }