#!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';
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>
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
$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);
$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) {
}
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]$/) {
bless($self, $class);
$self->{_spool_dir} = '';
+ $self->{_input_path} = '';
$self->{_undelivered_only} = 0;
$self->{_show_generated} = 0;
$self->{_output_long} = 1;
$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;
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};
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);
}
}
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 {
$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;
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): $_");
=item -bpra
-Same as '-bpr --unsorted' (exim)
+Same as '-bpa --unsorted' (exim)
=item -bpru
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
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 --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
=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'
=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
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.