← Back to branch summary

~ubuntu-branches/ubuntu/natty/exim4/natty

« back to all changes in this revision

Viewing changes to src/exipick.src

  • Committer: Bazaar Package Importer
  • Author(s): Artur Rona
  • Date: 2010-07-25 02:00:42 UTC
  • mfrom: (2.1.7 sid)
  • Revision ID: james.westby@ubuntu.com-20100725020042-bk1uw1p7ysmnsn9f
Tags: 4.72-1ubuntu1
https://launchpad.net/bugs/609620
http://bugs.debian.org/542726
* Merge with Debian unstable (LP: #609620). Remaining changes:
  + debian/patches/71_exiq_grep_error_on_messages_without_size.dpatch:
    Improve handling of broken messages when "exim4 -bp" (mailq) reports
    lines without size info.
  + Don't declare a Provides: default-mta; in Ubuntu, we want postfix to be
    the default.
  + debian/control: Change build dependencies to MySQL 5.1.
  + debian/{control,rules}: add and enable hardened build for PIE
    (Closes: #542726).

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/exipick.src
1
1
#!PERL_COMMAND
2
 
# $Cambridge: exim/exim-src/src/exipick.src,v 1.14 2006/11/17 22:27:41 jetmore Exp $
 
2
# $Cambridge: exim/exim-src/src/exipick.src,v 1.17 2010/03/23 14:06:48 jetmore Exp $
3
3
 
4
4
# This variable should be set by the building process to Exim's spool directory.
5
5
my $spool = 'SPOOL_DIRECTORY';
14
14
use Getopt::Long;
15
15
 
16
16
my($p_name)   = $0 =~ m|/?([^/]+)$|;
17
 
my $p_version = "20061117.2";
 
17
my $p_version = "20100323.0";
18
18
my $p_usage   = "Usage: $p_name [--help|--version] (see --help for details)";
19
19
my $p_cp      = <<EOM;
20
 
        Copyright (c) 2003-2006 John Jetmore <jj33\@pobox.com>
 
20
        Copyright (c) 2003-2010 John Jetmore <jj33\@pobox.com>
21
21
 
22
22
    This program is free software; you can redistribute it and/or modify
23
23
    it under the terms of the GNU General Public License as published by
40
40
Getopt::Long::Configure("bundling_override");
41
41
GetOptions(
42
42
  'spool=s'     => \$G::spool,      # exim spool dir
 
43
  'input-dir=s' => \$G::input_dir,  # name of the "input" dir
 
44
  'finput'      => \$G::finput,     # same as "--input-dir Finput"
43
45
  'bp'          => \$G::mailq_bp,   # List the queue (noop - default)
44
46
  'bpa'         => \$G::mailq_bpa,  # ... with generated address as well
45
47
  'bpc'         => \$G::mailq_bpc,  # ... but just show a count of messages
111
113
$G::caseless        = $G::caseful ? 0 : 1; # nocase by default, case if both
112
114
@G::recipients_crit = ();                  # holds per-recip criteria
113
115
$spool              = $G::spool if ($G::spool);
 
116
my $input_dir       = $G::input_dir || ($G::finput ? "Finput" : "input");
114
117
my $count_only      = 1 if ($G::mailq_bpc  || $G::qgrep_c);
115
118
my $unsorted        = 1 if ($G::mailq_bpr  || $G::mailq_bpra ||
116
119
                            $G::mailq_bpru || $G::unsorted);
117
120
my $msg             = $G::thaw ? thaw_message_list()
118
 
                               : get_all_msgs($spool, $unsorted,
 
121
                               : get_all_msgs($spool, $input_dir, $unsorted,
119
122
                                              $G::reverse, $G::random);
120
123
die "Problem accessing thaw file\n" if ($G::thaw && !$msg);
121
124
my $crit            = process_criteria(\@ARGV);
131
134
$e->output_flatq()               if ($G::flatq);
132
135
$e->output_vars_only()           if ($G::just_vars && $G::show_vars);
133
136
$e->set_show_vars($G::show_vars) if ($G::show_vars);
134
 
$e->set_spool($spool);
 
137
$e->set_spool($spool, $input_dir);
135
138
 
136
139
MSG:
137
140
foreach my $m (@$msg) {
396
399
}
397
400
 
398
401
sub get_all_msgs {
399
 
  my $d = shift() . '/input';
 
402
  my $d = shift();
 
403
  my $i = shift();
400
404
  my $u = shift; # don't sort
401
405
  my $r = shift; # right before returning, reverse order
402
406
  my $o = shift; # if true, randomize list order before returning
403
407
  my @m = ();
404
408
 
 
409
  if ($i =~ m|^/|) { $d = $i; } else { $d = $d . '/' . $i; }
 
410
 
405
411
  opendir(D, "$d") || die "Couldn't opendir $d: $!\n";
406
412
  foreach my $e (grep !/^\./, readdir(D)) {
407
413
    if ($e =~ /^[a-zA-Z0-9]$/) {
446
452
  bless($self, $class);
447
453
 
448
454
  $self->{_spool_dir}        = '';
 
455
  $self->{_input_path}       = '';
449
456
  $self->{_undelivered_only} = 0;
450
457
  $self->{_show_generated}   = 0;
451
458
  $self->{_output_long}      = 1;
563
570
  $self->_reset();
564
571
  $self->{_message} = shift || return(0);
565
572
  $self->{_path}    = shift; # optional path to message
566
 
  return(0) if (!$self->{_spool_dir});
 
573
  return(0) if (!$self->{_input_path});
567
574
  if (!$self->{_path} && !$self->_find_path()) {
568
575
    # assume the message was delivered from under us and ignore
569
576
    $self->{_delivered} = 1;
584
591
  return(1) if ($h->{_delivered});
585
592
  $self->_reset();
586
593
  $self->{_message} = $h->{_message} || return(0);
587
 
  return(0) if (!$self->{_spool_dir});
 
594
  return(0) if (!$self->{_input_path});
588
595
 
589
596
  $self->{_path}      = $h->{_path};
590
597
  $self->{_vars}      = $h->{_vars};
630
637
  my $self = shift;
631
638
 
632
639
  return(0) if (!$self->{_message});
633
 
  return(0) if (!$self->{_spool_dir});
 
640
  return(0) if (!$self->{_input_path});
634
641
 
635
642
  # test split spool first on the theory that people concerned about
636
643
  # performance will have split spool set =).
637
644
  foreach my $f (substr($self->{_message}, 5, 1).'/', '') {
638
 
    if (-f "$self->{_spool_dir}/input/$f$self->{_message}-H") {
639
 
      $self->{_path} = $self->{_spool_dir} . "/input/$f";
 
645
    if (-f "$self->{_input_path}/$f$self->{_message}-H") {
 
646
      $self->{_path} = "$self->{_input_path}}/$f";
640
647
      return(1);
641
648
    }
642
649
  }
646
653
sub set_spool {
647
654
  my $self = shift;
648
655
  $self->{_spool_dir} = shift;
 
656
  $self->{_input_path} = shift;
 
657
  if ($self->{_input_path} !~ m|^/|) {
 
658
    $self->{_input_path} = $self->{_spool_dir} . '/' . $self->{_input_path};
 
659
  }
649
660
}
650
661
 
651
662
sub get_matching_vars {
827
838
sub _parse_header {
828
839
  my $self = shift;
829
840
  my $f    = $self->{_path} . '/' . $self->{_message} . '-H';
 
841
  $self->{_vars}{header_path} = $f;
 
842
  $self->{_vars}{data_path}   = $self->{_path} . '/' . $self->{_message} . '-D';
830
843
 
831
844
  if (!open(I, "<$f")) {
832
845
    # assume message went away and silently ignore
914
927
        $self->{_vars}{host_lookup_failed} = 1;
915
928
      } elsif ($tag eq '-body_linecount') {
916
929
        $self->{_vars}{body_linecount} = $arg;
 
930
      } elsif ($tag eq '-max_received_linelength') {
 
931
        $self->{_vars}{max_received_linelength} = $arg;
917
932
      } elsif ($tag eq '-body_zerocount') {
918
933
        $self->{_vars}{body_zerocount} = $arg;
919
934
      } elsif ($tag eq '-frozen') {
1317
1332
 
1318
1333
=item -bpra
1319
1334
 
1320
 
Same as '-bpr --unsorted' (exim)
 
1335
Same as '-bpa --unsorted' (exim)
1321
1336
 
1322
1337
=item -bpru
1323
1338
 
1341
1356
 
1342
1357
=item -f <regexp>
1343
1358
 
1344
 
Same as '$sender_address = <regexp>' (exiqgrep)
 
1359
Same as '$sender_address =~ /<regexp>/' (exiqgrep).  Note that this preserves the default case sensitivity of exiqgrep's interface.
 
1360
 
 
1361
=item --finput
 
1362
 
 
1363
Same as '--input-dir Finput'.  'Finput' is where exim copies frozen messages when compiled with SUPPORT_MOVE_FROZEN_MESSAGES.
1345
1364
 
1346
1365
=item --flatq
1347
1366
 
1359
1378
 
1360
1379
Display only the message IDs (exiqgrep)
1361
1380
 
 
1381
=item --input-dir <inputname>
 
1382
 
 
1383
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.
 
1384
 
1362
1385
=item -l
1363
1386
 
1364
1387
Same as -bp (exiqgrep)
1381
1404
 
1382
1405
=item -r <regexp>
1383
1406
 
1384
 
Same as '$recipients = <regexp>' (exiqgrep)
 
1407
Same as '$recipients =~ /<regexp>/' (exiqgrep).  Note that this preserves the default case sensitivity of exiqgrep's interface.
1385
1408
 
1386
1409
=item --random
1387
1410
 
1397
1420
 
1398
1421
=item --spool <path>
1399
1422
 
1400
 
Set the path to the exim spool to use
 
1423
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.
1401
1424
 
1402
1425
=item --show-rules
1403
1426
 
1535
1558
 
1536
1559
The number of binary zero bytes in the message's body.
1537
1560
 
 
1561
=item S + $data_path
 
1562
 
 
1563
The path to the body file's location in the filesystem.
 
1564
 
1538
1565
=item B + $deliver_freeze
1539
1566
 
1540
1567
TRUE if the message is currently frozen.
1567
1594
 
1568
1595
This will always match the contents of the corresponding $bheader_* variable currently (the same behaviour Exim displays when iconv is not installed).
1569
1596
 
 
1597
=item S + $header_path
 
1598
 
 
1599
The path to the header file's location in the filesystem.
 
1600
 
1570
1601
=item B . $host_lookup_deferred
1571
1602
 
1572
1603
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
1618
 
1588
1619
TRUE when the message has been manually thawed.
1589
1620
 
 
1621
=item N . $max_received_linelength
 
1622
 
 
1623
The number of bytes in the longest line that was received as part of the message, not counting line termination characters.
 
1624
 
1590
1625
=item N . $message_age
1591
1626
 
1592
1627
The number of seconds since the message was received.