PVE/AAB.pm

   1 package PVE::AAB;
   2
   3 use strict;
   4 use warnings;
   5
   6 use File::Path;
   7 use File::Copy;
   8 use IO::File;
   9 use IO::Select;
  10 use IPC::Open2;
  11 use IPC::Open3;
  12 use UUID;
  13 use Cwd;
  14 my @BASE_PACKAGES = qw(base openssh vi nano);
  15 my @BASE_EXCLUDES = qw(
  16     e2fsprogs
  17     jfsutils
  18     linux
  19     linux-firmware
  20     lvm2
  21     mdadm
  22     netctl
  23     pcmciautils
  24     reiserfsprogs
  25     xfsprogs
  26 );
  27
  28 my $PKGDIR = "/var/cache/pacman/pkg";
  29
  30 my ($aablibdir, $fake_init);
  31
  32 sub setup_defaults($) {
  33     my ($dir) = @_;
  34     $aablibdir = $dir;
  35     $fake_init = "$aablibdir/scripts/init.bash";
  36 }
  37
  38 setup_defaults('/usr/lib/aab');
  39
  40 sub write_file {
  41     my ($data, $file, $perm) = @_;
  42
  43     die "no filename" if !$file;
  44     unlink $file;
  45
  46     my $fh = IO::File->new ($file, O_WRONLY | O_CREAT, $perm) ||
  47         die "unable to open file '$file'";
  48
  49     print $fh $data;
  50     $fh->close;
  51 }
  52
  53 sub copy_file {
  54     my ($a, $b) = @_;
  55     copy($a, $b) or die "failed to copy $a => $b: $!";
  56 }
  57
  58 sub rename_file {
  59     my ($a, $b) = @_;
  60     rename($a, $b) or die "failed to rename $a => $b: $!";
  61 }
  62
  63 sub symln {
  64     my ($a, $b) = @_;
  65     symlink($a, $b) or die "failed to symlink $a => $b: $!";
  66 }
  67
  68 sub logmsg {
  69     my $self = shift;
  70     print STDERR @_;
  71     $self->writelog (@_);
  72 }
  73
  74 sub writelog {
  75     my $self = shift;
  76     my $fd = $self->{logfd};
  77     print $fd @_;
  78 }
  79
  80 sub read_config {
  81     my ($filename) = @_;
  82
  83     my $res = {};
  84
  85     my $fh = IO::File->new ("<$filename") || return $res;
  86     my $rec = '';
  87
  88     while (defined (my $line = <$fh>)) {
  89         next if $line =~ m/^\#/;
  90         next if $line =~ m/^\s*$/;
  91         $rec .= $line;
  92     };
  93
  94     close ($fh);
  95
  96     chomp $rec;
  97     $rec .= "\n";
  98
  99     while ($rec) {
 100         if ($rec =~ s/^Description:\s*([^\n]*)(\n\s+.*)*$//si) {
 101             $res->{headline} = $1;
 102             chomp $res->{headline};
 103             my $long = $2;
 104             $long =~ s/^\s+/ /;
 105             $res->{description} = $long;
 106             chomp $res->{description};
 107         } elsif ($rec =~ s/^([^:]+):\s*(.*\S)\s*\n//) {
 108             my ($key, $value) = (lc ($1), $2);
 109             if ($key eq 'source' || $key eq 'mirror') {
 110                 push @{$res->{$key}}, $value;
 111             } else {
 112                 die "duplicate key '$key'\n" if defined ($res->{$key});
 113                 $res->{$key} = $value;
 114             }
 115         } else {
 116             die "unable to parse config file: $rec";
 117         }
 118     }
 119
 120     die "unable to parse config file" if $rec;
 121
 122     $res->{architecture} = 'amd64' if $res->{architecture} eq 'x86_64';
 123
 124     return $res;
 125 }
 126
 127 sub new {
 128     my ($class, $config) = @_;
 129
 130     $config = read_config ('aab.conf') if !$config;
 131     my $version = $config->{version};
 132     die "no 'version' specified\n" if !$version;
 133     die "no 'section' specified\n" if !$config->{section};
 134     die "no 'description' specified\n" if !$config->{headline};
 135     die "no 'maintainer' specified\n" if !$config->{maintainer};
 136
 137     my $name = $config->{name} || die "no 'name' specified\n";
 138     $name =~ m/^[a-z][0-9a-z\-\*\.]+$/ ||
 139         die "illegal characters in name '$name'\n";
 140
 141     my $targetname;
 142     if ($name =~ m/^archlinux/) {
 143         $targetname = "${name}_${version}_$config->{architecture}";
 144     } else {
 145         $targetname = "archlinux-${name}_${version}_$config->{architecture}";
 146     }
 147
 148     my $self = { logfile => 'logfile',
 149                  config => $config,
 150                  targetname => $targetname,
 151                  incl => [@BASE_PACKAGES],
 152                  excl => [@BASE_EXCLUDES],
 153                };
 154
 155     $self->{logfd} = IO::File->new($self->{logfile}, O_WRONLY | O_APPEND | O_CREAT)
 156         or die "unable to open log file";
 157
 158     bless $self, $class;
 159
 160     $self->__allocate_ve();
 161
 162     return $self;
 163 }
 164
 165 sub __sample_config {
 166     my ($self) = @_;
 167
 168     my $arch = $self->{config}->{architecture};
 169
 170     return <<"CFG";
 171 lxc.arch = $arch
 172 lxc.include = /usr/share/lxc/config/archlinux.common.conf
 173 lxc.uts.name = localhost
 174 lxc.rootfs.path = $self->{rootfs}
 175 lxc.mount.entry = $self->{pkgcache} $self->{pkgdir} none bind 0 0
 176 CFG
 177 }
 178
 179 sub __allocate_ve {
 180     my ($self) = @_;
 181
 182     my $cid;
 183     if (my $fd = IO::File->new(".veid")) {
 184         $cid = <$fd>;
 185         chomp $cid;
 186         close ($fd);
 187     }
 188
 189
 190     $self->{working_dir} = getcwd;
 191     $self->{veconffile} = "$self->{working_dir}/config";
 192     $self->{rootfs} = "$self->{working_dir}/rootfs";
 193     $self->{pkgdir} = "$self->{working_dir}/rootfs/$PKGDIR";
 194     $self->{pkgcache} = "$self->{working_dir}/pkgcache";
 195     $self->{'pacman.conf'} = "$self->{working_dir}/pacman.conf";
 196
 197     if ($cid) {
 198         $self->{veid} = $cid;
 199         return $cid;
 200     }
 201
 202     my $uuid;
 203     my $uuid_str;
 204     UUID::generate($uuid);
 205     UUID::unparse($uuid, $uuid_str);
 206     $self->{veid} = $uuid_str;
 207
 208     my $fd = IO::File->new (">.veid") ||
 209         die "unable to write '.veid'\n";
 210     print $fd "$self->{veid}\n";
 211     close ($fd);
 212     $self->logmsg("allocated VE $self->{veid}\n");
 213 }
 214
 215 sub initialize {
 216     my ($self) = @_;
 217
 218     my $config = $self->{config};
 219
 220     $self->{logfd} = IO::File->new($self->{logfile}, O_WRONLY | O_TRUNC | O_CREAT)
 221         or die "unable to open log file";
 222
 223     my $cdata = $self->__sample_config();
 224
 225     my $fh = IO::File->new($self->{veconffile}, O_WRONLY|O_CREAT|O_EXCL) ||
 226         die "unable to write lxc config file '$self->{veconffile}' - $!";
 227     print $fh $cdata;
 228     close ($fh);
 229
 230     if (!$config->{source} && !$config->{mirror}) {
 231         die "no sources/mirrors specified";
 232     }
 233
 234     $config->{source} //= [];
 235     $config->{mirror} //= [];
 236
 237     my $servers = "Server = "
 238                 . join("\nServer = ", @{$config->{source}}, @{$config->{mirror}})
 239                 . "\n";
 240
 241     $fh = IO::File->new($self->{'pacman.conf'}, O_WRONLY|O_CREAT|O_EXCL) ||
 242         die "unable to write pacman config file $self->{'pacman.conf'} - $!";
 243     my $arch = $config->{architecture};
 244     $arch = 'x86_64' if $arch eq 'amd64';
 245     print $fh <<"EOF";
 246 [options]
 247 HoldPkg = pacman glibc
 248 Architecture = $arch
 249 CheckSpace
 250 SigLevel = Never
 251
 252 [core]
 253 $servers
 254 [extra]
 255 $servers
 256 [community]
 257 $servers
 258 EOF
 259
 260     if ($config->{architecture} eq 'x86_64') {
 261         print $fh "[multilib]\n$servers\n";
 262     }
 263
 264     $self->logmsg("configured VE $self->{veid}\n");
 265 }
 266
 267 sub ve_status {
 268     my ($self) = @_;
 269
 270     my $veid = $self->{veid};
 271
 272     my $res = { running => 0 };
 273
 274     $res->{exist} = 1 if -d "$self->{rootfs}/usr";
 275
 276     my $filename = "/proc/net/unix";
 277
 278     # similar test is used by lcxcontainers.c: list_active_containers
 279     my $fh = IO::File->new ($filename, "r");
 280     return $res if !$fh;
 281
 282     while (defined(my $line = <$fh>)) {
 283         if ($line =~ m/^[a-f0-9]+:\s\S+\s\S+\s\S+\s\S+\s\S+\s\d+\s(\S+)$/) {
 284             my $path = $1;
 285             if ($path =~ m!^@/\S+/$veid/command$!) {
 286                 $res->{running} = 1;
 287             }
 288         }
 289     }
 290     close($fh);
 291
 292     return $res;
 293 }
 294
 295 sub ve_destroy {
 296     my ($self) = @_;
 297
 298     my $veid = $self->{veid}; # fixme
 299
 300     my $vestat = $self->ve_status();
 301     if ($vestat->{running}) {
 302         $self->stop_container();
 303     }
 304
 305     rmtree $self->{rootfs};
 306     unlink $self->{veconffile};
 307 }
 308
 309 sub ve_init {
 310     my ($self) = @_;
 311
 312
 313     my $veid = $self->{veid};
 314     my $conffile = $self->{veconffile};
 315
 316     $self->logmsg ("initialize VE $veid\n");
 317
 318     my $vestat = $self->ve_status();
 319     if ($vestat->{running}) {
 320         $self->run_command ("lxc-stop -n $veid --rcfile $conffile --kill");
 321     }
 322
 323     rmtree $self->{rootfs};
 324     mkpath "$self->{rootfs}/dev";
 325 }
 326
 327 sub ve_command {
 328     my ($self, $cmd, $input) = @_;
 329
 330     my $veid = $self->{veid};
 331     my $conffile = $self->{veconffile};
 332
 333     if (ref ($cmd) eq 'ARRAY') {
 334         unshift @$cmd, 'lxc-attach', '-n', $veid, '--rcfile', $conffile,'--clear-env', '--';
 335         $self->run_command ($cmd, $input);
 336     } else {
 337         $self->run_command ("lxc-attach -n $veid --rcfile $conffile --clear-env -- $cmd", $input);
 338     }
 339 }
 340
 341 sub ve_exec {
 342     my ($self, @cmd) = @_;
 343
 344     my $veid = $self->{veid};
 345     my $conffile = $self->{veconffile};
 346
 347     my $reader;
 348     my $pid = open2($reader, "<&STDIN", 'lxc-attach', '-n', $veid, '--rcfile', $conffile, '--', @cmd)
 349         or die "unable to exec command";
 350
 351     while (defined (my $line = <$reader>)) {
 352         $self->logmsg ($line);
 353     }
 354
 355     waitpid ($pid, 0);
 356     my $rc = $? >> 8;
 357
 358     die "ve_exec failed - status $rc\n" if $rc != 0;
 359 }
 360
 361 sub run_command {
 362     my ($self, $cmd, $input, $getoutput) = @_;
 363
 364     my $reader = IO::File->new();
 365     my $writer = IO::File->new();
 366     my $error  = IO::File->new();
 367
 368     my $orig_pid = $$;
 369
 370     my $cmdstr = ref ($cmd) eq 'ARRAY' ? join (' ', @$cmd) : $cmd;
 371
 372     my $pid;
 373     eval {
 374         if (ref ($cmd) eq 'ARRAY') {
 375             $pid = open3 ($writer, $reader, $error, @$cmd) || die $!;
 376         } else {
 377             $pid = open3 ($writer, $reader, $error, $cmdstr) || die $!;
 378         }
 379     };
 380
 381     my $err = $@;
 382
 383     # catch exec errors
 384     if ($orig_pid != $$) {
 385         $self->logmsg ("ERROR: command '$cmdstr' failed - fork failed\n");
 386         POSIX::_exit (1);
 387         kill ('KILL', $$);
 388     }
 389
 390     die $err if $err;
 391
 392     print $writer $input if defined $input;
 393     close $writer;
 394
 395     my $select = new IO::Select;
 396     $select->add ($reader);
 397     $select->add ($error);
 398
 399     my $res = '';
 400     my $logfd = $self->{logfd};
 401
 402     while ($select->count) {
 403         my @handles = $select->can_read ();
 404
 405         foreach my $h (@handles) {
 406             my $buf = '';
 407             my $count = sysread ($h, $buf, 4096);
 408             if (!defined ($count)) {
 409                 waitpid ($pid, 0);
 410                 die "command '$cmdstr' failed: $!";
 411             }
 412             $select->remove ($h) if !$count;
 413
 414             print $logfd $buf;
 415
 416             $res .= $buf if $getoutput;
 417         }
 418     }
 419
 420     waitpid ($pid, 0);
 421     my $ec = ($? >> 8);
 422
 423     die "command '$cmdstr' failed with exit code $ec\n" if $ec;
 424
 425     return $res;
 426 }
 427
 428 sub start_container {
 429     my ($self) = @_;
 430     my $veid = $self->{veid};
 431     $self->run_command(['lxc-start', '-n', $veid, '-f', $self->{veconffile}, '/usr/bin/aab_fake_init']);
 432 }
 433
 434 sub stop_container {
 435     my ($self) = @_;
 436     my $veid = $self->{veid};
 437     my $conffile = $self->{veconffile};
 438     $self->run_command ("lxc-stop -n $veid --rcfile $conffile --kill");
 439 }
 440
 441 sub pacman_command {
 442     my ($self) = @_;
 443     my $root = $self->{rootfs};
 444     return ('/usr/bin/pacman',
 445             '--root', $root,
 446             '--config', $self->{'pacman.conf'},
 447             '--cachedir', $self->{pkgcache},
 448             '--noconfirm');
 449 }
 450
 451 sub cache_packages {
 452     my ($self, $packages) = @_;
 453     my $root = $self->{rootfs};
 454
 455     my @pacman = $self->pacman_command();
 456     $self->run_command([@pacman, '-Sw', '--', @$packages]);
 457 }
 458
 459 sub mask_systemd_unit {
 460     my ($self, $unit) = @_;
 461     my $root = $self->{rootfs};
 462     symln '/dev/null', "$root/etc/systemd/system/$unit";
 463 }
 464
 465 sub bootstrap {
 466     my ($self, $include, $exclude) = @_;
 467     my $root = $self->{rootfs};
 468
 469     my @pacman = $self->pacman_command();
 470
 471     print "Fetching package database...\n";
 472     mkpath $self->{pkgcache};
 473     mkpath $self->{pkgdir};
 474     mkpath "$root/var/lib/pacman";
 475     $self->run_command([@pacman, '-Syy']);
 476
 477     print "Figuring out what to install...\n";
 478     my $incl = { map { $_ => 1 } @{$self->{incl}} };
 479     my $excl = { map { $_ => 1 } @{$self->{excl}} };
 480
 481     foreach my $addinc (@$include) {
 482         $incl->{$addinc} = 1;
 483         delete $excl->{$addinc};
 484     }
 485     foreach my $addexc (@$exclude) {
 486         $excl->{$addexc} = 1;
 487         delete $incl->{$addexc};
 488     }
 489
 490     my $expand = sub {
 491         my ($lst) = @_;
 492         foreach my $inc (keys %$lst) {
 493             my $group;
 494             eval { $group = $self->run_command([@pacman, '-Sqg', $inc], undef, 1); };
 495             if ($group && !$@) {
 496                 # add the group
 497                 delete $lst->{$inc};
 498                 $lst->{$_} = 1 foreach split(/\s+/, $group);
 499             }
 500         }
 501     };
 502
 503     $expand->($incl);
 504     $expand->($excl);
 505
 506     my $packages = [ grep { !$excl->{$_} } keys %$incl ];
 507
 508     print "Setting up basic environment...\n";
 509     mkpath "$root/etc";
 510     mkpath "$root/usr/bin";
 511
 512     my $data = "# UNCONFIGURED FSTAB FOR BASE SYSTEM\n";
 513     write_file ($data, "$root/etc/fstab", 0644);
 514
 515     write_file ("", "$root/etc/resolv.conf", 0644);
 516     write_file("localhost\n", "$root/etc/hostname", 0644);
 517     $self->run_command(['install', '-m0755', $fake_init, "$root/usr/bin/aab_fake_init"]);
 518
 519     unlink "$root/etc/localtime";
 520     symln '/usr/share/zoneinfo/UTC', "$root/etc/localtime";
 521
 522     print "Caching packages...\n";
 523     $self->cache_packages($packages);
 524     #$self->copy_packages();
 525
 526     print "Creating device nodes for package manager...\n";
 527     $self->create_dev();
 528
 529     print "Installing package manager and essentials...\n";
 530     # inetutils for 'hostname' for our init
 531     $self->run_command([@pacman, '-S', 'pacman', 'inetutils', 'archlinux-keyring']);
 532
 533     print "Setting up pacman for installation from cache...\n";
 534     my $file = "$root/etc/pacman.d/mirrorlist";
 535     my $backup = "${file}.aab_orig";
 536     if (!-f $backup) {
 537         rename_file($file, $backup);
 538         write_file("Server = file://$PKGDIR\n", $file);
 539     }
 540
 541     print "Populating keyring...\n";
 542     $self->populate_keyring();
 543
 544     print "Removing device nodes...\n";
 545     $self->cleanup_dev();
 546
 547     print "Starting container...\n";
 548     $self->start_container();
 549
 550     print "Installing packages...\n";
 551     $self->ve_command(['pacman', '-S', '--needed', '--noconfirm', '--', @$packages]);
 552
 553     print "Masking problematic systemd units...\n";
 554     for  my $unit (qw(sys-kernel-config.mount sys-kernel-debug.mount)) {
 555         $self->mask_systemd_unit($unit);
 556     }
 557 }
 558
 559 # devices needed for gnupg to function:
 560 my $devs = {
 561     '/dev/null'    => ['c', '1', '3'],
 562     '/dev/random'  => ['c', '1', '9'], # fake /dev/random (really urandom)
 563     '/dev/urandom' => ['c', '1', '9'],
 564     '/dev/tty'     => ['c', '5', '0'],
 565 };
 566
 567 sub cleanup_dev {
 568     my ($self) = @_;
 569     my $root = $self->{rootfs};
 570
 571     # remove temporary device files
 572     unlink "${root}$_" foreach keys %$devs;
 573 }
 574
 575 sub create_dev {
 576     my ($self) = @_;
 577     my $root = $self->{rootfs};
 578
 579     local $SIG{INT} = $SIG{TERM} = sub { $self->cleanup_dev; };
 580
 581     # we want to replace /dev/random, so delete devices first
 582     $self->cleanup_dev();
 583
 584     foreach my $dev (keys %$devs) {
 585         my ($type, $major, $minor) = @{$devs->{$dev}};
 586         system('mknod', "${root}${dev}", $type, $major, $minor);
 587     }
 588 }
 589
 590 sub populate_keyring {
 591     my ($self) = @_;
 592     my $root = $self->{rootfs};
 593
 594     # generate weak master key and populate the keyring
 595     system('unshare', '--fork', '--pid', 'chroot', "$root", 'pacman-key', '--init') == 0
 596         or die "failed to initialize keyring: $?";
 597     system('unshare', '--fork', '--pid', 'chroot', "$root", 'pacman-key', '--populate') == 0
 598         or die "failed to populate keyring: $?";
 599
 600 }
 601
 602 sub install {
 603     my ($self, $pkglist) = @_;
 604
 605     $self->cache_packages($pkglist);
 606     $self->ve_command(['pacman', '-S', '--needed', '--noconfirm', '--', @$pkglist]);
 607 }
 608
 609 sub write_config {
 610     my ($self, $filename, $size) = @_;
 611
 612     my $config = $self->{config};
 613
 614     my $data = '';
 615
 616     $data .= "Name: $config->{name}\n";
 617     $data .= "Version: $config->{version}\n";
 618     $data .= "Type: lxc\n";
 619     $data .= "OS: archlinux\n";
 620     $data .= "Section: $config->{section}\n";
 621     $data .= "Maintainer: $config->{maintainer}\n";
 622     $data .= "Architecture: $config->{architecture}\n";
 623     $data .= "Infopage: https://www.archlinux.org\n";
 624     $data .= "Installed-Size: $size\n";
 625
 626     # optional
 627     $data .= "Infopage: $config->{infopage}\n" if $config->{infopage};
 628     $data .= "ManageUrl: $config->{manageurl}\n" if $config->{manageurl};
 629     $data .= "Certified: $config->{certified}\n" if $config->{certified};
 630
 631     # description
 632     $data .= "Description: $config->{headline}\n";
 633     $data .= "$config->{description}\n" if $config->{description};
 634
 635     write_file ($data, $filename, 0644);
 636 }
 637
 638 sub finalize {
 639     my ($self, $compressor) = @_;
 640
 641     my $use_zstd = 1;
 642     if (defined($compressor)) {
 643         if ($compressor =~ /^\s*--zstd?\s*$/) {
 644             $use_zstd = 1;
 645         } elsif ($compressor =~ /^\s*--(?:gz|gzip)\s*$/) {
 646             $use_zstd = 0; # just boolean for now..
 647         } else {
 648             die "unkown compressor '$compressor'!\n";
 649         }
 650     }
 651
 652     my $rootdir = $self->{rootfs};
 653
 654     print "Stopping container...\n";
 655     $self->stop_container();
 656
 657     print "Rolling back mirrorlist changes...\n";
 658     my $file = "$rootdir/etc/pacman.d/mirrorlist";
 659     unlink $file;
 660     rename_file($file.'.aab_orig', $file);
 661
 662     print "Removing weak temporary pacman keyring...\n";
 663     rmtree("$rootdir/etc/pacman.d/gnupg");
 664
 665     my $sizestr = $self->run_command("du -sm $rootdir", undef, 1);
 666     my $size;
 667     if ($sizestr =~ m/^(\d+)\s+\Q$rootdir\E$/) {
 668         $size = $1;
 669     } else {
 670         die "unable to detect size\n";
 671     }
 672     $self->logmsg ("uncompressed size: $size MB\n");
 673
 674     $self->write_config ("$rootdir/etc/appliance.info", $size);
 675
 676     $self->logmsg ("creating final appliance archive\n");
 677
 678     my $compressor_ext =  $use_zstd ? 'zst' : 'gz';
 679
 680     my $target = "$self->{targetname}.tar";
 681     unlink $target;
 682     unlink "$target.$compressor_ext";
 683
 684     $self->run_command ("tar cpf $target --numeric-owner -C '$rootdir' ./etc/appliance.info");
 685     $self->run_command ("tar rpf $target --numeric-owner -C '$rootdir' --exclude ./etc/appliance.info .");
 686
 687     $self->logmsg ("compressing archive ($compressor_ext)\n");
 688     if ($use_zstd) {
 689         $self->run_command ("zstd -19 --rm $target");
 690     } else {
 691         $self->run_command ("gzip -9 $target");
 692     }
 693
 694     my $target_size = int(-s "$target.$compressor_ext") >> 20;
 695     $self->logmsg ("created '$target.$compressor_ext' with size: $target_size MB\n");
 696 }
 697
 698 sub enter {
 699     my ($self) = @_;
 700     my $veid = $self->{veid};
 701     my $conffile = $self->{veconffile};
 702
 703     my $vestat = $self->ve_status();
 704     if (!$vestat->{exist}) {
 705         $self->logmsg ("Please create the appliance first (bootstrap)");
 706         return;
 707     }
 708
 709     if (!$vestat->{running}) {
 710         $self->start_container();
 711     }
 712
 713     system ("lxc-attach -n $veid --rcfile $conffile --clear-env");
 714 }
 715
 716 sub clean {
 717     my ($self, $all) = @_;
 718
 719     unlink $self->{logfile};
 720     unlink $self->{'pacman.conf'};
 721     $self->ve_destroy();
 722     unlink '.veid';
 723     unlink $self->{veconffile};
 724
 725     rmtree $self->{pkgcache} if $all;
 726 }
 727
 728 1;