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