ecrc/ecrd

   1 #!/usr/bin/perl
   2 ################################################################################
   3 #
   4 # File:         ecrd: ECR Daemon
   5 # Description:  This script implements a daemon that handles requests for
   6 #               queries about information on ECRs contained in the Quintus
   7 #               database. In addition to lessoning the amount of time it takes
   8 #               for database opens, access to Quintus data is only available
   9 #               on certain machines. Additionally, for Perl to access this
  10 #               Informix database the Informix version of DBD would need to be
  11 #               locally installed. By calling this daemon instead clients need
  12 #               not have to install Informix and then code all the necessary
  13 #               code to access Quintus data as well as have to understand the
  14 #               structure of the database. Instead clients need only say "Give
  15 #               me what you got on ECR #<whatever>".
  16 # Author:       Andrew@DeFaria.com
  17 # Created:      Tue Feb 15 09:54:59 PST 2005
  18 # Modified:
  19 # Language:     Perl
  20 #
  21 # (c) Copyright 2005, LynuxWorks, all rights reserved.
  22 #
  23 ################################################################################
  24 use strict;
  25 use warnings;
  26
  27 use IO::Socket;
  28 use Net::hostent;
  29 use POSIX qw(setsid);
  30 use DBI;
  31
  32 my $ecrdb    = "lynxmigr1";
  33 my $port     = (!defined $ENV {ECRDPORT}) ? 1500 : $ENV {ECRDPORT};
  34
  35 # Global variables
  36 my $DB;
  37 my $ecrserver;
  38 my $ecrclient;
  39 my $sth;
  40 my $statement;
  41
  42 # Options
  43 my $verbose;
  44 my $debug;
  45 my $daemon_mode;
  46 my $quiet_mode;
  47 my $multithreaded;
  48 my $timeout     = 10;
  49
  50 # ECR translations. Note the Quintus database stores certain choice lists as
  51 # enumerations. They I guess they are configurable. The right thing to do
  52 # would be to figure out how to look up the definition given the number. But
  53 # we are gonna cheat here and hard code a few important enumerations.
  54 my @defstatus = (
  55   "Open",
  56   "Closed",
  57   "Fixed",
  58   "Not a bug",
  59   "Obsolete",
  60   "Defered",
  61   "Duplicate"
  62 );
  63 my @state = (
  64   "Reported",
  65   "Assigned",
  66   "Selected",
  67   "Resolved",
  68   "Integrated",
  69   "Retired",
  70   "Reviewed",
  71   "Pending Review"
  72 );
  73 my @priority = (
  74   "Low",
  75   "Medium",
  76   "High",
  77   "Critical"
  78 );
  79 my @severity = (
  80   "Low",
  81   "Medium",
  82   "High",
  83   "Critical"
  84 );
  85
  86 # Pid
  87 my $pid = $$;
  88
  89 my $me = `basename $0`;
  90 chomp $me;
  91 my $ecrdversion = "1.3";
  92
  93 my @all_fields = (
  94   "productdefect",      # integer
  95   "componentdefect",    # integer
  96   "defectdefectdup",    # integer
  97   "workgroupdefect",    # integer
  98   "reporterdefect",     # integer
  99   "resolverdefect",     # integer
 100   "confirmerdefect",    # integer
 101   "buildversdefect",    # integer
 102   "rpt_versdefect",     # integer
 103   "res_versdefect",     # integer
 104   "conf_versdefect",    # integer
 105   "state",              # integer
 106   "resolverstatus",     # integer
 107   "confirmerstatus",    # integer
 108   "escstatus",          # integer
 109   "owner",              # integer
 110   "severity",           # integer
 111   "priority",           # integer
 112   "summary",            # varchar(80,0)
 113   "datereported",       # datetime year to second
 114   "dateresolved",       # datetime year to second
 115 #  "description",       # text
 116 # Note: Some descriptions fields are huge containing things like
 117 # uuencoded tar files!  They are so huge that they cause this server
 118 # to fail (not sure why - it shouldn't but it does. So this hack
 119 # returns only the first 50K of description to avoid that problem.
 120   "description [1,50000]",      # text
 121   "cclist",             # varchar(80,0)
 122   "dateconfirmed",      # datetime year to second
 123   "datemodified",       # datetime year to second
 124   "fix_by_date",        # date
 125   "fix_by_version",     # integer
 126   "history",            # text
 127   "likelihood",         # integer
 128   "estfixtime",         # datetime year to second
 129   "actfixtime",         # datetime year to second
 130   "resolution",         # text
 131   "businessimpact",     # integer
 132   "origin",             # integer
 133   "docimpact",          # integer
 134   "report_platform",    # integer
 135   "resolve_platform",   # integer
 136   "confirm_platform",   # integer
 137   "test_file",          # varchar(64,0)
 138   "visibility",         # integer
 139   "misc",               # varchar(80,0)
 140   "defecttype",         # integer
 141   "defstatus",          # integer
 142   "customertext",       # text
 143   "modifiedby",         # varchar(20,0)
 144   "classification",     # integer
 145   "datefixed"           # datetime year to second
 146 );
 147
 148 # Forwards
 149 sub CloseDB;
 150 sub GetRequest;
 151
 152 sub timestamp {
 153   my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
 154
 155   $mday  = "0$mday" if $mday < 10;
 156   $mon   = "0$mon"  if $mon  < 10;
 157   $hour  = "0$hour" if $hour < 10;
 158   $min   = "0$min"  if $min  < 10;
 159   $year += 1900;
 160
 161   return "$mon/$mday/$year $hour:$min";
 162 } # timestamp
 163
 164 sub log_message {
 165   print "[$pid] " . timestamp . " @_\n" if defined $verbose;
 166 } # log_message
 167
 168 sub log_error {
 169   print STDERR "[$pid] " . timestamp . " ERROR: @_\n"
 170 } # log_error
 171
 172 sub log_warning {
 173   print STDERR "[$pid] " . timestamp . " WARNING: @_\n"
 174 } # log_error
 175
 176 sub debug {
 177   print "[$pid] " . timestamp . " @_\n" if defined $debug;
 178 } # debug
 179
 180 sub verbose {
 181   print "[$pid] " . timestamp . " @_\n" if !defined $quiet_mode;
 182 } # verbose
 183
 184 sub DBError {
 185   my $msg       = shift;
 186   my $statement = shift;
 187
 188   if (!defined $DB) {
 189     print "Catostrophic error: DB undefined!\n";
 190     exit 1;
 191   } # if
 192
 193   print $msg . "\nError #" . $DB->err . " " . $DB->errstr . "\n";
 194   print "SQL Statement: $statement\n" if defined $statement;
 195
 196   exit $DB->err;
 197 } # DBError
 198
 199 sub timeout {
 200   debug "After $timeout seconds of inactivity client timed out";
 201
 202   my $hostinfo = gethostbyaddr ($ecrclient->peeraddr);
 203   my $host = $hostinfo->name || $ecrclient->peerhost;
 204   debug "Closing connection to $host";
 205
 206   # Close client's connection
 207   close $ecrclient;
 208
 209   # Set up signal handlers again
 210   $SIG{ALRM} = \&timeout;
 211   $SIG{INT}  = $SIG{QUIT} = 23234
 212 \&interrupt;
 213   GetRequest;
 214 } # timeout
 215
 216 sub interrupt {
 217   log_warning "Interrupted - closing down...";
 218   close $ecrserver;
 219   verbose "Connection closed";
 220   CloseDB;
 221
 222   exit;
 223 } # interrupt
 224
 225 sub GetClientAck {
 226   my $client = shift;
 227   my $clientresp;
 228
 229   debug "ENTER: GetClientAck";
 230   alarm $timeout;
 231   while (defined $client and defined ($clientresp = <$client>)) {
 232     chomp $clientresp;
 233     chop $clientresp if $clientresp =~ /\r/;
 234     if ($clientresp eq "ACK") {
 235       return
 236     } # if
 237     log_warning "Received $clientresp from client - expected ACK";
 238   } # while
 239   debug "EXIT: GetClientAck";
 240 } # GetClientAck
 241
 242 sub GetClientCmd {
 243   my $client = shift;
 244   my $clientresp;
 245
 246   alarm $timeout;
 247   while (defined $client and defined ($clientresp = <$client>)) {
 248     chomp $clientresp;
 249     return $clientresp;
 250   } # while
 251 } # GetClientResponse
 252
 253 sub SendClientAck {
 254   my $client = shift;
 255
 256   debug "ENTER: SendClientAck";
 257   print $client "ACK\n";
 258   debug "EXIT: SendClientAck";
 259 } # SendClientAck
 260
 261 sub SendClientResponse {
 262   my $client   = shift;
 263   my $response = shift;
 264
 265   print $client "$response\n";
 266 } # SendClientResponse
 267
 268 sub EnterDaemonMode {
 269   my $logfile  = shift;
 270   my $errorlog = shift;
 271
 272   $logfile  = "/dev/null" if $logfile  eq "";
 273   $errorlog = "/dev/null" if $errorlog eq "";
 274
 275   # Change the current directory to /
 276   chdir '/'
 277     or die "$me: Error: Can't chdir to / ($!)";
 278
 279   # Turn off umask
 280   umask 0;
 281
 282   # Redirect STDIN to /dev/null
 283   open STDIN, '/dev/null'
 284     or die "$me: Error: Can't redirect /dev/null ($!)";
 285
 286   # Redirect STDOUT to logfile
 287   open STDOUT, ">>$logfile"
 288     or die "$me: Error: Can't redirect stdout to $logfile ($!)";
 289
 290   # Redirect STDERR to errorlog
 291   open STDERR, ">>$errorlog"
 292     or die "$me: Error: Can't redirect stderr to $errorlog ($!)";
 293
 294   # Now fork the daemon
 295   defined (my $pid = fork)
 296     or die "$me: Error: Can't create daemon ($!)";
 297
 298   # Now the parent exits
 299   exit if $pid;
 300
 301   # Set process to be session leader
 302   setsid
 303     or die "$me: Error: Can't start a new session ($!)";
 304 } # EnterDaemonMode
 305
 306 sub OpenDB {
 307   # Connect to database. Note this is using anonymous access (read only)
 308   $DB = DBI->connect("DBI:Informix:$ecrdb")
 309     or DBError "Unable to open database";
 310   log_message "Opened $ecrdb database";
 311
 312   # Setup our select statement with placeholders
 313   $statement = "select ";
 314
 315   # Build up the field list
 316   my $first_time = 1;
 317   foreach (@all_fields) {
 318     if ($first_time) {
 319       $first_time = 0;
 320       $statement .= $_;
 321     } else {
 322       $statement .= ",$_";
 323     } # if
 324   } # foreach
 325
 326   # Now add the table and condition
 327   $statement .= " from defect where pkey=?";
 328
 329   $sth = $DB->prepare ($statement)
 330     or DBError "Unable to prepare statement", $statement;
 331 } # OpenDB
 332
 333 sub CloseDB {
 334   $DB->disconnect ()
 335     or DBError "Unable to disconnect from database!";
 336   verbose "Closed $ecrdb database";
 337 } # CloseDB
 338
 339 sub Usage {
 340   my $msg = shift;
 341
 342   print "$msg\n\n" if defined $msg;
 343
 344   print "Usage: $me [ -D ] [ -v ] [ -d ] [-p <port>] [ -m ] [ -q ]\n\n";
 345   print "Where:\t-D\tEnter Daemon mode\n";
 346   print "\t-v\tVerbose mode (Default off)\n";
 347   print "\t-d\tDebug mode (Default off)\n";
 348   print "\t-p\tPort number to use (Default 1500)\n";
 349   print "\t-m\tMultithreaded (Default off)\n";
 350   print "\t-q\tQuiet mode (Default on)\n";
 351   exit 1;
 352 } # Usage
 353
 354 sub GetECRRecord {
 355   my $ecr = shift;
 356
 357   if ($ecr =~ /\D/) {
 358     log_error "ECR $ecr is not numeric!";
 359     return ();
 360   } # if
 361
 362   my %fields;
 363   my $record;
 364   my $value;
 365
 366   $sth->execute ($ecr)
 367     or DBError "Unable to execute statement", $statement;
 368
 369   my $row = $sth->fetchrow_arrayref;
 370
 371   if (!defined $row) {
 372     # @row is empty if there was no ECR by that number
 373     log_error "ECR $ecr not found!";
 374     return ();
 375   } # if
 376
 377   my @rows = @{$row};
 378   foreach (@all_fields) {
 379     my $value = shift @rows;
 380
 381     # Transform newlines to "\n" so the field is treated as one large field
 382     $value =~ s/\n/\\n/g if defined $value;
 383
 384     # Perform some choice list field translations. Again this would be
 385     # better done by doing database lookups to translate the enums...
 386     $value = $defstatus [$value]        if /defstatus/ and defined $value;
 387     $value = $state     [$value]        if /state/     and defined $value;
 388     $value = $priority  [$value]        if /priority/  and defined $value;
 389     $value = $severity  [$value]        if /severity/  and defined $value;
 390     # Fix description field back
 391     if (/^description/) {
 392       $_ = "description";
 393     } # if
 394     $fields {$_} = $value
 395   } # foreach
 396
 397   return %fields;
 398 } # GetECRRecord
 399
 400 sub ServiceClient {
 401   my $ecrclient = shift;
 402
 403   # Service this client
 404   my $hostinfo = gethostbyaddr ($ecrclient->peeraddr);
 405   my $host = $hostinfo->name || $ecrclient->peerhost;
 406
 407   verbose "Connect from $host";
 408   log_message "Waiting for command from $host";
 409   while () {
 410     GetClientAck ($ecrclient);
 411     $_ = GetClientCmd ($ecrclient);
 412     next unless /\S/; # Skip blank requests
 413     last if /quit|exit/i;
 414
 415     if (/\*/) {
 416       log_message "$host requests a list of all ECR #'s";
 417       SendClientAck ($ecrclient);
 418       ReturnAllECRNbrs ($ecrclient);
 419       SendClientAck ($ecrclient);
 420       next;
 421     } # if
 422
 423     log_message "$host requests information about ECR $_";
 424     SendClientAck ($ecrclient);
 425     my %fields = GetECRRecord $_;
 426
 427     if (%fields) {
 428       SendClientResponse ($ecrclient, "ecr: $_");
 429       while (my ($key, $value) = each (%fields)) {
 430         $value = !defined $value ? "" : $value;
 431         SendClientResponse ($ecrclient, "$key: $value");
 432       } # while
 433     } else {
 434       SendClientResponse ($ecrclient, "ECR $_ was not found");
 435     } # if
 436     SendClientAck ($ecrclient);
 437   } # while
 438
 439   verbose "Closing connection from $host at client's request";
 440   close $ecrclient;
 441 } # ServiceClient
 442
 443 sub Funeral {
 444   my $childpid = wait;
 445   $SIG{CHLD} = \&Funeral;
 446   log_message "Child has died" . ($? ? " with status $?" : "");
 447 } # Funeral
 448
 449 sub GetRequest {
 450   # Now wait for an incoming request
 451   while ($ecrclient = $ecrserver->accept ()) {
 452     my $hostinfo = gethostbyaddr ($ecrclient->peeraddr);
 453     my $host = $hostinfo->name || $ecrclient->peerhost;
 454     log_message "$host is requesting service";
 455     if (defined ($multithreaded)) {
 456       my $childpid;
 457
 458       log_message "Spawning child to handle request";
 459
 460       die "$me: ERROR: Can't fork: %!" unless defined ($childpid = fork ());
 461
 462       if ($childpid) {
 463         # In parent - set up for clean up of child process
 464         log_message "Parent produced child ($childpid)";
 465         $SIG{CHLD} = \&Funeral;
 466         log_message "Parent looking for another request to service";
 467       } else {
 468         # In child process - ServiceClient
 469         $pid = $$;
 470         debug "Child [$pid] has been born";
 471         ServiceClient ($ecrclient);
 472         log_message "Child finished servicing requests";
 473         kill ("TERM", $$);
 474         exit;
 475       } # if
 476     } else {
 477       ServiceClient ($ecrclient);
 478     } # if
 479   } # while
 480
 481   close ($ecrserver);
 482 } # GetRequest
 483
 484 sub ProcessRequests {
 485   # The subroutine handles processing of requests by using a socket to
 486   # communicate with clients.
 487   $ecrserver = IO::Socket::INET->new (
 488     Proto     => 'tcp',
 489     LocalPort => $port,
 490     Listen    => SOMAXCONN,
 491     Reuse     => 1
 492   );
 493
 494   die "$me: Error: Could not create socket ($!)\n" unless $ecrserver;
 495
 496   verbose "ECR DB Server (ecrd V$ecrdversion) accepting clients on port $port";
 497
 498   GetRequest;
 499 } # ProcessRequests
 500
 501 sub ReturnAllECRNbrs {
 502   my $ecrclient = shift;
 503
 504   my $statement = "select pkey from defect";
 505
 506   my $sth = $DB->prepare ($statement)
 507     or DBError "Unable to prepare statement", $statement;
 508
 509   $sth->execute ()
 510     or DBError "Unable to execute statement", $statement;
 511
 512   log_message "Returning all ECR numbers...";
 513   while (my @row = $sth->fetchrow_array) {
 514     SendClientResponse ($ecrclient, $row [0]);
 515   } # while
 516
 517   log_message "All ECR numbers returned";
 518 } # ReturnAllECRNbrs
 519
 520 # Start main code
 521 # Reopen STDOUT.
 522 open STDOUT, ">-" or die "Unable to reopen STDOUT\n";
 523
 524 # Set unbuffered output
 525 $| = 1;
 526
 527 while ($ARGV [0]) {
 528   if ($ARGV [0] eq "-D") {
 529     $daemon_mode = 1;
 530   } elsif ($ARGV [0] eq "-v") {
 531     $verbose = 1;
 532     undef ($quiet_mode);
 533   } elsif ($ARGV [0] eq "-d") {
 534     $debug = 1;
 535     undef ($quiet_mode);
 536   } elsif ($ARGV [0] eq "-m") {
 537     $multithreaded = 1;
 538   } elsif ($ARGV [0] eq "-q") {
 539     $quiet_mode = 1;
 540     undef ($verbose);
 541   } elsif ($ARGV [0] eq "-p") {
 542     shift @ARGV;
 543     Usage "Must specify a port # after -p" if (!defined $ARGV [0]);
 544     $port = $ARGV[0];
 545   } else {
 546     Usage "Unknown parameter found: " . $ARGV[0];
 547   } # if
 548
 549   shift @ARGV;
 550 } # while
 551
 552 my $tmp = (!defined $ENV {TMP}) ? "/tmp" : $ENV {TMP};
 553 my $ecrd_logfile = "$tmp/$me.log";
 554 my $ecrd_errfile = "$tmp/$me.err";
 555
 556 EnterDaemonMode ($ecrd_logfile, $ecrd_logfile) if defined ($daemon_mode);
 557
 558 OpenDB;
 559
 560 # Set up signal handlers
 561 $SIG{ALRM} = \&timeout;
 562 $SIG{INT}  = $SIG{QUIT} = \&interrupt;
 563
 564 ProcessRequests;