bin/raid

   1 #!/usr/local/bin/perl
   2 use strict;
   3 use warnings;
   4
   5 =pod
   6
   7 =head1 NAME $RCSfile: raid,v $
   8
   9 RAiD: Real Aid in Debugging
  10
  11 This script will dynamically load C functions described in a .h file
  12 and provide a command line interface to calling those functions.
  13
  14 =head1 VERSION
  15
  16 =over
  17
  18 =item Author
  19
  20 Andrew DeFaria <Andrew@ClearSCM.com>
  21
  22 =item Revision
  23
  24 $Revision: 1.1 $
  25
  26 =item Created:
  27
  28 Fri Apr 29 11:58:36 PDT 2011
  29
  30 =item Modified:
  31
  32 $Date: 2012/04/13 18:14:02 $
  33
  34 =back
  35
  36 =head1 SYNOPSIS
  37
  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>]
  40              [-t|imeout <n>]
  41
  42  Where:
  43    -u|sage:       Displays usage
  44
  45    -verb|ose:     Be verbose
  46    -deb|ug:       Output debug messages
  47    -vers|ion:     Display raid's version and exit
  48
  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)
  54
  55 =head1 DESCRIPTION
  56
  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:
  61
  62 =over
  63
  64 =item prototype
  65
  66 A prototype line that describes the C function to call
  67
  68 =item user input
  69
  70 A user input string which, when matched, tells raid to call the
  71 corresponding C function.
  72
  73 =item help (optional)
  74
  75 A short help string that describes the function.
  76
  77 =item description (optional)
  78
  79 A longer description string that can span multiple lines.
  80
  81 =item category:
  82
  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.
  88
  89 =back
  90
  91 Other comments can appear that we will just skip.
  92
  93 The format of comments must be close to:
  94
  95  int add (int a, int b);
  96  /**********************************************************
  97  prototype:   int add (int a, int b)
  98  user input:  myadd
  99  category:    0
 100  help:        Add two numbers together
 101  description: Because Perl's add is not good enough
 102  **********************************************************/
 103  ...
 104  int subtract (int a, int b)
 105  /**********************************************************
 106  prototype:   int subtract (int a, int b)
 107  user input:  mysub
 108  category:    0
 109  help:        Subtract b from a
 110  description: Because Perl's subtract is not good enough
 111  **********************************************************/
 112  ...
 113  void printit (char *s, int i, double f)
 114  /**********************************************************
 115  prototype:   void printit (char *s, int i, double f)
 116  user input:  printer
 117  category:    0
 118  help:        Print some different datatypes
 119  description: A simple routine to print out some different
 120               datatypes. Note the void return.
 121
 122  Turns out void returns are OK but void parms...  not so good
 123  **********************************************************/
 124  ...
 125  void backendCall (char *s, int i, double f)
 126  /**********************************************************
 127  prototype:   void backendCall (int i)
 128  user input:  call back end
 129  category:    1
 130  help:        This calls the back end passing it an int
 131  **********************************************************/
 132
 133 =head1 Autoloading
 134
 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.
 141
 142 =head1 TYPEMAPS
 143
 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.)
 150
 151 Inline parses your code for these types and generates the XS code to
 152 map them. The most commonly used types are:
 153
 154 =over
 155
 156 =item int
 157
 158 =item long
 159
 160 =item double
 161
 162 =item char*
 163
 164 =item void
 165
 166 =item SV*
 167
 168 =back
 169
 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
 174 option.
 175
 176 Note that the presence of a file named typemap along side your .h and
 177 .a file should work.
 178
 179 TYPEMAPS specifies a typemap file that defines non-standard C types
 180 and how they relate to Perl types.
 181
 182 =head1 COMMAND LINE
 183
 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.
 188
 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
 192 (if any).
 193
 194 =head1 One liners
 195
 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.
 199
 200 =head1 Exit status
 201
 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.
 205
 206 =head1 Colors
 207
 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.
 211
 212 =head1 More information
 213
 214 For more information see the internal wiki page:
 215
 216 =over
 217
 218 =item .
 219
 220 L<http://adp.ca.tellabs.com/twiki/bin/view/9200/RaidDebugShell>
 221
 222 =item .
 223
 224 L<http://adp.ca.tellabs.com/twiki/bin/view/9200/VersionHistory>
 225
 226 =back
 227
 228 =cut
 229
 230 use Config;
 231 use Getopt::Long;
 232 use FindBin;
 233 use File::Spec;
 234 use File::Basename;
 235 use IO::Handle;
 236
 237 use Term::ANSIColor qw (color);
 238
 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";
 245
 246 use CmdLine;
 247 use GetConfig;
 248 use Display;
 249 use Utils;
 250
 251 use constant DBGSH_APPID => 300;
 252
 253 my $VERSION  = '$Revision: 1.1 $';
 254   ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
 255
 256 my (%opts, %funcs, %allcmds, %modules, $debugshVer);
 257
 258 %opts = GetConfig "$FindBin::Bin/../etc/$FindBin::Script.conf";
 259
 260 my $debugshPid;
 261 my $name = 'RAiD';
 262
 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/;
 266
 267 my %raidCmds = (
 268   appiddisplay  => {
 269     help        => 'appiddisplay',
 270     description => 'Displays App ID information',
 271   },
 272
 273   appidclear    => {
 274     help        => 'appidclear <index>',
 275     description => 'Clears the specified App ID index',
 276   },
 277
 278   cmds          => {
 279     help        => 'cmds [<str>]',
 280     description => 'Lists currently loaded commands (matching <str>).',
 281   },
 282
 283   debug         => {
 284     help        => 'debug [<on|off>]',
 285     description => 'Turn on|off debuging of raid and debugsh. With no options displays
 286 status of debug.',
 287   },
 288
 289   exit          => {
 290     help        => 'exit',
 291     description => "Exits $name.",
 292   },
 293
 294   modules       => {
 295     help        => 'modules',
 296     description => 'Displays all available modules',
 297   },
 298
 299   perl          => {
 300     help        => 'perl <expression>',
 301     description => 'Evaluate a Perl expression. Must be on one line.',
 302   },
 303
 304   quit          => {
 305     help        => 'quit',
 306     description => "Quits $name.",
 307   },
 308
 309   restart       => {
 310     help        => 'restart',
 311     description => "Reinitializes $name",
 312   },
 313
 314   timeout       => {
 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.',
 317   },
 318
 319   version       => {
 320     help  => 'version',
 321     description => 'Displays version information.',
 322   },
 323 );
 324
 325 use Inline;
 326
 327 my $PROMPT;
 328
 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";
 332
 333 my ($cmdline, $attribs, $line, $result, $dsh);
 334
 335 sub terminateDebugSh () {
 336   if ($debugshPid) {
 337     kill HUP => $debugshPid;
 338
 339     waitpid $debugshPid, 0;
 340
 341     my $result = DbgShRaidUnRegister ();
 342
 343     warning "DbgShRaidRegister returned $result"
 344       if $result;
 345
 346     # Close old debugsh if we are reinitializing
 347     close $dsh if $dsh;
 348
 349     undef $dsh;
 350   } # if
 351
 352   return;
 353 } # terminateDebugSh
 354
 355 sub set_prompt (;$$) {
 356   my ($cmd, $nbr) = @_;
 357
 358   my $ignstart = $CmdLine::cmdline->{ignstart};
 359   my $ignstop  = $CmdLine::cmdline->{ignstop};
 360
 361   my $prompt;
 362
 363   if ($opts{color}) {
 364     return $ignstart . color ('cyan')   . $ignstop . $name
 365          . $ignstart . color ('reset')  . $ignstop . ' <'
 366          . $ignstart . color ('yellow') . $ignstop . '\#'
 367          . $ignstart . color ('reset')  . $ignstop . '> ';
 368   } else {
 369     return "$name <#>";
 370   } # if
 371 } # set_prompt
 372
 373 sub moduleName ($) {
 374   my ($file) = @_;
 375
 376   my ($module, $path, $suffix) = fileparse ($file, ('\.a$', '\.so$', '\.h$'));
 377
 378   $module =~ s/lib//;
 379
 380   return $module;
 381 } # moduleName
 382
 383 sub parseh ($) {
 384   my ($h) = @_;
 385
 386   my %funcs;
 387
 388   unless (-f $h) {
 389     error "Unable to open file $h - $!";
 390     return;
 391   } # unless
 392
 393   open my $file, '<', $h
 394     or error "Unable to open $h", 1;
 395
 396   my (
 397     $indefinition,
 398     $userinput,
 399     $funcname,
 400     $help,
 401     $description,
 402     $module,
 403     $prototype,
 404     $parms,
 405     $returntype,
 406     $type
 407   );
 408
 409   while (<$file>) {
 410     chomp; chop if /\r$/;
 411
 412     if (/^\/\*{5,}/) {
 413       $indefinition = 1;
 414       $type         = 0;
 415     } elsif (/^\*{5,}/) {
 416       error 'Missing user input keyword', 1
 417         unless $userinput;
 418
 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".
 423       for (keys %funcs) {
 424         error "Ambiguous command \"$userinput\" & \"$_\" found in $h", 1
 425           if /^$userinput /;
 426       } # for
 427
 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".
 430       my $str;
 431
 432       for my $word (split /\s+/, $userinput) {
 433         if ($str) {
 434           $str .= " $word";
 435         } else {
 436           $str .= $word;
 437         } # if
 438
 439         # See if this exactly matches any existing key
 440         error "Ambiguous command \"$userinput\" & \"$_\" found in $h", 1
 441           if $funcs{$str};
 442       } # for
 443
 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;
 452
 453       undef $userinput;
 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*$//;
 458
 459       while ($prototype !~ /\);*\s*$/) {
 460         my $line = <$file>;
 461
 462         if ($line) {
 463           chomp; chop if /\r$/;
 464
 465           # Trim
 466           $line =~ s/^\s+//;
 467           $line =~ s/\s+$//;
 468
 469           $prototype .= $line;
 470         } else {
 471           error "Unterminated function prototype found in $h", 1;
 472         } # if
 473       } # while
 474
 475       my $str = $prototype;
 476
 477       # Remove annoying spaces around delimiters only
 478       $str =~ s/\s*(\*|\(|\)|\,)\s*/$1/g;
 479
 480       my @parts = split /(\s+|\(|\)|\*)/, $str;
 481
 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];
 493       } else {
 494         $funcname   = $parts[2];
 495         $returntype = $parts[0];
 496         $parms      = join '', @parts[3..$#parts];
 497       } # if
 498
 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*$//;
 504
 505       $desc =~ s/^\s+//;
 506
 507       $description = $desc unless $desc eq '';
 508       $indefinition = 2;
 509     } elsif ($indefinition and $_ =~ /^\s*category:\s*(\d+)/i) {
 510       $type = $1;
 511     } elsif ($indefinition and $indefinition == 2) {
 512       if (/\*{5,}/) {
 513         $indefinition = 0;
 514         next;
 515       } else {
 516         s/^\s+//;
 517
 518         if ($description) {
 519           $description .= "\n$_";
 520         } else {
 521           $description = $_;
 522         } # if
 523       } # if
 524     } # if
 525   } # while
 526
 527   close $file;
 528
 529   return %funcs;
 530 } # parseh
 531
 532 sub loadModules ($) {
 533   my ($rcdir) = @_;
 534
 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;
 538
 539   my %moduleFuncs;
 540   my @modules = grep { !/^\./ } readdir $rc;
 541      @modules = grep { /.+\.h$/ } @modules;
 542
 543   closedir $rc;
 544
 545   for (@modules) {
 546     my $moduleFile = "$rcdir/$_";
 547     my $module     = moduleName $moduleFile;
 548     my %funcs      = parseh $moduleFile;
 549
 550     for (keys %funcs) {
 551       error "Duplicate definition $_ found in $moduleFile", 1
 552         if defined $moduleFuncs{$_};
 553
 554       $moduleFuncs{$_} = $funcs{$_};
 555     } # for
 556
 557     $modules{$module} = {
 558       moduleFile => $moduleFile,
 559       loaded     => 0,
 560     };
 561   } # for
 562
 563   return %moduleFuncs;
 564 } # loadModules
 565
 566 sub modules () {
 567   my ($moduleName, $moduleStatus, $moduleFile);
 568
 569   format STDOUT =
 570 @<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<
 571 $moduleName,$moduleStatus
 572 .
 573   for $moduleName (sort keys %modules) {
 574     next if $moduleName eq 'DbgSh';
 575
 576     $moduleStatus = ($modules{$moduleName}{loaded}) ? 'loaded' : 'not loaded';
 577
 578     write;
 579   } # for
 580
 581   return;
 582 } # modules
 583
 584 sub load ($;$) {
 585   my ($file, $lib) = @_;
 586
 587   my ($module, $path, $suffix) = fileparse ($file, ('\.a$', '\.so$', '\.h$'));
 588
 589   $module =~ s/lib//;
 590   $path   =~ s/^inc\///;
 591
 592   display_nolf color ('dark') . "Loading $module..." . color ('reset');
 593
 594   my $hfile;
 595
 596   if (-f "$path$module.h") {
 597     $hfile = "$path$module.h";
 598   } elsif (-f "${path}inc/$module.h") {
 599     $hfile = "${path}inc/$module.h";
 600   } # if
 601
 602   unless ($hfile) {
 603     display '';
 604     error "Unable to load $module - .h file missing";
 605     return;
 606   } # unless
 607
 608   my $libfile;
 609
 610   if ($lib and -f $lib) {
 611     $libfile = $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";
 624   } # if
 625
 626   unless ($libfile) {
 627     display '';
 628     error "Unable to load $module - .a or .so file missing";
 629     return;
 630   } # unable
 631
 632   # Need absolute pathname for -L
 633   my $libpath;
 634
 635   (undef, $libpath, $libfile) =
 636     File::Spec->splitpath (File::Spec->rel2abs ($libfile));
 637
 638   # Strip trailing "/", if any
 639   $libpath =~ s/\/$//;
 640
 641   # Compose $libs
 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};
 649
 650   verbose "Binding C functions defined in $hfile";
 651   debug "Loading module $module";
 652   debug "libs = $libs";
 653
 654   my ($status, @output) = Execute 'uname -r';
 655
 656   if ($output[0] =~ /WR3.0.2ax_cgl/) {
 657     my $sysroot   = '/usr/wichorus/sysroot';
 658
 659     Inline->bind (
 660       C                 => $hfile,
 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",
 665       LIBS              => $libs,
 666       ENABLE            => 'AUTOWRAP',
 667       FORCE_BUILD       => $opts{build},
 668       BUILD_NOISY       => $opts{noisy},
 669       CLEAN_AFTER_BUILD => $opts{clean},
 670       PRINT_INFO        => $opts{info},
 671     );
 672   } else {
 673     Inline->bind (
 674       C                 => $hfile,
 675       LIBS              => $libs,
 676       ENABLE            => 'AUTOWRAP',
 677       FORCE_BUILD       => $opts{build},
 678       BUILD_NOISY       => $opts{noisy},
 679       CLEAN_AFTER_BUILD => $opts{clean},
 680       PRINT_INFO        => $opts{info},
 681     );
 682   } # if
 683
 684   # Now the module's loaded
 685   $modules{$module}{loaded}     = 1;
 686   $modules{$module}{moduleFile} = $hfile;
 687
 688   $CmdLine::cmdline->set_prompt (set_prompt);
 689
 690   # Rebuild %allcmds
 691   %allcmds = %raidCmds;
 692
 693   $allcmds{$_} = $funcs{$_} for (keys %funcs);
 694
 695   # Set cmds
 696   $CmdLine::cmdline->set_cmds (%allcmds);
 697
 698   display color ('dark') . 'done' . color ('reset');
 699
 700   return 1;
 701 } # load
 702
 703 sub getOutput () {
 704   my ($status, @output) = (0, ());
 705
 706   debug "ENTER: getOutput";
 707
 708   eval {
 709     while (<$dsh>) {
 710       debug "read: $_";
 711       if (/\s*DBGSH\s*\[$debugshPid\]:\s*(\d+)$/) {
 712         debug "Found DBGSH line - status = $1";
 713         $status = $1;
 714         last;
 715       } # if
 716
 717       # Trim output of both \n and \r;
 718       chomp; chop if /\r$/;
 719
 720       debug "Pushing '$_' on output";
 721       push @output, $_
 722     } # while
 723   };
 724
 725   if ($@ =~ /Operation aborted/) {
 726     debug "Operation aborted - cleaning pipe";
 727
 728     # Need to remove debris from the pipe
 729     while (<$dsh>) {
 730       debug "Found debris: $_";
 731
 732       if (/\s*DBGSH\s*\[$debugshPid\]:\s*(\d+)$/) {
 733         debug "Found DBSH line - status = $1";
 734         $status = $1;
 735         last;
 736       } # if
 737     } # while
 738
 739     debug "Returning error $@";
 740     return (undef, ($@));
 741   } else {
 742     debug "Returning output (Status: $status)";
 743     return ($status, @output);
 744   } # if
 745 } # getOutput
 746
 747 sub debugshInit () {
 748   my @debugsh = ($opts{debugsh});
 749
 750   push @debugsh, '2>&1';
 751
 752   local $SIG{INT} = 'IGNORE';
 753
 754   $debugshPid = open $dsh, '-|', @debugsh
 755     or error "Unable to start pipe for $opts{debugsh}", 1;
 756
 757   # Turn off buffering on $dsg
 758   $dsh->autoflush (1);
 759
 760   # Temporarily turn off eval
 761   my $oldEval = $CmdLine::cmdline->set_eval;
 762
 763   # Set DEBUGSHPID
 764   $CmdLine::cmdline->_set ('DEBUGSHPID', $debugshPid);
 765
 766   # Turn eval back on
 767   $CmdLine::cmdline->set_eval ($oldEval);
 768
 769   # Load our interface to DbgSh lib
 770   load "$FindBin::Bin/DbgShRaidAPI", "$FindBin::Bin/lib/libDbgSh.a";
 771
 772   $debugshVer = GetDbgShVer ();
 773
 774   # Check verion of debugsh
 775   my $minimumVer = '0.3.0';
 776
 777   error "Debugsh Version $debugshVer must be >= $minimumVer", 1
 778     if compareVersions ($debugshVer, $minimumVer) == -1;
 779
 780   DbgShRaidRegister ($debugshPid);
 781
 782   if (get_debug) {
 783     DbgShProcessUserInput (DBGSH_APPID, $debugshPid, 'SetDebug');
 784
 785     my ($result, @output) = getOutput;
 786
 787     $CmdLine::cmdline->_set ('result', $result);
 788
 789     $CmdLine::cmdline->handleOutput ('', @output);
 790
 791     error "$line was not successful (Result: $result)"
 792       if $result;
 793   } # if
 794
 795   return;
 796 } # debugshInit
 797
 798 END {
 799   terminateDebugSh;
 800 } # END
 801
 802 sub interrupt () {
 803   display_nolf
 804     color ('yellow')
 805   . '<Control-C>'
 806   . color ('reset')
 807   . '... '
 808   . color ('red')
 809   . "Abort current operation (y/N)?"
 810   . color ('reset');
 811
 812   my $response = <STDIN>;
 813   chomp;
 814
 815   if ($response =~ /(^y$|^yes$)/i) {
 816     DbgShProcessUserInput (DBGSH_APPID, $debugshPid, 'Interrupted');
 817     die "Operation aborted\n";
 818   } # if
 819
 820   display color ('cyan') . 'Continuing...' . color ('reset');
 821 } # interrupt
 822
 823 sub init () {
 824   # Stop debugsh if it was running
 825   terminateDebugSh;
 826
 827   # Intialize functions (Type 1 commands)
 828   if (-d $opts{rc}) {
 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
 831     # is called.
 832     %funcs = loadModules $opts{rc};
 833   } else {
 834     %funcs = ();
 835
 836     warning "Unable to find RC commands in $opts{rc}";
 837   } # if
 838
 839   # Load commands from config file (Type 2 commands)
 840   for (keys %opts) {
 841     my $cmd;
 842
 843     if (/^type2_(\S+)/) {
 844       $cmd = $1;
 845       #$cmd =~ s/_/ /g;
 846     } else {
 847       next;
 848     } # if
 849
 850     $funcs{$cmd} = {
 851       appID     => $opts{$_},
 852       type      => 2,
 853       prototype => "$cmd <cmd>",
 854       help      => "Send <cmd> (AppID $opts{$_}) to debugsh",
 855     };
 856   } # for
 857
 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,
 860   # etc.
 861   %allcmds = %raidCmds;
 862
 863   for (keys %funcs) {
 864     $allcmds{$_} = $funcs{$_};
 865   } # for
 866
 867   # Initialize debugsh
 868   my $result = debugshInit;
 869
 870   error "Unable to initialize debugsh", $result
 871     if $result;
 872 } # init
 873
 874 sub compareVersions ($$) {
 875   my ($version1, $version2) = @_;
 876
 877   $version1 =~ s/\.//g;
 878   $version2 =~ s/\.//g;
 879
 880   return $version1 <=> $version2;
 881 } # compareVersions
 882
 883 sub setVersionStr () {
 884   my $raidVersionStr = color ('cyan')
 885                      . $name
 886                      . color ('reset')
 887                      . color ('dark')
 888                      . ' (Real Aid in Debugging) '
 889                      . color ('reset')
 890                      . color ('green')
 891                      . 'Version '
 892                      . color ('reset')
 893                      . color ('yellow')
 894                      . $VERSION
 895                      . color ('reset');
 896
 897   my $debugshVerStr = color ('cyan')
 898                     . 'Debug Shell Core '
 899                     . color ('green')
 900                     . 'Version '
 901                     . color ('yellow')
 902                     . $debugshVer
 903                     . color ('reset');
 904
 905   return $raidVersionStr . "\n" . $debugshVerStr;
 906 } # setVersionStr
 907
 908 sub cmds ($%) {
 909   my ($cmd, %funcs) = @_;
 910
 911   if (keys %funcs == 0) {
 912     warning "Nothing loaded";
 913     return;
 914   } else {
 915     my @output;
 916     my @colors = (color ('dark'), color ('magenta'), color ('green'));
 917
 918     my $searchStr;
 919
 920     if ($cmd and $cmd =~ /^\s*(\w+)/) {
 921       $searchStr = $1;
 922     } # if
 923
 924     for (sort {
 925       $funcs{$a}{type} <=> $funcs{$b}{type} ||
 926              $a        cmp        $b
 927     } keys %funcs) {
 928       if ($searchStr) {
 929         next
 930           unless /$searchStr/i;
 931       } # if
 932
 933       my $color = '';
 934
 935       $color = $colors[$funcs{$_}{type}]
 936         if $colors[$funcs{$_}{type}];
 937
 938       my $cmdName = $_;
 939
 940       my $boldOn  = '';
 941       my $boldOff = '';
 942
 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;
 949       } # if
 950
 951       if ($searchStr) {
 952         $cmdName =~ s/($searchStr)/$boldOn$1$boldOff/;
 953       } # if
 954
 955       my $line  = $color . $cmdName;
 956          $line .= " $funcs{$_}{parms}"     if $funcs{$_}{parms};
 957          $line .= color ('reset');
 958          $line .= " - $funcs{$_}{help}" if $funcs{$_}{help};
 959
 960       push @output, $line;
 961     } # for
 962
 963     $CmdLine::cmdline->handleOutput ('', @output);
 964   } # if
 965
 966   return;
 967 } # cmds
 968
 969 sub timeout (;$) {
 970   my ($timeout) = @_;
 971
 972   my ($result, @output);
 973
 974   if ($timeout) {
 975     if ($timeout < 0 or $timeout > 100) {
 976       error "Timeout must be between 0 and 100";
 977
 978       $CmdLine::cmdline->_set ('result', 1);
 979
 980       return;
 981     } # if
 982
 983     DbgShProcessUserInput (DBGSH_APPID, $debugshPid, "SetTimeout $timeout");
 984
 985     ($result, @output) = getOutput;
 986
 987     $CmdLine::cmdline->_set ('result', $result);
 988
 989     $CmdLine::cmdline->handleOutput ('', @output);
 990
 991     error "Unable to set timeout (Result: $result)"
 992       if $result;
 993   } else {
 994     DbgShProcessUserInput (DBGSH_APPID, $debugshPid, 'GetTimeout');
 995
 996     ($result, @output) = getOutput;
 997
 998     $CmdLine::cmdline->_set ('result', $result);
 999
1000     $CmdLine::cmdline->handleOutput ('', @output);
1001
1002     error "Unable to get timeout (Result: $result)"
1003       if $result;
1004   } # if
1005 } # timeout
1006
1007 sub callc ($@) {
1008   my ($cmd, @parms) = @_;
1009
1010   # Check to see if we know about this $cmd
1011   my $found;
1012
1013   for (keys %funcs) {
1014     next unless /^$cmd$/i;
1015
1016     if ($cmd eq $_) {
1017       $found = 1;
1018       last;
1019     } # if
1020   } # for
1021
1022   unless ($found) {
1023     error "Unknown command: $cmd";
1024
1025     return;
1026   } # unless
1027
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";
1033         return;
1034       } # unless
1035     } else {
1036       error "Undefined module for $cmd";
1037       return;
1038     } # if
1039   } # unless
1040
1041   my ($result, @output);
1042
1043   no strict;
1044
1045   eval {
1046     $result = &{$funcs{$cmd}{funcname}} (@parms);
1047   };
1048
1049   use strict;
1050
1051   if ($@) {
1052     display_nolf $@;
1053
1054     return -1;
1055   } else {
1056     return $result
1057       unless $funcs{$cmd}{type} == 1;
1058
1059     ($result, @output) = getOutput;
1060
1061     $CmdLine::cmdline->handleOutput ($cmd, @output);
1062
1063     return $result;
1064   } # if
1065 } # callc
1066
1067 sub evaluate ($) {
1068   my ($line) = @_;
1069
1070   my $result = $CmdLine::cmdline->_get('result');
1071   my @parms;
1072
1073   if ($line =~ /^\s*(exit|quit)\s*$/i) {
1074     unless ($result) {
1075       exit 0;
1076     } elsif ($result =~ /^\s*(\d+)\s*$/) {
1077       exit $1;
1078     } else {
1079       exit 1;
1080     } # if
1081   } elsif ($line =~ /^\s*version/i) {
1082     display setVersionStr;
1083     return;
1084   } elsif ($line =~ /^\s*cmds\s+(.*)/i) {
1085     cmds $1, %funcs;
1086     return;
1087   } elsif ($line =~ /^\s*cmds\s*$/i) {
1088     cmds undef, %funcs;
1089     return;
1090   } elsif ($line =~ /^\s*restart\s*$/i) {
1091     init;
1092     return;
1093   } elsif ($line =~ /^\s*debug\s+(\S+)/i) {
1094     my @output;
1095
1096     if ($1 =~ /(1|on)/i) {
1097       set_debug 1;
1098
1099       DbgShProcessUserInput (DBGSH_APPID, $debugshPid, 'SetDebug');
1100
1101       ($result, @output) = getOutput;
1102
1103       $CmdLine::cmdline->_set ('result', $result);
1104
1105       $CmdLine::cmdline->handleOutput ($line, @output);
1106
1107       error "$line was not successful (Result: $result)"
1108         if $result;
1109
1110       return;
1111     } elsif ($1 =~ /(0|off)/i) {
1112       set_debug 0;
1113
1114       DbgShProcessUserInput (DBGSH_APPID, $debugshPid, 'ClearDebug');
1115
1116       ($result, @output) = getOutput;
1117
1118       $CmdLine::cmdline->_set ('result', $result);
1119
1120       $CmdLine::cmdline->handleOutput ($line, @output);
1121
1122       error "$line was not successful (Result: $result)"
1123         if $result;
1124
1125       return;
1126     } else {
1127       error "Unknown command: $line";
1128       return;
1129     } # if
1130   } elsif ($line =~ /^\s*timeout\s+([-+]*\d+)/i) {
1131     timeout $1;
1132
1133     return;
1134   } elsif ($line =~ /^\s*timeout\s*$/i) {
1135     timeout;
1136
1137     return;
1138   } elsif ($line =~ /^\s*debug\s*$/) {
1139     if (get_debug) {
1140       display 'Debug is currently on';
1141     } else {
1142       display 'Debug is currently off';
1143     } # if
1144
1145     return;
1146   } elsif ($line =~ /^\s*appiddisplay\s*$/i) {
1147     DbgShAppIdInfo ();
1148     return;
1149   } elsif ($line =~ /^\s*appidclear\s+(\d+)\s*$/i) {
1150     DbgShAppIdClearIdx ($1);
1151     return;
1152   } elsif ($line =~ /^\s*perl\s*(.*)/) {
1153     # Need to turn off scrict for eval
1154     eval "no strict; $1; use strict";
1155
1156     $result = $@ ne '';
1157   } elsif ($line =~ /^\s*modules\s*$/i) {
1158     modules;
1159     return;
1160   } elsif ($line =~ /^\s*(.+)\s*$/) {
1161     my @userinput = split /[,\s\t]+/, $1;
1162     my $userinput = join ' ', @userinput;
1163     my $funcname  = $userinput[0];
1164
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?
1169     #
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.
1173     #
1174     # If we find a type 1 command but no type 2 then we simply execute the type
1175     # 1 command.
1176     #
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.
1179     #
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.
1182
1183     # Search for type 1 command
1184     while ($userinput ne '') {
1185       last if $funcs{$userinput} and $funcs{$userinput}{type} != 2;
1186
1187       unshift @parms, pop @userinput;
1188
1189       $userinput = join ' ', @userinput;
1190     } # while
1191
1192     if ($userinput eq '') {
1193       # No type 1 command - check type 2
1194       if ($funcs{$funcname} and $funcs{$funcname}{type} == 2) {
1195         my @output;
1196
1197         # Strip off any thing that begins with "\S+_"
1198         $line =~ s/^\s*\S+_(.+)/$1/;
1199
1200         DbgShProcessUserInput ($funcs{$funcname}{appID}, $debugshPid, $line);
1201
1202         ($result, @output) = getOutput;
1203
1204         $CmdLine::cmdline->_set ('result', $result);
1205
1206         $CmdLine::cmdline->handleOutput ($line, @output);
1207
1208         error "$line was not successful (Result: $result)"
1209           if $result;
1210
1211         return;
1212       } else {
1213         error "Unknown command: $line";
1214
1215         return;
1216       } # if
1217     } else {
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";
1221
1222         return;
1223       } # if
1224     } # if
1225
1226     # Process parms
1227     for my $parm (@parms) {
1228       # Strip () if they are there
1229       $parm =~ s/^\s*\(//;
1230       $parm =~ s/\)\s*$//;
1231
1232       # Trim
1233       $parm =~ s/^\s+//;
1234       $parm =~ s/\s+$//;
1235
1236       $parm = oct ($parm) if $parm =~ /^0/;
1237     } # for
1238
1239     $result = callc $userinput, @parms;
1240   } else {
1241     error "Unknown command: $line";
1242
1243     return;
1244   } # if
1245
1246   $CmdLine::cmdline->_set ('result', $result)
1247     if $result;
1248
1249   return $result
1250 } # evalulate
1251
1252 # Main
1253 $| = 1;
1254
1255 $CmdLine::cmdline->_set ('result', 1);
1256
1257 set_me $name;
1258
1259 $opts{histfile} = $ENV{RAID_HISTFILE}
1260   ? $ENV{RAID_HISTFILE}
1261   : '.raid_hist';
1262 $opts{debugsh} = $ENV{RAID_DEBUGSH}
1263   ? $ENV{RAID_DEBUGSH}
1264   : "$FindBin::Bin/debugsh";
1265 $opts{load} = $ENV{RAID_LOAD}
1266   ? $ENV{RAID_LOAD}
1267   : undef;
1268 $opts{lib} = $ENV{RAID_LIB}
1269   ? $ENV{RAID_LIB}
1270   : undef;
1271 $opts{additionalLibs} = $ENV{RAID_ADDITIONALLIBS}
1272   ? $ENV{RAID_ADDITIONALLIBS}
1273   : '';
1274 $opts{rc} = $ENV{RAID_RC}
1275   ? $ENV{RAID_RC}
1276   : "$FindBin::Bin/rc";
1277 $opts{build} = 1;
1278 $opts{clean} = 1;
1279 $opts{color} = 1;
1280
1281 GetOptions (
1282   \%opts,
1283   'verbose' => sub { set_verbose },
1284   'debug'   => sub { set_debug },
1285   'usage'   => sub { Usage },
1286   'rc=s',
1287   'load=s',
1288   'lib=s',
1289   'histfile=s',
1290   'debugsh=s',
1291   'timeout=i',
1292   'additionallibs=s',
1293   'noisy!',
1294   'build!',
1295   'clean!',
1296   'info!',
1297   'version',
1298 ) || Usage;
1299
1300 if ($opts{version}) {
1301   display "$name Version $VERSION";
1302   exit;
1303 } # if
1304
1305 $SIG{INT} = \&interrupt;
1306
1307 init;
1308
1309 timeout $opts{timeout} if $opts{timeout};
1310
1311 load $opts{load}, $opts{lib}
1312   if $opts{load};
1313
1314 # Single execution from command line
1315 if ($ARGV[0]) {
1316   my $result = evaluate join ' ', @ARGV;
1317
1318   $result ||= 1;
1319
1320   exit $result;
1321 } # if
1322
1323 my ($cmd, @parms);
1324
1325 $CmdLine::cmdline->set_histfile ($opts{histfile})
1326   if $opts{histfile};
1327
1328 $CmdLine::cmdline->set_prompt (set_prompt);
1329 $CmdLine::cmdline->set_cmds (%allcmds);
1330 $CmdLine::cmdline->set_eval (\&evaluate);
1331
1332 while (($line, $result) = $CmdLine::cmdline->get) {
1333   last unless $line;
1334   next if $line =~ /^\s*($|\#)/;
1335
1336   $result = evaluate $line;
1337
1338   if ($result) {
1339     if (ref \$result eq 'SCALAR') {
1340       if ($line =~ /^\s*(\S+)/) {
1341         $cmd = $1;
1342       } # if
1343
1344       # We used to output only for raidcmds...
1345       $CmdLine::cmdline->handleOutput ($line, split /\n/, $result);
1346     } else {
1347       display "Sorry but I cannot display structured results";
1348     } # if
1349   } # if
1350
1351   $CmdLine::cmdline->set_prompt (set_prompt $cmd);
1352 } # while
1353
1354 $result = $CmdLine::cmdline->_get ('result');
1355
1356 unless ($result) {
1357   exit 0;
1358 } elsif ($result =~ /^\s*(\d+)\s*$/) {
1359   exit $1;
1360 } else {
1361   exit 1;
1362 } # if