← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/exiqgrep.src

  • Committer: Bazaar Package Importer
  • Author(s): Michael Bienia
  • Date: 2010-01-01 16:28:19 UTC
  • mfrom: (2.1.5 sid)
  • Revision ID: james.westby@ubuntu.com-20100101162819-htn71my7yj4v1vkr
Tags: 4.71-3ubuntu1
https://launchpad.net/bugs/501657
* Merge with Debian unstable (lp: #501657). 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
    (Debian bug 542726).

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/exiqgrep.src
 
1
#!PERL_COMMAND
 
2
# $Cambridge: exim/exim-src/src/exiqgrep.src,v 1.1 2004/10/07 10:39:01 ph10 Exp $
 
3
 
 
4
# Utility for searching and displaying queue information.
 
5
# Written by Matt Hubbard 15 August 2002
 
6
 
 
7
# Except when they appear in comments, the following placeholders in this
 
8
# source are replaced when it is turned into a runnable script:
 
9
#
 
10
# BIN_DIRECTORY
 
11
# PERL_COMMAND
 
12
 
 
13
# PROCESSED_FLAG
 
14
 
 
15
 
 
16
# Routine for extracting the UTC timestamp from message ID
 
17
# lifted from eximstat utility
 
18
 
 
19
# Version 1.1
 
20
 
 
21
use strict;
 
22
use Getopt::Std;
 
23
 
 
24
# Have this variable point to your exim binary.
 
25
my $exim = 'BIN_DIRECTORY/exim4';
 
26
my $eargs = '-bpu';
 
27
my %id;
 
28
my %opt;
 
29
my $count = 0;
 
30
my $mcount = 0;
 
31
my @tab62 =
 
32
  (0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0,     # 0-9
 
33
   0,10,11,12,13,14,15,16,17,18,19,20,  # A-K
 
34
  21,22,23,24,25,26,27,28,29,30,31,32,  # L-W
 
35
  33,34,35, 0, 0, 0, 0, 0,              # X-Z
 
36
   0,36,37,38,39,40,41,42,43,44,45,46,  # a-k
 
37
  47,48,49,50,51,52,53,54,55,56,57,58,  # l-w
 
38
  59,60,61);                            # x-z
 
39
 
 
40
my $base;
 
41
if ($^O eq 'darwin') { # aka MacOS X
 
42
  $base = 36;
 
43
 } else {
 
44
  $base = 62;
 
45
};
 
46
 
 
47
getopts('hf:r:y:o:s:zxlibRc',\%opt);
 
48
if ($opt{h}) { &help; exit;}
 
49
 
 
50
# Read message queue output into hash
 
51
&collect();
 
52
# Identify which messages match selection criteria
 
53
&selection();
 
54
# Print matching data according to display option.
 
55
&display();
 
56
exit;
 
57
 
 
58
 
 
59
sub help() {
 
60
        print <<'EOF'
 
61
Exim message queue display utility.
 
62
 
 
63
        -h              This help message.
 
64
 
 
65
Selection criteria:
 
66
        -f <regexp>     Match sender address sender (field is "< >" wrapped)
 
67
        -r <regexp>     Match recipient address
 
68
        -s <regexp>     Match against the size field from long output
 
69
        -y <seconds>    Message younger than
 
70
        -o <seconds>    Message older than
 
71
        -z              Frozen messages only (exclude non-frozen)
 
72
        -x              Non-frozen messages only (exclude frozen)
 
73
 
 
74
[ NB: for regexps, provided string sits in /<string>/ ]
 
75
 
 
76
Display options:
 
77
        -c              Display match count
 
78
        -l              Long Format [Default]
 
79
        -i              Message IDs only
 
80
        -b              Brief Format
 
81
        -R              Reverse order
 
82
EOF
 
83
}
 
84
 
 
85
sub collect() {
 
86
        open(QUEUE,"$exim $eargs |") or die("Error openning pipe: $!\n");
 
87
        while(<QUEUE>) {
 
88
                chomp();
 
89
                my $line = $_;
 
90
                #Should be 1st line of record, if not error.
 
91
                if ($line =~ /^\s*(\w+)\s+(\S+)\s+(\w{6}-\w{6}-\w{2})\s+(<.*?>)/) {
 
92
                        my $msg = $3;
 
93
                        $id{$msg}{age} = $1;
 
94
                        $id{$msg}{size} = $2;
 
95
                        $id{$msg}{from} = $4;
 
96
                        $id{$msg}{birth} = &msg_utc($msg);
 
97
                        $id{$msg}{ages} = time - $id{$msg}{birth};
 
98
                        if ($line =~ /\*\*\* frozen \*\*\*$/) {
 
99
                                $id{$msg}{frozen} = 1;
 
100
                        } else {
 
101
                                $id{$msg}{frozen} = 0;
 
102
                        }
 
103
                        while(<QUEUE> =~ /\s+(.*?\@.*)$/) {
 
104
                                push(@{$id{$msg}{rcpt}},$1);
 
105
                        }
 
106
                        # Increment message counter.
 
107
                        $count++;
 
108
                } else {
 
109
                       if ($line =~ /^\s*(\w+)\s+(\w{6}-\w{6}-\w{2})\s+(<.*?>)/) {
 
110
                               my $msg = $2;
 
111
                               $id{$msg}{age} = $1;
 
112
                               $id{$msg}{size} = "0K";
 
113
                               $id{$msg}{from} = $3;
 
114
                               $id{$msg}{birth} = &msg_utc($msg);
 
115
                               $id{$msg}{ages} = time - $id{$msg}{birth};
 
116
                               if ($line =~ /\*\*\* frozen \*\*\*$/) {
 
117
                                       $id{$msg}{frozen} = 1;
 
118
                               } else {
 
119
                                       $id{$msg}{frozen} = 0;
 
120
                               }
 
121
                               while(<QUEUE> =~ /\s+(.*?\@.*)$/) {
 
122
                                       push(@{$id{$msg}{rcpt}},$1);
 
123
                               }
 
124
                               # Increment message counter.
 
125
                               $count++;
 
126
                       } else { 
 
127
                               print STDERR "Line mismatch: $line\n"; exit 1;
 
128
                       }
 
129
                }
 
130
        }
 
131
        close(QUEUE) or die("Error closing pipe: $!\n");
 
132
}
 
133
 
 
134
sub selection() {
 
135
        foreach my $msg (keys(%id)) {
 
136
                if ($opt{f}) {
 
137
                        # Match sender address
 
138
                        next unless ($id{$msg}{from} =~ /$opt{f}/);
 
139
                }
 
140
                if ($opt{r}) {
 
141
                        # Match any recipient address
 
142
                        my $match = 0;
 
143
                        foreach my $rcpt (@{$id{$msg}{rcpt}}) {
 
144
                                $match++ if ($rcpt =~ /$opt{r}/);
 
145
                        }
 
146
                        next unless ($match);
 
147
                }
 
148
                if ($opt{s}) {
 
149
                        # Match against the size string.
 
150
                        next unless ($id{$msg}{size} =~ /$opt{s}/);
 
151
                }
 
152
                if ($opt{y}) {
 
153
                        # Match younger than
 
154
                        next unless ($id{$msg}{ages} < $opt{y});
 
155
                }
 
156
                if ($opt{o}) {
 
157
                        # Match older than
 
158
                        next unless ($id{$msg}{ages} > $opt{o});
 
159
                }
 
160
                if ($opt{z}) {
 
161
                        # Exclude non frozen
 
162
                        next unless ($id{$msg}{frozen});
 
163
                }
 
164
                if ($opt{x}) {
 
165
                        # Exclude frozen
 
166
                        next if ($id{$msg}{frozen});
 
167
                }
 
168
                # Here's what we do to select the record.
 
169
                # Should only get this far if the message passed all of
 
170
                # the active tests.
 
171
                $id{$msg}{d} = 1;
 
172
                # Increment match counter.
 
173
                $mcount++;
 
174
        }
 
175
}
 
176
 
 
177
sub display() {
 
178
        if ($opt{c}) {
 
179
                printf("%d matches out of %d messages\n",$mcount,$count);
 
180
                exit;
 
181
        }
 
182
        foreach my $msg (sort { $opt{R} ? $id{$b}{birth} <=> $id{$a}{birth} : $id{$a}{birth} <=> $id{$b}{birth} } keys(%id) ) {
 
183
                if (exists($id{$msg}{d})) {
 
184
                        if ($opt{i}) {
 
185
                                # Just the msg ID
 
186
                                print $msg, "\n";
 
187
                        } elsif ($opt{b}) {
 
188
                                # Brief format
 
189
                                printf("%s From: %s To: %s\n",$msg,$id{$msg}{from},join(';',@{$id{$msg}{rcpt}}))
 
190
                        } else {
 
191
                                # Otherwise Long format attempted duplication of original format.
 
192
                                printf("%3s %5s %s %s%s\n",$id{$msg}{age},$id{$msg}{size},$msg,$id{$msg}{from},$id{$msg}{frozen} ? " *** frozen ***" : "");
 
193
                                foreach my $rcpt (@{$id{$msg}{rcpt}}) {
 
194
                                        printf("          %s\n",$rcpt);
 
195
                                }
 
196
                                print "\n";
 
197
                        }
 
198
                }
 
199
        }
 
200
}
 
201
 
 
202
sub report() {
 
203
        foreach my $msg (keys(%id)) {
 
204
                print "$id{$msg}{birth} $msg\tAge: $id{$msg}{age}\tSize: $id{$msg}{size}\tFrom: $id{$msg}{from}\tTo: " . join(" ",@{$id{$msg}{rcpt}}). "\n";
 
205
        }
 
206
}
 
207
 
 
208
sub msg_utc() {
 
209
        my $id = substr((pop @_), 0, 6);
 
210
        my $s = 0;
 
211
        my @c = split(//, $id);
 
212
        while($#c >= 0) { $s = $s * $base + $tab62[ord(shift @c) - ord('0')] }
 
213
        return $s;
 
214
}