PMG/Postfix.pm

   1 package PMG::Postfix;
   2
   3 use strict;
   4 use warnings;
   5 use Data::Dumper;
   6 use File::Find;
   7 use JSON;
   8
   9 use PVE::Tools;
  10
  11 use PMG::Utils;
  12
  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
  62     return $res;
  63 };
  64
  65 # Fixme: it is a bad idea to scan everything - list can be too large
  66 sub show_deferred_queue {
  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
  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\+$/)) {
  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+)$/) {
 106             my @d = split(/\s+/, $1);
 107             push @$res, {
 108                 domain => $d[0],
 109                 total => $d[1],
 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],
 120             };
 121         }
 122     }
 123
 124     return $res;
 125 }
 126
 127 sub mailq {
 128     my ($queue, $filter, $start, $limit) = @_;
 129
 130     open(my $fh, '-|', '/usr/sbin/postqueue', '-j') || die "ERROR: unable to run postqueue - $!\n";
 131
 132     my $count = 0;
 133
 134     $start = 0 if !$start;
 135     $limit = 50 if !$limit;
 136
 137     my $res = [];
 138     my $line;
 139     while (defined($line = <$fh>)) {
 140         my $rec = decode_json($line);
 141         my $recipients = $rec->{recipients};
 142         next if $rec->{queue_name} ne $queue;
 143
 144         foreach my $entry (@$recipients) {
 145             if (!$filter || $entry->{address} =~ m/$filter/i ||
 146                 $rec->{sender} =~ m/$filter/i) {
 147                 next if $count++ < $start;
 148                 next if $limit-- <= 0;
 149
 150                 my $data = {};
 151                 foreach my $k (qw(queue_name queue_id arrival_time message_size sender)) {
 152                     $data->{$k} = $rec->{$k};
 153                 }
 154                 $data->{receiver} = $entry->{address};
 155                 $data->{reason} = $entry->{delay_reason};
 156                 push @$res, $data;
 157             }
 158         }
 159     }
 160
 161     return ($count, $res);
 162 }
 163
 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
 187 # flush all queuespostconf -d|grep enable_long_queue_ids
 188 sub flush_queues {
 189     PVE::Tools::run_command(['/usr/sbin/postqueue', '-f']);
 190 }
 191
 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
 208     my $cmd = ['/usr/sbin/postsuper', '-d', 'ALL'];
 209     push @$cmd, $queue if defined($queue);
 210
 211     PVE::Tools::run_command($cmd);
 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
 220 1;