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] hginstserver	1.32 [server 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:       hginstserver.pl
#
# Purpose:    Installation and update of the Hyper-G Server 
#
# Created:       Mai 93    Gerald Pani
#
# Modified:   16 Nov 93    Gerald Pani
# Modified:   31 Jan 94    Gerald Pani
#		Version: 1.01 + directory ftserver
# Modified:    1 Feb 94    Gerald Pani
#		Version: 1.02 + unlink of files
# Modified:    2 Mar 94    Gerald Pani
#		Version: 1.03 + GOPHHOST
# Modified:    7 Mar 94    Gerald Pani
#		Version: 1.04 + directory contrib
# Modified:    5 Apr 94    Gerald Pani
#		Version: 1.05 + directory dcserver
# Modified:   20 Apr 94    Gerald Pani
#		Version: 1.06 + new cpu retrieving function (+machine, +which, -archdata)
#                             + readgophhost
# Modified:    5 Sep 94    Gerald Pani
#		Version: 1.07 + SUN5 supported
# Modified:   19 Sep 94    Gerald Pani
#		Version: 1.08 + directory dcserver/cache
# Modified:    5 Oct 94    Gerald Pani
#		Version: 1.10 + new option '-norestart'
# 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:   13 Dec 94    Gerald Pani    1.15 '<ROOT>' removed from hgtv.rc
# Modified:   17 Jan 95    Gerald Pani    1.16 sub Pwd
# Modified:   19 Jan 95    Gerald Pani    1.17 supports Linux
# Modified:   24 Jan 95    Gerald Pani    1.18 hgLinkDir changed
# Modified:   14 Feb 95    Gerald Pani    1.19 SOCK_STREAM default for Irix 5.x, no Perl 5 warnings
# Modified:   15 Mar 95    Gerald Pani    1.20 bug fixed
# Modified:   16 Mar 95    Gerald Pani    1.21 use syswrite/sysread for I/O on sockets
#             o 'test' of connections (write on socket) after each connect
#               (kicks a pending 'SYN_ACK' into net - bug of Solaris?)
# Modified:   17 Mar 95    Gerald Pani    1.22 bug fixed
# Modified:   19 Apr 95    Gerald Pani    1.23 bug fixed
# Modified:   18 May 95    Gerald Pani    1.24 option 'confirm', ChangeLog info
# Modified:   24 May 95    Gerald Pani    1.25 confirmation for all changes, options 'nochanges', 'changelog'
# Modified:   26 May 95    Gerald Pani    1.26 bug fixed
# Modified:    2 Aug 95    Gerald Pani    1.27 bug fixed
# Modified:   13 Oct 95    Gerald Pani    1.28 use evironment variable HYPERG_HOME
# Modified:   16 Oct 95    Gerald Pani    1.30 no registration necessary
# Modified:   19 Oct 95    Gerald Pani    1.31 creates 'file.new.date' and 'file.old.date'
#                                              (changeable recommended and required files)
# Modified:   20 Oct 95    Gerald Pani    1.32 bug fixed
#
# Description:
# 
# This script installs the Hyper-G server into the homedir of the
# current user. Call the script whit no option from the homedir.
# 
#</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
@limCore = ('SUN4', 'PMAX');		# limit core size
$reqFile = 'FetchFile';
$reqFileTable = 'FetchFiletable';
$reqCPU = 1;
$nameFileTable = '.Filetable';
$conn = 'S';
$doCheckSum = 1;
$waitAccept = 0;
$doLog = 1;
$port = 5004;
$myName = &basename( $0);
$uncomprComm = 'uncompress';
$beta = 0;
$exact = 0;
$confirm = 0;
$nochanges = 0;
$changelog = 0;

select(STDOUT); $| = 1;

# parse any switches
@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 =~ /^-norestart$/) && ($restart = 0, next); # no restart, if script install itself
	($arg =~ /^-beta$/) && ($beta = 1, next); # fetch beta versions
	($arg =~ /^-exact$/) && ($exact = 1, next); # fetch exact versions
	($arg =~ /^-exac$/) && ($exact = 1, next); # fetch exact versions
	($arg =~ /^-conf/) && ($confirm = 1, next); # confirm installations
	($arg =~ /^-noch/) && ($nochanges = 1, next);
	($arg =~ /^-chan/) && ($changelog = 1, next); # creates hginstserver.clog
	die &Usage();
    }
}

# check install directory
# currentdir equal homedir
$pwd = &Pwd();
chdir() || die "Couldn't find homedirectory\n";
$hdir = &Pwd();
$pwd eq $hdir || die "Current directory is not homedirectory.\n";

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

# check platform
($CPU = &readcpu()) || exit(1);
$ENV{'CPU'} = $CPU;

# check serverstring
$servstring = $ENV{'HGServerString'};
defined($servstring) || ($servstring = &readservstring()) || die "No HGServerString defined\n";
$ENV{'HGServerString'} = $servstring;

# check hostname
$hostname = `hostname` || die "Couldn't find hostname\n";
chop($hostname);

# check gophhost
$gophHost = $ENV{'GOPHHOST'};
defined($gophHost) || ($gophHost = &readgophhost()) || die "No full internet host name defined\n";
$ENV{'GOPHHOST'} = $gophHost;

#set umask
umask(022);

# make or check directories

# check /usr/local/Hyper-G
$hypergHome = $ENV{'HYPERG_HOME'} || '/usr/local/Hyper-G';
$instHyperG = 1;
-e "$hypergHome" 
  || ((print "Warning: $hypergHome doesn't exist\n") && ($instHyperG = 0));
!$instHyperG || -d "$hypergHome" 
  || ((print "Warning: $hypergHome must be a directory\n") && ($instHyperG = 0));
!$instHyperG || -r "$hypergHome" 
  || ((print "Warning: no read access to $hypergHome\n") && ($instHyperG = 0));
!$instHyperG || -w "$hypergHome" 
  || ((print "Warning: no write access to $hypergHome\n") && ($instHyperG = 0));

# check ~/bin
&MakePath('sgml');
&MakePath('samples');
&MakePath('contrib');
&MakePath('man');
&MakePath('doc');
&MakePath("bin/$CPU");
&MakePath('bin/scripts');

# check ~/server
-f "server" && die "server must be a directory\n";
-d "server" || mkdir("server", 0700) || die "Couldn't make directory server\n";
# chmod(0700, "server");

# check ~/HTF
-f "HTF" && die "HTF must be a directory\n";
-d "HTF" || mkdir("HTF", 0700) || die "Couldn't make directory HTF\n";
# chmod(0700, "HTF");

# check ~/ftserver
-f "ftserver" && die "ftserver must be a directory\n";
-d "ftserver" || mkdir("ftserver", 0700) || die "Couldn't make directory ftserver\n";
# chmod(0700, "ftserver");

# check ~/dcserver
-f "dcserver" && die "dcserver must be a directory\n";
-d "dcserver" || mkdir("dcserver", 0700) || die "Couldn't make directory dcserver\n";
# chmod(0700, "dcserver");

&MakePath('dcserver/local');
&MakePath('dcserver/cache');

if ($instHyperG) {
    chdir( "$hypergHome") || die "Can't change to $hypergHome: $!\n";
    local( $pwd) = &Pwd();
    chdir();
    if ($hdir ne $pwd) {
	&hgLinkDir('bin');
	&hgLinkDir('sgml');
	&hgLinkDir('samples');
	&hgLinkDir('contrib');
	&hgLinkDir('man');
	&hgLinkDir('doc');
    }
  
    if ( !-f "$hypergHome/hgtv.rc") {
	if (&confirmation( "create $hypergHome/hgtv.rc")) {
	    open(TVRC, "> $hypergHome/hgtv.rc") || die "Couldn't open $hypergHome/hgtv.rc\n";
	    print TVRC &tvrcdata();
	    close (TVRC);
	}
    }
}
else {
    if ( !-f ".hgtv.rc") {
	if (&confirmation( "create .hgtv.rc")) {
	    open(TVRC, "> .hgtv.rc") || die "Couldn't open .hgtv.rc\n";
	    print TVRC &tvrcdata();
	    close (TVRC);
	}
    }
}

# make .hgrc
open(HGRC, "> .hgrc.new") || die "Couldn't create .hgrc.new\n";
print HGRC '# hgrc Hyper-G resourcefile', "\n";
print HGRC '# @','(#)[Hyper-G] [HGS-CF] .hgrc	1.00 [server configuration file] [Gerald Pani]', "\n";
print HGRC 'setenv HGRC true', "\n";
print HGRC "umask 022\n";
print HGRC "unset noclobber\n";
print HGRC "setenv CPU $CPU\n";
print HGRC 'set path=(~/bin/scripts ~/bin/$CPU $path)', "\n";
print HGRC 'setenv DIRserver $HOME/server', "\n";
print HGRC 'setenv DIRhtf $HOME/HTF', "\n";
print HGRC 'setenv DIRfts $HOME/ftserver', "\n";
print HGRC 'setenv DIRdcs $HOME/dcserver', "\n";
# print HGRC 'if ( $?MANPATH) then', "\n";
# print HGRC '  setenv MANPATH \"${MANPATH}:${HOME}/man/man1\"', "\n";
# print HGRC 'else', "\n";
# print HGRC '  setenv MANPATH \"${HOME}/man/man1\"', "\n";
# print HGRC 'endif', "\n";
print HGRC "setenv DBHost $hostname\n";
print HGRC "setenv HGHOST $hostname\n";
print HGRC "setenv HGServerString \"$servstring\"\n";
print HGRC "setenv GOPHHOST \"$gophHost\"\n" if $gophHost;
print HGRC "limit coredumpsize 0\n" if (grep( /^$CPU$/, @limCore));
close(HGRC);


if (-f ".hgrc") {
    open(HGRC, "< .hgrc");
    local( $checksum, $newchecksum);
    { local($/); $checksum = unpack("%16C*", <HGRC>); 
    }
    close(HGRC);
    open(HGRC, "< .hgrc.new");
    local( $newchecksum);
    { local($/); $newchecksum = unpack("%16C*", <HGRC>); 
    }
    close(HGRC);
    if ($checksum != $newchecksum) {
	if (&confirmation( "change .hgrc")) {
	    rename( ".hgrc", ".hgrc.old");
	    rename( ".hgrc.new", ".hgrc");
	}
    }
}
else {
    if (&confirmation( "create .hgrc")) {
	rename( ".hgrc.new", ".hgrc");
    }
}

# adjust or make .cshrc
if (open(CSHRC, "< .cshrc")) {
    open(NCSHRC, "> .cshrc.new") || die "Couldn't create .cshrc.new\n";
    local( $inserted) = 0;
    while (<CSHRC>) {
	next if (/^\s*#\s*Hyper-G\s+resourcefile\s*$/);
	next if (/^\s*#\s*@\(#\)\[Hyper-G\] .*$/);
	if (/^\s*source\s+~\/.hgrc\s*$/o) {
	    print NCSHRC '# Hyper-G resourcefile', "\n";
	    print NCSHRC '# @','(#)[Hyper-G] [HGS-CF] .cshrc	1.00 [ADDITION csh conf.] [Gerald Pani]', "\n";
	    $inserted = 1;
	}
	print NCSHRC $_;
    }

    if (! $inserted) {
	print NCSHRC '# Hyper-G resourcefile';
	print NCSHRC "\n";
	print NCSHRC '# @','(#)[Hyper-G] [HGS-CF] .cshrc	1.00 [ADDITION csh conf.] [Gerald Pani]', "\n";
	print NCSHRC 'source ~/.hgrc';
	print NCSHRC "\n";
    }
    close(NCSHRC);
    close(CSHRC);

    open(CSHRC, "< .cshrc");
    local( $checksum, $newchecksum);
    { local($/); $checksum = unpack("%16C*", <CSHRC>); 
    }
    close(CSHRC);
    open(CSHRC, "< .cshrc.new");
    local( $newchecksum);
    { local($/); $newchecksum = unpack("%16C*", <CSHRC>); 
    }
    close(CSHRC);
    if ($checksum != $newchecksum) {
	if (&confirmation( "change .cshrc")) {
	    rename( ".cshrc", ".cshrc.old");
	    rename( ".cshrc.new", ".cshrc");
	}
    }
}
else {
    open(NCSHRC, "> .cshrc.new") || die "Couldn't create .cshrc.new\n";
    print NCSHRC "\n";
    print NCSHRC '# Hyper-G resourcefile';
    print NCSHRC "\n";
    print NCSHRC 'source ~/.hgrc';
    print NCSHRC "\n";
    close(NCSHRC);
    if (&confirmation( "create .cshrc")) {
	rename(".cshrc.new", ".cshrc");
    }
}

# 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 = pack("C4", ($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, $instMode) = split;
  defined($path) && defined($rsize) && defined($rmode) && defined($rmtime) || last;
  # 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;
  }

  local($old) = 'old';
  if ($instMode) {
      if ($instMode =~ /^<SINGLE_REQUIRED_(\d+\.\d+)>$/) {
	  local($required) = $1;
	  if (-e $localpath) {
	      local($ver) = &whatVersion($localpath);
	      $ver = 0.00 unless $ver;
	      if ($required > $ver) {
		  local( @timearr) = localtime( time);
		  local( $mday, $mon, $year) = splice(@timearr, 3, 3);
		  $old = sprintf( "old.%02d%02d%02d", $year, $mon +1, $mday);
	      }
	      else {
		  next;
	      }
	  }
      }
      elsif ($instMode =~ /^<SINGLE_RECOMMENDED_(\d+\.\d+)>$/)  {
	  local($recommended) = $1;
	  if (-e $localpath) {
	      local($ver) = &whatVersion($localpath);
	      $ver = 0.00 unless $ver;
	      if ($recommended > $ver) {
		  if (-e "$localpath.recommended") {
		      local($ver) = &whatVersion("$localpath.recommended");
		      $ver = 0.00 unless $ver;
		      if ($recommended > $ver) {
			  $localpath = "$localpath.recommended";
		      }
		      else {
			  next;
		      }
		  }
		  else {
		      $localpath = "$localpath.recommended";
		  }
	      }
	      else {
		  next;
	      }
	  }
      }
      elsif ($instMode =~ /^<SINGLE>$/) {
	  next if (-e $localpath);
      }
      else {
	  next;
      }
  }
  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, $old) || 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");
}

exit;

sub help {
  return '
    This script installs the Hyper-G server into the homedir of the
    current user. Invoke it from your homedir.

'.&Usage();
}

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

        -h[elp]         help
        -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 substPath {
   local( $name) = @_;
   return $name;
}
    
sub readservstring {
  local($ss);
  print "Hyper-G ServerString:";
  $ss = <STDIN>;
  print "\n";
  chop($ss);
  return $ss;
}

sub readgophhost {
  local($ss);
  print "Full internet host name of this machine:";
  $ss = <STDIN>;
  print "\n";
  chop($ss);
  return $ss;
}

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

# hostname and port of Hyper-G-server 
<HGHOST>$hostname
<HGPORT>4000

# Supported Languages: english, german, styrian
<LANGUAGE>english

# Sort order is an ordered list of letters:
#         -       on 1st position: sort descending (default ascending)
#         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>

# directory of sgml-config files
<SGMLDIR>$pwd/sgml
# path for scripts and binaries used by the client  
<PATH>$pwd/bin/scripts $pwd/bin/$CPU
";
}

# 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 ", join('.', unpack("C4", $uServAddr)), " $port\n$!\n";
# Set socket to be command buffered.
  select($conn); $| = 1; select(STDOUT);
# wait until accepted.
  $_ = '';
  syswrite($conn, "x\n", 2) || die "testing connection: $!\n";
  if ($waitAccept) {
      local($ok) = 0;
      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 (1)\n";
  $what =~ /^$reqFileTable$/ || die "connection out of sync (2)\n";
  defined ($what = shift(@answer)) || die "connection out of sync (3)\n";
  $what =~ /^PORT$/ || die "connection out of sync (4)\n";
  defined ($binport = shift(@answer)) || die "connection out of sync (5)\n";
  return(0) unless $binport;
  if ($doCheckSum) {
    defined ($checksum = shift(@answer)) || die "connection out of sync (6)\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, $old) = @_;
  &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) = ("$hypergHome/$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";
}

.