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     # always scan with clamav
 412     return analyze_virus_clam($queue, $filename, $pmg_cfg);
 413 }
 414
 415 sub magic_mime_type_for_file {
 416     my ($filename) = @_;
 417
 418     # we do not use get_mime_type_for_file, because that considers
 419     # filename extensions - we only want magic type detection
 420
 421     my $bufsize = Xdgmime::xdg_mime_get_max_buffer_extents();
 422     die "got strange value for max_buffer_extents" if $bufsize > 4096*10;
 423
 424     my $ct = "application/octet-stream";
 425
 426     my $fh = IO::File->new("<$filename") ||
 427         die "unable to open file '$filename' - $!";
 428
 429     my ($buf, $len);
 430     if (($len = $fh->read($buf, $bufsize)) > 0) {
 431         $ct = xdg_mime_get_mime_type_for_data($buf, $len);
 432     }
 433     $fh->close();
 434
 435     die "unable to read file '$filename' - $!" if ($len < 0);
 436
 437     return $ct;
 438 }
 439
 440 sub add_ct_marks {
 441     my ($entity) = @_;
 442
 443     if (my $path = $entity->{PMX_decoded_path}) {
 444
 445         # set a reasonable default if magic does not give a result
 446         $entity->{PMX_magic_ct} = $entity->head->mime_attr('content-type');
 447
 448         if (my $ct = magic_mime_type_for_file($path)) {
 449             if ($ct ne 'application/octet-stream' || !$entity->{PMX_magic_ct}) {
 450                 $entity->{PMX_magic_ct} = $ct;
 451             }
 452         }
 453
 454         my $filename = $entity->head->recommended_filename;
 455         $filename = basename($path) if !defined($filename) || $filename eq '';
 456
 457         if (my $ct = xdg_mime_get_mime_type_from_file_name($filename)) {
 458             $entity->{PMX_glob_ct} = $ct;
 459         }
 460     }
 461
 462     foreach my $part ($entity->parts)  {
 463         add_ct_marks ($part);
 464     }
 465 }
 466
 467 # x509 certificate utils
 468
 469 # only write output if something fails
 470 sub run_silent_cmd {
 471     my ($cmd) = @_;
 472
 473     my $outbuf = '';
 474
 475     my $record_output = sub {
 476         $outbuf .= shift;
 477         $outbuf .= "\n";
 478     };
 479
 480     eval {
 481         PVE::Tools::run_command($cmd, outfunc => $record_output,
 482                                 errfunc => $record_output);
 483     };
 484     my $err = $@;
 485
 486     if ($err) {
 487         print STDERR $outbuf;
 488         die $err;
 489     }
 490 }
 491
 492 my $proxmox_tls_cert_fn = "/etc/pmg/pmg-tls.pem";
 493
 494 sub gen_proxmox_tls_cert {
 495     my ($force) = @_;
 496
 497     my $resolv = PVE::INotify::read_file('resolvconf');
 498     my $domain = $resolv->{search};
 499
 500     my $company = $domain; # what else ?
 501     my $cn = "*.$domain";
 502
 503    return if !$force && -f $proxmox_tls_cert_fn;
 504
 505     my $sslconf = <<__EOD__;
 506 RANDFILE = /root/.rnd
 507 extensions = v3_req
 508
 509 [ req ]
 510 default_bits = 4096
 511 distinguished_name = req_distinguished_name
 512 req_extensions = v3_req
 513 prompt = no
 514 string_mask = nombstr
 515
 516 [ req_distinguished_name ]
 517 organizationalUnitName = Proxmox Mail Gateway
 518 organizationName = $company
 519 commonName = $cn
 520
 521 [ v3_req ]
 522 basicConstraints = CA:FALSE
 523 nsCertType = server
 524 keyUsage = nonRepudiation, digitalSignature, keyEncipherment
 525 __EOD__
 526
 527     my $cfgfn = "/tmp/pmgtlsconf-$$.tmp";
 528     my $fh = IO::File->new ($cfgfn, "w");
 529     print $fh $sslconf;
 530     close ($fh);
 531
 532     eval {
 533         my $cmd = ['openssl', 'req', '-batch', '-x509', '-new', '-sha256',
 534                    '-config', $cfgfn, '-days', 3650, '-nodes',
 535                    '-out', $proxmox_tls_cert_fn,
 536                    '-keyout', $proxmox_tls_cert_fn];
 537         run_silent_cmd($cmd);
 538     };
 539
 540     if (my $err = $@) {
 541         unlink $proxmox_tls_cert_fn;
 542         unlink $cfgfn;
 543         die "unable to generate proxmox certificate request:\n$err";
 544     }
 545
 546     unlink $cfgfn;
 547 }
 548
 549 sub find_local_network_for_ip {
 550     my ($ip, $noerr) = @_;
 551
 552     my $testip = Net::IP->new($ip);
 553
 554     my $isv6 = $testip->version == 6;
 555     my $routes = $isv6 ?
 556         PVE::ProcFSTools::read_proc_net_ipv6_route() :
 557         PVE::ProcFSTools::read_proc_net_route();
 558
 559     foreach my $entry (@$routes) {
 560         my $mask;
 561         if ($isv6) {
 562             $mask = $entry->{prefix};
 563             next if !$mask; # skip the default route...
 564         } else {
 565             $mask = $PVE::Network::ipv4_mask_hash_localnet->{$entry->{mask}};
 566             next if !defined($mask);
 567         }
 568         my $cidr = "$entry->{dest}/$mask";
 569         my $testnet = Net::IP->new($cidr);
 570         my $overlap = $testnet->overlaps($testip);
 571         if ($overlap == $Net::IP::IP_B_IN_A_OVERLAP ||
 572             $overlap == $Net::IP::IP_IDENTICAL)
 573         {
 574             return $cidr;
 575         }
 576     }
 577
 578     return undef if $noerr;
 579
 580     die "unable to detect local network for ip '$ip'\n";
 581 }
 582
 583 my $service_aliases = {
 584     'postfix' =>  'postfix@-',
 585     'postgres' => 'postgresql@9.6-main',
 586 };
 587
 588 sub lookup_real_service_name {
 589     my $alias = shift;
 590
 591     return $service_aliases->{$alias} // $alias;
 592 }
 593
 594 sub get_full_service_state {
 595     my ($service) = @_;
 596
 597     my $res;
 598
 599     my $parser = sub {
 600         my $line = shift;
 601         if ($line =~ m/^([^=\s]+)=(.*)$/) {
 602             $res->{$1} = $2;
 603         }
 604     };
 605
 606     $service = $service_aliases->{$service} // $service;
 607     PVE::Tools::run_command(['systemctl', 'show', $service], outfunc => $parser);
 608
 609     return $res;
 610 }
 611
 612 our $db_service_list = [
 613     'pmgpolicy', 'pmgmirror', 'pmgtunnel', 'pmg-smtp-filter' ];
 614
 615 sub service_wait_stopped {
 616     my ($timeout, $service_list) = @_;
 617
 618     my $starttime = time();
 619
 620     foreach my $service (@$service_list) {
 621         PVE::Tools::run_command(['systemctl', 'stop', $service]);
 622     }
 623
 624     while (1) {
 625         my $wait = 0;
 626
 627         foreach my $service (@$service_list) {
 628             my $ss = get_full_service_state($service);
 629             my $state = $ss->{ActiveState} // 'unknown';
 630
 631             if ($state ne 'inactive') {
 632                 if ((time() - $starttime) > $timeout) {
 633                     syslog('err', "unable to stop services (got timeout)");
 634                     $wait = 0;
 635                     last;
 636                 }
 637                 $wait = 1;
 638             }
 639         }
 640
 641         last if !$wait;
 642
 643         sleep(1);
 644     }
 645 }
 646
 647 sub service_cmd {
 648     my ($service, $cmd) = @_;
 649
 650     die "unknown service command '$cmd'\n"
 651         if $cmd !~ m/^(start|stop|restart|reload|reload-or-restart)$/;
 652
 653     if ($service eq 'pmgdaemon' || $service eq 'pmgproxy') {
 654         die "invalid service cmd '$service $cmd': ERROR" if $cmd eq 'stop';
 655     } elsif ($service eq 'fetchmail') {
 656         # use restart instead of start - else it does not start 'exited' unit
 657         # after setting START_DAEMON=yes in /etc/default/fetchmail
 658         $cmd = 'restart' if $cmd eq 'start';
 659     }
 660
 661     $service = $service_aliases->{$service} // $service;
 662     PVE::Tools::run_command(['systemctl', $cmd, $service]);
 663 };
 664
 665 # this is also used to get the IP of the local node
 666 sub lookup_node_ip {
 667     my ($nodename, $noerr) = @_;
 668
 669     my ($family, $packed_ip);
 670
 671     eval {
 672         my @res = PVE::Tools::getaddrinfo_all($nodename);
 673         $family = $res[0]->{family};
 674         $packed_ip = (PVE::Tools::unpack_sockaddr_in46($res[0]->{addr}))[2];
 675     };
 676
 677     if ($@) {
 678         die "hostname lookup failed:\n$@" if !$noerr;
 679         return undef;
 680     }
 681
 682     my $ip = Socket::inet_ntop($family, $packed_ip);
 683     if ($ip =~ m/^127\.|^::1$/) {
 684         die "hostname lookup failed - got local IP address ($nodename = $ip)\n" if !$noerr;
 685         return undef;
 686     }
 687
 688     return wantarray ? ($ip, $family) : $ip;
 689 }
 690
 691 sub run_postmap {
 692     my ($filename) = @_;
 693
 694     # make sure the file exists (else postmap fails)
 695     IO::File->new($filename, 'a', 0644);
 696
 697     my $mtime_src = (CORE::stat($filename))[9] //
 698         die "unbale to read mtime of $filename\n";
 699
 700     my $mtime_dst = (CORE::stat("$filename.db"))[9] // 0;
 701
 702     # if not changed, do nothing
 703     return if $mtime_src <= $mtime_dst;
 704
 705     eval {
 706         PVE::Tools::run_command(
 707             ['/usr/sbin/postmap', $filename],
 708             errmsg => "unable to update postfix table $filename");
 709     };
 710     my $err = $@;
 711
 712     warn $err if $err;
 713 }
 714
 715 sub clamav_dbstat {
 716
 717     my $res = [];
 718
 719     my $read_cvd_info = sub {
 720         my ($dbname, $dbfile) = @_;
 721
 722         my $header;
 723         my $fh = IO::File->new("<$dbfile");
 724         if (!$fh) {
 725             warn "cant open ClamAV Database $dbname ($dbfile) - $!\n";
 726             return;
 727         }
 728         $fh->read($header, 512);
 729         $fh->close();
 730
 731         ## ClamAV-VDB:16 Mar 2016 23-17 +0000:57:4218790:60:06386f34a16ebeea2733ab037f0536be:
 732         if ($header =~ m/^(ClamAV-VDB):([^:]+):(\d+):(\d+):/) {
 733             my ($ftype, $btime, $version, $nsigs) = ($1, $2, $3, $4);
 734             push @$res, {
 735                 name => $dbname,
 736                 type => $ftype,
 737                 build_time => $btime,
 738                 version => $version,
 739                 nsigs => $nsigs,
 740             };
 741         } else {
 742             warn "unable to parse ClamAV Database $dbname ($dbfile)\n";
 743         }
 744     };
 745
 746     # main database
 747     my $filename = "/var/lib/clamav/main.inc/main.info";
 748     $filename = "/var/lib/clamav/main.cvd" if ! -f $filename;
 749
 750     $read_cvd_info->('main', $filename) if -f $filename;
 751
 752     # daily database
 753     $filename = "/var/lib/clamav/daily.inc/daily.info";
 754     $filename = "/var/lib/clamav/daily.cvd" if ! -f $filename;
 755     $filename = "/var/lib/clamav/daily.cld" if ! -f $filename;
 756
 757     $read_cvd_info->('daily', $filename) if -f $filename;
 758
 759     $filename = "/var/lib/clamav/bytecode.cvd";
 760     $read_cvd_info->('bytecode', $filename) if -f $filename;
 761
 762     $filename = "/var/lib/clamav/safebrowsing.cvd";
 763     $read_cvd_info->('safebrowsing', $filename) if -f $filename;
 764
 765     my $ss_dbs_fn = "/var/lib/clamav-unofficial-sigs/configs/ss-include-dbs.txt";
 766     my $ss_dbs_files = {};
 767     if (my $ssfh = IO::File->new("<${ss_dbs_fn}")) {
 768         while (defined(my $line = <$ssfh>)) {
 769             chomp $line;
 770             $ss_dbs_files->{$line} = 1;
 771         }
 772     }
 773     my $last = 0;
 774     my $nsigs = 0;
 775     foreach $filename (</var/lib/clamav/*>) {
 776         my $fn = basename($filename);
 777         next if !$ss_dbs_files->{$fn};
 778
 779         my $fh = IO::File->new("<$filename");
 780         next if !defined($fh);
 781         my $st = stat($fh);
 782         next if !$st;
 783         my $mtime = $st->mtime();
 784         $last = $mtime if $mtime > $last;
 785         while (defined(my $line = <$fh>)) { $nsigs++; }
 786     }
 787
 788     if ($nsigs > 0) {
 789         push @$res, {
 790             name => 'sanesecurity',
 791             type => 'unofficial',
 792             build_time => strftime("%d %b %Y %H-%M %z", localtime($last)),
 793             nsigs => $nsigs,
 794         };
 795     }
 796
 797     return $res;
 798 }
 799
 800 # RRD related code
 801 my $rrd_dir = "/var/lib/rrdcached/db";
 802 my $rrdcached_socket = "/var/run/rrdcached.sock";
 803
 804 my $rrd_def_node = [
 805     "DS:loadavg:GAUGE:120:0:U",
 806     "DS:maxcpu:GAUGE:120:0:U",
 807     "DS:cpu:GAUGE:120:0:U",
 808     "DS:iowait:GAUGE:120:0:U",
 809     "DS:memtotal:GAUGE:120:0:U",
 810     "DS:memused:GAUGE:120:0:U",
 811     "DS:swaptotal:GAUGE:120:0:U",
 812     "DS:swapused:GAUGE:120:0:U",
 813     "DS:roottotal:GAUGE:120:0:U",
 814     "DS:rootused:GAUGE:120:0:U",
 815     "DS:netin:DERIVE:120:0:U",
 816     "DS:netout:DERIVE:120:0:U",
 817
 818     "RRA:AVERAGE:0.5:1:70", # 1 min avg - one hour
 819     "RRA:AVERAGE:0.5:30:70", # 30 min avg - one day
 820     "RRA:AVERAGE:0.5:180:70", # 3 hour avg - one week
 821     "RRA:AVERAGE:0.5:720:70", # 12 hour avg - one month
 822     "RRA:AVERAGE:0.5:10080:70", # 7 day avg - ony year
 823
 824     "RRA:MAX:0.5:1:70", # 1 min max - one hour
 825     "RRA:MAX:0.5:30:70", # 30 min max - one day
 826     "RRA:MAX:0.5:180:70", # 3 hour max - one week
 827     "RRA:MAX:0.5:720:70", # 12 hour max - one month
 828     "RRA:MAX:0.5:10080:70", # 7 day max - ony year
 829 ];
 830
 831 sub cond_create_rrd_file {
 832     my ($filename, $rrddef) = @_;
 833
 834     return if -f $filename;
 835
 836     my @args = ($filename);
 837
 838     push @args, "--daemon" => "unix:${rrdcached_socket}"
 839         if -S $rrdcached_socket;
 840
 841     push @args, '--step', 60;
 842
 843     push @args, @$rrddef;
 844
 845     # print "TEST: " . join(' ', @args) . "\n";
 846
 847     RRDs::create(@args);
 848     my $err = RRDs::error;
 849     die "RRD error: $err\n" if $err;
 850 }
 851
 852 sub update_node_status_rrd {
 853
 854     my $filename = "$rrd_dir/pmg-node-v1.rrd";
 855     cond_create_rrd_file($filename, $rrd_def_node);
 856
 857     my ($avg1, $avg5, $avg15) = PVE::ProcFSTools::read_loadavg();
 858
 859     my $stat = PVE::ProcFSTools::read_proc_stat();
 860
 861     my $netdev = PVE::ProcFSTools::read_proc_net_dev();
 862
 863     my ($uptime) = PVE::ProcFSTools::read_proc_uptime();
 864
 865     my $cpuinfo = PVE::ProcFSTools::read_cpuinfo();
 866
 867     my $maxcpu = $cpuinfo->{cpus};
 868
 869     # traffic from/to physical interface cards
 870     my $netin = 0;
 871     my $netout = 0;
 872     foreach my $dev (keys %$netdev) {
 873         next if $dev !~ m/^$PVE::Network::PHYSICAL_NIC_RE$/;
 874         $netin += $netdev->{$dev}->{receive};
 875         $netout += $netdev->{$dev}->{transmit};
 876     }
 877
 878     my $meminfo = PVE::ProcFSTools::read_meminfo();
 879
 880     my $dinfo = df('/', 1); # output is bytes
 881
 882     my $ctime = time();
 883
 884     # everything not free is considered to be used
 885     my $dused = $dinfo->{blocks} - $dinfo->{bfree};
 886
 887     my $data = "$ctime:$avg1:$maxcpu:$stat->{cpu}:$stat->{wait}:" .
 888         "$meminfo->{memtotal}:$meminfo->{memused}:" .
 889         "$meminfo->{swaptotal}:$meminfo->{swapused}:" .
 890         "$dinfo->{blocks}:$dused:$netin:$netout";
 891
 892
 893     my @args = ($filename);
 894
 895     push @args, "--daemon" => "unix:${rrdcached_socket}"
 896         if -S $rrdcached_socket;
 897
 898     push @args, $data;
 899
 900     # print "TEST: " . join(' ', @args) . "\n";
 901
 902     RRDs::update(@args);
 903     my $err = RRDs::error;
 904     die "RRD error: $err\n" if $err;
 905 }
 906
 907 sub create_rrd_data {
 908     my ($rrdname, $timeframe, $cf) = @_;
 909
 910     my $rrd = "${rrd_dir}/$rrdname";
 911
 912     my $setup = {
 913         hour =>  [ 60, 70 ],
 914         day  =>  [ 60*30, 70 ],
 915         week =>  [ 60*180, 70 ],
 916         month => [ 60*720, 70 ],
 917         year =>  [ 60*10080, 70 ],
 918     };
 919
 920     my ($reso, $count) = @{$setup->{$timeframe}};
 921     my $ctime  = $reso*int(time()/$reso);
 922     my $req_start = $ctime - $reso*$count;
 923
 924     $cf = "AVERAGE" if !$cf;
 925
 926     my @args = (
 927         "-s" => $req_start,
 928         "-e" => $ctime - 1,
 929         "-r" => $reso,
 930         );
 931
 932     push @args, "--daemon" => "unix:${rrdcached_socket}"
 933         if -S $rrdcached_socket;
 934
 935     my ($start, $step, $names, $data) = RRDs::fetch($rrd, $cf, @args);
 936
 937     my $err = RRDs::error;
 938     die "RRD error: $err\n" if $err;
 939
 940     die "got wrong time resolution ($step != $reso)\n"
 941         if $step != $reso;
 942
 943     my $res = [];
 944     my $fields = scalar(@$names);
 945     for my $line (@$data) {
 946         my $entry = { 'time' => $start };
 947         $start += $step;
 948         for (my $i = 0; $i < $fields; $i++) {
 949             my $name = $names->[$i];
 950             if (defined(my $val = $line->[$i])) {
 951                 $entry->{$name} = $val;
 952             } else {
 953                 # leave empty fields undefined
 954                 # maybe make this configurable?
 955             }
 956         }
 957         push @$res, $entry;
 958     }
 959
 960     return $res;
 961 }
 962
 963 sub decode_to_html {
 964     my ($charset, $data) = @_;
 965
 966     my $res = $data;
 967
 968     eval { $res = encode_entities(decode($charset, $data)); };
 969
 970     return $res;
 971 }
 972
 973 sub decode_rfc1522 {
 974     my ($enc) = @_;
 975
 976     my $res = '';
 977
 978     return '' if !$enc;
 979
 980     eval {
 981         foreach my $r (MIME::Words::decode_mimewords($enc)) {
 982             my ($d, $cs) = @$r;
 983             if ($d) {
 984                 if ($cs) {
 985                     $res .= decode($cs, $d);
 986                 } else {
 987                     $res .= $d;
 988                 }
 989             }
 990         }
 991     };
 992
 993     $res = $enc if $@;
 994
 995     return $res;
 996 }
 997
 998 sub rfc1522_to_html {
 999     my ($enc) = @_;
1000
1001     my $res = '';
1002
1003     return '' if !$enc;
1004
1005     eval {
1006         foreach my $r (MIME::Words::decode_mimewords($enc)) {
1007             my ($d, $cs) = @$r;
1008             if ($d) {
1009                 if ($cs) {
1010                     $res .= encode_entities(decode($cs, $d));
1011                 } else {
1012                     $res .= encode_entities($d);
1013                 }
1014             }
1015         }
1016     };
1017
1018     $res = $enc if $@;
1019
1020     return $res;
1021 }
1022
1023 # RFC 2047 B-ENCODING http://rfc.net/rfc2047.html
1024 # (Q-Encoding is complex and error prone)
1025 sub bencode_header {
1026     my $txt = shift;
1027
1028     my $CRLF = "\015\012";
1029
1030     # Nonprintables (controls + x7F + 8bit):
1031     my $NONPRINT = "\\x00-\\x1F\\x7F-\\xFF";
1032
1033     # always use utf-8 (work with japanese character sets)
1034     $txt = encode("UTF-8", $txt);
1035
1036     return $txt if $txt !~ /[$NONPRINT]/o;
1037
1038     my $res = '';
1039
1040     while ($txt =~ s/^(.{1,42})//sm) {
1041         my $t = MIME::Words::encode_mimeword ($1, 'B', 'UTF-8');
1042         $res .= $res ? "\015\012\t$t" : $t;
1043     }
1044
1045     return $res;
1046 }
1047
1048 sub load_sa_descriptions {
1049     my ($additional_dirs) = @_;
1050
1051     my @dirs = ('/usr/share/spamassassin',
1052                 '/usr/share/spamassassin-extra');
1053
1054     push @dirs, @$additional_dirs if @$additional_dirs;
1055
1056     my $res = {};
1057
1058     my $parse_sa_file = sub {
1059         my ($file) = @_;
1060
1061         open(my $fh,'<', $file);
1062         return if !defined($fh);
1063
1064         while (defined(my $line = <$fh>)) {
1065             if ($line =~ m/^describe\s+(\S+)\s+(.*)\s*$/) {
1066                 my ($name, $desc) = ($1, $2);
1067                 next if $res->{$name};
1068                 $res->{$name}->{desc} = $desc;
1069                 if ($desc =~ m|[\(\s](http:\/\/\S+\.[^\s\.\)]+\.[^\s\.\)]+)|i) {
1070                     $res->{$name}->{url} = $1;
1071                 }
1072             }
1073         }
1074         close($fh);
1075     };
1076
1077     foreach my $dir (@dirs) {
1078         foreach my $file (<$dir/*.cf>) {
1079             $parse_sa_file->($file);
1080         }
1081     }
1082
1083     $res->{'ClamAVHeuristics'}->{desc} = "ClamAV heuristic tests";
1084
1085     return $res;
1086 }
1087
1088 sub format_uptime {
1089     my ($uptime) = @_;
1090
1091     my $days = int($uptime/86400);
1092     $uptime -= $days*86400;
1093
1094     my $hours = int($uptime/3600);
1095     $uptime -= $hours*3600;
1096
1097     my $mins = $uptime/60;
1098
1099     if ($days) {
1100         my $ds = $days > 1 ? 'days' : 'day';
1101         return sprintf "%d $ds %02d:%02d", $days, $hours, $mins;
1102     } else {
1103         return sprintf "%02d:%02d", $hours, $mins;
1104     }
1105 }
1106
1107 sub finalize_report {
1108     my ($tt, $template, $data, $mailfrom, $receiver, $debug) = @_;
1109
1110     my $html = '';
1111
1112     $tt->process($template, $data, \$html) ||
1113         die $tt->error() . "\n";
1114
1115     my $title;
1116     if ($html =~ m|^\s*<title>(.*)</title>|m) {
1117         $title = $1;
1118     } else {
1119         die "unable to extract template title\n";
1120     }
1121
1122     my $top = MIME::Entity->build(
1123         Type    => "multipart/related",
1124         To      => $data->{pmail},
1125         From    => $mailfrom,
1126         Subject => bencode_header(decode_entities($title)));
1127
1128     $top->attach(
1129         Data     => $html,
1130         Type     => "text/html",
1131         Encoding => $debug ? 'binary' : 'quoted-printable');
1132
1133     if ($debug) {
1134         $top->print();
1135         return;
1136     }
1137     # we use an empty envelope sender (we dont want to receive NDRs)
1138     PMG::Utils::reinject_mail ($top, '', [$receiver], undef, $data->{fqdn});
1139 }
1140
1141 sub lookup_timespan {
1142     my ($timespan) = @_;
1143
1144     my (undef, undef, undef, $mday, $mon, $year) = localtime(time());
1145     my $daystart = timelocal(0, 0, 0, $mday, $mon, $year);
1146
1147     my $start;
1148     my $end;
1149
1150     if ($timespan eq 'today') {
1151         $start = $daystart;
1152         $end = $start + 86400;
1153     } elsif ($timespan eq 'yesterday') {
1154         $end = $daystart;
1155         $start = $end - 86400;
1156     } elsif ($timespan eq 'week') {
1157         $end = $daystart;
1158         $start = $end - 7*86400;
1159     } else {
1160         die "internal error";
1161     }
1162
1163     return ($start, $end);
1164 }
1165
1166 my $rbl_scan_last_cursor;
1167 my $rbl_scan_start_time = time();
1168
1169 sub scan_journal_for_rbl_rejects {
1170
1171     # example postscreen log entry for RBL rejects
1172     # 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>
1173
1174     # example for PREGREET reject
1175     # Dec  7 06:57:11 proxmox postfix/postscreen[32084]: PREGREET 14 after 0.23 from [x.x.x.x]:63492: EHLO yyyyy\r\n
1176
1177     my $identifier = 'postfix/postscreen';
1178
1179     my $rbl_count = 0;
1180     my $pregreet_count = 0;
1181
1182     my $parser = sub {
1183         my $line = shift;
1184
1185         if ($line =~ m/^--\scursor:\s(\S+)$/) {
1186             $rbl_scan_last_cursor = $1;
1187             return;
1188         }
1189
1190         if ($line =~ m/\s$identifier\[\d+\]:\sNOQUEUE:\sreject:.*550 5.7.1 Service unavailable;/) {
1191             $rbl_count++;
1192         } elsif ($line =~ m/\s$identifier\[\d+\]:\sPREGREET\s\d+\safter\s/) {
1193             $pregreet_count++;
1194         }
1195     };
1196
1197     # limit to last 5000 lines to avoid long delays
1198     my $cmd = ['journalctl', '--show-cursor', '-o', 'short-unix', '--no-pager',
1199                '--identifier', $identifier, '-n', 5000];
1200
1201     if (defined($rbl_scan_last_cursor)) {
1202         push @$cmd, "--after-cursor=${rbl_scan_last_cursor}";
1203     } else {
1204         push @$cmd, "--since=@" . $rbl_scan_start_time;
1205     }
1206
1207     PVE::Tools::run_command($cmd, outfunc => $parser);
1208
1209     return ($rbl_count, $pregreet_count);
1210 }
1211
1212 my $hwaddress;
1213
1214 sub get_hwaddress {
1215
1216     return $hwaddress if defined ($hwaddress);
1217
1218     my $fn = '/etc/ssh/ssh_host_rsa_key.pub';
1219     my $sshkey = PVE::Tools::file_get_contents($fn);
1220     $hwaddress = uc(Digest::MD5::md5_hex($sshkey));
1221
1222     return $hwaddress;
1223 }
1224
1225 my $default_locale = "en_US.UTF-8 UTF-8";
1226
1227 sub cond_add_default_locale {
1228
1229     my $filename = "/etc/locale.gen";
1230
1231     open(my $infh, "<", $filename) || return;
1232
1233     while (defined(my $line = <$infh>)) {
1234         if ($line =~ m/^\Q${default_locale}\E/) {
1235             # already configured
1236             return;
1237         }
1238     }
1239
1240     seek($infh, 0, 0) // return; # seek failed
1241
1242     open(my $outfh, ">", "$filename.tmp") || return;
1243
1244     my $done;
1245     while (defined(my $line = <$infh>)) {
1246         if ($line =~ m/^#\s*\Q${default_locale}\E.*/) {
1247             print $outfh "${default_locale}\n" if !$done;
1248             $done = 1;
1249         } else {
1250             print $outfh $line;
1251         }
1252     }
1253
1254     print STDERR "generation pmg default locale\n";
1255
1256     rename("$filename.tmp", $filename) || return; # rename failed
1257
1258     system("dpkg-reconfigure locales -f noninteractive");
1259 }
1260
1261 1;