1 #!C:/Progra~1/Rational/ClearQuest/CQPerl
2 ################################################################################
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
15 # (c) Copyright 2007, ClearSCM, Inc., all rights reserved.
17 ################################################################################
24 # Generic, harmless, user reporter
25 my $cquser = "reporter";
26 my $cqpasswd = "news";
37 my $me = `basename $0`;
39 my $cqdversion = "2.0";
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",
57 print "[$pid] @_\n" if defined ($verbose);
61 print "[$pid] @_\n" if !defined ($quiet_mode);
65 print STDERR "[$pid] ERROR: @_\n"
69 print STDERR "[$pid] WARNING: @_\n"
76 while (defined ($clientresp = <$client>)) {
78 if ($clientresp eq "ACK") {
81 log_warning "Received $clientresp from client - expected ACK";
89 while (defined ($clientresp = <$client>)) {
98 print $client "ACK\n";
101 sub SendClientResponse {
103 my $response = shift;
105 print $client "$response\n";
106 } # SendClientResponse
108 sub EnterDaemonMode {
109 my $logfile = shift (@_);
110 my $errorlog = shift (@_);
112 log_message "Entering Daemon Mode (\"$logfile\", \"$errorlog\")";
113 if ($logfile eq '') {
114 $logfile = "/dev/null";
117 if ($errorlog eq '') {
118 $errorlog = "/dev/null";
121 # Change the current directory to /
122 chdir 'C:\\' or die "$me: Error: Can't chdir to C:\\ ($!)";
127 # Redirect STDIN to /dev/null
128 open STDIN, '/dev/null'
129 or die "$me: Error: Can't read /dev/null ($!)";
131 # Redirect STDOUT to logfile
132 open STDOUT, ">>$logfile"
133 or die "$me: Error: Can't write to $logfile ($!)";
135 # Redirect STDERR to errorlog
136 open STDERR, ">>$errorlog"
137 or die "$me: Error: Can't write to $errorlog ($!)";
139 # Now fork the daemon
140 defined (my $pid = fork)
141 or die "$me: Error: Can't create daemon ($!)";
143 # Now the parent exits
146 # Set process to be session leader
148 or die "$me: Error: Can't start a new session ($!)";
149 log_message "Entered Daemon Mode";
153 log_message "Opening $cqdb database";
154 $session = CQPerlExt::CQSession_Build ();
155 $session->UserLogon ($cquser, $cqpasswd, $cqdb, "");
156 log_message "Opened $cqdb database";
160 CQSession::Unbuild ($session);
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";
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.
182 $record = $session->GetEntity ("defect", $bugid);
183 } or log_error "Bug ID $bugid not found!", return 0;
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.
191 $value = $record->GetFieldValue ($_)->GetValue
193 if ($@ =~ m/object that does not exist/) {
194 $value = "<Undefined field>";
195 } elsif ($value eq "") {
196 $value = "<Unspecified>";
199 $fields {$_} = $value;
206 my $cqclient = shift;
208 # Service this client
209 my $hostinfo = gethostbyaddr ($cqclient->peeraddr);
210 my $host = $hostinfo->name || $cqclient->peerhost;
212 display_message "Connect from $host";
213 log_message "Waiting for command from $host";
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: $_");
225 while (($key, $value) = each (%fields)) {
226 SendClientResponse ($cqclient, "$key: $value");
229 SendClientResponse ($cqclient, "Bug ID $_ was not found");
231 SendClientAck ($cqclient);
234 display_message "Closing connection from $host at client's request";
240 $SIG{CHLD} = \&Funeral;
241 log_message "Child has died" . ($? ? " with status $?" : "");
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 (
254 die "$me: Error: Could not create socket (%!)\n" unless $cqserver;
256 display_message "Clearquest DB Server (cqd V$cqdversion) accepting clients";
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)) {
266 log_message "Spawning child to handle request";
268 die "$me: ERROR: Can't fork: %!" unless defined ($childpid = fork ());
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";
278 # In child process - ServiceClient
279 log_message "In child";
281 log_message "Child has been born";
282 ServiceClient ($cqclient);
283 log_message "Child finished servicing requests";
288 ServiceClient ($cqclient);
292 display_message "Shutting down server";
298 # Reopen STDOUT. This is because cqperl screws around with STDOUT in some
300 open STDOUT, ">-" or die "Unable to reopen STDOUT\n";
301 # Set unbuffered output for the same reason (cqperl)
305 if ($ARGV [0] eq "-d") {
307 } elsif ($ARGV [0] eq "-v") {
310 } elsif ($ARGV [0] eq "-m") {
312 } elsif ($ARGV [0] eq "-q") {
321 my $tmp = $ENV {"TMP"};
322 my $cqd_logfile = "$tmp\\$me.log";
323 my $cqd_errfile = "$tmp\\$me.err";
325 EnterDaemonMode ($cqd_logfile, $cqd_errfile) if defined ($daemon_mode);
331 display_message "Shutting down";
334 display_message "Closed $cqdb database";