src/PMG/Utils.pm

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