package PVE::Tools;
use strict;
+use warnings;
use POSIX qw(EINTR);
use IO::Socket::INET;
use IO::Select;
use Digest::SHA;
use Text::ParseWords;
use String::ShellQuote;
+use Time::HiRes qw(usleep gettimeofday tv_interval);
our @EXPORT_OK = qw(
+$IPV6RE
+$IPV4RE
lock_file
lock_file_full
run_command
mkdir $pvelogdir;
mkdir $pvetaskdir;
+my $IPV4OCTET = "(?:25[0-5]|(?:[1-9]|1[0-9]|2[0-4])?[0-9])";
+our $IPV4RE = "(?:(?:$IPV4OCTET\\.){3}$IPV4OCTET)";
+my $IPV6H16 = "(?:[0-9a-fA-F]{1,4})";
+my $IPV6LS32 = "(?:(?:$IPV4RE|$IPV6H16:$IPV6H16))";
+
+our $IPV6RE = "(?:" .
+ "(?:(?:" . "(?:$IPV6H16:){6})$IPV6LS32)|" .
+ "(?:(?:" . "::(?:$IPV6H16:){5})$IPV6LS32)|" .
+ "(?:(?:(?:" . "$IPV6H16)?::(?:$IPV6H16:){4})$IPV6LS32)|" .
+ "(?:(?:(?:(?:$IPV6H16:){0,1}$IPV6H16)?::(?:$IPV6H16:){3})$IPV6LS32)|" .
+ "(?:(?:(?:(?:$IPV6H16:){0,2}$IPV6H16)?::(?:$IPV6H16:){2})$IPV6LS32)|" .
+ "(?:(?:(?:(?:$IPV6H16:){0,3}$IPV6H16)?::(?:$IPV6H16:){1})$IPV6LS32)|" .
+ "(?:(?:(?:(?:$IPV6H16:){0,4}$IPV6H16)?::" . ")$IPV6LS32)|" .
+ "(?:(?:(?:(?:$IPV6H16:){0,5}$IPV6H16)?::" . ")$IPV6H16)|" .
+ "(?:(?:(?:(?:$IPV6H16:){0,6}$IPV6H16)?::" . ")))";
+
sub run_with_timeout {
my ($timeout, $code, @param) = @_;
'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'],
return $res;
}
-# Note: we use this to wait until vncterm is ready
+# Note: we use this to wait until vncterm/spiceterm is ready
sub wait_for_vnc_port {
my ($port, $timeout) = @_;
$timeout = 5 if !$timeout;
+ my $sleeptime = 0;
+ my $starttime = [gettimeofday];
+ my $elapsed;
- for (my $i = 0; $i < $timeout; $i++) {
+ while (($elapsed = tv_interval($starttime)) < $timeout) {
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/) {
}
close($fh);
}
- sleep(1);
+ $sleeptime += 100000 if $sleeptime < 1000000;
+ usleep($sleeptime);
}
return undef;
return next_unused_port(5900, 6000);
}
+sub next_spice_port {
+ return next_unused_port(61000, 61099);
+}
+
# 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"
sub upid_encode {
my $d = shift;
+ # 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},
$d->{user});
my $filename;
# "UPID:$node:$pid:$pstart:$startime:$dtype:$id:$user"
- 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]+):$/) {
+ # Note: allow up to 9 characters for pstart (work until 20 years uptime)
+ 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,9}):([0-9A-Fa-f]{8}):([^:\s]+):([^:\s]*):([^:\s]+):$/) {
$res->{node} = $1;
$res->{pid} = hex($3);
$res->{pstart} = hex($4);
sub random_ether_addr {
- my $rand = Digest::SHA::sha1_hex(rand(), time());
+ my ($seconds, $microseconds) = gettimeofday;
+
+ my $rand = Digest::SHA::sha1_hex($$, rand(), $seconds, $microseconds);
my $mac = '';
for (my $i = 0; $i < 6; $i++) {