#!/usr/athena/bin/perl -w

#
# whichlocker, release 3
#
# An increasingly less stupid script to tell you
# which locker has a given program or library.
# 
# by Brad Thompson
#
# $Id: whichlocker.pl,v 1.14 2001/05/12 05:55:23 yak Exp yak $
#

my($HESINFO, $DB_NAME, %MACHTYPES, $WARNED);

$DB_NAME="/mit/outland/share/whichlocker/program-database";
$HESINFO="/bin/athena/hesinfo";
%MACHTYPES = (
    "sun4", [ "sun4x_58", "sun4x_57", "sun4x_56", "sun4x_55", "sun4m_54" ],
    "sgi", [ "sgi_65", "sgi_63", "sgi_62", "sgi_53" ],
    "linux", [ "i386_linux24", "i386_linux22", "i386_linux3", "i386_linux2" ],
    "inbsd", [ "i386_nbsd1" ],
    "vax", [ "vax_bsd43" ] );
$WARNED=0;

use strict;
use Fcntl;
use FileHandle;
use DirHandle;

# MAIN
do
{
  my $mode = "locate";
  my @bins = ();

  for my $arg (@ARGV)
  {
    if ($arg eq "--build") { $mode = "build"; }
    elsif (my @matches=($arg=~/^--db=(.*)$/)) { $DB_NAME=$matches[0]; }
    elsif ($arg=~/^[^-]/) { push (@bins, $arg); }
    else {
      print(STDERR "usage: $0 [--build] [--db=DBPREFIX] program...\n");
      exit 1;
    }
  }

  if ($mode eq "locate")
  {
    my $file = new FileHandle($DB_NAME) || die "can't open database";
    my %missing; for my $bin (@bins) { $missing{$bin}=1; }
    for my $line ($file->getlines())
    {
      for my $bin (@bins)
      {
	my $loc;
	$loc = ($line=~/^$bin\t(.*)/)[0] and
	  &print_hit($bin,$loc), delete($missing{$bin});
      }
    }
    for my $bin (keys(%missing))
    {
      print("\"$bin\" is not installed in a known location.\n");
    }
  } elsif ($mode eq "build") {
    &build_db();
  }

  exit 0;
};

sub print_hit($$) # (binaryname, location-string)
{
  my ($bin, $locs) = @_;
  my %locdb;

  for my $location (split(":", $locs))
  {
    my ($locker, $os) = split(/,/, $location);
    if (!$locdb{$locker}) { $locdb{$locker} = [ ]; }
    push(@{$locdb{$locker}}, $os);
  }

  while (my ($locker, $arch) = each(%locdb))
  {
    my $archstr = &english_list(sort(@{$arch}));
    if (!$WARNED)
    {
      $WARNED = 1;
      print("Locker software on Athena is maintained by many different people.\nDon't run these programs unless you know the maintainer can be trusted:\n");
    }
    print("\"$bin\" is installed in \"$locker\" for $archstr.\n");
  }
}

sub english_list
{
  my (@list) = @_;

  if (@list==0)
  {
    "";
  } elsif (@list==1) {
    $list[0];
  } elsif (@list==2) {
    $list[0] . " and " . $list[1];
  } else {
    join(", ", @list[0..$#list-1]) . ", and " . $list[$#list];
  }
}

sub build_db
{
    my (@lockers, @locker_dirs, @local_dirs);

    my %db = ( );

    @lockers = map { chomp($_); $_; } (<STDIN>);
    @locker_dirs = map { [ $_ , &locker_location($_) ] } (@lockers);

    for my $locker_dir (@locker_dirs)
    {
	print("building for ", $locker_dir->[0], "\n");

	for my $machtype (keys(%MACHTYPES))
	{
	    my ($locker_spec);

	    $locker_spec = $locker_dir->[0].",".$machtype;
	    for my $program (&locker_programs($locker_dir->[1], $machtype))
	    {
		if (!$db{$program}) { $db{$program} = $locker_spec; }
	    	else { $db{$program} .= ":" . $locker_spec };
	    }
	}
    }

    my $dbfile = new FileHandle(">$DB_NAME")
      or die "can't open database ($DB_NAME)";
    for my $key (keys(%db))
    {
      $dbfile->print($key."\t".$db{$key}."\n");
    }
    $dbfile->close() or die "couldn't close database ($DB_NAME)";
}

sub locker_programs($$) # locker_programs(path, machtype)
{                       # e.g. locker_programs("/mit/sipb", "vax")
    my ($path, $machtype) = @_;
    my ($bindir, $libdir, @binaries);

    $bindir = &athdir($path, "bin", $machtype);
    $libdir = &athdir($path, "lib", $machtype);

    @binaries = ();
    $bindir && push(@binaries, grep { -f "$bindir/$_" } (read_dir($bindir)));
    $libdir && push(@binaries, grep { -f "$libdir/$_" } (read_dir($libdir)));

    @binaries;
}

sub athdir($$$) # athdir(path, type, machtype)
{              # e.g. athdir("/mit/sipb", "bin", "vax")
    my ($path, $type, $machtype) = @_;
    my ($dir);

    for my $sysname (@{$MACHTYPES{$machtype}})
    {
	$dir = "$path/arch/$sysname/$type";
	if (-d $dir) { return $dir; }
    }

    $dir = "$path/$machtype$type";
    if (-d $dir) { return $dir; }

    "";
}

sub read_dir($) # read_dir(dir-name)
{
    my ($dirname) = @_;
    my ($fh, @data);

    $fh = new DirHandle($dirname) ||
	die "can't open file ($dirname)";

    @data = $fh->read();

    $fh->close();

    grep { $_ ne "." && $_ ne ".." } (@data);
}

sub locker_location($) # locker_location(locker-name)
{
    my ($locker) = @_;
    my (@hes_entries, @hes_entry);
    my ($fstype, $fspath, $fsopt, $fsmount);

    @hes_entries = split(/\n/, `$HESINFO '$locker' filsys`);

    scalar(@hes_entries) == 0 &&
	die "can't look up hesiod entry for locker ($locker)";

    ($fstype, $fspath, $fsopt, $fsmount) = split(/\s+/, $hes_entries[0]);
    $fstype ne "AFS" &&
	die "locker ($locker) not in AFS; it is \"$fstype\"";

    $fspath;
}