1 #!C:/Progra~1/Rational/ClearQuest/CQPerl
2 ################################################################################
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
14 # (c) Copyright 2002, Salira Optical Network Systems, all rights reserved.
16 ################################################################################
23 # Generic, harmless, user reporter
24 my $cquser = "reporter";
25 my $cqpasswd = "news";
36 my $me = `basename $0`;
38 my $cqdversion = "2.0";
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",
56 print "[$pid] @_\n" if defined ($verbose);
60 print "[$pid] @_\n" if !defined ($quiet_mode);
64 print STDERR "[$pid] ERROR: @_\n"
68 print STDERR "[$pid] WARNING: @_\n"
75 while (defined ($clientresp = <$client>)) {
77 if ($clientresp eq "ACK") {
80 log_warning "Received $clientresp from client - expected ACK";
88 while (defined ($clientresp = <$client>)) {
97 print $client "ACK\n";
100 sub SendClientResponse {
102 my $response = shift;
104 print $client "$response\n";
105 } # SendClientResponse
107 sub EnterDaemonMode {
108 my $logfile = shift (@_);
109 my $errorlog = shift (@_);
111 log_message "Entering Daemon Mode (\"$logfile\", \"$errorlog\")";
112 if ($logfile eq '') {
113 $logfile = "/dev/null";
116 if ($errorlog eq '') {
117 $errorlog = "/dev/null";
120 # Change the current directory to /
121 chdir 'C:\\' or die "$me: Error: Can't chdir to C:\\ ($!)";
126 # Redirect STDIN to /dev/null
127 open STDIN, '/dev/null'
128 or die "$me: Error: Can't read /dev/null ($!)";
130 # Redirect STDOUT to logfile
131 open STDOUT, ">>$logfile"
132 or die "$me: Error: Can't write to $logfile ($!)";
134 # Redirect STDERR to errorlog
135 open STDERR, ">>$errorlog"
136 or die "$me: Error: Can't write to $errorlog ($!)";
138 # Now fork the daemon
139 defined (my $pid = fork)
140 or die "$me: Error: Can't create daemon ($!)";
142 # Now the parent exits
145 # Set process to be session leader
147 or die "$me: Error: Can't start a new session ($!)";
148 log_message "Entered Daemon Mode";
152 log_message "Opening $cqdb database";
153 $session = CQPerlExt::CQSession_Build ();
154 $session->UserLogon ($cquser, $cqpasswd, $cqdb, "");
155 log_message "Opened $cqdb database";
159 CQSession::Unbuild ($session);
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";
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.
181 $record = $session->GetEntity ("defect", $bugid);
182 } or log_error "Bug ID $bugid not found!", return 0;
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.
190 $value = $record->GetFieldValue ($_)->GetValue
192 if ($@ =~ m/object that does not exist/) {
193 $value = "<Undefined field>";
194 } elsif ($value eq "") {
195 $value = "<Unspecified>";
198 $fields {$_} = $value;
205 my $cqclient = shift;
207 # Service this client
208 my $hostinfo = gethostbyaddr ($cqclient->peeraddr);
209 my $host = $hostinfo->name || $cqclient->peerhost;
211 display_message "Connect from $host";
212 log_message "Waiting for command from $host";
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: $_");
224 while (($key, $value) = each (%fields)) {
225 SendClientResponse ($cqclient, "$key: $value");
228 SendClientResponse ($cqclient, "Bug ID $_ was not found");
230 SendClientAck ($cqclient);
233 display_message "Closing connection from $host at client's request";
239 $SIG{CHLD} = \&Funeral;
240 log_message "Child has died" . ($? ? " with status $?" : "");
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 (
253 die "$me: Error: Could not create socket (%!)\n" unless $cqserver;
255 display_message "Clearquest DB Server (cqd V$cqdversion) accepting clients";
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)) {
265 log_message "Spawning child to handle request";
267 die "$me: ERROR: Can't fork: %!" unless defined ($childpid = fork ());
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";
277 # In child process - ServiceClient
278 log_message "In child";
280 log_message "Child has been born";
281 ServiceClient ($cqclient);
282 log_message "Child finished servicing requests";
287 ServiceClient ($cqclient);
291 display_message "Shutting down server";
297 # Reopen STDOUT. This is because cqperl screws around with STDOUT in some
299 open STDOUT, ">-" or die "Unable to reopen STDOUT\n";
300 # Set unbuffered output for the same reason (cqperl)
304 if ($ARGV [0] eq "-d") {
306 } elsif ($ARGV [0] eq "-v") {
309 } elsif ($ARGV [0] eq "-m") {
311 } elsif ($ARGV [0] eq "-q") {
320 my $tmp = $ENV {"TMP"};
321 my $cqd_logfile = "$tmp\\$me.log";
322 my $cqd_errfile = "$tmp\\$me.err";
324 EnterDaemonMode ($cqd_logfile, $cqd_errfile) if defined ($daemon_mode);
330 display_message "Shutting down";
333 display_message "Closed $cqdb database";