7 =head1 NAME $RCSfile: raid,v $
9 RAiD: Real Aid in Debugging
11 This script will dynamically load C functions described in a .h file
12 and provide a command line interface to calling those functions.
20 Andrew DeFaria <Andrew@ClearSCM.com>
28 Fri Apr 29 11:58:36 PDT 2011
32 $Date: 2012/04/13 18:14:02 $
38 Usage raid: [-u|sage] [-verb|ose] [-deb|ug] [-vers|ion] [-rc <dir>]
39 [-lo|ad <.h file>] [-li|b <.a file>] [-h|istfile <file>]
43 -u|sage: Displays usage
46 -deb|ug: Output debug messages
47 -vers|ion: Display raid's version and exit
49 -rc <file>: Directory to find "run commands"
50 -lo|ad <module>: A module to load
51 -li|b <library>: A library to load
52 -h|istfile <file>: Use <file> as history file.
53 -t|imeout <n>: Set the timeout to n seconds (Default: 5 seconds)
57 This script loads functions defined in a C module so that Perl can
58 call them dirctly. A C module is defined to be a set of files, a .h
59 file and a .a (or .so) file. The .h file must have specific comments
60 in it to identify things properly for raid. These are:
66 A prototype line that describes the C function to call
70 A user input string which, when matched, tells raid to call the
71 corresponding C function.
75 A short help string that describes the function.
77 =item description (optional)
79 A longer description string that can span multiple lines.
83 A category - either 0 or 1 - defining the category of call. Normally
84 this is 1 for type 1 calls. Type 1 calls communicate with the backend
85 through debugsh using TIPC and have their output paged. Type 0 calls
86 do not use debugsh and are pure C functions. Any output from type 0
87 calls are written directly to STDOUT and are not paged.
91 Other comments can appear that we will just skip.
93 The format of comments must be close to:
95 int add (int a, int b);
96 /**********************************************************
97 prototype: int add (int a, int b)
100 help: Add two numbers together
101 description: Because Perl's add is not good enough
102 **********************************************************/
104 int subtract (int a, int b)
105 /**********************************************************
106 prototype: int subtract (int a, int b)
109 help: Subtract b from a
110 description: Because Perl's subtract is not good enough
111 **********************************************************/
113 void printit (char *s, int i, double f)
114 /**********************************************************
115 prototype: void printit (char *s, int i, double f)
118 help: Print some different datatypes
119 description: A simple routine to print out some different
120 datatypes. Note the void return.
122 Turns out void returns are OK but void parms... not so good
123 **********************************************************/
125 void backendCall (char *s, int i, double f)
126 /**********************************************************
127 prototype: void backendCall (int i)
128 user input: call back end
130 help: This calls the back end passing it an int
131 **********************************************************/
135 Raid preloads cmds by parsing all .h files in the rc directory. From
136 there it learns of all potential commands that can be loaded. A .h
137 filename is called the "module name". If a call is made to a function
138 raid checks to see if the module has been loaded. If not it loads the
139 module using rc/<module>.h and lib/lib<module>.[a|so]. A module is only
140 loaded once. See modules command to see what modules have been loaded.
144 Inline uses the default Perl typemap file for its default types. This
145 file is called /usr/local/lib/perl5/5.6.1/ExtUtils/typemap, or
146 something similar, depending on your Perl installation. It has
147 definitions for over 40 types, which are automatically used by
148 Inline. (You should probably browse this file at least once, just to
149 get an idea of the possibilities.)
151 Inline parses your code for these types and generates the XS code to
152 map them. The most commonly used types are:
170 If you need to deal with a type that is not in the defaults, just use
171 the generic SV* type in the function definition. Then inside your
172 code, do the mapping yourself. Alternatively, you can create your own
173 typemap files and specify them using the TYPEMAPS configuration
176 Note that the presence of a file named typemap along side your .h and
179 TYPEMAPS specifies a typemap file that defines non-standard C types
180 and how they relate to Perl types.
184 Raid implements a command line with full ReadLine support. It
185 maintains a history stack of your commands for convenient recall as
186 well as audit purposes. Try using the arrow keys or C-p, C-n, C-r
187 Emacs bindings. History is saved between sessions in ~/.raid_hist.
189 There is a small help facility. Type help to get a listing of raid
190 commands as well as the currently loaded C functions. Also, "help <C
191 function name>" will display the detailed help provided in the .h file
196 You can also call raid and give is a parameter on the command line
197 which would be a command to execute. This command may need to be
198 quoted if any spaces or other special characters occur in the command.
202 Raid sets $? equal to the return of the last function called. If the
203 last function called returns a string then raid will set $? equal to 1
204 if the string has anything in it or 0 if it is empty or undefined.
208 For those of your who are color averse, simply export
209 ANSI_COLORS_DISABLED to some value and all coloring will be turned
210 off. Or use the color off|on command.
212 =head1 More information
214 For more information see the internal wiki page:
220 L<http://adp.ca.tellabs.com/twiki/bin/view/9200/RaidDebugShell>
224 L<http://adp.ca.tellabs.com/twiki/bin/view/9200/VersionHistory>
237 use Term::ANSIColor qw (color);
239 # Add our lib directory as well as the appropraite lib areas below "lib" that
240 # contain things like our local copy of Term::ReadLine::Gnu and Inline::C.
241 use lib "$FindBin::Bin/lib",
242 "$FindBin::Bin/lib/perl5/site_perl",
243 "$FindBin::Bin/lib/lib64/",
244 "$FindBin::Bin/lib/lib64/perl5/site_perl";
251 use constant DBGSH_APPID => 300;
253 my $VERSION = '$Revision: 1.1 $';
254 ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
256 my (%opts, %funcs, %allcmds, %modules, $debugshVer);
258 %opts = GetConfig "$FindBin::Bin/../etc/$FindBin::Script.conf";
263 # Not sure why this was not supported on 64 bit Perls...
264 #error "$name is not supported on 64 bit versions of Perl", 1
265 # if $Config{archname} =~ /64/;
269 help => 'appiddisplay',
270 description => 'Displays App ID information',
274 help => 'appidclear <index>',
275 description => 'Clears the specified App ID index',
279 help => 'cmds [<str>]',
280 description => 'Lists currently loaded commands (matching <str>).',
284 help => 'debug [<on|off>]',
285 description => 'Turn on|off debuging of raid and debugsh. With no options displays
291 description => "Exits $name.",
296 description => 'Displays all available modules',
300 help => 'perl <expression>',
301 description => 'Evaluate a Perl expression. Must be on one line.',
306 description => "Quits $name.",
311 description => "Reinitializes $name",
315 help => 'timeout [<n>]',
316 description => 'Set timeout to <n> seconds. If n = 0 then timeout is disabled. Without <n> just show current timeout value.',
321 description => 'Displays version information.',
329 # Seed PATH and LD_LIBRARY_PATH (Hack)
330 $ENV{PATH} = "/usr/wichorus/sysroot/usr/bin:/usr/wichorus/sysroot/usr/libexec/gcc/i386-redhat-linux/4.1.2:$ENV{PATH}";
331 $ENV{LD_LIBRARY_PATH} = "/usr/wichorus/sysroot/usr/lib";
333 my ($cmdline, $attribs, $line, $result, $dsh);
335 sub terminateDebugSh () {
337 kill HUP => $debugshPid;
339 waitpid $debugshPid, 0;
341 my $result = DbgShRaidUnRegister ();
343 warning "DbgShRaidRegister returned $result"
346 # Close old debugsh if we are reinitializing
355 sub set_prompt (;$$) {
356 my ($cmd, $nbr) = @_;
358 my $ignstart = $CmdLine::cmdline->{ignstart};
359 my $ignstop = $CmdLine::cmdline->{ignstop};
364 return $ignstart . color ('cyan') . $ignstop . $name
365 . $ignstart . color ('reset') . $ignstop . ' <'
366 . $ignstart . color ('yellow') . $ignstop . '\#'
367 . $ignstart . color ('reset') . $ignstop . '> ';
376 my ($module, $path, $suffix) = fileparse ($file, ('\.a$', '\.so$', '\.h$'));
389 error "Unable to open file $h - $!";
393 open my $file, '<', $h
394 or error "Unable to open $h", 1;
410 chomp; chop if /\r$/;
415 } elsif (/^\*{5,}/) {
416 error 'Missing user input keyword', 1
419 # We need to loop through and make sure that this new user input string
420 # does not previously appear, even if abbreviated. So we can't have say
421 # a new command - "my command" - when we already had a command such as
422 # "my command is nice".
424 error "Ambiguous command \"$userinput\" & \"$_\" found in $h", 1
428 # Now test for the other way where we already have "my command" in %funcs
429 # and we are trying to add "my command is nice".
432 for my $word (split /\s+/, $userinput) {
439 # See if this exactly matches any existing key
440 error "Ambiguous command \"$userinput\" & \"$_\" found in $h", 1
444 $funcs{$userinput}{funcname} = $funcname; undef $funcname;
445 $funcs{$userinput}{help} = $help; undef $help;
446 $funcs{$userinput}{description} = $description; undef $description;
447 $funcs{$userinput}{module} = $module; undef $module;
448 $funcs{$userinput}{prototype} = $prototype; undef $prototype;
449 $funcs{$userinput}{parms} = $parms; undef $parms;
450 $funcs{$userinput}{returntype} = $returntype; undef $returntype;
451 $funcs{$userinput}{type} = $type; undef $type;
454 } elsif ($indefinition and $_ =~ /^\s*user input:\s*(.+)/i) {
455 $userinput = $1; $userinput =~ s/\s*$//;
456 } elsif ($indefinition and $_ =~ /^\s*prototype:\s*(.+);*/i) {
457 $prototype = $1; $prototype =~ s/\s*$//;
459 while ($prototype !~ /\);*\s*$/) {
463 chomp; chop if /\r$/;
471 error "Unterminated function prototype found in $h", 1;
475 my $str = $prototype;
477 # Remove annoying spaces around delimiters only
478 $str =~ s/\s*(\*|\(|\)|\,)\s*/$1/g;
480 my @parts = split /(\s+|\(|\)|\*)/, $str;
482 # Handle the case where prototype lacks a return type (technically
483 # invalid but we're such nice guys...). Note we simply assume they meant
484 # "void" for a return type.
485 if ($parts[1] eq '(') {
486 $funcname = $parts[0];
487 $returntype = 'void';
488 $parms = join '', @parts[1..$#parts];
489 } elsif ($parts[1] eq '*') {
490 $funcname = $parts[2];
491 $returntype = "$parts[0]*";
492 $parms = join '', @parts[3..$#parts];
494 $funcname = $parts[2];
495 $returntype = $parts[0];
496 $parms = join '', @parts[3..$#parts];
499 $module = moduleName $h;
500 } elsif ($indefinition and $_ =~ /^\s*help:\s*(.*)/i) {
501 $help = $1; $help =~ s/\s*$//;
502 } elsif ($indefinition and $_ =~ /^\s*description:\s*(.*)/i) {
503 my $desc = $1; $desc =~ s/\s*$//;
507 $description = $desc unless $desc eq '';
509 } elsif ($indefinition and $_ =~ /^\s*category:\s*(\d+)/i) {
511 } elsif ($indefinition and $indefinition == 2) {
519 $description .= "\n$_";
532 sub loadModules ($) {
535 # Load all known commands by combing through $FindBin::Bin/rc/*.h
536 opendir my $rc, $rcdir
537 or error "Unable to opendir $rcdir", 1;
540 my @modules = grep { !/^\./ } readdir $rc;
541 @modules = grep { /.+\.h$/ } @modules;
546 my $moduleFile = "$rcdir/$_";
547 my $module = moduleName $moduleFile;
548 my %funcs = parseh $moduleFile;
551 error "Duplicate definition $_ found in $moduleFile", 1
552 if defined $moduleFuncs{$_};
554 $moduleFuncs{$_} = $funcs{$_};
557 $modules{$module} = {
558 moduleFile => $moduleFile,
567 my ($moduleName, $moduleStatus, $moduleFile);
570 @<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<
571 $moduleName,$moduleStatus
573 for $moduleName (sort keys %modules) {
574 next if $moduleName eq 'DbgSh';
576 $moduleStatus = ($modules{$moduleName}{loaded}) ? 'loaded' : 'not loaded';
585 my ($file, $lib) = @_;
587 my ($module, $path, $suffix) = fileparse ($file, ('\.a$', '\.so$', '\.h$'));
592 display_nolf color ('dark') . "Loading $module..." . color ('reset');
596 if (-f "$path$module.h") {
597 $hfile = "$path$module.h";
598 } elsif (-f "${path}inc/$module.h") {
599 $hfile = "${path}inc/$module.h";
604 error "Unable to load $module - .h file missing";
610 if ($lib and -f $lib) {
612 } elsif (-f "${path}lib$module.a") {
613 $libfile = "${path}lib$module.a";
614 } elsif (-f "${path}lib$module.so") {
615 $libfile = "${path}lib$module.so";
616 } elsif (-f "${path}lib/lib$module.a") {
617 $libfile = "${path}lib/lib$module.a";
618 } elsif (-f "${path}lib/lib$module.so") {
619 $libfile = "${path}lib/lib$module.so";
620 } elsif (-f "${path}../lib/lib$module.a") {
621 $libfile = "${path}../lib/lib$module.a";
622 } elsif (-f "${path}../lib/lib$module.so") {
623 $libfile = "${path}../lib/lib$module.so";
628 error "Unable to load $module - .a or .so file missing";
632 # Need absolute pathname for -L
635 (undef, $libpath, $libfile) =
636 File::Spec->splitpath (File::Spec->rel2abs ($libfile));
638 # Strip trailing "/", if any
642 my $devWinfraLibPath = "$FindBin::Bin/../../../../9200_packetcore/"
643 . "packetcore/infra/lib/src";
644 my $prodWinfraLibPath = '/usr/wichorus/lib';
645 my $devDbgShLibPath = "$FindBin::Bin/lib";
646 my $libs = "-L$libpath -L$libpath/lib -L$devWinfraLibPath -L$devDbgShLibPath "
647 . "-L$prodWinfraLibPath -l$module -lDbgSh -lwinfra -lrt";
648 $libs .= " $opts{additionallibs}" if $opts{additionallibs};
650 verbose "Binding C functions defined in $hfile";
651 debug "Loading module $module";
652 debug "libs = $libs";
654 my ($status, @output) = Execute 'uname -r';
656 if ($output[0] =~ /WR3.0.2ax_cgl/) {
657 my $sysroot = '/usr/wichorus/sysroot';
661 CC => "$sysroot/usr/bin/gcc",
662 LD => "$sysroot/usr/bin/ld",
663 CCFLAGS => "-I$sysroot/usr/include -I$sysroot/usr/lib/gcc/i386-redhat-linux/4.1.2/include",
664 LDDLFLAGS => "-fPIC -shared -O2 -L$sysroot/usr/lib -L/usr/local/lib",
666 ENABLE => 'AUTOWRAP',
667 FORCE_BUILD => $opts{build},
668 BUILD_NOISY => $opts{noisy},
669 CLEAN_AFTER_BUILD => $opts{clean},
670 PRINT_INFO => $opts{info},
676 ENABLE => 'AUTOWRAP',
677 FORCE_BUILD => $opts{build},
678 BUILD_NOISY => $opts{noisy},
679 CLEAN_AFTER_BUILD => $opts{clean},
680 PRINT_INFO => $opts{info},
684 # Now the module's loaded
685 $modules{$module}{loaded} = 1;
686 $modules{$module}{moduleFile} = $hfile;
688 $CmdLine::cmdline->set_prompt (set_prompt);
691 %allcmds = %raidCmds;
693 $allcmds{$_} = $funcs{$_} for (keys %funcs);
696 $CmdLine::cmdline->set_cmds (%allcmds);
698 display color ('dark') . 'done' . color ('reset');
704 my ($status, @output) = (0, ());
706 debug "ENTER: getOutput";
711 if (/\s*DBGSH\s*\[$debugshPid\]:\s*(\d+)$/) {
712 debug "Found DBGSH line - status = $1";
717 # Trim output of both \n and \r;
718 chomp; chop if /\r$/;
720 debug "Pushing '$_' on output";
725 if ($@ =~ /Operation aborted/) {
726 debug "Operation aborted - cleaning pipe";
728 # Need to remove debris from the pipe
730 debug "Found debris: $_";
732 if (/\s*DBGSH\s*\[$debugshPid\]:\s*(\d+)$/) {
733 debug "Found DBSH line - status = $1";
739 debug "Returning error $@";
740 return (undef, ($@));
742 debug "Returning output (Status: $status)";
743 return ($status, @output);
748 my @debugsh = ($opts{debugsh});
750 push @debugsh, '2>&1';
752 local $SIG{INT} = 'IGNORE';
754 $debugshPid = open $dsh, '-|', @debugsh
755 or error "Unable to start pipe for $opts{debugsh}", 1;
757 # Turn off buffering on $dsg
760 # Temporarily turn off eval
761 my $oldEval = $CmdLine::cmdline->set_eval;
764 $CmdLine::cmdline->_set ('DEBUGSHPID', $debugshPid);
767 $CmdLine::cmdline->set_eval ($oldEval);
769 # Load our interface to DbgSh lib
770 load "$FindBin::Bin/DbgShRaidAPI", "$FindBin::Bin/lib/libDbgSh.a";
772 $debugshVer = GetDbgShVer ();
774 # Check verion of debugsh
775 my $minimumVer = '0.3.0';
777 error "Debugsh Version $debugshVer must be >= $minimumVer", 1
778 if compareVersions ($debugshVer, $minimumVer) == -1;
780 DbgShRaidRegister ($debugshPid);
783 DbgShProcessUserInput (DBGSH_APPID, $debugshPid, 'SetDebug');
785 my ($result, @output) = getOutput;
787 $CmdLine::cmdline->_set ('result', $result);
789 $CmdLine::cmdline->handleOutput ('', @output);
791 error "$line was not successful (Result: $result)"
809 . "Abort current operation (y/N)?"
812 my $response = <STDIN>;
815 if ($response =~ /(^y$|^yes$)/i) {
816 DbgShProcessUserInput (DBGSH_APPID, $debugshPid, 'Interrupted');
817 die "Operation aborted\n";
820 display color ('cyan') . 'Continuing...' . color ('reset');
824 # Stop debugsh if it was running
827 # Intialize functions (Type 1 commands)
829 # Load %funcs with all type 1 commands. Nothing is loaded by this. Loading
830 # (actually binding) of C libraries is done automatically when the command
832 %funcs = loadModules $opts{rc};
836 warning "Unable to find RC commands in $opts{rc}";
839 # Load commands from config file (Type 2 commands)
843 if (/^type2_(\S+)/) {
853 prototype => "$cmd <cmd>",
854 help => "Send <cmd> (AppID $opts{$_}) to debugsh",
858 # Now combine %funcs, which contain all type 1 and type 2 commands, and
859 # %raidCmds, which contain raid commands like load, unload, perl, restart,
861 %allcmds = %raidCmds;
864 $allcmds{$_} = $funcs{$_};
868 my $result = debugshInit;
870 error "Unable to initialize debugsh", $result
874 sub compareVersions ($$) {
875 my ($version1, $version2) = @_;
877 $version1 =~ s/\.//g;
878 $version2 =~ s/\.//g;
880 return $version1 <=> $version2;
883 sub setVersionStr () {
884 my $raidVersionStr = color ('cyan')
888 . ' (Real Aid in Debugging) '
897 my $debugshVerStr = color ('cyan')
898 . 'Debug Shell Core '
905 return $raidVersionStr . "\n" . $debugshVerStr;
909 my ($cmd, %funcs) = @_;
911 if (keys %funcs == 0) {
912 warning "Nothing loaded";
916 my @colors = (color ('dark'), color ('magenta'), color ('green'));
920 if ($cmd and $cmd =~ /^\s*(\w+)/) {
925 $funcs{$a}{type} <=> $funcs{$b}{type} ||
930 unless /$searchStr/i;
935 $color = $colors[$funcs{$_}{type}]
936 if $colors[$funcs{$_}{type}];
943 if ($funcs{$_}{type} == 1) {
944 $boldOn = color ('white on_magenta');
945 $boldOff = color ('reset') . $color;
946 } elsif ($funcs{$_}{type} == 2) {
947 $boldOn = color ('white on_green');
948 $boldOff = color ('reset') . $color;
952 $cmdName =~ s/($searchStr)/$boldOn$1$boldOff/;
955 my $line = $color . $cmdName;
956 $line .= " $funcs{$_}{parms}" if $funcs{$_}{parms};
957 $line .= color ('reset');
958 $line .= " - $funcs{$_}{help}" if $funcs{$_}{help};
963 $CmdLine::cmdline->handleOutput ('', @output);
972 my ($result, @output);
975 if ($timeout < 0 or $timeout > 100) {
976 error "Timeout must be between 0 and 100";
978 $CmdLine::cmdline->_set ('result', 1);
983 DbgShProcessUserInput (DBGSH_APPID, $debugshPid, "SetTimeout $timeout");
985 ($result, @output) = getOutput;
987 $CmdLine::cmdline->_set ('result', $result);
989 $CmdLine::cmdline->handleOutput ('', @output);
991 error "Unable to set timeout (Result: $result)"
994 DbgShProcessUserInput (DBGSH_APPID, $debugshPid, 'GetTimeout');
996 ($result, @output) = getOutput;
998 $CmdLine::cmdline->_set ('result', $result);
1000 $CmdLine::cmdline->handleOutput ('', @output);
1002 error "Unable to get timeout (Result: $result)"
1008 my ($cmd, @parms) = @_;
1010 # Check to see if we know about this $cmd
1014 next unless /^$cmd$/i;
1023 error "Unknown command: $cmd";
1028 # Check to see if the module's been loaded
1029 unless ($modules{$funcs{$cmd}{module}}{loaded}) {
1030 if ($funcs{$cmd}{module}) {
1031 unless (load $modules{$funcs{$cmd}{module}}{moduleFile}) {
1032 error "Unable to load module for $cmd";
1036 error "Undefined module for $cmd";
1041 my ($result, @output);
1046 $result = &{$funcs{$cmd}{funcname}} (@parms);
1057 unless $funcs{$cmd}{type} == 1;
1059 ($result, @output) = getOutput;
1061 $CmdLine::cmdline->handleOutput ($cmd, @output);
1070 my $result = $CmdLine::cmdline->_get('result');
1073 if ($line =~ /^\s*(exit|quit)\s*$/i) {
1076 } elsif ($result =~ /^\s*(\d+)\s*$/) {
1081 } elsif ($line =~ /^\s*version/i) {
1082 display setVersionStr;
1084 } elsif ($line =~ /^\s*cmds\s+(.*)/i) {
1087 } elsif ($line =~ /^\s*cmds\s*$/i) {
1090 } elsif ($line =~ /^\s*restart\s*$/i) {
1093 } elsif ($line =~ /^\s*debug\s+(\S+)/i) {
1096 if ($1 =~ /(1|on)/i) {
1099 DbgShProcessUserInput (DBGSH_APPID, $debugshPid, 'SetDebug');
1101 ($result, @output) = getOutput;
1103 $CmdLine::cmdline->_set ('result', $result);
1105 $CmdLine::cmdline->handleOutput ($line, @output);
1107 error "$line was not successful (Result: $result)"
1111 } elsif ($1 =~ /(0|off)/i) {
1114 DbgShProcessUserInput (DBGSH_APPID, $debugshPid, 'ClearDebug');
1116 ($result, @output) = getOutput;
1118 $CmdLine::cmdline->_set ('result', $result);
1120 $CmdLine::cmdline->handleOutput ($line, @output);
1122 error "$line was not successful (Result: $result)"
1127 error "Unknown command: $line";
1130 } elsif ($line =~ /^\s*timeout\s+([-+]*\d+)/i) {
1134 } elsif ($line =~ /^\s*timeout\s*$/i) {
1138 } elsif ($line =~ /^\s*debug\s*$/) {
1140 display 'Debug is currently on';
1142 display 'Debug is currently off';
1146 } elsif ($line =~ /^\s*appiddisplay\s*$/i) {
1149 } elsif ($line =~ /^\s*appidclear\s+(\d+)\s*$/i) {
1150 DbgShAppIdClearIdx ($1);
1152 } elsif ($line =~ /^\s*perl\s*(.*)/) {
1153 # Need to turn off scrict for eval
1154 eval "no strict; $1; use strict";
1157 } elsif ($line =~ /^\s*modules\s*$/i) {
1160 } elsif ($line =~ /^\s*(.+)\s*$/) {
1161 my @userinput = split /[,\s\t]+/, $1;
1162 my $userinput = join ' ', @userinput;
1163 my $funcname = $userinput[0];
1165 # We have a slight problem here. It is possible for a type 1 command and a
1166 # type 2 command to clash. For example, if a type 1 command is defined as
1167 # "ckt show id" then that will conflict with the type 2 command "ckt". In
1168 # such cases which do we call?
1170 # Here's what we do. We favor type 1 calls (as they are the future). If we
1171 # do not find a type 1 call we'll check for a type 2. If we find neither
1172 # then we have an unknown command situation.
1174 # If we find a type 1 command but no type 2 then we simply execute the type
1177 # If we do not find a type 1 command but find a type 2 command then we
1178 # simply execute the type 2 command.
1180 # However if we find a type 1 command *and* we find a type 2 command we have
1181 # and error situation so we give an error.
1183 # Search for type 1 command
1184 while ($userinput ne '') {
1185 last if $funcs{$userinput} and $funcs{$userinput}{type} != 2;
1187 unshift @parms, pop @userinput;
1189 $userinput = join ' ', @userinput;
1192 if ($userinput eq '') {
1193 # No type 1 command - check type 2
1194 if ($funcs{$funcname} and $funcs{$funcname}{type} == 2) {
1197 # Strip off any thing that begins with "\S+_"
1198 $line =~ s/^\s*\S+_(.+)/$1/;
1200 DbgShProcessUserInput ($funcs{$funcname}{appID}, $debugshPid, $line);
1202 ($result, @output) = getOutput;
1204 $CmdLine::cmdline->_set ('result', $result);
1206 $CmdLine::cmdline->handleOutput ($line, @output);
1208 error "$line was not successful (Result: $result)"
1213 error "Unknown command: $line";
1218 # We've found a type 1 command but is there a clashing type 2 command?
1219 if ($funcs{$funcname} and $funcs{funcname}{type} == 2) {
1220 error "Clash between type 1 and type 2 commands for $funcname";
1227 for my $parm (@parms) {
1228 # Strip () if they are there
1229 $parm =~ s/^\s*\(//;
1230 $parm =~ s/\)\s*$//;
1236 $parm = oct ($parm) if $parm =~ /^0/;
1239 $result = callc $userinput, @parms;
1241 error "Unknown command: $line";
1246 $CmdLine::cmdline->_set ('result', $result)
1255 $CmdLine::cmdline->_set ('result', 1);
1259 $opts{histfile} = $ENV{RAID_HISTFILE}
1260 ? $ENV{RAID_HISTFILE}
1262 $opts{debugsh} = $ENV{RAID_DEBUGSH}
1263 ? $ENV{RAID_DEBUGSH}
1264 : "$FindBin::Bin/debugsh";
1265 $opts{load} = $ENV{RAID_LOAD}
1268 $opts{lib} = $ENV{RAID_LIB}
1271 $opts{additionalLibs} = $ENV{RAID_ADDITIONALLIBS}
1272 ? $ENV{RAID_ADDITIONALLIBS}
1274 $opts{rc} = $ENV{RAID_RC}
1276 : "$FindBin::Bin/rc";
1283 'verbose' => sub { set_verbose },
1284 'debug' => sub { set_debug },
1285 'usage' => sub { Usage },
1300 if ($opts{version}) {
1301 display "$name Version $VERSION";
1305 $SIG{INT} = \&interrupt;
1309 timeout $opts{timeout} if $opts{timeout};
1311 load $opts{load}, $opts{lib}
1314 # Single execution from command line
1316 my $result = evaluate join ' ', @ARGV;
1325 $CmdLine::cmdline->set_histfile ($opts{histfile})
1328 $CmdLine::cmdline->set_prompt (set_prompt);
1329 $CmdLine::cmdline->set_cmds (%allcmds);
1330 $CmdLine::cmdline->set_eval (\&evaluate);
1332 while (($line, $result) = $CmdLine::cmdline->get) {
1334 next if $line =~ /^\s*($|\#)/;
1336 $result = evaluate $line;
1339 if (ref \$result eq 'SCALAR') {
1340 if ($line =~ /^\s*(\S+)/) {
1344 # We used to output only for raidcmds...
1345 $CmdLine::cmdline->handleOutput ($line, split /\n/, $result);
1347 display "Sorry but I cannot display structured results";
1351 $CmdLine::cmdline->set_prompt (set_prompt $cmd);
1354 $result = $CmdLine::cmdline->_get ('result');
1358 } elsif ($result =~ /^\s*(\d+)\s*$/) {