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