src/PMG/Utils.pm

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