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 = '[email protected]';
$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;
             cho
p( $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";
}