account-manager-web.pl

#!/usr/bin/perl

## 15/09/2014, Olivier Salaün
## Web interface for the eduGAIN Test IdP Account Manager

use strict vars;
use utf8;
use lib "/opt/testidp/IdPAccountManager/lib";
use lib "/opt/testidp/IdPAccountManager/conf";

use CGI;
use CGI::Cookie;
use CGI::Util;
use Template;
use Template::Constants qw( :debug );
use POSIX;

use IdPAccountManager::TestAccount;
use IdPAccountManager::SAMLMetadata;
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 $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'    },
               'get_sp_list' => {'title_en' => 'Select your Service Provider'    },
               'generate_token' => {'title_en' => 'Generate an authentication token'},
               'validate_token' => {'title_en' => 'Validate an authentication token'},
    );

## Gives writes for the group
umask 0002;

chdir $Conf::global{'root_manager_dir'};

my $request = new WebRequest;

if (defined $request) {
    $request->execute();
}

$request->respond();

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;
    }
  }
  
  ## 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'} = 'get_sp_list';
  }
        
  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;
}


## 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]},
                #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';
    }
    
    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;
     }
   }
      
   ## Mail notification of admins about the error
   if (@errors_admin) {
       &IdPAccountManager::Tools::mail_notice('template' => 'templates/mail/notification_generic_error.tt2.eml', 
         		 'data' => $self->{'param_out'});
   }
}

## Return the list of known SPs
sub req_get_sp_list {
    my $self = shift;
    &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->parse()) {
 	      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'};
    
    return 1;
}

## Select a Service Provider and return metadata sctucture for the SP
## Sample URL : https://dev-edugain.renater.fr/accountmanager?action=select_sp&sp_entityid=http%3A%2F%2Fsp.lat.csc.fi
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;
    }
    
    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->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;
   }

   $self->{'param_out'}{'sp_metadata_as_hashref'} = $federation_metadata->{'federation_metadata_as_hashref'}[0];

    
    return 1;
}

## Generate an authentication token to validate an email address
## Sample call : dev-edugain.renater.fr/accountmanager?action=generate_token&style=nobanner&sp_entityid=https%3A%2F%2Fsourcesup.cru.fr%2Fshibboleth&email_address=support%40renater.fr
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;
    }

    unless ($self->{'param_in'}{'email_address'}) {
        push @{$self->{'param_out'}{'errors'}}, "email_address";
	&IdPAccountManager::Tools::do_log('error', "Missing parameter email_address");
	return undef;
    }

    my $authentication_token = new IdPAccountManager::AuthenticationToken();
    unless (defined $authentication_token) {
 	push @{$self->{'param_out'}{'errors'}}, "internal";
	&IdPAccountManager::Tools::do_log('error', "Failed to create authentication token");
	return undef;
    }
    
    unless ($authentication_token->set('email_address' => $self->{'param_in'}{'email_address'},
                                       'sp_entityid' => $self->{'param_in'}{'sp_entityid'})) {
 	push @{$self->{'param_out'}{'errors'}}, "internal";
	&IdPAccountManager::Tools::do_log('error', "Failed to update 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;
    }
    
    $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'};    

    ## Send the challenge email with the token
    &IdPAccountManager::Tools::mail_notice('template' => 'templates/mail/send_authentication_token.tt2.eml', 
         		 'data' => $self->{'param_out'});
    
    return 1;
}

## 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;
    }

    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;
    }

    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'}{'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'}{'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'}{'token'});
    }
    
    ## create test accounts
    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;        
    }
    
    ## 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;        
    }
    
    $self->{'param_out'}{'sp_entityid'} = $self->{'param_in'}{'sp_entityid'};
    $self->{'param_out'}{'test_accounts'} = \@test_accounts;
    
    return 1;
}