• Home
  • Services
    • Consultancy
    • Custom Software Solutions
    • Systems Adminsitration
    • Web Applications
    • Customers
  • SCM
    • Clearcase
      • Triggers
      • Evil Twin Finder
      • GUI DiffBL
      • View Ager
      • Open Source Builds
    • Clearquest
      • Clearquest Daemon
      • DB Conversions
    • Git
      • Repository
  • Scripting
    • Perl
    • ECRDig
  • Sysadm
    • Environment
  • About
    • Services
    • Our People
    • Contact Us
 

ClearSCM Inc.

You are viewing an unstyled version of this page. Either your browser does not support Cascading Style Sheets (CSS) or CSS styling has been disabled.

ECRD Daemon

This is a daemon script that opens a database and waits for requests for service by reading a socket. When requests come in it responds with the data for an ECR record from the database.

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;

Last modified: October 17 2016 @ 8:12 pm
Copyright © 2021, ClearSCM Inc. - All rights reserved