X-Git-Url: https://git.proxmox.com/?p=pve-common.git;a=blobdiff_plain;f=src%2FPVE%2FTools.pm;h=69c87304396129fe7dc7d70847299fb0db256b84;hp=341f0ac1cdc63c4d18d05e9da011c13e5c927dd7;hb=3c476ed580e5a934ce4d29a63612364c909fbd83;hpb=77b2b96ffcc973cb070325305ce2368fb6658f4a

diff --git a/src/PVE/Tools.pm b/src/PVE/Tools.pm
index 341f0ac..69c8730 100644
--- a/src/PVE/Tools.pm
+++ b/src/PVE/Tools.pm
@@ -32,10 +32,10 @@ no warnings 'portable'; # Support for 64-bit ints required
 our @EXPORT_OK = qw(
 $IPV6RE
 $IPV4RE
-lock_file 
+lock_file
 lock_file_full
-run_command 
-file_set_contents 
+run_command
+file_set_contents
 file_get_contents
 file_read_firstline
 dir_glob_regex
@@ -224,7 +224,7 @@ sub file_set_contents {
     if (!rename($tmpname, $filename)) {
 	my $msg = "close (rename) atomic file '$filename' failed: $!\n";
 	unlink $tmpname;
-	die $msg;	
+	die $msg;
     }
 }
 
@@ -234,7 +234,7 @@ sub file_get_contents {
     my $fh = IO::File->new($filename, "r") ||
 	die "can't open '$filename' - $!\n";
 
-    my $content = safe_read_from($fh, $max);
+    my $content = safe_read_from($fh, $max, 0, $filename);
 
     close $fh;
 
@@ -259,22 +259,24 @@ sub file_read_firstline {
 }
 
 sub safe_read_from {
-    my ($fh, $max, $oneline) = @_;
+    my ($fh, $max, $oneline, $filename) = @_;
 
     $max = 32768 if !$max;
 
+    my $subject = defined($filename) ? "file '$filename'" : 'input';
+
     my $br = 0;
     my $input = '';
     my $count;
     while ($count = sysread($fh, $input, 8192, $br)) {
 	$br += $count;
-	die "input too long - aborting\n" if $br > $max;
+	die "$subject too long - aborting\n" if $br > $max;
 	if ($oneline && $input =~ m/^(.*)\n/) {
 	    $input = $1;
 	    last;
 	}
-    } 
-    die "unable to read input - $!\n" if !defined($count);
+    }
+    die "unable to read $subject - $!\n" if !defined($count);
 
     return $input;
 }
@@ -387,7 +389,7 @@ sub run_command {
 			print STDERR "$laststderr\n" if $laststderr;
 		    }
 		}
-		$laststderr = shift; 
+		$laststderr = shift;
 	    };
 	}
 
@@ -396,8 +398,8 @@ sub run_command {
 	my $error  = IO::File->new();
 
 	# try to avoid locale related issues/warnings
-	my $lang = $param{lang} || 'C'; 
- 
+	my $lang = $param{lang} || 'C';
+
 	my $orig_pid = $$;
 
 	eval {
@@ -423,8 +425,8 @@ sub run_command {
 	# catch exec errors
 	if ($orig_pid != $$) {
 	    warn "ERROR: $err";
-	    POSIX::_exit (1); 
-	    kill ('KILL', $$); 
+	    POSIX::_exit (1);
+	    kill ('KILL', $$);
 	}
 
 	die $err if $err;
@@ -512,7 +514,7 @@ sub run_command {
 	&$logfunc($errlog) if $logfunc && $errlog;
 
 	waitpid ($pid, 0);
-  
+
 	if ($? == -1) {
 	    die "failed to execute\n";
 	} elsif (my $sig = ($? & 127)) {
@@ -565,7 +567,7 @@ sub split_list {
     my $listtxt = shift || '';
 
     return split (/\0/, $listtxt) if $listtxt =~ m/\0/;
-    
+
     $listtxt =~ s/[,;]/ /g;
     $listtxt =~ s/^\s+//;
 
@@ -581,7 +583,7 @@ sub trim {
 
     $txt =~ s/^\s+//;
     $txt =~ s/\s+$//;
-    
+
     return $txt;
 }
 
@@ -590,7 +592,7 @@ sub template_replace {
     my ($tmpl, $data) = @_;
 
     return $tmpl if !$tmpl;
- 
+
     my $res = '';
     while ($tmpl =~ m/([^{]+)?({([^}]+)})?/g) {
 	$res .= $1 if $1;
@@ -657,7 +659,7 @@ 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' ], 
+    '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', undef],
     'en-us'  => ['U.S. English', 'en-us', 'qwerty/us-latin1.kmap.gz',  'us', undef ],
     'es'     => ['Spanish', 'es', 'qwerty/es.kmap.gz', 'es', 'nodeadkeys'],
@@ -678,7 +680,7 @@ my $keymaphash =  {
     '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'], 
+    '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'],
@@ -762,11 +764,11 @@ sub next_unused_port {
 		    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++) {
@@ -786,20 +788,20 @@ sub next_unused_port {
 		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);
+    my $p = lock_file('/var/lock/pve-ports.lck', 10, $code);
     die $@ if $@;
-   
+
     die "unable to find free port (${range_start}-${range_end})\n" if !$p;
 
     return $p;
@@ -820,7 +822,7 @@ sub next_spice_port {
     return next_unused_port(61000, 61099, $family);
 }
 
-# NOTE: NFS syscall can't be interrupted, so alarm does 
+# NOTE: NFS syscall can't be interrupted, so alarm does
 # not work to provide timeouts.
 # from 'man nfs': "Only SIGKILL can interrupt a pending NFS operation"
 # So fork() before using Filesys::Df
@@ -873,7 +875,7 @@ sub df {
 
 # UPID helper
 # We use this to uniquely identify a process.
-# An 'Unique Process ID' has the following format: 
+# An 'Unique Process ID' has the following format:
 # "UPID:$node:$pid:$pstart:$startime:$dtype:$id:$user"
 
 sub upid_encode {
@@ -881,8 +883,8 @@ sub upid_encode {
 
     # Note: pstart can be > 32bit if uptime > 497 days, so this can result in
     # more that 8 characters for pstart
-    return sprintf("UPID:%s:%08X:%08X:%08X:%s:%s:%s:", $d->{node}, $d->{pid}, 
-		   $d->{pstart}, $d->{starttime}, $d->{type}, $d->{id}, 
+    return sprintf("UPID:%s:%08X:%08X:%08X:%s:%s:%s:", $d->{node}, $d->{pid},
+		   $d->{pstart}, $d->{starttime}, $d->{type}, $d->{id},
 		   $d->{user});
 }
 
@@ -917,7 +919,7 @@ sub upid_decode {
 sub upid_open {
     my ($upid) = @_;
 
-    my ($task, $filename) = upid_decode($upid); 
+    my ($task, $filename) = upid_decode($upid);
 
     my $dirname = dirname($filename);
     make_path($dirname);
@@ -926,7 +928,7 @@ sub upid_open {
 	die "getpwnam failed";
 
     my $perm = 0640;
- 
+
     my $outfh = IO::File->new ($filename, O_WRONLY|O_CREAT|O_EXCL, $perm) ||
 	die "unable to create output file '$filename' - $!\n";
     chown $wwwid, -1, $outfh;
@@ -960,7 +962,7 @@ sub upid_read_status {
     return "unable to read tail (got $br bytes)";
 }
 
-# useful functions to store comments in config files 
+# useful functions to store comments in config files
 sub encode_text {
     my ($text) = @_;
 
@@ -1035,7 +1037,7 @@ sub dump_logfile {
     my $count = 0;
 
     my $fh = IO::File->new($filename, "r");
-    if (!$fh) { 
+    if (!$fh) {
 	$count++;
 	push @$lines, { n => $count, t => "unable to open file - $!"};
 	return ($count, $lines);
@@ -1083,7 +1085,7 @@ sub dump_journal {
 
     my $lines = [];
     my $count = 0;
-    
+
     $start = 0 if !$start;
     $limit = 50 if !$limit;
 
@@ -1117,8 +1119,8 @@ sub dir_glob_regex {
 
     my $dh = IO::Dir->new ($dir);
     return wantarray ? () : undef if !$dh;
-  
-    while (defined(my $tmp = $dh->read)) { 
+
+    while (defined(my $tmp = $dh->read)) {
 	if (my @res = $tmp =~ m/^($regex)$/) {
 	    $dh->close;
 	    return wantarray ? @res : $tmp;
@@ -1139,7 +1141,7 @@ sub dir_glob_foreach {
 		&$func (@res);
 	    }
 	}
-    } 
+    }
 }
 
 sub assert_if_modified {