src/PVE/LXC/Setup/Base.pm

   1 package PVE::LXC::Setup::Base;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Cwd 'abs_path';
   7 use File::stat;
   8 use Digest::SHA;
   9 use IO::File;
  10 use Encode;
  11 use Fcntl;
  12 use File::Path;
  13 use File::Spec;
  14 use File::Basename;
  15 use POSIX ();
  16
  17 use PVE::INotify;
  18 use PVE::Tools;
  19 use PVE::Network;
  20
  21 use PVE::LXC::Setup::Plugin;
  22 use base qw(PVE::LXC::Setup::Plugin);
  23
  24 sub new {
  25     my ($class, $conf, $rootdir, $os_release) = @_;
  26
  27     return bless { conf => $conf, rootdir => $rootdir, os_release => $os_release }, $class;
  28 }
  29
  30 sub lookup_dns_conf {
  31     my ($self, $conf) = @_;
  32
  33     my $nameserver = $conf->{nameserver};
  34     my $searchdomains = $conf->{searchdomain};
  35
  36     if ($conf->{'testmode'}) {
  37         $nameserver //= '8.8.8.8 8.8.8.9';
  38         $searchdomains //= 'proxmox.com';
  39     }
  40
  41     my $host_resolv_conf = $self->{host_resolv_conf};
  42
  43     if (!defined($nameserver)) {
  44         my @list = ();
  45         foreach my $k ("dns1", "dns2", "dns3") {
  46             if (my $ns = $host_resolv_conf->{$k}) {
  47                 push @list, $ns;
  48             }
  49         }
  50         $nameserver = join(' ', @list);
  51     }
  52
  53     if (!defined($searchdomains)) {
  54         $searchdomains = $host_resolv_conf->{search};
  55     }
  56
  57     return ($searchdomains, $nameserver);
  58 }
  59
  60 sub update_etc_hosts {
  61     my ($self, $hostip, $oldname, $newname, $searchdomains) = @_;
  62
  63     my $hosts_fn = '/etc/hosts';
  64     return if $self->ct_is_file_ignored($hosts_fn);
  65
  66     my $namepart = ($newname =~ s/\..*$//r);
  67
  68     my $all_names = '';
  69     if ($newname =~ /\./) {
  70         $all_names .= "$newname $namepart";
  71     } else {
  72         foreach my $domain (PVE::Tools::split_list($searchdomains)) {
  73             $all_names .= ' ' if $all_names;
  74             $all_names .= "$newname.$domain";
  75         }
  76         $all_names .= ' ' if $all_names;
  77         $all_names .= $newname;
  78     }
  79
  80     # Prepare section:
  81     my $section = '';
  82
  83     my $lo4 = "127.0.0.1 localhost.localnet localhost\n";
  84     my $lo6 = "::1 localhost.localnet localhost\n";
  85     if ($self->ct_file_exists($hosts_fn)) {
  86         my $data = $self->ct_file_get_contents($hosts_fn);
  87         # don't take localhost entries within our hosts sections into account
  88         $data = remove_pve_sections($data);
  89
  90         # check for existing localhost entries
  91         $section .= $lo4 if $data !~ /^\h*127\.0\.0\.1\h+/m;
  92         $section .= $lo6 if $data !~ /^\h*::1\h+/m;
  93     } else {
  94         $section .= $lo4 . $lo6;
  95     }
  96
  97     if (defined($hostip)) {
  98         $section .= "$hostip $all_names\n";
  99     } elsif ($namepart ne 'localhost') {
 100         $section .= "127.0.1.1 $all_names\n";
 101     } else {
 102         $section .= "127.0.1.1 $namepart\n";
 103     }
 104
 105     $self->ct_modify_file($hosts_fn, $section);
 106 }
 107
 108 sub template_fixup {
 109     my ($self, $conf) = @_;
 110
 111     # do nothing by default
 112 }
 113
 114 sub set_dns {
 115     my ($self, $conf) = @_;
 116
 117     my ($searchdomains, $nameserver) = $self->lookup_dns_conf($conf);
 118
 119     my $data = '';
 120
 121     $data .= "search " . join(' ', PVE::Tools::split_list($searchdomains)) . "\n"
 122         if $searchdomains;
 123
 124     foreach my $ns ( PVE::Tools::split_list($nameserver)) {
 125         $data .= "nameserver $ns\n";
 126     }
 127
 128     $self->ct_modify_file("/etc/resolv.conf", $data, replace => 1);
 129 }
 130
 131 sub set_hostname {
 132     my ($self, $conf) = @_;
 133
 134     my $hostname = $conf->{hostname} || 'localhost';
 135
 136     my $namepart = ($hostname =~ s/\..*$//r);
 137
 138     my $hostname_fn = "/etc/hostname";
 139
 140     my $oldname = $self->ct_file_read_firstline($hostname_fn) || 'localhost';
 141
 142     my ($ipv4, $ipv6) = PVE::LXC::get_primary_ips($conf);
 143     my $hostip = $ipv4 || $ipv6;
 144
 145     my ($searchdomains) = $self->lookup_dns_conf($conf);
 146
 147     $self->update_etc_hosts($hostip, $oldname, $hostname, $searchdomains);
 148
 149     $self->ct_file_set_contents($hostname_fn, "$namepart\n");
 150 }
 151
 152 sub setup_network {
 153     my ($self, $conf) = @_;
 154
 155     die "please implement this inside subclass"
 156 }
 157
 158 sub setup_init {
 159     my ($self, $conf) = @_;
 160
 161     die "please implement this inside subclass"
 162 }
 163
 164 # A few distros as well as unprivileged containers cannot deal with the
 165 # /dev/lxc/ tty subdirectory.
 166 sub devttydir {
 167     my ($self, $conf) = @_;
 168     return $conf->{unprivileged} ? '' : 'lxc/';
 169 }
 170
 171 sub fixup_old_getty {
 172     my ($self) = @_;
 173
 174     my $sd_dir_rel = $self->ct_is_executable("/lib/systemd/systemd") ?
 175         "/lib/systemd/system" : "/usr/lib/systemd/system";
 176
 177     my $sd_getty_service_rel = "$sd_dir_rel/getty\@.service";
 178     return if !$self->ct_file_exists($sd_getty_service_rel);
 179
 180     my $raw = $self->ct_file_get_contents($sd_getty_service_rel);
 181
 182     my $sd_container_getty_service_rel = "$sd_dir_rel/container-getty\@.service";
 183     # systemd on CenoOS 7.1 is too old (version 205), so there is no
 184     # container-getty service
 185     if (!$self->ct_file_exists($sd_container_getty_service_rel)) {
 186         if ($raw =~ s!^ConditionPathExists=/dev/tty0$!ConditionPathExists=/dev/tty!m) {
 187             $self->ct_file_set_contents($sd_getty_service_rel, $raw);
 188         }
 189     } else {
 190         # undo above change (in case someone updated systemd)
 191         if ($raw =~ s!^ConditionPathExists=/dev/tty$!ConditionPathExists=/dev/tty0!m) {
 192             $self->ct_file_set_contents($sd_getty_service_rel, $raw);
 193         }
 194     }
 195 }
 196
 197 sub setup_container_getty_service {
 198     my ($self, $conf) = @_;
 199
 200     my $sd_dir = $self->ct_is_executable("/lib/systemd/systemd") ?
 201         "/lib/systemd/system" : "/usr/lib/systemd/system";
 202
 203     # prefer container-getty.service shipped by newer systemd versions
 204     # fallback to getty.service and just return if that doesn't exists either..
 205     my $template_base = "container-getty\@";
 206     my $template_path = "${sd_dir}/${template_base}.service";
 207     my $instance_base = $template_base;
 208
 209     if (!$self->ct_file_exists($template_path)) {
 210         $template_base = "getty\@";
 211         $template_path = "${template_base}.service";
 212         $instance_base = "{$template_base}tty";
 213         return if !$self->ct_file_exists($template_path);
 214     }
 215
 216     my $raw = $self->ct_file_get_contents($template_path);
 217     my $ttyname = $self->devttydir($conf) . 'tty%I';
 218     if ($raw =~ s@pts/%I|lxc/tty%I@$ttyname@g) {
 219         $self->ct_file_set_contents($template_path, $raw);
 220     }
 221
 222     my $getty_target_fn = "/etc/systemd/system/getty.target.wants/";
 223     my $ttycount = PVE::LXC::Config->get_tty_count($conf);
 224
 225     for (my $i = 1; $i < 7; $i++) {
 226         # ensure that not two gettys are using the same tty!
 227         $self->ct_unlink("$getty_target_fn/getty\@tty$i.service");
 228         $self->ct_unlink("$getty_target_fn/container-getty\@$i.service");
 229
 230         # re-enable only those requested
 231         if ($i <= $ttycount) {
 232             my $tty_service = "${instance_base}${i}.service";
 233
 234             $self->ct_symlink($template_path, "$getty_target_fn/$tty_service");
 235         }
 236     }
 237
 238     # ensure getty.target is not masked
 239     $self->ct_unlink("/etc/systemd/system/getty.target");
 240 }
 241
 242 sub setup_systemd_networkd {
 243     my ($self, $conf) = @_;
 244
 245     foreach my $k (keys %$conf) {
 246         next if $k !~ m/^net(\d+)$/;
 247         my $d = PVE::LXC::Config->parse_lxc_network($conf->{$k});
 248         next if !$d->{name};
 249
 250         my $filename = "/etc/systemd/network/$d->{name}.network";
 251
 252         my $data = <<"DATA";
 253 [Match]
 254 Name = $d->{name}
 255
 256 [Network]
 257 Description = Interface $d->{name} autoconfigured by PVE
 258 DATA
 259
 260         my $routes = '';
 261         my ($has_ipv4, $has_ipv6);
 262
 263         # DHCP bitflags:
 264         my @DHCPMODES = ('no', 'v4', 'v6', 'yes');
 265         my ($NONE, $DHCP4, $DHCP6, $BOTH) = (0, 1, 2, 3);
 266         my $dhcp = $NONE;
 267         my $accept_ra = 'false';
 268
 269         if (defined(my $ip = $d->{ip})) {
 270             if ($ip eq 'dhcp') {
 271                 $dhcp |= $DHCP4;
 272             } elsif ($ip ne 'manual') {
 273                 $has_ipv4 = 1;
 274                 $data .= "Address = $ip\n";
 275             }
 276         }
 277         if (defined(my $gw = $d->{gw})) {
 278             $data .= "Gateway = $gw\n";
 279             if ($has_ipv4 && !PVE::Network::is_ip_in_cidr($gw, $d->{ip}, 4)) {
 280                 $routes .= "\n[Route]\nDestination = $gw/32\nScope = link\n";
 281             }
 282         }
 283
 284         if (defined(my $ip = $d->{ip6})) {
 285             if ($ip eq 'dhcp') {
 286                 $dhcp |= $DHCP6;
 287             } elsif ($ip eq 'auto') {
 288                 $accept_ra = 'true';
 289             } elsif ($ip ne 'manual') {
 290                 $has_ipv6 = 1;
 291                 $data .= "Address = $ip\n";
 292             }
 293         }
 294         if (defined(my $gw = $d->{gw6})) {
 295             $accept_ra = 'false';
 296             $data .= "Gateway = $gw\n";
 297             if ($has_ipv6 && !PVE::Network::is_ip_in_cidr($gw, $d->{ip6}, 6) &&
 298                 !PVE::Network::is_ip_in_cidr($gw, 'fe80::/10', 6)) {
 299                 $routes .= "\n[Route]\nDestination = $gw/128\nScope = link\n";
 300             }
 301         }
 302
 303         $data .= "DHCP = $DHCPMODES[$dhcp]\n";
 304         $data .= "IPv6AcceptRA = $accept_ra\n";
 305         $data .= $routes if $routes;
 306
 307         $self->ct_file_set_contents($filename, $data);
 308     }
 309 }
 310
 311 sub setup_securetty {
 312     my ($self, $conf, @add) = @_;
 313
 314     my $filename = "/etc/securetty";
 315     # root login is already allowed on every device if no securetty present
 316     return if !$self->ct_file_exists($filename);
 317
 318     if (!scalar(@add)) {
 319         @add = qw(console tty1 tty2 tty3 tty4);
 320         if (my $dir = $self->devttydir($conf)) {
 321             @add = map { "${dir}$_" } @add;
 322         }
 323     }
 324
 325     my $data = $self->ct_file_get_contents($filename);
 326     chomp $data; $data .= "\n";
 327     foreach my $dev (@add) {
 328         if ($data !~ m!^\Q$dev\E\s*$!m) {
 329             $data .= "$dev\n";
 330         }
 331     }
 332     $self->ct_file_set_contents($filename, $data);
 333 }
 334
 335 my $replacepw  = sub {
 336     my ($self, $file, $user, $epw, $shadow) = @_;
 337
 338     my $tmpfile = "$file.$$";
 339
 340     eval  {
 341         my $src = $self->ct_open_file_read($file) ||
 342             die "unable to open file '$file' - $!";
 343
 344         my $st = $self->ct_stat($src) ||
 345             die "unable to stat file - $!";
 346
 347         my $dst = $self->ct_open_file_write($tmpfile) ||
 348             die "unable to open file '$tmpfile' - $!";
 349
 350         # copy owner and permissions
 351         chmod $st->mode, $dst;
 352         chown $st->uid, $st->gid, $dst;
 353
 354         my $last_change = int(time()/(60*60*24));
 355
 356         while (defined (my $line = <$src>)) {
 357             if ($shadow) {
 358                 $line =~ s/^${user}:[^:]*:[^:]*:/${user}:${epw}:${last_change}:/;
 359             } else {
 360                 $line =~ s/^${user}:[^:]*:/${user}:${epw}:/;
 361             }
 362             print $dst $line;
 363         }
 364
 365         $src->close() || die "close '$file' failed - $!\n";
 366         $dst->close() || die "close '$tmpfile' failed - $!\n";
 367     };
 368     if (my $err = $@) {
 369         $self->ct_unlink($tmpfile);
 370     } else {
 371         $self->ct_rename($tmpfile, $file);
 372         $self->ct_unlink($tmpfile); # in case rename fails
 373     }
 374 };
 375
 376 sub set_user_password {
 377     my ($self, $conf, $user, $opt_password) = @_;
 378
 379     my $pwfile = "/etc/passwd";
 380
 381     return if !$self->ct_file_exists($pwfile);
 382
 383     my $shadow = "/etc/shadow";
 384
 385     if (defined($opt_password)) {
 386         if ($opt_password !~ m/^\$(?:1|2[axy]?|5|6)\$[a-zA-Z0-9.\/]{1,16}\$[a-zA-Z0-9.\/]+$/) {
 387             my $time = substr (Digest::SHA::sha1_base64 (time), 0, 8);
 388             $opt_password = crypt(encode("utf8", $opt_password), "\$6\$$time\$");
 389         };
 390     } else {
 391         $opt_password = '*';
 392     }
 393
 394     if ($self->ct_file_exists($shadow)) {
 395         &$replacepw ($self, $shadow, $user, $opt_password, 1);
 396         &$replacepw ($self, $pwfile, $user, 'x');
 397     } else {
 398         &$replacepw ($self, $pwfile, $user, $opt_password);
 399     }
 400 }
 401
 402 my $parse_home_dir = sub {
 403     my ($self, $passwdfile, $user) = @_;
 404
 405     my $fh = $self->ct_open_file_read($passwdfile);
 406     while (defined (my $line = <$fh>)) {
 407         return $2
 408             if $line =~ m/^${user}:([^:]*:){4}([^:]*):/;
 409     }
 410 };
 411
 412 sub set_user_authorized_ssh_keys {
 413     my ($self, $conf, $user, $ssh_keys) = @_;
 414
 415     my $passwd = "/etc/passwd";
 416     my $home = $user eq "root" ? "/root/" : "/home/$user/";
 417
 418     $home = &$parse_home_dir($self, $passwd, $user)
 419         if $self->ct_file_exists($passwd);
 420
 421     die "home directory '$home' of $user does not exist!"
 422         if ! ($self->ct_is_directory($home) || $self->ct_is_symlink($home));
 423
 424     $self->ct_mkdir("$home/.ssh", 0700)
 425         if ! $self->ct_is_directory("$home/.ssh");
 426
 427     $self->ct_modify_file("$home/.ssh/authorized_keys", $ssh_keys, perms => 0700);
 428 }
 429
 430 my $randomize_crontab = sub {
 431     my ($self, $conf) = @_;
 432
 433     my @files;
 434     # Note: dir_glob_foreach() untaints filenames!
 435     PVE::Tools::dir_glob_foreach("/etc/cron.d", qr/[A-Z\-\_a-z0-9]+/, sub {
 436         my ($name) = @_;
 437         push @files, "/etc/cron.d/$name";
 438     });
 439
 440     my $crontab_fn = "/etc/crontab";
 441     unshift @files, $crontab_fn if $self->ct_file_exists($crontab_fn);
 442
 443     foreach my $filename (@files) {
 444         my $data = $self->ct_file_get_contents($filename);
 445         my $new = '';
 446         foreach my $line (split(/\n/, $data)) {
 447             # we only randomize minutes for root crontab entries
 448             if ($line =~ m/^\d+(\s+\S+\s+\S+\s+\S+\s+\S+\s+root\s+\S.*)$/) {
 449                 my $rest = $1;
 450                 my $min = int(rand()*59);
 451                 $new .= "$min$rest\n";
 452             } else {
 453                 $new .= "$line\n";
 454             }
 455         }
 456         $self->ct_file_set_contents($filename, $new);
 457    }
 458 };
 459
 460 sub set_timezone {
 461     my ($self, $conf) = @_;
 462
 463     my $zoneinfo = $conf->{timezone};
 464
 465     return if !defined($zoneinfo);
 466
 467     my $tz_path = "/usr/share/zoneinfo/$zoneinfo";
 468
 469     if ($zoneinfo eq 'host') {
 470         $tz_path = $self->{host_localtime};
 471     }
 472
 473     if ($self->ct_file_exists($tz_path)) {
 474         if (abs_path('/etc/localtime') ne $tz_path) {
 475             my $tmpfile = "localtime.$$.new.tmpfile";
 476             $self->ct_symlink($tz_path, $tmpfile);
 477             $self->ct_rename($tmpfile, "/etc/localtime");
 478         }
 479
 480         # not all distributions have /etc/timezone
 481         if ($self->ct_file_exists('/etc/timezone')) {
 482             my $contents = $zoneinfo eq 'host' ? $self->{host_timezone} : $zoneinfo;
 483             $self->ct_file_set_contents('/etc/timezone', "$contents\n");
 484         }
 485     } else {
 486         warn "container does not have $tz_path, timezone can not be modified\n";
 487     }
 488 }
 489
 490 sub clear_machine_id {
 491     my ($self, $conf, $clone) = @_;
 492
 493     my $uses_systemd = $self->ct_is_executable("/lib/systemd/systemd")
 494         || $self->ct_is_executable("/usr/lib/systemd/systemd");
 495
 496     my $dbus_machine_id_path = "/var/lib/dbus/machine-id";
 497     my $machine_id_path = "/etc/machine-id";
 498
 499     my $machine_id_existed = $self->ct_file_exists($machine_id_path);
 500
 501     if (
 502         $self->ct_file_exists($dbus_machine_id_path)
 503         && !$self->ct_is_symlink($dbus_machine_id_path)
 504         && $uses_systemd
 505     ) {
 506         $self->ct_unlink($dbus_machine_id_path);
 507     }
 508
 509     # truncate on clone to avoid that FirstBoot condition is set
 510     if ($clone && ($uses_systemd || $machine_id_existed)) {
 511         $self->ct_file_set_contents($machine_id_path, "\n");
 512     } elsif (!$clone && $machine_id_existed) {
 513         $self->ct_unlink($machine_id_path);
 514     }
 515 }
 516
 517 # tries to guess the systemd (major) version based on the
 518 # libsystemd-shared<version>.so linked with /sbin/init
 519 sub get_systemd_version {
 520     my ($self, $init) = @_;
 521
 522     my $version = undef;
 523     PVE::Tools::run_command(
 524         ['objdump', '-p', $self->{rootdir}.$init],
 525         outfunc => sub {
 526             my $line = shift;
 527             if ($line =~ /libsystemd-shared-(\d+)(?:[-.][a-zA-Z0-9]+)*\.so:?$/) {
 528                 $version = $1;
 529             }
 530         },
 531         errmsg => "objdump on $init failed",
 532     );
 533
 534     return $version;
 535 }
 536
 537 sub unified_cgroupv2_support {
 538     my ($self, $init) = @_;
 539
 540     # https://www.freedesktop.org/software/systemd/man/systemd.html
 541     # systemd is installed as symlink to /sbin/init
 542     # assume non-systemd init will run with unified cgroupv2
 543     if (!defined($init) || $init !~ m@/systemd$@) {
 544         return 1;
 545     }
 546
 547     # systemd version 232 (e.g. debian stretch) supports the unified hierarchy
 548     my $sdver = $self->get_systemd_version($init);
 549     if (!defined($sdver) || $sdver < 232) {
 550         return 0;
 551     }
 552
 553     return 1;
 554 }
 555
 556 sub get_ct_init_path {
 557     my ($self) = @_;
 558
 559     my $init_path = "/sbin/init";
 560     if ($self->ct_is_symlink($init_path)) {
 561         $init_path = $self->ct_readlink_recursive($init_path);
 562     }
 563     return $init_path;
 564 }
 565
 566 sub ssh_host_key_types_to_generate {
 567     my ($self) = @_;
 568
 569     return {
 570         rsa => 'ssh_host_rsa_key',
 571         dsa => 'ssh_host_dsa_key',
 572         ecdsa => 'ssh_host_ecdsa_key',
 573         ed25519 => 'ssh_host_ed25519_key',
 574     };
 575 }
 576
 577 sub pre_start_hook {
 578     my ($self, $conf) = @_;
 579
 580     $self->ct_file_set_contents('/fastboot', ''); # skips fsck, among other things
 581
 582     $self->setup_init($conf);
 583     $self->setup_network($conf);
 584     $self->set_hostname($conf);
 585     $self->set_dns($conf);
 586     $self->set_timezone($conf);
 587
 588     # fixme: what else ?
 589 }
 590
 591 sub post_clone_hook {
 592     my ($self, $conf) = @_;
 593
 594     $self->clear_machine_id($conf, 1);
 595 }
 596
 597 sub post_create_hook {
 598     my ($self, $conf, $root_password, $ssh_keys) = @_;
 599
 600     $self->clear_machine_id($conf);
 601     $self->template_fixup($conf);
 602
 603     &$randomize_crontab($self, $conf);
 604
 605     $self->set_user_password($conf, 'root', $root_password);
 606     $self->set_user_authorized_ssh_keys($conf, 'root', $ssh_keys) if $ssh_keys;
 607     $self->setup_init($conf);
 608     $self->setup_network($conf);
 609     $self->set_hostname($conf);
 610     $self->set_dns($conf);
 611     $self->set_timezone($conf);
 612
 613     # fixme: what else ?
 614 }
 615
 616 # File access wrappers for container setup code.
 617 # NOTE: those are not direct part of the Plugin API (yet), avoid using them outside the child plugins
 618 # For user-namespace support these might need to take uid and gid maps into account.
 619
 620 sub ct_is_file_ignored {
 621     my ($self, $file) = @_;
 622     my ($name, $path) = fileparse($file);
 623     return -f "$path/.pve-ignore.$name";
 624 }
 625
 626 sub ct_reset_ownership {
 627     my ($self, @files) = @_;
 628     my $conf = $self->{conf};
 629     return if !$self->{id_map};
 630
 631     @files = grep { !$self->ct_is_file_ignored($_) } @files;
 632     return if !@files;
 633
 634     my $uid = $self->{rootuid};
 635     my $gid = $self->{rootgid};
 636     chown($uid, $gid, @files);
 637 }
 638
 639 sub ct_mkdir {
 640     my ($self, $file, $mask) = @_;
 641     # mkdir goes by parameter count - an `undef' mode acts like a mode of 0000
 642     if (defined($mask)) {
 643         return CORE::mkdir($file, $mask) && $self->ct_reset_ownership($file);
 644     } else {
 645         return CORE::mkdir($file) && $self->ct_reset_ownership($file);
 646     }
 647 }
 648
 649 sub ct_unlink {
 650     my ($self, @files) = @_;
 651     foreach my $file (@files) {
 652         next if $self->ct_is_file_ignored($file);
 653         CORE::unlink($file);
 654     }
 655 }
 656
 657 sub ct_rename {
 658     my ($self, $old, $new) = @_;
 659     return if $self->ct_is_file_ignored($new);
 660     CORE::rename($old, $new);
 661 }
 662
 663 sub ct_open_file_read {
 664     my $self = shift;
 665     my $file = shift;
 666     return IO::File->new($file, O_RDONLY, @_);
 667 }
 668
 669 sub ct_open_file_write {
 670     my $self = shift;
 671     my $file = shift;
 672     $file = '/dev/null' if $self->ct_is_file_ignored($file);
 673     my $fh = IO::File->new($file, O_WRONLY | O_CREAT, @_);
 674     $self->ct_reset_ownership($fh);
 675     return $fh;
 676 }
 677
 678 sub ct_make_path {
 679     my $self = shift;
 680
 681     my $opts = {};
 682     if (defined($self->{id_map})) {
 683         $opts->{owner} = $self->{rootuid};
 684         $opts->{group} = $self->{rootgid};
 685     }
 686     File::Path::make_path(@_, $opts);
 687 }
 688
 689 sub ct_symlink {
 690     my ($self, $old, $new) = @_;
 691     return if $self->ct_is_file_ignored($new);
 692     if (CORE::symlink($old, $new)) {
 693         if (defined($self->{id_map})) {
 694             POSIX::lchown($self->{rootuid}, $self->{rootgid}, $new);
 695         }
 696         return 1;
 697     } else {
 698         return 0;
 699     }
 700 }
 701
 702 sub ct_readlink {
 703     my ($self, $name) = @_;
 704     return CORE::readlink($name);
 705 }
 706
 707 sub ct_readlink_recursive {
 708     my ($self, $name) = @_;
 709
 710     my $res = $name;
 711     for (my $i = 0; $self->ct_is_symlink($res); $i++) {
 712         # arbitrary limit, but should be enough for all for our management relevant things
 713         die "maximal link depth of 10 for resolving '$name' reached, abort\n" if $i >= 10;
 714         $res = $self->ct_readlink($res);
 715         $res = abs_path($res);
 716     }
 717     return $res;
 718 }
 719
 720 sub ct_file_exists {
 721     my ($self, $file) = @_;
 722     return -f $file;
 723 }
 724
 725 sub ct_is_directory {
 726     my ($self, $file) = @_;
 727     return -d $file;
 728 }
 729
 730 sub ct_is_symlink {
 731     my ($self, $file) = @_;
 732     return -l $file;
 733 }
 734
 735 sub ct_is_executable {
 736     my ($self, $file) = @_;
 737     return -x $file
 738 }
 739
 740 sub ct_stat {
 741     my ($self, $file) = @_;
 742     return File::stat::stat($file);
 743 }
 744
 745 sub ct_file_read_firstline {
 746     my ($self, $file) = @_;
 747     return PVE::Tools::file_read_firstline($file);
 748 }
 749
 750 sub ct_file_get_contents {
 751     my ($self, $file) = @_;
 752     return PVE::Tools::file_get_contents($file);
 753 }
 754
 755 sub ct_file_set_contents {
 756     my ($self, $file, $data, $perms) = @_;
 757     return if $self->ct_is_file_ignored($file);
 758     PVE::Tools::file_set_contents($file, $data, $perms);
 759     $self->ct_reset_ownership($file);
 760 }
 761
 762 # Modify a marked portion of a file.
 763 # Optionally if the file becomes empty it will be deleted.
 764 sub ct_modify_file {
 765     my ($self, $file, $data, %options) = @_;
 766     return if $self->ct_is_file_ignored($file);
 767
 768     my $head = "# --- BEGIN PVE ---\n";
 769     my $tail = "# --- END PVE ---\n";
 770     my $perms = $options{perms};
 771     $data .= "\n" if $data && $data !~ /\n$/;
 772
 773     if (!$self->ct_file_exists($file)) {
 774         $self->ct_file_set_contents($file, $head.$data.$tail, $perms) if $data;
 775         return;
 776     }
 777
 778     my $old = $self->ct_file_get_contents($file);
 779     my @lines = split(/\n/, $old);
 780
 781     my ($beg, $end);
 782     foreach my $i (0..(@lines-1)) {
 783         my $line = $lines[$i];
 784         $beg = $i if !defined($beg) &&
 785             $line =~ /^#\s*---\s*BEGIN\s*PVE\s*/;
 786         $end = $i if !defined($end) && defined($beg) &&
 787             $line =~ /^#\s*---\s*END\s*PVE\s*/i;
 788         last if defined($beg) && defined($end);
 789     }
 790
 791     if (defined($beg) && defined($end)) {
 792         # Found a section
 793         if ($data) {
 794             chomp $tail;
 795             splice @lines, $beg, $end-$beg+1, $head.$data.$tail;
 796         } else {
 797             if ($beg == 0 && $end == (@lines-1)) {
 798                 $self->ct_unlink($file) if $options{delete};
 799                 return;
 800             }
 801             splice @lines, $beg, $end-$beg+1, $head.$data.$tail;
 802         }
 803         $self->ct_file_set_contents($file, join("\n", @lines) . "\n");
 804     } elsif ($data) {
 805         # No section found
 806         my $content = join("\n", @lines);
 807         chomp $content;
 808         if (!$content && !$data && $options{delete}) {
 809             $self->ct_unlink($file);
 810             return;
 811         }
 812         $content .= "\n";
 813         $data = $head.$data.$tail;
 814         if ($options{replace}) {
 815             $self->ct_file_set_contents($file, $data, $perms);
 816         } elsif ($options{prepend}) {
 817             $self->ct_file_set_contents($file, $data . $content, $perms);
 818         } else { # append
 819             $self->ct_file_set_contents($file, $content . $data, $perms);
 820         }
 821     }
 822 }
 823
 824 sub remove_pve_sections {
 825     my ($data) = @_;
 826
 827     my $head = "# --- BEGIN PVE ---";
 828     my $tail = "# --- END PVE ---";
 829
 830     # Remove the sections enclosed with the above headers and footers.
 831     # from a line (^) starting with '\h*$head'
 832     # to a line (the other ^) starting with '\h*$tail' up to including that
 833     # line's end (.*?$).
 834     return $data =~ s/^\h*\Q$head\E.*^\h*\Q$tail\E.*?$//rgms;
 835 }
 836
 837 1;