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