ACU/process/exec/guantanamo.pl

#!/usr/bin/env perl

use v5.10.1;
use strict;
use warnings;
use Gearman::Worker;
use MIME::Base64;
use XML::LibXML;

use ACU::LDAP;
use ACU::Log;
use ACU::Process;

my %master_actions =
(
 "launch"   => \&master_launch,
 "list"     => \&master_list,
 "register" => \&master_register,
);

my @nodes;

sub master_register
{
    my $args = shift;

    if ($args->{param}{nodename})
    {
	my $nodename = $args->{param}{nodename};

	if (! grep { $_ eq $nodename } @nodes)
	{
	    log INFO, "New node: $nodename";
	    push @nodes, "$nodename";
	}
	else {
	    log WARN, "Node $nodename alredy registered";
	}
    }
    else {
	log WARN, "nodename empty, cannot register new node";
    }
}

sub master_list
{
    my $doc = XML::LibXML::Document->new('1.0');
    my $root = $doc->createElement("process");

    for my $target (@nodes)
    {
	my $t = $doc->createElement("target");
	$t->setAttribute("name", $target);
	$root->appendChild($t);
    }

    $doc->setDocumentElement( $root );
    return $doc->toString();
}

sub build_task_xml
{
    my $files = shift;
    my $subtree = shift;

    my $doc = XML::LibXML::Document->new('1.0');
    my $root = $doc->createElement("guantanamo");
    $doc->setDocumentElement( $root );

    log TRACE, $subtree;

    if ($files)
    {
	log TRACE, $files;

	for my $key (keys %{ $files })
	{
	    my $file = $doc->createElement("file");
	    $file->addChild( $doc->createAttribute("name", $key) );
	    $file->addChild( $doc->createAttribute("encoding", "base64") );
	    $file->appendText(encode_base64($files->{$key}));
	    $root->appendChild($file);
	}
    }

    if ($subtree) {
	$subtree->recreateNode($doc, $root);
    }

    my $ret = $doc->toString();
    log TRACE, $ret;
    return $ret;
}

sub master_launch
{
    my $args = shift;

    my @lnodes;
    my @warn;

    if ($args->{unamed})
    {
	for (my $i = $args->{unamed}; $i > 0; $i--)
	{
	    if (grep { $args->{param}{$i} eq $_ } @nodes) {
		push @lnodes, $args->{param}{$i};
	    } else {
		push @warn, $args->{param}{$i}." not a currently launched architecture.";
	    }
	}
    }
    else {
	@lnodes = @nodes;
    }

    log DEBUG, "Launching nodes...";

    my %ret;

    my $client = Gearman::Client->new;
    $client->job_servers('gearmand:4730');
    my $taskset = $client->new_task_set;
    for my $node (@lnodes)
    {
	log DEBUG, "Launching $node...";

	$taskset->add_task(
	    "guantanamo_".$node => build_task_xml($args->{files}, $args->{subtree}),
	    {
		on_complete => sub {
		    my $dom = XML::LibXML->load_xml(string => ${ $_[0] });
		    $ret{ $node } = $dom;
		}
	    });
    }
    $taskset->wait;

    if ($args->{subtree}->hasAttribute("output") && $args->{subtree}->getAttribute("output") eq "text")
    {
	my $output = "";

	for my $w (@warn) {
	    $output .= $w."\n";
	}

	for my $node (@lnodes) {
	    my @o = $ret{$node}->documentElement->getElementsByTagName("out");
	    if (@o) {
		$output .= $o[0]->firstChild->nodeValue;
	    }

	    my @e = $ret{$node}->documentElement->getElementsByTagName("err");
	    if (@e) {
		$output .= $e[0]->firstChild->nodeValue;
	    }
	    $output .= $e[0]->firstChild->nodeValue;
	}

	return $output;
    }
    else
    {
	my $doc = XML::LibXML::Document->new('1.0');
	my $root = $doc->createElement("process");
	$doc->setDocumentElement( $root );

	for my $w (@warn)
	{
	    my $warning = $doc->createElement("warning");
	    $warning->appendText($w);
	    $root->appendChild($warning);
	}

	for my $k (keys %ret)
	{
	    $root->appendChild($ret{ $k }->documentElement);
	}

	return $doc->toString();
    }
}

sub process_master
{
    my ($given_args, $args) = @_;

    my $action = $args->{param}{action} // "launch";

    if (! exists $master_actions{$action}) {
	log WARN, "Unknown action '$action' for guantanamo master process.";
    }
    return $master_actions{$action}($args);
}


log INFO, "Starting guantanamo.pl as master process";

Process::add_server("gearmand:4730");
Process::register("guantanamo", \&process_master);