X-Git-Url: https://git.proxmox.com/?p=pve-common.git;a=blobdiff_plain;f=data%2FPVE%2FTools.pm;h=85b32305e85c811885c4561e68e8507ad57d94b1;hp=b991ba5afef2a2592d6519fe05057f6d5fffbaf7;hb=3250f5c79906762177bc45dd9f9400fb910bbc6b;hpb=2b8e0f12c6c07e959362a48c89d498dac07e04a3

diff --git a/data/PVE/Tools.pm b/data/PVE/Tools.pm
index b991ba5..85b3230 100644
--- a/data/PVE/Tools.pm
+++ b/data/PVE/Tools.pm
@@ -35,45 +35,78 @@ my $pvetaskdir = "$pvelogdir/tasks";
 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 = $@;
+
+    alarm($prev_alarm) if defined($prev_alarm);
+
+    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.
 
-        local $SIG{ALRM} = sub { die "got timeout (can't lock '$filename')\n"; };
+my $lock_handles =  {};
+
+sub lock_file {
+    my ($filename, $timeout, $code, @param) = @_;
 
-        alarm ($timeout);
+    $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};
@@ -167,10 +200,14 @@ sub run_command {
     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;
@@ -178,12 +215,13 @@ sub run_command {
     my $oldtimeout;
     my $pid;
 
+    my $outfunc;
+    my $errfunc;
+    my $logfunc;
+    my $input;
+    my $output;
+
     eval {
-	my $input;
-	my $output;
-	my $outfunc;
-	my $errfunc;
-	my $logfunc;
 
 	foreach my $p (keys %param) {
 	    if ($p eq 'timeout') {
@@ -192,10 +230,6 @@ sub run_command {
 		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') {
@@ -211,6 +245,20 @@ sub run_command {
 	    }
 	}
 
+	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();
@@ -353,7 +401,9 @@ sub run_command {
 
     alarm(0);
 
-    print STDERR "$laststderr\n" if $laststderr;
+    if ($errmsg && $laststderr) {
+	&$errfunc(undef); # flush laststderr
+    }
 
     umask ($old_umask) if defined($old_umask);
 
@@ -404,6 +454,8 @@ sub trim {
 sub template_replace {
     my ($tmpl, $data) = @_;
 
+    return $tmpl if !$tmpl;
+ 
     my $res = '';
     while ($tmpl =~ m/([^{]+)?({([^}]+)})?/g) {
 	$res .= $1 if $1;
@@ -467,41 +519,52 @@ sub debmirrors {
     };
 }
 
+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 {
@@ -666,6 +729,16 @@ sub decode_text {
     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());
@@ -695,6 +768,19 @@ sub shellquote {
     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) = @_;
@@ -702,4 +788,41 @@ sub split_args {
     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;