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