| 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 = ""; |
| 195 | } elsif ($value eq "") { |
| 196 | $value = ""; |
| 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; |