cq/cqd/cqd

   1 #!C:/Progra~1/Rational/ClearQuest/CQPerl
   2 ################################################################################
   3 #
   4 # File:         cqd,v
   5 # Revision:     1.1.1.1
   6 # Description:  This script implements a daemon that handles requests for
   7 #               queries to the Clearquest database. Opening up the Clearquest
   8 #               database takes a long time, therefore this daemon will run in
   9 #               the background and handle requests.
  10 # Author:       Andrew@DeFaria.com
  11 # Created:      Fri May 31 15:34:50  2002
  12 # Modified:     2007/05/17 07:45:48
  13 # Language:     Perl
  14 #
  15 # (c) Copyright 2007, ClearSCM, Inc., all rights reserved.
  16 #
  17 ################################################################################
  18 use strict;
  19 use CQPerlExt;
  20 use IO::Socket;
  21 use Net::hostent;
  22 use POSIX qw(setsid);
  23
  24 # Generic, harmless, user reporter
  25 my $cquser   = "reporter";
  26 my $cqpasswd = "news";
  27 my $cqdb     = "BUGS2";
  28 my $port     = 1500;
  29
  30 my $session;
  31 my $verbose;
  32 my $daemon_mode;
  33 my $quiet_mode;
  34 my $multithreaded;
  35 my $pid = $$;
  36
  37 my $me = `basename $0`;
  38 chomp $me;
  39 my $cqdversion = "2.0";
  40
  41 my @all_fields = (
  42   "cc",                 "description",          "field_trial",
  43   "fixed_date",         "fixed_in",             "found_in",
  44   "headline",           "manager",              "module",
  45   "must_fix",           "note_entry",           "notes_log",
  46   "owner",              "pending_reason",       "priority",
  47   "product",            "project",              "resolution",
  48   "severity",           "state",                "submit_date",
  49   "submitter",          "symptoms",             "verified_by",
  50   "verified_date",      "resolution_statetype", "keywords",
  51   "fixed_by"
  52 );
  53
  54 my %fields= ();
  55
  56 sub log_message {
  57   print "[$pid] @_\n" if defined ($verbose);
  58 } # log_message
  59
  60 sub display_message {
  61   print "[$pid] @_\n" if !defined ($quiet_mode);
  62 } # display_message
  63
  64 sub log_error {
  65   print STDERR "[$pid] ERROR: @_\n"
  66 } # log_error
  67
  68 sub log_warning {
  69   print STDERR "[$pid] WARNING: @_\n"
  70 } # log_error
  71
  72 sub GetClientAck {
  73   my $client = shift;
  74   my $clientresp;
  75
  76   while (defined ($clientresp = <$client>)) {
  77     chomp $clientresp;
  78     if ($clientresp eq "ACK") {
  79       return
  80     } # if
  81     log_warning "Received $clientresp from client - expected ACK";
  82   } # while
  83 } # GetClientAck
  84
  85 sub GetClientCmd {
  86   my $client = shift;
  87   my $clientresp;
  88
  89   while (defined ($clientresp = <$client>)) {
  90     chomp $clientresp;
  91     return $clientresp;
  92   } # while
  93 } # GetClientResponse
  94
  95 sub SendClientAck {
  96   my $client = shift;
  97
  98   print $client "ACK\n";
  99 } # SendClientAck
 100
 101 sub SendClientResponse {
 102   my $client   = shift;
 103   my $response = shift;
 104
 105   print $client "$response\n";
 106 } # SendClientResponse
 107
 108 sub EnterDaemonMode {
 109   my $logfile  = shift (@_);
 110   my $errorlog = shift (@_);
 111
 112   log_message "Entering Daemon Mode (\"$logfile\", \"$errorlog\")";
 113   if ($logfile eq '') {
 114     $logfile = "/dev/null";
 115   } # if
 116
 117   if ($errorlog eq '') {
 118     $errorlog = "/dev/null";
 119   } # if
 120
 121   # Change the current directory to /
 122   chdir 'C:\\' or die "$me: Error: Can't chdir to C:\\ ($!)";
 123
 124   # Turn off umask
 125   umask 0;
 126
 127   # Redirect STDIN to /dev/null
 128   open STDIN, '/dev/null'
 129     or die "$me: Error: Can't read /dev/null ($!)";
 130
 131   # Redirect STDOUT to logfile
 132   open STDOUT, ">>$logfile"
 133     or die "$me: Error: Can't write to $logfile ($!)";
 134
 135   # Redirect STDERR to errorlog
 136   open STDERR, ">>$errorlog"
 137     or die "$me: Error: Can't write to $errorlog ($!)";
 138
 139   # Now fork the daemon
 140   defined (my $pid = fork)
 141     or die "$me: Error: Can't create daemon ($!)";
 142
 143   # Now the parent exits
 144   exit if $pid;
 145
 146   # Set process to be session leader
 147   setsid
 148     or die "$me: Error: Can't start a new session ($!)";
 149   log_message "Entered Daemon Mode";
 150 } # EnterDaemonMode
 151
 152 sub OpenDB {
 153   log_message "Opening $cqdb database";
 154   $session = CQPerlExt::CQSession_Build ();
 155   $session->UserLogon ($cquser, $cqpasswd, $cqdb, "");
 156   log_message "Opened $cqdb database";
 157 } # OpenDB
 158
 159 sub CloseDB {
 160   CQSession::Unbuild ($session);
 161 } # CloseDB
 162
 163 sub Usage {
 164   print "Usage: $me [ -d ] [ -v ] [ -m ] [ -q ]\n\n";
 165   print "Where:\t-d\tEnter Daemon mode (currently not working)\n";
 166   print "\t-v\tVerbose mode\n";
 167   print "\t-m\tMultithreaded (currently not working)\n";
 168   print "\t-q\tQuiet mode\n";
 169   exit 1;
 170 } # Usage
 171
 172 sub GetBugRecord {
 173   my $bugid = shift;
 174   %fields   = @_;
 175
 176   my $record;
 177   my $value;
 178
 179   # Use eval because the bug ID passed in may not be found. If there is
 180   # an error with this call we assume the bug ID is not valid.
 181   eval {
 182     $record = $session->GetEntity ("defect", $bugid);
 183   } or log_error "Bug ID $bugid not found!", return 0;
 184
 185   foreach (@all_fields) {
 186     # The field name specified may be undefined. It may also just be
 187     # not filled in. We need to use eval to attempt to get the field and
 188     # then determine which error it was: Undefined field or simply a field
 189     # that was not filled in.
 190     eval {
 191       $value = $record->GetFieldValue ($_)->GetValue
 192     };
 193     if ($@ =~ m/object that does not exist/) {
 194       $value = "<Undefined field>";
 195     } elsif ($value eq "") {
 196       $value = "<Unspecified>";
 197     } # if
 198     $value =~ tr/\n/ /s;
 199     $fields {$_} = $value;
 200   } # foreach
 201
 202   return 1;
 203 } # GetBugRecord
 204
 205 sub ServiceClient {
 206   my $cqclient = shift;
 207
 208   # Service this client
 209   my $hostinfo = gethostbyaddr ($cqclient->peeraddr);
 210   my $host = $hostinfo->name || $cqclient->peerhost;
 211
 212   display_message "Connect from $host";
 213   log_message "Waiting for command from $host";
 214   while () {
 215     GetClientAck ($cqclient);
 216     $_ = GetClientCmd ($cqclient);
 217     next unless /\S/; # Skip blank requests
 218     last if /quit|exit|shutdown/i;
 219     log_message "$host requests information about bug ID $_";
 220     SendClientAck ($cqclient);
 221     if (GetBugRecord ($_, %fields)) {
 222       SendClientResponse ($cqclient, "id: $_");
 223       my $key;
 224       my $value;
 225       while (($key, $value) = each (%fields)) {
 226         SendClientResponse ($cqclient, "$key: $value");
 227       } # while
 228     } else {
 229       SendClientResponse ($cqclient, "Bug ID $_ was not found");
 230     } # if
 231     SendClientAck ($cqclient);
 232   } # while
 233
 234   display_message "Closing connection from $host at client's request";
 235   close $cqclient;
 236 } # ServiceClient
 237
 238 sub Funeral {
 239   my $childpid = wait;
 240   $SIG{CHLD} = \&Funeral;
 241   log_message "Child has died" . ($? ? " with status $?" : "");
 242 } # Funeral
 243
 244 sub ProcessRequests {
 245   # The subroutine handles processing of requests by using a socket to
 246   # communicate with clients.
 247   my $cqserver = IO::Socket::INET->new (
 248     Proto     => 'tcp',
 249     LocalPort => $port,
 250     Listen    => SOMAXCONN,
 251     Reuse     => 1
 252   );
 253
 254   die "$me: Error: Could not create socket (%!)\n" unless $cqserver;
 255
 256   display_message "Clearquest DB Server (cqd V$cqdversion) accepting clients";
 257
 258   # Now wait for an incoming request
 259   while (my $cqclient = $cqserver->accept ()) {
 260     my $hostinfo = gethostbyaddr ($cqclient->peeraddr);
 261     my $host = $hostinfo->name || $cqclient->peerhost;
 262     log_message "$host is requesting service";
 263     if (defined ($multithreaded)) {
 264       my $childpid;
 265
 266       log_message "Spawning child to handle request";
 267
 268       die "$me: ERROR: Can't fork: %!" unless defined ($childpid = fork ());
 269
 270       if ($childpid) {
 271         # In parent - set up for clean up of child process
 272         log_message "In parent";
 273         $childpid = -$childpid;
 274         log_message "Parent produced child ($childpid)";
 275         $SIG{CHLD} = \&Funeral;
 276         log_message "Parent looking for another request to service";
 277       } else {
 278         # In child process - ServiceClient
 279         log_message "In child";
 280         $pid = -$$;
 281         log_message "Child has been born";
 282         ServiceClient ($cqclient);
 283         log_message "Child finished servicing requests";
 284         kill ("TERM", $$);
 285         exit;
 286       } # if
 287     } else {
 288       ServiceClient ($cqclient);
 289     } # if
 290   } # while
 291
 292   display_message "Shutting down server";
 293   close ($cqserver);
 294
 295 } # ProcessRequests
 296
 297 # Start main code
 298 # Reopen STDOUT. This is because cqperl screws around with STDOUT in some
 299 # weird fashion
 300 open STDOUT, ">-" or die "Unable to reopen STDOUT\n";
 301 # Set unbuffered output for the same reason (cqperl)
 302 $| = 1;
 303
 304 while ($ARGV [0]) {
 305   if ($ARGV [0] eq "-d") {
 306     $daemon_mode = 1;
 307   } elsif ($ARGV [0] eq "-v") {
 308     $verbose = 1;
 309     undef ($quiet_mode);
 310   } elsif ($ARGV [0] eq "-m") {
 311     $multithreaded = 1;
 312   } elsif ($ARGV [0] eq "-q") {
 313     $quiet_mode = 1;
 314     undef ($verbose);
 315   } else {
 316     Usage;
 317   } # if
 318   shift (@ARGV);
 319 } # while
 320
 321 my $tmp = $ENV {"TMP"};
 322 my $cqd_logfile = "$tmp\\$me.log";
 323 my $cqd_errfile = "$tmp\\$me.err";
 324
 325 EnterDaemonMode ($cqd_logfile, $cqd_errfile) if defined ($daemon_mode);
 326
 327 OpenDB;
 328
 329 ProcessRequests;
 330
 331 display_message "Shutting down";
 332
 333 CloseDB;
 334 display_message "Closed $cqdb database";
 335
 336 exit 0;