PMG/Utils.pm

   1 package PMG::Utils;
   2
   3 use strict;
   4 use warnings;
   5 use Carp;
   6 use DBI;
   7 use Net::Cmd;
   8 use Net::SMTP;
   9 use IO::File;
  10 use File::stat;
  11 use MIME::Words;
  12 use MIME::Parser;
  13 use Time::HiRes qw (gettimeofday);
  14 use Xdgmime;
  15
  16 use PVE::SafeSyslog;
  17 use PMG::MailQueue;
  18
  19 sub msgquote {
  20     my $msg = shift || '';
  21     $msg =~ s/%/%%/g;
  22     return $msg;
  23 }
  24
  25 sub lastid {
  26     my ($dbh, $seq) = @_;
  27
  28     return $dbh->last_insert_id(
  29         undef, undef, undef, undef, { sequence => $seq});
  30 }
  31
  32 sub file_older_than {
  33     my ($filename, $lasttime) = @_;
  34
  35     my $st = stat($filename);
  36
  37     return 0 if !defined($st);
  38
  39     return ($lasttime >= $st->ctime);
  40 }
  41
  42 sub extract_filename {
  43     my ($head) = @_;
  44
  45     if (my $value = $head->recommended_filename()) {
  46         chomp $value;
  47         if (my $decvalue = MIME::Words::decode_mimewords($value)) {
  48             $decvalue =~ s/\0/ /g;
  49             $decvalue = trim ($decvalue);
  50             return $decvalue;
  51         }
  52     }
  53
  54     return undef;
  55 }
  56
  57 sub remove_marks {
  58     my ($entity, $add_id, $id) = @_;
  59
  60     $id //= 1;
  61
  62     foreach my $tag (grep {/^x-proxmox-tmp/i} $entity->head->tags) {
  63         $entity->head->delete ($tag);
  64     }
  65
  66     $entity->head->replace('X-Proxmox-tmp-AID', $id) if $add_id;
  67
  68     foreach my $part ($entity->parts)  {
  69         $id = remove_marks($part, $add_id, $id + 1);
  70     }
  71
  72     return $id;
  73 }
  74
  75 sub subst_values {
  76     my ($body, $dh) = @_;
  77
  78     return if !$body;
  79
  80     foreach my $k (keys %$dh) {
  81         my $v = $dh->{$k};
  82         if (defined ($v)) {
  83             $body =~ s/__${k}__/$v/gs;
  84         }
  85     }
  86
  87     return $body;
  88 }
  89
  90 sub reinject_mail {
  91     my ($entity, $sender, $targets, $xforward, $me, $nodsn) = @_;
  92
  93     my $smtp;
  94     my $resid;
  95     my $rescode;
  96     my $resmess;
  97
  98     eval {
  99         my $smtp = Net::SMTP->new('127.0.0.1', Port => 10025, Hello => $me) ||
 100             die "unable to connect to localhost at port 10025";
 101
 102         if (defined($xforward)) {
 103             my $xfwd;
 104
 105             foreach my $attr (keys %{$xforward}) {
 106                 $xfwd .= " $attr=$xforward->{$attr}";
 107             }
 108
 109             if ($xfwd && $smtp->command("XFORWARD", $xfwd)->response() != CMD_OK) {
 110                 syslog('err', "xforward error - got: %s %s", $smtp->code, scalar($smtp->message));
 111             }
 112         }
 113
 114         if (!$smtp->mail($sender)) {
 115             syslog('err', "smtp error - got: %s %s", $smtp->code, scalar ($smtp->message));
 116             die "smtp from: ERROR";
 117         }
 118
 119         my $dsnopts = $nodsn ? {Notify => ['NEVER']} : {};
 120
 121         if (!$smtp->to (@$targets, $dsnopts)) {
 122             syslog ('err', "smtp error - got: %s %s", $smtp->code, scalar($smtp->message));
 123             die "smtp to: ERROR";
 124         }
 125
 126         # Output the head:
 127         #$entity->sync_headers ();
 128         $smtp->data();
 129
 130         my $out = PMG::SMTPPrinter->new($smtp);
 131         $entity->print($out);
 132
 133         # make sure we always have a newline at the end of the mail
 134         # else dataend() fails
 135         $smtp->datasend("\n");
 136
 137         if ($smtp->dataend()) {
 138             my @msgs = $smtp->message;
 139             $resmess = $msgs[$#msgs];
 140             ($resid) = $resmess =~ m/Ok: queued as ([0-9A-Z]+)/;
 141             $rescode = $smtp->code;
 142             if (!$resid) {
 143                 die sprintf("unexpected SMTP result - got: %s %s : WARNING", $smtp->code, $resmess);
 144             }
 145         } else {
 146             my @msgs = $smtp->message;
 147             $resmess = $msgs[$#msgs];
 148             $rescode = $smtp->code;
 149             die sprintf("sending data failed - got: %s %s : ERROR", $smtp->code, $resmess);
 150         }
 151     };
 152     my $err = $@;
 153
 154     $smtp->quit if $smtp;
 155
 156     if ($err) {
 157         syslog ('err', $err);
 158     }
 159
 160     return wantarray ? ($resid, $rescode, $resmess) : $resid;
 161 }
 162
 163 sub analyze_virus_clam {
 164     my ($queue, $dname, $pmg_cfg) = @_;
 165
 166     my $timeout = 60*5;
 167     my $vinfo;
 168
 169     my $clamdscan_opts = "--stdout";
 170
 171     my ($csec, $usec) = gettimeofday();
 172
 173     my $previous_alarm;
 174
 175     eval {
 176
 177         $previous_alarm = alarm($timeout);
 178
 179         $SIG{ALRM} = sub {
 180             die "$queue->{logid}: Maximum time ($timeout sec) exceeded. " .
 181                 "virus analyze (clamav) failed: ERROR";
 182         };
 183
 184         open(CMD, "/usr/bin/clamdscan $clamdscan_opts '$dname'|") ||
 185             die "$queue->{logid}: can't exec clamdscan: $! : ERROR";
 186
 187         my $ifiles;
 188         my $res;
 189
 190         while (<CMD>) {
 191             if (m/^$dname.*:\s+([^ :]*)\s+FOUND$/) {
 192                 # we just use the first detected virus name
 193                 $vinfo = $1 if !$vinfo;
 194             }
 195             if (m/^Infected files:\s(\d*)$/i) {
 196                 $ifiles = $1;
 197             }
 198
 199             $res .= $_;
 200         }
 201
 202         close(CMD);
 203
 204         alarm(0); # avoid race conditions
 205
 206         if (!defined($ifiles)) {
 207             die "$queue->{logid}: got undefined output from " .
 208                 "virus detector: $res : ERROR";
 209         }
 210
 211         if ($vinfo) {
 212             syslog ('info', "$queue->{logid}: virus detected: $vinfo (clamav)");
 213         }
 214     };
 215     my $err = $@;
 216
 217     alarm($previous_alarm);
 218
 219     my ($csec_end, $usec_end) = gettimeofday();
 220     $queue->{ptime_clam} =
 221         int (($csec_end-$csec)*1000 + ($usec_end - $usec)/1000);
 222
 223     if ($err) {
 224         syslog ('err', $err);
 225         $vinfo = undef;
 226         $queue->{errors} = 1;
 227     }
 228
 229     $queue->{vinfo_clam} = $vinfo;
 230
 231     return $vinfo ? "$vinfo (clamav)" : undef;
 232 }
 233
 234 sub analyze_virus {
 235     my ($queue, $filename, $pmg_cfg, $testmode) = @_;
 236
 237     # TODO: support other virus scanners?
 238
 239     # always scan with clamav
 240     return analyze_virus_clam($queue, $filename, $pmg_cfg);
 241 }
 242
 243 sub magic_mime_type_for_file {
 244     my ($filename) = @_;
 245
 246     # we do not use get_mime_type_for_file, because that considers
 247     # filename extensions - we only want magic type detection
 248
 249     my $bufsize = Xdgmime::xdg_mime_get_max_buffer_extents();
 250     die "got strange value for max_buffer_extents" if $bufsize > 4096*10;
 251
 252     my $ct = "application/octet-stream";
 253
 254     my $fh = IO::File->new("<$filename") ||
 255         die "unable to open file '$filename' - $!";
 256
 257     my ($buf, $len);
 258     if (($len = $fh->read($buf, $bufsize)) > 0) {
 259         $ct = xdg_mime_get_mime_type_for_data($buf, $len);
 260     }
 261     $fh->close();
 262
 263     die "unable to read file '$filename' - $!" if ($len < 0);
 264
 265     return $ct;
 266 }
 267
 268 sub add_ct_marks {
 269     my ($entity) = @_;
 270
 271     if (my $path = $entity->{PMX_decoded_path}) {
 272
 273         # set a reasonable default if magic does not give a result
 274         $entity->{PMX_magic_ct} = $entity->head->mime_attr('content-type');
 275
 276         if (my $ct = magic_mime_type_for_file($path)) {
 277             if ($ct ne 'application/octet-stream' || !$entity->{PMX_magic_ct}) {
 278                 $entity->{PMX_magic_ct} = $ct;
 279             }
 280         }
 281
 282         my $filename = $entity->head->recommended_filename;
 283         $filename = basename($path) if !defined($filename) || $filename eq '';
 284
 285         if (my $ct = xdg_mime_get_mime_type_from_file_name($filename)) {
 286             $entity->{PMX_glob_ct} = $ct;
 287         }
 288     }
 289
 290     foreach my $part ($entity->parts)  {
 291         add_ct_marks ($part);
 292     }
 293 }
 294
 295 1;