]>
Commit | Line | Data |
---|---|---|
006417f9 DM |
1 | package PMG::Postfix; |
2 | ||
3 | use strict; | |
4 | use warnings; | |
5 | use Data::Dumper; | |
6 | use File::Find; | |
70805f7d | 7 | use JSON; |
d66ca651 | 8 | use MIME::WordDecoder qw(mime_to_perl_string); |
006417f9 | 9 | |
1925d89d DM |
10 | use PVE::Tools; |
11 | ||
2ee08196 DM |
12 | use PMG::Utils; |
13 | ||
006417f9 DM |
14 | my $spooldir = "/var/spool/postfix"; |
15 | ||
16 | my $postfix_rec_get = sub { | |
17 | my ($fh) = @_; | |
18 | ||
19 | my $r = getc($fh); | |
20 | return if !defined($r); | |
21 | ||
22 | my $l = 0; | |
23 | my $shift = 0; | |
24 | ||
25 | while (defined(my $lb = getc($fh))) { | |
26 | my $o = ord($lb); | |
27 | $l |= ($o & 0x7f) << $shift ; | |
28 | last if (($o & 0x80) == 0); | |
29 | $shift += 7; | |
30 | return if ($shift > 7); # XXX: max rec len of 4096 | |
31 | } | |
32 | ||
33 | my $d = ""; | |
34 | return unless ($l == 0 || read($fh, $d, $l) == $l); | |
35 | return ($r, $l, $d); | |
36 | }; | |
37 | ||
38 | my $postfix_qenv = sub { | |
39 | my ($filename) = @_; | |
40 | ||
41 | my $fh = new IO::File($filename, "r"); | |
42 | return undef if !defined($fh); | |
43 | ||
44 | my $dlen; | |
45 | my $res = { receivers => [] }; | |
46 | while (my ($r, $l, $d) = $postfix_rec_get->($fh)) { | |
47 | #print "test:$r:$l:$d\n"; | |
48 | if ($r eq "C") { $dlen = $1 if $d =~ /^\s*(\d+)\s+\d+\s+\d+/; } | |
49 | elsif ($r eq 'T') { $res->{time} = $1 if $d =~ /^\s*(\d+)\s\d+/; } | |
50 | elsif ($r eq 'S') { $res->{sender} = $d; } | |
51 | elsif ($r eq 'R') { push @{$res->{receivers}}, $d; } | |
52 | elsif ($r eq 'N') { | |
53 | if ($d =~ m/^Subject:\s+(.*)$/i) { | |
54 | $res->{subject} = $1; | |
55 | } elsif (!$res->{messageid} && $d =~ m/^Message-Id:\s+<(.*)>$/i) { | |
56 | $res->{messageid} = $1; | |
57 | } | |
58 | } | |
59 | #elsif ($r eq "M") { last unless defined $dlen; seek($fh, $dlen, 1); } | |
60 | elsif ($r eq "E") { last; } | |
61 | } | |
62 | ||
006417f9 DM |
63 | return $res; |
64 | }; | |
65 | ||
c7533620 | 66 | # Fixme: it is a bad idea to scan everything - list can be too large |
006417f9 | 67 | sub show_deferred_queue { |
006417f9 DM |
68 | my $res; |
69 | ||
70 | my $queue = 'deferred'; | |
71 | ||
72 | my $callback = sub { | |
73 | my $path = $File::Find::name; | |
74 | my $filename = $_; | |
75 | ||
76 | my ($dev, $ino, $mode) = lstat($path); | |
77 | ||
78 | return if !defined($mode); | |
79 | return if !(-f _ && (($mode & 07777) == 0700)); | |
80 | ||
81 | if (my $rec = $postfix_qenv->($path)) { | |
82 | $rec->{queue} = $queue; | |
83 | $rec->{qid} = $filename; | |
84 | push @$res, $rec; | |
85 | } | |
86 | }; | |
87 | ||
88 | find($callback, "$spooldir/deferred"); | |
89 | ||
90 | return $res; | |
91 | } | |
92 | ||
c7533620 DM |
93 | sub qshape { |
94 | my ($queues) = @_; | |
95 | ||
96 | open(my $fh, '-|', '/usr/sbin/qshape', $queues) || die "ERROR: unable to run qshape: $!\n"; | |
97 | ||
98 | my $line = <$fh>; | |
99 | if (!$line || !($line =~ m/^\s+T\s+5\s+10\s+20\s+40\s+80\s+160\s+320\s+640\s+1280\s+1280\+$/)) { | |
c7533620 DM |
100 | die "ERROR: unable to parse qshape output: - $line"; |
101 | } | |
102 | ||
103 | my $count = 0; | |
104 | my $res = []; | |
105 | while (($count++ < 10000) && (defined($line = <$fh>))) { | |
106 | if ($line =~ m/^\s+(\S+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+)$/) { | |
70805f7d | 107 | my @d = split(/\s+/, $1); |
1925d89d | 108 | push @$res, { |
70805f7d DM |
109 | domain => $d[0], |
110 | total => $d[1], | |
98f0bb2d DM |
111 | '5m' => $d[2], |
112 | '10m' => $d[3], | |
113 | '20m' => $d[4], | |
114 | '40m' => $d[5], | |
115 | '80m' => $d[6], | |
116 | '160m' => $d[7], | |
117 | '320m' => $d[8], | |
118 | '640m' => $d[9], | |
119 | '1280m' => $d[10], | |
120 | '1280m+' => $d[11], | |
70805f7d | 121 | }; |
c7533620 DM |
122 | } |
123 | } | |
124 | ||
c7533620 DM |
125 | return $res; |
126 | } | |
127 | ||
70805f7d | 128 | sub mailq { |
1925d89d | 129 | my ($queue, $filter, $start, $limit) = @_; |
70805f7d DM |
130 | |
131 | open(my $fh, '-|', '/usr/sbin/postqueue', '-j') || die "ERROR: unable to run postqueue - $!\n"; | |
132 | ||
133 | my $count = 0; | |
84f31dc0 DM |
134 | |
135 | $start = 0 if !$start; | |
136 | $limit = 50 if !$limit; | |
137 | ||
70805f7d DM |
138 | my $res = []; |
139 | my $line; | |
140 | while (defined($line = <$fh>)) { | |
141 | my $rec = decode_json($line); | |
142 | my $recipients = $rec->{recipients}; | |
1925d89d | 143 | next if $rec->{queue_name} ne $queue; |
70805f7d DM |
144 | |
145 | foreach my $entry (@$recipients) { | |
1abd85be DM |
146 | if (!$filter || $entry->{address} =~ m/$filter/i || |
147 | $rec->{sender} =~ m/$filter/i) { | |
84f31dc0 DM |
148 | next if $count++ < $start; |
149 | next if $limit-- <= 0; | |
150 | ||
70805f7d DM |
151 | my $data = {}; |
152 | foreach my $k (qw(queue_name queue_id arrival_time message_size sender)) { | |
153 | $data->{$k} = $rec->{$k}; | |
154 | } | |
1abd85be | 155 | $data->{receiver} = $entry->{address}; |
70805f7d DM |
156 | $data->{reason} = $entry->{delay_reason}; |
157 | push @$res, $data; | |
70805f7d DM |
158 | } |
159 | } | |
160 | } | |
161 | ||
84f31dc0 | 162 | return ($count, $res); |
70805f7d DM |
163 | } |
164 | ||
1925d89d | 165 | sub postcat { |
d66ca651 | 166 | my ($queue_id, $header, $body, $decode) = @_; |
1925d89d DM |
167 | |
168 | die "no option specified (select header or body or both)" | |
169 | if !($header || $body); | |
170 | ||
171 | my @opts = (); | |
172 | ||
173 | push @opts, '-h' if $header; | |
174 | push @opts, '-b' if $body; | |
175 | ||
176 | push @opts, '-q', $queue_id; | |
177 | ||
178 | open(my $fh, '-|', '/usr/sbin/postcat', @opts) || die "ERROR: unable to run postcat - $!\n"; | |
179 | ||
180 | my $res = ''; | |
181 | while (defined(my $line = <$fh>)) { | |
d66ca651 | 182 | if ($decode) { |
a4f7449b | 183 | $res .= PMG::Utils::decode_rfc1522($line); |
800a98b2 | 184 | } else { |
a4f7449b | 185 | $res .= PMG::Utils::try_decode_utf8($line); |
d66ca651 | 186 | } |
1925d89d DM |
187 | } |
188 | ||
189 | return $res; | |
190 | } | |
191 | ||
658384c5 | 192 | # flush all queues |
2ee08196 | 193 | sub flush_queues { |
1925d89d | 194 | PVE::Tools::run_command(['/usr/sbin/postqueue', '-f']); |
2ee08196 DM |
195 | } |
196 | ||
1925d89d DM |
197 | # flush a single mail |
198 | sub flush_queued_mail { | |
199 | my ($queue_id) = @_; | |
200 | ||
201 | PVE::Tools::run_command(['/usr/sbin/postqueue', '-i', $queue_id]); | |
202 | } | |
203 | ||
204 | sub delete_queued_mail { | |
205 | my ($queue, $queue_id) = @_; | |
206 | ||
207 | PVE::Tools::run_command(['/usr/sbin/postsuper', '-d', $queue_id, $queue]); | |
208 | } | |
209 | ||
210 | sub delete_queue { | |
211 | my ($queue) = @_; | |
212 | ||
3ef62965 DM |
213 | my $cmd = ['/usr/sbin/postsuper', '-d', 'ALL']; |
214 | push @$cmd, $queue if defined($queue); | |
215 | ||
216 | PVE::Tools::run_command($cmd); | |
2ee08196 DM |
217 | } |
218 | ||
219 | sub discard_verify_cache { | |
220 | unlink "/var/lib/postfix/verify_cache.db"; | |
221 | ||
222 | PMG::Utils::service_cmd('postfix', 'reload'); | |
223 | } | |
224 | ||
006417f9 | 225 | 1; |