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