use URI::Escape;
use Encode;
use Digest::SHA1;
+use Text::ParseWords;
+use String::ShellQuote;
our @EXPORT_OK = qw(
lock_file
mkdir $pvelogdir;
mkdir $pvetaskdir;
-# flock: we use one file handle per process, so lock file
-# can be called multiple times and succeeds for the same process.
+sub run_with_timeout {
+ my ($timeout, $code, @param) = @_;
-my $lock_handles = {};
+ die "got timeout\n" if $timeout <= 0;
-sub lock_file {
- my ($filename, $timeout, $code, @param) = @_;
+ my $prev_alarm;
+
+ my $sigcount = 0;
my $res;
- $timeout = 10 if !$timeout;
+ local $SIG{ALRM} = sub { $sigcount++; }; # catch alarm outside eval
eval {
+ local $SIG{ALRM} = sub { $sigcount++; die "got timeout\n"; };
+ local $SIG{PIPE} = sub { $sigcount++; die "broken pipe\n" };
+ local $SIG{__DIE__}; # see SA bug 4631
+
+ $prev_alarm = alarm($timeout);
+
+ $res = &$code(@param);
+
+ alarm(0); # avoid race conditions
+ };
+
+ my $err = $@;
- local $SIG{ALRM} = sub { die "got timeout (can't lock '$filename')\n"; };
+ alarm($prev_alarm) if defined($prev_alarm);
- alarm ($timeout);
+ die "unknown error" if $sigcount && !$err; # seems to happen sometimes
+
+ die $err if $err;
+
+ return $res;
+}
+
+# flock: we use one file handle per process, so lock file
+# can be called multiple times and succeeds for the same process.
+
+my $lock_handles = {};
+
+sub lock_file {
+ my ($filename, $timeout, $code, @param) = @_;
+ $timeout = 10 if !$timeout;
+
+ my $lock_func = sub {
if (!$lock_handles->{$$}->{$filename}) {
$lock_handles->{$$}->{$filename} = new IO::File (">>$filename") ||
- die "can't open lock file '$filename' - $!\n";
+ die "can't open file - $!\n";
}
if (!flock ($lock_handles->{$$}->{$filename}, LOCK_EX|LOCK_NB)) {
print STDERR "trying to aquire lock...";
if (!flock ($lock_handles->{$$}->{$filename}, LOCK_EX)) {
print STDERR " failed\n";
- die "can't aquire lock for '$filename' - $!\n";
+ die "can't aquire lock - $!\n";
}
print STDERR " OK\n";
}
- alarm (0);
-
- $res = &$code(@param);
};
- my $err = $@;
+ my $res;
- alarm (0);
+ eval { run_with_timeout($timeout, $lock_func); };
+ my $err = $@;
+ if ($err) {
+ $err = "can't lock file '$filename' - $err";
+ } else {
+ eval { $res = &$code(@param) };
+ $err = $@;
+ }
if ($lock_handles->{$$}->{$filename}) {
my $fh = $lock_handles->{$$}->{$filename};
my ($cmd, %param) = @_;
my $old_umask;
+ my $cmdstr;
- $cmd = [ $cmd ] if !ref($cmd);
-
- my $cmdstr = join (' ', @$cmd);
+ if (!ref($cmd)) {
+ $cmdstr = $cmd;
+ $cmd = [ $cmd ];
+ } else {
+ $cmdstr = cmd2string($cmd);
+ }
my $errmsg;
my $laststderr;
my $oldtimeout;
my $pid;
- eval {
- my $reader = IO::File->new();
- my $writer = IO::File->new();
- my $error = IO::File->new();
+ my $outfunc;
+ my $errfunc;
+ my $logfunc;
+ my $input;
+ my $output;
- my $input;
- my $outfunc;
- my $errfunc;
+ eval {
foreach my $p (keys %param) {
if ($p eq 'timeout') {
umask($param{$p});
} elsif ($p eq 'errmsg') {
$errmsg = $param{$p};
- $errfunc = sub {
- print STDERR "$laststderr\n" if $laststderr;
- $laststderr = shift;
- };
} elsif ($p eq 'input') {
$input = $param{$p};
+ } elsif ($p eq 'output') {
+ $output = $param{$p};
} elsif ($p eq 'outfunc') {
$outfunc = $param{$p};
} elsif ($p eq 'errfunc') {
$errfunc = $param{$p};
+ } elsif ($p eq 'logfunc') {
+ $logfunc = $param{$p};
} else {
die "got unknown parameter '$p' for run_command\n";
}
}
+ if ($errmsg) {
+ my $origerrfunc = $errfunc;
+ $errfunc = sub {
+ if ($laststderr) {
+ if ($origerrfunc) {
+ &$origerrfunc("$laststderr\n");
+ } else {
+ print STDERR "$laststderr\n" if $laststderr;
+ }
+ }
+ $laststderr = shift;
+ };
+ }
+
+ my $reader = $output && $output =~ m/^>&/ ? $output : IO::File->new();
+ my $writer = $input && $input =~ m/^<&/ ? $input : IO::File->new();
+ my $error = IO::File->new();
+
# try to avoid locale related issues/warnings
my $lang = $param{lang} || 'C';
local $ENV{LVM_SUPPRESS_FD_WARNINGS} = "1";
$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.
+ # to avoid that we open /dev/null
+ if (!ref($writer) && !defined(fileno(STDIN))) {
+ POSIX::close(0);
+ open(STDIN, "</dev/null");
+ }
};
my $err = $@;
local $SIG{ALRM} = sub { die "got timeout\n"; } if $timeout;
$oldtimeout = alarm($timeout) if $timeout;
- print $writer $input if defined $input;
- close $writer;
+ if (ref($writer)) {
+ print $writer $input if defined $input;
+ close $writer;
+ }
my $select = new IO::Select;
- $select->add($reader);
+ $select->add($reader) if ref($reader);
$select->add($error);
my $outlog = '';
}
$select->remove ($h) if !$count;
if ($h eq $reader) {
- if ($outfunc) {
+ if ($outfunc || $logfunc) {
eval {
$outlog .= $buf;
while ($outlog =~ s/^([^\010\r\n]*)(\r|\n|(\010)+|\r\n)//s) {
my $line = $1;
- &$outfunc($line);
+ &$outfunc($line) if $outfunc;
+ &$logfunc($line) if $logfunc;
}
};
my $err = $@;
*STDOUT->flush();
}
} elsif ($h eq $error) {
- if ($errfunc) {
+ if ($errfunc || $logfunc) {
eval {
$errlog .= $buf;
while ($errlog =~ s/^([^\010\r\n]*)(\r|\n|(\010)+|\r\n)//s) {
my $line = $1;
- &$errfunc($line);
+ &$errfunc($line) if $errfunc;
+ &$logfunc($line) if $logfunc;
}
};
my $err = $@;
}
&$outfunc($outlog) if $outfunc && $outlog;
+ &$logfunc($outlog) if $logfunc && $outlog;
+
&$errfunc($errlog) if $errfunc && $errlog;
+ &$logfunc($errlog) if $logfunc && $errlog;
waitpid ($pid, 0);
} elsif (my $sig = ($? & 127)) {
die "got signal $sig\n";
} elsif (my $ec = ($? >> 8)) {
- if ($errmsg && $laststderr) {
- my $lerr = $laststderr;
- $laststderr = undef;
- die "$lerr\n";
+ if (!($ec == 24 && ($cmdstr =~ m|^(\S+/)?rsync\s|))) {
+ if ($errmsg && $laststderr) {
+ my $lerr = $laststderr;
+ $laststderr = undef;
+ die "$lerr\n";
+ }
+ die "exit code $ec\n";
}
- die "exit code $ec\n";
}
alarm(0);
alarm(0);
- print STDERR "$laststderr\n" if $laststderr;
+ if ($errmsg && $laststderr) {
+ &$errfunc(undef); # flush laststderr
+ }
umask ($old_umask) if defined($old_umask);
die "command '$cmdstr' failed: $err";
}
}
+
+ return undef;
}
sub split_list {
my $listtxt = shift || '';
- $listtxt =~ s/[,;\0]/ /g;
+ return split (/\0/, $listtxt) if $listtxt =~ m/\0/;
+
+ $listtxt =~ s/[,;]/ /g;
$listtxt =~ s/^\s+//;
my @data = split (/\s+/, $listtxt);
sub template_replace {
my ($tmpl, $data) = @_;
+ return $tmpl if !$tmpl;
+
my $res = '';
while ($tmpl =~ m/([^{]+)?({([^}]+)})?/g) {
$res .= $1 if $1;
};
}
+my $keymaphash = {
+ 'dk' => ['Danish', 'da', 'qwerty/dk-latin1.kmap.gz', 'dk', 'nodeadkeys'],
+ 'de' => ['German', 'de', 'qwertz/de-latin1-nodeadkeys.kmap.gz', 'de', 'nodeadkeys' ],
+ 'de-ch' => ['Swiss-German', 'de-ch', 'qwertz/sg-latin1.kmap.gz', 'ch', 'de_nodeadkeys' ],
+ 'en-gb' => ['United Kingdom', 'en-gb', 'qwerty/uk.kmap.gz' , 'gb', 'intl' ],
+ 'en-us' => ['U.S. English', 'en-us', 'qwerty/us-latin1.kmap.gz', 'us', 'intl' ],
+ 'es' => ['Spanish', 'es', 'qwerty/es.kmap.gz', 'es', 'nodeadkeys'],
+ #'et' => [], # Ethopia or Estonia ??
+ 'fi' => ['Finnish', 'fi', 'qwerty/fi-latin1.kmap.gz', 'fi', 'nodeadkeys'],
+ #'fo' => ['Faroe Islands', 'fo', ???, 'fo', 'nodeadkeys'],
+ 'fr' => ['French', 'fr', 'azerty/fr-latin1.kmap.gz', 'fr', 'nodeadkeys'],
+ 'fr-be' => ['Belgium-French', 'fr-be', 'azerty/be2-latin1.kmap.gz', 'be', 'nodeadkeys'],
+ 'fr-ca' => ['Canada-French', 'fr-ca', 'qwerty/cf.kmap.gz', 'ca', 'fr-legacy'],
+ 'fr-ch' => ['Swiss-French', 'fr-ch', 'qwertz/fr_CH-latin1.kmap.gz', 'ch', 'fr_nodeadkeys'],
+ #'hr' => ['Croatia', 'hr', 'qwertz/croat.kmap.gz', 'hr', ??], # latin2?
+ 'hu' => ['Hungarian', 'hu', 'qwertz/hu.kmap.gz', 'hu', undef],
+ 'is' => ['Icelandic', 'is', 'qwerty/is-latin1.kmap.gz', 'is', 'nodeadkeys'],
+ 'it' => ['Italian', 'it', 'qwerty/it2.kmap.gz', 'it', 'nodeadkeys'],
+ 'jp' => ['Japanese', 'ja', 'qwerty/jp106.kmap.gz', 'jp', undef],
+ 'lt' => ['Lithuanian', 'lt', 'qwerty/lt.kmap.gz', 'lt', 'std'],
+ #'lv' => ['Latvian', 'lv', 'qwerty/lv-latin4.kmap.gz', 'lv', ??], # latin4 or latin7?
+ 'mk' => ['Macedonian', 'mk', 'qwerty/mk.kmap.gz', 'mk', 'nodeadkeys'],
+ 'nl' => ['Dutch', 'nl', 'qwerty/nl.kmap.gz', 'nl', undef],
+ #'nl-be' => ['Belgium-Dutch', 'nl-be', ?, ?, ?],
+ 'no' => ['Norwegian', 'no', 'qwerty/no-latin1.kmap.gz', 'no', 'nodeadkeys'],
+ 'pl' => ['Polish', 'pl', 'qwerty/pl.kmap.gz', 'pl', undef],
+ 'pt' => ['Portuguese', 'pt', 'qwerty/pt-latin1.kmap.gz', 'pt', 'nodeadkeys'],
+ 'pt-br' => ['Brazil-Portuguese', 'pt-br', 'qwerty/br-latin1.kmap.gz', 'br', 'nodeadkeys'],
+ #'ru' => ['Russian', 'ru', 'qwerty/ru.kmap.gz', 'ru', undef], # dont know?
+ 'si' => ['Slovenian', 'sl', 'qwertz/slovene.kmap.gz', 'si', undef],
+ #'sv' => [], Swedish ?
+ #'th' => [],
+ #'tr' => [],
+};
+
+my $kvmkeymaparray = [];
+foreach my $lc (keys %$keymaphash) {
+ push @$kvmkeymaparray, $keymaphash->{$lc}->[1];
+}
+
sub kvmkeymaps {
- return {
- 'dk' => ['Danish', 'da', 'qwerty/dk-latin1.kmap.gz', 'dk', 'nodeadkeys'],
- 'de' => ['German', 'de', 'qwertz/de-latin1-nodeadkeys.kmap.gz', 'de', 'nodeadkeys' ],
- 'de-ch' => ['Swiss-German', 'de-ch', 'qwertz/sg-latin1.kmap.gz', 'ch', 'de_nodeadkeys' ],
- 'en-gb' => ['United Kingdom', 'en-gb', 'qwerty/uk.kmap.gz' , 'gb', 'intl' ],
- 'en-us' => ['U.S. English', 'en-us', 'qwerty/us-latin1.kmap.gz', 'us', 'intl' ],
- 'es' => ['Spanish', 'es', 'qwerty/es.kmap.gz', 'es', 'nodeadkeys'],
- #'et' => [], # Ethopia or Estonia ??
- 'fi' => ['Finnish', 'fi', 'qwerty/fi-latin1.kmap.gz', 'fi', 'nodeadkeys'],
- #'fo' => ['Faroe Islands', 'fo', ???, 'fo', 'nodeadkeys'],
- 'fr' => ['French', 'fr', 'azerty/fr-latin1.kmap.gz', 'fr', 'nodeadkeys'],
- 'fr-be' => ['Belgium-French', 'fr-be', 'azerty/be2-latin1.kmap.gz', 'be', 'nodeadkeys'],
- 'fr-ca' => ['Canada-French', 'fr-ca', 'qwerty/cf.kmap.gz', 'ca', 'fr-legacy'],
- 'fr-ch' => ['Swiss-French', 'fr-ch', 'qwertz/fr_CH-latin1.kmap.gz', 'ch', 'fr_nodeadkeys'],
- #'hr' => ['Croatia', 'hr', 'qwertz/croat.kmap.gz', 'hr', ??], # latin2?
- 'hu' => ['Hungarian', 'hu', 'qwertz/hu.kmap.gz', 'hu', undef],
- 'is' => ['Icelandic', 'is', 'qwerty/is-latin1.kmap.gz', 'is', 'nodeadkeys'],
- 'it' => ['Italian', 'it', 'qwerty/it2.kmap.gz', 'it', 'nodeadkeys'],
- 'jp' => ['Japanese', 'ja', 'qwerty/jp106.kmap.gz', 'jp', undef],
- 'lt' => ['Lithuanian', 'lt', 'qwerty/lt.kmap.gz', 'lt', 'std'],
- #'lv' => ['Latvian', 'lv', 'qwerty/lv-latin4.kmap.gz', 'lv', ??], # latin4 or latin7?
- 'mk' => ['Macedonian', 'mk', 'qwerty/mk.kmap.gz', 'mk', 'nodeadkeys'],
- 'nl' => ['Dutch', 'nl', 'qwerty/nl.kmap.gz', 'nl', undef],
- #'nl-be' => ['Belgium-Dutch', 'nl-be', ?, ?, ?],
- 'no' => ['Norwegian', 'no', 'qwerty/no-latin1.kmap.gz', 'no', 'nodeadkeys'],
- 'pl' => ['Polish', 'pl', 'qwerty/pl.kmap.gz', 'pl', undef],
- 'pt' => ['Portuguese', 'pt', 'qwerty/pt-latin1.kmap.gz', 'pt', 'nodeadkeys'],
- 'pt-br' => ['Brazil-Portuguese', 'pt-br', 'qwerty/br-latin1.kmap.gz', 'br', 'nodeadkeys'],
- #'ru' => ['Russian', 'ru', 'qwerty/ru.kmap.gz', 'ru', undef], # dont know?
- 'si' => ['Slovenian', 'sl', 'qwertz/slovene.kmap.gz', 'si', undef],
- #'sv' => [], Swedish ?
- #'th' => [],
- #'tr' => [],
- };
+ return $keymaphash;
+}
+
+sub kvmkeymaplist {
+ return $kvmkeymaparray;
}
sub extract_param {
my $outfh = IO::File->new ($filename, O_WRONLY|O_CREAT|O_EXCL, $perm) ||
die "unable to create output file '$filename' - $!\n";
- chown $wwwid, $outfh;
+ chown $wwwid, -1, $outfh;
return $outfh;
};
return Encode::decode("utf8", uri_unescape($data));
}
+sub decode_utf8_parameters {
+ my ($param) = @_;
+
+ foreach my $p (qw(comment description firstname lastname)) {
+ $param->{$p} = decode('utf8', $param->{$p}) if $param->{$p};
+ }
+
+ return $param;
+}
+
sub random_ether_addr {
my $rand = Digest::SHA1::sha1_hex(rand(), time());
return $mac;
}
+sub shellquote {
+ my $str = shift;
+
+ return String::ShellQuote::shell_quote($str);
+}
+
+sub cmd2string {
+ my ($cmd) = @_;
+
+ die "no arguments" if !$cmd;
+
+ return $cmd if !ref($cmd);
+
+ my @qa = ();
+ foreach my $arg (@$cmd) { push @qa, shellquote($arg); }
+
+ return join (' ', @qa);
+}
+
+# split an shell argument string into an array,
+sub split_args {
+ my ($str) = @_;
+
+ return $str ? [ Text::ParseWords::shellwords($str) ] : [];
+}
+
+sub dump_logfile {
+ my ($filename, $start, $limit) = @_;
+
+ my $lines = [];
+ my $count = 0;
+
+ my $fh = IO::File->new($filename, "r");
+ if (!$fh) {
+ $count++;
+ push @$lines, { n => $count, t => "unable to open file - $!"};
+ return ($count, $lines);
+ }
+
+ $start = 0 if !$start;
+ $limit = 50 if !$limit;
+
+ my $line;
+ while (defined($line = <$fh>)) {
+ next if $count++ < $start;
+ next if $limit <= 0;
+ chomp $line;
+ push @$lines, { n => $count, t => $line};
+ $limit--;
+ }
+
+ close($fh);
+
+ # HACK: ExtJS store.guaranteeRange() does not like empty array
+ # so we add a line
+ if (!$count) {
+ $count++;
+ push @$lines, { n => $count, t => "no content"};
+ }
+
+ return ($count, $lines);
+}
+
1;
projects / pve-common.git / blobdiff