#!/usr/local/bin/perl

#
# modman  --  Rscan Module Installation Manager
#
# (c) 1994-1995 Nate Sammons
#

##
## variables.  Some may need to be changed.
##
$gzip           = 'gzip';        ## if it's in the PATH, this will work
$gzip_create    = '--best';      ## the option to create an archive
$gunzip         = 'gunzip';      ## if it's in the PATH, this will work
$gunzip_extract = '-c';          ## extract to STDOUT
$tar            = 'tar';         ## if it's in the PATH, this will work
$tar_create     = 'cvf';         ## create an archive, verbosely.
$tar_extract    = 'xvf';         ## extract an archive, verbosely.
$tar_list       = 'tf';          ## non-verbose listing.
$remove         = '/bin/rm -rf'; ## remove dirs and files, etc.

############################################################
##       NO CONFIGURATION VARIABLES BELOW THIS LINE       ##
############################################################

##
## these variables should not be changed.
##
$version        = '1.4.0 -- April 3, 1995';
$pager          = $ENV{'PAGER'} || 'more';
$prompt         = 'Modman> ';
$spacer         = ' ' x length($prompt);
$pkgext         = 'tar.gz';
$redirect       = '2>&1';
$|              = 1;
$rscandir       = '.';
$moduledir      = '$rscandir . "/scanner/modules"';  ## must be eval'd

## See if we're root or not
if ($> != 0) {
  die "\nmodman must be run as root.\n\n";
  }

## print a nice looking header the first time through.
print &center('   __  ___        __              ', 70) , "\n" ,
      &center('  /  |/  /__  ___/ /_ _  ___  ___ ', 70) , "\n" ,
      &center(" / /|_/ / _ \\/ _  /  ' \\/ _ `/ _ \\", 70) , "\n" ,
      &center('/_/  /_/\___/\_,_/_/_/_/\_,_/_//_/', 70) , "\n" ,
      &center('The Rscan Module Installation Manager', 70) , "\n\n",
      &center("Version $version", 70), "\n\n";

## set for commands in the "shell"
## available commands and their perl counterparts
$cmd{'list'}        = '&list';
$cmd{'config'}      = '&config';
$cmd{'exit'}        = '&quit';
$cmd{'quit'}        = '&quit';
$cmd{'to'}          = '&to';
$cmd{'?'}           = '&help';
$cmd{'help'}        = '&help';
$cmd{'install'}     = '&install';
$cmd{'remove'}      = '&remove';
$cmd{'backup'}      = '&backup';
$cmd{'readme'}      = '&readme';

## some semi-useful help strings.
$help{'config'} =
  $spacer . "List configuration options currently set.\n";

$help{'readme'} =
  $spacer . "Read the readme for a module.  Either give the\n" .
  $spacer . "module's shortname as an argument or you will\n" .
  $spacer . "be prompted for it later.\n";

$help{'to'} =
  $spacer . "Set the location of the main Rscan directory.\n" .
  $spacer . "It can either take the location as an argument or\n" .
  $spacer . "prompt for it.  If modman is run from within the\n" .
  $spacer . "Rscan directory, it should be set properly.\n";

$help{'list'} = 
  $spacer . "List lists all modules that are currently installed,\n" .
  $spacer . "with information about each.\n";

$help{'exit'} = $spacer . "Exits modman.\n";
$help{'quit'} = $help{'exit'};

$help{'help'} =
  $spacer . "Get help.  This can be given by itself or with the name\n" .
  $spacer . "of a command that you need help with.\n";
                
$help{'?'} = $help{'help'};

$help{'install'} = 
  $spacer . "Install a module.  The module can either be given as\n" .
  $spacer . "an argument to the command or can be prompted for.\n" .
  $spacer . "The path to the package is either relative to the\n" .
  $spacer . "directory that modman was started in, or an absolute path.\n";

$help{'remove'} = 
  $spacer . "Remove a module.  This deletes the entire module, so it\n" .
  $spacer . "may be prudent to backup the module first.  The module\n" .
  $spacer . "can either be specified as an argument or prompted for.\n" .
  $spacer . "If the word \"sure\" is given as the second option,\n" .
  $spacer . "the module is deleted without asking.\n";

$help{'backup'} = 
  $spacer . "Make a backup copy of a module.  The module name can either\n" .
  $spacer . "be specified as an argument or prompted for.  Backups are\n" .
  $spacer . "created in the scanner/modules directory below the Rscan\n" .
  $spacer . "main directory.\n";

## main command loop.
print $prompt;
while (<>) {
  chop;
  @tmp = split(' ', $_);  ## split on whitespace
  
  if (/^\s*$/) { ; } ## no command, just a <CR>
  
  ## basically, we assemble a perl function to execute from what $commands
  ## says and the options given by the user, then run it.
  elsif ($cmd{$tmp[0]}) {
    $comd = $cmd{$tmp[0]} . "('" . $tmp[1] . "'";
    foreach $i (2..$#tmp) { $comd .= ", '$tmp[$i]'"; }
    $comd .= ')';
    eval $comd;
    }
  else { print "Unrecognized command: \"$_\" (type \"help\" for a list)\n"; }
  print $prompt;
  }

######################################################################
##                       SUBROUTINE DEFINITIONS                     ##
######################################################################

sub readme {
  local($rsdir) = eval $moduledir;
  local($module) = shift;
  
  if (!-d $rsdir) {
    print "  ERROR: The directory \"$rsdir\" does not exist.\n",
          "    Did you forget to set the rscan directory with 'to'?\n\n";
    return 1;
    }
  
  if (!$module) {
    print "  Read which module's README? : ";
    chop($module = <STDIN>);
    }
  
  if (!-d "$rsdir/$module") {
    print "  ERROR: The module \"$module\" is not installed.\n";
    return 1;
    }
  
  if (!-e "$rsdir/$module/README") {
    print "  ERROR: The module \"$module\" does not have a README.\n";
    return 1;
    }
  else {
    system "$pager $rsdir/$module/README";
    }
  }

sub install {
  local($rsdir) = eval $moduledir;
  local($package) = $_[0];

  if (!-d $rsdir) {
    print "  ERROR: The directory \"$rsdir\" does not exist.\n",
          "    Did you forget to set the rscan directory with 'to'?\n\n";
    return 1;
    }
  
  if (!$package) {
    print '  Install which module? : ';
    chop($package = <STDIN>);
    }
  if (!-e $package) {
    print "  ERROR: The module package $package does not exit.\n";
    return 1;
    }
  
  ## OK, get a list of things we're going to install, and make sure
  ## that it won't overwrite what's already there.
  undef %dirs;
  open(TAR,
    "$gunzip $gunzip_extract $package \| $tar $tar_list - $redirect |");
  while (<TAR>) { $dirs{(split('/', $_))[0]} = 1; }
  close(TAR);
  
  ## check each directory
  foreach $i (sort keys %dirs) {
    if (-d "$rsdir/$i") {
      $chose = 0;
      while (!$chose) {
        print "\n  The directory \"$i\" already exists.\n",
              '   What should I do? [b]ackup, [r]emove, [q]uit : ';
        chop($_ = <STDIN>);
        if ($_ eq 'b') {  ## backup the directory
     	$chose = 1;
     	if (&backup($i)) { return; } ## backup exits with 0=good, etc.
     	if (&remove($i, 'sure')) { return; } ## remove is the same
     	}
        elsif ($_ eq 'r') {  ## backup the directory
     	$chose = 1;
     	if (&remove($i)) { return; } ## remove exits with 0=good, etc.
     	}
        elsif ($_ eq 'q') { return; }
        }
      }
    }
   
  ## OK, now all we do is extract it in place
  chop($pwd = `pwd`);
  
  ## suffex the path with pwd if it's a relative path
  if ((substr($package, 0, 2) eq './') ||
      (substr($package, 0, 3) eq '../')) {
    $package = "$pwd/$package";
    }

  ## change directories
  $text = '  Extracting files:     ';
  print $text;
  chdir $rsdir;
  $fnum = 0;
  open(UNARCH,
    "$gunzip $gunzip_extract $package \| $tar $tar_extract - $redirect |");
  while (<UNARCH>) {
    print "\b" x 4, sprintf("%4d", ++$fnum);
    }
  close(UNARCH);
  print "\b" x length($text),
        ' ' x length($text),
        "\b" x length($text),
        "  Installed $fnum files/directories\n";
  chdir $pwd;
  
  }

sub remove {
  local($rsdir) = eval $moduledir;
  if (!-d $rsdir) {
    print "  ERROR: The directory \"$rsdir\" does not exist.\n",
          "    Did you forget to set the rscan directory with 'to'?\n\n";
    return 1;
    }
  
  if (!$_[0]) {
    print 'Remove which module? : ';
    chop($module = <STDIN>);
    if (!-d "$rsdir/$module") {
      print "  ERROR: The module \"$module\" does not exist.\n";
      return 1;
      }
    }
  else {
    $module = $_[0];
    if (!-d "$rsdir/$module") {
      print "  ERROR: The module \"$module\" does not exist.\n";
      return 1;
      }
    }
  
  $chose = 0;
  while (!$chose) {
    if ($_[1] ne 'sure') {
	 print "  Are you sure you want to remove \"$module\"\n",
            "    Please type \"yes\" or \"no\" : ";
	 chop($_ = <STDIN>);
	 }
    else { $_ = 'yes'; }
    if ($_ eq 'yes') {
      $chose = 1;
      $text = '  Removing files';
      print $text;
      if (system "$remove $rsdir/$module") {
        print "\n  ERROR: An error occurred in the removal process.\n",
              "    Please check that all the files in\n",
              "     $rsdir/$module\n",
              "    were deleted.\n\n";
        return 1;
        }
      else {
        print "\b" x length($text),
              ' ' x length($text),
              "\b" x length($text);
        return 0;
        }
      }
    elsif ($_ eq 'no') {
      print "  INFO: No files were removed.\n";
      return 1;
      }
    }
  }

sub backup {
  local($rsdir) = eval $moduledir;
  if (!-d $rsdir) {
    print "  ERROR: The directory \"$rsdir\" does not exist.\n",
          "    Did you forget to set the rscan directory with 'to'?\n\n";
    return 1;
    }
  
  if (!$_[0]) {
    print '  Backup which module? : ';
    chop($module = <STDIN>);
    if (!-d "$rsdir/$module") {
      print "  ERROR: The module \"$module\" does not exist.\n";
      return 1;
      }
    }
  else {
    $module = $_[0];
    if (!-d "$rsdir/$module") {
      print "  ERROR: The module \"$module\" does not exist.\n";
      return 1;
      }
    }
  
  $chose = 0;
  if (-e "$rsdir/$module.$pkgext") {
    while (!$chose) {
	 print "  A backup of \"$module\" already exists.\n",
            "   May I remove it? [y]es, [n]o : ";
	 chop($_ = <STDIN>);
	 if ($_ eq 'y') {
        $chose = 1;
        $text = '  Removing files';
        print $text;
        if (system "$remove $rsdir/$module.$pkgext") {
     	print "\n  ERROR: An error occurred in the removal process.\n",
          	 "    Please check that the file\n",
          	 "     $rsdir/$module.$pkgext\n",
          	 "    was deleted.\n\n";
     	return 1;
     	}
        else {
          print "\b" x length($text),
                ' ' x length($text),
                "\b" x length($text);
     	}
        }
	 elsif ($_ eq 'n') {
        print "  INFO: No files were removed.\n";
        return 1;
        }
	 }
    }
  
  ## backup the files
  $text = '  Tarring files:     ';
  print $text;
  $fnum = 0;
  chop($pwd = `pwd`);
  chdir $rsdir;
  open(TAR, "$tar $tar_create $module.tar $module $redirect |");

  while (<TAR>) {
    print "\b" x 4, sprintf("%4d", ++$fnum);
    }
  close(TAR);
  print "\b" x length($text),
        ' ' x length($text),
        "\b" x length($text);
  
  $text = '  Compressing files';
  
  print $text;
  system "$gzip $gzip_create $module.tar $redirect";
  print "\b" x length($text),
        ' ' x length($text),
        "\b" x length($text);
  chdir $pwd;
  return 0;
  }

## set the location of securscan
sub to {
  if ($_[0]) {
    if (-d $_[0]) { $rscandir = $_[0]; }
    else {
      print "  ERROR: The directory \"$_[0]\"\n",
            "         does not exist.\n\n";
      }
    }
  else {
    print '  Where is rscan located? : ';
    chop($_ = <STDIN>);
    if (-d $_) { $rscandir = $_; }
    else {
      print "ERROR: The directory \"$_\"\n",
            "       does not exist.\n\n";
      }
    }
  
  }

## list configuration options
sub config {
  print "\n",
        $spacer, "Current Configuration Options:\n\n",
        $spacer, "Rscan directory [to]       : \"$rscandir\"\n",
        "\n";
  }

## list installed modules
sub list {
  local($dir) = eval $moduledir;
  local(@mods, $fname, $version);
  if (!-d $dir) {
    print "  ERROR: The directory \"$dir\" does not exist.\n",
          "    Did you forget to set the rscan directory with 'to'?\n\n";
    }
  else {
    print "\n";
    opendir(DIR, $dir);
    while ($_ = readdir(DIR)) {
      if ((!/^\.+$/) && (-d "$dir/$_")) { push(@mods, $_); }
      }
    closedir(DIR);
    foreach $i (sort @mods) {
      open(FNAM, "$dir/$i/fullname");
      chop($fname = <FNAM>);
      close(FNAM);
      
      open(VERS, "$dir/$i/version");
      chop($version = <VERS>);
      close(VERS);
      
      print " Module: $fname\n",
            "   Short name:  $i\n",
            "   Version:     $version\n\n";
      }
    }
  }

## exits
sub quit {
  print "\nExiting Modman...\n";
  exit 0;
  }

## get help on a command or see available commands
sub help {
  local($it) = shift;
  if (defined $help{$it}) { print $help{$it}; }
  else {
  	print "\nKnown commands:\n";
  	local(@tmp) = sort keys %cmd;
  	local($tmp2) = int($#tmp / 3);
  	foreach $i (0..$tmp2) {
    	  # this make a nice, 3 column listing, it just looks messy ;-)
    	  print '  ' , ' ' ,
      	   &nprint($tmp[$i], 20, ' ') , 
      	   ' ' , &nprint(($tmp[$i + $tmp2 +1])[0], 20, ' ') , 
      	   ' ' , $tmp[$i + (2* $tmp2) +2], "\n";
    	}
  	print "\n",
  	      '  Type "help mycommand" to get help on using the ',
  	      "command \"mycommand\"\n",
  	      "\n";
  	}
  }

## centers text in a space of specified length
sub center {
  local($text, $space) = @_;
  $text = ' ' x (($space - length($text)) / 2) . $text;
  }

## returns a string buffered with a character to a certain length
sub nprint {
  local($text, $space, $char) = @_;
  $text .= $char x ($space - length($text));
  }
