Utils: exiqgrep error/usage if there are non-understood arguments. Bug 1586
[exim.git] / src / src / exiqgrep.src
1 #!PERL_COMMAND
2
3 # Utility for searching and displaying queue information.
4 # Written by Matt Hubbard 15 August 2002
5
6 # Except when they appear in comments, the following placeholders in this
7 # source are replaced when it is turned into a runnable script:
8 #
9 # BIN_DIRECTORY
10 # PERL_COMMAND
11
12 # PROCESSED_FLAG
13
14
15 # Routine for extracting the UTC timestamp from message ID
16 # lifted from eximstat utility
17
18 # Version 1.2
19
20 use strict;
21 use Getopt::Std;
22
23 # Have this variable point to your exim binary.
24 my $exim = 'BIN_DIRECTORY/exim';
25 my $eargs = '-bpu';
26 my %id;
27 my %opt;
28 my $count = 0;
29 my $mcount = 0;
30 my @tab62 =
31   (0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0,     # 0-9
32    0,10,11,12,13,14,15,16,17,18,19,20,  # A-K
33   21,22,23,24,25,26,27,28,29,30,31,32,  # L-W
34   33,34,35, 0, 0, 0, 0, 0,              # X-Z
35    0,36,37,38,39,40,41,42,43,44,45,46,  # a-k
36   47,48,49,50,51,52,53,54,55,56,57,58,  # l-w
37   59,60,61);                            # x-z
38
39 my $base;
40 if ($^O eq 'darwin') { # aka MacOS X
41   $base = 36;
42  } else {
43   $base = 62;
44 };
45
46 getopts('hf:r:y:o:s:C:zxlibRca',\%opt);
47 if ($ARGV[0]) { &help; exit;}
48 if ($opt{h}) { &help; exit;}
49 if ($opt{a}) { $eargs = '-bp'; }
50 if ($opt{C} && -e $opt{C} && -f $opt{C} && -R $opt{C}) { $eargs .= ' -C '.$opt{C}; }
51
52 # Read message queue output into hash
53 &collect();
54 # Identify which messages match selection criteria
55 &selection();
56 # Print matching data according to display option.
57 &display();
58 exit;
59
60
61 sub help() {
62         print <<'EOF'
63 Exim message queue display utility.
64
65         -h              This help message.
66         -C              Specify which exim.conf to use.
67
68 Selection criteria:
69         -f <regexp>     Match sender address sender (field is "< >" wrapped)
70         -r <regexp>     Match recipient address
71         -s <regexp>     Match against the size field from long output
72         -y <seconds>    Message younger than
73         -o <seconds>    Message older than
74         -z              Frozen messages only (exclude non-frozen)
75         -x              Non-frozen messages only (exclude frozen)
76
77 [ NB: for regexps, provided string sits in /<string>/ ]
78
79 Display options:
80         -c              Display match count
81         -l              Long Format [Default]
82         -i              Message IDs only
83         -b              Brief Format
84         -R              Reverse order
85         -a              All recipients (including delivered)
86 EOF
87 }
88
89 sub collect() {
90         open(QUEUE,"$exim $eargs |") or die("Error openning pipe: $!\n");
91         while(<QUEUE>) {
92                 chomp();
93                 my $line = $_;
94                 #Should be 1st line of record, if not error.
95                 if ($line =~ /^\s*(\w+)\s+((?:\d+(?:\.\d+)?[A-Z]?)?)\s*(\w{6}-\w{6}-\w{2})\s+(<.*?>)/) {
96                         my $msg = $3;
97                         $id{$msg}{age} = $1;
98                         $id{$msg}{size} = $2;
99                         $id{$msg}{from} = $4;
100                         $id{$msg}{birth} = &msg_utc($msg);
101                         $id{$msg}{ages} = time - $id{$msg}{birth};
102                         if ($line =~ /\*\*\* frozen \*\*\*$/) {
103                                 $id{$msg}{frozen} = 1;
104                         } else {
105                                 $id{$msg}{frozen} = 0;
106                         }
107                         while(<QUEUE> =~ /\s+(.*?\@.*)$/) {
108                                 push(@{$id{$msg}{rcpt}},$1);
109                         }
110                         # Increment message counter.
111                         $count++;
112                 } else {
113                         print STDERR "Line mismatch: $line\n"; exit 1;
114                 }
115         }
116         close(QUEUE) or die("Error closing pipe: $!\n");
117 }
118
119 sub selection() {
120         foreach my $msg (keys(%id)) {
121                 if ($opt{f}) {
122                         # Match sender address
123                         next unless ($id{$msg}{from} =~ /$opt{f}/i);
124                 }
125                 if ($opt{r}) {
126                         # Match any recipient address
127                         my $match = 0;
128                         foreach my $rcpt (@{$id{$msg}{rcpt}}) {
129                                 $match++ if ($rcpt =~ /$opt{r}/i);
130                         }
131                         next unless ($match);
132                 }
133                 if ($opt{s}) {
134                         # Match against the size string.
135                         next unless ($id{$msg}{size} =~ /$opt{s}/);
136                 }
137                 if ($opt{y}) {
138                         # Match younger than
139                         next unless ($id{$msg}{ages} < $opt{y});
140                 }
141                 if ($opt{o}) {
142                         # Match older than
143                         next unless ($id{$msg}{ages} > $opt{o});
144                 }
145                 if ($opt{z}) {
146                         # Exclude non frozen
147                         next unless ($id{$msg}{frozen});
148                 }
149                 if ($opt{x}) {
150                         # Exclude frozen
151                         next if ($id{$msg}{frozen});
152                 }
153                 # Here's what we do to select the record.
154                 # Should only get this far if the message passed all of
155                 # the active tests.
156                 $id{$msg}{d} = 1;
157                 # Increment match counter.
158                 $mcount++;
159         }
160 }
161
162 sub display() {
163         if ($opt{c}) {
164                 printf("%d matches out of %d messages\n",$mcount,$count);
165                 exit;
166         }
167         foreach my $msg (sort { $opt{R} ? $id{$b}{birth} <=> $id{$a}{birth} : $id{$a}{birth} <=> $id{$b}{birth} } keys(%id) ) {
168                 if (exists($id{$msg}{d})) {
169                         if ($opt{i}) {
170                                 # Just the msg ID
171                                 print $msg, "\n";
172                         } elsif ($opt{b}) {
173                                 # Brief format
174                                 printf("%s From: %s To: %s\n",$msg,$id{$msg}{from},join(';',@{$id{$msg}{rcpt}}))
175                         } else {
176                                 # Otherwise Long format attempted duplication of original format.
177                                 printf("%3s %5s %s %s%s\n",$id{$msg}{age},$id{$msg}{size},$msg,$id{$msg}{from},$id{$msg}{frozen} ? " *** frozen ***" : "");
178                                 foreach my $rcpt (@{$id{$msg}{rcpt}}) {
179                                         printf("          %s\n",$rcpt);
180                                 }
181                                 print "\n";
182                         }
183                 }
184         }
185 }
186
187 sub report() {
188         foreach my $msg (keys(%id)) {
189                 print "$id{$msg}{birth} $msg\tAge: $id{$msg}{age}\tSize: $id{$msg}{size}\tFrom: $id{$msg}{from}\tTo: " . join(" ",@{$id{$msg}{rcpt}}). "\n";
190         }
191 }
192
193 sub msg_utc() {
194         my $id = substr((pop @_), 0, 6);
195         my $s = 0;
196         my @c = split(//, $id);
197         while($#c >= 0) { $s = $s * $base + $tab62[ord(shift @c) - ord('0')] }
198         return $s;
199 }