WebRequest.pm

package IdPAccountManager::WebRequest;

use strict;
use warnings;

use CGI;
use English qw(-no_match_vars);
use Template;
use Log::Any::Adapter;
use List::MoreUtils qw(uniq);

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

## 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_validate_token',
    home           => 'req_home',
);

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

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

    Log::Any::Adapter->set(
        'File',
        $self->{configuration}->{log_file},
        log_level => $self->{configuration}->{log_level}
    );

    $self->{logger} = Log::Any->get_logger();

    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) = @_;

    my $status;


    # 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}->error(
                    "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_address        => $parameters{email_address},
            style                => $parameters{style},
            sp_entityid          => $parameters{sp_entityid},
            authentication_token => $parameters{authentication_token}
        };
    }

    my $action = $parameters{action} || 'home';

    # 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},
        },
        action => $action,
        title  => $self->{configuration}->{app_name}
    };

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

    }

    return 1;
}

## Return HTML content
sub respond {
    my ($self) = @_;

    ## Parse template
    my $tt2 = Template->new({
        INCLUDE_PATH => $self->{configuration}->{templates_dir}
    });

    my $template;

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

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

}

## Return the list of known SPs first
sub req_account_wizard {
    my ($self) = @_;

    my $metadata;

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

    $self->{out}->{metadata} = $metadata->parse(type => 'sp');

    $self->{out}->{subtitle} = 'Select your Service Provider';

    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) = @_;

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

    # Create a persistent service provider object
    my $provider = IdPAccountManager::Data::ServiceProvider->new(
        db       => $self->{db},
        entityid => $self->{in}->{sp_entityid}
    );

    if ($provider->load(speculative => 1)) {
        # already present in DB, nothing todo
    } else {
        # extract information from metadata
        my $metadata;

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

        my $sps = $metadata->parse(id => $self->{in}->{sp_entityid});
        if (!@$sps) {
            push @{ $self->{out}->{errors} }, "no_such_entity";
            $self->{logger}->errorf(
                "No such SP '%s' in metadata", $self->{in}->{sp_entityid}
            );
            return undef;
        }
        my $sp = $sps->[0];

        # complete persistent object
        $provider->displayname($sp->{display_name});
        $provider->contacts(uniq map { $_->{EmailAddress} } @{$sp->{contacts}})
            if $sp->{contacts};

        # save in DB
        unless ($provider->save()) {
            push @{ $self->{out}->{errors} }, "internal";
            $self->{logger}->error("Failed to save service provider object");
            return undef;
        }
    }

    if ($self->{configuration}->{dev_sp_contact}) {
        # replace SP contacts
        $provider->contacts(
            split(/, */, $self->{configuration}->{dev_sp_contact})
        );
    }

    $self->{out}->{provider} = $provider;
    $self->{out}->{subtitle} = 'Select your 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) = @_;

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

    unless ($self->{in}->{email_address}) {
        push @{ $self->{out}->{errors} }, "missing_email_address";
        $self->{logger}->error("Missing parameter email_address");
        return undef;
    }

    my $provider = IdPAccountManager::Data::ServiceProvider->new(
        db       => $self->{db},
        entityid => $self->{in}->{sp_entityid},
    );

    unless ($provider->load(speculative => 1)) {
        push @{ $self->{out}->{errors} }, "no_such_entity";
        $self->{logger}->errorf("No such SP '%s' in database", $self->{in}->{sp_entityid});
        return undef;
    }

    if ($self->{configuration}->{dev_sp_contact}) {
        # replace SP contacts
        $provider->contacts(
            split(/, */, $self->{configuration}->{dev_sp_contact})
        );
    }

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

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

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

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

    unless ($token->save()) {
        push @{ $self->{out}->{errors} }, "internal";
        $self->{logger}->error("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}->{subtitle}      = 'Generate an authentication token';

    my $sender    = $self->{configuration}->{notice_from};
    my $recipient = $self->{in}->{email_address};
    my $sendmail  = $self->{configuration}->{sendmail_path};

    open(my $handle, '|-', "$sendmail -f $sender $recipient") or do {
        push @{ $self->{out}->{errors} }, "mail_notification_error";
        $self->{logger}->errorf("Unable to run sendmail executable: %s", $ERRNO);
        return undef;
    };

    my $tt2 = Template->new({
        INCLUDE_PATH => $self->{configuration}->{templates_dir}
    });
    my $template = 'mail/send_authentication_token.tt2.eml';
    my $data = {
        env => {
            REMOTE_HOST => $ENV{REMOTE_HOST},
            REMOTE_ADDR => $ENV{REMOTE_ADDR},
        },
        conf => {
            app_name      => $self->{configuration}->{app_name},
            app_url       => $self->{configuration}->{app_url},
            support_email => $self->{configuration}->{support_email},
        },
        from                 => $sender,
        to                   => $recipient,
        sp_entityid          => $self->{in}->{sp_entityid},
        authentication_token => $token->token(),
    };

    unless ($tt2->process($template, $data, $handle)) {
        push @{ $self->{out}->{errors} }, "mail_notification_error";
        $self->{logger}->errorf("Mail notification error: %s", $tt2->error());
        return undef;
    }

    close $handle;

    $self->{logger}->infof(
        "Token send to %s for sp_entityid=%s;token=%s",
        $self->{in}->{email_address},
        $self->{in}->{sp_entityid},
        $token->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) = @_;

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

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

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

    if (! $token->load(speculative => 1)) {
        push @{ $self->{out}->{errors} }, "wrong_token";
        $self->{logger}->errorf(
            "Failed to validate authentication token %s for sp_entityid %s",
            $self->{in}->{authentication_token},
            $self->{in}->{sp_entityid}
        );
        return undef;
    }

    if (! $token->sp_entityid() eq $self->{in}->{sp_entityid}) {
        push @{ $self->{out}->{errors} }, "wrong_token_for_sp";
        $self->{logger}->errorf(
            "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 ($token->delete()) {
        $self->{logger}->errorf(
            "Failed to delete authentication token %s",
            $self->{in}->{authentication_token}
        );
    }

    ## create test accounts
    my @accounts;

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

    unless (@accounts) {
        push @{ $self->{out}->{errors} }, "accounts_creation_failed";
        $self->{logger}->errorf(
            "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}->{templates_dir},
            $self->{configuration}->{idp_accounts_file},
        )) {
        push @{ $self->{out}->{errors} }, "accounts_creation_failed";
        $self->{logger}->error(
            "Failed to create simpleSAMLphp configuration file"
        );
        return undef;
    }

    $self->{logger}->infof(
        "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} = \@accounts;
    $self->{out}->{subtitle} = 'Complete Email Challenge';

    return 1;
}

## Return the homepage of the service
sub req_home {
    my ($self) = @_;

    return 1;
}

1;