eval '(exit $?0)' && eval '[ -f /usr/local/bin/perl ] && exec /usr/local/bin/perl -S $0 ${1+"$@"}; exec perl -S $0 ${1+"$@"};'
& eval 'if ( -f /usr/local/bin/perl ) exec /usr/local/bin/perl -S $0 $argv:q ; exec perl -S $0 $argv:q'
     if 0;

# @(#)[Hyper-G] [INS] hginstclient	1.20 [client inst. script] [Gerald Pani]

# 
#<copyright>
# 
# Copyright (c) 1993-1995
# Institute for Information Processing and Computer Supported New Media (IICM),
# Graz University of Technology, Austria.
# 
#</copyright>
  
#<file>
#
# Name:       hginstclient.pl
#
# Purpose:    Installation and update of the Hyper-G Client
#
# Created:       Mai 93    Gerald Pani
#
# Modified:   16 Nov 93    Gerald Pani
# Modified:    9 Feb 94    Gerald Pani
# 	Version 1.01: supports SGI
# Modified:   10 Feb 94    Gerald Pani
# 	Version 1.02: bug in readcpu fixed
# Modified:    3 Oct 94    Gerald Pani
#       Version 1.03: supports SUN5
# Modified:   19 Oct 94    Gerald Pani    1.13 external 'what' no longer necessary
#                                              use gunzip if possible
# Modified:   11 Nov 94    Gerald Pani    1.14 SOCK_STREAM default for Solaris
# Modified:   12 Dec 94    Gerald Pani    1.16 + ALPHA_OSF1
# Modified:   13 Dec 94    Gerald Pani    1.17 '<ROOT>' removed from hgtv.rc
# Modified:   14 Feb 95    Gerald Pani    1.18 sub Pwd, SOCK_STREAM default for Irix 5.x, no Perl 5 warnings
# Modified:   19 Apr 95    Gerald Pani    1.19 bug fixed
# Modified:   25 Aug 95    Gerald Pani    1.20 supports Linux,
#                        options 'confirm', 'nochanges', 'changelog' and some bug fixes
#
# Description:
# 
# This script installs the Hyper-G client into the homedir of the
# current user or into the directory '/usr/local/Hyper-G'. Call the
# script from one of the both directories, or use the switches -home
# or -hyperg
# 
#</file>

$mailRegister = 'hgregister@iicm.tu-graz.ac.at';
$updateServerName = 'fiicmss01.tu-graz.ac.at';
$updateServerAddr = '129.27.153.5';

@cpuSupp = ('SUN4', 'PMAX', 'HPUX9', 'SUN5', 'SGI', 'ALPHA_OSF1', 'LINUX');	# supported cpu types
$reqFile = 'FetchClientFile';
$reqFileTable = 'FetchClientFiletable';
$reqCPU = 1;
$nameFileTable = '.ClientFiletable';
$conn = 'S';
$doCheckSum = 0;
$waitAccept = 0;
$doLog = 0;
$port = 5001;
$myName = &basename( $0);
$uncomprComm = 'uncompress';
$beta = 0;
$exact = 0;
$confirm = 0;
$nochanges = 0;
$changelog = 0;

select(STDOUT); $| = 1;

# parse any switches

$home = 0;			# install into homedir;
$instHyperG = 0;		# install into '/usr/local/Hyper-G'

@args = @ARGV;			# save args of this program;

$restart = 1;
{
    local($arg);
    while ($arg = shift) {
	($arg =~ /^-h$/)    && (die &help());	    # help
	($arg =~ /^-help$/) && (die &help());	    # help
	($arg =~ /^-nore/) && ($restart = 0, next); # no restart, if script install itself
	($arg =~ /^-beta$/) && ($beta = 1, next); # fetch beta versions
	($arg =~ /^-conf/) && ($confirm = 1, next); # confirm installations
	($arg =~ /^-noch/) && ($nochanges = 1, next);
	($arg =~ /^-chan/) && ($changelog = 1, next); # creates hginstserver.clog
	($arg =~ /^-home$/) && ($home = 1, next); # install into homedir
	($arg =~ /^-hype/) && ($instHyperG = 1, next); # install into '/usr/local/Hyper-G'
	die &Usage();
    }
}

die &Usage() if ($home && $instHyperG);	    # only one of both

# check install directory
if ($home) {
  chdir() || die "Couldn't find homedirectory\n";
}
if ($instHyperG) {
  chdir("/usr/local/Hyper-G") || die "Couldn't find directory /usr/local/Hyper-G\n";
}


# Is currentdir homedir or /usr/local/Hyper-G ?
# Set $instHyperG again
$pwd = &Pwd();			# name of currentdir;

if ($pwd eq "/usr/local/Hyper-G") {
  # Currentdir is /usr/local/Hyper-G
  # Are the permissions ok (read/write)?
  -r "/usr/local/Hyper-G" || die "Error: no read access to /usr/local/Hyper-G\n";
  -w "/usr/local/Hyper-G" || die "Error: no write access to /usr/local/Hyper-G\n";
  $instHyperG = 1;
  $lastinst = "hglastinst";
  $tvrc = "hgtv.rc";
}
else {
  # install in homedir
  # is this the homedir?
  chdir() || die "Couldn't find homedirectory\n";
  $hdir = &Pwd();
  $pwd eq $hdir || die "Current directory is not homedirectory.\n";
  $instHyperG = 0;
  $lastinst = ".hglastinst";
  $tvrc = ".hgtv.rc";
}

print "\nInstalling into directory $pwd\n";

if ($changelog) {
    rename( "hginstclient.clog", "hginstclient.clog.old");
    open( CLOG, "> hginstclient.clog") || die "Couldn't open hginstclient.clog: $!\n";
}

# Get parameter of prior installations.
if (-f $lastinst) {
  # further installation
  open(HGLI, $lastinst) || die "Couldn't open $lastinst\n";
  while(<HGLI>) {
    (/^\s*<CPU>\s*(\S+)\s*$/) && ($CPU = $1) && next;
    (/^\s*<BINDIR>\s*(\S+)\s*$/) && ($BINDIR = $1) && next;
    (/^\s*<SCRIPTDIR>\s*(\S+)\s*$/) && ($SCRIPTDIR = $1) && next;
    (/^\s*<SGMLDIR>\s*(\S+)\s*$/) && ($SGMLDIR = $1) && next;
    (/^\s*<MANDIR>\s*(\S+)\s*$/) && ($MANDIR = $1) && next;
  }
  close(HGLI);
}

# check platform
($CPU = &readcpu()) || exit(1);
$ENV{'CPU'} = $CPU;
  
# check BINDIR
defined($BINDIR) || ($BINDIR = &readbindir()) || die "Directory for binaries not defined\n";
# check SCRIPTDIR
defined($SCRIPTDIR) || ($SCRIPTDIR = &readscriptdir()) || die "Directory for scripts not defined\n";
# check SGMLDIR
defined($SGMLDIR) || ($SGMLDIR = &readsgmldir()) || die "Directory for sgml files not defined\n";
# check MANDIR
defined($MANDIR) || ($MANDIR = &readmandir()) || die "Directory for manual pages not defined\n";

# make or check directories;
&MakePath($SGMLDIR);
&MakePath($BINDIR);
&MakePath($SCRIPTDIR);
&MakePath($MANDIR);

# make $lastinst
open(HGLI, "> $lastinst") || die "Couldn't create $lastinst\n";
print HGLI "<CPU>$CPU\n";
print HGLI "<BINDIR>$BINDIR\n";
print HGLI "<SCRIPTDIR>$SCRIPTDIR\n";
print HGLI "<SGMLDIR>$SGMLDIR\n";
print HGLI "<MANDIR>$MANDIR\n";
close(HGLI);

# make or adjust $tvrc
if (-f $tvrc) {
    # further installation
    open(TVRC, "< $tvrc") || die "Couldn't open $tvrc\n";
    open(NTVRC, "> $tvrc.new") || die "Couldn't open $tvrc.new\n";
    local($pathset) = 0;
    while(<TVRC>) {
	if (/^\s*<SGMLDIR>\s*(\S+)\s*$/) {
	    print NTVRC "<SGMLDIR>$pwd/$SGMLDIR\n";
	    next;
	}
	if (/^\s*<PATH>(.*)$/) {
	    if (!$pathset) {
		print NTVRC "<PATH>$pwd/$SCRIPTDIR $pwd/$BINDIR\n";
		$pathset = 1;
	    }
	    next;
	}
	print NTVRC;
    }
    close (TVRC);
    close (NTVRC);
    
    open(TVRC, "< $tvrc");
    local( $checksum, $newchecksum);
    { local($/); $checksum = unpack("%16C*", <TVRC>); 
    }
    close(TVRC);
    open(NTVRC, "< $tvrc.new");
    local( $newchecksum);
    { local($/); $newchecksum = unpack("%16C*", <NTVRC>); 
    }
    close(NTVRC);
    if ($checksum != $newchecksum) {
	if (&confirmation( "change $tvrc")) {
	    rename("$tvrc", "$tvrc.old");
	    rename("$tvrc.new", "$tvrc");
	}
    }
}
else {
    if (&confirmation( "create $tvrc")) {
	open(TVRC, "> $tvrc") || die "Couldn't open $tvrc\n";
	print TVRC &tvrcdata();
	close (TVRC);
    }
}

# get socket definitions
if (&myRequire('sys/socket.ph')) {
  $AF_INET = &AF_INET;
  $SOCK_STREAM = &SOCK_STREAM;
}
else {
  print "Warning: perl: no sys/socket.ph, using default values\n";
  $AF_INET = 2;
  $SOCK_STREAM = 1;
  $SOCK_STREAM = 2 if ($CPU eq 'SUN5');
  if ($CPU eq 'SGI') {
      local( $cpu, $major) = &machine();
      $SOCK_STREAM = 2 if ($cpu eq 'SGI' && $major >= 5);
  }   
}

$sockaddr = 'S n a4 x8';
$proto = (getprotobyname('tcp'))[2];
{
    local(@arr) = gethostbyname("$updateServerName"); # ($name, $aliases, $type, $len, $uServAddr)
    $uServAddr = $arr[4];
    warn "Warning: $updateServerName unknown. Trying $updateServerAddr.\n" unless $arr[0];
    $uServAddr = sprintf( "%c%c%c%c", ($updateServerAddr =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)) unless $arr[0];
}

# init connection to Hyper-G InstallServer
&InitConnection() || die "Couldn't connect to Hyper-G InstallServer\n";

# fetch files if there are new ones
&FetchFiletable() || die "Couldn't fetch Filetable\n";

if ($doLog) {
  open(ILOG, "> $myName.log.new") ||  die "Couldn't open $myName.log.new\n";
  select(ILOG); $| = 1; select(STDOUT);
}

open(FT, "< $nameFileTable$$") ||  die "Couldn't open $nameFileTable$$\n";
while(<FT>) {
  # make symbolic link
  if (/^\s*<SLINK>\s*(\S+)\s*(\S+)\s*$/o) {
    local( $slink) = $1;
    local( $linkName) = $2;
    $linkName = &substPath( $linkName);
    if ((! -l $linkName) || (readlink($linkName) ne $slink)) {
	if (&confirmation( "create symbolic link $linkName -> $slink")) {
	    unlink( $linkName);
	    symlink( $slink, $linkName);
	    print "\tsymlink\t$slink $linkName\n";
	}
    }
    next;
  }
  # make a directory
  if (/^\s*<DIR>\s*(\S+)\s*$/o) {
    local( $newDir) = $1;
    $newDir = &substPath( $newDir);
    if (!-d $newDir) {
      &MakePath( $newDir);
      print "\tmakedir\t$newDir\n";
    }
    next;
  }
  # unlink a file
  if (/^\s*<UNLINK>\s*(\S+)\s*$/o) {
    local( $file) = $1;
    $file = &substPath( $file);
    if (-f $file) {
	if (&confirmation( "remove $file")) {
	    print "\tunlink\t$file\n";
	    unlink( $file);
	}
    }
    next;
  }
  local($path, $rsize, $rmode, $rmtime, $single) = split;
  defined($path) && defined($rsize) && defined($rmode) && defined($rmtime) || last;
  next if ($single && !($single =~ /^<SINGLE>$/));
  # line is ok
  # create localpath
  local($localpath) = $path;
  $localpath = &substPath( $localpath);
  if ($localpath =~ /^\/usr\/local\/Hyper-G\/.*$/) {
      $localpath =~ s/^\/usr\/local\/Hyper-G\//./ unless $instHyperG;
  }
  next if ($single && -e $localpath);
  if (-l $localpath && &confirmation( "remove $localpath")) {
      unlink( $localpath);
  }
  local($mtime, $size, $mode) = &filetime($localpath);

  local( $upToDate) = 0;
  if (defined($mtime)) {
      if (!$exact && ($mtime > $rmtime)) {
	  # need not install;
	  $upToDate = 1;
      }
      elsif (($mtime == $rmtime) && ($size == $rsize)) {
	  # need not install;
	  $upToDate = 1;
      }
  }

  if ($upToDate) {	# need not install;
      print "    \tup to date\t$localpath\n";
  }
  else {
      if ($changelog) {
	  local($file) = &basename($path);
	  local($ver) = &whatVersion($localpath);
	  local($info) = &fetchChangeLog( $file, $ver);
	  print CLOG "$file $ver -> $info";
      }
      if ($confirm) {
	  while( 1) {
	      local( $resp);
	      print "install $localpath? ([y]/c/n) ";
	      $resp = <STDIN>;
	      if ($resp =~ /^[Cc]/) {
		  local($file) = &basename($path);
		  local($ver) = &whatVersion($localpath);
		  local($info) = &fetchChangeLog($file, $ver);
		  print $info;
	      }
	      else {
		  if ($resp =~ /^[^Yy\n]/ || $nochanges) {
		      $upToDate = 1;
		  }
		  last;
	      }
	  }
      }
      elsif ($nochanges) {
	  print "    \tto install\t$localpath\n";
	  $upToDate = 1;
      }
      if (!$upToDate) {
	  local($d) = &dirname($localpath);
	  die "Error: no directory $d\n" unless (!$d || -d $d);
	  print "    \tpreparing\t$localpath\r";
	  &FetchFile($localpath, $path, $rsize, $rmode) || die "Couldn't fetch $localpath\n";
	  ($mtime, $size, $mode) = &filetime($localpath);
	  if ($path =~ /^bin\/scripts\/$myName$/) {
	      # new hginstprogram installed 
	      $newHgInstProgram = 1;
	  }
      }
  }

  if (!$upToDate) {
      $mode = $mode & 07777;
      if ($mode != oct($rmode) & 07777) {
	  chmod oct($rmode) & 07777, "$localpath";
      }
      if ($mtime != $rmtime) {
	  utime($rmtime, $rmtime, $localpath);
      }
  }
  &log( $localpath);

  last if ($newHgInstProgram);
}
close(FT);
close(ILOG) if $doLog;
close(CLOG) if $changelog;
unlink ("$nameFileTable$$");

close ($conn);

if ($newHgInstProgram) {
    if ($restart) {
	# restart
	print "New $myName installed - restarting $myName @args\n";
	exec( &substPath("bin/scripts/$myName"), @args);
    }
    else {
	print "New $myName installed - check the differencies\n";
	exit(2);
    }
}

if ($doLog) {
  rename("$myName.log", "$myName.log.old");
  rename("$myName.log.new", "$myName.log");
}

print "\nYou can start the client with the command $BINDIR/hgtv\n";
print "\nYou can configure the client by editing the file $pwd/$tvrc\n";
if ($instHyperG) {
    print "\nYou can configure the editcommand by editing the file /usr/local/Hyper-G/hgedit.mnu\n";
    print "    Override this common file by \$HOME/.hgedit.mnu\n";
}
else {
    print "\nYou can configure the editcommand by editing the file $pwd/.hgedit.mnu\n";
}
exit;

sub help {
  return '
    This script installs the Hyper-G client into the homedir of the
    current user or into the directory \'/usr/local/Hyper-G\'. Call the
    script from one of the both directories, or use the switches -home
    or -hyperg


'.&Usage();
}

sub Usage {
  return "
Usage: $0 [options]

        -h[elp]         help
	-home		install into users homedir
	-hype[rg]	install into /usr/local/Hyper-G
        -nore[start]    terminates, if $0 installs itself
        -conf[irm]      confirm each installation ([y]/c/n)
                        c ... retrieves a changelog for this file
        -noch[anges]    don't update installation
        -chan[gelog]    create changelog file 'hginstserver.clog'
";
}

sub tvrcdata {
  return "# Resource file for hgtv
# 1. homedir/.hgtv.rc or 2. /usr/local/Hyper-G/hgtv.rc or default.
# For interpretation see hgtv -v
 
# startcollection
# <ROOT> rootcollection 

# hostname and port of Hyper-G-server 
<HGHOST>hyperg
<HGPORT>418

# Supported Languages: en (english), ge (german), fr (french), st (styrian)
<LANGUAGE>en

# Sort order is an ordered list of letters:
#         -       on 1st position: sort descending (default ascending)
#         #       Sequence Number
#         A       Author
#         C       Creation time
#         E       Expiration time
#         O       Opening time
#         P       Parent (Search only)
#         S       Score (WAIS only)
#         T       Title
#         t       Type (Document, Collection, Anchor...)
<SORTORDER>

# file to log errors
<ERRLOG>

# <SGMLDIR> and <PATH> will be updated by hginstclient
# directory of sgml-config files
<SGMLDIR>$pwd/$SGMLDIR
# path for scripts and binaries used by the client  
<PATH>$pwd/$SCRIPTDIR $pwd/$BINDIR
";
}

sub substPath {
    local( $name) = @_;
    if ($name =~ /^bin\/$CPU\/.*$/) {
	$name =~ s/^bin\/$CPU/$BINDIR/;
    }
    elsif ($name =~ /^bin\/scripts\/.*$/) {
	$name =~ s/^bin\/scripts/$SCRIPTDIR/;
    }
    elsif ($name =~ /^sgml\/.*$/) {
	$name =~ s/^sgml/$SGMLDIR/;
    }
    elsif ($name =~ /^man\/.*$/) {
	$name =~ s/^man/$MANDIR/;
    }
    return $name;
}

sub readbindir {
  local($bindir);
  print "\nPlease enter name of directory for binaries\n";
  print "\t(default: bin/$CPU):";
  $bindir = <STDIN>;  
  print "\n";
  chop($bindir);
  $bindir = "bin/$CPU" unless $bindir;
  return $bindir;
}

sub readscriptdir {
  local($scriptdir);
  print "\nPlease enter name of directory for scripts\n";
  print "\t(default: bin/scripts):";
  $scriptdir = <STDIN>;  
  print "\n";
  chop($scriptdir);
  $scriptdir = "bin/scripts" unless $scriptdir;
  return $scriptdir;
}

sub readsgmldir {
  local($sgmldir);
  print "\nPlease enter name of directory for sgml definitions\n";
  print "\t(default: sgml):";
  $sgmldir = <STDIN>;  
  print "\n";
  chop($sgmldir);
  $sgmldir = "sgml" unless $sgmldir;
  return $sgmldir;
}

sub readmandir {
  local($mandir);
  print "\nPlease enter name of directory for manual pages\n";
  print "\t(default: man):";
  $mandir = <STDIN>;  
  print "\n";
  chop($mandir);
  $mandir = "man" unless $mandir;
  return $mandir;
}

# common functions

sub InitConnection {
  $this = pack($sockaddr, $AF_INET, 0, '');
  $that = pack($sockaddr, $AF_INET, $port, $uServAddr);
# Make the socket filehandle.
  socket($conn, $AF_INET, $SOCK_STREAM, $proto) || 
    die "socket: $!";
# Give the socket an address.
  bind($conn, $this) || die "bind: $!";
# Call up the server.
  connect($conn, $that) || die "Couldn't connect to $uServAddr $port\n$!\n";
# Set socket to be command buffered.
  select($conn); $| = 1; select(STDOUT);
# wait until accepted.
  if ($waitAccept) {
      local($ok) = 0;
      $_ = '';
      syswrite($conn, "x\n", 2) || die "testing connection: $!\n";
      while (sysread($conn, $_, 1024)) {
	  if (/^accepted$/) {
	      $ok = 1;
	      last;
	  }
	  if (/^not accepted$/) {
	      local( $uname, $uninfo);
	      $uname = &which('uname');
	      $uninfo = 'uname not found' unless $uname;
	      chop( $uninfo = `$uname -a`) if $uname;
	      &sockPrint( $conn, "CPU $CPU $uninfo\n");
	      die "Install not allowed. Mail to $mailRegister.\n";
	  }  
      }
      die "Broken connection: $!\n" unless $ok;
  }
  local($gunzip) = &which('gunzip');
  if ($gunzip) {
      &sockPrint( $conn, "use_gzip\n");
      $uncomprComm = "$gunzip -S .Z";
  }
  if ($beta) {
      &sockPrint( $conn, "install_beta\n");
  }
  return 1;
}

sub FetchFiletable {
  print "\tpreparing\tinfo about files\r";

  if ($reqCPU) {
    &sockPrint( $conn, "$reqFileTable $CPU\n");
  }
  else {
    &sockPrint( $conn, "$reqFileTable\n");
  }
  sysread($conn, $_, 1024);
  local(@answer) = split;
  local($what, $binport, $checksum);
  defined ($what = shift(@answer)) || die "connection out of sync\n";
  $what =~ /^$reqFileTable$/ || die "connection out of sync\n";
  defined ($what = shift(@answer)) || die "connection out of sync\n";
  $what =~ /^PORT$/ || die "connection out of sync\n";
  defined ($binport = shift(@answer)) || die "connection out of sync\n";
  return(0) unless $binport;
  if ($doCheckSum) {
    defined ($checksum = shift(@answer)) || die "connection out of sync\n";
  }
  $this = pack($sockaddr, $AF_INET, 0, '');
  $that = pack($sockaddr, $AF_INET, $binport, $uServAddr);
# Make the socket filehandle.  
  socket(BS, $AF_INET, $SOCK_STREAM, $proto) || die "socket: $!";
# Give the socket an address.
  bind(BS, $this) || die "bind: $!";
# Call up the server.
  connect(BS, $that) || die $!;
  syswrite(BS, "x", 1) || die "testing connection: $!\n";
  open(FILESTR, "> $nameFileTable$$.Z");
  print "\tretrieving\tinfo about files\r";
  &cpDescr('BS','FILESTR');
  close(BS);
  close(FILESTR);
  if ($doCheckSum) {
    open(FILESTR, "< $nameFileTable$$.Z");
    local( $mychecksum);
    { local($/); $mychecksum = unpack("%16C*", <FILESTR>); 
    }
    close(FILESTR);
    die "Fatal: wrong checksum\n" if ($checksum != $mychecksum);
  }
  unlink("$nameFileTable$$");
  `$uncomprComm $nameFileTable$$.Z`;

  print "\tretrieved \tinfo about files\n";

  return 1; 
}

sub FetchFile {
  local($localpath, $path, $size, $mode) = @_;
  &sockPrint( $conn, "$reqFile $path\n");
  sysread($conn, $_, 1024);
  local(@answer) = split;
  local($what, $binport, $checksum, $szCompr);
  defined ($what = shift(@answer)) || die "connection out of sync\n";
  $what =~ /^$reqFile$/ || die "connection out of sync\n";
  defined ($what = shift(@answer)) || die "connection out of sync\n";
  $what =~ /^PORT$/ || die "connection out of sync\n";
  defined ($binport = shift(@answer)) || die "connection out of sync\n";
  return(0) unless $binport;
  if ($doCheckSum) {
    defined ($checksum = shift(@answer)) || die "connection out of sync\n";
  }
  $szCompr = shift(@answer);
  $this = pack($sockaddr, $AF_INET, 0, '');
  $that = pack($sockaddr, $AF_INET, $binport, $uServAddr);
# Make the socket filehandle.  
  socket(BS, $AF_INET, $SOCK_STREAM, $proto) || die "socket: $!";
# Give the socket an address.
  bind(BS, $this) || die "bind: $!";
# Call up the server.
  connect(BS, $that) || die "connect: $!";
  syswrite(BS, "x", 1) || die "testing connection: $!\n";
  open(FILESTR, "> Tmp$$.Z");

  print "  0%\tretrieving\t$localpath\r";

  &cpDescrProgr('BS','FILESTR',$szCompr);

  print "    \tinstalling\t$localpath\r";

  close(BS);
  close(FILESTR);
  if ($doCheckSum) {
    open(FILESTR, "< Tmp$$.Z");
    local( $mychecksum);
    { local($/); $mychecksum = unpack("%16C*", <FILESTR>); 
    }
    close(FILESTR);
    die "Fatal: wrong checksum\n" if ($checksum != $mychecksum);
  }
  `$uncomprComm Tmp$$.Z`;
  if (-s "Tmp$$" == $size) {
    rename("$localpath", "$localpath.old") if -e "$localpath";
    `cp Tmp$$ $localpath`;
    chmod oct($mode) & 07777,  "$localpath";
    unlink("Tmp$$");

    print "    \tinstalled \t$localpath\n";

    return 1; 
  }
  else {
    unlink("Tmp$$");

    print "\n";

    return 0;
  }
}

sub readcpu {
  local($CPU);

  $CPU = $ENV{'CPU'};
  if (!defined($CPU)) {
      $CPU = (&machine())[0];
      print "\nYour machine type is $CPU\n";
  }
  return $CPU if (grep( /^$CPU$/, @cpuSupp));
  die "$myName: Architecture $CPU not yet supported!\n";
}

sub filetime {
  local($file) = @_;
  local(@arr) = stat("$file");	# ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev,
			      	# $size, $atime, $mtime, $ctime, $blksize, $blocks)
  local(@result) = ($arr[9], $arr[7], $arr[2]);	# ($mtime, $size, $mode)
  @result;
}

sub MakePath {
  local($path) = @_;
  local(@parts) = split(m;/;, $path);
  local($onpath) = "";
  local($nextdir);
  while(defined($nextdir = shift(@parts))) {
    $onpath .= $nextdir;
    &MakeDir($onpath);
    $onpath .= '/';
  }
}

sub MakeDir {
  local($dir) = @_;
  -f $dir && die "$dir must be a directory\n";
  return if (-d $dir);
  if (&confirmation( "create directory $dir")) {
      mkdir($dir, 0755) || die "Couldn't make directory $dir\n";
  }
}

sub myRequire {
  local($fileName) = @_;
  return 1 if $INC{$fileName};
  local($realFileName, $result);
 ITER: {
   foreach $prefix (@INC) {
     $realFileName = "$prefix/$fileName";
     if (-f $realFileName) {
       $result = do $realFileName;
       last ITER;
     }
   }
   return(0);
 }
  die $@ if $@;
  return(0) unless $result;
  $INC{$fileName} = $realFileName;
  $result;
}

sub cpDescr {
  local($from, $to) = @_;
  local($len, $buf) = (0, '');
  while (1) {
    $len = sysread($from, $buf, 1024);
    if (!defined $len) {
      next if $! =~ /^Interrupted/;
      die "System read error: $!\n";
    }
    last unless $len;
    print "len: $len\n" if $verbose;
    local($offset) = 0;
    while ($len) {
      local($written) = syswrite($to, $buf, $len, $offset);
      die "System write error: $!\n"
	unless defined $written;
      print "written: $written\n" if $verbose;
      $len -= $written;
      $offset += $written;
    }
  }
}

sub cpDescrProgr {
  local($from, $to, $size) = @_;
  local($len, $buf, $lsize) = (0, '', 0);
  while (1) {
    $len = sysread($from, $buf, 1024);
    if (!defined $len) {
      next if $! =~ /^Interrupted/;
      die "System read error: $!\n";
    }
    last unless $len;
    print "len: $len\n" if $verbose;
    local($offset) = 0;
    while ($len) {
      local($written) = syswrite($to, $buf, $len, $offset);
      die "System write error: $!\n"
	unless defined $written;
      print "written: $written\n" if $verbose;
      if ($size) {
	$lsize += $written;
	printf( "%3d%%\r", $lsize * 100 / $size);
      }
      $len -= $written;
      $offset += $written;
    }
  }
}

sub basename {
  local($path) = @_;
  
  return '' unless $path =~ m,(^|/)([^/]+)$,;
  return $2;
}

sub dirname {
  local($path) = @_;
  
  return '' unless $path =~ m,(^|^.*/)([^/]+)$,;
  return $1;
}

sub log {
    local($path) = @_;
    return unless $doLog;
    local($info) = 0;
    if (open(WHAT, "< $path")) {
	local($/) = '@(#)';
	local($x);
	$x = <WHAT>; 
	while(<WHAT>) {
	    if (/([^\n\0]*)/) {
		$x = $1;
		($x =~ /^\s*\[Hyper-G\]/) && (print(ILOG $path, "\t$x\n"), ($info = 1));
		($x =~ /^\s*\[GDS\]/) && (print(ILOG $path, "\t$x\n"), ($info = 1));
	    }
	}
	close(WHAT);
    }
    print ILOG $path, "\tNOINFO\n" unless $info;
}
 
sub hgLinkDir {
  local($dirName) = @_;
  local($src,$dst) = ("/usr/local/Hyper-G/$dirName", "$hdir/$dirName");

  if (-l "$src") {
      if (readlink("$src") eq "$dst") {
	  return(1);
      }
      else {
	  if (!&confirmation("unlink invalid symbolic link $src")) {
	      return(1);
	  }
	  unlink( "$src") || die "unlink invalid symbolic link $src: $!\n";
      }
  }

  -f "$src" && die "$src must be a directory\n";

  return(1) if (-d "$src");
  if (!&confirmation( "create symbolic link $src -> $dst")) {
      return(1);
  }
  symlink("$dst", "$src") 
      || die "create symbolic link $src --> $dst: $!\n";
  return(1);
}
  
sub machine {
  local( $uname, $sysname, $release);
  $uname = &which('uname') || die "uname not found\n";
  
  chop( $sysname = `$uname -s`) || die "no sysinfo from uname -s\n";
  chop( $release = `$uname -r`) || die "no release from uname -r\n";

  if ($sysname =~ /^HP-UX$/) {
    local($major, $minor) = ($release =~ /^A.([0-9]+)\.([0-9]+)/);
    if ($major < 8) {
      print "Major OS release must be at least 8 for HP-UX.\n";
      return ();
    }
    return ('HPUX', 8) if $major == 8;
    return ('HPUX9', 9) if $major == 9;
    print "Major OS release greater than 9 is not supported for HP-UX.\n";
  }
  elsif ($sysname =~ /^SunOS$/) {
    local($major, $minor) = ($release =~ /^([0-9]+)\.([0-9]+)/);
    if ($major < 4) {
      print "Major OS release must be at least 4 for SunOS.\n";
      return ();
    }
    return ('SUN4', 4) if $major == 4;
    return ('SUN5', 5) if $major == 5;
    print "Major OS release greater than SunOS 5 not supported.\n";
  }
  elsif ($sysname =~ /^ULTRIX$/) {
    local($major, $minor) = ($release =~ /^([0-9]+)\.([0-9]+)/);
    if ($major < 4) {
      print "Major OS release must be at least 4 for ULTRIX.\n";
      return ();
    }
    return ('PMAX', 4) if $major == 4;
    print "Major OS release greater than ULTRIX 4 not supported!\n";
  }
  elsif ($sysname =~ /^IRIX$/) {
    local($major, $minor) = ($release =~ /^([0-9]+)\.([0-9]+)/);
    print "Warning: Hyper-G may not work properly on $sysname $release.\n" if $major == 4;
    return ('SGI', $major);
  }
  elsif ($sysname =~ /^OSF1$/) {
    local($major, $minor) = ($release =~ /^V([0-9]+)\.([0-9]+)/);
    print "Warning: Hyper-G may not work properly on $sysname $release.\n" if $major < 2;
    return ('ALPHA_OSF1', $major);
  }
  elsif ($sysname =~ /^Linux$/) {
    local($major, $minor) = ($release =~ /^([0-9]+)\.([0-9]+)/);
    print "Warning: Hyper-G may not work properly on $sysname $release.\n" if $major != 1;
    return ('LINUX', $major);
  }
  else {
    print "$sysname not yet supported.\n";
  }
  return ();
}

sub which {
  local( $prog) = @_;
  local(@path) = split( /:/, $ENV{'PATH'});
  while(defined($p = shift(@path))) {
    $p .= '/' . $prog;
    return $p if (-x $p) && (-f $p);
  }
  return '';
}

sub Pwd {
    local($pwd);
    local($dd,$di) = stat('.');
    chop($pwd = `pwd`);
    die "Pwd:pwd empty\n" if (!$pwd);
    chdir( $pwd) || die "Pwd:chdir current:$!\n";
    local($pd,$pi) = stat('.');
    die "Pwd:dev or ino not equal\n" if ($di != $pi || $dd != $pd);
    return $pwd;
}

sub sockPrint {
    local( $conn, $str) = @_;
    syswrite($conn, $str, length($str));
}

sub whatVersion {
  local($file) = @_;
  local($version) = '';
  return $version unless -f $file;
  if (open(WHAT, "< $file")) {
      local($/) = '@(#)';
      local($x);
      $x = <WHAT>; 
      while(<WHAT>) {
	  if (/([^\n\0]*)/) {
	      $x = $1;
	      ($x =~ /\[Hyper-G\]\s+\[[^\]]+\]\s+\S+\s+(\S+)/) && ($version = $1);
	  }
      }
      close(WHAT);
  }
  return $version;
}

sub confirmation {
    local( $out) = @_;
    local( $resp);
    return(0) if ($nochanges);
    return(1) if (!$confirm);
    print "$out? ([y]/n) ";
    $resp = <STDIN>;
    return(($resp =~ /^[^Yy\n]/) ? 0 : 1);
}

sub readDescr {
    local( $from, $len) = @_;
    local( $currlen, $buf, $currbuf) = (0, '', '');
    while(1) {
	return( $buf) unless ($len > 0);
	$currbuf = '';
	$currlen = sysread( $from, $currbuf, $len);
	if (!defined $currlen) {
	    next if $! =~ /^Interrupted/;
	    die "System read error: $!\n";
	}
	die "readDescr: out of sync\n" unless ($currlen > 0);
	$len -= $currlen;
	$buf .= $currbuf;
    }
}

sub fetchChangeLog {
    local( $file, $ver) = @_;
    &sockPrint( $conn, "ChangeLog $file $ver\n");
    local($len, $buf) = (0, '');
    $buf = &readDescr( $conn, 21);
    if ($buf =~ /^ChangeLog (0x[0-9a-f]+) $/) {
	local($infoLen) = hex($1) +1;
	$buf = &readDescr( $conn, $infoLen);
	return($buf);
    }
    die "connection out of sync (ChangeLogInfo)\n";
}

.