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