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; |