data/PVE/Tools.pm

   1 package PVE::Tools;
   2
   3 use strict;
   4 use POSIX;
   5 use IO::Socket::INET;
   6 use IO::Select;
   7 use File::Basename;
   8 use File::Path qw(make_path);
   9 use IO::File;
  10 use IPC::Open3;
  11 use Fcntl qw(:DEFAULT :flock);
  12 use base 'Exporter';
  13 use URI::Escape;
  14 use Encode;
  15 use Digest::SHA1;
  16 use Text::ParseWords;
  17
  18 our @EXPORT_OK = qw(
  19 lock_file
  20 run_command
  21 file_set_contents
  22 file_get_contents
  23 file_read_firstline
  24 split_list
  25 template_replace
  26 safe_print
  27 trim
  28 extract_param
  29 );
  30
  31 my $pvelogdir = "/var/log/pve";
  32 my $pvetaskdir = "$pvelogdir/tasks";
  33
  34 mkdir $pvelogdir;
  35 mkdir $pvetaskdir;
  36
  37 # flock: we use one file handle per process, so lock file
  38 # can be called multiple times and succeeds for the same process.
  39
  40 my $lock_handles =  {};
  41
  42 sub lock_file {
  43     my ($filename, $timeout, $code, @param) = @_;
  44
  45     my $res;
  46
  47     $timeout = 10 if !$timeout;
  48
  49     eval {
  50
  51         local $SIG{ALRM} = sub { die "got timeout (can't lock '$filename')\n"; };
  52
  53         alarm ($timeout);
  54
  55         if (!$lock_handles->{$$}->{$filename}) {
  56             $lock_handles->{$$}->{$filename} = new IO::File (">>$filename") ||
  57                 die "can't open lock file '$filename' - $!\n";
  58         }
  59
  60         if (!flock ($lock_handles->{$$}->{$filename}, LOCK_EX|LOCK_NB)) {
  61             print STDERR "trying to aquire lock...";
  62             if (!flock ($lock_handles->{$$}->{$filename}, LOCK_EX)) {
  63                 print STDERR " failed\n";
  64                 die "can't aquire lock for '$filename' - $!\n";
  65             }
  66             print STDERR " OK\n";
  67         }
  68         alarm (0);
  69
  70         $res = &$code(@param);
  71     };
  72
  73     my $err = $@;
  74
  75     alarm (0);
  76
  77     if ($lock_handles->{$$}->{$filename}) {
  78         my $fh = $lock_handles->{$$}->{$filename};
  79         $lock_handles->{$$}->{$filename} = undef;
  80         close ($fh);
  81     }
  82
  83     if ($err) {
  84         $@ = $err;
  85         return undef;
  86     }
  87
  88     $@ = undef;
  89
  90     return $res;
  91 }
  92
  93 sub file_set_contents {
  94     my ($filename, $data, $perm)  = @_;
  95
  96     $perm = 0644 if !defined($perm);
  97
  98     my $tmpname = "$filename.tmp.$$";
  99
 100     eval {
 101         my $fh = IO::File->new($tmpname, O_WRONLY|O_CREAT, $perm);
 102         die "unable to open file '$tmpname' - $!\n" if !$fh;
 103         die "unable to write '$tmpname' - $!\n" unless print $fh $data;
 104         die "closing file '$tmpname' failed - $!\n" unless close $fh;
 105     };
 106     my $err = $@;
 107
 108     if ($err) {
 109         unlink $tmpname;
 110         die $err;
 111     }
 112
 113     if (!rename($tmpname, $filename)) {
 114         my $msg = "close (rename) atomic file '$filename' failed: $!\n";
 115         unlink $tmpname;
 116         die $msg;
 117     }
 118 }
 119
 120 sub file_get_contents {
 121     my ($filename, $max) = @_;
 122
 123     my $fh = IO::File->new($filename, "r") ||
 124         die "can't open '$filename' - $!\n";
 125
 126     my $content = safe_read_from($fh, $max);
 127
 128     close $fh;
 129
 130     return $content;
 131 }
 132
 133 sub file_read_firstline {
 134     my ($filename) = @_;
 135
 136     my $fh = IO::File->new ($filename, "r");
 137     return undef if !$fh;
 138     my $res = <$fh>;
 139     chomp $res;
 140     $fh->close;
 141     return $res;
 142 }
 143
 144 sub safe_read_from {
 145     my ($fh, $max, $oneline) = @_;
 146
 147     $max = 32768 if !$max;
 148
 149     my $br = 0;
 150     my $input = '';
 151     my $count;
 152     while ($count = sysread($fh, $input, 8192, $br)) {
 153         $br += $count;
 154         die "input too long - aborting\n" if $br > $max;
 155         if ($oneline && $input =~ m/^(.*)\n/) {
 156             $input = $1;
 157             last;
 158         }
 159     }
 160     die "unable to read input - $!\n" if !defined($count);
 161
 162     return $input;
 163 }
 164
 165 sub run_command {
 166     my ($cmd, %param) = @_;
 167
 168     my $old_umask;
 169
 170     $cmd = [ $cmd ] if !ref($cmd);
 171
 172     my $cmdstr = join (' ', @$cmd);
 173
 174     my $errmsg;
 175     my $laststderr;
 176     my $timeout;
 177     my $oldtimeout;
 178     my $pid;
 179
 180     eval {
 181         my $input;
 182         my $output;
 183         my $outfunc;
 184         my $errfunc;
 185         my $logfunc;
 186
 187         foreach my $p (keys %param) {
 188             if ($p eq 'timeout') {
 189                 $timeout = $param{$p};
 190             } elsif ($p eq 'umask') {
 191                 umask($param{$p});
 192             } elsif ($p eq 'errmsg') {
 193                 $errmsg = $param{$p};
 194                 $errfunc = sub {
 195                     print STDERR "$laststderr\n" if $laststderr;
 196                     $laststderr = shift;
 197                 };
 198             } elsif ($p eq 'input') {
 199                 $input = $param{$p};
 200             } elsif ($p eq 'output') {
 201                 $output = $param{$p};
 202             } elsif ($p eq 'outfunc') {
 203                 $outfunc = $param{$p};
 204             } elsif ($p eq 'errfunc') {
 205                 $errfunc = $param{$p};
 206             } elsif ($p eq 'logfunc') {
 207                 $logfunc = $param{$p};
 208             } else {
 209                 die "got unknown parameter '$p' for run_command\n";
 210             }
 211         }
 212
 213         my $reader = $output && $output =~ m/^>&/ ? $output : IO::File->new();
 214         my $writer = $input && $input =~ m/^<&/ ? $input : IO::File->new();
 215         my $error  = IO::File->new();
 216
 217         # try to avoid locale related issues/warnings
 218         my $lang = $param{lang} || 'C';
 219
 220         my $orig_pid = $$;
 221
 222         eval {
 223             local $ENV{LC_ALL} = $lang;
 224
 225             # suppress LVM warnings like: "File descriptor 3 left open";
 226             local $ENV{LVM_SUPPRESS_FD_WARNINGS} = "1";
 227
 228             $pid = open3($writer, $reader, $error, @$cmd) || die $!;
 229
 230             # if we pipe fron STDIN, open3 closes STDIN, so we we
 231             # a perl warning "Filehandle STDIN reopened as GENXYZ .. "
 232             # as soon as we open a new file.
 233             # to avoid that we open /dev/null
 234             if (!ref($writer) && !defined(fileno(STDIN))) {
 235                 POSIX::close(0);
 236                 open(STDIN, "</dev/null");
 237             }
 238         };
 239
 240         my $err = $@;
 241
 242         # catch exec errors
 243         if ($orig_pid != $$) {
 244             warn "ERROR: $err";
 245             POSIX::_exit (1);
 246             kill ('KILL', $$);
 247         }
 248
 249         die $err if $err;
 250
 251         local $SIG{ALRM} = sub { die "got timeout\n"; } if $timeout;
 252         $oldtimeout = alarm($timeout) if $timeout;
 253
 254         if (ref($writer)) {
 255             print $writer $input if defined $input;
 256             close $writer;
 257         }
 258
 259         my $select = new IO::Select;
 260         $select->add($reader) if ref($reader);
 261         $select->add($error);
 262
 263         my $outlog = '';
 264         my $errlog = '';
 265
 266         my $starttime = time();
 267
 268         while ($select->count) {
 269             my @handles = $select->can_read(1);
 270
 271             foreach my $h (@handles) {
 272                 my $buf = '';
 273                 my $count = sysread ($h, $buf, 4096);
 274                 if (!defined ($count)) {
 275                     my $err = $!;
 276                     kill (9, $pid);
 277                     waitpid ($pid, 0);
 278                     die $err;
 279                 }
 280                 $select->remove ($h) if !$count;
 281                 if ($h eq $reader) {
 282                     if ($outfunc || $logfunc) {
 283                         eval {
 284                             $outlog .= $buf;
 285                             while ($outlog =~ s/^([^\010\r\n]*)(\r|\n|(\010)+|\r\n)//s) {
 286                                 my $line = $1;
 287                                 &$outfunc($line) if $outfunc;
 288                                 &$logfunc($line) if $logfunc;
 289                             }
 290                         };
 291                         my $err = $@;
 292                         if ($err) {
 293                             kill (9, $pid);
 294                             waitpid ($pid, 0);
 295                             die $err;
 296                         }
 297                     } else {
 298                         print $buf;
 299                         *STDOUT->flush();
 300                     }
 301                 } elsif ($h eq $error) {
 302                     if ($errfunc || $logfunc) {
 303                         eval {
 304                             $errlog .= $buf;
 305                             while ($errlog =~ s/^([^\010\r\n]*)(\r|\n|(\010)+|\r\n)//s) {
 306                                 my $line = $1;
 307                                 &$errfunc($line) if $errfunc;
 308                                 &$logfunc($line) if $logfunc;
 309                             }
 310                         };
 311                         my $err = $@;
 312                         if ($err) {
 313                             kill (9, $pid);
 314                             waitpid ($pid, 0);
 315                             die $err;
 316                         }
 317                     } else {
 318                         print STDERR $buf;
 319                         *STDERR->flush();
 320                     }
 321                 }
 322             }
 323         }
 324
 325         &$outfunc($outlog) if $outfunc && $outlog;
 326         &$logfunc($outlog) if $logfunc && $outlog;
 327
 328         &$errfunc($errlog) if $errfunc && $errlog;
 329         &$logfunc($errlog) if $logfunc && $errlog;
 330
 331         waitpid ($pid, 0);
 332
 333         if ($? == -1) {
 334             die "failed to execute\n";
 335         } elsif (my $sig = ($? & 127)) {
 336             die "got signal $sig\n";
 337         } elsif (my $ec = ($? >> 8)) {
 338             if (!($ec == 24 && ($cmdstr =~ m|^(\S+/)?rsync\s|))) {
 339                 if ($errmsg && $laststderr) {
 340                     my $lerr = $laststderr;
 341                     $laststderr = undef;
 342                     die "$lerr\n";
 343                 }
 344                 die "exit code $ec\n";
 345             }
 346         }
 347
 348         alarm(0);
 349     };
 350
 351     my $err = $@;
 352
 353     alarm(0);
 354
 355     print STDERR "$laststderr\n" if $laststderr;
 356
 357     umask ($old_umask) if defined($old_umask);
 358
 359     alarm($oldtimeout) if $oldtimeout;
 360
 361     if ($err) {
 362         if ($pid && ($err eq "got timeout\n")) {
 363             kill (9, $pid);
 364             waitpid ($pid, 0);
 365             die "command '$cmdstr' failed: $err";
 366         }
 367
 368         if ($errmsg) {
 369             die "$errmsg: $err";
 370         } else {
 371             die "command '$cmdstr' failed: $err";
 372         }
 373     }
 374
 375     return undef;
 376 }
 377
 378 sub split_list {
 379     my $listtxt = shift || '';
 380
 381     return split (/\0/, $listtxt) if $listtxt =~ m/\0/;
 382
 383     $listtxt =~ s/[,;]/ /g;
 384     $listtxt =~ s/^\s+//;
 385
 386     my @data = split (/\s+/, $listtxt);
 387
 388     return @data;
 389 }
 390
 391 sub trim {
 392     my $txt = shift;
 393
 394     return $txt if !defined($txt);
 395
 396     $txt =~ s/^\s+//;
 397     $txt =~ s/\s+$//;
 398
 399     return $txt;
 400 }
 401
 402 # simple uri templates like "/vms/{vmid}"
 403 sub template_replace {
 404     my ($tmpl, $data) = @_;
 405
 406     my $res = '';
 407     while ($tmpl =~ m/([^{]+)?({([^}]+)})?/g) {
 408         $res .= $1 if $1;
 409         $res .= ($data->{$3} || '-') if $2;
 410     }
 411     return $res;
 412 }
 413
 414 sub safe_print {
 415     my ($filename, $fh, $data) = @_;
 416
 417     return if !$data;
 418
 419     my $res = print $fh $data;
 420
 421     die "write to '$filename' failed\n" if !$res;
 422 }
 423
 424 sub debmirrors {
 425
 426     return {
 427         'at' => 'ftp.at.debian.org',
 428         'au' => 'ftp.au.debian.org',
 429         'be' => 'ftp.be.debian.org',
 430         'bg' => 'ftp.bg.debian.org',
 431         'br' => 'ftp.br.debian.org',
 432         'ca' => 'ftp.ca.debian.org',
 433         'ch' => 'ftp.ch.debian.org',
 434         'cl' => 'ftp.cl.debian.org',
 435         'cz' => 'ftp.cz.debian.org',
 436         'de' => 'ftp.de.debian.org',
 437         'dk' => 'ftp.dk.debian.org',
 438         'ee' => 'ftp.ee.debian.org',
 439         'es' => 'ftp.es.debian.org',
 440         'fi' => 'ftp.fi.debian.org',
 441         'fr' => 'ftp.fr.debian.org',
 442         'gr' => 'ftp.gr.debian.org',
 443         'hk' => 'ftp.hk.debian.org',
 444         'hr' => 'ftp.hr.debian.org',
 445         'hu' => 'ftp.hu.debian.org',
 446         'ie' => 'ftp.ie.debian.org',
 447         'is' => 'ftp.is.debian.org',
 448         'it' => 'ftp.it.debian.org',
 449         'jp' => 'ftp.jp.debian.org',
 450         'kr' => 'ftp.kr.debian.org',
 451         'mx' => 'ftp.mx.debian.org',
 452         'nl' => 'ftp.nl.debian.org',
 453         'no' => 'ftp.no.debian.org',
 454         'nz' => 'ftp.nz.debian.org',
 455         'pl' => 'ftp.pl.debian.org',
 456         'pt' => 'ftp.pt.debian.org',
 457         'ro' => 'ftp.ro.debian.org',
 458         'ru' => 'ftp.ru.debian.org',
 459         'se' => 'ftp.se.debian.org',
 460         'si' => 'ftp.si.debian.org',
 461         'sk' => 'ftp.sk.debian.org',
 462         'tr' => 'ftp.tr.debian.org',
 463         'tw' => 'ftp.tw.debian.org',
 464         'gb' => 'ftp.uk.debian.org',
 465         'us' => 'ftp.us.debian.org',
 466     };
 467 }
 468
 469 sub kvmkeymaps {
 470     return {
 471         'dk'     => ['Danish', 'da', 'qwerty/dk-latin1.kmap.gz', 'dk', 'nodeadkeys'],
 472         'de'     => ['German', 'de', 'qwertz/de-latin1-nodeadkeys.kmap.gz', 'de', 'nodeadkeys' ],
 473         'de-ch'  => ['Swiss-German', 'de-ch', 'qwertz/sg-latin1.kmap.gz',  'ch', 'de_nodeadkeys' ],
 474         'en-gb'  => ['United Kingdom', 'en-gb', 'qwerty/uk.kmap.gz' , 'gb', 'intl' ],
 475         'en-us'  => ['U.S. English', 'en-us', 'qwerty/us-latin1.kmap.gz',  'us', 'intl' ],
 476         'es'     => ['Spanish', 'es', 'qwerty/es.kmap.gz', 'es', 'nodeadkeys'],
 477         #'et'     => [], # Ethopia or Estonia ??
 478         'fi'     => ['Finnish', 'fi', 'qwerty/fi-latin1.kmap.gz', 'fi', 'nodeadkeys'],
 479         #'fo'     => ['Faroe Islands', 'fo', ???, 'fo', 'nodeadkeys'],
 480         'fr'     => ['French', 'fr', 'azerty/fr-latin1.kmap.gz', 'fr', 'nodeadkeys'],
 481         'fr-be'  => ['Belgium-French', 'fr-be', 'azerty/be2-latin1.kmap.gz', 'be', 'nodeadkeys'],
 482         'fr-ca'  => ['Canada-French', 'fr-ca', 'qwerty/cf.kmap.gz', 'ca', 'fr-legacy'],
 483         'fr-ch'  => ['Swiss-French', 'fr-ch', 'qwertz/fr_CH-latin1.kmap.gz', 'ch', 'fr_nodeadkeys'],
 484         #'hr'     => ['Croatia', 'hr', 'qwertz/croat.kmap.gz', 'hr', ??], # latin2?
 485         'hu'     => ['Hungarian', 'hu', 'qwertz/hu.kmap.gz', 'hu', undef],
 486         'is'     => ['Icelandic', 'is', 'qwerty/is-latin1.kmap.gz', 'is', 'nodeadkeys'],
 487         'it'     => ['Italian', 'it', 'qwerty/it2.kmap.gz', 'it', 'nodeadkeys'],
 488         'jp'     => ['Japanese', 'ja', 'qwerty/jp106.kmap.gz', 'jp', undef],
 489         'lt'     => ['Lithuanian', 'lt', 'qwerty/lt.kmap.gz', 'lt', 'std'],
 490         #'lv'     => ['Latvian', 'lv', 'qwerty/lv-latin4.kmap.gz', 'lv', ??], # latin4 or latin7?
 491         'mk'     => ['Macedonian', 'mk', 'qwerty/mk.kmap.gz', 'mk', 'nodeadkeys'],
 492         'nl'     => ['Dutch', 'nl', 'qwerty/nl.kmap.gz', 'nl', undef],
 493         #'nl-be'  => ['Belgium-Dutch', 'nl-be', ?, ?, ?],
 494         'no'   => ['Norwegian', 'no', 'qwerty/no-latin1.kmap.gz', 'no', 'nodeadkeys'],
 495         'pl'     => ['Polish', 'pl', 'qwerty/pl.kmap.gz', 'pl', undef],
 496         'pt'     => ['Portuguese', 'pt', 'qwerty/pt-latin1.kmap.gz', 'pt', 'nodeadkeys'],
 497         'pt-br'  => ['Brazil-Portuguese', 'pt-br', 'qwerty/br-latin1.kmap.gz', 'br', 'nodeadkeys'],
 498         #'ru'     => ['Russian', 'ru', 'qwerty/ru.kmap.gz', 'ru', undef], # dont know?
 499         'si'     => ['Slovenian', 'sl', 'qwertz/slovene.kmap.gz', 'si', undef],
 500         #'sv'     => [], Swedish ?
 501         #'th'     => [],
 502         #'tr'     => [],
 503     };
 504 }
 505
 506 sub extract_param {
 507     my ($param, $key) = @_;
 508
 509     my $res = $param->{$key};
 510     delete $param->{$key};
 511
 512     return $res;
 513 }
 514
 515 sub next_vnc_port {
 516
 517     for (my $p = 5900; $p < 6000; $p++) {
 518
 519         my $sock = IO::Socket::INET->new (Listen => 5,
 520                                           LocalAddr => 'localhost',
 521                                           LocalPort => $p,
 522                                           ReuseAddr => 1,
 523                                           Proto     => 0);
 524
 525         if ($sock) {
 526             close ($sock);
 527             return $p;
 528         }
 529     }
 530
 531     die "unable to find free vnc port";
 532 };
 533
 534 # NOTE: NFS syscall can't be interrupted, so alarm does
 535 # not work to provide timeouts.
 536 # from 'man nfs': "Only SIGKILL can interrupt a pending NFS operation"
 537 # So the spawn external 'df' process instead of using
 538 # Filesys::Df (which uses statfs syscall)
 539 sub df {
 540     my ($path, $timeout) = @_;
 541
 542     my $cmd = [ 'df', '-P', '-B', '1', $path];
 543
 544     my $res = {
 545         total => 0,
 546         used => 0,
 547         avail => 0,
 548     };
 549
 550     my $parser = sub {
 551         my $line = shift;
 552         if (my ($fsid, $total, $used, $avail) = $line =~
 553             m/^(\S+.*)\s+(\d+)\s+(\d+)\s+(\d+)\s+\d+%\s.*$/) {
 554             $res = {
 555                 total => $total,
 556                 used => $used,
 557                 avail => $avail,
 558             };
 559         }
 560     };
 561     eval { run_command($cmd, timeout => $timeout, outfunc => $parser); };
 562     warn $@ if $@;
 563
 564     return $res;
 565 }
 566
 567 # UPID helper
 568 # We use this to uniquely identify a process.
 569 # An 'Unique Process ID' has the following format:
 570 # "UPID:$node:$pid:$pstart:$startime:$dtype:$id:$user"
 571
 572 sub upid_encode {
 573     my $d = shift;
 574
 575     return sprintf("UPID:%s:%08X:%08X:%08X:%s:%s:%s:", $d->{node}, $d->{pid},
 576                    $d->{pstart}, $d->{starttime}, $d->{type}, $d->{id},
 577                    $d->{user});
 578 }
 579
 580 sub upid_decode {
 581     my ($upid, $noerr) = @_;
 582
 583     my $res;
 584     my $filename;
 585
 586     # "UPID:$node:$pid:$pstart:$startime:$dtype:$id:$user"
 587     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]+):$/) {
 588         $res->{node} = $1;
 589         $res->{pid} = hex($2);
 590         $res->{pstart} = hex($3);
 591         $res->{starttime} = hex($4);
 592         $res->{type} = $5;
 593         $res->{id} = $6;
 594         $res->{user} = $7;
 595
 596         my $subdir = substr($4, 7, 8);
 597         $filename = "$pvetaskdir/$subdir/$upid";
 598
 599     } else {
 600         return undef if $noerr;
 601         die "unable to parse worker upid '$upid'\n";
 602     }
 603
 604     return wantarray ? ($res, $filename) : $res;
 605 }
 606
 607 sub upid_open {
 608     my ($upid) = @_;
 609
 610     my ($task, $filename) = upid_decode($upid);
 611
 612     my $dirname = dirname($filename);
 613     make_path($dirname);
 614
 615     my $wwwid = getpwnam('www-data') ||
 616         die "getpwnam failed";
 617
 618     my $perm = 0640;
 619
 620     my $outfh = IO::File->new ($filename, O_WRONLY|O_CREAT|O_EXCL, $perm) ||
 621         die "unable to create output file '$filename' - $!\n";
 622     chown $wwwid, $outfh;
 623
 624     return $outfh;
 625 };
 626
 627 sub upid_read_status {
 628     my ($upid) = @_;
 629
 630     my ($task, $filename) = upid_decode($upid);
 631     my $fh = IO::File->new($filename, "r");
 632     return "unable to open file - $!" if !$fh;
 633     my $maxlen = 1024;
 634     sysseek($fh, -$maxlen, 2);
 635     my $readbuf = '';
 636     my $br = sysread($fh, $readbuf, $maxlen);
 637     close($fh);
 638     if ($br) {
 639         return "unable to extract last line"
 640             if $readbuf !~ m/\n?(.+)$/;
 641         my $line = $1;
 642         if ($line =~ m/^TASK OK$/) {
 643             return 'OK';
 644         } elsif ($line =~ m/^TASK ERROR: (.+)$/) {
 645             return $1;
 646         } else {
 647             return "unexpected status";
 648         }
 649     }
 650     return "unable to read tail (got $br bytes)";
 651 }
 652
 653 # useful functions to store comments in config files
 654 sub encode_text {
 655     my ($text) = @_;
 656
 657     # all control and hi-bit characters, and ':'
 658     my $unsafe = "^\x20-\x39\x3b-\x7e";
 659     return uri_escape(Encode::encode("utf8", $text), $unsafe);
 660 }
 661
 662 sub decode_text {
 663     my ($data) = @_;
 664
 665     return Encode::decode("utf8", uri_unescape($data));
 666 }
 667
 668 sub random_ether_addr {
 669
 670     my $rand = Digest::SHA1::sha1_hex(rand(), time());
 671
 672     my $mac = '';
 673     for (my $i = 0; $i < 6; $i++) {
 674         my $ss = hex(substr($rand, $i*2, 2));
 675         if (!$i) {
 676             $ss &= 0xfe; # clear multicast
 677             $ss |= 2; # set local id
 678         }
 679         $ss = sprintf("%02X", $ss);
 680
 681         if (!$i) {
 682             $mac .= "$ss";
 683         } else {
 684             $mac .= ":$ss";
 685         }
 686     }
 687
 688     return $mac;
 689 }
 690
 691 sub shellquote {
 692     my $str = shift;
 693
 694     return "''" if !defined ($str) || ($str eq '');
 695
 696     die "unable to quote string containing null (\\000) bytes"
 697         if $str =~ m/\x00/;
 698
 699     # from String::ShellQuote
 700     if ($str =~ m|[^\w!%+,\-./:@^]|) {
 701
 702         # ' -> '\''
 703         $str =~ s/'/'\\''/g;
 704
 705         $str = "'$str'";
 706         $str =~ s/^''//;
 707         $str =~ s/''$//;
 708     }
 709
 710     return $str;
 711 }
 712
 713 # split an shell argument string into an array,
 714 sub split_args {
 715     my ($str) = @_;
 716
 717     return $str ? [ Text::ParseWords::shellwords($str) ] : [];
 718 }
 719
 720 1;