SAMLMetadata.pm

package IdPAccountManager::SAMLMetadata; 

use strict;

use IdPAccountManager::Tools;
use Conf;

use XML::LibXML;

require Exporter;
my @ISA = qw(Exporter);
my @EXPORT = qw();

use Carp;

sub new {
    my ($pkg) = shift;
    my %args = @_;

    my $self = {};

    ## Bless SAMLMetadata object
    bless $self, $pkg;
        
    return $self;
}

## Load metadata
sub load {
    my $self = shift;
    my %in = @_;
    
    unless ($in{'federation_metadata_file_path'}) {
        &IdPAccountManager::Tools::do_log('error', "Missing parameter 'federation_metadata_file_path'");
        return undef;
    }
   
    $self->{'federation_metadata_file_path'} = $in{'federation_metadata_file_path'};
    
    unless (-r $self->{'federation_metadata_file_path'}) {
        &IdPAccountManager::Tools::do_log('error', "Failed to read $in{'federation_metadata_file_path'} : $!");
        return undef;
    }
    
  unless ($self->{'federation_metadata_as_xml'} = &_get_xml_object($in{'federation_metadata_file_path'})) {
      &IdPAccountManager::Tools::do_log('error', "Failed to parse file $in{'metadata_file'} : $!");
      return undef;
  }
  
  my $root = $self->{'federation_metadata_as_xml'}->documentElement();
  unless ($root->nodeName() =~ /EntitiesDescriptor$/) {
        &IdPAccountManager::Tools::do_log('error', "Root element of file $in{'federation_metadata_file_path'} is of type '%s'; should be 'EntitiesDescriptor'",
                                          $root->nodeName());
        return undef;
  }
  
    return 1;
}

## Parse XML structure of metadata to fill a hashref
sub parse {
    my $self = shift;
    my %options = @_;
    
    my %parser_args = ('metadata_as_xml' => $self->{'federation_metadata_as_xml'},
                        'filter_entity_type' => 'sp');
    
    if ($options{'filter_entity_id'}) {
        $parser_args{'filter_entity_id'} = $options{'filter_entity_id'};
    }
    
    $self->{'federation_metadata_as_hashref'} = &_parse_saml_metadata(%parser_args);
    unless (defined $self->{'federation_metadata_as_hashref'}) {
        &IdPAccountManager::Tools::do_log('error', "Failed to parse federation metadata");
        return undef;
    }
    
    return 1;
}

## Print the content of a test account
sub print {
    my $self = shift;
    my $fd = shift || \*STDOUT;
    
    my $root = $self->{'federation_metadata_as_xml'}->documentElement();
    print $fd $root->toString();

    return 1.
}

## Internal function
## returns a Lib::XML représenting an XML file
sub _get_xml_object {
    my $metadata_file = shift;
    &IdPAccountManager::Tools::do_log('debug', "");

    unless (-f $metadata_file) {
	&IdPAccountManager::Tools::do_log('error', "File $metadata_file not found: $!");
	return undef;
    }
    
    unless (open FH,  $metadata_file) {
	&IdPAccountManager::Tools::do_log('error', "Failed to open file $metadata_file: $!");
	return undef;
    }
    
    my $parser;
    unless ($parser = XML::LibXML->new()) {
	&IdPAccountManager::Tools::do_log('error', "Failed to initialize XML parser");
	return undef;
    }
    
    $parser->line_numbers(1);
    my $doc;

    ## Eval() prevents the parsing from killing the main process
    eval {$doc = $parser->parse_fh(\*FH)};
    if ($@) {
	&IdPAccountManager::Tools::do_log('error', "Failed to parse file $metadata_file : $@");
	return undef;
    }
    
    unless ($doc) {
	&IdPAccountManager::Tools::do_log('error', "Failed to parse file $metadata_file : $!");
	return undef;
    }

    return $doc;
}

## Parse a SAML federation metadata file
sub _parse_saml_metadata {
    my %options = @_;
	#&IdPAccountManager::Tools::do_log('trace', "%s", join(',',%options));

    #unless ($options{'filter_entity_type'}) {
	#&IdPAccountManager::Tools::do_log('error', "paramètre entity_type manquant");
        #return undef;
    #}
        
  my $root = $options{'metadata_as_xml'};
    
  my @extracted_array;
  foreach my $EntityDescriptor (@{$root->getElementsByLocalName('EntityDescriptor')}) {

	my $extracted_data = {};
	
	if ($EntityDescriptor->hasAttributes()) {
		foreach my $attr ($EntityDescriptor->getAttribute('entityID')) {
			$extracted_data->{'entityid'} = $attr;
		}
	}
  
  	next if ($options{'filter_entity_id'} && ($options{'filter_entity_id'} ne $extracted_data->{'entityid'}));

	#&IdPAccountManager::Tools::do_log('trace', "EntityId: %s - Cherche %s", $extracted_data->{'entityid'}, $options{'filter_entity_id'});

	$extracted_data->{'xml_md'} = &IdPAccountManager::Tools::escape_xml($EntityDescriptor->toString());
  	
	#&IdPAccountManager::Tools::do_log('trace', "EntityId: %s", $extracted_data->{'entityid'});
	#&IdPAccountManager::Tools::do_log('trace', "Entity dump: %s", $EntityDescriptor->toString());

	foreach my $child ($EntityDescriptor->childNodes()) {
    
		## Ignoringnodes of type XML::LibXML::Text or XML::LibXML::Comment
		next unless (ref($child) =~ /^XML::LibXML::Element/);

		if ($child->nodeName =~ /IDPSSODescriptor$/) {

			$extracted_data->{'type'} = 'idp';
      
			foreach my $sso ($child->getElementsByLocalName('SingleSignOnService')) {
		  
				## On ne prend en compte que les endpoints prévus
				#next unless ($sso->getAttribute('Binding') && defined $supported_saml_bindings{$sso->getAttribute('Binding')});
		
				## On extrait les infos sur les endpoints
				push @{$extracted_data->{'idp_endpoints'}}, 
				{'type' => 'SingleSignOnService',
				'binding' => $sso->getAttribute('Binding'),
				'location' => $sso->getAttribute('Location'),
				};		
		       
		   }
		   
			## Getting domains declared for scoped attributes
			foreach my $scope ($child->getElementsByLocalName('Scope')) {	
				push @{$extracted_data->{'domain'}}, $scope->textContent();
			}
								       
		}elsif ($child->nodeName =~ /SPSSODescriptor$/) {

			$extracted_data->{'type'} = 'sp';
      
			## We check the Binding of the ACS that should match "urn:oasis:names:tc:SAML:1.0:profiles:browser-post"
			## We also check the index to select the ACS that has the lower index
			my ($index_saml1, $index_saml2);
			foreach my $sso ($child->getElementsByLocalName('AssertionConsumerService')) {
		  		
				## Extracting endpoints information
				push @{$extracted_data->{'sp_endpoints'}}, 
				{'type' => 'AssertionConsumerService',
				'binding' => $sso->getAttribute('Binding'),
				'location' => $sso->getAttribute('Location'),
				'index' => $sso->getAttribute('index'),
				'isdefault' => &IdPAccountManager::Tools::boolean2integer($sso->getAttribute('isDefault'))
				};
				#&IdPAccountManager::Tools::do_log('trace', "Endpoint: type:%s ; binding=%s ; location=%s ; index=%s ; isdefault=%s", 'AssertionConsumerService', $sso->getAttribute('Binding'), $sso->getAttribute('Location'), $sso->getAttribute('index'), $sso->getAttribute('isDefault'));
			}
			
			foreach my $requestedattribute ($child->getElementsByLocalName('RequestedAttribute')) {
		  		
				## Requested attributes information
				push @{$extracted_data->{'requested_attribute'}}, 
				{'friendly_name' => &IdPAccountManager::Tools::encode_utf8($requestedattribute->getAttribute('FriendlyName')),
				'name' => &IdPAccountManager::Tools::encode_utf8($requestedattribute->getAttribute('Name')),
				'is_required' => &IdPAccountManager::Tools::boolean2integer($requestedattribute->getAttribute('isRequired'))
				};
			}
			
		}elsif ($child->nodeName =~ /Extensions$/) {
			#&IdPAccountManager::Tools::do_log('trace', "Extensions for %s", $extracted_data->{'entityid'});
			foreach my $registrationinfo ($child->getElementsByLocalName('RegistrationInfo')) {
				
				$extracted_data->{'registration_info'}{'registration_authority'} = $registrationinfo->getAttribute('registrationAuthority');
				$extracted_data->{'registration_info'}{'registration_instant'} = $registrationinfo->getAttribute('registrationInstant');
				foreach my $registrationpolicy ($registrationinfo->getElementsByLocalName('RegistrationPolicy')) {
					if ($registrationpolicy->getAttribute('lang') eq 'en') {
						$extracted_data->{'registration_info'}{'registration_policy'} = &IdPAccountManager::Tools::encode_utf8($registrationpolicy->textContent());
					}
				}
			}
		}elsif ($child->nodeName =~ /ContactPerson$/) {
			my %contact_details;
			$contact_details{'type'} = $child->getAttribute('contactType');
                        if (defined $contact_details{'type'}) {
                            foreach my $contact_child ($child->childNodes()) {
                                    $contact_details{$contact_child->localName} = &IdPAccountManager::Tools::encode_utf8($contact_child->textContent());
                            }
                            push @{$extracted_data->{'contacts'}}, \%contact_details;
                        }
		}


		foreach my $displayname ($child->getElementsByLocalName('DisplayName')) {	
			
			$extracted_data->{'display_name'}{$displayname->getAttribute('xml:lang')} = &IdPAccountManager::Tools::encode_utf8($displayname->textContent());
                        
                        ## Set a default displayName in case no English version is provided
                        ## However there is no way to determine the native displayName
                        ## We take the first one as default
                        if (! $extracted_data->{'default_display_name'} || $displayname->getAttribute('xml:lang')) {
                            $extracted_data->{'default_display_name'} = &IdPAccountManager::Tools::encode_utf8($displayname->textContent());
                        }
                        
		}

		foreach my $description ($child->getElementsByLocalName('Description')) {	
			
			$extracted_data->{'description'}{$description->getAttribute('xml:lang')} = &IdPAccountManager::Tools::encode_utf8($description->textContent());
		}

		foreach my $contact ($child->getElementsByLocalName('ContactPerson')) {
			&IdPAccountManager::Tools::do_log('trace', "ContactPerson");

			my %contact_details;
			$contact_details{'type'} = $contact->getAttribute('contactType');
			foreach my $contact_child ($EntityDescriptor->childNodes()) {
				&IdPAccountManager::Tools::do_log('trace', "Contact : %s", $contact_child->localName);
				$contact_details{$contact_child->localName} = &IdPAccountManager::Tools::encode_utf8($contact_child->textContent());
			}
			push @{$extracted_data->{'contacts'}}, \%contact_details;
		}
		
		foreach my $sso ($child->getElementsByLocalName('OrganizationDisplayName')) {
			$extracted_data->{'organization'} = &IdPAccountManager::Tools::encode_utf8($sso->textContent());
		}

		## Getting X.509 certificates
		foreach my $cert ($child->getElementsByLocalName('X509Certificate')) {
			$extracted_data->{'certificate'} = &IdPAccountManager::Tools::encode_utf8($cert->textContent());
		}
	}	
	
	## Filter entities based  on type
	#&IdPAccountManager::Tools::do_log('trace', "Entity type : %s",  $extracted_data->{'type'});
	next if (defined $options{'filter_entity_type'} && 
	($options{'filter_entity_type'} ne $extracted_data->{'type'}));

	## Merge domains in a single string
	my $domains = join(',',@{$extracted_data->{'domain'}}) if ($extracted_data->{'domain'});
	$extracted_data->{'domain'} = $domains;
	#&IdPAccountManager::Tools::do_log('debug', "Scopes : %s", $domains);	
	
	push @extracted_array, $extracted_data;
  }    
 
  return \@extracted_array;
}

1; # Magic true value required at end of module
__END__

=head1 NAME

SAMLMetadata - Perl module loading SAML federation metadata

=head1 SYNOPSIS

=head1 DESCRIPTION

=head1 SUBROUTINES/METHODS

=head1 AUTHOR

Olivier Salaün (olivier.salaun@renater.fr)