]>
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 | |
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, | |
5f96733f | 435 | '--config', $self->{'pacman.conf'}, |
7b25f331 WB |
436 | '--cachedir', $self->{pkgcache}, |
437 | '--noconfirm'); | |
438 | } | |
439 | ||
440 | sub cache_packages { | |
441 | my ($self, $packages) = @_; | |
442 | my $root = $self->{rootfs}; | |
443 | ||
444 | my @pacman = $self->pacman_command(); | |
445 | $self->run_command([@pacman, '-Sw', '--', @$packages]); | |
446 | } | |
447 | ||
448 | sub bootstrap { | |
449 | my ($self, $include, $exclude) = @_; | |
450 | my $root = $self->{rootfs}; | |
451 | ||
452 | my @pacman = $self->pacman_command(); | |
453 | ||
454 | print "Fetching package database...\n"; | |
455 | mkpath $self->{pkgcache}; | |
456 | mkpath $self->{pkgdir}; | |
457 | mkpath "$root/var/lib/pacman"; | |
458 | $self->run_command([@pacman, '-Sy']); | |
459 | ||
460 | print "Figuring out what to install...\n"; | |
461 | my $incl = { map { $_ => 1 } @{$self->{incl}} }; | |
462 | my $excl = { map { $_ => 1 } @{$self->{excl}} }; | |
463 | ||
464 | foreach my $addinc (@$include) { | |
465 | $incl->{$addinc} = 1; | |
466 | delete $excl->{$addinc}; | |
467 | } | |
468 | foreach my $addexc (@$exclude) { | |
469 | $excl->{$addexc} = 1; | |
470 | delete $incl->{$addexc}; | |
471 | } | |
472 | ||
473 | my $expand = sub { | |
474 | my ($lst) = @_; | |
475 | foreach my $inc (keys %$lst) { | |
476 | my $group; | |
477 | eval { $group = $self->run_command([@pacman, '-Sqg', $inc], undef, 1); }; | |
478 | if ($group && !$@) { | |
479 | # add the group | |
480 | delete $lst->{$inc}; | |
481 | $lst->{$_} = 1 foreach split(/\s+/, $group); | |
482 | } | |
483 | } | |
484 | }; | |
485 | ||
486 | $expand->($incl); | |
487 | $expand->($excl); | |
488 | ||
489 | my $packages = [ grep { !$excl->{$_} } keys %$incl ]; | |
490 | ||
491 | print "Setting up basic environment...\n"; | |
492 | mkpath "$root/etc"; | |
493 | mkpath "$root/usr/bin"; | |
494 | ||
495 | my $data = "# UNCONFIGURED FSTAB FOR BASE SYSTEM\n"; | |
496 | write_file ($data, "$root/etc/fstab", 0644); | |
497 | ||
498 | write_file ("", "$root/etc/resolv.conf", 0644); | |
499 | write_file("localhost\n", "$root/etc/hostname", 0644); | |
500 | $self->run_command(['install', '-m0755', $fake_init, "$root/usr/bin/aab_fake_init"]); | |
501 | ||
502 | unlink "$root/etc/localtime"; | |
503 | symln '/usr/share/zoneinfo/UTC', "$root/etc/localtime"; | |
504 | ||
505 | print "Caching packages...\n"; | |
506 | $self->cache_packages($packages); | |
507 | #$self->copy_packages(); | |
508 | ||
509 | print "Installing package manager and essentials...\n"; | |
510 | # inetutils for 'hostname' for our init | |
511 | $self->run_command([@pacman, '-S', 'pacman', 'inetutils', 'archlinux-keyring']); | |
512 | ||
513 | print "Setting up pacman for installation from cache...\n"; | |
514 | my $file = "$root/etc/pacman.d/mirrorlist"; | |
515 | my $backup = "${file}.aab_orig"; | |
516 | if (!-f $backup) { | |
517 | rename_file($file, $backup); | |
518 | write_file("Server = file://$PKGDIR\n", $file); | |
519 | } | |
520 | ||
521 | print "Populating keyring...\n"; | |
522 | $self->run_command(['mount', '-t', 'devtmpfs', '-o', 'mode=0755,nosuid', 'udev', "$root/dev"]); | |
523 | $self->run_command(['unshare', '--fork', '--pid', 'chroot', "$root", 'pacman-key', '--init']); | |
524 | $self->run_command(['unshare', '--fork', '--pid', 'chroot', "$root", 'pacman-key', '--populate']); | |
525 | $self->run_command(['umount', "$root/dev"]); | |
526 | ||
527 | print "Starting container...\n"; | |
528 | $self->start_container(); | |
529 | ||
530 | print "Installing packages...\n"; | |
531 | $self->ve_command(['pacman', '-S', '--needed', '--noconfirm', '--', @$packages]); | |
532 | } | |
533 | ||
534 | sub install { | |
535 | my ($self, $pkglist) = @_; | |
536 | ||
537 | $self->cache_packages($pkglist); | |
538 | $self->ve_command(['pacman', '-S', '--needed', '--noconfirm', '--', @$pkglist]); | |
539 | } | |
540 | ||
541 | sub write_config { | |
542 | my ($self, $filename, $size) = @_; | |
543 | ||
544 | my $config = $self->{config}; | |
545 | ||
546 | my $data = ''; | |
547 | ||
548 | $data .= "Name: $config->{name}\n"; | |
549 | $data .= "Version: $config->{version}\n"; | |
550 | $data .= "Type: lxc\n"; | |
551 | $data .= "OS: archlinux\n"; | |
552 | $data .= "Section: $config->{section}\n"; | |
553 | $data .= "Maintainer: $config->{maintainer}\n"; | |
554 | $data .= "Architecture: $config->{architecture}\n"; | |
555 | $data .= "Installed-Size: $size\n"; | |
556 | ||
557 | # optional | |
558 | $data .= "Infopage: $config->{infopage}\n" if $config->{infopage}; | |
559 | $data .= "ManageUrl: $config->{manageurl}\n" if $config->{manageurl}; | |
560 | $data .= "Certified: $config->{certified}\n" if $config->{certified}; | |
561 | ||
562 | # description | |
563 | $data .= "Description: $config->{headline}\n"; | |
564 | $data .= "$config->{description}\n" if $config->{description}; | |
565 | ||
566 | write_file ($data, $filename, 0644); | |
567 | } | |
568 | ||
569 | sub finalize { | |
570 | my ($self) = @_; | |
571 | my $rootdir = $self->{rootfs}; | |
572 | ||
573 | print "Stopping container...\n"; | |
574 | $self->stop_container(); | |
575 | ||
576 | print "Rolling back mirrorlist changes...\n"; | |
577 | my $file = "$rootdir/etc/pacman.d/mirrorlist"; | |
578 | unlink $file; | |
579 | rename_file($file.'.aab_orig', $file); | |
580 | ||
581 | my $sizestr = $self->run_command("du -sm $rootdir", undef, 1); | |
582 | my $size; | |
583 | if ($sizestr =~ m/^(\d+)\s+\Q$rootdir\E$/) { | |
584 | $size = $1; | |
585 | } else { | |
586 | die "unable to detect size\n"; | |
587 | } | |
588 | $self->logmsg ("$size MB\n"); | |
589 | ||
590 | $self->write_config ("$rootdir/etc/appliance.info", $size); | |
591 | ||
592 | $self->logmsg ("creating final appliance archive\n"); | |
593 | ||
594 | my $target = "$self->{targetname}.tar"; | |
595 | unlink $target; | |
596 | unlink "$target.gz"; | |
597 | ||
598 | $self->run_command ("tar cpf $target --numeric-owner -C '$rootdir' ./etc/appliance.info"); | |
599 | $self->run_command ("tar rpf $target --numeric-owner -C '$rootdir' --exclude ./etc/appliance.info ."); | |
600 | $self->run_command ("gzip $target"); | |
601 | } | |
602 | ||
603 | sub enter { | |
604 | my ($self) = @_; | |
605 | my $veid = $self->{veid}; | |
606 | ||
607 | my $vestat = $self->ve_status(); | |
608 | if (!$vestat->{exist}) { | |
609 | $self->logmsg ("Please create the appliance first (bootstrap)"); | |
610 | return; | |
611 | } | |
612 | ||
613 | if (!$vestat->{running}) { | |
614 | $self->start_container(); | |
615 | } | |
616 | ||
617 | system ("lxc-attach -n $veid --clear-env"); | |
618 | } | |
619 | ||
620 | sub clean { | |
621 | my ($self, $all) = @_; | |
622 | ||
623 | unlink $self->{logfile}; | |
624 | unlink $self->{'pacman.conf'}; | |
625 | $self->ve_destroy(); | |
626 | unlink '.veid'; | |
627 | rmtree $self->{pkgcache} if $all; | |
628 | } | |
629 | ||
630 | 1; |