#!/usr/bin/perl

# draklive $Id: draklive 150793 2007-04-05 12:08:47Z blino $

# Copyright (C) 2005 Mandriva
#                    Olivier Blin <oblin@mandriva.com>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

use lib qw(/usr/lib/libDrakX);
use MDK::Common;
use common;
use list_modules;
use fs;
use modules;
use detect_devices;
use run_program;
use POSIX qw(strftime);
use Cwd 'getcwd';
use Getopt::Long;
use Pod::Usage;
use File::Temp;

my $dir_distrib_sqfs = {
    mountpoint => '/distrib',
    type => 'squashfs',
    path => '/distrib.sqfs',
    # perl -MMDK::Common -e 'print map_index { (32767 - $::i) . " $_" } grep { !m,^/(?:dev|proc|sys|live/distrib), } uniq(<>)' < bootlog.list > config/distrib.sort
    sort => "config/distrib.sort",
    build_from => '/',
};
my $dir_memory = {
    mountpoint => '/memory',
    type => 'tmpfs',
};

my $dir_modules = {
    mountpoint => '/modules',
    type => 'modules',
    path => '/modules',
    list => '/live-modules',
};

# this is not unused (it can be used from config file):
my %predefined = (
    mounts => {
        simple_union => {
            root => '/union',
            overlay => 'unionfs',
            dirs => [
                {
                    mountpoint => '/media',
                    type => 'plain',
                },
                $dir_memory,
            ],
        },
        volatile_squash_union => {
            root => '/union',
            overlay => 'unionfs',
            dirs => [
                $dir_distrib_sqfs,
                $dir_modules,
                $dir_memory,
            ],
        },
    },
);

# this is not unused (it can be used from config file):
my %custom = (
    fs => {
        nfs => sub {
            my ($module, $client, $path) = @_;
            (
                fs => 'nfs',
                modules => 'nfs',
                extra_modules => [ $module ],
                pre => "ifconfig eth0 $client up",
                source => $path,
            );
        },
    },
    mounts => {
        squash_union => sub {
            my ($default_size, $o_min_size) = @_;
            {
                root => '/union',
                overlay => 'unionfs',
                dirs => [
                    $dir_distrib_sqfs,
                    $dir_modules,
                    {
                        mountpoint => '/system',
                        type => 'loopfs',
                        pre_allocate => $default_size,
                        if_(defined $o_min_size, min_size => $o_min_size),
                        fs => 'ext2',
                        path => '/system.loop'
                    },
                    {
                        mountpoint => '/system',
                        type => 'tmpfs',
                        fallback => 1,
                    },
                ],
            };
        },
    },
);

my %storage = (
    cdrom => {
        modules => 'bus/usb disk/hardware_raid|ide|sata|scsi|usb',
        media_modules => 'disk/cdrom',
        fs => 'iso9660',
        source => 'LABEL=MDVCDROOT',
        read_only => 1,
        detect => \&detect_devices::burners,
        create => \&create_cdrom_master,
        format => \&format_cdrom_device,
        record_needs_master => 1,
        record => \&record_cdrom_master,
    },
    usb => {
        modules => 'bus/usb disk/usb',
        media_modules => 'disk/raw',
        fs => 'vfat',
        bootloader => 'grub',
        source => 'LABEL=MDVUSBROOT',
        detect => sub { grep { detect_devices::isKeyUsb($_) } detect_devices::get() },
        create => \&create_usb_master,
        format => \&format_usb_device,
        record => \&record_usb_master,
    },
);

my %storage_fs;
%storage_fs = (
    generic => {
        mount => sub {
            my ($live, $media) = @_;
            my @mount_options = (
                if_(get_media_setting($media, 'read_only'), "ro"),
                grep { $_ } get_media_setting($media, 'mount_options'),
            );
            'mount' . if_(@mount_options, " -o " . join(",", @mount_options)) . " -t " . get_media_setting($media, 'fs') .
              " " . get_media_source_for_nash($media) . " $live->{prefix}{live}{mnt}$live->{prefix}{media}{mnt}";
        },
    },
    nfs => {
        mount => sub {
            my ($live, $media) = @_;
            '/bin/mount -n -o ro,nolock -t nfs ' . get_media_source_for_nash($media) . " $live->{prefix}{live}{mnt}$live->{prefix}{media}{mnt}";
        }
    },
);

sub nls_modules {
    my ($live) = @_;
    if_(get_media_setting($live->{media}, 'fs') eq 'vfat', 'nls_cp437'), #- default FAT codepage
    map { "nls_$_" } (map { "iso8859_$_" } 1..7, 9, 13..15), 'utf8';
}

sub progress_start {
    my ($total, $time, $o_exp_divide) = @_;
    {
        total => $total,
        current => 0,
        start_time => $time,
        exp_divide => $o_exp_divide,
        maxl => length($total) - $o_exp_divide,
    };
}

sub progress_show {
    my ($progress, $time) = @_;
    my $elapsed_time = $time - $progress->{start_time};
    my $eta = $progress->{current} ? int($elapsed_time*$progress->{total}/$progress->{current}) : -1;
    printf("\r%3d%% (%$progress->{maxl}s/%-$progress->{maxl}s), %8s/%8s (ETA)",
           int(100*$progress->{current}/$progress->{total}),
           (map { substr($_, 0, length($_)-$progress->{exp_divide}) } $progress->{current}, $progress->{total}),
           (map { POSIX::strftime("%H:%M:%S", gmtime($_)) } $elapsed_time, $eta));
}

sub progress_end() { print "\n" }

my $loop_number = 0;
my %loop = (
    squashfs => {
        read_only => 1,
        is_loopback => 1,
        modules => [ qw(loop squashfs) ],
        extension => '.sqfs',
        build => sub {
            my ($live, $dir) = @_;
            my $dest = get_builddir($live) . $live->{prefix}{build}{loopbacks} . $dir->{path};
            mkdir_p(dirname($dest));
            my $root = $dir->{root} || get_system_root($live);
            my $src = $root . $dir->{build_from};
            my $total = directory_usage($src);
            print "have to process " . int($total/1000000) . " MB\n";
            my $progress = progress_start($total, time(), 6);
            my $exclude_file = tmpnam();
            output_p($exclude_file, map { $root . "$_\n" }  grep { -e $root . $_ } @{$dir->{exclude} || []});
            my $sort = $live->{settings}{config_root} . '/' . $dir->{sort};
            run_foreach(sub {
                            if (/^mksquashfs: file .*, uncompressed size (\d+) bytes\s*(?:DUPLICATE|LINK)?$/) {
                                $progress->{current} += $1;
                                progress_show($progress, time());
                            }
                        },
                        'mksquashfs', $src, $dest, '-noappend', '-no-progress', '-info',
                        '-ef', $exclude_file,
                        if_(-f $sort, '-sort', $sort),
		) or die "unable to run mksquashfs\n";
            progress_end();
            unlink $exclude_file;
        },
        mount => sub {
            my ($live, $dir) = @_;
            $dir->{loop} = "/dev/loop" . $loop_number++;
            (
                "/bin/losetup $dir->{loop} $live->{prefix}{live}{mnt}$live->{prefix}{media}{mnt}$live->{prefix}{media}{loopbacks}$dir->{path}",
                "mount -o ro -t squashfs $dir->{loop} $live->{prefix}{live}{mnt}$dir->{mountpoint}",
            );
        },
    },
    modules => {
        read_only => 1,
        delay_mount => 1,
        mount => sub {
            my ($live, $dir) = @_;
            "sh -c 'modules=; for m in $live->{prefix}{live}{mnt}$live->{prefix}{media}{mnt}$live->{prefix}{media}{loopbacks}$dir->{path}/*; do n=\$(basename \$m); n=\${n%.sqfs}; d=$live->{prefix}{live}{mnt}$dir->{mountpoint}/\$n; mkdir -p \$d; mount -n -o loop,ro -t squashfs \$m \$d && modules=\$modules\$d=ro:; done; echo \$modules | sed -e s/:\$// > $dir->{list}'";
        },
    },
    loopfs => {
        is_loopback => 1,
        modules => [],
        extension => '.loop',
        build => sub {
            my ($live, $dir) = @_;
            my $dest = get_builddir($live) . $live->{prefix}{build}{loopbacks} . $dir->{path};
            mkdir_p(dirname($dest));
            device_allocate_fs($dest, $dir->{pre_allocate});
            device_mkfs($dest, $dir->{fs}) if !defined $dir->{min_size};
        },
        mount => sub {
            my ($live, $dir) = @_;
            $dir->{loop} = "/dev/loop" . $loop_number++;
            my $fsck = "chroot </dev/tty1 $live->{prefix}{live}{mnt}$dir_distrib_sqfs->{mountpoint} /sbin/fsck $dir->{loop}";
            (
                "losetup $dir->{loop} $live->{prefix}{live}{mnt}$live->{prefix}{media}{mnt}$live->{prefix}{media}{loopbacks}$dir->{path}",
                qq(sh -c "$fsck -a || $fsck -y"),
                "mount -t $dir->{fs} $dir->{loop} $live->{prefix}{live}{mnt}$dir->{mountpoint}",
            );
        },
    },
    plain => {},
    tmpfs => {
        mount => sub {
            my ($live, $dir) = @_;
            my $mnt = $live->{prefix}{live}{mnt} . $dir->{mountpoint};
            my $cmd = "mount -t tmpfs none $mnt";
            $dir->{fallback} ? qq(sh -c 'if ! grep -q " $mnt " /proc/mounts; then $cmd; fi') : $cmd;
        },
    },
);

my %overlay = (
    unionfs => {
        modules => [ qw(unionfs) ],
        mount => sub {
            my ($live) = @_;
            #- build dirs list: "dir1=ro:dir2:ro:dir3=rw"
            my $dirs = join(':',
                            map {
                                $_->{list} ? "\$(cat $_->{list})" :
                                  "$live->{prefix}{live}{mnt}$_->{mountpoint}=" .
                                    (!$loop{$_->{type}}{read_only} && !$_->{read_only} ? 'rw' : 'ro');
                            } reverse grep { !$_->{fallback} } @{$live->{mount}{dirs} || []});
            "sh -c 'mount -o dirs=$dirs -t unionfs unionfs $live->{prefix}{live}{mnt}$live->{mount}{root}'";
        },
    },
);

sub directory_usage { first(split /\s/, `du -sb $_[0]`) }

#- expand only if the pattern contains '*'
#- and matches dot characters (like shell dotglob)
sub glob__ {
    my ($pattern) = @_;
    $pattern =~ /\*/ ? glob_($pattern) : $pattern;
}

sub run_ {
    my $options = ref $_[0] eq 'HASH' ? shift @_ : {};
    my @cmd = @_;
    $options->{timeout} ||= 'never';
    my $setarch = delete $options->{setarch};
    unshift @cmd, 'setarch', $setarch if $setarch;
    print STDERR "running " . (exists $options->{root} && "(in chroot) ") . join(' ', @cmd) . "\n";
    run_program::raw($options, @cmd);
}

sub run_foreach {
    my ($foreach, @command) = @_;
    print STDERR "running " . join(' ', @command) . "\n";
    open(my $OUTPUT, '-|', @command);
    local $_; #- avoid outside $_ to be overwritten
    $foreach->() while <$OUTPUT>;
    close $OUTPUT;
}

sub mtools_run_ {
    local $ENV{MTOOLS_SKIP_CHECK} = 1;
    &run_;
}

sub get_live_name {
    my ($live) = @_;
    join('-', grep { $_ } @{$live->{settings}}{qw(name product desktop region media arch)});
}

sub get_builddir {
    my ($live) = @_;
    $live->{settings}{builddir} . '/' . get_live_name($live);
}

sub get_system_root {
    my ($live) = @_;
    $live->{settings}{chroot} . '/' . get_live_name($live);
}

sub get_initrd_path {
    my ($media) = @_;
    '/' . $media->{storage} . '/initrd.gz';
}

sub get_syslinux_path {
    my ($media, $opts) = @_;
    '/' . $media->{storage} . '/syslinux' . ($opts->{boot} && '-boot-' . $opts->{boot}) . '.cfg';
}

sub find_kernel {
    my ($live) = @_;
    my $kernel = $live->{system}{kernel};
    unless ($kernel) {
        my $vmlinuz = readlink(get_system_root($live) . '/boot/vmlinuz');
        $vmlinuz ||= find { -e $_ && ! -l $_ } glob_(get_system_root($live) . '/boot/vmlinuz-*');
        ($kernel) = $vmlinuz =~ /\bvmlinuz-(.*)$/ or die "no kernel can be found\n";
    }
    $kernel;
}

sub create_initrd {
    my ($live) = @_;
    foreach ($live->{media}) {
        create_initrd_for_media($live, $_);
    }
    cp_f(get_builddir($live) . $live->{prefix}{build}{boot} . get_initrd_path($live->{media}),
         $live->{copy_initrd}) if $live->{copy_initrd};
}

sub create_initrd_for_media {
    my ($live, $media) = @_;

    my $initrd_tree = get_builddir($live) . $live->{prefix}{build}{initrd} . '/' . $media->{storage};
    rm_rf($initrd_tree) if -e $initrd_tree;

    my ($lib_prefix, $need_libs, @libs);
    foreach (qw(/lib64 /lib)) {
        my @ld = glob(get_system_root($live) . $_ . '/ld-*.so.*');
        my @libc = glob(get_system_root($live) . $_ . '/libc.so.*');
        if (@ld && @libc) {
            @libs = (@ld, @libc);
            $lib_prefix = $_;
            last;
        }
    }
    $lib_prefix or die "unable to find system libraries in /lib or /lib64\n";

    mkdir_p($initrd_tree . $_) foreach
      qw(/bin /dev /modules /proc /sys /tmp), $lib_prefix,
      map { $live->{prefix}{live}{mnt} . $_ }
        $live->{prefix}{media}{mnt},
        $live->{mount}{root},
        map { $_->{mountpoint} } @{$live->{mount}{dirs} || []};

    #- use nash with label support
    cp_f(get_system_root($live) . '/sbin/nash', $initrd_tree . '/bin/');

    #- busybox is required to:
    #-   detect usb-storage process (we need sh/while/ps/grep)
    #-   mount loopbacks read-only with losetup (useful over NFS)
    my $busybox = get_system_root($live) . '/usr/bin/busybox';
    cp_f($busybox, $initrd_tree . '/bin')
      or die "unable to copy busybox from system chroot\n";
    my @l = map { /functions:/ .. /^$/ ? do { s/\s//g; split /,/ } : () } `$busybox`;
    shift @l;
    symlink('busybox', $initrd_tree . "/bin/$_") foreach @l;

    cp_f(get_system_root($live) . "/usr/lib/drakx-installer-binaries/probe-modules", $initrd_tree . '/bin');

    my $rrpt_dev = get_media_setting($media, 'rereadpt');
    if ($rrpt_dev) {
        $need_libs = 1;
        cp_f(get_system_root($live) . '/sbin/blockdev', $initrd_tree . '/bin')
          or die "unable to copy blockdev from system chroot\n";
    }

    my $fs = get_media_setting($media, 'fs');
    if ($fs eq 'nfs') {
        #- FIXME: move in %storage_fs
        $need_libs = 1;
        cp_f(get_system_root($live) . '/sbin/ifconfig', $initrd_tree . '/bin/');
        #- needed to mount NFS (with nolock)
        cp_f(get_system_root($live) . '/bin/mount', $initrd_tree . '/bin/');
        if ($live->{debug}) {
            cp_f(get_system_root($live) . '/bin/ping', $initrd_tree . '/bin/');
            cp_f(glob(get_system_root($live) . $lib_prefix . '/libresolv*.so.*'), $initrd_tree . $lib_prefix);
        }
    }

    if (exists $storage_fs{$fs}{files}) {
        cp_f(get_system_root($live) . $_, $initrd_tree . '/bin/')
          foreach @{$storage_fs{$fs}{files} || []};
    }

    if ($live->{debug}) {
        $need_libs = 1;
        cp_f(get_system_root($live) . '/usr/bin/strace', $initrd_tree . '/bin/');
    }

    cp_f(@libs, $initrd_tree . $lib_prefix) if $need_libs;

    my $loop_nb = 63;
    require devices;
    devices::make($initrd_tree . "/dev/$_") foreach
        if_($rrpt_dev, $rrpt_dev),
        qw(console initrd null ram systty),
        (map { "tty$_" } 0..5),
        (map { "loop$_" } 0 .. $loop_nb);
    #- pre-create devfsd compatibility loop devices (since busybox is still built with devfsd support)
    mkdir_p($initrd_tree . "/dev/loop");
    cp_af($initrd_tree . "/dev/loop$_", $initrd_tree . "/dev/loop/$_") foreach 0 .. $loop_nb;

    my $kernel = find_kernel($live);
    print "using kernel $kernel\n";
    my $kernel_root = "/lib/modules/" . $kernel;
    list_modules::load_dependencies(get_system_root($live) . $kernel_root . "/modules.dep");

    my ($storage_modules, $skipped) = partition { list_modules::modname2filename($_) }
      uniq(map { modules::cond_mapping_24_26($_) } category2modules(get_media_setting($media, 'modules')));
    my ($extra_modules, $extra_missing) = partition { list_modules::modname2filename($_) }
      category2modules(get_media_setting($media, 'media_modules')),
      nls_modules($live),
      get_media_fs_module($media),
      @{get_media_setting($media, 'extra_modules') || []},
      (map { @{$loop{$_}{modules} || []} } uniq(map { $_->{type} } @{$live->{mount}{dirs} || []})),
      ($live->{mount}{overlay} ? @{$overlay{$live->{mount}{overlay}}{modules} || []} : ());

    my @additional_modules = map { m!([^/]+)\.ko! } @{$live->{system}{additional_modules}};

    my @missing = sort(difference2($extra_missing, \@additional_modules));
    @missing and die "missing mandatory modules:\n" . join("\n", @missing, '');

    if ($live->{system}{exclude_modules}) {
        print STDERR "excluding modules: " . join(' ', @{$live->{system}{exclude_modules}}) . "\n";
        @$_ = difference2($_, $live->{system}{exclude_modules}) foreach $storage_modules, $extra_modules;
    }

    my @modules = (@$storage_modules, @$extra_modules);
    my @module_deps = uniq(map { list_modules::dependencies_closure($_) } @modules);
    foreach my $m (@module_deps, @modules) {
        my $full = list_modules::modname2path($m);
        my $f = list_modules::modname2filename($m);
        run_program::run('gzip', '>', $initrd_tree . "/modules/$f.ko", '-dc', get_system_root($live) . $full);
        #- gzopen transparently opens uncompressed files
        symlink($f . ".ko", $initrd_tree . "/modules/$f.ko.gz");
    }
    cp_f((map { $live->{settings}{config_root} . '/' . $_ } @{$live->{system}{additional_modules}}), $initrd_tree . "/modules/");

    cp_f(get_system_root($live) . $kernel_root . "/" . $_, $initrd_tree . "/modules/")
      foreach qw(modules.alias modules.dep modules.description);
    substInFile { s![^ ]*/!!g; s!\.ko!!g; s!\.gz!!g } $initrd_tree . "/modules/modules.dep";

    mkdir_p($initrd_tree . "/lib/module-init-tools");
    cp_f(get_system_root($live) . "/lib/module-init-tools/ldetect-lst-modules.alias", $initrd_tree . "/lib/module-init-tools");
    mkdir_p($initrd_tree . "/usr/share/ldetect-lst");
    cp_f(get_system_root($live) . "/usr/share/pci.ids", $initrd_tree . "/usr/share");
    cp_f(get_system_root($live) . "/usr/share/ldetect-lst/" . $_, $initrd_tree . "/usr/share/ldetect-lst")
      foreach qw(fallback-modules.alias pcitable.gz usbtable.gz);

    @$skipped and print STDERR "skipped modules: " . join(' ', sort(@$skipped)) . "\n";

    #- move ide-generic to end of loaded modules, so that it registers unhandled drives only
    #- this avoid it to take-over drives which would have been managed by SATA modules
    my ($head, $tail) =  partition { $_ ne 'ide-generic' } @modules;
    @modules = (@$head, @$tail);

    my @extra_modules_closure = map { list_modules::modname2filename($_) }
      map { list_modules::dependencies_closure($_) }  @$extra_modules;
    create_initrd_scriptlet($live, $media, @extra_modules_closure, @additional_modules);
    compress_initrd_tree($live, $media);
    add_splash($live, $media);
}

sub create_initrd_scriptlet {
    my ($live, $media, @modules) = @_;
    my $target = $live->{prefix}{live}{mnt} . ($live->{mount}{root} || $live->{prefix}{media}{mnt});
    my $pre = get_media_setting($media, 'pre');
    my $fs = get_media_setting($media, 'fs');
    my $rrpt_dev = get_media_setting($media, 'rereadpt');
    my $debug_shell = "sh -c 'if grep -q debug /proc/cmdline; then exec sh </dev/console >/dev/console 2>/dev/console; fi'";
    my ($mount_first, $mount_last) = partition { !$loop{$_->{type}}{delay_mount} }
      grep { exists $loop{$_->{type}}{mount} } @{$live->{mount}{dirs} || []};

    output_with_perm(get_builddir($live) . $live->{prefix}{build}{initrd} . '/' . $media->{storage} . '/linuxrc', 0755,
                     join("\n",
                          "#!/bin/nash",
                          #- required for labels and ps
                          "mount -t proc none /proc",
                          #- required for cdrom labels
                          "mount -t sysfs none /sys",
                          (map { join(" ", "insmod", "/modules/$_.ko", grep { $_ } $live->{system}{module_options}{$_}) } @modules),
                          "probe-modules",
                          if_($rrpt_dev,
                              "echo *** Waiting for new partitions on device ${rrpt_dev} ***",
                              "sh -c 'while ! ls /sys/block/${rrpt_dev}/${rrpt_dev}* >/dev/null 2>&1; do sleep 3; blockdev --rereadpt /dev/${rrpt_dev} >/dev/null 2>&1; done'"),
                          $debug_shell,
                          if_($pre, deref_array($pre)),
                          "mkdevices /dev",
                          $storage_fs{exists $storage_fs{$fs}{mount} ? $fs : 'generic'}{mount}->($live, $media),
                          (map { $loop{$_->{type}}{mount}->($live, $_) } @$mount_first, @$mount_last),
                          ($live->{mount}{overlay} ? $overlay{$live->{mount}{overlay}}{mount}->($live) : ()),
                          "echo 0x0100 > /proc/sys/kernel/real-root-dev",
                          "umount /sys",
                          "umount /proc",
                          "pivot_root $target $target/initrd",
                          q(sh -c 'rmdir /initrd/live/union'),
                          q(sh -c 'if [ -d /initrd/live/modules ]; then cd /initrd/live/modules; for i in `ls -1`; do mkdir -p /live/modules/$i; mount -n --move $i /live/modules/$i; rmdir $i; done; rmdir /initrd/live/modules; fi'),
                          q(sh -c 'cd /initrd/live; for i in `ls -1`; do mkdir -p /live/$i; mount -n --move $i /live/$i; rmdir $i; done; rmdir /initrd/live'),
                          if_($live->{system}{initrd_post}, deref_array($live->{system}{initrd_post})),
                          ""));
}

sub compress_initrd_tree {
    my ($live, $media) = @_;

    my $initrd_tree = get_builddir($live) . $live->{prefix}{build}{initrd} . '/' . $media->{storage};
    my $size = run_program::get_stdout("du -ks $initrd_tree | awk '{print \$1}'") + 250;
    my $inodes = run_program::get_stdout("find $initrd_tree | wc -l") + 1250;
    $size = int($size + $inodes / 10) + 1; #- 10 inodes needs 1K
    my $initrd = get_builddir($live) . $live->{prefix}{build}{boot} . get_initrd_path($media);
    $initrd =~ s/.gz$//;

    mkdir_p(dirname($initrd));
    run_('dd', 'if=/dev/zero', "of=$initrd", 'bs=1k', "count=$size");
    run_('mke2fs', '-q', '-m', 0, '-F', '-N', $inodes, '-s', 1, $initrd);
    mkdir_p($live->{mnt});
    run_('mount', '-o', 'loop', '-t', 'ext2', $initrd, $live->{mnt});
    cp_af(glob("$initrd_tree/*"), $live->{mnt});
    rm_rf($live->{mnt} . "/lost+found");
    run_('umount', $live->{mnt});
    run_('gzip', '-f', '-9', $initrd);
}

sub add_splash {
    my ($live, $media) = @_;
    if ($live->{system}{vga_mode} && $live->{system}{splash} ne 'no') {
	require bootloader;
	my $initrd = get_builddir($live) . $live->{prefix}{build}{boot} . get_initrd_path($media);
	my $tmp_initrd = '/tmp/initrd.gz';
        cp_f($initrd, get_system_root($live) . $tmp_initrd);
        {
            local $::prefix = get_system_root($live);
            bootloader::add_boot_splash($tmp_initrd, $live->{system}{vga_mode});
        }
        cp_f(get_system_root($live) . $tmp_initrd, $initrd);
	unlink(get_system_root($live) . $tmp_initrd);
    }
}

sub get_default_append {
    my ($live) = @_;
    join(' ',
         'fastboot', #- needed to avoid fsck
         if_($live->{system}{vga_mode},
             'splash=silent',
             'vga=' . $live->{system}{vga_mode}),
     );
}

sub get_bootloader_timeout {
    my ($live) = @_;
    defined $live->{media}{bootloader_timeout} ? $live->{media}{bootloader_timeout} : 4;
}

my @syslinux_boot_files = qw(/vmlinuz /syslinux/bootlogo /help.msg);

sub build_syslinux_cfg {
    my ($live, $media, $opts) = @_;
    my $append = get_default_append($live);
    #- syslinux wants files at root (used with vfat fs)
    my $to_root = get_boot_setting($media, 'fs', $opts) eq 'vfat';
    my ($initrd, $kernel, $bootlogo, $help) = map { $to_root ? basename($_) : $_ }
      map { $live->{prefix}{media}{boot} . $_ } get_initrd_path($media), @syslinux_boot_files;
    my $has_bootlogo = -e get_builddir($live) . $live->{prefix}{build}{boot} . '/syslinux/bootlogo';
    my $timeout = get_bootloader_timeout($live) * 10;
    join("\n",
         "default $live->{media}{title}",
         "prompt 1",
         "timeout $timeout",
         $has_bootlogo ? "gfxboot $bootlogo" : "display $help",
         (map {
             my ($name, $cmdline) = @$_;
             $name =~ s/\s/_/g;
             "label " . ($name || $live->{media}{title}),
             "    kernel $kernel",
             "    append initrd=$initrd $append $cmdline";
         } group_by2('' => '', @{$live->{system}{boot_entries}})),
         "",
     );
}

sub build_grub_cfg {
    my ($live, $media, $device) = @_;
    #- FIXME: use the bootloader module from drakx
    my ($part_nb) = $device =~ /(\d+)$/;
    my $grub_part = "(hd0" . (defined $part_nb ? "," . ($part_nb-1) : "") . ")";
    join("\n",
         "timeout " . get_bootloader_timeout($live),
         "gfxmenu $grub_part" . $live->{prefix}{media}{boot} . "/gfxmenu",
         "default 0",
         (map {
             my ($name, $cmdline) = @$_;
             "title " . $live->{media}{title} . if_($name, " ($name)"),
             "kernel $grub_part" . $live->{prefix}{media}{boot} . "/vmlinuz " . get_default_append($live) . if_($cmdline, " $cmdline"),
             "initrd " . $live->{prefix}{media}{boot} . get_initrd_path($media);
         } group_by2('' => '', @{$live->{system}{boot_entries}})),
         "",
     );
}

sub install_system {
    my ($live) = @_;

    my $repository = $live->{settings}{repository} . '/' . $live->{settings}{arch};

    my $drakx_in_chroot = $repository . '/misc/drakx-in-chroot';
    my $remote_repository = $repository =~ m!^(ftp|http)://! && $1;
    if ($remote_repository) {
        my $local_drakx_in_chroot = get_builddir($live) . $live->{prefix}{build}{scripts} . '/drakx-in-chroot';
        mkdir_p(dirname($local_drakx_in_chroot));
        run_('curl', '--silent', '-o', $local_drakx_in_chroot, $drakx_in_chroot)
          or die "unable to get drakx-in-chroot from remote repository\n";
        $drakx_in_chroot = $local_drakx_in_chroot;
    }

    local %ENV = (%ENV, %{$live->{system}{install_env}});
    $ENV{DRAKLIVE_LANGS} = join(':', uniq((ref $live->{regions} ? @{$live->{regions}{$live->{settings}{region}}} : ()), @{$live->{system}{langs_always}}));
    $ENV{DRAKLIVE_REGION} = $live->{settings}{region};
    run_({ setarch => $live->{settings}{arch} },
	 'perl', $drakx_in_chroot,
         $repository,
         get_system_root($live),
         if_($live->{system}{auto_install}, '--auto_install', $live->{settings}{config_root} . '/' . $live->{system}{auto_install}),
         if_($live->{system}{patch_install}, '--defcfg', $live->{settings}{config_root} . '/' . $live->{system}{patch_install}),
         if_($live->{system}{rpmsrate}, '--rpmsrate', $live->{settings}{config_root} . '/' . $live->{system}{rpmsrate}),
         ($live->{system}{stage2_updates} ? (map { ('--stage2-update', $live->{settings}{config_root} . '/' . $_->[0], $_->[1]) } @{$live->{system}{stage2_updates}}) : ()),
    ) or die "unable to install system chroot\n";
    post_install_system($live);
}

sub configure_draklive_resize {
    my ($live) = @_;

    my $resizable_loopback = find { $_->{min_size} } @{$live->{mount}{dirs} || []};
    if ($resizable_loopback) {
        output(get_system_root($live) . '/etc/sysconfig/draklive-resize', <<EOF);
DRAKLIVE_RESIZE=yes
LOOPBACK=$live->{prefix}{live}{mnt}$live->{prefix}{media}{mnt}$live->{prefix}{media}{loopbacks}$resizable_loopback->{path}
TYPE=$resizable_loopback->{fs}
MIN_SIZE=$resizable_loopback->{min_size}
MOUNT=$live->{prefix}{live}{mnt}$resizable_loopback->{mountpoint}_resized
OLD_MOUNT=$live->{prefix}{live}{mnt}$resizable_loopback->{mountpoint}
UNION=/
EOF
    }
}

sub copy_files_to {
    my ($live, $files, $root) = @_;
    foreach (@$files) {
        my ($source, $dest, $o_perm) = @$_;
        $dest = $root . '/' . $dest;
        mkdir_p($dest =~ m|/$| ? $dest : dirname($dest));
        my @sources = glob__($live->{settings}{config_root} . '/' . $source);
        print STDERR "copying @sources to $dest\n";
        cp_f(@sources, $dest);
        chmod $o_perm, $dest if $o_perm;
    }
}

sub post_install_system {
    my ($live) = @_;

    my $previous_umask = umask;
    #- workaround buggy installation of directories that are not owned by any packages
    umask 022;

    #- copy resolv.conf for name resolution to work when adding media
    cp_f("/etc/resolv.conf", get_system_root($live) . "/etc");

    #- remove previous draklive leftovers if needed
    run_({ root => get_system_root($live) }, 'urpmi.removemedia', '-a');

    foreach (@{$live->{system}{additional_media}}) {
        run_({ root => get_system_root($live) }, 'urpmi.addmedia', if_($_->{distrib}, '--distrib'), $_->{name}, $_->{path})
          or die "unable to add media from $_->{path}\n";
        @{$_->{packages}} or next;
        run_({ root => get_system_root($live), setarch => $live->{settings}{arch} },
	     'urpmi', '--auto', '--no-verify-rpm', if_(!$_->{distrib}, '--searchmedia', $_->{name}), @{$_->{packages}})
          or die "unable to install packages from $_->{path}\n";
    }

    #- additional rpms may have dependencies in additional media
    if (@{$live->{system}{rpms}}) {
        my $rpm_tmp_dir = '/tmp/draklive_rpms';
        mkdir_p(get_system_root($live) . $rpm_tmp_dir);
        cp_f((map { $live->{settings}{config_root} . '/' . $_ } @{$live->{system}{rpms}}), get_system_root($live) . $rpm_tmp_dir);
        run_({ root => get_system_root($live), setarch => $live->{settings}{arch} },
	     'urpmi', '--auto', '--no-verify-rpm',
             map { $rpm_tmp_dir . '/' . basename($_) } @{$live->{system}{rpms}})
          or die "unable to install additional system rpms\n";
        rm_rf(get_system_root($live) . $rpm_tmp_dir);
    }

    #- remove urpmi media added by drakx-in-chroot and additional media, they're unusable
    run_({ root => get_system_root($live) }, 'urpmi.removemedia', '-a');

    my $erase = join(' ', @{$live->{system}{erase_rpms}});
    run_({ root => get_system_root($live), setarch => $live->{settings}{arch} },
	 'sh', '-c', "rpm -qa $erase | xargs rpm -e ") if $erase;

    run_({ root => get_system_root($live) }, 'chkconfig', '--del', $_) foreach @{$live->{system}{disable_services}};

    #- make sure harddrake is run:
    #- if previous HW config file is empty, we assumes DrakX has just completed the installation
    #- (do it in chroot, or else Storable from the build box may write an incompatible config file)
    run_({ root => get_system_root($live) },
         'perl', '-MStorable', '-e', qq(Storable::store({ UNKNOWN => {} }, '/etc/sysconfig/harddrake2/previous_hw')));

    #- remove some build-machine specific configuration
    substInFile { undef $_ if /^[^#]/ } get_system_root($live) . $_
      foreach qw(/etc/fstab /etc/mtab /etc/modprobe.conf /etc/modprobe.preload /etc/iftab /etc/shorewall/interfaces /etc/mdadm.conf /etc/resolv.conf);
    unlink($_) foreach map { glob(get_system_root($live) . $_) } @{$live->{system}{remove_files} || []};

    output_with_perm(get_system_root($live) . '/etc/fstab', 0644, "none / unionfs rw 0 0\n");

    #- interactive mode can lead to race in initscripts
    #- (don't use addVarsInSh from MDK::Common, it breaks shell escapes)
    substInFile { s/^PROMPT=.*/PROMPT=no/ } get_system_root($live) . '/etc/sysconfig/init';

    configure_draklive_resize($live);

    if ($live->{system}{preselect_kdm_user}) {
        #- preselect specified user in kdm
        my $kdm_cfg = get_system_root($live) . '/etc/kde/kdm/kdmrc';
        update_gnomekderc($kdm_cfg, 'X-:0-Greeter' => (PreselectUser => 'Default', DefaultUser => $live->{system}{preselect_kdm_user})) if -f $kdm_cfg;
    }

    #- apply patches and install files after the configuration is cleaned
    #- to allow special configuration files (especially modprobe.preload)
    foreach (@{$live->{system}{patches}}) {
        my $patch = $live->{settings}{config_root} . '/' . $_;
        my @args = ('-p0', '-d', get_system_root($live), '-i', $patch);
        run_program::run('patch', '>', '/dev/null', '--dry-run', '-f', '-R', @args) || run_('patch', @args)
            or die "unable to apply patch " . $patch . "\n";
    }

    copy_files_to($live, $live->{system}{files}, get_system_root($live));

    run_({ setarch => $live->{settings}{arch} },
	 "chroot", get_system_root($live), "bash", "-c", $live->{system}{postInstall}) if $live->{system}{postInstall};

    eval { rm_rf(get_builddir($live) . $live->{prefix}{build}{files}) };
    mkdir_p(get_builddir($live) . $live->{prefix}{build}{files});
    if ($live->{media}{files}) {
        copy_files_to($live, $live->{media}{files}, get_builddir($live) . $live->{prefix}{build}{files});
    }

    run_("chroot " . get_system_root($live) . " rpm -qa | sort > " . get_builddir($live) . "/packages.lst");

    #- workaround rpm bug that leaves a corrupted rpm DB in chroot
    rm_rf(glob_(get_builddir($live) . "/var/lib/rpm/__db.*"));

    umask $previous_umask;
}

sub umount_external_filesystem {
    my ($live) = @_;
    my $mnt = get_system_root($live) . "/mnt/";
    eval { fs::mount::umount("$mnt/$_") } foreach all($mnt);
}

sub expand_file_list {
    my ($live, @files) = @_;
    map {
        $_->{path} ?
          $_->{path} :
          chomp_(cat_(glob(($_->{rooted} && get_system_root($live)) . $_->{source})));
    } @files;
}

#- hardlink recursively file list to a directory
sub hardlink_filtered {
    my ($src, $dest, $files) = @_;
    mkdir_p($dest);
    my $pwd = $ENV{PWD};
    chdir($src);
    my $list_file = tmpnam();
    output_p($list_file, map { "$_\n" } grep { -e $src . $_ } @$files);
    #- cpio -pldm won't copy recursively, use rsync -r instead
    system('rsync', '-ar', '--files-from=' . $list_file, '--link-dest=' . $src, $src, $dest);
    unlink $list_file;
    chdir($pwd);
}

sub list_loopback_modules {
    my ($live) = @_;
    map {
        my $l = $_;
        map {
            my $list = $_;
            my $name = basename($list);
            $name =~ s/\.[^.]+$//;
            { type => $l->{type}, name => $name, files => [ expand_file_list($live, { source => $list }) ] };
        } glob(($_->{rooted} && get_system_root($live)) . $_->{source});
    } @{$live->{loopbacks}{modules}};
}

sub create_loopback_files {
    my ($live) = @_;
    # umount filesystem in the live before creating the loopback
    umount_external_filesystem($live);

    my @excluded_files = expand_file_list($live, @{$live->{loopbacks}{exclude}{files} || []});
    my @modules_files = expand_file_list($live, @{$live->{loopbacks}{modules} || []});

    foreach (grep { exists $loop{$_->{type}}{build} } @{$live->{mount}{dirs} || []}) {
        local $_->{exclude} = [ @excluded_files, @modules_files ];
        $loop{$_->{type}}{build}->($live, $_);
    }

    foreach my $module (list_loopback_modules($live)) {
        my $copy_tree = get_system_root($live) . "/tmp/draklive/loop/$module->{name}";
        eval { rm_rf($copy_tree) };
        hardlink_filtered(get_system_root($live), $copy_tree, $module->{files});
        my $loop = $loop{$module->{type}};
        $loop->{build}->($live, { path => "$live->{prefix}{build}{modules}/$module->{name}$loop->{extension}", root => $copy_tree, exclude => \@excluded_files });
        eval { rm_rf($copy_tree) };
    }

    if (@excluded_files) {
        my $excluded_tree = get_system_root($live) . "/tmp/draklive/excluded/all";
        eval { rm_rf($excluded_tree) };
        hardlink_filtered(get_system_root($live), $excluded_tree, \@excluded_files);

        foreach my $module (list_loopback_modules($live)) {
            my $copy_tree = get_system_root($live) . "/tmp/draklive/excluded/$module->{name}";
            eval { rm_rf($copy_tree) };
            hardlink_filtered($excluded_tree, $copy_tree, $module->{files});
            my $loop = $loop{$module->{type}};
            $loop->{build}->($live, { path => "$live->{prefix}{build}{modules}/excluded-$module->{name}$loop->{extension}", root => $copy_tree });
            eval { rm_rf($copy_tree) };
        }

        my $loop = $loop{$live->{loopbacks}{exclude}{type}};
        $loop->{build}->($live, { path => "/excluded$loop->{extension}", root => $excluded_tree, exclude => \@modules_files });

        eval { rm_rf($excluded_tree) };
    }
}

sub list_selected_loopbacks {
    my ($live) = @_;
    (map { $loop{$_->{type}}{is_loopback} && $_->{path} ? $_->{path} : () } @{$live->{mount}{dirs} || []}),
    (map { $live->{prefix}{build}{modules} . '/' . $_ }
       $live->{settings}{pack} ? @{$live->{packs}{$live->{settings}{pack}} || []} : ());
}

#- mainly for storage-specific subroutines
sub get_storage_setting {
    my ($media, $setting) = @_;
    $storage{$media->{storage}}{$setting};
}

#- for actions that support an optional boot storage type
sub get_boot_setting {
    my ($media, $setting, $opts) = @_;
    $opts->{boot} ? $storage{$opts->{boot}}{$setting} : get_media_setting($media, $setting);
}

#- for user-customisable media setting, that can override storage setting
sub get_media_setting {
    my ($media, $setting) = @_;
    $media->{$setting} || get_storage_setting($media, $setting);
}

sub get_media_fs_module {
    my ($media) = @_;
    my $fs = get_media_setting($media, 'fs');
    $fs eq 'iso9660' ? 'isofs' : $fs eq 'ext2' ? @{[]} : $fs;
}

sub get_media_label {
    my ($media) = @_;
    first(get_media_setting($media, 'source') =~ /^LABEL=(.*)$/);
}

sub get_media_device {
    my ($live, $opts) = @_;
    return $opts->{device} if $opts->{device};
    my $label = get_media_label($live->{media}) or return get_media_setting($live->{media}, 'source');
    my $device = chomp_(`readlink -f /dev/disk/by-label/$label`)
      or die "unable to find device for /dev/disk/by-label/$label\n";
    $device;
}

sub get_media_source_for_nash {
    my ($media) = @_;
    my $label = get_media_label($media);
    #- strip vfat labels to 11 chars and upper-case it
    $label && get_media_setting($media, 'fs') eq 'vfat' ?
      'LABEL=' . uc(substr($label, 0, 11)) :
      get_media_setting($media, 'source');
}

sub prepare_bootloader {
    my ($live) = @_;
    create_initrd($live);
    cp_f(get_system_root($live) . '/boot/vmlinuz-' . find_kernel($live), get_builddir($live) . $live->{prefix}{build}{boot} . '/vmlinuz');
    require bootsplash;
    my $theme = do {
        local $::prefix = get_system_root($live);
        bootsplash::themes_read_sysconfig('800x600');
    };
    my $syslinux_dir = get_builddir($live) . $live->{prefix}{build}{boot} . '/syslinux';
    mkdir_p($syslinux_dir);
    my $default_gfxboot_theme = "Mandriva";
    print "copying $default_gfxboot_theme gfxboot theme\n";
    cp_f(glob_(get_system_root($live) . "/usr/share/gfxboot/themes/$default_gfxboot_theme/install/*"), $syslinux_dir);
    if ($theme->{name} ne $default_gfxboot_theme) {
        print "copying $theme->{name} gfxboot theme\n";
        cp_f(glob_(get_system_root($live) . "/usr/share/gfxboot/themes/$theme->{name}/*"), $syslinux_dir);
    }
    my $bootlogo = $syslinux_dir . '/bootlogo';
    warn "unable to find gfxboot splash ($bootlogo)" if ! -f $bootlogo;
    output_p($syslinux_dir . '/gfxboot.cfg', "livecd=1\n");

    run_({ root => get_system_root($live) }, '/usr/sbin/grub-gfxmenu', '--update-gfxmenu');
    run_('mv', get_system_root($live) . '/boot/gfxmenu', get_builddir($live) . $live->{prefix}{build}{boot});

    output(get_builddir($live) . $live->{prefix}{build}{boot} . '/help.msg',
           pack("C*", 0x0E, 0x80, 0x03, 0x00, 0xC) . qq(
Welcome to Mandriva live!

The command line can be used to specify kernel options.

$live->{media}{title} <kernel options>

));

    foreach my $media ($live->{media}) {
        foreach my $boot ('', @{$media->{extra_boot}}) {
            my $opts = { boot => $boot };
            output(get_builddir($live) . $live->{prefix}{build}{boot} . get_syslinux_path($media, $opts),
                   build_syslinux_cfg($live, $media, $opts));
        }
    }
}

sub device_allocate_fs {
    my ($device, $size) = @_;
    run_('dd', "of=$device", 'count=0', 'bs=1', "seek=" . removeXiBSuffix($size));
}

#- format $device as type $type
sub device_mkfs {
    my ($device, $type) = @_;
    if ($type eq 'vfat') {
        run_('mkfs.vfat', $device);
    } elsif (member($type, 'ext2', 'ext3')) {
        run_("mkfs.$type", "-m", 0, if_(!-b $device, '-F'), $device);
    } else {
        die "unable to mkfs for unsupported media type $type\n";
    }
}

sub set_device_label {
    my ($device, $type, $label) = @_;
    if ($type eq 'vfat') {
        mtools_run_('mlabel', '-i', $device, '::' . $label);
    } elsif (member($type, 'ext2', 'ext3')) {
        run_('e2label', $device, $label);
    } else {
        die "unable to set label for unsupported media type $type\n";
    }
}

sub get_cdrom_master_path {
    my ($live, $opts) = @_;
    get_builddir($live) . $live->{prefix}{build}{images} . '/' . ($opts->{boot} ? 'boot-' . $opts->{boot} : 'live') . '.iso';
}

sub create_cdrom_master {
    my ($live, $opts) = @_;
    my $label = get_media_label($live->{media}) or die "the source device must be described by a label\n";
    my $dest;
    unless ($opts->{onthefly}) {
        $dest = get_cdrom_master_path($live, $opts);
        mkdir_p(dirname($dest));
    }
    run_('genisoimage', '-pad', '-l', '-R', '-J',
         '-V', $label, #'-A', $application, '-p', $preparer, '-P', $publisher,
         '-b', 'isolinux/isolinux.bin',
         '-c', 'isolinux/boot.cat',
         '-hide-rr-moved', '-no-emul-boot',
         '-boot-load-size', 4, '-boot-info-table',
         '-graft-points',
         if_($dest, '-o', $dest),
         'isolinux=' . get_builddir($live) . $live->{prefix}{build}{boot} . '/syslinux',
         'isolinux/isolinux.bin=/usr/lib/syslinux/isolinux.bin',
         'isolinux/isolinux.cfg=' . get_builddir($live) . $live->{prefix}{build}{boot} . get_syslinux_path($live->{media}, $opts),
         $live->{prefix}{media}{boot} . '=' . get_builddir($live) . $live->{prefix}{build}{boot},
         if_(!$opts->{boot_only},
             (map {
                 $live->{prefix}{media}{loopbacks} . $_ .
                 '=' .
                 get_builddir($live) . $live->{prefix}{build}{loopbacks} . $_;
             } list_selected_loopbacks($live)),
             if_($live->{media}{files},
                 map { 
                     $_ . '=' . get_builddir($live) . $live->{prefix}{build}{files} . '/' . $_;
                 } all(get_builddir($live) . $live->{prefix}{build}{files})
             ),
         ),
    ) or die "unable to run genisoimage\n";
    run_('mkcd', '--addmd5', $dest) if $dest;
}

sub get_usb_master_path {
    my ($live) = @_;
    get_builddir($live) . $live->{prefix}{build}{images} . '/live.img';
}

sub create_usb_master {
    my ($live, $opts) = @_;
    my $dest = get_usb_master_path($live);
    mkdir_p(dirname($dest));
    #- dumb guess, a bit too large, and valid for FAT only
    my $size = directory_usage(get_builddir($live) . $live->{prefix}{build}{loopbacks}) +
               directory_usage(get_builddir($live) . $live->{prefix}{build}{boot});
    device_allocate_fs($dest, $size);
    device_mkfs($dest, get_media_setting($live->{media}, 'fs'))
      or die "unable to format $dest\n";
    local $opts->{device} = $dest;
    record_usb_master($live, $opts);
}

#- $opts:
#-   media: alternate media
#-   onthefly : if true, the create function must output to stdout
sub create_master {
    my ($live, $opts) = @_;

    if (my $create = get_boot_setting($live->{media}, 'create', $opts)) {
        $create->($live, $opts);
    } else {
        warn "not implemented yet";
    }
}

sub maybe_umount_device {
    my ($device) = @_;
    run_('umount', $device) if cat_('/proc/mounts') =~ m!^$device\s+!m;
}

sub format_cdrom_device {
    my ($live, $opts) = @_;
    run_('wodim', '-v', 'dev=' . get_media_device($live, $opts), "blank=fast");
}

sub format_usb_device {
    my ($live, $opts) = @_;
    my $device = get_media_device($live, $opts);
    maybe_umount_device($device);
    device_mkfs($device, get_media_setting($live->{media}, 'fs'))
      or die "unable to format device $device\n";
}

#- $opts:
#-   media: alternate media
sub format_device {
    my ($live, $opts) = @_;

    get_media_device($live, $opts) or die "no device defined in media configuration\n";
    if (my $format = get_boot_setting($live->{media}, 'format', $opts)) {
        $format->($live, $opts);
    } else {
        warn "not implemented yet";
    }
}

sub record_cdrom_master {
    my ($live, $opts) = @_;
    my $device = get_media_device($live, $opts)
      or die "no device defined in media configuration\n";
    my $src = $opts->{onthefly} ? '-' : get_cdrom_master_path($live, $opts);
    run_('wodim', '-v', 'dev=' . $device, $src);
}

sub record_usb_master {
    my ($live, $opts) = @_;
    my $media = $live->{media};
    if (my $label = !$opts->{boot_only} && $opts->{device} && get_media_label($media)) {
        set_device_label($opts->{device}, get_media_setting($media, 'fs'), $label);
    }
    my $device = get_media_device($live, $opts)
      or die "unable to find recording device (missing label? try with --device <device>)\n";
    my $bootloader = get_boot_setting($media, 'bootloader', $opts);
    member($bootloader, 'grub', 'syslinux') or die "no bootloader defined in media configuration\n";
    mkdir_p($live->{mnt});
    run_('mount', if_(-f $device, '-o', 'loop'), $device, $live->{mnt})
      or die "unable to mount $device\n";
    rm_rf($live->{mnt} . $live->{prefix}{media}{boot}) if -e $live->{mnt} . $live->{prefix}{media}{boot};
    cp_af(get_builddir($live) . $live->{prefix}{build}{boot}, $live->{mnt} . $live->{prefix}{media}{boot});

    my $grub_device_map = $live->{mnt} . $live->{prefix}{media}{boot} . "/grub/device.map";
    if ($bootloader eq 'syslinux') {
        cp_f(get_builddir($live) . $_, $live->{mnt}) foreach map {
            $live->{prefix}{boot} . $_;
        } get_syslinux_path($media, $opts), get_initrd_path($media), @syslinux_boot_files;
    } elsif ($bootloader eq 'grub') {
        #- FIXME: add get_grub_path (when building boot configuration files)
        #         and get_bootloader_path (when copying)
        mkdir_p($live->{mnt} . $live->{prefix}{media}{boot} . '/grub');
        cp_f(get_builddir($live) . $live->{prefix}{build}{boot} . '/gfxmenu', $live->{mnt} . $live->{prefix}{media}{boot});
        output_p($live->{mnt} . $live->{prefix}{media}{boot} . '/grub/menu.lst', build_grub_cfg($live, $media, $device));
        unlink $grub_device_map;
    }

    if (-b $device) {
        if ($bootloader eq 'syslinux') {
            #- use syslinux -s, "safe, slow and stupid" version of SYSLINUX, unless specified otherwise
            run_('syslinux', if_(!$media->{fast_syslinux}, '-s'), $device)
              or die "unable to run syslinux on $device\n";
        } elsif ($bootloader eq 'grub') {
            my $local_grub_install = get_builddir($live) . $live->{prefix}{build}{scripts} . '/grub-install';
            mkdir_p(dirname($local_grub_install));
            cp_f(get_system_root($live) . '/sbin/grub-install', $local_grub_install);
            my $root = get_system_root($live);
            substInFile {
                s!^\s*exec_prefix=.*!exec_prefix=$root!;
                s!^\s*grub_prefix=/boot/!grub_prefix=$live->{prefix}{media}{boot}/!;
                s!^\s*bootdir=(.*)/boot$!bootdir=$1$live->{prefix}{media}{boot}!;
            } $local_grub_install;

            my $master_device = $device;
            $master_device =~ s/(\d+)$//;
            foreach ($master_device, $device) {
                run_($local_grub_install, '--root-directory=' . $live->{mnt}, '--no-floppy', $_)
                  or die "unable to run grub on $device\n";
            }
            unlink $grub_device_map;
        }
    } else {
        warn "not running $bootloader on non block device $device";
    }

    do {
        my $loopbacks_source = get_builddir($live) . $live->{prefix}{build}{loopbacks} . '/';
        my $total = directory_usage($loopbacks_source);
        my $all_files = 0;
        my $current_file = 0;
        my $list_file = tmpnam();
        output_p($list_file, map { ".$_\n" } list_selected_loopbacks($live));
        local $/ = "\r";
        run_foreach($live->{update_progress} ? sub {
                        if (/^\s*(\d+)\s+\d+%\s+/) {
                            $current_file = $1;
                            $live->{update_progress}->(undef, $all_files + $current_file, $total);
                        }
                        if (/(?:^|\n)\S+/) {
                            $all_files += $current_file;
                            $current_file = 0;
                        }
                    } : sub {},
                    'rsync', '-vdP', '--inplace', '--files-from=' . $list_file,
                    $loopbacks_source, $live->{mnt} . $live->{prefix}{media}{loopbacks})
          or die "unable to copy loopback files\n";
        unlink $list_file;

        cp_af(glob_(get_builddir($live) . $live->{prefix}{build}{files} . '/*'), $live->{mnt});
    } unless $opts->{boot_only};

    my @hidden_files = map { basename($_) } glob_($live->{mnt} . "/.*"), glob_($live->{mnt} . "/autorun.*");

    run_('umount', $live->{mnt});
    maybe_umount_device($device);

    if (get_media_setting($media, 'fs') eq 'vfat') {
        mtools_run_('mattrib', '+h', '-i', $device, '::' . $_) foreach @hidden_files;
        mtools_run_('mattrib', '+r', '+s', '-/', '-i', $device, '::' . $_)
          foreach $live->{prefix}{media}{boot}, $live->{prefix}{media}{loopbacks};
    }
}

#- $opts:
#-   onthefly : if true, the record function must read from stdin
sub record_master {
    my ($live, $opts) = @_;

    if (my $record = get_boot_setting($live->{media}, 'record', $opts)) {
        $record->($live, $opts);
    } else {
        warn "not implemented yet";
    }
}

sub pipe_subs {
    my ($writer, $reader) = @_;
    my ($r, $w) = POSIX::pipe;
    if (my $pid = fork()) {
        POSIX::close($w) or die "couldn't close: $!\n";
        my $stdin = POSIX::dup(0) or die "couldn't dup: $!\n";
        POSIX::dup2($r, 0) or die "couldn't dup2: $!\n";
        POSIX::close($r);
        $reader->();
        POSIX::close(0) or warn "writer exited $?";
        POSIX::dup2($stdin, 0) or die "couldn't dup2: $!\n";
        waitpid($pid, 0);
    } else {
        POSIX::close($r) or die "couldn't close: $!\n";
        #- don't screw up reader
        POSIX::dup2(POSIX::open('/dev/null', &POSIX::O_WRONLY), 2) or die "couldn't dup2: $!\n";
        POSIX::dup2($w, 1) or die "couldn't dup2: $!\n";
        POSIX::close($w);
        $| = 1; #- autoflush write
        exit !$writer->();
    }
}

sub record_onthefly {
    my ($live, $opts) = @_;

    my $record = get_storage_setting($live->{media}, 'record');
    unless ($record) {
        warn "not implemented yet";
        return;
    }
    if (my $create = get_storage_setting($live->{media}, 'record_needs_master') && get_storage_setting($live->{media}, 'create')) {
        local $opts->{onthefly} = 1;
        #- pipe creation step to recording step
        pipe_subs(sub { $create->($live, $opts) },
                  sub { $record->($live, $opts) });
    } else {
        #- no creation step, record directly
        $record->($live, $opts);
    }
}

sub copy_wizard {
    my ($live) = @_;

    complete_config($live);
    $live->{system}{vga_mode} = 788 if !defined $live->{system}{vga_mode};
    my $live_media = $live->{prefix}{live}{mnt} . $live->{prefix}{media}{mnt};

    require interactive;
    require wizards;
    my $in = 'interactive'->vnew('su');
    my (@available_storage, @available_devices);
    my ($storage, $device, $format);
    my %source_types = (
        live => N("Use current live system"),
        file => N("Select a file"),
    );
    my ($source_type, $source_path);
    my $source_is_mounted = sub { -d ($live->{settings}{builddir} . $live->{prefix}{media}{boot}) };
    my $umount_source = sub {
        if ($source_type ne 'live' && $source_is_mounted->()) {
            run_('umount', $live->{settings}{builddir});
            rmdir($live->{settings}{builddir});
        }
    };
    my $w;
    $w = wizards->new({
        name => N("Live system copy wizard"),
        pages => {
            welcome => {
                name => N("Welcome to the live system copy wizard"),
                no_back => 1,
                next => 'source',
            },
            source => {
                name => N("Which live system do you want to copy?"),
                data => [ if_(-d ($live_media . $live->{prefix}{media}{loopbacks}),
                              { type => 'list', val => \$source_type,
                                list => sort(keys(%source_types)),
                                format => sub { $source_types{$_[0]} } }),
                          { type => 'file', val => \$source_path,
                            disabled => sub { $source_type eq 'live' } } ],
                pre => $umount_source,
                complete => sub {
                    if ($source_type eq 'live') {
                        $live->{settings}{builddir} = $live_media;
                    } else {
                        $live->{settings}{builddir} = File::Temp::tempdir();
                        if (!run_('mount', '-o', 'loop', $source_path, $live->{settings}{builddir})) {
                            $in->ask_warn(N("Error"), N("Unable to use selected file"));
                            return 1;
                        }
                    }
                    0;
                },
                post => sub {
                    my $boot = $live->{settings}{builddir} . $live->{prefix}{media}{boot};
                    @available_storage = sort(grep { -d "$boot/$_" && exists $storage{$_}{detect} } all($boot));
                    if (@available_storage == 1) {
                        $storage = $available_storage[0];
                        return 'device';
                    }
                    return 'storage';
                }
            },
            storage => {
                name => N("Please select the medium type"),
                data => [ { type => 'list', allow_empty_list => 1,
                            val => \$storage, list => \@available_storage } ],
                next => 'device',
            },
            device => {
                name => N("Please select the device that will contain the new live system"),
                pre => sub {
                    my %devices = map { $_->{device} => $_ } $storage{$storage}{detect}->();
                    $_->{formatted_name} = $_->{usb_description} || $_->{info} || $_->{device} foreach values %devices;
                    @available_devices = ();
                    require fs::proc_partitions;
                    foreach (fs::proc_partitions::read([ values %devices ])) {
                        if ($_->{rootDevice} && exists $devices{$_->{rootDevice}}) {
                            my $description = $devices{$_->{rootDevice}}{usb_description} || $devices{$_->{rootDevice}}{info};
                            $_->{formatted_name} = $description ? "$description ($_->{device})" : $_->{device};
                            push @available_devices, $_;
                        }
                    }
                    delete $devices{$_->{rootDevice}} foreach @available_devices;
                    unshift @available_devices, map { $devices{$_} } sort keys %devices;
                    undef $device;
                },
                data => [ { type => 'list', allow_empty_list => 1,
                            val => \$device, , list => \@available_devices,
                            format => sub { $_[0]{formatted_name} } },
                          { text => N("Format selected device"), val => \$format, type => 'bool' } ],
                complete => sub {
                    return 0 if defined $device;
                    $in->ask_warn(N("Error"), N("You must select a device!"));
                    1;
                },
                post => sub {
                    (my $_wait, $live->{update_progress}) = $in->wait_message_with_progress_bar;
                    do {
                        local $::isInstall = 1; # quick hack to embed the wait message
                        $live->{update_progress}->(N("Copying in progress"));
                    };
                    eval {
                        my $opts = { media => { storage => $storage, device => '/dev/' . $device->{device} } };
                        format_device($live, $opts) if $format;
                        record_onthefly($live, $opts);
                    };
                    delete $live->{update_progress};
                    if (my $error = $@) {
                        $in->ask_warn(N("Error"), $error);
                        $w->{pages}{device}{end} = 1;
                    }
                    return "end";
                },
            },
            end => {
                name => N("Congratulations") . "\n\n" . N("Your live system is now copied."),
                no_back => 1,
                end => 1,
            },
        }
    });
    $w->process($in);
    $umount_source->();
    $in->exit;
}

sub read_config {
    my ($live, $config_root, $config_path, $settings_path) = @_;

    if ($config_path && -e getcwd() . '/' . $config_path) {
        $config_root = getcwd();
    }
    print "using $config_root as directory root\n";

    add2hash($live->{settings} ||= {}, { getVarsFromSh($config_root . '/' . $settings_path) }) if $settings_path;
    if ($config_path) {
        #- don't use do(), since it can't see lexicals in the enclosing scope
        my $cfg = eval(cat_($config_root . '/' . $config_path)) or die "unable to load $config_path: $@\n";
        put_in_hash($live, $cfg);
        print "loaded $config_path as config file\n";
    }
    $live->{settings}{config_root} = $config_root;
}

sub check_config {
    my ($live) = @_;
    unless (keys(%$live)) {
        warn 'no live definition';
        Pod::Usage::pod2usage();
    }
    #- check for minimum requirements
    ref $live->{media} && $live->{media}{storage} or die "no media storage definition\n";
    ref $live->{system} or die "no system definition\n";
}

sub complete_config {
    my ($live) = @_;

    my $default_prefix = {
        build => {
            boot => '/boot',
            files => '/files',
            images => '/images',
            initrd => '/initrd',
            loopbacks => '/loopbacks',
            modules => '/modules',
            scripts => '/scripts',
        },
        media => {
            # FIXME: CDROM image for USB systems use wrong boot directory
            boot => $live->{system}{hide_media_dirs} ? '/.boot' : '/boot',
            loopbacks => $live->{system}{hide_media_dirs} ? '/.loopbacks' : '/loopbacks',
            mnt => '/media',
        },
        live => {
            mnt => '/live',
        },
    };

    #- set unsupplied config dirs
    add2hash($live->{prefix}{$_} ||= {}, $default_prefix->{$_}) foreach keys %$default_prefix;

    $live->{settings}{builddir} ||= '/var/lib/draklive/build';
    $live->{settings}{chroot} ||= '/var/lib/draklive/chroot';
    mkdir_p(get_builddir($live));
    mkdir_p(get_system_root($live));

    $live->{mnt} ||= get_builddir($live) . "/mnt";

    $live->{settings}{arch} ||= `rpm --eval '%{_target_cpu}'`;
    $live->{media}{title} ||= "live";
}

sub dump_config {
    my ($live) = @_;
    use Data::Dumper;
    print Data::Dumper->Dump([ $live ], [ "live" ]);
}

sub clean {
    my ($live) = @_;
    # umount filesystem in the live before cleaning
    umount_external_filesystem($live);
    rm_rf($_) foreach grep { -e $_ } get_builddir($live), get_system_root($live);
}

my @actions = (
    { name => 'dump-config', do => \&dump_config },
    { name => 'clean', do => \&clean },
    { name => 'install', do => \&install_system },
    { name => 'post-install', do => \&post_install_system },
    { name => 'initrd', do => \&create_initrd },
    { name => 'boot', do => \&prepare_bootloader },
    { name => 'loop', do => \&create_loopback_files },
    { name => 'master', do => \&create_master },
    { name => 'format', do => \&format_device },
    { name => 'record', do => \&record_master },
    { name => 'record-onthefly', do => \&record_onthefly },
);
my @all = qw(install boot loop master);

require_root_capability();

my (%live, %opts);
my $config_root = '/etc/draklive';
my $config_path = 'config/live.cfg';
my $settings_path = 'config/settings.cfg';
GetOptions(
    "help" => sub { Pod::Usage::pod2usage('-verbose' => 1) },
    "copy-wizard" => \$live{copy_wizard},
    "boot-only" => \$opts{boot_only},
    "boot-image=s" => sub { $opts{boot} = $_[1]; $opts{boot_only} = 1 },
    "all" => sub { $_->{to_run} = 1 foreach grep { member($_->{name}, @all) } @actions },
    (map { $_->{name} => \$_->{to_run} } @actions),
    "device=s" => sub { $opts{device} = $_[1] },
    "all-regions" => sub { $live{all_regions} = 1 },
    "config-root=s" => \$config_root,
    "config=s" => \$config_path,
    "settings=s" => \$settings_path,
    "define=s" => \%{$live{settings}},
) or Pod::Usage::pod2usage();

require standalone;
if ($live{copy_wizard}) {
    copy_wizard(\%live);
} else {
    every { !$_->{to_run} } @actions and Pod::Usage::pod2usage();
    read_config(\%live, $config_root, $config_path, $settings_path);
    check_config(\%live);
    complete_config(\%live);
    foreach my $region ($live{all_regions} ? sort(keys %{$live{regions}}) : $live{settings}{region}) {
        $region and print qq(=== proceeding with region "$region"\n);
        $live{settings}{region} = $region;
        foreach (grep { $_->{to_run} } @actions) {
            print qq(* entering step "$_->{name}"\n);
            $_->{do}->(\%live, \%opts);
            print qq(* step "$_->{name}" done\n);
        }
    }
}

__END__

=head1 NAME

draklive - A live distribution mastering tool

=head1 SYNOPSIS

draklive [options]

 Options:
   --help            long help message

   --install         install selected distribution in chroot
   --boot            prepare initrd and bootloader files
   --loop            build compressed loopback files
   --master          build master image

   --all             run all steps, from installation to mastering

   --clean           clean installation chroot and work directory

   --device <dev>    use this device for live recording (not needed
                     if the device already has the required label)
   --format          format selected device
   --record          record live on selected media
   --record-onthefly record live by creating master from loopback files
                     on the fly

   --initrd          build initrd only
   --post-install    run post install only (rpms and patches installation)

   --config-root <dir>
                     root directory containing config files and additionnal files
                     defaults to current directory if it contains a configuration file
                     else, "/etc/draklive" is used

   --config <file>   use this configuration file as live description
                     defaults to "config/live.cfg"

   --settings <file> use this file as live settings (key=value format)
                     defaults to "config/settings.cfg"
   --define key=value
                     set setting "key" to "value"
                     takes precedence over values from a settings file

   --all-regions     proceed with all configured regions

   --copy-wizard     run the copy wizard

   --boot-only       copy only boot files
                     (affects master/record steps)

   --boot-image <method>
                     create a boot image for the selected method
                     (affects master/record steps, implies --boot-only)

Examples:

 draklive --clean

 draklive --all

 draklive --record --device /dev/sdb1

 draklive --config config/live.cfg --install

=head1 OPTIONS

=over 8

=item B<--config>

Makes draklive use the next argument as a configuration file.
This file should contain an hash describing the live distribution,
meaning the system (chroot and boot), media (usb, cdrom, nfs),
and mount type (simple R/W union, union with squash files).

Here's a configuration sample:

  {
    settings {
        repository => '/mnt/ken/2006.0',
        root => '/chroot/live-move',
    },
    system => {
        kernel => '2.6.12-12mdk-i586-up-1GB',
        auto_install => 'config/auto_inst.cfg.pl',
        patch_install => 'config/patch-2006-live.pl',
        rpmsrate => 'config/rpmsrate',
        rpms => [
             'rpms/unionfs-kernel-2.6.12-12mdk-i586-up-1GB-1.1.1.1.20051124.1mdk-1mdk.i586.rpm'
        ],
        patches => [
             'patches/halt.loopfs.patch',
        ],
        vga_mode => 788,
    },
    media => {
        storage => 'cdrom',
    },
    mount => $predefined{mounts}{squash_union}
  };

=item B<--settings>

Makes draklive load the next argument as a file in key=value format
into the $live->{settings} hash ($live being the global live configuration hash).

Built-in keys:
  arch: build architecture
  builddir: directory hosting build files (initrd, loopbacks, images)
  chroot: directory hosting chrooted installations
  region: use the matching set of langs from the regions configuration hash
  repository: path to the Mandriva distribution repository (ftp/http/local)

Example keys:
  desktop
  media
  product

=back

=head1 DESCRIPTION

B<draklive> builds a live distribution according to a
configuration file, creates a master image,
and optionally installs it on a device.

See L<http://qa.mandriva.com/twiki/bin/view/Main/DrakLive>

=head1 AUTHOR

Olivier Blin <oblin@mandriva.com>

=cut