Pileus Git - ~andy/fetchmail/blob - contrib/mailqueue.pl

   1 #!/usr/bin/perl
   2 # This is script will connect to your isp (if not already connected),
   3 #   send any outgoing mail and retrieve any incoming mail.  If this
   4 #   program made the connection, it will also break the connection
   5 #   when it is done.
   6 #
   7 # Bill Adams
   8 # bill@evil.inetarena.com
   9 #
  10 # Revision History
  11 # 1.0.1   05 Sep 1998  baa  Massive updates to work with fetchmail.
  12 #
  13 # Get the latest version from my home-page:
  14 #  http://www.inetarena.com/~badams/computerstuff.html
  15 #  following the 'Stuff I Have Written' link.
  16 #
  17 # License: GNU, but tell me of any improvements or changes.
  18 #
  19 use strict;
  20
  21 my $suck;
  22 my $rdate;
  23 my ($my_syslog, $debug, $verbose);
  24
  25 my $start_time = time;
  26 my $mailhost = 'mail';
  27 my $sendmail_queue_dir = '/var/spool/mqueue/';  #Need trailing slash!
  28 my $interface = 'ppp0';         #Watch this interface
  29 my $max_tries = 1;              #How many times to try and re-dial
  30 my $retry_delay = 300;          #How long to wait to retry (in seconds)
  31 my $connect_timeout = 45;       #How long to wait for connection
  32
  33 #For the log file, be sure to put the >, >>, or | depending on
  34 #  what you want it to do.  I have also written a little program
  35 #  called simple_syslog that you can pipe the data to.
  36 my $log_file = '>/dev/null';    #Where to put the data.
  37 $log_file = '>>/var/log/mailqueue.pl';
  38 #$log_file = '>/dev/console';
  39
  40 my $this_hour = +[localtime()]->[2];
  41
  42 #Define this to get mail between midnight and 5 am
  43 #$suck = '/var/spool/suck/get.news.inn';
  44
  45 #Define this to set the time to a remote server
  46 #$rdate = '/usr/bin/rdate -s clock1.unc.edu';
  47
  48 #Where are the programs are located.  You can specify the full path if needed.
  49 my $pppd = 'pppd';
  50 my $fetchmail = 'fetchmail'; #'etrn.pl';
  51 my $sendmail = 'sendmail';
  52
  53 #Where is the etrn/fetchmail pid
  54 my $fetchmail_pid = '/var/run/fetchmail.pid';
  55
  56
  57 #Set the path to where we think everything will live.
  58 $ENV{'PATH'} = ":/bin:/usr/bin:/sbin:/usr/sbin:/usr/local/bin:";
  59 my $lockfile = "/var/run/mailqueue.lock";       #lockfile for this program
  60 my $space = ' ';                        #Never know when you might need space
  61 my $program_name = $0;
  62 $program_name = substr ($program_name, (rindex ($program_name, '/') + 1));
  63 open SYSLOG, $log_file or die "Could not open $log_file\n\t";
  64
  65 sys_log ("Started by UID $<");
  66 #$< = 0;                                        #suid root
  67
  68 #Other global vars
  69 my $pppd_pid;
  70
  71 #Make sure we are root.  This has to be the case for everything
  72 #  to work properly.
  73 if ($< != 0) {
  74     sys_log ("Not root...exit");
  75     print STDERR "You are not root...sorry cannot run.\n";
  76     exit (1);
  77 }
  78
  79 sub sys_log {
  80     #Writes a message to the log file.
  81     my ($message) = @_;
  82     print SYSLOG join(' ',
  83                       $program_name,
  84                       ''.localtime(), #The '' puts it in a scaler context.
  85                       $message)."\n";
  86     print STDERR $message, "\n" if $debug;
  87 }
  88
  89 #Get the command line args.
  90 $verbose = 1;
  91 for (my $i = 0; $i <= $#ARGV; $i++) {
  92     if ($ARGV[$i] eq '-v' || $ARGV[$i] eq '-verbose') {
  93         $verbose++;
  94         print "Running in verbose mode level ($verbose).\n";
  95     } elsif ($ARGV[$i] eq '-d' || $ARGV[$i] eq '-debug') {
  96         $debug++;
  97         $verbose = 10;  #Some high value so everything gets printed
  98         print STDERR "Running in debug mode.\n";
  99     } elsif ($ARGV[$i] eq '-q' || $ARGV[$i] eq '-quiet') {
 100         $debug = 0;
 101         $verbose = 0;
 102     } elsif ($ARGV[$i] eq '-max_tries') {
 103         if (not defined $ARGV[$i + 1]) {
 104             printf STDERR "$0: Error: option -max_tries requires a value.\n";
 105             &usage;
 106         } else {
 107             $max_tries = $ARGV[$i + 1];
 108         }
 109     } elsif ($ARGV[$i] eq '-retry_delay') {
 110         if (not defined $ARGV[$i + 1]) {
 111             printf STDERR "$0: Error: option -retry_delay requires a value.\n";
 112             &usage;
 113         } else {
 114             $max_tries = $ARGV[$i + 1];
 115         }
 116     } elsif ($ARGV[$i] eq '-interface') {
 117         if (not defined $ARGV[$i + 1]) {
 118             printf STDERR "$0: Error: option -interface requires a value.\n";
 119             &usage;
 120         } else {
 121             $max_tries = $ARGV[$i + 1];
 122         }
 123     } elsif ($ARGV[$i] eq '-mailhost') {
 124         if (not defined $ARGV[$i + 1]) {
 125             printf STDERR "$0: Error: option -mailhost requires a value.\n";
 126             &usage;
 127         } else {
 128             $mailhost = $ARGV[$i + 1];
 129         }
 130     } else {
 131         print STDERR "Unknown command line option: [". $ARGV[$i]."]\n";
 132         &usage;
 133     }
 134 }
 135
 136
 137 $| = 1 if $verbose;                     #Output un-buffered if we are verbose
 138
 139
 140 #Do some checking for programs
 141 &check_program ($my_syslog) || die "$0 -> Error: $my_syslog is required\n";
 142 ($fetchmail = &check_program ($fetchmail))
 143     || die "$0 -> Error: Could not find fetchmail/etrn\n";
 144 ($pppd = &check_program ($pppd))
 145     || die "$0 -> Error: Could not find pppd\n";
 146 (-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";
 147 ($sendmail = &check_program ($sendmail))
 148     || die "$0 -> Error: Could not find $sendmail\n";
 149
 150
 151 #Do some process locking.  This kills any already running processes.
 152 if (-s $lockfile) {
 153     my $pid = `cat $lockfile`; chop $pid;
 154     if (not &process_is_dead ($pid)) {
 155         print STDERR "$0 -> Process locked by pid $pid killing it.\n"
 156             if $verbose;
 157         kill 15, $pid;
 158         waitpid ($pid, 0); #This has no effect.
 159     }
 160     sys_log ("Removing stale lock for pid $pid") if $verbose;
 161     unlink ($lockfile) || die $!;
 162 }
 163 open (LOCK, '>'.$lockfile) || die "$0: Could not create lockfile $lockfile\n";
 164 print LOCK $$, "\n";
 165 close LOCK;
 166
 167 #print out some info if needed.
 168 if ($debug) {
 169     print STDERR "             Max tries: $max_tries\n";
 170     print STDERR "      Dial Retry Delay: $retry_delay seconds.\n";
 171     print STDERR "Interface set to watch: $interface\n";
 172     print STDERR " Mailhost set to watch: $mailhost\n";
 173     print STDERR "    Connection timeout: $connect_timeout\n";
 174     print STDERR "              Sendmail: $sendmail\n";
 175     print STDERR "                  pppd: $pppd\n";
 176     print STDERR "     fetchmail/etrn.pl: $fetchmail\n";
 177     print STDERR "\n\n";
 178 }
 179 ((-x $pppd) && (-x $sendmail) && (-x $fetchmail))
 180         || 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";
 181
 182 while ($max_tries--) {
 183     my $child_pid;
 184     unless ($child_pid = fork)  {
 185         #This is the child process that waits for a connection to be made
 186         #  and then sends the local mail queue and then sends a request to
 187         #  get the remote mail queue
 188         my $count = $connect_timeout;
 189         while (&interface_is_down ($interface) && $count--) {sleep (1)}
 190         if ($count < 1) {exit (1)}
 191
 192         #Send any queued mail.  I had another routine that would
 193         #  fork and watch sendmail with a timeout, but that is kinda
 194         #  flaky depending on how big your queue size is. So
 195         #  now just call it and wait for it to return.  If you have bad
 196         #  messages in your queue, this can hang.
 197         sys_log ("Have connection->sending any local mail.") if $verbose;
 198         system("$sendmail -q");
 199
 200         sys_log ("Checking remote queue on ($mailhost)");
 201
 202         my $result;
 203         my $daemon = 0;
 204         my $pid;
 205         #In case we have a pid, read it and find out if it is
 206         #  still valid or not.
 207         if (defined $fetchmail_pid and -f $fetchmail_pid) {
 208             if (not open PID, $fetchmail_pid) {
 209                 sys_log("Could not open $fetchmail_pid");
 210                 die}
 211             $pid = <PID>;
 212             if ($pid =~ m|([0-9]+)\s+([0-9]*)|) {
 213                 $pid = $1;
 214                 $daemon = $2;
 215             }
 216             close PID;
 217             sys_log("Have PID file ($fetchmail_pid) with PID $pid $daemon");
 218             #In the case of fetchmail, we need to see if it is
 219             #  still running in case there is a stale lock file.
 220             if (&process_is_dead($pid)) {
 221                 sys_log("  It is no longer running");
 222                 $daemon = 0; $pid = 0}
 223         }
 224         if (not $pid or ($pid and $daemon)) {
 225             #Either it is not running or it is running and a daemon.
 226             sys_log("Running $fetchmail [$daemon]");
 227             my $result = (system ($fetchmail))/256;
 228             sys_log($fetchmail.' exited with status '.$result) if $debug;
 229         } else {
 230             sys_log("$fetchmail already running...");
 231         }
 232
 233         #Watch the directory for n seconds of inactivity.
 234         sys_log("Fetchmail done...watching $sendmail_queue_dir");
 235         &watch_dir ($sendmail_queue_dir, 10);
 236         sys_log ("Done polling for mail");
 237
 238         if (-f $fetchmail_pid and not $daemon) {
 239             #In case something went wrong and the fetchmail is still
 240             # running (and not a daemon)....
 241             my $result = `$fetchmail -q`; chop $result;
 242             sys_log($result);
 243         }
 244         exit (0);
 245     }
 246     #If a connection is needed, make it.
 247     if (&interface_is_down ($interface) && $pppd_pid == 0) {
 248         sys_log ("Try to connect with pppd") if $debug;
 249         # Fork pppd with a pid we can track.
 250         unless ($pppd_pid = fork) {
 251                 exec ($pppd.' -detach');
 252         }
 253     }
 254     #Wait for the child to exit and check for errors
 255     waitpid ($child_pid, 0);
 256     my $child_status = ($? / 256);
 257     my $child_kill = $? % 256;
 258     if ($child_status == 0) {
 259         if ($this_hour <= 4 and defined $suck) {
 260             sys_log ("Calling suck...");
 261             print `$suck`;
 262         }
 263         if (defined $rdate) {
 264            sys_log ("Calling rtime...");
 265            print `$rdate`;
 266         }
 267         if ($pppd_pid) {        #If we ran pppd, kill it
 268             sys_log ("Killing pppd (pid $pppd_pid)");
 269             kill 15, $pppd_pid;
 270             waitpid ($pppd_pid, 0);     #Wait for clean exit of child
 271         }
 272         sys_log ("Finished with cycle.");
 273         unlink ($lockfile);
 274         sys_log ("Total time: ".(time-$start_time)." seconds") if $debug;
 275         exit (0);
 276     }
 277     # Reset to pppp_pid to zero if pppd is not running.
 278     if ($pppd_pid && &process_is_dead ($pppd_pid)) {$pppd_pid = 0}
 279     sys_log (join ('', "Warn: Did not connect -> Try ",
 280                    $max_tries, " more times...after ",
 281                    $retry_delay, " seconds"));
 282     if (not $max_tries) {
 283         sys_log ("Giving up...");
 284         exit (1);
 285     }
 286     sleep ($retry_delay);
 287     sys_log ("ok...trying again.");
 288 }
 289
 290 sub check_program {
 291     #See if a program is in the path
 292     my ($program) = @_;
 293     my $exists = 0;
 294     my $path_specified = 0;
 295     my $path;
 296
 297     #catch the case where there is already a slash in the argument.
 298
 299     if ($program =~ /\//) {
 300         $path_specified = 1;
 301         if (-x $program) {$exists = $program}
 302     }
 303
 304     my $exists;
 305     foreach $path (split(/:/, $ENV{'PATH'})) {
 306         next if length ($path) < 3;             #skip bogus path entries
 307         #be sure the there is a trailing slash
 308         if (substr ($path, -1, 1) ne '/') {$path .= '/'}
 309         #Check to see if it exists and is executable
 310         if (-x $path.$program) {$exists = $path.$program; last}
 311     }
 312     if (not $exists) {
 313         if ($path_specified) {
 314             print STDERR "$0 -> Warn: ". $program.
 315                 " is not executable or does not exist.\n";
 316         } else {
 317             print STDERR "$0 -> Warn: [$program] was not found in path\n\t".
 318                 $ENV{'PATH'}."\n";
 319         }
 320     }
 321     return ($exists);
 322 }
 323
 324
 325 sub process_is_dead {
 326     #This is a cheap way to check for running processes.  I could use
 327     #  the /proc file-system in Linux but that would not be very
 328     #  friendly to other OS's.
 329     #
 330     #return 1 if pid is not in process list
 331     # This expects ps to return a header line and then another line if
 332     #  the process is running.  Also check for zombies
 333     my ($pid) = @_;
 334     my @results = split (/\n/, `ps $pid 2>/dev/null`);
 335     if (not defined $results[1]) {return  1}
 336     if ($results[1] =~ /zombie/i) {return 1}
 337     return 0;
 338 }
 339
 340
 341 sub interface_is_down {
 342     # return 1 (true) if the ip is down
 343     my ($interface) = @_;
 344     if (`ifconfig $interface` =~ /UP/) {
 345         return 0;
 346     } else {
 347         return 1;
 348     }
 349 }
 350
 351 sub watch_dir {
 352     #Watch the mailqueue directory for incoming files.
 353     #  The 'xf' files are the transfer (xfer) files on my system.
 354     #  If you find this is not the case, please email me.  To be safe,
 355     #  I check the latest mod time as long as xf files exist.  If no
 356     #  data has made it over in n seconds, we will assume that an
 357     #  error has occured and give up.
 358
 359     my $files_like = '^(xf.*)'; #Regexp
 360     my $dir_to_watch = shift;
 361     my $delay = shift;
 362     my $timeout = 120;  #Give it 120 seconds to get data.
 363     my $loop_delay = 1; #How long between each loop. Do not make 0!
 364
 365     #Make sure there is a trailing slash.
 366     if ($dir_to_watch !~ m|/$|) {$dir_to_watch .= '/'}
 367
 368     #How long to wait for transfer of data.  This gets reset
 369     #  each time the mod time falls below a certain time.
 370     my $flag = $delay;
 371     my $last_total = 0;
 372
 373     while (($flag -= $loop_delay) > 0) {
 374         sleep $loop_delay;
 375         opendir (DIR, $dir_to_watch);
 376         my $file_count = 0;
 377         my $last_data_dl = 500000; #Big Number
 378         foreach my $file (readdir (DIR)) {
 379             next if not -f $dir_to_watch.$file; #Only files.
 380             my @stats = stat($dir_to_watch.$file);
 381             my $m_time = time - $stats[9];
 382             #Here, if we have a recent file, reset the timeout.
 383             if ($m_time < $last_data_dl) {$last_data_dl = $m_time}
 384
 385             #If we have an xfer file, up the delay.
 386             if ($file =~ m|$files_like|) {
 387                 sys_log("$file is like $files_like");
 388                 $flag = $delay;
 389             }
 390         }
 391         closedir (DIR);
 392         sys_log ("Watch_dir: $flag ($last_data_dl)") if $debug;
 393
 394         #In the case of now data downloaded...
 395         if ($last_data_dl > $timeout and $flag == $delay) {
 396             sys_log("Watch_dir: Timed out after $timeout seconds.");
 397             $flag = 0;
 398         }
 399     }
 400     sys_log ("Watch_dir: Done.");
 401 }
 402
 403 sub usage {
 404     #print the usage
 405     print join ("\n",
 406                 'mailqueue.pl -- A program to send and receive mail form a sendmail spooler.',
 407                 '  Requires that you ISP is running sendmail, at lease version 8.6.?.',
 408                 '  Also requires that you have fetchmail or etrn.pl installed on this system.',
 409                 '', 'Command line args (Default in parrens):',
 410                 '  -v -verbose         Run in verbose mode.  Can use this arg multiple times.',
 411                 '  -d -debug           Run in debug mode.  Sets verbose level to 10',
 412                 '  -max_tries N        Sets the maximum number of connect retries to N.  ('.$max_tries.')',
 413                 '  -retry_delay N      Sets the delay between retrying to N seconds.  ('. $retry_delay.')',
 414                 "  -connect_timeout N  Sets the connection timeout to N seconds. (". $connect_timeout. ')',
 415                 '  -interface STR      Sets the default interface to STR.  ('. $interface. ')',
 416                 '  -mailhost STR       Sets the mailhost to STR. ('. $mailhost.')',
 417                 '');
 418     exit (1);
 419 }
 420