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