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

diff --git a/data/PVE/Tools.pm b/data/PVE/Tools.pm
index b991ba5..f962da5 100644
--- a/data/PVE/Tools.pm
+++ b/data/PVE/Tools.pm
@@ -7,12 +7,13 @@ 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;
 
@@ -22,6 +23,8 @@ run_command
 file_set_contents 
 file_get_contents
 file_read_firstline
+dir_glob_regex
+dir_glob_foreach
 split_list
 template_replace
 safe_print
@@ -35,45 +38,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;
+}
 
-        local $SIG{ALRM} = sub { die "got timeout (can't lock '$filename')\n"; };
+# flock: we use one file handle per process, so lock file
+# can be called multiple times and succeeds for the same process.
 
-        alarm ($timeout);
+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};
@@ -137,7 +173,7 @@ sub file_read_firstline {
     my $fh = IO::File->new ($filename, "r");
     return undef if !$fh;
     my $res = <$fh>;
-    chomp $res;
+    chomp $res if $res;
     $fh->close;
     return $res;
 }
@@ -167,10 +203,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,24 +218,21 @@ 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') {
 		$timeout = $param{$p};
 	    } elsif ($p eq 'umask') {
-		umask($param{$p});
+		$old_umask = 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 +248,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 +404,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);
 
@@ -367,6 +420,7 @@ sub run_command {
 	}
 
 	if ($errmsg) {
+	    $err =~ s/^usermod:\s*// if $cmdstr =~ m|^(\S+/)?usermod\s|;
 	    die "$errmsg: $err";
 	} else {
 	    die "command '$cmdstr' failed: $err";
@@ -404,6 +458,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 +523,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],
+    '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 {
@@ -585,16 +652,16 @@ sub upid_decode {
     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 {
@@ -666,9 +733,19 @@ 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());
+    my $rand = Digest::SHA::sha1_hex(rand(), time());
 
     my $mac = '';
     for (my $i = 0; $i < 6; $i++) {
@@ -695,6 +772,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 +792,71 @@ 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);
+}
+
+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;