Allow port setting on lists of hosts in manualroute, queryprogram,
[exim.git] / src / src / exipick.src
1 #!PERL_COMMAND
2 # $Cambridge: exim/src/src/exipick.src,v 1.7 2005/08/03 15:21:28 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 = "20050802.0";
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         = {};
75 $G::caseless        = $G::caseful ? 0 : 1; # nocase by default, case if both
76 @G::recipients_crit = ();
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);
84 my $mcount          = 0 if ($count_only);
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   next(MSG) if (scalar(@$crit, @local_crit) > 0 && !$match);
133
134   if ($count_only) {
135     $mcount++;
136   } else {
137     $e->print_message(\*STDOUT);
138   }
139 }
140
141 if ($G::mailq_bpc) {
142   print "$tcount\n";
143 } elsif ($G::qgrep_c) {
144   print "$mcount matches out of $tcount messages\n";
145 }
146
147 exit;
148
149 sub process_criteria {
150   my $a = shift;
151   my @c = ();
152   my $e = 0;
153
154   foreach (@$a) {
155     foreach my $t ('@') { s/$t/\\$t/g; } # '$'
156     if (/^(.*?)\s+(<=|>=|==|!=|<|>)\s+(.*)$/) {
157       #print STDERR "found as integer\n";
158       my $v = $1; my $o = $2; my $n = $3;
159       if    ($n =~ /^([\d\.]+)M$/)  { $n = $1 * 1024 * 1024; }
160       elsif ($n =~ /^([\d\.]+)K$/)  { $n = $1 * 1024; }
161       elsif ($n =~ /^([\d\.]+)B?$/) { $n = $1; }
162       elsif ($n =~ /^([\d\.]+)d$/)  { $n = $1 * 60 * 60 * 24; }
163       elsif ($n =~ /^([\d\.]+)h$/)  { $n = $1 * 60 * 60; }
164       elsif ($n =~ /^([\d\.]+)m$/)  { $n = $1 * 60; }
165       elsif ($n =~ /^([\d\.]+)s?$/) { $n = $1; }
166       else {
167         print STDERR "Expression $_ did not parse: numeric comparison with ",
168                      "non-number\n";
169         $e = 1;
170         next;
171       }
172       push(@c, { var => lc($v), cmp => "(\$var $o $n) ? 1 : 0" });
173     } elsif (/^(.*?)\s+(=~|!~)\s+(.*)$/) {
174       #print STDERR "found as string regexp\n";
175       push(@c, { var => lc($1), cmp => "(\"\$var\" $2 $3) ? 1 : 0" });
176     } elsif (/^(.*?)\s+=\s+(.*)$/) {
177       #print STDERR "found as bare string regexp\n";
178       my $case = $G::caseful ? '' : 'i';
179       push(@c, { var => lc($1), cmp => "(\"\$var\" =~ /$2/$case) ? 1 : 0" });
180     } elsif (/^(.*?)\s+(eq|ne)\s+(.*)$/) {
181       #print STDERR "found as string cmp\n";
182       my $var = lc($1); my $op = $2; my $val = $3;
183       $val =~ s|^(['"])(.*)\1$|$2|;
184       push(@c, { var => $var, cmp => "(\"\$var\" $op \"$val\") ? 1 : 0" });
185       if (($var eq 'message_id' || $var eq 'message_exim_id') && $op eq "eq") {
186         #print STDERR "short circuit @c[-1]->{cmp} $val\n";
187         $G::msg_ids->{$val} = 1;
188       }
189     } elsif (/^(!)?(\S+)$/) {
190       #print STDERR "found as boolean\n";
191       push(@c, { var => lc($2), cmp => "($1\$var) ? 1 : 0" });
192     } else {
193       print STDERR "Expression $_ did not parse\n";
194       $e = 1;
195     }
196     # support the each_* psuedo variables.  Steal the criteria off of the
197     # queue for special processing later
198     if ($c[-1]{var} =~ /^each_(recipients(_(un)?del)?)$/) {
199       my $var = $1;
200       push(@G::recipients_crit,pop(@c));
201       $G::recipients_crit[-1]{var} = $var; # remove each_ from the variable
202     }
203   }
204
205   exit(1) if ($e);
206
207   if ($G::show_rules) { foreach (@c) { print "$_->{var}\t$_->{cmp}\n"; } }
208
209   return(\@c);
210 }
211
212 sub get_all_msgs {
213   my $d = shift() . '/input';
214   my $u = shift;
215   my @m = ();
216
217   opendir(D, "$d") || die "Couldn't opendir $d: $!\n";
218   foreach my $e (grep !/^\./, readdir(D)) {
219     if ($e =~ /^[a-zA-Z0-9]$/) {
220       opendir(DD, "$d/$e") || next;
221       foreach my $f (grep !/^\./, readdir(DD)) {
222         push(@m, { message => $1, path => "$e/$1" }) if ($f =~ /^(.{16})-H$/);
223       }
224       closedir(DD);
225     } elsif ($e =~ /^(.{16})-H$/) {
226       push(@m, { message => $1, path => $1 });
227     }
228   }
229   closedir(D);
230
231   return($u ? \@m : [ sort { $a->{message} cmp $b->{message} } @m ]);
232 }
233
234 BEGIN {
235
236 package Exim::SpoolFile;
237
238 $Exim::SpoolFile::ACL_C_MAX = 10;
239 #$Exim::SpoolFile::ACL_M_MAX = 10;
240
241 sub new {
242   my $class = shift;
243   my $self  = {};
244   bless($self, $class);
245
246   $self->{_spool_dir}        = '';
247   $self->{_undelivered_only} = 0;
248   $self->{_show_generated}   = 0;
249   $self->{_output_long}      = 1;
250   $self->{_output_idonly}    = 0;
251   $self->{_output_brief}     = 0;
252   $self->{_output_flatq}     = 0;
253   $self->{_show_vars}        = [];
254
255   $self->_reset();
256   return($self);
257 }
258
259 sub output_long {
260   my $self = shift;
261
262   $self->{_output_long}      = 1;
263   $self->{_output_idonly}    = 0;
264   $self->{_output_brief}     = 0;
265   $self->{_output_flatq}     = 0;
266 }
267
268 sub output_idonly {
269   my $self = shift;
270
271   $self->{_output_long}      = 0;
272   $self->{_output_idonly}    = 1;
273   $self->{_output_brief}     = 0;
274   $self->{_output_flatq}     = 0;
275 }
276
277 sub output_brief {
278   my $self = shift;
279
280   $self->{_output_long}      = 0;
281   $self->{_output_idonly}    = 0;
282   $self->{_output_brief}     = 1;
283   $self->{_output_flatq}     = 0;
284 }
285
286 sub output_flatq {
287   my $self = shift;
288
289   $self->{_output_long}      = 0;
290   $self->{_output_idonly}    = 0;
291   $self->{_output_brief}     = 0;
292   $self->{_output_flatq}     = 1;
293 }
294
295 sub set_show_vars {
296   my $self = shift;
297   my $s    = shift;
298
299   foreach my $v (split(/\s*,\s*/, $s)) {
300     push(@{$self->{_show_vars}}, $v);
301   }
302 }
303
304 sub set_show_generated {
305   my $self = shift;
306   $self->{_show_generated} = shift;
307 }
308
309 sub set_undelivered_only {
310   my $self = shift;
311   $self->{_undelivered_only} = shift;
312 }
313
314 sub error {
315   my $self = shift;
316   return $self->{_error};
317 }
318
319 sub _error {
320   my $self = shift;
321   $self->{_error} = shift;
322   return(undef);
323 }
324
325 sub _reset {
326   my $self = shift;
327
328   $self->{_error}       = '';
329   $self->{_delivered}   = 0;
330   $self->{_message}     = '';
331   $self->{_path}        = '';
332   $self->{_vars}        = {};
333
334   $self->{_numrecips}   = 0;
335   $self->{_udel_tree}   = {};
336   $self->{_del_tree}    = {};
337   $self->{_recips}      = {};
338
339   return($self);
340 }
341
342 sub parse_message {
343   my $self = shift;
344
345   $self->_reset();
346   $self->{_message} = shift || return(0);
347   return(0) if (!$self->{_spool_dir});
348   if (!$self->_find_path()) {
349     # assume the message was delivered from under us and ignore
350     $self->{_delivered} = 1;
351     return(1);
352   }
353   $self->_parse_header() || return(0);
354
355   return(1);
356 }
357
358 sub _find_path {
359   my $self = shift;
360
361   return(0) if (!$self->{_message});
362   return(0) if (!$self->{_spool_dir});
363
364   foreach my $f ('', substr($self->{_message}, 5, 1).'/') {
365     if (-f $self->{_spool_dir} . "/input/$f" . $self->{_message} . '-H') {
366       $self->{_path} = $self->{_spool_dir} . "/input/$f";
367       return(1);
368     }
369   }
370   return(0);
371 }
372
373 sub set_spool {
374   my $self = shift;
375   $self->{_spool_dir} = shift;
376 }
377
378 # accepts a variable with or without leading '$' or trailing ':'
379 sub get_var {
380   my $self = shift;
381   my $var  = shift;
382
383   $var =~ s/^\$//;
384   $var =~ s/:$//;
385
386   $self->_parse_body()
387       if ($var eq 'message_body' && !$self->{_vars}{message_body});
388
389   return $self->{_vars}{$var};
390 }
391
392 sub _parse_body {
393   my $self = shift;
394   my $f    = $self->{_path} . '/' . $self->{_message} . '-D';
395
396   open(I, "<$f") || return($self->_error("Couldn't open $f: $!"));
397   chomp($_ = <I>);
398   return(0) if ($self->{_message}.'-D' ne $_);
399
400   $self->{_vars}{message_body} = join('', <I>);
401   close(I);
402   $self->{_vars}{message_body} =~ s/\n/ /g;
403   $self->{_vars}{message_body} =~ s/\000/ /g;
404   return(1);
405 }
406
407 sub _parse_header {
408   my $self = shift;
409   my $f    = $self->{_path} . '/' . $self->{_message} . '-H';
410
411   open(I, "<$f") || return($self->_error("Couldn't open $f: $!"));
412   chomp($_ = <I>);
413   return(0) if ($self->{_message}.'-H' ne $_);
414   $self->{_vars}{message_id}       = $self->{_message};
415   $self->{_vars}{message_exim_id}  = $self->{_message};
416
417   # line 2
418   chomp($_ = <I>);
419   return(0) if (!/^(.+)\s(\-?\d+)\s(\-?\d+)$/);
420   $self->{_vars}{originator_login} = $1;
421   $self->{_vars}{originator_uid}   = $2;
422   $self->{_vars}{originator_gid}   = $3;
423
424   # line 3
425   chomp($_ = <I>);
426   return(0) if (!/^<(.*)>$/);
427   $self->{_vars}{sender_address}   = $1;
428   $self->{_vars}{sender_address_domain} = $1;
429   $self->{_vars}{sender_address_local_part} = $1;
430   $self->{_vars}{sender_address_domain} =~ s/^.*\@//;
431   $self->{_vars}{sender_address_local_part} =~ s/^(.*)\@.*$/$1/;
432
433   # line 4
434   chomp($_ = <I>);
435   return(0) if (!/^(\d+)\s(\d+)$/);
436   $self->{_vars}{received_time}    = $1;
437   $self->{_vars}{warning_count}    = $2;
438   $self->{_vars}{message_age}      = time() - $self->{_vars}{received_time};
439
440   while (<I>) {
441     chomp();
442     if (/^(-\S+)\s*(.*$)/) {
443       my $tag = $1;
444       my $arg = $2;
445       if ($tag eq '-acl') {
446         my $t;
447         return(0) if ($arg !~ /^(\d+)\s(\d+)$/);
448         if ($1 < $Exim::SpoolFile::ACL_C_MAX) {
449           $t = "acl_c$1";
450         } else {
451           $t = "acl_m" . ($1 - $Exim::SpoolFile::ACL_C_MAX);
452         }
453         read(I, $self->{_vars}{$t}, $2+1) || return(0);
454         chomp($self->{_vars}{$t});
455       } elsif ($tag eq '-local') {
456         $self->{_vars}{sender_local} = 1;
457       } elsif ($tag eq '-localerror') {
458         $self->{_vars}{local_error_message} = 1;
459       } elsif ($tag eq '-local_scan') {
460         $self->{_vars}{local_scan_data} = $arg;
461       } elsif ($tag eq '-spam_score_int') {
462         $self->{_vars}{spam_score_int} = $arg;
463         $self->{_vars}{spam_score}     = $arg / 10;
464       } elsif ($tag eq '-bmi_verdicts') {
465         $self->{_vars}{bmi_verdicts} = $arg;
466       } elsif ($tag eq '-host_lookup_deferred') {
467         $self->{_vars}{host_lookup_deferred} = 1;
468       } elsif ($tag eq '-host_lookup_failed') {
469         $self->{_vars}{host_lookup_failed} = 1;
470       } elsif ($tag eq '-body_linecount') {
471         $self->{_vars}{body_linecount} = $arg;
472       } elsif ($tag eq '-body_zerocount') {
473         $self->{_vars}{body_zerocount} = $arg;
474       } elsif ($tag eq '-frozen') {
475         $self->{_vars}{deliver_freeze} = 1;
476         $self->{_vars}{deliver_frozen_at} = $arg;
477       } elsif ($tag eq '-allow_unqualified_recipient') {
478         $self->{_vars}{allow_unqualified_recipient} = 1;
479       } elsif ($tag eq '-allow_unqualified_sender') {
480         $self->{_vars}{allow_unqualified_sender} = 1;
481       } elsif ($tag eq '-deliver_firsttime') {
482         $self->{_vars}{deliver_firsttime} = 1;
483         $self->{_vars}{first_delivery} = 1;
484       } elsif ($tag eq '-manual_thaw') {
485         $self->{_vars}{deliver_manual_thaw} = 1;
486         $self->{_vars}{manually_thawed} = 1;
487       } elsif ($tag eq '-auth_id') {
488         $self->{_vars}{authenticated_id} = $arg;
489       } elsif ($tag eq '-auth_sender') {
490         $self->{_vars}{authenticated_sender} = $arg;
491       } elsif ($tag eq '-sender_set_untrusted') {
492         $self->{_vars}{sender_set_untrusted} = 1;
493       } elsif ($tag eq '-tls_certificate_verified') {
494         $self->{_vars}{tls_certificate_verified} = 1;
495       } elsif ($tag eq '-tls_cipher') {
496         $self->{_vars}{tls_cipher} = $arg;
497       } elsif ($tag eq '-tls_peerdn') {
498         $self->{_vars}{tls_peerdn} = $arg;
499       } elsif ($tag eq '-host_address') {
500         $self->{_vars}{sender_host_port} = $self->_get_host_and_port(\$arg);
501         $self->{_vars}{sender_host_address} = $arg;
502       } elsif ($tag eq '-interface_address') {
503         $self->{_vars}{interface_port} = $self->_get_host_and_port(\$arg);
504         $self->{_vars}{interface_address} = $arg;
505       } elsif ($tag eq '-active_hostname') {
506         $self->{_vars}{smtp_active_hostname} = $arg;
507       } elsif ($tag eq '-host_auth') {
508         $self->{_vars}{sender_host_authenticated} = $arg;
509       } elsif ($tag eq '-host_name') {
510         $self->{_vars}{sender_host_name} = $arg;
511       } elsif ($tag eq '-helo_name') {
512         $self->{_vars}{sender_helo_name} = $arg;
513       } elsif ($tag eq '-ident') {
514         $self->{_vars}{sender_ident} = $arg;
515       } elsif ($tag eq '-received_protocol') {
516         $self->{_vars}{received_protocol} = $arg;
517       } elsif ($tag eq '-N') {
518         $self->{_vars}{dont_deliver} = 1;
519       } else {
520         # unrecognized tag, save it for reference
521         $self->{$tag} = $arg;
522       }
523     } else {
524       last;
525     }
526   }
527
528   # when we drop out of the while loop, we have the first line of the
529   # delivered tree in $_
530   do {
531     if ($_ eq 'XX') {
532       ; # noop
533     } elsif ($_ =~ s/^[YN][YN]\s+//) {
534       $self->{_del_tree}{$_} = 1;
535     } else {
536       return(0);
537     }
538     chomp($_ = <I>);
539   } while ($_ !~ /^\d+$/);
540
541   $self->{_numrecips} = $_;
542   $self->{_vars}{recipients_count} = $self->{_numrecips};
543   for (my $i = 0; $i < $self->{_numrecips}; $i++) {
544     chomp($_ = <I>);
545     return(0) if (/^$/);
546     my $addr = '';
547     if (/^(.*)\s\d+,(\d+),\d+$/) {
548       #print STDERR "exim3 type (untested): $_\n";
549       $self->{_recips}{$1} = { pno => $2 };
550       $addr = $1;
551     } elsif (/^(.*)\s(\d+)$/) {
552       #print STDERR "exim4 original type (untested): $_\n";
553       $self->{_recips}{$1} = { pno => $2 };
554       $addr = $1;
555     } elsif (/^(.*)\s(.*)\s(\d+),(\d+)#1$/) {
556       #print STDERR "exim4 new type #1 (untested): $_\n";
557       return($self->_error("incorrect format: $_")) if (length($2) != $3);
558       $self->{_recips}{$1} = { pno => $4, errors_to => $2 };
559       $addr = $1;
560     } elsif (/^.*#(\d+)$/) {
561       #print STDERR "exim4 #$1 style (unimplemented): $_\n";
562       $self->_error("exim4 #$1 style (unimplemented): $_");
563     } else {
564       #print STDERR "default type: $_\n";
565       $self->{_recips}{$_} = {};
566       $addr = $_;
567     }
568     $self->{_udel_tree}{$addr} = 1 if (!$self->{_del_tree}{$addr});
569   }
570   $self->{_vars}{recipients}         = join(', ', keys(%{$self->{_recips}}));
571   $self->{_vars}{recipients_del}     = join(', ', keys(%{$self->{_del_tree}}));
572   $self->{_vars}{recipients_undel}   = join(', ', keys(%{$self->{_udel_tree}}));
573   $self->{_vars}{recipients_undel_count} = scalar(keys(%{$self->{_udel_tree}}));
574   $self->{_vars}{recipients_del_count}   = 0;
575   foreach my $r (keys %{$self->{_del_tree}}) {
576     next if (!$self->{_recips}{$r});
577     $self->{_vars}{recipients_del_count}++;
578   }
579
580   # blank line
581   $_ = <I>;
582   return(0) if (!/^$/);
583
584   # start reading headers
585   while (read(I, $_, 3) == 3) {
586     my $t = getc(I);
587     return(0) if (!length($t));
588     while ($t =~ /^\d$/) {
589       $_ .= $t;
590       $t  = getc(I);
591     }
592     # ok, right here $t contains the header flag and $_ contains the number of
593     # bytes to read.  If we ever use the header flag, grab it here.
594     $self->{_vars}{message_size} += $_ if ($t ne '*');
595     $t = getc(I); # strip the space out of the file
596     my $bytes = $_;
597     return(0) if (read(I, $_, $bytes) != $bytes);
598     chomp(); # may regret this later
599     $self->{_vars}{message_linecount} += scalar(split(/\n/)) if ($t ne '*');
600     # build the $header_ variable, following exim's rules (sort of)
601     if (/^([^ :]+):(.*)$/s) {
602       my $v = "header_" . lc($1);
603       my $d = $2;
604       $d =~ s/^\s*//;
605       $d =~ s/\s*$//;
606       $self->{_vars}{$v} .= (defined($self->{_vars}{$v}) ? "\n" : '') . $d;
607       $self->{_vars}{received_count}++ if ($v eq 'header_received');
608     }
609     # push header onto $message_headers var, following exim's rules
610     $self->{_vars}{message_headers} .=
611         (defined($self->{_vars}{message_headers}) ? "\n" : '') . $_;
612   }
613   close(I);
614
615   if (length($self->{_vars}{"header_reply-to"}) > 0) {
616     $self->{_vars}{reply_address} = $self->{_vars}{"header_reply-to"};
617   } else {
618     $self->{_vars}{reply_address} = $self->{_vars}{header_from};
619   }
620
621   $self->{_vars}{message_body_size} =
622       (stat($self->{_path}.'/'.$self->{_message}.'-D'))[7] - 19;
623   if ($self->{_vars}{message_body_size} < 0) {
624     $self->{_vars}{message_size} = 0;
625   } else {
626     $self->{_vars}{message_size} += $self->{_vars}{message_body_size} + 1;
627   }
628
629   $self->{_vars}{message_linecount} += $self->{_vars}{body_linecount};
630
631   my $i = $self->{_vars}{message_size};
632   if ($i == 0)              { $i = ""; }
633   elsif ($i < 1024)         { $i = sprintf("%d", $i); }
634   elsif ($i < 10*1024)      { $i = sprintf("%.1fK", $i / 1024); }
635   elsif ($i < 1024*1024)    { $i = sprintf("%dK", ($i+512)/1024); }
636   elsif ($i < 10*1024*1024) { $i = sprintf("%.1fM", $i/(1024*1024)); }
637   else { $i = sprintf("%dM", ($i + 512 * 1024)/(1024*1024)); }
638   $self->{_vars}{shown_message_size} = $i;
639
640   return(1);
641 }
642
643 # mimic exim's host_extract_port function - receive a ref to a scalar,
644 # strip it of port, return port
645 sub _get_host_and_port {
646   my $self = shift;
647   my $host = shift; # scalar ref, be careful
648
649   if ($$host =~ /^\[([^\]]+)\](?:\:(\d+))?$/) {
650     $$host = $1;
651     return($2 || 0);
652   } elsif ($$host =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})(?:\.(\d+))?$/) {
653     $$host = $1;
654     return($2 || 0);
655   } elsif ($$host =~ /^([\d\:]+)(?:\.(\d+))?$/) {
656     $$host = $1;
657     return($2 || 0);
658   }
659   # implicit else
660   return(0);
661 }
662
663 sub print_message {
664   my $self = shift;
665   my $fh   = shift || \*STDOUT;
666   return if ($self->{_delivered});
667
668   if ($self->{_output_idonly}) {
669     print $fh $self->{_message};
670     foreach my $v (@{$self->{_show_vars}}) {
671       print $fh " $v='", $self->get_var($v), "'";
672     }
673     print $fh "\n";
674     return;
675   }
676
677   if ($self->{_output_long} || $self->{_output_flatq}) {
678     my $i = int($self->{_vars}{message_age} / 60);
679     if ($i > 90) {
680       $i = int(($i+30)/60);
681       if ($i > 72) { printf $fh "%2dd ", int(($i+12)/24); }
682       else { printf $fh "%2dh ", $i; }
683     } else { printf $fh "%2dm ", $i; }
684
685     if ($self->{_output_flatq} && $self->{_show_vars}) {
686         print $fh join(';',
687                        map { "$_='".$self->get_var($_)."'" }
688                            (@{$self->{_show_vars}})
689                       );
690     } else {
691       printf $fh "%5s", $self->{_vars}{shown_message_size};
692     }
693     print $fh " ";
694   }
695   print $fh "$self->{_message} ";
696   print $fh "From: " if ($self->{_output_brief});
697   print $fh "<$self->{_vars}{sender_address}>";
698
699   if ($self->{_output_long}) {
700     print $fh " ($self->{_vars}{originator_login})"
701         if ($self->{_vars}{sender_set_untrusted});
702
703     # XXX exim contains code here to print spool format errors
704     print $fh " *** frozen ***" if ($self->{_vars}{deliver_freeze});
705     print $fh "\n";
706
707     foreach my $v (@{$self->{_show_vars}}) {
708       printf $fh "  %25s = '%s'\n", $v, $self->get_var($v);
709     }
710
711     foreach my $r (keys %{$self->{_recips}}) {
712       next if ($self->{_del_tree}{$r} && $self->{_undelivered_only});
713       printf $fh "        %s %s\n", $self->{_del_tree}{$r} ? "D" : " ", $r;
714     }
715     if ($self->{_show_generated}) {
716       foreach my $r (keys %{$self->{_del_tree}}) {
717         next if ($self->{_recips}{$r});
718         printf $fh "       +D %s\n", $r;
719       }
720     }
721   } elsif ($self->{_output_brief}) {
722     my @r = ();
723     foreach my $r (keys %{$self->{_recips}}) {
724       next if ($self->{_del_tree}{$r});
725       push(@r, $r);
726     }
727     print $fh " To: ", join(';', @r);
728     if ($self->{_show_vars}) {
729       print $fh " Vars: ", join(';',
730                                 map { "$_='".$self->get_var($_)."'" }
731                                     (@{$self->{_show_vars}})
732                                );
733     }
734   } elsif ($self->{_output_flatq}) {
735     print $fh " *** frozen ***" if ($self->{_vars}{deliver_freeze});
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 " ", join(' ', @r);
742   }
743
744   print $fh "\n";
745 }
746
747 sub dump {
748   my $self = shift;
749
750   foreach my $k (sort keys %$self) {
751     my $r = ref($self->{$k});
752     if ($r eq 'ARRAY') {
753       printf "%20s <<EOM\n", $k;
754       print @{$self->{$k}}, "EOM\n";
755     } elsif ($r eq 'HASH') {
756       printf "%20s <<EOM\n", $k;
757       foreach (sort keys %{$self->{$k}}) {
758         printf "%20s %s\n", $_, $self->{$k}{$_};
759       }
760       print "EOM\n";
761     } else {
762       printf "%20s %s\n", $k, $self->{$k};
763     }
764   }
765 }
766
767 } # BEGIN
768
769 sub ext_usage {
770   if ($ARGV[0] =~ /^--help$/i) {
771     require Config;
772     $ENV{PATH} .= ":" unless $ENV{PATH} eq "";
773     $ENV{PATH} = "$ENV{PATH}$Config::Config{'installscript'}";
774     #exec("perldoc", "-F", "-U", $0) || exit 1;
775     $< = $> = 1 if ($> == 0 || $< == 0);
776     exec("perldoc", $0) || exit 1;
777     # make parser happy
778     %Config::Config = ();
779   } elsif ($ARGV[0] =~ /^--version$/i) {
780     print "$p_name version $p_version\n\n$p_cp\n";
781   } else {
782     return;
783   }
784
785   exit(0);
786 }
787
788 __END__
789
790 =head1 NAME
791
792 exipick - display messages from Exim queue based on a variety of criteria
793
794 =head1 USAGE
795
796 exipick [--help|--version] | [-spool <spool>] [-and|-or] [-bp|-bpa|-bpc|-bpr|-bpra|-bpru|-bpu] [<criterion> [<criterion> ...]]
797
798 =head1 DESCRIPTION
799
800 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.
801
802 =head1 OPTIONS
803
804 =over 4
805
806 =item --spool
807
808 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.
809
810 =item --and
811
812 A message will be displayed only if it matches all of the specified criteria.  This is the default.
813
814 =item --or
815
816 A message will be displayed if it matches any of the specified criteria.
817
818 =item --caseful
819
820 By default criteria using the '=' operator are caseless.  Specifying this option make them respect case.
821
822 =item --show-vars <variable>[,<variable>...]
823
824 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.
825
826 =item --show-rules
827
828 If specified the internal representation of each message criteria is shown.  This is primarily used for debugging purposes.
829
830 ==item --show-tests
831
832 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.
833
834 =item --flatq
835
836 Change format of output so that every message is on a single line.  Useful for parsing with tools such as sed, awk, cut, etc.
837
838 =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:
839
840 =item -bp   display the matching messages in 'mailq' format.
841
842 =item -bpa    ... with generated addresses as well.
843
844 =item -bpc    ... just show a count of messages.
845
846 =item -bpr    ... do not sort.
847
848 =item -bpra   ... with generated addresses, unsorted.
849
850 =item -bpru   ... only undelivered addresses, unsorted.
851
852 =item -bpu    ... only undelivered addresses.
853
854 Please see Exim's spec.txt for details on the format and information displayed with each option.
855
856 =item The following options are included for compatibility with the 'exiqgrep' utility:
857
858 =item -f <regexp>  Same as '$sender_address = <regexp>'
859
860 =item -r <regexp>  Same as '$recipients = <regexp>'
861
862 =item -s <string>  Same as '$shown_message_size eq <string>'
863
864 =item -y <seconds> Same as '$message_age < <seconds>'
865
866 =item -o <seconds> Same as '$message_age > <seconds>'
867
868 =item -z           Same as '$deliver_freeze'
869
870 =item -x           Same as '!$deliver_freeze'
871
872 =item -c           Display count of matches only
873
874 =item -l           Display in long format (default)
875
876 =item -i           Display message IDs only
877
878 =item -b           Display brief format only
879
880 Please see the 'exiqgrep' documentation for more details on the behaviour and output format produced by these options
881
882 =item <criterion>
883
884 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.
885
886 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.
887
888 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')
889
890 =item --help
891
892 This screen.
893
894 =item --version
895
896 Version info.
897
898 =back
899
900 =head1 VARIABLE TYPES
901
902 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.
903
904 =over 4
905
906 =item NUMERIC
907
908 Variable of the numeric type can be of integer or float.  Valid comparisons are <, <=, >, >=, ==, and !=.
909
910 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'.
911
912 =item BOOLEAN
913
914 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.
915
916 =item STRING
917
918 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.
919
920 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.
921
922 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".
923
924 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.
925
926 =back
927
928 =head1 VARIABLES
929
930 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.
931
932 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.
933
934 =head2 Boolean variables
935
936 =over 4
937
938 =item + $allow_unqualified_recipient
939
940 TRUE if unqualified recipient addresses are permitted in header lines.
941
942 =item + $allow_unqualified_sender
943
944 TRUE if unqualified sender addresses are permitted in header lines.
945
946 =item + $deliver_freeze
947
948 TRUE if the message is currently frozen.
949
950 =item . $first_delivery
951
952 TRUE if the message has never been deferred.
953
954 =item . $manually_thawed
955
956 TRUE when the message has been manually thawed.
957
958 =item + $dont_deliver
959
960 TRUE if, under normal circumstances, Exim will not try to deliver the message.
961
962 =item . $host_lookup_deferred
963
964 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.
965
966 =item . $host_lookup_failed
967
968 TRUE if there was an attempt to look up the host's name from its IP address, but the attempt returned a negative result.
969
970 =item + $local_error_message
971
972 TRUE if the message is a locally-generated error message.
973
974 =item + $sender_local
975
976 TRUE if the message was locally generated.
977
978 =item + $sender_set_untrusted
979
980 TRUE if the envelope sender of this message was set by an untrusted local caller.
981
982 =item . $tls_certificate_verified
983
984 TRUE if a TLS certificate was verified when the message was received.
985
986 =back
987
988 =head2 Numeric variables
989
990 =over 4
991
992 =item . $body_linecount
993
994 The number of lines in the message's body.
995
996 =item . $body_zerocount
997
998 The number of binary zero bytes in the message's body.
999
1000 =item + $deliver_frozen_at
1001
1002 The epoch time at which message was frozen.
1003
1004 =item . $interface_port
1005
1006 The local port number if network-originated messages.
1007
1008 =item . $message_age
1009
1010 The number of seconds since the message was received.
1011
1012 =item . $message_body_size
1013
1014 The size of the body in bytes.
1015
1016 =item . $message_linecount
1017
1018 The number of lines in the entire message (body and headers).
1019
1020 =item . $message_size
1021
1022 The size of the message in bytes.
1023
1024 =item . $originator_gid
1025
1026 The group id under which the process that called Exim was running as when the message was received.
1027
1028 =item . $originator_uid
1029
1030 The user id under which the process that called Exim was running as when the message was received.
1031
1032 =item . $received_count
1033
1034 The number of Received: header lines in the message.
1035
1036 =item . $received_time
1037
1038 The epoch time at which the message was received.
1039
1040 =item . $recipients_count
1041
1042 The number of envelope recipients for the message.
1043
1044 =item + $recipients_del_count
1045
1046 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.
1047
1048 =item + $recipients_undel_count
1049
1050 The number of envelope recipients for the message which have not yet been delivered.
1051
1052 =item . $sender_host_port
1053
1054 The port number that was used on the remote host for network-originated messages.
1055
1056 =item + $warning_count
1057
1058 The number of delay warnings which have been sent for this message.
1059
1060 =back
1061
1062 =head2 String variables
1063
1064 =over 4
1065
1066 =item . $acl_c0-$acl_c9, $acl_m0-$acl_m9
1067
1068 User definable variables.
1069
1070 =item . $authenticated_id
1071
1072 Optional saved information from authenticators, or the login name of the calling process for locally submitted messages.
1073
1074 =item . $authenticated_sender
1075
1076 The value of AUTH= param for smtp messages, or a generated value from the calling processes login and qualify domain for locally submitted messages.
1077
1078 =item + $bmi_verdicts
1079
1080 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).
1081
1082 =item + $each_recipients
1083
1084 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.
1085
1086 =item + $each_recipients_del
1087
1088 Like $each_recipients, but for the $recipients_del variable.
1089
1090 =item + $each_recipients_undel
1091
1092 Like $each_recipients, but for the $recipients_undel variable.
1093
1094 =item # $header_*
1095
1096 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.
1097
1098 =item . $interface_address
1099
1100 The address of the local IP interface for network-originated messages.
1101
1102 =item . $local_scan_data
1103
1104 The text returned by the local_scan() function when a message is received.
1105
1106 =item # $message_body
1107
1108 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.
1109
1110 =item . $message_headers
1111
1112 A concatenation of all the header lines except for lines added by routers or transports.
1113
1114 =item . $message_exim_id, $message_id
1115
1116 The unique message id that is used by Exim to identify the message.  $message_id is deprecated as of Exim 4.53.
1117
1118 =item + $originator_login
1119
1120 The login of the process which called Exim.
1121
1122 =item . $received_protocol
1123
1124 The name of the protocol by which the message was received.
1125
1126 =item # $recipients
1127
1128 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.
1129
1130 =item + $recipients_del
1131
1132 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.
1133
1134 =item + $recipients_undel
1135
1136 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.
1137
1138 =item . $reply_address
1139
1140 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.
1141
1142 =item . $sender_address
1143
1144 The sender's address that was received in the message's envelope.  For bounce messages, the value of this variable is the empty string.
1145
1146 =item . $sender_address_domain
1147
1148 The domain part of $sender_address.
1149
1150 =item . $sender_address_local_part
1151
1152 The local part of $sender_address.
1153
1154 =item . $sender_helo_name
1155
1156 The HELO or EHLO value supplied for smtp or bsmtp messages.
1157
1158 =item . $sender_host_address
1159
1160 The remote host's IP address.
1161
1162 =item . $sender_host_authenticated
1163
1164 The name of the authenticator driver which successfully authenticated the client from which the message was received.
1165
1166 =item . $sender_host_name
1167
1168 The remote host's name as obtained by looking up its IP address.
1169
1170 =item . $sender_ident
1171
1172 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.
1173
1174 =item + $shown_message_size
1175
1176 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.
1177
1178 =item . $smtp_active_hostname
1179
1180 The value of the active host name when the message was received, as specified by the "smtp_active_hostname" option.
1181
1182 =item . $spam_score
1183
1184 The spam score of the message, for example '3.4' or '30.5'.  (Requires exiscan or WITH_CONTENT_SCAN)
1185
1186 =item . $spam_score_int
1187
1188 The spam score of the message, multiplied by ten, as an integer value.  For instance '34' or '305'.  (Requires exiscan or WITH_CONTENT_SCAN)
1189
1190 =item . $tls_cipher
1191
1192 The cipher suite that was negotiated for encrypted SMTP connections.
1193
1194 =item . $tls_peerdn
1195
1196 The value of the Distinguished Name of the certificate if Exim is configured to request one.
1197
1198 =back
1199
1200 =head1 EXAMPLES
1201
1202 =over 4
1203
1204 =item exipick '$deliver_freeze'
1205
1206 Display only frozen messages.
1207
1208 =item exipick '$received_protocol eq asmtp' '$message_age < 20m'
1209
1210 Display only messages which were delivered over an authenticated smtp session in the last 20 minutes.
1211
1212 =item exipick -bpc '$message_size > 200K'
1213
1214 Display a count of messages in the queue which are over 200 kilobytes in size.
1215
1216 =item exipick -or '$sender_helo_name =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/' '$sender_helo_name = _'
1217
1218 Display message which have a HELO string which either is an IP address or contains an underscore.
1219
1220 =back
1221
1222 =head1 REQUIREMENTS
1223
1224 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).
1225
1226 =head1 ACKNOWLEDGEMENTS
1227
1228 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.
1229
1230 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.
1231
1232 =head1 CONTACT
1233
1234 =over 4
1235
1236 =item EMAIL: proj-exipick@jetmore.net
1237
1238 =item HOME: jetmore.org/john/code/#exipick
1239
1240 =back
1241
1242 =cut