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

This is host-cmds.pl in view mode; [Download] [Up]

# Defined commands:
#

sub command_initialize
{
    $chread_handle = 'CHREAD0001';
    $chwrite_handle = 'CHWRITE0001';
    %vars = ("startnode-query", "on",
	     "rsh-timeout", 30,
	     "show-output", "yes",
	     "collect-output", "yes",
	     "kill-nodes-on-exit", "prompt",
	     "host-config-loaded","no",
	     "window-width", 70,
	     "editor","/usr/ucb/vi");
    
    
    %valid_var_values = ("startnode-query", "on|off",
			 "rsh-timeout", '\d+',
			 "window-width", '\d+',
			 "show-output", "yes|no",
			 "collect-output", "yes|no",
			 "kill-nodes-on-exit", "yes|no|prompt",
			 "host-config-loaded", "yes|no",
			 "editor", "\S+");
    
    %groups = ();

    %cmds = ("kj", kj,
	     "hosts", "hosts",
	     "start-group", "start_group",
	     "listen-port", "listen_port",
	     "apropos", "apropos",
	     "enabled", "enabled",
	     "enable", "enable",
	     "disable", "disable",
	     "dump-output", "dump_output",
	     "flush-output", "flush_output",
	     "define-group", "define_group",
	     "delete-group", "delete_group",
	     "undefine-group", "undefine_group",
	     "list-groups", "list_groups",
	     "list-group", "list_group",
	     "save-group", "save_group",
	     "load-group", "load_group",
	     "restart", "restart",
	     "node-rusage", "node_rusage",
	     "edit", "edit",
	     "kill-pcn", "kill_pcn",
	     "write-nodes", "write_nodes",
	     "connect-to-node", "connect_to_node_cmd",
	     "uptime", "uptime",
	     "load-config", "load_config",
	     "reconnect", "reconnect",
	     "status", "status",
	     "help", "help",
	     "usage", "usage",
	     "pushd", "pushd",
	     "popd", "popd",
	     "pwd", "pwd",
	     "dirs", "dirs",
	     "quit", "quit",
	     "arch", "arch",
	     "conns","conns",
	     "ps", "ps",
	     "!", "shell_escape",
	     "cd", "change_directory",
	     "set", "set",
	     "rset", "remote_set",
	     "unset", "unset",
	     "wait-for-pending", "wait_for_pending",
	     "start-node", "startnode",
	     "alias", "cmd_add_alias",
	     "abbrev", "cmd_abbrev",
	     "unalias", "cmd_remove_alias",
	     "kill", "kill");

    %gurucmds = ("parray", "cmd_parray",
		 "passoc", "cmd_passoc",
		 "eval", "eval");

    if ($host_control_guru)
    {
	local($k, $v);
	while (($k, $v) = each %gurucmds)
	{
	    $cmds{$k} = $v;
	}
    }
    
    #print "Cmds are ", join(':', %cmds), "\n";

    %abbrevs = ();
    &compute_abbrevs(*cmds, *abbrevs);
    
    @dirstack = (&getwd);
}

sub cmd_parray
{
    local($array) = @_;
    local(*name) = $array;
    &termout("Printing array '$array'\n");
    for (@array)
    {
	print "    '$_'\n";
    }
    0;
}

sub cmd_passoc
{
    local($name) = @_;
    local(*assoc) = $name;
    local($key, $val);
    
    &termout("Printing assoc '$name'\n");
    while (($key, $val) = each(%assoc))
    {
	print "    '$key' = '$val'\n";
    }
    0;
}

sub cmd_abbrev
{
    return &usage($cmd) unless @_ <= 1;
    local($str) = @_;
    local($key, $val);

    local($a) = $abbrevs{$str};

    if ($str)
    {
	if ($a =~ /:/)
	{
	    $a =~ s/:/ /g;
	    print "$str is an ambiguous abbreviation for $a\n";
	}
	elsif ($a)
	{
	    print "$str is the abbreviation for $a\n";
	}
	else
	{
	    while (($key, $val) = each %abbrevs)
	    {
		last if $val eq $str;
	    }
	    if ($key)
	    {
		print "$key is the abbreviation for $str\n";
	    }
	    else
	    {
		print "$str is not an abbreviation\n";
	    }
	}
    }
    else
    {
	print "Unambiguous abbreviations:\n";
	for $a (sort keys %abbrevs)
	{
	    $cmd = $abbrevs{$a};

	    if ($cmd !~ /:/)
	    {
		print "$a = $cmd\n";
	    }
	}
    }
       
    0;
}
	   

sub hosts
{
    return &usage($cmd) unless @_ == 0;

    local(@hosts) = &get_host_list;
    print "Current hosts:\n";
    &print_list('    ', 70, sort @hosts);
    0;
}

sub listen_port
{
    return &usage($cmd) unless @_ == 0;

    print "Listening on port $listen_port\n";
    0;
}

sub apropos
{
    local($regexp) = join(" ", @_);
    local(@matches);
    local($topic, $help);

    do { &load_file("host-help.pl"); &help_init; } if (!$help_initialized);
    
    while (($topic, $help) = each %help)
    {
	push(@matches, $topic) if $help =~ /$regexp/i || $topic =~ /$regexp/i;
    }

    print "Matching help topics:\n";
    &print_list('    ', 70, sort @matches);
    0;
}
    

sub enable
{
    for (@_)
    {
	&enable_one($_, "yes");
    }
    0;
}

sub disable
{
    for (@_)
    {
	&enable_one($_, "no");
    }
    0;
}

# enable_one [group|host|arch] flag
sub enable_one
{
    local($thing, $flag) = @_;

    if ($thing eq "all")
    {
	&enable_host(all, $flag);
    }
    else
    {
	local($kind,$thing2) = split(/=/,$thing);
	if ($thing2 eq "")
	{
	    &enable_one_kind($thing, $flag);
	}
	else
	{
	    if ($kind eq "host")
	    {
		&enable_host($thing2, $flag);
	    }
	    elsif ($kind eq "arch")
	    {
		&enable_arch($thing2, $flag);
	    }
	    elsif ($kind eq "group")
	    {
		&enable_group($thing2, $flag);
	    }
	    else
	    {
		&usage($cmd);
	    }
	}
    }
}

sub enable_one_kind
{
    local($thing, $flag) = @_;
    local($host);

    if ($host = &expand_hostname($thing))
    {
	&enable_host($host, $flag);
    }
    else
    {
	&enable_arch($thing, $flag);
    }
}

sub enable_host
{
    local($host, $flag) = @_;

    print $flag eq "yes" ? "En" : "Dis", "abling host $host\n";

    &remote_set($host, "enabled", $flag);
}

sub enable_group
{
    local($group, $flag) = @_;

    if (*list = $groups{$group})
    {
	print $flag eq "yes" ? "En" : "Dis", "abling group $group\n";
	for (@list)
	{
	    &enable_host($_, $flag);
	}
    }
    else
    {
	print "Group $group not defined\n";
    }
    0;
}

sub enable_arch
{
    local($arch, $flag) = @_;
    local($host, $hostarch, @a);

    print $flag eq "yes" ? "En" : "Dis", "abling arch $arch\n";

    for $host (keys %ports)
    {
	@a = &send_command_to_host_collecting_reply($host, "arch");
	$hostarch = $a[0];
	if ($arch eq $hostarch)
	{
	    &enable_host($host, $flag);
	}
    }
}
    
sub enabled
{
    return &usage($cmd) unless @_ == 0;
    local( @a);

    print "Enabled hosts:\n";
    for $host (keys %ports)
    {
	@a = &send_command_to_host_collecting_reply($host, "set", "enabled");
	print "\t$host\n" if grep(/yes/,@a);
    }
}
    
sub dump_output
{
    local(@list) = (@_ > 0) ? @_ : (keys %ports);

    print "Dumping from @list\n";

    for $host (@list)
    {
	$host = &full_hostname($host);

	if (defined($node_output{$host}))
	{
	    print "Output from $host:\n";
	    print $node_output{$host};
	}
	else
	{
	    print "No output from $host\n";
	}
    }
    0;
}

sub flush_output
{
    local(@list) = (@_ > 0) ? @_ : (keys %ports);

    print "Flushing from @list\n";

    for $host (@list)
    {
	$host = &full_hostname($host);

	delete $node_output{$host};
    }
    0;
}

sub undefine_group
{
    local($name) = @_;
    local($host, $varname);

    return &usage($cmd) unless @_ == 1;

    if (defined($varname = $groups{$name}))
    {
	*list = $varname;
	undef @list;
	delete $groups{$name};
    }
    0;
}

sub delete_group
{
    local($name) = @_;
    local($host, $varname);

    return &usage($cmd) unless @_ == 1;

    if (defined($varname = $groups{$name}))
    {
	*list = $varname;
	undef @list;
	delete $groups{$name};
    }

    local($groupdir) = "$control_dir/groups";
    local($groupfile) = "$control_dir/groups/$name.def";

    if (-f $groupfile)
    {
	unlink($groupfile);
	print "Deleted group $name.\n";
    }
    else
    {
	print "Group $name not defined.\n";
    }
    0;
}
    
sub define_group
{
    local($name) = @_;
    local($host, $varname);

    return &usage($cmd) unless @_ == 1;

    if ($groups{$name})
    {
	print "Group $name exists. Undefine first\n";
	return 0;
    }

    $varname = &host_group_varname($name);
    $groups{$name} = $varname;

    eval "@$varname = ()";
    *list = $varname;

    print "Enter group members and blank line to end\n";
    print "define-group > ";
    while (<STDIN>)
    {
	chop;
	last if /^\s*$/;
	last if /^\.$/;
	$host = &expand_hostname($_);

	if (!defined($host))
	{
	    print "Host $_ not found\n";
	}
	else
	{
	    print "Adding $host\n";
	    push(@list, $host);
	}
	print "define-group > ";
    }
    seek(STDIN, 0, 0) unless $_;

    0;
}

sub list_groups
{
    return &usage($cmd) unless @_ == 0;
    local(%saved_groups) = &saved_groups;

    local($group, $var, $size);

    print "Loaded groups:\n";
    while (($group, $var) = each %groups)
    {
	*list = $var;
	$size = @list;
	print "\t$group ($size members)\n";
	delete $saved_groups{$group};
    }

    local(@rest) = keys %saved_groups;

    if (@rest)
    {
	print "Other groups (not currently loaded):\n";
	for (sort @rest)
	{
	    print "\t$_\n";
	}
    }
    
    0;
}

sub list_group
{
    return &usage($cmd) unless @_ == 1;

    local($group) = @_;

    if (!defined($groups{$group}))
    {
	local(%saved_groups) = &saved_groups;
	if (defined($saved_groups{$group}))
	{
	    &load_group($group);
	}
    }

    if (defined($groups{$group}))
    {
	*list = $groups{$group};
	print "Group $group:\n";
	print "\t", join("\n\t", @list), "\n";
	print "\n";
    }
    else
    {
	print "Group $group not defined\n";
    }
    0;
}

sub group_contents
{
    local($group) = @_;

    if (!defined($groups{$group}))
    {
	local(%saved_groups) = &saved_groups;
	if (defined($saved_groups{$group}))
	{
	    &load_group($group);
	}
    }

    if (defined($groups{$group}))
    {
	*list = $groups{$group};
	@list;
    }
    else
    {
	return undef;
    }
}

sub save_group
{
    return &usage($cmd) unless @_ >= 1;

    local($group);
    
    for $group (@_)
    {
	&save_one_group($group);
    }
    0;
}

sub save_one_group
{
    local($group) = @_;
    local($groupdir) = "$control_dir/groups";

    local($var) = $groups{$group};

    if (!defined($var))
    {
	print "Group $group not defined\n";
	return;
    }

    -d $groupdir || mkdir($groupdir, 0755) || die "Couldn't mkdir $groupdir: $!\n";

    open(FILE, ">$groupdir/$group.def") || die "Error opening group file for $group: $!\n";

    *list = $var;

    print FILE join("\n", @list), "\n";
    close(FILE);
}

sub saved_groups
{
    local($groupdir) = "$control_dir/groups";
    local(%sgroups) = ();

    -d $groupdir || mkdir($groupdir, 0755) || die "Couldn't mkdir $groupdir: $!\n";

    opendir(DIR, $groupdir) || die "Couldn't opendir $groupdir: $!\n";

    while ($_ = readdir(DIR))
    {
	if (/^(\S+)\.def$/)
	{
	    $sgroups{$1} = 1;
	}
    }
    %sgroups;
}


sub load_group
{
    local(@groups) = @_;
    local($group);

    return &usage($cmd) unless @_ >= 1;

    for $group (@groups)
    {
	&load_one_group($group) || print "Group $group not defined\n";
    }
    0;
}

sub load_one_group
{
    local($group) = @_;
    local($groupdir) = "$control_dir/groups";
    local($var);

    print "Loading group '$group' dir='$groupdir'\n" if $verbose;

    if (!open(FILE, "<$groupdir/$group.def"))
    {
	return undef;
    }

    if (!defined($var = $groups{$group}))
    {
	$var = &host_group_varname($group);
    }

    *list = $var;
    @list = ();

    $groups{$group} = $var;

    while (<FILE>)
    {
	chop;
	push(@list, $_);
    }

    close(FILE);

    print "Loaded group $group (", scalar(@list), " members)\n";
    return 1;
}

sub host_group_varname
{
    local($name) = @_;

    $name =~ s/_/__/g;
    $name =~ s/-/_/g;
    $name;
}

sub node_rusage
{
    local($where) = @_;

    if ($where ne "all" && !$node_connections{($where = &full_hostname($where))})
    {
	&usage($cmd);
	return 0;
    }

    &send_command($where, "child-rusage");
    0;
}

sub restart
{
    local($cmd);
    &send_command("all", "quit");
    &unlink_host_file($hostname);

    $cmd = $0;
    $cmd .= ' -v' if $verbose;
    
    exec $cmd;
    chop($@);
    die "restart failed: $@\n";
}

sub edit
{
    local($editor);

    ($editor = $vars{"editor"}) || ($editor = $ENV{EDITOR}) ||
	($editor = "/usr/ucb/vi");
    print "Running editor $editor\n";
    system($editor, @_);
    0;
}

sub cmd_add_alias
{
    local($word, $alias) = @_;

    if (!defined($word))
    {
	&write_aliases;
    }
    elsif (!defined($alias))
    {
	if ($alias = &return_alias($word))
	{
	    print "$word $alias\n";
	}
	else
	{
	    print "$word not aliased\n";
	}
    }
    else
    {
	&add_alias($word, $alias);
    }
    0;
}

sub cmd_remove_alias
{
    local($word) = @_;

    if (!defined($word))
    {
	&usage($cmd);
    }
    else
    {
	&remove_alias($word);
    }
    0;
}

sub write_nodes
{
    local($file) = @_;
    local($host);

    if (!open(FILEOUT, ">$file"))
    {
	warn "Error opening file $file: $!\n";
	return 0;
    }
    for $host (sort keys %ports)
    {
	print FILEOUT "$host\n";
    }
    close(FILEOUT);
    0;
}

sub connect_to_node_cmd
{
    local($host, $port) = @_;

    $host = &full_hostname($host);

    if (&connect_to_node($host, $port))
    {
	&write_node_file("$host", $port);
    }
    0;
}

sub eval
{
    local($expr) = join(' ', @_);
    local($rc) = eval $expr;
    print "Eval returns '$rc'\n";
    if ($@)
    {
	print "Eval error: $@";
	undef $@;
    }
    0;
}

sub getwd
{
    local($wd);

    chop($wd = `pwd`);
    $wd;
}

sub pushd
{
    local($dir) = @_;
    local($olddir) = &getwd;

    if (!defined($dir))
    {
	&usage($cmd);
	return 0;
    }

    $dir = &expand_filename($dir);

    if (chdir($dir))
    {
	unshift(@dirstack, &getwd);
    }
    else
    {
	warn "Couldn't access $dir: $!\n";
    }
    &dirs;
    0;
}

sub popd
{
    if (@_ > 0)
    {
	&usage($cmd);
    }
    else
    {
	shift(@dirstack);
	local($dir) = $dirstack[0];
	print "changing to $dir\n";
	chdir($dir);
    }
    0;

}

sub dirs
{
    for (@dirstack)
    {
	print &unexpand_filename($_), " ";
    }
    print "\n";
    0;
}

sub pwd
{
    print &getwd, "\n";
    0;
}

sub shell_escape
{
    system("@_");
    0;
}

sub change_directory
{
    local($dir) = @_;

    $dir = &expand_filename($dir);
    
    if (!defined($dir))
    {
	$dir = $ENV{HOME};
    }

    if (chdir($dir))
    {
	$dirstack[0] = &getwd;
    }
    else
    {
	warn "Couldn't chdir $dir: $!\n";
    }
    0;
}

# Load a node config file of the form
# arch
# variable value
# <blank line>
# arch-2
# variable value
#
# and so on.
#
sub load_config
{
    local($file) = @_;
    local($arch, $var, $val);
    local($host, @hosts, $h);
    local(%host_bindings, %arch_bindings, $binding_tbl_name);
    local(@startus, $node);

    $file = &expand_filename($file);
    
    if (!open(CONFIG_FILE, "<$file"))
    {
	print "Error opening config file $file: $!\n";
	return 0;
    }
 LOOP:
    while (<CONFIG_FILE>)
    {
	chop;

	if (/^arch:\s*(\S+)/)
	{
	    $arch = $1;
	    print "Got arch $arch\n" if $verbose;
	    undef $host;
	    $binding_tbl_name = "binding_table_$arch";
	    $arch_bindings{$arch} = $binding_tbl_name;
	    eval "%$binding_tbl_name = ()";
	    next;
	}
	elsif (/^host:\s*(\S+)/)
	{
	    undef @hosts;
	    
	    $host = &expand_hostname($1);
	    if (!$host)
	    {
		print "Unknown host $1, skipping section\n";
		while (<CONFIG_FILE>)
		{
		    last if /^\s*$/;
		}
		last LOOP;
	    }

	    undef $arch;

	    print "adding $host\n";
	    $binding_tbl_name = "binding_table_$host";
	    $binding_tbl_name =~ s/\./__/g;
	    $host_bindings{$host} = $binding_tbl_name;
	    eval "%$binding_tbl_name = ()";
	    next;
	}
	elsif (/^startnode:\s*(.*)/)
	{
	    local(@nodes) = split(/\s+/,$1);
	    print "Got startnode @nodes\n";
	    push(@startus, @nodes);
	    next;
	}

	next if (/^#/);
	next if (/^\s*$/);

	# anything else (for now) is a variable assignment

	if (/^\s*(\S+)\s+(\S+)\s*$/)
	{
	    if (defined($arch))
	    {
	        # arch_bindings{$arch} *must* have been defined here, since
	        # they were defined when $arch was
		print "Arch binds $1 to $2\n" if $verbose;
		*bindings = $arch_bindings{$arch};
		$bindings{$1} = $2;
	    }
	    elsif (defined($host))
	    {
		print "Host binds $1 to $2\n" if $verbose;
		*bindings = $host_bindings{$host};
		$bindings{$1} = $2;
	    }
	    else
	    {
		warn "Error in config file at line $.: neither architecture nor host defined\n";
		return 0;
	    }
	}
    }

    print "Starting nodes @startus\n";
    &startnode(@startus);
    &wait_for_named_nodes(keys %pending);

    for $host (keys %node_connections)
    {
	@reply = &send_command_to_host_collecting_reply($host, "arch");
	$arch = $reply[0];

	print "Configuring host $host of architecture $arch\n" if $verbose;

	*bindings = $arch_bindings{$arch};

	while (($var, $val) = each %bindings)
	{
	    &remote_set($host, $var, $val);
	}
    }

    for $host (keys %host_bindings)
    {
	*bindings = $host_bindings{$host};
	while (($var, $val) = each %bindings)
	{
	    &remote_set($host, $var, $val);
	}
    }
	

    $vars{"host-config-loaded"} = "yes";
    0;
}

sub remote_set
{
    local($node, $var, @value) = @_;
    local($valuestr);
    local($host) = &full_hostname($node);

    if ($node eq "all")
    {
	$host = "all";
    }
    elsif (!$host)
    {
	$host = "all";
	unshift(@value, $var);
	$var = $node;
    }

    $valuestr = join(' ', @value);
    print "Setting variable $var to $valuestr on $host\n" if $verbose;

    &send_command($host, "set", $var, $valuestr);

    0;
}

sub remote_eval
{
    local($node, @args) = @_;
    local($host) = &expand_hostname($node);

    return &usage($cmd) unless $host;

    &send_command($host, "eval", @args);
    0;
}

sub kill_pcn
{
    if (@_ == 0)
    {
	&usage($cmd);
	return 0;
    }
    local($where, @pids) = @_;

    if (($where ne "all") && !$node_connections{($where = &full_hostname($where))})
    {
	&usage($cmd);
	return 0;
    }
    print "Killing pids '@pids' on host $where\n" if $verbose;

    &send_command($where, "kill_pcn", @pids);
    0;
}


sub set
{
    local($var, $value) = @_;

    if (!$var)
    {
	for $var (sort keys %vars)
	{
	    $value = $vars{$var};
	    printf "%10s = %s\n", $var, $value;
	}
    }
    elsif (!$value)
    {
	$value = $vars{$value};
	if (defined($value))
	{
	    printf "%10s = %s\n", $var, $vars{$value};
	}
	else
	{
	    print "$var not defined\n";
	}
    }
    else
    {
	if (defined($vars{$var}))
	{
	    print "Old value: $vars{$var}\n" if $verbose;
	}
	local($regexp) = $valid_var_values{$var};
	if ($value =~ /^$regexp$/)
	{
	    $vars{$var} = $value;
	}
	else
	{
	    print "Invalid value for $var. Value must match $regexp\n";
	}
    }
    0;
}

sub unset
{
    local($var) = @_;

    &usage($cmd) unless @_ == 1;

    if (defined($vars{$var}))
    {
	print "Old value: $vars{$var}\n";
	delete $vars{$var};
    }
    0;
}

sub wait_for_pending
{
    &wait_for_named_nodes(keys %pending);
    0;
}

sub wait_for_named_nodes
{
    local(@nodes) = @_;
    local($name, @ready, $handle, $func);
    local(%nodeassoc);
    
    for (@nodes)
    {
	$nodeassoc{&full_hostname($_)} = 1;
    }

    @nodes = keys %nodeassoc;
    print "Waiting for connection from @nodes\n" if @nodes;
    while (@nodes)
    {
	@ready = &select($listen_handle, keys %misc_connections_funcs);
	for $handle (@ready)
	{
	    if ($handle eq $listen_handle)
	    {
		$name = &wait_for_connection;
		if (!$name)
		{
		    print "Error waiting... $@\n";
		    return;
		}
		if ($nodeassoc{$name})
		{
		    delete $nodeassoc{$name};
		}
	    }
	    else
	    {
		$func = $misc_connections_funcs{$handle};
		&$func($handle, split(/$;/, $misc_connections_data{$handle}));
	    }
	}
	@nodes = keys %nodeassoc;
	print "Waiting for connection from @nodes\n" if @nodes;
    }
    0;
}

sub start_group
{
    do { &usage($cmd); return 0; } unless @_ == 1;
    local($group) = @_;

    local(@nodes) = &group_contents($group);
    if (@nodes)
    {
	&startnode(@nodes);
    }
    else
    {
	print "No nodes in group $group\n";
    }
    0;
}

sub startnode
{
    local(@nodes) = @_;
    local($host, $user);
    local($cmd);

    for $host (@nodes)
    {
	$cmd = "node-control";
	$user = $ENV{USER};
	
	if ($host =~ /(([^@]+)@)?([^:]+)(:(\S+))?/)
	{
	    $user = $2 if $1;
	    $host = $3;
	    $cmd = $5 if $4;
	    print "Got full form $user $host $cmd\n" if $verbose;
	}
	$name = &expand_hostname($host);

	if (!$name)
	{
	    if ($host =~ /^~/)
	    {
		$host =~ s/^~/$ENV{HOME}/;
	    }
	    if (-f $host)
	    {
		&start_nodes_from_file($host);
	    }
	    else
	    {
		print "Invalid node '$host'\n";
	    }
	}
	else
	{
	    if ($node_connections{$name})
	    {
		print "Node-control already running on $name\n";
		next;
	    }

	    if ($vars{"startnode-query"} eq "on")
	    {
		print "Node-control not running on $name. Start it? ";
		$_ = <STDIN>;
		next if (!/^y/i);
	    }

	    print "Starting node on $name\n";
#	    if (system("rsh $name -n node-control &"))
#	    {
#		print "Failed to start node-control on $name\n";
#	    }
	    if (&start_node_on_host_with_fork($name, $user, $cmd))
	    {
		$pending{$name} = 1;
	    }
	    else
	    {
		print "Trying to start node using groups\n";
		&start_node_with_groups($name, $user, $cmd);
	    }
	}
    }
}


sub start_node_with_groups
{
    local($host, $user, $cmd) = @_;
    local($group, $var, $h, $rhost);
    local(%saved_groups) = &saved_groups;

    while (($group, $var) = each %groups)
    {
	delete $saved_groups{$group};
	last if (&host_in_group($host, $var));
    }

    if (!$var)
    {
	for $group (keys %saved_groups)
	{
	    &load_one_group($group);
	    $var = $groups{$group};
	    print "$group: var is $var\n" if $verbose;
	    last if (&host_in_group($host, $var));
	}
    }

    if (!$var)
    {
	print "Couldn't find group for $host\n";
	return undef;
    }

    *list = $var;

    print "got $host in group $group\n" if $verbose;

    print "Starting node on $host using group $group\n";

    for $h (@list)
    {
	if ($ports{$h})
	{
	    print "got host $h\n" if $verbose;
	    $rhost = $h;
	    last;
	}
    }
    if ($rhost)
    {
	print "connected to host $rhost in group $group\n" if $verbose;
	@repl = &send_command_to_host_collecting_reply($rhost, "startnode", @_);
	print "Got reply <@repl>\n" if $verbose;
	if (grep(/success/i, @repl))
	{
	    print "Startnode succeeded\n";
	    $pending{$host} = 1;
	}
	else
	{
	    print "Startnode failed\n";
	}
    }
    0;
}

sub host_in_group
{
    local($host, $group) = @_;

    *list= $group;
    return grep(/$host/, @list);
}


sub start_nodes_from_file
{
    local($file) = @_;
	    
    return if (! -f $file);

    open(NODEFILE,"<$file") || print "Cannot open file $file: $!\n" && return;

    while (<NODEFILE>)
    {
	chop;
	s/^\s*//;
	s/\s*$//;
	next if (/^[#%]/);
	next if (/^$/);
	&startnode($_);
    }
    close(NODEFILE);
}
    

sub reconnect
{
    local($host);

    for $host (keys %ports)
    {
	&disconnect($host);
    }
    &setup_connections;
    undef $@;
    0;
}

sub arch
{
    local($where, @list) = @_;
    if ($where ne "all" && !$node_connections{($where = &full_hostname($where))})
    {
	&usage($cmd);
	return 0;
    }
    &send_command($where, "arch", @list);
    0;
}
    
sub status
{
    local($where, @list) = @_;
    if ($where ne "all" && !$node_connections{($where = &full_hostname($where))})
    {
	&usage($cmd);
	return 0;
    }
    &send_command($where, "status", @list);
    0;
}
    
sub uptime
{
    local($where, @list) = @_;
    if ($where ne "all" && !$node_connections{($where = &full_hostname($where))})
    {
	&usage($cmd);
	return 0;
    }
    &send_command($where, "uptime", @list);
    0;
}
    
sub ps
{
    local($where, @list) = @_;
    if ($where ne "all" && !$node_connections{($where = &full_hostname($where))})
    {
	&usage($cmd);
	return 0;
    }
    &send_command($where, "ps", @list);
    0;
}
    

sub conns
{
    local($name, $handle, $port);
    local(@hosts) = sort keys %ports;

    print "Current connections (", scalar(@hosts), "):\n";
    for $name (@hosts)
    {
	$handle = $node_connections{$name};
	$port = $ports{$name};
	print "\t$name/$port ", $verbose ? $handle : "", "\n";
    }
    0;
}


sub quit
{
    1;
}

sub kj
{
    local($where, @list) = @_;
    if ($where ne "all" && !$node_connections{($where = &full_hostname($where))})
    {
	&usage($cmd);
	return 0;
    }
    &send_command($where, "kj", @list);
    0;
}

sub kill
{
    local($where, @list) = @_;
    local($host);

    if (($host = &full_hostname($where)) || (($host = $where) eq "all"))
    {
	&send_command($host, "kill", @list);
    }
    else
    {
	&usage($cmd);
    }
    0;
}

sub help
{
    local($cmd) = @_;
    local($help, $topic);

    do { &load_file("host-help.pl"); &help_init; } if (!$help_initialized);

    if ($cmd eq 'all')
    {
	print "Available comands: \n";
	for $cmd (sort keys %cmds)
	{
	    print "$cmd:\n", $help{$cmd}, "\n";
	}
    }
    elsif ($cmd eq 'tex')
    {
	local($old) = $*;
	$* = 1;
	open(TEX, ">summary.tex");
	print TEX "\\begin{itemize}\n";
	for $cmd (sort keys %cmds)
	{
	    ($help = $help{$cmd}) =~ s/([_\$])/\\\1/g;
	    $help =~ s/^%%TEX //g;
	    print TEX "\\item[{\\bf $cmd}] ", $help, "\n";
	}
	print TEX "\\end{itemize}\n";
	close(TEX);
	$* = $old;
    }
    elsif ($cmd ne "")
    {
	if (!$host_control_guru && $gurucmds{$cmd})
	{
	    print "No help for $cmd\n";
	}
	elsif ($help = $help{$cmd})
	{
	    local($old) = $*;
	    local($usage);
	    $* = 1;
	    $help =~ s/^%%TEX .*\n//g;
	    print $help;
	    $* = $old;
	    if ($usage = $usage{$cmd})
	    {
		print "Usage: \n";
		print $usage;
	    }
	}
	else
	{
	    print "No help for $cmd\n";
	}
    }
    else
    {
	print "Available comands: \n";
	&print_list('    ', $vars{"window-width"}, sort keys %cmds);
#	for $cmd (sort keys %cmds)
#	{
#	    print "\t$cmd";
#	    print " (no help)" unless $help{$cmd};
#	    print "\n";
#	}
	print "Other help:\n";
	local(@other) = ();
	for $topic (keys %help)
	{
	    push(@other, $topic) unless ($cmds{$topic} || $gurucmds{$topic});
	}
	&print_list('    ', $vars{"window-width"}, sort @other);
    }
    0;
}

sub usage
{
    local($cmd) = @_;
    local($help);

    do { &load_file("host-help.pl"); &help_init; } if (!$help_initialized);

    if (defined($cmd))
    {
	if ($help = $usage{$cmd})
	{
	    print "Usage: \n";
	    print $help;
	}
	else
	{
	    print "No usage infomation for $cmd\n";
	}
    }
    else
    {
	print "Available comands: \n";
	for $cmd (sort keys %cmds)
	{
	    print "\t$cmd\n";
	}
    }
    0;
}

# Start inclusion from new2.pl

$ch_read_handle = 'CHREAD0001';
$ch_error_handle = 'CHERROR0001';

sub start_node_on_host_with_fork
{
    local($name, $user, $cmd) = @_;
    local($child);
    local($rh, $eh) = ($ch_read_handle++, $ch_error_handle++);
    local($crh, $ceh) = ("C_$rh", "C_$eh");
    local(@cmd);

    pipe($rh, $crh) || die "Pipe failed: $!";
#    pipe($eh, $ceh) || die "Pipe failed: $!";
    pipe(INP, CHILD_STDIN) || die "Pipe failed: $!";

    @cmd = ("rsh", $host, "-l", $user, "/bin/sh");
    @cmd = ("/bin/sh") if $name eq $hostname;
    &termout("Command is '@cmd'\n") if $verbose;

    &nonbuf_list($rh, $crh, INP, CHILD_STDIN);
    
    $child = fork;
    
    die "fork failed: $!\n" if $child < 0;

    open(TTY, ">/dev/tty") || warn "Couldn't open tty: $!\n";
    select((select(TTY), $| = 1)[0]);
    
    if ($child == 0)
    {
	close(CHILD_STDIN);
	close($rh);
#	close($eh);
	close(STDIN);
	close(STDOUT);
	close(STDERR);

	open(STDIN, "<&INP");
	open(STDOUT, ">&$crh");
	open(STDERR, ">&$crh");
#	open(STDERR, ">&$ceh");

	close($crh);
#	close($ceh);
	close(INP);
	
	select(STDERR); $| = 1;
	select(STDOUT); $| = 1;

	exec @cmd;
	die "Exec failed: $!\n";
    }

    close(INP);
    close($crh);
#    close($ceh);
    
    print CHILD_STDIN "$cmd < /dev/null \n";
    &termout("$cmd < /dev/null &\n") if $verbose;
    close(CHILD_STDIN);

    delete $rsh_error_output{$eh};
    delete $rsh_output{$rh};

#    &noblock($rh, $eh);

    &add_misc_pipe($rh, 'rsh_stdout', $name);
#    &add_misc_pipe($eh, 'rsh_stderr', $name);
}

sub rsh_stderr
{
    local($handle, $host) = @_;
    
    while (1)
    {
	undef $!;
	$_ = <$handle>;
	if (!$_)
	{
	    return if ($! == &EWOULDBLOCK);
	    print "Got EOF for host $host $handle $_\n" if $verbose;
	    &rsh_stderr_eof;
	    return;
	}
	else
	{
	    chop;
	    return if /^\s*$/;
	    
	    $rsh_error_output{$handle} .= "$_$;";
	    if (eof($handle))
	    {
		&termout("eof test caught stderr\n") if $verbose;
		&rsh_stderr_eof;
		return;
	    }
	}
    }
}

sub rsh_stderr_eof
{
    local($handle, $host) = @_;

    print "stderr eof on $handle\n" if $verbose;
    close($handle);
    &remove_misc_pipe($handle);
    
    local($error_output) = $rsh_error_output{$handle};
    if ($error_output ne '')
    {
	&termout("Startnode on $host failed:\n");
	&termout(join("\n", split(/$;/, $error_output)), "\n");
    }
}

sub rsh_stdout
{
    local($handle, $host) = @_;
    
    while (1)
    {
	undef $!;
	$_ = <$handle>;
	print "Rsh returns '$_'\n" if $verbose;
	if (!$_)
	{
	    return if ($! == &EWOULDBLOCK);
	    "Got stdout EOF for host $host $handle $_\n" if $verbose;
	    &rsh_stdout_eof;
	    return;
	}
	else
	{
	    chop;
	    return if /^\s*$/;
	    
	    $rsh_output{$handle} .= "$_$;";
	    if (eof($handle))
	    {
		&termout("eof test caught stdout\n") if $verbose;
		&rsh_stdout_eof;
		return;
	    }
	}
    }
}

sub rsh_stdout_eof
{
    local($handle, $host) = @_;

    print "stdout eof on $handle\n" if $verbose;
    
    close($handle);
    &remove_misc_pipe($handle);
    
    local($output) = $rsh_output{$handle};
    
    if ($output =~ /pcn\s+node\s+control.*version\s*([\d\.]+)/i)
    {
	&termout("Node control version $1 running on $host\n");
    }
    elsif ($output ne '')
    {
	&termout("Startnode $host failed: \n");
	&termout(join("\n", split(/$;/, $output)), "\n");
    }
    else
    {
	&termout("Startnode $host failed\n");
    }
}

sub nonbuf_list
{
    local($handle);
    
    $handle = shift(@_);
    local($old) = select($handle);
    $| = 1;
    
    for (@_)
    {
	select($_);
	$| = 1;
    }
    select($old);
}

# End inclusion from new2.pl


1;

These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Marcel Waldvogel and Netfuture.ch.