[aab.git] / PVE / AAB.pm

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
EOF

    if ($config->{architecture} eq 'x86_64') {
	print $fh "[multilib]\n$servers\n";
    }

    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,
            '--config', $self->{'pacman.conf'},
            '--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->populate_keyring();

    print "Starting container...\n";
    $self->start_container();

    print "Installing packages...\n";
    $self->ve_command(['pacman', '-S', '--needed', '--noconfirm', '--', @$packages]);
}

sub populate_keyring {
    my ($self) = @_;
    my $root = $self->{rootfs};

    # devices needed for gnupg to function:
    my $devs = {
	'/dev/null'    => ['c', '1', '3'],
	'/dev/random'  => ['c', '1', '9'], # fake /dev/random (really urandom)
	'/dev/urandom' => ['c', '1', '9'],
	'/dev/tty'     => ['c', '5', '0'],
    };

    my $cleanup_dev = sub {
	# remove temporary device files
	unlink "${root}$_" foreach keys %$devs;
    };
    local $SIG{INT} = $SIG{TERM} = $cleanup_dev;

    # at least /dev/null exists as regular file after installing the filesystem package,
    # and we want to replace /dev/random, so delete devices first
    &$cleanup_dev();

    foreach my $dev (keys %$devs) {
	my ($type, $major, $minor) = @{$devs->{$dev}};
	system('mknod', "${root}${dev}", $type, $major, $minor);
    }

    # generate weak master key and populate the keyring
    system('unshare', '--fork', '--pid', 'chroot', "$root", 'pacman-key', '--init') == 0
	or die "failed to initialize keyring: $?";
    system('unshare', '--fork', '--pid', 'chroot', "$root", 'pacman-key', '--populate') == 0
	or die "failed to populate keyring: $?";

    &$cleanup_dev();
    # reset to original state
    system('touch', "$root/dev/null");
}

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 .= "Infopage: https://www.archlinux.org\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;
Commit	Line	Data
7b25f331 WB	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
7b25f331 WB	251	EOF
7b25f331 WB	252
4eaaed91 WB	253	if ($config->{architecture} eq 'x86_64') {
	254	print $fh "[multilib]\n$servers\n";
	255	}
	256
7b25f331 WB	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
	310	$self->logmsg ("initialize VE $veid\n");
	311
	312	my $vestat = $self->ve_status();
	313	if ($vestat->{running}) {
	314	$self->run_command ("lxc-stop -n $veid --kill");
	315	}
	316
	317	rmtree $self->{rootfs};
	318	mkpath $self->{rootfs};
	319	}
	320
321	sub ve_command {
322	my ($self, $cmd, $input) = @_;
323
324	my $veid = $self->{veid};
325
326	if (ref ($cmd) eq 'ARRAY') {
327	unshift @$cmd, 'lxc-attach', '-n', $veid, '--clear-env', '--';
328	$self->run_command ($cmd, $input);
329	} else {
330	$self->run_command ("lxc-attach -n $veid --clear-env -- $cmd", $input);
331	}
332	}
333
334	sub ve_exec {
335	my ($self, @cmd) = @_;
336
337	my $veid = $self->{veid};
338
339	my $reader;
340	my $pid = open2($reader, "<&STDIN", 'lxc-attach', '-n', $veid, '--', @cmd)
341	or die "unable to exec command";
342
343	while (defined (my $line = <$reader>)) {
344	$self->logmsg ($line);
345	}
346
347	waitpid ($pid, 0);
348	my $rc = $? >> 8;
349
350	die "ve_exec failed - status $rc\n" if $rc != 0;
351	}
352
353	sub run_command {
354	my ($self, $cmd, $input, $getoutput) = @_;
355
356	my $reader = IO::File->new();
357	my $writer = IO::File->new();
358	my $error = IO::File->new();
359
360	my $orig_pid = $$;
361
362	my $cmdstr = ref ($cmd) eq 'ARRAY' ? join (' ', @$cmd) : $cmd;
363
364	my $pid;
365	eval {
366	if (ref ($cmd) eq 'ARRAY') {
367	$pid = open3 ($writer, $reader, $error, @$cmd) \|\| die $!;
368	} else {
369	$pid = open3 ($writer, $reader, $error, $cmdstr) \|\| die $!;
370	}
371	};
372
373	my $err = $@;
374
375	# catch exec errors
376	if ($orig_pid != $$) {
377	$self->logmsg ("ERROR: command '$cmdstr' failed - fork failed\n");
378	POSIX::_exit (1);
379	kill ('KILL', $$);
380	}
381
382	die $err if $err;
383
384	print $writer $input if defined $input;
385	close $writer;
386
387	my $select = new IO::Select;
388	$select->add ($reader);
389	$select->add ($error);
390
391	my $res = '';
392	my $logfd = $self->{logfd};
393
394	while ($select->count) {
395	my @handles = $select->can_read ();
396
397	foreach my $h (@handles) {
398	my $buf = '';
399	my $count = sysread ($h, $buf, 4096);
400	if (!defined ($count)) {
401	waitpid ($pid, 0);
402	die "command '$cmdstr' failed: $!";
403	}
404	$select->remove ($h) if !$count;
405
406	print $logfd $buf;
407
408	$res .= $buf if $getoutput;
409	}
410	}
411
412	waitpid ($pid, 0);
413	my $ec = ($? >> 8);
414
415	die "command '$cmdstr' failed with exit code $ec\n" if $ec;
416
417	return $res;
418	}
419
420	sub start_container {
421	my ($self) = @_;
422	my $veid = $self->{veid};
423	$self->run_command(['lxc-start', '-n', $veid, '-f', $self->{veconffile}, '/usr/bin/aab_fake_init']);
424	}
425
426	sub stop_container {
427	my ($self) = @_;
428	my $veid = $self->{veid};
429	$self->run_command ("lxc-stop -n $veid --kill");
430	}
431
432	sub pacman_command {
433	my ($self) = @_;
434	my $root = $self->{rootfs};
435	return ('/usr/bin/pacman',
436	'--root', $root,
5f96733f	437	'--config', $self->{'pacman.conf'},
7b25f331 WB	438	'--cachedir', $self->{pkgcache},
	439	'--noconfirm');
	440	}
	441
	442	sub cache_packages {
	443	my ($self, $packages) = @_;
	444	my $root = $self->{rootfs};
	445
	446	my @pacman = $self->pacman_command();
	447	$self->run_command([@pacman, '-Sw', '--', @$packages]);
	448	}
	449
	450	sub bootstrap {
	451	my ($self, $include, $exclude) = @_;
	452	my $root = $self->{rootfs};
	453
	454	my @pacman = $self->pacman_command();
	455
	456	print "Fetching package database...\n";
	457	mkpath $self->{pkgcache};
	458	mkpath $self->{pkgdir};
	459	mkpath "$root/var/lib/pacman";
	460	$self->run_command([@pacman, '-Sy']);
	461
	462	print "Figuring out what to install...\n";
	463	my $incl = { map { $_ => 1 } @{$self->{incl}} };
	464	my $excl = { map { $_ => 1 } @{$self->{excl}} };
	465
	466	foreach my $addinc (@$include) {
	467	$incl->{$addinc} = 1;
	468	delete $excl->{$addinc};
	469	}
	470	foreach my $addexc (@$exclude) {
	471	$excl->{$addexc} = 1;
	472	delete $incl->{$addexc};
	473	}
	474
	475	my $expand = sub {
	476	my ($lst) = @_;
	477	foreach my $inc (keys %$lst) {
	478	my $group;
	479	eval { $group = $self->run_command([@pacman, '-Sqg', $inc], undef, 1); };
	480	if ($group && !$@) {
	481	# add the group
	482	delete $lst->{$inc};
	483	$lst->{$_} = 1 foreach split(/\s+/, $group);
	484	}
	485	}
	486	};
	487
	488	$expand->($incl);
	489	$expand->($excl);
	490
	491	my $packages = [ grep { !$excl->{$_} } keys %$incl ];
	492
	493	print "Setting up basic environment...\n";
	494	mkpath "$root/etc";
	495	mkpath "$root/usr/bin";
	496
	497	my $data = "# UNCONFIGURED FSTAB FOR BASE SYSTEM\n";
	498	write_file ($data, "$root/etc/fstab", 0644);
	499
	500	write_file ("", "$root/etc/resolv.conf", 0644);
	501	write_file("localhost\n", "$root/etc/hostname", 0644);
502	$self->run_command(['install', '-m0755', $fake_init, "$root/usr/bin/aab_fake_init"]);
503
504	unlink "$root/etc/localtime";
505	symln '/usr/share/zoneinfo/UTC', "$root/etc/localtime";
506
507	print "Caching packages...\n";
508	$self->cache_packages($packages);
509	#$self->copy_packages();
510
511	print "Installing package manager and essentials...\n";
512	# inetutils for 'hostname' for our init
513	$self->run_command([@pacman, '-S', 'pacman', 'inetutils', 'archlinux-keyring']);
514
515	print "Setting up pacman for installation from cache...\n";
516	my $file = "$root/etc/pacman.d/mirrorlist";
517	my $backup = "${file}.aab_orig";
518	if (!-f $backup) {
519	rename_file($file, $backup);
520	write_file("Server = file://$PKGDIR\n", $file);
521	}
522
523	print "Populating keyring...\n";
766f0fa3	524	$self->populate_keyring();
7b25f331 WB	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
766f0fa3 WB	533	sub populate_keyring {
	534	my ($self) = @_;
	535	my $root = $self->{rootfs};
	536
	537	# devices needed for gnupg to function:
	538	my $devs = {
	539	'/dev/null' => ['c', '1', '3'],
	540	'/dev/random' => ['c', '1', '9'], # fake /dev/random (really urandom)
	541	'/dev/urandom' => ['c', '1', '9'],
	542	'/dev/tty' => ['c', '5', '0'],
	543	};
	544
	545	my $cleanup_dev = sub {
	546	# remove temporary device files
	547	unlink "${root}$_" foreach keys %$devs;
	548	};
	549	local $SIG{INT} = $SIG{TERM} = $cleanup_dev;
	550
	551	# at least /dev/null exists as regular file after installing the filesystem package,
	552	# and we want to replace /dev/random, so delete devices first
	553	&$cleanup_dev();
	554
	555	foreach my $dev (keys %$devs) {
	556	my ($type, $major, $minor) = @{$devs->{$dev}};
	557	system('mknod', "${root}${dev}", $type, $major, $minor);
	558	}
	559
	560	# generate weak master key and populate the keyring
	561	system('unshare', '--fork', '--pid', 'chroot', "$root", 'pacman-key', '--init') == 0
	562	or die "failed to initialize keyring: $?";
	563	system('unshare', '--fork', '--pid', 'chroot', "$root", 'pacman-key', '--populate') == 0
	564	or die "failed to populate keyring: $?";
	565
	566	&$cleanup_dev();
	567	# reset to original state
	568	system('touch', "$root/dev/null");
	569	}
	570
7b25f331 WB	571	sub install {
	572	my ($self, $pkglist) = @_;
	573
	574	$self->cache_packages($pkglist);
	575	$self->ve_command(['pacman', '-S', '--needed', '--noconfirm', '--', @$pkglist]);
	576	}
	577
	578	sub write_config {
	579	my ($self, $filename, $size) = @_;
	580
	581	my $config = $self->{config};
	582
	583	my $data = '';
	584
	585	$data .= "Name: $config->{name}\n";
	586	$data .= "Version: $config->{version}\n";
	587	$data .= "Type: lxc\n";
	588	$data .= "OS: archlinux\n";
	589	$data .= "Section: $config->{section}\n";
	590	$data .= "Maintainer: $config->{maintainer}\n";
	591	$data .= "Architecture: $config->{architecture}\n";
b65bfe8c	592	$data .= "Infopage: https://www.archlinux.org\n";
7b25f331 WB	593	$data .= "Installed-Size: $size\n";
	594
	595	# optional
	596	$data .= "Infopage: $config->{infopage}\n" if $config->{infopage};
	597	$data .= "ManageUrl: $config->{manageurl}\n" if $config->{manageurl};
	598	$data .= "Certified: $config->{certified}\n" if $config->{certified};
	599
	600	# description
	601	$data .= "Description: $config->{headline}\n";
	602	$data .= "$config->{description}\n" if $config->{description};
	603
	604	write_file ($data, $filename, 0644);
	605	}
	606
	607	sub finalize {
	608	my ($self) = @_;
	609	my $rootdir = $self->{rootfs};
	610
	611	print "Stopping container...\n";
	612	$self->stop_container();
	613
	614	print "Rolling back mirrorlist changes...\n";
	615	my $file = "$rootdir/etc/pacman.d/mirrorlist";
	616	unlink $file;
	617	rename_file($file.'.aab_orig', $file);
	618
	619	my $sizestr = $self->run_command("du -sm $rootdir", undef, 1);
	620	my $size;
	621	if ($sizestr =~ m/^(\d+)\s+\Q$rootdir\E$/) {
	622	$size = $1;
	623	} else {
	624	die "unable to detect size\n";
	625	}
	626	$self->logmsg ("$size MB\n");
	627
	628	$self->write_config ("$rootdir/etc/appliance.info", $size);
	629
	630	$self->logmsg ("creating final appliance archive\n");
	631
	632	my $target = "$self->{targetname}.tar";
	633	unlink $target;
	634	unlink "$target.gz";
	635
	636	$self->run_command ("tar cpf $target --numeric-owner -C '$rootdir' ./etc/appliance.info");
	637	$self->run_command ("tar rpf $target --numeric-owner -C '$rootdir' --exclude ./etc/appliance.info .");
	638	$self->run_command ("gzip $target");
	639	}
	640
	641	sub enter {
	642	my ($self) = @_;
	643	my $veid = $self->{veid};
	644
	645	my $vestat = $self->ve_status();
	646	if (!$vestat->{exist}) {
	647	$self->logmsg ("Please create the appliance first (bootstrap)");
	648	return;
	649	}
	650
	651	if (!$vestat->{running}) {
	652	$self->start_container();
	653	}
	654
	655	system ("lxc-attach -n $veid --clear-env");
	656	}
657
658	sub clean {
659	my ($self, $all) = @_;
660
661	unlink $self->{logfile};
662	unlink $self->{'pacman.conf'};
663	$self->ve_destroy();
664	unlink '.veid';
665	rmtree $self->{pkgcache} if $all;
666	}
667
668	1;