bump version to 8.2.1

[pve-common.git] / src / PVE / Tools.pm

diff --git a/src/PVE/Tools.pm b/src/PVE/Tools.pm
index d864b41b3226007f95aac0ba5e3b1a855290710f..766c8091554a1ff1ed048ea1f634c65cceab00a1 100644 (file)
--- a/src/PVE/Tools.pm
+++ b/src/PVE/Tools.pm
@@ -62,6 +62,20 @@ CLONE_NEWIPC
 CLONE_NEWUSER
 CLONE_NEWPID
 CLONE_NEWNET
+MS_RDONLY
+MS_NOSUID
+MS_NODEV
+MS_NOEXEC
+MS_SYNCHRONOUS
+MS_REMOUNT
+MS_MANDLOCK
+MS_DIRSYNC
+MS_NOSYMFOLLOW
+MS_NOATIME
+MS_NODIRATIME
+MS_BIND
+MS_MOVE
+MS_REC
 );
 
 my $pvelogdir = "/var/log/pve";
@@ -110,6 +124,23 @@ use constant {RENAME_NOREPLACE => (1 << 0),
               RENAME_EXCHANGE  => (1 << 1),
               RENAME_WHITEOUT  => (1 << 2)};
 
+use constant {
+    MS_RDONLY      => (1),
+    MS_NOSUID      => (1 <<  1),
+    MS_NODEV       => (1 <<  2),
+    MS_NOEXEC      => (1 <<  3),
+    MS_SYNCHRONOUS => (1 <<  4),
+    MS_REMOUNT     => (1 <<  5),
+    MS_MANDLOCK    => (1 <<  6),
+    MS_DIRSYNC     => (1 <<  7),
+    MS_NOSYMFOLLOW => (1 <<  8),
+    MS_NOATIME     => (1 << 10),
+    MS_NODIRATIME  => (1 << 11),
+    MS_BIND        => (1 << 12),
+    MS_MOVE        => (1 << 13),
+    MS_REC         => (1 << 14),
+};
+
 sub run_with_timeout {
     my ($timeout, $code, @param) = @_;
 
@@ -143,7 +174,8 @@ sub run_with_timeout {
     # this shouldn't happen anymore?
     die "unknown error" if $sigcount && !$err; # seems to happen sometimes
 
-    die $err if $err && !wantarray; # assume that user handles timeout err if called in list context
+    # assume that user handles timeout err if called in list context
+    die $err if $err && (!wantarray || !$got_timeout);
 
     return wantarray ? ($res, $got_timeout) : $res;
 }
@@ -237,7 +269,7 @@ sub lock_file {
 }
 
 sub file_set_contents {
-    my ($filename, $data, $perm)  = @_;
+    my ($filename, $data, $perm, $force_utf8)  = @_;
 
     $perm = 0644 if !defined($perm);
 
@@ -252,6 +284,9 @@ sub file_set_contents {
            }
        }
        die "unable to open file '$tmpname' - $!\n" if !$fh;
+
+       binmode($fh, ":encoding(UTF-8)") if $force_utf8;
+
        die "unable to write '$tmpname' - $!\n" unless print $fh $data;
        die "closing file '$tmpname' failed - $!\n" unless close $fh;
     };
@@ -579,7 +614,7 @@ sub run_command {
            }
        }
 
-        alarm(0);
+       alarm(0);
     };
 
     my $err = $@;
@@ -1016,10 +1051,16 @@ sub run_fork_with_timeout {
        $res = $child_res->{result};
        $error = $child_res->{error};
     };
+
     my $got_timeout = 0;
+    my $wantarray = wantarray; # so it can be queried inside eval
     eval {
        if (defined($timeout)) {
-           (undef, $got_timeout) = run_with_timeout($timeout, $readvalues);
+           if ($wantarray) {
+               (undef, $got_timeout) = run_with_timeout($timeout, $readvalues);
+           } else {
+               run_with_timeout($timeout, $readvalues);
+           }
        } else {
            $readvalues->();
        }
@@ -1354,7 +1395,7 @@ sub dump_journal {
     my $parser = sub {
        my $line = shift;
 
-        return if $count++ < $start;
+       return if $count++ < $start;
        return if $limit <= 0;
        push @$lines, { n => int($count), t => $line};
        $limit--;
@@ -1588,6 +1629,7 @@ sub sendmail {
 
     if (defined($text)) {
        print $mail "Content-Type: text/plain;\n";
+       print $mail "Auto-Submitted: auto-generated;\n";
        print $mail "\tcharset=\"UTF-8\"\n";
        print $mail "Content-Transfer-Encoding: 8bit\n";
        print $mail "\n";
@@ -1603,6 +1645,7 @@ sub sendmail {
 
     if (defined($html)) {
        print $mail "Content-Type: text/html;\n";
+       print $mail "Auto-Submitted: auto-generated;\n";
        print $mail "\tcharset=\"UTF-8\"\n";
        print $mail "Content-Transfer-Encoding: 8bit\n";
        print $mail "\n";
@@ -1708,6 +1751,11 @@ sub mkdirat($$$) {
     return syscall(PVE::Syscall::mkdirat, int($dirfd), $name, int($mode)) == 0;
 }
 
+sub mknod($$$) {
+    my ($filename, $mode, $dev) = @_;
+    return syscall(PVE::Syscall::SYS_mknod, $filename, int($mode), int($dev)) == 0;
+}
+
 sub fchownat($$$$$) {
     my ($dirfd, $pathname, $owner, $group, $flags) = @_;
     return syscall(
@@ -2102,4 +2150,35 @@ sub get_file_hash {
     return lc($digest);
 }
 
+# compare two perl variables recursively, so this works for scalars, nested
+# hashes and nested arrays
+sub is_deeply {
+    my ($a, $b) = @_;
+
+    return 0 if defined($a) != defined($b);
+    return 1 if !defined($a); # both are undef
+
+    my ($ref_a, $ref_b) = (ref($a), ref($b));
+
+    # scalar case
+    return 0 if !$ref_a && !$ref_b && "$a" ne "$b";
+
+    # different types, ok because ref never returns undef, only empty string
+    return 0 if $ref_a ne $ref_b;
+
+    if ($ref_a eq 'HASH') {
+       return 0 if scalar(keys $a->%*) != scalar(keys $b->%*);
+       for my $opt (keys $a->%*) {
+           return 0 if !is_deeply($a->{$opt}, $b->{$opt});
+       }
+    } elsif ($ref_a eq 'ARRAY') {
+       return 0 if scalar($a->@*) != scalar($b->@*);
+       for (my $i = 0; $i < $a->@*; $i++) {
+           return 0 if !is_deeply($a->[$i], $b->[$i]);
+       }
+    }
+
+    return 1;
+}
+
 1;