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) = @_;
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';
$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, "</dev/null");
+ open(STDIN, '<', '/dev/null');
}
};
close $writer;
}
- my $select = new IO::Select;
+ my $select = IO::Select->new();
$select->add($reader) if ref($reader);
$select->add($error);
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) = @_;
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";
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 {
$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};
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) = @_;
);
}
+# 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) = @_;
# 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
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";
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";
}
}
projects / pve-common.git / blobdiff