view release on metacpan or  search on metacpan

lib/Authen/NZRealMe/ServiceProvider.pm  view on Meta::CPAN

package Authen::NZRealMe::ServiceProvider;
$Authen::NZRealMe::ServiceProvider::VERSION = '1.23';
use strict;
use warnings;
use autodie;

require XML::LibXML;
require XML::LibXML::XPathContext;
require XML::Generator;
require Crypt::OpenSSL::X509;
require HTTP::Response;

use URI::Escape  qw(uri_escape uri_unescape);
use POSIX        qw(strftime);
use Date::Parse  qw();
use File::Spec   qw();
use JSON::XS     qw();
use MIME::Base64 qw();

use Authen::NZRealMe::CommonURIs qw(URI NS_PAIR);
use Authen::NZRealMe::Asserts    qw(assert_is_base64);

use WWW::Curl::Easy qw(
    CURLOPT_URL
    CURLOPT_POST
    CURLOPT_HTTPHEADER
    CURLOPT_POSTFIELDS
    CURLOPT_SSLCERT
    CURLOPT_SSLKEY
    CURLOPT_SSL_VERIFYPEER
    CURLOPT_WRITEDATA
    CURLOPT_WRITEHEADER
    CURLOPT_CAPATH
);

use constant DATETIME_BEFORE => -1;
use constant DATETIME_EQUAL  => 0;
use constant DATETIME_AFTER  => 1;


my %metadata_cache;
my $signing_cert_filename = 'sp-sign-crt.pem';
my $signing_key_filename  = 'sp-sign-key.pem';
my $ssl_cert_filename     = 'sp-ssl-crt.pem';
my $ssl_key_filename      = 'sp-ssl-key.pem';
my $icms_wsdl_filename    = 'metadata-icms.wsdl';
my $ca_cert_directory     = 'ca-certs';

my $ns_samlmd     = [ NS_PAIR('samlmd') ];
my $ns_ds         = [ NS_PAIR('ds') ];
my $ns_saml       = [ NS_PAIR('saml') ];
my $ns_samlp      = [ NS_PAIR('samlp') ];
my $ns_soap11     = [ NS_PAIR('soap11') ];
my $ns_xenc       = [ NS_PAIR('xenc') ];
my $ns_xpil       = [ NS_PAIR('xpil') ];
my $ns_xal        = [ NS_PAIR('xal') ];
my $ns_xnl        = [ NS_PAIR('xnl') ];
my $ns_ct         = [ NS_PAIR('ct') ];
my $ns_soap12     = [ NS_PAIR('soap12') ];
my $ns_wsse       = [ NS_PAIR('wsse') ];
my $ns_wsu        = [ NS_PAIR('wsu') ];
my $ns_wst        = [ NS_PAIR('wst') ];
my $ns_wsa        = [ NS_PAIR('wsa') ];
my $ns_ec14n      = [ NS_PAIR('ec14n') ];
my $ns_icms       = [ NS_PAIR('icms') ];
my $ns_wsdl       = [ NS_PAIR('wsdl') ];
my $ns_wsdl_soap  = [ NS_PAIR('wsdl_soap') ];
my $ns_wsam       = [ NS_PAIR('wsam') ];

my @ivs_namespaces  = ( $ns_xpil, $ns_xnl, $ns_ct, $ns_xal );
my @avs_namespaces  = ( $ns_xpil, $ns_xal );
my @icms_namespaces = ( $ns_ds, $ns_saml, $ns_icms, $ns_wsse, $ns_wsu, $ns_wst, $ns_soap12  );
my @wsdl_namespaces = ( $ns_wsdl, $ns_wsdl_soap, $ns_wsam );

my %urn_attr_name = (
    fit         => 'urn:nzl:govt:ict:stds:authn:attribute:igovt:IVS:FIT',
    ivsx        => 'urn:nzl:govt:ict:stds:authn:safeb64:attribute:igovt:IVS:Assertion:Identity',
    ivs         => 'urn:nzl:govt:ict:stds:authn:safeb64:attribute:igovt:IVS:Assertion:JSON:Identity',
    avs         => 'urn:nzl:govt:ict:stds:authn:safeb64:attribute:NZPost:AVS:Assertion:Address',
    icms_token  => 'urn:nzl:govt:ict:stds:authn:safeb64:attribute:opaque_token',
);

my $soap_action = 'http://www.oasis-open.org/committees/security';


sub new {
    my $class = shift;

    my $self = bless {
        type                     => 'login',
        skip_signature_check     => 0,
        @_

lib/Authen/NZRealMe/ServiceProvider.pm  view on Meta::CPAN

    if($args{_to_file_}) {
        # Add a -icms suffix so we don't overwrite the SAML response file
        my $icms_file = $args{_to_file_};
        $icms_file =~ s{([.]\w+|)$}{-icms$1};
        $self->_write_file($icms_file, $content);
    }

    my $flt = $self->_extract_flt($content);
    $idp_response->set_flt($flt);
}

sub _extract_flt {
    my($self, $xml, %args) = @_;

    # We have a SAML assertion in the SOAP body, make sure it's signed.
    # The assertion comes from the login IDP so use that cert to check.
    my $idp = $self->idp;
    my $verifier;
    eval {
        $verifier = Authen::NZRealMe->class_for('xml_signer')->new(
            pub_cert_text => $idp->login_cert_pem_data(),
        );
        $verifier->verify($xml, '//soap12:Body//ds:Signature', NS_PAIR('soap12'), NS_PAIR('ds'));
    };
    if($@) {
        die "Failed to verify signature on assertion from IdP:\n  $@\n$xml";
    }
    my $xc = $self->_xpath_context_dom($xml, @icms_namespaces);
    my($flt) = $verifier->find_verified_element(
        $xc,
        q{/soap12:Envelope/soap12:Body/wst:RequestSecurityTokenResponse/wst:RequestedSecurityToken/saml:Assertion/saml:Subject/saml:NameID}
    ) or die "Unable to find FLT in iCMS response: $xml\n";
    return $flt->to_literal;
}

sub _https_post {
    my($self, $url, $headers, $body) = @_;

    my $curl = new WWW::Curl::Easy;

    $curl->setopt(CURLOPT_URL,        $url);
    $curl->setopt(CURLOPT_POST,       1);
    $curl->setopt(CURLOPT_HTTPHEADER, $headers);
    $curl->setopt(CURLOPT_POSTFIELDS, $body);
    $curl->setopt(CURLOPT_SSLCERT,    $self->ssl_cert_pathname);
    $curl->setopt(CURLOPT_SSLKEY,     $self->ssl_key_pathname);

    if ($self->{disable_ssl_verify}){
        $curl->setopt(CURLOPT_SSL_VERIFYPEER, 0);
    }
    else {
        $curl->setopt(CURLOPT_SSL_VERIFYPEER, 1);
        $curl->setopt(CURLOPT_CAPATH, $self->ca_cert_pathname);
    }

    my($resp_body, $resp_head);
    open (my $body_fh, ">", \$resp_body);
    $curl->setopt(CURLOPT_WRITEDATA, $body_fh);
    open (my $head_fh, ">", \$resp_head);
    $curl->setopt(CURLOPT_WRITEHEADER, $head_fh);

    my $resp;
    my $retcode = $curl->perform;
    if($retcode == 0) {
        $resp_head =~ s/\A(?:HTTP\/1\.1\s+200\s+Connection\s+established).*?\r?\n\r?\n//is; # Remove any '200' response from a proxy
        $resp_head =~ s/\A(?:HTTP\/1\.1 100 Continue)?[\r\n]*//; # Remove any '100' responses and/or leading newlines
        my($status, @head_lines) = split(/\r?\n/, $resp_head);
        my($protocol, $code, $message) = split /\s+/, $status, 3;
        my $headers = [ map { split /:\s+/, $_, 2 } @head_lines];
        $resp = HTTP::Response->new($code, $message, $headers, $resp_body);
    }
    else {
        $resp = HTTP::Response->new(
            500, 'Error', [], $curl->strerror($retcode)." ($retcode)\n"
        );
    }

    return $resp;
}


sub _verify_assertion {
    my($self, $xml, %args) = @_;

    my $request_id = $args{request_id}
        or die "Can't resolve to assertion without original request ID\n";

    my $binding = $args{saml_response} ? 'http_post' : 'http_artifact';

    my @ns_prefs = ($ns_soap11, $ns_saml, $ns_samlp, $ns_xenc);
    my $xc = $self->_xpath_context_dom($xml, @ns_prefs);

    my $encrypted = $binding eq 'http_post';
    if($xc->findnodes('//saml:EncryptedAssertion/xenc:EncryptedData')) {
        $encrypted = 1;
        $xml = $self->decrypt_assertion($xml);
        $xc = $self->_xpath_context_dom($xml, @ns_prefs);
    }

    # Check for SOAP error

    if($binding eq 'http_artifact') {
        if(my($error) = $xc->findnodes('//soap11:Fault')) {
            my $code   = $xc->findvalue('./faultcode',   $error) || 'Unknown';
            my $string = $xc->findvalue('./faultstring', $error) || 'Unknown';
            die "SOAP protocol error:\n  Fault Code: $code\n  Fault String: $string\n";
        }
    }


    # Extract the SAML result code

    my $response = $self->_build_resolution_response($xc, $xml, $binding);
    return $response if $response->is_error;


    # Make sure the response payload is signed

    my $idp  = $self->idp;
    my $verifier = $self->_verify_assertion_signature($idp, $xml);