src/PVE/LXC/Setup/Base.pm

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