#!/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"; #------------------------------------------------------------------------------- # warnMsg - prints warning (to STDERR and/or Syslog) and returns 1 #------------------------------------------------------------------------------- sub warnMsg { my $msg = shift; # print warning to STDERR? if ($WardenClientConf::LOG_STDERR) { print STDERR $msg . "\n"; } # print warning to Syslog? if ($WardenClientConf::LOG_SYSLOG) { openlog("Warden-client:", "pid", "$WardenClientConf::LOG_SYSLOG_FACILITY"); syslog("warn|$WardenClientConf::LOG_SYSLOG_FACILITY", $msg . "\n"); closelog(); } return 1; } # end of warnMsg() #------------------------------------------------------------------------------- # errMsg - print error message and returns undef #------------------------------------------------------------------------------- sub errMsg { my $msg = shift; # is Verbose logging mode enabled? if ($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("err|$WardenClientConf::LOG_SYSLOG_FACILITY", $msg . "\n"); closelog(); } 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(10);} 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; } }