blob: 6893f3245dc8fa6038d97f7a50341c988c5652a2 [file] [log] [blame]
#!/usr/bin/perl -w
###############################################################################
# $Id$
###############################################################################
# Licensed to the Apache Software Foundation (ASF) under one or more
# contributor license agreements. See the NOTICE file distributed with
# this work for additional information regarding copyright ownership.
# The ASF licenses this file to You under the Apache License, Version 2.0
# (the "License"); you may not use this file except in compliance with
# the License. You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
###############################################################################
=head1 NAME
VCL::vcld - VCL daemon module
=head1 SYNOPSIS
perl vcld
=head1 DESCRIPTION
This is the executable module for running the VCL management node daemon.
=cut
##############################################################################
package VCL::vcld;
# Specify the lib path using FindBin
use FindBin;
use lib "$FindBin::Bin/../lib";
# Configure inheritance
use base qw();
# Specify the version of this module
our $VERSION = '2.5.1';
# Specify the version of Perl to use
use 5.008000;
use strict;
use warnings;
#use diagnostics;
use Symbol;
use POSIX;
use Getopt::Long;
use English qw( -no_match_vars );
use Fcntl qw(:DEFAULT :flock);
use List::Util qw(min);
use VCL::utils;
use VCL::DataStructure;
##############################################################################
# Turn on autoflush
$| = 1;
# Retrieve the management node configuration info from the database
get_management_node_info();
# Check if -setup argument was specified
if ($SETUP_MODE) {
&setup_management_node();
};
# Call daemonize if -d (debug) wasn't specified
if ($DAEMON_MODE) {
&daemonize;
}
# Rename this process
rename_vcld_process();
# Variables to store child process information
our %child_pids = (); # keys are current child process IDs
our $child_count = 0; # current number of children
# Install signal handlers
$SIG{CHLD} = \&REAPER;
$SIG{INT} = \&HUNTSMAN;
$SIG{QUIT} = \&HUNTSMAN;
$SIG{HUP} = \&HUNTSMAN;
$SIG{TERM} = \&HUNTSMAN;
$SIG{__WARN__} = \&warning_handler;
$SIG{__DIE__} = \&die_handler;
# Call main subroutine
&main();
#/////////////////////////////////////////////////////////////////////////////
=head2 main
Parameters :
Returns :
Description : Main VCL daemon engine subroutine. Queries database for request
and passes off data to make_new_child() to begin processing.
=cut
sub main () {
# Create a hash to store all of the program state information
my %info;
# Get the management node info from the database
# get_management_node_info() will determine the hostname
if ($info{managementnode} = get_management_node_info()) {
notify($ERRORS{'DEBUG'}, $LOGFILE, "retrieved management node information from database");
}
else {
notify($ERRORS{'CRITICAL'}, $LOGFILE, "unable to retrieve management node information from database");
exit;
}
# Define local variables from the management node hash for code simplicity
my $management_node_id = $info{managementnode}{id};
my $management_node_hostname = $info{managementnode}{hostname};
# Set environment variables for global management node information
$ENV->{management_node_id} = $management_node_id;
notify($ERRORS{'DEBUG'}, $LOGFILE, "management_node_id environment variable set: $management_node_id");
# Get the management node checkin interval from the database if defined
# Otherwise, the default is 12 seconds
my $management_node_checkin_interval = 12;
if (defined $info{managementnode}{checkininterval}) {
$management_node_checkin_interval = $info{managementnode}{checkininterval};
}
notify($ERRORS{'DEBUG'}, $LOGFILE, "management node checkin interval is $management_node_checkin_interval seconds");
notify($ERRORS{'OK'}, $LOGFILE, "vcld started on $management_node_hostname");
#===========================================================================
while (1) {
delete $ENV->{request_id};
delete $ENV->{reservation_id};
delete $ENV->{state};
delete $ENV->{data};
# Web site inserts into variable table whenever an admin or user message is modified
# Check if the variable exists, if so, validate all of the messages
check_messages_need_validating();
my $data_age_seconds = (time - $ENV->{management_node_info}->{$management_node_id}->{RETRIEVAL_TIME});
if ($data_age_seconds > 120 ) {
notify($ERRORS{'DEBUG'}, $LOGFILE, "retrieving management node info for '$management_node_id', cached data is stale: $data_age_seconds seconds old");
$info{managementnode} = get_management_node_info();
if (defined $info{managementnode}{checkininterval}) {
$management_node_checkin_interval = $info{managementnode}{checkininterval};
}
#notify($ERRORS{'DEBUG'}, $LOGFILE, "dump: " . format_data($ENV->{management_node_info}->{$management_node_id}));
}
# Set the vcld environment variable to 0 so other subroutines know if this is the vcld or child process
if (!defined($ENV{vcld})) {
$ENV{vcld} = 1;
notify($ERRORS{'DEBUG'}, $LOGFILE, "vcld environment variable set to $ENV{vcld} for this process");
}
else {
#notify($ERRORS{'DEBUG'}, $LOGFILE, "sleeping for $management_node_checkin_interval seconds");
sleep_uninterrupted($management_node_checkin_interval);
}
#===========================================================================
# Update lastcheckin for this management node
my $lastcheckin_timestamp = update_lastcheckin($management_node_id);
if ($lastcheckin_timestamp) {
notify($ERRORS{'DEBUG'}, $LOGFILE, "lastcheckin time updated for management node $management_node_id: $lastcheckin_timestamp");
# Update the local hash info to reflect the new timestamp
$info{managementnode}{lastcheckin} = $lastcheckin_timestamp;
}
else {
notify($ERRORS{'CRITICAL'}, $LOGFILE, "could not update lastcheckin for management node $management_node_id");
}
# Get all the requests assigned to this management node
# get_management_node_requests() gets a subset of the information available
$info{request} = get_management_node_requests($management_node_id);
if (defined($info{request})) {
#notify($ERRORS{'DEBUG'}, $LOGFILE, "retrieved request information for management node $management_node_id");
}
else {
notify($ERRORS{'CRITICAL'}, $LOGFILE, "could not retrieve request information for management node $management_node_id");
}
# See if there's anything to do
my $request_count = scalar keys %{$info{request}};
#notify($ERRORS{'DEBUG'}, $LOGFILE, "number of requests assigned to management node $management_node_id: $request_count");
#===========================================================================
# Loop through the requests assigned to this management node
REQUEST: foreach my $request_id (keys %{$info{request}}) {
#notify($ERRORS{'DEBUG'}, $LOGFILE, "management node $management_node_id has been assigned request id: $request_id");
# Store some request data into a local variables
my $request_state_name = $info{request}{$request_id}{state}{name};
my $request_laststate_name = $info{request}{$request_id}{laststate}{name};
my $request_start = $info{request}{$request_id}{start};
my $request_end = $info{request}{$request_id}{end};
my $request_preload = $info{request}{$request_id}{preload};
my $changelog_timestamp = $info{request}{$request_id}{log}{changelog}{timestamp};
my @reservation_ids = sort { $a <=> $b } keys %{$info{request}{$request_id}{reservation}};
my $reservation_count = @reservation_ids;
$ENV->{request_id} = $request_id;
$ENV->{reservation_id} = 0;
$ENV->{state} = $request_state_name;
# Make sure the request state is valid
if ($request_state_name !~ /inuse|reserved|deleted|timeout|reclaim|reload|new|tomaintenance|image|imageprep|makeproduction|imageinuse|complete|failed|pending|maintenance|tovmhostinuse|rebootsoft|reboothard|reinstall|servermodified|checkpoint|test/) {
notify($ERRORS{'WARNING'}, $LOGFILE, "assigned request in unsupported state: $request_state_name");
next REQUEST;
}
# Don't process requests that are already pending
if ($request_state_name =~ /^(pending|maintenance)/) {
next REQUEST;
}
my $request_info;
#===========================================================================
# Loop through the reservations associated with this request
RESERVATION: foreach my $reservation_id (@reservation_ids) {
$ENV->{reservation_id} = $reservation_id;
$ENV->{database_select_count} = 0;
$ENV->{database_execute_count} = 0;
$ENV->{database_select_calls} = {};
my $reservation_info = $info{request}{$request_id}{reservation}{$reservation_id};
my $reservation_management_node_id = $reservation_info->{managementnodeid};
my $reservation_lastcheck = $reservation_info->{lastcheck};
my $server_request_id = 0;
$server_request_id = $reservation_info->{serverrequestid} if(defined($reservation_info->{serverrequestid}));
#notify($ERRORS{'DEBUG'}, $LOGFILE, "dump: " . format_data($info{request}{$request_id}));
if ($management_node_id != $reservation_management_node_id) {
notify($ERRORS{'DEBUG'}, $LOGFILE, "ignoring reservation $reservation_id assigned to management node ID $reservation_management_node_id");
next RESERVATION;
}
# Figure out the status of this reservation based on reservation times and the request state
# check_time_result can be: start, preload, end, poll, old, remove, 0
my $check_time_result = check_time($request_start, $request_end, $reservation_lastcheck, $request_state_name, $request_laststate_name, $server_request_id, $reservation_count, $changelog_timestamp);
# Do nothing if check_time returned 0
# Check this before querying for the large set of request data
if (!$check_time_result) {
next RESERVATION;
}
elsif ($check_time_result eq "remove") {
# Remove the request and associated reservations from database
# This also removes rows from computerloadlog table for associated reservations
if (delete_request($request_id)) {
notify($ERRORS{'OK'}, $LOGFILE, "request deleted");
}
else {
notify($ERRORS{'WARNING'}, $LOGFILE, "unable to delete rows from request, reservation, and computerloadlog tables for request");
}
# Remove the request key from the hash
delete $info{request}{$request_id};
next REQUEST;
}
elsif ($check_time_result eq "preload" && $request_preload) {
# Preload flag has already been set, don't process preload request again
notify($ERRORS{'DEBUG'}, $LOGFILE, "preload request has already been processed");
next RESERVATION;
}
# Make sure reservation is not currently being processed
my $being_processed = reservation_being_processed($reservation_id);
if ($being_processed) {
# It's OK for if a process is already running for some user-initated state changes
if ($request_state_name =~ /^(deleted|makeproduction|image|reinstall|rebootsoft|reboothard|servermodified|checkpoint)$/) {
notify($ERRORS{'DEBUG'}, $LOGFILE, "$request_state_name processing delayed, reservation $reservation_id is currently being processed");
next RESERVATION;
}
else {
notify($ERRORS{'DEBUG'}, $LOGFILE, "reservation $reservation_id is already being processed");
next RESERVATION;
}
}
else {
notify($ERRORS{'DEBUG'}, $LOGFILE, "reservation $reservation_id is NOT already being processed");
}
# Get the full set of database data for this request
if (!$request_info) {
if ($request_info = get_request_info($request_id)) {
notify($ERRORS{'DEBUG'}, $LOGFILE, "retrieved request information from database");
# Set request variables that may have changed by other processes to their original values
# They may change if this is a cluster reservation
$request_info->{state}{name} = $request_state_name;
$request_info->{laststate}{name} = $request_laststate_name;
$request_info->{preload} = $request_preload;
# Add the check_time result to the hash
$request_info->{CHECKTIME} = $check_time_result;
# Check if preload was returned by check_time and that preload flag is 0
# The preload flag will be set to 1 by new.pm module after it's done
if ($check_time_result =~ /preload/ && !($request_info->{preload})) {
notify($ERRORS{'OK'}, $LOGFILE, "request start time within 25-35 minute window and preload flag is 0, processing preload request");
$request_info->{PRELOADONLY} = 1;
}
}
else {
notify($ERRORS{'WARNING'}, $LOGFILE, "could not retrieve request information from database");
next REQUEST;
}
}
# Add the reservation ID to be processed to the hash
$request_info->{RESERVATIONID} = $reservation_id;
# Get a new data structure object
my $data_structure;
eval {$data_structure = new VCL::DataStructure({request_data => $request_info, reservation_id => $reservation_id});};
if (my $error = Exception::Class::Base->caught()) {
notify($ERRORS{'CRITICAL'}, 0, "unable to create DataStructure object" . $error->message);
next RESERVATION;
}
# Add the DataStructure reference to %ENV so it can be accessed from non-object methods
$ENV->{data} = $data_structure;
# Remove any existing 'exited' computerloadlog entries
delete_computerloadlog_reservation($reservation_id, 'exited');
# Insert a computerloadlog 'begin' entry to indicate processing has begun for this reservation
# This should prevent multiple processes from being forked for a given reservation
# Do this before forking the new process because a cluster child will wait for the parent in State.pm::initialize
my $computer_id = $data_structure->get_computer_id();
insertloadlog($reservation_id, $computer_id, "begin", "beginning to process, state is $request_state_name");
# Make a new child process, passing it the request/reservation info
make_new_child({request_info => $request_info, data_structure => $data_structure});
} ## end foreach my $reservation_id (keys %{$info{request...
} ## end foreach my $request_id (keys %{$info{request}})
delete $ENV->{request_id};
delete $ENV->{reservation_id};
delete $ENV->{state};
delete $ENV->{data};
#===========================================================================
# Get all the block requests assigned to this management node
my $blockrequest_data = get_management_node_blockrequests($management_node_id);
if (!defined $blockrequest_data) {
notify($ERRORS{'CRITICAL'}, $LOGFILE, "could not retrieve block request information for management node $management_node_id");
next;
}
elsif (!$blockrequest_data) {
#notify($ERRORS{'OK'}, 0, "there are 0 block requests assigned to management node $management_node_id");
next;
}
#notify($ERRORS{'CRITICAL'}, $LOGFILE, "\$blockrequest_data", $blockrequest_data);
#next;
# Loop through the block requests assigned to this management node
BLOCKREQUEST: foreach my $blockrequest_id (keys %{$blockrequest_data}) {
#notify($ERRORS{'DEBUG'}, $LOGFILE, "checking block request id=$blockrequest_id");
BLOCKTIME: foreach my $blocktime_id (keys %{$blockrequest_data->{$blockrequest_id}{blockTimes}}) {
#notify($ERRORS{'DEBUG'}, $LOGFILE, "checking block time id=$blocktime_id");
# Get a new data structure object
my $data_structure;
eval {$data_structure = new VCL::DataStructure({blockrequest_data => $blockrequest_data, blockrequest_id => $blockrequest_id, blocktime_id => $blocktime_id});};
if (my $e = Exception::Class::Base->caught()) {
notify($ERRORS{'CRITICAL'}, 0, "unable to create DataStructure object" . $e->message);
next;
}
# Store some block request data into a local variables
my $blockrequest_name = $data_structure->get_blockrequest_name();
my $blockrequest_expire = $data_structure->get_blockrequest_expire();
my $blockrequest_processing = $data_structure->get_blockrequest_processing();
my $blocktime_start = $data_structure->get_blocktime_start();
my $blocktime_end = $data_structure->get_blocktime_end();
my $blocktime_processed = $data_structure->get_blocktime_processed();
my $blocktime_id = $data_structure->get_blocktime_id();
#use VCL::blockrequest;
#$data_structure->set_blockrequest_mode('start');
#my $br_start = VCL::blockrequest->new({%{$blockrequest_data->{$blockrequest_id}}, data_structure => $data_structure});
#notify($ERRORS{'OK'}, $LOGFILE, "***** Starting start process *****");
#$br_start->process();
#exit;
#notify($ERRORS{'OK'}, $LOGFILE, "***** DONE WITH START *****");
#sleep 5;
#$data_structure->set_blockrequest_mode('end');
#my $br_end = VCL::blockrequest->new({%{$blockrequest_data->{$blockrequest_id}}, data_structure => $data_structure});
#notify($ERRORS{'OK'}, $LOGFILE, "***** Starting end process *****");
#$br_end->process();
#notify($ERRORS{'OK'}, $LOGFILE, "***** DONE WITH END *****");
#exit;
# Check if the block request is already being processed
if ($blockrequest_processing) {
#notify($ERRORS{'DEBUG'}, $LOGFILE, "block request $blockrequest_id '$blockrequest_name' is already being processed");
next BLOCKREQUEST;
}
else {
#notify($ERRORS{'OK'}, $LOGFILE, "block request $blockrequest_id '$blockrequest_name' is not currently being processed");
}
# Check block request start, end and expire time
my $blockrequest_mode = check_blockrequest_time($blocktime_start, $blocktime_end, $blockrequest_expire);
# check_blockrequest_time will return 0 if nothing needs to be done and undefined if an error occurred
if (!defined $blockrequest_mode) {
notify($ERRORS{'CRITICAL'}, $LOGFILE, "error occurred checking block request $blockrequest_id '$blockrequest_name' status");
next;
}
elsif (!$blockrequest_mode) {
#notify($ERRORS{'DEBUG'}, $LOGFILE, "block request $blockrequest_id will not be processed at this time");
next;
}
else {
#notify($ERRORS{'DEBUG'}, $LOGFILE, "block request $blockrequest_id will be processed, mode: $blockrequest_mode");
}
if ($blockrequest_mode eq 'start' && $blocktime_processed) {
#notify($ERRORS{'DEBUG'}, $LOGFILE, "block request $blockrequest_id '$blockrequest_name' blocktime_id $blocktime_id has already been processed");
next BLOCKREQUEST;
}
# Start processing block request
$data_structure->set_blockrequest_mode($blockrequest_mode);
# Attempt to set the blockRequest processing column to 1
if (update_blockrequest_processing($blockrequest_id, 1)) {
notify($ERRORS{'OK'}, $LOGFILE, "block request $blockrequest_id '$blockrequest_name' processing set to 1");
# Make a new child process, passing it the request/reservation info
make_new_child({data_structure => $data_structure, request_info => $blockrequest_data->{$blockrequest_id}});
}
else {
notify($ERRORS{'CRITICAL'}, $LOGFILE, "unable to set block request $blockrequest_id '$blockrequest_name' processing to 1");
next;
}
} ## end foreach my $blocktime_id (keys %{$blockrequest_data...
} ## end foreach my $blockrequest_id (keys %{$blockrequest_data...
} ## end while (1)
} ## end sub main ()
#/////////////////////////////////////////////////////////////////////////////
=head2 make_new_child
Parameters :
Returns :
Description :
=cut
sub make_new_child {
my ($args) = @_;
my $request_data = $args->{request_info};
my $data_structure = $args->{data_structure};
$data_structure = 0 if !$data_structure;
# Assemble a consistent prefix for notify messages
my $request_id = $request_data->{id};
my $reservation_id = $request_data->{RESERVATIONID};
# Get the state name
my $state;
my $state_module;
if ($data_structure) {
$state = $data_structure->get_state_name();
$state_module = "VCL::$state";
}
else {
$state = $request_data->{state}{name};
$state_module = "VCL::$state";
}
# The timeout and deleted states have been combined into reclaim.pm
if ($state =~ /^(timeout|deleted)$/) {
notify($ERRORS{'DEBUG'}, $LOGFILE, "request will be processed by reclaim.pm");
$state_module = "VCL::reclaim";
}
# The imageinuse state is now handled by inuse.pm
if ($state =~ /^(imageinuse|rebootsoft|reboothard|servermodified)$/) {
notify($ERRORS{'DEBUG'}, $LOGFILE, "request will be processed by inuse.pm");
$state_module = "VCL::inuse";
}
# The tomaintenance state is handled by new.pm
if ($state =~ /^(tomaintenance|imageprep|reload|reinstall|tovmhostinuse)$/) {
notify($ERRORS{'DEBUG'}, $LOGFILE, "request will be processed by new.pm");
$state_module = "VCL::new";
}
# The checkpoint state is handled by image.pm
if ($state =~ /^(image|checkpoint)$/) {
notify($ERRORS{'DEBUG'}, $LOGFILE, "request will be processed by image.pm");
$state_module = "VCL::image";
}
# Build a signal set using POSIX::SigSet->new, contains only the SIGINT signal
my $sigset = POSIX::SigSet->new(SIGINT);
# Pass the POSIX::SigSet object to sigprocmask with the SIG_BLOCK flag to delay SIGINT signal delivery
sigprocmask(SIG_BLOCK, $sigset) or die "can't block SIGINT for fork: $!\n";
FORK: {
my $pid;
if ($pid = fork) {
# If here, this is the parent process
# Restore delivery of SIGINT signal for the parent process
sigprocmask(SIG_UNBLOCK, $sigset) or die "can't unblock SIGINT for fork: $!\n";
# Parent process records the child's PID and returns
# Store the reservation ID so REAPER can clean up the reservation when it dies
$child_count++;
$child_pids{$pid} = $reservation_id;
notify($ERRORS{'DEBUG'}, $LOGFILE, "created child process $pid for reservation $reservation_id, state: $state, current number of forked kids: $child_count");
return;
}
elsif (defined $pid) {
# If here, this is the child process
# Child must *NOT* return from this subroutine after this point. It must exit.
# If child returns it will become a parent process and spawn off its own children
# Close/release the lockfile if the handle is shared with the forked child
# This behavior isn't reliable, using the old SysV daemon it doesn't get shared with the child
# It does get shared using systemd
# If shared, the child keeps the file locked even the the parent vcld process dies
# This prevents the parent from being able to start up again until the child dies
if (fileno LOCKFILE) {
close LOCKFILE;
}
# Set the process group of this child process to its own PID instead of it's parent PID
# This allows any processes forked by this child to be killed when this process is killed
setpgrp $$, 0;
# Configure the SIGINT signal to kill this process normally
$SIG{INT} = 'DEFAULT';
# Unblock the SIGINT signal
sigprocmask(SIG_UNBLOCK, $sigset) or die "can't unblock SIGINT for fork: $!\n";
# Set the vcld environment variable to 0 so other subroutines know if this is the vcld or child process
$ENV{vcld} = 0;
notify($ERRORS{'DEBUG'}, $LOGFILE, "vcld environment variable set to $ENV{vcld} for this process");
# Set the request_id and reservation_id environment variables
$ENV->{request_id} = $request_id;
$ENV->{reservation_id} = $reservation_id if $reservation_id;
$ENV->{state} = $state;
$ENV->{data} = $data_structure;
# Rename this process to include some request info
rename_vcld_process($data_structure);
#notify($ERRORS{'DEBUG'}, $LOGFILE, "creating new process");
eval "use $state_module";
if ($EVAL_ERROR) {
notify($ERRORS{'CRITICAL'}, $LOGFILE, "$state_module module could not be loaded, error: $EVAL_ERROR");
exit;
}
notify($ERRORS{'DEBUG'}, $LOGFILE, "loaded $state_module module");
# Create a new VCL state object, passing it the reservation data
my $state_object;
eval {
$state_object = ($state_module)->new({%{$request_data}, data_structure => $data_structure});
};
if ($state_object) {
notify($ERRORS{'OK'}, $LOGFILE, "$state_module object created and initialized");
# Call the state object's process() subroutine
$state_object->process();
}
else {
if ($EVAL_ERROR) {
notify($ERRORS{'CRITICAL'}, $LOGFILE, "$state_module object could not be created and initialized, error:\n$EVAL_ERROR");
}
else {
notify($ERRORS{'CRITICAL'}, $LOGFILE, "$state_module object could not be created and initialized");
}
}
exit;
} ## end elsif (defined $pid) [ if ($pid = fork)
elsif ($! =~ /No more process/) {
sleep 5;
redo FORK;
}
else {
# strange error
die "can't fork: $!\n";
}
} ## end FORK:
} ## end sub make_new_child
#/////////////////////////////////////////////////////////////////////////////
=head2 warning_handler
Parameters : None
Returns : Nothing
Description : Handles __WARN__ signals. This signal is generated when warn()
is called. This may occur when the VCL code encounters an
error such as:
Use of uninitialized value in concatenation (.) or string at
If the signal isn't handled, the warning message is dumped
to STDOUT and will appear in the log file. This handler
causes WARN signals to be logged by the notify() subroutine.
=cut
sub warning_handler {
# Call notify, passing it a string of whatever is contained in @_
notify($ERRORS{'WARNING'}, $LOGFILE, "@_");
# Reinstall the signal handler in case of unreliable signals
$SIG{__WARN__} = \&warning_handler;
}
#/////////////////////////////////////////////////////////////////////////////
=head2 die_handler
Parameters : None
Returns : Nothing
Description : Handles __DIE__ signals. This signal is generated when die()
is called. This may occur when the VCL code encounters an
error such as:
Uncaught exception from user code:
Undefined subroutine ... called at ...
If the signal isn't handled, the output is dumped to STDERR
and the process exits quietly.
=cut
sub die_handler {
# Call notify, passing it a string of whatever is contained in @_
notify($ERRORS{'CRITICAL'}, $LOGFILE, "@_");
# Prevent requests stuck in pending, try to set state back to original
if ($ENV->{request_id} && $ENV->{state}) {
update_request_state($ENV->{request_id}, $ENV->{state}, $ENV->{state});
}
# Reinstall the signal handler in case of unreliable signals
$SIG{__DIE__} = \&die_handler;
exit;
}
#/////////////////////////////////////////////////////////////////////////////
=head2 HUNTSMAN
Parameters : None
Returns : Nothing, process exits
Description : Signal handler for:
$SIG{INT}
$SIG{QUIT}
$SIG{HUP}
$SIG{TERM}
=cut
sub HUNTSMAN {
my $signal = shift;
local ($SIG{CHLD}) = 'IGNORE';
# Display a message and exit
notify($ERRORS{'DEBUG'}, 0, "HUNTSMAN called: signal: $signal, pid: $PID, process exiting");
exit;
}
#/////////////////////////////////////////////////////////////////////////////
=head2 REAPER
Parameters : None
Returns : Undefined
Description : The REAPER subroutine gets called whenever a child process
stops running or exits. This occurs because the subroutine is
configured as the handler for SIGCHLD signals. The system will
send a SIGCHLD signal whenever a child process stops running
or exits.
The REAPER subroutine manages the child PID hash when a VCL .
state process exits. It also captures the exit code of the
child process which died and makes sure the special $?
variable is set to this value.
=cut
sub REAPER {
my $signal = shift;
# Don't overwrite current error
local $!;
# Save the information saved in $? before proceeding
# This is done to save the exit status of the child process which died
# If you don't save it, wait() will overwrite it
my $status_save = $?;
my $child_exit_status = $? >> 8;
my $signal_number = $? & 127;
my $dumped_core = $? & 128;
#notify($ERRORS{'DEBUG'}, 0, "REAPER called: signal: $signal, initial value of \$?: $status_save");
# Wait for a child processes to die
my $dead_pid = -1;
my $wait_pid;
while (($wait_pid = waitpid(-1, WNOHANG)) > 0) {
$status_save = $?;
$child_exit_status = $? >> 8;
$signal_number = $? & 127;
$dumped_core = $? & 128;
$dead_pid = $wait_pid;
# Assemble a string containing the dead process info
#notify($ERRORS{'DEBUG'}, 0, "process reaped: pid: $dead_pid, \$?: $status_save, exit status: $child_exit_status");
# Check if the child PID hash contains the pid of the process which just died
if (exists $child_pids{$dead_pid}) {
my $dead_reservation_id = $child_pids{$dead_pid} || "<unknown>";
notify($ERRORS{'DEBUG'}, 0, "VCL process exited for reservation $dead_reservation_id, PID: $dead_pid, signal: $signal");
# Child which died was a VCL state process since its pid is in the hash
$child_count--;
delete $child_pids{$dead_pid};
# Kill all child processes which were forked by this process
kill 'SIGTERM', -$dead_pid;
}
}
# Reinstall the signal handler in case of unreliable signals
$SIG{CHLD} = \&REAPER;
# Set the special $? variable back to the exit status of the child which died
# This is useful when utilities such as SSH are run in other places in the code
# The code which called the utility can check the exit status to see if it was successful
#notify($ERRORS{'DEBUG'}, 0, "setting \$? to $status_save, exit status: $child_exit_status");
$? = $status_save;
return;
} ## end sub REAPER
#/////////////////////////////////////////////////////////////////////////////
=head2 daemonize
Parameters : none
Returns : true or exits
Description :
=cut
sub daemonize {
#Create EX lock on lockfile
my $subsys_lock = "/var/lock/subsys/$PROCESSNAME";
sysopen(LOCKFILE, $subsys_lock, O_RDONLY | O_CREAT ) or die "unable to open lock file: $PIDFILE \n";
unless(flock(LOCKFILE, LOCK_EX|LOCK_NB)) {
notify($ERRORS{'WARNING'}, $LOGFILE, " an process instance of $PROCESSNAME is already running, failed to lock file: $subsys_lock");
print STDOUT "\nFailed to start. An instance of $PROCESSNAME is already running\n\n";
print STDERR "\nFailed to start. An instance of $PROCESSNAME is already running\n\n";
exit(1);
}
my $child_pid = fork();
if (!defined($child_pid)) {
die "Can't fork $!";
}
elsif ($child_pid) {
# If here, this is the process that called fork()
# This service starting process is only used to start the actual forked vcld daemon process, it must exit
# Before exiting, the parent must create the pidfile
# This must be done before this parent exits can cannot be done by the forked child
# Otherwise, timing issues will occur with systemd
# As soon as this parent exits, systemd expects the pidfile to exist and checks it
# If the pidfile is missing or incorrect, systemd will try over and over again to start vcld
notify($ERRORS{'DEBUG'}, 0, "this is parent service startup process: $PID, forked child process which will be the main vcld daemon process: $child_pid, writing child PID to file: $PIDFILE");
open(PIDFILE, ">" . $PIDFILE) or notify($ERRORS{'WARNING'}, $LOGFILE, "unable to open PID file: $PIDFILE, $!");
print PIDFILE $child_pid ;
close(PIDFILE);
notify($ERRORS{'DEBUG'}, 0, "parent service startup process exiting: $PID");
exit;
}
else {
# If here, this is the child process created by the fork and will be the main vcld process
# Detatch from controlling terminal
setsid;
# Process umask is inherited to child from fork
umask 0;
# Current working directory is inherited to child from fork
# The daemon will run from that directory and may prevent modification
chdir '/';
preplogfile();
# Redirect STDIN,STDOUT,STDERR
open STDIN, '/dev/null' or die "Can't read /dev/null $!";
open STDOUT, ">>$LOGFILE" or die "Can't write $LOGFILE $!";
open STDERR, ">>$LOGFILE" or die "Can't write $LOGFILE $!";
print "Created VCL daemon process: $$\n";
return 1;
}
} ## end sub daemonize
#/////////////////////////////////////////////////////////////////////////////
=head2 setup_management_node
Parameters : None.
Returns :
Description : Checks each module in the module table for
the existance of a subroutine named "setup". Calls the setup
subroutine for each module which contains one.
The program terminates if a module's setup subroutine returns
false. The program continues if a module's setup subroutine
returns true.
STDOUT "print" statements are printed to the screen. Messages
sent to the "notify" subroutine are printed to the logfile.
=cut
sub setup_management_node {
print "VCL Management Node Setup\n";
# Always use verbose mode when running in setup mode
$VERBOSE = 1;
# Create a DataStructure object which will be passed to modules when they are instantiated
# The creation of this DataStructure object collects the management node information
my $data_structure = new VCL::DataStructure();
if (!$data_structure) {
die "unable to create DataStructure object";
}
notify($ERRORS{'DEBUG'}, 0, "created DataStructure object to be used for vcld setup");
# Get the information from the module table
my $module_info = get_module_info();
# Loop through the entries in the data from the module table
my %setup_module_objects;
my %setup_menu;
use VCL::Module;
for my $module_id (keys %$module_info) {
# Get the module's Perl package and name
my $module_name = $module_info->{$module_id}{name};
my $module_perl_package = $module_info->{$module_id}{perlpackage};
notify($ERRORS{'DEBUG'}, 0, "checking if setup() subroutine has been implemented by '$module_name' module");
# Attempt to load the module
eval "use $module_perl_package";
if ($EVAL_ERROR) {
notify($ERRORS{'WARNING'}, 0, "$module_name module (" . $module_perl_package . ") could not be loaded, error message:\n$EVAL_ERROR");
next;
}
# Check if the module implements a setup subroutine
# Don't use 'can' or else the same setup subroutine will be called multiple times due to inheritance
if (!defined(&{$module_perl_package . "::setup"}) && !defined(&{$module_perl_package . "::setup_get_menu"})) {
next;
}
my $module_object = VCL::Module::create_object($module_perl_package);
if (!$module_object) {
next;
}
# Store the module object in a hash
$setup_module_objects{$module_perl_package}{object} = $module_object;
# Determine the name to display for the module
my $module_display_name = $module_info->{$module_id}{prettyname};
if (!$module_display_name) {
# Use the last part of the module's Perl package path if the pretty name isn't set
($module_display_name) = $module_perl_package =~ /([^:]+)$/;
# Capitalize the first letter
$module_display_name =~ s/\b([a-z])(\w+)\b/\u$1$2/g;
}
$setup_module_objects{$module_perl_package}{display_name} = $module_display_name;
if (defined(&{$module_perl_package . "::setup_get_menu"})) {
my $module_menu = $module_object->setup_get_menu();
%setup_menu = (%setup_menu, %$module_menu);
}
else {
$setup_menu{Modules}{$module_display_name} = \&{$module_perl_package . "::setup"}
}
}
# Loop until the user selects 'c' to cancel
while (1) {
# Set the setup_path environment variable to anonymous array containing 'vcld'
# This is used to display the location in the menu hierarchy
# strings added/removed to the array cause the location to change
$ENV->{setup_path} = ['vcld'];
setup_print_break();
my $choice = setup_get_menu_choice(\%setup_menu);
## For testing
#my $choice = {
# "name" => "VM Host Operations",
# "parent_menu_names" => ["VMware Provisioning Module"],
# "sub_ref" => \&VCL::Module::Provisioning::VMware::VMware::setup_vm_host_operations,
#};
last unless defined($choice);
my $choice_name = $choice->{name};
my $choice_sub_ref = $choice->{sub_ref};
my $choice_parent_menu_names = $choice->{parent_menu_names};
push @{$ENV->{setup_path}}, @$choice_parent_menu_names, $choice_name;
my $package_name = get_code_ref_package_name($choice_sub_ref);
my $subroutine_name = get_code_ref_subroutine_name($choice_sub_ref);
my $module_object = $setup_module_objects{$package_name}{object};
&$choice_sub_ref($module_object);
pop @{$ENV->{setup_path}};
}
setup_print_break('=');
exit;
}
#/////////////////////////////////////////////////////////////////////////////
1;
__END__
=head1 SEE ALSO
L<http://cwiki.apache.org/VCL/>
=cut