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