3 # todo: maybe we do not need update_file() ?
11 use Fcntl
qw(:DEFAULT :flock);
13 use PVE
::Exception
qw(raise_param_exc);
15 use Storable
qw(dclone);
20 our @EXPORT_OK = qw(read_file write_file register_file);
29 '/etc/network/interfaces' => '/etc/network/interfaces.new',
32 # to enable cached operation, you need to call 'inotify_init'
33 # inotify handles are a limited resource, so use with care (only
34 # enable the cache if you really need it)
36 # Note: please close the inotify handle after you fork
38 sub ccache_default_writer
{
39 my ($filename, $data) = @_;
41 die "undefined config writer for '$filename' :ERROR";
44 sub ccache_default_parser
{
45 my ($filename, $srcfd) = @_;
47 die "undefined config reader for '$filename' :ERROR";
50 sub ccache_compute_diff
{
51 my ($filename, $shadow) = @_;
55 open (TMP
, "diff -b -N -u '$filename' '$shadow'|");
57 while (my $line = <TMP
>) {
63 $diff = undef if !$diff;
71 foreach my $uid (keys %$ccacheregex) {
72 my $ccinfo = $ccacheregex->{$uid};
73 my $dir = $ccinfo->{dir
};
74 my $regex = $ccinfo->{regex
};
75 if ($filename =~ m
|^$dir/+$regex$|) {
76 if (!$ccache->{$filename}) {
78 while (my ($k, $v) = each %$ccinfo) {
81 $ccache->{$filename} = $cp;
83 return ($ccache->{$filename}, $filename);
87 $filename = $ccachemap->{$filename} if defined ($ccachemap->{$filename});
89 die "file '$filename' not added :ERROR" if !defined ($ccache->{$filename});
91 return ($ccache->{$filename}, $filename);
95 my ($fileid, $data, $full) = @_;
97 my ($ccinfo, $filename) = ccache_info
($fileid);
99 my $writer = $ccinfo->{writer
};
101 my $realname = $filename;
104 if ($shadow = $shadowfiles->{$filename}) {
108 my $perm = $ccinfo->{perm
} || 0644;
110 my $tmpname = "$realname.tmp.$$";
114 my $fh = IO
::File-
>new($tmpname, O_WRONLY
|O_CREAT
, $perm);
115 die "unable to open file '$tmpname' - $!\n" if !$fh;
117 $res = &$writer($filename, $fh, $data);
119 die "closing file '$tmpname' failed - $!\n" unless close $fh;
123 $ccinfo->{version
} = undef;
130 if (!rename($tmpname, $realname)) {
131 my $msg = "close (rename) atomic file '$filename' failed: $!\n";
137 if ($shadow && $full) {
138 $diff = ccache_compute_diff
($filename, $shadow);
142 return { data
=> $res, changes
=> $diff };
149 my ($fileid, $data, @args) = @_;
151 my ($ccinfo, $filename) = ccache_info
($fileid);
153 my $update = $ccinfo->{update
};
155 die "unable to update/merge data" if !$update;
157 my $lkfn = "$filename.lock";
165 $fd = IO
::File-
>new ($filename, "r");
167 my $new = &$update($filename, $fd, $data, @args);
170 PVE
::Tools
::file_set_contents
($filename, $new, $ccinfo->{perm
});
176 PVE
::Tools
::lock_file
($lkfn, $timeout, $code);
179 close($fd) if defined($fd);
186 sub discard_changes
{
187 my ($fileid, $full) = @_;
189 my ($ccinfo, $filename) = ccache_info
($fileid);
191 if (my $copy = $shadowfiles->{$filename}) {
195 return read_file
($filename, $full);
199 my ($fileid, $full) = @_;
203 my ($ccinfo, $filename) = ccache_info
($fileid);
205 $parser = $ccinfo->{parser
};
210 poll
() if $inotify; # read new inotify events
212 $versions->{$filename} = 0 if !defined ($versions->{$filename});
214 my $cver = $versions->{$filename};
216 if (my $copy = $shadowfiles->{$filename}) {
217 if ($fd = IO
::File-
>new ($copy, "r")) {
220 $fd = IO
::File-
>new ($filename, "r");
223 $fd = IO
::File-
>new ($filename, "r");
226 my $acp = $ccinfo->{always_call_parser
};
229 $ccinfo->{version
} = undef;
230 $ccinfo->{data
} = undef;
231 $ccinfo->{diff
} = undef;
232 return undef if !$acp;
235 my $noclone = $ccinfo->{noclone
};
238 if (!$ccinfo->{nocache
} &&
239 $inotify && $versions->{$filename} &&
240 defined ($ccinfo->{data
}) &&
241 defined ($ccinfo->{version
}) &&
242 ($ccinfo->{readonce
} ||
243 ($ccinfo->{version
} == $versions->{$filename}))) {
246 if (!$noclone && ref ($ccinfo->{data
})) {
247 $ret->{data
} = dclone
($ccinfo->{data
});
249 $ret->{data
} = $ccinfo->{data
};
251 $ret->{changes
} = $ccinfo->{diff
};
253 return $full ?
$ret : $ret->{data
};
259 $diff = ccache_compute_diff
($filename, $shadow);
262 my $res = &$parser($filename, $fd);
264 if (!$ccinfo->{nocache
}) {
265 $ccinfo->{version
} = $cver;
268 # we cache data with references, so we always need to
269 # dclone this data. Else the original data may get
271 $ccinfo->{data
} = $res;
274 $ccinfo->{diff
} = $diff;
277 if (!$noclone && ref ($ccinfo->{data
})) {
278 $ret->{data
} = dclone
($ccinfo->{data
});
280 $ret->{data
} = $ccinfo->{data
};
282 $ret->{changes
} = $ccinfo->{diff
};
284 return $full ?
$ret : $ret->{data
};
287 sub parse_ccache_options
{
288 my ($ccinfo, %options) = @_;
290 foreach my $opt (keys %options) {
291 my $v = $options{$opt};
292 if ($opt eq 'readonce') {
293 $ccinfo->{$opt} = $v;
294 } elsif ($opt eq 'nocache') {
295 $ccinfo->{$opt} = $v;
296 } elsif ($opt eq 'shadow') {
297 $ccinfo->{$opt} = $v;
298 } elsif ($opt eq 'perm') {
299 $ccinfo->{$opt} = $v;
300 } elsif ($opt eq 'noclone') {
301 # noclone flag for large read-only data chunks like aplinfo
302 $ccinfo->{$opt} = $v;
303 } elsif ($opt eq 'always_call_parser') {
304 # when set, we call parser even when the file does not exists.
305 # this allows the parser to return some default
306 $ccinfo->{$opt} = $v;
308 die "internal error - unsupported option '$opt'";
314 my ($id, $filename, $parser, $writer, $update, %options) = @_;
316 die "can't register file after initify_init" if $inotify;
318 die "file '$filename' already added :ERROR" if defined ($ccache->{$filename});
319 die "ID '$id' already used :ERROR" if defined ($ccachemap->{$id});
324 $ccinfo->{parser
} = $parser || \
&ccache_default_parser
;
325 $ccinfo->{writer
} = $writer || \
&ccache_default_writer
;
326 $ccinfo->{update
} = $update;
328 parse_ccache_options
($ccinfo, %options);
330 if ($options{shadow
}) {
331 $shadowfiles->{$filename} = $options{shadow
};
334 $ccachemap->{$id} = $filename;
335 $ccache->{$filename} = $ccinfo;
339 my ($dir, $regex, $parser, $writer, $update, %options) = @_;
341 die "can't register regex after initify_init" if $inotify;
343 my $uid = "$dir/$regex";
344 die "regular expression '$uid' already added :ERROR" if defined ($ccacheregex->{$uid});
348 $ccinfo->{dir
} = $dir;
349 $ccinfo->{regex
} = $regex;
350 $ccinfo->{parser
} = $parser || \
&ccache_default_parser
;
351 $ccinfo->{writer
} = $writer || \
&ccache_default_writer
;
352 $ccinfo->{update
} = $update;
354 parse_ccache_options
($ccinfo, %options);
356 $ccacheregex->{$uid} = $ccinfo;
362 if ($inotify_pid != $$) {
363 syslog
('err', "got inotify poll request in wrong process - disabling inotify");
366 1 while $inotify && $inotify->poll;
371 foreach my $filename (keys %$ccache) {
372 $ccache->{$filename}->{version
} = undef;
373 $ccache->{$filename}->{data
} = undef;
374 $ccache->{$filename}->{diff
} = undef;
384 die "only one inotify instance allowed" if $inotify;
386 $inotify = Linux
::Inotify2-
>new()
387 || die "Unable to create new inotify object: $!";
389 $inotify->blocking (0);
394 foreach my $fn (keys %$ccache) {
395 my $dir = dirname
($fn);
396 my $base = basename
($fn);
398 $dirhash->{$dir}->{$base} = $fn;
400 if (my $sf = $shadowfiles->{$fn}) {
401 $base = basename
($sf);
402 $dir = dirname
($sf);
403 $dirhash->{$dir}->{$base} = $fn; # change version of original file!
407 foreach my $uid (keys %$ccacheregex) {
408 my $ccinfo = $ccacheregex->{$uid};
409 $dirhash->{$ccinfo->{dir
}}->{_regex
} = 1;
414 foreach my $dir (keys %$dirhash) {
416 my $evlist = IN_MODIFY
|IN_ATTRIB
|IN_MOVED_FROM
|IN_MOVED_TO
|IN_DELETE
|IN_CREATE
;
417 $inotify->watch ($dir, $evlist, sub {
421 if ($inotify_pid != $$) {
422 syslog
('err', "got inotify event in wrong process");
425 if ($e->IN_ISDIR || !$name) {
429 if ($e->IN_Q_OVERFLOW) {
430 syslog
('info', "got inotify overflow - flushing cache");
435 if ($e->IN_UNMOUNT) {
436 syslog
('err', "got 'unmount' event on '$name' - disabling inotify");
439 if ($e->IN_IGNORED) {
440 syslog
('err', "got 'ignored' event on '$name' - disabling inotify");
444 if ($dirhash->{$dir}->{_regex
}) {
445 foreach my $uid (keys %$ccacheregex) {
446 my $ccinfo = $ccacheregex->{$uid};
447 next if $dir ne $ccinfo->{dir
};
448 my $regex = $ccinfo->{regex
};
449 if ($regex && ($name =~ m
|^$regex$|)) {
451 my $fn = "$dir/$name";
453 #print "VERSION:$fn:$versions->{$fn}\n";
456 } elsif (my $fn = $dirhash->{$dir}->{$name}) {
459 #print "VERSION:$fn:$versions->{$fn}\n";
464 foreach my $dir (keys %$dirhash) {
465 foreach my $name (keys %{$dirhash->{$dir}}) {
466 if ($name eq '_regex') {
467 foreach my $uid (keys %$ccacheregex) {
468 my $ccinfo = $ccacheregex->{$uid};
469 next if $dir ne $ccinfo->{dir
};
470 my $re = $ccinfo->{regex
};
471 if (my $fd = IO
::Dir-
>new ($dir)) {
472 while (defined(my $de = $fd->read)) {
473 if ($de =~ m/^$re$/) {
475 $versions->{$fn}++; # init with version
476 #print "init:$fn:$versions->{$fn}\n";
482 my $fn = $dirhash->{$dir}->{$name};
483 $versions->{$fn}++; # init with version
484 #print "init:$fn:$versions->{$fn}\n";
494 return $cached_nodename if $cached_nodename;
496 my ($sysname, $nodename) = POSIX
::uname
();
498 $nodename =~ s/\..*$//; # strip domain part, if any
500 die "unable to read node name\n" if !$nodename;
502 $cached_nodename = $nodename;
504 return $cached_nodename;
507 sub read_etc_hostname
{
508 my ($filename, $fd) = @_;
510 my $hostname = <$fd>;
514 $hostname =~ s/\..*$//; # strip domain part, if any
519 sub write_etc_hostname
{
520 my ($filename, $fh, $hostname) = @_;
522 die "write failed: $!" unless print $fh "$hostname\n";
527 register_file
('hostname', "/etc/hostname",
529 \
&write_etc_hostname
);
531 sub read_etc_resolv_conf
{
532 my ($filename, $fh) = @_;
537 while (my $line = <$fh>) {
539 if ($line =~ m/^(search|domain)\s+(\S+)\s*/) {
541 } elsif ($line =~ m/^nameserver\s+(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})\s*/) {
544 $res->{"dns$nscount"} = $1;
552 sub update_etc_resolv_conf
{
553 my ($filename, $fh, $resolv, @args) = @_;
557 $data = "search $resolv->{search}\n"
558 if $resolv->{search
};
561 foreach my $k ("dns1", "dns2", "dns3") {
562 my $ns = $resolv->{$k};
563 if ($ns && $ns ne '0.0.0.0' && !$written->{$ns}) {
565 $data .= "nameserver $ns\n";
569 while (my $line = <$fh>) {
570 next if $line =~ m/^(search|domain|nameserver)\s+/;
577 register_file
('resolvconf', "/etc/resolv.conf",
578 \
&read_etc_resolv_conf
, undef,
579 \
&update_etc_resolv_conf
);
581 sub read_etc_timezone
{
582 my ($filename, $fd) = @_;
584 my $timezone = <$fd>;
591 sub write_etc_timezone
{
592 my ($filename, $fh, $timezone) = @_;
594 my $tzinfo = "/usr/share/zoneinfo/$timezone";
596 raise_param_exc
({ 'timezone' => "No such timezone" })
599 ($timezone) = $timezone =~ m/^(.*)$/; # untaint
601 print $fh "$timezone\n";
603 unlink ("/etc/localtime");
604 symlink ("/usr/share/zoneinfo/$timezone", "/etc/localtime");
608 register_file
('timezone', "/etc/timezone",
610 \
&write_etc_timezone
);
612 sub read_active_workers
{
613 my ($filename, $fh) = @_;
618 while (defined (my $line = <$fh>)) {
619 if ($line =~ m/^(\S+)\s(0|1)(\s([0-9A-Za-z]{8})(\s(\s*\S.*))?)?$/) {
624 if ((my $task = PVE
::Tools
::upid_decode
($upid, 1))) {
625 $task->{upid
} = $upid;
626 $task->{saved
} = $saved;
627 $task->{endtime
} = hex($endtime) if $endtime;
628 $task->{status
} = $status if $status;
632 warn "unable to parse line: $line";
640 sub write_active_workers
{
641 my ($filename, $fh, $tasklist) = @_;
644 foreach my $task (@$tasklist) {
645 my $upid = $task->{upid
};
646 my $saved = $task->{saved
} ?
1 : 0;
647 if ($task->{endtime
}) {
648 if ($task->{status
}) {
649 $raw .= sprintf("$upid $saved %08X $task->{status}\n", $task->{endtime
});
651 $raw .= sprintf("$upid $saved %08X\n", $task->{endtime
});
654 $raw .= "$upid $saved\n";
658 PVE
::Tools
::safe_print
($filename, $fh, $raw) if $raw;
661 register_file
('active', "/var/log/pve/tasks/active",
662 \
&read_active_workers
,
663 \
&write_active_workers
);
666 my $bond_modes = { 'balance-rr' => 0,
667 'active-backup' => 1,
675 #sub get_bond_modes {
676 # return $bond_modes;
679 sub read_etc_network_interfaces
{
680 my ($filename, $fh) = @_;
686 if (my $fd2 = IO
::File-
>new("/proc/net/dev", "r")) {
687 while (defined ($line = <$fd2>)) {
688 if ($line =~ m/^\s*(eth[0-9]):.*/) {
689 $ifaces->{$1}->{exists} = 1;
695 # we try to keep order inside the file
696 my $priority = 2; # 1 is reserved for lo
698 # always add the vmbr0 bridge device
699 $ifaces->{vmbr0
}->{exists} = 1;
701 if (my $fd2 = IO
::File-
>new("/proc/net/if_inet6", "r")) {
702 while (defined ($line = <$fd2>)) {
703 if ($line =~ m/^[a-f0-9]{32}\s+[a-f0-9]{2}\s+[a-f0-9]{2}\s+[a-f0-9]{2}\s+[a-f0-9]{2}\s+(lo|eth\d+|vmbr\d+|bond\d+)$/) {
704 $ifaces->{$1}->{active
} = 1;
712 while (defined ($line = <$fh>)) {
714 next if $line =~ m/^#/;
716 if ($line =~ m/^auto\s+(.*)$/) {
717 my @aa = split (/\s+/, $1);
719 foreach my $a (@aa) {
720 $ifaces->{$a}->{autostart
} = 1;
723 } elsif ($line =~ m/^iface\s+(\S+)\s+inet\s+(\S+)\s*$/) {
725 $ifaces->{$i}->{method} = $2;
726 $ifaces->{$i}->{priority
} = $priority++;
728 my $d = $ifaces->{$i};
729 while (defined ($line = <$fh>)) {
730 if ($line =~ m/^#(.*)\s*$/) {
731 $d->{comment
} = '' if !$d->{comment
};
732 $d->{comment
} .= PVE
::Tools
::decode_text
($1) . "\n";
733 } elsif ($line =~ m/^\s+((\S+)\s+(.+))$/) {
735 my ($id, $value) = ($2, $3);
736 if (($id eq 'address') || ($id eq 'netmask') || ($id eq 'broadcast')) {
738 } elsif ($id eq 'gateway') {
741 } elsif ($id eq 'slaves' || $id eq 'bridge_ports') {
743 foreach my $p (split (/\s+/, $value)) {
744 next if $p eq 'none';
747 my $str = join (' ', sort keys %{$devs});
748 $d->{$id} = $str || '';
749 } elsif ($id eq 'bridge_stp') {
750 if ($value =~ m/^\s*(on|yes)\s*$/i) {
755 } elsif ($id eq 'bridge_fd') {
757 } elsif ($id eq 'bond_miimon') {
759 } elsif ($id eq 'bond_mode') {
761 foreach my $bm (keys %$bond_modes) {
762 my $id = $bond_modes->{$bm};
770 push @{$d->{options
}}, $option;
781 $ifaces->{vmbr0
}->{gateway
} = '';
784 if (!$ifaces->{lo
}) {
785 $ifaces->{lo
}->{priority
} = 1;
786 $ifaces->{lo
}->{method} = 'loopback';
787 $ifaces->{lo
}->{type
} = 'loopback';
788 $ifaces->{lo
}->{autostart
} = 1;
791 foreach my $iface (keys %$ifaces) {
792 my $d = $ifaces->{$iface};
793 if ($iface =~ m/^bond\d+$/) {
795 } elsif ($iface =~ m/^vmbr\d+$/) {
796 $d->{type
} = 'bridge';
797 if (!defined ($d->{bridge_fd
})) {
800 if (!defined ($d->{bridge_stp
})) {
801 $d->{bridge_stp
} = 'off';
803 } elsif ($iface =~ m/^(\S+):\d+$/) {
804 $d->{type
} = 'alias';
805 if (defined ($ifaces->{$1})) {
806 $d->{exists} = $ifaces->{$1}->{exists};
808 $ifaces->{$1}->{exists} = 0;
811 } elsif ($iface =~ m/^eth[0-9]$/) {
813 } elsif ($iface =~ m/^lo$/) {
814 $d->{type
} = 'loopback';
816 $d->{type
} = 'unknown';
819 $d->{method} = 'manual' if !$d->{method};
825 sub __interface_to_string
{
826 my ($iface, $d) = @_;
828 return '' if !($d && $d->{method});
832 if ($d->{autostart
}) {
833 $raw .= "auto $iface\n";
835 $raw .= "iface $iface inet $d->{method}\n";
836 $raw .= "\taddress $d->{address}\n" if $d->{address
};
837 $raw .= "\tnetmask $d->{netmask}\n" if $d->{netmask
};
838 $raw .= "\tgateway $d->{gateway}\n" if $d->{gateway
};
839 $raw .= "\tbroadcast $d->{broadcast}\n" if $d->{broadcast
};
841 if ($d->{bridge_ports
} || ($iface =~ m/^vmbr\d+$/)) {
842 my $ports = $d->{bridge_ports
} || 'none';
843 $raw .= "\tbridge_ports $ports\n";
846 if ($d->{bridge_stp
} || ($iface =~ m/^vmbr\d+$/)) {
847 my $v = $d->{bridge_stp
};
848 $v = defined ($v) ?
$v : 'off';
849 $raw .= "\tbridge_stp $v\n";
852 if (defined ($d->{bridge_fd
}) || ($iface =~ m/^vmbr\d+$/)) {
853 my $v = $d->{bridge_fd
};
854 $v = defined ($v) ?
$v : 0;
855 $raw .= "\tbridge_fd $v\n";
858 if ($d->{slaves
} || ($iface =~ m/^bond\d+$/)) {
859 my $slaves = $d->{slaves
} || 'none';
860 $raw .= "\tslaves $slaves\n";
863 if (defined ($d->{'bond_miimon'}) || ($iface =~ m/^bond\d+$/)) {
864 my $v = $d->{'bond_miimon'};
865 $v = defined ($v) ?
$v : 100;
866 $raw .= "\tbond_miimon $v\n";
869 if (defined ($d->{'bond_mode'}) || ($iface =~ m/^bond\d+$/)) {
870 my $v = $d->{'bond_mode'};
871 $v = defined ($v) ?
$v : 'balance-rr';
872 $raw .= "\tbond_mode $v\n";
875 foreach my $option (@{$d->{options
}}) {
876 $raw .= "\t$option\n";
880 my $comment = $d->{comment
} || '';
881 foreach my $cl (split(/\n/, $comment)) {
882 $raw .= '#' . PVE
::Tools
::encode_text
($cl) . "\n";
890 sub write_etc_network_interfaces
{
891 my ($filename, $fh, $ifaces) = @_;
893 my $raw = "# network interface settings\n";
897 foreach my $iface (sort {
898 my $ref1 = $ifaces->{$a};
899 my $ref2 = $ifaces->{$b};
900 my $p1 = $ref1->{priority
} || 100000;
901 my $p2 = $ref2->{priority
} || 100000;
903 return $p1 <=> $p2 if $p1 != $p2;
909 my $d = $ifaces->{$iface};
911 next if $printed->{$iface};
913 $printed->{$iface} = 1;
914 $raw .= __interface_to_string
($iface, $d);
917 PVE
::Tools
::safe_print
($filename, $fh, $raw);
920 register_file
('interfaces', "/etc/network/interfaces",
921 \
&read_etc_network_interfaces
,
922 \
&write_etc_network_interfaces
);