view release on metacpan or  search on metacpan

lib/Mojo/SAML/Entity.pm  view on Meta::CPAN

package Mojo::SAML::Entity;

use Mojo::Base -base;

use Mojo::XMLSig;
use Mojo::SAML::Names;

use Carp ();
use Mojo::DOM;
use Mojo::File;
use Mojo::UserAgent;
use Mojo::Util;
use Mojo::URL;
use Scalar::Util ();

my $isa = sub {
  my ($obj, $class) = @_;
  Scalar::Util::blessed($obj) && $obj->isa($class);
};
my %ns = (
  md => 'urn:oasis:names:tc:SAML:2.0:metadata',
  ds => 'http://www.w3.org/2000/09/xmldsig#',
);
my %uses = (
  encryption => 1,
  signing    => 1,
);

has entity_id => sub {
  my $dom = shift->metadata;
  my $desc = $dom->find('md|EntityDescriptor[entityID]', %ns);
  Carp::croak 'Multiple EntityDescriptor elements found' if $desc->size > 1;
  Carp::croak 'No EntityDescriptor elements found' if $desc->size < 1;
  return $desc->[0]->{entityID};
};
has role_type => sub { Carp::croak 'role_type is required' };
has metadata => sub { Carp::croak 'metadata is required' };
has ua => sub { Mojo::UserAgent->new };

sub certificate_for {
  my ($self, $use) = @_;
  my $attr = ':not([use])';
  if (defined $use) {
    Carp::croak "Unknown certificate use $use" unless exists $uses{$use};
    if ($Mojolicious::VERSION >= 8.42) {
      $attr = qq!:is([use="$use"], $attr)!;
    } else {
      $attr = qq!:matches([use="$use"], $attr)!;
    }
  }
  require Crypt::OpenSSL::X509;
  my $s = qq!md|KeyDescriptor$attr > ds|KeyInfo > ds|X509Data > ds|X509Certificate!;
  return undef unless my $elem = $self->role->at($s, %ns);
  my $cert = Mojo::XMLSig::format_cert($elem->text);
  return Crypt::OpenSSL::X509->new_from_string($cert);
}

sub default_id_format {
  my $self = shift;
  my $formats = $self->_formats;
  return $formats->[0];
}

sub entity {
  my $self = shift;
  my $id = Mojo::Util::xml_escape $self->entity_id;
  return $self->metadata->at(qq<EntityDescriptor[entityID="$id"]>) // Carp::croak 'EntityDescriptor not found';
}

sub from {
  my ($self, $arg) = @_;
  my $method = $arg =~ m{^https?://} ? 'from_url' :
               $arg =~ m{\s*<}       ? 'from_xml' :
                                       'from_file';
  return $self->$method($arg);
}

sub from_file {
  my ($self, $file) = @_;
  $file = Mojo::File->new("$file")
    unless $file->$isa('Mojo::File');
  return $self->from_xml(Mojo::Util::decode 'UTF-8', $file->slurp);