A tweak to the "H" retry rule from Michael Haardt.
[exim.git] / src / src / exipick.src
1 #!PERL_COMMAND
2 # $Cambridge: exim/src/src/exipick.src,v 1.8 2005/12/15 17:58:23 jetmore Exp $
3
4 # This variable should be set by the building process to Exim's spool directory.
5 my $spool = 'SPOOL_DIRECTORY';
6
7 use strict;
8 use Getopt::Long;
9
10 my($p_name)   = $0 =~ m|/?([^/]+)$|;
11 my $p_version = "20051215.3";
12 my $p_usage   = "Usage: $p_name [--help|--version] (see --help for details)";
13 my $p_cp      = <<EOM;
14         Copyright (c) 2003-2005 John Jetmore <jj33\@pobox.com>
15
16     This program is free software; you can redistribute it and/or modify
17     it under the terms of the GNU General Public License as published by
18     the Free Software Foundation; either version 2 of the License, or
19     (at your option) any later version.
20
21     This program is distributed in the hope that it will be useful,
22     but WITHOUT ANY WARRANTY; without even the implied warranty of
23     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
24     GNU General Public License for more details.
25
26     You should have received a copy of the GNU General Public License
27     along with this program; if not, write to the Free Software
28     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
29 EOM
30 ext_usage(); # before we do anything else, check for --help
31
32 $| = 1; # unbuffer STDOUT
33
34 Getopt::Long::Configure("bundling_override");
35 GetOptions(
36   'spool:s'     => \$G::spool,      # exim spool dir
37   'bp'          => \$G::mailq_bp,   # List the queue (noop - default)
38   'bpa'         => \$G::mailq_bpa,  # ... with generated address as well
39   'bpc'         => \$G::mailq_bpc,  # ... but just show a count of messages
40   'bpr'         => \$G::mailq_bpr,  # ... do not sort
41   'bpra'        => \$G::mailq_bpra, # ... with generated addresses, unsorted
42   'bpru'        => \$G::mailq_bpru, # ... only undelivered addresses, unsorted
43   'bpu'         => \$G::mailq_bpu,  # ... only undelivered addresses
44   'and'         => \$G::and,        # 'and' the criteria (default)
45   'or'          => \$G::or,         # 'or' the criteria
46   'f:s'         => \$G::qgrep_f,    # from regexp
47   'r:s'         => \$G::qgrep_r,    # recipient regexp
48   's:s'         => \$G::qgrep_s,    # match against size field
49   'y:s'         => \$G::qgrep_y,    # message younger than (secs)
50   'o:s'         => \$G::qgrep_o,    # message older than (secs)
51   'z'           => \$G::qgrep_z,    # frozen only
52   'x'           => \$G::qgrep_x,    # non-frozen only
53   'c'           => \$G::qgrep_c,    # display match count
54   'l'           => \$G::qgrep_l,    # long format (default)
55   'i'           => \$G::qgrep_i,    # message ids only
56   'b'           => \$G::qgrep_b,    # brief format
57   'flatq'       => \$G::flatq,      # brief format
58   'caseful'     => \$G::caseful,    # in '=' criteria, respect case
59   'caseless'    => \$G::caseless,   #   ...ignore case (default)
60   'show-vars:s' => \$G::show_vars,  # display the contents of these vars
61   'show-rules'  => \$G::show_rules, # display compiled match rules
62   'show-tests'  => \$G::show_tests  # display tests as applied to each message
63 ) || exit(1);
64
65 push(@ARGV, "\$sender_address     =~ /$G::qgrep_f/") if ($G::qgrep_f);
66 push(@ARGV, "\$recipients         =~ /$G::qgrep_r/") if ($G::qgrep_r);
67 push(@ARGV, "\$shown_message_size eq $G::qgrep_s")   if ($G::qgrep_s);
68 push(@ARGV, "\$message_age        <  $G::qgrep_y")   if ($G::qgrep_y);
69 push(@ARGV, "\$message_age        >  $G::qgrep_o")   if ($G::qgrep_o);
70 push(@ARGV, "\$deliver_freeze")                      if ($G::qgrep_z);
71 push(@ARGV, "!\$deliver_freeze")                     if ($G::qgrep_x);
72 $G::mailq_bp        = $G::mailq_bp;        # shut up -w
73 $G::and             = $G::and;             # shut up -w
74 $G::msg_ids         = {};                  # short circuit when crit is only MID
75 $G::caseless        = $G::caseful ? 0 : 1; # nocase by default, case if both
76 @G::recipients_crit = ();                  # holds per-recip criteria
77 $spool              = $G::spool if ($G::spool);
78 my $count_only      = 1 if ($G::mailq_bpc || $G::qgrep_c);
79 my $unsorted        = 1 if ($G::mailq_bpr || $G::mailq_bpra || $G::mailq_bpru);
80 my $msg             = get_all_msgs($spool, $unsorted);
81 my $crit            = process_criteria(\@ARGV);
82 my $e               = Exim::SpoolFile->new();
83 my $tcount          = 0 if ($count_only);  # holds count of all messages
84 my $mcount          = 0 if ($count_only);  # holds count of matching messages
85 $e->set_undelivered_only(1)      if ($G::mailq_bpru || $G::mailq_bpu);
86 $e->set_show_generated(1)        if ($G::mailq_bpra || $G::mailq_bpa);
87 $e->output_long()                if ($G::qgrep_l);
88 $e->output_idonly()              if ($G::qgrep_i);
89 $e->output_brief()               if ($G::qgrep_b);
90 $e->output_flatq()               if ($G::flatq);
91 $e->set_show_vars($G::show_vars) if ($G::show_vars);
92 $e->set_spool($spool);
93
94 MSG:
95 foreach my $m (@$msg) {
96   next if (scalar(keys(%$G::msg_ids)) && !$G::or
97                                       && !$G::msg_ids->{$m->{message}});
98   if (!$e->parse_message($m->{message})) {
99     warn "Couldn't parse $m->{message}: ".$e->error()."\n";
100     next(MSG);
101   }
102   $tcount++;
103   my $match = 0;
104   my @local_crit = ();
105   foreach my $c (@G::recipients_crit) {              # handle each_recip* vars
106     foreach my $addr (split(/, /, $e->get_var($c->{var}))) {
107       my %t = ( 'cmp' => $c->{cmp}, 'var' => $c->{var} );
108       $t{cmp} =~ s/"?\$var"?/'$addr'/;
109       push(@local_crit, \%t);
110     }
111   }
112   if ($G::show_tests) { print $e->get_var('message_exim_id'), "\n"; }
113   CRITERIA:
114   foreach my $c (@$crit, @local_crit) {
115     my $var = $e->get_var($c->{var});
116     my $ret = eval($c->{cmp});
117     if ($G::show_tests) {
118       printf "  %25s =  '%s'\n  %25s => $ret\n",$c->{var},$var,$c->{cmp},$ret;
119     }
120     if ($@) {
121       print STDERR "Error in eval '$c->{cmp}': $@\n";
122       next(MSG);
123     } elsif ($ret) {
124       $match = 1;
125       if ($G::or) { last(CRITERIA); }
126       else        { next(CRITERIA); }
127     } else { # no match
128       if ($G::or) { next(CRITERIA); }
129       else        { next(MSG);      }
130     }
131   }
132
133   # skip this message if any criteria were supplied and it didn't match
134   next(MSG) if ((scalar(@$crit) || scalar(@local_crit)) && !$match);
135
136   if ($count_only) {
137     $mcount++;
138   } else {
139     $e->print_message(\*STDOUT);
140   }
141 }
142
143 if ($G::mailq_bpc) {
144   print "$tcount\n";
145 } elsif ($G::qgrep_c) {
146   print "$mcount matches out of $tcount messages\n";
147 }
148
149 exit;
150
151 sub process_criteria {
152   my $a = shift;
153   my @c = ();
154   my $e = 0;
155
156   foreach (@$a) {
157     foreach my $t ('@') { s/$t/\\$t/g; } # '$'
158     if (/^(.*?)\s+(<=|>=|==|!=|<|>)\s+(.*)$/) {
159       #print STDERR "found as integer\n";
160       my $v = $1; my $o = $2; my $n = $3;
161       if    ($n =~ /^([\d\.]+)M$/)  { $n = $1 * 1024 * 1024; }
162       elsif ($n =~ /^([\d\.]+)K$/)  { $n = $1 * 1024; }
163       elsif ($n =~ /^([\d\.]+)B?$/) { $n = $1; }
164       elsif ($n =~ /^([\d\.]+)d$/)  { $n = $1 * 60 * 60 * 24; }
165       elsif ($n =~ /^([\d\.]+)h$/)  { $n = $1 * 60 * 60; }
166       elsif ($n =~ /^([\d\.]+)m$/)  { $n = $1 * 60; }
167       elsif ($n =~ /^([\d\.]+)s?$/) { $n = $1; }
168       else {
169         print STDERR "Expression $_ did not parse: numeric comparison with ",
170                      "non-number\n";
171         $e = 1;
172         next;
173       }
174       push(@c, { var => lc($v), cmp => "(\$var $o $n) ? 1 : 0" });
175     } elsif (/^(.*?)\s+(=~|!~)\s+(.*)$/) {
176       #print STDERR "found as string regexp\n";
177       push(@c, { var => lc($1), cmp => "(\"\$var\" $2 $3) ? 1 : 0" });
178     } elsif (/^(.*?)\s+=\s+(.*)$/) {
179       #print STDERR "found as bare string regexp\n";
180       my $case = $G::caseful ? '' : 'i';
181       push(@c, { var => lc($1), cmp => "(\"\$var\" =~ /$2/$case) ? 1 : 0" });
182     } elsif (/^(.*?)\s+(eq|ne)\s+(.*)$/) {
183       #print STDERR "found as string cmp\n";
184       my $var = lc($1); my $op = $2; my $val = $3;
185       $val =~ s|^(['"])(.*)\1$|$2|;
186       push(@c, { var => $var, cmp => "(\"\$var\" $op \"$val\") ? 1 : 0" });
187       if (($var eq 'message_id' || $var eq 'message_exim_id') && $op eq "eq") {
188         #print STDERR "short circuit @c[-1]->{cmp} $val\n";
189         $G::msg_ids->{$val} = 1;
190       }
191     } elsif (/^(!)?(\S+)$/) {
192       #print STDERR "found as boolean\n";
193       push(@c, { var => lc($2), cmp => "($1\$var) ? 1 : 0" });
194     } else {
195       print STDERR "Expression $_ did not parse\n";
196       $e = 1;
197     }
198     # support the each_* psuedo variables.  Steal the criteria off of the
199     # queue for special processing later
200     if ($c[-1]{var} =~ /^each_(recipients(_(un)?del)?)$/) {
201       my $var = $1;
202       push(@G::recipients_crit,pop(@c));
203       $G::recipients_crit[-1]{var} = $var; # remove each_ from the variable
204     }
205   }
206
207   exit(1) if ($e);
208
209   if ($G::show_rules) { foreach (@c) { print "$_->{var}\t$_->{cmp}\n"; } }
210
211   return(\@c);
212 }
213
214 sub get_all_msgs {
215   my $d = shift() . '/input';
216   my $u = shift;
217   my @m = ();
218
219   opendir(D, "$d") || die "Couldn't opendir $d: $!\n";
220   foreach my $e (grep !/^\./, readdir(D)) {
221     if ($e =~ /^[a-zA-Z0-9]$/) {
222       opendir(DD, "$d/$e") || next;
223       foreach my $f (grep !/^\./, readdir(DD)) {
224         push(@m, { message => $1, path => "$e/$1" }) if ($f =~ /^(.{16})-H$/);
225       }
226       closedir(DD);
227     } elsif ($e =~ /^(.{16})-H$/) {
228       push(@m, { message => $1, path => $1 });
229     }
230   }
231   closedir(D);
232
233   return($u ? \@m : [ sort { $a->{message} cmp $b->{message} } @m ]);
234 }
235
236 BEGIN {
237
238 package Exim::SpoolFile;
239
240 # versions 4.61 and higher will not need these variables anymore, but they
241 # are left for handling legacy installs
242 $Exim::SpoolFile::ACL_C_MAX_LEGACY = 10;
243 #$Exim::SpoolFile::ACL_M_MAX _LEGACY= 10;
244
245 sub new {
246   my $class = shift;
247   my $self  = {};
248   bless($self, $class);
249
250   $self->{_spool_dir}        = '';
251   $self->{_undelivered_only} = 0;
252   $self->{_show_generated}   = 0;
253   $self->{_output_long}      = 1;
254   $self->{_output_idonly}    = 0;
255   $self->{_output_brief}     = 0;
256   $self->{_output_flatq}     = 0;
257   $self->{_show_vars}        = [];
258
259   $self->_reset();
260   return($self);
261 }
262
263 sub output_long {
264   my $self = shift;
265
266   $self->{_output_long}      = 1;
267   $self->{_output_idonly}    = 0;
268   $self->{_output_brief}     = 0;
269   $self->{_output_flatq}     = 0;
270 }
271
272 sub output_idonly {
273   my $self = shift;
274
275   $self->{_output_long}      = 0;
276   $self->{_output_idonly}    = 1;
277   $self->{_output_brief}     = 0;
278   $self->{_output_flatq}     = 0;
279 }
280
281 sub output_brief {
282   my $self = shift;
283
284   $self->{_output_long}      = 0;
285   $self->{_output_idonly}    = 0;
286   $self->{_output_brief}     = 1;
287   $self->{_output_flatq}     = 0;
288 }
289
290 sub output_flatq {
291   my $self = shift;
292
293   $self->{_output_long}      = 0;
294   $self->{_output_idonly}    = 0;
295   $self->{_output_brief}     = 0;
296   $self->{_output_flatq}     = 1;
297 }
298
299 sub set_show_vars {
300   my $self = shift;
301   my $s    = shift;
302
303   foreach my $v (split(/\s*,\s*/, $s)) {
304     push(@{$self->{_show_vars}}, $v);
305   }
306 }
307
308 sub set_show_generated {
309   my $self = shift;
310   $self->{_show_generated} = shift;
311 }
312
313 sub set_undelivered_only {
314   my $self = shift;
315   $self->{_undelivered_only} = shift;
316 }
317
318 sub error {
319   my $self = shift;
320   return $self->{_error};
321 }
322
323 sub _error {
324   my $self = shift;
325   $self->{_error} = shift;
326   return(undef);
327 }
328
329 sub _reset {
330   my $self = shift;
331
332   $self->{_error}       = '';
333   $self->{_delivered}   = 0;
334   $self->{_message}     = '';
335   $self->{_path}        = '';
336   $self->{_vars}        = {};
337
338   $self->{_numrecips}   = 0;
339   $self->{_udel_tree}   = {};
340   $self->{_del_tree}    = {};
341   $self->{_recips}      = {};
342
343   return($self);
344 }
345
346 sub parse_message {
347   my $self = shift;
348
349   $self->_reset();
350   $self->{_message} = shift || return(0);
351   return(0) if (!$self->{_spool_dir});
352   if (!$self->_find_path()) {
353     # assume the message was delivered from under us and ignore
354     $self->{_delivered} = 1;
355     return(1);
356   }
357   $self->_parse_header() || return(0);
358
359   return(1);
360 }
361
362 sub _find_path {
363   my $self = shift;
364
365   return(0) if (!$self->{_message});
366   return(0) if (!$self->{_spool_dir});
367
368   foreach my $f ('', substr($self->{_message}, 5, 1).'/') {
369     if (-f $self->{_spool_dir} . "/input/$f" . $self->{_message} . '-H') {
370       $self->{_path} = $self->{_spool_dir} . "/input/$f";
371       return(1);
372     }
373   }
374   return(0);
375 }
376
377 sub set_spool {
378   my $self = shift;
379   $self->{_spool_dir} = shift;
380 }
381
382 # accepts a variable with or without leading '$' or trailing ':'
383 sub get_var {
384   my $self = shift;
385   my $var  = lc(shift);
386
387   $var =~ s/^\$//;
388   $var =~ s/:$//;
389
390   $self->_parse_body()
391       if ($var eq 'message_body' && !$self->{_vars}{message_body});
392
393   return $self->{_vars}{$var};
394 }
395
396 sub _parse_body {
397   my $self = shift;
398   my $f    = $self->{_path} . '/' . $self->{_message} . '-D';
399
400   open(I, "<$f") || return($self->_error("Couldn't open $f: $!"));
401   chomp($_ = <I>);
402   return(0) if ($self->{_message}.'-D' ne $_);
403
404   $self->{_vars}{message_body} = join('', <I>);
405   close(I);
406   $self->{_vars}{message_body} =~ s/\n/ /g;
407   $self->{_vars}{message_body} =~ s/\000/ /g;
408   return(1);
409 }
410
411 sub _parse_header {
412   my $self = shift;
413   my $f    = $self->{_path} . '/' . $self->{_message} . '-H';
414
415   open(I, "<$f") || return($self->_error("Couldn't open $f: $!"));
416   chomp($_ = <I>);
417   return(0) if ($self->{_message}.'-H' ne $_);
418   $self->{_vars}{message_id}       = $self->{_message};
419   $self->{_vars}{message_exim_id}  = $self->{_message};
420
421   # line 2
422   chomp($_ = <I>);
423   return(0) if (!/^(.+)\s(\-?\d+)\s(\-?\d+)$/);
424   $self->{_vars}{originator_login} = $1;
425   $self->{_vars}{originator_uid}   = $2;
426   $self->{_vars}{originator_gid}   = $3;
427
428   # line 3
429   chomp($_ = <I>);
430   return(0) if (!/^<(.*)>$/);
431   $self->{_vars}{sender_address}   = $1;
432   $self->{_vars}{sender_address_domain} = $1;
433   $self->{_vars}{sender_address_local_part} = $1;
434   $self->{_vars}{sender_address_domain} =~ s/^.*\@//;
435   $self->{_vars}{sender_address_local_part} =~ s/^(.*)\@.*$/$1/;
436
437   # line 4
438   chomp($_ = <I>);
439   return(0) if (!/^(\d+)\s(\d+)$/);
440   $self->{_vars}{received_time}    = $1;
441   $self->{_vars}{warning_count}    = $2;
442   $self->{_vars}{message_age}      = time() - $self->{_vars}{received_time};
443
444   while (<I>) {
445     chomp();
446     if (/^(-\S+)\s*(.*$)/) {
447       my $tag = $1;
448       my $arg = $2;
449       if ($tag eq '-acl') {
450         my $t;
451         return(0) if ($arg !~ /^(\d+)\s(\d+)$/);
452         if ($1 < $Exim::SpoolFile::ACL_C_MAX_LEGACY) {
453           $t = "acl_c$1";
454         } else {
455           $t = "acl_m" . ($1 - $Exim::SpoolFile::ACL_C_MAX_LEGACY);
456         }
457         read(I, $self->{_vars}{$t}, $2+1) || return(0);
458         chomp($self->{_vars}{$t});
459       } elsif ($tag eq '-aclc') {
460         return(0) if ($arg !~ /^(\d+)\s(\d+)$/);
461         my $t = "acl_c$1";
462         read(I, $self->{_vars}{$t}, $2+1) || return(0);
463         chomp($self->{_vars}{$t});
464       } elsif ($tag eq '-aclm') {
465         return(0) if ($arg !~ /^(\d+)\s(\d+)$/);
466         my $t = "acl_m$1";
467         read(I, $self->{_vars}{$t}, $2+1) || return(0);
468         chomp($self->{_vars}{$t});
469       } elsif ($tag eq '-local') {
470         $self->{_vars}{sender_local} = 1;
471       } elsif ($tag eq '-localerror') {
472         $self->{_vars}{local_error_message} = 1;
473       } elsif ($tag eq '-local_scan') {
474         $self->{_vars}{local_scan_data} = $arg;
475       } elsif ($tag eq '-spam_score_int') {
476         $self->{_vars}{spam_score_int} = $arg;
477         $self->{_vars}{spam_score}     = $arg / 10;
478       } elsif ($tag eq '-bmi_verdicts') {
479         $self->{_vars}{bmi_verdicts} = $arg;
480       } elsif ($tag eq '-host_lookup_deferred') {
481         $self->{_vars}{host_lookup_deferred} = 1;
482       } elsif ($tag eq '-host_lookup_failed') {
483         $self->{_vars}{host_lookup_failed} = 1;
484       } elsif ($tag eq '-body_linecount') {
485         $self->{_vars}{body_linecount} = $arg;
486       } elsif ($tag eq '-body_zerocount') {
487         $self->{_vars}{body_zerocount} = $arg;
488       } elsif ($tag eq '-frozen') {
489         $self->{_vars}{deliver_freeze} = 1;
490         $self->{_vars}{deliver_frozen_at} = $arg;
491       } elsif ($tag eq '-allow_unqualified_recipient') {
492         $self->{_vars}{allow_unqualified_recipient} = 1;
493       } elsif ($tag eq '-allow_unqualified_sender') {
494         $self->{_vars}{allow_unqualified_sender} = 1;
495       } elsif ($tag eq '-deliver_firsttime') {
496         $self->{_vars}{deliver_firsttime} = 1;
497         $self->{_vars}{first_delivery} = 1;
498       } elsif ($tag eq '-manual_thaw') {
499         $self->{_vars}{deliver_manual_thaw} = 1;
500         $self->{_vars}{manually_thawed} = 1;
501       } elsif ($tag eq '-auth_id') {
502         $self->{_vars}{authenticated_id} = $arg;
503       } elsif ($tag eq '-auth_sender') {
504         $self->{_vars}{authenticated_sender} = $arg;
505       } elsif ($tag eq '-sender_set_untrusted') {
506         $self->{_vars}{sender_set_untrusted} = 1;
507       } elsif ($tag eq '-tls_certificate_verified') {
508         $self->{_vars}{tls_certificate_verified} = 1;
509       } elsif ($tag eq '-tls_cipher') {
510         $self->{_vars}{tls_cipher} = $arg;
511       } elsif ($tag eq '-tls_peerdn') {
512         $self->{_vars}{tls_peerdn} = $arg;
513       } elsif ($tag eq '-host_address') {
514         $self->{_vars}{sender_host_port} = $self->_get_host_and_port(\$arg);
515         $self->{_vars}{sender_host_address} = $arg;
516       } elsif ($tag eq '-interface_address') {
517         $self->{_vars}{interface_port} = $self->_get_host_and_port(\$arg);
518         $self->{_vars}{interface_address} = $arg;
519       } elsif ($tag eq '-active_hostname') {
520         $self->{_vars}{smtp_active_hostname} = $arg;
521       } elsif ($tag eq '-host_auth') {
522         $self->{_vars}{sender_host_authenticated} = $arg;
523       } elsif ($tag eq '-host_name') {
524         $self->{_vars}{sender_host_name} = $arg;
525       } elsif ($tag eq '-helo_name') {
526         $self->{_vars}{sender_helo_name} = $arg;
527       } elsif ($tag eq '-ident') {
528         $self->{_vars}{sender_ident} = $arg;
529       } elsif ($tag eq '-received_protocol') {
530         $self->{_vars}{received_protocol} = $arg;
531       } elsif ($tag eq '-N') {
532         $self->{_vars}{dont_deliver} = 1;
533       } else {
534         # unrecognized tag, save it for reference
535         $self->{$tag} = $arg;
536       }
537     } else {
538       last;
539     }
540   }
541
542   # when we drop out of the while loop, we have the first line of the
543   # delivered tree in $_
544   do {
545     if ($_ eq 'XX') {
546       ; # noop
547     } elsif ($_ =~ s/^[YN][YN]\s+//) {
548       $self->{_del_tree}{$_} = 1;
549     } else {
550       return(0);
551     }
552     chomp($_ = <I>);
553   } while ($_ !~ /^\d+$/);
554
555   $self->{_numrecips} = $_;
556   $self->{_vars}{recipients_count} = $self->{_numrecips};
557   for (my $i = 0; $i < $self->{_numrecips}; $i++) {
558     chomp($_ = <I>);
559     return(0) if (/^$/);
560     my $addr = '';
561     if (/^(.*)\s\d+,(\d+),\d+$/) {
562       #print STDERR "exim3 type (untested): $_\n";
563       $self->{_recips}{$1} = { pno => $2 };
564       $addr = $1;
565     } elsif (/^(.*)\s(\d+)$/) {
566       #print STDERR "exim4 original type (untested): $_\n";
567       $self->{_recips}{$1} = { pno => $2 };
568       $addr = $1;
569     } elsif (/^(.*)\s(.*)\s(\d+),(\d+)#1$/) {
570       #print STDERR "exim4 new type #1 (untested): $_\n";
571       return($self->_error("incorrect format: $_")) if (length($2) != $3);
572       $self->{_recips}{$1} = { pno => $4, errors_to => $2 };
573       $addr = $1;
574     } elsif (/^.*#(\d+)$/) {
575       #print STDERR "exim4 #$1 style (unimplemented): $_\n";
576       $self->_error("exim4 #$1 style (unimplemented): $_");
577     } else {
578       #print STDERR "default type: $_\n";
579       $self->{_recips}{$_} = {};
580       $addr = $_;
581     }
582     $self->{_udel_tree}{$addr} = 1 if (!$self->{_del_tree}{$addr});
583   }
584   $self->{_vars}{recipients}         = join(', ', keys(%{$self->{_recips}}));
585   $self->{_vars}{recipients_del}     = join(', ', keys(%{$self->{_del_tree}}));
586   $self->{_vars}{recipients_undel}   = join(', ', keys(%{$self->{_udel_tree}}));
587   $self->{_vars}{recipients_undel_count} = scalar(keys(%{$self->{_udel_tree}}));
588   $self->{_vars}{recipients_del_count}   = 0;
589   foreach my $r (keys %{$self->{_del_tree}}) {
590     next if (!$self->{_recips}{$r});
591     $self->{_vars}{recipients_del_count}++;
592   }
593
594   # blank line
595   $_ = <I>;
596   return(0) if (!/^$/);
597
598   # start reading headers
599   while (read(I, $_, 3) == 3) {
600     my $t = getc(I);
601     return(0) if (!length($t));
602     while ($t =~ /^\d$/) {
603       $_ .= $t;
604       $t  = getc(I);
605     }
606     # ok, right here $t contains the header flag and $_ contains the number of
607     # bytes to read.  If we ever use the header flag, grab it here.
608     $self->{_vars}{message_size} += $_ if ($t ne '*');
609     $t = getc(I); # strip the space out of the file
610     my $bytes = $_;
611     return(0) if (read(I, $_, $bytes) != $bytes);
612     chomp(); # may regret this later
613     $self->{_vars}{message_linecount} += scalar(split(/\n/)) if ($t ne '*');
614     # build the $header_ variable, following exim's rules (sort of)
615     if (/^([^ :]+):(.*)$/s) {
616       my $v = "header_" . lc($1);
617       my $d = $2;
618       $d =~ s/^\s*//;
619       $d =~ s/\s*$//;
620       $self->{_vars}{$v} .= (defined($self->{_vars}{$v}) ? "\n" : '') . $d;
621       $self->{_vars}{received_count}++ if ($v eq 'header_received');
622     }
623     # push header onto $message_headers var, following exim's rules
624     $self->{_vars}{message_headers} .=
625         (defined($self->{_vars}{message_headers}) ? "\n" : '') . $_;
626   }
627   close(I);
628
629   if (length($self->{_vars}{"header_reply-to"}) > 0) {
630     $self->{_vars}{reply_address} = $self->{_vars}{"header_reply-to"};
631   } else {
632     $self->{_vars}{reply_address} = $self->{_vars}{header_from};
633   }
634
635   $self->{_vars}{message_body_size} =
636       (stat($self->{_path}.'/'.$self->{_message}.'-D'))[7] - 19;
637   if ($self->{_vars}{message_body_size} < 0) {
638     $self->{_vars}{message_size} = 0;
639   } else {
640     $self->{_vars}{message_size} += $self->{_vars}{message_body_size} + 1;
641   }
642
643   $self->{_vars}{message_linecount} += $self->{_vars}{body_linecount};
644
645   my $i = $self->{_vars}{message_size};
646   if ($i == 0)              { $i = ""; }
647   elsif ($i < 1024)         { $i = sprintf("%d", $i); }
648   elsif ($i < 10*1024)      { $i = sprintf("%.1fK", $i / 1024); }
649   elsif ($i < 1024*1024)    { $i = sprintf("%dK", ($i+512)/1024); }
650   elsif ($i < 10*1024*1024) { $i = sprintf("%.1fM", $i/(1024*1024)); }
651   else { $i = sprintf("%dM", ($i + 512 * 1024)/(1024*1024)); }
652   $self->{_vars}{shown_message_size} = $i;
653
654   return(1);
655 }
656
657 # mimic exim's host_extract_port function - receive a ref to a scalar,
658 # strip it of port, return port
659 sub _get_host_and_port {
660   my $self = shift;
661   my $host = shift; # scalar ref, be careful
662
663   if ($$host =~ /^\[([^\]]+)\](?:\:(\d+))?$/) {
664     $$host = $1;
665     return($2 || 0);
666   } elsif ($$host =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})(?:\.(\d+))?$/) {
667     $$host = $1;
668     return($2 || 0);
669   } elsif ($$host =~ /^([\d\:]+)(?:\.(\d+))?$/) {
670     $$host = $1;
671     return($2 || 0);
672   }
673   # implicit else
674   return(0);
675 }
676
677 sub print_message {
678   my $self = shift;
679   my $fh   = shift || \*STDOUT;
680   return if ($self->{_delivered});
681
682   if ($self->{_output_idonly}) {
683     print $fh $self->{_message};
684     foreach my $v (@{$self->{_show_vars}}) {
685       print $fh " $v='", $self->get_var($v), "'";
686     }
687     print $fh "\n";
688     return;
689   }
690
691   if ($self->{_output_long} || $self->{_output_flatq}) {
692     my $i = int($self->{_vars}{message_age} / 60);
693     if ($i > 90) {
694       $i = int(($i+30)/60);
695       if ($i > 72) { printf $fh "%2dd ", int(($i+12)/24); }
696       else { printf $fh "%2dh ", $i; }
697     } else { printf $fh "%2dm ", $i; }
698
699     if ($self->{_output_flatq} && $self->{_show_vars}) {
700         print $fh join(';',
701                        map { "$_='".$self->get_var($_)."'" }
702                            (@{$self->{_show_vars}})
703                       );
704     } else {
705       printf $fh "%5s", $self->{_vars}{shown_message_size};
706     }
707     print $fh " ";
708   }
709   print $fh "$self->{_message} ";
710   print $fh "From: " if ($self->{_output_brief});
711   print $fh "<$self->{_vars}{sender_address}>";
712
713   if ($self->{_output_long}) {
714     print $fh " ($self->{_vars}{originator_login})"
715         if ($self->{_vars}{sender_set_untrusted});
716
717     # XXX exim contains code here to print spool format errors
718     print $fh " *** frozen ***" if ($self->{_vars}{deliver_freeze});
719     print $fh "\n";
720
721     foreach my $v (@{$self->{_show_vars}}) {
722       printf $fh "  %25s = '%s'\n", $v, $self->get_var($v);
723     }
724
725     foreach my $r (keys %{$self->{_recips}}) {
726       next if ($self->{_del_tree}{$r} && $self->{_undelivered_only});
727       printf $fh "        %s %s\n", $self->{_del_tree}{$r} ? "D" : " ", $r;
728     }
729     if ($self->{_show_generated}) {
730       foreach my $r (keys %{$self->{_del_tree}}) {
731         next if ($self->{_recips}{$r});
732         printf $fh "       +D %s\n", $r;
733       }
734     }
735   } elsif ($self->{_output_brief}) {
736     my @r = ();
737     foreach my $r (keys %{$self->{_recips}}) {
738       next if ($self->{_del_tree}{$r});
739       push(@r, $r);
740     }
741     print $fh " To: ", join(';', @r);
742     if ($self->{_show_vars} && scalar(@{$self->{_show_vars}})) {
743       print $fh " Vars: ", join(';',
744                                 map { "$_='".$self->get_var($_)."'" }
745                                     (@{$self->{_show_vars}})
746                                );
747     }
748   } elsif ($self->{_output_flatq}) {
749     print $fh " *** frozen ***" if ($self->{_vars}{deliver_freeze});
750     my @r = ();
751     foreach my $r (keys %{$self->{_recips}}) {
752       next if ($self->{_del_tree}{$r});
753       push(@r, $r);
754     }
755     print $fh " ", join(' ', @r);
756   }
757
758   print $fh "\n";
759 }
760
761 sub dump {
762   my $self = shift;
763
764   foreach my $k (sort keys %$self) {
765     my $r = ref($self->{$k});
766     if ($r eq 'ARRAY') {
767       printf "%20s <<EOM\n", $k;
768       print @{$self->{$k}}, "EOM\n";
769     } elsif ($r eq 'HASH') {
770       printf "%20s <<EOM\n", $k;
771       foreach (sort keys %{$self->{$k}}) {
772         printf "%20s %s\n", $_, $self->{$k}{$_};
773       }
774       print "EOM\n";
775     } else {
776       printf "%20s %s\n", $k, $self->{$k};
777     }
778   }
779 }
780
781 } # BEGIN
782
783 sub ext_usage {
784   if ($ARGV[0] =~ /^--help$/i) {
785     require Config;
786     $ENV{PATH} .= ":" unless $ENV{PATH} eq "";
787     $ENV{PATH} = "$ENV{PATH}$Config::Config{'installscript'}";
788     #exec("perldoc", "-F", "-U", $0) || exit 1;
789     $< = $> = 1 if ($> == 0 || $< == 0);
790     exec("perldoc", $0) || exit 1;
791     # make parser happy
792     %Config::Config = ();
793   } elsif ($ARGV[0] =~ /^--version$/i) {
794     print "$p_name version $p_version\n\n$p_cp\n";
795   } else {
796     return;
797   }
798
799   exit(0);
800 }
801
802 __END__
803
804 =head1 NAME
805
806 exipick - display messages from Exim queue based on a variety of criteria
807
808 =head1 USAGE
809
810 exipick [--help|--version] | [-spool <spool>] [-and|-or] [-bp|-bpa|-bpc|-bpr|-bpra|-bpru|-bpu] [<criterion> [<criterion> ...]]
811
812 =head1 DESCRIPTION
813
814 exipick is designed to display the contents of a Exim mail spool based on user-specified criteria.  It is designed to mimic the output of 'exim -bp' (or any of the other -bp* options) and Exim's spec.txt should be used to learn more about the exact format of the output.  The criteria are formed by creating comparisons against characteristics of the messages, for instance $message_size, $sender_helo_name, or $message_headers.
815
816 =head1 OPTIONS
817
818 =over 4
819
820 =item --spool
821
822 The path to Exim's spool directory.  In general usage you should set the $spool variable in the script to your site's main spool directory (and if exipick was installed from the Exim distribution, this is done by default), but this option is useful for alternate installs, or installs on NFS servers, etc.
823
824 =item --and
825
826 A message will be displayed only if it matches all of the specified criteria.  This is the default.
827
828 =item --or
829
830 A message will be displayed if it matches any of the specified criteria.
831
832 =item --caseful
833
834 By default criteria using the '=' operator are caseless.  Specifying this option make them respect case.
835
836 =item --show-vars <variable>[,<variable>...]
837
838 Cause the value of each specified variable to be displayed for every message dispayed.  For instance, the command "exipick --show-vars '$sender_ident' 'sender_host_address eq 127.0.01'" will show the ident string for every message submitted via localhost.  How exactly the variable value is diplayed changes according to what output format you specify.
839
840 =item --show-rules
841
842 If specified the internal representation of each message criteria is shown.  This is primarily used for debugging purposes.
843
844 ==item --show-tests
845
846 If specified, for every message (regardless of matching criteria) the criteria's actual value is shown and the compiled internal eval is shown.  This is used primarily for debugging purposes.
847
848 =item --flatq
849
850 Change format of output so that every message is on a single line.  Useful for parsing with tools such as sed, awk, cut, etc.
851
852 =item The -bp* options all control how much information is displayed and in what manner.  They all match the functionality of the options of the same name in Exim.  Briefly:
853
854 =item -bp   display the matching messages in 'mailq' format.
855
856 =item -bpa    ... with generated addresses as well.
857
858 =item -bpc    ... just show a count of messages.
859
860 =item -bpr    ... do not sort.
861
862 =item -bpra   ... with generated addresses, unsorted.
863
864 =item -bpru   ... only undelivered addresses, unsorted.
865
866 =item -bpu    ... only undelivered addresses.
867
868 Please see Exim's spec.txt for details on the format and information displayed with each option.
869
870 =item The following options are included for compatibility with the 'exiqgrep' utility:
871
872 =item -f <regexp>  Same as '$sender_address = <regexp>'
873
874 =item -r <regexp>  Same as '$recipients = <regexp>'
875
876 =item -s <string>  Same as '$shown_message_size eq <string>'
877
878 =item -y <seconds> Same as '$message_age < <seconds>'
879
880 =item -o <seconds> Same as '$message_age > <seconds>'
881
882 =item -z           Same as '$deliver_freeze'
883
884 =item -x           Same as '!$deliver_freeze'
885
886 =item -c           Display count of matches only
887
888 =item -l           Display in long format (default)
889
890 =item -i           Display message IDs only
891
892 =item -b           Display brief format only
893
894 Please see the 'exiqgrep' documentation for more details on the behaviour and output format produced by these options
895
896 =item <criterion>
897
898 The criteria are used to determine whether or not a given message should be displayed.  The criteria are built using variables containing information about the individual messages (see VARIABLES section for list and descriptions of available variables).  Each criterion is evaluated for each message in the spool and if all (by default) criteria match or (if --or option is specified) any criterion matches, the message is displayed.  See VARIABLE TYPES for explanation of types of variables and the evaluations that can be performed on them and EXAMPLES section for complete examples.
899
900 The format of a criterion is explained in detail below, but a key point to make is that the variable being compared must always be on the left side of the comparison.
901
902 If no criteria are provided all messages in the queue are displayed (in this case the output of exipick should be identical to the output of 'exim -bp')
903
904 =item --help
905
906 This screen.
907
908 =item --version
909
910 Version info.
911
912 =back
913
914 =head1 VARIABLE TYPES
915
916 Although there are variable types defined, they are defined only by the type of data that gets put into them.  They are internally typeless.  Because of this it is perfectly legal to perform a numeric comparison against a string variable, although the results will probably be meaningless.
917
918 =over 4
919
920 =item NUMERIC
921
922 Variable of the numeric type can be of integer or float.  Valid comparisons are <, <=, >, >=, ==, and !=.
923
924 The numbers specified in the criteria can have a suffix of d, h, m, s, M, K, or B, in which case the number will be mulitplied by 86400, 3600, 60, 1, 1048576, 1024, or 1 respectively.  These suffixes are case sensitive.  While these are obviously designed to aid in date and size calculations, they are not restricted to variables of their respective types.  That is, though it's odd it's legal to create a criterion of a message being around for 3 kiloseconds: '$message_age >= 3K'.
925
926 =item BOOLEAN
927
928 Variables of the boolean type are very easy to use in criteria.  The format is either the variable by itself or the variable negated with a ! sign.  For instance, '$deliver_freeze' matches if the message in question is frozen, '!$deliver_freeze' matches if message is not frozen.
929
930 =item STRING
931
932 String variables are basically defined as those that are neither numeric nor boolean and can contain any data.  The string operators are =, eq, ne, =~, and !~.  With the exception of '=', the operators all match the functionality of the like-named perl operators.
933
934 The simplest form is a bare string regular expression, represented by the operator '='.  The value used for the comparison will be evaluated as a regular expression and can be as simple or as complex as desired.  For instance '$sender_helo_name = example' on the simple end or '$sender_helo_name = ^aol\.com$' on the more complex end.  This comparison is caseless by default, but see the --caseful option to change this.
935
936 Slightly more complex is the string comparison with the operators 'eq' and 'ne' for equal and not equal, respectively.  '$sender_helo_name eq hotmail.com' is true for messages with the exact helo string "hotmail.com", while '$sender_helo_name ne hotmail.com' is true for any message with a helo string other than "hotmail.com".
937
938 The most complex and the most flexible format are straight regular expressions with the operators '=~' and '!~'.  The value in the criteria is expected to be a correctly formatted perl regular expression B<including the regexp delimiters (usually //)>.  The criterion '$sender_helo_name !~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/' matches for any message which does not have an IP address for its helo string.
939
940 =back
941
942 =head1 VARIABLES
943
944 With a few exceptions the available variables match Exim's internal expansion variables in both name and exact contents.  There are a few notable additions and format deviations which are noted below.  Although a brief explanation is offered below, Exim's spec.txt should be consulted for full details.  It is important to remember that not every variable will be defined for every message.  For example, $sender_host_port is not defined for messages not received from a remote host.
945
946 In the list below, '.' denotes standard messages with contents matching Exim's variable, '#' denotes standard variables with non-standard contents, and '+' denotes a non-standard variable.
947
948 =head2 Boolean variables
949
950 =over 4
951
952 =item + $allow_unqualified_recipient
953
954 TRUE if unqualified recipient addresses are permitted in header lines.
955
956 =item + $allow_unqualified_sender
957
958 TRUE if unqualified sender addresses are permitted in header lines.
959
960 =item + $deliver_freeze
961
962 TRUE if the message is currently frozen.
963
964 =item . $first_delivery
965
966 TRUE if the message has never been deferred.
967
968 =item . $manually_thawed
969
970 TRUE when the message has been manually thawed.
971
972 =item + $dont_deliver
973
974 TRUE if, under normal circumstances, Exim will not try to deliver the message.
975
976 =item . $host_lookup_deferred
977
978 TRUE if there was an attempt to look up the host's name from its IP address, but an error occurred that during the attempt.
979
980 =item . $host_lookup_failed
981
982 TRUE if there was an attempt to look up the host's name from its IP address, but the attempt returned a negative result.
983
984 =item + $local_error_message
985
986 TRUE if the message is a locally-generated error message.
987
988 =item + $sender_local
989
990 TRUE if the message was locally generated.
991
992 =item + $sender_set_untrusted
993
994 TRUE if the envelope sender of this message was set by an untrusted local caller.
995
996 =item . $tls_certificate_verified
997
998 TRUE if a TLS certificate was verified when the message was received.
999
1000 =back
1001
1002 =head2 Numeric variables
1003
1004 =over 4
1005
1006 =item . $body_linecount
1007
1008 The number of lines in the message's body.
1009
1010 =item . $body_zerocount
1011
1012 The number of binary zero bytes in the message's body.
1013
1014 =item + $deliver_frozen_at
1015
1016 The epoch time at which message was frozen.
1017
1018 =item . $interface_port
1019
1020 The local port number if network-originated messages.
1021
1022 =item . $message_age
1023
1024 The number of seconds since the message was received.
1025
1026 =item . $message_body_size
1027
1028 The size of the body in bytes.
1029
1030 =item . $message_linecount
1031
1032 The number of lines in the entire message (body and headers).
1033
1034 =item . $message_size
1035
1036 The size of the message in bytes.
1037
1038 =item . $originator_gid
1039
1040 The group id under which the process that called Exim was running as when the message was received.
1041
1042 =item . $originator_uid
1043
1044 The user id under which the process that called Exim was running as when the message was received.
1045
1046 =item . $received_count
1047
1048 The number of Received: header lines in the message.
1049
1050 =item . $received_time
1051
1052 The epoch time at which the message was received.
1053
1054 =item . $recipients_count
1055
1056 The number of envelope recipients for the message.
1057
1058 =item + $recipients_del_count
1059
1060 The number of envelope recipients for the message which have already been delivered.  Note that this is the count of original recipients to which the message has been delivered.  It does not include generated addresses so it is possible that this number will be less than the number of addresses in the recipients_del string.
1061
1062 =item + $recipients_undel_count
1063
1064 The number of envelope recipients for the message which have not yet been delivered.
1065
1066 =item . $sender_host_port
1067
1068 The port number that was used on the remote host for network-originated messages.
1069
1070 =item + $warning_count
1071
1072 The number of delay warnings which have been sent for this message.
1073
1074 =back
1075
1076 =head2 String variables
1077
1078 =over 4
1079
1080 =item . $acl_c0-$acl_c9, $acl_m0-$acl_m9
1081
1082 User definable variables.
1083
1084 =item . $authenticated_id
1085
1086 Optional saved information from authenticators, or the login name of the calling process for locally submitted messages.
1087
1088 =item . $authenticated_sender
1089
1090 The value of AUTH= param for smtp messages, or a generated value from the calling processes login and qualify domain for locally submitted messages.
1091
1092 =item + $bmi_verdicts
1093
1094 I honestly don't know what the format of this variable is.  It only exists if you have Exim compiled with WITH_CONTENT_SCAN and EXPERIMENTAL_BRIGHTMAIL (and, you know, pay Symantec/Brightmail a bunch of money for the client libs and a server to use them with).
1095
1096 =item + $each_recipients
1097
1098 This is a psuedo variable which allows you to apply a criterion against each address in $recipients individually.  This allows you to create criteria against which every individual recipient is tested.  For instance, '$recipients =~ /aol.com/' will match if any of the recipient addresses contain the string "aol.com".  However, with the criterion '$each_recipients =~ /@aol.com$/', a message will only match if B<every> recipient matches that pattern.  Note that this obeys --and or --or being set.  Using it with --or is very similar to just matching against $recipients, but with the added benefit of being able to use anchors at the beginning and end of each recipient address.
1099
1100 =item + $each_recipients_del
1101
1102 Like $each_recipients, but for the $recipients_del variable.
1103
1104 =item + $each_recipients_undel
1105
1106 Like $each_recipients, but for the $recipients_undel variable.
1107
1108 =item # $header_*
1109
1110 The value of the same named message header, for example header_to or header_reply-to.  These variables are really closer to Exim's rheader_* variables, with the exception that leading and trailing space is removed.
1111
1112 =item . $interface_address
1113
1114 The address of the local IP interface for network-originated messages.
1115
1116 =item . $local_scan_data
1117
1118 The text returned by the local_scan() function when a message is received.
1119
1120 =item # $message_body
1121
1122 The message's body.  Unlike Exim's variable of the same name, this variable contains the entire message body.  The logic behind this is that the message body is not read unless it is specifically referenced, so under normal circumstances it is not a penalty, but when you need the entire body you need the entire body.  Like Exim's copy, newlines and nulls are replaced by spaces.
1123
1124 =item . $message_headers
1125
1126 A concatenation of all the header lines except for lines added by routers or transports.
1127
1128 =item . $message_exim_id, $message_id
1129
1130 The unique message id that is used by Exim to identify the message.  $message_id is deprecated as of Exim 4.53.
1131
1132 =item + $originator_login
1133
1134 The login of the process which called Exim.
1135
1136 =item . $received_protocol
1137
1138 The name of the protocol by which the message was received.
1139
1140 =item # $recipients
1141
1142 The list of envelope recipients for a message.  Unlike Exim's version, this variable always contains every envelope recipient of the message.  The recipients are separated by a comma and a space.
1143
1144 =item + $recipients_del
1145
1146 The list of delivered envelope recipients for a message.  This non-standard variable is in the same format as recipients and contains the list of already-delivered recipients including any generated addresses.
1147
1148 =item + $recipients_undel
1149
1150 The list of undelivered envelope recipients for a message.  This non-standard variable is in the same format as recipients and contains the list of undelivered recipients.
1151
1152 =item . $reply_address
1153
1154 The contents of the Reply-To: header line if one exists and it is not empty, or otherwise the contents of the From: header line.
1155
1156 =item . $sender_address
1157
1158 The sender's address that was received in the message's envelope.  For bounce messages, the value of this variable is the empty string.
1159
1160 =item . $sender_address_domain
1161
1162 The domain part of $sender_address.
1163
1164 =item . $sender_address_local_part
1165
1166 The local part of $sender_address.
1167
1168 =item . $sender_helo_name
1169
1170 The HELO or EHLO value supplied for smtp or bsmtp messages.
1171
1172 =item . $sender_host_address
1173
1174 The remote host's IP address.
1175
1176 =item . $sender_host_authenticated
1177
1178 The name of the authenticator driver which successfully authenticated the client from which the message was received.
1179
1180 =item . $sender_host_name
1181
1182 The remote host's name as obtained by looking up its IP address.
1183
1184 =item . $sender_ident
1185
1186 The identification received in response to an RFC 1413 request for remote messages, the login name of the user that called Exim for locally generated messages.
1187
1188 =item + $shown_message_size
1189
1190 This non-standard variable contains the formatted size string.  That is, for a message whose $message_size is 66566 bytes, $shown_message_size is 65K.
1191
1192 =item . $smtp_active_hostname
1193
1194 The value of the active host name when the message was received, as specified by the "smtp_active_hostname" option.
1195
1196 =item . $spam_score
1197
1198 The spam score of the message, for example '3.4' or '30.5'.  (Requires exiscan or WITH_CONTENT_SCAN)
1199
1200 =item . $spam_score_int
1201
1202 The spam score of the message, multiplied by ten, as an integer value.  For instance '34' or '305'.  (Requires exiscan or WITH_CONTENT_SCAN)
1203
1204 =item . $tls_cipher
1205
1206 The cipher suite that was negotiated for encrypted SMTP connections.
1207
1208 =item . $tls_peerdn
1209
1210 The value of the Distinguished Name of the certificate if Exim is configured to request one.
1211
1212 =back
1213
1214 =head1 EXAMPLES
1215
1216 =over 4
1217
1218 =item exipick '$deliver_freeze'
1219
1220 Display only frozen messages.
1221
1222 =item exipick '$received_protocol eq asmtp' '$message_age < 20m'
1223
1224 Display only messages which were delivered over an authenticated smtp session in the last 20 minutes.
1225
1226 =item exipick -bpc '$message_size > 200K'
1227
1228 Display a count of messages in the queue which are over 200 kilobytes in size.
1229
1230 =item exipick -or '$sender_helo_name =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/' '$sender_helo_name = _'
1231
1232 Display message which have a HELO string which either is an IP address or contains an underscore.
1233
1234 =back
1235
1236 =head1 REQUIREMENTS
1237
1238 None that I know of, except an Exim installation.  Your life will also be a lot easier if you set $spool at the top of the script to your install's spool directory (assuming this was not done automatically by the Exim install process).
1239
1240 =head1 ACKNOWLEDGEMENTS
1241
1242 Although I conceived of the concept for this program independently, the name 'exipick' was taken from the Exim WishList and was suggested by Jeffrey Goldberg.
1243
1244 Thank you to Philip Hazel for writing Exim.  Of course this program exists because of Exim, but more specifically the message parsing code is based on Exim's and some of this documentation was copy/pasted from Exim's.
1245
1246 =head1 CONTACT
1247
1248 =over 4
1249
1250 =item EMAIL: proj-exipick@jetmore.net
1251
1252 =item HOME: jetmore.org/john/code/#exipick
1253
1254 =back
1255
1256 =cut