src/PMG/Utils.pm

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