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