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;

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

    my $self = {
        format        => $args{format},
        actions       => $args{actions},
        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;
}

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

    my $status;

    # initialize output parameters
    $self->{param_out} = {
        url_cgi => $ENV{SCRIPT_NAME},
        env     => \%ENV,
        actions => $self->{actions},
        conf    => $self->{configuration},
    };

    # 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 $self->{format}->{$parameter}
            && !ref($self->{format}->{$parameter})) {
            if ($parameters{$parameter} !~ /^$self->format->{$parameter}$/) {
                push @{ $self->{param_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->{param_in} = {
            email_adress => $parameters{action},
            style        => $parameters{style},
            sp_entityid  => $parameters{sp_entityid},
            authentication_token => $parameters{authentication_token}
        };
    }

    # Check the requested action
    $self->{action} = $parameters{action} || 'home';

    if (defined $self->actions->{ $self->{action} }) {
        ## Execute the target subroutine named req_actionName
        no strict 'refs';
        my $sub = 'req_' . $self->{action};
        $status = &{$sub}($self);
    } else {
        ## Inknown action
        push @{ $self->{param_out}->{errors} }, "unknown_action";
        $self->{logger}->log(
            level   => LOG_ERROR,
            message => "Unknown action '%s'",
            $self->{action}
        );

    }

    return 1;
}

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

    ## Automatic pass object entries to the output hash
    foreach my $key (keys %{$self}) {

        $self->{param_out}{$key} ||= $self->{$key}
          unless ($key eq 'param_out');
    }

    ## An action may redirect to an external URL
    if ($self->{url_redirection}) {

        printf "Location: %s\n\n", $self->{url_redirection};

    } else {

        ## 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',

                #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();
            $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->{param_out}->{errors} }) {
        unless ($id_error =~ /^(error_x)$/) {
            push @errors_admin, $id_error;
        }
    }

    ## 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},
            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->{param_out}->{errors} }, "internal";
        $self->{logger}->log(
            level   => LOG_ERROR,
            message => "Failed to load federation metadata: $EVAL_ERROR"
        );
        return undef;
    }

    eval {
        $self->{param_out} = $federation_metadata->parse();
    };
    if ($EVAL_ERROR) {
        push @{ $self->{param_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->{param_in}->{sp_entityid}) {
        push @{ $self->{param_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->{param_out}->{errors} }, "internal";
        $self->{logger}->log(
            level   => LOG_ERROR,
            message => "Failed to load federation metadata: $EVAL_ERROR"
        );
        return undef;
    }

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

    ## 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->{param_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->{param_in}->{sp_entityid},
            contacts       => join(',', @contacts),
            displayname    => $display_name,
            dev_sp_contact => $self->{configuration}->{dev_sp_contact}
        );
        unless (defined $service_provider) {
            push @{ $self->{param_out}->{errors} }, "internal";
            $self->{logger}->log(
                level   => LOG_ERROR,
                message => "Failed to create serviceprovider object"
            );
            return undef;
        }
    }

    unless ($service_provider->save()) {
        push @{ $self->{param_out}->{errors} }, "internal";
        $self->{logger}->log(
            level   => LOG_ERROR,
            message => "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;

    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->{param_in}->{sp_entityid}) {
        push @{ $self->{param_out}->{errors} }, "missing_sp_entityid";
        $self->{logger}
          ->log(level => LOG_ERROR, message => "Missing parameter sp_entityid");
        return undef;
    }

    unless ($self->{param_in}->{email_address}) {
        push @{ $self->{param_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->{param_in}->{sp_entityid},
        dev_sp_contact => $self->{configuration}->{dev_sp_contact}
    );

    # Try loading DB object first
    unless ($service_provider->load(speculative => 1)) {
        push @{ $self->{param_out}->{errors} }, "internal";
        $self->{logger}->log(
            level   => LOG_ERROR,
            message => "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";
        $self->{logger}->log(
            level => LOG_ERROR,
            message =>
              "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 = IdPAccountManager::Data::AuthenticationToken->new(
        db            => $self->{db},
        email_address => $self->{param_in}->{email_address},
        sp_entityid   => $self->{param_in}->{sp_entityid}
    );
    unless (defined $authentication_token) {
        push @{ $self->{param_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->{param_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->{param_in}->{email_address},
            sp_entityid   => $self->{param_in}->{sp_entityid}
        );
        unless (defined $authentication_token) {
            push @{ $self->{param_out}->{errors} }, "internal";
            $self->{logger}->log(
                level   => LOG_ERROR,
                message => "Failed to create authentication token"
            );
            return undef;
        }
    }

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

    $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}->{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->{param_in}->{email_address},
        data     => $self->{param_out},
        logger   => $self->{logger}
    );

    $self->{logger}->log(
        level   => LOG_INFO,
        message => "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
## 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->{param_in}->{sp_entityid}) {
        push @{ $self->{param_out}->{errors} }, "missing_sp_entityid";
        $self->{logger}->log(
            level => LOG_ERROR, message => "Missing parameter sp_entityid"
        );
        return undef;
    }

    unless ($self->{param_in}->{authentication_token}) {
        push @{ $self->{param_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->{param_in}->{authentication_token});

    unless ($authentication_token->load()) {
        push @{ $self->{param_out}->{errors} }, "wrong_token";
        $self->{logger}->log(
            level => LOG_ERROR,
            message =>
              "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";
        $self->{logger}->log(
            level => LOG_ERROR,
            message =>
              "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()) {
        $self->{logger}->log(
            level   => LOG_ERROR,
            message => "Failed to delete authentication token %s",
            $self->{param_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->{param_in}->{sp_entityid}
        );
        next unless $test_account;
        next unless $test_account->save();
        push @test_accounts, $test_account;
    }

    unless (@test_accounts) {
        push @{ $self->{param_out}->{errors} }, "accounts_creation_failed";
        $self->{logger}->log(
            level   => LOG_ERROR,
            message => "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(
            $self->{configuration}->{root_manager_dir},
            $self->{configuration}
        )) {
        push @{ $self->{param_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->{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;
}

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

    return 1;
}

1;