package PVE::Tools;
use strict;
-use POSIX;
+use POSIX qw(EINTR);
use IO::Socket::INET;
use IO::Select;
use File::Basename;
use File::Path qw(make_path);
use IO::File;
+use IO::Dir;
use IPC::Open3;
use Fcntl qw(:DEFAULT :flock);
use base 'Exporter';
use URI::Escape;
use Encode;
-use Digest::SHA1;
+use Digest::SHA;
use Text::ParseWords;
use String::ShellQuote;
file_set_contents
file_get_contents
file_read_firstline
+dir_glob_regex
+dir_glob_foreach
split_list
template_replace
safe_print
if (!flock ($lock_handles->{$$}->{$filename}, LOCK_EX|LOCK_NB)) {
print STDERR "trying to aquire lock...";
- if (!flock ($lock_handles->{$$}->{$filename}, LOCK_EX)) {
+ my $success;
+ while(1) {
+ $success = flock($lock_handles->{$$}->{$filename}, LOCK_EX);
+ # try again on EINTR (see bug #273)
+ if ($success || ($! != EINTR)) {
+ last;
+ }
+ }
+ if (!$success) {
print STDERR " failed\n";
die "can't aquire lock - $!\n";
}
my $fh = IO::File->new ($filename, "r");
return undef if !$fh;
my $res = <$fh>;
- chomp $res;
+ chomp $res if $res;
$fh->close;
return $res;
}
my ($cmd, %param) = @_;
my $old_umask;
+ my $cmdstr;
- $cmd = [ $cmd ] if !ref($cmd);
-
- my $cmdstr = cmd2string($cmd);
+ if (!ref($cmd)) {
+ $cmdstr = $cmd;
+ if ($cmd =~ m/|/) {
+ # see 'man bash' for option pipefail
+ $cmd = [ '/bin/bash', '-c', "set -o pipefail && $cmd" ];
+ } else {
+ $cmd = [ $cmd ];
+ }
+ } else {
+ $cmdstr = cmd2string($cmd);
+ }
my $errmsg;
my $laststderr;
my $logfunc;
my $input;
my $output;
+ my $afterfork;
eval {
if ($p eq 'timeout') {
$timeout = $param{$p};
} elsif ($p eq 'umask') {
- umask($param{$p});
+ $old_umask = umask($param{$p});
} elsif ($p eq 'errmsg') {
$errmsg = $param{$p};
} elsif ($p eq 'input') {
$errfunc = $param{$p};
} elsif ($p eq 'logfunc') {
$logfunc = $param{$p};
+ } elsif ($p eq 'afterfork') {
+ $afterfork = $param{$p};
} else {
die "got unknown parameter '$p' for run_command\n";
}
local $SIG{ALRM} = sub { die "got timeout\n"; } if $timeout;
$oldtimeout = alarm($timeout) if $timeout;
+ &$afterfork() if $afterfork;
+
if (ref($writer)) {
print $writer $input if defined $input;
close $writer;
}
if ($errmsg) {
+ $err =~ s/^usermod:\s*// if $cmdstr =~ m|^(\S+/)?usermod\s|;
die "$errmsg: $err";
} else {
die "command '$cmdstr' failed: $err";
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],
+ 'se' => ['Swedish', 'sv', 'qwerty/se-latin1.kmap.gz', 'se', 'nodeadkeys'],
+ #'th' => [],
+ 'tr' => ['Turkish', 'tr', 'qwerty/trq.kmap.gz', 'tr', undef],
+};
+
+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 {
return $res;
}
+# Note: we use this to wait until vncterm is ready
+sub wait_for_vnc_port {
+ my ($port, $timeout) = @_;
+
+ $timeout = 5 if !$timeout;
+
+ for (my $i = 0; $i < $timeout; $i++) {
+ if (my $fh = IO::File->new ("/proc/net/tcp", "r")) {
+ while (defined (my $line = <$fh>)) {
+ if ($line =~ m/^\s*\d+:\s+([0-9A-Fa-f]{8}):([0-9A-Fa-f]{4})\s/) {
+ if ($port == hex($2)) {
+ close($fh);
+ return 1;
+ }
+ }
+ }
+ close($fh);
+ }
+ sleep(1);
+ }
+
+ return undef;
+}
+
sub next_vnc_port {
for (my $p = 5900; $p < 6000; $p++) {
my $filename;
# "UPID:$node:$pid:$pstart:$startime:$dtype:$id:$user"
- if ($upid =~ m/^UPID:([A-Za-z][[:alnum:]\-]*[[:alnum:]]+):([0-9A-Fa-f]{8}):([0-9A-Fa-f]{8}):([0-9A-Fa-f]{8}):([^:\s]+):([^:\s]*):([^:\s]+):$/) {
+ if ($upid =~ m/^UPID:([a-zA-Z0-9]([a-zA-Z0-9\-]*[a-zA-Z0-9])?):([0-9A-Fa-f]{8}):([0-9A-Fa-f]{8}):([0-9A-Fa-f]{8}):([^:\s]+):([^:\s]*):([^:\s]+):$/) {
$res->{node} = $1;
- $res->{pid} = hex($2);
- $res->{pstart} = hex($3);
- $res->{starttime} = hex($4);
- $res->{type} = $5;
- $res->{id} = $6;
- $res->{user} = $7;
-
- my $subdir = substr($4, 7, 8);
+ $res->{pid} = hex($3);
+ $res->{pstart} = hex($4);
+ $res->{starttime} = hex($5);
+ $res->{type} = $6;
+ $res->{id} = $7;
+ $res->{user} = $8;
+
+ my $subdir = substr($5, 7, 8);
$filename = "$pvetaskdir/$subdir/$upid";
} else {
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());
+ my $rand = Digest::SHA::sha1_hex(rand(), time());
my $mac = '';
for (my $i = 0; $i < 6; $i++) {
return ($count, $lines);
}
+sub dir_glob_regex {
+ my ($dir, $regex) = @_;
+
+ my $dh = IO::Dir->new ($dir);
+ return wantarray ? () : undef if !$dh;
+
+ while (defined(my $tmp = $dh->read)) {
+ if (my @res = $tmp =~ m/^($regex)$/) {
+ $dh->close;
+ return wantarray ? @res : $tmp;
+ }
+ }
+ $dh->close;
+
+ return wantarray ? () : undef;
+}
+
+sub dir_glob_foreach {
+ my ($dir, $regex, $func) = @_;
+
+ my $dh = IO::Dir->new ($dir);
+ if (defined $dh) {
+ while (defined(my $tmp = $dh->read)) {
+ if (my @res = $tmp =~ m/^($regex)$/) {
+ &$func (@res);
+ }
+ }
+ }
+}
+
1;
projects / pve-common.git / blobdiff