defaria.com/Computers/code/bin/clearquest/cqd

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