view release on metacpan or  search on metacpan

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

    my $str = $index eq 'default' ? qq{isDefault="true"} : qq{index="$index"};
    die qq{Unable to find <AssertionConsumerService> with $str}
        unless @match;

    my $count = @match;
    die qq{$count <AssertionConsumerService> elements have $str}
        unless $count == 1;
    return $match[0];
}


sub new_request {
    my $self = shift;

    my %opt = @_;
    my $acs = $self->select_acs_by_index($opt{acs_index});
    $opt{acs_index} = $acs->{index};
    my $req = Authen::NZRealMe->class_for('authen_request')->new($self, %opt);
    return $req;
}


sub _signing_cert_pem_data {
    my $self = shift;

    return $self->{signing_cert_pem_data} if $self->{signing_cert_pem_data};

    my $path = $self->signing_cert_pathname
        or die "No path to signing certificate file";

    my $cert_data = $self->_read_file($path);

    $cert_data =~ s{\r\n}{\n}g;
    $cert_data =~ s{\A.*?^-+BEGIN CERTIFICATE-+\n}{}sm;
    $cert_data =~ s{^-+END CERTIFICATE-+\n?.*\z}{}sm;

    return $cert_data;
}


sub metadata_xml {
    my $self = shift;

    return $self->_to_xml_string();
}


sub _sign_xml {
    my $self      = shift;
    my $algorithm = shift;
    my %options;
    $options{algorithm} = 'algorithm_' . $algorithm if $algorithm;
    my $signer = $self->_signer(%options);
    return $signer->sign(@_);
}


sub sign_query_string {
    my($self, $qs) = @_;

    $qs .= '&SigAlg=http%3A%2F%2Fwww.w3.org%2F2000%2F09%2Fxmldsig%23rsa-sha1';

    my $signer = $self->_signer(signature_algorithm => 'rsa_sha1');

    my $sig = $signer->create_detached_signature($qs, '');

    return $qs . '&Signature=' . uri_escape( $sig );
}


sub _signer {
    my($self, %options) = @_;

    my $key_path = $self->signing_key_pathname
        or die "No path to signing key file";

    return Authen::NZRealMe->class_for('xml_signer')->new(
        pub_cert_file => $self->signing_cert_pathname,
        key_file      => $key_path,
        %options,
    );
}


sub _encrypter {
    my($self, %options) = @_;

    my $key_path = $self->signing_key_pathname
        or die "No path to signing key file";

    return Authen::NZRealMe->class_for('xml_encrypter')->new(
        pub_cert_file => $self->signing_cert_pathname,
        key_file      => $key_path,
        %options,
    );
}


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

    my $post_param = $args{saml_response}
        or die "No saml_response value was supplied to resolve_posted_assertion()";

    $post_param =~ s/\s+//g;

    assert_is_base64($post_param, '$args{saml_response}');
    my $xml = MIME::Base64::decode_base64($post_param);
    $xml = $self->decrypt_assertion($xml);

    my $response = $self->_verify_assertion($xml, %args);

    if($response->is_success) {
        if($self->type eq 'assertion' and $self->nameid_format ne URI('saml_nameid_format_persistent')) {
             $self->_resolve_flt($response, %args) if $args{resolve_flt};
        }
    }

    return $response;
}