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