Avoid parsing cost for auto-macro creates
[exim.git] / src / src / exiqgrep.src
CommitLineData
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
20use strict;
21use Getopt::Std;
22
23# Have this variable point to your exim binary.
24my $exim = 'BIN_DIRECTORY/exim';
25my $eargs = '-bpu';
26my %id;
27my %opt;
28my $count = 0;
29my $mcount = 0;
30my @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
39my $base;
40if ($^O eq 'darwin') { # aka MacOS X
41 $base = 36;
42 } else {
43 $base = 62;
44};
45
8d91c6dc 46getopts('hf:r:y:o:s:C:zxlibRca',\%opt);
a0f38e05 47if ($ARGV[0]) { &help; exit;}
059ec3d9 48if ($opt{h}) { &help; exit;}
209e806c 49if ($opt{a}) { $eargs = '-bp'; }
3ae173e7 50if ($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();
58exit;
59
60
61sub help() {
62 print <<'EOF'
63Exim message queue display utility.
64
65 -h This help message.
8d91c6dc 66 -C Specify which exim.conf to use.
059ec3d9
PH
67
68Selection 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
79Display 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
86EOF
87}
88
89sub 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
119sub 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
162sub 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
187sub 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
193sub 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}