X-Git-Url: https://git.proxmox.com/?p=pve-common.git;a=blobdiff_plain;f=data%2FPVE%2FTools.pm;h=0961e9289a690caa4f4e65a6bd54309ccca6118d;hp=12b5ba291045829eda74f9af967bb462dd188668;hb=5a5ca434b2a25edcf9fe89b8dcadf34e1dc1d967;hpb=568ba6a4711f8e89e92ac67fc53e9149703adb08 diff --git a/data/PVE/Tools.pm b/data/PVE/Tools.pm index 12b5ba2..0961e92 100644 --- a/data/PVE/Tools.pm +++ b/data/PVE/Tools.pm @@ -1,12 +1,14 @@ package PVE::Tools; use strict; -use POSIX; +use warnings; +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'; @@ -18,10 +20,13 @@ use String::ShellQuote; our @EXPORT_OK = qw( lock_file +lock_file_full run_command file_set_contents file_get_contents file_read_firstline +dir_glob_regex +dir_glob_foreach split_list template_replace safe_print @@ -76,20 +81,30 @@ sub run_with_timeout { my $lock_handles = {}; -sub lock_file { - my ($filename, $timeout, $code, @param) = @_; +sub lock_file_full { + my ($filename, $timeout, $shared, $code, @param) = @_; $timeout = 10 if !$timeout; + my $mode = $shared ? LOCK_SH : LOCK_EX; + my $lock_func = sub { if (!$lock_handles->{$$}->{$filename}) { $lock_handles->{$$}->{$filename} = new IO::File (">>$filename") || die "can't open file - $!\n"; } - if (!flock ($lock_handles->{$$}->{$filename}, LOCK_EX|LOCK_NB)) { + if (!flock ($lock_handles->{$$}->{$filename}, $mode|LOCK_NB)) { print STDERR "trying to aquire lock..."; - if (!flock ($lock_handles->{$$}->{$filename}, LOCK_EX)) { + my $success; + while(1) { + $success = flock($lock_handles->{$$}->{$filename}, $mode); + # try again on EINTR (see bug #273) + if ($success || ($! != EINTR)) { + last; + } + } + if (!$success) { print STDERR " failed\n"; die "can't aquire lock - $!\n"; } @@ -124,6 +139,13 @@ sub lock_file { return $res; } + +sub lock_file { + my ($filename, $timeout, $code, @param) = @_; + + return lock_file_full($filename, $timeout, 0, $code, @param); +} + sub file_set_contents { my ($filename, $data, $perm) = @_; @@ -170,7 +192,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 +226,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 +247,7 @@ sub run_command { my $logfunc; my $input; my $output; + my $afterfork; eval { @@ -227,7 +255,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 +268,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 +330,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; @@ -524,8 +556,8 @@ 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' ], + 'en-gb' => ['United Kingdom', 'en-gb', 'qwerty/uk.kmap.gz' , 'gb', undef], + 'en-us' => ['U.S. English', 'en-us', 'qwerty/us-latin1.kmap.gz', 'us', undef ], 'es' => ['Spanish', 'es', 'qwerty/es.kmap.gz', 'es', 'nodeadkeys'], #'et' => [], # Ethopia or Estonia ?? 'fi' => ['Finnish', 'fi', 'qwerty/fi-latin1.kmap.gz', 'fi', 'nodeadkeys'], @@ -552,7 +584,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 = []; @@ -577,24 +609,102 @@ sub extract_param { return $res; } -sub next_vnc_port { - - for (my $p = 5900; $p < 6000; $p++) { +# Note: we use this to wait until vncterm is ready +sub wait_for_vnc_port { + my ($port, $timeout) = @_; - my $sock = IO::Socket::INET->new (Listen => 5, - LocalAddr => 'localhost', - LocalPort => $p, - ReuseAddr => 1, - Proto => 0); + $timeout = 5 if !$timeout; - if ($sock) { - close ($sock); - return $p; + 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); } - die "unable to find free vnc port"; -}; + return undef; +} + +sub next_unused_port { + my ($range_start, $range_end) = @_; + + # We use a file to register allocated ports. + # Those registrations expires after $expiretime. + # We use this to avoid race conditions between + # allocation and use of ports. + + my $filename = "/var/tmp/pve-reserved-ports"; + + my $code = sub { + + my $expiretime = 5; + my $ctime = time(); + + my $ports = {}; + + if (my $fh = IO::File->new ($filename, "r")) { + while (my $line = <$fh>) { + if ($line =~ m/^(\d+)\s(\d+)$/) { + my ($port, $timestamp) = ($1, $2); + if (($timestamp + $expiretime) > $ctime) { + $ports->{$port} = $timestamp; # not expired + } + } + } + } + + my $newport; + + for (my $p = $range_start; $p < $range_end; $p++) { + next if $ports->{$p}; # reserved + + my $sock = IO::Socket::INET->new(Listen => 5, + LocalAddr => 'localhost', + LocalPort => $p, + ReuseAddr => 1, + Proto => 0); + + if ($sock) { + close($sock); + $newport = $p; + $ports->{$p} = $ctime; + last; + } + } + + my $data = ""; + foreach my $p (keys %$ports) { + $data .= "$p $ports->{$p}\n"; + } + + file_set_contents($filename, $data); + + return $newport; + }; + + my $p = lock_file($filename, 10, $code); + die $@ if $@; + + die "unable to find free port (${range_start}-${range_end})\n" if !$p; + + return $p; +} + +sub next_migrate_port { + return next_unused_port(60000, 60010); +} + +sub next_vnc_port { + return next_unused_port(5900, 6000); +} # NOTE: NFS syscall can't be interrupted, so alarm does # not work to provide timeouts. @@ -649,16 +759,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 { @@ -695,7 +805,7 @@ sub upid_read_status { my ($task, $filename) = upid_decode($upid); my $fh = IO::File->new($filename, "r"); return "unable to open file - $!" if !$fh; - my $maxlen = 1024; + my $maxlen = 4096; sysseek($fh, -$maxlen, 2); my $readbuf = ''; my $br = sysread($fh, $readbuf, $maxlen); @@ -826,4 +936,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;