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 error "$name is not supported on 64 bit versions of Perl", 1
 264   if $Config{archname} =~ /64/;
 265
 266 my %raidCmds = (
 267   appiddisplay  => {
 268     help        => 'appiddisplay',
 269     description => 'Displays App ID information',
 270   },
 271
 272   appidclear    => {
 273     help        => 'appidclear <index>',
 274     description => 'Clears the specified App ID index',
 275   },
 276
 277   cmds          => {
 278     help        => 'cmds [<str>]',
 279     description => 'Lists currently loaded commands (matching <str>).',
 280   },
 281
 282   debug         => {
 283     help        => 'debug [<on|off>]',
 284     description => 'Turn on|off debuging of raid and debugsh. With no options displays
 285 status of debug.',
 286   },
 287
 288   exit          => {
 289     help        => 'exit',
 290     description => "Exits $name.",
 291   },
 292
 293   modules       => {
 294     help        => 'modules',
 295     description => 'Displays all available modules',
 296   },
 297
 298   perl          => {
 299     help        => 'perl <expression>',
 300     description => 'Evaluate a Perl expression. Must be on one line.',
 301   },
 302
 303   quit          => {
 304     help        => 'quit',
 305     description => "Quits $name.",
 306   },
 307
 308   restart       => {
 309     help        => 'restart',
 310     description => "Reinitializes $name",
 311   },
 312
 313   timeout       => {
 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.',
 316   },
 317
 318   version       => {
 319     help  => 'version',
 320     description => 'Displays version information.',
 321   },
 322 );
 323
 324 use Inline;
 325
 326 my $PROMPT;
 327
 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";
 331
 332 my ($cmdline, $attribs, $line, $result, $dsh);
 333
 334 sub terminateDebugSh () {
 335   if ($debugshPid) {
 336     kill HUP => $debugshPid;
 337
 338     waitpid $debugshPid, 0;
 339
 340     my $result = DbgShRaidUnRegister ();
 341
 342     warning "DbgShRaidRegister returned $result"
 343       if $result;
 344
 345     # Close old debugsh if we are reinitializing
 346     close $dsh if $dsh;
 347
 348     undef $dsh;
 349   } # if
 350
 351   return;
 352 } # terminateDebugSh
 353
 354 sub set_prompt (;$$) {
 355   my ($cmd, $nbr) = @_;
 356
 357   my $ignstart = $CmdLine::cmdline->{ignstart};
 358   my $ignstop  = $CmdLine::cmdline->{ignstop};
 359
 360   my $prompt;
 361
 362   if ($opts{color}) {
 363     return $ignstart . color ('cyan')   . $ignstop . $name
 364          . $ignstart . color ('reset')  . $ignstop . ' <'
 365          . $ignstart . color ('yellow') . $ignstop . '\#'
 366          . $ignstart . color ('reset')  . $ignstop . '> ';
 367   } else {
 368     return "$name <#>";
 369   } # if
 370 } # set_prompt
 371
 372 sub moduleName ($) {
 373   my ($file) = @_;
 374
 375   my ($module, $path, $suffix) = fileparse ($file, ('\.a$', '\.so$', '\.h$'));
 376
 377   $module =~ s/lib//;
 378
 379   return $module;
 380 } # moduleName
 381
 382 sub parseh ($) {
 383   my ($h) = @_;
 384
 385   my %funcs;
 386
 387   unless (-f $h) {
 388     error "Unable to open file $h - $!";
 389     return;
 390   } # unless
 391
 392   open my $file, '<', $h
 393     or error "Unable to open $h", 1;
 394
 395   my (
 396     $indefinition,
 397     $userinput,
 398     $funcname,
 399     $help,
 400     $description,
 401     $module,
 402     $prototype,
 403     $parms,
 404     $returntype,
 405     $type
 406   );
 407
 408   while (<$file>) {
 409     chomp; chop if /\r$/;
 410
 411     if (/^\/\*{5,}/) {
 412       $indefinition = 1;
 413       $type         = 0;
 414     } elsif (/^\*{5,}/) {
 415       error 'Missing user input keyword', 1
 416         unless $userinput;
 417
 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
 424           if /^$userinput /;
 425       } # foreach
 426
 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".
 429       my $str;
 430
 431       foreach my $word (split /\s+/, $userinput) {
 432         if ($str) {
 433           $str .= " $word";
 434         } else {
 435           $str .= $word;
 436         } # if
 437
 438         # See if this exactly matches any existing key
 439         error "Ambiguous command \"$userinput\" & \"$_\" found in $h", 1
 440           if $funcs{$str};
 441       } # foreach
 442
 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;
 451
 452       undef $userinput;
 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*$//;
 457
 458       while ($prototype !~ /\);*\s*$/) {
 459         my $line = <$file>;
 460
 461         if ($line) {
 462           chomp; chop if /\r$/;
 463
 464           # Trim
 465           $line =~ s/^\s+//;
 466           $line =~ s/\s+$//;
 467
 468           $prototype .= $line;
 469         } else {
 470           error "Unterminated function prototype found in $h", 1;
 471         } # if
 472       } # while
 473
 474       my $str = $prototype;
 475
 476       # Remove annoying spaces around delimiters only
 477       $str =~ s/\s*(\*|\(|\)|\,)\s*/$1/g;
 478
 479       my @parts = split /(\s+|\(|\)|\*)/, $str;
 480
 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];
 492       } else {
 493         $funcname   = $parts[2];
 494         $returntype = $parts[0];
 495         $parms      = join '', @parts[3..$#parts];
 496       } # if
 497
 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*$//;
 503
 504       $desc =~ s/^\s+//;
 505
 506       $description = $desc unless $desc eq '';
 507       $indefinition = 2;
 508     } elsif ($indefinition and $_ =~ /^\s*category:\s*(\d+)/i) {
 509       $type = $1;
 510     } elsif ($indefinition and $indefinition == 2) {
 511       if (/\*{5,}/) {
 512         $indefinition = 0;
 513         next;
 514       } else {
 515         s/^\s+//;
 516
 517         if ($description) {
 518           $description .= "\n$_";
 519         } else {
 520           $description = $_;
 521         } # if
 522       } # if
 523     } # if
 524   } # while
 525
 526   close $file;
 527
 528   return %funcs;
 529 } # parseh
 530
 531 sub loadModules ($) {
 532   my ($rcdir) = @_;
 533
 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;
 537
 538   my %moduleFuncs;
 539   my @modules = grep { !/^\./ } readdir $rc;
 540      @modules = grep { /.+\.h$/ } @modules;
 541
 542   closedir $rc;
 543
 544   foreach (@modules) {
 545     my $moduleFile = "$rcdir/$_";
 546     my $module     = moduleName $moduleFile;
 547     my %funcs      = parseh $moduleFile;
 548
 549     foreach (keys %funcs) {
 550       error "Duplicate definition $_ found in $moduleFile", 1
 551         if defined $moduleFuncs{$_};
 552
 553       $moduleFuncs{$_} = $funcs{$_};
 554     } # foreach
 555
 556     $modules{$module} = {
 557       moduleFile => $moduleFile,
 558       loaded     => 0,
 559     };
 560   } # foreach
 561
 562   return %moduleFuncs;
 563 } # loadModules
 564
 565 sub modules () {
 566   my ($moduleName, $moduleStatus, $moduleFile);
 567
 568   format STDOUT =
 569 @<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<
 570 $moduleName,$moduleStatus
 571 .
 572   foreach $moduleName (sort keys %modules) {
 573     next if $moduleName eq 'DbgSh';
 574
 575     $moduleStatus = ($modules{$moduleName}{loaded}) ? 'loaded' : 'not loaded';
 576
 577     write;
 578   } # foreach
 579
 580   return;
 581 } # modules
 582
 583 sub load ($;$) {
 584   my ($file, $lib) = @_;
 585
 586   my ($module, $path, $suffix) = fileparse ($file, ('\.a$', '\.so$', '\.h$'));
 587
 588   $module =~ s/lib//;
 589   $path   =~ s/^inc\///;
 590
 591   display_nolf color ('dark') . "Loading $module..." . color ('reset');
 592
 593   my $hfile;
 594
 595   if (-f "$path$module.h") {
 596     $hfile = "$path$module.h";
 597   } elsif (-f "${path}inc/$module.h") {
 598     $hfile = "${path}inc/$module.h";
 599   } # if
 600
 601   unless ($hfile) {
 602     display '';
 603     error "Unable to load $module - .h file missing";
 604     return;
 605   } # unless
 606
 607   my $libfile;
 608
 609   if ($lib and -f $lib) {
 610     $libfile = $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";
 623   } # if
 624
 625   unless ($libfile) {
 626     display '';
 627     error "Unable to load $module - .a or .so file missing";
 628     return;
 629   } # unable
 630
 631   # Need absolute pathname for -L
 632   my $libpath;
 633
 634   (undef, $libpath, $libfile) =
 635     File::Spec->splitpath (File::Spec->rel2abs ($libfile));
 636
 637   # Strip trailing "/", if any
 638   $libpath =~ s/\/$//;
 639
 640   # Compose $libs
 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};
 648
 649   verbose "Binding C functions defined in $hfile";
 650   debug "Loading module $module";
 651   debug "libs = $libs";
 652
 653   my ($status, @output) = Execute 'uname -r';
 654
 655   if ($output[0] =~ /WR3.0.2ax_cgl/) {
 656     my $sysroot   = '/usr/wichorus/sysroot';
 657
 658     Inline->bind (
 659       C                 => $hfile,
 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",
 664       LIBS              => $libs,
 665       ENABLE            => 'AUTOWRAP',
 666       FORCE_BUILD       => $opts{build},
 667       BUILD_NOISY       => $opts{noisy},
 668       CLEAN_AFTER_BUILD => $opts{clean},
 669       PRINT_INFO        => $opts{info},
 670     );
 671   } else {
 672     Inline->bind (
 673       C                 => $hfile,
 674       LIBS              => $libs,
 675       ENABLE            => 'AUTOWRAP',
 676       FORCE_BUILD       => $opts{build},
 677       BUILD_NOISY       => $opts{noisy},
 678       CLEAN_AFTER_BUILD => $opts{clean},
 679       PRINT_INFO        => $opts{info},
 680     );
 681   } # if
 682
 683   # Now the module's loaded
 684   $modules{$module}{loaded}     = 1;
 685   $modules{$module}{moduleFile} = $hfile;
 686
 687   $CmdLine::cmdline->set_prompt (set_prompt);
 688
 689   # Rebuild %allcmds
 690   %allcmds = %raidCmds;
 691
 692   $allcmds{$_} = $funcs{$_} foreach (keys %funcs);
 693
 694   # Set cmds
 695   $CmdLine::cmdline->set_cmds (%allcmds);
 696
 697   display color ('dark') . 'done' . color ('reset');
 698
 699   return 1;
 700 } # load
 701
 702 sub getOutput () {
 703   my ($status, @output) = (0, ());
 704
 705   debug "ENTER: getOutput";
 706
 707   eval {
 708     while (<$dsh>) {
 709       debug "read: $_";
 710       if (/\s*DBGSH\s*\[$debugshPid\]:\s*(\d+)$/) {
 711         debug "Found DBGSH line - status = $1";
 712         $status = $1;
 713         last;
 714       } # if
 715
 716       # Trim output of both \n and \r;
 717       chomp; chop if /\r$/;
 718
 719       debug "Pushing '$_' on output";
 720       push @output, $_
 721     } # while
 722   };
 723
 724   if ($@ =~ /Operation aborted/) {
 725     debug "Operation aborted - cleaning pipe";
 726
 727     # Need to remove debris from the pipe
 728     while (<$dsh>) {
 729       debug "Found debris: $_";
 730
 731       if (/\s*DBGSH\s*\[$debugshPid\]:\s*(\d+)$/) {
 732         debug "Found DBSH line - status = $1";
 733         $status = $1;
 734         last;
 735       } # if
 736     } # while
 737
 738     debug "Returning error $@";
 739     return (undef, ($@));
 740   } else {
 741     debug "Returning output (Status: $status)";
 742     return ($status, @output);
 743   } # if
 744 } # getOutput
 745
 746 sub debugshInit () {
 747   my @debugsh = ($opts{debugsh});
 748
 749   push @debugsh, '2>&1';
 750
 751   local $SIG{INT} = 'IGNORE';
 752
 753   $debugshPid = open $dsh, '-|', @debugsh
 754     or error "Unable to start pipe for $opts{debugsh}", 1;
 755
 756   # Turn off buffering on $dsg
 757   $dsh->autoflush (1);
 758
 759   # Temporarily turn off eval
 760   my $oldEval = $CmdLine::cmdline->set_eval;
 761
 762   # Set DEBUGSHPID
 763   $CmdLine::cmdline->_set ('DEBUGSHPID', $debugshPid);
 764
 765   # Turn eval back on
 766   $CmdLine::cmdline->set_eval ($oldEval);
 767
 768   # Load our interface to DbgSh lib
 769   load "$FindBin::Bin/DbgShRaidAPI", "$FindBin::Bin/lib/libDbgSh.a";
 770
 771   $debugshVer = GetDbgShVer ();
 772
 773   # Check verion of debugsh
 774   my $minimumVer = '0.3.0';
 775
 776   error "Debugsh Version $debugshVer must be >= $minimumVer", 1
 777     if compareVersions ($debugshVer, $minimumVer) == -1;
 778
 779   DbgShRaidRegister ($debugshPid);
 780
 781   if (get_debug) {
 782     DbgShProcessUserInput (DBGSH_APPID, $debugshPid, 'SetDebug');
 783
 784     my ($result, @output) = getOutput;
 785
 786     $CmdLine::cmdline->_set ('result', $result);
 787
 788     $CmdLine::cmdline->handleOutput ('', @output);
 789
 790     error "$line was not successful (Result: $result)"
 791       if $result;
 792   } # if
 793
 794   return;
 795 } # debugshInit
 796
 797 END {
 798   terminateDebugSh;
 799 } # END
 800
 801 sub interrupt () {
 802   display_nolf
 803     color ('yellow')
 804   . '<Control-C>'
 805   . color ('reset')
 806   . '... '
 807   . color ('red')
 808   . "Abort current operation (y/N)?"
 809   . color ('reset');
 810
 811   my $response = <STDIN>;
 812   chomp;
 813
 814   if ($response =~ /(^y$|^yes$)/i) {
 815     DbgShProcessUserInput (DBGSH_APPID, $debugshPid, 'Interrupted');
 816     die "Operation aborted\n";
 817   } # if
 818
 819   display color ('cyan') . 'Continuing...' . color ('reset');
 820 } # interrupt
 821
 822 sub init () {
 823   # Stop debugsh if it was running
 824   terminateDebugSh;
 825
 826   # Intialize functions (Type 1 commands)
 827   if (-d $opts{rc}) {
 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
 830     # is called.
 831     %funcs = loadModules $opts{rc};
 832   } else {
 833     %funcs = ();
 834
 835     warning "Unable to find RC commands in $opts{rc}";
 836   } # if
 837
 838   # Load commands from config file (Type 2 commands)
 839   foreach (keys %opts) {
 840     my $cmd;
 841
 842     if (/^type2_(\S+)/) {
 843       $cmd = $1;
 844       #$cmd =~ s/_/ /g;
 845     } else {
 846       next;
 847     } # if
 848
 849     $funcs{$cmd} = {
 850       appID     => $opts{$_},
 851       type      => 2,
 852       prototype => "$cmd <cmd>",
 853       help      => "Send <cmd> (AppID $opts{$_}) to debugsh",
 854     };
 855   } # foreach
 856
 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,
 859   # etc.
 860   %allcmds = %raidCmds;
 861
 862   foreach (keys %funcs) {
 863     $allcmds{$_} = $funcs{$_};
 864   } # foreach
 865
 866   # Initialize debugsh
 867   my $result = debugshInit;
 868
 869   error "Unable to initialize debugsh", $result
 870     if $result;
 871 } # init
 872
 873 sub compareVersions ($$) {
 874   my ($version1, $version2) = @_;
 875
 876   $version1 =~ s/\.//g;
 877   $version2 =~ s/\.//g;
 878
 879   return $version1 <=> $version2;
 880 } # compareVersions
 881
 882 sub setVersionStr () {
 883   my $raidVersionStr = color ('cyan')
 884                      . $name
 885                      . color ('reset')
 886                      . color ('dark')
 887                      . ' (Real Aid in Debugging) '
 888                      . color ('reset')
 889                      . color ('green')
 890                      . 'Version '
 891                      . color ('reset')
 892                      . color ('yellow')
 893                      . $VERSION
 894                      . color ('reset');
 895
 896   my $debugshVerStr = color ('cyan')
 897                     . 'Debug Shell Core '
 898                     . color ('green')
 899                     . 'Version '
 900                     . color ('yellow')
 901                     . $debugshVer
 902                     . color ('reset');
 903
 904   return $raidVersionStr . "\n" . $debugshVerStr;
 905 } # setVersionStr
 906
 907 sub cmds ($%) {
 908   my ($cmd, %funcs) = @_;
 909
 910   if (keys %funcs == 0) {
 911     warning "Nothing loaded";
 912     return;
 913   } else {
 914     my @output;
 915     my @colors = (color ('dark'), color ('magenta'), color ('green'));
 916
 917     my $searchStr;
 918
 919     if ($cmd and $cmd =~ /^\s*(\w+)/) {
 920       $searchStr = $1;
 921     } # if
 922
 923     foreach (sort {
 924       $funcs{$a}{type} <=> $funcs{$b}{type} ||
 925              $a        cmp        $b
 926     } keys %funcs) {
 927       if ($searchStr) {
 928         next
 929           unless /$searchStr/i;
 930       } # if
 931
 932       my $color = '';
 933
 934       $color = $colors[$funcs{$_}{type}]
 935         if $colors[$funcs{$_}{type}];
 936
 937       my $cmdName = $_;
 938
 939       my $boldOn  = '';
 940       my $boldOff = '';
 941
 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;
 948       } # if
 949
 950       if ($searchStr) {
 951         $cmdName =~ s/($searchStr)/$boldOn$1$boldOff/;
 952       } # if
 953
 954       my $line  = $color . $cmdName;
 955          $line .= " $funcs{$_}{parms}"     if $funcs{$_}{parms};
 956          $line .= color ('reset');
 957          $line .= " - $funcs{$_}{help}" if $funcs{$_}{help};
 958
 959       push @output, $line;
 960     } # foreach
 961
 962     $CmdLine::cmdline->handleOutput ('', @output);
 963   } # if
 964
 965   return;
 966 } # cmds
 967
 968 sub timeout (;$) {
 969   my ($timeout) = @_;
 970
 971   my ($result, @output);
 972
 973   if ($timeout) {
 974     if ($timeout < 0 or $timeout > 100) {
 975       error "Timeout must be between 0 and 100";
 976
 977       $CmdLine::cmdline->_set ('result', 1);
 978
 979       return;
 980     } # if
 981
 982     DbgShProcessUserInput (DBGSH_APPID, $debugshPid, "SetTimeout $timeout");
 983
 984     ($result, @output) = getOutput;
 985
 986     $CmdLine::cmdline->_set ('result', $result);
 987
 988     $CmdLine::cmdline->handleOutput ('', @output);
 989
 990     error "Unable to set timeout (Result: $result)"
 991       if $result;
 992   } else {
 993     DbgShProcessUserInput (DBGSH_APPID, $debugshPid, 'GetTimeout');
 994
 995     ($result, @output) = getOutput;
 996
 997     $CmdLine::cmdline->_set ('result', $result);
 998
 999     $CmdLine::cmdline->handleOutput ('', @output);
1000
1001     error "Unable to get timeout (Result: $result)"
1002       if $result;
1003   } # if
1004 } # timeout
1005
1006 sub callc ($@) {
1007   my ($cmd, @parms) = @_;
1008
1009   # Check to see if we know about this $cmd
1010   my $found;
1011
1012   foreach (keys %funcs) {
1013     next unless /^$cmd$/i;
1014
1015     if ($cmd eq $_) {
1016       $found = 1;
1017       last;
1018     } # if
1019   } # foreach
1020
1021   unless ($found) {
1022     error "Unknown command: $cmd";
1023
1024     return;
1025   } # unless
1026
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";
1032         return;
1033       } # unless
1034     } else {
1035       error "Undefined module for $cmd";
1036       return;
1037     } # if
1038   } # unless
1039
1040   my ($result, @output);
1041
1042   no strict;
1043
1044   eval {
1045     $result = &{$funcs{$cmd}{funcname}} (@parms);
1046   };
1047
1048   use strict;
1049
1050   if ($@) {
1051     display_nolf $@;
1052
1053     return -1;
1054   } else {
1055     return $result
1056       unless $funcs{$cmd}{type} == 1;
1057
1058     ($result, @output) = getOutput;
1059
1060     $CmdLine::cmdline->handleOutput ($cmd, @output);
1061
1062     return $result;
1063   } # if
1064 } # callc
1065
1066 sub evaluate ($) {
1067   my ($line) = @_;
1068
1069   my $result = $CmdLine::cmdline->_get('result');
1070   my @parms;
1071
1072   if ($line =~ /^\s*(exit|quit)\s*$/i) {
1073     unless ($result) {
1074       exit 0;
1075     } elsif ($result =~ /^\s*(\d+)\s*$/) {
1076       exit $1;
1077     } else {
1078       exit 1;
1079     } # if
1080   } elsif ($line =~ /^\s*version/i) {
1081     display setVersionStr;
1082     return;
1083   } elsif ($line =~ /^\s*cmds\s+(.*)/i) {
1084     cmds $1, %funcs;
1085     return;
1086   } elsif ($line =~ /^\s*cmds\s*$/i) {
1087     cmds undef, %funcs;
1088     return;
1089   } elsif ($line =~ /^\s*restart\s*$/i) {
1090     init;
1091     return;
1092   } elsif ($line =~ /^\s*debug\s+(\S+)/i) {
1093     my @output;
1094
1095     if ($1 =~ /(1|on)/i) {
1096       set_debug 1;
1097
1098       DbgShProcessUserInput (DBGSH_APPID, $debugshPid, 'SetDebug');
1099
1100       ($result, @output) = getOutput;
1101
1102       $CmdLine::cmdline->_set ('result', $result);
1103
1104       $CmdLine::cmdline->handleOutput ($line, @output);
1105
1106       error "$line was not successful (Result: $result)"
1107         if $result;
1108
1109       return;
1110     } elsif ($1 =~ /(0|off)/i) {
1111       set_debug 0;
1112
1113       DbgShProcessUserInput (DBGSH_APPID, $debugshPid, 'ClearDebug');
1114
1115       ($result, @output) = getOutput;
1116
1117       $CmdLine::cmdline->_set ('result', $result);
1118
1119       $CmdLine::cmdline->handleOutput ($line, @output);
1120
1121       error "$line was not successful (Result: $result)"
1122         if $result;
1123
1124       return;
1125     } else {
1126       error "Unknown command: $line";
1127       return;
1128     } # if
1129   } elsif ($line =~ /^\s*timeout\s+([-+]*\d+)/i) {
1130     timeout $1;
1131
1132     return;
1133   } elsif ($line =~ /^\s*timeout\s*$/i) {
1134     timeout;
1135
1136     return;
1137   } elsif ($line =~ /^\s*debug\s*$/) {
1138     if (get_debug) {
1139       display 'Debug is currently on';
1140     } else {
1141       display 'Debug is currently off';
1142     } # if
1143
1144     return;
1145   } elsif ($line =~ /^\s*appiddisplay\s*$/i) {
1146     DbgShAppIdInfo ();
1147     return;
1148   } elsif ($line =~ /^\s*appidclear\s+(\d+)\s*$/i) {
1149     DbgShAppIdClearIdx ($1);
1150     return;
1151   } elsif ($line =~ /^\s*perl\s*(.*)/) {
1152     # Need to turn off scrict for eval
1153     eval "no strict; $1; use strict";
1154
1155     $result = $@ ne '';
1156   } elsif ($line =~ /^\s*modules\s*$/i) {
1157     modules;
1158     return;
1159   } elsif ($line =~ /^\s*(.+)\s*$/) {
1160     my @userinput = split /[,\s\t]+/, $1;
1161     my $userinput = join ' ', @userinput;
1162     my $funcname  = $userinput[0];
1163
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?
1168     #
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.
1172     #
1173     # If we find a type 1 command but no type 2 then we simply execute the type
1174     # 1 command.
1175     #
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.
1178     #
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.
1181
1182     # Search for type 1 command
1183     while ($userinput ne '') {
1184       last if $funcs{$userinput} and $funcs{$userinput}{type} != 2;
1185
1186       unshift @parms, pop @userinput;
1187
1188       $userinput = join ' ', @userinput;
1189     } # while
1190
1191     if ($userinput eq '') {
1192       # No type 1 command - check type 2
1193       if ($funcs{$funcname} and $funcs{$funcname}{type} == 2) {
1194         my @output;
1195
1196         # Strip off any thing that begins with "\S+_"
1197         $line =~ s/^\s*\S+_(.+)/$1/;
1198
1199         DbgShProcessUserInput ($funcs{$funcname}{appID}, $debugshPid, $line);
1200
1201         ($result, @output) = getOutput;
1202
1203         $CmdLine::cmdline->_set ('result', $result);
1204
1205         $CmdLine::cmdline->handleOutput ($line, @output);
1206
1207         error "$line was not successful (Result: $result)"
1208           if $result;
1209
1210         return;
1211       } else {
1212         error "Unknown command: $line";
1213
1214         return;
1215       } # if
1216     } else {
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";
1220
1221         return;
1222       } # if
1223     } # if
1224
1225     # Process parms
1226     foreach my $parm (@parms) {
1227       # Strip () if they are there
1228       $parm =~ s/^\s*\(//;
1229       $parm =~ s/\)\s*$//;
1230
1231       # Trim
1232       $parm =~ s/^\s+//;
1233       $parm =~ s/\s+$//;
1234
1235       $parm = oct ($parm) if $parm =~ /^0/;
1236     } # foreach
1237
1238     $result = callc $userinput, @parms;
1239   } else {
1240     error "Unknown command: $line";
1241
1242     return;
1243   } # if
1244
1245   $CmdLine::cmdline->_set ('result', $result)
1246     if $result;
1247
1248   return $result
1249 } # evalulate
1250
1251 # Main
1252 $| = 1;
1253
1254 $CmdLine::cmdline->_set ('result', 1);
1255
1256 set_me $name;
1257
1258 $opts{histfile} = $ENV{RAID_HISTFILE}
1259   ? $ENV{RAID_HISTFILE}
1260   : '.raid_hist';
1261 $opts{debugsh} = $ENV{RAID_DEBUGSH}
1262   ? $ENV{RAID_DEBUGSH}
1263   : "$FindBin::Bin/debugsh";
1264 $opts{load} = $ENV{RAID_LOAD}
1265   ? $ENV{RAID_LOAD}
1266   : undef;
1267 $opts{lib} = $ENV{RAID_LIB}
1268   ? $ENV{RAID_LIB}
1269   : undef;
1270 $opts{additionalLibs} = $ENV{RAID_ADDITIONALLIBS}
1271   ? $ENV{RAID_ADDITIONALLIBS}
1272   : '';
1273 $opts{rc} = $ENV{RAID_RC}
1274   ? $ENV{RAID_RC}
1275   : "$FindBin::Bin/rc";
1276 $opts{build} = 1;
1277 $opts{clean} = 1;
1278 $opts{color} = 1;
1279
1280 GetOptions (
1281   \%opts,
1282   'verbose' => sub { set_verbose },
1283   'debug'   => sub { set_debug },
1284   'usage'   => sub { Usage },
1285   'rc=s',
1286   'load=s',
1287   'lib=s',
1288   'histfile=s',
1289   'debugsh=s',
1290   'timeout=i',
1291   'additionallibs=s',
1292   'noisy!',
1293   'build!',
1294   'clean!',
1295   'info!',
1296   'version',
1297 ) || Usage;
1298
1299 if ($opts{version}) {
1300   display "$name Version $VERSION";
1301   exit;
1302 } # if
1303
1304 $SIG{INT} = \&interrupt;
1305
1306 init;
1307
1308 timeout $opts{timeout} if $opts{timeout};
1309
1310 load $opts{load}, $opts{lib}
1311   if $opts{load};
1312
1313 # Single execution from command line
1314 if ($ARGV[0]) {
1315   my $result = evaluate join ' ', @ARGV;
1316
1317   $result ||= 1;
1318
1319   exit $result;
1320 } # if
1321
1322 my ($cmd, @parms);
1323
1324 $CmdLine::cmdline->set_histfile ($opts{histfile})
1325   if $opts{histfile};
1326
1327 $CmdLine::cmdline->set_prompt (set_prompt);
1328 $CmdLine::cmdline->set_cmds (%allcmds);
1329 $CmdLine::cmdline->set_eval (\&evaluate);
1330
1331 while ((($line, $result) = $CmdLine::cmdline->get)) {
1332   last unless defined $line;
1333   next if $line =~ /^\s*($|\#)/;
1334
1335   $result = evaluate $line;
1336
1337   if (defined $result) {
1338     if (ref \$result eq 'SCALAR') {
1339       if ($line =~ /^\s*(\S+)/) {
1340   $cmd = $1;
1341       } # if
1342
1343       # We used to output only for raidcmds...
1344       $CmdLine::cmdline->handleOutput ($line, split /\n/, $result);
1345     } else {
1346       display "Sorry but I cannot display structured results";
1347     } # if
1348   } # if
1349
1350   $CmdLine::cmdline->set_prompt (set_prompt $cmd);
1351 } # while
1352
1353 $result = $CmdLine::cmdline->_get ('result');
1354
1355 unless ($result) {
1356   exit 0;
1357 } elsif ($result =~ /^\s*(\d+)\s*$/) {
1358   exit $1;
1359 } else {
1360   exit 1;
1361 } # if