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