Support use of system default CA bundle
[users/heiko/exim.git] / src / src / exipick.src
index 931ff51aa83a6900f54672712a967561f9657aad..4708ebb4a29d4e4419d9d54b5bbdf472329628dc 100644 (file)
@@ -1,5 +1,4 @@
 #!PERL_COMMAND
-# $Cambridge: exim/src/src/exipick.src,v 1.15 2010/01/04 18:16:54 jetmore Exp $
 
 # This variable should be set by the building process to Exim's spool directory.
 my $spool = 'SPOOL_DIRECTORY';
@@ -14,7 +13,7 @@ use strict;
 use Getopt::Long;
 
 my($p_name)   = $0 =~ m|/?([^/]+)$|;
-my $p_version = "20100104.1";
+my $p_version = "20100323.0";
 my $p_usage   = "Usage: $p_name [--help|--version] (see --help for details)";
 my $p_cp      = <<EOM;
         Copyright (c) 2003-2010 John Jetmore <jj33\@pobox.com>
@@ -40,6 +39,8 @@ $| = 1; # unbuffer STDOUT
 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
@@ -111,11 +112,12 @@ $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);
+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()
-                               : 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);
@@ -131,7 +133,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->set_spool($spool);
+$e->set_spool($spool, $input_dir);
 
 MSG:
 foreach my $m (@$msg) {
@@ -396,12 +398,15 @@ sub process_criteria {
 }
 
 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 = ();
 
+  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]$/) {
@@ -446,6 +451,7 @@ sub new {
   bless($self, $class);
 
   $self->{_spool_dir}        = '';
+  $self->{_input_path}       = '';
   $self->{_undelivered_only} = 0;
   $self->{_show_generated}   = 0;
   $self->{_output_long}      = 1;
@@ -563,7 +569,7 @@ sub parse_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;
@@ -584,7 +590,7 @@ sub restore_state {
   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};
@@ -630,13 +636,13 @@ sub _find_path {
   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).'/', '') {
-    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);
     }
   }
@@ -646,6 +652,10 @@ sub _find_path {
 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 {
@@ -945,6 +955,8 @@ sub _parse_header {
         $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;
@@ -1008,6 +1020,12 @@ sub _parse_header {
       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): $_");
@@ -1321,7 +1339,7 @@ Same as '-bp --unsorted' (exim)
 
 =item -bpra
 
-Same as '-bpr --unsorted' (exim)
+Same as '-bpa --unsorted' (exim)
 
 =item -bpru
 
@@ -1347,6 +1365,10 @@ Override the default local character set for $header_ decoding
 
 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
 
 Use a single-line output format
@@ -1363,6 +1385,10 @@ Display this output
 
 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)
@@ -1401,7 +1427,7 @@ Same as '$shown_message_size eq <string>' (exiqgrep)
 
 =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.
 
 =item --show-rules
 
@@ -1469,7 +1495,7 @@ Boolean variables are checked simply by being true or false.  There is no real o
 
 =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'
@@ -1483,7 +1509,7 @@ The string operators are =, eq, ne, =~, and !~.  With the exception of '=', the
 
 =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
 
@@ -1775,6 +1801,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
 
+=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.