3 =head1 NAME $RCSfile: CCDBService.pm,v $
5 CCDBService - ClearCase DataBase Service
13 Andrew DeFaria <Andrew@ClearSCM.com>
21 Fri Mar 11 15:37:34 PST 2011
25 $Date: 2011/05/05 18:41:44 $
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.
35 This library implements both the daemon portion of the server and the client
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.
45 The caller makes requests in the form of:
49 Different methods will return different values. See CCDB.pm.
53 The following methods are available:
66 use POSIX ":sys_wait_h";
68 use lib "$FindBin::Bin/../../lib";
74 # Seed options from config file
75 our %OPTS = GetConfig ("$FindBin::Bin/../etc/ccdbservice.conf");
77 our $VERSION = '$Revision: 1.6 $';
78 ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
80 # Override options if in the environment
81 $OPTS{CCDB_HOST} = $ENV{CCDB_HOST}
83 $OPTS{CCDB_PORT} = $ENV{CCDB_PORT}
85 $OPTS{CCDB_MULTITHREADED} = $ENV{CCDB_MULTITHREADED}
86 if $ENV{CCDB_MULTITHREADED};
91 my $ccdbservice = bless {}, $class;
93 $ccdbservice->{multithreaded} = $OPTS{CCDB_MULTITHREADED};
99 my ($self, $msg) = @_;
103 $tag .= $self->{pid} ? "[$self->{pid}] " : '';
109 my ($self, $msg) = @_;
111 verbose $self->_tag ($msg);
117 my ($self, $msg) = @_;
119 debug $self->_tag ($msg);
125 my ($self, $msg) = @_;
127 display $self->_tag ($msg);
133 debug 'Entered _funeral';
135 while (my $childpid = waitpid (-1, WNOHANG) > 0) {
138 debug "childpid: $childpid - status: $status";
140 if ($childpid != -1) {
141 local $SIG{CHLD} = \&_funeral;
143 my $msg = 'Child has died';
144 $msg .= $status ? " with status $status" : '';
146 verbose "[$childpid] $msg"
149 debug "All children reaped";
157 display "CCDBService V$VERSION shutdown at " . localtime;
162 # Wait for all children to die
167 # Now that we are alone, we can simply exit
171 sub _restartServer () {
172 # Not sure what to do on a restart server
173 display 'Entered _restartServer';
178 sub setMultithreaded ($) {
179 my ($self, $value) = @_;
181 my $oldValue = $self->{multithreaded};
183 $self->{multithreaded} = $value;
188 sub getMultithreaded () {
191 return $self->{multithreaded};
194 sub connectToServer (;$$) {
195 my ($self, $host, $port) = @_;
197 $host ||= $OPTS{CCDB_HOST};
198 $port ||= $OPTS{CCDB_PORT};
200 $self->{socket} = IO::Socket::INET->new (
206 return unless $self->{socket};
208 $self->{socket}->autoflush
211 $self->{host} = $host;
212 $self->{port} = $port;
214 if ($self->{socket}) {
223 sub disconnectFromServer () {
226 undef $self->{socket};
229 } # disconnectFromServer
231 sub _serviceClient ($$) {
232 my ($self, $host, $client) = @_;
234 $self->_verbose ("Serving requests from $host");
236 # Set autoflush for client
240 my $ccdb = CCDB->new;
243 # Read command from client
252 last if $cmd =~ /^quit|^exit/i;
254 $self->_debug ("$host wants us to do $cmd");
257 my ($method, $rec, @keys, @values);
259 if ($cmd =~ /stopserver/i) {
260 if ($self->{server}) {
261 $self->_verbose ("$host requested to stop server [$self->{server}]");
263 # Send server hangup signal
264 kill 'HUP', $self->{server};
266 $self->_verbose ('Shutting down server');
268 print $client "CCDBService Status: 0\n";
273 $self->_debug ("Returning 0, undef");
276 @values = split /[^\S]+/, $cmd;
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";
285 $method = shift @values;
287 my $values = join ' ', @values;
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";
302 $self->_debug ("Executing CCDB::$method");
306 if ($method =~ /^get/i) {
308 %rec = $ccdb->$method (@values);
312 print $client "$@\n";
313 print $client "CCDB Status: 1\n";
318 } elsif ($method =~ /^find/i) {
320 @recs = $ccdb->$method (@values);
324 print $client "$@\n";
325 print $client "CCDB Status: 1\n";
330 } elsif ($method =~ /^add/i) {
334 ($err, $msg) = $ccdb->$method ($values);
338 print $client "$@\n";
339 print $client "CCDB Status: 1\n";
344 $rec = "Err:$err;Msg:$msg";
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.
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;
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/;
360 push @parms, shift @values;
363 # Now just join the rest of the @values together
364 push @parms, join ' ', @values;
369 ($err, $msg) = $ccdb->$method (@parms);
373 print $client "$@\n";
374 print $client "CCDB Status: 1\n";
379 $rec = "Err:$err;Msg:$msg";
381 } elsif ($method =~ /^delete/i) {
385 ($err, $msg) = $ccdb->$method (@values);
389 print $client "$@\n";
390 print $client "CCDB Status: 1\n";
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
398 if $msg eq 'Records deleted';
400 $rec = "Err:$err;Msg:$msg";
405 if (ref $rec eq 'HASH') {
407 foreach (keys %$rec) {
408 $self->_debug ("Get: Found record");
411 $data .= $$rec{$_} ? $$rec{$_} : '';
413 print $client "$data\n";
416 print $client "CCDB Status: 0\n";
418 $self->_debug ("Get: No record found");
420 print $client "CCDB::$method: No record found\n";
421 print $client "CCDB Status: 1\n";
423 } elsif (ref $rec eq 'ARRAY') {
425 $self->_debug ("Find: Records found: " . scalar @$rec);
427 foreach my $entry (@$rec) {
430 print $client '-' x 80 . "\n";
432 foreach (keys %rec) {
434 $data .= $rec{$_} ? $rec{$_} : '';
436 print $client "$data\n";
440 print $client '=' x 80 . "\n";
441 print $client "CCDB Status: 0\n";
443 $self->_debug ("Find: Records not found");
445 print $client "CCDB::$method: No records found\n";
446 print $client "CCDB Status: 1\n";
448 } elsif (ref \$rec eq 'SCALAR') {
451 if ($rec =~ /Err:(-*\d+);Msg:(.*)/ms) {
456 print $client "$msg\n"
458 print $client "CCDB Status: $err\n";
461 $self->_debug ("Looping around for next command");
466 $self->_verbose ("Serviced requests from $host");
472 my ($self, $request) = @_;
474 return (-1, 'Unable to talk to server')
475 unless $self->{socket};
477 my ($status, @output) = (-1, ());
479 my $server = $self->{socket};
481 print $server "$request\n";
485 while (defined ($response = <$server>)) {
486 if ($response =~ /CCDB Status: (-*\d+)/) {
491 push @output, $response;
498 return ($status, \@output)
501 if ($output[0] eq '-' x 80) {
504 while ($_ = shift @output) {
505 last if $_ eq '=' x 80;
510 last if $_ eq '-' x 80;
512 if (/^(\S+)~(.*)$/) {
527 if (/^(\S+):(.*)$/) {
535 return ($status, $output);
538 sub startServer (;$) {
539 my ($self, $port) = @_;
541 $port ||= $OPTS{CCDB_PORT};
543 # Create new socket to communicate to clients with
544 $self->{socket} = IO::Socket::INET->new(
551 error "Could not create socket - $!", 1
552 unless $self->{socket};
555 $self->_log ("Clearexec V$VERSION accepting clients at " . localtime);
557 # Now wait for an incoming request
561 while ($client = $self->{socket}->accept) {
562 my $hostinfo = gethostbyaddr $client->peeraddr;
563 my $host = $hostinfo ? $hostinfo->name : $client->peerhost;
565 $self->_verbose ("$host is requesting service");
567 if ($self->getMultithreaded) {
568 $self->{server} = $$;
572 $self->_debug ("Spawning child to handle request");
574 error "Can't fork: $!"
575 unless defined ($childpid = fork);
580 $SIG{CHLD} = \&_funeral;
581 $SIG{HUP} = \&_endServer;
582 $SIG{USR2} = \&_restartServer;
584 $self->_debug ("Parent produced child [$childpid]");
586 # In child process - ServiceClient
589 $self->_debug ("Calling _serviceClient");
590 $self->_serviceClient ($host, $client);
591 $self->_debug ("Returned from _serviceClient - exiting...");
596 $self->_serviceClient ($host, $client);
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!
612 =head1 CONFIGURATION AND ENVIRONMENT
614 DEBUG: If set then $debug is set to this level.
616 VERBOSE: If set then $verbose is set to this level.
618 TRACE: If set then $trace is set to this level.
628 L<IO::Socket|IO::Socket>
630 L<Net::hostent|Net::hostent>
634 =head2 ClearSCM Perl Modules
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>
665 <a href="http://clearscm.com/php/scm_man.php?file=CCDB/lib/CCDB.pm">CCDB</a><br>
670 =head1 BUGS AND LIMITATIONS
672 There are no known bugs in this module.
674 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
676 =head1 LICENSE AND COPYRIGHT
678 Copyright (c) 2011, ClearSCM, Inc. All rights reserved.