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