#!/usr/bin/perl -w
#
#    kernellab - manage kernel configs for many machines easily
#    Copyright (C) 1999 Tommi Virtanen <tv@havoc.fi>
#
#    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.
#
#    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 strict;
use vars qw(@BASEPATH @SOURCES @ALANCOX @MODULES @IMAGES @CONFIG
            $TEMPDIR $VERBOSE $DO_CONFIG);

use vars qw($BUILDDIR $_host_regexp %FLAGS $MAKE_HEADERS $SOURCE_TYPE $PATCH_TYPE $KERNEL_REVISION
            $WRITE_CONFIG $WRITE_IMAGE);
use File::Find;
use POSIX qw(strftime);

my $_programname=$0;
$_programname=~s{^.*/}{};
sub fail(@) { die "$_programname: @_\n" }
sub info(@) {print "$_programname: info: @_\n" if $VERBOSE}
sub debug(@) {print "$_programname: debug: @_\n" if $VERBOSE>1}

do "$ENV{HOME}/.kernellab.conf"
  or do '/etc/kernellab.conf'
  or fail "config error; $@\n";

sub find_first_matching(&@) {
  my $match = shift;
  foreach (@_) {
    return $_ if $match->($_);
  }
  return undef;
}

$BUILDDIR = $TEMPDIR . '/kernellab.' . time() . '.' . $$;
@BASEPATH = map { append_slash($_) } grep {-d $_} @BASEPATH;
@SOURCES =
  map { append_slash($_) }
  grep {-d $_}
  map { prefix_relative($_, @BASEPATH) }
  @SOURCES;
@ALANCOX =
  map { append_slash($_) }
  grep {-d $_}
  map { prefix_relative($_, @BASEPATH) }
  @ALANCOX;
@MODULES =
  map { append_slash($_) }
  grep {-d $_}
  map { prefix_relative($_, @BASEPATH) }
  @MODULES;
@IMAGES =
  map { append_slash($_) }
  grep {-d $_}
  map { prefix_relative($_, @BASEPATH) }
  @IMAGES;
@CONFIG =
  map { append_slash($_) }
  grep {-d $_}
  map { prefix_relative($_, @BASEPATH) }
  @CONFIG;
$WRITE_IMAGE = find_first_matching {-w $_} @IMAGES
  or fail "cannot find a writable place to store kernel images\n",
  "perhaps you should run 'mkdir -p ~/kernellab/images'";
$WRITE_CONFIG = find_first_matching {-w $_} @CONFIG
  or fail "cannot find a writable place to store configs\n",
  "perhaps you should run 'mkdir -p ~/kernellab/configs'";
@BASEPATH and @SOURCES and @ALANCOX and @MODULES and @IMAGES and @CONFIG
  or fail "some of the base directories did not exist. Check config";

$_host_regexp = '[a-z0-9.-]+';

sub usage() {
  print <<EOF;
usage: $_programname [options] <host> [<version>[-ac<patchlevel>] [<module>..]]
  where options are
    -O, --official	use official linux-x.x.x sources (default)
    -D, --debian	use Debian kernel-source-x.x.x sources
    -a, --ac		use Alan Cox patches (default)
    -p, --pre		use Linus Thorvalds pre-patches
	--ben		use Benjamin Herrenschmidt ben patches
	--benh		use Benjamin Herrenschmidt benh patches
	--paulus	use Paul Mackerras patches
    -c, --configure	always run menuconfig
    -H, --headers	also create a kernel-headers -package
    -v, --verbose	be more verbose
    -h, --help		show this help
EOF
}

sub prefix($@;) {
  my ($file)=shift;
  return map {$_.$file} @_;
}

sub prefix_relative($@;) {
  my ($file) = shift;
  return $file if $file=~m{^[/.]};
  return prefix($file, @_);
}

sub append_slash($;) {
  for (@_) {
    return m{ /$ }x ? $_ : $_.'/'
  }
}

sub getdir($;) {
  -d $_[0] or return ();
  opendir(DIR, $_[0]) or fail "cannot open directory $_[0]; $!";
  my @r = readdir(DIR);
  closedir DIR;
  return @r;
}

sub _find_filename(@) { # for filename_* functions
  foreach (@_) { return $_ if -e $_ }
  return undef;
}

sub filename_kernel($$;) {
  my ($basename, $file) = @_;
  _find_filename(prefix($basename . '-' . $file . '.tar.bz2', @SOURCES),
                 prefix($basename . '-' . $file . '.tar.gz', @SOURCES));
}

sub filename_patch($$$;) {
  my ($k, $patch, $patchver) = @_;
  _find_filename(prefix('patch-' . $k . '-' . $patch . $patchver . '.bz2', @ALANCOX),
                 prefix('patch-' . $k . '-' . $patch . $patchver . '.gz', @ALANCOX));
}

sub filename_module($;) {
  _find_filename(prefix($_[0] . '.tar.gz', @MODULES),
                 prefix($_[0] . '.tar.bz2', @MODULES));
}

sub max(@) {
  my $max;
  foreach (@_) {
    $max=$_ if not defined $max or $max<$_;
  }
  return $max;
}

sub source_basename($;) {
  my ($source) = @_;
  my ($basename);
  for ($source) {
    /^debian$/ and $basename='kernel-source', next;
    /^official$/ and $basename='linux', next;
    fail "unknown kernel source type \"$source\"";
  }
  return $basename;
}

sub latest_kernel($$;) {
  my ($basename, $patch) = @_;
  my @kernels =
    map {/^$basename-(\d+)\.(\d+)\.(\d+)\./; [$_,$1,$2,$3]}
      grep {/^$basename-\d+\.\d+\.\d+\.tar\.(?:gz|bz2)$/}
        map {getdir $_} @SOURCES;
  my $a = max map {$_->[1]} @kernels;
  defined $a or fail "cannot determine latest kernel version (1)";
  @kernels = grep {$_->[1] == $a} @kernels;
  my $b = max map {$_->[2]} @kernels;
  defined $b or fail "cannot determine latest kernel version (2)";
  @kernels = grep {$_->[2] == $b} @kernels;
  my $c = max map {$_->[3]} @kernels;
  defined $c or fail "cannot determine latest kernel version (3)";
  my $kernel = "$a.$b.$c";

  my @patches =
    map {/^patch-\d+\.\d+\.\d+.-$patch(\d+\w*)\./; [$_,$1]}
      grep {/^patch-$a\.$b\.$c-$patch\d+\w*\.(?:gz|bz2)$/}
        map {getdir $_} @ALANCOX;
  my $patchver = max map {$_->[1]} @patches;
  $kernel .= '-' . $patch . $patchver if defined $patchver;

  return $kernel;
}

sub closest_config($$$;$;) {
  my ($host, $kver, $patch, $patchver) = @_;
  debug "finding closest config for $host $kver"
    . (defined $patchver ? "-$patch$patchver" : '');
  my @configs;
  foreach my $confdir (@CONFIG) {
    foreach my $conffile (getdir $confdir) {
      $conffile =~ 
        /^config-($_host_regexp)-(\d+)\.(\d+)\.(\d+)(?:-$patch(\d+)\w*)?$/
          or next;
      $1 eq $host or next;
      push @configs, [$confdir.$conffile, $1,$2,$3,$4,$5];
    }
  }

  @configs = sort { #descending
    $b->[2] <=> $a->[2]
      ||
        $b->[3] <=> $a->[3]
          ||
            $b->[4] <=> $a->[4]
              ||
                $b->[5] <=> $a->[5]
                  # rely on (undef<=>0)==(0<=>undef)==0
              } @configs;

  return $configs[0]->[0];
}

sub next_revision($$$$;) {
  my ($host, $kver, $date, $patch) = @_;
  my @revs =
    sort {$b<=>$a}
      map { $_->[3] }
        grep {
          $_->[1] eq $host
            and $_->[2] eq $date
          }
          map {
            /^kernel-image-
              (\d+\.\d+\.\d+(?:-$patch\d+\w*)?)_	# kernel version number
                ($_host_regexp)\.	# hostname
                  (\d\d\d\d\d\d\d\d)\.	# yyyymmdd
                    (\d+)_			# revision
                      .*\.deb$
                        /x;
            [$1,$2,$3,$4]
          }
            grep {/^kernel-image-/}
              map {getdir "$_/$host"} @IMAGES;
  return "$host.$date.".($revs[0]+1) if @revs;
  return "$host.$date.1";
}

sub extract($;) {
  my $cmd;
  for ($_[0]) {
    /\.bz2$/ and $cmd='/usr/bin/bzip2', next;
    /\.gz$/ and $cmd='/bin/gzip', next;
    fail "unknown package format, file $_";
  }
  system('/bin/tar', '-xf', $_[0], '--use-compress-program', $cmd) == 0
    or fail "unpacking $_[0] failed: $?";
}

sub apply_patch($;) {
debug "YOW!";
  my ($file) = @_;
debug "applying patch from file $file";
  my $zcat;
  for ($file) {
    /\.bz2$/ and $zcat='/usr/bin/bzcat', next;
    /\.gz$/ and $zcat='/bin/zcat', next;
    fail "unknown patch compression, file $_";
  }
  system("$zcat \"$file\" | patch -p1") == 0
    or fail "applying patch $file failed: $?";
  find(sub {/\.rej$/
              and fail "patch $file failed for file $File::Find::name"},
       '.');
}

%FLAGS = (
          v => 'verbose',
          verbose => sub {$VERBOSE++},
          h => 'help',
          help => sub {usage(); exit(0)},
          c => 'configure',
          config => 'configure',
          configure => sub {$DO_CONFIG++},
          H => 'headers',
          headers => sub {$MAKE_HEADERS++},
          O => 'official',
          official => sub {$SOURCE_TYPE = 'official'},
          D => 'debian',
          debian => sub {$SOURCE_TYPE = 'debian'},
          a => 'ac',
          ac => sub {$PATCH_TYPE = 'ac'},
          p => 'pre',
          pre => sub {$PATCH_TYPE = 'pre'},
          ben => sub {$PATCH_TYPE = 'ben'},
          benh => sub {$PATCH_TYPE = 'benh'},
          paulus => sub {$PATCH_TYPE = 'paulus'},
          revision => sub {$KERNEL_REVISION = undef},
         );

$SOURCE_TYPE = 'official';
$PATCH_TYPE = 'ac';
while (@ARGV and $ARGV[0] =~ /^-/) {
  local $_ = shift;
  s/^-//g;
  if (/^-/) { # long opt
    s/^-//g;
    exists $FLAGS{$_} or usage(), exit(1);
    $_=$FLAGS{$_} if not ref $FLAGS{$_};
    &{$FLAGS{$_}};
  } else {
    foreach (split //, $_) {
      exists $FLAGS{$_} or usage(), exit(1);
      $_=$FLAGS{$_} if not ref $FLAGS{$_};
      &{$FLAGS{$_}};
    }
  }
}

my ($host, $version, @modules) = @ARGV;
defined $host and $host =~ /^$_host_regexp$/ or usage(), exit(1);

my ($srcbasename) = source_basename($SOURCE_TYPE);
$version = latest_kernel($srcbasename, $PATCH_TYPE) if not defined $version;
my ($kernver, $kernver_first, $kernver_last, $patchver) = ($version =~ /^((\d+\.\d+\.)(\d+))(?:-$PATCH_TYPE(\d+\w*))?$/);
defined $kernver or fail "invalid kernel version $version";
my ($kernfile);
if ($PATCH_TYPE eq 'pre') {
  if ($kernver_last gt 0) {
    $kernfile=filename_kernel($srcbasename, $kernver_first . ($kernver_last - 1));
  } else {
    fail "pre-patched x.x.0 sources not supported in kernellab (can't guess earlier version)";
  }
} else {
  $kernfile=filename_kernel($srcbasename, $kernver);
}
defined $kernfile or fail "kernel $kernver not found.";
info "kernel version=$kernver, filename=$kernfile";
my $patchfile;
if (defined $patchver) {
  $patchfile=filename_patch($kernver, $PATCH_TYPE, $patchver);
  defined $patchfile or fail "$PATCH_TYPE patch $kernver-$PATCH_TYPE$patchver not found.";
  info "$PATCH_TYPE patch $patchver, filename=$patchfile";
}

if (@modules) {
  foreach (@modules) {
    defined filename_module($_)
      or fail "module $_ not found.";
  }
  info "modules=", join(', ', @modules);
}

info "making build dir";
mkdir $BUILDDIR, 0755 or fail "cannot mkdir build directory $BUILDDIR; $!";
chdir $BUILDDIR or fail "cannot chdir to build directory $BUILDDIR; $!";
info "extracting kernel sources";
extract($kernfile);
if (-d "kernel-source-$kernver") {
  info "creating a symlink from '$kernfile' to 'linux'";
  symlink ("kernel-source-$kernver",'linux') or fail "couldn't symlink 'kernel-source-$kernver' to 'linux'";
}
-d 'linux' or fail "kernel source didn't unpack in 'linux'";
chdir 'linux' or fail "cannot chdir to kernel subdir; $!";

if (defined $patchfile) {
  info "applying $PATCH_TYPE patches";
  apply_patch($patchfile);
}

# find closest config file, copy to .config
my $config=closest_config($host, $kernver, $PATCH_TYPE, $patchver);
if (defined $config) { #found one
  info "using old config $config";
  system('cp', $config, '.config') == 0
    or fail "copying $config to .config failed; $?";
  system('make', 'oldconfig') == 0
    or fail "make oldconfig failed; $?";
}
else {$DO_CONFIG++} # default settings -> configure

if ($DO_CONFIG) {
  system('make', 'menuconfig') == 0
    or fail "make menuconfig failed; $?";
  -e '.config'
    or fail "menuconfig didn't write a config file, exiting..";
}

info "storing config";
system('cp', '.config', 
       $WRITE_CONFIG . 'config-' . $host . '-' . $version) == 0
  or fail "copying .config to $WRITE_CONFIG failed; $?";

info "building kernel...";
my $revision;
if (defined $KERNEL_REVISION) {
	$revision = $KERNEL_REVISION ? "--revision $KERNEL_REVISION" : "";
} else {
	$revision = '--revision 1:'.next_revision($host, $kernver,
				  strftime('%Y%m%d',localtime()), $PATCH_TYPE);
}
system('fakeroot', '/usr/bin/make-kpkg', "$revision",
       'kernel_image') == 0
  or fail "make-kpkg kernel_image failed; $?";

if ($MAKE_HEADERS) {
  info "building headers...";
  system('fakeroot', '/usr/bin/make-kpkg',
         'kernel_headers') == 0
           or fail "make-kpkg kernel_headers failed; $?";
}

chdir $BUILDDIR or fail "cannot chdir to build directory $BUILDDIR; $!";

info "extracting modules";
#modules have to unpack into modules/<name>
foreach(@modules) {
  extract filename_module $_;
}
if (@modules) {
  # this check is too many false positives
  -d 'modules' or fail "modules didn't unpack in 'modules'";

  chdir 'linux' or fail "cannot chdir to kernel subdir; $!";

  info "building modules...";
  $ENV{MODULE_LOC}=$BUILDDIR . '/modules';
#  $ENV{SRCTOP}=$BUILDDIR . '/linux';
#  $ENV{PWD}=$BUILDDIR . '/linux';
  system('fakeroot', '/usr/bin/make-kpkg', 'modules_image') == 0
    or fail "make-kpkg modules_image failed; $?";
}

chdir $BUILDDIR or fail "cannot chdir to build directory $BUILDDIR; $!";
info "cleaning";
system('rm', '-rf', 'linux', 'modules', 'kernel-source-*');

info "moving images to", $WRITE_IMAGE.$host;
-d "$WRITE_IMAGE/$host"
  or mkdir "$WRITE_IMAGE/$host", 0755
  or fail "cannot make directory $WRITE_IMAGE/$host; $!";

my $image_exists_error = defined($KERNEL_REVISION)
  ? "don't build with same revision twice!"
  : "this can't happen!";
foreach (grep {!/^\./} getdir '.') {
  fail "$_ exists in $WRITE_IMAGE, $image_exists_error"
    if -e "$WRITE_IMAGE/$host/$_";
  system('mv', '-i', $_, "$WRITE_IMAGE/$host/$_") == 0
    or fail "moving images failed on file $_: $!";
}

info "final cleaning";
chdir '/' or fail "cannot chdir out from build dir; $!";
rmdir $BUILDDIR or fail "cannot remove build dir $BUILDDIR; $!";

print "$_programname: Done.\n";
exit(0);

__END__

=head1 NAME

kernellab - manage kernel configs for many machines easily

=head1 SYNOPSIS

kernellab [options] <host> [<version>[-ac<patchlevel>] [<module>..]]

=head1 DESCRIPTION

Kernellab helps you manage kernel configs for many heterogenous
machines. The configs are just stored in their normal format in
/var/state/kernellab/configs/config-<hostname>-<kernversion>[-ac<acver>].
This and placing the kernel sources in a format accessible to
kernellab allows you to easily build a new kernel for your computers.

Let's take an example: say you have 20 miscellanous machines working
as routers all over your network, with different ethernet cards and
other kernel options. Say someone discovers a denial of service
-attack in the linux TCP/IP stack. So you wait two hours till Alan Cox
puts out a new -ac42 patch, download this patch and put in to
/var/state/kernellab/alancox/patch-n.n.n-ac42.bz2. Now, all you need
to do to recompile the new, fixed, kernel for all your routers, is

	for a in router1 router2 router3 ...; do kernellab "$a"; done

=head1 OPTIONS

  -O		use official linux-x.x.x sources (default)
  -D		use Debian kernel-source-x.x.x sources
  -a		use Alan Cox patches (default)
  -p		use Linus Thorvalds pre-patches
  --ben		use Benjamin Herrenschmidt ben patches
  --benh	use Benjamin Herrenschmidt benh patches
  --paulus	use Paul Mackerras patches
  -c		always run make menuconfig
  -H		also create a kernel-headers -package
  -v		increase verbosity (can specify many times)
  -h		show usage

=head1 BUGS

This manpage.

=head1 AUTHOR

Tommi Virtanen <tv@havoc.fi>

=cut