[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 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;

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