add PVE::Tools::extract_param helper
[pve-client.git] / 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;