#!/usr/bin/perl

use warnings;
use strict;

use Getopt::Long;
use LWP::Simple     qw<getstore>;
use File::Copy      qw<copy>;
use File::Basename  qw<basename>;
use Term::ANSIColor qw<:constants>;

$ENV{PATH} .= ":/sbin:/usr/sbin";

sub step {
  my %args = @_;
  local $_;

  $args{descr}  ||= "(no description)";
  $args{ensure} ||= sub { 1 };
  $args{using}  ||= sub {};
  $args{help}   ||= "";

  $args{help} =~ s/# (.*)$/# @{[BOLD . WHITE]}$1@{[RESET]}/m;

  printf STDERR "%s»%s %s%s%s... ", BOLD . BLUE, RESET, BOLD . RED, $args{descr}, RESET;

  if($args{ensure}->()) {
    printf STDERR "skipped (%sgood%s).\n", BOLD . GREEN, RESET;
  } else {
    if($args{help}) {
      printf STDERR "\b\n";
      printf STDERR "  %s:%s %s\n", BOLD . BLUE, RESET, $_ for map { (/^\s*(.*)$/g)[0] } split "\n", $args{help};
      printf STDERR "  %s»%s ", BOLD . BLUE, RESET;
    }
    $args{using}->();
    if($args{pause}) {
      printf STDERR "\b\b\b\b\b   %s:%s Press a key to continue... ", BOLD . BLUE, RESET;
      <STDIN>;
      printf STDERR "  %s»%s ", BOLD . BLUE, RESET;
    }
    if($args{ensure}->()) {
      printf STDERR "%sgood%s.\n", BOLD . GREEN, RESET;
    } else {
      printf STDERR "%sfailed%s.\n", BOLD . RED, RESET;
      exit 1;
    }
  }
}

my $kernel_uri   = "http://m19s28.vlinux.de/iblech/pugs/livecd-kernel.bin";
my $grub_uri     = "http://m19s28.vlinux.de/iblech/pugs/grub.tar.bz2";
my $kernel_local = "vmlinuz";
my $grub_local   = "grub.tar.bz2";
my $pugs         = "../../pugs";
my $pge          = "../../src/pge";
my $parrot_path  = "../../../parrot-trunk";
my $bash         = "/bin/bash";
my $inputrc      = "/etc/inputrc";
my $terminfo     = "/etc/terminfo/l/linux";
my $linuxrc      = "linuxrc";
my $welcome_p6   = "welcome.pl";
my $splashscreen = "splashscreen.txt";
my $lib6         = "../../blib6/lib";
my $initrd_gz    = "initrd.gz";
my $initrd_img   = "initrd.img";
my $initrd_mnt   = "/mnt/loop0";
my $initrd_size  = int 16.0 * 1024;
my $cdroot       = "cdroot";
my $iso          = "cd.iso";

sub usage { print <<USAGE; exit }
Usage: $0 [options]

$0 creates a very minimalistic Pugs Live CD.
It fetches kernel and GRUB from a public server (which can be specified below).
Then, it creates a initrd and copies your pugs binary and the shared libraries
it needs on it. Finally, it will call mkisofs to create a ISO9660 image.

You can stop this program at any time, it'll continue when you run it again.

Note: This program should be run as unpreviliged user, it will ask you to enter
      commands requiring root privilegies.

Note: The only option you'll have to specify is probably --initrd-mnt.

Note: I only tested this program on Linux, but it should work on other *nix
      systems, too. For now, I made the script stop if you aren't running under
      Linux, you may want to change that.

Note: A precompiled (but most of the time outdated) image is available at
      http://m19s28.vlinux.de/iblech/pugs/livecd.iso.

Note: If you want to modify the kernel used, you may want to use the
      configuration at
      http://m19s28.vlinux.de/iblech/pugs/livecd-kernel.config.

Available options and defaults:
  --kernel-uri=$kernel_uri
    mklivecd.pl automatically fetches a kernel from the Internet.
  --kernel-local=$kernel_local
    Locally, the kernel is saved as --kernel-local.
  --grub-uri=$grub_uri
    mklivecd.pl automatically fetches a GRUB tarball.
  --grub-local=$grub_local
    Locally, the GRUB tarball is saved as --grub-local.
  --pugs=$pugs
    mklivecd.pl takes --pugs as the binary to put on the CD.
  --parrot-path=$parrot_path
    mklivecd.pl takes --parrot-path as the root of an Parrot source directory.
  --pge=$pge
    mklivecd.pl takes --pge as the path of the PGE shipped with Pugs.
  --bash=$bash
    linuxrc needs a bash-compatible shell.
  --inputrc=$inputrc
    The readline library likes to have a /etc/inputrc.
  --terminfo=$terminfo
    To make, for example, the <Pos1> and <End> keys working, we need a terminfo
    file.
  --linuxrc=$linuxrc
    --linuxrc is the first script to run after the kernel has started.
  --welcome-p6=$welcome_p6
    --welcome-p6 is a Perl 6 program runnable by Pugs which will
    introduce Pugs.
  --splashscreen=$splashscreen
    The file referenced by --splashscreen will be displayed before booting.
  --lib6=$lib6
    --lib6 will be copied to the CD, too.
  --initrd-gz=$initrd_gz
    mklivecd.pl automatically generates a gzipped initrd suitable for GRUB.
  --initrd-img=$initrd_img
    --initrd-img is the temporary image of the initrd, which will be mounted.
  --initrd-size=$initrd_size
    --initrd-size specifies the size of the (uncompressed) initrd (in KiB).
  --initrd-mnt=$initrd_mnt
    --initrd-img will be mounted to --initrd-mnt in order to copy files to it.
  --cdroot=$cdroot
    --cdroot is the directory which will later be the / of the CD.
  --iso=$iso
    The final ISO9660 image name will be --iso.

Options may be abbreviated to uniqueness.

Author:         Ingo Blechschmidt <iblech\@web.de>
Many thanks to: Michael Hartmann <michael.hartmann\@as-netz.de>
USAGE

GetOptions(
  "kernel-uri=s"   => \$kernel_uri,
  "grub-uri=s"     => \$grub_uri,
  "kernel-local=s" => \$kernel_local,
  "grub-local=s"   => \$grub_local,
  "parrot-path=s"  => \$parrot_path,
  "pugs=s"         => \$pugs,
  "bash=s"         => \$bash,
  "linuxrc=s"      => \$linuxrc,
  "welcome-p6=s"   => \$welcome_p6,
  "initrd-gz=s"    => \$initrd_gz,
  "initrd-img=s"   => \$initrd_img,
  "initrd-size=i"  => \$initrd_size,
  "initrd-mnt=s"   => \$initrd_mnt,
  "cdroot=s"       => \$cdroot,
  "iso=s"          => \$iso,
  "terminfo=s"     => \$terminfo,
  help             => \&usage,
) or usage();
check_for_evil_chars($initrd_img, $initrd_gz, $initrd_mnt, $lib6, $parrot_path);

my $welcomed = 0;
step
  descr  => "Welcome",
  ensure => sub { $welcomed },
  using  => sub { $welcomed++ },
  pause  => 1,
  help   => <<HELP;
    Have you read --help?
    You can stop this program by hitting ^C (<Ctrl>+<C>).
HELP

step
  descr  => "Checking for Linux",
  help   => "This program needs Linux to run correctly.",
  ensure => sub { $^O eq "linux" };

step
  descr  => "Fetching GRUB from \"$grub_uri\"",
  help   => "Remove \"$grub_local\" if you want mklivecd.pl to refetch GRUB.",
  ensure => sub { -r $grub_local and -s $grub_local },
  using  => sub { getstore $grub_uri => $grub_local };

step
  descr  => "Fetching kernel from \"$kernel_uri\"",
  help   => "Remove \"$kernel_local\" if you want mklivecd.pl to refetch the kernel.",
  ensure => sub { -r $kernel_local and -s $kernel_local },
  using  => sub { getstore $kernel_uri => $kernel_local };

step
  descr  => "Checking for Pugs binary",
  help   => "Compile Pugs if you haven't done so already (looked at $pugs).",
  ensure => sub { -r $pugs and -s $pugs };

step
  descr  => "Checking for Bash binary",
  ensure => sub { -r $bash and -s $bash };

my $pugs_version;
step
  descr  => "Querying Pugs for its version",
  ensure => sub { defined $pugs_version },
  using  => sub { $pugs_version = get_version($pugs) };

step
  descr  => "Checking for Parrot binary",
  ensure => sub { -r "$parrot_path/parrot" and -s "$parrot_path/parrot" };

my @modfiles;
step
  descr  => "Searching for module files",
  ensure => sub { @modfiles > 0 },
  using  => sub {
    @modfiles = map { (/^\Q$lib6\E\/(.+)$/)[0] }
                split "\000",
                `find $lib6 -print0`;
  };
my $newest_mod_stamp = 100000; # ugly
-M "$lib6/$_" <= $newest_mod_stamp and $newest_mod_stamp = -M "$lib6/$_"
  for @modfiles;

my @pfiles;
step
  descr  => "Searching for Parrot include files",
  ensure => sub { @pfiles > 0 },
  using  => sub {
    @pfiles = map { (/^\Q$parrot_path\/runtime\/parrot\/include\E(.+)$/)[0] }
              grep { !/(^|\/)\.(?!\.)/ }
              split "\000",
              `find $parrot_path/runtime/parrot/include -print0`;
  };
my $newest_p_stamp = 100000; # ugly
-M "$parrot_path/runtime/parrot/include/$_" <= $newest_p_stamp and
  $newest_p_stamp = -M "$parrot_path/runtime/parrot/include/$_"
  for @pfiles;

my $rebuild;
step
  descr  => "Checking if we have to rebuild the initrd",
  ensure => sub { defined $rebuild },
  using  => sub {
    $rebuild = !(
      -r $initrd_gz and
      -M $initrd_gz <= -M $pugs and
      -M $initrd_gz <= -M "$parrot_path/parrot" and
      -M $initrd_gz <= -M $linuxrc and
      -M $initrd_gz <= -M $bash and
      -M $initrd_gz <= -M $inputrc and
      -M $initrd_gz <= -M $terminfo and
      -M $initrd_gz <= -M $welcome_p6 and
      -M $initrd_gz <= $newest_mod_stamp and
      -M $initrd_gz <= $newest_p_stamp and
      -d "$initrd_mnt/tmp"
    );
  };

if($rebuild) {
  my @libs;
  step
    descr  => "Checking which shared libraries pugs, parrot and bash require",
    ensure => sub { @libs > 1 },
    using  => sub { my %l; @l{ldd($pugs), ldd("$parrot_path/parrot"), ldd($bash)} = (); @libs = keys %l },
    help   => <<HELP;
      We use 'ldd' to read the list of shared libraries (*.so) pugs
      requires. This is necessary so we can copy them on the CD later.
HELP

  step
    descr  => "Creating an empty \"$initrd_img\"",
    ensure => sub { -r $initrd_img and -s $initrd_img == 1024 * $initrd_size },
    using  => sub { system "dd", "if=/dev/zero", "of=$initrd_img", "bs=1K", "count=$initrd_size" },
    help   => "We're now creating a zeroed image we will later mount.";

  step
    descr  => "Creating an ext2 filesystem on \"$initrd_img\"",
    ensure => sub { `strings $initrd_img | grep lost+found` },
    using  => sub { system "mkfs.ext2", "-m", "0", "-F", $initrd_img };

  step
    descr  => "Mounting \"$initrd_img\"",
    ensure => sub { `mount` =~ /\Q$initrd_img/ },
    pause  => 1,
    help   => <<HELP;
      Please mount \"$initrd_img\" into \"$initrd_mnt\" by entering the following
      command as root:
      # mount -o loop -t ext2 $initrd_img $initrd_mnt
HELP

  my @dirs = map { "$initrd_mnt/$_" }
               "bin", "dev", "lib", "lib6", "tmp",
               "etc", "etc/terminfo", "etc/terminfo/l";
  step
    descr  => "Creating directories " . join(", ", map { "$_" } @dirs),
    ensure => sub { -d $_ or return for @dirs; 1 },
    using  => sub { utime undef, undef, $initrd_img; mkdir $_ for @dirs },
    help   => <<HELP;
      We need a temporary directory the initrd.gz will be built later from.
      We'll copy pugs and the libraries it needs to it.
HELP

  my @files = (
    [$pugs                 => "$initrd_mnt/bin/pugs"],
    ["$parrot_path/parrot" => "$initrd_mnt/bin/parrot"],
    [$bash                 => "$initrd_mnt/bin/bash"],
    [$inputrc              => "$initrd_mnt/etc/inputrc"],
    [$terminfo             => "$initrd_mnt/etc/terminfo/l/linux"],
    [$linuxrc              => "$initrd_mnt/linuxrc"],
    [$welcome_p6           => "$initrd_mnt/welcome.pl"],
  );
  step
    descr  => "Copying Pugs, Parrot, Bash, inputrc, the terminfo description, linuxrc, and welcome.pl to the initrd",
    help   => "Note: You might want to strip pugs and parrot to save space.",
    ensure => sub {
      for(@files) {
        my ($src, $dest) = @$_;
        -r $dest and -x $dest and
        -M $dest <= -M $src   and
        -s $dest == -s $src
          or do { warn "mismatch: $src <=> $dest" ; return };
      }
      1;
    },
    using  => sub {
      utime undef, undef, $initrd_img;
      for(@files) {
        my ($src, $dest) = @$_;
        copy $src => $dest;
        chmod 0755, $dest;
      };
    };

  step
    descr  => "Copying Perl 6 modules to the initrd",
    ensure => sub { -r "$initrd_mnt/lib6/$_" or return for @modfiles; 1 },
    using  => sub {
      utime undef, undef, $initrd_img;
      for(@modfiles) {
        if(-d "$lib6/$_") {
          mkdir "$initrd_mnt/lib6/$_";
        } else {
          copy "$lib6/$_" => "$initrd_mnt/lib6/$_";
        }
      }
    };

  step
    descr  => "Copying Parrot include files to the initrd",
    ensure => sub { -r "$initrd_mnt/$_" or return for @pfiles; 1 },
    using  => sub {
      utime undef, undef, $initrd_img;
      for(@pfiles) {
        if(-d "$parrot_path/runtime/parrot/include/$_") {
          mkdir "$initrd_mnt/$_";
        } else {
          copy "$parrot_path/runtime/parrot/include/$_" => "$initrd_mnt/$_";
        }
      }
    };

  my @pge = map { s/^\Q$pge//; $_ } glob "$pge/* $pge/*/* $pge/*/*/*";
  step
    descr  => "Copying PGE to the initrd",
    ensure => sub { -r "$initrd_mnt/$_" or return for @pge; 1 },
    using  => sub {
      utime undef, undef, $initrd_img;
      for(@pge) {
        if(-d "$pge/$_") {
          mkdir "$initrd_mnt/$_";
        } else {
          copy "$pge/$_" => "$initrd_mnt/$_";
        }
      }
    };

  step
    descr  => "Copying shared libraries to \"$initrd_mnt/lib\"",
    ensure => sub {
      -r "$_" && -x "$_" or return for map { "$initrd_mnt/lib/" . basename $_ } @libs;
      1;
    },
    using  => sub {
      utime undef, undef, $initrd_img;
      for(@libs) {
        copy $_ => "$initrd_mnt/lib/" . basename $_;
        chmod 0755, "$initrd_mnt/lib/" . basename $_;
      }
    };

  step
    descr  => "Copying necessary device files to \"$initrd_mnt/dev\"",
    ensure => sub { -c "$initrd_mnt/dev/console" },
    pause  => 1,
    using  => sub { utime undef, undef, $initrd_img },
    help   => <<HELP;
      Please create a $initrd_mnt/dev/console by entering the following command
      as root:
      # mknod $initrd_mnt/dev/console c 5 1
HELP

  step
    descr  => "Unmounting \"$initrd_img\"",
    ensure => sub { `mount` !~ /\Q$initrd_img/ },
    pause  => 1,
    help   => <<HELP;
      Please umount \"$initrd_img\" by entering the following command as root:
      # umount $initrd_img
HELP

  step
    descr  => "Compressing \"$initrd_img\"",
    ensure => sub { -r $initrd_gz and -M $initrd_gz <= -M $initrd_img },
    using  => sub { system "gzip -vvv -9 -c $initrd_img > $initrd_gz" };
}

step
  descr  => "Creating directory \"$cdroot\"",
  ensure => sub { -d $cdroot and -r $cdroot },
  using  => sub { mkdir $cdroot };

step
  descr  => "Unpacking GRUB in \"$cdroot\"",
  ensure => sub { -r "$cdroot/boot/grub/stage2_eltorito" },
  using  => sub { system "tar", "-xvjf", $grub_local, "-C", $cdroot };

my $wrote_menulst = 0;
step
  descr  => "Creating \"$cdroot/boot/grub/menu.lst\"",
  ensure => sub { -r "$cdroot/boot/grub/menu.lst" and $wrote_menulst },
  using  => sub { open my $fh, ">", "$cdroot/boot/grub/menu.lst"; print $fh <<GRUB; $wrote_menulst++ };
default 0
timeout 0
color light-blue/black black/light-gray
hiddenmenu

title    $pugs_version
root     (cd)
kernel   /boot/vmlinuz root=/dev/ram rw init=/linuxrc ramdisk_size=$initrd_size quiet
initrd   /boot/initrd.gz
clear
cat      /boot/splashscreen.txt
GRUB

for(
  [$splashscreen => "$cdroot/boot/splashscreen.txt"],
  [$initrd_gz    => "$cdroot/boot/initrd.gz"],
  [$kernel_local => "$cdroot/boot/vmlinuz"],
) {
  my ($src, $dest) = @$_;

  step
    descr  => "Copying \"$src\" to \"$dest\"",
    ensure => sub { -r $dest and -M $dest <= -M $src },
    using  => sub { copy $src => $dest };
}

step
  descr  => "Creating final ISO image",
  ensure => sub { -r $iso and -M $iso <= -M $initrd_gz and -M $iso <= -M "$cdroot/boot/grub/menu.lst" },
  using  => sub {
    system
      "mkisofs",
      "-R",                                # Generate Rock Ridge directory information
      "-b" => "boot/grub/stage2_eltorito", # Set El Torito boot image name
      "-no-emul-boot",                     # Boot image is 'no emulation' image
      "-boot-load-size" => 4,              # Set numbers of load sectors
      "-boot-info-table",                  # Patch boot image with info table
      "-o" => $iso,                        # Set output file name
      $cdroot;
  };

sub ldd {
  my $bin = shift;
  my @so;
  local $_;
  
  open my $ldd, "-|", "ldd", $bin or die "Couldn't open pipe to \"ldd $bin\": $!\n";
    while(<$ldd>) {
      s{^.*?/}{} or next;
      push @so, "/" . (split " ")[0];
    }

  return @so;
}

# This is a kludge. But for now, as a simple script, it suffices.
# This script doesn't run as root, anyway.
sub check_for_evil_chars {
  local $_;
  for(@_) {
    die "Error: Parameter \"$_\" contains potential unsafe characters.\n"
      if /[ <>;&\\\$'"]/;
  }
}

sub get_version {
  my $bin = shift;

  open my $fh, "-|", $bin, "-V:pugs_version" or
    die "Couldn't open pipe to \"$bin -V:pugs_version\": $!\n";
  my $rev = <$fh>;
  $rev =~ s/^.*?: //g;

  return $rev;
}