]>
git.proxmox.com Git - pmg-api.git/blob - src/PMG/Postfix.pm
8 use MIME
::WordDecoder
qw(mime_to_perl_string);
14 my $spooldir = "/var/spool/postfix";
16 my $postfix_rec_get = sub {
20 return if !defined($r);
25 while (defined(my $lb = getc($fh))) {
27 $l |= ($o & 0x7f) << $shift ;
28 last if (($o & 0x80) == 0);
30 return if ($shift > 7); # XXX: max rec len of 4096
34 return unless ($l == 0 || read($fh, $d, $l) == $l);
38 my $postfix_qenv = sub {
41 my $fh = new IO
::File
($filename, "r");
42 return undef if !defined($fh);
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; }
53 if ($d =~ m/^Subject:\s+(.*)$/i) {
55 } elsif (!$res->{messageid
} && $d =~ m/^Message-Id:\s+<(.*)>$/i) {
56 $res->{messageid
} = $1;
59 #elsif ($r eq "M") { last unless defined $dlen; seek($fh, $dlen, 1); }
60 elsif ($r eq "E") { last; }
66 # Fixme: it is a bad idea to scan everything - list can be too large
67 sub show_deferred_queue
{
70 my $queue = 'deferred';
73 my $path = $File::Find
::name
;
76 my ($dev, $ino, $mode) = lstat($path);
78 return if !defined($mode);
79 return if !(-f _
&& (($mode & 07777) == 0700));
81 if (my $rec = $postfix_qenv->($path)) {
82 $rec->{queue
} = $queue;
83 $rec->{qid
} = $filename;
88 find
($callback, "$spooldir/deferred");
96 open(my $fh, '-|', '/usr/sbin/qshape', $queues) || die "ERROR: unable to run qshape: $!\n";
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\+$/)) {
100 die "ERROR: unable to parse qshape output: - $line";
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+)$/) {
107 my @d = split(/\s+/, $1);
129 my ($queue, $filter, $start, $limit) = @_;
131 open(my $fh, '-|', '/usr/sbin/postqueue', '-j') || die "ERROR: unable to run postqueue - $!\n";
135 $start = 0 if !$start;
136 $limit = 50 if !$limit;
140 while (defined($line = <$fh>)) {
141 my $rec = decode_json
($line);
142 my $recipients = $rec->{recipients
};
143 next if $rec->{queue_name
} ne $queue;
145 foreach my $entry (@$recipients) {
146 if (!$filter || $entry->{address
} =~ m/$filter/i ||
147 $rec->{sender
} =~ m/$filter/i) {
148 next if $count++ < $start;
149 next if $limit-- <= 0;
152 foreach my $k (qw(queue_name queue_id arrival_time message_size sender)) {
153 $data->{$k} = $rec->{$k};
155 $data->{receiver
} = $entry->{address
};
156 $data->{reason
} = $entry->{delay_reason
};
162 return ($count, $res);
166 my ($queue_id, $header, $body, $decode) = @_;
168 die "no option specified (select header or body or both)"
169 if !($header || $body);
173 push @opts, '-h' if $header;
174 push @opts, '-b' if $body;
176 push @opts, '-q', $queue_id;
178 open(my $fh, '-|', '/usr/sbin/postcat', @opts) || die "ERROR: unable to run postcat - $!\n";
181 while (defined(my $line = <$fh>)) {
183 $res .= PMG
::Utils
::decode_rfc1522
($line);
185 $res .= PMG
::Utils
::try_decode_utf8
($line);
194 PVE
::Tools
::run_command
(['/usr/sbin/postqueue', '-f']);
197 # flush a single mail
198 sub flush_queued_mail
{
201 PVE
::Tools
::run_command
(['/usr/sbin/postqueue', '-i', $queue_id]);
204 sub delete_queued_mail
{
205 my ($queue, $queue_id) = @_;
207 PVE
::Tools
::run_command
(['/usr/sbin/postsuper', '-d', $queue_id, $queue]);
213 my $cmd = ['/usr/sbin/postsuper', '-d', 'ALL'];
214 push @$cmd, $queue if defined($queue);
216 PVE
::Tools
::run_command
($cmd);
219 sub discard_verify_cache
{
220 unlink "/var/lib/postfix/verify_cache.db";
222 PMG
::Utils
::service_cmd
('postfix', 'reload');