src/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 use MIME::WordDecoder qw(mime_to_perl_string);
   9
  10 use PVE::Tools;
  11
  12 use PMG::Utils;
  13
  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
  63     return $res;
  64 };
  65
  66 # Fixme: it is a bad idea to scan everything - list can be too large
  67 sub show_deferred_queue {
  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
  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\+$/)) {
 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+)$/) {
 107             my @d = split(/\s+/, $1);
 108             push @$res, {
 109                 domain => $d[0],
 110                 total => $d[1],
 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],
 121             };
 122         }
 123     }
 124
 125     return $res;
 126 }
 127
 128 sub mailq {
 129     my ($queue, $filter, $start, $limit) = @_;
 130
 131     open(my $fh, '-|', '/usr/sbin/postqueue', '-j') || die "ERROR: unable to run postqueue - $!\n";
 132
 133     my $count = 0;
 134
 135     $start = 0 if !$start;
 136     $limit = 50 if !$limit;
 137
 138     my $res = [];
 139     my $line;
 140     while (defined($line = <$fh>)) {
 141         my $rec = decode_json($line);
 142         my $recipients = $rec->{recipients};
 143         next if $rec->{queue_name} ne $queue;
 144
 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;
 150
 151                 my $data = {};
 152                 foreach my $k (qw(queue_name queue_id arrival_time message_size sender)) {
 153                     $data->{$k} = $rec->{$k};
 154                 }
 155                 $data->{receiver} = $entry->{address};
 156                 $data->{reason} = $entry->{delay_reason};
 157                 push @$res, $data;
 158             }
 159         }
 160     }
 161
 162     return ($count, $res);
 163 }
 164
 165 sub postcat {
 166     my ($queue_id, $header, $body, $decode) = @_;
 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>)) {
 182         if ($decode) {
 183             $res .= PMG::Utils::decode_rfc1522($line);
 184         } else {
 185             $res .= PMG::Utils::try_decode_utf8($line);
 186         }
 187     }
 188
 189     return $res;
 190 }
 191
 192 # flush all queues
 193 sub flush_queues {
 194     PVE::Tools::run_command(['/usr/sbin/postqueue', '-f']);
 195 }
 196
 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
 213     my $cmd = ['/usr/sbin/postsuper', '-d', 'ALL'];
 214     push @$cmd, $queue if defined($queue);
 215
 216     PVE::Tools::run_command($cmd);
 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
 225 1;