arti/irix-657m-src
1
0
Fork 0
Code Activity
Files
8fc8fa80899c66937979cd5b807766a40b74cd13
irix-657m-src/eoe/cmd/ktools/ksteal
T
calmsacibis995 8fc8fa8089 Source code upload
2022-09-29 17:59:04 +03:00

566 lines
15 KiB
Perl
Executable File
Raw Blame History

#!/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
.
View Git Blame Copy Permalink