1
0
Files
irix-657m-src/eoe/cmd/ktools/ksteal
2022-09-29 17:59:04 +03:00

566 lines
15 KiB
Perl
Executable File
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
#!/usr/annex/perl
#
# kcons, the perl version.
# kgrab merged into this.
# kfree too
# klist also
# ksteal as well
#
# $Header: /proj/irix6.5.7m/isms/eoe/cmd/ktools/RCS/ksteal,v 1.7 1996/01/23 08:15:03 ack Exp $
# $Revision: 1.7 $
# $Modified: Fri Apr 21 14:49:48 1995 by cwilson $
# Set up a session between this system and the indicated target
# (debug) system's console port. The session is composed of
# a TELNET process.
#
# If invoked as kgrab,
# Set up a session between this system and the indicated target
# (debug) system. The session is composed of a TELNET
# process for each console port on the target, and a shell
# window for each debug port on the target. The shells for
# the debug ports will have the KDBXPORT environment variable
# set to the appropriate path (ie: /dev/annex/foo.d0).
#
#
# -lock locks the port
# -cu uses cu (if possible) to talk to the system.
# -nodebug|-nodbg -- we won't bring up the debug ports if running as kgrab.
# -q quiet mode. Mostly for quietly stealing a tap session
#
$REVISION = '$Revision: 1.7 $'; # ";" <-- this fixes indenting and highlighting
$TELNET = 'telnet';
$RCFILE = "$ENV{'HOME'}/.kgrabrc"; # for kgrab
$KWHO = '/usr/annex/kwho';
$HOSTNAME = `hostname -s`;chop $HOSTNAME;
$CONSOLE = 0; # default console to grab.
$| = 1;
$PORTSFILE = '/usr/annex/ktools.map';
# we can now require this, since the ktools are an inst image
# that has pre-reqs on eoe2.sw.gifts_perl or perl.sw.perl
require 'newgetopt.pl';
&NGetOpt( "c:s", "lock", "cu", "steal", "grab", "f", "a:s",
"nodebug", "nodbg", "debug", "dbg", "DEBUG", "noyp", "q");
$opt_nodbg += $opt_nodebug;
$opt_dbg += $opt_debug;
$REVISION =~ s/.*(\d\.\d+).*/$1/;
`/etc/chkconfig yp`;
$KWHO .= ' -noyp' if $opt_noyp || $? ;
print (stderr "Sorry, you can't use the ktools with the -noyp option until you copy\n" .
"the ktools configuration file, ktools.map, to your system.\n"), exit 1 if $opt_noyp && !-e $PORTSFILE;
$CONSOLE = $ARGV[1] if $ARGV[1];
&checkclasses; # validate classes, if any
&kfree if ($0 =~ /kfree$/);
&klist if ($0 =~ /klist$/);
&Usage, exit(1) if $#ARGV > 1 || $#ARGV == -1;
&kgrab_setup if ($0 =~ /kgrab/ || $opt_grab);
# if attempting to use cu, make sure there's a device to talk to
#
if ($opt_cu) {
# verify device entry
$dev = `grep $ARGV[0] /usr/annex/cu_device_names`;
# verify rtelnetd is running
if ($dev) {
$rt = `ps -elf|grep rtelnetd`;
}
if (!$dev || !$rt) {
print stderr "cu device doesn't exist or rtelenetd not running.\n";
exit(1);
}
}
@kwho = `$KWHO $ARGV[0]`;
&tapcheck if $#kwho; # check to see if there's a tap session running
&ksteal if ($0 =~ /ksteal$/ || $opt_steal);
if (($sysinfo = &ypmatch($ARGV[0]))) {
&Doit($ARGV[0]);
&checkversion;
exit(0);
}
else {
print "$0: Unknown system: $ARGV[0]\n";
&Usage, exit(1);
}
#
# ypmatch:
# do the ypmatch thing
#
sub ypmatch {
local($foo) = $opt_noyp ? `grep ^$_[0] $PORTSFILE` : `ypmatch -k $_[0] ktools 2>&1`;
if ($opt_noyp) {
if ($foo !~ /$_[0]/) { return 0; }
$foo =~ s/(.*)$_[0]\s*(.*)/$2/;
} else {
if ($foo !~ /$_[0]:/) { return 0; }
$foo =~ s/(.*)$_[0]: (.*)/$2/;
}
$foo;
}
#
# ypcat:
# do the ypcat thing
#
sub ypcat {
local(@foo) = $opt_noyp ? `cat $PORTSFILE` : `ypcat -k ktools 2>&1`;
@foo;
}
#
# slurpMachInfo:
# a single point to futz with splitting the info from the maps.
# presumes that $_[0] holds the info string.
#
sub slurpMachInfo {
($M_desc, $M_mach_type, $M_mktg_mach_type, $M_chassis, $M_gfx, $M_mem,
$M_special, $M_loc, $M_asset, $M_serial, $M_notes, $M_owner,
$M_owner_uname, $M_owner_ext, $M_ports, $M_annex, $M_reset,
$M_consoles, $M_dbg_consoles, $M_access) = split('`', $_[0]);
@M_consoles = split(',', $M_consoles);
@M_dbg_consoles = split(',', $M_dbg_consoles);
grep(s/\s//g, @M_consoles);
grep(s/\s//g, @M_dbg_consoles);
$M_notes =~ s/^\s+//;
$M_full_owner = '';
$M_full_owner = "$M_owner ($M_owner_uname), $M_owner_ext" if
( length($M_owner) && length($M_owner_uname) && length($M_owner_ext));
}
#
# Doit:
# start the telnet session
#
sub Doit {
$machine = $ARGV[0];
&slurpMachInfo($sysinfo);
grep(s/r//, @M_consoles);
&PrintNote if $M_notes;
$ARGV[0] .= ".con.$CONSOLE";# if $CONSOLE;
if (grep(/$ARGV[0]/, @kwho)) {
print "$ARGV[0] appears to be in use:\n", @kwho;
exit(1) ;
}
# print "$TELNET $annex 50$Console{$_}\n";
if ($0 =~ /kgrab/) {
# tell the annex box who's connected.
foreach ( defined($ARGV[1]) ? $M_consoles[$CONSOLE] :
@M_consoles) {
&NA($_, $M_annex);
}
if ($opt_dbg) {
foreach ( defined($ARGV[1]) ? $M_dbg_consoles[$CONSOLE] :
@M_dbg_consoles) {
&NA($_, $M_annex);
}
}
foreach ( defined($ARGV[1]) ? $CONSOLE :
(0..$#M_consoles)) {
if ($CMD eq "xwsh") {
$conargs = "-icontitle $machine" . "_c_$_ -title $machine" . "_cons_$_";
$dbgargs = "-icontitle $machine" . "_debug_$_ -title $machine" . "_debug_$_";
*x = $machine . '_con_' . $_;
$conargs .= " $x";
*x = $machine . '_dbg_' . $_;
$dbgargs .= " $x";
}
elsif ($CMD eq "xterm") {
$conargs = "-n $machine" . "_c_$_ -title $machine" . "_c_$_";
$dbgargs = "-n $machine" . "_debug_$_ -title $machine" . "_debug_$_";
}
print "$CMD $iconic $con_geom[$_] $conargs -e $TELNET $M_annex 50$M_consoles[$_] &\n" if $opt_DEBUG;
system "$CMD $iconic $con_geom[$_] $conargs -e $TELNET $M_annex 50$M_consoles[$_] &\n";
$ENV{'KDBXPORT'} = "/dev/annex/$machine.dbg.$_";
print "$CMD $iconic $dbg_geom[$_] $dbgargs -e $ENV{'SHELL'} &\n" if !$opt_nodbg && $opt_DEBUG;
system "$CMD $iconic $dbg_geom[$_] $dbgargs -e $ENV{'SHELL'} &\n" if $opt_dbg;
}
}
else { # kcons
# change the xwsh title bar && icon if we've got an xwsh
if ($ENV{'TERM'} eq 'iris-ansi') {
print "P1.ykcons:$machine\\P3.ykcons:$machine\\";
}
$M_consoles[$CONSOLE] =~ s/^r//;
&NA($M_consoles[$CONSOLE], $M_annex);
if (!$opt_cu) {
print "$TELNET $M_annex 50$M_consoles[$CONSOLE]\n" if $opt_DEBUG;
system("$TELNET $M_annex 50$M_consoles[$CONSOLE];echo 'P1.y$HOSTNAME\\P3.y$HOSTNAME\\'");
}
else {
print "cu -lannex/$machine.con.$CONSOLE\n" if $opt_DEBUG;
system("cu -lannex/$machine.con.$CONSOLE;echo 'P1.y$HOSTNAME\\P3.y$HOSTNAME\\'");
}
}
}
# talk to na to set the username for the port
#
#
sub NA {
local ($port, $annex) = @_;
$user = $opt_lock ? '[' . $ENV{'USER'} . ']' : $ENV{'USER'};
system $opt_DEBUG ? "/bin/echo 'set port=$port\@$annex user_name \"$user\"' | /usr/annex/na" :
"/bin/echo 'set port=$port\@$annex user_name \"$user\"' | /usr/annex/na 1>/dev/null 2>&1";
}
# usage:
#
sub Usage {
print "Usage: $0 sysname\nWhere sysname is one of:\n";
&ListMachines;
}
# checkversion:
# check to make sure that we've got the latest version of this
#
sub checkversion {
$nis_version = &ypmatch("kcons_version");
if (!$nis_version) {
printf(stderr "\n$0: unable to find kcons_version in ktools NIS map.\n");
} else {
if ($nis_version > $REVISION) {
printf(stderr "\n NOTICE: A newer version of $0 is available. \n Please upgrade at your earliest convenience\n");
printf(stderr " for added functionality and bug fixes.\n Install from babylon:/usr/dist/misc/ktools\n");
}
}
}
# checkclasses: verify that there's a classes map to check against, and that
# the KTOOLS_CLASS envariable has valid values.
#
sub checkclasses {
chop ($x = &ypmatch('classes'));
if (!length($x)) {
die "No classes found in ktools NIS map.\n";
}
foreach $class (split ('`', $x)) {
$Class{$class} = &ypmatch($class . '_config');
}
if ($ENV{KTOOLS_CLASS}) {
foreach (split(':', $ENV{KTOOLS_CLASS})) {
if (!$Class{$_}) {
print "ERROR: Unknown class: $ENV{KTOOLS_CLASS}. Valid classes are:\n";
&PrintClasses;
exit 1;
}
}
}
}
########################################
#
sub PrintClasses {
$^ = 'ch';
$~ = 'cd';
foreach (keys Class) {
($C_desc, @x) = split('`', $Class{$_});
$x = join(',', @x);
$C_name = $_;
write;
}
}
########################################
#
sub ListMachines {
$~ = 'mach';
@ypinfo = &ypcat;
foreach (@ypinfo) {
/^(\S+)\s+(.*)/;
$ktools{$1} = $2;
}
if (defined ($_[0])) {
@classes = $_[0];
} elsif (defined ($ENV{'KTOOLS_CLASS'})) {
@classes = split(':', $ENV{'KTOOLS_CLASS'});
}
if (defined @classes) {
foreach $class (@classes) {
$annexes = (split('`', $ktools{$class . '_config'}))[4];
foreach $annex (split(',', $annexes)) {
push( machines, split('`', $ktools{$annex . '_machines'}));
}
}
} else {
foreach (split('`', $ktools{'annexes'})) {
if ($opt_a) {
push( machines, split('`', $ktools{$_ . '_machines'}))
if $opt_a eq $_;
} else {
push( machines, split('`', $ktools{$_ . '_machines'}));
}
}
}
foreach $machine (sort @machines) {
$machine =~ s/\s//g;
$M_mach = $machine;
&slurpMachInfo($ktools{$machine});
write;
}
}
# tapcheck: check to see if a tap session is running
# if so, steal it.
#
sub tapcheck {
if ((($who) = grep(/$ARGV[0].con.$CONSOLE/, @kwho)) && $who =~ /tapper/) {
print STDERR "Tap session for $who found, stealing.\n" if $opt_DEBUG;
$opt_f = 1;
$opt_steal = 1;
$opt_q = 1 if !$opt_DEBUG;
@kwho = (); # so kcons later succeeds
&ksteal;
}
}
# ksteal: Steal a session from someone else
#
sub ksteal {
if (@kwho) { # somebody's using the desired machine
@x = grep(/$ARGV[0].con.$CONSOLE/, @kwho);
$host = substr($x[0], 19, 15); $host =~ s/\s//g;
$person = substr($x[0], 37, 11); $person =~ s/\s//g;
$idle = substr($x[0], 65, 11); $idle =~ s/\s//g;
if ($person =~ /\[(\w+)\]/) {
$person = $1;
print "$ARGV[0] is being used by $person@$host, idle $idle \n";
print "However, it has been locked. Please contact $person directly\n";
print "and have them release the port(s).\n";
exit 1;
}
print "$ARGV[0] is being used by $person@$host, idle $idle \n" if !$opt_q;
if (($hour, $min) = $idle =~ /(\d+):(\d+)/) {
$waylong = 1 if $hour >= 2;
}
$waylong = $opt_f if $opt_f;
if (!$waylong) {
print "Can't steal $ARGV[0], idle time less than 2 hours.\n" if !$opt_q;
exit (1);
}
}
&ResetEm;
grep(s/$ARGV[0]//, @kwho); # remove old status info from kwho
$stole = $opt_f ? "forcefully stole" : "stole";
`echo "$ENV{'USER'} $stole $ARGV[0] from you at $DATE, idle $idle\n" | Mail -s 'Annex Box Notice' $person@$host` if !$opt_q;
}
#########################################
#
sub PrintNote {
$~ = note;
print "NOTES:\n";
write;
}
#########################################
#
sub ResetEm {
print "Stealing $ARGV[0]\n" if !$opt_q;
$sysinfo = &ypmatch($ARGV[0]);
&slurpMachInfo($sysinfo);
# $consoles = (split('`', $sysinfo))[17]; $consoles =~ s/,\s*$//;
# $annex = (split('`', $sysinfo))[15];
$M_consoles =~ s/r//g;
if ($opt_DEBUG) {
print "/bin/echo 'reset $M_consoles@$M_annex' | /usr/annex/na 1>/dev/null 2>&1\n";
system "/bin/echo 'reset $M_consoles@$M_annex' | /usr/annex/na";
} else {
system "/bin/echo 'reset $M_consoles@$M_annex' | /usr/annex/na 1>/dev/null 2>&1";
}
}
#########################################
#
sub klist {
if (defined $opt_c && !length($opt_c)) {
&PrintClasses;
exit 0;
} else {
if (length($opt_c)) {
print "\n Machines hooked up to the annex boxes:\n" . ' ' x 15 . "class = $opt_c\n" . '=' x 50 . "\n";
} else {
print "\n Machines hooked up to the annex boxes:\n" . ' ' x 15 . "KTOOLS_CLASS = $ENV{KTOOLS_CLASS}\n" . '=' x 50 . "\n";
}
&ListMachines($opt_c);
&checkversion;
exit 0;
}
}
#########################################
#
sub kfree {
$~ = 'mach';
@kwho = `$KWHO`;
@ypinfo = &ypcat;
foreach (@ypinfo) {
/^(\S+)\s+(.*)/;
$ktools{$1} = $2;
}
if (length($opt_c)) {
@classes = $opt_c;
} else {
@classes = split(':', $ENV{'KTOOLS_CLASS'});
}
if (defined @classes) {
foreach $class (@classes) {
foreach $annex (split(',', (split('`', $ktools{$class . '_config'}))[4])) {
push( machines, split('`', $ktools{$annex . '_machines'}));
}
}
} else {
foreach (split('`', $ktools{'annexes'})) {
push( machines, split('`', $ktools{$_ . '_machines'}));
}
}
print " Unused Machines";
if (length($opt_c)) {
print " (class = $opt_c):\n";
} else {
print $ENV{'KTOOLS_CLASS'} ? " (KTOOLS_CLASS = $ENV{'KTOOLS_CLASS'}):\n" : ":\n";
}
print '=' x 60 . "\n";
foreach $machine (sort @machines) {
$machine =~ s/\s//g;
$M_mach = $machine;
&slurpMachInfo($ktools{$machine});
if (!grep(/$M_mach/, @kwho)) {
write;
}
}
&checkversion;
exit 0;
}
#########################################
#
sub kgrab_setup {
#customizable defaults:
$con1_geom = ""; $dbg1_geom = "";
$con2_geom = ""; $dbg2_geom = "";
$con3_geom = ""; $dbg3_geom = "";
$con4_geom = ""; $dbg4_geom = "";
$con5_geom = ""; $dbg5_geom = "";
$con6_geom = ""; $dbg6_geom = "";
$con7_geom = ""; $dbg7_geom = "";
$con8_geom = ""; $dbg8_geom = "";
$CMD = "xwsh";
$openiconic = 0;
#
#pick up any customizations from the user:
if ( -r $RCFILE) {
open (RCFILE, $RCFILE);
while (<RCFILE>) {
s/set /\$/; $_ .= ';';
eval "$_";
}
}
$opt_dbg = $debug if $debug;
@con_geom = ($con1_geom, $con2_geom, $con3_geom, $con4_geom,
$con5_geom, $con6_geom, $con7_geom, $con8_geom);
@dbg_geom = ($dbg1_geom, $dbg2_geom, $dbg3_geom, $dbg4_geom,
$dbg5_geom, $dbg6_geom, $dbg7_geom, $dbg8_geom);
$iconic = '-iconic' if $openiconic; #
}
#########################################
#
sub Keys {
local ($sub) = $_[1];
local (@keys) = eval "keys %$_[0]";
local (@return);
foreach (@keys) {
push (@return, $1) if /$sub$;(\S+)/;
}
@return;
}
sub Values {
local ($sub) = $_[1];
local (@keys) = &Keys($_[0], $sub);
local (@return);
foreach (@keys) {
eval "push (\@return, \$$_[0]{$sub, $_})";
}
@return;
}
sub Defined {
local ($sub) = $_[1];
local (@keys) = &Keys($_[0], $sub);
foreach (@keys) {
return 1 if eval "defined \$$_[0]{$sub, $_}";
}
return 0;
}
format mach =
@<<<<<<<<< @<<<<< @<<<<<<<<<< @<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$M_mach, $M_mach_type, $M_mktg_mach_type, $M_mem, $M_desc
~ @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
"$M_loc $M_full_owner"
.
format note =
~^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$M_notes
~^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$M_notes
~^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$M_notes
~^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$M_notes
~^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$M_notes
~^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$M_notes
.
format ch =
Class name Class description Class owner, email, extension
---------- ----------------- -----------------------------
.
format cd =
@<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$_, $C_desc, $x
.