ftp.nice.ch/pub/next/unix/developer/pcn.2.0.s.tar.gz#/scripts/host-control/utils.pl

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 Marcel Waldvogel and Netfuture.ch.