#!/usr/bin/perl
#
#                              -*- Mode: Perl -*-
# make-kpkg ---
# Author           : Eduard Bloch <blade@debian.org>
# Status           : Useable, new features planed
#
# Script to assist users with building of the kernel modules
# First purpose: automate as much as possible for Joe User
# Second purpose: have a database about the source of module packages
# (and all steps needed to get it)
# Third purpose: provide general debian/rules include snippets
#
# TARGETs:
#   see usage

require 5.002;
#use strict;
#use diagnostics;

=head1 NAME

module-assistant - helper to manage Debian kernel modules packages and their sources

=cut

use Getopt::Long qw(:config no_ignore_case bundling pass_through);
use File::Basename;
use Cwd;

$res = (defined($ENV{"MA_DIR"})) ? $ENV{"MA_DIR"} : "/usr/share/modass";
$var= (defined($ENV{"MA_VARDIR"})) ? $ENV{"MA_VARDIR"} : "/var/cache/modass";

$main::Author      = "Eduard Bloch";
$main::AuthorMail  = "blade\@debian.org";
$main::Version     = ' $Id:  $ ';

$helpmsg="
USAGE:

  update-modules update
  update-modules [options] COMMAND [ packages ]

module-assistant is the toy to get debianized source of kernel modules,
build module package from it and install them. The most frequently used
command may be auto-install followed by alli argument.

Commands:

  update - refresh internal information about the packages
  get - download/install the source (package) and unpack if needed
  build - build the specified package(s)
  list - print information about installed/available/compiled packages
  install - install the generated binary modulse DEB package with dpkg
  auto-install - the whole process, get & build & install (abbreviated: a-i)
  prepare - install headers for the current kernel and set the linux symlink
  clean - quick clean of the source (eg. wiping the build directory)
  purge - removes cached data and existing modules packages
  la (alias for \"list all\"), li (= \"list all installed\"), search (= \"list -p\")

Package arguments:

  Source package name(s). If -src or -source is omited, name completion will 
  try to guess the package name. If 'all' the first argument, the list will be
  expanded to all packages. 'alli' will be expanded to \"all installed\".

Options:
 -h, --help        Print this help screen
 -v, --verbose     Be verbose, show full paths, etc.
 -q, --quiet       The oposite of verbose
 -n, --no-rebuild  Don't rebuild when any useable modules package for 
                   this kernel exists (even an old one)
 -i, --ignore-failures Don't stop on build failures
 -s, --apt-search  Search for installation candidates in the Debian archive
 -f, --force       Force to use the new versions even when old ones exist
 -u, --user-dir    Specifies a (writeable) replacement directory for /var&/usr
 -l, --kvers-list  List of kernel versions to work on (default: current version)
 -k, --kernel-dir  List of kernel headers/source directories, comma separated
Lists in options are strings separated by commas, spaces or new lines.

Example:
  m-a update ; m-a a-i nvidia ; echo Enjoy!
";


chomp($my_kvers=`uname -r`);
my $kpackage='linux';
my $kheaders=$kpackage.'-headers';
my $ksource=$kpackage.'-source';
my $kimage=$kpackage.'-image';

my $opt_help;
my @opt_kerneldirs;
my @opt_kverslist;
my $opt_verbose;
my $opt_force;
my $opt_norebuild;
my $opt_quiet;
my $opt_debug;
my $opt_search;
my $opt_nogui;
my $opt_userdir;
my $opt_ignfails;

%options = (
   "q"                => \$opt_quiet,
   "d"                => \$opt_debug,
   "h|help"                => \$opt_help,
   "f|force"               => \$opt_force,
   "n|no-rebuild"                => \$opt_norebuild,
   "i|ignore-failures"                => \$opt_ignfails,
   "k|kernel-dir=s"             => \@opt_kerneldirs,
   "l|kvers-list=s"             => \@opt_kverslist,
   "v|verbose"              => \$opt_verbose,
   "t|text-mode"          => \$opt_nogui,
   "u|userdir=s"          => \$opt_userdir,
   "s|apt-search"          => \$opt_search
);
&help unless ( GetOptions(%options));
&help if ($opt_help);
$ENV{"VERBOSE"}=1 if($opt_verbose);

my $buildNumber = time();

my $command=$ARGV[0];
shift(@ARGV);
@targets=@ARGV;
@opt_kerneldirs = split(/,|\ |\r|\n/,join(',',@opt_kerneldirs));
@opt_kverslist = split(/,|\ |\r|\n/,join(',',@opt_kverslist));

# add current kernel to the kvers list, check validity later
push(@opt_kverslist, $my_kvers) if ($#opt_kverslist < 0 && $#opt_kerneldirs < 0);

push(@opt_kerneldirs, split(/,|\ |\r|\n/,$ENV{"KERNELDIRS"})) if (defined $ENV{"KERNELDIRS"});


if(!$opt_nogui) {
   $dialog=$ENV{"DIALOG"};
   if(!$dialog) {
      if(defined($ENV{"TERM"})) {
         @expaths=split(/:/,$ENV{"PATH"});
         for $dia ("dialog", "whiptail") {
            for(@expaths) {
               last if($dialog);
               $dialog="$_/$dia" if(-x "$_/$dia");
            }
         }
      }
   }
   $opt_nogui = !$dialog;
   $wtmode=1 if($dialog=~/whiptail$/);
}


sub help() {
   print $helpmsg;
   exit 1;
};

sub withecho {
   our ($cmd) = @_;
   print STDERR "$cmd\n" if($opt_verbose);
   $myret=system($cmd);
   $ret += $myret;
   return $myret;
}

my $catchprint;

sub printwrap {
   if($catchprint) {
      $printbuf .= join('', @_);
   }
   else { 
      print @_; }
}

sub printmsg {
   if(!$opt_nogui) {
      chomp($tmpname = `mktemp`);
      open($tmpfile, ">$tmpname");
      print $tmpfile @_;
      close($tmpfile);
      if($wtmode) {
         system($dialog, "--scrolltext", "--title", "module-assistant, error message", "--textbox", $tmpname, 18, 70);
      }
      else {
         system($dialog, "--aspect", 12, "--title", "module-assistant, error message", "--textbox", $tmpname, 0, 0);
      }
      unlink $tmpname;
   }
   else {
      print STDERR @_;
   }
}

# User-trimmed paths
if($opt_userdir) {
   die "$opt_userdir is not a directory!\n"  if(! -d "$opt_userdir/.");
   die "$opt_userdir is not writeable!\n"  if(! -w "$opt_userdir/.");
   $opt_userdir=Cwd::abs_path($opt_userdir);
   $var="$opt_userdir/var_cache_modass";
   $ENV{"MA_VARDIR"}=$var;
   mkdir $var;
   $ENV{"MOD_TOPDIR"}="$opt_userdir/usr_src";
   mkdir "$opt_userdir/usr_src";
   $ENV{"MODULE_LOC"}="$opt_userdir/usr_src/modules";
   $ENV{"KPKG_DEST_DIR"}=$opt_userdir if(! defined($ENV{"KPKG_DEST_DIR"}));
   if(-x "/usr/bin/sudo") {
      print "Found sudo, will use it for apt-get and dpkg commands.\n";
      $sudo="/usr/bin/sudo";
   }
   else {
      print "Warning: sudo not found. Automatical package installations not possible!\n";
   }
}

sub setvars {
   $ENV{"KDREV"} = $KDREV if defined($KDREV);
   $ENV{"KVERS"} = $KVERS;
   $ENV{"KSRC"} =  $kerneldirs{$KVERS};
   $ENV{"KPKG_DEST_DIR"}=Cwd::abs_path($kerneldirs{$KVERS}."/..") if(! defined($ENV{"KPKG_DEST_DIR"}));
}

sub have_source_or_break {
   # if user specified no source, extra_vers[0] is our $my_kvers. If
   # user specified something but without useable source, then
   # extra_vers[0] is at least this one value. If there are more, don't
   # complaing about them, though

   my $kvers=$extra_kvers[0];
   if(!(keys %kerneldirs)) {
      printmsg "

Bad luck, the kernel headers for this kernel version could not be found
and you did not specify other kernel headers to use.
      ";

      if (length(`apt-cache show $kheaders-$kvers 2>/dev/null`) ) {
         printmsg "
However, you can install the header files for your kernel which are provided
by the $kheaders-$kvers package. For most modules packages,
this files are perfectly sufficient without having the original kernel source.

To install the package, run".($opt_nogui ? "" : " the PREPARE command from the main menu,\nor on the command line").":

module-assistant prepare

or

apt-get install $kheaders-$kvers

" ;
         exit 255 if($opt_nogui);
         $ret++;
         return 0;
      }
      else {
         printmsg "
If the running kernel has been shipped with the Debian distribution,
please install the package $kheaders-$kvers. If your kernel
source tree (or headers) is located in some non-usual location, please
set the KERNELDIRS environment variable to the path of this directory,
or (alternatively) specify the source directory we build for with the
--kernel-dir option in module-assistant calls.
"
         ;
         exit 255  if($opt_nogui);
         $ret++;
         return 0;
      }
   }
   return 1;
}

sub up {
   my $pkg;
   my @packnames;
   if(@_) {
      @packnames=@_;
   }
   else {
      @packnames=sort(keys %packs);
   }
   # we provide apt-policy data, polling it with one call for
   # performance reasons
   open($apt, "LANG=C apt-cache policy ".join(' ', @packnames)." 2>/dev/null |");
   while(<$apt>) 
   { 
      if(eof($apt) || /^\w/) {
         if (defined($pkg)) {
            open($out, ">".$var."/cache/$pkg.apt_policy");
            print $out @tmp; 
            undef @tmp; undef $pkg;
            close($out);
         }
      }
      push(@tmp, $_);
      $pkg=$1 if /^(\w\S+):/;
   }
   my $i;
   if(!$opt_nogui) {
      open($dpipe, "| $dialog --title \"Updating cached package data\" --gauge \"Reading apt-cache output...\" 7 75 0");
   }

   foreach(@packnames) {
      $i++;
      if($opt_verbose) {
         print "Updating info about $_\n";
      }
      elsif($opt_nogui) {
         syswrite(STDERR,'.') if(!$opt_quiet);
      }
      else {
         $pr=sprintf("%.0f", $i * 100 / ($#packnames+1));
         print $dpipe "$pr\nXXX\n$_\nXXX\n";
      }
      $ret += system("$packs{$_} update");
   }
   close($dpipe);
   print "\nUpdated infos about $i package".($i ? "s\n":"\n");
   $ret += system ("rm -f $var/*.apt_policy");
}

sub prep {
   $source=$kerneldirs{$my_kvers};
         print STDERR "$source.\n" if $opt_debug;
         print STDERR values(%kerneldirs),"\n\n" if $opt_debug;
   if(defined($source)) {
      print STDERR "Kernel headers available in $source\n";
      $opt_verbose=1;
      chdir "/usr/src";
      # if source was resolved to linux before, it is okay. If not,
      # make the symlink. If linux exists but points to sth. wrong for
      # us, move it away by renaming
      if($source ne "/usr/src/linux") {
         rename("/usr/src/linux","/usr/src/linux-OLDVERSION.".time) if(-e "/usr/src/linux" || -l "/usr/src/linux");
         print STDERR "Creating symlink...\n";
         symlink((dirname($source) eq "/usr/src") ? basename($source) :  Cwd::abs_path($source) ,"linux") || print STDERR "Couldn't create the /usr/src/linux symlink!\n";
      }
   }
   else {
      $opt_verbose=1;
      withecho "$sudo apt-get install $kheaders-$my_kvers\n";
      rename("/usr/src/linux","/usr/src/linux-OLDVERSION.".time) if(-e "/usr/src/linux" || -l "/usr/src/linux");
      symlink("$kheaders-$my_kvers","linux") || print STDERR "Couldn't create the /usr/src/linux symlink!\n";
   }
   if(`apt-cache policy build-essential` =~ /Installed:..none/) {
      print STDERR "Installing packages needed for the build environment...\n" if (!opt_quiet);
      withecho "$sudo apt-get install build-essential";
   }
   print STDERR "\nDone!\n"
}

sub complete_name {
   my $target = $_[0];
   my $pkg;
   my @posnames;
   my $d;

   return $target if(defined($packs{$target}));

   # no luck, begin with probing
   #
   for $sufMult ("", "s") {
      for $sufType ("", "-driver", "-kernel", "-module") {
         for $sufSrc ("-source", "-src") {
            push(@posnames, $target.$sufType.$sufMult.$sufSrc);
         }
      }
   }
   PROBE: for (@posnames) {
      print STDERR "PROBE: $_\n" if $opt_debug;
      if(defined($packs{$_})) 
      {
         print STDERR "GOT NAME: $_\n" if $opt_debug;
         return $_;
      }
   }

   for $getName (keys %packs) {
      if(!defined($pkg)) {
         $prefix=`$packs{$pkg} prefix`;
         chomp($prefix);
         return $prefix if($prefix eq $getName);
      }
   }

   # ugly, ugly, ugly, looking for an available package with similar
   # name
   #print "apt-cache policy ".join(" ", @posnames)." 2>/dev/null |\n";
   #exit 1;
   open($d, "apt-cache policy ".join(" ", @posnames)." 2>/dev/null |");
   pol: while(<$d>) {
      if(/^(\S+):/) {
         $pkg=$1;
         mkdir "$var/unreg" if(!-d "$var/unreg");
         unlink "$var/unreg/$pkg";
         if(symlink("$res/packages/default.sh", "$var/unreg/$pkg")) {
            $packs{$pkg}="$var/unreg/$pkg";
            return $pkg;
         }
         else { undef $pkg; }
      }
   }
   close($d);
            
   die "$target, what is $target?\n";
}

sub get {
   my $newstuff=0;
   SKIP: foreach $target (@_) {
      my $pkg;
      my $reti=0;
      $pkg=complete_name($target);
      next SKIP if( $installed_only && system("$packs{$pkg} installed"));
      # zero is success! non-zero is failure!
      if($opt_force) {
         $ENV{"REINSTALL"} = "--reinstall";
         $reti=withecho("$packs{$pkg} download");
         $newstuff++;
      }
      else {
         if(system($packs{$pkg}, "installed")) {
            $reti=withecho("$packs{$pkg} download");
            $newstuff++;
         }
         else {
            my $curpkgvers=`$packs{$pkg} cur_version`; chomp($curpkgvers);
            my $avpkgvers=`$packs{$pkg} avail_version`; chomp($avpkgvers);
            if($curpkgvers ne $avpkgvers) {
               $reti=withecho("$packs{$pkg} download");
               $newstuff++;
            }
         }
      }

      # and don't unpack if download failed
      withecho("$packs{$pkg} unpack") if (!$reti);
   }
   &up(@_) if($newstuff);
}

sub build {
   # lart the user if there is no source (only @extra_kvers)
   # exit in non-dialog mode

   # if have_source_or_break terminates the program, okay. If
   # have_source_or_break returns 0, then build should not continue;
   # otherwise, go ahead
   return if (!have_source_or_break());
   foreach(values %kerneldirs) {
      if( (! $ENV{"KPKG_DEST_DIR"}) && (! -w Cwd::abs_path("$_/..")) ) {
         printmsg "\$KPKG_DEST_DIR is not set and the target directory\n".
         Cwd::abs_path("$_/..")." is not writeable for you!\nYour build will probably fail!\n";
         sleep(5) if($opt_nogui);
      }
   }
   # apropos, common code
   my $pkg;
   SKIP: foreach $target (@_) {
      $pkg=complete_name($target);
      next SKIP if( $installed_only && system("$packs{$pkg} installed"));

      labKVERS: foreach $KVERS ((values %kernelvers)) {
         undef $newdeb;
         undef $lastdeb;
         open($aptpipe,"LANG=C apt-cache policy $kheaders-$KVERS 2>/dev/null |");
         while(<$aptpipe>) { /Installed:\s*(.+)\n/; last if $KDREV=$1};
         chomp($KDREV);
         if($KDREV eq "(none)" || !defined($KDREV)) {
            open($aptpipe,"LANG=C apt-cache policy $kimage-$KVERS 2>/dev/null|");
            while(<$aptpipe>) { /Installed:\s*(.+)\n/; last if $KDREV=$1};
            chomp($KDREV);
         }
         undef $KDREV if($KDREV eq "(none)");
         &setvars;
         $lastdeb=`KVERS=$KVERS $packs{$pkg} lastpkg`;
         $newdeb=`KVERS=$KVERS $packs{$pkg} echodebfile`;
         chomp($lastdeb); chomp($newdeb);
         if (length($lastdeb) && -e $lastdeb && !$opt_force) {
            $lastdeb=Cwd::abs_path($lastdeb);
            $newdeb =Cwd::abs_path($newdeb);
            # there is a candidate
            if($opt_norebuild) {
               # and do _not_ rebuild choosen
               print "Recently built package $lastdeb found, not rebuilding $pkg\n";
               next labKVERS;
            }
            if ($lastdeb eq $newdeb) {
               # target file is absolutely the same
               print STDERR "Target package file $newdeb already exists, not rebuilding!\n";
               print "(however, you could use the -f switch to ignore it)\n";
               next labKVERS;
            }
         }
         # implicit else
         $cmd ="$packs{$pkg} build KVERS=$KVERS KSRC=".
         $kerneldirs{$KVERS}.
         ( (defined($KDREV)) ? " KDREV=$KDREV" : "").
         ( (defined($ENV{"KPKG_DEST_DIR"})) ? "" : 
         "KPKG_DEST_DIR=".Cwd::abs_path($kerneldirs{$KVERS}."/..") ).
         ( ($ENV{"SIGNCHANGES"}) ? " kdist" : " kdist_image" )
         ;
         print STDERR "$cmd\n" if($opt_verbose);
         if(!$opt_nogui) {
            # guess how verbose the build will be...
            $modloc=$ENV{"MODULE_LOC"} ? $ENV{"MODULE_LOC"}:"/usr/src/modules";
            $pkg=~/^([^-]+)/;
            open($flist, "find $modloc/$1* |"); while(<$flist>) {$lnumber++};
            $lnumber = 250 if($lnumber<100);
            
            open($bpipe, "$cmd 2>&1 |");
            $step=1;
            open($dpipe, "| $dialog --title \"Building $pkg, step $step\" --gauge \"Build starting...\" 15 75 0");
            while(<$bpipe>) {
               $pr=sprintf("%.0f", $lfdzeile++ * 100 / $lnumber);
               if($pr> 100) {
                  # eeeeks, overflow, restart dialog
                  $step++;
                  close($dpipe);
                  open($dpipe, "| $dialog --title \"Building $pkg, step $step\" --gauge \"$_\" 15 75 0");
                  $lfdzeile=0;
                  $pr=0;
               }
               print $dpipe "$pr\nXXX\n$_\nXXX\n";
            }
            close($bpipe);
            $ret += ($? >> 8);
            if(!$?) {
               $deb=`KVERS=$KVERS $packs{$pkg} lastpkg`;
               chomp($deb);
               print $dpipe "100\nXXX\nDone! Run\\nm-a install $pkg\\nto install.\nXXX\n";
#               $build_ok{$pkg}
            }
            else {
               # hack. Dirty hack. But if this fails, what is reliable
               # then?
               chomp($file=`ls -tr $var/$pkg.buildlog.$KVERS.* | tail -n1`);
               if(!$opt_ignfails) {
                  $gui_loop=1;
                  $defsel="VIEW";
                  sleep 1;
                  RES: while($gui_loop) {
                     open($intro, "$dialog --default-item $defsel --clear --title ".'"module-assistant, interactive mode" --menu "Build of the package '.$pkg.' failed! How do you wish to proceed?\n\n" 14 65 5 VIEW "Examine the build log file" CONTINUE "Skip and continue with the next operation" STOP "Stop processing the build commands" 2>&1 >/dev/tty |');
                     @out = <$intro>;
                     close($intro);
                     $dialog_ret= ($? >> 8);
                     last RES if($dialog_ret);
                     die "Dialog command not working correctly!\n" if($#out != 0);
                     $defsel=$out[0];
                     if($defsel eq "VIEW") {
                        system($dialog, ($wtmode ? "--scrolltext" : "--clear" ), "--title", "module-assistant, log file viewer", "--textbox", $file, 21, 78);
                     }
                     elsif($defsel eq "CONTINUE") {
                        $gui_loop=0;
                     }
                     elsif($defsel eq "STOP") {
                        close $dpipe;
                        return;
                     }
                  }
               }
               else { print $dpipe "100\nXXX\nBuild failed! See $file for details!\nXXX\n"; }
            }
            close $dpipe;
            print STDERR "Done with $deb .\n" if $deb;
         }
         else {
            $res = system $cmd;
            if( (!$opt_ignfails) && $res) {
               print "Build failed. Press Return to continue...\n";
               <STDIN>;
            }
            $ret += $res;
         }
      }
   }
}

sub install {
   my $pkg;
   foreach $target (@_) {
      $pkg=complete_name($target);
      &setvars;
      foreach $KVERS ((values %kernelvers), @extra_kvers) {
         &setvars;
         $deb=`KVERS=$KVERS $packs{$pkg} lastpkg`;
         chomp($deb);
         if (length($deb) && -e $deb) {
            push(@debs, Cwd::abs_path($deb));
         }
         else {
            printmsg "Package $pkg was not built successfully, see $var/$pkg*buildlog* for details!\n";
            if ($command ne "auto-install" && $opt_nogui) {
               print "You maybe want to run \"auto-install\" instead of install.\n";
            }
         }
      }
   }
   $ret_save = $ret;
   withecho "dpkg -i ".join(' ',@debs) if($#debs >= 0);
   if($ret > $ret_save) {
      $ret--;
      print STDERR "\nI: Direct installation failed, trying to post-install the dependencies\n\n";
      $ret += withecho "$sudo apt-get -f install";
   }
}

sub clean {
   my $pkg;
   SKIP: foreach $target (@_) {
      $pkg=complete_name($target);
      next SKIP if( $installed_only && system("$packs{$pkg} installed"));
      $ret += withecho "$packs{$pkg} clean";
   }
}

sub purge {
   my $pkg;
   SKIP: foreach $target (@_) {
      $pkg=complete_name($target);
      next SKIP if( $installed_only && system("$packs{$pkg} installed"));
      $ret += withecho "$packs{$pkg} purge";
   }
}

sub list {
    print "Warning, the cache is empty. You maybe wish to run\nthe command \"module-assistant update\" first!\n" if ("" eq <$var/*>);
   my $i;
   $retcode=1;
   PKG: foreach (sort @_) {
      $requested=$_;
      #syswrite(STDERR,'.') if(!$opt_quiet);
      $pkg=complete_name($_);
      my $tellsearch;
      
      # is i(nstall)ed or not?
      # 
      if(!system($packs{$pkg}, "installed") ) {
         my $curpkgvers=`$packs{$pkg} cur_version`; chomp($curpkgvers);
         my $avpkgvers=`$packs{$pkg} avail_version`; chomp($avpkgvers);
         printwrap "$pkg (source package installed";
         if($curpkgvers ne $avpkgvers) {
            printwrap ", not up-to-date, cur. version: $curpkgvers, available: $avpkgvers";
         }
         printwrap "):\n";
      }
      elsif($installed_only) { # nichts damit machen
         next PKG;
      }
      else { # not installed but try the bins though
         printwrap "$pkg (source package not installed):\n";
      }
      $retcode=0;

      my $binstring;
      foreach $KVERS ((values %kernelvers), @extra_kvers) {
         $lastbin=`KVERS=$KVERS $packs{$pkg} lastpkg`; chomp($lastbin);
         $binstring .= 
         "   + ($KVERS): ";

         if(length($lastbin) >0 ) {
            $binstring .= ( $opt_verbose ? Cwd::abs_path($lastbin) : basename($lastbin))."\n";
         }
         elsif($opt_search) {
            my $packname = ((split(/-/, $pkg))[0]);
            if(@precomp=`apt-cache pkgnames $packname- | grep -- -$KVERS\$`)
            {
               # preset but try others if needed
               my $binpackage=$precomp[0];

               if($#precomp > 0) {
                  $shortname=$pkg;
                  $shortname=~s/-(source|src)$//;
                  # stupid similar looking names
                  for(@precomp) {
                     if(/$shortname-$KVERS/) {
                        $binpackage=$_;
                        last;
                     }
                  }
               }
               if(`apt-cache show $binpackage`=~/Filename:/) {
                  $binstring .= "not found, possible candidate(s) installable with apt-get:\n\t";
               }
               else {
                  printwrap "package not found, but following is already installed:\n\t";
               }
               $binstring .= join("\n\t", @precomp);
            }
         }
         else {
            $binstring .= "not found\n";
            $tellsearch++;
         }
      }
      if(length($binstring)) {
         printwrap "  -- Binary package(s) for kernel(s):\n$binstring";
         printwrap (($tellsearch>1 ? "Some packages were not found" : "One package could not be found").". Use the \"search\" command to look in the pool.\n") if($tellsearch && !$opt_quiet);
      }
      else
      {
         printwrap "  -- No binary packages found" . (!$opt_search && 
         " (use the \"search\" command to look in the pool)")."\n" if(!$opt_quiet);
      }
      
      $i++;
      printwrap "\n";
   }
   if(!$i) {
      printwrap "No data? You maybe want to run \"module-assistant update\" first.\n" ;
      $ret++;
   }
   return $retcode;
}

opendir($resdir, $res."/packages");
foreach(readdir($resdir)) {
   $packs{$_}=$res."/packages/".$_ if(-e $res."/packages/".$_ && !/\.|~$/);
}
opendir($overdir, $res."/overrides");
foreach(readdir($overdir)) {
   $packs{$_}=$res."/overrides/".$_ if(-e $res."/overrides/".$_ && !/\.|~$/);
}

sub argv_expand {
   @ARGV=split(/,|\ /,join(',',@ARGV));
   @ARGV=sort(keys %packs) if ($ARGV[0] eq "all");
   if ($ARGV[0] eq "alli") {
      @ARGV=sort(keys %packs);
      $installed_only=1;
   }
}

sub init_packs_desc {
   # allow control scripts to preset descriptions
   open($descfile, "<$var/descriptions");
   while(<$descfile>) {
      if(/([^:]+):\ ?(.*)/) {
         $packsdesc{$1}=$2;
         last;
      }
   }
   close($descfile);
   for $source (keys %packs) {
      $shortname=$source;
      $shortname=~s/-(source|src)$//;
      if(!defined($packsdesc{$shortname})) {
         # accidentaly named after -source package
         if(defined($packsdesc{$source})) {
            $namefound = $packsdesc{$source};
            delete $packsdesc{$source};
         }
         else {
            # precache once with cummulative apt-get run
            if(!(keys %descache)) {
               open($getdesc, "apt-cache show ".join(' ',keys %packs)." |");
               while(<$getdesc>) { 
                  $pkg=$1 if(/^Package: (.*)\n/);
                  if(/^Description: (.*)\n/) {
                     $descache{$pkg}=$1;
                  }
               }
               close($getdesc);
            }
            $namefound=$descache{$source};
         }
         $namefound=~s/\(source.*\)//i;
         $namefound=~s/(source)?\.?$//i;
         $namefound=~s/^(driver|module)?.?sources? (code )?(for|of)? (the )?//i;
         # and if there still nothing, it will be an empty description
         $packsdesc{$shortname} = "$namefound";
      }
   }
   open($descfile, ">$var/descriptions");
   for(keys %packsdesc) {
      print $descfile $_.": ".$packsdesc{$_}."\n";
   }
   close($descfile);
}
         

sub fakesrc {
   my $kpkg = $kimage."-".$_[0];
   my $kvers=$_[0];
   my $knmbr=$kvers;
   $knmbr=~s/^([\d\.]+)(.*)/$1/;
   my $extra=$2;
   my $confile="/boot/config-$kvers";
   print "Experimental kernel source recreating method...\nGetting source...\n";
   return 0 if withecho "apt-get install $ksource-$knmbr";
   if(! -f $confile) {
      print "Config not found, getting headers to extract the config...\n";
      return 0 if withecho "apt-get install $kheaders-$kvers";
      $confile="/usr/src/$kheaders-$kvers/.config";
   }
   return 0 if withecho "cd /usr/src; tar jxf $ksource-$knmbr.tar.bz2";
   withecho "mv /usr/src/$ksource-$knmbr /usr/src/$ksource-$kvers";
   withecho "cp $confile /usr/src/$ksource-$kvers/.config";
   if($extra) {
      open(mk,"</usr/src/$ksource-$kvers/Makefile");
      while(<mk>) {
         if($extra && s/^EXTRAVERSION.*/EXTRAVERSION=$extra\n/)
         {
            undef($extra);
         }
         push(@mkcont,$_);
      }
      close(mk);
      open(mk,">/usr/src/$ksource-$kvers/Makefile");
      print mk @mkcont;
      close(mk);
   }

   withecho "cd /usr/src/$ksource-$kvers ; make include/linux/version.h || make dep";
   print "\nFaked kernel source for the Kernel $kvers.\nWarning: the configuration may not match the running kernel.\n\n"
}
#   &prepare($kvers);
#   if ( length(`apt-cache showsrc $kpkg 2>/dev/null`) ) {
#      
#      withecho "apt-get build-dep $kpkg";
#      open($apt,"apt-cache showsrc $kpkg|");
#      while(<$apt>) {
#         if(/Build-Depends:\s(.*)/) {
#            $ksrc=$1;
#            $ksrc=((grep(/^$ksource/, split(/[,\n\ ]/, $ksrc)))[0]);
#         }
#      }
#      chdir "/usr/src";
#      withecho "tar zxvf $ksrc FIXME THIS IS BORKEN WITH RECENT EXPERIMENTS FROM HERBERT XU
#   }
#   else {
#      die "There is no source package for $kimage-$my_kvers\n";
#   }
#}
   

#$maxlen=0;
#foreach $key (keys %packs) {
#   $maxlen = length($key) if (length($key) > $maxlen);
#}
#print @output;

# things that belong together:
# Kernel version von some directory
# $kernelvers{"directory"}= VERSION-NUMBER
# Directory to some kernel version
# $kerneldirs{VERSION-NUMBER} = "directory"

foreach(@opt_kerneldirs) {
   if(-d $_) {
      open($versionh, "<$_/include/linux/version.h");
      <$versionh> =~ /"(.+)"/;
      if(close($versionh)) {
         $kernelvers{$_}=$1;
         $kerneldirs{$1}=$_;
      }
      elsif(-r "$_/Makefile") {
         printmsg "Warning, $_ seems to contain unconfigured kernel source!";
      }
      else {
         printmsg "Warning, $1 doesn't have valid source, skipping!";
      }
   }
}
# now go trough the user-specified kverslist, skipping kvers that we
# detected already and look for for the appropriate kernel headers for
# the rest

HAVEIT: foreach $kvers (@opt_kverslist) {
   next HAVEIT if(defined($kerneldirs{$kvers}));
   LOOKUP: foreach("/usr/src/linux", "/usr/src/$kheaders-$my_kvers", </usr/src/*>, </usr/local/src/*>, "/lib/modules/".$my_kvers."/build") {
      if(-e "$_/include/linux/version.h") {
         open($versionh, "<$_/include/linux/version.h");
         <$versionh> =~ /"(.+)"/;
         if($1 eq $kvers) {
            $kernelvers{$_}=$kvers;
            $kerneldirs{$kvers}=$_;
            last LOOKUP;
         }
      }
      elsif(-r "$_/Makefile") {
         printmsg "Warning, $_ seems to contain unconfigured kernel source!";
      }
   }
}
# finaly, go trough @opt_kverslist and push versions with no source to
# @extra_kvers
for(@opt_kverslist) {push(@extra_kvers, $_) if(!defined($kerneldirs{$_}))}
print "valid: ", (keys %kerneldirs), " extra: ", @extra_kvers if($opt_debug);

&argv_expand;

### MAIN part ###
if(! (`id -u`=~/^0/) && !$opt_userdir) {
   printmsg "You are not root and no replacement directory (the -u option) is specified. Unable to continue.";
   exit 254;
}
if($command eq "list" || $command eq "list-available" || $command eq "la") {
   if($#ARGV<0) { $ARGV[0]="all" ; &argv_expand}
   &list(@ARGV);
}
elsif($command eq "search") {
   if($#ARGV<0) { $ARGV[0]="all" ; &argv_expand}
   $opt_search=1;
   &list(@ARGV);
}
elsif($command eq "list-installed" || $command eq "li") {
   if($#ARGV<0) { $ARGV[0]="alli" ; &argv_expand}
   &list(@ARGV);
}
elsif($command eq "get") {
   &help if($#ARGV<0);
   die "No package specifies. STOP.\n" if($#ARGV<0);
   &get(@ARGV);
}
elsif($command eq "build") {
   $opt_nogui = 0 if $wtmode; # whiptail's gauge sucks
   die "No package specifies. STOP.\n" if($#ARGV<0);
   &build(@ARGV);
}
elsif($command eq "update") {
   if($#ARGV<0) { $ARGV[0]="all" ; &argv_expand}
   &up(@ARGV);
}
elsif($command eq "prepare") {
   &prep();
}
elsif($command eq "auto-install" || $command eq "ai" || $command eq "a-i") {
   die "No package specifies. STOP.\n" if($#ARGV<0);
   &get(@ARGV);
   &build(@ARGV);
   &install(@ARGV);
}
elsif($command eq "auto-build" || $command eq "ab") {
   die "No package specifies. STOP.\n" if($#ARGV<0);
   &get(@ARGV);
   &build(@ARGV);
}
elsif($command eq "install") {
   die "No package specifies. STOP.\n" if($#ARGV<0);
   &install(@ARGV);
   }
elsif($command eq "clean") {
   die "No package specifies. STOP.\n" if($#ARGV<0);
   &clean(@ARGV);
}
elsif($command eq "purge") {
   die "Do you really wish to remove all binary packages?\nIf so, use the --force option.\n" if(!$opt_force);
   die "No package specifies. STOP.\n" if($#ARGV<0);
   &purge(@ARGV);
}
elsif($command eq "fakesource") {
   $ARGV[0]=$my_kvers if($#ARGV < 0);
   &fakesrc($ARGV[0]);
}
else {
   # bounce with error message if there is no gui, otherwise work with dialog
   &help() if ($opt_nogui || !$dialog);

   print STDERR "Starting the Dialog UI...\n";
   chomp($tmpname=`mktemp`);
   $gui_loop=1;
   $defsel="OVERVIEW";
   GUI: while($gui_loop) {
      open($intro, "$dialog --default-item $defsel --clear --title ".'"module-assistant, interactive mode" --menu "Welcome to the dialog frontend of module-assistant. This user interface provides access to the few commands of this program.\n\nIf you wish to learn more, choose the OVERVIEW option.\n\nIf you wish to look for existing module packages for your needs or wish to compile a new one from source, choose them in the SELECT dialog an continue with possible commands.\n\n" 20 65 5 OVERVIEW "Show all possible command line commands" UPDATE "Update the cached package information" PREPARE "Configure the system to compile modules" "SELECT" "Select the module/source packages to work on" "EXIT" "Exit the program" 2>&1 >/dev/tty |');
      @out = <$intro>;
      close($intro);
      $dialog_ret= ($? >> 8);
      last GUI if($dialog_ret);
      die "Dialog command not working correctly!\n" if($#out != 0);
      $defsel=$out[0];
      if($defsel eq "OVERVIEW") {
         open($tmpfile, ">$tmpname");
         print $tmpfile $helpmsg;
         close($tmpfile);
         system($dialog, ($wtmode ? "--scrolltext" : "--clear" ), "--title", "module-assistant, command overview", "--textbox", $tmpname, 21, 78);
         unlink $tmpname;
      }
      elsif($defsel eq "UPDATE") {
         up();
      }
      elsif($defsel eq "PREPARE") {
         prep();
         print STDERR "\n\nPress Return to continue...";
         $a=<STDIN>;
      }
      elsif($defsel eq "SELECT") {
         &init_packs_desc();
         %packsel = %packsdesc;
         for(keys %packsel) { $packsel{$_}="off"};
         
         SELECTION: while(1) {
            my $tmpstring = $dialog.' --clear --title "module-assistant, package selection" --checklist "\nPlease select the interesting module (source) packages\n\nUse Cursor keys to browse, Space to select and Return to continue.\n\nCancel to return to the main menu." 21 70 10';
            for(sort(keys %packsel)) {
               $tmpstring .= " $_ \"".$packsdesc{$_}.'" '.$packsel{$_};
            }
            $tmpstring .= ' 2>&1 >/dev/tty |';
            open($select, $tmpstring);
            @out = <$select>;
            close $select;
            last SELECTION if($? >> 8);
#            die "Dialog command not working correctly!\n" if($#out != 0);
            $selection=$out[0];
            $selection=~s/\"//g;
            @selected=split(/\ /,$selection);
            for(@selected) { $packsel{$_}="on"};
            next SELECTION if($#selected < 0);

            ACTION: while(1) {
               $tmpstring = $dialog.' --clear --title "module-assistant, interactive mode" --menu "You have selected the following packages:\n\n'
               .join(', ', @selected)
               .'\n\nChoose one of the following commands to proceed or Cancel to return to the selection menu.\n\n" 18 65 6 LIST "List installed (binary) packages" SEARCH "List and search with apt-cache" GET "Get or update the source package" "BUILD" "Compiles module packages for the current kernel" INSTALL "Installs the packages for the current kernel" BACK "Returns to the module selection" 2>&1 >/dev/tty |';
               open($select, $tmpstring);
               @out = <$select>;
               close $select;
               last SELECTION if($? >> 8);
               $selection=$out[0];
               if($selection eq "LIST" | $selection eq "SEARCH") {
                  $opt_search=1 if($selection eq "SEARCH");
                  undef $printbuf;
                  $catchprint=1;
                  list(@selected);
                  undef $catchprint;
                  open($tmpfile, ">$tmpname");
                  print $tmpfile $printbuf;
                  close($tmpfile);
                  system($dialog, "--title", "module-assistant, present packages", "--textbox", $tmpname, 21, 78);
                  unlink $tmpname;

                  undef $opt_search;
               }
               elsif($selection eq "GET") {
                  get(@selected);
               }
               elsif($selection eq "BUILD") {
                  my $instatus;
                  my $retold=$ret;
                  for(@selected) {$instatus += system($packs{complete_name($_)}." installed") };
                  if($instatus && !system($dialog, "--title", "module-assistant, source installation", "--yesno", "Some source packages seem not to be installed. Would you like to install or upgrade selected source packages now?", 7, 60)) {
                     get(@selected);
                  }
                  build(@selected);
                  if($ret > $retold) {
                     printmsg "The build was not successful! See /var/cache/modass/*buildlog* for more details.";
                  }
                  elsif(!system($dialog, "--title", "module-assistant, package installation", "--yesno", "Would you like to install the created module package(s) now?", 7, 60)) {
                     install(@selected);
                  }
                        

               }
               elsif($selection eq "INSTALL") {
                  install(@selected);
               }
               else {
                  next SELECTION;
               }
            }
         }
      }
      else {
         exit;
      }
   }
}

sub ende {
   if($ret >= 250 && $ret < 256) {
      exit $ret;
   }
   else {
      exit (($ret%250)+($ret>0));
   }
}

ende();
