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; | |
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 | ||
8d91c6dc | 46 | getopts('hf:r:y:o:s:C:zxlibRca',\%opt); |
a0f38e05 | 47 | if ($ARGV[0]) { &help; exit;} |
059ec3d9 | 48 | if ($opt{h}) { &help; exit;} |
209e806c | 49 | if ($opt{a}) { $eargs = '-bp'; } |
3ae173e7 | 50 | if ($opt{C} && -e $opt{C} && -f $opt{C} && -R $opt{C}) { $eargs .= ' -C '.$opt{C}; } |
059ec3d9 PH |
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. | |
8d91c6dc | 66 | -C Specify which exim.conf to use. |
059ec3d9 PH |
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 | |
209e806c | 85 | -a All recipients (including delivered) |
059ec3d9 PH |
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. | |
196f5966 | 95 | if ($line =~ /^\s*(\w+)\s+((?:\d+(?:\.\d+)?[A-Z]?)?)\s*(\w{6}-\w{6}-\w{2})\s+(<.*?>)/) { |
059ec3d9 PH |
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 | |
98157739 | 123 | next unless ($id{$msg}{from} =~ /$opt{f}/i); |
059ec3d9 PH |
124 | } |
125 | if ($opt{r}) { | |
126 | # Match any recipient address | |
127 | my $match = 0; | |
128 | foreach my $rcpt (@{$id{$msg}{rcpt}}) { | |
98157739 | 129 | $match++ if ($rcpt =~ /$opt{r}/i); |
059ec3d9 PH |
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 | } |