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