PMG/Utils.pm

   1 package PMG::Utils;
   2
   3 use strict;
   4 use warnings;
   5 use Carp;
   6 use DBI;
   7 use Net::Cmd;
   8 use Net::SMTP;
   9 use IO::File;
  10 use File::stat;
  11 use File::Basename;
  12 use MIME::Words;
  13 use MIME::Parser;
  14 use Time::HiRes qw (gettimeofday);
  15 use Xdgmime;
  16 use Data::Dumper;
  17 use Net::IP;
  18 use Socket;
  19
  20 use PVE::Network;
  21 use PVE::Tools;
  22 use PVE::SafeSyslog;
  23 use PVE::ProcFSTools;
  24 use PMG::AtomicFile;
  25 use PMG::MailQueue;
  26 use PMG::SMTPPrinter;
  27
  28 sub msgquote {
  29     my $msg = shift || '';
  30     $msg =~ s/%/%%/g;
  31     return $msg;
  32 }
  33
  34 sub lastid {
  35     my ($dbh, $seq) = @_;
  36
  37     return $dbh->last_insert_id(
  38         undef, undef, undef, undef, { sequence => $seq});
  39 }
  40
  41 sub file_older_than {
  42     my ($filename, $lasttime) = @_;
  43
  44     my $st = stat($filename);
  45
  46     return 0 if !defined($st);
  47
  48     return ($lasttime >= $st->ctime);
  49 }
  50
  51 sub extract_filename {
  52     my ($head) = @_;
  53
  54     if (my $value = $head->recommended_filename()) {
  55         chomp $value;
  56         if (my $decvalue = MIME::Words::decode_mimewords($value)) {
  57             $decvalue =~ s/\0/ /g;
  58             $decvalue = PVE::Tools::trim($decvalue);
  59             return $decvalue;
  60         }
  61     }
  62
  63     return undef;
  64 }
  65
  66 sub remove_marks {
  67     my ($entity, $add_id, $id) = @_;
  68
  69     $id //= 1;
  70
  71     foreach my $tag (grep {/^x-proxmox-tmp/i} $entity->head->tags) {
  72         $entity->head->delete ($tag);
  73     }
  74
  75     $entity->head->replace('X-Proxmox-tmp-AID', $id) if $add_id;
  76
  77     foreach my $part ($entity->parts)  {
  78         $id = remove_marks($part, $add_id, $id + 1);
  79     }
  80
  81     return $id;
  82 }
  83
  84 sub subst_values {
  85     my ($body, $dh) = @_;
  86
  87     return if !$body;
  88
  89     foreach my $k (keys %$dh) {
  90         my $v = $dh->{$k};
  91         if (defined($v)) {
  92             $body =~ s/__\Q${k}\E__/$v/gs;
  93         }
  94     }
  95
  96     return $body;
  97 }
  98
  99 sub reinject_mail {
 100     my ($entity, $sender, $targets, $xforward, $me, $nodsn) = @_;
 101
 102     my $smtp;
 103     my $resid;
 104     my $rescode;
 105     my $resmess;
 106
 107     eval {
 108         my $smtp = Net::SMTP->new('127.0.0.1', Port => 10025, Hello => $me) ||
 109             die "unable to connect to localhost at port 10025";
 110
 111         if (defined($xforward)) {
 112             my $xfwd;
 113
 114             foreach my $attr (keys %{$xforward}) {
 115                 $xfwd .= " $attr=$xforward->{$attr}";
 116             }
 117
 118             if ($xfwd && $smtp->command("XFORWARD", $xfwd)->response() != CMD_OK) {
 119                 syslog('err', "xforward error - got: %s %s", $smtp->code, scalar($smtp->message));
 120             }
 121         }
 122
 123         if (!$smtp->mail($sender)) {
 124             syslog('err', "smtp error - got: %s %s", $smtp->code, scalar ($smtp->message));
 125             die "smtp from: ERROR";
 126         }
 127
 128         my $dsnopts = $nodsn ? {Notify => ['NEVER']} : {};
 129
 130         if (!$smtp->to (@$targets, $dsnopts)) {
 131             syslog ('err', "smtp error - got: %s %s", $smtp->code, scalar($smtp->message));
 132             die "smtp to: ERROR";
 133         }
 134
 135         # Output the head:
 136         #$entity->sync_headers ();
 137         $smtp->data();
 138
 139         my $out = PMG::SMTPPrinter->new($smtp);
 140         $entity->print($out);
 141
 142         # make sure we always have a newline at the end of the mail
 143         # else dataend() fails
 144         $smtp->datasend("\n");
 145
 146         if ($smtp->dataend()) {
 147             my @msgs = $smtp->message;
 148             $resmess = $msgs[$#msgs];
 149             ($resid) = $resmess =~ m/Ok: queued as ([0-9A-Z]+)/;
 150             $rescode = $smtp->code;
 151             if (!$resid) {
 152                 die sprintf("unexpected SMTP result - got: %s %s : WARNING", $smtp->code, $resmess);
 153             }
 154         } else {
 155             my @msgs = $smtp->message;
 156             $resmess = $msgs[$#msgs];
 157             $rescode = $smtp->code;
 158             die sprintf("sending data failed - got: %s %s : ERROR", $smtp->code, $resmess);
 159         }
 160     };
 161     my $err = $@;
 162
 163     $smtp->quit if $smtp;
 164
 165     if ($err) {
 166         syslog ('err', $err);
 167     }
 168
 169     return wantarray ? ($resid, $rescode, $resmess) : $resid;
 170 }
 171
 172 sub analyze_virus_clam {
 173     my ($queue, $dname, $pmg_cfg) = @_;
 174
 175     my $timeout = 60*5;
 176     my $vinfo;
 177
 178     my $clamdscan_opts = "--stdout";
 179
 180     my ($csec, $usec) = gettimeofday();
 181
 182     my $previous_alarm;
 183
 184     eval {
 185
 186         $previous_alarm = alarm($timeout);
 187
 188         $SIG{ALRM} = sub {
 189             die "$queue->{logid}: Maximum time ($timeout sec) exceeded. " .
 190                 "virus analyze (clamav) failed: ERROR";
 191         };
 192
 193         open(CMD, "/usr/bin/clamdscan $clamdscan_opts '$dname'|") ||
 194             die "$queue->{logid}: can't exec clamdscan: $! : ERROR";
 195
 196         my $ifiles;
 197
 198         my $response = '';
 199         while (defined(my $line = <CMD>)) {
 200             if ($line =~ m/^$dname.*:\s+([^ :]*)\s+FOUND$/) {
 201                 # we just use the first detected virus name
 202                 $vinfo = $1 if !$vinfo;
 203             } elsif ($line =~ m/^Infected files:\s(\d*)$/i) {
 204                 $ifiles = $1;
 205             }
 206
 207             $response .= $line;
 208         }
 209
 210         close(CMD);
 211
 212         alarm(0); # avoid race conditions
 213
 214         if (!defined($ifiles)) {
 215             die "$queue->{logid}: got undefined output from " .
 216                 "virus detector: $response : ERROR";
 217         }
 218
 219         if ($vinfo) {
 220             syslog('info', "$queue->{logid}: virus detected: $vinfo (clamav)");
 221         }
 222     };
 223     my $err = $@;
 224
 225     alarm($previous_alarm);
 226
 227     my ($csec_end, $usec_end) = gettimeofday();
 228     $queue->{ptime_clam} =
 229         int (($csec_end-$csec)*1000 + ($usec_end - $usec)/1000);
 230
 231     if ($err) {
 232         syslog ('err', $err);
 233         $vinfo = undef;
 234         $queue->{errors} = 1;
 235     }
 236
 237     $queue->{vinfo_clam} = $vinfo;
 238
 239     return $vinfo ? "$vinfo (clamav)" : undef;
 240 }
 241
 242 sub analyze_virus {
 243     my ($queue, $filename, $pmg_cfg, $testmode) = @_;
 244
 245     # TODO: support other virus scanners?
 246
 247     # always scan with clamav
 248     return analyze_virus_clam($queue, $filename, $pmg_cfg);
 249 }
 250
 251 sub magic_mime_type_for_file {
 252     my ($filename) = @_;
 253
 254     # we do not use get_mime_type_for_file, because that considers
 255     # filename extensions - we only want magic type detection
 256
 257     my $bufsize = Xdgmime::xdg_mime_get_max_buffer_extents();
 258     die "got strange value for max_buffer_extents" if $bufsize > 4096*10;
 259
 260     my $ct = "application/octet-stream";
 261
 262     my $fh = IO::File->new("<$filename") ||
 263         die "unable to open file '$filename' - $!";
 264
 265     my ($buf, $len);
 266     if (($len = $fh->read($buf, $bufsize)) > 0) {
 267         $ct = xdg_mime_get_mime_type_for_data($buf, $len);
 268     }
 269     $fh->close();
 270
 271     die "unable to read file '$filename' - $!" if ($len < 0);
 272
 273     return $ct;
 274 }
 275
 276 sub add_ct_marks {
 277     my ($entity) = @_;
 278
 279     if (my $path = $entity->{PMX_decoded_path}) {
 280
 281         # set a reasonable default if magic does not give a result
 282         $entity->{PMX_magic_ct} = $entity->head->mime_attr('content-type');
 283
 284         if (my $ct = magic_mime_type_for_file($path)) {
 285             if ($ct ne 'application/octet-stream' || !$entity->{PMX_magic_ct}) {
 286                 $entity->{PMX_magic_ct} = $ct;
 287             }
 288         }
 289
 290         my $filename = $entity->head->recommended_filename;
 291         $filename = basename($path) if !defined($filename) || $filename eq '';
 292
 293         if (my $ct = xdg_mime_get_mime_type_from_file_name($filename)) {
 294             $entity->{PMX_glob_ct} = $ct;
 295         }
 296     }
 297
 298     foreach my $part ($entity->parts)  {
 299         add_ct_marks ($part);
 300     }
 301 }
 302
 303 # x509 certificate utils
 304
 305 # only write output if something fails
 306 sub run_silent_cmd {
 307     my ($cmd) = @_;
 308
 309     my $outbuf = '';
 310
 311     my $record_output = sub {
 312         $outbuf .= shift;
 313         $outbuf .= "\n";
 314     };
 315
 316     eval {
 317         PVE::Tools::run_command($cmd, outfunc => $record_output,
 318                                 errfunc => $record_output);
 319     };
 320     my $err = $@;
 321
 322     if ($err) {
 323         print STDERR $outbuf;
 324         die $err;
 325     }
 326 }
 327
 328 my $proxmox_tls_cert_fn = "/etc/pmg/pmg-tls.pem";
 329
 330 sub gen_proxmox_tls_cert {
 331     my ($force) = @_;
 332
 333     my $resolv = PVE::INotify::read_file('resolvconf');
 334     my $domain = $resolv->{search};
 335
 336     my $company = $domain; # what else ?
 337     my $cn = "*.$domain";
 338
 339    return if !$force && -f $proxmox_tls_cert_fn;
 340
 341     my $sslconf = <<__EOD__;
 342 RANDFILE = /root/.rnd
 343 extensions = v3_req
 344
 345 [ req ]
 346 default_bits = 4096
 347 distinguished_name = req_distinguished_name
 348 req_extensions = v3_req
 349 prompt = no
 350 string_mask = nombstr
 351
 352 [ req_distinguished_name ]
 353 organizationalUnitName = Proxmox Mail Gateway
 354 organizationName = $company
 355 commonName = $cn
 356
 357 [ v3_req ]
 358 basicConstraints = CA:FALSE
 359 nsCertType = server
 360 keyUsage = nonRepudiation, digitalSignature, keyEncipherment
 361 __EOD__
 362
 363     my $cfgfn = "/tmp/pmgtlsconf-$$.tmp";
 364     my $fh = IO::File->new ($cfgfn, "w");
 365     print $fh $sslconf;
 366     close ($fh);
 367
 368     eval {
 369         my $cmd = ['openssl', 'req', '-batch', '-x509', '-new', '-sha256',
 370                    '-config', $cfgfn, '-days', 3650, '-nodes',
 371                    '-out', $proxmox_tls_cert_fn,
 372                    '-keyout', $proxmox_tls_cert_fn];
 373         run_silent_cmd($cmd);
 374     };
 375
 376     if (my $err = $@) {
 377         unlink $proxmox_tls_cert_fn;
 378         unlink $cfgfn;
 379         die "unable to generate proxmox certificate request:\n$err";
 380     }
 381
 382     unlink $cfgfn;
 383 }
 384
 385 sub find_local_network_for_ip {
 386     my ($ip) = @_;
 387
 388     my $testip = Net::IP->new($ip);
 389
 390     my $isv6 = $testip->version == 6;
 391     my $routes = $isv6 ?
 392         PVE::ProcFSTools::read_proc_net_ipv6_route() :
 393         PVE::ProcFSTools::read_proc_net_route();
 394
 395     foreach my $entry (@$routes) {
 396         my $mask;
 397         if ($isv6) {
 398             $mask = $entry->{prefix};
 399             next if !$mask; # skip the default route...
 400         } else {
 401             $mask = $PVE::Network::ipv4_mask_hash_localnet->{$entry->{mask}};
 402             next if !defined($mask);
 403         }
 404         my $cidr = "$entry->{dest}/$mask";
 405         my $testnet = Net::IP->new($cidr);
 406         my $overlap = $testnet->overlaps($testip);
 407         if ($overlap == $Net::IP::IP_B_IN_A_OVERLAP ||
 408             $overlap == $Net::IP::IP_IDENTICAL)
 409         {
 410             return $cidr;
 411         }
 412     }
 413
 414     die "unable to detect local network for ip '$ip'\n";
 415 }
 416
 417 sub service_cmd {
 418     my ($service, $cmd) = @_;
 419
 420     die "unknown service command '$cmd'\n"
 421         if $cmd !~ m/^(start|stop|restart|reload)$/;
 422
 423     if ($service eq 'pmgdaemon' || $service eq 'pmgproxy') {
 424         if ($cmd eq 'restart') {
 425             # OK
 426         } else {
 427             die "invalid service cmd '$service $cmd': ERROR";
 428         }
 429     }
 430
 431     $service = 'postfix@-' if $service eq 'postfix';
 432     PVE::Tools::run_command(['systemctl', $cmd, $service]);
 433 };
 434
 435 # this is also used to get the IP of the local node
 436 sub lookup_node_ip {
 437     my ($nodename, $noerr) = @_;
 438
 439     my ($family, $packed_ip);
 440
 441     eval {
 442         my @res = PVE::Tools::getaddrinfo_all($nodename);
 443         $family = $res[0]->{family};
 444         $packed_ip = (PVE::Tools::unpack_sockaddr_in46($res[0]->{addr}))[2];
 445     };
 446
 447     if ($@) {
 448         die "hostname lookup failed:\n$@" if !$noerr;
 449         return undef;
 450     }
 451
 452     my $ip = Socket::inet_ntop($family, $packed_ip);
 453     if ($ip =~ m/^127\.|^::1$/) {
 454         die "hostname lookup failed - got local IP address ($nodename = $ip)\n" if !$noerr;
 455         return undef;
 456     }
 457
 458     return wantarray ? ($ip, $family) : $ip;
 459 }
 460
 461 1;