--- /dev/null
+#!/usr/bin/perl
+################################################################################
+#
+# File: ecrd: ECR Daemon
+# Description: This script implements a daemon that handles requests for
+# queries about information on ECRs contained in the Quintus
+# database. In addition to lessoning the amount of time it takes
+# for database opens, access to Quintus data is only available
+# on certain machines. Additionally, for Perl to access this
+# Informix database the Informix version of DBD would need to be
+# locally installed. By calling this daemon instead clients need
+# not have to install Informix and then code all the necessary
+# code to access Quintus data as well as have to understand the
+# structure of the database. Instead clients need only say "Give
+# me what you got on ECR #<whatever>".
+# Author: Andrew@DeFaria.com
+# Created: Tue Feb 15 09:54:59 PST 2005
+# Modified:
+# Language: Perl
+#
+# (c) Copyright 2005, LynuxWorks, all rights reserved.
+#
+################################################################################
+use strict;
+use warnings;
+
+use IO::Socket;
+use Net::hostent;
+use POSIX qw(setsid);
+use DBI;
+
+my $ecrdb = "lynxmigr1";
+my $port = (!defined $ENV {ECRDPORT}) ? 1500 : $ENV {ECRDPORT};
+
+# Global variables
+my $DB;
+my $ecrserver;
+my $ecrclient;
+my $sth;
+my $statement;
+
+# Options
+my $verbose;
+my $debug;
+my $daemon_mode;
+my $quiet_mode;
+my $multithreaded;
+my $timeout = 10;
+
+# ECR translations. Note the Quintus database stores certain choice lists as
+# enumerations. They I guess they are configurable. The right thing to do
+# would be to figure out how to look up the definition given the number. But
+# we are gonna cheat here and hard code a few important enumerations.
+my @defstatus = (
+ "Open",
+ "Closed",
+ "Fixed",
+ "Not a bug",
+ "Obsolete",
+ "Defered",
+ "Duplicate"
+);
+my @state = (
+ "Reported",
+ "Assigned",
+ "Selected",
+ "Resolved",
+ "Integrated",
+ "Retired",
+ "Reviewed",
+ "Pending Review"
+);
+my @priority = (
+ "Low",
+ "Medium",
+ "High",
+ "Critical"
+);
+my @severity = (
+ "Low",
+ "Medium",
+ "High",
+ "Critical"
+);
+
+# Pid
+my $pid = $$;
+
+my $me = `basename $0`;
+chomp $me;
+my $ecrdversion = "1.3";
+
+my @all_fields = (
+ "productdefect", # integer
+ "componentdefect", # integer
+ "defectdefectdup", # integer
+ "workgroupdefect", # integer
+ "reporterdefect", # integer
+ "resolverdefect", # integer
+ "confirmerdefect", # integer
+ "buildversdefect", # integer
+ "rpt_versdefect", # integer
+ "res_versdefect", # integer
+ "conf_versdefect", # integer
+ "state", # integer
+ "resolverstatus", # integer
+ "confirmerstatus", # integer
+ "escstatus", # integer
+ "owner", # integer
+ "severity", # integer
+ "priority", # integer
+ "summary", # varchar(80,0)
+ "datereported", # datetime year to second
+ "dateresolved", # datetime year to second
+# "description", # text
+# Note: Some descriptions fields are huge containing things like
+# uuencoded tar files! They are so huge that they cause this server
+# to fail (not sure why - it shouldn't but it does. So this hack
+# returns only the first 50K of description to avoid that problem.
+ "description [1,50000]", # text
+ "cclist", # varchar(80,0)
+ "dateconfirmed", # datetime year to second
+ "datemodified", # datetime year to second
+ "fix_by_date", # date
+ "fix_by_version", # integer
+ "history", # text
+ "likelihood", # integer
+ "estfixtime", # datetime year to second
+ "actfixtime", # datetime year to second
+ "resolution", # text
+ "businessimpact", # integer
+ "origin", # integer
+ "docimpact", # integer
+ "report_platform", # integer
+ "resolve_platform", # integer
+ "confirm_platform", # integer
+ "test_file", # varchar(64,0)
+ "visibility", # integer
+ "misc", # varchar(80,0)
+ "defecttype", # integer
+ "defstatus", # integer
+ "customertext", # text
+ "modifiedby", # varchar(20,0)
+ "classification", # integer
+ "datefixed" # datetime year to second
+);
+
+# Forwards
+sub CloseDB;
+sub GetRequest;
+
+sub timestamp {
+ my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
+
+ $mday = "0$mday" if $mday < 10;
+ $mon = "0$mon" if $mon < 10;
+ $hour = "0$hour" if $hour < 10;
+ $min = "0$min" if $min < 10;
+ $year += 1900;
+
+ return "$mon/$mday/$year $hour:$min";
+} # timestamp
+
+sub log_message {
+ print "[$pid] " . timestamp . " @_\n" if defined $verbose;
+} # log_message
+
+sub log_error {
+ print STDERR "[$pid] " . timestamp . " ERROR: @_\n"
+} # log_error
+
+sub log_warning {
+ print STDERR "[$pid] " . timestamp . " WARNING: @_\n"
+} # log_error
+
+sub debug {
+ print "[$pid] " . timestamp . " @_\n" if defined $debug;
+} # debug
+
+sub verbose {
+ print "[$pid] " . timestamp . " @_\n" if !defined $quiet_mode;
+} # verbose
+
+sub DBError {
+ my $msg = shift;
+ my $statement = shift;
+
+ if (!defined $DB) {
+ print "Catostrophic error: DB undefined!\n";
+ exit 1;
+ } # if
+
+ print $msg . "\nError #" . $DB->err . " " . $DB->errstr . "\n";
+ print "SQL Statement: $statement\n" if defined $statement;
+
+ exit $DB->err;
+} # DBError
+
+sub timeout {
+ debug "After $timeout seconds of inactivity client timed out";
+
+ my $hostinfo = gethostbyaddr ($ecrclient->peeraddr);
+ my $host = $hostinfo->name || $ecrclient->peerhost;
+ debug "Closing connection to $host";
+
+ # Close client's connection
+ close $ecrclient;
+
+ # Set up signal handlers again
+ $SIG{ALRM} = \&timeout;
+ $SIG{INT} = $SIG{QUIT} = 23234
+\&interrupt;
+ GetRequest;
+} # timeout
+
+sub interrupt {
+ log_warning "Interrupted - closing down...";
+ close $ecrserver;
+ verbose "Connection closed";
+ CloseDB;
+
+ exit;
+} # interrupt
+
+sub GetClientAck {
+ my $client = shift;
+ my $clientresp;
+
+ debug "ENTER: GetClientAck";
+ alarm $timeout;
+ while (defined $client and defined ($clientresp = <$client>)) {
+ chomp $clientresp;
+ chop $clientresp if $clientresp =~ /\r/;
+ if ($clientresp eq "ACK") {
+ return
+ } # if
+ log_warning "Received $clientresp from client - expected ACK";
+ } # while
+ debug "EXIT: GetClientAck";
+} # GetClientAck
+
+sub GetClientCmd {
+ my $client = shift;
+ my $clientresp;
+
+ alarm $timeout;
+ while (defined $client and defined ($clientresp = <$client>)) {
+ chomp $clientresp;
+ return $clientresp;
+ } # while
+} # GetClientResponse
+
+sub SendClientAck {
+ my $client = shift;
+
+ debug "ENTER: SendClientAck";
+ print $client "ACK\n";
+ debug "EXIT: SendClientAck";
+} # SendClientAck
+
+sub SendClientResponse {
+ my $client = shift;
+ my $response = shift;
+
+ print $client "$response\n";
+} # SendClientResponse
+
+sub EnterDaemonMode {
+ my $logfile = shift;
+ my $errorlog = shift;
+
+ $logfile = "/dev/null" if $logfile eq "";
+ $errorlog = "/dev/null" if $errorlog eq "";
+
+ # Change the current directory to /
+ chdir '/'
+ or die "$me: Error: Can't chdir to / ($!)";
+
+ # Turn off umask
+ umask 0;
+
+ # Redirect STDIN to /dev/null
+ open STDIN, '/dev/null'
+ or die "$me: Error: Can't redirect /dev/null ($!)";
+
+ # Redirect STDOUT to logfile
+ open STDOUT, ">>$logfile"
+ or die "$me: Error: Can't redirect stdout to $logfile ($!)";
+
+ # Redirect STDERR to errorlog
+ open STDERR, ">>$errorlog"
+ or die "$me: Error: Can't redirect stderr to $errorlog ($!)";
+
+ # Now fork the daemon
+ defined (my $pid = fork)
+ or die "$me: Error: Can't create daemon ($!)";
+
+ # Now the parent exits
+ exit if $pid;
+
+ # Set process to be session leader
+ setsid
+ or die "$me: Error: Can't start a new session ($!)";
+} # EnterDaemonMode
+
+sub OpenDB {
+ # Connect to database. Note this is using anonymous access (read only)
+ $DB = DBI->connect("DBI:Informix:$ecrdb")
+ or DBError "Unable to open database";
+ log_message "Opened $ecrdb database";
+
+ # Setup our select statement with placeholders
+ $statement = "select ";
+
+ # Build up the field list
+ my $first_time = 1;
+ foreach (@all_fields) {
+ if ($first_time) {
+ $first_time = 0;
+ $statement .= $_;
+ } else {
+ $statement .= ",$_";
+ } # if
+ } # foreach
+
+ # Now add the table and condition
+ $statement .= " from defect where pkey=?";
+
+ $sth = $DB->prepare ($statement)
+ or DBError "Unable to prepare statement", $statement;
+} # OpenDB
+
+sub CloseDB {
+ $DB->disconnect ()
+ or DBError "Unable to disconnect from database!";
+ verbose "Closed $ecrdb database";
+} # CloseDB
+
+sub Usage {
+ my $msg = shift;
+
+ print "$msg\n\n" if defined $msg;
+
+ print "Usage: $me [ -D ] [ -v ] [ -d ] [-p <port>] [ -m ] [ -q ]\n\n";
+ print "Where:\t-D\tEnter Daemon mode\n";
+ print "\t-v\tVerbose mode (Default off)\n";
+ print "\t-d\tDebug mode (Default off)\n";
+ print "\t-p\tPort number to use (Default 1500)\n";
+ print "\t-m\tMultithreaded (Default off)\n";
+ print "\t-q\tQuiet mode (Default on)\n";
+ exit 1;
+} # Usage
+
+sub GetECRRecord {
+ my $ecr = shift;
+
+ if ($ecr =~ /\D/) {
+ log_error "ECR $ecr is not numeric!";
+ return ();
+ } # if
+
+ my %fields;
+ my $record;
+ my $value;
+
+ $sth->execute ($ecr)
+ or DBError "Unable to execute statement", $statement;
+
+ my $row = $sth->fetchrow_arrayref;
+
+ if (!defined $row) {
+ # @row is empty if there was no ECR by that number
+ log_error "ECR $ecr not found!";
+ return ();
+ } # if
+
+ my @rows = @{$row};
+ foreach (@all_fields) {
+ my $value = shift @rows;
+
+ # Transform newlines to "\n" so the field is treated as one large field
+ $value =~ s/\n/\\n/g if defined $value;
+
+ # Perform some choice list field translations. Again this would be
+ # better done by doing database lookups to translate the enums...
+ $value = $defstatus [$value] if /defstatus/ and defined $value;
+ $value = $state [$value] if /state/ and defined $value;
+ $value = $priority [$value] if /priority/ and defined $value;
+ $value = $severity [$value] if /severity/ and defined $value;
+ # Fix description field back
+ if (/^description/) {
+ $_ = "description";
+ } # if
+ $fields {$_} = $value
+ } # foreach
+
+ return %fields;
+} # GetECRRecord
+
+sub ServiceClient {
+ my $ecrclient = shift;
+
+ # Service this client
+ my $hostinfo = gethostbyaddr ($ecrclient->peeraddr);
+ my $host = $hostinfo->name || $ecrclient->peerhost;
+
+ verbose "Connect from $host";
+ log_message "Waiting for command from $host";
+ while () {
+ GetClientAck ($ecrclient);
+ $_ = GetClientCmd ($ecrclient);
+ next unless /\S/; # Skip blank requests
+ last if /quit|exit/i;
+
+ if (/\*/) {
+ log_message "$host requests a list of all ECR #'s";
+ SendClientAck ($ecrclient);
+ ReturnAllECRNbrs ($ecrclient);
+ SendClientAck ($ecrclient);
+ next;
+ } # if
+
+ log_message "$host requests information about ECR $_";
+ SendClientAck ($ecrclient);
+ my %fields = GetECRRecord $_;
+
+ if (%fields) {
+ SendClientResponse ($ecrclient, "ecr: $_");
+ while (my ($key, $value) = each (%fields)) {
+ $value = !defined $value ? "" : $value;
+ SendClientResponse ($ecrclient, "$key: $value");
+ } # while
+ } else {
+ SendClientResponse ($ecrclient, "ECR $_ was not found");
+ } # if
+ SendClientAck ($ecrclient);
+ } # while
+
+ verbose "Closing connection from $host at client's request";
+ close $ecrclient;
+} # ServiceClient
+
+sub Funeral {
+ my $childpid = wait;
+ $SIG{CHLD} = \&Funeral;
+ log_message "Child has died" . ($? ? " with status $?" : "");
+} # Funeral
+
+sub GetRequest {
+ # Now wait for an incoming request
+ while ($ecrclient = $ecrserver->accept ()) {
+ my $hostinfo = gethostbyaddr ($ecrclient->peeraddr);
+ my $host = $hostinfo->name || $ecrclient->peerhost;
+ log_message "$host is requesting service";
+ if (defined ($multithreaded)) {
+ my $childpid;
+
+ log_message "Spawning child to handle request";
+
+ die "$me: ERROR: Can't fork: %!" unless defined ($childpid = fork ());
+
+ if ($childpid) {
+ # In parent - set up for clean up of child process
+ log_message "Parent produced child ($childpid)";
+ $SIG{CHLD} = \&Funeral;
+ log_message "Parent looking for another request to service";
+ } else {
+ # In child process - ServiceClient
+ $pid = $$;
+ debug "Child [$pid] has been born";
+ ServiceClient ($ecrclient);
+ log_message "Child finished servicing requests";
+ kill ("TERM", $$);
+ exit;
+ } # if
+ } else {
+ ServiceClient ($ecrclient);
+ } # if
+ } # while
+
+ close ($ecrserver);
+} # GetRequest
+
+sub ProcessRequests {
+ # The subroutine handles processing of requests by using a socket to
+ # communicate with clients.
+ $ecrserver = IO::Socket::INET->new (
+ Proto => 'tcp',
+ LocalPort => $port,
+ Listen => SOMAXCONN,
+ Reuse => 1
+ );
+
+ die "$me: Error: Could not create socket ($!)\n" unless $ecrserver;
+
+ verbose "ECR DB Server (ecrd V$ecrdversion) accepting clients on port $port";
+
+ GetRequest;
+} # ProcessRequests
+
+sub ReturnAllECRNbrs {
+ my $ecrclient = shift;
+
+ my $statement = "select pkey from defect";
+
+ my $sth = $DB->prepare ($statement)
+ or DBError "Unable to prepare statement", $statement;
+
+ $sth->execute ()
+ or DBError "Unable to execute statement", $statement;
+
+ log_message "Returning all ECR numbers...";
+ while (my @row = $sth->fetchrow_array) {
+ SendClientResponse ($ecrclient, $row [0]);
+ } # while
+
+ log_message "All ECR numbers returned";
+} # ReturnAllECRNbrs
+
+# Start main code
+# Reopen STDOUT.
+open STDOUT, ">-" or die "Unable to reopen STDOUT\n";
+
+# Set unbuffered output
+$| = 1;
+
+while ($ARGV [0]) {
+ if ($ARGV [0] eq "-D") {
+ $daemon_mode = 1;
+ } elsif ($ARGV [0] eq "-v") {
+ $verbose = 1;
+ undef ($quiet_mode);
+ } elsif ($ARGV [0] eq "-d") {
+ $debug = 1;
+ undef ($quiet_mode);
+ } elsif ($ARGV [0] eq "-m") {
+ $multithreaded = 1;
+ } elsif ($ARGV [0] eq "-q") {
+ $quiet_mode = 1;
+ undef ($verbose);
+ } elsif ($ARGV [0] eq "-p") {
+ shift @ARGV;
+ Usage "Must specify a port # after -p" if (!defined $ARGV [0]);
+ $port = $ARGV[0];
+ } else {
+ Usage "Unknown parameter found: " . $ARGV[0];
+ } # if
+
+ shift @ARGV;
+} # while
+
+my $tmp = (!defined $ENV {TMP}) ? "/tmp" : $ENV {TMP};
+my $ecrd_logfile = "$tmp/$me.log";
+my $ecrd_errfile = "$tmp/$me.err";
+
+EnterDaemonMode ($ecrd_logfile, $ecrd_logfile) if defined ($daemon_mode);
+
+OpenDB;
+
+# Set up signal handlers
+$SIG{ALRM} = \&timeout;
+$SIG{INT} = $SIG{QUIT} = \&interrupt;
+
+ProcessRequests;
projects / clearscm.git / blobdiff