| 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 #". |
| 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 ] [ -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; |