#!/usr/local/bin/perl -w
BEGIN {
$Sys::Syslog::host = "bug_in_perl_5.003";
}
use strict;
#
# $Header: /home/tibbs/tlb/RCS/tlb,v 1.26 1998/09/22 04:41:41 tibbs Exp $
#
$::rcs_version = '$Revision: 1.26 $$Author: tibbs $$Date: 1998/09/22 04:41:41 $';
$::rcs_version =~ s/\$|Revision: |Author: |Date: //g;
$::rcs_version =~ s/ $//;
$::release_version = "0.11a";
require 5.002;
# Extra libraries required.
# These come with perl.
use Carp;
use Getopt::Std;
use POSIX qw(ceil waitpid);
use Socket 1.3;
use IPC::Open2;
# These you need to get from CPAN; see http://www.perl.com/perl
# Copies that are possibly out of date but are known to work are at
# ftp://ftp.hpc.uh.edu/pub/tlb/
use IO::Socket; # From the IO package
use Net::Domain qw(hostfqdn hostname); # From the libnet package
use Date::Format qw(strftime); # From the TimeDate package
use Mail::Address qw(address parse); # From the MailTools package
# Uncomment if you have the module and want more precise performance data
# use Time::HiRes qw(time);
# Perl 5.003 has a bug in Sys::Syslog, fixed in 5.003_01. We work around
# it here, and with the BEGIN clause.
use Sys::Syslog;
$Sys::Syslog::host = hostfqdn;
# Prototypes for all subroutines.
sub AddRecipient ($ );
sub BatchAddrLists ();
sub BatchSeparatedomains ($$$ );
sub BatchMaxaddrs ($$ );
sub BatchMaxdomains ($$ );
sub BatchNumbatches ($$ );
sub ChildReaper ();
sub CloseAllConnections ();
sub CloseConnection (@ );
sub CloseEnvelope (@ );
sub DeliverBatches ();
sub GetResponse ($$$ );
sub Log ($$$ );
sub LogAbort ($ );
sub LogClose ();
sub LogIn ($$$ );
sub LogOpen ();
sub LogOut (;$ );
sub LogStartupTime ();
sub MakeFromLine ();
sub ParseAddrs ($ );
sub PrintAddrLists ();
sub PrintBatches ();
sub PrintUsageInfo ();
sub PrintVersionInfo ();
sub PushAddr ($ );
sub ReadAddrs ($ );
sub ReverseDomain ($ );
sub RunTestMode ();
sub OpenCommand ($ );
sub OpenConnection ($$ );
sub OpenEnvelope ($$ );
sub OpenSocket ($$ );
sub ReadMessage ();
sub SendData ($@ );
sub SendGreeting ($@ );
sub SendMessage ($@ );
sub SendRCPT ($@ );
sub SendSMTP ($$@ );
sub SendToExternals ($$ );
sub SortAddrLists ();
# Set up child process reaper; we can leave this in constantly because we
# always want to reap children.
$SIG{CHLD} = \&ChildReaper;
# Constants. One day the compiler will make these fast.
sub DEFAULT_BATCH_SIZE { 10 };
sub DEFAULT_TIMEOUT { 60 };
$| = 1;
# Process command line args.
getopts('abcl:x:y:z:vhd:t:');
#Aargh
use vars qw($opt_a $opt_b $opt_c $opt_h $opt_l $opt_v $opt_x $opt_y $opt_z);
if ($::opt_v) {
PrintVersionInfo;
exit(0);
}
if ($::opt_h) {
PrintUsageInfo;
exit(0);
}
# Set defaults for config variables, override from config file, then
# calculate unspecified vaules, if needed
{
package Config;
no strict "vars"; # Turn off strict checking for this block
use vars qw($opt_a $opt_b $opt_c $opt_x $opt_y $opt_z);
my($i, $j);
# Pull the user options into this package
#foreach $i (qw(a b c l x y z)) {
# $j = "\$opt_$i = \$::opt_$i";
# eval $j;
#}
$opt_a = $::opt_a;
$opt_b = $::opt_b;
$opt_c = $::opt_c;
$opt_l = $::opt_l;
$opt_x = $::opt_x;
$opt_y = $::opt_y;
$opt_z = $::opt_z;
$address_file = undef;
$sender = undef;
$send_no_mail = undef;
$send_to_externals = undef;
$list_name = $opt_l || "init";
$local_ESMTP = undef;
$local_hostname = ::hostfqdn(); # it wasn't imported into this package
$log_entries = undef;
$log_level = 6;
$mailer = "/usr/sbin/sendmail -bs";
$sorted_address_list = undef;
$stripped_address_list = undef;
$tempdir = "/tmp";
@delivery_matrix = ();
@external_programs = ();
# Open the log now, to have a place to complain about errors.
::LogOpen;
# What's left after argument processing must be the config file. Check it, then load it.
unless (defined $::ARGV[0]) {
::LogAbort("You must specify a config file, stopped");
}
unless (-r $::ARGV[0]) {
::LogAbort("Invalid or unreadable config file: $::ARGV[0], stopped");
}
require $::ARGV[0] ||
::LogAbort("Error loading config file: $::ARGV[0], $!, stopped");
# Check values and abort if necessary.
# XXX Need more checks here
unless ($address_file) {
::LogAbort("Config must specify address file, stopped");
}
unless (-r $address_file) {
::LogAbort("Cannot read address file \"$address_file\", stopped");
}
$address_file =~ m|.*/(.*)|;
$list_name = $opt_l || $1 || $list_name;
# Provide defaults derived from other config variables
$sender = "owner-$list_name\@$local_hostname" unless $sender;
}
# We reset the log here so new parameters will take effect.
::LogClose;
::LogOpen;
# Avoid annoying warnings
if (!$::opt_d) {
$::opt_d = 0;
}
# Allow a simple failsafe
if (defined $Config::send_no_mail && !defined $::opt_t) {
$::opt_d = $::opt_d | 256;
}
# 256 implies 128, or we bomb writing to unopened handles
if ($::opt_d & 256) {
$::opt_d = $::opt_d | 128;
}
print "Debugging with $::opt_d.\n" if $::opt_d;
print "Testing with $::opt_t.\n" if $::opt_t;
if ($::opt_t) {
RunTestMode;
exit(0);
}
#
# Main program flow (yup, this is it)
#
LogStartupTime;
($::filename,$::from_line) = ReadMessage;
if ($Config::send_to_externals &&
defined(@Config::external_programs))
{
SendToExternals($::filename, $::from_line);
}
ReadAddrs($Config::address_file);
PrintAddrLists if ($::opt_d & 1);
unless ($Config::sorted_address_list) {
SortAddrLists;
PrintAddrLists if ($::opt_d & 2);
}
BatchAddrLists;
PrintBatches if ($::opt_d & 4);
DeliverBatches unless ($::opt_d & 256);
unlink $::filename;
exit(0);
#
# Subroutines follow
#
#
# Address/Batch handling routines
#
# Read in the addresses and put them into the main data structure
sub ReadAddrs ($) {
my($file) = shift;
LogIn(6, "info", "Reading addresses");
open(LIST,$file) or
LogAbort("Couldn't open address file $file: $!");
# read in addresses and place them in the proper address lists
while (<LIST>) {
# XXX Could do more useful address parsing here.
# XXX Will ignoring lines with leading octathorpes cause problems?
next if /^\#/;
chomp;
PushAddr($_);
}
LogOut;
}
# Push an address, domain pair onto the appropriate address list
sub PushAddr ($) {
my($addr) = shift;
my($domain, $revdomain, $i);
unless ($Config::stripped_address_list) {
$addr = ParseAddrs($addr);
}
($domain = $addr) =~ s/(.*@|\[|\])//g; # Leave only the domain and strip brackets.
$revdomain = uc(join('.',reverse(split /\./,$domain)));
for $i (0..$#Config::delivery_matrix) {
if (!defined $Config::delivery_matrix[$i]{'regexp'} ||
$domain =~ /$Config::delivery_matrix[$i]{'regexp'}/i)
{
push @{$Config::delivery_matrix[$i]{'addrs'}},[$addr, $revdomain];
return;
}
}
# Only get here if no match, meaning we have a completely unspecified
# default destination. We extend the delivery matrix by one element to
# include the default delivery path. We should only ever get here once.
push @{$Config::delivery_matrix[$#Config::delivery_matrix + 1]{'addrs'}},[$addr, $revdomain];
}
# Sort each of the address lists according to the reversed components of
# the domain, so addresses in the same top level domain cluster together,
# addresses with the same two last domain levels cluster together, etc.
sub SortAddrLists () {
my($i);
LogIn(6, "info", "Sorting addresses");
for $i (0..$#Config::delivery_matrix) {
next if (defined $Config::delivery_matrix[$i]{'nosort'} ||
!defined $Config::delivery_matrix[$i]{'addrs'});
$Config::delivery_matrix[$i]{'addrs'} =
[ sort { $a->[1] cmp $b->[1] } @{$Config::delivery_matrix[$i]{'addrs'}} ];
}
LogOut;
}
# Place address lists into an array of batches
sub BatchAddrLists () {
my($i, $dest, $j, $count, $maxcount, $lastdomain);
LogIn(6, "info", "Batching addresses");
for $i (0..$#Config::delivery_matrix) {
SWITCH: for $dest ($Config::delivery_matrix[$i]) {
if (defined $dest->{'minseparate'}) {
BatchSeparatedomains($dest, $dest->{'minseparate'},
(defined $dest->{'maxdomains'} ?
$dest->{'maxdomains'} :
DEFAULT_BATCH_SIZE));
last SWITCH;
}
if (defined $dest->{'maxdomains'}) {
BatchMaxdomains($dest, $dest->{'maxdomains'});
last SWITCH;
}
if (defined $dest->{'maxaddrs'}) {
BatchMaxaddrs($dest, $dest->{'maxaddrs'});
last SWITCH;
}
{ # DEFAULT
if (!$dest->{'numbatches'}) {
$dest->{'numbatches'} = 1;
print"No batch parameters found; assuming one batch.\n" if ($::opt_d & 4);
}
BatchNumbatches($dest, $dest->{'numbatches'});
last SWITCH;
}
}
}
LogOut;
}
# Make exactly numbatches batches, each with an indeterminate number of
# addresses.
sub BatchNumbatches ($$) {
my($dest) = shift;
my($numbatches) = shift;
my($maxcount, $currentbatch);
print "Batching with numbatches = $numbatches -> " if ($::opt_d & 4);
$maxcount = ceil( ($#{$dest->{'addrs'}}+1) / $numbatches);
BatchMaxaddrs($dest,$maxcount);
}
# Make an indeterminate number of batches each with maxaddrs addresses.
sub BatchMaxaddrs ($$) {
my($dest) = shift;
my($maxcount) = shift;
my($count, $currentbatch, $i);
print "Batching with maxaddrs = $maxcount.\n" if ($::opt_d & 4);
$count = 0;
$currentbatch = 0;
for $i (0..$#{$dest->{'addrs'}}) {
if ($count >= $maxcount) {
$currentbatch++;
$count = 0;
}
push @{$dest->{'batches'}[$currentbatch]}, $dest->{'addrs'}[$i][0];
$count++;
}
}
# Make an indeterminate number of batches each with maxdomains different
# domains. The number of addresses per batch is >= maxdomains.
sub BatchMaxdomains ($$) {
my($dest) = shift;
my($maxcount) = shift;
my($count, $currentbatch, $lastdomain, $i);
print "Batching with maxdomains = $maxcount.\n" if ($::opt_d & 4);
$count = 0;
$currentbatch = 0;
undef $lastdomain;
for $i (0..$#{$dest->{'addrs'}}) {
if (defined $lastdomain &&
$lastdomain ne $dest->{'addrs'}[$i][1] &&
$count >= $maxcount)
{
$currentbatch++;
$count = 0;
}
push @{$dest->{'batches'}[$currentbatch]}, $dest->{'addrs'}[$i][0];
if (! defined $lastdomain ||
$lastdomain ne $dest->{'addrs'}[$i][1])
{
$count++;
$lastdomain = $dest->{'addrs'}[$i][1];
}
}
}
# Put domains appearing more than minseparate times in separate batches;
# put all other domains into batches with maxdomains total domains.
sub BatchSeparatedomains ($$$) {
my($dest) = shift;
my($minseparate) = shift;
my($maxdomains) = shift;
my($count, $stragglercount, $currentbatch, $lastdomain, @stragglers, $i);
print "Batching with minseparate = $minseparate and maxdomains = $maxdomains.\n"
if ($::opt_d & 4);
$count = 0;
$stragglercount = 0;
$currentbatch = 0;
undef $lastdomain;
# Loop over all addresses
for $i (0..$#{$dest->{'addrs'}}) {
# If this domain isn't the same as the last one
if (defined $lastdomain &&
$lastdomain ne $dest->{'addrs'}[$i][1]) {
# If we didn't get enough addresses from that domain
if ($count < $minseparate) {
# Place these addresses in a straggler batch
push @stragglers, @{$dest->{'batches'}[$currentbatch]};
@{$dest->{'batches'}[$currentbatch]} = ();
$stragglercount++;
# If we filled the straggler batch
if ($stragglercount >= $maxdomains) {
# Place it in the list and start a new one
@{$dest->{'batches'}[$currentbatch]} = @stragglers;
@stragglers = ();
$stragglercount = 0;
$currentbatch++;
}
}
# We got enough address from that domain
else {
$currentbatch++;
}
$count = 0;
}
push @{$dest->{'batches'}[$currentbatch]}, $dest->{'addrs'}[$i][0];
$count++;
$lastdomain = $dest->{'addrs'}[$i][1];
}
if (@stragglers) {
if ($#{$dest->{'batches'}[$currentbatch]} < $minseparate) {
push @{$dest->{'batches'}[$currentbatch]}, @stragglers;
}
else {
@{$dest->{'batches'}[$currentbatch+1]} = @stragglers;
}
}
}
# The real work. Deliver each batch according to the rules of the
# destination and hosts.
sub DeliverBatches () {
my($currenthost, @envelope, $i, $j, $result);
LogIn(6, "info", "Delivering batches");
# Loop over each destination
for $i (0..$#Config::delivery_matrix) {
$currenthost = 0;
# It's silly to log this if we only have one destination
unless ($#Config::delivery_matrix == 0) {
LogIn(7, "info", "Delivering to dest $i");
}
# Loop over each batch
for $j (0..$#{$Config::delivery_matrix[$i]{'batches'}}) {
LogIn(8, "info", "Delivering dest $i, batch $j");
# Weird control structure follows. What we want to do is perform a
# series of operations, and if one of them fails we execute failure
# code and try again. If none of them fails, we execute success code
# and exit.
while (1) {
@envelope = OpenEnvelope($Config::delivery_matrix[$i],
$Config::delivery_matrix[$i]{'allhostsdown'}
? 'LOCAL'
: $currenthost);
next unless @envelope;
print "Successfully opened the envelope: D$i, B$j.\n" if ($::opt_d & 16);
# Send the address list
$result = SendRCPT($Config::delivery_matrix[$i]{'batches'}[$j], @envelope);
next unless $result;
if ($result == -1) {
# The batch contained only one bad address, so we pretend it was sent completely
Log(5, "notice", "Batch contained just a single rejected address.\n");
last;
}
# Send the message body
SendMessage($::filename, @envelope) ||
next;
# Close the envelope
CloseEnvelope(@envelope) ||
next;
# OK, we successfully sent a batch. Increment the current host if
# not in failsafe mode, skip backup hosts if no hosts are down.
if (!defined $Config::delivery_matrix[$i]{'allhostsdown'}) {
do {
$currenthost = ($currenthost + 1) % ($#{$Config::delivery_matrix[$i]{'hosts'}} + 1);
} until
(!$Config::delivery_matrix[$i]{'hosts'}[$currenthost]{'down'} &&
(!$Config::delivery_matrix[$i]{'hosts'}[$currenthost]{'backup'}
|| ($Config::delivery_matrix[$i]{'downcount'}
&& $Config::delivery_matrix[$i]{'downcount'} > 0)));
}
print "Switching to host $currenthost.\n" if ($::opt_d & 16);
last;
}
continue {
# Mark host down
print "Marking $Config::delivery_matrix[$i]{'hosts'}[$currenthost]{'hostname'} down.\n"
if ($::opt_d & 8);
Log(3, "notice", "Marking $Config::delivery_matrix[$i]{'hosts'}[$currenthost]{'hostname'} down.\n");
$Config::delivery_matrix[$i]{'hosts'}[$currenthost]{'down'} = 1;
$Config::delivery_matrix[$i]{'downcount'}++;
# Nuke a possible cached connection
delete $Config::delivery_matrix[$i]{'connection'};
# Are all our hosts down? Fall back to failsafe.
if ($Config::delivery_matrix[$i]{'downcount'} >= ($#{$Config::delivery_matrix[$i]{'hosts'}}+1)) {
print "Switching to failsafe.\n" if ($::opt_d & 8);
Log(2, "warning", "Dest $i, in failsafe mode.");
$Config::delivery_matrix[$i]{'allhostsdown'} = 1;
}
else {
# Skip to next working host
SKIP:
while (1) {
$currenthost = ($currenthost + 1) % ($#{$Config::delivery_matrix[$i]{'hosts'}}+1);
last SKIP unless $Config::delivery_matrix[$i]{'hosts'}[$currenthost]{'down'};
}
}
}
LogOut;
}
unless ($#Config::delivery_matrix == 0) {
LogOut;
}
}
LogOut;
CloseAllConnections;
}
#
# Message handling functions
#
# Read the message in from STDIN, adding our Received: header and saving
# any leading From_ line separately. Note that we assume that there is no
# space between the From_ line and the real headers; this assumption should
# be perfectly valid.
sub ReadMessage () {
my(@time, $date, $received, $filename, $seen_header, $from_line);
LogIn(6, "info", "Reading message");
@time = localtime;
$date = strftime("%a, %d %b %Y %T %z (%Z)", @time);
$received = "Received: by $Config::local_hostname (TLB v$::release_version ($::rcs_version)); $date\n";
$filename = "$Config::tempdir/tlb.$$";
# XXX Check for error here. Try to log the error or inform the
# postmaster, and exit EX_TEMPFAIL.
open(MOUT, ">$filename");
print "Reading message to $filename.\n" if ($::opt_d & 8);
# Add our Received: header
print MOUT $received;
# First skip over any leading blank lines and store any From_ line just
# in case
while (<STDIN>) {
last if (/^\S+: /);
next if (/^\s/);
if (/^From /) {
$from_line = $_;
next;
}
}
print " Found mbox separator: $from_line" if ($::opt_d & 16 && defined($from_line));
unless (defined $from_line) {
$from_line = MakeFromLine;
print " Made mbox separator: $from_line" if ($::opt_d & 16);
}
print " Copying message.\n" if ($::opt_d & 16);
# We've found a real header; print it, then copy rest of message
print MOUT $_;
while (<STDIN>) {
print MOUT $_;
}
close MOUT;
print "\n" if ($::opt_d & 8);
LogOut;
return ($filename, $from_line);
}
# Generate our own From_ line, in case we weren't called from an MTA. I
# don't like having to do this, but some packages (like archive2.pl) expect
# to be called from a Sendmail alias and thus get the From_ line.
sub MakeFromLine () {
my($from_line, $time);
$time = localtime;
$from_line = "From $Config::sender $time\n";
return $from_line;
}
# Send the message to an open and completely set up SMTP connection. We
# expect all necessary SMTP to already have been sent, including DATA. We
# do not send \r\n.\r\n, though we do escape leading periods.
sub SendMessage ($@) {
my($filename) = shift;
print "Sending message.\n" if ($::opt_d & 16);
SendSMTP("DATA\r\n", 0, @_) || return undef;
open(MESSAGE,"<$filename");
while (<MESSAGE>) {
SendData($_,@_); # Isn't that pretty?
}
close(MESSAGE);
return 1;
}
# Send the message to each of a set of command lines
sub SendToExternals ($$) {
my($filename) = shift;
my($from_line) = shift;
my($pipe) = new IO::Handle;
my($message) = new IO::Handle;
my($external,$cmdline,);
# reaping our own children confuses pipe spawns
local $SIG{CHLD} = 'IGNORE';
LogIn(6, "info", "Spawning externals");
print "Spawning externals.\n" if ($::opt_d & 8);
for $external (@Config::external_programs) {
# Take care of any token expansions. Eventually a sub call or
# something will be useful here, when there are more tokens.
# XXX Or should this be handled with embedded variables and an eval?
($cmdline = $external->{'commandline'}) =~ s/=FILE=/$filename/g;
print " Will spawn: $cmdline\n" if ($::opt_d & 16);
if (!($::opt_d & 128)) {
open($pipe,"|$cmdline") ||
LogAbort("Failed to execute external: $cmdline, $!, stopped");
open($message,"$filename") ||
LogAbort("Could not open saved message $filename for reading, $!, stopped");
if ($external->{'pipemessage'}) {
if ($external->{'needsfrom'}) {
print $pipe $from_line;
}
while(<$message>) {
print $pipe $_;
}
}
# Sendmail appends a blank line to the message, so we must, too.
# XXX Perhaps this should be configurable.
print $pipe "\n";
close $message || LogAbort("Error closing $filename, $!, stopped");
close $pipe || LogAbort("Error closing $cmdline, $!, stopped");
}
}
print "\n" if ($::opt_d & 8);
LogOut;
}
#
# Misc. functions
#
# This replaces the function below. The old function was nicked from old
# Majordomo code and could generate bad results for many uncommon but legal
# addresses. Since the stripped address is actually used to deliver to, we
# have to make sure that we do it properly.
sub ParseAddrs ($) {
my($addr) = shift;
Mail::Address::address(parse Mail::Address $addr);
}
#sub ParseAddrs {
# local($_) = shift;
# 1 while s/\([^\(\)]*\)//g; # strip parenthesized comments
# 1 while s/"[^"]*"//g; # strip quoted comments
# 1 while s/.*<(.*)>.*/$1/; # strip out bracketed addresses
# s/^\s+//; # strip leading whitespace
# s/\s+$//; # strip trailing whitespace
#
# $_; # return stripped address
#}
# This deals with waiting for the children that we spawn
sub ChildReaper () {
my($child);
$SIG{CHLD} = \&ChildReaper;
# Careful here; waitpid may return -1 if we have no more children
while (($child = waitpid(-1,&POSIX::WNOHANG())) > 0) {
$::child_status{$child} = $?;
}
}
#
# Envelope/Connection handling functions
#
# Open an envelope. We check to see if there is an open connection, open
# one, stash it and send the greeting if needed. If there was an open
# connection, reset it. Then send the MAIL FROM: line.
sub OpenEnvelope ($$) {
my($dest) = shift;
my($host) = shift; # Could be 'LOCAL'
my($hostref, @envelope);
$hostref = ($host eq 'LOCAL') ? undef :
$dest->{'hosts'}[$host];
$hostref = undef if $hostref eq 'LOCAL';
# Do we need to open a connection?
# XXX Need to probe extant connections with NOOP to make sure they're
# still open.
if (!$hostref || !$hostref->{'connection'} || !@{$hostref->{'connection'}}) {
@envelope = OpenConnection($dest, $host);
if (@envelope) {
SendGreeting($hostref, @envelope) ||
return wantarray ? () : undef;
}
else {
return wantarray ? () : undef;
}
}
# We already have a connection. Reset it. Note that the local mailer
# will never do persistent connections, so we don't have to worry about
# LOCAL here.
else {
@envelope = @{$hostref->{'connection'}};
SendSMTP("RSET\r\n", 0, @envelope) ||
return wantarray ? () : undef;
}
# We have an open envelope, ready to accept a piece of mail.
SendSMTP("MAIL FROM:<$Config::sender>\r\n", 0, @envelope) ||
return wantarray ? () : undef;
# The envelope is good, so stash it
return (@{$hostref->{'connection'}} = @envelope);
}
# Open a connection and send the greeting.
sub OpenConnection ($$) {
my($dest) = shift;
my($host) = shift; # Could be 'LOCAL'
my($hostname, $port, $timeout, $rfh, $wfh, $pid);
# For testing, if host has 'fail' tag, fail now
if ($host ne 'LOCAL' &&
$dest->{'hosts'}[$host] ne 'LOCAL' &&
$dest->{'hosts'}[$host]{'fail'} &&
($::opt_d & 512))
{
return wantarray ? () : undef;
}
if ($host eq 'LOCAL' ||
$dest->{'hosts'} eq 'LOCAL' ||
$dest->{'hosts'}[$host] eq 'LOCAL' )
{
# in failsafe mode
print "Opening envelope in failsafe mode to LOCAL.\n" if ($::opt_d & 16);
$hostname = 'LOCAL';
$timeout = DEFAULT_TIMEOUT;
}
else {
$hostname = $dest->{'hosts'}[$host]{'hostname'} || 'LOCAL';
$timeout = $dest->{'hosts'}[$host]{'timeout'} || DEFAULT_TIMEOUT;
}
LogIn(9, "info", "Opening connection to $hostname");
SWITCH: for ($hostname) {
/^LOCAL$/ && do {
($rfh, $wfh, $pid) = OpenCommand($Config::mailer);
last SWITCH;
};
/^\// && do {
# Fail randomly if user requests
if (($::opt_d & 1024) && (rand > 0.5)) {
return wantarray ? () : undef;
}
($rfh, $wfh, $pid) = OpenCommand($hostname);
last SWITCH;
};
# DEFAULT
do {
# Fail randomly if user requests
if (($::opt_d & 1024) && (rand > 0.5)) {
return wantarray ? () : undef;
}
$rfh = OpenSocket($dest, $host);
$wfh = undef;
$pid = undef;
last SWITCH;
}
}
# Check that the open routine worked
if (!$rfh || ($pid && !$wfh)) {
print "Open of socket or command failed!\n" if ($::opt_d & 8);
LogOut("failed");
return wantarray ? () : undef;
}
# We expect a response from the server
unless (GetResponse($rfh, 0, $timeout)) {
print "Timeout waiting for greeting!\n" if ($::opt_d & 8);
LogOut("timeout");
return wantarray ? () : undef;
}
LogOut;
return ($rfh, $wfh, $pid, $timeout);
}
# Open two filehandles, one on either end of a command that will be exec'ed
sub OpenCommand ($) {
my($cmdline) = shift;
my($rfh, $wfh, $pid, $command);
print "Will exec command: $cmdline\n" if ($::opt_d & 16);
$command = (split(" ",$cmdline))[0];
# Open2 gives spurious warnings and generally behaves badly if it
# couldn't exec the command. Here we check to see if we can exec the
# command. This doesn't tell us if it ran but died due to bad options or
# something. We could trap STDERR with open3, but open2 is bad enough.
# XXX the mechanics are in place to reap the child if it dies and record
# its status. We should use this to make sure it exists. It already
# prevents a hang in case we read from it after it dies; instead we die.
if (! -x $command) {
print "Cannot execute $command!" if ($::opt_d & 8);
return wantarray ? () : undef;
}
$rfh = new IO::Handle;
$rfh->autoflush;
$wfh = new IO::Handle;
$wfh->autoflush;
$pid = open2($rfh, $wfh, $cmdline);
# XXX Must check to see that program is still running; it may have died
# because we gave it bad args. If we don't check this, we die trying to
# read the greeting because the reaper gets catches the death of the
# child so the filehandles go nowhere. As an alternative to dying (and a
# better alternative than wrapping every read/write in an eval is to
# sleep a little while to give the child time to die, then check the
# %child_status hash to see if it's been reaped. Using open3 isn't
# really an option because we need the same read/write semantics as a
# socket for transparency.
return($rfh, $wfh, $pid);
}
sub OpenSocket ($$) {
my($dest) = shift;
my($host) = shift;
my($fh, $hostname, $timeout, $port, $iaddr, $try);
# Fill in default port value if necessary
if (!$dest->{'hosts'}[$host]{'port'}) {
$dest->{'hosts'}[$host]{'port'} = 'smtp';
}
# IO::Socket will spew to stderr and eval won't catch it, so we'll do
# some error checking ourselves. Remember that we just mark the host
# down and continue of something fails.
if ($dest->{'hosts'}[$host]{'port'} =~ /\D/) {
$port = getservbyname($dest->{'hosts'}[$host]{'port'},"tcp");
if (!$port) {
print "Failed to get port number for port: $dest->{'hosts'}[$host]{'port'}!\n"
if ($::opt_d & 8);
return wantarray ? () : undef;
}
# Save it so we don't have to do this later
$dest->{'hosts'}[$host]{'port'} = $port;
}
else {
$port = $dest->{'hosts'}[$host]{'port'};
}
# Likewise, resolve the hostname
$hostname = $dest->{'hosts'}[$host]{'hostname'};
$iaddr = inet_aton($hostname);
if (!$iaddr) {
print "Failed to resolve hostname: $hostname!\n"
if ($::opt_d & 8);
return wantarray ? () : undef;
}
$timeout = $dest->{'hosts'}[$host]{'timeout'} || DEFAULT_TIMEOUT;
print "Will open socket to: host = $hostname,\n" if ($::opt_d & 16);
print " port = $port,\n" if ($::opt_d & 16);
print " timeout = $timeout.\n" if ($::opt_d & 16);
$try = eval {
$fh = new IO::Socket::INET (
PeerAddr => $hostname,
PeerPort => $port,
Proto => "tcp",
Timeout => $timeout,
);
};
if (!$try) {
print "Error opening socket: $@"
if ($::opt_d & 8);
Log(3, "notice", "Error opening socket: $@");
return wantarray ? () : undef;
}
if (!$fh) {
print "(Probably) Timeout ($timeout sec) connecting to $hostname!\n"
if ($::opt_d & 8);
return wantarray ? () : undef;
}
print "Opened socket!\n" if $fh && ($::opt_d & 16);
$fh->autoflush;
return $fh;
}
# End the DATA segment, hang up on the other end, and close our handles.
sub CloseEnvelope (@) {
print "Closing envelope.\n" if ($::opt_d & 16);
SendSMTP("\r\n.\r\n", 0, @_) ||
return undef;
return 1;
}
sub CloseAllConnections () {
my($i, $j);
for $i (@Config::delivery_matrix) {
for $j (@{$i->{'hosts'}}) {
if ($j ne 'LOCAL' && $j->{'connection'} && @{$j->{'connection'}}) {
print "Closing connection to $j->{'hostname'}.\n" if ($::opt_d & 16);
CloseConnection(@{$j->{'connection'}});
delete $j->{'connection'};
}
}
}
}
sub CloseConnection (@) {
my($rfh, $wfh, $pid, $timeout) = @_;
my($waited);
SendSMTP("QUIT\r\n", 0, @_);
# We must wait for a child command to shut down, exit, and be reaped.
if ($pid) {
$waited = 0;
while (!defined ($::child_status{$pid})) {
$waited++;
if ($waited > $timeout) {
Log(3, "notice", "Waited too long for child to exit.");
last;
}
print "Waiting for child process to exit: $waited.\n" if ($::opt_d & 16);
sleep(1);
}
delete $::child_status{$pid};
}
# Remote end should have gone away; let's close up shop. Only actually
# close the handle if it was a socket; the reaper will automatically have
# cleaned up after a command.
unless ($pid) {
$rfh->close;
}
return 1;
}
# This sends the proper SMTP greeting once the connection has been opened
sub SendGreeting ($@) {
my($host, @envelope) = @_;
my($hostname, $local_hostname);
unless (!$host || $host eq 'LOCAL') {
$hostname = $host->{'hostname'};
}
if (!$hostname || $hostname eq 'LOCAL' || $hostname =~ m|^/|) {
$local_hostname = 'localhost';
}
else {
$local_hostname = $Config::local_hostname;
}
# XXX Need to allow for persistent connections; HELO may already have
# been issued in this connection
# Nasty BS to get around strictification
if (!$host || $host eq 'LOCAL') {
if ($Config::local_ESMTP) {
SendSMTP("EHLO $local_hostname\r\n", 0, @envelope) ||
return undef;;
}
}
elsif ($host->{'ESMTP'}) {
SendSMTP("EHLO $local_hostname\r\n", 0, @envelope) ||
return undef;
}
else {
SendSMTP("HELO $local_hostname\r\n", 0, @envelope) ||
return undef;
}
if ($host && $host ne 'LOCAL' && $host->{'ONEX'}) {
SendSMTP("ONEX\r\n", 0, @envelope) ||
return undef;
}
return 1;
}
#
# SMTP handling functions
#
# Send an SMTP command and expect a reply
sub SendSMTP ($$@) {
my($string, $ignorenonfatal, $rfh, $wfh, $pid, $timeout) = @_;
my($code);
# XXX We should have a sigpipe handler to trap bad pipe writes, and
# something to handle a write to a closed socket.
# We may be using a socket, in which case we use the same handle for
# input and output
if (!$wfh) {
$wfh = $rfh;
}
if ($string =~ /^\r\n\./) {
LogIn(10, "info", "SMTP DATA end");
}
elsif ($string =~ /^RCPT/) {
LogIn(10, "info", "SMTP RCPT<".substr($string,9,4).">");
}
else {
LogIn(10, "info", "SMTP ".substr($string,0,4));
}
push(@::transaction_log, ">>> $string") if $::opt_t;
print ">>> $string" if ($::opt_d & 32);
return(1) if ($::opt_d & 128);
print $wfh "$string";
$code = GetResponse($rfh, $timeout, $ignorenonfatal) || return undef;
LogOut;
return $code;
}
# Send a line of data without expecting a response. Doing this at any time
# other than after sending a DATA command will screw things up badly (the
# read and write ends will get out of sync). We must escape leading
# periods here, and lines are expected to be terminated properly. (No \n
# is added.)
sub SendData ($@) {
my($string, $rfh, $wfh, $pid) = @_;
# We may be using a socket, in which case we use the same handle for
# input and output
if (!$wfh) {
$wfh = $rfh;
}
# Escape leading periods
$string =~ s/^\./../;
print $wfh $string unless ($::opt_d & 128);
print ">>> $string" if ($::opt_d & 64);
}
# Sends RCPT TO: for each address in the batch
sub SendRCPT ($@) {
my($batch) = shift;
my($i, $code);
# Problem: if the batch has only one address and it is rejected with a
# non-fatal error then we haven't addresses the envelope and the DATA
# segment will fail.
for $i (0..$#{$batch}) {
$code = SendSMTP("RCPT TO:<$batch->[$i]>\r\n", 1, @_) ||
return undef;;
}
# If we only have one address in this batch, it could be rejected. We
# can't continue sending this batch, but we can't just fail because the
# batch will be resent. So we return an exceptional value.
if ($code == -1 && $#{$batch} == 0) {
return -1;
}
return 1;
}
# Get a (possibly multiline) SMTP response from the other end, timing out
# if necessary. The reply code is read, and non-fatal errors arising from
# the RCPT TO: command can be ignored.
sub GetResponse ($$$) {
my($rfh) = shift;
my($timeout) = shift;
my($ignorenonfatal) = shift;
my($resp, $gotresp, $error, $code, $dummy, $multi, $text);
while (1) {
# The remote host _must_ respond.
$gotresp = 0;
local $SIG{ALRM} = sub { die };
eval {
$resp = <$rfh>;
$gotresp = 1;
};
$SIG{ALRM} = 'DEFAULT';
unless ($resp) {
print "Received null STP response!\n" if ($::opt_d & 32);
Log(3, "notice", "Received null SMTP response!\n");
return undef;
}
unless ($gotresp) {
print "Timeout waiting for response!\n" if ($::opt_d & 32);
Log(3, "notice", "Timeout waiting for SMTP response!\n");
return undef;
}
$resp =~ s/\r\n$//;
push(@::transaction_log, "<<< $resp\n") if $::opt_t;
print "<<< $resp\n" if ($::opt_d & 32);
# Take apart the SMTP response
($code, $multi, $text) = ($resp =~ /(\d{3})(.)(.*)/);
# Check SMTP return code
if ($code =~ /^(55[0123])|(45[012])$/ &&
$ignorenonfatal)
{
# We received a non-fatal error that we should ignore.
# XXX We should store these somewhere so that we can generate an
# error report later.
Log(4, "notice", "Received non-fatal SMTP response: $resp\n");
$code = -1;
}
elsif ($code =~ /^[45]../) {
# Temporary or permanent failure
Log(4,"notice","SMTP Failure: $resp\n");
$error = 1;
}
elsif ($code =~ /^[123]../) {
# No problem
Log(12, "info", "SMTP Resp: $resp\n");
}
else {
# Whoa; the code was hosed
LogAbort "Illegal SMTP response: $resp";
}
# Loop until we get a non-continued response
last if $multi eq " ";
}
return $error ? undef : $code
}
#
# Logging routines
#
sub LogOpen () {
openlog("tlb/$Config::list_name", 'pid', 'mail');
Log(8, "info", "TLB starting.");
}
sub LogClose () {
closelog;
}
sub Log ($$$) {
my $level = shift;
my $prio = shift;
my $message = shift;
confess("Log with no message!") unless $message;
if ($level <= $Config::log_level) {
syslog($prio, $message);
}
}
sub LogStartupTime () {
my($user, $system) = (times)[0..1];
$user = sprintf("%.2f", $user);
$system = sprintf("%.2f", $system);
Log(6, "info", "Compilation took " . $user . "s, " . $system . "u");
}
sub LogIn ($$$) {
my $level = shift;
my $prio = shift;
my $message = shift;
if ($Config::log_entries) {
Log($level, $prio, $message);
}
unshift @::log_state, [$level, $prio, $message, time()];
}
sub LogOut (;$) {
my $extra = shift || "done";
my $state = shift @::log_state;
unless ($state) {
LogAbort "LogOut called without corresponding LogIn, stopped";
}
my ($level, $prio, $message) = @{$state}[0..2];
my $elapsed = time() - @{$state}[3];
$elapsed = sprintf("%.2f", $elapsed);
Log($level, $prio, "$message..$extra, took $elapsed sec");
}
sub LogAbort ($) {
my $message = shift;
Log(1, "warning", $message);
confess $message;
}
#
# Debugging and informational routines
#
# Print out unbatched address lists
sub PrintAddrLists () {
my ($i, $j, @blah);
print "Address lists:\n";
for $i (0..$#Config::delivery_matrix) {
if (defined $Config::delivery_matrix[$i]{'hosts'}) {
@blah = ();
for $j (0..$#{$Config::delivery_matrix[$i]{'hosts'}}) {
push @blah,$Config::delivery_matrix[$i]{'hosts'}[$j]{'hostname'};
}
}
else {
@blah = ('LOCAL');
}
print " List for destination $i, host(s): ",join(", ",@blah),".\n";
foreach (@{$Config::delivery_matrix[$i]{'addrs'}}) {
print " $_->[0], $_->[1]\n";
}
print "\n";
}
}
# Print out destinations and corresponding batches
sub PrintBatches () {
my($i, $j, $k, @blah);
print "Batches:\n";
for $i (0..$#Config::delivery_matrix) {
if (defined $Config::delivery_matrix[$i]{'hosts'}) {
@blah = ();
for $j (0..$#{$Config::delivery_matrix[$i]{'hosts'}}) {
if ($Config::delivery_matrix[$i]{'hosts'}[$j]{'backup'}) {
push @blah,"$Config::delivery_matrix[$i]{'hosts'}[$j]{'hostname'}(b)";
}
else {
push @blah,"$Config::delivery_matrix[$i]{'hosts'}[$j]{'hostname'}";
}
}
}
else {
@blah = ('LOCAL');
}
print " Batch to ",join(", ",@blah),".\n";
for $j (0..$#{$Config::delivery_matrix[$i]{'batches'}}) {
print " batch \#$j:\n";
for $k (0..$#{$Config::delivery_matrix[$i]{'batches'}[$j]}) {
print " $Config::delivery_matrix[$i]{'batches'}[$j][$k]\n";
}
}
print "\n";
}
}
sub PrintUsageInfo () {
PrintVersionInfo;
print <<"EOF";
Send questions or comments to Jason Tibbitts <tibbs\@hpc.uh.edu>.
Usage: $0 [-hv] [-t address] [-d ##] config-file
-h print this usage info
-v print version info
-t test address (do delivery test for all destinations)
-d debug level
Debug flags. Add desired flags to get -d value.
1 - address lists before sorting
2 - address lists after sorting
4 - batches that will be sent to each host, and batch info
8 - delivery verbosity (important things, errors))
16 - delivery verbosity (less important things, informationals)
32 - SMTP transactions excluding the message test
64 - The escaped mesage text
128 - Open connections, but do not actually send or receive and data.
Do not spawn external programs.
256 - Do not open sockets, and send no data (has no effect in test mode).
512 - Pay attention to 'fail' tags in hosts descriptions.
1024 - Fail all envelope opens (except to LOCAL) with 50% probability
Usage in aliases file:
listname-out: "|$0 config-file"
Usage with Majordomo:
listname: "|/path/to/wrapper resend -l listname
-h your.host listname-secret,nobody"
listname-secret: "|/path/to/wrapper tlb config-file"
Or for Majordomo 1.94 or later, see majordomo.cf for calling TLB as a
mailer.
EOF
}
sub PrintVersionInfo () {
print "TLB version $::release_version ($::rcs_version)\n";
}
# Here we send some informational message to an address provided on the
# command line through each host in each destination. This _should_ test
# every delivery path possible. The idea is that _if_ each host will
# accept a message bound for one random address, it will accept one bound
# for a bunch of random addresses. Currently hosts that appear in
# different destinations will be tested multiple times. Eliminating this
# is easy, but then you'd have to guess why you didn't get the number of
# test messages you expected.
sub RunTestMode () {
my($i, $j, @envelope, @time, $date, $filename, $hostname, $hregexp, $line);
# Override the config default for this, so bounces go where we expect
# them to
# XXX is this a good idea? Might some hosts reject based on the
# envelope sender? We hope to get no bounces anyway.
$Config::sender = $::opt_t;
# Add another element to the end of the delivery matrix, to force test of
# LOCAL destination
# XXX This could be redundant, but it can't hurt
push @Config::delivery_matrix, {'test' => 1};
# Loop over each destination
for $i (@Config::delivery_matrix) {
if (!$i->{'hosts'}) {
$i->{'hosts'} = [ 'LOCAL' ];
}
# Loop over each possible delivery host (even backups)
for $j (0..$#{$i->{'hosts'}}) {
@time = localtime;
$date = strftime("%a, %d %b %Y %T %z (%Z)", @time);
if ($i->{'hosts'}[$j] eq 'LOCAL') {
$hostname = 'LOCAL';
}
else {
$hostname = $i->{'hosts'}[$j]{'hostname'};
}
$hregexp = $i->{'regexp'} ? $i->{'regexp'} : 'DEFAULT';
$filename = "/tmp/tlb.$$";
open(MESSAGE,">$filename");
print MESSAGE <<"EOM";
Date: $date
From: list_batcher_test\@$Config::local_hostname
To: $::opt_t
This is a test message from list_batcher.
Destination $hregexp
Host $hostname
.
The SMTP transaction so far:
EOM
close MESSAGE;
@::transaction_log = ();
print "Opening envelope.\n" if ($::opt_d & 16);
@envelope = OpenEnvelope($i,$j);
if (@envelope) {
SendSMTP("RCPT TO: $::opt_t\r\n", 1, @envelope);
SendMessage($filename,@envelope);
for $line (@::transaction_log) {
SendData($line,@envelope);
}
CloseEnvelope(@envelope);
}
else {
print "Problems connecting to Dest: $hregexp\n";
print " Host: $hostname\n";
}
unlink $filename;
}
}
CloseAllConnections();
}
#
# $Log: tlb,v $
# Revision 1.26 1998/09/22 04:41:41 tibbs
# Fixed some warnings.
#
# Revision 1.25 1997/01/30 01:05:08 tibbs
# sorted_address_list, stripped_address_list: test for truth, not
# definedness.
#
# Revision 1.24 1997/01/30 01:03:49 tibbs
# Fixed a couple more warnings.
#
# Revision 1.23 1997/01/09 00:29:32 tibbs
# Bumped to rev 0.10a.
#
# Revision 1.22 1997/01/08 23:26:40 tibbs
# Fixed undef variable reference in connection caching code.
#
# Revision 1.21 1997/01/08 20:34:08 tibbs
# Got rid of cute eval trick with command line args because of perl bug.
# Added warhing for null SMTP response.
#
# Revision 1.20 1996/10/09 22:03:07 tibbs
# Bump to rev 0.09a.
# Chomp redundant comments.
# Properly derive list name from address file.
# Take out a whold bunch of -d256 tests; we don't even pretend to do delivery
# in that case.
# CloseAllConnections doesn't trip over LOCAL, removes stashed connection.
# RunTest doesn't send greeting twice, and closes conections when it's done.
#
# Revision 1.19 1996/10/09 04:15:26 tibbs
# Bumped to version 0.08a.
# Don't do any delivery-related stuff if -d256.
# Now warn if in failsafe mode.
# Fix bug with LOCAL mailer in OpenConnection.
# Add some return(1)'s to prevent failures when debugging.
# Better SMTP performance data for \r\n.\r\n and RCPT.
# Moved SMTP logging to level 12.
#
# Revision 1.18 1996/10/06 23:32:29 tibbs
# Bumped to release 0.07a.
# Delete cached connection when marking host down.
#
# Revision 1.17 1996/10/06 07:35:00 tibbs
# Added commands to open and close connections.
# GetResponse and SendSMTP can now ignore non-fatal eror replies.
# Moved SIGCHLD definition up a bit higher so Evan's system doesn't croak.
# Rewrote most of DeliverBatches to allow failure at any point without losing
# or resending a batch.
# Rewrite OpenEnvelope to keep a record of open connections and not open one
# if it's not necessary.
# Rewrote CloseEnvelope to keep the connection open.
# SendRCPT will return exceptional value on single-address batches that
# return a non-fatal RCPT error.
#
# Revision 1.16 1996/10/04 22:57:07 tibbs
# GetResponse now takes a timeout value.
# Added DEFAULT_TIMEOUT.
# Fixed broken regexp handling in PushAddr.
# No need to avoid carning on $child_status.
# Minor code cleanups and realignments.
# Handle timeouts from GetResponse.
# An @envelope now includes a timeout.
# Log problem opening socket.
# Properly wait for spawned children to exit.
# SendSMTP now knows about GetResponse timing out, and will handle returned
# error codes.
# Nicely format startup times.
#
# Revision 1.15 1996/09/28 08:48:32 tibbs
# Moved user-arg package munging up a bit, so we have $opt_l in the config
# package before we set $list_name.
# Default $list_name to $opt_l if defined, otherwise use "init". We'll later
# extract it from $address_file if necesary.
# Abort if the config require fails.
# Add a couple of extra log messages in case of problems.
# Fix booboo in external spawning when -d tells us not to.
# Fix precedence bug in ChildReaper.
# Autoflush handles attached to commands.
# Don't close handles associated with programs; the reaper will take care of
# them.
# Confess if Log is called with no message. (Once got an error about this,
# probably spurious.)
#
# Revision 1.14 1996/09/26 00:38:39 tibbs
# Use Time::HiRes if desired to give better performance date.
# Added extra command-line options that can be used for conditionals in the
# config file.
# Initialize the @external_programs array.
# Abort due to config errors before providing after-config defaults.
# Reset the log file to pick up any changes made after bringing in the config
# file, and to fill in the name of the list.
# Put the name of the list in the config file.
#
# Revision 1.13 1996/09/18 08:14:36 tibbs
# Released 0.05a after a week's testing.
# Added syslogging, including workaround for 5.003's bug and performance data.
# Only require 5.002; it should work.
# Carp on errors.
# Add usage and version info on the command line.
# Fix waitpid infloop bug; burn, Solaris, burn.
# More strictification. I've exercised the code path now and it seems to be
# fine.
# Don't ever die; instead, we log and confess. This gets around the complete
# lack of an error reporting channel when we're running as a sendmail
# replacement.
#
# Revision 1.12 1996/08/22 22:11:59 tibbs
# Fixed a couple of warnings and cleaned up some debugging output.
#
# Bumped to release 0.04.
#
# Revision 1.11 1996/08/22 05:51:17 tibbs
# Added $sorted_address_list and $stripped_address_list.
# More strict fixes.
#
# Revision 1.10 1996/08/20 06:54:58 tibbs
# Fixed bogus #-d in hash-bang line.
#
# Added info on getting copies of packages from hpc site.
#
# Converted to Mail::Address for parsing addresses, instead of using buggy
# routine.
#
# Added nosort flag to turn off sorting for batching methods that don't need
# it.
#
# Bumped to release 0.03.
#
# Revision 1.9 1996/08/15 17:24:36 tibbs
# Added BatchSeparatedomains method and hooks for calling it.
# Complete strictification (which fixed a few latent bugs).
# Added check for no specified config file.
#
# Revision 1.8 1996/08/12 09:39:45 tibbs
# Added death for unreadable config file.
# Added extra blank line at the end of piped messages.
# Release version 0.02a.
#
# Revision 1.7 1996/07/31 05:53:15 tibbs
# Added SendToExternals functionality.
# Added MakeFromLine.
#
# -d128 doesn't spawn externals.
# Use $tempdir
#
# ReadMessage returns a From_ line, even if it has to generate one.
# Took out extraneous bugfinding message in DeliverBatches.
#
# Slightly better error handling; now know what die does when spawned from
# sendmail.
#
# Rewrote ReadMessage copying.
#
# Revision 1.6 1996/07/22 17:48:35 tibbs
# Reworked version string.
# Converted to using TimeDate package for proper timezone offsets.
# Didn't properly close message after sending.
#
# Released 0.01a!
#
# Revision 1.5 1996/07/17 01:04:59 tibbs
# ReadMessage: eat blank lines and From_ headers until we see a real header.
#
# Revision 1.4 1996/07/16 22:52:30 tibbs
# Played with version handling.
# Changed format of received line.
# Adjusted for use with IO::Socket 1.08 instead of my gross patch.
# Started supporting help and version options.
#
# Revision 1.3 1996/07/15 06:10:04 tibbs
# Reordered subroutines and added extra commentary.
#
# Revision 1.2 1996/07/14 22:55:41 tibbs
# Continuing development.
#
# Revision 1.1 1996/07/01 21:19:48 tibbs
# Initial revision
#
#
syntax highlighted by Code2HTML, v. 0.9.1