view release on metacpan or  search on metacpan

lib/Net/SPID/SAML.pm  view on Meta::CPAN

package Net::SPID::SAML;
$Net::SPID::SAML::VERSION = '0.15';
use Moo;

use Carp;
use Crypt::OpenSSL::RSA;
use Crypt::OpenSSL::X509;
use File::Slurp qw(read_file);
use MIME::Base64 qw(decode_base64);
use Net::SPID::SAML::IdP;
use Net::SPID::SAML::In::LogoutRequest;
use Net::SPID::SAML::In::LogoutResponse;
use Net::SPID::SAML::In::Response;
use Net::SPID::SAML::Out::AuthnRequest;
use Net::SPID::SAML::Out::LogoutRequest;
use Net::SPID::SAML::Out::LogoutResponse;
use URI::Escape qw(uri_escape);
use XML::Writer;

has 'sp_entityid'   => (is => 'ro', required => 1);
has 'sp_key_file'   => (is => 'ro', required => 1);
has 'sp_cert_file'  => (is => 'ro', required => 1);
has 'sp_key'        => (is => 'lazy');
has 'sp_cert'       => (is => 'lazy');
has 'sp_assertionconsumerservice'   => (is => 'ro', required => 1);
has 'sp_singlelogoutservice'        => (is => 'ro', required => 1);
has 'sp_attributeconsumingservice'  => (is => 'ro', default => sub {[]});
has '_idp'          => (is => 'ro', default => sub { {} });

extends 'Net::SPID';

sub _build_sp_key {
    my ($self) = @_;
    
    my $key_string = read_file($self->sp_key_file);
    my $key = Crypt::OpenSSL::RSA->new_private_key($key_string);
    $key->use_sha256_hash;
    return $key;
}

sub _build_sp_cert {
    my ($self) = @_;
    
    return Crypt::OpenSSL::X509->new_from_file($self->sp_cert_file);
}

# TODO: generate the actual SPID button.
sub get_button {
    my ($self, $url_cb) = @_;
    
    # If $url_cb is a sprintf pattern, turn it into a callback.
    if (!ref $url_cb) {
        my $pattern = $url_cb;
        $url_cb = sub {
            sprintf $pattern, uri_escape(shift);
        };
    }
    
    my $html = '';
    foreach my $idp_id (sort keys %{$self->_idp}) {
        $html .= sprintf qq!<p><a class="btn btn-primary" href="%s">Login with SPID</a> <small>(%s)</small></p>\n!,
            $url_cb->($idp_id), $idp_id;
    }
    return $html;
}

sub load_idp_metadata {
    my ($self, $dir) = @_;
    
    $self->load_idp_from_xml_file($_) for glob "$dir/*.xml";
}

sub load_idp_from_xml_file {
    my ($self, $xml_file) = @_;
    
    # slurp XML from file
    my $xml = do { local $/ = undef; open my $fh, '<', $xml_file; scalar <$fh> };
    
    return $self->load_idp_from_xml($xml);
}

sub load_idp_from_xml {
    my ($self, $xml) = @_;
    
    my $idp = Net::SPID::SAML::IdP->new_from_xml(
        _spid   => $self,
        xml     => $xml,
    );
    $self->_idp->{$idp->entityID} = $idp;
    
    return 1;
}

sub idps {
    my ($self) = @_;