CCDB/lib/CCDBService.pm

   1 =pod
   2
   3 =head1 NAME $RCSfile: CCDBService.pm,v $
   4
   5 CCDBService - ClearCase DataBase Service
   6
   7 =head1 VERSION
   8
   9 =over
  10
  11 =item Author
  12
  13 Andrew DeFaria <Andrew@ClearSCM.com>
  14
  15 =item Revision
  16
  17 $Revision: 1.6 $
  18
  19 =item Created
  20
  21 Fri Mar 11 15:37:34 PST 2011
  22
  23 =item Modified
  24
  25 $Date: 2011/05/05 18:41:44 $
  26
  27 =back
  28
  29 =head1 SYNOPSIS
  30
  31 Provides an interface to the CCDB object over the netwok. This is useful as
  32 neither ccperl nor cqperl have DBI installed so if clients want to talk to an
  33 SQL database such as MySQL they generally can't.
  34
  35 This library implements both the daemon portion of the server and the client
  36 API.
  37
  38 =head1 DESCRIPTION
  39
  40 This client/server process (ccdbc and ccdbd) serves only an informational
  41 purpose. By that I mean the client can request information as described below
  42 but it cannot request to add/delete or update information. In other words the
  43 client has read only access.
  44
  45 The caller makes requests in the form of:
  46
  47  <method> <parms>
  48
  49 Different methods will return different values. See CCDB.pm.
  50
  51 =head1 ROUTINES
  52
  53 The following methods are available:
  54
  55 =cut
  56
  57 package CCDBService;
  58
  59 use strict;
  60 use warnings;
  61
  62 use Carp;
  63 use FindBin;
  64 use IO::Socket;
  65 use Net::hostent;
  66 use POSIX ":sys_wait_h";
  67
  68 use lib "$FindBin::Bin/../../lib";
  69
  70 use DateUtils;
  71 use Display;
  72 use GetConfig;
  73
  74 # Seed options from config file
  75 our %OPTS = GetConfig ("$FindBin::Bin/../etc/ccdbservice.conf");
  76
  77 our $VERSION  = '$Revision: 1.6 $';
  78    ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
  79
  80 # Override options if in the environment
  81 $OPTS{CCDB_HOST}          = $ENV{CCDB_HOST}
  82   if $ENV{CCDB_HOST};
  83 $OPTS{CCDB_PORT}          = $ENV{CCDB_PORT}
  84   if $ENV{CCDB_PORT};
  85 $OPTS{CCDB_MULTITHREADED} = $ENV{CCDB_MULTITHREADED}
  86   if $ENV{CCDB_MULTITHREADED};
  87
  88 sub new () {
  89   my ($class) = @_;
  90
  91   my $ccdbservice = bless {}, $class;
  92
  93   $ccdbservice->{multithreaded} = $OPTS{CCDB_MULTITHREADED};
  94
  95   return $ccdbservice;
  96 } # new
  97
  98 sub _tag ($) {
  99   my ($self, $msg) = @_;
 100
 101   my $tag  = YMDHMS;
 102      $tag .= ' ';
 103      $tag .= $self->{pid} ? "[$self->{pid}] " : '';
 104
 105   return "$tag$msg";
 106 } # _tag
 107
 108 sub _verbose ($) {
 109   my ($self, $msg) = @_;
 110
 111   verbose $self->_tag ($msg);
 112
 113   return;
 114 } # _verbose
 115
 116 sub _debug ($) {
 117   my ($self, $msg) = @_;
 118
 119   debug $self->_tag ($msg);
 120
 121   return;
 122 } # _debug
 123
 124 sub _log ($) {
 125   my ($self, $msg) = @_;
 126
 127   display $self->_tag ($msg);
 128
 129   return;
 130 } # log
 131
 132 sub _funeral () {
 133   debug 'Entered _funeral';
 134
 135   while (my $childpid = waitpid (-1, WNOHANG) > 0) {
 136     my $status = $?;
 137
 138     debug "childpid: $childpid - status: $status";
 139
 140     if ($childpid != -1) {
 141       local $SIG{CHLD} = \&_funeral;
 142
 143       my $msg  = 'Child has died';
 144          $msg .= $status ? " with status $status" : '';
 145
 146       verbose "[$childpid] $msg"
 147         if $status;
 148     } else {
 149       debug "All children reaped";
 150     } # if
 151   } # while
 152
 153   return;
 154 } # _funeral
 155
 156 sub _endServer () {
 157   display "CCDBService V$VERSION shutdown at " . localtime;
 158
 159   # Kill process group
 160   kill 'TERM', -$$;
 161
 162   # Wait for all children to die
 163   while (wait != -1) {
 164     # do nothing
 165   } # while
 166
 167   # Now that we are alone, we can simply exit
 168   exit;
 169 } # _endServer
 170
 171 sub _restartServer () {
 172   # Not sure what to do on a restart server
 173   display 'Entered _restartServer';
 174
 175   return;
 176 } # _restartServer
 177
 178 sub setMultithreaded ($) {
 179   my ($self, $value) = @_;
 180
 181   my $oldValue = $self->{multithreaded};
 182
 183   $self->{multithreaded} = $value;
 184
 185   return $oldValue;
 186 } # setMultithreaded
 187
 188 sub getMultithreaded () {
 189   my ($self) = @_;
 190
 191   return $self->{multithreaded};
 192 } # getMultithreaded
 193
 194 sub connectToServer (;$$) {
 195   my ($self, $host, $port) = @_;
 196
 197   $host ||= $OPTS{CCDB_HOST};
 198   $port ||= $OPTS{CCDB_PORT};
 199
 200   $self->{socket} = IO::Socket::INET->new (
 201     Proto       => 'tcp',
 202     PeerAddr    => $host,
 203     PeerPort    => $port,
 204   );
 205
 206   return unless $self->{socket};
 207
 208   $self->{socket}->autoflush
 209     if $self->{socket};
 210
 211   $self->{host} = $host;
 212   $self->{port} = $port;
 213
 214   if ($self->{socket}) {
 215     return 1;
 216   } else {
 217     return;
 218   } # if
 219
 220   return;
 221 } # connectToServer
 222
 223 sub disconnectFromServer () {
 224   my ($self) = @_;
 225
 226   undef $self->{socket};
 227
 228   return;
 229 } # disconnectFromServer
 230
 231 sub _serviceClient ($$) {
 232   my ($self, $host, $client) = @_;
 233
 234   $self->_verbose ("Serving requests from $host");
 235
 236   # Set autoflush for client
 237   $client->autoflush
 238     if $client;
 239
 240   my $ccdb = CCDB->new;
 241
 242   while () {
 243     # Read command from client
 244     my $cmd = <$client>;
 245
 246     last unless $cmd;
 247
 248     chomp $cmd;
 249
 250     next if $cmd eq '';
 251
 252     last if $cmd =~ /^quit|^exit/i;
 253
 254     $self->_debug ("$host wants us to do $cmd");
 255
 256     my $status = 0;
 257     my ($method, $rec, @keys, @values);
 258
 259     if ($cmd =~ /stopserver/i) {
 260       if ($self->{server}) {
 261         $self->_verbose ("$host requested to stop server [$self->{server}]");
 262
 263         # Send server hangup signal
 264         kill 'HUP', $self->{server};
 265       } else {
 266         $self->_verbose ('Shutting down server');
 267
 268         print $client "CCDBService Status: 0\n";
 269
 270         exit;
 271       } # if
 272
 273       $self->_debug ("Returning 0, undef");
 274     } else {
 275       # Parse command
 276       @values = split /[^\S]+/, $cmd;
 277
 278       if (@values < 2) {
 279         print $client "ERROR: I don't understand the command: $cmd\n";
 280         print $client "Request must be of the form: <method> <parms>\n";
 281         print $client "CCDB Status: 1\n";
 282         next;
 283       } # if
 284
 285       $method = shift @values;
 286
 287       my $values = join ' ', @values;
 288
 289       unless (
 290          $method =~ /^get/i
 291       or $method =~ /^find/i
 292       or $method =~ /^add/i
 293       or $method =~ /^delete/i
 294       or $method =~ /^update/i) {
 295         print $client "I only understand get, find, add, delete and ";
 296         print $client "update operations ";
 297         print $client "- not '$method'\n";
 298         print $client "CCDB Status: 1\n";
 299         next;
 300       } # unless
 301
 302       $self->_debug ("Executing CCDB::$method");
 303
 304       my (%rec, @recs);
 305
 306       if ($method =~ /^get/i) {
 307         eval {
 308           %rec = $ccdb->$method (@values);
 309         }; # eval
 310
 311         if ($@) {
 312           print $client "$@\n";
 313           print $client "CCDB Status: 1\n";
 314           next;
 315         } else {
 316           $rec = \%rec;
 317         } # if
 318       } elsif ($method =~ /^find/i) {
 319         eval {
 320           @recs = $ccdb->$method (@values);
 321         }; # eval
 322
 323         if ($@) {
 324           print $client "$@\n";
 325           print $client "CCDB Status: 1\n";
 326           next;
 327         } else {
 328           $rec = \@recs;
 329         } # if
 330       } elsif ($method =~ /^add/i) {
 331         my ($err, $msg);
 332
 333         eval {
 334           ($err, $msg) = $ccdb->$method ($values);
 335         }; # eval
 336
 337         if ($@) {
 338           print $client "$@\n";
 339           print $client "CCDB Status: 1\n";
 340           next;
 341         } else {
 342           $msg = "Success"
 343             if $msg eq '';
 344           $rec = "Err:$err;Msg:$msg";
 345         } # if
 346       } elsif ($method =~ /^update/i) {
 347         # Updates are tricky because there is an unknown number of parms then
 348         # a hash. We will look for $VAR1 in the @values array and if we find
 349         # that then that is the start of the hash.
 350         my @parms;
 351
 352         # Since we're gonna shift off of @values we don't want to use $#values
 353         # in the for loop because it's value is dynamic and will change.
 354         my $valuesSize = $#values;
 355
 356         # Shift off each parm into @parms until we find $VAR1
 357         for (my $i = 0; $i < $valuesSize; $i++) {
 358           last if $values[0] =~ /^\$VAR1/;
 359
 360           push @parms, shift @values;
 361         } # for
 362
 363         # Now just join the rest of the @values together
 364         push @parms, join ' ', @values;
 365
 366         my ($err, $msg);
 367
 368         eval {
 369           ($err, $msg) = $ccdb->$method (@parms);
 370         }; # eval
 371
 372         if ($@) {
 373           print $client "$@\n";
 374           print $client "CCDB Status: 1\n";
 375           next;
 376         } else {
 377           $msg = "Success"
 378             if $msg eq '';
 379           $rec = "Err:$err;Msg:$msg";
 380         } # if
 381       } elsif ($method =~ /^delete/i) {
 382         my ($err, $msg);
 383
 384         eval {
 385           ($err, $msg) = $ccdb->$method (@values);
 386         }; # eval
 387
 388         if ($@) {
 389           print $client "$@\n";
 390           print $client "CCDB Status: 1\n";
 391           next;
 392         } else {
 393           # A little messy here. Normally a delete method returns the number of
 394           # records deleted as its status. But the caller will sense non-zero as
 395           # an error. So if the $msg simply says 'Records deleted' then we flip
 396           # the $err to 0.
 397           $err = 0
 398             if $msg eq 'Records deleted';
 399
 400           $rec = "Err:$err;Msg:$msg";
 401         } # if
 402       } # if
 403     } # if
 404
 405     if (ref $rec eq 'HASH') {
 406       if (%$rec) {
 407         foreach (keys %$rec) {
 408           $self->_debug ("Get: Found record");
 409
 410           my $data  = "$_~";
 411              $data .= $$rec{$_} ? $$rec{$_} : '';
 412
 413           print $client "$data\n";
 414         } # foreach
 415
 416         print $client "CCDB Status: 0\n";
 417       } else {
 418         $self->_debug ("Get: No record found");
 419
 420         print $client "CCDB::$method: No record found\n";
 421         print $client "CCDB Status: 1\n";
 422       } # if
 423     } elsif (ref $rec eq 'ARRAY') {
 424       if (@$rec > 0) {
 425         $self->_debug ("Find: Records found: " . scalar @$rec);
 426
 427         foreach my $entry (@$rec) {
 428           my %rec = %$entry;
 429
 430           print $client '-' x 80 . "\n";
 431
 432           foreach (keys %rec) {
 433             my $data  = "$_~";
 434                $data .= $rec{$_} ? $rec{$_} : '';
 435
 436             print $client "$data\n";
 437           } # foreach
 438         } # foreach
 439
 440         print $client '=' x 80 . "\n";
 441         print $client "CCDB Status: 0\n";
 442       } else {
 443         $self->_debug ("Find: Records not found");
 444
 445         print $client "CCDB::$method: No records found\n";
 446         print $client "CCDB Status: 1\n";
 447       } # if
 448     } elsif (ref \$rec eq 'SCALAR') {
 449       my ($err, $msg);
 450
 451       if ($rec =~ /Err:(-*\d+);Msg:(.*)/ms) {
 452         $err = $1;
 453         $msg = $2;
 454       } # if
 455
 456       print $client "$msg\n"
 457         if $msg;
 458       print $client "CCDB Status: $err\n";
 459     } # if
 460
 461     $self->_debug ("Looping around for next command");
 462   } # while
 463
 464   close $client;
 465
 466   $self->_verbose ("Serviced requests from $host");
 467
 468   return;
 469 }  # _serviceClient
 470
 471 sub execute ($) {
 472   my ($self, $request) = @_;
 473
 474   return (-1, 'Unable to talk to server')
 475     unless $self->{socket};
 476
 477   my ($status, @output) = (-1, ());
 478
 479   my $server = $self->{socket};
 480
 481   print $server "$request\n";
 482
 483   my $response;
 484
 485   while (defined ($response = <$server>)) {
 486     if ($response =~ /CCDB Status: (-*\d+)/) {
 487       $status = $1;
 488       last;
 489     } # if
 490
 491     push @output, $response;
 492   } # while
 493
 494   chomp @output;
 495
 496   my (@recs, $output);
 497
 498   return ($status, \@output)
 499     if $status;
 500
 501   if ($output[0] eq '-' x 80) {
 502     shift @output;
 503
 504     while ($_ = shift @output) {
 505       last if $_ eq '=' x 80;
 506
 507       my %rec;
 508
 509       while ($_) {
 510         last if $_ eq '-' x 80;
 511
 512         if (/^(\S+)~(.*)$/) {
 513           $rec{$1} = $2;
 514         } # if
 515
 516         $_ = shift @output;
 517       } # while
 518
 519       push @recs, \%rec;
 520     } # while
 521
 522     $output = \@recs;
 523   } else {
 524     my %rec;
 525
 526     foreach (@output) {
 527       if (/^(\S+):(.*)$/) {
 528         $rec{$1} = $2;
 529       } # if
 530     } # foreach
 531
 532     $output = \%rec;
 533   } # if
 534
 535   return ($status, $output);
 536 } # execute
 537
 538 sub startServer (;$) {
 539   my ($self, $port) = @_;
 540
 541   $port ||= $OPTS{CCDB_PORT};
 542
 543   # Create new socket to communicate to clients with
 544   $self->{socket} = IO::Socket::INET->new(
 545     Proto     => 'tcp',
 546     LocalPort => $port,
 547     Listen    => SOMAXCONN,
 548     Reuse     => 1
 549   );
 550
 551   error "Could not create socket - $!", 1
 552     unless $self->{socket};
 553
 554   # Announce ourselves
 555   $self->_log ("Clearexec V$VERSION accepting clients at " . localtime);
 556
 557   # Now wait for an incoming request
 558   LOOP:
 559   my $client;
 560
 561   while ($client = $self->{socket}->accept) {
 562     my $hostinfo = gethostbyaddr $client->peeraddr;
 563     my $host     = $hostinfo ? $hostinfo->name : $client->peerhost;
 564
 565     $self->_verbose ("$host is requesting service");
 566
 567     if ($self->getMultithreaded) {
 568       $self->{server} = $$;
 569
 570       my $childpid;
 571
 572       $self->_debug ("Spawning child to handle request");
 573
 574       error "Can't fork: $!"
 575         unless defined ($childpid = fork);
 576
 577       if ($childpid) {
 578         $self->{pid} = $$;
 579
 580         $SIG{CHLD} = \&_funeral;
 581         $SIG{HUP}  = \&_endServer;
 582         $SIG{USR2} = \&_restartServer;
 583
 584         $self->_debug ("Parent produced child [$childpid]");
 585       } else {
 586         # In child process - ServiceClient
 587         $self->{pid} = $$;
 588
 589         $self->_debug ("Calling _serviceClient");
 590         $self->_serviceClient ($host, $client);
 591         $self->_debug ("Returned from _serviceClient - exiting...");
 592
 593         exit;
 594       } # if
 595     } else {
 596       $self->_serviceClient ($host, $client);
 597     } # if
 598   } # while
 599
 600   # This works but I really don't like it. The parent should have looped back to
 601   # the while statement thus waiting for the next client. But it doesn't seem to
 602   # do that. Instead, when multithreaded, the child exits above and then the
 603   # parent breaks out of the while loop. I'm not sure why this is happening.
 604   # This goto fixes this up but it's sooooo ugly!
 605   goto LOOP;
 606 } # startServer
 607
 608 1;
 609
 610 =pod
 611
 612 =head1 CONFIGURATION AND ENVIRONMENT
 613
 614 DEBUG: If set then $debug is set to this level.
 615
 616 VERBOSE: If set then $verbose is set to this level.
 617
 618 TRACE: If set then $trace is set to this level.
 619
 620 =head1 DEPENDENCIES
 621
 622 =head2 Perl Modules
 623
 624 L<Carp>
 625
 626 L<FindBin>
 627
 628 L<IO::Socket|IO::Socket>
 629
 630 L<Net::hostent|Net::hostent>
 631
 632 L<POSIX>
 633
 634 =head2 ClearSCM Perl Modules
 635
 636 =begin man
 637
 638  DateUtils
 639  Display
 640  GetConfig
 641
 642 =end man
 643
 644 =begin html
 645
 646 <blockquote>
 647 <a href="http://clearscm.com/php/scm_man.php?file=lib/DateUtils.pm">DateUtils</a><br>
 648 <a href="http://clearscm.com/php/scm_man.php?file=lib/Display.pm">Display</a><br>
 649 <a href="http://clearscm.com/php/scm_man.php?file=lib/GetConfig.pm">GetConf</a><br>
 650 </blockquote>
 651
 652 =end html
 653
 654 =head1 SEE ALSO
 655
 656 =begin man
 657
 658 See also: CCDB
 659
 660 =end man
 661
 662 =begin html
 663
 664 <blockquote>
 665 <a href="http://clearscm.com/php/scm_man.php?file=CCDB/lib/CCDB.pm">CCDB</a><br>
 666 </blockquote>
 667
 668 =end html
 669
 670 =head1 BUGS AND LIMITATIONS
 671
 672 There are no known bugs in this module.
 673
 674 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
 675
 676 =head1 LICENSE AND COPYRIGHT
 677
 678 Copyright (c) 2011, ClearSCM, Inc. All rights reserved.
 679
 680 =cut