X-Git-Url: https://git.proxmox.com/?a=blobdiff_plain;f=src%2FPVE%2FTools.pm;h=c90810ca764449a1365286db1a8f9ac6e79279f2;hb=9fffe4bc89609736408d5daf3a0386cc6f30b79a;hp=d9c69e3d803683460ac7b7c95981e3d9d1e8e306;hpb=cb9db10c1a9855cf40ff13e81f9dd97d6a9b2698;p=pve-common.git

diff --git a/src/PVE/Tools.pm b/src/PVE/Tools.pm
index d9c69e3..c90810c 100644
--- a/src/PVE/Tools.pm
+++ b/src/PVE/Tools.pm
@@ -2,29 +2,32 @@ package PVE::Tools;
 
 use strict;
 use warnings;
-use POSIX qw(EINTR EEXIST EOPNOTSUPP);
-use IO::Socket::IP;
-use Socket qw(AF_INET AF_INET6 AI_ALL AI_V4MAPPED AI_CANONNAME SOCK_DGRAM
-	      IPPROTO_TCP);
-use IO::Select;
+
+use Date::Format qw(time2str);
+use Digest::MD5;
+use Digest::SHA;
+use Encode;
+use Fcntl qw(:DEFAULT :flock);
 use File::Basename;
 use File::Path qw(make_path);
 use Filesys::Df (); # don't overwrite our df()
-use IO::Pipe;
-use IO::File;
 use IO::Dir;
+use IO::File;
 use IO::Handle;
+use IO::Pipe;
+use IO::Select;
+use IO::Socket::IP;
 use IPC::Open3;
-use Fcntl qw(:DEFAULT :flock);
-use base 'Exporter';
-use URI::Escape;
-use Encode;
-use Digest::SHA;
 use JSON;
-use Text::ParseWords;
+use POSIX qw(EINTR EEXIST EOPNOTSUPP);
+use Scalar::Util 'weaken';
+use Socket qw(AF_INET AF_INET6 AI_ALL AI_V4MAPPED AI_CANONNAME SOCK_DGRAM IPPROTO_TCP);
 use String::ShellQuote;
+use Text::ParseWords;
 use Time::HiRes qw(usleep gettimeofday tv_interval alarm);
-use Scalar::Util 'weaken';
+use URI::Escape;
+use base 'Exporter';
+
 use PVE::Syscall;
 
 # avoid warning when parsing long hex values with hex()
@@ -46,6 +49,7 @@ template_replace
 safe_print
 trim
 extract_param
+extract_sensitive_params
 file_copy
 get_host_arch
 O_PATH
@@ -84,6 +88,9 @@ our $IPV6RE = "(?:" .
 
 our $IPRE = "(?:$IPV4RE|$IPV6RE)";
 
+our $EMAIL_USER_RE = qr/[\w\+\-\~]+(\.[\w\+\-\~]+)*/;
+our $EMAIL_RE = qr/$EMAIL_USER_RE@[a-zA-Z0-9\-]+(\.[a-zA-Z0-9\-]+)*/;
+
 use constant {CLONE_NEWNS   => 0x00020000,
               CLONE_NEWUTS  => 0x04000000,
               CLONE_NEWIPC  => 0x08000000,
@@ -92,11 +99,17 @@ use constant {CLONE_NEWNS   => 0x00020000,
               CLONE_NEWNET  => 0x40000000};
 
 use constant {O_PATH    => 0x00200000,
+              O_CLOEXEC => 0x00080000,
               O_TMPFILE => 0x00410000}; # This includes O_DIRECTORY
 
 use constant {AT_EMPTY_PATH => 0x1000,
               AT_FDCWD => -100};
 
+# from <linux/fs.h>
+use constant {RENAME_NOREPLACE => (1 << 0),
+              RENAME_EXCHANGE  => (1 << 1),
+              RENAME_WHITEOUT  => (1 << 2)};
+
 sub run_with_timeout {
     my ($timeout, $code, @param) = @_;
 
@@ -497,7 +510,7 @@ sub run_command {
 		if ($h eq $reader) {
 		    if ($outfunc || $logfunc) {
 			eval {
-			    while ($buf =~ s/^([^\010\r\n]*)(\r|\n|(\010)+|\r\n)//) {
+			    while ($buf =~ s/^([^\010\r\n]*)(?:\n|(?:\010)+|\r\n?)//) {
 				my $line = $outlog . $1;
 				$outlog = '';
 				&$outfunc($line) if $outfunc;
@@ -518,7 +531,7 @@ sub run_command {
 		} elsif ($h eq $error) {
 		    if ($errfunc || $logfunc) {
 			eval {
-			    while ($buf =~ s/^([^\010\r\n]*)(\r|\n|(\010)+|\r\n)//s) {
+			    while ($buf =~ s/^([^\010\r\n]*)(?:\n|(?:\010)+|\r\n?)//) {
 				my $line = $errlog . $1;
 				$errlog = '';
 				&$errfunc($line) if $errfunc;
@@ -804,6 +817,28 @@ sub extract_param {
     return $res;
 }
 
+# For extracting sensitive keys (e.g. password), to avoid writing them to www-data owned configs
+sub extract_sensitive_params :prototype($$$) {
+    my ($param, $sensitive_list, $delete_list) = @_;
+
+    my %delete = map { $_ => 1 } ($delete_list || [])->@*;
+
+    my $sensitive = {};
+    for my $opt (@$sensitive_list) {
+	# handle deletions as explicitly setting `undef`, so subs which only have $param but not
+	# $delete_list available can recognize them. Afterwards new values  may override.
+	if (exists($delete{$opt})) {
+	    $sensitive->{$opt} = undef;
+	}
+
+	if (defined(my $value = extract_param($param, $opt))) {
+	    $sensitive->{$opt} = $value;
+	}
+    }
+
+    return $sensitive;
+}
+
 # Note: we use this to wait until vncterm/spiceterm is ready
 sub wait_for_vnc_port {
     my ($port, $family, $timeout) = @_;
@@ -1127,6 +1162,8 @@ sub upid_read_status {
 	    return 'OK';
 	} elsif ($line =~ m/^TASK ERROR: (.+)$/) {
 	    return $1;
+	} elsif ($line =~ m/^TASK (WARNINGS: \d+)$/) {
+	    return $1;
 	} else {
 	    return "unexpected status";
 	}
@@ -1359,8 +1396,10 @@ sub unpack_sockaddr_in46 {
 
 sub getaddrinfo_all {
     my ($hostname, @opts) = @_;
-    my %hints = ( flags => AI_V4MAPPED | AI_ALL,
-                  @opts );
+    my %hints = (
+	flags => AI_V4MAPPED | AI_ALL,
+	@opts,
+    );
     my ($err, @res) = Socket::getaddrinfo($hostname, '0', \%hints);
     die "failed to get address info for: $hostname: $err\n" if $err;
     return @res;
@@ -1428,55 +1467,78 @@ sub fsync($) {
     return 0 == syscall(PVE::Syscall::fsync, $fileno);
 }
 
+sub renameat2($$$$$) {
+    my ($olddirfd, $oldpath, $newdirfd, $newpath, $flags) = @_;
+    return 0 == syscall(PVE::Syscall::renameat2, $olddirfd, $oldpath, $newdirfd, $newpath, $flags);
+}
+
 sub sync_mountpoint {
     my ($path) = @_;
-    sysopen my $fd, $path, O_PATH or die "failed to open $path: $!\n";
-    my $result = syncfs(fileno($fd));
+    sysopen my $fd, $path, O_RDONLY|O_CLOEXEC or die "failed to open $path: $!\n";
+    my $syncfs_err;
+    if (!syncfs(fileno($fd))) {
+	$syncfs_err = "$!";
+    }
     close($fd);
-    return $result;
+    die "syncfs '$path' failed - $syncfs_err\n" if defined $syncfs_err;
 }
 
 # support sending multi-part mail messages with a text and or a HTML part
 # mailto may be a single email string or an array of receivers
 sub sendmail {
     my ($mailto, $subject, $text, $html, $mailfrom, $author) = @_;
-    my $mail_re = qr/[^-a-zA-Z0-9+._@]/;
 
     $mailto = [ $mailto ] if !ref($mailto);
 
-    foreach (@$mailto) {
-	die "illegal character in mailto address\n"
-	    if ($_ =~ $mail_re);
+    my $mailto_quoted = [];
+    for my $to (@$mailto) {
+	die "mailto does not look like a valid email address or username\n"
+	    if $to !~ /^$EMAIL_RE$/ && $to !~ /^$EMAIL_USER_RE$/;
+	push @$mailto_quoted, shellquote($to);
     }
 
     my $rcvrtxt = join (', ', @$mailto);
 
     $mailfrom = $mailfrom || "root";
-    die "illegal character in mailfrom address\n"
-	if $mailfrom =~ $mail_re;
+    die "mailfrom does not look like a valid email address or username\n"
+	    if $mailfrom !~ /^$EMAIL_RE$/ && $mailfrom !~ /^$EMAIL_USER_RE$/;
+    my $mailfrom_quoted = shellquote($mailfrom);
+
+    $author = $author // 'Proxmox VE';
+
+    open (MAIL, "|-", "sendmail", "-B", "8BITMIME", "-f", $mailfrom_quoted,
+	"--", @$mailto_quoted) || die "unable to open 'sendmail' - $!";
 
-    $author = $author || 'Proxmox VE';
+    my $date = time2str('%a, %d %b %Y %H:%M:%S %z', time());
 
-    open (MAIL, "|-", "sendmail", "-B", "8BITMIME", "-f", $mailfrom, "--", @$mailto) ||
-	die "unable to open 'sendmail' - $!";
+    my $is_multipart = $text && $html;
 
     # multipart spec see https://www.ietf.org/rfc/rfc1521.txt
     my $boundary = "----_=_NextPart_001_".int(time).$$;
 
-    print MAIL "Content-Type: multipart/alternative;\n";
-    print MAIL "\tboundary=\"$boundary\"\n";
-    print MAIL "MIME-Version: 1.0\n";
+    if ($subject =~ /[^[:ascii:]]/) {
+	$subject = Encode::encode('MIME-Header', $subject);
+    }
 
-    print MAIL "FROM: $author <$mailfrom>\n";
-    print MAIL "TO: $rcvrtxt\n";
-    print MAIL "SUBJECT: $subject\n";
-    print MAIL "\n";
-    print MAIL "This is a multi-part message in MIME format.\n\n";
-    print MAIL "--$boundary\n";
+    if ($subject =~ /[^[:ascii:]]/ || $is_multipart) {
+	print MAIL "MIME-Version: 1.0\n";
+    }
+    print MAIL "From: $author <$mailfrom>\n";
+    print MAIL "To: $rcvrtxt\n";
+    print MAIL "Date: $date\n";
+    print MAIL "Subject: $subject\n";
+
+    if ($is_multipart) {
+	print MAIL "Content-Type: multipart/alternative;\n";
+	print MAIL "\tboundary=\"$boundary\"\n";
+	print MAIL "\n";
+	print MAIL "This is a multi-part message in MIME format.\n\n";
+	print MAIL "--$boundary\n";
+    }
 
     if (defined($text)) {
 	print MAIL "Content-Type: text/plain;\n";
-	print MAIL "\tcharset=\"UTF8\"\n";
+	print MAIL "\tcharset=\"UTF-8\"\n";
 	print MAIL "Content-Transfer-Encoding: 8bit\n";
 	print MAIL "\n";
 
@@ -1486,18 +1548,18 @@ sub sendmail {
 
 	print MAIL $text;
 
-	print MAIL "\n--$boundary\n";
+	print MAIL "\n--$boundary\n" if $is_multipart;
     }
 
     if (defined($html)) {
 	print MAIL "Content-Type: text/html;\n";
-	print MAIL "\tcharset=\"UTF8\"\n";
+	print MAIL "\tcharset=\"UTF-8\"\n";
 	print MAIL "Content-Transfer-Encoding: 8bit\n";
 	print MAIL "\n";
 
 	print MAIL $html;
 
-	print MAIL "\n--$boundary--\n";
+	print MAIL "\n--$boundary--\n" if $is_multipart;
     }
 
     close(MAIL);
@@ -1778,4 +1840,108 @@ sub safe_compare {
     return $cmp->($left, $right);
 }
 
+
+# opts is a hash ref with the following known properties
+#  hash_required - if 1, at least one checksum has to be specified otherwise an error will be thrown
+#  http_proxy
+#  https_proxy
+#  verify_certificates - if 0 (false) we tell wget to ignore untrusted TLS certs. Default to true
+#  md5sum|sha(1|224|256|384|512)sum - the respective expected checksum string
+sub download_file_from_url {
+    my ($dest, $url, $opts) = @_;
+
+    my ($checksum_algorithm, $checksum_expected);
+    for ('sha512', 'sha384', 'sha256', 'sha224', 'sha1', 'md5') {
+	if (defined($opts->{"${_}sum"})) {
+	    $checksum_algorithm = $_;
+	    $checksum_expected = $opts->{"${_}sum"};
+	    last;
+	}
+    }
+    die "checksum required but not specified\n" if ($opts->{hash_required} && !$checksum_algorithm);
+
+    print "downloading $url to $dest\n";
+
+    my $tmpdest = "$dest.tmp.$$";
+    eval {
+	if (-f $dest && $checksum_algorithm) {
+	    print "calculating checksum of existing file...";
+	    my $checksum_got = get_file_hash($checksum_algorithm, $dest);
+
+	    if (lc($checksum_got) eq lc($checksum_expected)) {
+		print "OK, got correct file already, no need to download\n";
+		return;
+	    } else {
+		# we could re-download, but may not be safe so just abort for now..
+		die "mismatch (got '$checksum_got' != expect '$checksum_expected'), aborting\n";
+	    }
+	}
+
+	local $SIG{INT} = sub {
+	    unlink $tmpdest or warn "could not cleanup temporary file: $!";
+	    die "got interrupted by signal\n";
+	};
+
+	{ # limit the scope of the ENV change
+	    local %ENV;
+	    if ($opts->{http_proxy}) {
+		$ENV{http_proxy} = $opts->{http_proxy};
+	    }
+	    if ($opts->{https_proxy}) {
+		$ENV{https_proxy} = $opts->{https_proxy};
+	    }
+
+	    my $cmd = ['wget', '--progress=dot:giga', '-O', $tmpdest, $url];
+
+	    if (!($opts->{verify_certificates} // 1)) { # default to true
+		push @$cmd, '--no-check-certificate';
+	    }
+
+	    run_command($cmd, errmsg => "download failed");
+	}
+
+	if ($checksum_algorithm) {
+	    print "calculating checksum...";
+
+	    my $checksum_got = get_file_hash($checksum_algorithm, $tmpdest);
+
+	    if (lc($checksum_got) eq lc($checksum_expected)) {
+		print "OK, checksum verified\n";
+	    } else {
+		die "ERROR, checksum mismatch: got '$checksum_got' != expect '$checksum_expected'\n";
+	    }
+	}
+
+	rename($tmpdest, $dest) or die "unable to rename temporary file: $!\n";
+    };
+    if (my $err = $@) {
+	unlink $tmpdest or warn "could not cleanup temporary file: $!";
+	die $err;
+    }
+
+    print "download of '$url' to '$dest' finished\n";
+}
+
+sub get_file_hash {
+    my ($algorithm, $filename) = @_;
+
+    my $algorithm_map = {
+	'md5' => sub { Digest::MD5->new },
+	'sha1' => sub { Digest::SHA->new(1) },
+	'sha224' => sub { Digest::SHA->new(224) },
+	'sha256' => sub { Digest::SHA->new(256) },
+	'sha384' => sub { Digest::SHA->new(384) },
+	'sha512' => sub { Digest::SHA->new(512) },
+    };
+
+    my $digester = $algorithm_map->{$algorithm}->() or die "unknown algorithm '$algorithm'\n";
+
+    open(my $fh, '<', $filename) or die "unable to open '$filename': $!\n";
+    binmode($fh);
+
+    my $digest = $digester->addfile($fh)->hexdigest;
+
+    return lc($digest);
+}
+
 1;