[pmg-api.git] / PMG / Utils.pm

package PMG::Utils;

use strict;
use warnings;
use DBI;
use Net::Cmd;
use Net::SMTP;
use IO::File;
use File::stat;
use POSIX qw(strftime);
use File::stat;
use File::Basename;
use MIME::Words;
use MIME::Parser;
use Time::HiRes qw (gettimeofday);
use Xdgmime;
use Data::Dumper;
use Digest::SHA;
use Net::IP;
use Socket;
use RRDs;
use Filesys::Df;

use PVE::ProcFSTools;
use PVE::Network;
use PVE::Tools;
use PVE::SafeSyslog;
use PVE::ProcFSTools;
use PMG::AtomicFile;
use PMG::MailQueue;
use PMG::SMTPPrinter;

my $realm_regex = qr/[A-Za-z][A-Za-z0-9\.\-_]+/;

PVE::JSONSchema::register_format('pmg-realm', \&verify_realm);
sub verify_realm {
    my ($realm, $noerr) = @_;

    if ($realm !~ m/^${realm_regex}$/) {
	return undef if $noerr;
	die "value does not look like a valid realm\n";
    }
    return $realm;
}

PVE::JSONSchema::register_standard_option('realm', {
    description => "Authentication domain ID",
    type => 'string', format => 'pmg-realm',
    maxLength => 32,
});

PVE::JSONSchema::register_format('pmg-userid', \&verify_username);
sub verify_username {
    my ($username, $noerr) = @_;

    $username = '' if !$username;
    my $len = length($username);
    if ($len < 3) {
	die "user name '$username' is too short\n" if !$noerr;
	return undef;
    }
    if ($len > 64) {
	die "user name '$username' is too long ($len > 64)\n" if !$noerr;
	return undef;
    }

    # we only allow a limited set of characters
    # colon is not allowed, because we store usernames in
    # colon separated lists)!
    # slash is not allowed because it is used as pve API delimiter
    # also see "man useradd"
    if ($username =~ m!^([^\s:/]+)\@(${realm_regex})$!) {
	return wantarray ? ($username, $1, $2) : $username;
    }

    die "value '$username' does not look like a valid user name\n" if !$noerr;

    return undef;
}

PVE::JSONSchema::register_standard_option('userid', {
    description => "User ID",
    type => 'string', format => 'pmg-userid',
    minLength => 4,
    maxLength => 64,
});

PVE::JSONSchema::register_standard_option('username', {
    description => "Username (without realm)",
    type => 'string',
    pattern => '[^\s:\/\@]{3,60}',
    minLength => 4,
    maxLength => 64,
});

sub msgquote {
    my $msg = shift || '';
    $msg =~ s/%/%%/g;
    return $msg;
}

sub lastid {
    my ($dbh, $seq) = @_;

    return $dbh->last_insert_id(
	undef, undef, undef, undef, { sequence => $seq});
}

sub encrypt_pw {
    my ($pw) = @_;

    my $time = substr(Digest::SHA::sha1_base64(time), 0, 8);
    return crypt(encode("utf8", $pw), "\$5\$$time\$");
}

sub file_older_than {
    my ($filename, $lasttime) = @_;

    my $st = stat($filename);

    return 0 if !defined($st);

    return ($lasttime >= $st->ctime);
}

sub extract_filename {
    my ($head) = @_;

    if (my $value = $head->recommended_filename()) {
	chomp $value;
	if (my $decvalue = MIME::Words::decode_mimewords($value)) {
	    $decvalue =~ s/\0/ /g;
	    $decvalue = PVE::Tools::trim($decvalue);
	    return $decvalue;
	}
    }

    return undef;
}

sub remove_marks {
    my ($entity, $add_id, $id) = @_;

    $id //= 1;

    foreach my $tag (grep {/^x-proxmox-tmp/i} $entity->head->tags) {
	$entity->head->delete ($tag);
    }

    $entity->head->replace('X-Proxmox-tmp-AID', $id) if $add_id;

    foreach my $part ($entity->parts)  {
	$id = remove_marks($part, $add_id, $id + 1);
    }

    return $id;
}

sub subst_values {
    my ($body, $dh) = @_;

    return if !$body;

    foreach my $k (keys %$dh) {
	my $v = $dh->{$k};
	if (defined($v)) {
	    $body =~ s/__\Q${k}\E__/$v/gs;
	}
    }

    return $body;
}

sub reinject_mail {
    my ($entity, $sender, $targets, $xforward, $me, $nodsn) = @_;

    my $smtp;
    my $resid;
    my $rescode;
    my $resmess;

    eval {
	my $smtp = Net::SMTP->new('127.0.0.1', Port => 10025, Hello => $me) ||
	    die "unable to connect to localhost at port 10025";

	if (defined($xforward)) {
	    my $xfwd;

	    foreach my $attr (keys %{$xforward}) {
		$xfwd .= " $attr=$xforward->{$attr}";
	    }

	    if ($xfwd && $smtp->command("XFORWARD", $xfwd)->response() != CMD_OK) {
		syslog('err', "xforward error - got: %s %s", $smtp->code, scalar($smtp->message));
	    }
	}

	if (!$smtp->mail($sender)) {
	    syslog('err', "smtp error - got: %s %s", $smtp->code, scalar ($smtp->message));
	    die "smtp from: ERROR";
	}

	my $dsnopts = $nodsn ? {Notify => ['NEVER']} : {};

	if (!$smtp->to (@$targets, $dsnopts)) {
	    syslog ('err', "smtp error - got: %s %s", $smtp->code, scalar($smtp->message));
	    die "smtp to: ERROR";
	}

	# Output the head:
	#$entity->sync_headers ();
	$smtp->data();

	my $out = PMG::SMTPPrinter->new($smtp);
	$entity->print($out);

	# make sure we always have a newline at the end of the mail
	# else dataend() fails
	$smtp->datasend("\n");

	if ($smtp->dataend()) {
	    my @msgs = $smtp->message;
	    $resmess = $msgs[$#msgs];
	    ($resid) = $resmess =~ m/Ok: queued as ([0-9A-Z]+)/;
	    $rescode = $smtp->code;
	    if (!$resid) {
		die sprintf("unexpected SMTP result - got: %s %s : WARNING", $smtp->code, $resmess);
	    }
	} else {
	    my @msgs = $smtp->message;
	    $resmess = $msgs[$#msgs];
	    $rescode = $smtp->code;
	    die sprintf("sending data failed - got: %s %s : ERROR", $smtp->code, $resmess);
	}
    };
    my $err = $@;

    $smtp->quit if $smtp;

    if ($err) {
	syslog ('err', $err);
    }

    return wantarray ? ($resid, $rescode, $resmess) : $resid;
}

sub analyze_virus_clam {
    my ($queue, $dname, $pmg_cfg) = @_;

    my $timeout = 60*5;
    my $vinfo;

    my $clamdscan_opts = "--stdout";

    my ($csec, $usec) = gettimeofday();

    my $previous_alarm;

    eval {

	$previous_alarm = alarm($timeout);

	$SIG{ALRM} = sub {
	    die "$queue->{logid}: Maximum time ($timeout sec) exceeded. " .
		"virus analyze (clamav) failed: ERROR";
	};

	open(CMD, "/usr/bin/clamdscan $clamdscan_opts '$dname'|") ||
	    die "$queue->{logid}: can't exec clamdscan: $! : ERROR";

	my $ifiles;

	my $response = '';
	while (defined(my $line = <CMD>)) {
	    if ($line =~ m/^$dname.*:\s+([^ :]*)\s+FOUND$/) {
		# we just use the first detected virus name
		$vinfo = $1 if !$vinfo;
	    } elsif ($line =~ m/^Infected files:\s(\d*)$/i) {
		$ifiles = $1;
	    }

	    $response .= $line;
	}

	close(CMD);

	alarm(0); # avoid race conditions

	if (!defined($ifiles)) {
	    die "$queue->{logid}: got undefined output from " .
		"virus detector: $response : ERROR";
	}

	if ($vinfo) {
	    syslog('info', "$queue->{logid}: virus detected: $vinfo (clamav)");
	}
    };
    my $err = $@;

    alarm($previous_alarm);

    my ($csec_end, $usec_end) = gettimeofday();
    $queue->{ptime_clam} =
	int (($csec_end-$csec)*1000 + ($usec_end - $usec)/1000);

    if ($err) {
	syslog ('err', $err);
	$vinfo = undef;
	$queue->{errors} = 1;
    }

    $queue->{vinfo_clam} = $vinfo;

    return $vinfo ? "$vinfo (clamav)" : undef;
}

sub analyze_virus {
    my ($queue, $filename, $pmg_cfg, $testmode) = @_;

    # TODO: support other virus scanners?

    # always scan with clamav
    return analyze_virus_clam($queue, $filename, $pmg_cfg);
}

sub magic_mime_type_for_file {
    my ($filename) = @_;

    # we do not use get_mime_type_for_file, because that considers
    # filename extensions - we only want magic type detection

    my $bufsize = Xdgmime::xdg_mime_get_max_buffer_extents();
    die "got strange value for max_buffer_extents" if $bufsize > 4096*10;

    my $ct = "application/octet-stream";

    my $fh = IO::File->new("<$filename") ||
	die "unable to open file '$filename' - $!";

    my ($buf, $len);
    if (($len = $fh->read($buf, $bufsize)) > 0) {
	$ct = xdg_mime_get_mime_type_for_data($buf, $len);
    }
    $fh->close();

    die "unable to read file '$filename' - $!" if ($len < 0);

    return $ct;
}

sub add_ct_marks {
    my ($entity) = @_;

    if (my $path = $entity->{PMX_decoded_path}) {

	# set a reasonable default if magic does not give a result
	$entity->{PMX_magic_ct} = $entity->head->mime_attr('content-type');

	if (my $ct = magic_mime_type_for_file($path)) {
	    if ($ct ne 'application/octet-stream' || !$entity->{PMX_magic_ct}) {
		$entity->{PMX_magic_ct} = $ct;
	    }
	}

	my $filename = $entity->head->recommended_filename;
	$filename = basename($path) if !defined($filename) || $filename eq '';

	if (my $ct = xdg_mime_get_mime_type_from_file_name($filename)) {
	    $entity->{PMX_glob_ct} = $ct;
	}
    }

    foreach my $part ($entity->parts)  {
	add_ct_marks ($part);
    }
}

# x509 certificate utils

# only write output if something fails
sub run_silent_cmd {
    my ($cmd) = @_;

    my $outbuf = '';

    my $record_output = sub {
	$outbuf .= shift;
	$outbuf .= "\n";
    };

    eval {
	PVE::Tools::run_command($cmd, outfunc => $record_output,
				errfunc => $record_output);
    };
    my $err = $@;

    if ($err) {
	print STDERR $outbuf;
	die $err;
    }
}

my $proxmox_tls_cert_fn = "/etc/pmg/pmg-tls.pem";

sub gen_proxmox_tls_cert {
    my ($force) = @_;

    my $resolv = PVE::INotify::read_file('resolvconf');
    my $domain = $resolv->{search};

    my $company = $domain; # what else ?
    my $cn = "*.$domain";

   return if !$force && -f $proxmox_tls_cert_fn;

    my $sslconf = <<__EOD__;
RANDFILE = /root/.rnd
extensions = v3_req

[ req ]
default_bits = 4096
distinguished_name = req_distinguished_name
req_extensions = v3_req
prompt = no
string_mask = nombstr

[ req_distinguished_name ]
organizationalUnitName = Proxmox Mail Gateway
organizationName = $company
commonName = $cn

[ v3_req ]
basicConstraints = CA:FALSE
nsCertType = server
keyUsage = nonRepudiation, digitalSignature, keyEncipherment
__EOD__

    my $cfgfn = "/tmp/pmgtlsconf-$$.tmp";
    my $fh = IO::File->new ($cfgfn, "w");
    print $fh $sslconf;
    close ($fh);

    eval {
	my $cmd = ['openssl', 'req', '-batch', '-x509', '-new', '-sha256',
		   '-config', $cfgfn, '-days', 3650, '-nodes',
		   '-out', $proxmox_tls_cert_fn,
		   '-keyout', $proxmox_tls_cert_fn];
	run_silent_cmd($cmd);
    };

    if (my $err = $@) {
	unlink $proxmox_tls_cert_fn;
	unlink $cfgfn;
	die "unable to generate proxmox certificate request:\n$err";
    }

    unlink $cfgfn;
}

sub find_local_network_for_ip {
    my ($ip) = @_;

    my $testip = Net::IP->new($ip);

    my $isv6 = $testip->version == 6;
    my $routes = $isv6 ?
	PVE::ProcFSTools::read_proc_net_ipv6_route() :
	PVE::ProcFSTools::read_proc_net_route();

    foreach my $entry (@$routes) {
	my $mask;
	if ($isv6) {
	    $mask = $entry->{prefix};
	    next if !$mask; # skip the default route...
	} else {
	    $mask = $PVE::Network::ipv4_mask_hash_localnet->{$entry->{mask}};
	    next if !defined($mask);
	}
	my $cidr = "$entry->{dest}/$mask";
	my $testnet = Net::IP->new($cidr);
	my $overlap = $testnet->overlaps($testip);
	if ($overlap == $Net::IP::IP_B_IN_A_OVERLAP ||
	    $overlap == $Net::IP::IP_IDENTICAL)
	{
	    return $cidr;
	}
    }

    die "unable to detect local network for ip '$ip'\n";
}

sub service_cmd {
    my ($service, $cmd) = @_;

    die "unknown service command '$cmd'\n"
	if $cmd !~ m/^(start|stop|restart|reload)$/;

    if ($service eq 'pmgdaemon' || $service eq 'pmgproxy') {
	if ($cmd eq 'restart') {
	    # OK
	} else {
	    die "invalid service cmd '$service $cmd': ERROR";
	}
    }

    $service = 'postfix@-' if $service eq 'postfix';
    PVE::Tools::run_command(['systemctl', $cmd, $service]);
};

# this is also used to get the IP of the local node
sub lookup_node_ip {
    my ($nodename, $noerr) = @_;

    my ($family, $packed_ip);

    eval {
	my @res = PVE::Tools::getaddrinfo_all($nodename);
	$family = $res[0]->{family};
	$packed_ip = (PVE::Tools::unpack_sockaddr_in46($res[0]->{addr}))[2];
    };

    if ($@) {
	die "hostname lookup failed:\n$@" if !$noerr;
	return undef;
    }

    my $ip = Socket::inet_ntop($family, $packed_ip);
    if ($ip =~ m/^127\.|^::1$/) {
	die "hostname lookup failed - got local IP address ($nodename = $ip)\n" if !$noerr;
	return undef;
    }

    return wantarray ? ($ip, $family) : $ip;
}

sub run_postmap {
    my ($filename) = @_;

    # make sure the file exists (else postmap fails)
    IO::File->new($filename, 'a', 0644);

    eval {
	PVE::Tools::run_command(
	    ['/usr/sbin/postmap', $filename],
	    errmsg => "unable to update postfix table $filename");
    };
    my $err = $@;

    warn $err if $err;
}

sub clamav_dbstat {

    my $res = [];

    my $read_cvd_info = sub {
	my ($dbname, $dbfile) = @_;

        my $header;
	my $fh = IO::File->new("<$dbfile");
	if (!$fh) {
	    warn "cant open ClamAV Database $dbname ($dbfile) - $!\n";
	    return;
	}
	$fh->read($header, 512);
	$fh->close();

	## ClamAV-VDB:16 Mar 2016 23-17 +0000:57:4218790:60:06386f34a16ebeea2733ab037f0536be:
	if ($header =~ m/^(ClamAV-VDB):([^:]+):(\d+):(\d+):/) {
	    my ($ftype, $btime, $version, $nsigs) = ($1, $2, $3, $4);
	    push @$res, {
		name => $dbname,
		type => $ftype,
		build_time => $btime,
		version => $version,
		nsigs => $nsigs,
	    };
	} else {
	    warn "unable to parse ClamAV Database $dbname ($dbfile)\n";
	}
    };

    # main database
    my $filename = "/var/lib/clamav/main.inc/main.info";
    $filename = "/var/lib/clamav/main.cvd" if ! -f $filename;

    $read_cvd_info->('main', $filename) if -f $filename;

    # daily database
    $filename = "/var/lib/clamav/daily.inc/daily.info";
    $filename = "/var/lib/clamav/daily.cvd" if ! -f $filename;
    $filename = "/var/lib/clamav/daily.cld" if ! -f $filename;

    $read_cvd_info->('daily', $filename) if -f $filename;

    $filename = "/var/lib/clamav/bytecode.cvd";
    $read_cvd_info->('bytecode', $filename) if -f $filename;

    $filename = "/var/lib/clamav/safebrowsing.cvd";
    $read_cvd_info->('safebrowsing', $filename) if -f $filename;

    my $ss_dbs_fn = "/var/lib/clamav-unofficial-sigs/configs/ss-include-dbs.txt";
    my $ss_dbs_files = {};
    if (my $ssfh = IO::File->new("<${ss_dbs_fn}")) {
	while (defined(my $line = <$ssfh>)) {
	    chomp $line;
	    $ss_dbs_files->{$line} = 1;
	}
    }
    my $last = 0;
    my $nsigs = 0;
    foreach $filename (</var/lib/clamav/*>) {
	my $fn = basename($filename);
	next if !$ss_dbs_files->{$fn};

	my $fh = IO::File->new("<$filename");
	next if !defined($fh);
	my $st = stat($fh);
	next if !$st;
	my $mtime = $st->mtime();
	$last = $mtime if $mtime > $last;
	while (defined(my $line = <$fh>)) { $nsigs++; }
    }

    if ($nsigs > 0) {
	push @$res, {
	    name => 'sanesecurity',
	    type => 'unofficial',
	    build_time => strftime("%d %b %Y %H-%M %z", localtime($last)),
	    nsigs => $nsigs,
	};
    }

    return $res;
}

# RRD related code
my $rrd_dir = "/var/lib/rrdcached/db";
my $rrdcached_socket = "/var/run/rrdcached.sock";

my $rrd_def_node = [
    "DS:loadavg:GAUGE:120:0:U",
    "DS:maxcpu:GAUGE:120:0:U",
    "DS:cpu:GAUGE:120:0:U",
    "DS:iowait:GAUGE:120:0:U",
    "DS:memtotal:GAUGE:120:0:U",
    "DS:memused:GAUGE:120:0:U",
    "DS:swaptotal:GAUGE:120:0:U",
    "DS:swapused:GAUGE:120:0:U",
    "DS:roottotal:GAUGE:120:0:U",
    "DS:rootused:GAUGE:120:0:U",
    "DS:netin:DERIVE:120:0:U",
    "DS:netout:DERIVE:120:0:U",

    "RRA:AVERAGE:0.5:1:70", # 1 min avg - one hour
    "RRA:AVERAGE:0.5:30:70", # 30 min avg - one day
    "RRA:AVERAGE:0.5:180:70", # 3 hour avg - one week
    "RRA:AVERAGE:0.5:720:70", # 12 hour avg - one month
    "RRA:AVERAGE:0.5:10080:70", # 7 day avg - ony year

    "RRA:MAX:0.5:1:70", # 1 min max - one hour
    "RRA:MAX:0.5:30:70", # 30 min max - one day
    "RRA:MAX:0.5:180:70", # 3 hour max - one week
    "RRA:MAX:0.5:720:70", # 12 hour max - one month
    "RRA:MAX:0.5:10080:70", # 7 day max - ony year
];

sub cond_create_rrd_file {
    my ($filename, $rrddef) = @_;

    return if -f $filename;

    my @args = ($filename);

    push @args, "--daemon" => "unix:${rrdcached_socket}"
	if -S $rrdcached_socket;

    push @args, '--step', 60;

    push @args, @$rrddef;

    # print "TEST: " . join(' ', @args) . "\n";

    RRDs::create(@args);
    my $err = RRDs::error;
    die "RRD error: $err\n" if $err;
}

sub update_node_status_rrd {

    my $filename = "$rrd_dir/pmg-node-v1.rrd";
    cond_create_rrd_file($filename, $rrd_def_node);

    my ($avg1, $avg5, $avg15) = PVE::ProcFSTools::read_loadavg();

    my $stat = PVE::ProcFSTools::read_proc_stat();

    my $netdev = PVE::ProcFSTools::read_proc_net_dev();

    my ($uptime) = PVE::ProcFSTools::read_proc_uptime();

    my $cpuinfo = PVE::ProcFSTools::read_cpuinfo();

    my $maxcpu = $cpuinfo->{cpus};

    # traffic from/to physical interface cards
    my $netin = 0;
    my $netout = 0;
    foreach my $dev (keys %$netdev) {
	next if $dev !~ m/^eth\d+$/;
	$netin += $netdev->{$dev}->{receive};
	$netout += $netdev->{$dev}->{transmit};
    }

    my $meminfo = PVE::ProcFSTools::read_meminfo();

    my $dinfo = df('/', 1); # output is bytes

    my $ctime = time();

    # everything not free is considered to be used
    my $dused = $dinfo->{blocks} - $dinfo->{bfree};

    my $data = "$ctime:$avg1:$maxcpu:$stat->{cpu}:$stat->{wait}:" .
	"$meminfo->{memtotal}:$meminfo->{memused}:" .
	"$meminfo->{swaptotal}:$meminfo->{swapused}:" .
	"$dinfo->{blocks}:$dused:$netin:$netout";


    my @args = ($filename);

    push @args, "--daemon" => "unix:${rrdcached_socket}"
	if -S $rrdcached_socket;

    push @args, $data;

    # print "TEST: " . join(' ', @args) . "\n";

    RRDs::update(@args);
    my $err = RRDs::error;
    die "RRD error: $err\n" if $err;
}

sub create_rrd_data {
    my ($rrdname, $timeframe, $cf) = @_;

    my $rrd = "${rrd_dir}/$rrdname";

    my $setup = {
	hour =>  [ 60, 70 ],
	day  =>  [ 60*30, 70 ],
	week =>  [ 60*180, 70 ],
	month => [ 60*720, 70 ],
	year =>  [ 60*10080, 70 ],
    };

    my ($reso, $count) = @{$setup->{$timeframe}};
    my $ctime  = $reso*int(time()/$reso);
    my $req_start = $ctime - $reso*$count;

    $cf = "AVERAGE" if !$cf;

    my @args = (
	"-s" => $req_start,
	"-e" => $ctime - 1,
	"-r" => $reso,
	);

    push @args, "--daemon" => "unix:${rrdcached_socket}"
	if -S $rrdcached_socket;

    my ($start, $step, $names, $data) = RRDs::fetch($rrd, $cf, @args);

    my $err = RRDs::error;
    die "RRD error: $err\n" if $err;

    die "got wrong time resolution ($step != $reso)\n"
	if $step != $reso;

    my $res = [];
    my $fields = scalar(@$names);
    for my $line (@$data) {
	my $entry = { 'time' => $start };
	$start += $step;
	for (my $i = 0; $i < $fields; $i++) {
	    my $name = $names->[$i];
	    if (defined(my $val = $line->[$i])) {
		$entry->{$name} = $val;
	    } else {
		# leave empty fields undefined
		# maybe make this configurable?
	    }
	}
	push @$res, $entry;
    }

    return $res;
}

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