PMG/Utils.pm

   1 package PMG::Utils;
   2
   3 use strict;
   4 use warnings;
   5 use DBI;
   6 use Net::Cmd;
   7 use Net::SMTP;
   8 use IO::File;
   9 use File::stat;
  10 use File::Basename;
  11 use MIME::Words;
  12 use MIME::Parser;
  13 use Time::HiRes qw (gettimeofday);
  14 use Xdgmime;
  15 use Data::Dumper;
  16 use Net::IP;
  17 use Socket;
  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 # only write output if something fails
 305 sub run_silent_cmd {
 306     my ($cmd) = @_;
 307
 308     my $outbuf = '';
 309
 310     my $record_output = sub {
 311         $outbuf .= shift;
 312         $outbuf .= "\n";
 313     };
 314
 315     eval {
 316         PVE::Tools::run_command($cmd, outfunc => $record_output,
 317                                 errfunc => $record_output);
 318     };
 319     my $err = $@;
 320
 321     if ($err) {
 322         print STDERR $outbuf;
 323         die $err;
 324     }
 325 }
 326
 327 my $proxmox_tls_cert_fn = "/etc/pmg/pmg-tls.pem";
 328
 329 sub gen_proxmox_tls_cert {
 330     my ($force) = @_;
 331
 332     my $resolv = PVE::INotify::read_file('resolvconf');
 333     my $domain = $resolv->{search};
 334
 335     my $company = $domain; # what else ?
 336     my $cn = "*.$domain";
 337
 338    return if !$force && -f $proxmox_tls_cert_fn;
 339
 340     my $sslconf = <<__EOD__;
 341 RANDFILE = /root/.rnd
 342 extensions = v3_req
 343
 344 [ req ]
 345 default_bits = 4096
 346 distinguished_name = req_distinguished_name
 347 req_extensions = v3_req
 348 prompt = no
 349 string_mask = nombstr
 350
 351 [ req_distinguished_name ]
 352 organizationalUnitName = Proxmox Mail Gateway
 353 organizationName = $company
 354 commonName = $cn
 355
 356 [ v3_req ]
 357 basicConstraints = CA:FALSE
 358 nsCertType = server
 359 keyUsage = nonRepudiation, digitalSignature, keyEncipherment
 360 __EOD__
 361
 362     my $cfgfn = "/tmp/pmgtlsconf-$$.tmp";
 363     my $fh = IO::File->new ($cfgfn, "w");
 364     print $fh $sslconf;
 365     close ($fh);
 366
 367     eval {
 368         my $cmd = ['openssl', 'req', '-batch', '-x509', '-new', '-sha256',
 369                    '-config', $cfgfn, '-days', 3650, '-nodes',
 370                    '-out', $proxmox_tls_cert_fn,
 371                    '-keyout', $proxmox_tls_cert_fn];
 372         run_silent_cmd($cmd);
 373     };
 374
 375     if (my $err = $@) {
 376         unlink $proxmox_tls_cert_fn;
 377         unlink $cfgfn;
 378         die "unable to generate proxmox certificate request:\n$err";
 379     }
 380
 381     unlink $cfgfn;
 382 }
 383
 384 sub find_local_network_for_ip {
 385     my ($ip) = @_;
 386
 387     my $testip = Net::IP->new($ip);
 388
 389     my $isv6 = $testip->version == 6;
 390     my $routes = $isv6 ?
 391         PVE::ProcFSTools::read_proc_net_ipv6_route() :
 392         PVE::ProcFSTools::read_proc_net_route();
 393
 394     foreach my $entry (@$routes) {
 395         my $mask;
 396         if ($isv6) {
 397             $mask = $entry->{prefix};
 398             next if !$mask; # skip the default route...
 399         } else {
 400             $mask = $PVE::Network::ipv4_mask_hash_localnet->{$entry->{mask}};
 401             next if !defined($mask);
 402         }
 403         my $cidr = "$entry->{dest}/$mask";
 404         my $testnet = Net::IP->new($cidr);
 405         my $overlap = $testnet->overlaps($testip);
 406         if ($overlap == $Net::IP::IP_B_IN_A_OVERLAP ||
 407             $overlap == $Net::IP::IP_IDENTICAL)
 408         {
 409             return $cidr;
 410         }
 411     }
 412
 413     die "unable to detect local network for ip '$ip'\n";
 414 }
 415
 416 sub service_cmd {
 417     my ($service, $cmd) = @_;
 418
 419     die "unknown service command '$cmd'\n"
 420         if $cmd !~ m/^(start|stop|restart|reload)$/;
 421
 422     if ($service eq 'pmgdaemon' || $service eq 'pmgproxy') {
 423         if ($cmd eq 'restart') {
 424             # OK
 425         } else {
 426             die "invalid service cmd '$service $cmd': ERROR";
 427         }
 428     }
 429
 430     $service = 'postfix@-' if $service eq 'postfix';
 431     PVE::Tools::run_command(['systemctl', $cmd, $service]);
 432 };
 433
 434 # this is also used to get the IP of the local node
 435 sub lookup_node_ip {
 436     my ($nodename, $noerr) = @_;
 437
 438     my ($family, $packed_ip);
 439
 440     eval {
 441         my @res = PVE::Tools::getaddrinfo_all($nodename);
 442         $family = $res[0]->{family};
 443         $packed_ip = (PVE::Tools::unpack_sockaddr_in46($res[0]->{addr}))[2];
 444     };
 445
 446     if ($@) {
 447         die "hostname lookup failed:\n$@" if !$noerr;
 448         return undef;
 449     }
 450
 451     my $ip = Socket::inet_ntop($family, $packed_ip);
 452     if ($ip =~ m/^127\.|^::1$/) {
 453         die "hostname lookup failed - got local IP address ($nodename = $ip)\n" if !$noerr;
 454         return undef;
 455     }
 456
 457     return wantarray ? ($ip, $family) : $ip;
 458 }
 459
 460 sub run_postmap {
 461     my ($filename) = @_;
 462
 463     # make sure the file exists (else postmap fails)
 464     IO::File->new($filename, 'a', 0644);
 465
 466     eval {
 467         PVE::Tools::run_command(
 468             ['/usr/sbin/postmap', $filename],
 469             errmsg => "unable to update postfix table $filename");
 470     };
 471     my $err = $@;
 472
 473     warn $err if $err;
 474 }
 475
 476 1;