# Connector::Proxy::SOAP::Lite
#
# Proxy class for accessing SOAP servers
#
# Written by Martin Bartosch for the OpenXPKI project 2012
#
package Connector::Proxy::SOAP::Lite;

use strict;
use warnings;
use English;
use SOAP::Lite;
use Try::Tiny;
use Data::Dumper;

use Moose;
extends 'Connector::Proxy';

has uri => (
    is => 'rw',
    isa => 'Str',
    required => 1,
    );

has method => (
    is => 'rw',
    isa => 'Str',
    required => 1,
    );

has do_not_use_charset => (
    is => 'ro',
    isa => 'Bool',
    default => 0,
    );

has use_microsoft_dot_net_compatible_separator => (
    is => 'rw',
    isa => 'Bool',
    default => 0,
    );

# By default the SOAP call uses positional parameters. If this flag is set,
# the argument list to the call is interpreted as a Hash
has named_parameters => (
    is => 'rw',    
    isa => 'ArrayRef|Str|Undef',
    trigger => \&_convert_parameters,    
    );

has use_net_ssl => (
    is => 'rw',
    isa => 'Bool',
    default => 0,
    );

has ssl_ignore_hostname => (
    is => 'rw',
    isa => 'Bool',
    default => 0,
    );

has certificate_file => (
    is => 'rw',
    isa => 'Str',
    );

has certificate_key_file => (
    is => 'rw',
    isa => 'Str',
    );

has certificate_p12_file => (
    is => 'rw',
    isa => 'Str',
    );

has certificate_key_password => (
    is => 'rw',
    isa => 'Str',
    );

has ca_certificate_path => (
    is => 'rw',
    isa => 'Str',
    );
    
has ca_certificate_file => (
    is => 'rw',
    isa => 'Str',
    );    

sub BUILD {
    my $self = shift;
    if ($self->do_not_use_charset) {
	$SOAP::Constants::DO_NOT_USE_CHARSET = 1;
    }
}

# If named_parameters is set using a string (necessary atm for Config::Std)
# its converted to an arrayref. Might be removed if Config::* improves
# This might create indefinite loops if something goes wrong on the conversion!
sub _convert_parameters {
    my ( $self, $new, $old ) = @_;

    # Test if the given value is a non empty scalar
    if ($new && !ref $new && (!$old || $new ne $old)) {
        my @attrs = split(" ", $new);
        $self->named_parameters( \@attrs )
    }

}


sub _build_config {
    my $self = shift;
}


sub _soap_call {
    my $self = shift;

    my @args = $self->_build_path( shift );

    my $proxy = $self->LOCATION();

    my %ENV_BACKUP = %ENV;

    my $client = SOAP::Lite
        ->uri($self->uri);
        
    $self->log()->debug('Performing SOAP call to method ' . $self->method . ' on service ' . $self->uri . ' via ' . $proxy);
        
    # Force usage of net::ssl 
    if ($self->use_net_ssl()) {
        use Net::SSL;
        $ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS} = "Net::SSL";
    
        if ($self->certificate_p12_file) {
            $ENV{HTTPS_PKCS12_FILE}  = $self->certificate_p12_file;
            
            if ($self->certificate_key_file || $self->certificate_file) {
                die "Options certificate_file/certificate_key_file and certificate_p12_file are mutually exclusive";
            }
            
            if ($self->certificate_key_password) {
                $ENV{HTTPS_PKCS12_PASSWORD}  = $self->certificate_key_password;
            }
        }
    
        if ($self->certificate_key_file) {
            if ($self->certificate_key_password) {
                die "Net::SSL does not support password protected keys - use certificate_p12_file instead";     
            }
                        
            if (!$self->certificate_file) {
                die "You need to pass certificate AND key file, use certificate_p12_file to pass a PKCS12";
            }
            
            $ENV{HTTPS_KEY_FILE}  = $self->certificate_key_file;
            $ENV{HTTPS_CERT_FILE} = $self->certificate_file;                 
            
        } elsif ($self->certificate_file) {
            die "You need to pass certificate AND key file, use certificate_p12_file to pass a PKCS12";
        }
        
        if ($self->ca_certificate_path) {
            $ENV{HTTPS_CA_DIR} = $self->ca_certificate_path;
        }
        
        if ($self->ca_certificate_file) {
            $ENV{HTTPS_CA_FILE} = $self->ca_certificate_file;
        }
                
        $client->proxy($proxy); 
        
        $self->log()->trace('Using Net::SSL, EVN is' . Dumper $ENV);
        
    } # end of Net:SSL, IO::Socket::SSL
    elsif( $proxy =~ /^https:/i ) {
                
        use IO::Socket::SSL;
        $ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS} = "IO::Socket::SSL";
        
        my $ssl_opts = { 
            verify_hostname => ($self->ssl_ignore_hostname ? 0 : 1)
        };
        
        if ($self->certificate_p12_file) {
            die "Using pkcs12 containers is not supported by IO::Socket::SSL"
        }
        
        if ($self->certificate_key_file) {
            if (!$self->certificate_file) {
                die "You need to pass certificate AND key file";
            }
            $ssl_opts->{SSL_key_file}  = $self->certificate_key_file;            
            $ssl_opts->{SSL_cert_file}  = $self->certificate_file;    
            
            if ( $self->certificate_key_password ) {
                $ssl_opts->{SSL_passwd_cb} = sub { return $self->certificate_key_password; };
            }
            
        } elsif ($self->certificate_file) {
            die "You need to pass certificate AND key file";
        }
                  
        if ($self->ca_certificate_path) {	   
	        $ssl_opts->{SSL_ca_path}  = $self->ca_certificate_path;
        }
        
        if ($self->ca_certificate_file) {      
            $ssl_opts->{SSL_ca_file}  = $self->ca_certificate_file;
        }
        # For whatever reason LWP wants the ssl_opts as ARRAYref!    
        $client-> proxy($proxy, ssl_opts => [%{$ssl_opts}] );
                
        $self->log()->trace('Using IO::Socket::SSL with options ' . Dumper $ssl_opts);
    } else {
        # No ssl
        $client->proxy($proxy);         
    }
    
    if ($self->use_microsoft_dot_net_compatible_separator) {
        # This modifies the seperator used in the SOAPAction Header to add
        # the method to the uri. Default is # but .Net expects a slash.  
	    $client->on_action( sub { join('/', @_) } );
    }

    my @params;
    if (ref $self->named_parameters eq 'ARRAY' && scalar @{$self->named_parameters}) {
 	    foreach my $key (@{$self->named_parameters}) {
 	        my $value = shift @args;
 	        push @params, SOAP::Data->new(name => $key, value => $value );
	        $self->log()->debug('Named parameter: ' . $key . ' => ' . $value );
 	    }
    } else {
	   @params = @args;
	   $self->log()->debug('Parameters: ' . join(', ', @params));
    }


    my $som;
    eval {
        $som = $client->call($self->method, @params);
    };
    if ($@) {
	   $self->log()->error('SOAP call died: ' . $@);
	   die 'Fatal SOAP Error: ' . $@ . " [method=" . $self->method . ", params=(" . join(', ', @params) . ")]";
    }


    # restore environment
    %ENV = %ENV_BACKUP;

    if ($som->fault) {
	   $self->log()->error('SOAP call returned error: ' . $som->fault->{faultstring});
	   die $som->fault->{faultstring};
    }

    return $som->result;
}


sub get {
    my $self = shift;

    my $result = $self->_soap_call(@_);
    return if (! defined $result);

    if (ref $result ne '') {
	   die "SOAP call result is not a scalar";
    }
    return $result;
}

sub get_size {
    my $self = shift;

    my $result = $self->get_list(@_);
    return scalar @{$result};
}

sub get_list {
    my $self = shift;

    my $result = $self->_soap_call(@_);

    return if (! defined $result);

    if (ref $result ne 'ARRAY' ) {
        die "SOAP call result is not a list";
    }

    return @{$result};
}

sub get_keys {
    my $self = shift;

    my $result = $self->get_hash(@_);
    return keys %{$result};
}

sub get_hash {
    my $self = shift;

    my $result = $self->_soap_call(@_);

    return if (! defined $result);

    if (ref $result ne 'HASH' ) {
        die "SOAP call result is not a hash";
    }

    return $result;
}

sub get_meta {
    my $self = shift;
    # FIXME
    die "Sorry that is not supported, yet";
}

sub exists {

    my $self = shift;

    # FIXME
    die "Sorry that is not supported, yet";

}
no Moose;
__PACKAGE__->meta->make_immutable;

1;
__END__

=head 1 NAME

Connector::Proxy::SOAP::Lite

=head 1 DESCRIPTION

Make a SOAP call using the SOAP::Lite package. Use get if your SOAP call 
expects a scalar result or get_hash for a hashref. get_meta, get_list and 
set methods are not supported yet.    

=head1 USAGE

=head2 minimal setup

  Connector::Proxy::SOAP::Lite->new({
    LOCATION => 'https://127.0.0.1/soap',
    uri => 'http://schema.company.org/SOAP/Endpoint',
    method => 'GetInfo'
  });

=head2 additional options

=over 

=item do_not_use_charset 

Boolean, sets $SOAP::Constants::DO_NOT_USE_CHARSET = 1;

=item use_microsoft_dot_net_compatible_separator

Boolean, set the parameter seperator to "/" (forward slash)

=item named_parameters 

By default, the passed arguments are used as postional arguments in the
soap call. If you want to use a named parameter, set this to a list of names
used as keys with the passed parameters. If you pass a string, it is split
into a list a the whitespace character (usefull with Config::Std, etc).

=back

=head2 SSL support

This connector supports client authentication using certificates.  

=over 

=item use_net_ssl 

Set this to a true value to use Net::SSL as backend library (otherwise 
IO::Socket::SSL is used). Be aware the Net::SSL does not check the hostname
of the server certificate so Man-in-the-Middle-Attacks might be possible.
You should use this only with a really good reason or if you need support
for PKCS12 containers.

=item ssl_ignore_hostname

Do not validate the hostname of the server certificate (only useful with 
IO::Socket::SSL as Net::SSL does not check the hostname at all). 

=item certificate_file

Path to a PEM encoded certificate file.

=item certificate_key_file

Path to a PEM encoded key file.

=item certificate_p12_file 

Path to a PKCS12 container file. This is only supported by Net:SSL and can 
not be used together with certificate_file/certificate_key_file. 

=item certificate_key_password

The plain password of your encrypted key or PKCS12 container. Note that 
Net::SSL does not support password protected keys. You need to use a PKCS12
container instead! Leave this empty if your key is not protected by a password.

=item ca_certificate_path

Path to a directory with trusted certificates (with openssl hashed names).
Also used to validate the server certificate even if no client authentication
is used.

=item ca_certificate_file

Same as ca_certificate_path pointing to a single file.