App.pm

package AccountManager::App;

use strict;
use warnings;

use CGI;
use DateTime;
use English qw(-no_match_vars);
use HTTP::AcceptLanguage;
use Log::Any::Adapter;
use List::MoreUtils qw(uniq);
use Template;
use Text::CSV;

use AccountManager::Account;
use AccountManager::Account::Manager;
use AccountManager::Metadata;
use AccountManager::Service;
use AccountManager::Token;
use AccountManager::Tools;

# Format de type URL HTTP ou URN
my $entity_id_pattern = qr{
    ^
    (?:
        https?://[\w.:/-]+
    |
        urn:[\w.:-]+
    )
    $
}x;

my %actions = (
    home               => 'req_home',
    select_sp          => 'req_select_sp',
    select_email       => 'req_select_email',
    complete_challenge => 'req_complete_challenge',
    create_accounts    => 'req_create_accounts',
    download_accounts  => 'req_download_accounts',
);

my $version = '1.0';

sub new {
    my ($pkg, %args) = @_;

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

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

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

    AccountManager::DB->register_db(
        driver   => $self->{configuration}->{database}->{type},
        database => $self->{configuration}->{database}->{name},
        host     => $self->{configuration}->{database}->{host},
        username => $self->{configuration}->{database}->{username},
        password => $self->{configuration}->{database}->{password},
    );

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

    bless $self, $pkg;

    return $self;
}

sub run {
    my ($self) = @_;


    # 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

        # 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    => $parameters{email},
            entityid => $parameters{entityid},
            token    => $parameters{token},
            key      => $parameters{key},
        };
    }

    # process requested action
    my $action = $parameters{action} || 'home';
    if ($actions{$action}) {
        $self->{logger}->debug("Processing action '$action'");
        my $method = $actions{$action};
        $self->$method();
    } else {
        ## unknown action
        $self->{logger}->error( "Unknown action '$action'");
        $self->respond(
            template => 'index.tt2.html',
            data     => {
                content => 'errors.tt2.html',
                errors  => [ "Unknown action '$action'" ]
            }
        );
    }

    return 1;
}

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

    $in{data}->{app} = {
        url           => $self->{configuration}->{app}->{url},
        support_email => $self->{configuration}->{app}->{support_email},
        version       => $version,
    };

    my $lang = HTTP::AcceptLanguage->new($ENV{HTTP_ACCEPT_LANGUAGE})->match(qw/en fr/) || 'en';

    ## Parse template
    my $tt2 = Template->new({
        ENCODING => 'utf8',
        INCLUDE_PATH => $self->{configuration}->{setup}->{templates_dir} . "/web/$lang"
    });

    $self->{logger}->debug("Responding with outer template '$in{template}' and inner template '$in{data}->{content}'");

    binmode(STDOUT, ":utf8");

    print $self->{cgi}->header(
        -type    => 'text/html',
        -charset => 'utf8'
    );

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

    exit 0;
}

sub req_select_sp {
    my ($self) = @_;

    my $metadata;

    eval {
        $metadata = AccountManager::Metadata->new(
            file => $self->{configuration}->{setup}->{federation_metadata_file}
        );
    };
    if ($EVAL_ERROR) {
        $self->{logger}->error("Failed to load federation metadata: $EVAL_ERROR");
        $self->respond(
            template => 'index.tt2.html',
            data     => {
                content => 'errors.tt2.html',
                errors  => [ "internal" ]
            }
        );
    }

    $self->respond(
        template => 'index.tt2.html',
        data     => {
            env => {
                SCRIPT_NAME => $ENV{SCRIPT_NAME}
            },
            metadata => $metadata->parse(type => 'sp'),
            content  => 'select_sp.tt2.html'
        }
    );
}

sub req_select_email {
    my ($self) = @_;

    if (! $self->{in}->{entityid}) {
        $self->{logger}->error("Missing parameter: entityid");
        $self->respond(
            template => 'index-nobanner.tt2.html',
            data     => {
                content => 'errors.tt2.html',
                errors  => [ "missing_entityid" ]
            }
        );
    }

    if ($self->{in}->{entityid} !~ $entity_id_pattern) {
        $self->{logger}->error("Incorrect parameter format: entityid");
        $self->respond(
            template => 'index-nobanner.tt2.html',
            data     => {
                content => 'errors.tt2.html',
                errors  => [ "format_entityid" ]
            }
        );
    }

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

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

        eval {
            $metadata = AccountManager::Metadata->new(
                file => $self->{configuration}->{setup}->{federation_metadata_file}
            );
        };
        if ($EVAL_ERROR) {
            $self->{logger}->error("Failed to load federation metadata: $EVAL_ERROR");
            $self->respond(
                template => 'index-nobanner.tt2.html',
                data     => {
                    content => 'errors.tt2.html',
                    errors  => [ "internal" ]
                }
            );
        }

        my $sps = $metadata->parse(id => $self->{in}->{entityid});
        if (!@$sps) {
            $self->{logger}->errorf(
                "No such SP '%s' in metadata", $self->{in}->{entityid}
            );
            $self->respond(
                template => 'index-nobanner.tt2.html',
                data     => {
                    content => 'errors.tt2.html',
                    errors  => [ "no_such_entity" ]
                }
            );
        }
        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()) {
            $self->{logger}->error("Failed to save service provider object");
            $self->respond(
                template => 'index-nobanner.tt2.html',
                data     => {
                    content => 'errors.tt2.html',
                    errors  => [ "internal" ]
                }
            );
        }
    }

    # override metadata contacts if needed
    my $entity = $self->{in}->{entityid};
    my $contacts =
        $self->{configuration}->{$entity}->{contacts} ||
        $self->{configuration}->{service}->{contacts};
    if ($contacts) {
        if ($contacts =~ /^\+(.+)/) {
            # complement original contacts
            $provider->contacts($provider->contacts(), split(/, */, $1));
        } else {
            # replace original contacts
            $provider->contacts(split(/, */, $contacts));
        }
    }

    $self->respond(
        template => 'index-nobanner.tt2.html',
        data     => {
            provider => $provider,
            content  => 'select_email.tt2.html'
        }
    );
}

sub req_complete_challenge {
    my ($self) = @_;

    unless ($self->{in}->{entityid}) {
        $self->{logger}->error("Missing parameter entityid");
        $self->respond(
            template => 'index-nobanner.tt2.html',
            data     => {
                errors => [ "missing_entityid" ]
            }
        );
    }

    unless ($self->{in}->{email}) {
        $self->{logger}->error("Missing parameter email");
        $self->respond(
            template => 'index-nobanner.tt2.html',
            data     => {
                content => 'errors.tt2.html',
                errors  => [ "missing_email" ]
            }
        );
    }

    my $provider = AccountManager::Service->new(
        db       => $self->{db},
        entityid => $self->{in}->{entityid},
    );

    unless ($provider->load(speculative => 1)) {
        $self->{logger}->errorf("No such SP '%s' in database", $self->{in}->{entityid});
        $self->respond(
            template => 'index-nobanner.tt2.html',
            data     => {
                content => 'errors.tt2.html',
                errors  => [ "no_such_entity" ]
            }
        );
    }

    # override metadata contacts if needed
    my $entity = $self->{in}->{entityid};
    my $contacts =
        $self->{configuration}->{$entity}->{contacts} ||
        $self->{configuration}->{service}->{contacts};
    if ($contacts) {
        if ($contacts =~ /^\+(.+)/) {
            # complement original contacts
            $provider->contacts($provider->contacts(), split(/, */, $1));
        } else {
            # replace original contacts
            $provider->contacts(split(/, */, $contacts));
        }
    }

    ## Check that email is a known contact for this SP
    unless ($provider->is_contact($self->{in}->{email}))
    {
        $self->{logger}->errorf(
            "Requested a token for %s for an unautorized address '%s'",
            $self->{in}->{entityid},
            $self->{in}->{email}
        );
        $self->respond(
            template => 'index-nobanner.tt2.html',
            data     => {
                content => 'errors.tt2.html',
                errors  => [ "internal" ]
            }
        );
    }

    # delete any previous token for the same email/service couple
    my $old_token = AccountManager::Token->new(
        db            => $self->{db},
        email_address => $self->{in}->{email},
        sp_entityid   => $self->{in}->{entityid}
    );

    if ($old_token->load(speculative => 1)) {
        unless ($old_token->delete()) {
            $self->{logger}->errorf(
                "Failed to delete previous authentication token with ID %s",
                $old_token->id()
            );
            $self->respond(
                template => 'index-nobanner.tt2.html',
                data     => {
                    content => 'errors.tt2.html',
                    errors  => [ "internal" ]
                }
            );
        }
    }

    # compute a new token
    my $validity_period =
        $self->{configuration}->{_}->{tokens_validity_period};
    my $token = AccountManager::Token->new(
        db              => $self->{db},
        email_address   => $self->{in}->{email},
        sp_entityid     => $self->{in}->{entityid},
        creation_date   => DateTime->now(),
        expiration_date => DateTime->now()->add(hours => $validity_period),
        token           => AccountManager::Tools::generate_secret(20)
    );

    unless ($token->save()) {
        $self->{logger}->error("Failed to save authentication token");
        $self->respond(
            template => 'index-nobanner.tt2.html',
            data     => {
                content => 'errors.tt2.html',
                errors  => [ "internal" ]
            }
        );
    }

    my $sender    = $self->{configuration}->{mailer}->{from};
    my $sendmail  = $self->{configuration}->{mailer}->{sendmail_path} ||
                    '/usr/sbin/sendmail';
    my $recipient = $self->{in}->{email};

    open(my $handle, '|-', "$sendmail -f $sender $recipient") or do {
        $self->{logger}->errorf("Unable to run sendmail executable: %s", $ERRNO);
        $self->respond(
            template => 'index-nobanner.tt2.html',
            data     => {
                content => 'errors.tt2.html',
                errors  => [ "mail_notification_error" ]
            }
        );
    };

    my $lang = HTTP::AcceptLanguage->new($ENV{HTTP_ACCEPT_LANGUAGE})->match(qw/en fr/) || 'en';

    my $tt2 = Template->new({
        ENCODING => 'utf8',
        INCLUDE_PATH => $self->{configuration}->{setup}->{templates_dir} . "/mail/$lang"
    });
    my $template = 'send_authentication_token.tt2.eml';
    my $data = {
        app => {
            url           => $self->{configuration}->{app}->{url},
            support_email => $self->{configuration}->{app}->{support_email},
            version       => $self->{configuration}->{app}->{version},
        },
        sourceip  => $ENV{REMOTE_ADDR},
        from      => $sender,
        to        => $recipient,
        entityid  => $self->{in}->{entityid},
        token     => $token->token(),
    };

    unless ($tt2->process($template, $data, $handle)) {
        $self->{logger}->errorf("Mail notification error: %s", $tt2->error());
        $self->respond(
            template => 'index-nobanner.tt2.html',
            data     => {
                content => 'errors.tt2.html',
                errors  => [ "mail_notification_error" ]
            }
        );
    }

    close $handle;

    $self->{logger}->infof(
        "Token send to %s for entityid=%s;token=%s",
        $self->{in}->{email},
        $self->{in}->{entityid},
        $token->token(),
    );

    $self->respond(
        template => 'index-nobanner.tt2.html',
        data     => {
            email    => $self->{in}->{email},
            entityid => $self->{in}->{entityid},
            content  => 'complete_challenge.tt2.html'
        }
    );
}

sub req_create_accounts {
    my ($self) = @_;

    unless ($self->{in}->{entityid}) {
        $self->{logger}->error("Missing parameter entityid");
        $self->respond(
            template => 'index.tt2.html',
            data     => {
                content => 'errors.tt2.html',
                errors  => [ "missing_entityid" ]
            }
        );
    }

    unless ($self->{in}->{token}) {
        $self->{logger}->error("Missing parameter token");
        $self->respond(
            template => 'index.tt2.html',
            data => {
                content => 'errors.tt2.html',
                errors  => [ "missing_token" ]
            }
        );
    }

    unless ($self->{in}->{email}) {
        $self->{logger}->error("Missing parameter email");
        $self->respond(
            template => 'index.tt2.html',
            data     => {
                content => 'errors.tt2.html',
                errors  => [ "missing_email" ]
            }
        );
    }

    my $token = AccountManager::Token->new(
        db    => $self->{db},
        token => $self->{in}->{token}
    );

    if (! $token->load(speculative => 1)) {
        $self->{logger}->errorf(
            "Failed to validate authentication token %s for entityid %s",
            $self->{in}->{token},
            $self->{in}->{entityid}
        );
        $self->respond(
            template => 'index.tt2.html',
            data     => {
                content => 'errors.tt2.html',
                errors  => [ "wrong_token" ]
            }
        );
    }

    if (! $token->sp_entityid() eq $self->{in}->{entityid}) {
        $self->{logger}->errorf(
            "Authentication token %s cannot be used for SP with entityid %s",
            $self->{in}->{token},
            $self->{in}->{entityid}
        );
        $self->respond(
            template => 'index.tt2.html',
            data     => {
                content => 'errors.tt2.html',
                errors  => [ "wrong_token_for_sp" ]
            }
        );
    }

    ## delete the token
    unless ($token->delete()) {
        $self->{logger}->errorf(
            "Failed to delete authentication token %s",
            $self->{in}->{token}
        );
    }

    ## create test accounts
    my @accounts;

    my $entity = $self->{in}->{entityid};
    my $profiles =
        $self->{configuration}->{$entity}->{account_profiles} ||
        $self->{configuration}->{service}->{account_profiles};
    my $validity_period =
        $self->{configuration}->{$entity}->{account_validity_period} ||
        $self->{configuration}->{service}->{account_validity_period};


    my $download_token = AccountManager::Token->new(
        db              => $self->{db},
        email_address   => $self->{in}->{email},
        sp_entityid     => $self->{in}->{entityid},
        creation_date   => DateTime->now(),
        expiration_date => DateTime->now()->add(hours => $validity_period),
        token           => AccountManager::Tools::generate_secret(20)
    );

    unless ($download_token->save()) {
        $self->{logger}->error("Failed to save authentication token");
        $self->respond(
            template => 'index.tt2.html',
            data     => {
                content => 'errors.tt2.html',
                errors  => [ "internal" ]
            }
        );
    }

    my $key = AccountManager::Tools::generate_secret(10);

    foreach my $profile (split(/, */, $profiles)) {
        my $password = AccountManager::Tools::generate_password(10);
        my $account = AccountManager::Account->new(
            db              => $self->{db},
            profile         => $profile,
            sp_entityid     => $entity,
            scope           => $self->{configuration}->{idp}->{scope},
            password        => $password,
            password_crypt  => AccountManager::Tools::encrypt($password, $key),
            password_hash   => AccountManager::Tools::sha256_hash($password),
            token           => $download_token->token(),
            creation_date   => DateTime->now(),
            expiration_date => DateTime->now()->add(days => $validity_period)
        );
        next unless $account->save();
        push @accounts, $account;
    }

    unless (@accounts) {
        $self->{logger}->errorf(
            "Failed to create test accounts for SP with entityid %s",
            $self->{in}->{entityid}
        );
        $self->respond(
            template => 'index.tt2.html',
            data     => {
                content => 'errors.tt2.html',
                errors  => [ "accounts_creation_failed" ]
            }
        );
    }

    ## Update simpleSAMLphp configuration to enable test accounts
    my $accounts = AccountManager::Account::Manager->get_accounts(
        db => $self->{db}
    );

    eval {
        AccountManager::Tools::update_ssp_authsources(
            $self->{configuration}->{setup}->{templates_dir},
            $self->{configuration}->{idp}->{accounts_file},
            $accounts
        );
    };
    if ($EVAL_ERROR) {
        $self->{logger}->errorf(
            "Failed to create simpleSAMLphp configuration file: %s",
            $EVAL_ERROR
        );
        $self->respond(
            template => 'index.tt2.html',
            data     => {
                content => 'errors.tt2.html',
                errors  => [ "accounts_creation_failed" ]
            }
        );
    }

    $self->{logger}->infof(
        "Token validated for entityid=%s;token=%s",
        $self->{in}->{entityid},
        $self->{in}->{token}
    );

    $self->respond(
        template => 'index.tt2.html',
        data     => {
            accounts => \@accounts,
            entityid => $self->{in}->{entityid},
            key      => $key,
            token    => $download_token->token(),
            content  => 'create_accounts.tt2.html'
        }
    );
}

sub req_download_accounts {
    my ($self) = @_;

    unless ($self->{in}->{entityid}) {
        $self->{logger}->error("Missing parameter entityid");
        $self->respond(
            template => 'index.tt2.html',
            data     => {
                content => 'errors.tt2.html',
                errors  => [ "missing_entityid" ]
            }
        );
    }

    unless ($self->{in}->{token}) {
        $self->{logger}->error("Missing parameter token");
        $self->respond(
            template => 'index.tt2.html',
            data     => {
                content => 'errors.tt2.html',
                errors  => [ "missing_token" ]
            }
        );
    }

    unless ($self->{in}->{key}) {
        $self->{logger}->error("Missing parameter key");
        $self->respond(
            template => 'index.tt2.html',
            data     => {
                content => 'errors.tt2.html',
                errors  => [ "missing_key" ]
            }
        );
    }

    my $token = AccountManager::Token->new(
        db    => $self->{db},
        token => $self->{in}->{token}
    );

    if (! $token->load(speculative => 1)) {
        $self->{logger}->errorf(
            "Non-existing authentication token %s",
            $self->{in}->{token},
        );
        $self->respond(
            template => 'index.tt2.html',
            data     => {
                content => 'errors.tt2.html',
                errors  => [ "wrong_token" ]
            }
        );
    }

    if (! $token->sp_entityid() eq $self->{in}->{entityid}) {
        $self->{logger}->errorf(
            "Authentication token %s cannot be used for SP %s",
            $self->{in}->{token},
            $self->{in}->{entityid}
        );
        $self->respond(
            template => 'index.tt2.html',
            data     => {
                content => 'errors.tt2.html',
                errors  => [ "wrong_token_for_sp" ]
            }
        );
    }

    # delete the token
    unless ($token->delete()) {
        $self->{logger}->errorf(
            "Failed to delete authentication token %s",
            $self->{in}->{token}
        );
    }

    # load accounts from database
    my $accounts = AccountManager::Account::Manager->get_accounts(
        db    => $self->{db},
        query => [
            token => $self->{in}->{token}
        ],
    );

    binmode(STDOUT, ":utf8");

    print $self->{cgi}->header(
        -type                => 'text/csv',
        -content_disposition => 'attachment; filename="accounts.csv"'
    );

    my $csv = Text::CSV->new ({ binary => 1, eol => "\r\n", quote_space => 0 });
    $csv->print(\*STDOUT, [ qw/
        username
        password
        profile
        cn
        displayName
        givenName
        mail
        eduPersonAffiliation
        eduPersonScopedAffiliation
        eduPersonPrincipalName
        schacHomeOrganization
        schacHomeOrganizationType
    / ]);

    foreach my $account (@$accounts) {
        my $password = AccountManager::Tools::decrypt(
            $account->password_crypt(),
            $self->{in}->{key}
        );
        $account->password($password);
        $csv->print(\*STDOUT, [
            $account->internal_uid(),
            $account->password(),
            $account->profile(),
            $account->cn(),
            $account->displayName(),
            $account->givenName(),
            $account->mail(),
            $account->eduPersonAffiliation(),
            $account->eduPersonScopedAffiliation(),
            $account->eduPersonPrincipalName(),
            $account->schacHomeOrganization(),
            $account->schacHomeOrganizationType(),
        ]);
    }
}

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

    $self->respond(
        template => 'index.tt2.html',
        data     => {
            content => 'home.tt2.html'
        }
    );
}

1;