contrib/sendmail-8.13.4/contrib/movemail.pl

   1 #!/usr/bin/perl -w
   2 #
   3 # Move old mail messages between queues by calling re-mqueue.pl.
   4 #
   5 # movemail.pl [config-script]
   6 #
   7 # Default config script is /usr/local/etc/movemail.conf.
   8 #
   9 # Graeme Hewson <graeme.hewson@oracle.com>, June 2000
  10 #
  11
  12 use strict;
  13
  14 # Load external program as subroutine to avoid
  15 # compilation overhead on each call
  16
  17 sub loadsub {
  18     my $fn = shift
  19         or die "Filename not specified";
  20     my $len = (stat($fn))[7]
  21         or die "Can't stat $fn: $!";
  22     open PROG, "< $fn"
  23         or die "Can't open $fn: $!";
  24     my $prog;
  25     read PROG, $prog, $len
  26         or die "Can't read $fn: $!";
  27     close PROG;
  28     eval join "",
  29         'return sub { my @ARGV = @_; $0 = $fn; no strict;',
  30         "$prog",
  31         '};';
  32 }
  33
  34 my $progname = $0;
  35 my $lastage = -1;
  36 my $LOCK_EX = 2;
  37 my $LOCK_NB = 4;
  38
  39 # Load and eval config script
  40
  41 my $conffile = shift || "/usr/local/etc/movemail.conf";
  42 my $len = (stat($conffile))[7]
  43     or die "Can't stat $conffile: $!";
  44 open CONF, "< $conffile"
  45     or die "Can't open $conffile: $!";
  46 my $conf;
  47 read CONF, $conf, $len
  48     or die "Can't read $conffile: $!";
  49 close CONF;
  50 use vars qw(@queues $subqbase @ages $remqueue $lockfile);
  51 eval $conf;
  52
  53 if ($#queues < 1) {
  54     print "$progname: there must be at least two queues\n";
  55     exit 1;
  56 }
  57
  58 if ($#ages != ($#queues - 1)) {
  59     print "$progname: wrong number of ages (should be one less than number of queues)\n";
  60     exit 1;
  61 }
  62
  63 # Get lock or exit quietly.  Useful when running from cron.
  64
  65 if ($lockfile) {
  66     open LOCK, ">>$lockfile"
  67         or die "Can't open lock file: $!";
  68     unless (flock LOCK, $LOCK_EX|$LOCK_NB) {
  69         close LOCK;
  70         exit 0;
  71     }
  72 }
  73
  74 my $remsub = loadsub($remqueue);
  75
  76 # Go through directories in reverse order so as to check spool files only once
  77
  78 for (my $n = $#queues - 1; $n >= 0; $n--) {
  79     unless ($ages[$n] =~ /^\d+$/) {
  80         print "$progname: invalid number $ages[$n] in ages array\n";
  81         exit 1;
  82     }
  83     unless ($lastage < 0 || $ages[$n] < $lastage) {
  84         print "$progname: age $lastage is not > previous value $ages[$n]\n";
  85         exit 1;
  86     }
  87     $lastage = $ages[$n];
  88     if ($subqbase) {
  89         my $subdir;
  90         opendir(DIR, $queues[$n])
  91             or die "Can't open $queues[$n]: $!";
  92         foreach $subdir ( grep { /^$subqbase/ } readdir DIR) {
  93             &$remsub("$queues[$n]/$subdir", "$queues[$n+1]/$subdir",
  94                 $ages[$n]);
  95         }
  96         closedir(DIR);
  97     } else {
  98         # Not using subdirectories
  99         &$remsub($queues[$n], $queues[$n+1], $ages[$n]);
 100     }
 101 }
 102
 103 if ($lockfile) {
 104     unlink $lockfile;
 105     close LOCK;
 106 }