use URI::Escape;
use Encode;
use Digest::SHA;
+use JSON;
use Text::ParseWords;
use String::ShellQuote;
use Time::HiRes qw(usleep gettimeofday tv_interval alarm);
or die "can't open file - $!\n";
if (!flock($fh, $mode|LOCK_NB)) {
- print STDERR "trying to acquire lock...";
+ print STDERR "trying to acquire lock...\n";
my $success;
while(1) {
$success = flock($fh, $mode);
return $exitcode;
}
+# Run a command with a tcp socket as standard input.
+sub pipe_socket_to_command {
+ my ($cmd, $ip, $port) = @_;
+
+ my $params = {
+ Listen => 1,
+ ReuseAddr => 1,
+ Proto => &Socket::IPPROTO_TCP,
+ GetAddrInfoFlags => 0,
+ LocalAddr => $ip,
+ LocalPort => $port,
+ };
+ my $socket = IO::Socket::IP->new(%$params) or die "failed to open socket: $!\n";
+
+ print "$ip\n$port\n"; # tell remote where to connect
+ *STDOUT->flush();
+
+ alarm 0;
+ local $SIG{ALRM} = sub { die "timed out waiting for client\n" };
+ alarm 30;
+ my $client = $socket->accept; # Wait for a client
+ alarm 0;
+ close($socket);
+
+ # We want that the command talks over the TCP socket and takes
+ # ownership of it, so that when it closes it the connection is
+ # terminated, so we need to be able to close the socket. So we
+ # can't really use PVE::Tools::run_command().
+ my $pid = fork() // die "fork failed: $!\n";
+ if (!$pid) {
+ POSIX::dup2(fileno($client), 0);
+ POSIX::dup2(fileno($client), 1);
+ close($client);
+ exec {$cmd->[0]} @$cmd or do {
+ warn "exec failed: $!\n";
+ POSIX::_exit(1);
+ };
+ }
+
+ close($client);
+ if (waitpid($pid, 0) != $pid) {
+ kill(15 => $pid); # if we got interrupted terminate the child
+ my $count = 0;
+ while (waitpid($pid, POSIX::WNOHANG) != $pid) {
+ usleep(100000);
+ $count++;
+ kill(9 => $pid), last if $count > 300; # 30 second timeout
+ }
+ }
+ if (my $sig = ($? & 127)) {
+ die "got signal $sig\n";
+ } elsif (my $exitcode = ($? >> 8)) {
+ die "exit code $exitcode\n";
+ }
+
+ return undef;
+}
+
sub split_list {
my $listtxt = shift || '';
my $res;
my $error;
my $pipe_out = IO::Pipe->new();
- my $pipe_err = IO::Pipe->new();
# disable pending alarms, save their remaining time
my $prev_alarm = alarm 0;
- # trap before forking to avoid leaving a zombie if the parent get killed
+ # avoid leaving a zombie if the parent gets interrupted
my $sig_received;
- local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
- $sig_received++;
- };
+ local $SIG{INT} = sub { $sig_received++; };
my $child = fork();
if (!defined($child)) {
if (!$child) {
$pipe_out->writer();
- $pipe_err->writer();
eval {
$res = $sub->();
- print {$pipe_out} "$res";
+ print {$pipe_out} encode_json({ result => $res });
$pipe_out->flush();
};
if (my $err = $@) {
- print {$pipe_err} "$err";
- $pipe_err->flush();
+ print {$pipe_out} encode_json({ error => $err });
+ $pipe_out->flush();
POSIX::_exit(1);
}
POSIX::_exit(0);
}
$pipe_out->reader();
- $pipe_err->reader();
my $readvalues = sub {
local $/ = undef;
- $res = <$pipe_out>;
- $error = <$pipe_err>;
+ my $child_res = decode_json(scalar<$pipe_out>);
+ $res = $child_res->{result};
+ $error = $child_res->{error};
};
eval {
- run_with_timeout($timeout, $readvalues);
+ if (defined($timeout)) {
+ run_with_timeout($timeout, $readvalues);
+ } else {
+ $readvalues->();
+ }
};
warn $@ if $@;
$pipe_out->close();
- $pipe_err->close();
kill('KILL', $child);
waitpid($child, 0);
return $res;
}
+sub run_fork {
+ my ($code) = @_;
+ return run_fork_with_timeout(undef, $code);
+}
+
# NOTE: NFS syscall can't be interrupted, so alarm does
# not work to provide timeouts.
# from 'man nfs': "Only SIGKILL can interrupt a pending NFS operation"
$pipe->writer();
eval {
my $df = Filesys::Df::df($path, 1);
- print {$pipe} "$df->{blocks}\n$df->{used}\n$df->{bavail}\n";
+ print {$pipe} "$df->{blocks}\n$df->{used}\n$df->{bavail}\n"
+ if defined($df);
$pipe->close();
};
if (my $err = $@) {
$pipe->reader();
my $readvalues = sub {
- $res->{total} = int((<$pipe> =~ /^(\d*)$/)[0]);
- $res->{used} = int((<$pipe> =~ /^(\d*)$/)[0]);
- $res->{avail} = int((<$pipe> =~ /^(\d*)$/)[0]);
+ $res->{total} = int(((<$pipe> // 0) =~ /^(\d*)$/)[0]);
+ $res->{used} = int(((<$pipe> // 0) =~ /^(\d*)$/)[0]);
+ $res->{avail} = int(((<$pipe> // 0) =~ /^(\d*)$/)[0]);
};
eval {
run_with_timeout($timeout, $readvalues);
return crypt(encode("utf8", $pw), "\$5\$$salt\$");
}
+# intended usage: convert_size($val, "kb" => "gb")
+# on reduction (converting to a bigger unit) we round up by default if
+# information got lost. E.g. `convert_size(1023, "b" => "kb")` returns 1
+# use $no_round_up to switch this off, above example would then return 0
+sub convert_size {
+ my ($value, $from, $to, $no_round_up) = @_;
+
+ my $units = {
+ b => 0,
+ kb => 1,
+ mb => 2,
+ gb => 3,
+ tb => 4,
+ pb => 5,
+ };
+
+ $from = lc($from); $to = lc($to);
+ die "unknown 'from' and/or 'to' units ($from => $to)"
+ if !(defined($units->{$from}) && defined($units->{$to}));
+
+ my $shift_amount = $units->{$from} - $units->{$to};
+
+ if ($shift_amount > 0) {
+ $value <<= ($shift_amount * 10);
+ } elsif ($shift_amount < 0) {
+ my $remainder = ($value & (1 << abs($shift_amount)*10) - 1);
+ $value >>= abs($shift_amount) * 10;
+ $value++ if $remainder && !$no_round_up;
+ }
+
+ return $value;
+}
+
1;