# 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; use File::Basename; our $VERSION = "2.2"; # load client configuration my $lib = File::Basename::dirname(__FILE__); my $etc = "$lib/../etc"; my $conf_file = "$etc/warden-client.conf"; loadConf($conf_file); #------------------------------------------------------------------------------- # 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; 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: " . $@); # setting of connection timeout eval {$client->timeout($WardenClientCommon::CONNECTION_TIMEOUT);} or return errMsg("Error in function 'c2s()' when setting connection timeout: " . $@); # 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: " . $@); # 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: " . $@); # 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: " . $@); } else { eval { $envelope = $soap->serializer->envelope(method => $method, $data); } or return errMsg("Error in function 'c2s()' when serializing envelope and data: " . $@); } # 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: " . $@); # 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: " . $@ . " (Received response: " . $result . ")"); # check SOAP fault status $response->fault ? return errMsg("Server sent error message:: " . $response->faultstring) : return $response; } } #------------------------------------------------------------------------------- # getClientInfo - retrieve information about other clients from Warden server #------------------------------------------------------------------------------- sub getClientInfo { # obtain information about clients on Warden server my $response = c2s($WardenClientCommon::URI, $WardenClientCommon::SSL_KEY, $WardenClientCommon::SSL_CERT, $WardenClientCommon::SSL_CA_CERT, "getClientInfo"); defined $response or return; # receive data or return undef # parse server response (SOAP data object) my @clients; 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 (@clients,\%client); } return @clients; } # End of getClientInfo #------------------------------------------------------------------------------- # loadConf - load configuration file #------------------------------------------------------------------------------- sub loadConf { my $conf_file = shift; our $BASEDIR = undef; 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': $@") if $@; die("Can't read config file '$conf_file': $!") unless defined $_; # if $_ defined, it's retvalue of last statement of conf, for which we don't care } } # End of loadConf 1;