path: root/contrib/mailqueue.pl

#!/usr/bin/perl
# This is script will connect to your isp (if not already connected),
#   send any outgoing mail and retrieve any incoming mail.  If this
#   program made the connection, it will also break the connection
#   when it is done.
#
# Bill Adams
# bill@evil.inetarena.com
#
# Revision History
# 1.0.1   05 Sep 1998  baa  Massive updates to work with fetchmail.
# 
# Get the latest version from my home-page:
#  http://www.inetarena.com/~badams/computerstuff.html
#  following the 'Stuff I Have Written' link.
#
# License: GNU, but tell me of any improvements or changes.
#
use strict;

my $suck;
my $rdate;
my ($my_syslog, $debug, $verbose);

my $start_time = time;
my $mailhost = 'mail';
my $sendmail_queue_dir = '/var/spool/mqueue/';	#Need trailing slash!
my $interface = 'ppp0';         #Watch this interface
my $max_tries = 1;		#How many times to try and re-dial
my $retry_delay = 300;	        #How long to wait to retry (in seconds)
my $connect_timeout = 45;	#How long to wait for connection

#For the log file, be sure to put the >, >>, or | depending on
#  what you want it to do.  I have also written a little program
#  called simple_syslog that you can pipe the data to.
my $log_file = '>/dev/null';    #Where to put the data.
$log_file = '>>/var/log/mailqueue.pl';
#$log_file = '>/dev/console';

my $this_hour = +[localtime()]->[2];

#Define this to get mail between midnight and 5 am
#$suck = '/var/spool/suck/get.news.inn';

#Define this to set the time to a remote server
#$rdate = '/usr/bin/rdate -s clock1.unc.edu';

#Where are the programs are located.  You can specify the full path if needed.
my $pppd = 'pppd';
my $fetchmail = 'fetchmail'; #'etrn.pl';
my $sendmail = 'sendmail';

#Where is the etrn/fetchmail pid
my $fetchmail_pid = '/var/run/fetchmail.pid';


#Set the path to where we think everything will live.
$ENV{'PATH'} = ":/bin:/usr/bin:/sbin:/usr/sbin:/usr/local/bin:";
my $lockfile = "/var/run/mailqueue.lock";	#lockfile for this program
my $space = ' ';			#Never know when you might need space
my $program_name = $0;
$program_name = substr ($program_name, (rindex ($program_name, '/') + 1));
open SYSLOG, $log_file or die "Could not open $log_file\n\t";

sys_log ("Started by UID $<");
#$< = 0;					#suid root

#Other global vars
my $pppd_pid;

#Make sure we are root.  This has to be the case for everything
#  to work properly.
if ($< != 0) {
    sys_log ("Not root...exit");
    print STDERR "You are not root...sorry cannot run.\n";
    exit (1);
}

sub sys_log {
    #Writes a message to the log file.
    my ($message) = @_;
    print SYSLOG join(' ', 
		      $program_name,
		      ''.localtime(), #The '' puts it in a scaler context.
		      $message)."\n";
    print STDERR $message, "\n" if $debug;
}

#Get the command line args.
$verbose = 1;
for (my $i = 0; $i <= $#ARGV; $i++) {
    if ($ARGV[$i] eq '-v' || $ARGV[$i] eq '-verbose') {
	$verbose++;
	print "Running in verbose mode level ($verbose).\n";
    } elsif ($ARGV[$i] eq '-d' || $ARGV[$i] eq '-debug') {
	$debug++;
	$verbose = 10;	#Some high value so everything gets printed
	print STDERR "Running in debug mode.\n";
    } elsif ($ARGV[$i] eq '-q' || $ARGV[$i] eq '-quiet') {
	$debug = 0;
	$verbose = 0; 
    } elsif ($ARGV[$i] eq '-max_tries') {
	if (not defined $ARGV[$i + 1]) {
	    printf STDERR "$0: Error: option -max_tries requires a value.\n";
	    &usage;
	} else {
	    $max_tries = $ARGV[$i + 1];
	}
    } elsif ($ARGV[$i] eq '-retry_delay') {
	if (not defined $ARGV[$i + 1]) {
	    printf STDERR "$0: Error: option -retry_delay requires a value.\n";
	    &usage;
	} else {
	    $max_tries = $ARGV[$i + 1];
	}
    } elsif ($ARGV[$i] eq '-interface') {
	if (not defined $ARGV[$i + 1]) {
	    printf STDERR "$0: Error: option -interface requires a value.\n";
	    &usage;
	} else {
	    $max_tries = $ARGV[$i + 1];
	}
    } elsif ($ARGV[$i] eq '-mailhost') {
	if (not defined $ARGV[$i + 1]) {
	    printf STDERR "$0: Error: option -mailhost requires a value.\n";
	    &usage;
	} else {
	    $mailhost = $ARGV[$i + 1];
	}
    } else {
	print STDERR "Unknown command line option: [". $ARGV[$i]."]\n";
	&usage;
    }
}


$| = 1 if $verbose;			#Output un-buffered if we are verbose


#Do some checking for programs
&check_program ($my_syslog) || die "$0 -> Error: $my_syslog is required\n";
($fetchmail = &check_program ($fetchmail)) 
    || die "$0 -> Error: Could not find fetchmail/etrn\n";
($pppd = &check_program ($pppd))
    || die "$0 -> Error: Could not find pppd\n";
(-d $sendmail_queue_dir) || die "$0 -> Error: The sendmail queue directory\n\t[$sendmail_queue_dir] does not exist or is not a directory.\n";
($sendmail = &check_program ($sendmail)) 
    || die "$0 -> Error: Could not find $sendmail\n";


#Do some process locking.  This kills any already running processes.
if (-s $lockfile) {
    my $pid = `cat $lockfile`; chop $pid;
    if (not &process_is_dead ($pid)) {
	print STDERR "$0 -> Process locked by pid $pid killing it.\n" 
	    if $verbose;
	kill 15, $pid;
	waitpid ($pid, 0); #This has no effect.
    }
    sys_log ("Removing stale lock for pid $pid") if $verbose;
    unlink ($lockfile) || die $!;
}
open (LOCK, '>'.$lockfile) || die "$0: Could not create lockfile $lockfile\n";
print LOCK $$, "\n";
close LOCK;

#print out some info if needed.
if ($debug) {
    print STDERR "             Max tries: $max_tries\n";
    print STDERR "      Dial Retry Delay: $retry_delay seconds.\n";
    print STDERR "Interface set to watch: $interface\n";
    print STDERR " Mailhost set to watch: $mailhost\n";
    print STDERR "    Connection timeout: $connect_timeout\n";
    print STDERR "              Sendmail: $sendmail\n";
    print STDERR "                  pppd: $pppd\n";
    print STDERR "     fetchmail/etrn.pl: $fetchmail\n";
    print STDERR "\n\n";
}
((-x $pppd) && (-x $sendmail) && (-x $fetchmail)) 
	|| die "Still some problem with programs.\n\tRun with -d to see if the path is specified for sendmail,\n\tpppd and fetchmail/etrn.pl";

while ($max_tries--) {
    my $child_pid;
    unless ($child_pid = fork)  {
	#This is the child process that waits for a connection to be made
	#  and then sends the local mail queue and then sends a request to
	#  get the remote mail queue
	my $count = $connect_timeout;
	while (&interface_is_down ($interface) && $count--) {sleep (1)}
	if ($count < 1) {exit (1)}
	
	#Send any queued mail.  I had another routine that would
	#  fork and watch sendmail with a timeout, but that is kinda
	#  flaky depending on how big your queue size is. So
	#  now just call it and wait for it to return.  If you have bad
	#  messages in your queue, this can hang.
	sys_log ("Have connection->sending any local mail.") if $verbose;
	system("$sendmail -q");

	sys_log ("Checking remote queue on ($mailhost)");

	my $result;
	my $daemon = 0;
	my $pid;
	#In case we have a pid, read it and find out if it is
	#  still valid or not.
	if (defined $fetchmail_pid and -f $fetchmail_pid) {
	    if (not open PID, $fetchmail_pid) {
		sys_log("Could not open $fetchmail_pid");
		die}
	    $pid = <PID>;
	    if ($pid =~ m|([0-9]+)\s+([0-9]*)|) {
		$pid = $1;
		$daemon = $2;
	    }
	    close PID;
	    sys_log("Have PID file ($fetchmail_pid) with PID $pid $daemon");
	    #In the case of fetchmail, we need to see if it is
	    #  still running in case there is a stale lock file.
	    if (&process_is_dead($pid)) {
		sys_log("  It is no longer running");
		$daemon = 0; $pid = 0}
	}
	if (not $pid or ($pid and $daemon)) {
	    #Either it is not running or it is running and a daemon.
	    sys_log("Running $fetchmail [$daemon]");
	    my $result = (system ($fetchmail))/256;
	    sys_log($fetchmail.' exited with status '.$result) if $debug;
	} else {
	    sys_log("$fetchmail already running...");
	}

	#Watch the directory for n seconds of inactivity.
	sys_log("Fetchmail done...watching $sendmail_queue_dir");
	&watch_dir ($sendmail_queue_dir, 10);
	sys_log ("Done polling for mail");
	
	if (-f $fetchmail_pid and not $daemon) {
	    #In case something went wrong and the fetchmail is still 
	    # running (and not a daemon)....
	    my $result = `$fetchmail -q`; chop $result;
	    sys_log($result);
	}
	exit (0);
    }
    #If a connection is needed, make it.
    if (&interface_is_down ($interface) && $pppd_pid == 0) {
	sys_log ("Try to connect with pppd") if $debug;
	# Fork pppd with a pid we can track.
	unless ($pppd_pid = fork) {
		exec ($pppd.' -detach');
	}
    }
    #Wait for the child to exit and check for errors
    waitpid ($child_pid, 0);
    my $child_status = ($? / 256);
    my $child_kill = $? % 256;
    if ($child_status == 0) {
	if ($this_hour <= 4 and defined $suck) {
	    sys_log ("Calling suck...");
	    print `$suck`;
	}
	if (defined $rdate) {
	   sys_log ("Calling rtime...");
	   print `$rdate`;
	}
	if ($pppd_pid) { 	#If we ran pppd, kill it
	    sys_log ("Killing pppd (pid $pppd_pid)");
	    kill 15, $pppd_pid;
	    waitpid ($pppd_pid, 0);	#Wait for clean exit of child
	}
	sys_log ("Finished with cycle.");
	unlink ($lockfile);
	sys_log ("Total time: ".(time-$start_time)." seconds") if $debug;
	exit (0);
    }
    # Reset to pppp_pid to zero if pppd is not running.
    if ($pppd_pid && &process_is_dead ($pppd_pid)) {$pppd_pid = 0}
    sys_log (join ('', "Warn: Did not connect -> Try ",
		   $max_tries, " more times...after ",
		   $retry_delay, " seconds"));
    if (not $max_tries) {
	sys_log ("Giving up...");
	exit (1);
    }
    sleep ($retry_delay);
    sys_log ("ok...trying again.");
}

sub check_program {
    #See if a program is in the path
    my ($program) = @_;
    my $exists = 0;
    my $path_specified = 0;
    my $path;
    
    #catch the case where there is already a slash in the argument.

    if ($program =~ /\//) {
	$path_specified = 1;
	if (-x $program) {$exists = $program}
    }

    my $exists;
    foreach $path (split(/:/, $ENV{'PATH'})) {
	next if length ($path) < 3;		#skip bogus path entries
	#be sure the there is a trailing slash
	if (substr ($path, -1, 1) ne '/') {$path .= '/'}
	#Check to see if it exists and is executable
	if (-x $path.$program) {$exists = $path.$program; last}
    }
    if (not $exists) {
	if ($path_specified) {
	    print STDERR "$0 -> Warn: ". $program. 
		" is not executable or does not exist.\n";
	} else {
	    print STDERR "$0 -> Warn: [$program] was not found in path\n\t".
		$ENV{'PATH'}."\n";
	}
    }
    return ($exists);
}


sub process_is_dead {
    #This is a cheap way to check for running processes.  I could use
    #  the /proc file-system in Linux but that would not be very 
    #  friendly to other OS's.
    #
    #return 1 if pid is not in process list
    # This expects ps to return a header line and then another line if
    #  the process is running.  Also check for zombies
    my ($pid) = @_;
    my @results = split (/\n/, `ps $pid 2>/dev/null`);
    if (not defined $results[1]) {return  1}
    if ($results[1] =~ /zombie/i) {return 1}
    return 0;
}


sub interface_is_down {
    # return 1 (true) if the ip is down
    my ($interface) = @_;
    if (`ifconfig $interface` =~ /UP/) {
	return 0;
    } else {
	return 1;
    }
}

sub watch_dir {
    #Watch the mailqueue directory for incoming files.
    #  The 'xf' files are the transfer (xfer) files on my system.
    #  If you find this is not the case, please email me.  To be safe,
    #  I check the latest mod time as long as xf files exist.  If no
    #  data has made it over in n seconds, we will assume that an
    #  error has occured and give up.

    my $files_like = '^(xf.*)'; #Regexp
    my $dir_to_watch = shift;
    my $delay = shift;
    my $timeout = 120;  #Give it 120 seconds to get data.
    my $loop_delay = 1; #How long between each loop. Do not make 0!

    #Make sure there is a trailing slash.
    if ($dir_to_watch !~ m|/$|) {$dir_to_watch .= '/'}

    #How long to wait for transfer of data.  This gets reset
    #  each time the mod time falls below a certain time.
    my $flag = $delay;	
    my $last_total = 0;
    
    while (($flag -= $loop_delay) > 0) {
	sleep $loop_delay;
	opendir (DIR, $dir_to_watch);
	my $file_count = 0;
	my $last_data_dl = 500000; #Big Number
	foreach my $file (readdir (DIR)) {
	    next if not -f $dir_to_watch.$file; #Only files.
	    my @stats = stat($dir_to_watch.$file);
	    my $m_time = time - $stats[9];
	    #Here, if we have a recent file, reset the timeout.
	    if ($m_time < $last_data_dl) {$last_data_dl = $m_time}
	    
	    #If we have an xfer file, up the delay.
	    if ($file =~ m|$files_like|) {
		sys_log("$file is like $files_like");
		$flag = $delay;
	    }
	}
	closedir (DIR);
	sys_log ("Watch_dir: $flag ($last_data_dl)") if $debug;

	#In the case of now data downloaded...
	if ($last_data_dl > $timeout and $flag == $delay) {
	    sys_log("Watch_dir: Timed out after $timeout seconds.");
	    $flag = 0;
	}
    }
    sys_log ("Watch_dir: Done.");
}

sub usage {
    #print the usage
    print join ("\n",
		'mailqueue.pl -- A program to send and receive mail form a sendmail spooler.',
		'  Requires that you ISP is running sendmail, at lease version 8.6.?.',
		'  Also requires that you have fetchmail or etrn.pl installed on this system.',
		'', 'Command line args (Default in parrens):',
		'  -v -verbose         Run in verbose mode.  Can use this arg multiple times.',
		'  -d -debug           Run in debug mode.  Sets verbose level to 10',
		'  -max_tries N	       Sets the maximum number of connect retries to N.  ('.$max_tries.')',
		'  -retry_delay N      Sets the delay between retrying to N seconds.  ('. $retry_delay.')',
	        "  -connect_timeout N  Sets the connection timeout to N seconds. (". $connect_timeout. ')',
		'  -interface STR      Sets the default interface to STR.  ('. $interface. ')',
		'  -mailhost STR       Sets the mailhost to STR. ('. $mailhost.')',
		'');
    exit (1);
}