implement afterfork callback

[pve-common.git] / data / PVE / Tools.pm

diff --git a/data/PVE/Tools.pm b/data/PVE/Tools.pm
index 319961651669136c427dde07c0a77de9e908203f..20fc1ea3ad0f73c1ee4f03b8d6b93586833b6e5b 100644 (file)
--- a/data/PVE/Tools.pm
+++ b/data/PVE/Tools.pm
@@ -1,18 +1,19 @@
 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;
 
@@ -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
@@ -89,7 +92,15 @@ sub lock_file {
 
         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";
             }
@@ -170,7 +181,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;
 }
@@ -204,7 +215,12 @@ sub run_command {
 
     if (!ref($cmd)) {
        $cmdstr = $cmd;
-       $cmd = [ $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);
     }
@@ -220,6 +236,7 @@ sub run_command {
     my $logfunc;
     my $input;
     my $output;
+    my $afterfork;
 
     eval {
 
@@ -227,7 +244,7 @@ sub run_command {
            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') {
@@ -240,6 +257,8 @@ sub run_command {
                $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";
            }
@@ -300,6 +319,8 @@ sub run_command {
        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;
@@ -417,6 +438,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";
@@ -551,7 +573,7 @@ my $keymaphash =  {
     'si'     => ['Slovenian', 'sl', 'qwertz/slovene.kmap.gz', 'si', undef],
     'se'     => ['Swedish', 'sv', 'qwerty/se-latin1.kmap.gz', 'se', 'nodeadkeys'],
     #'th'     => [],
-    #'tr'     => [],
+    'tr'     => ['Turkish', 'tr', 'qwerty/trq.kmap.gz', 'tr', undef],
 };
 
 my $kvmkeymaparray = [];
@@ -576,6 +598,30 @@ 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++) {
@@ -648,16 +694,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 {
@@ -741,7 +787,7 @@ sub decode_utf8_parameters {
 
 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++) {
@@ -825,4 +871,34 @@ sub dump_logfile {
     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;