WardenClientCommon.pm

#!/usr/bin/perl -w
#
# WardenClientCommon.pm
#
# Copyright (C) 2011-2012 Cesnet z.s.p.o
#
# Use of this source is governed by a BSD-style license, see LICENSE file.

package WardenClientCommon;

use strict;
use Carp;
use SOAP::Lite;
use IO::Socket::SSL qw(debug1);
use SOAP::Transport::HTTP;

our $VERSION = "2.2";

#-------------------------------------------------------------------------------
# errMsg - prints error msg and returns undef or prints warning and returns 1
#-------------------------------------------------------------------------------
sub errMsg
{
  my $msg = shift;
  my $type = shift; 
  defined $type or $type = "err"; # default type is err. Other: warn
  
  # is this error report and is Verbose logging mode enabled?
  if (($type eq "err") && ($WardenClientConf::LOG_VERBOSE)) { # user wants to log debug information
    $msg .= "\nStack info: " . Carp::longmess();
  }

  # log into STDERR?
  if ($WardenClientConf::LOG_STDERR) {
    print STDERR $msg . "\n";
  }

  # log into Syslog?
  if ($WardenClientConf::LOG_SYSLOG) {
    openlog("Warden-client:", "pid", "$WardenClientConf::LOG_SYSLOG_FACILITY");
    syslog("$type|$WardenClientConf::LOG_SYSLOG_FACILITY", $msg . "\n");
    closelog();
  }

  if ($type eq 'warn') { # case of 'warn'
    return 1;
  } else { # case of 'err'
    return;
  }

} # End of errMsg


#-------------------------------------------------------------------------------
# c2s - connect to server, send request and receive response
#-------------------------------------------------------------------------------
sub c2s
{
  my $uri               = shift;
  my $ssl_key_file      = shift;
  my $ssl_cert_file     = shift;
  my $ssl_ca_file       = shift;
  my $method            = shift;
  my $data              = shift;

  my $client;
  my ($server, $port, $service) = $uri =~ /https:\/\/(.+)\:(\d+)\/(.+)/;
  eval {
    $client = SOAP::Transport::HTTP::Client->new();
  } or return errMsg('Unknown error in c2s() when creating socket, SOAP::Transport::HTTP::Client->new(), ' . $@);
 
  eval {$client->timeout($WardenClientConf::CONNECTION_TIMEOUT);}
  or return errMsg('Unknown error in c2s() when setting socket timeout, ' . $@);

  eval {
    $client->ssl_opts(verify_hostname   => 1,
                    SSL_use_cert        => 1,
                    SSL_verify_mode     => 0x02,
                    SSL_key_file        => $ssl_key_file,
                    SSL_cert_file       => $ssl_cert_file,
                    SSL_ca_file         => $ssl_ca_file);
    return 1; # fix of eval triggering 'or' statement
  } or return errMsg('Unknown error in c2s() when setting socket SSL options, ' . $@);

  # setting of URI and serialize SOAP envelope and data object
  
  my $soap;
  eval {
    $soap = SOAP::Lite->uri($service)->proxy($uri);
  } or return errMsg('Unknown error in c2s() when serializing SOAP object, ' . $@);
  
  my $envelope;
  if (!defined $data) {
    eval {
      $envelope = $soap->serializer->envelope(method => $method);
    } or return errMsg('Unknown error in c2s() when setting enevelope, ' . $@);
  } else {
    eval {
      $envelope = $soap->serializer->envelope(method => $method, $data);
    } or return errMsg('Unknown error in c2s() when setting envelope, ' . $@);
  }

  # setting of TCP URI and send serialized SOAP envelope and data
  my $server_uri = "https://$server:$port/$service";
  my $result;
  eval {
    $result = $client->send_receive(envelope => $envelope, endpoint => $server_uri);
  } or return errMsg('Unknown error in c2s() sending SOAP data, ' . $@);

  # check server response
  if (!defined $result) {
    errMsg("Server returned empty response. Problem with used SSL ceritificates or Warden server at $server:$port is down.");
  } else {
    # deserialized response from server -> create SOAP envelope and data object
    
    my $response;

    eval {
      $response = $soap->deserializer->deserialize($result);
    } or return errMsg('Unknown error in SOAP data deserialization. Received data: ' . $result . ', ' . $@);
    # check SOAP fault status
    $response->fault ? return errMsg("Server sent error message:: " . $response->faultstring) : return $response;
  }
}

#-------------------------------------------------------------------------------
# getClientsInfo - retrieve information about other clients from Warden server
#-------------------------------------------------------------------------------
sub getClientsInfo 
{
  my $warden_path = shift;

  my $etcdir = $warden_path . "/etc/";
  my $libdir = $warden_path . "/lib/";

  require $libdir . "WardenClientConf.pm";

  # read the config file
  my $conf_file = $etcdir . "warden-client.conf";
  WardenClientConf::loadConf($conf_file);

  # c2s() returns undef on fail
  my $response = c2s($WardenClientConf::URI, $WardenClientConf::SSL_KEY_FILE, $WardenClientConf::SSL_CERT_FILE, $WardenClientConf::SSL_CA_FILE, "getClientInfo");
  
  defined $response or return; # receive data or return undef     

  # parse returned SOAP data object with clients
  my @clients;
  my ($client_id, $hostname, $registered, $requestor, $service, $client_type, $type, $receive_own_events, $description_tags, $ip_net_client);
  my @response_list = $response->valueof('/Envelope/Body/getClientInfoResponse/client/');

  while (scalar @response_list) {
    my $response_data = shift(@response_list);
    my %client;

    $client{'client_id'}		= $response_data->{'CLIENT_ID'} ;
    $client{'hostname'}			= $response_data->{'HOSTNAME'};
    $client{'registered'}		= $response_data->{'REGISTERED'};
    $client{'requestor'}		= $response_data->{'REQUESTOR'};
    $client{'service'}	 		= $response_data->{'SERVICE'};
    $client{'client_type'}		= $response_data->{'CLIENT_TYPE'};
    $client{'type'}			= $response_data->{'TYPE'};
    $client{'receive_own_events'}	= $response_data->{'RECEIVE_OWN_EVENTS'};
    $client{'description_tags'}		= $response_data->{'DESCRIPTION_TAGS'};
    $client{'ip_net_client'}		= $response_data->{'IP_NET_CLIENT'};

    # push received clients from warden server into @clients which is returned
    push (@clients,\%client);
  }

  return @clients;
}

1;