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