SituationSoap has asked for the wisdom of the Perl Monks concerning the following question:

I've asked for a bit of help with the following Perl service a couple of times in the last few days, and everyone has been very helpful, I appreciate it. I'm writing this to interface with our QualysGuard API (which provides vulnerability data for our network).

The issue I'm having is that the END{} subroutine is called when I initialize the program for the parent subroutine, but is not called for the child subroutine (the one the loop actually runs in) in the code below. As a result, while I can see when the code starts running, I have no way to tell when it ends.

use strict;
use warnings;
use diagnostics;
use POSIX qw(setsid);
use DBI;
use Config::Simple '-strict';
use Qualys;
use vars qw($hup);
use Class::Date qw(:errors date localdate gmdate now -DateParse -EnvC)
+;
use Net::SMTP;
use Config::Simple '-strict';

######################################################################
+##########
#   Qualys API Daemon
#   Written By: Eric Boersma
#   Date: 7/14/2009
#   
#   Function: This daemon is the API call handler for the Qualys API. 
+Due to 
#       restrictions placed on the API by Qualys, this system handles 
+desired
#       API calls in a timely fashion. By daemonizing this process, we
+ ensure
#       that the maximum number of API calls (300) happens in a 24-hou
+r period.
#       This loop opens the priority modified FIFO (First In First Out
+) queue in
#       the MySQL database, reads the highest priority, oldest entry,
#       determines the type of API call to be made, and hands that req
+uest off 
#       to a subroutine to do the heavy lifting. Once the subroutine i
+s finished
#       the daemon waits five minutes before starting the next call, s
+o as not 
#       to exceed the maximum number of API function calls in a 24-hou
+r period.
#
#   Usage: In order to interface with this Daemon, send your desired A
+PI call to
#       the database table APIQueue in the designated format. 
######################################################################
+##########


######################################################################
+##########
#
#   Preparing our Subroutines
#
######################################################################
+##########

sub processCall{
    my $conf = $-[1];
    my $call = $_[0];
    my $qualys = new Qualys; #Instantiate Qualys
    my $uname = $conf->param("qualysuname");
    my $pass = $conf->param("qualyspass"); 
    #Log in
    $qualys->userid($uname);
    $qualys->passwd($pass);
    
    #Connect to the requested script, using our modified format.
    #$call should just be a querystring with the api function call as 
+the start.
    return $qualys->connect_to($call);
}

#This script is run on program exit, it is called after errorOut()
#If errorOut() has already printed an error, we won't print another on
+e
sub programExit{
    print "Exiting program!\n"; 
    my $progname = $0; #program name
    my $now = date now; #right now
    my $exit = $?; #exit error code
    my $log; #prepare the line to be written to the log
    
    if($exit == 7142){
        open (LOG, ">>/some/directory/APIlog") or die "$!"; #open the 
+log file
        print LOG "The program successfully began execution at $now\n"
+;
        close LOG;
        return;
    }
    
    open (LOG, ">>/some/directory/APIlog") or die "$!"; #open the log 
+file
    $log = "$now Qualys API Queue daemon exited unexepectedly. "; #sta
+ndard statement
    if($exit != 0){
        $log = $log . "The program exited with errors\n The error was:
+ $!"; #append additional information
    }
    else{
        $log = $log . "The program exited without errors\n"; #ditto
    }
    
    if($exit != 5432){
        print LOG $log; #if this isn't a code provided by errorOut(), 
+then print the log
    }
    SendMail($log, "$progname terminated unexpectedly", "failmail"); #
+no matter what, tell the programmer about the exit
    
    close LOG; #cleanliness
}

sub SendMail{
    #standard SendMail() sub which you've probably seen before if you'
+ve edited any of my other code.
    #Don't really feel necessary to go into the inner workings, it's p
+retty straightforward
    my $report = $_[0];
    my $subject = $_[1];
    my $list = $_[2];
    my $conf = new Config::Simple('bind.conf') or die "Can't find conf
+ig file";
    my @email = $conf->param($list);
    my $smtp = Net::SMTP->new(
                           Host => 'mail.company.com',
                           Hello => 'deptname.company.com',
                           Timeout => 30,
                           Debug   => 0,
                          );
    
    $smtp->mail('deptname@company.com');
    foreach my $email (@email)
    {
        $smtp->to($email);
    }
    $smtp->data();
    $smtp->datasend("From:  Qualys API Daemon\n");
    foreach my $email (@email)
    {
        $smtp->datasend("To: $email\n");
    }
    $smtp->datasend("Subject: $subject\n");
    $smtp->datasend("MIME-Version: 1.0\n");
    $smtp->datasend("Content-type: text/html\n");
    $smtp->datasend("Content-Transfer-Encoding: 7bit\n");
    $smtp->datasend("\n");
    $smtp->datasend("$report\n");
    $smtp->dataend("");
    $smtp->quit();
}

#Captures the $! error input in placing of dying the program, and prin
+ts it to the log.
sub errorOut{
    my $error = $_[0];
    open (LOG, ">>/some/directory/APIlog") or die "$!";
    print LOG "$error\n";
    close LOG;
    exit 5432;
}

sub handleErorr{ #TODO: Add additional error handling for multiple typ
+es of erros here
    my $error = $_[0];
    open (LOG, ">>/some/directory/APIlog");
    print LOG "$error\n";
    close LOG;    
}

sub dailyTasks{
    my $currentfile = $_[0];
    my $date = date now;
    my @day = split(/ /, $date);
}

$| = 1; #Signal handling variables for HUP restarts.
$hup = 0;

#if we get a kill -hup call, increment the hup counter so the loop kno
+ws to restart
$SIG{HUP} = sub{
    $hup++;
};

######################################################################
+##########
#
#   public static void main()
#
######################################################################
+##########

#Due to the looping nature of this program, any configuration changes 
+will require
#a service restart. This is by design.

open(LOG, ">>/some/directory/APIlog") or errorOut("$!"); #We will prin
+t to a log file
chdir '/some/directory' or errorOut("Can't change directory: $!"); #se
+t our root
umask 0; #mask ourselves w/ userid 0, so the calling user isn't tied t
+o us
open (STDIN, "/dev/null") or errorOut("$!"); #no STDIN for this servic
+e
open (STDOUT, ">/dev/null") or errorOut("$!"); #Or STDOUT
open (STDERR, ">/dev/null") or errorOut("$!"); #or STDERR
defined(my $pid = fork) or errorOut("Can't fork: $!"); #fork the proce
+ss to create a child
exit 7142 if $pid; #the fork makes it so that we're not tied to the us
+er's shell session
setsid or errorOut("Can't start a new session: $!"); #start a new sess
+ion

#Config files to Log us into the database
my $conf = new Config::Simple('/some/directory/conf') or errorOut("Can
+'t find config file");
my $username = $conf->param("db_username");
my $password = $conf->param("db_password");
my $dbh = DBI->connect("dbi:mysql:database=DBName; host=server.company
+.com; port=3306", $username, $password,) or errorOut(DBI->errstr);

my $now = date now;
open (my $currentfile, ">", "/some/directory/CurrentLog");



while(1){ #This while loop will never turn false, so the service is de
+signed to always run.
    my $timer = $now + '1D';
    my $report = date now;
    
    
    if($report >= $timer){
        dailyTasks($currentfile);
        $now = $report;
    }
    
    my $sql = "SELECT RequestTime, Priority, RequestString, OutputFile
+, OutputScript, QueueID FROM APIQueue ORDER BY Priority, RequestTime 
+LIMIT 1"; #get our next call to process
    my $sth = $dbh->prepare($sql);
    
    my $sql2 = "DELETE FROM APIQueue WHERE QueueID = ?";
    my $sth2 = $dbh->prepare($sql2);
    
    $sth->execute();
    while(my @row = $sth->fetchrow_array()){
        #assign the relevant values
        my $time = $row[0];
        my $priority = $row[1];
        my $request = $row[2];
        my $output = $row[3];
        my $script = $row[4];
        my $id = $row[5];
        
        open(OUTPUT, $output) or errorOut("Couldn't open output buffer
+ $output: $!");
         
        my $result = processCall($request, $conf); #make the call
        print OUTPUT $result; #print the result to the requested file
        close OUTPUT;
        my $parser;
        #check which file parser we're going to be using, based on a r
+egex in the script name.
        if($script =~ m/\.php/i){
            $parser = "php";
        }
        
        if($script =~ m/\.pl/i){
            $parser = "perl";
        }
        
        if(!($pid = fork)){ #Run the child process to process the outp
+ut.
            system("$parser $script");
        }
        
        $sth2->execute($id); #Delete the record
        my $log = "ID: $id, Requested: $time, Priority: $priority, Cal
+l: $request, Processed: $report\n";
        print LOG $log;
        #TODO: schedule nightly logging and result emails
        
        #TODO: Exception handling.
    }
    #check our hup, and restart the program with default arguments if 
+we get a hup signal.
    if ($hup > 0){
        SendMail("Qualys API Daemon restarted successfully", "Qualys A
+PI Daemon Restart", "failmail");
        exec($0, @ARGV) || warn "$!";
    }
    sleep(300);
}

END{
    programExit();
}

[download]

I have no doubt there are probably some other issues with this, so if you see anything, please feel free to point them out. While Perl was my first language, it's certainly not my best, and I'd be much more comfortable writing something like this in PHP or Java than I am in Perl. As a result, I'm sure there are errors in the script which aren't apparent, as this isn't in production yet.

First and foremost is the standing question: can you see why END{} is called when the program starts and forks, but not when it die()s or is killed from the command line?

Replies are listed 'Best First'.
Re: END{} Subroutine not being called for Child process
by ig (Vicar) on Aug 04, 2009 at 01:55 UTC

    If you kill your program the END block will not be run, unless you handled the kill signal. I think you only handle HUP, so any other terminal signal (INT, TERM, KILL etc.) will terminate your program without the END block being run. See BEGIN, UNITCHECK, CHECK, INIT and END for details.

    An END code block is executed as late as possible, that is, after perl has finished running the program and just before the interpreter is being exited, even if it is exiting as a result of a die() function. (But not if it's morphing into another program via exec, or being blown out of the water by a signal--you have to trap that yourself (if you can).)

    You open STDOUT and STDERR to /dev/null but then you print to STDERR and call die in various circumstances. For example, in the child the output from the print at the beginning of programExit() will go to /dev/null and will not be seen on your terminal. It might be better to open STDOUT and STDERR to a log file. You might then find why other operations are failing.

    I note also that in the loop in your child you fork and both the parent and child continue to loop (the child after executing a system command). Maybe the child should exit after executing the system command or maybe the child should be using exec rather than system.

[reply]

      Appreciate the info on the SIGTERM trapping, that looks like it's my problem. I wasn't aware that sending a kill signal just blew the program out of the water; I think that comes from never having had to code in this context before.

      I've been considering moving STD outputs to files instead of to /dev/null, although at this point, I've coded around much of what's there, so I'm not sure how much more benefit I would gain. I do switch back and forth between having those lines commented out and not; the line you were referring to in the programExit() subroutine was intended to see if I was hitting the END{} sub, and STDOUT was open when I was using it.

      I assume the code you're referring to in the last paragraph is this one:

      if(!($pid = fork)){
    system("$parser $script");
}

      [download]

      I'm confused as to what you're saying, though. When I fork the process, I believed that the process in question would only run what was inside the bracket, then exit. Is that not the case? Should I be using exec(), in that case?

[reply]
[d/l]

        When I fork the process, I believed that the process in question would only run what was inside the bracket, then exit.

        if doesn't do anything special if the condition happens to be a call to fork. It won't exit if you don't tell it to exit. Indeed, it sounds like you want exec instead of system.

[reply]
[d/l]
[select]

        In general I don't redirect STDOUT or STDERR to /dev/null and never when I am debugging. Very often, when something unexpected goes wrong, important clues are written to one of these outputs. This may include output from modules that have been used, which might not be obvious without reading all the module source.

[reply]
Re: END{} Subroutine not being called for Child process
by GrandFather (Saint) on Aug 03, 2009 at 23:44 UTC

    It helps you and us if you reduce your code to a sample that just demonstrates the issue. See I know what I mean. Why don't you? for some ideas that may help.

    True laziness is hard work
[reply]
      Generally, I would do this, but it was requested by those who were trying to help me in the Chatterbox to bring in the whole script, as we were pretty sure it was an issue of not trapping a SIG (which it looks like it was), and so they wanted to see all SIG handling.
[reply]
Re: END{} Subroutine not being called for Child process
by ssandv (Hermit) on Aug 03, 2009 at 21:16 UTC
    I don't see anything obvious (and this seems like it should be something obvious). However, you do have die inside your exit subroutine a couple times, which could conceivably be causing trouble, since you're already in END. (You can't stack ENDs up)
[reply]
[d/l]
[select]
      Interesting note. I wasn't sure if those would work, but checking a file open is sort of a habit for me, so it's one of those things that I put in there more out of routine than anything else.
[reply]

Back to Seekers of Perl Wisdom