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