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