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.35 [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
# Modified:   20 Oct 95    Gerald Pani    1.33 two update servers
# Modified:   24 Jan 96    Gerald Pani    1.34 OFFHOSTNAME, DIRdbs, DIRhgs
# Modified:   26 Jan 96    Gerald Pani    1.35 bug fixed: syntax error
#
# 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';

@updateServers = ( 'fiicmss04.tu-graz.ac.at 129.27.153.27', 'fiicmss01.tu-graz.ac.at 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 offHostName
$offHostName = $ENV{'OFFHOSTNAME'} || $ENV{'GOPHHOST'};
defined($offHostName) || ($offHostName = &readOffHostName()) || die "No full internet host name defined\n";
$ENV{'OFFHOSTNAME'} = $offHostName;

#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 ~/dbserver
$useOldDIRdbs = 0;
if (! -d "dbserver") {
    if (-d "server") {
	print( "Warning: using $hdir/server instead of $hdir/dbserver for DIRdbs\n");
	print( "\tTo avoid this message: stop the server, rename this directory,\n");
	print( "\tinvoke hginstserver, 'source ~/.hgrc' and restart the server.\n");
	$useOldDIRdbs = 1;
    }
    else {
	-f "dbserver" && die "dbserver must be a directory\n";
	mkdir("dbserver", 0700) || die "Can't create directory dbserver\n";
    }
}
# -f "server" && die "server must be a directory\n";
# -d "server" || mkdir("server", 0700) || die "Couldn't make directory server\n";

# check ~/HTF
$useOldDIRhgs = 0;
if (! -d "hgserver") {
    if (-d "HTF") {
	print( "Warning: using $hdir/HTF instead of $hdir/hgserver for DIRhgs\n");
	print( "\tTo avoid this message: stop the server, rename this directory,\n");
	print( "\tinvoke hginstserver, 'source ~/.hgrc' and restart the server.\n");
	$useOldDIRhgs = 1;
    }
    else {
	-f "hgserver" && die "hgserver must be a directory\n";
	mkdir("hgserver", 0700) || die "Can't create directory hgserver\n";
    }
}
# -f "HTF" && die "HTF must be a directory\n";
# -d "HTF" || mkdir("HTF", 0700) || die "Couldn't make directory HTF\n";

# 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);
	}
    }
}

# adjust or create .hgrc
if (-f ".hgrc") {
    if (!&readHGRC( ".hgrc")) {
	&createHGRC( ".hgrc.recommended");
	if (&confirmation( "change .hgrc")) {
	    rename( ".hgrc", ".hgrc.old");
	    rename( ".hgrc.recommended", ".hgrc");
	}
    }
}
else {
    &createHGRC( ".hgrc.recommended");
    if (&confirmation( "create .hgrc")) {
	rename( ".hgrc.recommended", ".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];
@uServAddrs = ();
{
    while (1) {
	local($name, $addr) = split(/ /, shift(@updateServers));
	last unless ($name && $addr);
	local(@arr) = gethostbyname($name); # ($name, $aliases, $type, $len, $uServAddr)
	local($uServAddr) = $arr[4];
	warn "Warning: $name unknown. Trying $addr.\n" unless $arr[0];
	$uServAddr = pack("C4", ($addr =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)) unless $arr[0];
	push(@uServAddrs, $uServAddr);
    }
}

# 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 readOffHostName {
  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, '');

  local($taddr) = shift(@uServAddrs);
  die "Error: no update server specified\n" unless $taddr;

  local($cconn) = 'C00';

  local($tconn) = $cconn++;
  socket($tconn, $AF_INET, $SOCK_STREAM, $proto) || 
      die "socket: $!";
  bind($tconn, $this) || die "bind: $!";
  $that = pack($sockaddr, $AF_INET, $port, $taddr);

  local($ttime) = time;
  local($tret) = connect($tconn, $that);
  $ttime = time - $ttime;
  local($terr) = $!;
  local($error);
  $error = "Couldn't connect to " . join('.', unpack("C4", $taddr)) . " $port\n\t$terr\n" unless $tret;
  close($tconn) unless $tret;

  local($saddr);
  while ($saddr = shift(@uServAddrs)) {
      local($sconn) = $cconn++;
      socket($sconn, $AF_INET, $SOCK_STREAM, $proto) || 
	  die "socket: $!";
      bind($sconn, $this) || die "bind: $!";
      $that = pack($sockaddr, $AF_INET, $port, $saddr);
      local($stime) = time;
      local($sret) = connect($sconn, $that);
      $stime = time - $stime;
      local($serr) = $!;
      close($sconn) unless $sret;
      $error .= "Couldn't connect to " . join('.', unpack("C4", $saddr)) . " $port\n\t$serr\n" unless $sret;

      if ($tret && (!$sret || $ttime <= $stime)) {
	  close($sconn);
      }
      elsif ($sret && (!$tret || $stime < $ttime)) {
	  close($tconn);
	  $tconn = $sconn;
	  $taddr = $saddr;
	  $tret = $sret;
	  $ttime = $stime;
      }
  }

  if (!$tret) {
      print $error;
      exit(1);
  }

  $conn = $tconn;
  $uServAddr = $taddr;

# Set socket to be command buffered.
  select($conn); $| = 1; select(STDOUT);
# wait until accepted.
  $_ = '';
  &cleanSysWrite($conn, "x\n", 2);
  if ($waitAccept) {
      local($ok) = 0;
      while (&cleanSysRead($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");
  }
  $_ = '';
  &cleanSysRead($conn, *_, 1024) while !$_;
  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 $!;
  &cleanSysWrite(BS, "x", 1);
  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");
  &cleanSysRead($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: $!";
  &cleanSysWrite(BS, "x", 1);
  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) = @_;
    &cleanSysWrite($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 cleanSysRead {
    local( $from, *buffer, $len) = @_;
    local( $currlen) = 0;
    while(1) {
	$currlen = sysread( $from, $buffer, $len);
	if (!defined $currlen) {
	    next if $! =~ /^Interrupted/;
	    die "Error: cleanSysRead: System read error: $!\n";
	}
	last;
    }
    return( $currlen);
}

sub cleanSysWrite {
    local( $to, $buffer, $len) = @_;
    local($offset) = 0;
    while ($len) {
	local($written) = syswrite($to, $buffer, $len, $offset);
	die "System write error: $!\n"
	    unless defined $written;
	print "written: $written\n" if $verbose;
	$len -= $written;
	$offset += $written;
    }
    return $offset;
}

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";
}

sub createHGRC {
    local( $hgrc) = @_;
    open(HGRC, "> $hgrc") || die "Couldn't create $hgrc\n";
    print HGRC '# hgrc Hyper-G resourcefile', "\n";
    print HGRC '# @','(#)[Hyper-G] [HGS-CF] .hgrc	1.10 [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";
    if ($useOldDIRdbs) {
	print HGRC 'setenv DIRserver $HOME/server', "\n";
    }
    else {
	print HGRC 'setenv DIRdbs $HOME/dbserver', "\n";
    }
    if ($useOldDIRhgs) {
	print HGRC 'setenv DIRhtf $HOME/HTF', "\n";
    }
    else {
	print HGRC 'setenv DIRhgs $HOME/hgserver', "\n";
    }
    print HGRC 'setenv DIRfts $HOME/ftserver', "\n";
    print HGRC 'setenv DIRdcs $HOME/dcserver', "\n";
    print HGRC "setenv DBHost $hostname\n";
    print HGRC "setenv HGHOST localhost\n";
    print HGRC "setenv HGServerString \"$servstring\"\n";
    print HGRC "setenv OFFHOSTNAME \"$offHostName\"\n" if $offHostName;
    print HGRC "limit coredumpsize 0\n" if (grep( /^$CPU$/, @limCore));
    close(HGRC);
}

sub readHGRC {
    local( $hgrc) = @_;
    if (open(RC, "< $hgrc")) {
	local(%hgenv);
	while (<RC>) {
	    next if /^\s*#.*$/;
	    (/^\s*setenv\s*(\S+)\s*$/) && ($hgenv{$1} = '') && next;
	    (/^\s*setenv\s*(\S+)\s+(.*)$/) && ($hgenv{$1} = $2) && next;
	}
	close (RC);
	return 0 if ($hgenv{'CPU'} ne $CPU);
	return 0 if (!$useOldDIRdbs && !$hgenv{'DIRdbs'});
	return 0 if ($useOldDIRdbs && !$hgenv{'DIRserver'});
	return 0 if (!$useOldDIRhgs && !$hgenv{'DIRhgs'});
	return 0 if ($useOldDIRhgs && !$hgenv{'DIRhtf'});
	return 0 if (!$hgenv{'DIRfts'});
	return 0 if (!$hgenv{'DIRdcs'});
	return 0 if ($hgenv{'DBHost'} ne $hostname);
	return 0 if ($hgenv{'HGHOST'} ne $hostname && $hgenv{'HGHOST'} ne 'localhost');
	return 0 if (!$hgenv{'OFFHOSTNAME'});

	return 1;
    }
    return 0;
}

