X-Git-Url: https://git.proxmox.com/?p=pve-common.git;a=blobdiff_plain;f=src%2FPVE%2FTools.pm;h=a1571ea3d9fa8c05746fea45ad7c525b197d5c6d;hp=567f604347880e7dd5421c8a93a95ca1623bc9f7;hb=d94f7005cee0677d186f67b5641cd4a96824477c;hpb=3a94648515835dcb74d5fda49c57d0dd2753087d diff --git a/src/PVE/Tools.pm b/src/PVE/Tools.pm index 567f604..a1571ea 100644 --- a/src/PVE/Tools.pm +++ b/src/PVE/Tools.pm @@ -2,29 +2,31 @@ 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 Date::Format qw(time2str); +use URI::Escape; +use base 'Exporter'; use PVE::Syscall; @@ -103,6 +105,11 @@ use constant {O_PATH => 0x00200000, use constant {AT_EMPTY_PATH => 0x1000, AT_FDCWD => -100}; +# from +use constant {RENAME_NOREPLACE => (1 << 0), + RENAME_EXCHANGE => (1 << 1), + RENAME_WHITEOUT => (1 << 2)}; + sub run_with_timeout { my ($timeout, $code, @param) = @_; @@ -295,7 +302,7 @@ sub safe_read_from { my ($fh, $max, $oneline, $filename) = @_; # pmxcfs file size limit - $max = 512*1024 if !$max; + $max = 1024 * 1024 if !$max; my $subject = defined($filename) ? "file '$filename'" : 'input'; @@ -447,13 +454,12 @@ sub run_command { $pid = open3($writer, $reader, $error, @$cmd) || die $!; - # if we pipe fron STDIN, open3 closes STDIN, so we we - # a perl warning "Filehandle STDIN reopened as GENXYZ .. " - # as soon as we open a new file. + # if we pipe fron STDIN, open3 closes STDIN, so we get a perl warning like + # "Filehandle STDIN reopened as GENXYZ .. " as soon as we open a new file. # to avoid that we open /dev/null if (!ref($writer) && !defined(fileno(STDIN))) { POSIX::close(0); - open(STDIN, "new(); $select->add($reader) if ref($reader); $select->add($error); @@ -1164,6 +1170,31 @@ sub upid_read_status { return "unable to read tail (got $br bytes)"; } +# Check if the status returned by upid_read_status is an error status. +# If the status could not be parsed it's also treated as an error. +sub upid_status_is_error { + my ($status) = @_; + + return !($status eq 'OK' || $status =~ m/^WARNINGS: \d+$/); +} + +# takes the parsed status and returns the type, either ok, warning, error or unknown +sub upid_normalize_status_type { + my ($status) = @_; + + if (!$status) { + return 'unknown'; + } elsif ($status eq 'OK') { + return 'ok'; + } elsif ($status =~ m/^WARNINGS: \d+$/) { + return 'warning'; + } elsif ($status eq 'unexpected status') { + return 'unknown'; + } else { + return 'error'; + } +} + # useful functions to store comments in config files sub encode_text { my ($text) = @_; @@ -1460,6 +1491,11 @@ 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_RDONLY|O_CLOEXEC or die "failed to open $path: $!\n"; @@ -1471,6 +1507,12 @@ sub sync_mountpoint { die "syncfs '$path' failed - $syncfs_err\n" if defined $syncfs_err; } +my sub check_mail_addr { + my ($addr) = @_; + die "'$addr' does not look like a valid email address or username\n" + if $addr !~ /^$EMAIL_RE$/ && $addr !~ /^$EMAIL_USER_RE$/; +} + # 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 { @@ -1478,88 +1520,90 @@ sub sendmail { $mailto = [ $mailto ] if !ref($mailto); - 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); + check_mail_addr($_) for $mailto->@*; + my $to_quoted = [ map { shellquote($_) } $mailto->@* ]; $mailfrom = $mailfrom || "root"; - 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); + check_mail_addr($mailfrom); + my $from_quoted = shellquote($mailfrom); $author = $author // 'Proxmox VE'; - open (MAIL, "|-", "sendmail", "-B", "8BITMIME", "-f", $mailfrom_quoted, - "--", @$mailto_quoted) || die "unable to open 'sendmail' - $!"; - - my $date = time2str('%a, %d %b %Y %H:%M:%S %z', time()); + open (my $mail, "|-", "sendmail", "-B", "8BITMIME", "-f", $from_quoted, "--", $to_quoted->@*) + or die "unable to open 'sendmail' - $!"; my $is_multipart = $text && $html; + my $boundary = "----_=_NextPart_001_" . int(time()) . $$; # multipart spec, see rfc 1521 - # multipart spec see https://www.ietf.org/rfc/rfc1521.txt - my $boundary = "----_=_NextPart_001_".int(time).$$; + $subject = Encode::encode('MIME-Header', $subject) if $subject =~ /[^[:ascii:]]/; - if ($subject =~ /[^[:ascii:]]/) { - $subject = Encode::encode('MIME-Header', $subject); - } + print $mail "MIME-Version: 1.0\n" if $subject =~ /[^[:ascii:]]/ || $is_multipart; - 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"; + print $mail "From: $author <$mailfrom>\n"; + print $mail "To: " . join(', ', @$mailto) ."\n"; + print $mail "Date: " . time2str('%a, %d %b %Y %H:%M:%S %z', time()) . "\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"; + 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=\"UTF-8\"\n"; - print MAIL "Content-Transfer-Encoding: 8bit\n"; - print MAIL "\n"; + print $mail "Content-Type: text/plain;\n"; + print $mail "\tcharset=\"UTF-8\"\n"; + print $mail "Content-Transfer-Encoding: 8bit\n"; + print $mail "\n"; # avoid 'remove extra line breaks' issue (MS Outlook) my $fill = ' '; $text =~ s/^/$fill/gm; - print MAIL $text; + print $mail $text; - print MAIL "\n--$boundary\n" if $is_multipart; + print $mail "\n--$boundary\n" if $is_multipart; } if (defined($html)) { - print MAIL "Content-Type: text/html;\n"; - print MAIL "\tcharset=\"UTF-8\"\n"; - print MAIL "Content-Transfer-Encoding: 8bit\n"; - print MAIL "\n"; + print $mail "Content-Type: text/html;\n"; + print $mail "\tcharset=\"UTF-8\"\n"; + print $mail "Content-Transfer-Encoding: 8bit\n"; + print $mail "\n"; - print MAIL $html; + print $mail $html; - print MAIL "\n--$boundary--\n" if $is_multipart; + print $mail "\n--$boundary--\n" if $is_multipart; } - close(MAIL); + close($mail); } +# creates a temporary file that does not shows up on the file system hierarchy. +# +# Uses O_TMPFILE if available, which makes it just an anon inode that never shows up in the FS. +# If O_TMPFILE is not available, which unlikely nowadays (added in 3.11 kernel and all FS relevant +# for us support it) back to open-create + immediate unlink while still holding the file handle. +# +# TODO: to avoid FS dependent features we could (transparently) switch to memfd_create as backend sub tempfile { my ($perm, %opts) = @_; # default permissions are stricter than with file_set_contents $perm = 0600 if !defined($perm); - my $dir = $opts{dir} // '/run'; + my $dir = $opts{dir}; + if (!$dir) { + if (-d "/run/user/$<") { + $dir = "/run/user/$<"; + } elsif ($< == 0) { + $dir = "/run"; + } else { + $dir = "/tmp"; + } + } my $mode = $opts{mode} // O_RDWR; $mode |= O_EXCL if !$opts{allow_links}; @@ -1574,6 +1618,7 @@ sub tempfile { return $fh; } +# create an (ideally) anon file with the $data as content and return its FD-path and FH sub tempfile_contents { my ($data, $perm, %opts) = @_; @@ -1819,6 +1864,37 @@ sub mount($$$$$) { ); } +# size is optional and defaults to 256, note that xattr limits are FS specific and that xattrs can +# get arbitrary long. pass `0` for $size in array context to get the actual size of a value +sub getxattr($$;$) { + my ($path_or_handle, $name, $size) = @_; + $size //= 256; + my $buf = pack("x${size}"); + + my $xattr_size = -1; # the actual size of the xattr, can be zero + if (defined(my $fd = fileno($path_or_handle))) { + $xattr_size = syscall(&PVE::Syscall::fgetxattr, $fd, $name, $buf, $size); + } else { + $xattr_size = syscall(&PVE::Syscall::getxattr, $path_or_handle, $name, $buf, $size); + } + if ($xattr_size < 0) { + return undef; + } + return wantarray ? ($buf, $xattr_size) : $buf; +} + +# NOTE: can take either a path or an open file handle, i.e., its multiplexing setxattr and fsetxattr +sub setxattr($$$;$) { + my ($path_or_handle, $name, $value, $flags) = @_; + my $size = length($value); # NOTE: seems to get correct length also for wide-characters in text.. + + if (defined(my $fd = fileno($path_or_handle))) { + return 0 == syscall(&PVE::Syscall::fsetxattr, $fd, $name, $value, $size, $flags // 0); + } else { + return 0 == syscall(&PVE::Syscall::setxattr, $path_or_handle, $name, $value, $size, $flags // 0); + } +} + sub safe_compare { my ($left, $right, $cmp) = @_; @@ -1830,6 +1906,7 @@ sub safe_compare { # opts is a hash ref with the following known properties +# allow_overwrite - if 1, overwriting existing files is allowed, use with care. Default to false # hash_required - if 1, at least one checksum has to be specified otherwise an error will be thrown # http_proxy # https_proxy @@ -1850,21 +1927,27 @@ sub download_file_from_url { print "downloading $url to $dest\n"; - my $tmpdest = "$dest.tmp.$$"; - eval { - if (-f $dest && $checksum_algorithm) { + if (-f $dest) { + if ($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; + } elsif ($opts->{allow_overwrite}) { + print "checksum mismatch: got '$checksum_got' != expect '$checksum_expected', re-download\n"; } 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"; + print "\n"; # the front end expects the error to reside at the last line without any noise + die "checksum mismatch: got '$checksum_got' != expect '$checksum_expected', aborting\n"; } + } elsif (!$opts->{allow_overwrite}) { + die "refusing to override existing file '$dest'\n"; } + } + my $tmpdest = "$dest.tmp.$$"; + eval { local $SIG{INT} = sub { unlink $tmpdest or warn "could not cleanup temporary file: $!"; die "got interrupted by signal\n"; @@ -1896,7 +1979,8 @@ sub download_file_from_url { 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"; + print "\n"; # the front end expects the error to reside at the last line without any noise + die "checksum mismatch: got '$checksum_got' != expect '$checksum_expected'\n"; } }