Skip to content
Snippets Groups Projects
Forked from 713 / Warden / Warden - archive
959 commits behind the upstream repository.
WardenClientSend.pm 5.42 KiB
#!/usr/bin/perl -w
#
# WardenClientSend.pm
#
# Copyright (C) 2011-2012 Cesnet z.s.p.o
# Author(s):	Tomas PLESNIK	<plesnik@ics.muni.cz>
#		Jan SOUKAL	<soukal@ics.muni.cz>
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in
#    the documentation and/or other materials provided with the
#    distribution.
# 3. Neither the name of the Cesnet z.s.p.o nor the names of its
#    contributors may be used to endorse or promote products derived from
#    this software without specific prior written permission.
#
# This software is provided ``as is'', and any express or implied
# warranties, including, but not limited to, the implied warranties of
# merchantability and fitness for a particular purpose are disclaimed.
# In no event shall the Cesnet z.s.p.o or contributors be liable for
# any direct, indirect, incidental, special, exemplary, or consequential
# damages (including, but not limited to, procurement of substitute
# goods or services; loss of use, data, or profits; or business
# interruption) however caused and on any theory of liability, whether
# in contract, strict liability, or tort (including negligence or
# otherwise) arising in any way out of the use of this software, even
# if advised of the possibility of such damage.

package WardenClientSend;

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

our $VERSION = "1.1";


#-------------------------------------------------------------------------------
# errMsg - print error message and die
#-------------------------------------------------------------------------------
sub errMsg
{
  my $msg = shift;
  die($msg . "\n");
} # 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+)\/(.+)/;
  if (!($client = SOAP::Transport::TCP::Client->new(
    PeerAddr            => $server,
    PeerPort            => $port,