#!PERL_COMMAND
-# $Cambridge: exim/src/src/exipick.src,v 1.14 2006/11/17 22:27:41 jetmore Exp $
+# $Cambridge: exim/src/src/exipick.src,v 1.17 2010/03/23 14:06:48 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 = "20061117.2";
+my $p_version = "20100323.0";
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
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 {
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
$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') {
=item -bpra
-Same as '-bpr --unsorted' (exim)
+Same as '-bpa --unsorted' (exim)
=item -bpru
=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
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 -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 --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
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.
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.
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 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
git://git.exim.org / exim.git / blobdiff