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 [multilib]
 252 $servers
 253 EOF
 254
 255     mkdir $self->{rootfs} || die "unable to create rootfs - $!";
 256
 257     $self->logmsg("configured VE $self->{veid}\n");
 258 }
 259
 260 sub ve_status {
 261     my ($self) = @_;
 262
 263     my $veid = $self->{veid};
 264
 265     my $res = { running => 0 };
 266
 267     $res->{exist} = 1 if -d "$self->{rootfs}/usr";
 268
 269     my $filename = "/proc/net/unix";
 270
 271     # similar test is used by lcxcontainers.c: list_active_containers
 272     my $fh = IO::File->new ($filename, "r");
 273     return $res if !$fh;
 274
 275     while (defined(my $line = <$fh>)) {
 276         if ($line =~ m/^[a-f0-9]+:\s\S+\s\S+\s\S+\s\S+\s\S+\s\d+\s(\S+)$/) {
 277             my $path = $1;
 278             if ($path =~ m!^@/\S+/$veid/command$!) {
 279                 $res->{running} = 1;
 280             }
 281         }
 282     }
 283     close($fh);
 284
 285     return $res;
 286 }
 287
 288 sub ve_destroy {
 289     my ($self) = @_;
 290
 291     my $veid = $self->{veid}; # fixme
 292
 293     my $vestat = $self->ve_status();
 294     if ($vestat->{running}) {
 295         $self->stop_container();
 296     }
 297
 298     rmtree $self->{rootfs};
 299     unlink $self->{veconffile};
 300 }
 301
 302 sub ve_init {
 303     my ($self) = @_;
 304
 305
 306     my $veid = $self->{veid};
 307
 308     $self->logmsg ("initialize VE $veid\n");
 309
 310     my $vestat = $self->ve_status();
 311     if ($vestat->{running}) {
 312         $self->run_command ("lxc-stop -n $veid --kill");
 313     }
 314
 315     rmtree $self->{rootfs};
 316     mkpath $self->{rootfs};
 317 }
 318
 319 sub ve_command {
 320     my ($self, $cmd, $input) = @_;
 321
 322     my $veid = $self->{veid};
 323
 324     if (ref ($cmd) eq 'ARRAY') {
 325         unshift @$cmd, 'lxc-attach', '-n', $veid, '--clear-env', '--';
 326         $self->run_command ($cmd, $input);
 327     } else {
 328         $self->run_command ("lxc-attach -n $veid --clear-env -- $cmd", $input);
 329     }
 330 }
 331
 332 sub ve_exec {
 333     my ($self, @cmd) = @_;
 334
 335     my $veid = $self->{veid};
 336
 337     my $reader;
 338     my $pid = open2($reader, "<&STDIN", 'lxc-attach', '-n', $veid,  '--', @cmd)
 339         or die "unable to exec command";
 340
 341     while (defined (my $line = <$reader>)) {
 342         $self->logmsg ($line);
 343     }
 344
 345     waitpid ($pid, 0);
 346     my $rc = $? >> 8;
 347
 348     die "ve_exec failed - status $rc\n" if $rc != 0;
 349 }
 350
 351 sub run_command {
 352     my ($self, $cmd, $input, $getoutput) = @_;
 353
 354     my $reader = IO::File->new();
 355     my $writer = IO::File->new();
 356     my $error  = IO::File->new();
 357
 358     my $orig_pid = $$;
 359
 360     my $cmdstr = ref ($cmd) eq 'ARRAY' ? join (' ', @$cmd) : $cmd;
 361
 362     my $pid;
 363     eval {
 364         if (ref ($cmd) eq 'ARRAY') {
 365             $pid = open3 ($writer, $reader, $error, @$cmd) || die $!;
 366         } else {
 367             $pid = open3 ($writer, $reader, $error, $cmdstr) || die $!;
 368         }
 369     };
 370
 371     my $err = $@;
 372
 373     # catch exec errors
 374     if ($orig_pid != $$) {
 375         $self->logmsg ("ERROR: command '$cmdstr' failed - fork failed\n");
 376         POSIX::_exit (1);
 377         kill ('KILL', $$);
 378     }
 379
 380     die $err if $err;
 381
 382     print $writer $input if defined $input;
 383     close $writer;
 384
 385     my $select = new IO::Select;
 386     $select->add ($reader);
 387     $select->add ($error);
 388
 389     my $res = '';
 390     my $logfd = $self->{logfd};
 391
 392     while ($select->count) {
 393         my @handles = $select->can_read ();
 394
 395         foreach my $h (@handles) {
 396             my $buf = '';
 397             my $count = sysread ($h, $buf, 4096);
 398             if (!defined ($count)) {
 399                 waitpid ($pid, 0);
 400                 die "command '$cmdstr' failed: $!";
 401             }
 402             $select->remove ($h) if !$count;
 403
 404             print $logfd $buf;
 405
 406             $res .= $buf if $getoutput;
 407         }
 408     }
 409
 410     waitpid ($pid, 0);
 411     my $ec = ($? >> 8);
 412
 413     die "command '$cmdstr' failed with exit code $ec\n" if $ec;
 414
 415     return $res;
 416 }
 417
 418 sub start_container {
 419     my ($self) = @_;
 420     my $veid = $self->{veid};
 421     $self->run_command(['lxc-start', '-n', $veid, '-f', $self->{veconffile}, '/usr/bin/aab_fake_init']);
 422 }
 423
 424 sub stop_container {
 425     my ($self) = @_;
 426     my $veid = $self->{veid};
 427     $self->run_command ("lxc-stop -n $veid --kill");
 428 }
 429
 430 sub pacman_command {
 431     my ($self) = @_;
 432     my $root = $self->{rootfs};
 433     return ('/usr/bin/pacman',
 434             '--root', $root,
 435             '--cachedir', $self->{pkgcache},
 436             '--noconfirm');
 437 }
 438
 439 sub cache_packages {
 440     my ($self, $packages) = @_;
 441     my $root = $self->{rootfs};
 442
 443     my @pacman = $self->pacman_command();
 444     $self->run_command([@pacman, '-Sw', '--', @$packages]);
 445 }
 446
 447 sub bootstrap {
 448     my ($self, $include, $exclude) = @_;
 449     my $root = $self->{rootfs};
 450
 451     my @pacman = $self->pacman_command();
 452
 453     print "Fetching package database...\n";
 454     mkpath $self->{pkgcache};
 455     mkpath $self->{pkgdir};
 456     mkpath "$root/var/lib/pacman";
 457     $self->run_command([@pacman, '-Sy']);
 458
 459     print "Figuring out what to install...\n";
 460     my $incl = { map { $_ => 1 } @{$self->{incl}} };
 461     my $excl = { map { $_ => 1 } @{$self->{excl}} };
 462
 463     foreach my $addinc (@$include) {
 464         $incl->{$addinc} = 1;
 465         delete $excl->{$addinc};
 466     }
 467     foreach my $addexc (@$exclude) {
 468         $excl->{$addexc} = 1;
 469         delete $incl->{$addexc};
 470     }
 471
 472     my $expand = sub {
 473         my ($lst) = @_;
 474         foreach my $inc (keys %$lst) {
 475             my $group;
 476             eval { $group = $self->run_command([@pacman, '-Sqg', $inc], undef, 1); };
 477             if ($group && !$@) {
 478                 # add the group
 479                 delete $lst->{$inc};
 480                 $lst->{$_} = 1 foreach split(/\s+/, $group);
 481             }
 482         }
 483     };
 484
 485     $expand->($incl);
 486     $expand->($excl);
 487
 488     my $packages = [ grep { !$excl->{$_} } keys %$incl ];
 489
 490     print "Setting up basic environment...\n";
 491     mkpath "$root/etc";
 492     mkpath "$root/usr/bin";
 493
 494     my $data = "# UNCONFIGURED FSTAB FOR BASE SYSTEM\n";
 495     write_file ($data, "$root/etc/fstab", 0644);
 496
 497     write_file ("", "$root/etc/resolv.conf", 0644);
 498     write_file("localhost\n", "$root/etc/hostname", 0644);
 499     $self->run_command(['install', '-m0755', $fake_init, "$root/usr/bin/aab_fake_init"]);
 500
 501     unlink "$root/etc/localtime";
 502     symln '/usr/share/zoneinfo/UTC', "$root/etc/localtime";
 503
 504     print "Caching packages...\n";
 505     $self->cache_packages($packages);
 506     #$self->copy_packages();
 507
 508     print "Installing package manager and essentials...\n";
 509     # inetutils for 'hostname' for our init
 510     $self->run_command([@pacman, '-S', 'pacman', 'inetutils', 'archlinux-keyring']);
 511
 512     print "Setting up pacman for installation from cache...\n";
 513     my $file = "$root/etc/pacman.d/mirrorlist";
 514     my $backup = "${file}.aab_orig";
 515     if (!-f $backup) {
 516         rename_file($file, $backup);
 517         write_file("Server = file://$PKGDIR\n", $file);
 518     }
 519
 520     print "Populating keyring...\n";
 521     $self->run_command(['mount', '-t', 'devtmpfs', '-o', 'mode=0755,nosuid', 'udev', "$root/dev"]);
 522     $self->run_command(['unshare', '--fork', '--pid', 'chroot', "$root", 'pacman-key', '--init']);
 523     $self->run_command(['unshare', '--fork', '--pid', 'chroot', "$root", 'pacman-key', '--populate']);
 524     $self->run_command(['umount', "$root/dev"]);
 525
 526     print "Starting container...\n";
 527     $self->start_container();
 528
 529     print "Installing packages...\n";
 530     $self->ve_command(['pacman', '-S', '--needed', '--noconfirm', '--', @$packages]);
 531 }
 532
 533 sub install {
 534     my ($self, $pkglist) = @_;
 535
 536     $self->cache_packages($pkglist);
 537     $self->ve_command(['pacman', '-S', '--needed', '--noconfirm', '--', @$pkglist]);
 538 }
 539
 540 sub write_config {
 541     my ($self, $filename, $size) = @_;
 542
 543     my $config = $self->{config};
 544
 545     my $data = '';
 546
 547     $data .= "Name: $config->{name}\n";
 548     $data .= "Version: $config->{version}\n";
 549     $data .= "Type: lxc\n";
 550     $data .= "OS: archlinux\n";
 551     $data .= "Section: $config->{section}\n";
 552     $data .= "Maintainer: $config->{maintainer}\n";
 553     $data .= "Architecture: $config->{architecture}\n";
 554     $data .= "Installed-Size: $size\n";
 555
 556     # optional
 557     $data .= "Infopage: $config->{infopage}\n" if $config->{infopage};
 558     $data .= "ManageUrl: $config->{manageurl}\n" if $config->{manageurl};
 559     $data .= "Certified: $config->{certified}\n" if $config->{certified};
 560
 561     # description
 562     $data .= "Description: $config->{headline}\n";
 563     $data .= "$config->{description}\n" if $config->{description};
 564
 565     write_file ($data, $filename, 0644);
 566 }
 567
 568 sub finalize {
 569     my ($self) = @_;
 570     my $rootdir = $self->{rootfs};
 571
 572     print "Stopping container...\n";
 573     $self->stop_container();
 574
 575     print "Rolling back mirrorlist changes...\n";
 576     my $file = "$rootdir/etc/pacman.d/mirrorlist";
 577     unlink $file;
 578     rename_file($file.'.aab_orig', $file);
 579
 580     my $sizestr = $self->run_command("du -sm $rootdir", undef, 1);
 581     my $size;
 582     if ($sizestr =~ m/^(\d+)\s+\Q$rootdir\E$/) {
 583         $size = $1;
 584     } else {
 585         die "unable to detect size\n";
 586     }
 587     $self->logmsg ("$size MB\n");
 588
 589     $self->write_config ("$rootdir/etc/appliance.info", $size);
 590
 591     $self->logmsg ("creating final appliance archive\n");
 592
 593     my $target = "$self->{targetname}.tar";
 594     unlink $target;
 595     unlink "$target.gz";
 596
 597     $self->run_command ("tar cpf $target --numeric-owner -C '$rootdir' ./etc/appliance.info");
 598     $self->run_command ("tar rpf $target --numeric-owner -C '$rootdir' --exclude ./etc/appliance.info .");
 599     $self->run_command ("gzip $target");
 600 }
 601
 602 sub enter {
 603     my ($self) = @_;
 604     my $veid = $self->{veid};
 605
 606     my $vestat = $self->ve_status();
 607     if (!$vestat->{exist}) {
 608         $self->logmsg ("Please create the appliance first (bootstrap)");
 609         return;
 610     }
 611
 612     if (!$vestat->{running}) {
 613         $self->start_container();
 614     }
 615
 616     system ("lxc-attach -n $veid --clear-env");
 617 }
 618
 619 sub clean {
 620     my ($self, $all) = @_;
 621
 622     unlink $self->{logfile};
 623     unlink $self->{'pacman.conf'};
 624     $self->ve_destroy();
 625     unlink '.veid';
 626     rmtree $self->{pkgcache} if $all;
 627 }
 628
 629 1;