#!/usr/bin/perl -w
#
# Copyright (c) 2003
#   Chris Adams <cmadams@iruntheinter.net>
#   http://www.iruntheinter.net/files/misc/
#
########################################################################
# 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 of the License, 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.
########################################################################
#
# Add and/or delete modules from the base Red Hat Linux bootdisk (using the
# drvnet, drvblock, and pcmcia driver disks).  This will also modify the PCI
# table so that an alternate module is used (like replacing sym53c8xx with
# sym53c8xx_2), and can optionally replace the kernel and modules with new
# versions from a kernel-BOOT-*.rpm.  Files on the bootdisk (like the "splash"
# image) can also be removed to make more space for the initrd.  Any modules
# added will automatically have module dependencies added as well.
#
# Command line options:
# -q - quiet mode
# -a <module>[,<module>...] - module(s) to add
# -d <module>[,<module>...] - module(s) to remove
# -i <directory> - original disk image directory
# -k <kernel-BOOT.rpm> - new kernel boot RPM to replace kernel/modules
# -o <file> - output image file name
# -r <omod=nmod>[,<omod2=nmod2>...] - replace omod with nmod in pcitable
# -u <glob>[,<glob>...] - unlink files matching glob on bootdisk
# -I <directory> - just update the vmlinuz/initrd.img in the directory
#
# Requires:
#   coreutils
#   cpio
#   e2fsprogs
#   losetup
#   mount
#   perl
#   perl-Compress-Zlib
#   rpm
#
# History:
# 1.0 - 2003-04-26
#	initial version
#
# 1.1 - 2003-04-28
#	when replacing kernel, rename module directory too
#
# 1.2 - 2003-05-01
#	add error handling clean-ups
#	allow adding additional modules (like RAID) from supplied kernel RPM
#	add option to unlink files from bootdisk to make more space for initrd
#	make sure new initrd fits onto floppy
#
# 1.3 - 2003-06-11
#	add support for PCMCIA disk as well (and make adding additional images
#	easier)
#
# 1.4 - 2003-06-18
#	fix reading driver disk module info files (broken in 1.3)
#	add a little more output - list modules on new floppy
#
# 1.5 - 2003-07-06
#	add a usage message
#
# 1.6 - 2003-10-20
#	add option to update kernel and initrd.img in a given directory; this
#	is useful for updating ISO and/or PXE boot setups.  The only options
#	this makes sense with is -k and -r
#
# 1.7 - 2003-10-21
#	fix some handling for RHEL, based on taroon beta
#
# 1.8 - 2003-10-21
#	fix initrd size handling
#
# 1.9 - 2003-10-22
#	handle changing kernel architecture (i.e. i386=>i686)
#

use Getopt::Std;
use File::Temp qw(tempdir);
use File::Copy;
use File::Path;
use Compress::Zlib;
use POSIX qw(mkfifo);
use Fcntl qw(:mode);
use strict;

# Get and check options
die "Must be run as root\n" if ($> != 0);

use vars qw($opt_i $opt_a $opt_d $opt_o $opt_r $opt_k $opt_q $opt_u $opt_h
    $opt_I);
$opt_i = ".";
$opt_a = $opt_d = $opt_r = $opt_k = $opt_q = $opt_u = $opt_h = $opt_I = "";
$opt_o = "custom.img";
getopts ("i:a:d:o:r:k:qu:hI:");
usage () if ($opt_h);
usage ("invalid options: \"", join (" ", @ARGV), "\"") if (@ARGV);

die "Can't find kernel update RPM\n" if ($opt_k && ! -e $opt_k);

my @add = split (/,/, $opt_a);
my @del = split (/,/, $opt_d);

my %drv = ();
my $base = "";
if ($opt_I) {
	die "Must specify -k and/or -r with -I\n" if (! $opt_k && ! $opt_r);
	die "Image directory doesn't exist\n" if (! -e $opt_I);
	die "No kernel in image directory\n" if (! -e "$opt_I/vmlinuz");
	die "No initrd in image directory\n" if (! -e "$opt_I/initrd.img");
} else {
	die "Output image already exists\n" if (-e $opt_o);

	die "Can't find RHL images directory\n" if (! -e $opt_i);
	$base = $opt_i . "/bootdisk.img";
	$drv{"drvnet"} = $opt_i . "/drvnet.img";
	$drv{"drvblock"} = $opt_i . "/drvblock.img";
	$drv{"pcmcia"} = $opt_i . "/pcmciadd.img";
	die "Can't find RHL base image\n" if (! -e $base);
	foreach my $dsk (keys %drv) {
		die "Can't find RHL $dsk image\n" if (! -e $drv{$dsk});
	}
}

my %replace = ();
foreach my $pair (split (/,/, $opt_r)) {
	my ($old, $new) = split (/=/, $pair);
	die "Invalid replace pair \"$pair\"\n" if (! $old || ! $new);
	$replace{$new} = $old;
}

# Variables to keep track of things to clean-up
use vars qw(@mounts $tdir);
@mounts = ();
$tdir = "";

$SIG{"__DIE__"} = sub {
	warn @_;
	debug ("Cleaning up\n");
	foreach my $mount (reverse @mounts) {
		debug ("Unmounting ", $mount, "\n");
		umount ($mount);
	}
	debug ("Removing ", $tdir, "\n");
	rmtree ($tdir) if ($tdir);
	debug ("Removing ", $opt_o, "\n");
	unlink ($opt_o);
	exit 1;
};

# Make a workspace and mount the bootdisk
my $bootmnt;
$tdir = tempdir ("modXXXXXXXX");
if ($opt_I) {
	$bootmnt = $opt_I;
} else {
	debug ("Mounting bootdisk\n");
	copy ($base, $opt_o) or die "copy($base,$opt_o): $!\n";
	$bootmnt = $tdir . "/bootdisk";
	mkdir ($bootmnt) or die "mkdir($bootmnt): $!\n";
	mount ("-tvfat", "-orw,loop", $opt_o, $bootmnt);
}

# Remove the specified files
if ($opt_u) {
	unlink (map { glob ($bootmnt . "/" . $_) } (split (/,/, $opt_u)));
}

# Uncompress the initrd image and make a copy of the tree
my $initrd = $tdir . "/initrd.img";
open (INITRD, "> $initrd") or die "open(>$initrd): $!\n";
my $gz = gzopen ($bootmnt . "/initrd.img", "r")
    or die "gzopen($bootmnt/initrd.img): $gzerrno\n";
my $buf;
while ($gz->gzread ($buf)) {
	print INITRD $buf;
}
close (INITRD);
$gz->gzclose;

my $SIZE = int ((stat ($initrd))[7] / 1024);

debug ("Mounting original initrd\n");
my $initmnt = $tdir . "/initrd";
mkdir ($initmnt) or die "mkdir($initmnt): $!\n";
mount ("-text2", "-oro,loop", $initrd, $initmnt);

debug ("Copying initrd\n");
my $newinit = $tdir . "/newinit";
mkdir ($newinit) or die "mkdir($newinit): $!\n";
copydir ($initmnt, $newinit);
umount ($initmnt);
rmdir ($initmnt);
unlink ($initrd);

debug ("Extracting initrd modules\n");
my $initmod = $tdir . "/mod-init";
mkdir ($initmod) or die "mkdir($initmod): $!\n";
cgzextract ($newinit . "/modules/modules.cgz", $initmod);

# Mount the driver images and extract the modules
foreach my $d (keys %drv) {
	debug ("Mounting ", $d, " disk\n");
	my $img = $drv{$d};
	my $imgmnt = $tdir . "/" . $d;
	mkdir ($imgmnt) or die "mkdir($imgmnt): $!\n";
	mount ("-text2", "-oro,loop", $img, $imgmnt);

	debug ("Extracting ", $d, " modules\n");
	my $imgmod = $tdir . "/mod-" . $d;
	mkdir ($imgmod) or die "mkdir($imgmod): $!\n";
	cgzextract ($imgmnt . "/modules.cgz", $imgmod);
}

# Find the kernel version and inventory all the modules and dependencies
opendir (IMOD, $initmod) or die "opendir($initmod): $!\n";
my $kver = "";
while (defined (my $e = readdir (IMOD))) {
	next if ($e =~ /^\.{1,2}$/);
	if ($e =~ /^\d+\.\d+\.\d+-\S+BOOT$/) {
		$kver = $e;
		last;
	}
}
closedir (IMOD);
die "Can't figure kernel version\n" if (! $kver);

debug ("Taking module inventory\n");
my %mods = ();
my $modbase = "";
my @moddirs = map { $tdir . "/mod-" . $_ . "/" . $kver } ("init", keys %drv);
foreach my $dir (@moddirs) {
	opendir (MOD, $dir) or die "opendir($dir) $!\n";
	while (defined (my $e = readdir (MOD))) {
		next if ($e =~ /^\.{1,2}$/);
		my $f = $dir . "/" . $e;
		if (-d $f) {
			$modbase = "/" . $e if (! $modbase);
			push @moddirs, $f;
			next;
		}
		my ($mod) = $e =~ /(.+)\.o$/;
		next if (! $mod);
		$mods{$mod} = $f;
	}
	closedir (MOD);
}
my %deps = my %info = my %pci = my %special = ();
foreach my $d ("newinit/modules", keys %drv) {
	debug ("Reading module info in ", $d, "\n");
	my $dir = $tdir . "/" . $d;
	open (DEP, "$dir/modules.dep") or die "open($dir/modules.dep): $!\n";
	while (<DEP>) {
		chomp;
		my ($mod, $dep) = $_ =~ /^(\S+): (.+)$/;
		$deps{$mod} = $dep;
	}
	close (DEP);

	my $info = "";
	foreach my $file (qw(modinfo module-info)) {
		my $f = $dir . "/" . $file;
		if (-f $f) {
			$info = $f;
			last;
		}
	}
	die "Can't find module info in $d\n" if (! $info);
	open (INFO, $info) or die "open($info): $!\n";
	my $ver = <INFO>;
	chomp $ver;
	die "Unknown info version $ver\n" if ($ver ne "Version 0");
	my $mod = "";
	while (<INFO>) {
		if (/^\S/) {
			$mod = $_;
			chomp $mod;
			$info{$mod} = $_;
		} else {
			$info{$mod} .= $_;
		}
	}
	close (INFO);

	open (PCI, "$dir/pcitable") or die "open($dir/pcitable): $!\n";
	while (<PCI>) {
		chomp;
		my ($id, $mod, $desc) = $_ =~ /^(.+\s+")([^"]+)("\s+".+")$/;
		$pci{$mod}{$id} = $desc;
		if ($d eq "newinit/modules") {
			$special{$mod} = 1;
		}
	}
	close (PCI);
}

foreach my $d (keys %drv) {
	debug ("Unmounting ", $d, "\n");
	my $dir = $tdir . "/" . $d;
	umount ($dir);
	rmdir ($dir);
}

# Now actually add and remove modules and regenerate info files
my $mdir = $tdir . "/mod-init/" . $kver . $modbase;
foreach my $mod (@del) {
	debug ("Removing ", $mod, "\n");
	my $f = $mdir . "/" . $mod . ".o";
	if (-e $f) {
		unlink ($f) or die "unlink($f): $!\n";
	} else {
		warn "Can't remove $mod (doesn't exist) - skipping\n";
	}
}
my %add = map { $_ => 1 } @add;
foreach my $mod (@add) {
	debug ("Checking ", $mod, " for dependencies\n");
	next if (! $deps{$mod});
	my @dep = split (/\s+/, $deps{$mod});
	foreach my $dep (@dep) {
		my $f = $mdir . "/" . $dep . ".o";
		next if (-e $f);
		push @add, $dep if (! $add{$dep});
		$add{$dep} = 1;
		debug ("Adding dependency for ", $mod, " on ", $dep, "\n");
	}
}
@add = sort keys %add;
my @toadd = ();
foreach my $mod (@add) {
	debug ("Adding ", $mod, "\n");
	my $f = $mdir . "/" . $mod . ".o";
	if (! $mods{$mod}) {
		if ($opt_k) {
			# Module may be found in new kernel RPM
			warn "Skipping $mod - will look in kernel RPM\n";
			push @toadd, $mod;
			next;
		}
		die "Unknown module $mod\n";
	}
	if (-e $f) {
		warn "Skipping adding $mod - already exists\n";
	} else {
		my ($atime, $mtime) = (stat ($mods{$mod}))[8,9];
		copy ($mods{$mod}, $f) or die "copy($mods{$mod},$f): $!\n";
		utime ($atime, $mtime, $f);
	}
}

my @mods = ();
opendir (MDIR, $mdir) or die "opendir($mdir): $!\n";
while (defined (my $e = readdir (MDIR))) {
	next if ($e =~ /^\.{1,2}$/);
	my ($mod) = $e =~ /^(.+)\.o$/;
	push @mods, $mod;
}
closedir (MDIR);
debug ("Modules in new image:\n  ", join ("\n  ", @mods), "\n");

debug ("Creating new modules.dep\n");
open (DEP, ">$newinit/modules/modules.dep")
    or die "open(>$newinit/modules/modules.dep): $!\n";
foreach my $mod (sort @mods) {
	if (defined ($deps{$mod})) {
		print DEP $mod, ": ", $deps{$mod}, "\n";
	}
}
close (DEP);

debug ("Creating new module-info\n");
open (INFO, ">$newinit/modules/module-info")
    or die "open(>$newinit/modules/module-info): $!\n";
print INFO "Version 0\n";
foreach my $mod (sort @mods) {
	if (defined ($info{$mod})) {
		print INFO $info{$mod};
	} else {
		debug ("- no module info for ", $mod, "\n");
	}
}
close (INFO);

debug ("Creating new pcitable\n");
open (PCI, ">$newinit/modules/pcitable")
    or die "open(>$newinit/modules/pcitable): $!\n";
my %pcimods = ();
@pcimods{(keys %special, @mods)} = (1) x (keys %special, @mods);
foreach my $mod (sort (keys %pcimods)) {
	my $m = $mod;
	if ($replace{$mod}) {
		debug ("Replacing ", $mod, " with ", $replace{$mod}, "\n");
		$m = $replace{$mod};
	}
	my @ids = (sort keys %{$pci{$m}});
	if (@ids) {
		foreach my $id (@ids) {
			print PCI $id, $mod, $pci{$m}{$id}, "\n";
		}
	} else {
		debug ("- no PCI IDs for ", $m, "\n");
	}
}
close (PCI);

debug ("Removing original module trees\n");
foreach my $d (keys %drv) {
	rmtree ($tdir . "/mod-" . $d) or die "rmtree($tdir/mod-$d): $!\n";
}

# If there is a new kernel to use, replace the files now
if ($opt_k) {
	debug ("Extracting new kernel RPM\n");
	my ($nkarch) = $opt_k =~ /\.([^\.]+)\.rpm$/;
	$nkarch = "/" . $nkarch if ($nkarch);
	my $kdir = $tdir . "/kern";
	mkdir ($kdir) or die "mkdir($kdir): $!\n";
	die "fork(rpm): $!\n" unless defined (my $pid = open (RPM, "-|"));
	if (! $pid) {
		open (STDIN, "</dev/null");
		open (STDERR, ">/dev/null");
		exec "/usr/bin/rpm2cpio", $opt_k
		    or die "exec(rpm): $!\n";
	}
	die "fork(cpio): $!\n" unless defined ($pid = open (CPIO, "-|"));
	if (! $pid) {
		chdir ($kdir);
		open (STDIN, "<&RPM") or die "dup(RPM): $!\n";
		open (STDERR, ">&STDOUT") or die "dup(STDOUT): $!\n";
		exec "/bin/cpio", "-dumi" or die "exec(cpio): $!\n";
	}
	close (RPM);
	my $res = join ("", <CPIO>);
	close (CPIO);
	die "rpm2cpio failed: \"$res\"\n" if (($? >>8) != 0);

	debug ("Taking inventory of new kernel modules\n");
	my $nkmod = $kdir . "/lib/modules";
	opendir (NK, $nkmod) or die "opendir($nkmod): $!\n";
	my $nkver = "";
	while (defined (my $e = readdir (NK))) {
		next if ($e =~ /^\.{1,2}$/);
		if ($e =~ /^\d+\.\d+\.\d+-[a-zA-Z0-9\.]+$/) {
			$nkver = $e;
			last;
		}
	}
	closedir (NK);
	die "Can't figure new kernel version\n" if (! $nkver);
	$nkmod .= "/" . $nkver . "/kernel";

	# Find all the module files in the new kernel tree and replace them in
	# the modules tree
	use File::Find;
	my %nmod= ();
	find ({"wanted" => sub { $nmod{$1} = $_ if (/([^\/]+)\.o$/) },
	    "no_chdir" => 1}, $nkmod);

	debug ("Replacing modules\n");
	foreach my $mod (@mods) {
		die "Can't find new module \"$mod\"\n" if (! $nmod{$mod});
		my $mfile = $mdir . "/" . $mod . ".o";
		copy ($nmod{$mod}, $mfile)
		    or die "copy($nmod{$mod},$mfile): $!\n";
	}

	if (@toadd) {
		debug ("Adding modules from kernel RPM\n");
		foreach my $mod (@toadd) {
			die "Unknown module $mod\n" if (! $nmod{$mod});
			my $mfile = $mdir . "/" . $mod . ".o";
			copy ($nmod{$mod}, $mfile)
			    or die "copy($nmod{$mod},$mfile): $!\n";
			push @mods, $mod;
		}
	}

	debug ("Replacing kernel\n");
	my $nkern = $kdir . "/boot/vmlinuz-" . $nkver;
	my $okern = $bootmnt . "/vmlinuz";
	copy ($nkern, $okern) or die "copy($nkern,$okern): $!\n";

	debug ("Removing new kernel RPM tree\n");
	rmtree ($kdir) or die "rmtree($kdir): $!\n";

	my $omdir = $tdir . "/mod-init/" . $kver;
	my $nmdir = $tdir . "/mod-init/" . $nkver;
	rename ($omdir, $nmdir) or die "rename($omdir,$nmdir): $!\n";
	if ($modbase && $nkarch && ($modbase ne $nkarch)) {
		rename ($nmdir . $modbase, $nmdir . $nkarch)
		    or die "rename($nmdir$modbase,$nmdir$nkarch): $!\n";
		$modbase = $nkarch;
	}
	$kver = $nkver;
	$nmdir .= $modbase;
	$mdir = $nmdir;
}

# Make the new modules.cgz
debug ("Building modules.cgz\n");
my $cgz = gzopen ($newinit . "/modules/modules.cgz", "w9")
    or die "gzopen($newinit/modules/modules.cgz): $gzerrno\n";

pipe (FILELIST, TOCPIO) or die "pipe: $!\n";
die "fork(cpio): $!\n" unless defined (my $pid = open (SUB, "-|"));
if (! $pid) {
	chdir ($tdir . "/mod-init");
	open (STDIN, "<&FILELIST") or die "dup(FILELIST): $!\n";
	close (FILELIST);
	close (TOCPIO);
	open (STDERR, ">/dev/null");
	exec "/bin/cpio", "-oa", "-Hcrc" or die "exec(cpio): $!\n";
}
close (FILELIST);
print TOCPIO map { $kver . $modbase . "/" . $_ . ".o\n" } @mods;
close (TOCPIO);
my $cbuf;
while (sysread (SUB, $cbuf, 4096)) {
	$cgz->gzwrite ($cbuf);
}
close (SUB);
die "cpio failed\n" if (($? >> 8) != 0);
$cgz->gzclose;

debug ("Removing new module tree\n");
rmtree ($tdir . "/mod-init") or die "rmtree($tdir/mod-init): $!\n";

# Make the new initrd
debug ("Creating new initrd\n");
my $lodev = `echo findlodev | /sbin/nash --quiet`;
chomp $lodev;
die "Can't find available loopback device\n" if (! $lodev);

my $lofile = $tdir . "/newinit.img";
open (LO, ">$lofile") or die "open(>$lofile): $!\n";
print LO "\0" x ($SIZE * 1024);
close (LO);

die "fork(losetup): $!\n" unless defined ($pid = open (SUB, "-|"));
if (! $pid) {
	open (STDERR, ">&STDOUT") or die "dup: $!\n";
	exec "/sbin/losetup", $lodev, $lofile or die "exec(losetup): $!\n";
}
my $res = join ("", <SUB>);
close (SUB);
die "losetup failed: \"$res\"\n" if (($? >> 8) != 0);

pipe (YES, TOMKFS) or die "pipe: $!\n";
die "fork(mke2fs): $!\n" unless defined ($pid = open (SUB, "-|"));
if (! $pid) {
	open (STDIN, "<&YES") or die "dup(FILELIST): $!\n";
	close (YES);
	close (TOMKFS);
	open (STDERR, ">&STDOUT") or die "dup: $!\n";
	exec "/sbin/mke2fs", $lodev, $SIZE or die "exec(mke2fs): $!\n";
}
close (YES);
print TOMKFS "y\n";
close (TOMKFS);
$res = join ("", <SUB>);
close (SUB);
die "mke2fs failed: \"$res\"\n" if (($? >> 8) != 0);

die "fork(tune2fs): $!\n" unless defined ($pid = open (SUB, "-|"));
if (! $pid) {
	open (STDERR, ">&STDOUT") or die "dup: $!\n";
	exec "/sbin/tune2fs", "-i0", "-c0", $lodev
	    or die "exec(tune2fs): $!\n";
}
$res = join ("", <SUB>);
close (SUB);
die "tune2fs failed: \"$res\"\n" if (($? >> 8) != 0);

my $lomnt = $tdir . "/newinit-mnt";
mkdir ($lomnt) or die "mkdir($lomnt): $!\n";
mount ("-text2", "-orw", $lodev, $lomnt);

rmdir ($newinit . "/lost+found");
copydir ($newinit, $lomnt);
rmtree ($newinit) or die "rmtree($newinit): $!\n";
umount ($lomnt);
rmdir ($lomnt);

die "fork(losetup): $!\n" unless defined ($pid = open (SUB, "-|"));
if (! $pid) {
	open (STDERR, ">&STDOUT") or die "dup: $!\n";
	exec "/sbin/losetup", "-d", $lodev or die "exec(losetup): $!\n";
}
$res = join ("", <SUB>);
close (SUB);
die "losetup failed: \"$res\"\n" if (($? >> 8) != 0);

debug ("Compressing new initrd\n");
my $newimg = $tdir . "/initrd.img";
my $igz = gzopen ($newimg, "w9")
    or die "gzopen($newimg): $gzerrno\n";
open (LO, "$lofile") or die "open($lofile): $!\n";
my $ibuf;
while (sysread (LO, $ibuf, 4096)) {
	$igz->gzwrite ($ibuf);
}
close (LO);
$igz->gzclose;
unlink ($lofile);

debug ("new initrd size: ", (stat ($newimg))[7], "\n");
copy ($newimg, $bootmnt . "/initrd.img")
    or die "copy($newimg,$bootmnt/initrd.img): $!\n";
unlink ($newimg);

debug ("Cleaning up\n");
if (! $opt_I) {
	umount ($bootmnt);
	rmdir ($bootmnt);
}
rmdir ($tdir);


# Print debug messages
sub debug
{
	print STDERR @_ if (! $opt_q);
}


# Call out to mount, die on failure
sub mount
{
	use vars qw($mount_bin);
	if (! $mount_bin) {
		# Find it
		foreach my $d (qw(/usr/sbin /sbin /usr/bin /bin)) {
			if (-e $d . "/mount") {
				$mount_bin = $d . "/mount";
				last;
			}
		}
		die "Can't find mount\n" if (! $mount_bin);
	}

	local (*SUB);
	die "fork(mount): $!\n" unless defined (my $pid = open (SUB, "-|"));
	if (! $pid) {
		open (STDERR, ">&STDOUT") or die "dup: $!\n";
		exec $mount_bin, @_ or die "exec(mount): $!\n";
	}
	my $out = join ("", <SUB>);
	close (SUB);
	die "mount failed: \"$out\"\n" if (($? >> 8) != 0);

	push @mounts, $_[$#_];
}


# Call out to umount, die on failure
sub umount
{
	use vars qw($umount_bin);
	if (! $umount_bin) {
		# Find it
		foreach my $d (qw(/usr/sbin /sbin /usr/bin /bin)) {
			if (-e $d . "/umount") {
				$umount_bin = $d . "/umount";
				last;
			}
		}
		die "Can't find umount\n" if (! $umount_bin);
	}

	# Need to take this dir out of list first in case we die
	my $dir = $_[$#_];
	@mounts = grep { $_ ne $dir } @mounts;

	local (*SUB);
	die "fork(umount): $!\n" unless defined (my $pid = open (SUB, "-|"));
	if (! $pid) {
		open (STDERR, ">&STDOUT") or die "dup: $!\n";
		exec $umount_bin, @_ or die "exec(umount): $!\n";
	}
	my $out = join ("", <SUB>);
	close (SUB);
	die "umount failed: \"$out\"\n" if (($? >> 8) != 0);
}


# Copy a directory tree from one place to another
sub copydir
{
	my $src = shift;
	my $dst = shift;

	my %inodes;

	local (*SRC);
	opendir (SRC, $src) or die "opendir($src): $!\n";
	while (defined (my $e = readdir (SRC))) {
		next if ($e =~ /^\.{1,2}$/);
		my $s = $src . "/" . $e;
		my $d = $dst . "/" . $e;

		my ($dev, $ino, $mode, $uid, $gid, $rdev, $atime, $mtime) =
		    (lstat $s)[0,1,2,4,5,6,8,9];
		if (defined ($inodes{$dev}{$ino})) {
			link ($inodes{$dev}{$ino}, $d)
			    or die "link($d): $!\n";
		} elsif (S_ISREG ($mode)) {
			copy ($s, $d) or die "copy($s,$d): $!\n";
			chmod ($mode, $d) or die "chmod($d): $!\n";
			chown ($uid, $gid, $d) or die "chown($d): $!\n";
			utime ($atime, $mtime, $d) or die "utime($d): $!\n";
		} elsif (S_ISDIR ($mode)) {
			mkdir ($d, $mode) or die "mkdir($d): $!\n";
			chown ($uid, $gid, $d) or die "chown($d): $!\n";
			copydir ($s, $d);
			utime ($atime, $mtime, $d) or die "utime($d): $!\n";
		} elsif (S_ISFIFO ($mode)) {
			mkfifo ($d);
			chmod ($mode, $d) or die "chmod($d): $!\n";
			chown ($uid, $gid, $d) or die "chown($d): $!\n";
			utime ($atime, $mtime, $d) or die "utime($d): $!\n";
		} elsif (S_ISLNK ($mode)) {
			my $lnk = readlink ($s);
			symlink ($lnk, $d) or die "symlink($d): $!\n";
			lchown ($uid, $gid, $d);
		} elsif (S_ISBLK ($mode)) {
			mknod ($d, "b", $rdev >> 8, $rdev & 0xff);
			chmod ($mode, $d) or die "chmod($d): $!\n";
			chown ($uid, $gid, $d) or die "chown($d): $!\n";
			utime ($atime, $mtime, $d) or die "utime($d): $!\n";
		} elsif (S_ISCHR ($mode)) {
			mknod ($d, "c", $rdev >> 8, $rdev & 0xff);
			chmod ($mode, $d) or die "chmod($d): $!\n";
			chown ($uid, $gid, $d) or die "chown($d): $!\n";
			utime ($atime, $mtime, $d) or die "utime($d): $!\n";
		} else {
			die "copydir: can't handle type for $s\n";
		}
	}
	closedir (SRC);
}


# Make a device node
sub mknod
{
	use vars qw($mknod_bin);
	if (! $mknod_bin) {
		# Find it
		foreach my $d (qw(/usr/sbin /sbin /usr/bin /bin)) {
			if (-e $d . "/mknod") {
				$mknod_bin = $d . "/mknod";
				last;
			}
		}
		die "Can't find mknod\n" if (! $mknod_bin);
	}

	local (*SUB);
	die "fork(mknod): $!\n" unless defined (my $pid = open (SUB, "-|"));
	if (! $pid) {
		open (STDERR, ">&STDOUT") or die "dup: $!\n";
		exec $mknod_bin, @_ or die "exec(mknod): $!\n";
	}
	my $out = join ("", <SUB>);
	close (SUB);
	die "mknod failed: \"$out\"\n" if (($? >> 8) != 0);
}


# Change ownership on a symlink
sub lchown
{
	my $uid = shift;
	my $gid = shift;

	local (*SUB);
	die "fork(chown): $!\n" unless defined (my $pid = open (SUB, "-|"));
	if (! $pid) {
		open (STDERR, ">&STDOUT") or die "dup: $!\n";
		exec "/bin/chown", "-h", $uid . ":" . $gid, @_
		    or die "exec(chown): $!\n";
	}
	my $out = join ("", <SUB>);
	close (SUB);
	die "chown failed: \"$out\"\n" if (($? >> 8) != 0);
}


# Extract a cgz file to a given directory
sub cgzextract
{
	my $cgz = shift;
	my $dir = shift;

	my $gz = gzopen ($cgz, "r") or die "gzopen($cgz): $gzerrno\n";

	local (*SUB);
	die "fork(cpio): $!\n" unless defined (my $pid = open (SUB, "|-"));
	if (! $pid) {
		chdir ($dir);
		open (STDOUT, ">/dev/null");
		open (STDERR, ">/dev/null");
		exec "/bin/cpio", "-dumi" or die "exec(cpio): $!\n";
	}
	my $buf;
	while ($gz->gzread ($buf)) {
		print SUB $buf;
	}
	$gz->gzclose;
	close (SUB);
	die "cpio failed\n" if (($? >> 8) != 0);
}


# Usage message
sub usage
{
	my @msg = @_;
	my ($prog) = $0 =~ m!([^/]+)$!;

	my $code = 0;
	my $fh = \*STDOUT;
	if (@msg) {
		$code = 1;
		$fh = \*STDERR;
		print STDERR $prog, ": ", @msg, "\n";
	}

	print $fh <<EOF;
Usage: $prog [OPTIONS]
    -a <module>[,<module>...] : module(s) to add
    -d <module>[,<module>...] : module(s) to remove
    -h : this message
    -i <directory> : original disk image directory
    -k <kernel-BOOT.rpm> : new kernel boot RPM to replace kernel/modules
    -o <file> : output image file name
    -q : quiet mode
    -r <omod=nmod>[,<omod2=nmod2>...] : replace omod with nmod in pcitable
    -u <glob>[,<glob>...] : unlink files matching glob on bootdisk
    -I <directory> - just update the vmlinuz/initrd.img in the directory

Note that if you replace the kernel, you'll need to be using a kickstart
file, you'll need to include ALL necessary modules for install, and the
kickstart \%pre section will need to manually load some modules (any
filesystem, RAID, or LVM modules).  For example:

	mkdir /tmp/mod.man
	cd /tmp/mod.man
	gzip -dc < /modules/modules.cgz | cpio -imud
	cd 2*
	for mod in raid1 jbd ext3; do insmod \$mod.o; done
	cd /
	rm -rf /tmp/mod.man

EOF

	exit ($code);
}