PMG/Utils.pm

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