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

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.