diff --git a/bin/account-manager-client.pl b/bin/account-manager-client.pl
index 38694e243451ca58c7aeee5dc6c71bb0a6d83aeb..c9020c07618167a941e109cff2bda1918b75e2b0 100755
--- a/bin/account-manager-client.pl
+++ b/bin/account-manager-client.pl
@@ -9,7 +9,7 @@
use strict;
use utf8;
-use lib "/opt/testidp/IdPAccountManager/lib", ;
+use lib "/opt/testidp/IdPAccountManager/lib",;
use lib "/opt/testidp/IdPAccountManager/conf";
use Getopt::Long qw(:config auto_help);
@@ -21,14 +21,25 @@ use IdPAccountManager::ServiceProvider;
use IdPAccountManager::AuthenticationToken;
my %options;
-unless (&GetOptions(\%options, 'add_test_account', 'account_profile=s', 'sp_entityid=s', 'list_test_accounts', 'parse_federation_metadata',
- 'list_service_providers','list_authentication_tokens', 'get_authentication_token', 'add_authentication_token','email_address=s',
- 'token=s','send_notice','filter_expired','delete','add_service_provider','contacts=s','displayname=s')) {
+unless (
+ &GetOptions(
+ \%options, 'add_test_account',
+ 'account_profile=s', 'sp_entityid=s',
+ 'list_test_accounts', 'parse_federation_metadata',
+ 'list_service_providers', 'list_authentication_tokens',
+ 'get_authentication_token', 'add_authentication_token',
+ 'email_address=s', 'token=s',
+ 'send_notice', 'filter_expired',
+ 'delete', 'add_service_provider',
+ 'contacts=s', 'displayname=s'
+ )
+ )
+{
die "Unknown options.";
}
if ($options{'add_test_account'}) {
-
+
unless ($options{'account_profile'}) {
die "Missing account_profile option";
}
@@ -36,62 +47,73 @@ if ($options{'add_test_account'}) {
unless ($options{'sp_entityid'}) {
die "Missing sp_entityid option";
}
-
- my $test_account = new IdPAccountManager::TestAccount(account_profile => $options{'account_profile'},
- sp_entityid => $options{'sp_entityid'});
+
+ my $test_account = new IdPAccountManager::TestAccount(
+ account_profile => $options{'account_profile'},
+ sp_entityid => $options{'sp_entityid'}
+ );
unless (defined $test_account) {
- IdPAccountManager::Tools::do_log('error',"Failed to create test account");
- exit -1;
+ IdPAccountManager::Tools::do_log('error',
+ "Failed to create test account");
+ exit -1;
}
-
+
unless ($test_account->save()) {
- IdPAccountManager::Tools::do_log('error',"Failed to create test account");
+ IdPAccountManager::Tools::do_log('error',
+ "Failed to create test account");
exit -1;
}
-
- printf "Account created:\n\tuserid: user%d\n\tpassword: %s\n", $test_account->get('id'), $test_account->get('user_password');
-
-}elsif ($options{'list_test_accounts'}) {
-
+
+ printf "Account created:\n\tuserid: user%d\n\tpassword: %s\n",
+ $test_account->get('id'), $test_account->get('user_password');
+
+} elsif ($options{'list_test_accounts'}) {
+
my %args;
if ($options{'sp_entityid'}) {
- push @{$args{'query'}}, 'sp_entityid' => $options{'sp_entityid'};
+ push @{ $args{'query'} }, 'sp_entityid' => $options{'sp_entityid'};
}
-
+
if ($options{'account_profile'}) {
- push @{$args{'query'}}, 'account_profile' => $options{'account_profile'};
+ push @{ $args{'query'} },
+ 'account_profile' => $options{'account_profile'};
}
-
+
if ($options{'filter_expired'}) {
- push @{$args{'query'}}, 'expiration_date' => {lt => time};
+ push @{ $args{'query'} }, 'expiration_date' => { lt => time };
}
-
+
my $all = IdPAccountManager::TestAccount::list_test_accounts(%args);
-
+
if ($#{$all} < 0) {
printf "No matching test account in DB\n";
}
-
+
foreach my $test_account (@$all) {
$test_account->print();
- $test_account->delete || die if ($options{'delete'});
+ $test_account->delete || die if ($options{'delete'});
}
-
+
if ($options{'delete'}) {
- printf "%d accounts removed\n", $#{$all}+1;
+ printf "%d accounts removed\n", $#{$all} + 1;
## Update simpleSamlPhp configuration file
printf "Update simpleSamlPhp configuration file...\n";
IdPAccountManager::Tools::update_ssp_authsources();
}
-
-}elsif ($options{'parse_federation_metadata'}) {
+} elsif ($options{'parse_federation_metadata'}) {
my $federation_metadata = new IdPAccountManager::SAMLMetadata;
- unless ($federation_metadata->load(federation_metadata_file_path => $Conf::global{'federation_metadata_file_path'})) {
+ unless (
+ $federation_metadata->load(
+ federation_metadata_file_path =>
+ $Conf::global{'federation_metadata_file_path'}
+ )
+ )
+ {
die;
}
-
+
my %args;
if ($options{'sp_entityid'}) {
$args{'filter_entity_id'} = $options{'sp_entityid'};
@@ -100,15 +122,18 @@ if ($options{'add_test_account'}) {
unless ($federation_metadata->parse(%args)) {
die;
}
-
- printf "Document %s parsed\n", $Conf::global{'federation_metadata_file_path'};
-
+
+ printf "Document %s parsed\n",
+ $Conf::global{'federation_metadata_file_path'};
+
## List SAML entities
printf "Hashref representing the metadata:\n";
- &IdPAccountManager::Tools::dump_var($federation_metadata->{'federation_metadata_as_hashref'}, 0, \*STDOUT);
-
-}elsif ($options{'add_service_provider'}) {
-
+ &IdPAccountManager::Tools::dump_var(
+ $federation_metadata->{'federation_metadata_as_hashref'},
+ 0, \*STDOUT);
+
+} elsif ($options{'add_service_provider'}) {
+
unless ($options{'sp_entityid'}) {
die "Missing sp_entityid option";
}
@@ -116,152 +141,175 @@ if ($options{'add_test_account'}) {
unless ($options{'contacts'}) {
die "Missing contacts option";
}
-
+
## Check if entry already exists in DB first
- my $service_provider = new IdPAccountManager::ServiceProvider(entityid => $options{'sp_entityid'});
+ my $service_provider =
+ new IdPAccountManager::ServiceProvider(
+ entityid => $options{'sp_entityid'});
if ($service_provider->load(speculative => 1)) {
- printf "Entry for %s already in DB; update it with new data\n", $options{'sp_entityid'};
-
+ printf "Entry for %s already in DB; update it with new data\n",
+ $options{'sp_entityid'};
+
$service_provider->contacts($options{'contacts'});
- $service_provider->displayname($options{'displayname'}) if ($options{'displayname'});
- }else {
-
- $service_provider = new IdPAccountManager::ServiceProvider(entityid => $options{'sp_entityid'},
- contacts => $options{'contacts'},
- displayname => $options{'displayname'});
+ $service_provider->displayname($options{'displayname'})
+ if ($options{'displayname'});
+ } else {
+
+ $service_provider = new IdPAccountManager::ServiceProvider(
+ entityid => $options{'sp_entityid'},
+ contacts => $options{'contacts'},
+ displayname => $options{'displayname'}
+ );
unless (defined $service_provider) {
- IdPAccountManager::Tools::do_log('error',"Failed to create service provider");
- exit -1;
+ IdPAccountManager::Tools::do_log('error',
+ "Failed to create service provider");
+ exit -1;
}
}
-
+
unless ($service_provider->save()) {
- IdPAccountManager::Tools::do_log('error',"Failed to create service provider");
+ IdPAccountManager::Tools::do_log('error',
+ "Failed to create service provider");
exit -1;
}
-
+
printf "Service Provider created:\n";
-
- }elsif ($options{'list_service_providers'}) {
-
- my %args;
-
+
+} elsif ($options{'list_service_providers'}) {
+
+ my %args;
+
my $all = IdPAccountManager::ServiceProvider::list_service_providers(%args);
-
+
if ($#{$all} < 0) {
printf "No service provider in DB\n";
}
-
+
foreach my $service_provider (@$all) {
$service_provider->print();
}
-
-}elsif ($options{'list_authentication_tokens'}) {
-
- my %args;
+
+} elsif ($options{'list_authentication_tokens'}) {
+
+ my %args;
if ($options{'sp_entityid'}) {
- push @{$args{'query'}}, 'sp_entityid' => $options{'sp_entityid'};
+ push @{ $args{'query'} }, 'sp_entityid' => $options{'sp_entityid'};
}
if ($options{'token'}) {
- push @{$args{'query'}}, 'token' => $options{'token'};
+ push @{ $args{'query'} }, 'token' => $options{'token'};
}
if ($options{'filter_expired'}) {
- push @{$args{'query'}}, 'creation_date' => {lt => time-($Conf::global{'tokens_validity_period'} * 3600)};
+ push @{ $args{'query'} }, 'creation_date' =>
+ { lt => time - ($Conf::global{'tokens_validity_period'} * 3600) };
}
-
- my $all = IdPAccountManager::AuthenticationToken::list_authentication_tokens(%args);
-
+
+ my $all =
+ IdPAccountManager::AuthenticationToken::list_authentication_tokens(%args);
+
if ($#{$all} < 0) {
printf "No corresponding token found in DB\n";
}
-
+
foreach my $authentication_token (@$all) {
$authentication_token->print();
- $authentication_token->delete || die if ($options{'delete'});
+ $authentication_token->delete || die if ($options{'delete'});
}
-
+
if ($options{'delete'}) {
- printf "%d tokens removed\n", $#{$all}+1;
+ printf "%d tokens removed\n", $#{$all} + 1;
+
+ }
- }
-
-}elsif ($options{'get_authentication_token'}) {
-
- my %args;
+} elsif ($options{'get_authentication_token'}) {
+
+ my %args;
if ($options{'token'}) {
$args{'token'} = $options{'token'};
}
-
- my $authentication_token = new IdPAccountManager::AuthenticationToken(%args);
-
+
+ my $authentication_token =
+ new IdPAccountManager::AuthenticationToken(%args);
+
unless ($authentication_token->load()) {
die "No corresponding token found in DB\n";
}
-
+
if ($options{'sp_entityid'}) {
- unless ($authentication_token->get('sp_entityid') eq $options{'sp_entityid'}) {
+ unless ($authentication_token->get('sp_entityid') eq
+ $options{'sp_entityid'})
+ {
die "Authentication token cannot be used for this SP\n";
}
}
-
$authentication_token->print();
-}elsif ($options{'add_authentication_token'}) {
-
+} elsif ($options{'add_authentication_token'}) {
+
unless ($options{'email_address'}) {
die "Missing email_address option";
- }
+ }
unless ($options{'sp_entityid'}) {
die "Missing sp_entityid option";
}
-
- my $authentication_token = new IdPAccountManager::AuthenticationToken('email_address' => $options{'email_address'},
- 'sp_entityid' => $options{'sp_entityid'});
+
+ my $authentication_token = new IdPAccountManager::AuthenticationToken(
+ 'email_address' => $options{'email_address'},
+ 'sp_entityid' => $options{'sp_entityid'}
+ );
unless (defined $authentication_token) {
- IdPAccountManager::Tools::do_log('error',"Failed to create token object");
- exit -1;
+ IdPAccountManager::Tools::do_log('error',
+ "Failed to create token object");
+ exit -1;
}
## First remove token if on exist for this email+SP
if ($authentication_token->load()) {
unless ($authentication_token->delete()) {
- IdPAccountManager::Tools::do_log('error',"Failed to delete token");
+ IdPAccountManager::Tools::do_log('error', "Failed to delete token");
exit -1;
}
-
- $authentication_token = new IdPAccountManager::AuthenticationToken('email_address' => $options{'email_address'},
- 'sp_entityid' => $options{'sp_entityid'});
+
+ $authentication_token = new IdPAccountManager::AuthenticationToken(
+ 'email_address' => $options{'email_address'},
+ 'sp_entityid' => $options{'sp_entityid'}
+ );
unless (defined $authentication_token) {
- IdPAccountManager::Tools::do_log('error',"Failed to create token object");
+ IdPAccountManager::Tools::do_log('error',
+ "Failed to create token object");
exit -1;
}
}
-
+
unless ($authentication_token->save()) {
- IdPAccountManager::Tools::do_log('error',"Failed to create token");
+ IdPAccountManager::Tools::do_log('error', "Failed to create token");
exit -1;
}
-
+
$authentication_token->print();
-
-}elsif ($options{'send_notice'}) {
+
+} elsif ($options{'send_notice'}) {
unless ($options{'email_address'}) {
die "Missing email_address option";
}
- unless (&IdPAccountManager::Tools::mail_notice('template' => 'templates/mail/notification_generic_error.tt2.eml',
- 'data' => {},
- 'to' => $options{'email_address'})) {
+ unless (
+ &IdPAccountManager::Tools::mail_notice(
+ 'template' => 'templates/mail/notification_generic_error.tt2.eml',
+ 'data' => {},
+ 'to' => $options{'email_address'}
+ )
+ )
+ {
die "Failed to send mail notice to $options{'email_address'}\n";
}
-
+
printf "Mail notice sent to $options{'email_address'}\n";
-
-}else {
+
+} else {
die "Missing arguments";
-
+
}
__END__
diff --git a/bin/account-manager-web.pl b/bin/account-manager-web.pl
index ac1b410bb45115d6a6f70e90d0eb032c0241e393..c6697e3b15a1f4109a663042fdecb3055a3ab15e 100755
--- a/bin/account-manager-web.pl
+++ b/bin/account-manager-web.pl
@@ -27,22 +27,24 @@ use IdPAccountManager::ServiceProvider;
use IdPAccountManager::AuthenticationToken;
## Defining parameters format
-my $urn_or_url_regex = '(http(s?):\/\/|urn:)[^\\\$\*\"\'\`\^\|\<\>\n\s]+'; ## Format de type URL HTTP ou URN
-my $url_regex = 'http(s?):\/\/[^\\\$\*\"\'\`\^\|\<\>\n\s]+';
-my $email_regex = '([\w\-\_\.\/\+\=\'\&]+|\".*\")\@[\w\-]+(\.[\w\-]+)+';
+my $urn_or_url_regex = '(http(s?):\/\/|urn:)[^\\\$\*\"\'\`\^\|\<\>\n\s]+'
+ ; ## Format de type URL HTTP ou URN
+my $url_regex = 'http(s?):\/\/[^\\\$\*\"\'\`\^\|\<\>\n\s]+';
+my $email_regex = '([\w\-\_\.\/\+\=\'\&]+|\".*\")\@[\w\-]+(\.[\w\-]+)+';
my $domains_regex = '[\w\.\-]+(,[\w\.\-]+)*';
-my %format = (
- ## URL
- #'attributeauthority' => $url_regex,
- 'sp_entityid' => $urn_or_url_regex,
- );
-
-my %actions = ('select_sp' => {'title_en' => 'Select your Service Provider' },
- 'account_wizard' => {'title_en' => 'Select your Service Provider' },
- 'generate_token' => {'title_en' => 'Generate an authentication token'},
- 'validate_token' => {'title_en' => 'Complete Email Challenge'},
- 'home' => {'title_en' => $Conf::global{'app_name'}},
- );
+my %format = (
+ ## URL
+ #'attributeauthority' => $url_regex,
+ 'sp_entityid' => $urn_or_url_regex,
+);
+
+my %actions = (
+ 'select_sp' => { 'title_en' => 'Select your Service Provider' },
+ 'account_wizard' => { 'title_en' => 'Select your Service Provider' },
+ 'generate_token' => { 'title_en' => 'Generate an authentication token' },
+ 'validate_token' => { 'title_en' => 'Complete Email Challenge' },
+ 'home' => { 'title_en' => $Conf::global{'app_name'} },
+);
## Gives writes for the group
umask 0002;
@@ -61,180 +63,200 @@ package WebRequest;
## New web request
sub new {
- my $pkg = shift;
- my $request = {};
- &IdPAccountManager::Tools::do_log('info', "");
-
-
- my $http_query = new CGI;
-
- ## Input parameters
- my %in_vars = $http_query->Vars;
- $request->{'param_in'} = \%in_vars;
-
- ## Check if admin acts as another user
- $request->{'cookies'} = CGI::Cookie->fetch;
- #if (defined $request->{'cookies'}{'as_user'} && $request->{'is_admin'}) {
- # $request->{'utilisateur'} = $request->{'as_user'} = $request->{'cookies'}{'as_user'}->value;
- # $request->{'is_admin'} = 0;
- #}
-
- ## Usefull data for output (web pages or mail notices)
- $request->{'param_out'}{'url_cgi'} = $ENV{'SCRIPT_NAME'};
- $request->{'param_out'}{'env'} = \%ENV;
- $request->{'param_out'}{'actions'} = \%actions;
- $request->{'param_out'}{'conf'} = \%Conf::global;
-
- ## Dumping input data
- #open TMP, ">/tmp/account_manager.in"; &IdPAccountManager::Tools::dump_var($request->{'param_in'}, 0, \*TMP); close TMP;
-
- ## Clean input vars
- foreach my $key (keys %{$request->{'param_in'}}) {
- #&IdPAccountManager::Tools::do_log('trace', "PARAM_ENTREE: %s=%s", $key, $request->{'param_in'}{$key});
-
- ## Removing all ^M (0D)
- $request->{'param_in'}{$key} =~ s/\r//g;
-
- $request->{'param_in'}{$key} =~ s/\s+$//; ## Remove trailing spaces
- $request->{'param_in'}{$key} =~ s/^\s+//; ## Remove leading spaces
- #if ($request->{'param_in'}{$key} =~ /\0/) {
- # my @valeurs = split /\0/, $request->{'param_in'}{$key};
- # $request->{'param_in'}{$key} = $valeurs[0]; ## Only keep first value of multi-valued parameters
- #}
-
- ## If action_xx param is set, then action=xx
- ## Usefull to have sementicless values in submit forms
- if ($key =~ /^action_(\w+)$/) {
- #&IdPAccountManager::Tools::do_log('trace', "ACTION $key");
- $request->{'param_in'}{'action'} = $1;
+ my $pkg = shift;
+ my $request = {};
+ &IdPAccountManager::Tools::do_log('info', "");
+
+ my $http_query = new CGI;
+
+ ## Input parameters
+ my %in_vars = $http_query->Vars;
+ $request->{'param_in'} = \%in_vars;
+
+ ## Check if admin acts as another user
+ $request->{'cookies'} = CGI::Cookie->fetch;
+
+#if (defined $request->{'cookies'}{'as_user'} && $request->{'is_admin'}) {
+# $request->{'utilisateur'} = $request->{'as_user'} = $request->{'cookies'}{'as_user'}->value;
+# $request->{'is_admin'} = 0;
+#}
+
+ ## Usefull data for output (web pages or mail notices)
+ $request->{'param_out'}{'url_cgi'} = $ENV{'SCRIPT_NAME'};
+ $request->{'param_out'}{'env'} = \%ENV;
+ $request->{'param_out'}{'actions'} = \%actions;
+ $request->{'param_out'}{'conf'} = \%Conf::global;
+
+ ## Dumping input data
+#open TMP, ">/tmp/account_manager.in"; &IdPAccountManager::Tools::dump_var($request->{'param_in'}, 0, \*TMP); close TMP;
+
+ ## Clean input vars
+ foreach my $key (keys %{ $request->{'param_in'} }) {
+
+#&IdPAccountManager::Tools::do_log('trace', "PARAM_ENTREE: %s=%s", $key, $request->{'param_in'}{$key});
+
+ ## Removing all ^M (0D)
+ $request->{'param_in'}{$key} =~ s/\r//g;
+
+ $request->{'param_in'}{$key} =~ s/\s+$//; ## Remove trailing spaces
+ $request->{'param_in'}{$key} =~ s/^\s+//; ## Remove leading spaces
+ #if ($request->{'param_in'}{$key} =~ /\0/) {
+ # my @valeurs = split /\0/, $request->{'param_in'}{$key};
+ # $request->{'param_in'}{$key} = $valeurs[0]; ## Only keep first value of multi-valued parameters
+ #}
+
+ ## If action_xx param is set, then action=xx
+ ## Usefull to have sementicless values in submit forms
+ if ($key =~ /^action_(\w+)$/) {
+
+ #&IdPAccountManager::Tools::do_log('trace', "ACTION $key");
+ $request->{'param_in'}{'action'} = $1;
+ }
+ }
+
+ ## Check the requested action
+ if ($request->{'param_in'}{'action'}) {
+ $request->{'action'} = $request->{'param_in'}{'action'};
+ } else {
+ ## Default action
+ &IdPAccountManager::Tools::do_log('info', "Default action");
+ $request->{'action'} = 'home';
}
- }
-
- ## Check the requested action
- if ($request->{'param_in'}{'action'} ) {
- $request->{'action'} = $request->{'param_in'}{'action'};
- }else {
- ## Default action
- &IdPAccountManager::Tools::do_log('info', "Default action");
- $request->{'action'} = 'home';
- }
-
- bless $request, $pkg;
-
- return $request;
+
+ bless $request, $pkg;
+
+ return $request;
}
## Execute a web request
sub execute {
- my $self = shift;
- &IdPAccountManager::Tools::do_log('debug', "");
-
- my $status;
-
- ## Check input parameters format
- foreach my $key (keys %{$self->{'param_in'}}) {
- if ($self->{'param_in'}{$key} !~ /^\s*$/ &&
- defined $format{$key} &&
- ! ref($format{$key})) {
- unless ($self->{'param_in'}{$key} =~ /^$format{$key}$/) {
- push @{$self->{'param_out'}{'errors'}}, "format_$key";
- &IdPAccountManager::Tools::do_log('error', "Incorrect parameter format : $key");
- return undef;
- }
- }
- }
-
- do {
- ## Actions can be chained
- $self->{'action'} = $self->{'next_action'} if ($self->{'next_action'});
- delete $self->{'next_action'}; ## Prevent loops
-
- if (defined $actions{$self->{'action'}}) {
-
- ## Execute the target subroutine named req_actionName
- my $sub = 'req_'.$self->{'action'};
- $status = &{$sub}($self);
-
- }else {
- ## Inknown action
- push @{$self->{'param_out'}{'errors'}}, "unknown_action";
- &IdPAccountManager::Tools::do_log('error', "Unknown action '%s'", $self->{'action'});
-
- }
-
- } while ($self->{'next_action'});
-
- #return undef if (!defined $status);
-
- return 1;
-}
+ my $self = shift;
+ &IdPAccountManager::Tools::do_log('debug', "");
+
+ my $status;
+
+ ## Check input parameters format
+ foreach my $key (keys %{ $self->{'param_in'} }) {
+ if ( $self->{'param_in'}{$key} !~ /^\s*$/
+ && defined $format{$key}
+ && !ref($format{$key}))
+ {
+ unless ($self->{'param_in'}{$key} =~ /^$format{$key}$/) {
+ push @{ $self->{'param_out'}{'errors'} }, "format_$key";
+ &IdPAccountManager::Tools::do_log('error',
+ "Incorrect parameter format : $key");
+ return undef;
+ }
+ }
+ }
+
+ do {
+ ## Actions can be chained
+ $self->{'action'} = $self->{'next_action'} if ($self->{'next_action'});
+ delete $self->{'next_action'}; ## Prevent loops
+
+ if (defined $actions{ $self->{'action'} }) {
+
+ ## Execute the target subroutine named req_actionName
+ my $sub = 'req_' . $self->{'action'};
+ $status = &{$sub}($self);
+
+ } else {
+ ## Inknown action
+ push @{ $self->{'param_out'}{'errors'} }, "unknown_action";
+ &IdPAccountManager::Tools::do_log('error', "Unknown action '%s'",
+ $self->{'action'});
+ }
+
+ } while ($self->{'next_action'});
+
+ #return undef if (!defined $status);
+
+ return 1;
+}
## Return HTML content
sub respond {
- my $self = shift;
- &IdPAccountManager::Tools::do_log('debug', "");
-
- ## Dump output data
- #open TMP, ">/tmp/account_registry.out"; &IdPAccountManager::Tools::dump_var($self->{'param_out'}, 0, \*TMP); close TMP;
-
- ## Enable dumping off all variables in web pages
- #$self->{'param_out'}{'dump'} = $self->{'param_out'};
-
- ## Automatic pass object entries to the output hash
- foreach my $key (keys %{$self}) {
- #&IdPAccountManager::Tools::do_log('trace', "Passing $key");
- $self->{'param_out'}{$key} ||= $self->{$key} unless ($key eq 'param_out');
- }
-
- ## An action may redirect to an external URL
- if ($self->{'url_redirection'}) {
- #&IdPAccountManager::Tools::do_log('trace', "URL Redirect : $self->{'url_redirection'}");
- printf "Location: %s\n\n", $self->{'url_redirection'};
-
- }else {
- #$self->{'param_out'}{'cookie'} = CGI::Cookie->new(-name=>'as_user',-value=>$self->{'as_user'},-expires=>'-1M');
-
- ## Parse template
- my $tt2 = Template->new({
- ENCODING => 'iso-8859-1', ## le défaut apparemment
- FILTERS => {'encode_utf8', => [\&IdPAccountManager::Tools::encode_utf8, 0],
- 'escape_quotes' => [\&IdPAccountManager::Tools::escape_quotes, 0]},
- INCLUDE_PATH => $Conf::global{'root_manager_dir'}.':'.$Conf::global{'root_manager_dir'}.'/templates/accountProfiles',
+ my $self = shift;
+ &IdPAccountManager::Tools::do_log('debug', "");
+
+ ## Dump output data
+#open TMP, ">/tmp/account_registry.out"; &IdPAccountManager::Tools::dump_var($self->{'param_out'}, 0, \*TMP); close TMP;
+
+ ## Enable dumping off all variables in web pages
+ #$self->{'param_out'}{'dump'} = $self->{'param_out'};
+
+ ## Automatic pass object entries to the output hash
+ foreach my $key (keys %{$self}) {
+
+ #&IdPAccountManager::Tools::do_log('trace', "Passing $key");
+ $self->{'param_out'}{$key} ||= $self->{$key}
+ unless ($key eq 'param_out');
+ }
+
+ ## An action may redirect to an external URL
+ if ($self->{'url_redirection'}) {
+
+#&IdPAccountManager::Tools::do_log('trace', "URL Redirect : $self->{'url_redirection'}");
+ printf "Location: %s\n\n", $self->{'url_redirection'};
+
+ } else {
+
+#$self->{'param_out'}{'cookie'} = CGI::Cookie->new(-name=>'as_user',-value=>$self->{'as_user'},-expires=>'-1M');
+
+ ## Parse template
+ my $tt2 = Template->new(
+ {
+ ENCODING => 'iso-8859-1', ## le défaut apparemment
+ FILTERS => {
+ 'encode_utf8', =>
+ [ \&IdPAccountManager::Tools::encode_utf8, 0 ],
+ 'escape_quotes' =>
+ [ \&IdPAccountManager::Tools::escape_quotes, 0 ]
+ },
+ INCLUDE_PATH => $Conf::global{'root_manager_dir'} . ':'
+ . $Conf::global{'root_manager_dir'}
+ . '/templates/accountProfiles',
+
#DEBUG => 'all',
#DEBUG => 'caller',
#DEBUG => 'parser'
- });
-
- my $template;
-
- ## nobanner is used to do AJAX to get only pieces of HTML to load in the web client
- if ($self->{'param_in'}{'style'} eq 'nobanner') {
- $template = 'templates/web/index-nobanner.tt2.html';
- }else {
- $template = 'templates/web/index.tt2.html';
+ }
+ );
+
+ my $template;
+
+ ## nobanner is used to do AJAX to get only pieces of HTML to load in the web client
+ if ($self->{'param_in'}{'style'} eq 'nobanner') {
+ $template = 'templates/web/index-nobanner.tt2.html';
+ } else {
+ $template = 'templates/web/index.tt2.html';
+ }
+
+ unless ($tt2->process($template, $self->{'param_out'}, \*STDOUT)) {
+ printf "Content-type: text/plain\n\n Error: %s", $tt2->error();
+ &IdPAccountManager::Tools::do_log('error', "Web parser error : %s",
+ $tt2->error());
+ }
}
-
- unless ($tt2->process($template, $self->{'param_out'}, \*STDOUT)) {
- printf "Content-type: text/plain\n\n Error: %s", $tt2->error();
- &IdPAccountManager::Tools::do_log('error', "Web parser error : %s", $tt2->error());
+
+ ## Ignore some type of errors
+ my @errors_admin;
+ foreach my $id_error (@{ $self->{'param_out'}{'errors'} }) {
+ unless ($id_error =~ /^(error_x)$/) {
+ push @errors_admin, $id_error;
+ }
}
- }
-
- ## Ignore some type of errors
- my @errors_admin;
- foreach my $id_error (@{$self->{'param_out'}{'errors'}}) {
- unless ($id_error =~ /^(error_x)$/) {
- push @errors_admin, $id_error;
- }
- }
-
- ## Mail notification of admins about the error
- if (@errors_admin) {
+
+ ## Mail notification of admins about the error
+ if (@errors_admin) {
$self->{'param_out'}{'subject'} = 'Error notification - web interface';
- &IdPAccountManager::Tools::mail_notice('template' => 'templates/mail/notification_generic_error.tt2.eml',
- 'data' => $self->{'param_out'});
- }
+ &IdPAccountManager::Tools::mail_notice(
+ 'template' => 'templates/mail/notification_generic_error.tt2.eml',
+ 'data' => $self->{'param_out'}
+ );
+ }
}
## Return the list of known SPs first
@@ -243,20 +265,29 @@ sub req_account_wizard {
&IdPAccountManager::Tools::do_log('info', "");
my $federation_metadata = new IdPAccountManager::SAMLMetadata;
- unless ($federation_metadata->load(federation_metadata_file_path => $Conf::global{'federation_metadata_file_path'})) {
- push @{$self->{'param_out'}{'errors'}}, "internal";
- &IdPAccountManager::Tools::do_log('error', "Failed to load federation metadata : $!");
- return undef;
+ unless (
+ $federation_metadata->load(
+ federation_metadata_file_path =>
+ $Conf::global{'federation_metadata_file_path'}
+ )
+ )
+ {
+ push @{ $self->{'param_out'}{'errors'} }, "internal";
+ &IdPAccountManager::Tools::do_log('error',
+ "Failed to load federation metadata : $!");
+ return undef;
}
-
+
unless ($federation_metadata->parse()) {
- push @{$self->{'param_out'}{'errors'}}, "internal";
- &IdPAccountManager::Tools::do_log('error', "Failed to parse federation metadata : $!");
- return undef;
- }
+ push @{ $self->{'param_out'}{'errors'} }, "internal";
+ &IdPAccountManager::Tools::do_log('error',
+ "Failed to parse federation metadata : $!");
+ return undef;
+ }
+
+ $self->{'param_out'}{'federation_metadata_as_hashref'} =
+ $federation_metadata->{'federation_metadata_as_hashref'};
- $self->{'param_out'}{'federation_metadata_as_hashref'} = $federation_metadata->{'federation_metadata_as_hashref'};
-
return 1;
}
@@ -265,37 +296,53 @@ sub req_account_wizard {
sub req_select_sp {
my $self = shift;
&IdPAccountManager::Tools::do_log('info', "");
-
+
unless ($self->{'param_in'}{'sp_entityid'}) {
- push @{$self->{'param_out'}{'errors'}}, "missing_sp_entityid";
- &IdPAccountManager::Tools::do_log('error', "Missing parameter sp_entityid");
- return undef;
+ push @{ $self->{'param_out'}{'errors'} }, "missing_sp_entityid";
+ &IdPAccountManager::Tools::do_log('error',
+ "Missing parameter sp_entityid");
+ return undef;
}
-
+
my $federation_metadata = new IdPAccountManager::SAMLMetadata;
- unless ($federation_metadata->load(federation_metadata_file_path => $Conf::global{'federation_metadata_file_path'})) {
- push @{$self->{'param_out'}{'errors'}}, "internal";
- &IdPAccountManager::Tools::do_log('error', "Failed to load federation metadata : $!");
- return undef;
+ unless (
+ $federation_metadata->load(
+ federation_metadata_file_path =>
+ $Conf::global{'federation_metadata_file_path'}
+ )
+ )
+ {
+ push @{ $self->{'param_out'}{'errors'} }, "internal";
+ &IdPAccountManager::Tools::do_log('error',
+ "Failed to load federation metadata : $!");
+ return undef;
}
-
- unless ($federation_metadata->parse(filter_entity_id => $self->{'param_in'}{'sp_entityid'})) {
- push @{$self->{'param_out'}{'errors'}}, "internal";
- &IdPAccountManager::Tools::do_log('error', "Failed to parse federation metadata : $!");
- return undef;
- }
-
+
+ unless (
+ $federation_metadata->parse(
+ filter_entity_id => $self->{'param_in'}{'sp_entityid'}
+ )
+ )
+ {
+ push @{ $self->{'param_out'}{'errors'} }, "internal";
+ &IdPAccountManager::Tools::do_log('error',
+ "Failed to parse federation metadata : $!");
+ return undef;
+ }
+
## Create a serviceprovider object to store major parameters for this SP in DB
- my $service_provider = new IdPAccountManager::ServiceProvider(entityid => $self->{'param_in'}{'sp_entityid'});
-
+ my $service_provider = new IdPAccountManager::ServiceProvider(
+ entityid => $self->{'param_in'}{'sp_entityid'});
+
## Prepare data
- #open TMP, ">/tmp/account_manager_metadata.dump"; &IdPAccountManager::Tools::dump_var($federation_metadata->{'federation_metadata_as_hashref'}[0], 0, \*TMP); close TMP;
- my $sp_metadata_as_hashref = $federation_metadata->{'federation_metadata_as_hashref'}[0];
+#open TMP, ">/tmp/account_manager_metadata.dump"; &IdPAccountManager::Tools::dump_var($federation_metadata->{'federation_metadata_as_hashref'}[0], 0, \*TMP); close TMP;
+ my $sp_metadata_as_hashref =
+ $federation_metadata->{'federation_metadata_as_hashref'}[0];
my @contacts;
if (defined $sp_metadata_as_hashref->{'contacts'}) {
- foreach my $contact (@{$sp_metadata_as_hashref->{'contacts'}}) {
+ foreach my $contact (@{ $sp_metadata_as_hashref->{'contacts'} }) {
my $email = $contact->{'EmailAddress'};
- $email =~ s/^(mailto:)//; ## Remove 'mailto:' prefixes if any
+ $email =~ s/^(mailto:)//; ## Remove 'mailto:' prefixes if any
push @contacts, $email;
}
}
@@ -303,12 +350,15 @@ sub req_select_sp {
if (defined $sp_metadata_as_hashref->{'display_name'}) {
## Use English version of displayName if available
if ($sp_metadata_as_hashref->{'display_name'}{'en'}) {
- $display_name = $sp_metadata_as_hashref->{'display_name'}{'en'};
- ## Else any language
- }else {
- foreach my $lang (keys %{$sp_metadata_as_hashref->{'display_name'}}) {
- #&IdPAccountManager::Tools::do_log('TRACE', "Display name(%s): %s", $lang, $sp_metadata_as_hashref->{'display_name'}{$lang});
- $display_name = $sp_metadata_as_hashref->{'display_name'}{$lang};
+ $display_name = $sp_metadata_as_hashref->{'display_name'}{'en'};
+ ## Else any language
+ } else {
+ foreach
+ my $lang (keys %{ $sp_metadata_as_hashref->{'display_name'} })
+ {
+#&IdPAccountManager::Tools::do_log('TRACE', "Display name(%s): %s", $lang, $sp_metadata_as_hashref->{'display_name'}{$lang});
+ $display_name =
+ $sp_metadata_as_hashref->{'display_name'}{$lang};
last;
}
}
@@ -318,30 +368,33 @@ sub req_select_sp {
if ($service_provider->load(speculative => 1)) {
$service_provider->contacts(join(',', @contacts));
$service_provider->displayname($display_name);
-
- }else {
-
- $service_provider = new IdPAccountManager::ServiceProvider(entityid => $self->{'param_in'}{'sp_entityid'},
- contacts => join(',', @contacts),
- displayname => $display_name);
+
+ } else {
+
+ $service_provider = new IdPAccountManager::ServiceProvider(
+ entityid => $self->{'param_in'}{'sp_entityid'},
+ contacts => join(',', @contacts),
+ displayname => $display_name
+ );
unless (defined $service_provider) {
- push @{$self->{'param_out'}{'errors'}}, "internal";
- &IdPAccountManager::Tools::do_log('error', "Failed to create serviceprovider object");
+ push @{ $self->{'param_out'}{'errors'} }, "internal";
+ &IdPAccountManager::Tools::do_log('error',
+ "Failed to create serviceprovider object");
return undef;
}
}
-
+
unless ($service_provider->save()) {
- push @{$self->{'param_out'}{'errors'}}, "internal";
- &IdPAccountManager::Tools::do_log('error', "Failed to save serviceprovider object");
+ push @{ $self->{'param_out'}{'errors'} }, "internal";
+ &IdPAccountManager::Tools::do_log('error',
+ "Failed to save serviceprovider object");
return undef;
}
+ $self->{'param_out'}{'sp_metadata_as_hashref'} =
+ $federation_metadata->{'federation_metadata_as_hashref'}[0];
+ $self->{'param_out'}{'serviceprovider'} = $service_provider;
- $self->{'param_out'}{'sp_metadata_as_hashref'} = $federation_metadata->{'federation_metadata_as_hashref'}[0];
- $self->{'param_out'}{'serviceprovider'} = $service_provider;
-
-
return 1;
}
@@ -350,147 +403,207 @@ sub req_select_sp {
sub req_generate_token {
my $self = shift;
&IdPAccountManager::Tools::do_log('info', "");
-
+
unless ($self->{'param_in'}{'sp_entityid'}) {
- push @{$self->{'param_out'}{'errors'}}, "missing_sp_entityid";
- &IdPAccountManager::Tools::do_log('error', "Missing parameter sp_entityid");
- return undef;
+ push @{ $self->{'param_out'}{'errors'} }, "missing_sp_entityid";
+ &IdPAccountManager::Tools::do_log('error',
+ "Missing parameter sp_entityid");
+ return undef;
}
unless ($self->{'param_in'}{'email_address'}) {
- push @{$self->{'param_out'}{'errors'}}, "email_address";
- &IdPAccountManager::Tools::do_log('error', "Missing parameter email_address");
- return undef;
+ push @{ $self->{'param_out'}{'errors'} }, "email_address";
+ &IdPAccountManager::Tools::do_log('error',
+ "Missing parameter email_address");
+ return undef;
}
## Create a serviceprovider object to load parameters for this SP from DB
- my $service_provider = new IdPAccountManager::ServiceProvider(entityid => $self->{'param_in'}{'sp_entityid'});
+ my $service_provider = new IdPAccountManager::ServiceProvider(
+ entityid => $self->{'param_in'}{'sp_entityid'});
+
# Try loading DB object first
unless ($service_provider->load(speculative => 1)) {
- push @{$self->{'param_out'}{'errors'}}, "internal";
- &IdPAccountManager::Tools::do_log('error', "Failed to load SP with entityid '%s'", $self->{'param_in'}{'sp_entityid'});
- return undef;
+ push @{ $self->{'param_out'}{'errors'} }, "internal";
+ &IdPAccountManager::Tools::do_log(
+ 'error',
+ "Failed to load SP with entityid '%s'",
+ $self->{'param_in'}{'sp_entityid'}
+ );
+ return undef;
}
-
+
## Check that email_address is a known contact for this SP
- unless ($service_provider->is_contact($self->{'param_in'}{'email_address'})) {
- push @{$self->{'param_out'}{'errors'}}, "internal";
- &IdPAccountManager::Tools::do_log('error', "Requested a token for %s for an unautorized address '%s'", $self->{'param_in'}{'sp_entityid'}, $self->{'param_in'}{'email_address'});
- return undef;
+ unless ($service_provider->is_contact($self->{'param_in'}{'email_address'}))
+ {
+ push @{ $self->{'param_out'}{'errors'} }, "internal";
+ &IdPAccountManager::Tools::do_log(
+ 'error',
+ "Requested a token for %s for an unautorized address '%s'",
+ $self->{'param_in'}{'sp_entityid'},
+ $self->{'param_in'}{'email_address'}
+ );
+ return undef;
}
-
- my $authentication_token = new IdPAccountManager::AuthenticationToken('email_address' => $self->{'param_in'}{'email_address'},
- 'sp_entityid' => $self->{'param_in'}{'sp_entityid'});
+
+ my $authentication_token = new IdPAccountManager::AuthenticationToken(
+ 'email_address' => $self->{'param_in'}{'email_address'},
+ 'sp_entityid' => $self->{'param_in'}{'sp_entityid'}
+ );
unless (defined $authentication_token) {
- push @{$self->{'param_out'}{'errors'}}, "internal";
- &IdPAccountManager::Tools::do_log('error', "Failed to create authentication token");
- return undef;
+ push @{ $self->{'param_out'}{'errors'} }, "internal";
+ &IdPAccountManager::Tools::do_log('error',
+ "Failed to create authentication token");
+ return undef;
}
-
+
## First remove token if one exist for this email+SP
if ($authentication_token->load()) {
unless ($authentication_token->delete()) {
- push @{$self->{'param_out'}{'errors'}}, "internal";
- &IdPAccountManager::Tools::do_log('error', "Failed to delete previous authentication token with ID %s", $authentication_token->get('id'));
+ push @{ $self->{'param_out'}{'errors'} }, "internal";
+ &IdPAccountManager::Tools::do_log(
+ 'error',
+ "Failed to delete previous authentication token with ID %s",
+ $authentication_token->get('id')
+ );
return undef;
}
-
- $authentication_token = new IdPAccountManager::AuthenticationToken('email_address' => $self->{'param_in'}{'email_address'},
- 'sp_entityid' => $self->{'param_in'}{'sp_entityid'});
+
+ $authentication_token = new IdPAccountManager::AuthenticationToken(
+ 'email_address' => $self->{'param_in'}{'email_address'},
+ 'sp_entityid' => $self->{'param_in'}{'sp_entityid'}
+ );
unless (defined $authentication_token) {
- push @{$self->{'param_out'}{'errors'}}, "internal";
- &IdPAccountManager::Tools::do_log('error', "Failed to create authentication token");
+ push @{ $self->{'param_out'}{'errors'} }, "internal";
+ &IdPAccountManager::Tools::do_log('error',
+ "Failed to create authentication token");
return undef;
}
- }
-
+ }
+
unless ($authentication_token->save()) {
- push @{$self->{'param_out'}{'errors'}}, "internal";
- &IdPAccountManager::Tools::do_log('error', "Failed to save authentication token");
- return undef;
+ push @{ $self->{'param_out'}{'errors'} }, "internal";
+ &IdPAccountManager::Tools::do_log('error',
+ "Failed to save authentication token");
+ return undef;
}
-
- $self->{'param_out'}{'authentication_token'} = $authentication_token->get('token');
- $self->{'param_out'}{'email_address'} = $self->{'param_in'}{'email_address'};
+
+ $self->{'param_out'}{'authentication_token'} =
+ $authentication_token->get('token');
+ $self->{'param_out'}{'email_address'} =
+ $self->{'param_in'}{'email_address'};
$self->{'param_out'}{'sp_entityid'} = $self->{'param_in'}{'sp_entityid'};
- $self->{'param_out'}{'to'} = $self->{'param_in'}{'email_address'};
+ $self->{'param_out'}{'to'} = $self->{'param_in'}{'email_address'};
## Send the challenge email with the token
- &IdPAccountManager::Tools::mail_notice('template' => 'templates/mail/send_authentication_token.tt2.eml',
- 'to' => $self->{'param_in'}{'email_address'},
- 'data' => $self->{'param_out'});
-
- &IdPAccountManager::Tools::do_log('info', "Token send to %s for sp_entityid=%s;token=%s", $self->{'param_in'}{'email_address'},
- $self->{'param_in'}{'sp_entityid'}, $self->{'param_out'}{'authentication_token'});
-
-
+ &IdPAccountManager::Tools::mail_notice(
+ 'template' => 'templates/mail/send_authentication_token.tt2.eml',
+ 'to' => $self->{'param_in'}{'email_address'},
+ 'data' => $self->{'param_out'}
+ );
+
+ &IdPAccountManager::Tools::do_log(
+ 'info',
+ "Token send to %s for sp_entityid=%s;token=%s",
+ $self->{'param_in'}{'email_address'},
+ $self->{'param_in'}{'sp_entityid'},
+ $self->{'param_out'}{'authentication_token'}
+ );
+
return 1;
}
-## Validate an authentication token
+## Validate an authentication token
## Test accounts get created
## Sample call : dev-edugain.renater.fr/accountmanager?action=validate_token&style=nobanner&sp_entityid=https%3A%2F%2Fsourcesup.cru.fr%2Fshibboleth&authentication_token=c1cfecb51ea40d39a695
sub req_validate_token {
my $self = shift;
&IdPAccountManager::Tools::do_log('info', "");
-
+
unless ($self->{'param_in'}{'sp_entityid'}) {
- push @{$self->{'param_out'}{'errors'}}, "missing_sp_entityid";
- &IdPAccountManager::Tools::do_log('error', "Missing parameter sp_entityid");
- return undef;
+ push @{ $self->{'param_out'}{'errors'} }, "missing_sp_entityid";
+ &IdPAccountManager::Tools::do_log('error',
+ "Missing parameter sp_entityid");
+ return undef;
}
unless ($self->{'param_in'}{'authentication_token'}) {
- push @{$self->{'param_out'}{'errors'}}, "missing_authentication_token";
- &IdPAccountManager::Tools::do_log('error', "Missing parameter authentication_token");
- return undef;
+ push @{ $self->{'param_out'}{'errors'} },
+ "missing_authentication_token";
+ &IdPAccountManager::Tools::do_log('error',
+ "Missing parameter authentication_token");
+ return undef;
}
- my $authentication_token = new IdPAccountManager::AuthenticationToken(token => $self->{'param_in'}{'authentication_token'});
-
+ my $authentication_token = new IdPAccountManager::AuthenticationToken(
+ token => $self->{'param_in'}{'authentication_token'});
+
unless ($authentication_token->load()) {
- push @{$self->{'param_out'}{'errors'}}, "wrong_token";
- &IdPAccountManager::Tools::do_log('error', "Failed to validate authentication token %s for sp_entityid %s",
- $self->{'param_in'}{'authentication_token'}, $self->{'param_in'}{'sp_entityid'});
- return undef;
+ push @{ $self->{'param_out'}{'errors'} }, "wrong_token";
+ &IdPAccountManager::Tools::do_log(
+ 'error',
+ "Failed to validate authentication token %s for sp_entityid %s",
+ $self->{'param_in'}{'authentication_token'},
+ $self->{'param_in'}{'sp_entityid'}
+ );
+ return undef;
}
-
- unless ($authentication_token->get('sp_entityid') eq $self->{'param_in'}{'sp_entityid'}) {
- push @{$self->{'param_out'}{'errors'}}, "wrong_token_for_sp";
- &IdPAccountManager::Tools::do_log('error', "Authentication token %s cannot be used for SP with entityid %s",
- $self->{'param_in'}{'authentication_token'}, $self->{'param_in'}{'sp_entityid'});
- return undef;
+
+ unless ($authentication_token->get('sp_entityid') eq
+ $self->{'param_in'}{'sp_entityid'})
+ {
+ push @{ $self->{'param_out'}{'errors'} }, "wrong_token_for_sp";
+ &IdPAccountManager::Tools::do_log(
+ 'error',
+ "Authentication token %s cannot be used for SP with entityid %s",
+ $self->{'param_in'}{'authentication_token'},
+ $self->{'param_in'}{'sp_entityid'}
+ );
+ return undef;
}
-
+
## delete the token
unless ($authentication_token->delete()) {
- &IdPAccountManager::Tools::do_log('error', "Failed to delete authentication token %s",
- $self->{'param_in'}{'authentication_token'});
+ &IdPAccountManager::Tools::do_log(
+ 'error',
+ "Failed to delete authentication token %s",
+ $self->{'param_in'}{'authentication_token'}
+ );
}
-
+
## create test accounts
- my @test_accounts = &IdPAccountManager::TestAccount::create_test_accounts_for_sp(sp_entityid => $self->{'param_in'}{'sp_entityid'});
-
+ my @test_accounts =
+ &IdPAccountManager::TestAccount::create_test_accounts_for_sp(
+ sp_entityid => $self->{'param_in'}{'sp_entityid'});
+
unless (@test_accounts) {
- push @{$self->{'param_out'}{'errors'}}, "accounts_creation_failed";
- &IdPAccountManager::Tools::do_log('error', "Failed to create test accounts for SP with entityid %s",
- $self->{'param_in'}{'sp_entityid'});
- return undef;
+ push @{ $self->{'param_out'}{'errors'} }, "accounts_creation_failed";
+ &IdPAccountManager::Tools::do_log(
+ 'error',
+ "Failed to create test accounts for SP with entityid %s",
+ $self->{'param_in'}{'sp_entityid'}
+ );
+ return undef;
}
-
+
## Update simpleSAMLphp configuration to enable test accounts
unless (&IdPAccountManager::Tools::update_ssp_authsources()) {
- push @{$self->{'param_out'}{'errors'}}, "accounts_creation_failed";
- &IdPAccountManager::Tools::do_log('error', "Failed to create simpleSAMLphp configuration file");
- return undef;
+ push @{ $self->{'param_out'}{'errors'} }, "accounts_creation_failed";
+ &IdPAccountManager::Tools::do_log('error',
+ "Failed to create simpleSAMLphp configuration file");
+ return undef;
}
-
-
- &IdPAccountManager::Tools::do_log('info', "Token validated for sp_entityid=%s;token=%s", $self->{'param_in'}{'sp_entityid'}, $self->{'param_in'}{'authentication_token'});
-
- $self->{'param_out'}{'sp_entityid'} = $self->{'param_in'}{'sp_entityid'};
+
+ &IdPAccountManager::Tools::do_log(
+ 'info',
+ "Token validated for sp_entityid=%s;token=%s",
+ $self->{'param_in'}{'sp_entityid'},
+ $self->{'param_in'}{'authentication_token'}
+ );
+
+ $self->{'param_out'}{'sp_entityid'} = $self->{'param_in'}{'sp_entityid'};
$self->{'param_out'}{'test_accounts'} = \@test_accounts;
-
+
return 1;
}
diff --git a/bin/create-database-code.pl b/bin/create-database-code.pl
index a154a5985ec8623038ac010aa99d04faecd76a3c..1c8f2651ca0e0c99590de439e112dc42d06c1850 100755
--- a/bin/create-database-code.pl
+++ b/bin/create-database-code.pl
@@ -16,19 +16,27 @@ unless (&GetOptions(\%options, 'database=s')) {
my $dbname = $options{'database'} || $Conf::global{'database_name'};
-$loader =
- Rose::DB::Object::Loader->new(
- db_dsn => 'dbi:'.$Conf::global{'database_type'}.':dbname='.$dbname.';host='.$Conf::global{'database_host'},
- db_username => $Conf::global{'database_user'},
- db_password => $Conf::global{'database_password'},
- db_options => { AutoCommit => 1, ChopBlanks => 1 },
- class_prefix => 'IdPAccountManager::Data',
- #with_unique_keys => 0,
- );
-
-$loader->make_modules(with_managers => 1,
- module_dir => '/tmp',
- #with_relationships => ['one to many','many to one']
- );
-
-printf "Database-related code created in /tmp/IdPAccountManager. You should copy this code in lib/ directory\n";
\ No newline at end of file
+$loader = Rose::DB::Object::Loader->new(
+ db_dsn => 'dbi:'
+ . $Conf::global{'database_type'}
+ . ':dbname='
+ . $dbname
+ . ';host='
+ . $Conf::global{'database_host'},
+ db_username => $Conf::global{'database_user'},
+ db_password => $Conf::global{'database_password'},
+ db_options => { AutoCommit => 1, ChopBlanks => 1 },
+ class_prefix => 'IdPAccountManager::Data',
+
+ #with_unique_keys => 0,
+);
+
+$loader->make_modules(
+ with_managers => 1,
+ module_dir => '/tmp',
+
+ #with_relationships => ['one to many','many to one']
+);
+
+printf
+"Database-related code created in /tmp/IdPAccountManager. You should copy this code in lib/ directory\n";
diff --git a/bin/make_pdf_from_pod.pl b/bin/make_pdf_from_pod.pl
index 96391a2c326ce2f7067769e8b3fc4ec7aa81d011..ee375a0e6031ece8584a61751c0878540f2073e3 100644
--- a/bin/make_pdf_from_pod.pl
+++ b/bin/make_pdf_from_pod.pl
@@ -12,8 +12,8 @@ BEGIN {
}
{
- # a simple class that uses App::pod2pdf to create pdfs containing many pod files
- # The hierarchical outline is generated on the fly while traversing directories
+# a simple class that uses App::pod2pdf to create pdfs containing many pod files
+# The hierarchical outline is generated on the fly while traversing directories
package MultiPDF;
use Moose;
@@ -21,23 +21,23 @@ BEGIN {
use App::pod2pdf;
has parser => (
- is => 'ro',
- isa => 'App::pod2pdf',
- lazy => 1,
+ is => 'ro',
+ isa => 'App::pod2pdf',
+ lazy => 1,
default => sub { App::pod2pdf->new },
);
has pdf => (
- is => 'ro',
- isa => 'PDF::API2',
- lazy => 1,
+ is => 'ro',
+ isa => 'PDF::API2',
+ lazy => 1,
builder => '_build_pdf',
);
sub _build_pdf {
my $self = shift;
- $self->parser->{pdf},
+ $self->parser->{pdf},;
}
sub process_file {
@@ -48,31 +48,32 @@ BEGIN {
$self->parser->parse_from_file($file->stringify);
$self->parser->formfeed;
-
+
return $self;
}
sub process_dir {
my $self = shift;
- my $dir = Path::Class::Dir->new(shift);
+ my $dir = Path::Class::Dir->new(shift);
- my %structure; # { _outline => PDF::API2::Outline }
+ my %structure; # { _outline => PDF::API2::Outline }
$dir->recurse(
depthfirst => 1,
- callback => sub {
+ callback => sub {
my $file = shift;
- return if !-f $file || $file->basename !~ m{[.](?:pm|pod|pl) \z}xms;
-
+ return
+ if !-f $file || $file->basename !~ m{[.](?:pm|pod|pl) \z}xms;
+
## Look for POD tags to skip files without documentation
- my $fh = $file->open or die "Failed to open ".$file->basename ;
+ my $fh = $file->open or die "Failed to open " . $file->basename;
my $has_pod = 0;
while (<$fh>) {
$has_pod = 1 if (/^=head1/);
}
close $fh;
-
+
return unless ($has_pod);
my $nr_pages = $self->pdf->pages;
@@ -81,18 +82,22 @@ BEGIN {
my $name = $file->basename;
$name =~ s{[.]\w+ \z}{}xms;
- my $tree = \%structure;
- my $outline = $structure{_outline} ||= $self->pdf->outlines->outline;
+ my $tree = \%structure;
+ my $outline = $structure{_outline} ||=
+ $self->pdf->outlines->outline;
- foreach my $part (grep { $_ ne '.' } $file->relative($dir)->dir->dir_list, $name) {
- $tree = $tree->{$part} ||= { _outline => $outline->outline };
+ foreach my $part (grep { $_ ne '.' }
+ $file->relative($dir)->dir->dir_list, $name)
+ {
+ $tree = $tree->{$part} ||=
+ { _outline => $outline->outline };
$outline = $tree->{_outline};
$outline->title($part);
}
$outline->dest($self->pdf->openpage($nr_pages));
}
);
-
+
return $self;
}
@@ -110,6 +115,4 @@ BEGIN {
}
}
-MultiPDF->new
- ->process_dir($ARGV[0])
- ->save_as($ARGV[1]);
+MultiPDF->new->process_dir($ARGV[0])->save_as($ARGV[1]);
diff --git a/conf/Conf.pm b/conf/Conf.pm
index 3635f7eb1fe544e1d47c3e4e49ad6e4d5d5f539a..27f31b8be33fccfbc274a83b9b3da4e699b6fcca 100644
--- a/conf/Conf.pm
+++ b/conf/Conf.pm
@@ -1,87 +1,92 @@
package Conf;
our %global = (
-
+
## Code version
'version' => 'open Beta 1',
-
+
## Name of the application used in web pages, mail notices
'app_name' => 'eduGAIN Access Check',
-
+
## URL of the application
'app_url' => 'https://my.fqdn/accountmanager',
-
+
## Validity period of test accounts, in days
'accounts_validity_period' => 7,
-
+
## Token validity period, in hours
'tokens_validity_period' => 2,
## Scope used by the associated IdP
'idp_scope' => 'my.fqdn',
-
+
## EntityID of the IdP
'idp_entityid' => 'https://my.fqdn/simplesaml/saml2/idp/metadata.php',
-
+
## Name of the IdP
'idp_displayname' => 'eduGAIN Access Check',
-
+
## Root simpleSamlPhp directory
'root_ssp_dir' => '/opt/testidp/simplesamlphp',
-
+
## Root test account manager directory
'root_manager_dir' => '/opt/testidp/IdPAccountManager',
-
+
## Database type refers to a Perl Database Driver name
## However only a subset of existing DBDs are supported by Rose::DB::Object:
## Pg, mysql, SQLite, Informix, Oracle (DBD names are case sensitives)
'database_type' => 'mysql',
-
+
## Database hostname
'database_host' => 'localhost',
-
+
## Database_name
'database_name' => 'idp_account_manager',
-
+
## Database username
'database_user' => 'idpadmin',
-
+
## Database user password
'database_password' => 'secret',
-
+
## Log file for the manager
'log_file' => '/opt/testidp/IdPAccountManager/log/manager.log',
-
+
## Log level : debug, info, trace, notice, error
'log-level' => 'info',
-
+
## email address to contact admins
'admin_email' => 'john@my.fqdn',
-
+
## email address to ask for support
'support_email' => 'support@my.fqdn',
-
+
## Development feature
## Protection to prevent notifications during test dev phases
## Notify only admin_email above
'dev_no_mail_outside' => 1,
-
+
## Development feature
## hard-coded list of contactPersons
## these email addresses will be added to the list of contacts for any SP
'dev_sp_contact' => 'john@my.fqdn,sarah@my.fqdn',
-
+
## From field use by the account manager
'notice_from' => 'edugain-access-check.fqdn',
-
+
## federation metadata local copy path
- 'federation_metadata_file_path' => '/opt/testidp/IdPAccountManager/conf/edugain-md.xml',
-
+ 'federation_metadata_file_path' =>
+ '/opt/testidp/IdPAccountManager/conf/edugain-md.xml',
+
## Valid account profiles
- 'account_profiles' => ['fullset1','limitedset1','generic1','student1','student2','teacher1','teacher2','alumni1','librarywalkin1','employee1','researcher1'],
+ 'account_profiles' => [
+ 'fullset1', 'limitedset1', 'generic1', 'student1',
+ 'student2', 'teacher1', 'teacher2', 'alumni1',
+ 'librarywalkin1', 'employee1', 'researcher1'
+ ],
);
-
-1; # Magic true value required at end of module
+
+1; # Magic true value required at end of module
__END__
=head1 NAME
diff --git a/lib/IdPAccountManager/AuthenticationToken.pm b/lib/IdPAccountManager/AuthenticationToken.pm
index f64cbd533f8fc9a8ae8e4b2bc54dd2730a944538..6a3ba9b80b46fae00671394f2fbc25eb19bdf432 100644
--- a/lib/IdPAccountManager/AuthenticationToken.pm
+++ b/lib/IdPAccountManager/AuthenticationToken.pm
@@ -4,7 +4,6 @@ package IdPAccountManager::AuthenticationToken;
## This software was developed by RENATER. The research leading to these results has received funding
## from the European Community¹s Seventh Framework Programme (FP7/2007-2013) under grant agreement nº 238875 (GÉANT).
-
use strict;
use IdPAccountManager::Data::Authenticationtoken;
@@ -16,15 +15,15 @@ use Conf;
use Digest::MD5;
require Exporter;
-my @ISA = qw(Exporter);
+my @ISA = qw(Exporter);
my @EXPORT = qw();
use Carp;
INIT {
- ## Set error mode to non fatal
- IdPAccountManager::Data::Authenticationtoken::Manager->error_mode('return');
- }
+ ## Set error mode to non fatal
+ IdPAccountManager::Data::Authenticationtoken::Manager->error_mode('return');
+}
sub new {
my ($pkg) = shift;
@@ -34,57 +33,60 @@ sub new {
## Bless AuthenticationToken object
bless $self, $pkg;
-
+
## Object may be created either with a hashref as argument or an IdPAccountManager::Data::Authenticationtoken object
## Second case is usefull when fetching a set of IdPAccountManager::Data::Authenticationtoken via IdPAccountManager::Data::Authenticationtoken::Manager
if (ref($_[0]) eq 'IdPAccountManager::Data::Authenticationtoken') {
$self->{'persistent'} = $_[0];
- }else {
- $self->{'persistent'} = IdPAccountManager::Data::Authenticationtoken->new(%args);
+ } else {
+ $self->{'persistent'} =
+ IdPAccountManager::Data::Authenticationtoken->new(%args);
}
-
+
return $self;
}
## Load an authentication token from DB
sub load {
my $self = shift;
-
+
return $self->{'persistent'}->load(speculative => 1);
}
## Get object parameter
sub get {
- my $self = shift;
+ my $self = shift;
my $attribute_name = shift;
-
+
return $self->{'persistent'}->$attribute_name;
}
## Set object parameters
sub set {
- my $self = shift;
+ my $self = shift;
my %parameters = @_;
-
+
foreach my $parameter_name (keys %parameters) {
$self->{'persistent'}->$parameter_name($parameters{$parameter_name});
}
-
+
return 1;
}
## Save object to DB
sub save {
my $self = shift;
-
+
## If no id is defined, it is a new account
unless (defined $self->{'persistent'}->id) {
$self->{'persistent'}->creation_date(time);
- $self->{'persistent'}->token(&_generate_token($self->{'persistent'}->{'email_address'}));
+ $self->{'persistent'}
+ ->token(&_generate_token($self->{'persistent'}->{'email_address'}));
}
-
+
unless ($self->{'persistent'}->save()) {
- IdPAccountManager::Tools::do_log('error', "Failed to save Authenticationtoken in DB");
+ IdPAccountManager::Tools::do_log('error',
+ "Failed to save Authenticationtoken in DB");
return undef;
}
}
@@ -92,9 +94,10 @@ sub save {
## Delete a test account
sub delete {
my $self = shift;
-
+
unless ($self->{'persistent'}->delete()) {
- IdPAccountManager::Tools::do_log('error', "Failed to delete a Authenticationtoken in DB");
+ IdPAccountManager::Tools::do_log('error',
+ "Failed to delete a Authenticationtoken in DB");
return undef;
}
}
@@ -103,12 +106,14 @@ sub delete {
sub print {
my $self = shift;
my $fd = shift || \*STDOUT;
-
- printf $fd "AuthenticationToken ID=%s; token=%s; email_address=%s; sp_entityid=%s; creation_date=%s\n",
- $self->get('id'), $self->get('token'), $self->get('email_address'), $self->get('sp_entityid'),
- &POSIX::strftime('%Y:%m:%d', localtime($self->get('creation_date')));
- return 1.
+ printf $fd
+"AuthenticationToken ID=%s; token=%s; email_address=%s; sp_entityid=%s; creation_date=%s\n",
+ $self->get('id'), $self->get('token'), $self->get('email_address'),
+ $self->get('sp_entityid'),
+ &POSIX::strftime('%Y:%m:%d', localtime($self->get('creation_date')));
+
+ return 1.;
}
## list all authentication tokens
@@ -116,13 +121,16 @@ sub print {
sub list_authentication_tokens {
my %args = @_;
- my $persistent_tokens = IdPAccountManager::Data::Authenticationtoken::Manager->get_authenticationtokens(%args);
+ my $persistent_tokens =
+ IdPAccountManager::Data::Authenticationtoken::Manager
+ ->get_authenticationtokens(%args);
my $authentication_tokens;
foreach my $persistent_token (@{$persistent_tokens}) {
- my $authentication_token = new IdPAccountManager::AuthenticationToken($persistent_token);
+ my $authentication_token =
+ new IdPAccountManager::AuthenticationToken($persistent_token);
push @$authentication_tokens, $authentication_token;
}
-
+
return $authentication_tokens;
}
@@ -132,10 +140,10 @@ sub _generate_token {
my $size = shift || 20;
## ID is based on time + PID
- return substr(Digest::MD5::md5_hex(time.$$.$salt), -1*$size);
+ return substr(Digest::MD5::md5_hex(time . $$ . $salt), -1 * $size);
}
-1; # Magic true value required at end of module
+1; # Magic true value required at end of module
__END__
=head1 NAME
diff --git a/lib/IdPAccountManager/Data/Testaccount.pm b/lib/IdPAccountManager/Data/Testaccount.pm
index 8c33b1d122aad24bcb0f6b0105496e69e675d3bb..3ecd53e74495fc636c82560ff7bdebceda6543df 100644
--- a/lib/IdPAccountManager/Data/Testaccount.pm
+++ b/lib/IdPAccountManager/Data/Testaccount.pm
@@ -5,18 +5,19 @@ use strict;
use base qw(IdPAccountManager::Data::DB::Object::AutoBase2);
__PACKAGE__->meta->setup(
- table => 'testaccounts',
+ table => 'testaccounts',
columns => [
- id => { type => 'bigserial', not_null => 1 },
- user_password_hash => { type => 'varchar', length => 50, not_null => 1 },
- creation_date => { type => 'integer' },
- expiration_date => { type => 'integer' },
- account_profile => { type => 'varchar', length => 100, not_null => 1 },
- sp_entityid => { type => 'varchar', length => 250, not_null => 1 },
+ id => { type => 'bigserial', not_null => 1 },
+ user_password_hash =>
+ { type => 'varchar', length => 50, not_null => 1 },
+ creation_date => { type => 'integer' },
+ expiration_date => { type => 'integer' },
+ account_profile => { type => 'varchar', length => 100, not_null => 1 },
+ sp_entityid => { type => 'varchar', length => 250, not_null => 1 },
],
- primary_key_columns => [ 'id' ],
+ primary_key_columns => ['id'],
);
1;
diff --git a/lib/IdPAccountManager/SAMLMetadata.pm b/lib/IdPAccountManager/SAMLMetadata.pm
index 64c48b71d94c70f135f4df4044710a3bd2bbc61b..d1dbd1c68ef701a7a52b7122ad460ec2b0178a62 100644
--- a/lib/IdPAccountManager/SAMLMetadata.pm
+++ b/lib/IdPAccountManager/SAMLMetadata.pm
@@ -1,4 +1,4 @@
-package IdPAccountManager::SAMLMetadata;
+package IdPAccountManager::SAMLMetadata;
## Copyright (c) GEANT
## This software was developed by RENATER. The research leading to these results has received funding
@@ -12,7 +12,7 @@ use Conf;
use XML::LibXML;
require Exporter;
-my @ISA = qw(Exporter);
+my @ISA = qw(Exporter);
my @EXPORT = qw();
use Carp;
@@ -25,60 +25,73 @@ sub new {
## Bless SAMLMetadata object
bless $self, $pkg;
-
+
return $self;
}
## Load metadata
sub load {
my $self = shift;
- my %in = @_;
-
+ my %in = @_;
+
unless ($in{'federation_metadata_file_path'}) {
- &IdPAccountManager::Tools::do_log('error', "Missing parameter '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'};
-
+
+ $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'} : $!");
+ &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());
+
+ 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 $self = shift;
my %options = @_;
-
- my %parser_args = ('metadata_as_xml' => $self->{'federation_metadata_as_xml'},
- 'filter_entity_type' => 'sp');
-
+
+ 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);
+
+ $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");
+ &IdPAccountManager::Tools::do_log('error',
+ "Failed to parse federation metadata");
return undef;
}
-
+
return 1;
}
@@ -86,11 +99,11 @@ sub parse {
sub print {
my $self = shift;
my $fd = shift || \*STDOUT;
-
+
my $root = $self->{'federation_metadata_as_xml'}->documentElement();
print $fd $root->toString();
- return 1.
+ return 1.;
}
## Internal function
@@ -100,34 +113,39 @@ sub _get_xml_object {
&IdPAccountManager::Tools::do_log('debug', "");
unless (-f $metadata_file) {
- &IdPAccountManager::Tools::do_log('error', "File $metadata_file not found: $!");
- return undef;
+ &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;
+
+ 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;
+ &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)};
+ eval { $doc = $parser->parse_fh(\*FH) };
if ($@) {
- &IdPAccountManager::Tools::do_log('error', "Failed to parse file $metadata_file : $@");
- return undef;
+ &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;
+ &IdPAccountManager::Tools::do_log('error',
+ "Failed to parse file $metadata_file : $!");
+ return undef;
}
return $doc;
@@ -136,174 +154,245 @@ sub _get_xml_object {
## 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());
+ #&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());
}
-
- }
-
- 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;
+ }
+ }
+ } 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
+1; # Magic true value required at end of module
__END__
=head1 NAME
diff --git a/lib/IdPAccountManager/ServiceProvider.pm b/lib/IdPAccountManager/ServiceProvider.pm
index 5c6df0b23f2884f19bc7e68917fbe86213ed2779..cd61788d6647caed798f70e6ec7493e88ea2bf51 100644
--- a/lib/IdPAccountManager/ServiceProvider.pm
+++ b/lib/IdPAccountManager/ServiceProvider.pm
@@ -14,54 +14,54 @@ use IdPAccountManager::Tools;
use Conf;
require Exporter;
-my @ISA = qw(Exporter);
+my @ISA = qw(Exporter);
my @EXPORT = qw();
use Carp;
-INIT {
- ## Set error mode to non fatal
- IdPAccountManager::Data::Serviceprovider::Manager->error_mode('return');
- }
-
+INIT {
+ ## Set error mode to non fatal
+ IdPAccountManager::Data::Serviceprovider::Manager->error_mode('return');
+}
## Print the content of a test account
sub print {
my $self = shift;
my $fd = shift || \*STDOUT;
-
- printf $fd "ServiceProvider ID=%s; entityid=%s; displayname=%s; contacts=%s\n",
- $self->id, $self->entityid, $self->displayname, $self->contacts;
- return 1.
+ printf $fd
+ "ServiceProvider ID=%s; entityid=%s; displayname=%s; contacts=%s\n",
+ $self->id, $self->entityid, $self->displayname, $self->contacts;
+
+ return 1.;
}
## list contacts for this SP, including those listed in conf.dev_sp_contact
sub list_contacts_as_array {
my $self = shift;
-
+
my %contact_list;
-
+
foreach my $contact_email (split /,/, $self->contacts()) {
$contact_list{$contact_email}++;
}
-
- foreach my $contact_email (split /,/, $Conf::global{'dev_sp_contact'}) {
+
+ foreach my $contact_email (split /,/, $Conf::global{'dev_sp_contact'}) {
$contact_list{$contact_email}++;
- }
-
+ }
+
return keys %contact_list;
}
## Check if email address is a known contact (or conf.dev_sp_contact)
sub is_contact {
- my $self = shift;
+ my $self = shift;
my $email = shift;
-
+
foreach my $known_contact ($self->list_contacts_as_array()) {
return 1 if (lc($email) eq lc($known_contact));
}
-
+
return 0;
}
@@ -70,19 +70,22 @@ sub is_contact {
sub list_service_providers {
my %args = @_;
- my $persistent_accounts= IdPAccountManager::Data::Serviceprovider::Manager->get_serviceproviders(%args);
+ my $persistent_accounts =
+ IdPAccountManager::Data::Serviceprovider::Manager->get_serviceproviders(
+ %args);
my $service_providers;
foreach my $persistent_sp (@{$persistent_accounts}) {
- my $service_provider = new IdPAccountManager::ServiceProvider(entityid => $persistent_sp->entityid());
+ my $service_provider =
+ new IdPAccountManager::ServiceProvider(
+ entityid => $persistent_sp->entityid());
$service_provider->load();
push @$service_providers, $service_provider;
}
-
+
return $service_providers;
}
-
-1; # Magic true value required at end of module
+1; # Magic true value required at end of module
__END__
=head1 NAME
diff --git a/lib/IdPAccountManager/TestAccount.pm b/lib/IdPAccountManager/TestAccount.pm
index b87f5a087f51e62b6726f5d4aba7b120f025f4e0..2dee16dda3d409fee65375638323a51c6f7f670f 100644
--- a/lib/IdPAccountManager/TestAccount.pm
+++ b/lib/IdPAccountManager/TestAccount.pm
@@ -13,15 +13,15 @@ use IdPAccountManager::Tools;
use Conf;
require Exporter;
-my @ISA = qw(Exporter);
+my @ISA = qw(Exporter);
my @EXPORT = qw();
use Carp;
INIT {
- ## Set error mode to non fatal
- IdPAccountManager::Data::Testaccount::Manager->error_mode('return');
- }
+ ## Set error mode to non fatal
+ IdPAccountManager::Data::Testaccount::Manager->error_mode('return');
+}
sub new {
my ($pkg) = shift;
@@ -31,26 +31,27 @@ sub new {
## Bless Provider object
bless $self, $pkg;
-
+
## Object may be created either with a hashref as argument or an IdPAccountManager::Data::Testaccount object
## Second case is usefull when fetching a set of IdPAccountManager::Data::Testaccount via IdPAccountManager::Data::Testaccount::Manager
if (ref($_[0]) eq 'IdPAccountManager::Data::Testaccount') {
$self->{'persistent'} = $_[0];
- }else {
- $self->{'persistent'} = IdPAccountManager::Data::Testaccount->new(%args);
+ } else {
+ $self->{'persistent'} =
+ IdPAccountManager::Data::Testaccount->new(%args);
}
-
+
return $self;
}
sub get {
- my $self = shift;
+ my $self = shift;
my $attribute_name = shift;
-
+
## User password is not stored in DB
if ($attribute_name eq 'user_password') {
return $self->{$attribute_name};
- }else {
+ } else {
return $self->{'persistent'}->$attribute_name;
}
@@ -58,17 +59,21 @@ sub get {
sub save {
my $self = shift;
-
+
## If no id is defined, it is a new account
unless (defined $self->{'persistent'}->id) {
$self->{'persistent'}->creation_date(time);
- $self->{'persistent'}->expiration_date(time + ($Conf::global{'accounts_validity_period'} * 3600 * 24));
- $self->{'user_password'} = &IdPAccountManager::Tools::generate_password();
- $self->{'persistent'}->user_password_hash(&IdPAccountManager::Tools::sha256_hash($self->{'user_password'}));
+ $self->{'persistent'}->expiration_date(
+ time + ($Conf::global{'accounts_validity_period'} * 3600 * 24));
+ $self->{'user_password'} =
+ &IdPAccountManager::Tools::generate_password();
+ $self->{'persistent'}->user_password_hash(
+ &IdPAccountManager::Tools::sha256_hash($self->{'user_password'}));
}
-
+
unless ($self->{'persistent'}->save()) {
- IdPAccountManager::Tools::do_log('error', "Failed to save Test Account in DB");
+ IdPAccountManager::Tools::do_log('error',
+ "Failed to save Test Account in DB");
return undef;
}
}
@@ -76,9 +81,10 @@ sub save {
## Delete a test account
sub delete {
my $self = shift;
-
+
unless ($self->{'persistent'}->delete()) {
- IdPAccountManager::Tools::do_log('error', "Failed to delete a test account in DB");
+ IdPAccountManager::Tools::do_log('error',
+ "Failed to delete a test account in DB");
return undef;
}
}
@@ -87,12 +93,15 @@ sub delete {
sub print {
my $self = shift;
my $fd = shift || \*STDOUT;
-
- printf $fd "Account ID=%s; password_hash=%s; sp_entityid=%s; account_profile=%s; creation_date=%s; expiration_date=%s\n",
- $self->get('id'), $self->get('user_password_hash'), $self->get('sp_entityid'), $self->get('account_profile'),
- &POSIX::strftime('%Y:%m:%d', localtime($self->get('creation_date'))), &POSIX::strftime('%Y:%m:%d', localtime($self->get('expiration_date')));
- return 1.
+ printf $fd
+"Account ID=%s; password_hash=%s; sp_entityid=%s; account_profile=%s; creation_date=%s; expiration_date=%s\n",
+ $self->get('id'), $self->get('user_password_hash'),
+ $self->get('sp_entityid'), $self->get('account_profile'),
+ &POSIX::strftime('%Y:%m:%d', localtime($self->get('creation_date'))),
+ &POSIX::strftime('%Y:%m:%d', localtime($self->get('expiration_date')));
+
+ return 1.;
}
## list all test accounts
@@ -100,13 +109,14 @@ sub print {
sub list_test_accounts {
my %args = @_;
- my $persistent_accounts= IdPAccountManager::Data::Testaccount::Manager->get_testaccounts(%args);
+ my $persistent_accounts =
+ IdPAccountManager::Data::Testaccount::Manager->get_testaccounts(%args);
my $accounts;
foreach my $persistent_account (@{$persistent_accounts}) {
my $account = new IdPAccountManager::TestAccount($persistent_account);
push @$accounts, $account;
}
-
+
return $accounts;
}
@@ -114,25 +124,30 @@ sub list_test_accounts {
sub create_test_accounts_for_sp {
my %args = @_;
my @test_accounts;
-
+
unless ($args{'sp_entityid'}) {
- IdPAccountManager::Tools::do_log('error',"Failed to create test account");
+ IdPAccountManager::Tools::do_log('error',
+ "Failed to create test account");
return undef;
}
-
- foreach my $profile (@{$Conf::global{'account_profiles'}}) {
- my $test_account = new IdPAccountManager::TestAccount(account_profile => $profile,
- sp_entityid => $args{'sp_entityid'});
+
+ foreach my $profile (@{ $Conf::global{'account_profiles'} }) {
+ my $test_account = new IdPAccountManager::TestAccount(
+ account_profile => $profile,
+ sp_entityid => $args{'sp_entityid'}
+ );
unless (defined $test_account) {
- IdPAccountManager::Tools::do_log('error',"Failed to create test account");
- return undef;
+ IdPAccountManager::Tools::do_log('error',
+ "Failed to create test account");
+ return undef;
}
-
+
unless ($test_account->save()) {
- IdPAccountManager::Tools::do_log('error',"Failed to create test account");
+ IdPAccountManager::Tools::do_log('error',
+ "Failed to create test account");
return undef;
}
-
+
push @test_accounts, $test_account;
}
@@ -141,7 +156,7 @@ sub create_test_accounts_for_sp {
#before 'new' => sub { print "about to call new\n"; };
-1; # Magic true value required at end of module
+1; # Magic true value required at end of module
__END__
=head1 NAME
diff --git a/lib/IdPAccountManager/Tools.pm b/lib/IdPAccountManager/Tools.pm
index a661d3a0bdfbecbfaca3c1805b4f31dcbd40d5a4..e4f1bd560de1195b80322b90a590fe611c543eac 100644
--- a/lib/IdPAccountManager/Tools.pm
+++ b/lib/IdPAccountManager/Tools.pm
@@ -12,14 +12,15 @@ use Template::Stash;
use Digest::SHA;
use Encode;
-my %log_levels = ('debug' => 0, 'info' => 1, 'trace' => 1, 'notice' => 2, 'error' => 3);
+my %log_levels =
+ ('debug' => 0, 'info' => 1, 'trace' => 1, 'notice' => 2, 'error' => 3);
INIT {
## a TT2 virtual method to get a variable type
$Template::Stash::LIST_OPS->{isa} = sub {
my $list = shift;
my $type = shift;
-
+
return 1 if ($type eq 'ARRAY');
return 0;
};
@@ -35,128 +36,150 @@ INIT {
# get SHA256 hash for a string
sub sha256_hash {
my $s = shift;
-
+
return &Digest::SHA::sha256_base64($s);
}
# This function generates a random password
-sub generate_password{
- my $length_of_randomstring=10;# the length of
- # the random string to generate
-
- # plusieurs tirages :
- # 1-tirage des caractères obligatoires : les mettre dans un tableau
- my @uppers=('A'..'N','P'..'Z');
- my @lowers=('a'..'k','m'..'z');
- my @punctuation=(':','!','?','&','$','=','-','#');
- my @numerics=('0'..'9');
- my @rndtab;
- push(@rndtab,$uppers[rand @uppers]);
- push(@rndtab,$lowers[rand @lowers]);
- push(@rndtab,$punctuation[rand @punctuation]);
-
- ## Pas de caractères 8bit pour l'antispam
- push(@rndtab,$numerics[rand @numerics]);
-
- # 2-tirage des caractères optionnels : les ajouter au tableau
- my @chars=('a'..'k','m'..'z','A'..'N','P'..'Z','0'..'9','_','%',';',':','!','?','&','$','*','(',')','{','}','[',']','.','=','-','#');
- foreach (6..$length_of_randomstring) {
- # rand @chars will generate a random
- # number between 0 and scalar @chars
- push(@rndtab,$chars[rand @chars]);
- }
-
- # 3-ordonnancement de ceux-ci : les retirer aléatoirement du tableau en les concaténant dans une chaîne
- my $rndstring='';
- my $cpt=1;
- while($cpt<=$length_of_randomstring) {
- my $indice = rand @rndtab;
- $rndstring.=$rndtab[$indice];
- splice (@rndtab, $indice, 1);
- $cpt+=1;
- }
- return $rndstring;
+sub generate_password {
+ my $length_of_randomstring = 10; # the length of
+ # the random string to generate
+
+ # plusieurs tirages :
+ # 1-tirage des caractères obligatoires : les mettre dans un tableau
+ my @uppers = ('A' .. 'N', 'P' .. 'Z');
+ my @lowers = ('a' .. 'k', 'm' .. 'z');
+ my @punctuation = (':', '!', '?', '&', '$', '=', '-', '#');
+ my @numerics = ('0' .. '9');
+ my @rndtab;
+ push(@rndtab, $uppers[ rand @uppers ]);
+ push(@rndtab, $lowers[ rand @lowers ]);
+ push(@rndtab, $punctuation[ rand @punctuation ]);
+
+ ## Pas de caractères 8bit pour l'antispam
+ push(@rndtab, $numerics[ rand @numerics ]);
+
+ # 2-tirage des caractères optionnels : les ajouter au tableau
+ my @chars = (
+ 'a' .. 'k', 'm' .. 'z', 'A' .. 'N', 'P' .. 'Z',
+ '0' .. '9', '_', '%', ';',
+ ':', '!', '?', '&',
+ '$', '*', '(', ')',
+ '{', '}', '[', ']',
+ '.', '=', '-', '#'
+ );
+ foreach (6 .. $length_of_randomstring) {
+
+ # rand @chars will generate a random
+ # number between 0 and scalar @chars
+ push(@rndtab, $chars[ rand @chars ]);
+ }
+
+# 3-ordonnancement de ceux-ci : les retirer aléatoirement du tableau en les concaténant dans une chaîne
+ my $rndstring = '';
+ my $cpt = 1;
+ while ($cpt <= $length_of_randomstring) {
+ my $indice = rand @rndtab;
+ $rndstring .= $rndtab[$indice];
+ splice(@rndtab, $indice, 1);
+ $cpt += 1;
+ }
+ return $rndstring;
}
## Updates simpleSamlPhp authsources.php configuration file
sub update_ssp_authsources {
-
- my $tt2 = Template->new({'INCLUDE_PATH' => $Conf::global{'root_manager_dir'}.':'.$Conf::global{'root_manager_dir'}.'/templates/accountProfiles'});
- my %args = ('accounts' => IdPAccountManager::TestAccount::list_test_accounts(),
- 'conf' => \%Conf::global);
-
+
+ my $tt2 = Template->new(
+ {
+ 'INCLUDE_PATH' => $Conf::global{'root_manager_dir'} . ':'
+ . $Conf::global{'root_manager_dir'}
+ . '/templates/accountProfiles'
+ }
+ );
+ my %args = (
+ 'accounts' => IdPAccountManager::TestAccount::list_test_accounts(),
+ 'conf' => \%Conf::global
+ );
+
#chdir $Conf::global{'root_manager_dir'};
-
+
my $template_file = 'templates/accountProfiles/valid-accounts.php.tt2';
- my $output_file = 'conf/valid-accounts.php';
+ my $output_file = 'conf/valid-accounts.php';
+
#printf "Trace : in=%s, out=%s\n", $template_file, $output_file;
unless ($tt2->process($template_file, \%args, $output_file)) {
- IdPAccountManager::Tools::do_log('error', "Failed to update valid-accounts.php: %s", $tt2->error());
+ IdPAccountManager::Tools::do_log('error',
+ "Failed to update valid-accounts.php: %s",
+ $tt2->error());
return undef;
}
-
+
}
## Dump a variable's content
sub dump_var {
my ($var, $level, $fd) = @_;
-
+
if (ref($var)) {
if (ref($var) eq 'ARRAY') {
- foreach my $index (0..$#{$var}) {
- print $fd "\t"x$level.$index."\n";
- &dump_var($var->[$index], $level+1, $fd);
+ foreach my $index (0 .. $#{$var}) {
+ print $fd "\t" x $level . $index . "\n";
+ &dump_var($var->[$index], $level + 1, $fd);
}
- }elsif (ref($var) eq 'HASH') {
+ } elsif (ref($var) eq 'HASH') {
foreach my $key (sort keys %{$var}) {
- print $fd "\t"x$level.'_'.$key.'_'."\n";
- &dump_var($var->{$key}, $level+1, $fd);
- }
- }else {
+ print $fd "\t" x $level . '_' . $key . '_' . "\n";
+ &dump_var($var->{$key}, $level + 1, $fd);
+ }
+ } else {
if (defined $var) {
- print $fd "\t"x$level."'$var'"."\n";
- }else {
- print $fd "\t"x$level."UNDEF\n";
+ print $fd "\t" x $level . "'$var'" . "\n";
+ } else {
+ print $fd "\t" x $level . "UNDEF\n";
}
}
- }else {
+ } else {
if (defined $var) {
- print $fd "\t"x$level."'$var'"."\n";
- }else {
- print $fd "\t"x$level."UNDEF\n";
+ print $fd "\t" x $level . "'$var'" . "\n";
+ } else {
+ print $fd "\t" x $level . "UNDEF\n";
}
}
}
sub do_log {
- my $level = shift;
+ my $level = shift;
my $message = shift;
- unless ($log_levels{$level} < $log_levels{$Conf::global{'log_level'}}) {
+ unless ($log_levels{$level} < $log_levels{ $Conf::global{'log_level'} }) {
## Determine calling function and parameters
## If in 'err' level, build a stack trace
my $caller_string;
- if ($level eq 'error'){
+ if ($level eq 'error') {
my $go_back = 1;
my @calls;
while (my @call = caller($go_back)) {
- unshift @calls, $call[3].'#'.$call[2];
+ unshift @calls, $call[3] . '#' . $call[2];
$go_back++;
}
-
- $caller_string = join(' > ',@calls);
- }else {
+
+ $caller_string = join(' > ', @calls);
+ } else {
my @call = caller(1);
-
- $caller_string = $call[3].'()';
+
+ $caller_string = $call[3] . '()';
}
$level = uc($level);
- my $ip = $ENV{'REMOTE_HOST'}.'/'.$ENV{'REMOTE_ADDR'} || 'NOIP';
- my $date = POSIX::strftime ("%Y:%m:%d %H:%M:%S", localtime(time));
+ my $ip = $ENV{'REMOTE_HOST'} . '/' . $ENV{'REMOTE_ADDR'} || 'NOIP';
+ my $date = POSIX::strftime("%Y:%m:%d %H:%M:%S", localtime(time));
my $user = lc($ENV{'mail'}) || 'NOEMAIL';
- open LOG, ">>".$Conf::global{'log_file'}; printf LOG "$date - ($level) - $ip - $user - $caller_string $message\n", @_; close LOG;
+ open LOG, ">>" . $Conf::global{'log_file'};
+ printf LOG "$date - ($level) - $ip - $user - $caller_string $message\n",
+ @_;
+ close LOG;
}
return 1;
}
@@ -168,61 +191,77 @@ sub do_log {
## template : mail template file
## data : data used by the TT2 parser
sub mail_notice {
- my %in = @_;
- my $tt2_file = $in{'template'};
- my $mail_data = $in{'data'};
-
- $mail_data->{'conf'} ||= \%Conf::global;
-
- my $notice_email = $in{'to'} || $Conf::global{'admin_email'};
- $mail_data->{'to'} = $notice_email;
-
- ## Protection to prevent notifications during test dev phases
- ## Notify only admin_email or dev_sp_contact addresses
- if ($Conf::global{'dev_no_mail_outside'}) {
- my %rcpt = map {$_ => 1} split(/,/, $notice_email);
- my %authorized_rcpt = map {$_ => 1} split(/,/, join(',', $Conf::global{'admin_email'}, $Conf::global{'dev_sp_contact'}));
-
- my $change_rcpt = 0;
- foreach my $email (keys %rcpt) {
- unless ($authorized_rcpt{$email}) {
- $change_rcpt = 1;
- last
+ my %in = @_;
+ my $tt2_file = $in{'template'};
+ my $mail_data = $in{'data'};
+
+ $mail_data->{'conf'} ||= \%Conf::global;
+
+ my $notice_email = $in{'to'} || $Conf::global{'admin_email'};
+ $mail_data->{'to'} = $notice_email;
+
+ ## Protection to prevent notifications during test dev phases
+ ## Notify only admin_email or dev_sp_contact addresses
+ if ($Conf::global{'dev_no_mail_outside'}) {
+ my %rcpt = map { $_ => 1 } split(/,/, $notice_email);
+ my %authorized_rcpt = map { $_ => 1 } split(
+ /,/,
+ join(',',
+ $Conf::global{'admin_email'},
+ $Conf::global{'dev_sp_contact'})
+ );
+
+ my $change_rcpt = 0;
+ foreach my $email (keys %rcpt) {
+ unless ($authorized_rcpt{$email}) {
+ $change_rcpt = 1;
+ last;
+ }
+ }
+
+ if ($change_rcpt) {
+ &do_log(
+ 'info',
+"no_mail_outside option set; notification for %s rerouted to admins ; ",
+ $notice_email
+ );
+ $notice_email = $Conf::global{'admin_email'};
}
}
-
- if ($change_rcpt) {
- &do_log('info',"no_mail_outside option set; notification for %s rerouted to admins ; ", $notice_email);
- $notice_email = $Conf::global{'admin_email'};
- }
- }
- &do_log('trace', '(template=%s, to=%s)', $in{'template'}, $mail_data->{'to'});
+ &do_log('trace', '(template=%s, to=%s)',
+ $in{'template'}, $mail_data->{'to'});
- open SENDMAIL, "|/usr/sbin/sendmail -f ".$Conf::global{'notice_from'}." $notice_email";
+ open SENDMAIL,
+ "|/usr/sbin/sendmail -f "
+ . $Conf::global{'notice_from'}
+ . " $notice_email";
- my $tt2 = Template->new(FILTERS => {qencode => [\&qencode, 0]});
- unless ($tt2->process($tt2_file, $mail_data, \*SENDMAIL)) {
- &do_log('error', "Error TT2 : %s", $tt2->error());
- }
- close SENDMAIL;
+ my $tt2 = Template->new(FILTERS => { qencode => [ \&qencode, 0 ] });
+ unless ($tt2->process($tt2_file, $mail_data, \*SENDMAIL)) {
+ &do_log('error', "Error TT2 : %s", $tt2->error());
+ }
+ close SENDMAIL;
}
sub qencode {
my $string = shift;
+
# We are not able to determine the name of header field, so assume
- # longest (maybe) one.
- return MIME::EncWords::encode_mimewords(Encode::decode('utf8', $string),
- Encoding=>'A',
- Charset=> 'utf8',
- Field=>"subject");
+ # longest (maybe) one.
+ return MIME::EncWords::encode_mimewords(
+ Encode::decode('utf8', $string),
+ Encoding => 'A',
+ Charset => 'utf8',
+ Field => "subject"
+ );
}
## usefull to pass parameters to TT2
sub encode_utf8 ($) {
- my $string = shift||'';
-
- return Encode::encode('utf8', $string);
+ my $string = shift || '';
+
+ return Encode::encode('utf8', $string);
}
## Escape characters that may interfer in an XML document
@@ -234,35 +273,33 @@ sub escape_xml {
$s =~ s/\</<\;/gm;
$s =~ s/\>/>\;/gm;
$s =~ s/\'/'/gm;
-
+
return $s;
}
## usefull to pass parameters to TT2
sub escape_quotes {
- my $string = shift;
-
- $string =~ s/\'/\\\'/g;
-
- return $string;
+ my $string = shift;
+
+ $string =~ s/\'/\\\'/g;
+
+ return $string;
}
## returns an integer (0 or 1), given an input string ('true' or 'false')
sub boolean2integer {
- my $boolean = shift;
-
- if ($boolean eq 'true') {
- return 1;
- }elsif ($boolean eq 'false') {
- return 0;
- }
-
- return undef;
-}
+ my $boolean = shift;
+ if ($boolean eq 'true') {
+ return 1;
+ } elsif ($boolean eq 'false') {
+ return 0;
+ }
+ return undef;
+}
-1; # Magic true value required at end of module
+1; # Magic true value required at end of module
__END__
=head1 NAME