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 error "$name is not supported on 64 bit versions of Perl", 1
264 if $Config{archname} =~ /64/;
268 help => 'appiddisplay',
269 description => 'Displays App ID information',
273 help => 'appidclear <index>',
274 description => 'Clears the specified App ID index',
278 help => 'cmds [<str>]',
279 description => 'Lists currently loaded commands (matching <str>).',
283 help => 'debug [<on|off>]',
284 description => 'Turn on|off debuging of raid and debugsh. With no options displays
290 description => "Exits $name.",
295 description => 'Displays all available modules',
299 help => 'perl <expression>',
300 description => 'Evaluate a Perl expression. Must be on one line.',
305 description => "Quits $name.",
310 description => "Reinitializes $name",
314 help => 'timeout [<n>]',
315 description => 'Set timeout to <n> seconds. If n = 0 then timeout is disabled. Without <n> just show current timeout value.',
320 description => 'Displays version information.',
328 # Seed PATH and LD_LIBRARY_PATH (Hack)
329 $ENV{PATH} = "/usr/wichorus/sysroot/usr/bin:/usr/wichorus/sysroot/usr/libexec/gcc/i386-redhat-linux/4.1.2:$ENV{PATH}";
330 $ENV{LD_LIBRARY_PATH} = "/usr/wichorus/sysroot/usr/lib";
332 my ($cmdline, $attribs, $line, $result, $dsh);
334 sub terminateDebugSh () {
336 kill HUP => $debugshPid;
338 waitpid $debugshPid, 0;
340 my $result = DbgShRaidUnRegister ();
342 warning "DbgShRaidRegister returned $result"
345 # Close old debugsh if we are reinitializing
354 sub set_prompt (;$$) {
355 my ($cmd, $nbr) = @_;
357 my $ignstart = $CmdLine::cmdline->{ignstart};
358 my $ignstop = $CmdLine::cmdline->{ignstop};
363 return $ignstart . color ('cyan') . $ignstop . $name
364 . $ignstart . color ('reset') . $ignstop . ' <'
365 . $ignstart . color ('yellow') . $ignstop . '\#'
366 . $ignstart . color ('reset') . $ignstop . '> ';
375 my ($module, $path, $suffix) = fileparse ($file, ('\.a$', '\.so$', '\.h$'));
388 error "Unable to open file $h - $!";
392 open my $file, '<', $h
393 or error "Unable to open $h", 1;
409 chomp; chop if /\r$/;
414 } elsif (/^\*{5,}/) {
415 error 'Missing user input keyword', 1
418 # We need to loop through and make sure that this new user input string
419 # does not previously appear, even if abbreviated. So we can't have say
420 # a new command - "my command" - when we already had a command such as
421 # "my command is nice".
422 foreach (keys %funcs) {
423 error "Ambiguous command \"$userinput\" & \"$_\" found in $h", 1
427 # Now test for the other way where we already have "my command" in %funcs
428 # and we are trying to add "my command is nice".
431 foreach my $word (split /\s+/, $userinput) {
438 # See if this exactly matches any existing key
439 error "Ambiguous command \"$userinput\" & \"$_\" found in $h", 1
443 $funcs{$userinput}{funcname} = $funcname; undef $funcname;
444 $funcs{$userinput}{help} = $help; undef $help;
445 $funcs{$userinput}{description} = $description; undef $description;
446 $funcs{$userinput}{module} = $module; undef $module;
447 $funcs{$userinput}{prototype} = $prototype; undef $prototype;
448 $funcs{$userinput}{parms} = $parms; undef $parms;
449 $funcs{$userinput}{returntype} = $returntype; undef $returntype;
450 $funcs{$userinput}{type} = $type; undef $type;
453 } elsif ($indefinition and $_ =~ /^\s*user input:\s*(.+)/i) {
454 $userinput = $1; $userinput =~ s/\s*$//;
455 } elsif ($indefinition and $_ =~ /^\s*prototype:\s*(.+);*/i) {
456 $prototype = $1; $prototype =~ s/\s*$//;
458 while ($prototype !~ /\);*\s*$/) {
462 chomp; chop if /\r$/;
470 error "Unterminated function prototype found in $h", 1;
474 my $str = $prototype;
476 # Remove annoying spaces around delimiters only
477 $str =~ s/\s*(\*|\(|\)|\,)\s*/$1/g;
479 my @parts = split /(\s+|\(|\)|\*)/, $str;
481 # Handle the case where prototype lacks a return type (technically
482 # invalid but we're such nice guys...). Note we simply assume they meant
483 # "void" for a return type.
484 if ($parts[1] eq '(') {
485 $funcname = $parts[0];
486 $returntype = 'void';
487 $parms = join '', @parts[1..$#parts];
488 } elsif ($parts[1] eq '*') {
489 $funcname = $parts[2];
490 $returntype = "$parts[0]*";
491 $parms = join '', @parts[3..$#parts];
493 $funcname = $parts[2];
494 $returntype = $parts[0];
495 $parms = join '', @parts[3..$#parts];
498 $module = moduleName $h;
499 } elsif ($indefinition and $_ =~ /^\s*help:\s*(.*)/i) {
500 $help = $1; $help =~ s/\s*$//;
501 } elsif ($indefinition and $_ =~ /^\s*description:\s*(.*)/i) {
502 my $desc = $1; $desc =~ s/\s*$//;
506 $description = $desc unless $desc eq '';
508 } elsif ($indefinition and $_ =~ /^\s*category:\s*(\d+)/i) {
510 } elsif ($indefinition and $indefinition == 2) {
518 $description .= "\n$_";
531 sub loadModules ($) {
534 # Load all known commands by combing through $FindBin::Bin/rc/*.h
535 opendir my $rc, $rcdir
536 or error "Unable to opendir $rcdir", 1;
539 my @modules = grep { !/^\./ } readdir $rc;
540 @modules = grep { /.+\.h$/ } @modules;
545 my $moduleFile = "$rcdir/$_";
546 my $module = moduleName $moduleFile;
547 my %funcs = parseh $moduleFile;
549 foreach (keys %funcs) {
550 error "Duplicate definition $_ found in $moduleFile", 1
551 if defined $moduleFuncs{$_};
553 $moduleFuncs{$_} = $funcs{$_};
556 $modules{$module} = {
557 moduleFile => $moduleFile,
566 my ($moduleName, $moduleStatus, $moduleFile);
569 @<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<
570 $moduleName,$moduleStatus
572 foreach $moduleName (sort keys %modules) {
573 next if $moduleName eq 'DbgSh';
575 $moduleStatus = ($modules{$moduleName}{loaded}) ? 'loaded' : 'not loaded';
584 my ($file, $lib) = @_;
586 my ($module, $path, $suffix) = fileparse ($file, ('\.a$', '\.so$', '\.h$'));
591 display_nolf color ('dark') . "Loading $module..." . color ('reset');
595 if (-f "$path$module.h") {
596 $hfile = "$path$module.h";
597 } elsif (-f "${path}inc/$module.h") {
598 $hfile = "${path}inc/$module.h";
603 error "Unable to load $module - .h file missing";
609 if ($lib and -f $lib) {
611 } elsif (-f "${path}lib$module.a") {
612 $libfile = "${path}lib$module.a";
613 } elsif (-f "${path}lib$module.so") {
614 $libfile = "${path}lib$module.so";
615 } elsif (-f "${path}lib/lib$module.a") {
616 $libfile = "${path}lib/lib$module.a";
617 } elsif (-f "${path}lib/lib$module.so") {
618 $libfile = "${path}lib/lib$module.so";
619 } elsif (-f "${path}../lib/lib$module.a") {
620 $libfile = "${path}../lib/lib$module.a";
621 } elsif (-f "${path}../lib/lib$module.so") {
622 $libfile = "${path}../lib/lib$module.so";
627 error "Unable to load $module - .a or .so file missing";
631 # Need absolute pathname for -L
634 (undef, $libpath, $libfile) =
635 File::Spec->splitpath (File::Spec->rel2abs ($libfile));
637 # Strip trailing "/", if any
641 my $devWinfraLibPath = "$FindBin::Bin/../../../../9200_packetcore/"
642 . "packetcore/infra/lib/src";
643 my $prodWinfraLibPath = '/usr/wichorus/lib';
644 my $devDbgShLibPath = "$FindBin::Bin/lib";
645 my $libs = "-L$libpath -L$libpath/lib -L$devWinfraLibPath -L$devDbgShLibPath "
646 . "-L$prodWinfraLibPath -l$module -lDbgSh -lwinfra -lrt";
647 $libs .= " $opts{additionallibs}" if $opts{additionallibs};
649 verbose "Binding C functions defined in $hfile";
650 debug "Loading module $module";
651 debug "libs = $libs";
653 my ($status, @output) = Execute 'uname -r';
655 if ($output[0] =~ /WR3.0.2ax_cgl/) {
656 my $sysroot = '/usr/wichorus/sysroot';
660 CC => "$sysroot/usr/bin/gcc",
661 LD => "$sysroot/usr/bin/ld",
662 CCFLAGS => "-I$sysroot/usr/include -I$sysroot/usr/lib/gcc/i386-redhat-linux/4.1.2/include",
663 LDDLFLAGS => "-fPIC -shared -O2 -L$sysroot/usr/lib -L/usr/local/lib",
665 ENABLE => 'AUTOWRAP',
666 FORCE_BUILD => $opts{build},
667 BUILD_NOISY => $opts{noisy},
668 CLEAN_AFTER_BUILD => $opts{clean},
669 PRINT_INFO => $opts{info},
675 ENABLE => 'AUTOWRAP',
676 FORCE_BUILD => $opts{build},
677 BUILD_NOISY => $opts{noisy},
678 CLEAN_AFTER_BUILD => $opts{clean},
679 PRINT_INFO => $opts{info},
683 # Now the module's loaded
684 $modules{$module}{loaded} = 1;
685 $modules{$module}{moduleFile} = $hfile;
687 $CmdLine::cmdline->set_prompt (set_prompt);
690 %allcmds = %raidCmds;
692 $allcmds{$_} = $funcs{$_} foreach (keys %funcs);
695 $CmdLine::cmdline->set_cmds (%allcmds);
697 display color ('dark') . 'done' . color ('reset');
703 my ($status, @output) = (0, ());
705 debug "ENTER: getOutput";
710 if (/\s*DBGSH\s*\[$debugshPid\]:\s*(\d+)$/) {
711 debug "Found DBGSH line - status = $1";
716 # Trim output of both \n and \r;
717 chomp; chop if /\r$/;
719 debug "Pushing '$_' on output";
724 if ($@ =~ /Operation aborted/) {
725 debug "Operation aborted - cleaning pipe";
727 # Need to remove debris from the pipe
729 debug "Found debris: $_";
731 if (/\s*DBGSH\s*\[$debugshPid\]:\s*(\d+)$/) {
732 debug "Found DBSH line - status = $1";
738 debug "Returning error $@";
739 return (undef, ($@));
741 debug "Returning output (Status: $status)";
742 return ($status, @output);
747 my @debugsh = ($opts{debugsh});
749 push @debugsh, '2>&1';
751 local $SIG{INT} = 'IGNORE';
753 $debugshPid = open $dsh, '-|', @debugsh
754 or error "Unable to start pipe for $opts{debugsh}", 1;
756 # Turn off buffering on $dsg
759 # Temporarily turn off eval
760 my $oldEval = $CmdLine::cmdline->set_eval;
763 $CmdLine::cmdline->_set ('DEBUGSHPID', $debugshPid);
766 $CmdLine::cmdline->set_eval ($oldEval);
768 # Load our interface to DbgSh lib
769 load "$FindBin::Bin/DbgShRaidAPI", "$FindBin::Bin/lib/libDbgSh.a";
771 $debugshVer = GetDbgShVer ();
773 # Check verion of debugsh
774 my $minimumVer = '0.3.0';
776 error "Debugsh Version $debugshVer must be >= $minimumVer", 1
777 if compareVersions ($debugshVer, $minimumVer) == -1;
779 DbgShRaidRegister ($debugshPid);
782 DbgShProcessUserInput (DBGSH_APPID, $debugshPid, 'SetDebug');
784 my ($result, @output) = getOutput;
786 $CmdLine::cmdline->_set ('result', $result);
788 $CmdLine::cmdline->handleOutput ('', @output);
790 error "$line was not successful (Result: $result)"
808 . "Abort current operation (y/N)?"
811 my $response = <STDIN>;
814 if ($response =~ /(^y$|^yes$)/i) {
815 DbgShProcessUserInput (DBGSH_APPID, $debugshPid, 'Interrupted');
816 die "Operation aborted\n";
819 display color ('cyan') . 'Continuing...' . color ('reset');
823 # Stop debugsh if it was running
826 # Intialize functions (Type 1 commands)
828 # Load %funcs with all type 1 commands. Nothing is loaded by this. Loading
829 # (actually binding) of C libraries is done automatically when the command
831 %funcs = loadModules $opts{rc};
835 warning "Unable to find RC commands in $opts{rc}";
838 # Load commands from config file (Type 2 commands)
839 foreach (keys %opts) {
842 if (/^type2_(\S+)/) {
852 prototype => "$cmd <cmd>",
853 help => "Send <cmd> (AppID $opts{$_}) to debugsh",
857 # Now combine %funcs, which contain all type 1 and type 2 commands, and
858 # %raidCmds, which contain raid commands like load, unload, perl, restart,
860 %allcmds = %raidCmds;
862 foreach (keys %funcs) {
863 $allcmds{$_} = $funcs{$_};
867 my $result = debugshInit;
869 error "Unable to initialize debugsh", $result
873 sub compareVersions ($$) {
874 my ($version1, $version2) = @_;
876 $version1 =~ s/\.//g;
877 $version2 =~ s/\.//g;
879 return $version1 <=> $version2;
882 sub setVersionStr () {
883 my $raidVersionStr = color ('cyan')
887 . ' (Real Aid in Debugging) '
896 my $debugshVerStr = color ('cyan')
897 . 'Debug Shell Core '
904 return $raidVersionStr . "\n" . $debugshVerStr;
908 my ($cmd, %funcs) = @_;
910 if (keys %funcs == 0) {
911 warning "Nothing loaded";
915 my @colors = (color ('dark'), color ('magenta'), color ('green'));
919 if ($cmd and $cmd =~ /^\s*(\w+)/) {
924 $funcs{$a}{type} <=> $funcs{$b}{type} ||
929 unless /$searchStr/i;
934 $color = $colors[$funcs{$_}{type}]
935 if $colors[$funcs{$_}{type}];
942 if ($funcs{$_}{type} == 1) {
943 $boldOn = color ('white on_magenta');
944 $boldOff = color ('reset') . $color;
945 } elsif ($funcs{$_}{type} == 2) {
946 $boldOn = color ('white on_green');
947 $boldOff = color ('reset') . $color;
951 $cmdName =~ s/($searchStr)/$boldOn$1$boldOff/;
954 my $line = $color . $cmdName;
955 $line .= " $funcs{$_}{parms}" if $funcs{$_}{parms};
956 $line .= color ('reset');
957 $line .= " - $funcs{$_}{help}" if $funcs{$_}{help};
962 $CmdLine::cmdline->handleOutput ('', @output);
971 my ($result, @output);
974 if ($timeout < 0 or $timeout > 100) {
975 error "Timeout must be between 0 and 100";
977 $CmdLine::cmdline->_set ('result', 1);
982 DbgShProcessUserInput (DBGSH_APPID, $debugshPid, "SetTimeout $timeout");
984 ($result, @output) = getOutput;
986 $CmdLine::cmdline->_set ('result', $result);
988 $CmdLine::cmdline->handleOutput ('', @output);
990 error "Unable to set timeout (Result: $result)"
993 DbgShProcessUserInput (DBGSH_APPID, $debugshPid, 'GetTimeout');
995 ($result, @output) = getOutput;
997 $CmdLine::cmdline->_set ('result', $result);
999 $CmdLine::cmdline->handleOutput ('', @output);
1001 error "Unable to get timeout (Result: $result)"
1007 my ($cmd, @parms) = @_;
1009 # Check to see if we know about this $cmd
1012 foreach (keys %funcs) {
1013 next unless /^$cmd$/i;
1022 error "Unknown command: $cmd";
1027 # Check to see if the module's been loaded
1028 unless ($modules{$funcs{$cmd}{module}}{loaded}) {
1029 if ($funcs{$cmd}{module}) {
1030 unless (load $modules{$funcs{$cmd}{module}}{moduleFile}) {
1031 error "Unable to load module for $cmd";
1035 error "Undefined module for $cmd";
1040 my ($result, @output);
1045 $result = &{$funcs{$cmd}{funcname}} (@parms);
1056 unless $funcs{$cmd}{type} == 1;
1058 ($result, @output) = getOutput;
1060 $CmdLine::cmdline->handleOutput ($cmd, @output);
1069 my $result = $CmdLine::cmdline->_get('result');
1072 if ($line =~ /^\s*(exit|quit)\s*$/i) {
1075 } elsif ($result =~ /^\s*(\d+)\s*$/) {
1080 } elsif ($line =~ /^\s*version/i) {
1081 display setVersionStr;
1083 } elsif ($line =~ /^\s*cmds\s+(.*)/i) {
1086 } elsif ($line =~ /^\s*cmds\s*$/i) {
1089 } elsif ($line =~ /^\s*restart\s*$/i) {
1092 } elsif ($line =~ /^\s*debug\s+(\S+)/i) {
1095 if ($1 =~ /(1|on)/i) {
1098 DbgShProcessUserInput (DBGSH_APPID, $debugshPid, 'SetDebug');
1100 ($result, @output) = getOutput;
1102 $CmdLine::cmdline->_set ('result', $result);
1104 $CmdLine::cmdline->handleOutput ($line, @output);
1106 error "$line was not successful (Result: $result)"
1110 } elsif ($1 =~ /(0|off)/i) {
1113 DbgShProcessUserInput (DBGSH_APPID, $debugshPid, 'ClearDebug');
1115 ($result, @output) = getOutput;
1117 $CmdLine::cmdline->_set ('result', $result);
1119 $CmdLine::cmdline->handleOutput ($line, @output);
1121 error "$line was not successful (Result: $result)"
1126 error "Unknown command: $line";
1129 } elsif ($line =~ /^\s*timeout\s+([-+]*\d+)/i) {
1133 } elsif ($line =~ /^\s*timeout\s*$/i) {
1137 } elsif ($line =~ /^\s*debug\s*$/) {
1139 display 'Debug is currently on';
1141 display 'Debug is currently off';
1145 } elsif ($line =~ /^\s*appiddisplay\s*$/i) {
1148 } elsif ($line =~ /^\s*appidclear\s+(\d+)\s*$/i) {
1149 DbgShAppIdClearIdx ($1);
1151 } elsif ($line =~ /^\s*perl\s*(.*)/) {
1152 # Need to turn off scrict for eval
1153 eval "no strict; $1; use strict";
1156 } elsif ($line =~ /^\s*modules\s*$/i) {
1159 } elsif ($line =~ /^\s*(.+)\s*$/) {
1160 my @userinput = split /[,\s\t]+/, $1;
1161 my $userinput = join ' ', @userinput;
1162 my $funcname = $userinput[0];
1164 # We have a slight problem here. It is possible for a type 1 command and a
1165 # type 2 command to clash. For example, if a type 1 command is defined as
1166 # "ckt show id" then that will conflict with the type 2 command "ckt". In
1167 # such cases which do we call?
1169 # Here's what we do. We favor type 1 calls (as they are the future). If we
1170 # do not find a type 1 call we'll check for a type 2. If we find neither
1171 # then we have an unknown command situation.
1173 # If we find a type 1 command but no type 2 then we simply execute the type
1176 # If we do not find a type 1 command but find a type 2 command then we
1177 # simply execute the type 2 command.
1179 # However if we find a type 1 command *and* we find a type 2 command we have
1180 # and error situation so we give an error.
1182 # Search for type 1 command
1183 while ($userinput ne '') {
1184 last if $funcs{$userinput} and $funcs{$userinput}{type} != 2;
1186 unshift @parms, pop @userinput;
1188 $userinput = join ' ', @userinput;
1191 if ($userinput eq '') {
1192 # No type 1 command - check type 2
1193 if ($funcs{$funcname} and $funcs{$funcname}{type} == 2) {
1196 # Strip off any thing that begins with "\S+_"
1197 $line =~ s/^\s*\S+_(.+)/$1/;
1199 DbgShProcessUserInput ($funcs{$funcname}{appID}, $debugshPid, $line);
1201 ($result, @output) = getOutput;
1203 $CmdLine::cmdline->_set ('result', $result);
1205 $CmdLine::cmdline->handleOutput ($line, @output);
1207 error "$line was not successful (Result: $result)"
1212 error "Unknown command: $line";
1217 # We've found a type 1 command but is there a clashing type 2 command?
1218 if ($funcs{$funcname} and $funcs{funcname}{type} == 2) {
1219 error "Clash between type 1 and type 2 commands for $funcname";
1226 foreach my $parm (@parms) {
1227 # Strip () if they are there
1228 $parm =~ s/^\s*\(//;
1229 $parm =~ s/\)\s*$//;
1235 $parm = oct ($parm) if $parm =~ /^0/;
1238 $result = callc $userinput, @parms;
1240 error "Unknown command: $line";
1245 $CmdLine::cmdline->_set ('result', $result)
1254 $CmdLine::cmdline->_set ('result', 1);
1258 $opts{histfile} = $ENV{RAID_HISTFILE}
1259 ? $ENV{RAID_HISTFILE}
1261 $opts{debugsh} = $ENV{RAID_DEBUGSH}
1262 ? $ENV{RAID_DEBUGSH}
1263 : "$FindBin::Bin/debugsh";
1264 $opts{load} = $ENV{RAID_LOAD}
1267 $opts{lib} = $ENV{RAID_LIB}
1270 $opts{additionalLibs} = $ENV{RAID_ADDITIONALLIBS}
1271 ? $ENV{RAID_ADDITIONALLIBS}
1273 $opts{rc} = $ENV{RAID_RC}
1275 : "$FindBin::Bin/rc";
1282 'verbose' => sub { set_verbose },
1283 'debug' => sub { set_debug },
1284 'usage' => sub { Usage },
1299 if ($opts{version}) {
1300 display "$name Version $VERSION";
1304 $SIG{INT} = \&interrupt;
1308 timeout $opts{timeout} if $opts{timeout};
1310 load $opts{load}, $opts{lib}
1313 # Single execution from command line
1315 my $result = evaluate join ' ', @ARGV;
1324 $CmdLine::cmdline->set_histfile ($opts{histfile})
1327 $CmdLine::cmdline->set_prompt (set_prompt);
1328 $CmdLine::cmdline->set_cmds (%allcmds);
1329 $CmdLine::cmdline->set_eval (\&evaluate);
1331 while ((($line, $result) = $CmdLine::cmdline->get)) {
1332 last unless defined $line;
1333 next if $line =~ /^\s*($|\#)/;
1335 $result = evaluate $line;
1337 if (defined $result) {
1338 if (ref \$result eq 'SCALAR') {
1339 if ($line =~ /^\s*(\S+)/) {
1343 # We used to output only for raidcmds...
1344 $CmdLine::cmdline->handleOutput ($line, split /\n/, $result);
1346 display "Sorry but I cannot display structured results";
1350 $CmdLine::cmdline->set_prompt (set_prompt $cmd);
1353 $result = $CmdLine::cmdline->_get ('result');
1357 } elsif ($result =~ /^\s*(\d+)\s*$/) {