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