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