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 Netfuture.ch.