]>
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; | |
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; |