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