lemonldap-ng/lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Issuer/Get.pm
2019-02-28 08:52:48 +01:00

126 lines
3.1 KiB
Perl

package Lemonldap::NG::Portal::Issuer::Get;
use strict;
use Mouse;
use URI::Escape;
use Lemonldap::NG::Common::FormEncode;
use Lemonldap::NG::Portal::Main::Constants qw(PE_OK PE_BADURL PE_GET_SERVICE_NOT_ALLOWED);
our $VERSION = '2.1.0';
extends 'Lemonldap::NG::Portal::Main::Issuer';
has rule => ( is => 'rw' );
# INITIALIZATION
sub init {
my ($self) = @_;
# Parse activation rule
my $hd = $self->p->HANDLER;
$self->logger->debug(
"GET rule -> " . $self->conf->{issuerDBGetRule} );
my $rule =
$hd->buildSub(
$hd->substitute( $self->conf->{issuerDBGetRule} ) );
unless ($rule) {
$self->error( "Bad GET rule -> " . $hd->tsv->{jail}->error );
return 0;
}
$self->{rule} = $rule;
return 0 unless ( $self->SUPER::init() );
return 1;
}
# RUNNING METHODS
sub run {
my ( $self, $req ) = @_;
# Check activation rule
unless ( $self->rule->( $req, $req->sessionInfo ) ) {
$self->userLogger->error('GET service not authorized');
return PE_GET_SERVICE_NOT_ALLOWED;
}
# Session ID
my $session_id = $req->{sessionInfo}->{_session_id} || $self->{id};
# Session creation timestamp
my $time = $req->{sessionInfo}->{_utime} || time();
$req->path =~ m#^$self->{conf}->{issuerDBGetPath}/(log(?:in|out))#;
my $logInOut = $1 || 'login';
if ( $logInOut eq 'login' ) {
$self->logger->debug("IssuerGet: request for login");
$self->computeGetParams($req);
return PE_OK;
}
elsif ( $logInOut eq 'logout' ) {
$self->logger->debug("IssuerGet: request for logout");
# TODO
# Display a link to the provided URL
return PE_OK;
}
else {
$self->logger->error("IssuerGet: bad url");
return PE_BADURL;
}
}
# Nothing to do here for now
sub logout {
PE_OK;
}
# INTERNAL METHODS
sub computeGetParams {
my ( $self, $req ) = @_;
# Additional GET variables
my %getPrms;
if ( exists $self->conf->{issuerDBGetParameters} ) {
unless ( $req->urldc =~ m#^https?://([^/]+)# ) {
$self->logger->error("Malformed url $req->urldc");
return;
}
my $vhost = $1;
my $prms = $self->conf->{issuerDBGetParameters}->{$vhost};
unless ($prms) {
$self->logger->warn("IssuerGet: $vhost has no configuration");
return '';
}
foreach my $param ( keys %$prms ) {
my $value = $req->{sessionInfo}->{ $prms->{$param} };
$value =~ s/[\r\n\t]//;
$getPrms{$param} = $value;
}
}
else {
$self->logger->warn("IssuerGet: no configuration");
return;
}
my $getVars = build_urlencoded(%getPrms);
# If there are some GET variables to send
# Add them to URL string
if ( $getVars ne "" ) {
my $urldc = $req->urldc;
$urldc .= ( $urldc =~ /\?\w/ )
?
# there are already get variables
"&" . $getVars
:
# there are no get variables
"?" . $getVars;
$req->urldc($urldc);
}
}
1;