$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) = @_;
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) = @_;
projects / pve-common.git / blobdiff