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";
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) = @_;
my $prev_alarm = alarm 0; # suspend outer alarm early
my $sigcount = 0;
+ my $got_timeout = 0;
my $res;
eval {
- local $SIG{ALRM} = sub { $sigcount++; die "got timeout\n"; };
+ local $SIG{ALRM} = sub { $sigcount++; $got_timeout = 1; die "got timeout\n"; };
local $SIG{PIPE} = sub { $sigcount++; die "broken pipe\n" };
local $SIG{__DIE__}; # see SA bug 4631
# this shouldn't happen anymore?
die "unknown error" if $sigcount && !$err; # seems to happen sometimes
- die $err if $err;
+ # assume that user handles timeout err if called in list context
+ die $err if $err && (!wantarray || !$got_timeout);
- return $res;
+ return wantarray ? ($res, $got_timeout) : $res;
}
# flock: we use one file handle per process, so lock file
}
sub file_set_contents {
- my ($filename, $data, $perm) = @_;
+ my ($filename, $data, $perm, $force_utf8) = @_;
$perm = 0644 if !defined($perm);
}
}
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;
};
my ($filename) = @_;
my $fh = IO::File->new ($filename, "r");
- return undef if !$fh;
+ if (!$fh) {
+ return undef if $! == POSIX::ENOENT;
+ die "file '$filename' exists but open for reading failed - $!\n";
+ }
my $res = <$fh>;
chomp $res if $res;
$fh->close;
}
}
- alarm(0);
+ alarm(0);
};
my $err = $@;
$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)) {
- run_with_timeout($timeout, $readvalues);
+ if ($wantarray) {
+ (undef, $got_timeout) = run_with_timeout($timeout, $readvalues);
+ } else {
+ run_with_timeout($timeout, $readvalues);
+ }
} else {
$readvalues->();
}
die "interrupted by unexpected signal\n" if $sig_received;
die $error if $error;
- return $res;
+ return wantarray ? ($res, $got_timeout) : $res;
}
sub run_fork {
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--;
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";
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";
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(
}
}
- my $tmpdest = "$dest.tmp.$$";
+ my $tmp_download = "$dest.tmp_dwnl.$$";
+ my $tmp_decomp = "$dest.tmp_dcom.$$";
eval {
local $SIG{INT} = sub {
- unlink $tmpdest or warn "could not cleanup temporary file: $!";
+ unlink $tmp_download or warn "could not cleanup temporary file: $!"
+ if -e $tmp_download;
+ unlink $tmp_decomp or warn "could not cleanup temporary file: $!"
+ if $opts->{decompression_command} && -e $tmp_decomp;
die "got interrupted by signal\n";
};
$ENV{https_proxy} = $opts->{https_proxy};
}
- my $cmd = ['wget', '--progress=dot:giga', '-O', $tmpdest, $url];
+ my $cmd = ['wget', '--progress=dot:giga', '-O', $tmp_download, $url];
if (!($opts->{verify_certificates} // 1)) { # default to true
push @$cmd, '--no-check-certificate';
if ($checksum_algorithm) {
print "calculating checksum...";
- my $checksum_got = get_file_hash($checksum_algorithm, $tmpdest);
+ my $checksum_got = get_file_hash($checksum_algorithm, $tmp_download);
if (lc($checksum_got) eq lc($checksum_expected)) {
print "OK, checksum verified\n";
}
}
- rename($tmpdest, $dest) or die "unable to rename temporary file: $!\n";
+ if (my $cmd = $opts->{decompression_command}) {
+ push @$cmd, $tmp_download;
+ my $fh;
+ if (!open($fh, ">", "$tmp_decomp")) {
+ die "cant open temporary file $tmp_decomp for decompresson: $!\n";
+ }
+ print "decompressing $tmp_download to $tmp_decomp\n";
+ run_command($cmd, output => '>&'.fileno($fh));
+ unlink $tmp_download;
+ rename($tmp_decomp, $dest) or die "unable to rename temporary file: $!\n";
+ } else {
+ rename($tmp_download, $dest) or die "unable to rename temporary file: $!\n";
+ }
};
if (my $err = $@) {
- unlink $tmpdest or warn "could not cleanup temporary file: $!";
+ unlink $tmp_download or warn "could not cleanup temporary file: $!"
+ if -e $tmp_download;
+ unlink $tmp_decomp or warn "could not cleanup temporary file: $!"
+ if $opts->{decompression_command} && -e $tmp_decomp;
die $err;
}
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;
projects / pve-common.git / blobdiff