This is utils.pl in view mode; [Download] [Up]
sub gethostname
{
local($hostname);
chop($hostname = `hostname`);
$hostname = &full_hostname($hostname);
$hostname =~ tr/A-Z/a-z/;
$hostname;
}
sub getarch
{
return $ENV'arch if defined($ENV'arch);
local($arch);
chop($arch = `arch`);
$arch =~ tr/A-Z/a-z/;
$arch;
}
if (!do 'fcntl.ph')
{
sub F_SETFL { 4; }
sub F_GETFL { 3; }
sub FNDELAY { 4; }
}
sub noblock
{
local($handle, $flags);
for $handle (@_)
{
if (($flags = fcntl($handle, &F_GETFL, 0)) < 0)
{
warn "fcntl $handle failed: $!\n";
return;
}
$flags |= &FNDELAY;
if (fcntl($handle, &F_SETFL, $flags) < 0)
{
warn "fcntl $handle failed: $!\n";
return;
}
}
}
sub cmd {
local(*cmd) = @_;
%cmd = ('start-node-foo-bar', "snfbasdf");
}
sub compute_abbrevs
{
local(*cmds, *abbrevs, $level) = @_;
local($cmd, @a, $a);
local(%clashes);
local($gotclash, $regexp);
local(@nogood);
$level = 1 unless $level;
%abbrevs = ();
for $cmd (keys %cmds)
{
$regexp = '[^-]' x $level;
# print "regexp is '$regexp'\n";
($a = $cmd) =~ s/($regexp)[^-]*/\1/g;
$a =~ s/-//g;
# print "got '$a'\n";
if (defined($abbrevs{$a}))
{
print "Abbrev clash! $cmd and $abbrevs{$a}\n" if $verbose > 1;
$abbrevs{$a} .= ":$cmd";
push(@nogood, $a);
$gotclash = 1;
}
else
{
$abbrevs{$a} = $cmd;
}
}
if ($gotclash)
{
local($x,$y);
while (($x, $y) = each(%abbrevs))
{
if ($y =~ /:/)
{
local(@a) = split(/:/,$y);
for (@a)
{
$clashes{$_} = $cmds{$_};
}
}
}
# print "Got clash:\n";
# while (($x, $y) = each(%clashes))
# {
# print "CL: $x = $y\n";
# }
local(%newabbrevs);
&compute_abbrevs(*clashes, *newabbrevs, $level+1);
# print "New abbrevs:\n";
while (($x, $y) = each(%newabbrevs))
{
$abbrevs{$x} = $y;
# print "NA: $x = $y\n";
}
}
}
sub start_node_on_host
{
local($name, $user, $cmd) = @_;
local($rc, $tmpfile);
local($oldhandler, $oldtime);
sub alarming { die "TIMEOUT\n"; }
$oldhandler = $SIG{ALRM};
$SIG{ALRM} = alarming;
$oldtime = alarm($vars{"rsh-timeout"});
eval <<ENDEVAL;
&open2(READ, WRITE, \"rsh \$name -l \$user /bin/sh\");
# print WRITE \"echo rshrunning\\n\";
# print WRITE \"hostname\\n\";
# print WRITE \"uptime\\n\";
# print WRITE \"date\\n\";
print WRITE \"\$cmd \&\\n\";
print WRITE \"exit\\n\";
\@out = \<READ\>;
close(WRITE);
close(READ);
# Wait for the rsh process to finish up...
# Do it inside the eval block in case there's a problem.
print \"waiting\\n\" if \$verbose;
\$pid = wait;
ENDEVAL
alarm(0);
$SIG{ALRM} = $oldhandler;
alarm($oldtime);
print "pid is $pid\n" if $verbose;
print "Output is:\n<@out>\n" if $verbose;
chop(@out);
if ($@)
{
print "Startnode failed: $@\n";
undef $@;
return undef;
}
local(@which) = grep(/PCN Node control/, @out);
if (@which)
{
local($version) = $which[0] =~ /version\s*(\S+)/;
print "Node control version $version running on $name\n";
return 1;
}
else
{
print "Startnode failed: @out\n";
print "Startnode output: @out\n" if $verbose;
return undef;
}
}
sub get_host_list
{
local($host, $port);
local(@list);
&dir_exists($control_dir, "$control_dir/hosts");
opendir(DIR, "$control_dir/hosts") || die "Can't opendir $control_dir: $!\n";
while ($host = readdir(DIR))
{
next if $host =~ /^\./;
$port = &read_host_file("$host");
next unless $port;
push(@list, "$host/$port");
}
closedir(DIR);
return @list;
}
sub get_node_list
{
local($node, $port);
local(@list);
&dir_exists($control_dir, "$control_dir/nodes");
opendir(DIR, "$control_dir/nodes") || die "Can't opendir $control_dir: $!\n";
while ($node = readdir(DIR))
{
next if $node =~ /^\./;
$port = &read_node_file("$node");
next unless $port;
push(@list, "$node/$port");
}
closedir(DIR);
return @list;
}
sub dir_exists
{
local($dir);
for $dir (@_)
{
-d $dir || mkdir($dir, 0755) ||
die "Cannot mkdir $dir: $!\n";
}
}
sub print_list
{
local($prefix, $linelen, @stuff) = @_;
local($len);
$len = length($prefix);
print $prefix;
for (@stuff)
{
if ($len + length($_) > $linelen)
{
print "\n";
print $prefix;
$len = length $prefix;
}
print $_ . ' ';
$len += length($_) + 1;
}
print "\n";
}
sub append
{
local(*string, @elts) = @_;
$string = shift @elts if $string eq "";
for (@elts)
{
$string .= "," . $_;
}
}
sub hostname_from_addr
{
local(@addr) = @_;
local($inetaddr, @info);
$inetaddr = pack('C4', @addr);
@info = gethostbyaddr($inetaddr, 2);
$info[0];
}
sub full_hostname
{
local($host) = @_;
local($name) = &expand_hostname($host);
return $name if $name;
$host;
}
sub expand_hostname
{
local($host) = @_;
local($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($host);
if (!$name)
{
if (@addr = $host =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)
{
($name, $aliases, $addrtype, $length, @addrs) =
gethostbyaddr(pack('C4', @addr),2);
}
}
return $name;
}
sub unexpand_filename
{
local($file) = @_;
if ($file =~ m,^$ENV{HOME}\b,)
{
$file =~ s,,~,;
}
$file;
}
sub expand_filename
{
local($file) = @_;
local($user, $dir);
if ($file =~ m,^~([a-zA-Z]+)(/?),)
{
$user = $1;
# print "Expanding user $user\n";
local(@ary) = getpwnam($user);
if (@ary)
{
$dir = $ary[7];
# print "Got dir $dir\n";
$file =~ s,^~[a-zA-Z]+(/?),${dir}$1,;
}
}
elsif ($file =~ m,^~(/?),)
{
$file =~ s,^~(/?),$ENV{HOME}$1,;
}
return $file;
}
sub flush
{
local($handle) = @_;
local($old);
$old = select($handle); $| = 1;
select($old);
}
# Select from the connections in @_, returning a list of
# handles.
sub select
{
local($rin, $handle, $n);
local(@ready);
print "Selecting from ", join(' ', @_), "\n" if $watch_select;
while (1)
{
$rin = '';
for $handle (@_)
{
vec($rin, fileno($handle), 1) = 1;
}
$n = select($rout = $rin, undef, undef, undef);
# print "select returns $n\n" if $verbose;
if ($n < 0)
{
next if ($! =~ /interrupted\s*system\s*call/i);
die "Select fails: $!\n";
}
else
{
last;
}
}
for $handle (@_)
{
last if $n == 0;
if (vec($rout, fileno($handle), 1) == 1)
{
push(@ready, $handle);
$n--;
}
}
return @ready;
}
sub read_host_file
{
local($host) = @_;
local($port, $file);
-d "$control_dir/hosts" || mkdir("$control_dir/hosts", 0755);
$file = "$control_dir/hosts/$host";
open(HOST_FILE, "<$file") || return undef;
chop($port = <HOST_FILE>);
close(HOST_FILE);
return undef if ($port !~ /^\d+$/);
return $port;
}
sub write_host_file
{
local($host, $port) = @_;
-d "$control_dir/hosts" || mkdir("$control_dir/hosts", 0755);
local($file) = "$control_dir/hosts/$host";
open(HOST_FILE, ">$file") || die "Can't write $file: $!\n";
print HOST_FILE "$port\n";
close(HOST_FILE);
}
sub read_node_file
{
local($node) = @_;
local($port, $file);
-d "$control_dir/nodes" || mkdir("$control_dir/nodes", 0755);
$file = "$control_dir/nodes/$node";
open(NODE_FILE, "<$file") || return undef;
chop($port = <NODE_FILE>);
close(NODE_FILE);
return undef if ($port !~ /^\d+$/);
return $port;
}
sub write_node_file
{
local($node, $port) = @_;
-d "$control_dir/nodes" || mkdir("$control_dir/nodes", 0755);
local($file) = "$control_dir/nodes/$node";
open(NODE_FILE, ">$file") || die "Can't write $file: $!\n";
print NODE_FILE "$port\n";
close(NODE_FILE);
}
sub unlink_node_file
{
local($node) = @_;
local($file) = "$control_dir/nodes/$node";
unlink($file);
}
sub unlink_host_file
{
local($host) = @_;
local($file) = "$control_dir/hosts/$host";
unlink($file);
}
# &open2: tom christiansen, <tchrist@convex.com>
#
# usage: $pid = open2('rdr', 'wtr', 'some cmd and args');
#
# spawn the given $cmd and connect $rdr for
# reading and $wtr for writing. return pid
# of child, or 0 on failure.
#
# WARNING: this is dangerous, as you may block forever
# unless you are very careful.
#
# $wtr is left unbuffered.
#
# abort program if
# rdr or wtr are null
# pipe or fork or exec fails
#package open2;
$fh = 'FHOPEN000'; # package static in case called more than once
#sub main'open2 {
sub open2 {
local($kidpid);
local($dad_rdr, $dad_wtr, $cmd) = @_;
$dad_rdr ne '' || die "open2: rdr should not be null";
$dad_wtr ne '' || die "open2: wtr should not be null";
# force unqualified filehandles into callers' package
local($package) = caller;
$dad_rdr =~ s/^[^']+$/$package'$&/;
$dad_wtr =~ s/^[^']+$/$package'$&/;
local($kid_rdr) = ++$fh;
local($kid_wtr) = ++$fh;
pipe($dad_rdr, $kid_wtr) || die "open2: pipe 1 failed: $!";
pipe($kid_rdr, $dad_wtr) || die "open2: pipe 2 failed: $!";
if (($kidpid = fork) < 0) {
die "open2: fork failed: $!";
} elsif ($kidpid == 0) {
close $dad_rdr; close $dad_wtr;
open(STDIN, ">&$kid_rdr");
open(STDOUT, ">&$kid_wtr");
print STDERR "execing $cmd\n" if $verbose;
open(STDERR, ">&$kid_wtr");
exec $cmd;
die "open2: exec of $cmd failed";
}
close $kid_rdr; close $kid_wtr;
select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
$kidpid;
}
sub ltime
{
local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
localtime($_[0]);
return sprintf("%02d:%02d:%02d %02d/%02d/%02d",
$hour, $min, $sec,
$mon+1, $mday, $year);
}
1;
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.