WebRequest.pm

package IdPAccountManager::WebRequest;

use strict;
use warnings;

use CGI;
use English qw(-no_match_vars);
use Template;

use IdPAccountManager::Data::TestAccount;
use IdPAccountManager::Data::AuthenticationToken;
use IdPAccountManager::Data::ServiceProvider;
use IdPAccountManager::Logger;
use IdPAccountManager::SAMLMetadata;

## 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      => 'req_select_sp',
    account_wizard => 'req_account_wizard',
    generate_token => 'req_generate_token',
    validate_token => 'req_validation_token',
    home           => 'req_home',
);

## New web request
sub new {
    my ($pkg, %args) = @_;

    my $self = {
        configuration => $args{configuration},
    };

    $self->{logger} = IdPAccountManager::Logger->new(
        file      => $self->{configuration}->{log_file},
        verbosity => $self->{configuration}->{log_level}
    );
    $self->{logger}->log(
        level   => LOG_INFO,
        message => ''
    );

    IdPAccountManager::DB->register_db(
        driver          => $self->{configuration}->{database_type},
        database        => $self->{configuration}->{database_name},
        host            => $self->{configuration}->{database_host},
        password        => $self->{configuration}->{database_password},
        username        => $self->{configuration}->{database_user}
    );

    $self->{db} = IdPAccountManager::DB->new();
    $self->{cgi} = CGI->new();

    bless $self, $pkg;

    return $self;
}

sub run {
    my ($self) = @_;
    $self->execute();
    $self->respond();
}

## Execute a web request
sub execute {
    my ($self) = @_;
    $self->{logger}->log(level => LOG_DEBUG, message => "");

    my $status;

    # initialize output parameters
    $self->{out} = {
        env => {
            REMOTE_HOST => $ENV{REMOTE_HOST},
            REMOTE_ADDR => $ENV{REMOTE_ADDR},
            SCRIPT_NAME => $ENV{SCRIPT_NAME}
        },
        conf => {
            accounts_validity_period => $self->{configuration}->{accounts_validity_period},
            app_name                 => $self->{configuration}->{app_name},
            app_url                  => $self->{configuration}->{app_url},
            idp_scope                => $self->{configuration}->{idp_scope},
            idp_displayname          => $self->{configuration}->{idp_displayname},
            support_email            => $self->{configuration}->{support_email},
            version                  => $self->{configuration}->{version},
        }
    };

    # process input parameters
    my %parameters = $self->{cgi}->Vars();

    foreach my $parameter (keys %parameters) {

        # cleanup
        $parameters{$parameter} =~ s/\r//g;  # remove &0D char
        $parameters{$parameter} =~ s/\s+$//; # remove trailing spaces
        $parameters{$parameter} =~ s/^\s+//; # remove leading spaces

        # format check
        if (defined $format{$parameter}
            && !ref($format{$parameter})) {
            if ($parameters{$parameter} !~ /^$format{$parameter}$/) {
                push @{ $self->{out}->{errors} }, "format_$parameter";
                $self->{logger}->log(
                    level   => LOG_ERROR,
                    message => "Incorrect parameter format : $parameter"
                );
                return undef;
            }
        }

        # If action_xx parameter is set, set action parameter with value xx
        if ($parameter =~ /^action_(\w+)$/) {
            $parameters{action} = $1;
        }

        # register needed parameters
        $self->{in} = {
            email_adress => $parameters{action},
            style        => $parameters{style},
            sp_entityid  => $parameters{sp_entityid},
            authentication_token => $parameters{authentication_token}
        };
    }

    # Check the requested action
    my $action = $parameters{action} || 'home';

    if ($actions{$action}) {
        my $method = $actions{$action};
        $status = $self->$method();
    } else {
        ## inknown action
        push @{ $self->{out}->{errors} }, "unknown_action";
        $self->{logger}->log(
            level   => LOG_ERROR,
            message => "Unknown action '$action'"
        );

    }

    return 1;
}

## Return HTML content
sub respond {
    my ($self) = @_;
    $self->{logger}->log(level => LOG_DEBUG, message => "");

    ## 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 => $self->{configuration}->{root_manager_dir} . ':'
              . $self->{configuration}->{root_manager_dir}
              . '/templates/accountProfiles',
        }
    );

    my $template;

    ## nobanner is used to do AJAX to get only pieces of HTML to load in the web client
    if ($self->{in}->{style} eq 'nobanner') {
        $template = 'templates/web/index-nobanner.tt2.html';
    } else {
        $template = 'templates/web/index.tt2.html';
    }

    unless ($tt2->process($template, $self->{out}, \*STDOUT)) {
        printf "Content-type: text/plain\n\n Error: %s", $tt2->error();
        $self->{logger}->log(
            level   => LOG_ERROR,
            message => sprintf("Web parser error : %s", $tt2->error())
        );
    }

    ## Ignore some type of errors
    my @errors_admin;
    foreach my $id_error (@{ $self->{out}->{errors} }) {
        unless ($id_error =~ /^(error_x)$/) {
            push @errors_admin, $id_error;
        }
    }

    ## Mail notification of admins about the error
    if (@errors_admin) {
        $self->{out}->{subject} = 'Error notification - web interface';
        IdPAccountManager::Tools::mail_notice(
            template            => 'templates/mail/notification_generic_error.tt2.eml',
            data                => $self->{out},
            logger              => $self->{logger},
            conf                => $self->{configuration},
            admin_email         => $self->{configuration}->{admin_email},
            dev_no_mail_outside => $self->{configuration}->{dev_no_mail_outside},
            dev_sp_contact      => $self->{configuration}->{dev_sp_contact},
            notice_from         => $self->{configuration}->{notice_from}
        );
    }
}

## Return the list of known SPs first
sub req_account_wizard {
    my ($self) = @_;
    $self->{logger}->log(level => LOG_INFO, message => "");

    my $federation_metadata = IdPAccountManager::SAMLMetadata->new();

    eval {
        $federation_metadata->load(
            federation_metadata_file_path =>
              $self->{configuration}->{federation_metadata_file_path}
        );
    };
    if ($EVAL_ERROR) {
        push @{ $self->{out}->{errors} }, "internal";
        $self->{logger}->log(
            level   => LOG_ERROR,
            message => "Failed to load federation metadata: $EVAL_ERROR"
        );
        return undef;
    }

    eval {
        $self->{out} = $federation_metadata->parse();
    };
    if ($EVAL_ERROR) {
        push @{ $self->{out}->{errors} }, "internal";
        $self->{logger}->log(
            level   => LOG_ERROR,
            message => "Failed to parse federation metadata: $EVAL_ERROR"
        );
        return undef;
    }

    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) = @_;
    $self->{logger}->log(level => LOG_INFO, message => "");

    unless ($self->{in}->{sp_entityid}) {
        push @{ $self->{out}->{errors} }, "missing_sp_entityid";
        $self->{logger}
          ->log(level => LOG_ERROR, message => "Missing parameter sp_entityid");
        return undef;
    }

    my $federation_metadata;

    eval {
        $federation_metadata = IdPAccountManager::SAMLMetadata->new(
            file => $self->{configuration}->{federation_metadata_file_path}
        );
    };
    if ($EVAL_ERROR) {
        push @{ $self->{out}->{errors} }, "internal";
        $self->{logger}->log(
            level   => LOG_ERROR,
            message => "Failed to load federation metadata: $EVAL_ERROR"
        );
        return undef;
    }

    $federation_metadata->parse(
        filter_entity_id => $self->{in}->{sp_entityid}
    );

    ## Create a serviceprovider object to store major parameters for this SP in DB
    my $service_provider = IdPAccountManager::Data::ServiceProvider->new(
        db             => $self->{db},
        entityid       => $self->{in}->{sp_entityid},
        dev_sp_contact => $self->{configuration}->{dev_sp_contact}
    );

    ## Prepare data
    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} }) {
            my $email = $contact->{EmailAddress};
            $email =~ s/^(mailto:)//;    ## Remove 'mailto:' prefixes if any
            push @contacts, $email;
        }
    }
    my $display_name;
    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} })
            {
                $display_name =
                  $sp_metadata_as_hashref->{display_name}->{$lang};
                last;
            }
        }
    }

    ## Try loading DB object first
    if ($service_provider->load(speculative => 1)) {
        $service_provider->contacts(join(',', @contacts));
        $service_provider->displayname($display_name);

    } else {

        $service_provider = IdPAccountManager::Data::ServiceProvider->new(
            db             => $self->{db},
            entityid       => $self->{in}->{sp_entityid},
            contacts       => join(',', @contacts),
            displayname    => $display_name,
            dev_sp_contact => $self->{configuration}->{dev_sp_contact}
        );
        unless (defined $service_provider) {
            push @{ $self->{out}->{errors} }, "internal";
            $self->{logger}->log(
                level   => LOG_ERROR,
                message => "Failed to create serviceprovider object"
            );
            return undef;
        }
    }

    unless ($service_provider->save()) {
        push @{ $self->{out}->{errors} }, "internal";
        $self->{logger}->log(
            level   => LOG_ERROR,
            message => "Failed to save serviceprovider object"
        );
        return undef;
    }

    $self->{out}->{sp_metadata_as_hashref} =
      $federation_metadata->{federation_metadata_as_hashref}->[0];
    $self->{out}->{serviceprovider} = $service_provider;

    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) = @_;
    $self->{logger}->log(level => LOG_INFO, message => "");

    unless ($self->{in}->{sp_entityid}) {
        push @{ $self->{out}->{errors} }, "missing_sp_entityid";
        $self->{logger}
          ->log(level => LOG_ERROR, message => "Missing parameter sp_entityid");
        return undef;
    }

    unless ($self->{in}->{email_address}) {
        push @{ $self->{out}->{errors} }, "email_address";
        $self->{logger}->log(
            level   => LOG_ERROR,
            message => "Missing parameter email_address"
        );
        return undef;
    }

    ## Create a serviceprovider object to load parameters for this SP from DB
    my $service_provider = IdPAccountManager::Data::ServiceProvider->new(
        db             => $self->{db},
        entityid       => $self->{in}->{sp_entityid},
        dev_sp_contact => $self->{configuration}->{dev_sp_contact}
    );

    # Try loading DB object first
    unless ($service_provider->load(speculative => 1)) {
        push @{ $self->{out}->{errors} }, "internal";
        $self->{logger}->log(
            level   => LOG_ERROR,
            message => "Failed to load SP with entityid '%s'",
            $self->{in}->{sp_entityid}
        );
        return undef;
    }

    ## Check that email_address is a known contact for this SP
    unless ($service_provider->is_contact($self->{in}->{email_address}))
    {
        push @{ $self->{out}->{errors} }, "internal";
        $self->{logger}->log(
            level => LOG_ERROR,
            message =>
              "Requested a token for %s for an unautorized address '%s'",
            $self->{in}->{sp_entityid},
            $self->{in}->{email_address}
        );
        return undef;
    }

    my $authentication_token = IdPAccountManager::Data::AuthenticationToken->new(
        db            => $self->{db},
        email_address => $self->{in}->{email_address},
        sp_entityid   => $self->{in}->{sp_entityid}
    );
    unless (defined $authentication_token) {
        push @{ $self->{out}->{errors} }, "internal";
        $self->{logger}->log(
            level   => LOG_ERROR,
            message => "Failed to create authentication token"
        );
        return undef;
    }

    ## First remove token if one exist for this email+SP
    if ($authentication_token->load(speculative => 1)) {
        unless ($authentication_token->delete()) {
            push @{ $self->{out}->{errors} }, "internal";
            $self->{logger}->log(
                level   => LOG_ERROR,
                message => sprintf(
                    "Failed to delete previous authentication token with ID %s",
                    $authentication_token->get('id')
                )
            );
            return undef;
        }

        $authentication_token = IdPAccountManager::Data::AuthenticationToken->new(
            db            => $self->{db},
            email_address => $self->{in}->{email_address},
            sp_entityid   => $self->{in}->{sp_entityid}
        );
        unless (defined $authentication_token) {
            push @{ $self->{out}->{errors} }, "internal";
            $self->{logger}->log(
                level   => LOG_ERROR,
                message => "Failed to create authentication token"
            );
            return undef;
        }
    }

    unless ($authentication_token->save()) {
        push @{ $self->{out}->{errors} }, "internal";
        $self->{logger}->log(
            level   => LOG_ERROR,
            message => "Failed to save authentication token"
        );
        return undef;
    }

    $self->{out}->{email_address} = $self->{in}->{email_address};
    $self->{out}->{sp_entityid}   = $self->{in}->{sp_entityid};
    $self->{out}->{to}            = $self->{in}->{email_address};
    $self->{out}->{authentication_token} =
        $authentication_token->get('token');

    ## Send the challenge email with the token
    IdPAccountManager::Tools::mail_notice(
        template => 'templates/mail/send_authentication_token.tt2.eml',
        to       => $self->{in}->{email_address},
        data     => $self->{out},
        logger   => $self->{logger}
    );

    $self->{logger}->log(
        level   => LOG_INFO,
        message => "Token send to %s for sp_entityid=%s;token=%s",
        $self->{in}->{email_address},
        $self->{in}->{sp_entityid},
        $self->{out}->{authentication_token}
    );

    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) = @_;
    $self->{logger}->log(level => LOG_INFO, message => "");

    unless ($self->{in}->{sp_entityid}) {
        push @{ $self->{out}->{errors} }, "missing_sp_entityid";
        $self->{logger}->log(
            level => LOG_ERROR, message => "Missing parameter sp_entityid"
        );
        return undef;
    }

    unless ($self->{in}->{authentication_token}) {
        push @{ $self->{out}->{errors} },
          "missing_authentication_token";
        $self->{logger}->log(
            level   => LOG_ERROR,
            message => "Missing parameter authentication_token"
        );
        return undef;
    }

    my $authentication_token = IdPAccountManager::Data::AuthenticationToken->new(
        db    => $self->{db},
        token => $self->{in}->{authentication_token});

    unless ($authentication_token->load()) {
        push @{ $self->{out}->{errors} }, "wrong_token";
        $self->{logger}->log(
            level => LOG_ERROR,
            message =>
              "Failed to validate authentication token %s for sp_entityid %s",
            $self->{in}->{authentication_token},
            $self->{in}->{sp_entityid}
        );
        return undef;
    }

    unless ($authentication_token->get('sp_entityid') eq
        $self->{in}->{sp_entityid})
    {
        push @{ $self->{out}->{errors} }, "wrong_token_for_sp";
        $self->{logger}->log(
            level => LOG_ERROR,
            message =>
              "Authentication token %s cannot be used for SP with entityid %s",
            $self->{in}->{authentication_token},
            $self->{in}->{sp_entityid}
        );
        return undef;
    }

    ## delete the token
    unless ($authentication_token->delete()) {
        $self->{logger}->log(
            level   => LOG_ERROR,
            message => "Failed to delete authentication token %s",
            $self->{in}->{authentication_token}
        );
    }

    ## create test accounts
    my @test_accounts;

    foreach my $profile ($self->{configuration}->{account_profiles}) {
        my $test_account = IdPAccountManager::Data::TestAccount->new(
            db              => $self->{db},
            account_profile => $profile,
            sp_entityid     => $self->{in}->{sp_entityid}
        );
        next unless $test_account;
        next unless $test_account->save();
        push @test_accounts, $test_account;
    }

    unless (@test_accounts) {
        push @{ $self->{out}->{errors} }, "accounts_creation_failed";
        $self->{logger}->log(
            level   => LOG_ERROR,
            message => "Failed to create test accounts for SP with entityid %s",
            $self->{in}->{sp_entityid}
        );
        return undef;
    }

    ## Update simpleSAMLphp configuration to enable test accounts
    unless (IdPAccountManager::Tools::update_ssp_authsources(
            $self->{configuration}->{root_manager_dir},
            $self->{configuration}
        )) {
        push @{ $self->{out}->{errors} }, "accounts_creation_failed";
        $self->{logger}->log(
            level   => LOG_ERROR,
            message => "Failed to create simpleSAMLphp configuration file"
        );
        return undef;
    }

    $self->{logger}->log(
        level   => LOG_INFO,
        message => "Token validated for sp_entityid=%s;token=%s",
        $self->{in}->{sp_entityid},
        $self->{in}->{authentication_token}
    );

    $self->{out}->{sp_entityid}   = $self->{in}->{sp_entityid};
    $self->{out}->{test_accounts} = \@test_accounts;

    return 1;
}

## Return the homepage of the service
sub req_home {
    my ($self) = @_;
    $self->{logger}->log(level => LOG_INFO, message => "");

    return 1;
}

1;