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
12use strict;
13
14# Load external program as subroutine to avoid
15# compilation overhead on each call
16
17sub 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
34my $progname = $0;
35my $lastage = -1;
36my $LOCK_EX = 2;
37my $LOCK_NB = 4;
38
39# Load and eval config script
40
41my $conffile = shift || "/usr/local/etc/movemail.conf";
42my $len = (stat($conffile))[7]
43    or die "Can't stat $conffile: $!";
44open CONF, "< $conffile"
45    or die "Can't open $conffile: $!";
46my $conf;
47read CONF, $conf, $len
48    or die "Can't read $conffile: $!";
49close CONF;
50use vars qw(@queues $subqbase @ages $remqueue $lockfile);
51eval $conf;
52
53if ($#queues < 1) {
54    print "$progname: there must be at least two queues\n";
55    exit 1;
56}
57
58if ($#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
65if ($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
74my $remsub = loadsub($remqueue);
75
76# Go through directories in reverse order so as to check spool files only once
77
78for (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
103if ($lockfile) {
104    unlink $lockfile;
105    close LOCK;
106}
107