From: Wolfgang Bumiller <w.bumiller@proxmox.com>
Date: Fri, 21 Aug 2015 08:02:48 +0000 (+0200)
Subject: move AAB.pm to PVE/
X-Git-Url: https://git.proxmox.com/?p=aab.git;a=commitdiff_plain;h=36cffb85ebc49f705ca3fc32b37eba23fd527024

move AAB.pm to PVE/
---

diff --git a/AAB.pm b/AAB.pm
deleted file mode 100644
index 5bab200..0000000
--- a/AAB.pm
+++ /dev/null
@@ -1,629 +0,0 @@
-package PVE::AAB;
-
-use strict;
-use warnings;
-
-use File::Path;
-use File::Copy;
-use IO::File;
-use IO::Select;
-use IPC::Open3;
-use UUID;
-use Cwd;
-
-my @BASE_PACKAGES = qw(base openssh);
-my @BASE_EXCLUDES = qw(e2fsprogs
-                       jfsutils
-                       linux
-                       lvm2
-                       mdadm
-                       netctl
-                       pcmciautils
-                       reiserfsprogs
-                       xfsprogs);
-
-my $PKGDIR = "/var/cache/pacman/pkg";
-
-my ($aablibdir, $fake_init);
-
-sub setup_defaults($) {
-    my ($dir) = @_;
-    $aablibdir = $dir;
-    $fake_init = "$aablibdir/scripts/init.bash";
-}
-
-setup_defaults('/usr/lib/aab');
-
-sub write_file {
-    my ($data, $file, $perm) = @_;
-
-    die "no filename" if !$file;
-    unlink $file;
-
-    my $fh = IO::File->new ($file, O_WRONLY | O_CREAT, $perm) ||
-	die "unable to open file '$file'";
-
-    print $fh $data;
-    $fh->close;
-}
-
-sub copy_file {
-    my ($a, $b) = @_;
-    copy($a, $b) or die "failed to copy $a => $b: $!";
-}
-
-sub rename_file {
-    my ($a, $b) = @_;
-    rename($a, $b) or die "failed to rename $a => $b: $!";
-}
-
-sub symln {
-    my ($a, $b) = @_;
-    symlink($a, $b) or die "failed to symlink $a => $b: $!";
-}
-
-sub logmsg {
-    my $self = shift;
-    print STDERR @_;
-    $self->writelog (@_);
-}
-
-sub writelog {
-    my $self = shift;
-    my $fd = $self->{logfd};
-    print $fd @_;
-}
-
-sub read_config {
-    my ($filename) = @_;
-
-    my $res = {};
-
-    my $fh = IO::File->new ("<$filename") || return $res;
-    my $rec = '';
-
-    while (defined (my $line = <$fh>)) {
-	next if $line =~ m/^\#/;
-	next if $line =~ m/^\s*$/;
-	$rec .= $line;
-    };
-
-    close ($fh);
-
-    chomp $rec;
-    $rec .= "\n";
-
-    while ($rec) {
-	if ($rec =~ s/^Description:\s*([^\n]*)(\n\s+.*)*$//si) {
-	    $res->{headline} = $1;
-	    chomp $res->{headline};
-	    my $long = $2;
-	    $long =~ s/^\s+/ /;
-	    $res->{description} = $long;
-	    chomp $res->{description};	    
-	} elsif ($rec =~ s/^([^:]+):\s*(.*\S)\s*\n//) {
-	    my ($key, $value) = (lc ($1), $2);
-	    if ($key eq 'source' || $key eq 'mirror') {
-		push @{$res->{$key}}, $value;
-	    } else {
-		die "duplicate key '$key'\n" if defined ($res->{$key});
-		$res->{$key} = $value;
-	    }
-	} else {
-	    die "unable to parse config file: $rec";
-	}
-    }
-
-    die "unable to parse config file" if $rec;
-
-    return $res;
-}
-
-sub new {
-    my ($class, $config) = @_;
-
-    $config = read_config ('aab.conf') if !$config;
-    my $version = $config->{version};
-    die "no 'version' specified\n" if !$version;
-    die "no 'section' specified\n" if !$config->{section};
-    die "no 'description' specified\n" if !$config->{headline};
-    die "no 'maintainer' specified\n" if !$config->{maintainer};
-
-    my $name = $config->{name} || die "no 'name' specified\n";
-    $name =~ m/^[a-z][0-9a-z\-\*\.]+$/ || 
-	die "illegal characters in name '$name'\n";
-
-    my $targetname;
-    if ($name =~ m/^archlinux/) {
-	$targetname = "${name}_${version}_$config->{architecture}";
-    } else {
-	$targetname = "archlinux-${name}_${version}_$config->{architecture}";
-    }
-
-    my $self = { logfile => 'logfile',
-                 config => $config,
-                 targetname => $targetname,
-                 incl => [@BASE_PACKAGES],
-                 excl => [@BASE_EXCLUDES],
-               };
-
-    $self->{logfd} = IO::File->new($self->{logfile}, O_WRONLY | O_APPEND | O_CREAT)
-	or die "unable to open log file";
-
-    bless $self, $class;
-
-    $self->__allocate_ve();
-
-    return $self;
-}
-
-sub __sample_config {
-    my ($self) = @_;
-
-    my $arch = $self->{config}->{architecture};
-
-    return <<"CFG";
-lxc.arch = $arch
-lxc.include = /usr/share/lxc/config/archlinux.common.conf
-lxc.utsname = localhost
-lxc.rootfs = $self->{rootfs}
-lxc.mount.entry = $self->{pkgcache} $self->{pkgdir} none bind 0 0
-CFG
-}
-
-sub __allocate_ve {
-    my ($self) = @_;
-
-    my $cid;
-    if (my $fd = IO::File->new(".veid")) {
-	$cid = <$fd>;
-	chomp $cid;
-	close ($fd);
-    }
-
-
-    $self->{working_dir} = getcwd;
-    $self->{veconffile} = "$self->{working_dir}/config";
-    $self->{rootfs} = "$self->{working_dir}/rootfs";
-    $self->{pkgdir} = "$self->{working_dir}/rootfs/$PKGDIR";
-    $self->{pkgcache} = "$self->{working_dir}/pkgcache";
-    $self->{'pacman.conf'} = "$self->{working_dir}/pacman.conf";
-
-    if ($cid) {
-	$self->{veid} = $cid;
-	return $cid;
-    }
-
-    my $uuid;
-    my $uuid_str;
-    UUID::generate($uuid);
-    UUID::unparse($uuid, $uuid_str);
-    $self->{veid} = $uuid_str;
-
-    my $fd = IO::File->new (">.veid") ||
-	die "unable to write '.veid'\n";
-    print $fd "$self->{veid}\n";
-    close ($fd);
-    $self->logmsg("allocated VE $self->{veid}\n");
-}
-
-sub initialize {
-    my ($self) = @_;
-
-    my $config = $self->{config};
-
-    $self->{logfd} = IO::File->new($self->{logfile}, O_WRONLY | O_TRUNC | O_CREAT)
-	or die "unable to open log file";
-
-    my $cdata = $self->__sample_config();
-
-    my $fh = IO::File->new($self->{veconffile}, O_WRONLY|O_CREAT|O_EXCL) ||
-	die "unable to write lxc config file '$self->{veconffile}' - $!";
-    print $fh $cdata;
-    close ($fh);
-
-    if (!$config->{source} && !$config->{mirror}) {
-	die "no sources/mirrors specified";
-    }
-
-    $config->{source} //= [];
-    $config->{mirror} //= [];
-
-    my $servers = "Server = "
-                . join("\nServer = ", @{$config->{source}}, @{$config->{mirror}})
-                . "\n";
-
-    $fh = IO::File->new($self->{'pacman.conf'}, O_WRONLY|O_CREAT|O_EXCL) ||
-	die "unable to write pacman config file $self->{'pacman.conf'} - $!";
-    print $fh <<"EOF";
-[options]
-HoldPkg = pacman glibc
-Architecture = $config->{architecture}
-CheckSpace
-SigLevel = Never
-
-[core]
-$servers
-[extra]
-$servers
-[community]
-$servers
-[multilib]
-$servers
-EOF
-
-    mkdir $self->{rootfs} || die "unable to create rootfs - $!";
-
-    $self->logmsg("configured VE $self->{veid}\n");
-}
-
-sub ve_status {
-    my ($self) = @_;
-
-    my $veid = $self->{veid};
-
-    my $res = { running => 0 };
-
-    $res->{exist} = 1 if -d "$self->{rootfs}/usr";
-
-    my $filename = "/proc/net/unix";
-
-    # similar test is used by lcxcontainers.c: list_active_containers
-    my $fh = IO::File->new ($filename, "r");
-    return $res if !$fh;
-
-    while (defined(my $line = <$fh>)) {
-	if ($line =~ m/^[a-f0-9]+:\s\S+\s\S+\s\S+\s\S+\s\S+\s\d+\s(\S+)$/) {
-	    my $path = $1;
-	    if ($path =~ m!^@/\S+/$veid/command$!) {
-		$res->{running} = 1;
-	    }
-	}
-    }
-    close($fh);
-    
-    return $res;
-}
-
-sub ve_destroy {
-    my ($self) = @_;
-
-    my $veid = $self->{veid}; # fixme
-
-    my $vestat = $self->ve_status();
-    if ($vestat->{running}) {
-	$self->stop_container();
-    }
-
-    rmtree $self->{rootfs};
-    unlink $self->{veconffile};
-}
-
-sub ve_init {
-    my ($self) = @_;
-
-
-    my $veid = $self->{veid};
-
-    $self->logmsg ("initialize VE $veid\n");
-
-    my $vestat = $self->ve_status();
-    if ($vestat->{running}) {
-	$self->run_command ("lxc-stop -n $veid --kill");
-    } 
-
-    rmtree $self->{rootfs};
-    mkpath $self->{rootfs};
-}
-
-sub ve_command {
-    my ($self, $cmd, $input) = @_;
-
-    my $veid = $self->{veid};
-
-    if (ref ($cmd) eq 'ARRAY') {
-	unshift @$cmd, 'lxc-attach', '-n', $veid, '--clear-env', '--';
-	$self->run_command ($cmd, $input);
-    } else {
-	$self->run_command ("lxc-attach -n $veid --clear-env -- $cmd", $input);
-    }
-}
-
-sub ve_exec {
-    my ($self, @cmd) = @_;
-
-    my $veid = $self->{veid};
-
-    my $reader;
-    my $pid = open2($reader, "<&STDIN", 'lxc-attach', '-n', $veid,  '--', @cmd)
-	or die "unable to exec command";
-
-    while (defined (my $line = <$reader>)) {
-	$self->logmsg ($line);
-    }
-
-    waitpid ($pid, 0);
-    my $rc = $? >> 8;
-
-    die "ve_exec failed - status $rc\n" if $rc != 0;
-}
-
-sub run_command {
-    my ($self, $cmd, $input, $getoutput) = @_;
-
-    my $reader = IO::File->new();
-    my $writer = IO::File->new();
-    my $error  = IO::File->new();
-
-    my $orig_pid = $$;
-
-    my $cmdstr = ref ($cmd) eq 'ARRAY' ? join (' ', @$cmd) : $cmd;
-
-    my $pid;
-    eval {
-	if (ref ($cmd) eq 'ARRAY') {
-	    $pid = open3 ($writer, $reader, $error, @$cmd) || die $!;
-	} else {
-	    $pid = open3 ($writer, $reader, $error, $cmdstr) || die $!;
-	}
-    };
-
-    my $err = $@;
-
-    # catch exec errors
-    if ($orig_pid != $$) {
-	$self->logmsg ("ERROR: command '$cmdstr' failed - fork failed\n");
-	POSIX::_exit (1); 
-	kill ('KILL', $$); 
-    }
-
-    die $err if $err;
-
-    print $writer $input if defined $input;
-    close $writer;
-
-    my $select = new IO::Select;
-    $select->add ($reader);
-    $select->add ($error);
-
-    my $res = '';
-    my $logfd = $self->{logfd};
-
-    while ($select->count) {
-	my @handles = $select->can_read ();
-
-	foreach my $h (@handles) {
-	    my $buf = '';
-	    my $count = sysread ($h, $buf, 4096);
-	    if (!defined ($count)) {
-		waitpid ($pid, 0);
-		die "command '$cmdstr' failed: $!";
-	    }
-	    $select->remove ($h) if !$count;
-
-	    print $logfd $buf;
-
-	    $res .= $buf if $getoutput;
-	}
-    }
-
-    waitpid ($pid, 0);
-    my $ec = ($? >> 8);
-
-    die "command '$cmdstr' failed with exit code $ec\n" if $ec;
-
-    return $res;
-}
-
-sub start_container {
-    my ($self) = @_;
-    my $veid = $self->{veid};
-    $self->run_command(['lxc-start', '-n', $veid, '-f', $self->{veconffile}, '/usr/bin/aab_fake_init']);
-}
-
-sub stop_container {
-    my ($self) = @_;
-    my $veid = $self->{veid};
-    $self->run_command ("lxc-stop -n $veid --kill");
-}
-
-sub pacman_command {
-    my ($self) = @_;
-    my $root = $self->{rootfs};
-    return ('/usr/bin/pacman',
-            '--root', $root,
-            '--cachedir', $self->{pkgcache},
-            '--noconfirm');
-}
-
-sub cache_packages {
-    my ($self, $packages) = @_;
-    my $root = $self->{rootfs};
-
-    my @pacman = $self->pacman_command();
-    $self->run_command([@pacman, '-Sw', '--', @$packages]);
-}
-
-sub bootstrap {
-    my ($self, $include, $exclude) = @_;
-    my $root = $self->{rootfs};
-
-    my @pacman = $self->pacman_command();
-
-    print "Fetching package database...\n";
-    mkpath $self->{pkgcache};
-    mkpath $self->{pkgdir};
-    mkpath "$root/var/lib/pacman";
-    $self->run_command([@pacman, '-Sy']);
-
-    print "Figuring out what to install...\n";
-    my $incl = { map { $_ => 1 } @{$self->{incl}} };
-    my $excl = { map { $_ => 1 } @{$self->{excl}} };
-
-    foreach my $addinc (@$include) {
-	$incl->{$addinc} = 1;
-	delete $excl->{$addinc};
-    }
-    foreach my $addexc (@$exclude) {
-	$excl->{$addexc} = 1;
-	delete $incl->{$addexc};
-    }
-
-    my $expand = sub {
-	my ($lst) = @_;
-	foreach my $inc (keys %$lst) {
-	    my $group;
-	    eval { $group = $self->run_command([@pacman, '-Sqg', $inc], undef, 1); };
-	    if ($group && !$@) {
-		# add the group
-		delete $lst->{$inc};
-		$lst->{$_} = 1 foreach split(/\s+/, $group);
-	    }
-	}
-    };
-
-    $expand->($incl);
-    $expand->($excl);
-
-    my $packages = [ grep { !$excl->{$_} } keys %$incl ];
-
-    print "Setting up basic environment...\n";
-    mkpath "$root/etc";
-    mkpath "$root/usr/bin";
-
-    my $data = "# UNCONFIGURED FSTAB FOR BASE SYSTEM\n";
-    write_file ($data, "$root/etc/fstab", 0644);
-
-    write_file ("", "$root/etc/resolv.conf", 0644);
-    write_file("localhost\n", "$root/etc/hostname", 0644);
-    $self->run_command(['install', '-m0755', $fake_init, "$root/usr/bin/aab_fake_init"]);
-
-    unlink "$root/etc/localtime";
-    symln '/usr/share/zoneinfo/UTC', "$root/etc/localtime";
-
-    print "Caching packages...\n";
-    $self->cache_packages($packages);
-    #$self->copy_packages();
-
-    print "Installing package manager and essentials...\n";
-    # inetutils for 'hostname' for our init
-    $self->run_command([@pacman, '-S', 'pacman', 'inetutils', 'archlinux-keyring']);
-
-    print "Setting up pacman for installation from cache...\n";
-    my $file = "$root/etc/pacman.d/mirrorlist";
-    my $backup = "${file}.aab_orig";
-    if (!-f $backup) {
-	rename_file($file, $backup);
-	write_file("Server = file://$PKGDIR\n", $file);
-    }
-
-    print "Populating keyring...\n";
-    $self->run_command(['mount', '-t', 'devtmpfs', '-o', 'mode=0755,nosuid', 'udev', "$root/dev"]);
-    $self->run_command(['unshare', '--fork', '--pid', 'chroot', "$root", 'pacman-key', '--init']);
-    $self->run_command(['unshare', '--fork', '--pid', 'chroot', "$root", 'pacman-key', '--populate']);
-    $self->run_command(['umount', "$root/dev"]);
-
-    print "Starting container...\n";
-    $self->start_container();
-
-    print "Installing packages...\n";
-    $self->ve_command(['pacman', '-S', '--needed', '--noconfirm', '--', @$packages]);
-}
-
-sub install {
-    my ($self, $pkglist) = @_;
-
-    $self->cache_packages($pkglist);
-    $self->ve_command(['pacman', '-S', '--needed', '--noconfirm', '--', @$pkglist]);
-}
-
-sub write_config {
-    my ($self, $filename, $size) = @_;
-
-    my $config = $self->{config};
-
-    my $data = '';
-
-    $data .= "Name: $config->{name}\n";
-    $data .= "Version: $config->{version}\n";
-    $data .= "Type: lxc\n";
-    $data .= "OS: archlinux\n";
-    $data .= "Section: $config->{section}\n";
-    $data .= "Maintainer: $config->{maintainer}\n";
-    $data .= "Architecture: $config->{architecture}\n";
-    $data .= "Installed-Size: $size\n";
-
-    # optional
-    $data .= "Infopage: $config->{infopage}\n" if $config->{infopage};
-    $data .= "ManageUrl: $config->{manageurl}\n" if $config->{manageurl};
-    $data .= "Certified: $config->{certified}\n" if $config->{certified};
-
-    # description
-    $data .= "Description: $config->{headline}\n";
-    $data .= "$config->{description}\n" if $config->{description};
-
-    write_file ($data, $filename, 0644);
-}
-
-sub finalize {
-    my ($self) = @_;
-    my $rootdir = $self->{rootfs};
-
-    print "Stopping container...\n";
-    $self->stop_container();
-
-    print "Rolling back mirrorlist changes...\n";
-    my $file = "$rootdir/etc/pacman.d/mirrorlist";
-    unlink $file;
-    rename_file($file.'.aab_orig', $file);
-
-    my $sizestr = $self->run_command("du -sm $rootdir", undef, 1);
-    my $size;
-    if ($sizestr =~ m/^(\d+)\s+\Q$rootdir\E$/) {
-	$size = $1;
-    } else {
-	die "unable to detect size\n";
-    }
-    $self->logmsg ("$size MB\n");
-
-    $self->write_config ("$rootdir/etc/appliance.info", $size);
-
-    $self->logmsg ("creating final appliance archive\n");
-
-    my $target = "$self->{targetname}.tar";
-    unlink $target;
-    unlink "$target.gz";
-
-    $self->run_command ("tar cpf $target --numeric-owner -C '$rootdir' ./etc/appliance.info");
-    $self->run_command ("tar rpf $target --numeric-owner -C '$rootdir' --exclude ./etc/appliance.info .");
-    $self->run_command ("gzip $target");
-}
-
-sub enter {
-    my ($self) = @_;
-    my $veid = $self->{veid};
-
-    my $vestat = $self->ve_status();
-    if (!$vestat->{exist}) {
-	$self->logmsg ("Please create the appliance first (bootstrap)");
-	return;
-    }
-
-    if (!$vestat->{running}) {
-	$self->start_container();
-    }
-
-    system ("lxc-attach -n $veid --clear-env");
-}
-
-sub clean {
-    my ($self, $all) = @_;
-
-    unlink $self->{logfile};
-    unlink $self->{'pacman.conf'};
-    $self->ve_destroy();
-    unlink '.veid';
-    rmtree $self->{pkgcache} if $all;
-}
-
-1;
diff --git a/PVE/AAB.pm b/PVE/AAB.pm
new file mode 100644
index 0000000..5bab200
--- /dev/null
+++ b/PVE/AAB.pm
@@ -0,0 +1,629 @@
+package PVE::AAB;
+
+use strict;
+use warnings;
+
+use File::Path;
+use File::Copy;
+use IO::File;
+use IO::Select;
+use IPC::Open3;
+use UUID;
+use Cwd;
+
+my @BASE_PACKAGES = qw(base openssh);
+my @BASE_EXCLUDES = qw(e2fsprogs
+                       jfsutils
+                       linux
+                       lvm2
+                       mdadm
+                       netctl
+                       pcmciautils
+                       reiserfsprogs
+                       xfsprogs);
+
+my $PKGDIR = "/var/cache/pacman/pkg";
+
+my ($aablibdir, $fake_init);
+
+sub setup_defaults($) {
+    my ($dir) = @_;
+    $aablibdir = $dir;
+    $fake_init = "$aablibdir/scripts/init.bash";
+}
+
+setup_defaults('/usr/lib/aab');
+
+sub write_file {
+    my ($data, $file, $perm) = @_;
+
+    die "no filename" if !$file;
+    unlink $file;
+
+    my $fh = IO::File->new ($file, O_WRONLY | O_CREAT, $perm) ||
+	die "unable to open file '$file'";
+
+    print $fh $data;
+    $fh->close;
+}
+
+sub copy_file {
+    my ($a, $b) = @_;
+    copy($a, $b) or die "failed to copy $a => $b: $!";
+}
+
+sub rename_file {
+    my ($a, $b) = @_;
+    rename($a, $b) or die "failed to rename $a => $b: $!";
+}
+
+sub symln {
+    my ($a, $b) = @_;
+    symlink($a, $b) or die "failed to symlink $a => $b: $!";
+}
+
+sub logmsg {
+    my $self = shift;
+    print STDERR @_;
+    $self->writelog (@_);
+}
+
+sub writelog {
+    my $self = shift;
+    my $fd = $self->{logfd};
+    print $fd @_;
+}
+
+sub read_config {
+    my ($filename) = @_;
+
+    my $res = {};
+
+    my $fh = IO::File->new ("<$filename") || return $res;
+    my $rec = '';
+
+    while (defined (my $line = <$fh>)) {
+	next if $line =~ m/^\#/;
+	next if $line =~ m/^\s*$/;
+	$rec .= $line;
+    };
+
+    close ($fh);
+
+    chomp $rec;
+    $rec .= "\n";
+
+    while ($rec) {
+	if ($rec =~ s/^Description:\s*([^\n]*)(\n\s+.*)*$//si) {
+	    $res->{headline} = $1;
+	    chomp $res->{headline};
+	    my $long = $2;
+	    $long =~ s/^\s+/ /;
+	    $res->{description} = $long;
+	    chomp $res->{description};	    
+	} elsif ($rec =~ s/^([^:]+):\s*(.*\S)\s*\n//) {
+	    my ($key, $value) = (lc ($1), $2);
+	    if ($key eq 'source' || $key eq 'mirror') {
+		push @{$res->{$key}}, $value;
+	    } else {
+		die "duplicate key '$key'\n" if defined ($res->{$key});
+		$res->{$key} = $value;
+	    }
+	} else {
+	    die "unable to parse config file: $rec";
+	}
+    }
+
+    die "unable to parse config file" if $rec;
+
+    return $res;
+}
+
+sub new {
+    my ($class, $config) = @_;
+
+    $config = read_config ('aab.conf') if !$config;
+    my $version = $config->{version};
+    die "no 'version' specified\n" if !$version;
+    die "no 'section' specified\n" if !$config->{section};
+    die "no 'description' specified\n" if !$config->{headline};
+    die "no 'maintainer' specified\n" if !$config->{maintainer};
+
+    my $name = $config->{name} || die "no 'name' specified\n";
+    $name =~ m/^[a-z][0-9a-z\-\*\.]+$/ || 
+	die "illegal characters in name '$name'\n";
+
+    my $targetname;
+    if ($name =~ m/^archlinux/) {
+	$targetname = "${name}_${version}_$config->{architecture}";
+    } else {
+	$targetname = "archlinux-${name}_${version}_$config->{architecture}";
+    }
+
+    my $self = { logfile => 'logfile',
+                 config => $config,
+                 targetname => $targetname,
+                 incl => [@BASE_PACKAGES],
+                 excl => [@BASE_EXCLUDES],
+               };
+
+    $self->{logfd} = IO::File->new($self->{logfile}, O_WRONLY | O_APPEND | O_CREAT)
+	or die "unable to open log file";
+
+    bless $self, $class;
+
+    $self->__allocate_ve();
+
+    return $self;
+}
+
+sub __sample_config {
+    my ($self) = @_;
+
+    my $arch = $self->{config}->{architecture};
+
+    return <<"CFG";
+lxc.arch = $arch
+lxc.include = /usr/share/lxc/config/archlinux.common.conf
+lxc.utsname = localhost
+lxc.rootfs = $self->{rootfs}
+lxc.mount.entry = $self->{pkgcache} $self->{pkgdir} none bind 0 0
+CFG
+}
+
+sub __allocate_ve {
+    my ($self) = @_;
+
+    my $cid;
+    if (my $fd = IO::File->new(".veid")) {
+	$cid = <$fd>;
+	chomp $cid;
+	close ($fd);
+    }
+
+
+    $self->{working_dir} = getcwd;
+    $self->{veconffile} = "$self->{working_dir}/config";
+    $self->{rootfs} = "$self->{working_dir}/rootfs";
+    $self->{pkgdir} = "$self->{working_dir}/rootfs/$PKGDIR";
+    $self->{pkgcache} = "$self->{working_dir}/pkgcache";
+    $self->{'pacman.conf'} = "$self->{working_dir}/pacman.conf";
+
+    if ($cid) {
+	$self->{veid} = $cid;
+	return $cid;
+    }
+
+    my $uuid;
+    my $uuid_str;
+    UUID::generate($uuid);
+    UUID::unparse($uuid, $uuid_str);
+    $self->{veid} = $uuid_str;
+
+    my $fd = IO::File->new (">.veid") ||
+	die "unable to write '.veid'\n";
+    print $fd "$self->{veid}\n";
+    close ($fd);
+    $self->logmsg("allocated VE $self->{veid}\n");
+}
+
+sub initialize {
+    my ($self) = @_;
+
+    my $config = $self->{config};
+
+    $self->{logfd} = IO::File->new($self->{logfile}, O_WRONLY | O_TRUNC | O_CREAT)
+	or die "unable to open log file";
+
+    my $cdata = $self->__sample_config();
+
+    my $fh = IO::File->new($self->{veconffile}, O_WRONLY|O_CREAT|O_EXCL) ||
+	die "unable to write lxc config file '$self->{veconffile}' - $!";
+    print $fh $cdata;
+    close ($fh);
+
+    if (!$config->{source} && !$config->{mirror}) {
+	die "no sources/mirrors specified";
+    }
+
+    $config->{source} //= [];
+    $config->{mirror} //= [];
+
+    my $servers = "Server = "
+                . join("\nServer = ", @{$config->{source}}, @{$config->{mirror}})
+                . "\n";
+
+    $fh = IO::File->new($self->{'pacman.conf'}, O_WRONLY|O_CREAT|O_EXCL) ||
+	die "unable to write pacman config file $self->{'pacman.conf'} - $!";
+    print $fh <<"EOF";
+[options]
+HoldPkg = pacman glibc
+Architecture = $config->{architecture}
+CheckSpace
+SigLevel = Never
+
+[core]
+$servers
+[extra]
+$servers
+[community]
+$servers
+[multilib]
+$servers
+EOF
+
+    mkdir $self->{rootfs} || die "unable to create rootfs - $!";
+
+    $self->logmsg("configured VE $self->{veid}\n");
+}
+
+sub ve_status {
+    my ($self) = @_;
+
+    my $veid = $self->{veid};
+
+    my $res = { running => 0 };
+
+    $res->{exist} = 1 if -d "$self->{rootfs}/usr";
+
+    my $filename = "/proc/net/unix";
+
+    # similar test is used by lcxcontainers.c: list_active_containers
+    my $fh = IO::File->new ($filename, "r");
+    return $res if !$fh;
+
+    while (defined(my $line = <$fh>)) {
+	if ($line =~ m/^[a-f0-9]+:\s\S+\s\S+\s\S+\s\S+\s\S+\s\d+\s(\S+)$/) {
+	    my $path = $1;
+	    if ($path =~ m!^@/\S+/$veid/command$!) {
+		$res->{running} = 1;
+	    }
+	}
+    }
+    close($fh);
+    
+    return $res;
+}
+
+sub ve_destroy {
+    my ($self) = @_;
+
+    my $veid = $self->{veid}; # fixme
+
+    my $vestat = $self->ve_status();
+    if ($vestat->{running}) {
+	$self->stop_container();
+    }
+
+    rmtree $self->{rootfs};
+    unlink $self->{veconffile};
+}
+
+sub ve_init {
+    my ($self) = @_;
+
+
+    my $veid = $self->{veid};
+
+    $self->logmsg ("initialize VE $veid\n");
+
+    my $vestat = $self->ve_status();
+    if ($vestat->{running}) {
+	$self->run_command ("lxc-stop -n $veid --kill");
+    } 
+
+    rmtree $self->{rootfs};
+    mkpath $self->{rootfs};
+}
+
+sub ve_command {
+    my ($self, $cmd, $input) = @_;
+
+    my $veid = $self->{veid};
+
+    if (ref ($cmd) eq 'ARRAY') {
+	unshift @$cmd, 'lxc-attach', '-n', $veid, '--clear-env', '--';
+	$self->run_command ($cmd, $input);
+    } else {
+	$self->run_command ("lxc-attach -n $veid --clear-env -- $cmd", $input);
+    }
+}
+
+sub ve_exec {
+    my ($self, @cmd) = @_;
+
+    my $veid = $self->{veid};
+
+    my $reader;
+    my $pid = open2($reader, "<&STDIN", 'lxc-attach', '-n', $veid,  '--', @cmd)
+	or die "unable to exec command";
+
+    while (defined (my $line = <$reader>)) {
+	$self->logmsg ($line);
+    }
+
+    waitpid ($pid, 0);
+    my $rc = $? >> 8;
+
+    die "ve_exec failed - status $rc\n" if $rc != 0;
+}
+
+sub run_command {
+    my ($self, $cmd, $input, $getoutput) = @_;
+
+    my $reader = IO::File->new();
+    my $writer = IO::File->new();
+    my $error  = IO::File->new();
+
+    my $orig_pid = $$;
+
+    my $cmdstr = ref ($cmd) eq 'ARRAY' ? join (' ', @$cmd) : $cmd;
+
+    my $pid;
+    eval {
+	if (ref ($cmd) eq 'ARRAY') {
+	    $pid = open3 ($writer, $reader, $error, @$cmd) || die $!;
+	} else {
+	    $pid = open3 ($writer, $reader, $error, $cmdstr) || die $!;
+	}
+    };
+
+    my $err = $@;
+
+    # catch exec errors
+    if ($orig_pid != $$) {
+	$self->logmsg ("ERROR: command '$cmdstr' failed - fork failed\n");
+	POSIX::_exit (1); 
+	kill ('KILL', $$); 
+    }
+
+    die $err if $err;
+
+    print $writer $input if defined $input;
+    close $writer;
+
+    my $select = new IO::Select;
+    $select->add ($reader);
+    $select->add ($error);
+
+    my $res = '';
+    my $logfd = $self->{logfd};
+
+    while ($select->count) {
+	my @handles = $select->can_read ();
+
+	foreach my $h (@handles) {
+	    my $buf = '';
+	    my $count = sysread ($h, $buf, 4096);
+	    if (!defined ($count)) {
+		waitpid ($pid, 0);
+		die "command '$cmdstr' failed: $!";
+	    }
+	    $select->remove ($h) if !$count;
+
+	    print $logfd $buf;
+
+	    $res .= $buf if $getoutput;
+	}
+    }
+
+    waitpid ($pid, 0);
+    my $ec = ($? >> 8);
+
+    die "command '$cmdstr' failed with exit code $ec\n" if $ec;
+
+    return $res;
+}
+
+sub start_container {
+    my ($self) = @_;
+    my $veid = $self->{veid};
+    $self->run_command(['lxc-start', '-n', $veid, '-f', $self->{veconffile}, '/usr/bin/aab_fake_init']);
+}
+
+sub stop_container {
+    my ($self) = @_;
+    my $veid = $self->{veid};
+    $self->run_command ("lxc-stop -n $veid --kill");
+}
+
+sub pacman_command {
+    my ($self) = @_;
+    my $root = $self->{rootfs};
+    return ('/usr/bin/pacman',
+            '--root', $root,
+            '--cachedir', $self->{pkgcache},
+            '--noconfirm');
+}
+
+sub cache_packages {
+    my ($self, $packages) = @_;
+    my $root = $self->{rootfs};
+
+    my @pacman = $self->pacman_command();
+    $self->run_command([@pacman, '-Sw', '--', @$packages]);
+}
+
+sub bootstrap {
+    my ($self, $include, $exclude) = @_;
+    my $root = $self->{rootfs};
+
+    my @pacman = $self->pacman_command();
+
+    print "Fetching package database...\n";
+    mkpath $self->{pkgcache};
+    mkpath $self->{pkgdir};
+    mkpath "$root/var/lib/pacman";
+    $self->run_command([@pacman, '-Sy']);
+
+    print "Figuring out what to install...\n";
+    my $incl = { map { $_ => 1 } @{$self->{incl}} };
+    my $excl = { map { $_ => 1 } @{$self->{excl}} };
+
+    foreach my $addinc (@$include) {
+	$incl->{$addinc} = 1;
+	delete $excl->{$addinc};
+    }
+    foreach my $addexc (@$exclude) {
+	$excl->{$addexc} = 1;
+	delete $incl->{$addexc};
+    }
+
+    my $expand = sub {
+	my ($lst) = @_;
+	foreach my $inc (keys %$lst) {
+	    my $group;
+	    eval { $group = $self->run_command([@pacman, '-Sqg', $inc], undef, 1); };
+	    if ($group && !$@) {
+		# add the group
+		delete $lst->{$inc};
+		$lst->{$_} = 1 foreach split(/\s+/, $group);
+	    }
+	}
+    };
+
+    $expand->($incl);
+    $expand->($excl);
+
+    my $packages = [ grep { !$excl->{$_} } keys %$incl ];
+
+    print "Setting up basic environment...\n";
+    mkpath "$root/etc";
+    mkpath "$root/usr/bin";
+
+    my $data = "# UNCONFIGURED FSTAB FOR BASE SYSTEM\n";
+    write_file ($data, "$root/etc/fstab", 0644);
+
+    write_file ("", "$root/etc/resolv.conf", 0644);
+    write_file("localhost\n", "$root/etc/hostname", 0644);
+    $self->run_command(['install', '-m0755', $fake_init, "$root/usr/bin/aab_fake_init"]);
+
+    unlink "$root/etc/localtime";
+    symln '/usr/share/zoneinfo/UTC', "$root/etc/localtime";
+
+    print "Caching packages...\n";
+    $self->cache_packages($packages);
+    #$self->copy_packages();
+
+    print "Installing package manager and essentials...\n";
+    # inetutils for 'hostname' for our init
+    $self->run_command([@pacman, '-S', 'pacman', 'inetutils', 'archlinux-keyring']);
+
+    print "Setting up pacman for installation from cache...\n";
+    my $file = "$root/etc/pacman.d/mirrorlist";
+    my $backup = "${file}.aab_orig";
+    if (!-f $backup) {
+	rename_file($file, $backup);
+	write_file("Server = file://$PKGDIR\n", $file);
+    }
+
+    print "Populating keyring...\n";
+    $self->run_command(['mount', '-t', 'devtmpfs', '-o', 'mode=0755,nosuid', 'udev', "$root/dev"]);
+    $self->run_command(['unshare', '--fork', '--pid', 'chroot', "$root", 'pacman-key', '--init']);
+    $self->run_command(['unshare', '--fork', '--pid', 'chroot', "$root", 'pacman-key', '--populate']);
+    $self->run_command(['umount', "$root/dev"]);
+
+    print "Starting container...\n";
+    $self->start_container();
+
+    print "Installing packages...\n";
+    $self->ve_command(['pacman', '-S', '--needed', '--noconfirm', '--', @$packages]);
+}
+
+sub install {
+    my ($self, $pkglist) = @_;
+
+    $self->cache_packages($pkglist);
+    $self->ve_command(['pacman', '-S', '--needed', '--noconfirm', '--', @$pkglist]);
+}
+
+sub write_config {
+    my ($self, $filename, $size) = @_;
+
+    my $config = $self->{config};
+
+    my $data = '';
+
+    $data .= "Name: $config->{name}\n";
+    $data .= "Version: $config->{version}\n";
+    $data .= "Type: lxc\n";
+    $data .= "OS: archlinux\n";
+    $data .= "Section: $config->{section}\n";
+    $data .= "Maintainer: $config->{maintainer}\n";
+    $data .= "Architecture: $config->{architecture}\n";
+    $data .= "Installed-Size: $size\n";
+
+    # optional
+    $data .= "Infopage: $config->{infopage}\n" if $config->{infopage};
+    $data .= "ManageUrl: $config->{manageurl}\n" if $config->{manageurl};
+    $data .= "Certified: $config->{certified}\n" if $config->{certified};
+
+    # description
+    $data .= "Description: $config->{headline}\n";
+    $data .= "$config->{description}\n" if $config->{description};
+
+    write_file ($data, $filename, 0644);
+}
+
+sub finalize {
+    my ($self) = @_;
+    my $rootdir = $self->{rootfs};
+
+    print "Stopping container...\n";
+    $self->stop_container();
+
+    print "Rolling back mirrorlist changes...\n";
+    my $file = "$rootdir/etc/pacman.d/mirrorlist";
+    unlink $file;
+    rename_file($file.'.aab_orig', $file);
+
+    my $sizestr = $self->run_command("du -sm $rootdir", undef, 1);
+    my $size;
+    if ($sizestr =~ m/^(\d+)\s+\Q$rootdir\E$/) {
+	$size = $1;
+    } else {
+	die "unable to detect size\n";
+    }
+    $self->logmsg ("$size MB\n");
+
+    $self->write_config ("$rootdir/etc/appliance.info", $size);
+
+    $self->logmsg ("creating final appliance archive\n");
+
+    my $target = "$self->{targetname}.tar";
+    unlink $target;
+    unlink "$target.gz";
+
+    $self->run_command ("tar cpf $target --numeric-owner -C '$rootdir' ./etc/appliance.info");
+    $self->run_command ("tar rpf $target --numeric-owner -C '$rootdir' --exclude ./etc/appliance.info .");
+    $self->run_command ("gzip $target");
+}
+
+sub enter {
+    my ($self) = @_;
+    my $veid = $self->{veid};
+
+    my $vestat = $self->ve_status();
+    if (!$vestat->{exist}) {
+	$self->logmsg ("Please create the appliance first (bootstrap)");
+	return;
+    }
+
+    if (!$vestat->{running}) {
+	$self->start_container();
+    }
+
+    system ("lxc-attach -n $veid --clear-env");
+}
+
+sub clean {
+    my ($self, $all) = @_;
+
+    unlink $self->{logfile};
+    unlink $self->{'pacman.conf'};
+    $self->ve_destroy();
+    unlink '.veid';
+    rmtree $self->{pkgcache} if $all;
+}
+
+1;