projects / exim.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
PROXY: fix v2 protocol decode. Bugs 2003, 1747
[exim.git] / src / src / exipick.src
diff --git a/src/src/exipick.src b/src/src/exipick.src
index e4df56b3055eed41e35cc73eb32e9e6af1ae03d8..bdeba95fc66488c66fe23f3c92741ebdd7ba965e 100644 (file)
--- a/src/src/exipick.src
+++ b/src/src/exipick.src
@@ -1,8 +1,9 @@
 #!PERL_COMMAND
 #!PERL_COMMAND
-# $Cambridge: exim/src/src/exipick.src,v 1.14 2006/11/17 22:27:41 jetmore Exp $
 
 
-# This variable should be set by the building process to Exim's spool directory.
-my $spool = 'SPOOL_DIRECTORY';
+# This variables should be set by the building process
+my $spool = 'SPOOL_DIRECTORY'; # may be overridden later
+my $exim  = 'BIN_DIRECTORY/exim';
+
 # Need to set this dynamically during build, but it's not used right now anyway.
 my $charset = 'ISO-8859-1';
 
 # Need to set this dynamically during build, but it's not used right now anyway.
 my $charset = 'ISO-8859-1';
 
@@ -14,10 +15,10 @@ use strict;
 use Getopt::Long;
 
 my($p_name)   = $0 =~ m|/?([^/]+)$|;
 use Getopt::Long;
 
 my($p_name)   = $0 =~ m|/?([^/]+)$|;
-my $p_version = "20061117.2";
+my $p_version = "20100323.0";
 my $p_usage   = "Usage: $p_name [--help|--version] (see --help for details)";
 my $p_cp      = <<EOM;
 my $p_usage   = "Usage: $p_name [--help|--version] (see --help for details)";
 my $p_cp      = <<EOM;
-        Copyright (c) 2003-2006 John Jetmore <jj33\@pobox.com>
+        Copyright (c) 2003-2010 John Jetmore <jj33\@pobox.com>
 
     This program is free software; you can redistribute it and/or modify
     it under the terms of the GNU General Public License as published by
 
     This program is free software; you can redistribute it and/or modify
     it under the terms of the GNU General Public License as published by
@@ -40,6 +41,8 @@ $| = 1; # unbuffer STDOUT
 Getopt::Long::Configure("bundling_override");
 GetOptions(
   'spool=s'     => \$G::spool,      # exim spool dir
 Getopt::Long::Configure("bundling_override");
 GetOptions(
   'spool=s'     => \$G::spool,      # exim spool dir
+  'input-dir=s' => \$G::input_dir,  # name of the "input" dir
+  'finput'      => \$G::finput,     # same as "--input-dir Finput"
   'bp'          => \$G::mailq_bp,   # List the queue (noop - default)
   'bpa'         => \$G::mailq_bpa,  # ... with generated address as well
   'bpc'         => \$G::mailq_bpc,  # ... but just show a count of messages
   'bp'          => \$G::mailq_bp,   # List the queue (noop - default)
   'bpa'         => \$G::mailq_bpa,  # ... with generated address as well
   'bpc'         => \$G::mailq_bpc,  # ... but just show a count of messages
@@ -110,12 +113,15 @@ $G::and             = $G::and;             # shut up -w
 $G::msg_ids         = {};                  # short circuit when crit is only MID
 $G::caseless        = $G::caseful ? 0 : 1; # nocase by default, case if both
 @G::recipients_crit = ();                  # holds per-recip criteria
 $G::msg_ids         = {};                  # short circuit when crit is only MID
 $G::caseless        = $G::caseful ? 0 : 1; # nocase by default, case if both
 @G::recipients_crit = ();                  # holds per-recip criteria
-$spool              = $G::spool if ($G::spool);
+$spool              = defined $G::spool ? $G::spool
+                     : do { chomp($_ = `$exim -n -bP spool_directory`);
+                       $_ // $spool };
+my $input_dir       = $G::input_dir || ($G::finput ? "Finput" : "input");
 my $count_only      = 1 if ($G::mailq_bpc  || $G::qgrep_c);
 my $unsorted        = 1 if ($G::mailq_bpr  || $G::mailq_bpra ||
                             $G::mailq_bpru || $G::unsorted);
 my $msg             = $G::thaw ? thaw_message_list()
 my $count_only      = 1 if ($G::mailq_bpc  || $G::qgrep_c);
 my $unsorted        = 1 if ($G::mailq_bpr  || $G::mailq_bpra ||
                             $G::mailq_bpru || $G::unsorted);
 my $msg             = $G::thaw ? thaw_message_list()
-                               : get_all_msgs($spool, $unsorted,
+                               : get_all_msgs($spool, $input_dir, $unsorted,
                                               $G::reverse, $G::random);
 die "Problem accessing thaw file\n" if ($G::thaw && !$msg);
 my $crit            = process_criteria(\@ARGV);
                                               $G::reverse, $G::random);
 die "Problem accessing thaw file\n" if ($G::thaw && !$msg);
 my $crit            = process_criteria(\@ARGV);
@@ -131,7 +137,7 @@ $e->output_brief()               if ($G::qgrep_b);
 $e->output_flatq()               if ($G::flatq);
 $e->output_vars_only()           if ($G::just_vars && $G::show_vars);
 $e->set_show_vars($G::show_vars) if ($G::show_vars);
 $e->output_flatq()               if ($G::flatq);
 $e->output_vars_only()           if ($G::just_vars && $G::show_vars);
 $e->set_show_vars($G::show_vars) if ($G::show_vars);
-$e->set_spool($spool);
+$e->set_spool($spool, $input_dir);
 
 MSG:
 foreach my $m (@$msg) {
 
 MSG:
 foreach my $m (@$msg) {
@@ -396,12 +402,15 @@ sub process_criteria {
 }
 
 sub get_all_msgs {
 }
 
 sub get_all_msgs {
-  my $d = shift() . '/input';
+  my $d = shift();
+  my $i = shift();
   my $u = shift; # don't sort
   my $r = shift; # right before returning, reverse order
   my $o = shift; # if true, randomize list order before returning
   my @m = ();
 
   my $u = shift; # don't sort
   my $r = shift; # right before returning, reverse order
   my $o = shift; # if true, randomize list order before returning
   my @m = ();
 
+  if ($i =~ m|^/|) { $d = $i; } else { $d = $d . '/' . $i; }
+
   opendir(D, "$d") || die "Couldn't opendir $d: $!\n";
   foreach my $e (grep !/^\./, readdir(D)) {
     if ($e =~ /^[a-zA-Z0-9]$/) {
   opendir(D, "$d") || die "Couldn't opendir $d: $!\n";
   foreach my $e (grep !/^\./, readdir(D)) {
     if ($e =~ /^[a-zA-Z0-9]$/) {
@@ -446,6 +455,7 @@ sub new {
   bless($self, $class);
 
   $self->{_spool_dir}        = '';
   bless($self, $class);
 
   $self->{_spool_dir}        = '';
+  $self->{_input_path}       = '';
   $self->{_undelivered_only} = 0;
   $self->{_show_generated}   = 0;
   $self->{_output_long}      = 1;
   $self->{_undelivered_only} = 0;
   $self->{_show_generated}   = 0;
   $self->{_output_long}      = 1;
@@ -563,7 +573,7 @@ sub parse_message {
   $self->_reset();
   $self->{_message} = shift || return(0);
   $self->{_path}    = shift; # optional path to message
   $self->_reset();
   $self->{_message} = shift || return(0);
   $self->{_path}    = shift; # optional path to message
-  return(0) if (!$self->{_spool_dir});
+  return(0) if (!$self->{_input_path});
   if (!$self->{_path} && !$self->_find_path()) {
     # assume the message was delivered from under us and ignore
     $self->{_delivered} = 1;
   if (!$self->{_path} && !$self->_find_path()) {
     # assume the message was delivered from under us and ignore
     $self->{_delivered} = 1;
@@ -584,7 +594,7 @@ sub restore_state {
   return(1) if ($h->{_delivered});
   $self->_reset();
   $self->{_message} = $h->{_message} || return(0);
   return(1) if ($h->{_delivered});
   $self->_reset();
   $self->{_message} = $h->{_message} || return(0);
-  return(0) if (!$self->{_spool_dir});
+  return(0) if (!$self->{_input_path});
 
   $self->{_path}      = $h->{_path};
   $self->{_vars}      = $h->{_vars};
 
   $self->{_path}      = $h->{_path};
   $self->{_vars}      = $h->{_vars};
@@ -630,13 +640,13 @@ sub _find_path {
   my $self = shift;
 
   return(0) if (!$self->{_message});
   my $self = shift;
 
   return(0) if (!$self->{_message});
-  return(0) if (!$self->{_spool_dir});
+  return(0) if (!$self->{_input_path});
 
   # test split spool first on the theory that people concerned about
   # performance will have split spool set =).
   foreach my $f (substr($self->{_message}, 5, 1).'/', '') {
 
   # test split spool first on the theory that people concerned about
   # performance will have split spool set =).
   foreach my $f (substr($self->{_message}, 5, 1).'/', '') {
-    if (-f "$self->{_spool_dir}/input/$f$self->{_message}-H") {
-      $self->{_path} = $self->{_spool_dir} . "/input/$f";
+    if (-f "$self->{_input_path}/$f$self->{_message}-H") {
+      $self->{_path} = "$self->{_input_path}}/$f";
       return(1);
     }
   }
       return(1);
     }
   }
@@ -646,6 +656,10 @@ sub _find_path {
 sub set_spool {
   my $self = shift;
   $self->{_spool_dir} = shift;
 sub set_spool {
   my $self = shift;
   $self->{_spool_dir} = shift;
+  $self->{_input_path} = shift;
+  if ($self->{_input_path} !~ m|^/|) {
+    $self->{_input_path} = $self->{_spool_dir} . '/' . $self->{_input_path};
+  }
 }
 
 sub get_matching_vars {
 }
 
 sub get_matching_vars {
@@ -827,6 +841,8 @@ sub _parse_body {
 sub _parse_header {
   my $self = shift;
   my $f    = $self->{_path} . '/' . $self->{_message} . '-H';
 sub _parse_header {
   my $self = shift;
   my $f    = $self->{_path} . '/' . $self->{_message} . '-H';
+  $self->{_vars}{header_path} = $f;
+  $self->{_vars}{data_path}   = $self->{_path} . '/' . $self->{_message} . '-D';
 
   if (!open(I, "<$f")) {
     # assume message went away and silently ignore
 
   if (!open(I, "<$f")) {
     # assume message went away and silently ignore
@@ -914,6 +930,8 @@ sub _parse_header {
         $self->{_vars}{host_lookup_failed} = 1;
       } elsif ($tag eq '-body_linecount') {
         $self->{_vars}{body_linecount} = $arg;
         $self->{_vars}{host_lookup_failed} = 1;
       } elsif ($tag eq '-body_linecount') {
         $self->{_vars}{body_linecount} = $arg;
+      } elsif ($tag eq '-max_received_linelength') {
+        $self->{_vars}{max_received_linelength} = $arg;
       } elsif ($tag eq '-body_zerocount') {
         $self->{_vars}{body_zerocount} = $arg;
       } elsif ($tag eq '-frozen') {
       } elsif ($tag eq '-body_zerocount') {
         $self->{_vars}{body_zerocount} = $arg;
       } elsif ($tag eq '-frozen') {
@@ -941,6 +959,8 @@ sub _parse_header {
         $self->{_vars}{tls_cipher} = $arg;
       } elsif ($tag eq '-tls_peerdn') {
         $self->{_vars}{tls_peerdn} = $arg;
         $self->{_vars}{tls_cipher} = $arg;
       } elsif ($tag eq '-tls_peerdn') {
         $self->{_vars}{tls_peerdn} = $arg;
+      } elsif ($tag eq '-tls_sni') {
+        $self->{_vars}{tls_sni} = $arg;
       } elsif ($tag eq '-host_address') {
         $self->{_vars}{sender_host_port} = $self->_get_host_and_port(\$arg);
         $self->{_vars}{sender_host_address} = $arg;
       } elsif ($tag eq '-host_address') {
         $self->{_vars}{sender_host_port} = $self->_get_host_and_port(\$arg);
         $self->{_vars}{sender_host_address} = $arg;
@@ -1004,6 +1024,12 @@ sub _parse_header {
       return($self->_error("incorrect format: $_")) if (length($2) != $3);
       $self->{_recips}{$1} = { pno => $4, errors_to => $2 };
       $addr = $1;
       return($self->_error("incorrect format: $_")) if (length($2) != $3);
       $self->{_recips}{$1} = { pno => $4, errors_to => $2 };
       $addr = $1;
+    } elsif (/^(\S*)\s(\S*)\s(\d+),(\d+)\s(\S*)\s(\d+),(-?\d+)#3$/) {
+      #print STDERR "exim4 new type #3 DSN (untested): $_\n";
+      return($self->_error("incorrect format: $_"))
+        if ((length($2) != $3) || (length($5) != $6));
+      $self->{_recips}{$1} = { pno => $7, errors_to => $5 };
+      $addr = $1;
     } elsif (/^.*#(\d+)$/) {
       #print STDERR "exim4 #$1 style (unimplemented): $_\n";
       $self->_error("exim4 #$1 style (unimplemented): $_");
     } elsif (/^.*#(\d+)$/) {
       #print STDERR "exim4 #$1 style (unimplemented): $_\n";
       $self->_error("exim4 #$1 style (unimplemented): $_");
@@ -1317,7 +1343,7 @@ Same as '-bp --unsorted' (exim)
 
 =item -bpra
 
 
 =item -bpra
 
-Same as '-bpr --unsorted' (exim)
+Same as '-bpa --unsorted' (exim)
 
 =item -bpru
 
 
 =item -bpru
 
@@ -1341,7 +1367,11 @@ Override the default local character set for $header_ decoding
 
 =item -f <regexp>
 
 
 =item -f <regexp>
 
-Same as '$sender_address = <regexp>' (exiqgrep)
+Same as '$sender_address =~ /<regexp>/' (exiqgrep).  Note that this preserves the default case sensitivity of exiqgrep's interface.
+
+=item --finput
+
+Same as '--input-dir Finput'.  'Finput' is where exim copies frozen messages when compiled with SUPPORT_MOVE_FROZEN_MESSAGES.
 
 =item --flatq
 
 
 =item --flatq
 
@@ -1359,6 +1389,10 @@ Display this output
 
 Display only the message IDs (exiqgrep)
 
 
 Display only the message IDs (exiqgrep)
 
+=item --input-dir <inputname>
+
+Set the name of the directory under the spool directory.  By defaut this is "input".  If this starts with '/', the value of --spool is ignored.  See also --finput.
+
 =item -l
 
 Same as -bp (exiqgrep)
 =item -l
 
 Same as -bp (exiqgrep)
@@ -1381,7 +1415,7 @@ Same as --reverse (exiqgrep)
 
 =item -r <regexp>
 
 
 =item -r <regexp>
 
-Same as '$recipients = <regexp>' (exiqgrep)
+Same as '$recipients =~ /<regexp>/' (exiqgrep).  Note that this preserves the default case sensitivity of exiqgrep's interface.
 
 =item --random
 
 
 =item --random
 
@@ -1397,7 +1431,8 @@ Same as '$shown_message_size eq <string>' (exiqgrep)
 
 =item --spool <path>
 
 
 =item --spool <path>
 
-Set the path to the exim spool to use
+Set the path to the exim spool to use.  This value will have the argument to --input or 'input' appended, or be ignored if --input is a full path. If not specified, exipick uses the value from C<exim -bP spool_directory>, and if this fails, the  F<SPOOL_DIRECTORY>
+from build time (F<Local/Makefile>) is used.
 
 =item --show-rules
 
 
 =item --show-rules
 
@@ -1465,7 +1500,7 @@ Boolean variables are checked simply by being true or false.  There is no real o
 
 =item NUMERIC
 
 
 =item NUMERIC
 
-Valid comparisons are <, <=, >, >=, ==, and !=.  Numbers can be integers or floats.  Any number in a test suffixed with d, h, m, s, M, K, or B will be mulitplied by 86400, 3600, 60, 1, 1048576, 1024, or 1 respectively.  Examples of valid numeric tests:
+Valid comparisons are <, <=, >, >=, ==, and !=.  Numbers can be integers or floats.  Any number in a test suffixed with d, h, m, s, M, K, or B will be multiplied by 86400, 3600, 60, 1, 1048576, 1024, or 1 respectively.  Examples of valid numeric tests:
   '$message_age >= 3d'
   '$local_interface == 587'
   '$message_size < 30K'
   '$message_age >= 3d'
   '$local_interface == 587'
   '$message_size < 30K'
@@ -1479,7 +1514,7 @@ The string operators are =, eq, ne, =~, and !~.  With the exception of '=', the
 
 =item NEGATION
 
 
 =item NEGATION
 
-There are many ways to negate tests, each having a reason for existing.  Many tests can be negated using native operators.  For instance, >1 is the opposite of <=1 and eq and ne are opposites.  In addition, each individual test can be negated by adding a ! at the beginning of the test.  For instance, '!$acl_m1 =~ /^DENY$/' is the same as '$acl_m1 !~ /^DENY$/'.  Finally, every test can be specified by using the command line argument --not.  This is functionally equivilant to adding a ! to the beginning of every test.
+There are many ways to negate tests, each having a reason for existing.  Many tests can be negated using native operators.  For instance, >1 is the opposite of <=1 and eq and ne are opposites.  In addition, each individual test can be negated by adding a ! at the beginning of the test.  For instance, '!$acl_m1 =~ /^DENY$/' is the same as '$acl_m1 !~ /^DENY$/'.  Finally, every test can be specified by using the command line argument --not.  This is functionally equivalent to adding a ! to the beginning of every test.
 
 =back
 
 
 =back
 
@@ -1535,6 +1570,10 @@ The number of lines in the message's body.
 
 The number of binary zero bytes in the message's body.
 
 
 The number of binary zero bytes in the message's body.
 
+=item S + $data_path
+
+The path to the body file's location in the filesystem.
+
 =item B + $deliver_freeze
 
 TRUE if the message is currently frozen.
 =item B + $deliver_freeze
 
 TRUE if the message is currently frozen.
@@ -1567,6 +1606,10 @@ TRUE if the message has never been deferred.
 
 This will always match the contents of the corresponding $bheader_* variable currently (the same behaviour Exim displays when iconv is not installed).
 
 
 This will always match the contents of the corresponding $bheader_* variable currently (the same behaviour Exim displays when iconv is not installed).
 
+=item S + $header_path
+
+The path to the header file's location in the filesystem.
+
 =item B . $host_lookup_deferred
 
 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.
 =item B . $host_lookup_deferred
 
 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.
@@ -1587,6 +1630,10 @@ The text returned by the local_scan() function when a message is received.
 
 TRUE when the message has been manually thawed.
 
 
 TRUE when the message has been manually thawed.
 
+=item N . $max_received_linelength
+
+The number of bytes in the longest line that was received as part of the message, not counting line termination characters.
+
 =item N . $message_age
 
 The number of seconds since the message was received.
 =item N . $message_age
 
 The number of seconds since the message was received.
@@ -1657,7 +1704,7 @@ The epoch time at which the message was received.
 
 =item S # $recipients
 
 
 =item S # $recipients
 
-The list of envelope recipients for a message.  Unlike Exim's version, this variable always contains every recipient of the message.  The recipients are seperated by a comma and a space.  See also $each_recipients.
+The list of envelope recipients for a message.  Unlike Exim's version, this variable always contains every recipient of the message.  The recipients are separated by a comma and a space.  See also $each_recipients.
 
 =item N . $recipients_count
 
 
 =item N . $recipients_count
 
@@ -1759,6 +1806,10 @@ The cipher suite that was negotiated for encrypted SMTP connections.
 
 The value of the Distinguished Name of the certificate if Exim is configured to request one
 
 
 The value of the Distinguished Name of the certificate if Exim is configured to request one
 
+=item S . $tls_sni
+
+The value of the Server Name Indication TLS extension sent by a client, if one was sent.
+
 =item N + $warning_count
 
 The number of delay warnings which have been sent for this message.
 =item N + $warning_count
 
 The number of delay warnings which have been sent for this message.
Unnamed repository; edit this file 'description' to name the repository.