PVE/Tools.pm

   1 package PVE::Tools;
   2
   3 use strict;
   4 use warnings;
   5 use POSIX qw(EINTR EEXIST EOPNOTSUPP);
   6 use base 'Exporter';
   7
   8 use IO::File;
   9 use Text::ParseWords;
  10
  11 our @EXPORT_OK = qw(
  12 $IPV6RE
  13 $IPV4RE
  14 split_list
  15 file_set_contents
  16 file_get_contents
  17 extract_param
  18 );
  19
  20 my $IPV4OCTET = "(?:25[0-5]|(?:2[0-4]|1[0-9]|[1-9])?[0-9])";
  21 our $IPV4RE = "(?:(?:$IPV4OCTET\\.){3}$IPV4OCTET)";
  22 my $IPV6H16 = "(?:[0-9a-fA-F]{1,4})";
  23 my $IPV6LS32 = "(?:(?:$IPV4RE|$IPV6H16:$IPV6H16))";
  24
  25 our $IPV6RE = "(?:" .
  26     "(?:(?:" .                             "(?:$IPV6H16:){6})$IPV6LS32)|" .
  27     "(?:(?:" .                           "::(?:$IPV6H16:){5})$IPV6LS32)|" .
  28     "(?:(?:(?:" .              "$IPV6H16)?::(?:$IPV6H16:){4})$IPV6LS32)|" .
  29     "(?:(?:(?:(?:$IPV6H16:){0,1}$IPV6H16)?::(?:$IPV6H16:){3})$IPV6LS32)|" .
  30     "(?:(?:(?:(?:$IPV6H16:){0,2}$IPV6H16)?::(?:$IPV6H16:){2})$IPV6LS32)|" .
  31     "(?:(?:(?:(?:$IPV6H16:){0,3}$IPV6H16)?::(?:$IPV6H16:){1})$IPV6LS32)|" .
  32     "(?:(?:(?:(?:$IPV6H16:){0,4}$IPV6H16)?::" .           ")$IPV6LS32)|" .
  33     "(?:(?:(?:(?:$IPV6H16:){0,5}$IPV6H16)?::" .            ")$IPV6H16)|" .
  34     "(?:(?:(?:(?:$IPV6H16:){0,6}$IPV6H16)?::" .                    ")))";
  35
  36 our $IPRE = "(?:$IPV4RE|$IPV6RE)";
  37
  38 sub file_set_contents {
  39     my ($filename, $data, $perm)  = @_;
  40
  41     $perm = 0644 if !defined($perm);
  42
  43     my $tmpname = "$filename.tmp.$$";
  44
  45     eval {
  46         my ($fh, $tries) = (undef, 0);
  47         while (!$fh && $tries++ < 3) {
  48             $fh = IO::File->new($tmpname, O_WRONLY|O_CREAT|O_EXCL, $perm);
  49             if (!$fh && $! == EEXIST) {
  50                 unlink($tmpname) or die "unable to delete old temp file: $!\n";
  51             }
  52         }
  53         die "unable to open file '$tmpname' - $!\n" if !$fh;
  54         die "unable to write '$tmpname' - $!\n" unless print $fh $data;
  55         die "closing file '$tmpname' failed - $!\n" unless close $fh;
  56     };
  57     my $err = $@;
  58
  59     if ($err) {
  60         unlink $tmpname;
  61         die $err;
  62     }
  63
  64     if (!rename($tmpname, $filename)) {
  65         my $msg = "close (rename) atomic file '$filename' failed: $!\n";
  66         unlink $tmpname;
  67         die $msg;
  68     }
  69 }
  70
  71 sub file_get_contents {
  72     my ($filename, $max) = @_;
  73
  74     my $fh = IO::File->new($filename, "r") ||
  75         die "can't open '$filename' - $!\n";
  76
  77     my $content = safe_read_from($fh, $max, 0, $filename);
  78
  79     close $fh;
  80
  81     return $content;
  82 }
  83
  84 sub file_read_firstline {
  85     my ($filename) = @_;
  86
  87     my $fh = IO::File->new ($filename, "r");
  88     return undef if !$fh;
  89     my $res = <$fh>;
  90     chomp $res if $res;
  91     $fh->close;
  92     return $res;
  93 }
  94
  95 sub safe_read_from {
  96     my ($fh, $max, $oneline, $filename) = @_;
  97
  98     $max = 32768 if !$max;
  99
 100     my $subject = defined($filename) ? "file '$filename'" : 'input';
 101
 102     my $br = 0;
 103     my $input = '';
 104     my $count;
 105     while ($count = sysread($fh, $input, 8192, $br)) {
 106         $br += $count;
 107         die "$subject too long - aborting\n" if $br > $max;
 108         if ($oneline && $input =~ m/^(.*)\n/) {
 109             $input = $1;
 110             last;
 111         }
 112     }
 113     die "unable to read $subject - $!\n" if !defined($count);
 114
 115     return $input;
 116 }
 117
 118 sub split_list {
 119     my $listtxt = shift || '';
 120
 121     return split (/\0/, $listtxt) if $listtxt =~ m/\0/;
 122
 123     $listtxt =~ s/[,;]/ /g;
 124     $listtxt =~ s/^\s+//;
 125
 126     my @data = split (/\s+/, $listtxt);
 127
 128     return @data;
 129 }
 130
 131 # split an shell argument string into an array,
 132 sub split_args {
 133     my ($str) = @_;
 134
 135     return $str ? [ Text::ParseWords::shellwords($str) ] : [];
 136 }
 137
 138 sub extract_param {
 139     my ($param, $key) = @_;
 140
 141     my $res = $param->{$key};
 142     delete $param->{$key};
 143
 144     return $res;
 145 }
 146
 147 1;