view release on metacpan or  search on metacpan

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

        $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);


    # Look for the SAML Response Subject payload in a signed section

    my $transport_prefix =  $binding eq 'http_post'
        ? '/samlp:Response'
        : '/soap11:Envelope/soap11:Body/samlp:ArtifactResponse/samlp:Response';

    my $encrypted_prefix = $encrypted
        ? '/saml:EncryptedAssertion'
        : '';

    my $subj_xpath = $transport_prefix . $encrypted_prefix
        . '/saml:Assertion/saml:Subject';
    my($subject) = $verifier->find_verified_element($xc, $subj_xpath);
    my $assertion = $subject->parentNode();


    # Confirm that subject is valid for our SP

    $self->_check_subject_confirmation($xc, $subject, $request_id);


    # Check that it was generated by the expected IdP

    my $idp_entity_id = $idp->entity_id;
    my $from_sp = $xc->findvalue('./saml:NameID/@NameQualifier', $subject) || '';
    die "SAML assertion created by '$from_sp', expected '$idp_entity_id'. Assertion follows:\n$xml\n"
        if $from_sp ne $idp_entity_id;


    # Check that it's intended for our SP

    if($self->type eq 'login') {  # Not provided by assertion IdP
        my $sp_entity_id  = $self->entity_id;
        my $for_sp = $xc->findvalue('./saml:NameID/@SPNameQualifier', $subject) || '';
        die "SAML assertion created for '$for_sp', expected '$sp_entity_id'\n$xml\n"