blob: 4c36db5c1531136238fbbabdbcc59b2e52af46b2 [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::blockrequest
=head1 SYNOPSIS
Needs to be written
=head1 DESCRIPTION
This module provides VCL support for...
=cut
##############################################################################
package VCL::blockrequest;
# Specify the lib path using FindBin
use FindBin;
use lib "$FindBin::Bin/..";
# Configure inheritance
use base qw(VCL::Module::State);
# Specify the version of this module
our $VERSION = '2.00';
# Specify the version of Perl to use
use 5.008000;
use strict;
use warnings;
use diagnostics;
use English '-no_match_vars';
use VCL::utils;
use DBI;
##############################################################################
=head1 OBJECT METHODS
=cut
#/////////////////////////////////////////////////////////////////////////////
=head2 initialize
Parameters : Reference to current inuse object is automatically passed when
invoked as a class method.
Returns : 1 if successful, 0 otherwise
Description : Prepares the delete object to process a reservation. Renames the
process.
=cut
sub initialize {
my $self = shift;
# Initialize the database handle count
$ENV{dbh_count} = 0;
# Attempt to get a database handle
if ($ENV{dbh} = getnewdbh()) {
notify($ERRORS{'OK'}, 0, "obtained a database handle for this state process, stored as \$ENV{dbh}");
}
else {
notify($ERRORS{'WARNING'}, 0, "unable to obtain a database handle for this state process");
}
# Rename this process to include some request info
rename_vcld_process($self->data);
notify($ERRORS{'OK'}, 0, "returning 1");
return 1;
} ## end sub initialize
=pod
////////////////////////////////////////////////////////////////////////////////
///
/// \fn sub process
///
/// \param hash
///
/// \return 1, 0
///
/// \brief start mode:
/// uses xml-rpc to call the web api to process block request
// event
/// end mode:
/// remove machines from blockComputers table for block request id X
/// reload ?
/// expire mode:
/// delete entries related to blockRequest
///
////////////////////////////////////////////////////////////////////////////////
=cut
sub process {
my $self = shift;
my ($package, $filename, $line) = caller;
# Retrieve data from the data structure
my $blockrequest_id = $self->data->get_blockrequest_id();
my $blockrequest_mode = $self->data->get_blockrequest_mode();
my $blockrequest_image_id = $self->data->get_blockrequest_image_id();
my $blockrequest_number_machines = $self->data->get_blockrequest_number_machines();
my $blockrequest_expire = $self->data->get_blockrequest_expire();
my $blocktime_id = $self->data->get_blocktime_id();
my $blocktime_processed = $self->data->get_blocktime_processed();
my $blocktime_start = $self->data->get_blocktime_start();
my $blocktime_end = $self->data->get_blocktime_end();
my $blockrequest_name = $self->data->get_blockrequest_name();
my $blockrequest_owner_id = $self->data->get_blockrequest_owner_id();
my $block_group_id = $self->data->get_blockrequest_group_id();
my $block_group_name = $self->data->get_blockrequest_group_name();
# Get user info
my $user_info;
my %image_info;
my $image_prettyname;
my $owner_affiliation_helpaddress;
my $owner_email;
if ($user_info = get_user_info($blockrequest_owner_id)) {
$owner_email = $user_info->{email};
$owner_affiliation_helpaddress = $user_info->{affiliation}{helpaddress};
}
#Get image info
if(%image_info = get_image_info($blockrequest_image_id)){
$image_prettyname = $image_info{prettyname};
}
#Set local timer
my $localtimer = convert_to_epoch_seconds();
notify($ERRORS{'DEBUG'}, 0, "blockrequest id: $blockrequest_id");
notify($ERRORS{'DEBUG'}, 0, "blockrequest mode: $blockrequest_mode");
notify($ERRORS{'DEBUG'}, 0, "blockrequest image id: $blockrequest_image_id");
notify($ERRORS{'DEBUG'}, 0, "blockrequest number machines: $blockrequest_number_machines");
notify($ERRORS{'DEBUG'}, 0, "blockrequest expire: $blockrequest_expire");
notify($ERRORS{'DEBUG'}, 0, "blocktime id: $blocktime_id");
notify($ERRORS{'DEBUG'}, 0, "blocktime processed: $blocktime_processed");
notify($ERRORS{'DEBUG'}, 0, "blocktime start: $blocktime_start");
notify($ERRORS{'DEBUG'}, 0, "owner email: $owner_email");
notify($ERRORS{'DEBUG'}, 0, "help address: $owner_affiliation_helpaddress");
if ($blockrequest_mode eq "start") {
#update processed flag for request
if (update_blockTimes_processing($blocktime_id, 1)) {
notify($ERRORS{'OK'}, 0, "updated process flag on blocktime_id= $blocktime_id");
}
my $completed = 0;
my $loop_control = 0;
my $xmlcall;
my ($warningmsg, $errormsg);
my $urla = $XMLRPC_URL;
my $blockAlloc_URL;
if($urla =~ /(.*)(=xmlrpccall)/){
$blockAlloc_URL = $1 . "=blockallocations";
}
my($allocated,$unallocated) = 0;
while(!($completed)){
if($loop_control < 6){
$loop_control++;
notify($ERRORS{'DEBUG'}, 0, "processing blocktime_id= $blocktime_id pass $loop_control");
$xmlcall = process_block_time($blocktime_id);
}
else{
$completed=1;
notify($ERRORS{'DEBUG'}, 0, "attempted $loop_control passes to complete block_request $blockrequest_id\n allocated= $allocated \nblockrequest_number_machines= $blockrequest_number_machines");
last;
}
$allocated = $xmlcall->{allocated} if (defined($xmlcall->{allocated}));
$unallocated = $xmlcall->{unallocated} if (defined($xmlcall->{unallocated}));
if($allocated >= $blockrequest_number_machines){
$completed=1;
notify($ERRORS{'OK'}, 0, "success blockTimes id $blocktime_id processed and allocated $xmlcall->{allocated} nodes \nstatus= $xmlcall->{status}");
last;
}
if ($xmlcall->{status} =~ /warning|fault/) {
$warningmsg = $xmlcall->{warningmsg} if (defined($xmlcall->{warningmsg}));
notify($ERRORS{'DEBUG'}, 0, "xmlrpc warning: $warningmsg allocated= $allocated unallocated= $unallocated");
}
if ($xmlcall->{status} =~ /error/) {
$errormsg = $xmlcall->{errormsg} if (defined($xmlcall->{errormsg}));
notify($ERRORS{'DEBUG'}, 0, "xmlrpc error on blockrequest_id=$blockrequest_id blocktime_id=$blocktime_id : $errormsg");
}
if ($xmlcall->{status} =~ /completed/) {
$completed=1;
notify($ERRORS{'OK'}, 0, "success blockTimes id $blocktime_id already processed");
}
sleep 5 if(!$completed);
}
my $body;
my $subject = "VCL Block allocation results for $blockrequest_name";
my $mailstring;
if(defined($warningmsg) || defined($errormsg) || ($allocated < $blockrequest_number_machines)){
$body .= "Problem processing block allocation \n\n";
$body .= "Block id = $blockrequest_id\n";
$body .= "Block name = $blockrequest_name\n";
$body .= "Block start time = $blocktime_start\n";
$body .= "Block end time = $blocktime_end\n";
$body .= "Environment name = $image_prettyname\n";
$body .= "Allocated = $allocated\n";
$body .= "Block requested = $blockrequest_number_machines\n";
$body .= "xmlrpc warn msg = $warningmsg\n" if(defined($warningmsg));
$body .= "xmlrpc error msg = $errormsg\n" if(defined($errormsg));
$body .= "\n";
notify($ERRORS{'CRITICAL'}, 0, "$body");
if($allocated < $blockrequest_number_machines){
$subject = "VCL Block allocation warning for $blockrequest_name";
$mailstring .= << "EOF";
WARNING - The block allocation for $blockrequest_name was not successfully processed for the following session.
REASON: machines allocated were less than requested
Block allocation name = $blockrequest_name
Machines allocated = $allocated
Machines requested = $blockrequest_number_machines
Block Start time = $blocktime_start
Block End time = $blocktime_end
User Group = $block_group_name
Environment name = $image_prettyname
The VCL staff have been notified to attempt to correct the issue.
If you wish to cancel this session or make changes to future sessions. Please visit
the VCL site: $blockAlloc_URL
EOF
if(defined($owner_email)){
mail($owner_email, $subject, $mailstring, $owner_affiliation_helpaddress);
}
}
}
elsif($completed){
# Notify block request owner for given time slot has been processed.
my $mailstring .= <<"EOF";
The block allocation for $blockrequest_name was processed successfully with the following results:
Block allocation name = $blockrequest_name
Machines allocated = $allocated
Machines requested = $blockrequest_number_machines
Block Start time = $blocktime_start
Block End time = $blocktime_end
User Group = $block_group_name
Environment name = $image_prettyname
The machines for this block allocation will be loaded up to an hour before the actual start time.
Once loaded the users listed in the user group $block_group_name will be able to login 5 minutes before the start time.
PLEASE NOTE:
The VCL resources are valuable and if you choose not to utilize them during this session, you should make them available for others to use. To skip this session please visit the VCL block allocations page: $blockAlloc_URL
Select View times and skip the desired session.
Thank You,
VCL Team
EOF
if(defined($owner_email)){
mail($owner_email, $subject, $mailstring, $owner_affiliation_helpaddress);
}
}
sleep 10;
} ## end if ($blockrequest_mode eq "start")
elsif ($blockrequest_mode eq "end") {
# remove blockTime entry for this request
if (clear_blockComputers($blocktime_id)) {
notify($ERRORS{'OK'}, 0, "Removed computers from blockComputers table for blocktime_id=$blocktime_id");
}
if (clear_blockTimes($blocktime_id)) {
notify($ERRORS{'OK'}, 0, "Removed blocktime_id=$blocktime_id from blockTimes table");
}
#check expire time, if this was the last blockTimes entry then this is likely the expiration time as well
my $status = check_blockrequest_time($blocktime_start, $blocktime_end, $blockrequest_expire);
if ($status eq "expire") {
#fork start processing
notify($ERRORS{'OK'}, 0, "Block Request $blockrequest_id has expired");
if(udpate_block_request_status($blockrequest_id,"completed")){
notify($ERRORS{'OK'}, 0, "Updated status of blockRequest id $blockrequest_id to completed");
}
}
} ## end elsif ($blockrequest_mode eq "end") [ if ($blockrequest_mode eq "start")
elsif ($blockrequest_mode eq "expire") {
notify($ERRORS{'OK'}, 0, "Block Request $blockrequest_id has expired");
if(udpate_block_request_status($blockrequest_id,"completed")){
notify($ERRORS{'OK'}, 0, "Updated status of blockRequest id $blockrequest_id to completed");
}
}
else {
#should not of hit this
notify($ERRORS{'CRITICAL'}, 0, "mode not determined mode= $blockrequest_mode");
}
##remove processing flag
if (update_blockrequest_processing($blockrequest_id, 0)) {
notify($ERRORS{'OK'}, 0, "Removed processing flag on blockrequest_id $blockrequest_id");
}
return 1;
} ## end sub process
#/////////////////////////////////////////////////////////////////////////////
=head2 process_block_time
Parameters : $blockTimesid
Returns : hash references
Description : calls xmlrpc_call routine with specificed method and args
=cut
sub process_block_time {
my $blockTimesid = $_[0];
if(!$blockTimesid){
notify($ERRORS{'WARNING'}, 0, "blockTimesid argument was not passed");
return 0;
}
my $method = "XMLRPCprocessBlockTime";
my $ignoreprivileges = 1;
my @argument_string = ($method,$blockTimesid, $ignoreprivileges);
my $xml_ret = xmlrpc_call(@argument_string);
my %info;
if( ref($xml_ret) =~ /STRUCT/i){
$info{status} = $xml_ret->value->{status};
$info{allocated} = $xml_ret->value->{allocated} if(defined($xml_ret->value->{allocated})) ;
$info{unallocated} = $xml_ret->value->{unallocated} if(defined($xml_ret->value->{unallocated}));
#error
$info{errorcode} = $xml_ret->value->{errorcode} if(defined($xml_ret->value->{errorcode}));
$info{errormsg} = $xml_ret->value->{errormsg} if(defined($xml_ret->value->{errormsg}));
#warning
$info{warningcode} = $xml_ret->value->{warningcode} if(defined($xml_ret->value->{warningcode}));
$info{warningmsg} = $xml_ret->value->{warningmsg} if(defined($xml_ret->value->{warningmsg}));
#$info{reqidlists} = $xml_ret->value->{requestids};
}
else {
notify($ERRORS{'WARNING'}, 0, "return argument XMLRPCprocessBlockTime was not a STRUCT as expected" . ref($xml_ret) );
if(ref($xml_ret) =~ /fault/){
$info{status} = "fault";
}
else {
$info{status} = ref($xml_ret);
}
}
return \%info;
}
#/////////////////////////////////////////////////////////////////////////////
=head2 update_blockTimes_processing
Parameters : $blockTimes_id, $processing
Returns : 0 or 1
Description : Updates the processed flag in blockTimes table
=cut
sub update_blockTimes_processing {
my ($blockTimes_id, $processing) = @_;
my ($package, $filename, $line, $sub) = caller(0);
# Check the arguments
if (!defined($blockTimes_id)) {
notify($ERRORS{'WARNING'}, 0, "blockTimes ID was not specified");
return 0;
}
if (!defined($processing)) {
notify($ERRORS{'WARNING'}, 0, "processing was not specified");
return 0;
}
# Construct the update statement
my $update_statement = "
UPDATE
blockTimes
SET
blockTimes.processed = $processing
WHERE
blockTimes.id = $blockTimes_id
";
# Call the database execute subroutine
if (database_execute($update_statement)) {
return 1;
}
else {
notify($ERRORS{'WARNING'}, 0, "unable to update blockTimes table, id=$blockTimes_id, processing=$processing");
return 0;
}
} ## end sub update_blockTimes_processing
#/////////////////////////////////////////////////////////////////////////////
=head2 delete_block_request
Parameters : $blockrequest_id
Returns : 0 or 1
Description : removes an expired blockrequest from the blockrequest table
=cut
sub delete_block_request {
my ($blockrequest_id) = @_;
# Check the arguments
if (!defined($blockrequest_id)) {
notify($ERRORS{'WARNING'}, 0, "blockrequest ID was not specified");
return 0;
}
# Construct the update statement
my $delete_statement = "
DELETE
blockRequest
FROM blockRequest
WHERE
blockRequest.id = $blockrequest_id
";
# Call the database execute subroutine
if (database_execute($delete_statement)) {
return 1;
}
else {
notify($ERRORS{'WARNING'}, 0, "unable to deleted blockrequest $blockrequest_id blockRequest table ");
return 0;
}
}
#/////////////////////////////////////////////////////////////////////////////
=head2 udpate_block_request_status
Parameters : $blockrequest_id
Returns : 0 or 1
Description : update the status of a blockrequest from the blockrequest table
=cut
sub udpate_block_request_status {
my ($blockrequest_id,$status) = @_;
# Check the arguments
if (!defined($blockrequest_id)) {
notify($ERRORS{'WARNING'}, 0, "blockrequest ID was not specified");
return 0;
}
if (!defined($status)) {
notify($ERRORS{'WARNING'}, 0, "status was not specified for blockrequest_id $blockrequest_id ");
return 0;
}
# Construct the update statement
my $update_statement = "
UPDATE
blockRequest
SET blockRequest.status = '$status'
WHERE
blockRequest.id = $blockrequest_id
";
# Call the database execute subroutine
if (database_execute($update_statement)) {
return 1;
}
else {
notify($ERRORS{'WARNING'}, 0, "unable to updated blockrequest $blockrequest_id blockRequest table ");
return 0;
}
}
#/////////////////////////////////////////////////////////////////////////////
=head2 clear_blockTimes
Parameters : $blockTimes_id
Returns : 0 or 1
Description : Removes blockTimes id from blockTimes table
=cut
sub clear_blockTimes {
my ($blockTimes_id) = @_;
my ($package, $filename, $line, $sub) = caller(0);
# Check the arguments
if (!defined($blockTimes_id)) {
notify($ERRORS{'WARNING'}, 0, "blockTimes ID was not specified");
return 0;
}
# Construct the update statement
my $delete_statement = "
DELETE
blockTimes
FROM blockTimes
WHERE
blockTimes.id = $blockTimes_id
";
# Call the database execute subroutine
if (database_execute($delete_statement)) {
return 1;
}
else {
notify($ERRORS{'WARNING'}, 0, "unable to deleted blockTimes_id $blockTimes_id blockTimes table ");
return 0;
}
} ## end sub clear_blockTimes
#/////////////////////////////////////////////////////////////////////////////
=head2 clear_blockComputers
Parameters : $blockTimes_id, $processing
Returns : 0 or 1
Description : Clears blockcomputers from an expired BlockTimesid
=cut
sub clear_blockComputers {
my ($blockTimes_id) = @_;
my ($package, $filename, $line, $sub) = caller(0);
# Check the arguments
if (!defined($blockTimes_id)) {
notify($ERRORS{'WARNING'}, 0, "blockTimes ID was not specified");
return 0;
}
# Construct the update statement
my $delete_statement = "
DELETE
blockComputers
FROM blockComputers
WHERE
blockTimeid = $blockTimes_id
";
# Call the database execute subroutine
if (database_execute($delete_statement)) {
return 1;
}
else {
notify($ERRORS{'WARNING'}, 0, "unable to delete blockComputers for id=$blockTimes_id, ");
return 0;
}
} ## end sub clear_blockComputers
=pod
////////////////////////////////////////////////////////////////////////////////
///
/// \fn sub pauseprocessing
///
/// \param process start time
///
/// \return 1, 0
///
/// \brief rest until our window for checking request has closed
///
////////////////////////////////////////////////////////////////////////////////
=cut
sub pauseprocessing {
my $myStartTime = shift;
# set timer to 8 minutes
my $wait_minutes = (8 * 60);
my $delta = (convert_to_epoch_seconds() - $myStartTime);
while ($delta < $wait_minutes) {
#continue to loop
notify($ERRORS{'OK'}, 0, "going to sleep for 30 seconds, delta=$delta (until delta >= $wait_minutes)");
sleep 30;
$delta = (convert_to_epoch_seconds() - $myStartTime);
}
return 1;
} ## end sub pauseprocessing
#/////////////////////////////////////////////////////////////////////////////
1;
__END__
=head1 SEE ALSO
L<http://cwiki.apache.org/VCL/>
=cut