WardenClientCommon.pm

# WardenClientCommon.pm
#
# Copyright (C) 2011-2015 Cesnet z.s.p.o
#
# Use of this source is governed by a BSD-style license, see LICENSE file.

package WardenClientCommon;

use strict;
use warnings;

use SOAP::Lite;
use IO::Socket::SSL qw(debug1);
use SOAP::Transport::HTTP;
use Sys::Syslog qw(:DEFAULT setlogsock);
Sys::Syslog::setlogsock('unix');
use Carp;

our $VERSION = "2.2";


#-------------------------------------------------------------------------------
# trim - remove whitespace from the start and end of the string
#-------------------------------------------------------------------------------
sub trim
{
  my $string = shift;
  $string =~ s/^\s+//;
  $string =~ s/\s+$//;
  return $string;
} # End of trim


#-------------------------------------------------------------------------------
# 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

  # check verbose logging
  if (($type eq "err") && ($WardenClientCommon::LOG_VERBOSE)) {
    $msg .= "\nStack info: " . Carp::longmess();
  }

  # check logging into STDERR
  if ($WardenClientCommon::LOG_STDERR) {
    print STDERR $msg . "\n";
  }

  # check logging into Syslog
  if ($WardenClientCommon::SYSLOG) {
    openlog("Warden-client:", "pid", "$WardenClientCommon::SYSLOG_FACILITY");
    syslog("$type|$WardenClientCommon::SYSLOG_FACILITY", $msg . "\n");
    closelog();
  }

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


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

  my $client;
  # parse service URI
  my ($server, $port, $service) = $WardenClientCommon::URI =~ /https:\/\/(.+)\:(\d+)\/(.+)/;

  # create SOAP::Transport::HTTP:Client object
  eval {
    $client = SOAP::Transport::HTTP::Client->new();
  } or return errMsg("Error in function 'c2s()' when creating SOAP::Transport::HTTP::Client object: " . trim($@));

  # setting of connection timeout
  eval {$client->timeout($WardenClientCommon::CONNECTION_TIMEOUT);}
  or return errMsg("Error in function 'c2s()' when setting connection timeout: " . trim($@));

  # setting of SSL options
  eval {
    $client->ssl_opts(verify_hostname   => 1,
                    SSL_use_cert        => 1,
                    SSL_verify_mode     => 0x03,
                    SSL_key_file        => $WardenClientCommon::SSL_KEY,
                    SSL_cert_file       => $WardenClientCommon::SSL_CERT,
                    SSL_ca_file         => $WardenClientCommon::SSL_CA_CERT);
    return 1; # fix of eval triggering 'or' statement
  } or return errMsg("Ërror in function 'c2s()' when setting SSL options: " . trim($@));

  # setting of service URI
  my $soap;
  eval {
    $soap = SOAP::Lite->uri($service)->proxy($WardenClientCommon::URI);
  } or return errMsg("Error in function 'c2s()' when setting service URI: " . trim($@));

  # serialize SOAP envelope or SOAP envelope and data object
  my $envelope;
  if (!defined $data) {
    eval {
      $envelope = $soap->serializer->envelope(method => $method);
    } or return errMsg("Error in function 'c2s()' when serializing envelope: " . trim($@));
  } else {
    eval {
      $envelope = $soap->serializer->envelope(method => $method, $data);
    } or return errMsg("Error in function 'c2s()' when serializing envelope and data: " . trim($@));
  }

  # setting of complete HTTPs 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("Error in function 'c2s()' when sending SOAP envelope and data: " . trim($@));

  # check server response
  if (!defined $result) {
    errMsg("Server returned empty response. Problem with used SSL ceritificate/key or Warden server at $server:$port is down.");
  } else {
    # deserialized response from server to SOAP data object
    my $response;
    eval {
      $response = $soap->deserializer->deserialize($result);
    } or return errMsg("Error in deserialization of server response: " . trim($@) . "\nReceived response: " . trim($result));
    # check SOAP fault status
    $response->fault ? return errMsg("Server sent error message: " . trim($response->faultstring)) : return $response;
  }
}


#-------------------------------------------------------------------------------
# loadConf - load configuration file
#-------------------------------------------------------------------------------
sub loadConf
{
  my $conf_file = shift;

  our $URI                  = undef;
  our $SSL_KEY              = undef;
  our $SSL_CERT             = undef;
  our $SSL_CA_CERT          = undef;
  our $MAX_RCV_EVENTS_LIMIT = undef;
  our $CONNECTION_TIMEOUT   = undef;
  our $LOG_STDERR           = undef;
  our $LOG_VERBOSE          = undef;
  our $SYSLOG               = undef;
  our $SYSLOG_FACILITY      = undef;

  unless (do $conf_file) {
    die("Errors in config file '$conf_file': " . trim($@)) if $@;
    die("Can't read config file '$conf_file': " . trim($!)) unless defined $_;
    # if $_ defined, it's retvalue of last statement of conf, for which we don't care
  }
} # End of loadConf

1;