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 POSIX qw(strftime);
  11 use File::stat;
  12 use File::Basename;
  13 use MIME::Words;
  14 use MIME::Parser;
  15 use Time::HiRes qw (gettimeofday);
  16 use Time::Local;
  17 use Xdgmime;
  18 use Data::Dumper;
  19 use Digest::SHA;
  20 use Digest::MD5;
  21 use Net::IP;
  22 use Socket;
  23 use RRDs;
  24 use Filesys::Df;
  25 use Encode;
  26 use utf8;
  27 no utf8;
  28
  29 use HTML::Entities;
  30
  31 use PVE::ProcFSTools;
  32 use PVE::Network;
  33 use PVE::Tools;
  34 use PVE::SafeSyslog;
  35 use PVE::ProcFSTools;
  36 use PMG::AtomicFile;
  37 use PMG::MailQueue;
  38 use PMG::SMTPPrinter;
  39
  40 my $valid_pmg_realms = ['pam', 'pmg', 'quarantine'];
  41
  42 PVE::JSONSchema::register_standard_option('realm', {
  43     description => "Authentication domain ID",
  44     type => 'string',
  45     enum => $valid_pmg_realms,
  46     maxLength => 32,
  47 });
  48
  49 PVE::JSONSchema::register_standard_option('pmg-starttime', {
  50     description => "Only consider entries newer than 'starttime' (unix epoch). Default is 'now - 1day'.",
  51     type => 'integer',
  52     minimum => 0,
  53     optional => 1,
  54 });
  55
  56 PVE::JSONSchema::register_standard_option('pmg-endtime', {
  57     description => "Only consider entries older than 'endtime' (unix epoch). This is set to '<start> + 1day' by default.",
  58     type => 'integer',
  59     minimum => 1,
  60     optional => 1,
  61 });
  62
  63 PVE::JSONSchema::register_format('pmg-userid', \&verify_username);
  64 sub verify_username {
  65     my ($username, $noerr) = @_;
  66
  67     $username = '' if !$username;
  68     my $len = length($username);
  69     if ($len < 3) {
  70         die "user name '$username' is too short\n" if !$noerr;
  71         return undef;
  72     }
  73     if ($len > 64) {
  74         die "user name '$username' is too long ($len > 64)\n" if !$noerr;
  75         return undef;
  76     }
  77
  78     # we only allow a limited set of characters
  79     # colon is not allowed, because we store usernames in
  80     # colon separated lists)!
  81     # slash is not allowed because it is used as pve API delimiter
  82     # also see "man useradd"
  83     my $realm_list = join('|', @$valid_pmg_realms);
  84     if ($username =~ m!^([^\s:/]+)\@(${realm_list})$!) {
  85         return wantarray ? ($username, $1, $2) : $username;
  86     }
  87
  88     die "value '$username' does not look like a valid user name\n" if !$noerr;
  89
  90     return undef;
  91 }
  92
  93 PVE::JSONSchema::register_standard_option('userid', {
  94     description => "User ID",
  95     type => 'string', format => 'pmg-userid',
  96     minLength => 4,
  97     maxLength => 64,
  98 });
  99
 100 PVE::JSONSchema::register_standard_option('username', {
 101     description => "Username (without realm)",
 102     type => 'string',
 103     pattern => '[^\s:\/\@]{3,60}',
 104     minLength => 4,
 105     maxLength => 64,
 106 });
 107
 108 PVE::JSONSchema::register_standard_option('pmg-email-address', {
 109     description => "Email Address (allow most characters).",
 110     type => 'string',
 111     pattern => '(?:[^\s\/\\\@]+\@[^\s\/\\\@]+)',
 112     maxLength => 512,
 113     minLength => 3,
 114 });
 115
 116 PVE::JSONSchema::register_standard_option('pmg-whiteblacklist-entry-list', {
 117     description => "White/Blacklist entry list (allow most characters). Can contain globs",
 118     type => 'string',
 119     pattern => '(?:[^\s\/\\\;\,]+)(?:\,[^\s\/\\\;\,]+)*',
 120     minLength => 3,
 121 });
 122
 123 sub lastid {
 124     my ($dbh, $seq) = @_;
 125
 126     return $dbh->last_insert_id(
 127         undef, undef, undef, undef, { sequence => $seq});
 128 }
 129
 130 # quote all regex operators
 131 sub quote_regex {
 132     my $val = shift;
 133
 134     $val =~ s/([\(\)\[\]\/\}\+\*\?\.\|\^\$\\])/\\$1/g;
 135
 136     return $val;
 137 }
 138
 139 sub file_older_than {
 140     my ($filename, $lasttime) = @_;
 141
 142     my $st = stat($filename);
 143
 144     return 0 if !defined($st);
 145
 146     return ($lasttime >= $st->ctime);
 147 }
 148
 149 sub extract_filename {
 150     my ($head) = @_;
 151
 152     if (my $value = $head->recommended_filename()) {
 153         chomp $value;
 154         if (my $decvalue = MIME::Words::decode_mimewords($value)) {
 155             $decvalue =~ s/\0/ /g;
 156             $decvalue = PVE::Tools::trim($decvalue);
 157             return $decvalue;
 158         }
 159     }
 160
 161     return undef;
 162 }
 163
 164 sub remove_marks {
 165     my ($entity, $add_id, $id) = @_;
 166
 167     $id //= 1;
 168
 169     foreach my $tag (grep {/^x-proxmox-tmp/i} $entity->head->tags) {
 170         $entity->head->delete ($tag);
 171     }
 172
 173     $entity->head->replace('X-Proxmox-tmp-AID', $id) if $add_id;
 174
 175     foreach my $part ($entity->parts)  {
 176         $id = remove_marks($part, $add_id, $id + 1);
 177     }
 178
 179     return $id;
 180 }
 181
 182 sub subst_values {
 183     my ($body, $dh) = @_;
 184
 185     return if !$body;
 186
 187     foreach my $k (keys %$dh) {
 188         my $v = $dh->{$k};
 189         if (defined($v)) {
 190             $body =~ s/__\Q${k}\E__/$v/gs;
 191         }
 192     }
 193
 194     return $body;
 195 }
 196
 197 sub reinject_mail {
 198     my ($entity, $sender, $targets, $xforward, $me, $nodsn) = @_;
 199
 200     my $smtp;
 201     my $resid;
 202     my $rescode;
 203     my $resmess;
 204
 205     eval {
 206         my $smtp = Net::SMTP->new('127.0.0.1', Port => 10025, Hello => $me) ||
 207             die "unable to connect to localhost at port 10025";
 208
 209         if (defined($xforward)) {
 210             my $xfwd;
 211
 212             foreach my $attr (keys %{$xforward}) {
 213                 $xfwd .= " $attr=$xforward->{$attr}";
 214             }
 215
 216             if ($xfwd && $smtp->command("XFORWARD", $xfwd)->response() != CMD_OK) {
 217                 syslog('err', "xforward error - got: %s %s", $smtp->code, scalar($smtp->message));
 218             }
 219         }
 220
 221         my $has_utf8_targets = 0;
 222         foreach my $target (@$targets) {
 223             if (utf8::is_utf8($target)) {
 224                 $has_utf8_targets = 1;
 225                 last;
 226             }
 227         }
 228
 229         my $mail_opts = " BODY=8BITMIME";
 230         my $sender_addr;
 231         if (utf8::is_utf8($sender)) {
 232             $sender_addr = encode('UTF-8', $smtp->_addr($sender));
 233             $mail_opts .= " SMTPUTF8";
 234         } else {
 235             $sender_addr = $smtp->_addr($sender);
 236             $mail_opts .= " SMTPUTF8" if $has_utf8_targets;
 237         }
 238
 239         if (!$smtp->_MAIL("FROM:" . $sender_addr . $mail_opts)) {
 240             syslog('err', "smtp error - got: %s %s", $smtp->code, scalar ($smtp->message));
 241             die "smtp from: ERROR";
 242         }
 243
 244         my $rcpt_opts = $nodsn ? " NOTIFY=NEVER" : "";
 245
 246         foreach my $target (@$targets) {
 247             my $rcpt_addr;
 248             if (utf8::is_utf8($target)) {
 249                 $rcpt_addr = encode('UTF-8', $smtp->_addr($target));
 250             } else {
 251                 $rcpt_addr = $smtp->_addr($target);
 252             }
 253             if (!$smtp->_RCPT("TO:" . $rcpt_addr . $rcpt_opts)) {
 254                 syslog ('err', "smtp error - got: %s %s", $smtp->code, scalar($smtp->message));
 255                 die "smtp to: ERROR";
 256             }
 257         }
 258
 259         # Output the head:
 260         #$entity->sync_headers ();
 261         $smtp->data();
 262
 263         my $out = PMG::SMTPPrinter->new($smtp);
 264         $entity->print($out);
 265
 266         # make sure we always have a newline at the end of the mail
 267         # else dataend() fails
 268         $smtp->datasend("\n");
 269
 270         if ($smtp->dataend()) {
 271             my @msgs = $smtp->message;
 272             $resmess = $msgs[$#msgs];
 273             ($resid) = $resmess =~ m/Ok: queued as ([0-9A-Z]+)/;
 274             $rescode = $smtp->code;
 275             if (!$resid) {
 276                 die sprintf("unexpected SMTP result - got: %s %s : WARNING", $smtp->code, $resmess);
 277             }
 278         } else {
 279             my @msgs = $smtp->message;
 280             $resmess = $msgs[$#msgs];
 281             $rescode = $smtp->code;
 282             die sprintf("sending data failed - got: %s %s : ERROR", $smtp->code, $resmess);
 283         }
 284     };
 285     my $err = $@;
 286
 287     $smtp->quit if $smtp;
 288
 289     if ($err) {
 290         syslog ('err', $err);
 291     }
 292
 293     return wantarray ? ($resid, $rescode, $resmess) : $resid;
 294 }
 295
 296 sub analyze_virus_clam {
 297     my ($queue, $dname, $pmg_cfg) = @_;
 298
 299     my $timeout = 60*5;
 300     my $vinfo;
 301
 302     my $clamdscan_opts = "--stdout";
 303
 304     my ($csec, $usec) = gettimeofday();
 305
 306     my $previous_alarm;
 307
 308     eval {
 309
 310         $previous_alarm = alarm($timeout);
 311
 312         $SIG{ALRM} = sub {
 313             die "$queue->{logid}: Maximum time ($timeout sec) exceeded. " .
 314                 "virus analyze (clamav) failed: ERROR";
 315         };
 316
 317         open(CMD, "/usr/bin/clamdscan $clamdscan_opts '$dname'|") ||
 318             die "$queue->{logid}: can't exec clamdscan: $! : ERROR";
 319
 320         my $ifiles;
 321
 322         my $response = '';
 323         while (defined(my $line = <CMD>)) {
 324             if ($line =~ m/^$dname.*:\s+([^ :]*)\s+FOUND$/) {
 325                 # we just use the first detected virus name
 326                 $vinfo = $1 if !$vinfo;
 327             } elsif ($line =~ m/^Infected files:\s(\d*)$/i) {
 328                 $ifiles = $1;
 329             }
 330
 331             $response .= $line;
 332         }
 333
 334         close(CMD);
 335
 336         alarm(0); # avoid race conditions
 337
 338         if (!defined($ifiles)) {
 339             die "$queue->{logid}: got undefined output from " .
 340                 "virus detector: $response : ERROR";
 341         }
 342
 343         if ($vinfo) {
 344             syslog('info', "$queue->{logid}: virus detected: $vinfo (clamav)");
 345         }
 346     };
 347     my $err = $@;
 348
 349     alarm($previous_alarm);
 350
 351     my ($csec_end, $usec_end) = gettimeofday();
 352     $queue->{ptime_clam} =
 353         int (($csec_end-$csec)*1000 + ($usec_end - $usec)/1000);
 354
 355     if ($err) {
 356         syslog ('err', $err);
 357         $vinfo = undef;
 358         $queue->{errors} = 1;
 359     }
 360
 361     $queue->{vinfo_clam} = $vinfo;
 362
 363     return $vinfo ? "$vinfo (clamav)" : undef;
 364 }
 365
 366 sub analyze_virus_avast {
 367     my ($queue, $dname, $pmg_cfg) = @_;
 368
 369     my $timeout = 60*5;
 370     my $vinfo;
 371
 372     my ($csec, $usec) = gettimeofday();
 373
 374     my $previous_alarm;
 375
 376     eval {
 377
 378         $previous_alarm = alarm($timeout);
 379
 380         $SIG{ALRM} = sub {
 381             die "$queue->{logid}: Maximum time ($timeout sec) exceeded. " .
 382                 "virus analyze (avast) failed: ERROR";
 383         };
 384
 385         open(my $cmd, '-|', '/bin/scan', $dname) ||
 386             die "$queue->{logid}: can't exec avast scan: $! : ERROR";
 387
 388         my $response = '';
 389         while (defined(my $line = <$cmd>)) {
 390             if ($line =~ m/^$dname\s+(.*\S)\s*$/) {
 391                 # we just use the first detected virus name
 392                 $vinfo = $1 if !$vinfo;
 393             }
 394
 395             $response .= $line;
 396         }
 397
 398         close($cmd);
 399
 400         alarm(0); # avoid race conditions
 401
 402         if ($vinfo) {
 403             syslog('info', "$queue->{logid}: virus detected: $vinfo (avast)");
 404         }
 405     };
 406     my $err = $@;
 407
 408     alarm($previous_alarm);
 409
 410     my ($csec_end, $usec_end) = gettimeofday();
 411     $queue->{ptime_clam} =
 412         int (($csec_end-$csec)*1000 + ($usec_end - $usec)/1000);
 413
 414     if ($err) {
 415         syslog ('err', $err);
 416         $vinfo = undef;
 417         $queue->{errors} = 1;
 418     }
 419
 420     return undef if !$vinfo;
 421
 422     $queue->{vinfo_avast} = $vinfo;
 423
 424     return "$vinfo (avast)";
 425 }
 426
 427 sub analyze_virus {
 428     my ($queue, $filename, $pmg_cfg, $testmode) = @_;
 429
 430     # TODO: support other virus scanners?
 431
 432     if ($testmode) {
 433         my $vinfo_clam = analyze_virus_clam($queue, $filename, $pmg_cfg);
 434         my $vinfo_avast = analyze_virus_avast($queue, $filename, $pmg_cfg);
 435
 436         return $vinfo_avast || $vinfo_clam;
 437     }
 438
 439     my $enable_avast  = $pmg_cfg->get('admin', 'avast');
 440
 441     if ($enable_avast) {
 442         if (my $vinfo = analyze_virus_avast($queue, $filename, $pmg_cfg)) {
 443             return $vinfo;
 444         }
 445     }
 446
 447     my $enable_clamav = $pmg_cfg->get('admin', 'clamav');
 448
 449     if ($enable_clamav) {
 450         if (my $vinfo = analyze_virus_clam($queue, $filename, $pmg_cfg)) {
 451             return $vinfo;
 452         }
 453     }
 454
 455     return undef;
 456 }
 457
 458 sub magic_mime_type_for_file {
 459     my ($filename) = @_;
 460
 461     # we do not use get_mime_type_for_file, because that considers
 462     # filename extensions - we only want magic type detection
 463
 464     my $bufsize = Xdgmime::xdg_mime_get_max_buffer_extents();
 465     die "got strange value for max_buffer_extents" if $bufsize > 4096*10;
 466
 467     my $ct = "application/octet-stream";
 468
 469     my $fh = IO::File->new("<$filename") ||
 470         die "unable to open file '$filename' - $!";
 471
 472     my ($buf, $len);
 473     if (($len = $fh->read($buf, $bufsize)) > 0) {
 474         $ct = xdg_mime_get_mime_type_for_data($buf, $len);
 475     }
 476     $fh->close();
 477
 478     die "unable to read file '$filename' - $!" if ($len < 0);
 479
 480     return $ct;
 481 }
 482
 483 sub add_ct_marks {
 484     my ($entity) = @_;
 485
 486     if (my $path = $entity->{PMX_decoded_path}) {
 487
 488         # set a reasonable default if magic does not give a result
 489         $entity->{PMX_magic_ct} = $entity->head->mime_attr('content-type');
 490
 491         if (my $ct = magic_mime_type_for_file($path)) {
 492             if ($ct ne 'application/octet-stream' || !$entity->{PMX_magic_ct}) {
 493                 $entity->{PMX_magic_ct} = $ct;
 494             }
 495         }
 496
 497         my $filename = $entity->head->recommended_filename;
 498         $filename = basename($path) if !defined($filename) || $filename eq '';
 499
 500         if (my $ct = xdg_mime_get_mime_type_from_file_name($filename)) {
 501             $entity->{PMX_glob_ct} = $ct;
 502         }
 503     }
 504
 505     foreach my $part ($entity->parts)  {
 506         add_ct_marks ($part);
 507     }
 508 }
 509
 510 # x509 certificate utils
 511
 512 # only write output if something fails
 513 sub run_silent_cmd {
 514     my ($cmd) = @_;
 515
 516     my $outbuf = '';
 517
 518     my $record_output = sub {
 519         $outbuf .= shift;
 520         $outbuf .= "\n";
 521     };
 522
 523     eval {
 524         PVE::Tools::run_command($cmd, outfunc => $record_output,
 525                                 errfunc => $record_output);
 526     };
 527     my $err = $@;
 528
 529     if ($err) {
 530         print STDERR $outbuf;
 531         die $err;
 532     }
 533 }
 534
 535 my $proxmox_tls_cert_fn = "/etc/pmg/pmg-tls.pem";
 536
 537 sub gen_proxmox_tls_cert {
 538     my ($force) = @_;
 539
 540     my $resolv = PVE::INotify::read_file('resolvconf');
 541     my $domain = $resolv->{search};
 542
 543     my $company = $domain; # what else ?
 544     my $cn = "*.$domain";
 545
 546    return if !$force && -f $proxmox_tls_cert_fn;
 547
 548     my $sslconf = <<__EOD__;
 549 RANDFILE = /root/.rnd
 550 extensions = v3_req
 551
 552 [ req ]
 553 default_bits = 4096
 554 distinguished_name = req_distinguished_name
 555 req_extensions = v3_req
 556 prompt = no
 557 string_mask = nombstr
 558
 559 [ req_distinguished_name ]
 560 organizationalUnitName = Proxmox Mail Gateway
 561 organizationName = $company
 562 commonName = $cn
 563
 564 [ v3_req ]
 565 basicConstraints = CA:FALSE
 566 nsCertType = server
 567 keyUsage = nonRepudiation, digitalSignature, keyEncipherment
 568 __EOD__
 569
 570     my $cfgfn = "/tmp/pmgtlsconf-$$.tmp";
 571     my $fh = IO::File->new ($cfgfn, "w");
 572     print $fh $sslconf;
 573     close ($fh);
 574
 575     eval {
 576         my $cmd = ['openssl', 'req', '-batch', '-x509', '-new', '-sha256',
 577                    '-config', $cfgfn, '-days', 3650, '-nodes',
 578                    '-out', $proxmox_tls_cert_fn,
 579                    '-keyout', $proxmox_tls_cert_fn];
 580         run_silent_cmd($cmd);
 581     };
 582
 583     if (my $err = $@) {
 584         unlink $proxmox_tls_cert_fn;
 585         unlink $cfgfn;
 586         die "unable to generate proxmox certificate request:\n$err";
 587     }
 588
 589     unlink $cfgfn;
 590 }
 591
 592 sub find_local_network_for_ip {
 593     my ($ip, $noerr) = @_;
 594
 595     my $testip = Net::IP->new($ip);
 596
 597     my $isv6 = $testip->version == 6;
 598     my $routes = $isv6 ?
 599         PVE::ProcFSTools::read_proc_net_ipv6_route() :
 600         PVE::ProcFSTools::read_proc_net_route();
 601
 602     foreach my $entry (@$routes) {
 603         my $mask;
 604         if ($isv6) {
 605             $mask = $entry->{prefix};
 606             next if !$mask; # skip the default route...
 607         } else {
 608             $mask = $PVE::Network::ipv4_mask_hash_localnet->{$entry->{mask}};
 609             next if !defined($mask);
 610         }
 611         my $cidr = "$entry->{dest}/$mask";
 612         my $testnet = Net::IP->new($cidr);
 613         my $overlap = $testnet->overlaps($testip);
 614         if ($overlap == $Net::IP::IP_B_IN_A_OVERLAP ||
 615             $overlap == $Net::IP::IP_IDENTICAL)
 616         {
 617             return $cidr;
 618         }
 619     }
 620
 621     return undef if $noerr;
 622
 623     die "unable to detect local network for ip '$ip'\n";
 624 }
 625
 626 my $service_aliases = {
 627     'postfix' =>  'postfix@-',
 628     'postgres' => 'postgresql@9.6-main',
 629 };
 630
 631 sub lookup_real_service_name {
 632     my $alias = shift;
 633
 634     return $service_aliases->{$alias} // $alias;
 635 }
 636
 637 sub get_full_service_state {
 638     my ($service) = @_;
 639
 640     my $res;
 641
 642     my $parser = sub {
 643         my $line = shift;
 644         if ($line =~ m/^([^=\s]+)=(.*)$/) {
 645             $res->{$1} = $2;
 646         }
 647     };
 648
 649     $service = $service_aliases->{$service} // $service;
 650     PVE::Tools::run_command(['systemctl', 'show', $service], outfunc => $parser);
 651
 652     return $res;
 653 }
 654
 655 our $db_service_list = [
 656     'pmgpolicy', 'pmgmirror', 'pmgtunnel', 'pmg-smtp-filter' ];
 657
 658 sub service_wait_stopped {
 659     my ($timeout, $service_list) = @_;
 660
 661     my $starttime = time();
 662
 663     foreach my $service (@$service_list) {
 664         PVE::Tools::run_command(['systemctl', 'stop', $service]);
 665     }
 666
 667     while (1) {
 668         my $wait = 0;
 669
 670         foreach my $service (@$service_list) {
 671             my $ss = get_full_service_state($service);
 672             my $state = $ss->{ActiveState} // 'unknown';
 673
 674             if ($state ne 'inactive') {
 675                 if ((time() - $starttime) > $timeout) {
 676                     syslog('err', "unable to stop services (got timeout)");
 677                     $wait = 0;
 678                     last;
 679                 }
 680                 $wait = 1;
 681             }
 682         }
 683
 684         last if !$wait;
 685
 686         sleep(1);
 687     }
 688 }
 689
 690 sub service_cmd {
 691     my ($service, $cmd) = @_;
 692
 693     die "unknown service command '$cmd'\n"
 694         if $cmd !~ m/^(start|stop|restart|reload|reload-or-restart)$/;
 695
 696     if ($service eq 'pmgdaemon' || $service eq 'pmgproxy') {
 697         die "invalid service cmd '$service $cmd': ERROR" if $cmd eq 'stop';
 698     } elsif ($service eq 'fetchmail') {
 699         # use restart instead of start - else it does not start 'exited' unit
 700         # after setting START_DAEMON=yes in /etc/default/fetchmail
 701         $cmd = 'restart' if $cmd eq 'start';
 702     }
 703
 704     $service = $service_aliases->{$service} // $service;
 705     PVE::Tools::run_command(['systemctl', $cmd, $service]);
 706 };
 707
 708 # this is also used to get the IP of the local node
 709 sub lookup_node_ip {
 710     my ($nodename, $noerr) = @_;
 711
 712     my ($family, $packed_ip);
 713
 714     eval {
 715         my @res = PVE::Tools::getaddrinfo_all($nodename);
 716         $family = $res[0]->{family};
 717         $packed_ip = (PVE::Tools::unpack_sockaddr_in46($res[0]->{addr}))[2];
 718     };
 719
 720     if ($@) {
 721         die "hostname lookup failed:\n$@" if !$noerr;
 722         return undef;
 723     }
 724
 725     my $ip = Socket::inet_ntop($family, $packed_ip);
 726     if ($ip =~ m/^127\.|^::1$/) {
 727         die "hostname lookup failed - got local IP address ($nodename = $ip)\n" if !$noerr;
 728         return undef;
 729     }
 730
 731     return wantarray ? ($ip, $family) : $ip;
 732 }
 733
 734 sub run_postmap {
 735     my ($filename) = @_;
 736
 737     # make sure the file exists (else postmap fails)
 738     IO::File->new($filename, 'a', 0644);
 739
 740     my $mtime_src = (CORE::stat($filename))[9] //
 741         die "unbale to read mtime of $filename\n";
 742
 743     my $mtime_dst = (CORE::stat("$filename.db"))[9] // 0;
 744
 745     # if not changed, do nothing
 746     return if $mtime_src <= $mtime_dst;
 747
 748     eval {
 749         PVE::Tools::run_command(
 750             ['/usr/sbin/postmap', $filename],
 751             errmsg => "unable to update postfix table $filename");
 752     };
 753     my $err = $@;
 754
 755     warn $err if $err;
 756 }
 757
 758 sub clamav_dbstat {
 759
 760     my $res = [];
 761
 762     my $read_cvd_info = sub {
 763         my ($dbname, $dbfile) = @_;
 764
 765         my $header;
 766         my $fh = IO::File->new("<$dbfile");
 767         if (!$fh) {
 768             warn "cant open ClamAV Database $dbname ($dbfile) - $!\n";
 769             return;
 770         }
 771         $fh->read($header, 512);
 772         $fh->close();
 773
 774         ## ClamAV-VDB:16 Mar 2016 23-17 +0000:57:4218790:60:06386f34a16ebeea2733ab037f0536be:
 775         if ($header =~ m/^(ClamAV-VDB):([^:]+):(\d+):(\d+):/) {
 776             my ($ftype, $btime, $version, $nsigs) = ($1, $2, $3, $4);
 777             push @$res, {
 778                 name => $dbname,
 779                 type => $ftype,
 780                 build_time => $btime,
 781                 version => $version,
 782                 nsigs => $nsigs,
 783             };
 784         } else {
 785             warn "unable to parse ClamAV Database $dbname ($dbfile)\n";
 786         }
 787     };
 788
 789     # main database
 790     my $filename = "/var/lib/clamav/main.inc/main.info";
 791     $filename = "/var/lib/clamav/main.cvd" if ! -f $filename;
 792
 793     $read_cvd_info->('main', $filename) if -f $filename;
 794
 795     # daily database
 796     $filename = "/var/lib/clamav/daily.inc/daily.info";
 797     $filename = "/var/lib/clamav/daily.cvd" if ! -f $filename;
 798     $filename = "/var/lib/clamav/daily.cld" if ! -f $filename;
 799
 800     $read_cvd_info->('daily', $filename) if -f $filename;
 801
 802     $filename = "/var/lib/clamav/bytecode.cvd";
 803     $read_cvd_info->('bytecode', $filename) if -f $filename;
 804
 805     $filename = "/var/lib/clamav/safebrowsing.cvd";
 806     $read_cvd_info->('safebrowsing', $filename) if -f $filename;
 807
 808     my $ss_dbs_fn = "/var/lib/clamav-unofficial-sigs/configs/ss-include-dbs.txt";
 809     my $ss_dbs_files = {};
 810     if (my $ssfh = IO::File->new("<${ss_dbs_fn}")) {
 811         while (defined(my $line = <$ssfh>)) {
 812             chomp $line;
 813             $ss_dbs_files->{$line} = 1;
 814         }
 815     }
 816     my $last = 0;
 817     my $nsigs = 0;
 818     foreach $filename (</var/lib/clamav/*>) {
 819         my $fn = basename($filename);
 820         next if !$ss_dbs_files->{$fn};
 821
 822         my $fh = IO::File->new("<$filename");
 823         next if !defined($fh);
 824         my $st = stat($fh);
 825         next if !$st;
 826         my $mtime = $st->mtime();
 827         $last = $mtime if $mtime > $last;
 828         while (defined(my $line = <$fh>)) { $nsigs++; }
 829     }
 830
 831     if ($nsigs > 0) {
 832         push @$res, {
 833             name => 'sanesecurity',
 834             type => 'unofficial',
 835             build_time => strftime("%d %b %Y %H-%M %z", localtime($last)),
 836             nsigs => $nsigs,
 837         };
 838     }
 839
 840     return $res;
 841 }
 842
 843 # RRD related code
 844 my $rrd_dir = "/var/lib/rrdcached/db";
 845 my $rrdcached_socket = "/var/run/rrdcached.sock";
 846
 847 my $rrd_def_node = [
 848     "DS:loadavg:GAUGE:120:0:U",
 849     "DS:maxcpu:GAUGE:120:0:U",
 850     "DS:cpu:GAUGE:120:0:U",
 851     "DS:iowait:GAUGE:120:0:U",
 852     "DS:memtotal:GAUGE:120:0:U",
 853     "DS:memused:GAUGE:120:0:U",
 854     "DS:swaptotal:GAUGE:120:0:U",
 855     "DS:swapused:GAUGE:120:0:U",
 856     "DS:roottotal:GAUGE:120:0:U",
 857     "DS:rootused:GAUGE:120:0:U",
 858     "DS:netin:DERIVE:120:0:U",
 859     "DS:netout:DERIVE:120:0:U",
 860
 861     "RRA:AVERAGE:0.5:1:70", # 1 min avg - one hour
 862     "RRA:AVERAGE:0.5:30:70", # 30 min avg - one day
 863     "RRA:AVERAGE:0.5:180:70", # 3 hour avg - one week
 864     "RRA:AVERAGE:0.5:720:70", # 12 hour avg - one month
 865     "RRA:AVERAGE:0.5:10080:70", # 7 day avg - ony year
 866
 867     "RRA:MAX:0.5:1:70", # 1 min max - one hour
 868     "RRA:MAX:0.5:30:70", # 30 min max - one day
 869     "RRA:MAX:0.5:180:70", # 3 hour max - one week
 870     "RRA:MAX:0.5:720:70", # 12 hour max - one month
 871     "RRA:MAX:0.5:10080:70", # 7 day max - ony year
 872 ];
 873
 874 sub cond_create_rrd_file {
 875     my ($filename, $rrddef) = @_;
 876
 877     return if -f $filename;
 878
 879     my @args = ($filename);
 880
 881     push @args, "--daemon" => "unix:${rrdcached_socket}"
 882         if -S $rrdcached_socket;
 883
 884     push @args, '--step', 60;
 885
 886     push @args, @$rrddef;
 887
 888     # print "TEST: " . join(' ', @args) . "\n";
 889
 890     RRDs::create(@args);
 891     my $err = RRDs::error;
 892     die "RRD error: $err\n" if $err;
 893 }
 894
 895 sub update_node_status_rrd {
 896
 897     my $filename = "$rrd_dir/pmg-node-v1.rrd";
 898     cond_create_rrd_file($filename, $rrd_def_node);
 899
 900     my ($avg1, $avg5, $avg15) = PVE::ProcFSTools::read_loadavg();
 901
 902     my $stat = PVE::ProcFSTools::read_proc_stat();
 903
 904     my $netdev = PVE::ProcFSTools::read_proc_net_dev();
 905
 906     my ($uptime) = PVE::ProcFSTools::read_proc_uptime();
 907
 908     my $cpuinfo = PVE::ProcFSTools::read_cpuinfo();
 909
 910     my $maxcpu = $cpuinfo->{cpus};
 911
 912     # traffic from/to physical interface cards
 913     my $netin = 0;
 914     my $netout = 0;
 915     foreach my $dev (keys %$netdev) {
 916         next if $dev !~ m/^$PVE::Network::PHYSICAL_NIC_RE$/;
 917         $netin += $netdev->{$dev}->{receive};
 918         $netout += $netdev->{$dev}->{transmit};
 919     }
 920
 921     my $meminfo = PVE::ProcFSTools::read_meminfo();
 922
 923     my $dinfo = df('/', 1); # output is bytes
 924
 925     my $ctime = time();
 926
 927     # everything not free is considered to be used
 928     my $dused = $dinfo->{blocks} - $dinfo->{bfree};
 929
 930     my $data = "$ctime:$avg1:$maxcpu:$stat->{cpu}:$stat->{wait}:" .
 931         "$meminfo->{memtotal}:$meminfo->{memused}:" .
 932         "$meminfo->{swaptotal}:$meminfo->{swapused}:" .
 933         "$dinfo->{blocks}:$dused:$netin:$netout";
 934
 935
 936     my @args = ($filename);
 937
 938     push @args, "--daemon" => "unix:${rrdcached_socket}"
 939         if -S $rrdcached_socket;
 940
 941     push @args, $data;
 942
 943     # print "TEST: " . join(' ', @args) . "\n";
 944
 945     RRDs::update(@args);
 946     my $err = RRDs::error;
 947     die "RRD error: $err\n" if $err;
 948 }
 949
 950 sub create_rrd_data {
 951     my ($rrdname, $timeframe, $cf) = @_;
 952
 953     my $rrd = "${rrd_dir}/$rrdname";
 954
 955     my $setup = {
 956         hour =>  [ 60, 70 ],
 957         day  =>  [ 60*30, 70 ],
 958         week =>  [ 60*180, 70 ],
 959         month => [ 60*720, 70 ],
 960         year =>  [ 60*10080, 70 ],
 961     };
 962
 963     my ($reso, $count) = @{$setup->{$timeframe}};
 964     my $ctime  = $reso*int(time()/$reso);
 965     my $req_start = $ctime - $reso*$count;
 966
 967     $cf = "AVERAGE" if !$cf;
 968
 969     my @args = (
 970         "-s" => $req_start,
 971         "-e" => $ctime - 1,
 972         "-r" => $reso,
 973         );
 974
 975     push @args, "--daemon" => "unix:${rrdcached_socket}"
 976         if -S $rrdcached_socket;
 977
 978     my ($start, $step, $names, $data) = RRDs::fetch($rrd, $cf, @args);
 979
 980     my $err = RRDs::error;
 981     die "RRD error: $err\n" if $err;
 982
 983     die "got wrong time resolution ($step != $reso)\n"
 984         if $step != $reso;
 985
 986     my $res = [];
 987     my $fields = scalar(@$names);
 988     for my $line (@$data) {
 989         my $entry = { 'time' => $start };
 990         $start += $step;
 991         for (my $i = 0; $i < $fields; $i++) {
 992             my $name = $names->[$i];
 993             if (defined(my $val = $line->[$i])) {
 994                 $entry->{$name} = $val;
 995             } else {
 996                 # leave empty fields undefined
 997                 # maybe make this configurable?
 998             }
 999         }
1000         push @$res, $entry;
1001     }
1002
1003     return $res;
1004 }
1005
1006 sub decode_to_html {
1007     my ($charset, $data) = @_;
1008
1009     my $res = $data;
1010
1011     eval { $res = encode_entities(decode($charset, $data)); };
1012
1013     return $res;
1014 }
1015
1016 sub decode_rfc1522 {
1017     my ($enc) = @_;
1018
1019     my $res = '';
1020
1021     return '' if !$enc;
1022
1023     eval {
1024         foreach my $r (MIME::Words::decode_mimewords($enc)) {
1025             my ($d, $cs) = @$r;
1026             if ($d) {
1027                 if ($cs) {
1028                     $res .= decode($cs, $d);
1029                 } else {
1030                     $res .= $d;
1031                 }
1032             }
1033         }
1034     };
1035
1036     $res = $enc if $@;
1037
1038     return $res;
1039 }
1040
1041 sub rfc1522_to_html {
1042     my ($enc) = @_;
1043
1044     my $res = '';
1045
1046     return '' if !$enc;
1047
1048     eval {
1049         foreach my $r (MIME::Words::decode_mimewords($enc)) {
1050             my ($d, $cs) = @$r;
1051             if ($d) {
1052                 if ($cs) {
1053                     $res .= encode_entities(decode($cs, $d));
1054                 } else {
1055                     $res .= encode_entities($d);
1056                 }
1057             }
1058         }
1059     };
1060
1061     $res = $enc if $@;
1062
1063     return $res;
1064 }
1065
1066 # RFC 2047 B-ENCODING http://rfc.net/rfc2047.html
1067 # (Q-Encoding is complex and error prone)
1068 sub bencode_header {
1069     my $txt = shift;
1070
1071     my $CRLF = "\015\012";
1072
1073     # Nonprintables (controls + x7F + 8bit):
1074     my $NONPRINT = "\\x00-\\x1F\\x7F-\\xFF";
1075
1076     # always use utf-8 (work with japanese character sets)
1077     $txt = encode("UTF-8", $txt);
1078
1079     return $txt if $txt !~ /[$NONPRINT]/o;
1080
1081     my $res = '';
1082
1083     while ($txt =~ s/^(.{1,42})//sm) {
1084         my $t = MIME::Words::encode_mimeword ($1, 'B', 'UTF-8');
1085         $res .= $res ? "\015\012\t$t" : $t;
1086     }
1087
1088     return $res;
1089 }
1090
1091 sub load_sa_descriptions {
1092     my ($additional_dirs) = @_;
1093
1094     my @dirs = ('/usr/share/spamassassin',
1095                 '/usr/share/spamassassin-extra');
1096
1097     push @dirs, @$additional_dirs if @$additional_dirs;
1098
1099     my $res = {};
1100
1101     my $parse_sa_file = sub {
1102         my ($file) = @_;
1103
1104         open(my $fh,'<', $file);
1105         return if !defined($fh);
1106
1107         while (defined(my $line = <$fh>)) {
1108             if ($line =~ m/^describe\s+(\S+)\s+(.*)\s*$/) {
1109                 my ($name, $desc) = ($1, $2);
1110                 next if $res->{$name};
1111                 $res->{$name}->{desc} = $desc;
1112                 if ($desc =~ m|[\(\s](http:\/\/\S+\.[^\s\.\)]+\.[^\s\.\)]+)|i) {
1113                     $res->{$name}->{url} = $1;
1114                 }
1115             }
1116         }
1117         close($fh);
1118     };
1119
1120     foreach my $dir (@dirs) {
1121         foreach my $file (<$dir/*.cf>) {
1122             $parse_sa_file->($file);
1123         }
1124     }
1125
1126     $res->{'ClamAVHeuristics'}->{desc} = "ClamAV heuristic tests";
1127
1128     return $res;
1129 }
1130
1131 sub format_uptime {
1132     my ($uptime) = @_;
1133
1134     my $days = int($uptime/86400);
1135     $uptime -= $days*86400;
1136
1137     my $hours = int($uptime/3600);
1138     $uptime -= $hours*3600;
1139
1140     my $mins = $uptime/60;
1141
1142     if ($days) {
1143         my $ds = $days > 1 ? 'days' : 'day';
1144         return sprintf "%d $ds %02d:%02d", $days, $hours, $mins;
1145     } else {
1146         return sprintf "%02d:%02d", $hours, $mins;
1147     }
1148 }
1149
1150 sub finalize_report {
1151     my ($tt, $template, $data, $mailfrom, $receiver, $debug) = @_;
1152
1153     my $html = '';
1154
1155     $tt->process($template, $data, \$html) ||
1156         die $tt->error() . "\n";
1157
1158     my $title;
1159     if ($html =~ m|^\s*<title>(.*)</title>|m) {
1160         $title = $1;
1161     } else {
1162         die "unable to extract template title\n";
1163     }
1164
1165     my $top = MIME::Entity->build(
1166         Type    => "multipart/related",
1167         To      => $data->{pmail},
1168         From    => $mailfrom,
1169         Subject => bencode_header(decode_entities($title)));
1170
1171     $top->attach(
1172         Data     => $html,
1173         Type     => "text/html",
1174         Encoding => $debug ? 'binary' : 'quoted-printable');
1175
1176     if ($debug) {
1177         $top->print();
1178         return;
1179     }
1180     # we use an empty envelope sender (we dont want to receive NDRs)
1181     PMG::Utils::reinject_mail ($top, '', [$receiver], undef, $data->{fqdn});
1182 }
1183
1184 sub lookup_timespan {
1185     my ($timespan) = @_;
1186
1187     my (undef, undef, undef, $mday, $mon, $year) = localtime(time());
1188     my $daystart = timelocal(0, 0, 0, $mday, $mon, $year);
1189
1190     my $start;
1191     my $end;
1192
1193     if ($timespan eq 'today') {
1194         $start = $daystart;
1195         $end = $start + 86400;
1196     } elsif ($timespan eq 'yesterday') {
1197         $end = $daystart;
1198         $start = $end - 86400;
1199     } elsif ($timespan eq 'week') {
1200         $end = $daystart;
1201         $start = $end - 7*86400;
1202     } else {
1203         die "internal error";
1204     }
1205
1206     return ($start, $end);
1207 }
1208
1209 my $rbl_scan_last_cursor;
1210 my $rbl_scan_start_time = time();
1211
1212 sub scan_journal_for_rbl_rejects {
1213
1214     # example postscreen log entry for RBL rejects
1215     # Aug 29 08:00:36 proxmox postfix/postscreen[11266]: NOQUEUE: reject: RCPT from [x.x.x.x]:1234: 550 5.7.1 Service unavailable; client [x.x.x.x] blocked using zen.spamhaus.org; from=<xxxx>, to=<yyyy>, proto=ESMTP, helo=<zzz>
1216
1217     # example for PREGREET reject
1218     # Dec  7 06:57:11 proxmox postfix/postscreen[32084]: PREGREET 14 after 0.23 from [x.x.x.x]:63492: EHLO yyyyy\r\n
1219
1220     my $identifier = 'postfix/postscreen';
1221
1222     my $rbl_count = 0;
1223     my $pregreet_count = 0;
1224
1225     my $parser = sub {
1226         my $line = shift;
1227
1228         if ($line =~ m/^--\scursor:\s(\S+)$/) {
1229             $rbl_scan_last_cursor = $1;
1230             return;
1231         }
1232
1233         if ($line =~ m/\s$identifier\[\d+\]:\sNOQUEUE:\sreject:.*550 5.7.1 Service unavailable;/) {
1234             $rbl_count++;
1235         } elsif ($line =~ m/\s$identifier\[\d+\]:\sPREGREET\s\d+\safter\s/) {
1236             $pregreet_count++;
1237         }
1238     };
1239
1240     # limit to last 5000 lines to avoid long delays
1241     my $cmd = ['journalctl', '--show-cursor', '-o', 'short-unix', '--no-pager',
1242                '--identifier', $identifier, '-n', 5000];
1243
1244     if (defined($rbl_scan_last_cursor)) {
1245         push @$cmd, "--after-cursor=${rbl_scan_last_cursor}";
1246     } else {
1247         push @$cmd, "--since=@" . $rbl_scan_start_time;
1248     }
1249
1250     PVE::Tools::run_command($cmd, outfunc => $parser);
1251
1252     return ($rbl_count, $pregreet_count);
1253 }
1254
1255 my $hwaddress;
1256
1257 sub get_hwaddress {
1258
1259     return $hwaddress if defined ($hwaddress);
1260
1261     my $fn = '/etc/ssh/ssh_host_rsa_key.pub';
1262     my $sshkey = PVE::Tools::file_get_contents($fn);
1263     $hwaddress = uc(Digest::MD5::md5_hex($sshkey));
1264
1265     return $hwaddress;
1266 }
1267
1268 my $default_locale = "en_US.UTF-8 UTF-8";
1269
1270 sub cond_add_default_locale {
1271
1272     my $filename = "/etc/locale.gen";
1273
1274     open(my $infh, "<", $filename) || return;
1275
1276     while (defined(my $line = <$infh>)) {
1277         if ($line =~ m/^\Q${default_locale}\E/) {
1278             # already configured
1279             return;
1280         }
1281     }
1282
1283     seek($infh, 0, 0) // return; # seek failed
1284
1285     open(my $outfh, ">", "$filename.tmp") || return;
1286
1287     my $done;
1288     while (defined(my $line = <$infh>)) {
1289         if ($line =~ m/^#\s*\Q${default_locale}\E.*/) {
1290             print $outfh "${default_locale}\n" if !$done;
1291             $done = 1;
1292         } else {
1293             print $outfh $line;
1294         }
1295     }
1296
1297     print STDERR "generation pmg default locale\n";
1298
1299     rename("$filename.tmp", $filename) || return; # rename failed
1300
1301     system("dpkg-reconfigure locales -f noninteractive");
1302 }
1303
1304 1;