src/src/exipick.src

   1 #!PERL_COMMAND
   2 # $Cambridge: exim/src/src/exipick.src,v 1.5 2005/06/07 09:15:04 ph10 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 = "20050604.1";
  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_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' && $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
 416   # line 2
 417   chomp($_ = <I>);
 418   return(0) if (!/^(.+)\s(\-?\d+)\s(\-?\d+)$/);
 419   $self->{_vars}{originator_login} = $1;
 420   $self->{_vars}{originator_uid}   = $2;
 421   $self->{_vars}{originator_gid}   = $3;
 422
 423   # line 3
 424   chomp($_ = <I>);
 425   return(0) if (!/^<(.*)>$/);
 426   $self->{_vars}{sender_address}   = $1;
 427   $self->{_vars}{sender_address_domain} = $1;
 428   $self->{_vars}{sender_address_local_part} = $1;
 429   $self->{_vars}{sender_address_domain} =~ s/^.*\@//;
 430   $self->{_vars}{sender_address_local_part} =~ s/^(.*)\@.*$/$1/;
 431
 432   # line 4
 433   chomp($_ = <I>);
 434   return(0) if (!/^(\d+)\s(\d+)$/);
 435   $self->{_vars}{received_time}    = $1;
 436   $self->{_vars}{warning_count}    = $2;
 437   $self->{_vars}{message_age}      = time() - $self->{_vars}{received_time};
 438
 439   while (<I>) {
 440     chomp();
 441     if (/^(-\S+)\s*(.*$)/) {
 442       my $tag = $1;
 443       my $arg = $2;
 444       if ($tag eq '-acl') {
 445         my $t;
 446         return(0) if ($arg !~ /^(\d+)\s(\d+)$/);
 447         if ($1 < $Exim::SpoolFile::ACL_C_MAX) {
 448           $t = "acl_c$1";
 449         } else {
 450           $t = "acl_m" . ($1 - $Exim::SpoolFile::ACL_C_MAX);
 451         }
 452         read(I, $self->{_vars}{$t}, $2+1) || return(0);
 453         chomp($self->{_vars}{$t});
 454       } elsif ($tag eq '-local') {
 455         $self->{_vars}{sender_local} = 1;
 456       } elsif ($tag eq '-localerror') {
 457         $self->{_vars}{local_error_message} = 1;
 458       } elsif ($tag eq '-local_scan') {
 459         $self->{_vars}{local_scan_data} = $arg;
 460       } elsif ($tag eq '-spam_score_int') {
 461         $self->{_vars}{spam_score_int} = $arg;
 462         $self->{_vars}{spam_score}     = $arg / 10;
 463       } elsif ($tag eq '-bmi_verdicts') {
 464         $self->{_vars}{bmi_verdicts} = $arg;
 465       } elsif ($tag eq '-host_lookup_deferred') {
 466         $self->{_vars}{host_lookup_deferred} = 1;
 467       } elsif ($tag eq '-host_lookup_failed') {
 468         $self->{_vars}{host_lookup_failed} = 1;
 469       } elsif ($tag eq '-body_linecount') {
 470         $self->{_vars}{body_linecount} = $arg;
 471       } elsif ($tag eq '-body_zerocount') {
 472         $self->{_vars}{body_zerocount} = $arg;
 473       } elsif ($tag eq '-frozen') {
 474         $self->{_vars}{deliver_freeze} = 1;
 475         $self->{_vars}{deliver_frozen_at} = $arg;
 476       } elsif ($tag eq '-allow_unqualified_recipient') {
 477         $self->{_vars}{allow_unqualified_recipient} = 1;
 478       } elsif ($tag eq '-allow_unqualified_sender') {
 479         $self->{_vars}{allow_unqualified_sender} = 1;
 480       } elsif ($tag eq '-deliver_firsttime') {
 481         $self->{_vars}{deliver_firsttime} = 1;
 482         $self->{_vars}{first_delivery} = 1;
 483       } elsif ($tag eq '-manual_thaw') {
 484         $self->{_vars}{deliver_manual_thaw} = 1;
 485         $self->{_vars}{manually_thawed} = 1;
 486       } elsif ($tag eq '-auth_id') {
 487         $self->{_vars}{authenticated_id} = $arg;
 488       } elsif ($tag eq '-auth_sender') {
 489         $self->{_vars}{authenticated_sender} = $arg;
 490       } elsif ($tag eq '-sender_set_untrusted') {
 491         $self->{_vars}{sender_set_untrusted} = 1;
 492       } elsif ($tag eq '-tls_certificate_verified') {
 493         $self->{_vars}{tls_certificate_verified} = 1;
 494       } elsif ($tag eq '-tls_cipher') {
 495         $self->{_vars}{tls_cipher} = $arg;
 496       } elsif ($tag eq '-tls_peerdn') {
 497         $self->{_vars}{tls_peerdn} = $arg;
 498       } elsif ($tag eq '-host_address') {
 499         $self->{_vars}{sender_host_port} = $self->_get_host_and_port(\$arg);
 500         $self->{_vars}{sender_host_address} = $arg;
 501       } elsif ($tag eq '-interface_address') {
 502         $self->{_vars}{interface_port} = $self->_get_host_and_port(\$arg);
 503         $self->{_vars}{interface_address} = $arg;
 504       } elsif ($tag eq '-active_hostname') {
 505         $self->{_vars}{smtp_active_hostname} = $arg;
 506       } elsif ($tag eq '-host_auth') {
 507         $self->{_vars}{sender_host_authenticated} = $arg;
 508       } elsif ($tag eq '-host_name') {
 509         $self->{_vars}{sender_host_name} = $arg;
 510       } elsif ($tag eq '-helo_name') {
 511         $self->{_vars}{sender_helo_name} = $arg;
 512       } elsif ($tag eq '-ident') {
 513         $self->{_vars}{sender_ident} = $arg;
 514       } elsif ($tag eq '-received_protocol') {
 515         $self->{_vars}{received_protocol} = $arg;
 516       } elsif ($tag eq '-N') {
 517         $self->{_vars}{dont_deliver} = 1;
 518       } else {
 519         # unrecognized tag, save it for reference
 520         $self->{$tag} = $arg;
 521       }
 522     } else {
 523       last;
 524     }
 525   }
 526
 527   # when we drop out of the while loop, we have the first line of the
 528   # delivered tree in $_
 529   do {
 530     if ($_ eq 'XX') {
 531       ; # noop
 532     } elsif ($_ =~ s/^[YN][YN]\s+//) {
 533       $self->{_del_tree}{$_} = 1;
 534     } else {
 535       return(0);
 536     }
 537     chomp($_ = <I>);
 538   } while ($_ !~ /^\d+$/);
 539
 540   $self->{_numrecips} = $_;
 541   $self->{_vars}{recipients_count} = $self->{_numrecips};
 542   for (my $i = 0; $i < $self->{_numrecips}; $i++) {
 543     chomp($_ = <I>);
 544     return(0) if (/^$/);
 545     my $addr = '';
 546     if (/^(.*)\s\d+,(\d+),\d+$/) {
 547       #print STDERR "exim3 type (untested): $_\n";
 548       $self->{_recips}{$1} = { pno => $2 };
 549       $addr = $1;
 550     } elsif (/^(.*)\s(\d+)$/) {
 551       #print STDERR "exim4 original type (untested): $_\n";
 552       $self->{_recips}{$1} = { pno => $2 };
 553       $addr = $1;
 554     } elsif (/^(.*)\s(.*)\s(\d+),(\d+)#1$/) {
 555       #print STDERR "exim4 new type #1 (untested): $_\n";
 556       return($self->_error("incorrect format: $_")) if (length($2) != $3);
 557       $self->{_recips}{$1} = { pno => $4, errors_to => $2 };
 558       $addr = $1;
 559     } elsif (/^.*#(\d+)$/) {
 560       #print STDERR "exim4 #$1 style (unimplemented): $_\n";
 561       $self->_error("exim4 #$1 style (unimplemented): $_");
 562     } else {
 563       #print STDERR "default type: $_\n";
 564       $self->{_recips}{$_} = {};
 565       $addr = $_;
 566     }
 567     $self->{_udel_tree}{$addr} = 1 if (!$self->{_del_tree}{$addr});
 568   }
 569   $self->{_vars}{recipients}         = join(', ', keys(%{$self->{_recips}}));
 570   $self->{_vars}{recipients_del}     = join(', ', keys(%{$self->{_del_tree}}));
 571   $self->{_vars}{recipients_undel}   = join(', ', keys(%{$self->{_udel_tree}}));
 572   $self->{_vars}{recipients_undel_count} = scalar(keys(%{$self->{_udel_tree}}));
 573   $self->{_vars}{recipients_del_count}   = 0;
 574   foreach my $r (keys %{$self->{_del_tree}}) {
 575     next if (!$self->{_recips}{$r});
 576     $self->{_vars}{recipients_del_count}++;
 577   }
 578
 579   # blank line
 580   $_ = <I>;
 581   return(0) if (!/^$/);
 582
 583   # start reading headers
 584   while (read(I, $_, 3) == 3) {
 585     my $t = getc(I);
 586     return(0) if (!length($t));
 587     while ($t =~ /^\d$/) {
 588       $_ .= $t;
 589       $t  = getc(I);
 590     }
 591     # ok, right here $t contains the header flag and $_ contains the number of
 592     # bytes to read.  If we ever use the header flag, grab it here.
 593     $self->{_vars}{message_size} += $_ if ($t ne '*');
 594     $t = getc(I); # strip the space out of the file
 595     my $bytes = $_;
 596     return(0) if (read(I, $_, $bytes) != $bytes);
 597     chomp(); # may regret this later
 598     $self->{_vars}{message_linecount} += scalar(split(/\n/)) if ($t ne '*');
 599     # build the $header_ variable, following exim's rules (sort of)
 600     if (/^([^ :]+):(.*)$/s) {
 601       my $v = "header_" . lc($1);
 602       my $d = $2;
 603       $d =~ s/^\s*//;
 604       $d =~ s/\s*$//;
 605       $self->{_vars}{$v} .= (defined($self->{_vars}{$v}) ? "\n" : '') . $d;
 606       $self->{_vars}{received_count}++ if ($v eq 'header_received');
 607     }
 608     # push header onto $message_headers var, following exim's rules
 609     $self->{_vars}{message_headers} .=
 610         (defined($self->{_vars}{message_headers}) ? "\n" : '') . $_;
 611   }
 612   close(I);
 613
 614   if (length($self->{_vars}{"header_reply-to"}) > 0) {
 615     $self->{_vars}{reply_address} = $self->{_vars}{"header_reply-to"};
 616   } else {
 617     $self->{_vars}{reply_address} = $self->{_vars}{header_from};
 618   }
 619
 620   $self->{_vars}{message_body_size} =
 621       (stat($self->{_path}.'/'.$self->{_message}.'-D'))[7] - 19;
 622   if ($self->{_vars}{message_body_size} < 0) {
 623     $self->{_vars}{message_size} = 0;
 624   } else {
 625     $self->{_vars}{message_size} += $self->{_vars}{message_body_size} + 1;
 626   }
 627
 628   $self->{_vars}{message_linecount} += $self->{_vars}{body_linecount};
 629
 630   my $i = $self->{_vars}{message_size};
 631   if ($i == 0)              { $i = ""; }
 632   elsif ($i < 1024)         { $i = sprintf("%d", $i); }
 633   elsif ($i < 10*1024)      { $i = sprintf("%.1fK", $i / 1024); }
 634   elsif ($i < 1024*1024)    { $i = sprintf("%dK", ($i+512)/1024); }
 635   elsif ($i < 10*1024*1024) { $i = sprintf("%.1fM", $i/(1024*1024)); }
 636   else { $i = sprintf("%dM", ($i + 512 * 1024)/(1024*1024)); }
 637   $self->{_vars}{shown_message_size} = $i;
 638
 639   return(1);
 640 }
 641
 642 # mimic exim's host_extract_port function - receive a ref to a scalar,
 643 # strip it of port, return port
 644 sub _get_host_and_port {
 645   my $self = shift;
 646   my $host = shift; # scalar ref, be careful
 647
 648   if ($$host =~ /^\[([^\]]+)\](?:\:(\d+))?$/) {
 649     $$host = $1;
 650     return($2 || 0);
 651   } elsif ($$host =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})(?:\.(\d+))?$/) {
 652     $$host = $1;
 653     return($2 || 0);
 654   } elsif ($$host =~ /^([\d\:]+)(?:\.(\d+))?$/) {
 655     $$host = $1;
 656     return($2 || 0);
 657   }
 658   # implicit else
 659   return(0);
 660 }
 661
 662 sub print_message {
 663   my $self = shift;
 664   my $fh   = shift || \*STDOUT;
 665   return if ($self->{_delivered});
 666
 667   if ($self->{_output_idonly}) {
 668     print $fh $self->{_message};
 669     foreach my $v (@{$self->{_show_vars}}) {
 670       print $fh " $v='", $self->get_var($v), "'";
 671     }
 672     print $fh "\n";
 673     return;
 674   }
 675
 676   if ($self->{_output_long} || $self->{_output_flatq}) {
 677     my $i = int($self->{_vars}{message_age} / 60);
 678     if ($i > 90) {
 679       $i = int(($i+30)/60);
 680       if ($i > 72) { printf $fh "%2dd ", int(($i+12)/24); }
 681       else { printf $fh "%2dh ", $i; }
 682     } else { printf $fh "%2dm ", $i; }
 683
 684     if ($self->{_output_flatq} && $self->{_show_vars}) {
 685         print $fh join(';',
 686                        map { "$_='".$self->get_var($_)."'" }
 687                            (@{$self->{_show_vars}})
 688                       );
 689     } else {
 690       printf $fh "%5s", $self->{_vars}{shown_message_size};
 691     }
 692     print $fh " ";
 693   }
 694   print $fh "$self->{_message} ";
 695   print $fh "From: " if ($self->{_output_brief});
 696   print $fh "<$self->{_vars}{sender_address}>";
 697
 698   if ($self->{_output_long}) {
 699     print $fh " ($self->{_vars}{originator_login})"
 700         if ($self->{_vars}{sender_set_untrusted});
 701
 702     # XXX exim contains code here to print spool format errors
 703     print $fh " *** frozen ***" if ($self->{_vars}{deliver_freeze});
 704     print $fh "\n";
 705
 706     foreach my $v (@{$self->{_show_vars}}) {
 707       printf $fh "  %25s = '%s'\n", $v, $self->get_var($v);
 708     }
 709
 710     foreach my $r (keys %{$self->{_recips}}) {
 711       next if ($self->{_del_tree}{$r} && $self->{_undelivered_only});
 712       printf $fh "        %s %s\n", $self->{_del_tree}{$r} ? "D" : " ", $r;
 713     }
 714     if ($self->{_show_generated}) {
 715       foreach my $r (keys %{$self->{_del_tree}}) {
 716         next if ($self->{_recips}{$r});
 717         printf $fh "       +D %s\n", $r;
 718       }
 719     }
 720   } elsif ($self->{_output_brief}) {
 721     my @r = ();
 722     foreach my $r (keys %{$self->{_recips}}) {
 723       next if ($self->{_del_tree}{$r});
 724       push(@r, $r);
 725     }
 726     print $fh " To: ", join(';', @r);
 727     if ($self->{_show_vars}) {
 728       print $fh " Vars: ", join(';',
 729                                 map { "$_='".$self->get_var($_)."'" }
 730                                     (@{$self->{_show_vars}})
 731                                );
 732     }
 733   } elsif ($self->{_output_flatq}) {
 734     print $fh " *** frozen ***" if ($self->{_vars}{deliver_freeze});
 735     my @r = ();
 736     foreach my $r (keys %{$self->{_recips}}) {
 737       next if ($self->{_del_tree}{$r});
 738       push(@r, $r);
 739     }
 740     print $fh " ", join(' ', @r);
 741   }
 742
 743   print $fh "\n";
 744 }
 745
 746 sub dump {
 747   my $self = shift;
 748
 749   foreach my $k (sort keys %$self) {
 750     my $r = ref($self->{$k});
 751     if ($r eq 'ARRAY') {
 752       printf "%20s <<EOM\n", $k;
 753       print @{$self->{$k}}, "EOM\n";
 754     } elsif ($r eq 'HASH') {
 755       printf "%20s <<EOM\n", $k;
 756       foreach (sort keys %{$self->{$k}}) {
 757         printf "%20s %s\n", $_, $self->{$k}{$_};
 758       }
 759       print "EOM\n";
 760     } else {
 761       printf "%20s %s\n", $k, $self->{$k};
 762     }
 763   }
 764 }
 765
 766 } # BEGIN
 767
 768 sub ext_usage {
 769   if ($ARGV[0] =~ /^--help$/i) {
 770     require Config;
 771     $ENV{PATH} .= ":" unless $ENV{PATH} eq "";
 772     $ENV{PATH} = "$ENV{PATH}$Config::Config{'installscript'}";
 773     #exec("perldoc", "-F", "-U", $0) || exit 1;
 774     $< = $> = 1 if ($> == 0 || $< == 0);
 775     exec("perldoc", $0) || exit 1;
 776     # make parser happy
 777     %Config::Config = ();
 778   } elsif ($ARGV[0] =~ /^--version$/i) {
 779     print "$p_name version $p_version\n\n$p_cp\n";
 780   } else {
 781     return;
 782   }
 783
 784   exit(0);
 785 }
 786
 787 __END__
 788
 789 =head1 NAME
 790
 791 exipick - display messages from Exim queue based on a variety of criteria
 792
 793 =head1 USAGE
 794
 795 exipick [--help|--version] | [-spool <spool>] [-and|-or] [-bp|-bpa|-bpc|-bpr|-bpra|-bpru|-bpu] [<criterion> [<criterion> ...]]
 796
 797 =head1 DESCRIPTION
 798
 799 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.
 800
 801 =head1 OPTIONS
 802
 803 =over 4
 804
 805 =item --spool
 806
 807 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.
 808
 809 =item --and
 810
 811 A message will be displayed only if it matches all of the specified criteria.  This is the default.
 812
 813 =item --or
 814
 815 A message will be displayed if it matches any of the specified criteria.
 816
 817 =item --caseful
 818
 819 By default criteria using the '=' operator are caseless.  Specifying this option make them respect case.
 820
 821 =item --show-vars <variable>[,<variable>...]
 822
 823 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.
 824
 825 =item --show-rules
 826
 827 If specified the internal representation of each message criteria is shown.  This is primarily used for debugging purposes.
 828
 829 ==item --show-tests
 830
 831 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.
 832
 833 =item --flatq
 834
 835 Change format of output so that every message is on a single line.  Useful for parsing with tools such as sed, awk, cut, etc.
 836
 837 =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:
 838
 839 =item -bp   display the matching messages in 'mailq' format.
 840
 841 =item -bpa    ... with generated addresses as well.
 842
 843 =item -bpc    ... just show a count of messages.
 844
 845 =item -bpr    ... do not sort.
 846
 847 =item -bpra   ... with generated addresses, unsorted.
 848
 849 =item -bpru   ... only undelivered addresses, unsorted.
 850
 851 =item -bpu    ... only undelivered addresses.
 852
 853 Please see Exim's spec.txt for details on the format and information displayed with each option.
 854
 855 =item The following options are included for compatibility with the 'exiqgrep' utility:
 856
 857 =item -f <regexp>  Same as '$sender_address = <regexp>'
 858
 859 =item -r <regexp>  Same as '$recipients = <regexp>'
 860
 861 =item -s <string>  Same as '$shown_message_size eq <string>'
 862
 863 =item -y <seconds> Same as '$message_age < <seconds>'
 864
 865 =item -o <seconds> Same as '$message_age > <seconds>'
 866
 867 =item -z           Same as '$deliver_freeze'
 868
 869 =item -x           Same as '!$deliver_freeze'
 870
 871 =item -c           Display count of matches only
 872
 873 =item -l           Display in long format (default)
 874
 875 =item -i           Display message IDs only
 876
 877 =item -b           Display brief format only
 878
 879 Please see the 'exiqgrep' documentation for more details on the behaviour and output format produced by these options
 880
 881 =item <criterion>
 882
 883 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.
 884
 885 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.
 886
 887 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')
 888
 889 =item --help
 890
 891 This screen.
 892
 893 =item --version
 894
 895 Version info.
 896
 897 =back
 898
 899 =head1 VARIABLE TYPES
 900
 901 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.
 902
 903 =over 4
 904
 905 =item NUMERIC
 906
 907 Variable of the numeric type can be of integer or float.  Valid comparisons are <, <=, >, >=, ==, and !=.
 908
 909 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'.
 910
 911 =item BOOLEAN
 912
 913 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.
 914
 915 =item STRING
 916
 917 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.
 918
 919 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.
 920
 921 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".
 922
 923 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.
 924
 925 =back
 926
 927 =head1 VARIABLES
 928
 929 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.
 930
 931 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.
 932
 933 =head2 Boolean variables
 934
 935 =over 4
 936
 937 =item + $allow_unqualified_recipient
 938
 939 TRUE if unqualified recipient addresses are permitted in header lines.
 940
 941 =item + $allow_unqualified_sender
 942
 943 TRUE if unqualified sender addresses are permitted in header lines.
 944
 945 =item + $deliver_freeze
 946
 947 TRUE if the message is currently frozen.
 948
 949 =item . $first_delivery
 950
 951 TRUE if the message has never been deferred.
 952
 953 =item . $manually_thawed
 954
 955 TRUE when the message has been manually thawed.
 956
 957 =item + $dont_deliver
 958
 959 TRUE if, under normal circumstances, Exim will not try to deliver the message.
 960
 961 =item . $host_lookup_deferred
 962
 963 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.
 964
 965 =item . $host_lookup_failed
 966
 967 TRUE if there was an attempt to look up the host's name from its IP address, but the attempt returned a negative result.
 968
 969 =item + $local_error_message
 970
 971 TRUE if the message is a locally-generated error message.
 972
 973 =item + $sender_local
 974
 975 TRUE if the message was locally generated.
 976
 977 =item + $sender_set_untrusted
 978
 979 TRUE if the envelope sender of this message was set by an untrusted local caller.
 980
 981 =item . $tls_certificate_verified
 982
 983 TRUE if a TLS certificate was verified when the message was received.
 984
 985 =back
 986
 987 =head2 Numeric variables
 988
 989 =over 4
 990
 991 =item . $body_linecount
 992
 993 The number of lines in the message's body.
 994
 995 =item . $body_zerocount
 996
 997 The number of binary zero bytes in the message's body.
 998
 999 =item + $deliver_frozen_at
1000
1001 The epoch time at which message was frozen.
1002
1003 =item . $interface_port
1004
1005 The local port number if network-originated messages.
1006
1007 =item . $message_age
1008
1009 The number of seconds since the message was received.
1010
1011 =item . $message_body_size
1012
1013 The size of the body in bytes.
1014
1015 =item . $message_linecount
1016
1017 The number of lines in the entire message (body and headers).
1018
1019 =item . $message_size
1020
1021 The size of the message in bytes.
1022
1023 =item . $originator_gid
1024
1025 The group id under which the process that called Exim was running as when the message was received.
1026
1027 =item . $originator_uid
1028
1029 The user id under which the process that called Exim was running as when the message was received.
1030
1031 =item . $received_count
1032
1033 The number of Received: header lines in the message.
1034
1035 =item . $received_time
1036
1037 The epoch time at which the message was received.
1038
1039 =item . $recipients_count
1040
1041 The number of envelope recipients for the message.
1042
1043 =item + $recipients_del_count
1044
1045 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.
1046
1047 =item + $recipients_undel_count
1048
1049 The number of envelope recipients for the message which have not yet been delivered.
1050
1051 =item . $sender_host_port
1052
1053 The port number that was used on the remote host for network-originated messages.
1054
1055 =item + $warning_count
1056
1057 The number of delay warnings which have been sent for this message.
1058
1059 =back
1060
1061 =head2 String variables
1062
1063 =over 4
1064
1065 =item . $acl_c0-$acl_c9, $acl_m0-$acl_m9
1066
1067 User definable variables.
1068
1069 =item . $authenticated_id
1070
1071 Optional saved information from authenticators, or the login name of the calling process for locally submitted messages.
1072
1073 =item . $authenticated_sender
1074
1075 The value of AUTH= param for smtp messages, or a generated value from the calling processes login and qualify domain for locally submitted messages.
1076
1077 =item + $bmi_verdicts
1078
1079 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).
1080
1081 =item + $each_recipients
1082
1083 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.
1084
1085 =item + $each_recipients_del
1086
1087 Like $each_recipients, but for the $recipients_del variable.
1088
1089 =item + $each_recipients_undel
1090
1091 Like $each_recipients, but for the $recipients_undel variable.
1092
1093 =item # $header_*
1094
1095 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.
1096
1097 =item . $interface_address
1098
1099 The address of the local IP interface for network-originated messages.
1100
1101 =item . $local_scan_data
1102
1103 The text returned by the local_scan() function when a message is received.
1104
1105 =item # $message_body
1106
1107 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.
1108
1109 =item . $message_headers
1110
1111 A concatenation of all the header lines except for lines added by routers or transports.
1112
1113 =item . $message_id
1114
1115 The unique message id that is used by Exim to identify the message.
1116
1117 =item + $originator_login
1118
1119 The login of the process which called Exim.
1120
1121 =item . $received_protocol
1122
1123 The name of the protocol by which the message was received.
1124
1125 =item # $recipients
1126
1127 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.
1128
1129 =item + $recipients_del
1130
1131 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.
1132
1133 =item + $recipients_undel
1134
1135 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.
1136
1137 =item . $reply_address
1138
1139 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.
1140
1141 =item . $sender_address
1142
1143 The sender's address that was received in the message's envelope.  For bounce messages, the value of this variable is the empty string.
1144
1145 =item . $sender_address_domain
1146
1147 The domain part of $sender_address.
1148
1149 =item . $sender_address_local_part
1150
1151 The local part of $sender_address.
1152
1153 =item . $sender_helo_name
1154
1155 The HELO or EHLO value supplied for smtp or bsmtp messages.
1156
1157 =item . $sender_host_address
1158
1159 The remote host's IP address.
1160
1161 =item . $sender_host_authenticated
1162
1163 The name of the authenticator driver which successfully authenticated the client from which the message was received.
1164
1165 =item . $sender_host_name
1166
1167 The remote host's name as obtained by looking up its IP address.
1168
1169 =item . $sender_ident
1170
1171 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.
1172
1173 =item + $shown_message_size
1174
1175 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.
1176
1177 =item . $smtp_active_hostname
1178
1179 The value of the active host name when the message was received, as specified by the "smtp_active_hostname" option.
1180
1181 =item . $spam_score
1182
1183 The spam score of the message, for example '3.4' or '30.5'.  (Requires exiscan or WITH_CONTENT_SCAN)
1184
1185 =item . $spam_score_int
1186
1187 The spam score of the message, multiplied by ten, as an integer value.  For instance '34' or '305'.  (Requires exiscan or WITH_CONTENT_SCAN)
1188
1189 =item . $tls_cipher
1190
1191 The cipher suite that was negotiated for encrypted SMTP connections.
1192
1193 =item . $tls_peerdn
1194
1195 The value of the Distinguished Name of the certificate if Exim is configured to request one.
1196
1197 =back
1198
1199 =head1 EXAMPLES
1200
1201 =over 4
1202
1203 =item exipick '$deliver_freeze'
1204
1205 Display only frozen messages.
1206
1207 =item exipick '$received_protocol eq asmtp' '$message_age < 20m'
1208
1209 Display only messages which were delivered over an authenticated smtp session in the last 20 minutes.
1210
1211 =item exipick -bpc '$message_size > 200K'
1212
1213 Display a count of messages in the queue which are over 200 kilobytes in size.
1214
1215 =item exipick -or '$sender_helo_name =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/' '$sender_helo_name = _'
1216
1217 Display message which have a HELO string which either is an IP address or contains an underscore.
1218
1219 =back
1220
1221 =head1 REQUIREMENTS
1222
1223 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).
1224
1225 =head1 ACKNOWLEDGEMENTS
1226
1227 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.
1228
1229 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.
1230
1231 =head1 CONTACT
1232
1233 =over 4
1234
1235 =item EMAIL: proj-exipick@jetmore.net
1236
1237 =item HOME: jetmore.org/john/code/#exipick
1238
1239 =back
1240
1241 =cut