X-Git-Url: https://git.proxmox.com/?a=blobdiff_plain;f=src%2FPVE%2FTools.pm;h=b4caf5440f26fcbcfccdaaf3e22ba2173bc1f78f;hb=2531c455e8b02fc6879cd3ec669e8bc2de5e8477;hp=676647eefb375d8d1ad00e9d06ab404baab9c906;hpb=3982313e8d89982f109d4b4c6c1248d1b7d35512;p=pve-common.git diff --git a/src/PVE/Tools.pm b/src/PVE/Tools.pm index 676647e..b4caf54 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,9 +49,19 @@ template_replace safe_print trim extract_param +extract_sensitive_params file_copy +get_host_arch O_PATH O_TMPFILE +AT_EMPTY_PATH +AT_FDCWD +CLONE_NEWNS +CLONE_NEWUTS +CLONE_NEWIPC +CLONE_NEWUSER +CLONE_NEWPID +CLONE_NEWNET ); my $pvelogdir = "/var/log/pve"; @@ -75,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, @@ -83,8 +99,12 @@ 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}; + sub run_with_timeout { my ($timeout, $code, @param) = @_; @@ -276,7 +296,8 @@ sub file_read_firstline { sub safe_read_from { my ($fh, $max, $oneline, $filename) = @_; - $max = 32768 if !$max; + # pmxcfs file size limit + $max = 512*1024 if !$max; my $subject = defined($filename) ? "file '$filename'" : 'input'; @@ -484,12 +505,13 @@ sub run_command { if ($h eq $reader) { if ($outfunc || $logfunc) { eval { - $outlog .= $buf; - while ($outlog =~ s/^([^\010\r\n]*)(\r|\n|(\010)+|\r\n)//s) { - my $line = $1; + while ($buf =~ s/^([^\010\r\n]*)(?:\n|(?:\010)+|\r\n?)//) { + my $line = $outlog . $1; + $outlog = ''; &$outfunc($line) if $outfunc; &$logfunc($line) if $logfunc; } + $outlog .= $buf; }; my $err = $@; if ($err) { @@ -504,12 +526,13 @@ sub run_command { } elsif ($h eq $error) { if ($errfunc || $logfunc) { eval { - $errlog .= $buf; - while ($errlog =~ s/^([^\010\r\n]*)(\r|\n|(\010)+|\r\n)//s) { - my $line = $1; + while ($buf =~ s/^([^\010\r\n]*)(?:\n|(?:\010)+|\r\n?)//) { + my $line = $errlog . $1; + $errlog = ''; &$errfunc($line) if $errfunc; &$logfunc($line) if $logfunc; } + $errlog .= $buf; }; my $err = $@; if ($err) { @@ -789,6 +812,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) = @_; @@ -896,9 +941,13 @@ sub next_vnc_port { return next_unused_port(5900, 6000, $family, $address); } +sub spice_port_range { + return (61000, 61999); +} + sub next_spice_port { my ($family, $address) = @_; - return next_unused_port(61000, 61099, $family, $address); + return next_unused_port(spice_port_range(), $family, $address); } sub must_stringify { @@ -995,8 +1044,8 @@ sub df { my $res = eval { run_fork_with_timeout($timeout, $df) } // {}; warn $@ if $@; - # untaint the values - my ($blocks, $used, $bavail) = map { defined($_) ? (/^(\d+)$/) : 0 } + # untaint, but be flexible: PB usage can result in scientific notation + my ($blocks, $used, $bavail) = map { defined($_) ? (/^([\d\.e\-+]+)$/) : 0 } $res->@{qw(blocks used bavail)}; return { @@ -1108,6 +1157,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"; } @@ -1340,8 +1391,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; @@ -1411,53 +1464,71 @@ sub fsync($) { 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'; - $author = $author || 'Proxmox VE'; + open (MAIL, "|-", "sendmail", "-B", "8BITMIME", "-f", $mailfrom_quoted, + "--", @$mailto_quoted) || die "unable to open 'sendmail' - $!"; - open (MAIL, "|-", "sendmail", "-B", "8BITMIME", "-f", $mailfrom, @$mailto) || - die "unable to open 'sendmail' - $!"; + my $date = time2str('%a, %d %b %Y %H:%M:%S %z', time()); + + 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"; @@ -1467,18 +1538,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); @@ -1556,6 +1627,11 @@ sub mkdirat($$$) { return syscall(PVE::Syscall::mkdirat, $dirfd, $name, $mode) == 0; } +sub fchownat($$$$$) { + my ($dirfd, $pathname, $owner, $group, $flags) = @_; + return syscall(PVE::Syscall::fchownat, $dirfd, $pathname, $owner, $group, $flags) == 0; +} + my $salt_starter = time(); sub encrypt_pw { @@ -1623,18 +1699,10 @@ sub readline_nointr { return $line; } +my $host_arch; sub get_host_arch { - - my @uname = POSIX::uname(); - my $machine = $uname[4]; - - if ($machine eq 'x86_64') { - return 'amd64'; - } elsif ($machine eq 'aarch64') { - return 'arm64'; - } else { - die "unsupported host architecture '$machine'\n"; - } + $host_arch = (POSIX::uname())[4] if !$host_arch; + return $host_arch; } # Devices are: [ (12 bits minor) (12 bits major) (8 bits minor) ] @@ -1687,5 +1755,183 @@ sub array_intersect { return $return_arr; } +sub open_tree($$$) { + my ($dfd, $pathname, $flags) = @_; + return PVE::Syscall::file_handle_result(syscall( + &PVE::Syscall::open_tree, + $dfd, + $pathname, + $flags, + )); +} + +sub move_mount($$$$$) { + my ($from_dirfd, $from_pathname, $to_dirfd, $to_pathname, $flags) = @_; + return 0 == syscall( + &PVE::Syscall::move_mount, + $from_dirfd, + $from_pathname, + $to_dirfd, + $to_pathname, + $flags, + ); +} + +sub fsopen($$) { + my ($fsname, $flags) = @_; + return PVE::Syscall::file_handle_result(syscall(&PVE::Syscall::fsopen, $fsname, $flags)); +} + +sub fsmount($$$) { + my ($fd, $flags, $mount_attrs) = @_; + return PVE::Syscall::file_handle_result(syscall( + &PVE::Syscall::fsmount, + $fd, + $flags, + $mount_attrs, + )); +} + +sub fspick($$$) { + my ($dirfd, $pathname, $flags) = @_; + return PVE::Syscall::file_handle_result(syscall( + &PVE::Syscall::fspick, + $dirfd, + $pathname, + $flags, + )); +} + +sub fsconfig($$$$$) { + my ($fd, $command, $key, $value, $aux) = @_; + return 0 == syscall(&PVE::Syscall::fsconfig, $fd, $command, $key, $value, $aux); +} + +# "raw" mount, old api, not for generic use (as it does not invoke any helpers). +# use for lower level stuff such as bind/remount/... or simple tmpfs mounts +sub mount($$$$$) { + my ($source, $target, $filesystemtype, $mountflags, $data) = @_; + return 0 == syscall( + &PVE::Syscall::mount, + $source, + $target, + $filesystemtype, + $mountflags, + $data, + ); +} + +sub safe_compare { + my ($left, $right, $cmp) = @_; + + return 0 if !defined($left) && !defined($right); + return -1 if !defined($left); + return 1 if !defined($right); + 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 "ERRROR, 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;