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