X-Git-Url: https://git.proxmox.com/?a=blobdiff_plain;f=src%2FPVE%2FTools.pm;h=7d3368393809f7c3c767e7454d9f6f2b3418b2cd;hb=09d47f9d477b95382874de1233d1b012fbf4763f;hp=0f31fdbe6f4f98750be4b8e0c9098416cd6a85a9;hpb=14410e5f204ac17373c6eae07986bb2fd787701c;p=pve-common.git

diff --git a/src/PVE/Tools.pm b/src/PVE/Tools.pm
index 0f31fdb..7d33683 100644
--- a/src/PVE/Tools.pm
+++ b/src/PVE/Tools.pm
@@ -25,6 +25,8 @@ use Text::ParseWords;
 use String::ShellQuote;
 use Time::HiRes qw(usleep gettimeofday tv_interval alarm);
 use Scalar::Util 'weaken';
+use Date::Format qw(time2str);
+
 use PVE::Syscall;
 
 # avoid warning when parsing long hex values with hex()
@@ -47,8 +49,17 @@ safe_print
 trim
 extract_param
 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";
@@ -83,8 +94,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 +291,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 +500,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 +521,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) {
@@ -640,7 +658,7 @@ sub pipe_socket_to_command  {
 }
 
 sub split_list {
-    my $listtxt = shift || '';
+    my $listtxt = shift // '';
 
     return split (/\0/, $listtxt) if $listtxt =~ m/\0/;
 
@@ -896,9 +914,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 +1017,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 {
@@ -1384,6 +1406,11 @@ sub parse_host_and_port {
     return; # nothing
 }
 
+sub setresuid($$$) {
+    my ($ruid, $euid, $suid) = @_;
+    return 0 == syscall(PVE::Syscall::setresuid, $ruid, $euid, $suid);
+}
+
 sub unshare($) {
     my ($flags) = @_;
     return 0 == syscall(PVE::Syscall::unshare, $flags);
@@ -1399,12 +1426,20 @@ sub syncfs($) {
     return 0 == syscall(PVE::Syscall::syncfs, $fileno);
 }
 
+sub fsync($) {
+    my ($fileno) = @_;
+    return 0 == syscall(PVE::Syscall::fsync, $fileno);
+}
+
 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
@@ -1426,28 +1461,41 @@ sub sendmail {
     die "illegal character in mailfrom address\n"
 	if $mailfrom =~ $mail_re;
 
-    $author = $author || 'Proxmox VE';
+    $author = $author // 'Proxmox VE';
 
-    open (MAIL, "|-", "sendmail", "-B", "8BITMIME", "-f", $mailfrom, @$mailto) ||
+    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";
 
@@ -1457,18 +1505,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);
@@ -1546,6 +1594,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 {
@@ -1613,18 +1666,135 @@ sub readline_nointr {
     return $line;
 }
 
+my $host_arch;
 sub get_host_arch {
+    $host_arch = (POSIX::uname())[4] if !$host_arch;
+    return $host_arch;
+}
 
-    my @uname = POSIX::uname();
-    my $machine = $uname[4];
+# Devices are: [ (12 bits minor) (12 bits major) (8 bits minor) ]
+sub dev_t_major($) {
+    my ($dev_t) = @_;
+    return (int($dev_t) & 0xfff00) >> 8;
+}
 
-    if ($machine eq 'x86_64') {
-	return 'amd64';
-    } elsif ($machine eq 'aarch64') {
-	return 'arm64';
-    } else {
-	die "unsupported host architecture '$machine'\n";
+sub dev_t_minor($) {
+    my ($dev_t) = @_;
+    $dev_t = int($dev_t);
+    return (($dev_t >> 12) & 0xfff00) | ($dev_t & 0xff);
+}
+
+# Given an array of array refs [ \[a b c], \[a b b], \[e b a] ]
+# Returns the intersection of elements as a single array [a b]
+sub array_intersect {
+    my ($arrays) = @_;
+
+    if (!ref($arrays->[0])) {
+	$arrays = [ grep { ref($_) eq 'ARRAY' } @_ ];
     }
+
+    return [] if scalar(@$arrays) == 0;
+    return $arrays->[0] if scalar(@$arrays) == 1;
+
+    my $array_unique = sub {
+	my %seen = ();
+	return grep { ! $seen{ $_ }++ } @_;
+    };
+
+    # base idea is to get all unique members from the first array, then
+    # check the common elements with the next (uniquely made) one, only keep
+    # those. Repeat for every array and at the end we only have those left
+    # which exist in all arrays
+    my $return_arr = [ $array_unique->(@{$arrays->[0]}) ];
+    for my $i (1 .. $#$arrays) {
+	my %count = ();
+	# $return_arr is already unique, explicit at before the loop, implicit below.
+	foreach my $element (@$return_arr, $array_unique->(@{$arrays->[$i]})) {
+	    $count{$element}++;
+	}
+	$return_arr = [];
+	foreach my $element (keys %count) {
+	    push @$return_arr, $element if $count{$element} > 1;
+	}
+	last if scalar(@$return_arr) == 0; # empty intersection, early exit
+    }
+
+    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);
 }
 
 1;