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