#!/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
            $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
    -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 ($file) = @_;
  _find_filename(prefix('linux-' . $file . '.tar.bz2', @SOURCES),
                 prefix('linux-' . $file . '.tar.gz', @SOURCES));
}

sub filename_ac($$;) {
  my ($k, $ac) = @_;
  _find_filename(prefix('patch-' . $k . '-ac' . $ac . '.bz2', @ALANCOX),
                 prefix('patch-' . $k . '-ac' . $ac . '.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 latest_kernel() {
  my @kernels =
    map {/^linux-(\d+)\.(\d+)\.(\d+)\./; [$_,$1,$2,$3]}
      grep {/^linux-\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 @acs =
    map {/^patch-\d+\.\d+\.\d+.-ac(\d+)\./; [$_,$1]}
      grep {/^patch-$a\.$b\.$c-ac\d+\.(?:gz|bz2)$/}
        map {getdir $_} @ALANCOX;
  my $ac = max map {$_->[1]} @acs;
  $kernel .= '-ac' . $ac if defined $ac;

  return $kernel;
}

sub closest_config($$;$;) {
  my ($host, $kver, $acver) = @_;
  debug "finding closest config for $host $kver"
    . (defined $acver ? "-ac$acver" : '');
  my @configs;
  foreach my $confdir (@CONFIG) {
    foreach my $conffile (getdir $confdir) {
      $conffile =~ 
        /^config-($_host_regexp)-(\d+)\.(\d+)\.(\d+)(?:-ac(\d+))?$/
          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) = @_;
  my @revs =
    sort {$b<=>$a}
      map { $_->[3] }
        grep {
          $_->[1] eq $host
            and $_->[2] eq $date
          }
          map {
            /^kernel-image-
              (\d+\.\d+\.\d+)_	# 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++},
         );

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);

$version = latest_kernel() if not defined $version;
my ($kernver, $acver) = ($version =~ /^(\d+\.\d+\.\d+)(?:-ac(\d+))?$/);
defined $kernver or fail "invalid kernel version $version";
my $kernfile=filename_kernel($kernver);
defined $kernfile or fail "kernel $kernver not found.";
info "kernel version=$kernver, filename=$kernfile";
my $acfile;
if (defined $acver) {
  $acfile=filename_ac($kernver, $acver);
  defined $acfile or fail "ac patch $kernver-ac$acver not found.";
  info "ac patch $acver, filename=$acfile";
}

my @modules;
if (defined $modules) {
  @modules=split ',', $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);
-d 'linux' or fail "kernel source didn't unpack in 'linux'";
chdir 'linux' or fail "cannot chdir to kernel subdir; $!";

if (defined $acfile) {
  info "applying ac patches";
  apply_patch($acfile);
}

# find closest config file, copy to .config
my $config=closest_config($host, $kernver, $acver);
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 = '1:'.next_revision($host, $kernver,
				  strftime('%Y%m%d',localtime()));
system('fakeroot', '/usr/bin/make-kpkg', '--revision', $revision,
       'kernel_image') == 0
  or fail "make-kpkg kernel_image failed; $?";

if ($MAKE_HEADERS) {
  info "building headers...";
  system('fakeroot', '/usr/bin/make-kpkg', '--revision', $revision,
         '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';
  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');

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; $!";

foreach (grep {!/^\./} getdir '.') {
  fail "$_ exists in $WRITE_IMAGE, this can't happen!"
    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

  -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
