]>
Commit | Line | Data |
---|---|---|
565bbc73 DM |
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; | |
a8d03417 | 9 | use Text::ParseWords; |
565bbc73 DM |
10 | |
11 | our @EXPORT_OK = qw( | |
12 | $IPV6RE | |
13 | $IPV4RE | |
14 | split_list | |
15 | file_set_contents | |
16 | file_get_contents | |
cff6d4f9 | 17 | extract_param |
565bbc73 DM |
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 | ||
a8d03417 DM |
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 | ||
cff6d4f9 DM |
138 | sub extract_param { |
139 | my ($param, $key) = @_; | |
140 | ||
141 | my $res = $param->{$key}; | |
142 | delete $param->{$key}; | |
143 | ||
144 | return $res; | |
145 | } | |
146 | ||
565bbc73 | 147 | 1; |