Commit 40b7535f authored by Xavier Guimard's avatar Xavier Guimard

Reorganize handler (closes: #1160)

parent 4b8db05b
......@@ -4,7 +4,7 @@
# Uncomment this if no previous NameVirtualHost declaration
#NameVirtualHost __VHOSTLISTEN__
PerlModule Lemonldap::NG::Handler::Menu
PerlModule Lemonldap::NG::Handler::ApacheMP2::Menu
# Sample application
<VirtualHost __VHOSTLISTEN__>
......@@ -27,7 +27,7 @@ PerlModule Lemonldap::NG::Handler::Menu
PerlResponseHandler ModPerl::Registry
# Display Menu
PerlOutputFilterHandler Lemonldap::NG::Handler::Menu->run
PerlOutputFilterHandler Lemonldap::NG::Handler::ApacheMP2::Menu->run
</Files>
......
......@@ -4,7 +4,7 @@
# Uncomment this if no previous NameVirtualHost declaration
#NameVirtualHost __VHOSTLISTEN__
PerlModule Lemonldap::NG::Handler::Menu
PerlModule Lemonldap::NG::Handler::ApacheMP2::Menu
# Sample application
<VirtualHost __VHOSTLISTEN__>
......@@ -33,7 +33,7 @@ PerlModule Lemonldap::NG::Handler::Menu
PerlResponseHandler ModPerl::Registry
# Display Menu
PerlOutputFilterHandler Lemonldap::NG::Handler::Menu->run
PerlOutputFilterHandler Lemonldap::NG::Handler::ApacheMP2::Menu->run
</Files>
......
......@@ -4,7 +4,7 @@
# Uncomment this if no previous NameVirtualHost declaration
#NameVirtualHost __VHOSTLISTEN__
PerlModule Lemonldap::NG::Handler::Menu
PerlModule Lemonldap::NG::Handler::ApacheMP2::Menu
# Sample application
<VirtualHost __VHOSTLISTEN__>
......@@ -28,7 +28,7 @@ PerlModule Lemonldap::NG::Handler::Menu
PerlResponseHandler ModPerl::Registry
# Display Menu
PerlOutputFilterHandler Lemonldap::NG::Handler::Menu->run
PerlOutputFilterHandler Lemonldap::NG::Handler::ApacheMP2::Menu->run
</Files>
......
......@@ -129,7 +129,7 @@
.\" ========================================================================
.\"
.IX Title "llng-fastcgi-server 1"
.TH llng-fastcgi-server 1 "2017-02-10" "perl v5.24.1" "User Contributed Perl Documentation"
.TH llng-fastcgi-server 1 "2017-02-11" "perl v5.24.1" "User Contributed Perl Documentation"
.\" For nroff, turn off justification. Always turn off hyphenation; it makes
.\" way too many mistakes in technical documents.
.if n .ad l
......
......@@ -57,20 +57,16 @@ if ($customFunctionsFile) {
my %builder = (
handler => sub {
require Lemonldap::NG::Handler::Nginx;
return Lemonldap::NG::Handler::Nginx->run( {} );
},
authbasic => sub {
require Lemonldap::NG::Handler::Nginx::AuthBasic;
return Lemonldap::NG::Handler::Nginx::AuthBasic->run( {} );
require Lemonldap::NG::Handler::Server::Nginx;
return Lemonldap::NG::Handler::Server::Nginx->run( {} );
},
reload => sub {
require Lemonldap::NG::Handler::Nginx;
return Lemonldap::NG::Handler::Nginx->reload();
require Lemonldap::NG::Handler::Server::Nginx;
return Lemonldap::NG::Handler::Server::Nginx->reload();
},
status => sub {
require Lemonldap::NG::Handler::Nginx;
return Lemonldap::NG::Handler::Nginx->status();
require Lemonldap::NG::Handler::Server::Nginx;
return Lemonldap::NG::Handler::Server::Nginx->status();
},
manager => sub {
require Lemonldap::NG::Manager;
......
......@@ -90,9 +90,9 @@ sub getApacheSession {
storageModule => $mod->{module},
storageModuleOptions => $mod->{options},
cacheModule =>
Lemonldap::NG::Handler::PSGI::API->tsv->{sessionCacheModule},
Lemonldap::NG::Handler::PSGI::Main->tsv->{sessionCacheModule},
cacheModuleOptions =>
Lemonldap::NG::Handler::PSGI::API->tsv->{sessionCacheOptions},
Lemonldap::NG::Handler::PSGI::Main->tsv->{sessionCacheOptions},
id => $id,
kind => $mod->{kind},
}
......
package Lemonldap::NG::Handler::API::Nginx;
our $VERSION = '2.0.0';
use constant FORBIDDEN => 403;
use constant HTTP_UNAUTHORIZED => 401;
use constant REDIRECT => 302;
use constant OK => 0;
use constant DECLINED => -1;
use constant DONE => -2;
use constant SERVER_ERROR => 500;
use constant AUTH_REQUIRED => 401;
use constant MAINTENANCE => 503;
my $request; # Nginx object for current request
## @method void thread_share(string $variable)
# not applicable with Nginx
sub thread_share {
}
## @method void setServerSignature(string sign)
# modifies web server signature
# @param $sign String to add to server signature
sub setServerSignature {
my ( $class, $sign ) = @_;
# TODO
}
sub newRequest {
my ( $class, $r ) = @_;
$request = $r;
$Lemonldap::NG::API::mode = 'Nginx';
}
## @method void _lmLog(string $msg, string $level)
# logs message $msg to Apache logs with loglevel $level
# @param $msg string message to log
# @param $level string loglevel
sub _lmLog {
my ( $class, $msg, $level ) = @_;
# TODO
}
## @method void set_user(string user)
# sets remote_user
# @param user string username
sub set_user {
my ( $class, $user ) = @_;
$request->variable( 'lmremote_user', $user );
}
## @method string header_in(string header)
# returns request header value
# @param header string request header
# @return request header value
sub header_in {
my ( $class, $header ) = @_;
$header ||= $class; # to use header_in as a method or as a function
return $request->header_in($header);
}
## @method void set_header_in(hash headers)
# sets or modifies request headers
# @param headers hash containing header names => header value
sub set_header_in {
my ( $class, %headers ) = @_;
while ( my ( $h, $v ) = each %headers ) {
if ( $h =~ /cookie/i ) {
# TODO: check that variable $lmcookie is defined,
# else warn that LL::NG cookie will not be removed
$request->variable( 'lmcookie', $v );
}
else {
# TODO: check that header is not yet set, else throw warning
# or reject request if mode paranoid is set
# TODO: check that variable nginxName($h) is defined,
# else warn that header will not be sent
$request->variable( nginxName($h), $v );
}
}
}
## @method void unset_header_in(array headers)
# removes request headers
# @param headers array with header names to remove
sub unset_header_in {
my ( $class, @headers ) = @_;
foreach my $h1 (@headers) {
# TODO: check that header is not yet set, else throw warning
$request->variable( nginxName($h), '' );
}
}
## @method void set_header_out(hash headers)
# sets response headers
# @param headers hash containing header names => header value
sub set_header_out {
my ( $class, %headers ) = @_;
while ( my ( $h, $v ) = each %headers ) {
if ( $h =~ /location/i ) {
$request->variable( 'lmlocation', $v );
}
else {
$request->header_out( $h, $v );
}
}
}
## @method string hostname()
# returns host, as set by full URI or Host header
# @return host string Host value
sub hostname {
my $class = shift;
return $request->variable('host');
}
## @method string remote_ip
# returns client IP address
# @return IP_Addr string client IP
sub remote_ip {
my $class = shift;
return $request->variable('remote_addr');
}
## @method boolean is_initial_req
# returns true unless the current request is a subrequest
# @return is_initial_req boolean
sub is_initial_req {
my $class = shift;
return 1;
}
## @method string args(string args)
# gets the query string
# @return args string Query string
sub args {
my $class = shift;
return $request->args();
}
## @method string uri
# returns the path portion of the URI, normalized, i.e. :
# * URL decoded (characters encoded as %XX are decoded,
# except ? in order not to merge path and query string)
# * references to relative path components "." and ".." are resolved
# * two or more adjacent slashes are merged into a single slash
# @return path portion of the URI, normalized
sub uri {
my $class = shift;
return $request->uri();
}
## @method string uri_with_args
# returns the URI, with arguments and with path portion normalized
# @return URI with normalized path portion
sub uri_with_args {
my $class = shift;
return uri() . ( $request->args ? "?" . $request->args : "" );
}
## @method string unparsed_uri
# returns the full original request URI, with arguments
# @return full original request URI, with arguments
sub unparsed_uri {
my $class = shift;
return $request->variable('request_uri');
}
## @method string get_server_port
# returns the port the server is receiving the current request on
# @return port string server port
sub get_server_port {
my $class = shift;
return $request->variable('server_port');
}
## @method string method
# returns the method the request is sent with
# @return port string server port
sub method {
my $class = shift;
return $request->request_method;
}
## @method void print(string data)
# write data in HTTP response body
# @param data Text to add in response body
sub print {
my ( $class, $data ) = @_;
$request->print($data);
}
## @method void addToHtmlHead(string data)
# add data at end of html head: not feasible with Nginx
# @param data Text to add in html head
sub addToHtmlHead {
my ( $class, $data ) = @_;
# TODO: throw error log
}
## @method void setPostParams(hashref $params)
# add or modify parameters in POST request body: not feasible with Nginx
# @param $params hashref containing name => value
sub setPostParams {
my ( $class, $params ) = @_;
# TODO: throw error log
}
sub nginxName {
my $h = lc(shift);
$h =~ s/-/_/g;
return "lm_$h";
}
1;
......@@ -5,10 +5,9 @@
# Menu
#
# Display a menu on protected applications
package Lemonldap::NG::Handler::Menu;
package Lemonldap::NG::Handler::ApacheMP2::Menu;
use strict;
use Lemonldap::NG::Handler::ApacheMP2::Main qw(:all);
use base qw(Lemonldap::NG::Handler::ApacheMP2::Main);
use Apache2::Filter ();
use constant BUFF_LEN => 8192;
......
# Auth-basic authentication with Lemonldap::NG rights management
# This specific handler is intended to be called directly by Apache
package Lemonldap::NG::Handler::ApacheMP2::SecureToken;
use strict;
use base 'Lemonldap::NG::Handler::Lib::SecureToken',
'Lemonldap::NG::Handler::ApacheMP2::Main';
our $VERSION = '2.0.0';
1;
# Auth-basic authentication with Lemonldap::NG rights management
# This specific handler is intended to be called directly by Apache
package Lemonldap::NG::Handler::ApacheMP2::ZimbraPreAuth;
use strict;
use base 'Lemonldap::NG::Handler::Lib::ZimbraPreAuth',
'Lemonldap::NG::Handler::ApacheMP2::Main';
our $VERSION = '2.0.0';
1;
package Lemonldap::NG::Handler::PSGI::Base;
package Lemonldap::NG::Handler::Lib::PSGI;
use 5.10.0;
use Mouse;
......@@ -116,9 +116,11 @@ sub _authAndTrace {
my ( $self, $req, $noCall ) = @_;
# TODO: handle types
my $type = $self->api->checkType($req);
my ( $res, $session ) = $self->api->run( $req, $self->{rule} );
$self->portal( $self->api->tsv->{portal}->() );
my $type = $self->api;
$type =~ s/::\w+$/::/;
$type .= $self->api->checkType($req);
my ( $res, $session ) = $type->run( $req, $self->{rule} );
$self->portal( $type->tsv->{portal}->() );
$req->userData($session) if ($session);
if ( $res < 300 ) {
......@@ -137,7 +139,7 @@ sub _authAndTrace {
}
else {
my %h = $req->{respHeaders} ? @{ $req->{respHeaders} } : ();
my $s = $self->api->tsv->{portal}->() . "?lmError=$res";
my $s = $type->tsv->{portal}->() . "?lmError=$res";
$s =
'<html><head><title>Redirection</title></head><body>'
. qq{<script type="text/javascript">window.location='$s'</script>}
......
......@@ -8,14 +8,11 @@
# This specific handler is intended to be called directly by Apache
package Lemonldap::NG::Handler::Specific::SecureToken;
package Lemonldap::NG::Handler::Lib::SecureToken;
use strict;
use Lemonldap::NG::Handler::ApacheMP2 qw(:all);
use base qw(Lemonldap::NG::Handler::ApacheMP2);
use Cache::Memcached;
use Apache::Session::Generate::MD5;
use Lemonldap::NG::Handler::Main::Logger;
our $VERSION = '2.0.0';
......@@ -29,11 +26,6 @@ BEGIN {
};
}
sub handler {
my ( $class, $request ) = ( __PACKAGE__, shift );
$class->run($request);
}
## @rmethod Apache2::Const run(Apache2::RequestRec r)
# Overload main run method
# @param r Current request
......@@ -246,6 +238,4 @@ sub _returnError {
}
}
__PACKAGE__->init( {} );
1;
## @file
# Status process mechanism
package Lemonldap::NG::Handler::Status;
package Lemonldap::NG::Handler::Lib::Status;
use strict;
use POSIX qw(setuid setgid);
......
......@@ -8,34 +8,24 @@
# This specific handler is intended to be called directly by Apache
package Lemonldap::NG::Handler::Specific::ZimbraPreAuth;
package Lemonldap::NG::Handler::Lib::ZimbraPreAuth;
use strict;
use Lemonldap::NG::Handler::ApacheMP2 qw(:all);
use base qw(Lemonldap::NG::Handler::ApacheMP2::Main);
use Digest::HMAC_SHA1 qw(hmac_sha1 hmac_sha1_hex);
our $VERSION = '2.0.0';
sub handler {
my ( $class, $request ) = ( __PACKAGE__, shift );
$class->run($request);
}
## @rmethod Apache2::Const run(Apache2::RequestRec r)
# Overload main run method
# @param r Current request
# @return Apache2::Const value ($class->OK, $class->FORBIDDEN, $class->REDIRECT or $class->SERVER_ERROR)
sub run {
my $class = shift;
my $r = $_[0];
my $ret = $class->SUPER::run();
my($class,$req) = @_;
my $ret = $class->SUPER::run($req);
# Continue only if user is authorized
return $ret unless ( $ret == $class->OK );
# Get current URI
my $uri = $class->uri_with_args($r);
my $uri = $class->uri_with_args($req);
# Get Zimbra parameters
my $localConfig = $class->localConfig;
......@@ -111,6 +101,4 @@ sub _buildZimbraPreAuthUrl {
return $zimbra_url;
}
__PACKAGE__->init( {} );
1;
......@@ -88,9 +88,9 @@ sub statusInit {
open STDIN, "<&$fdin";
open STDOUT, ">&$fdout";
my $perl_exec = ( $^X =~ /perl/ ) ? $^X : 'perl';
exec $perl_exec, '-MLemonldap::NG::Handler::Status',
exec $perl_exec, '-MLemonldap::NG::Handler::Lib::Status',
map( {"-I$_"} @INC ),
'-e &Lemonldap::NG::Handler::Status::run()';
'-e &Lemonldap::NG::Handler::Lib::Status::run()';
}
}
......
......@@ -36,7 +36,7 @@ sub status {
# Public methods
# Return Handler::Status output
# Return Handler::Lib::Status output
sub getStatus {
my ($class) = @_;
$class->lmLog( "Request for status", 'debug' );
......
......@@ -2,16 +2,16 @@ package Lemonldap::NG::Handler::PSGI;
use 5.10.0;
use Mouse;
use Lemonldap::NG::Handler::PSGI::API;
use Lemonldap::NG::Handler::PSGI::Main;
extends 'Lemonldap::NG::Handler::PSGI::Base', 'Lemonldap::NG::Common::PSGI';
extends 'Lemonldap::NG::Handler::Lib::PSGI', 'Lemonldap::NG::Common::PSGI';
our $VERSION = '2.0.0';
sub init {
$_[0]->api('Lemonldap::NG::Handler::PSGI::API') unless ( $_[0]->api );
$_[0]->api('Lemonldap::NG::Handler::PSGI::Main') unless ( $_[0]->api );
my $tmp = $_[0]->Lemonldap::NG::Common::PSGI::init( $_[1] )
and $_[0]->Lemonldap::NG::Handler::PSGI::Base::init( $_[1] );
and $_[0]->Lemonldap::NG::Handler::Lib::PSGI::init( $_[1] );
return $tmp;
}
......
package Lemonldap::NG::Handler::PSGI::API::Server;
use strict;
use base 'Lemonldap::NG::Handler::PSGI::API';
# In server mode, headers are not passed to a PSGI application but returned
# to the server
## @method void set_header_in(hash headers)
# sets or modifies request headers
# @param headers hash containing header names => header value
sub set_header_in {
my ( $class, %headers ) = @_;
for my $k ( keys %headers ) {
$Lemonldap::NG::Handler::PSGI::API::request->{ cgiName($k) } =
$headers{$k};
}
push @{ $Lemonldap::NG::Handler::PSGI::API::request->{respHeaders} },
%headers;
}
sub unset_header_in {
my ( $class, $header ) = @_;
$Lemonldap::NG::Handler::PSGI::API::request->{respHeaders} =
[ grep { $_ ne $header }
@{ $Lemonldap::NG::Handler::PSGI::API::request->{respHeaders} } ];
$header =~ s/-/_/g;
delete $Lemonldap::NG::Handler::PSGI::API::request->{ cgiName($header) };
}
# Inheritence is broken in this case with Debian >= jessie
*setServerSignature = *Lemonldap::NG::Handler::PSGI::API::setServerSignature;
*thread_share = *Lemonldap::NG::Handler::PSGI::API::thread_share;
*newRequest = *Lemonldap::NG::Handler::PSGI::API::newRequest;
*set_user = *Lemonldap::NG::Handler::PSGI::API::set_user;
*header_in = *Lemonldap::NG::Handler::PSGI::API::header_in;
*set_header_out = *Lemonldap::NG::Handler::PSGI::API::set_header_out;
*hostname = *Lemonldap::NG::Handler::PSGI::API::hostname;
*remote_ip = *Lemonldap::NG::Handler::PSGI::API::remote_ip;
*is_initial_req = *Lemonldap::NG::Handler::PSGI::API::is_initial_req;
*args = *Lemonldap::NG::Handler::PSGI::API::args;
*uri = *Lemonldap::NG::Handler::PSGI::API::uri;
*uri_with_args = *Lemonldap::NG::Handler::PSGI::API::uri_with_args;
*unparsed_uri = *Lemonldap::NG::Handler::PSGI::API::unparsed_uri;
*get_server_port = *Lemonldap::NG::Handler::PSGI::API::get_server_port;
*method = *Lemonldap::NG::Handler::PSGI::API::method;
*print = *Lemonldap::NG::Handler::PSGI::API::print;
*cgiName = *Lemonldap::NG::Handler::PSGI::API::cgiName;
*addToHtmlHead = *Lemonldap::NG::Handler::PSGI::API::addToHtmlHead;
1;
package Lemonldap::NG::Handler::PSGI::API;
package Lemonldap::NG::Handler::PSGI::Main;
use strict;
use base 'Lemonldap::NG::Handler::Main';
......
......@@ -2,17 +2,17 @@ package Lemonldap::NG::Handler::PSGI::Router;
use 5.10.0;
use Mouse;
require Lemonldap::NG::Handler::PSGI::API;
require Lemonldap::NG::Handler::PSGI::Main;
extends 'Lemonldap::NG::Handler::PSGI::Base',
extends 'Lemonldap::NG::Handler::Lib::PSGI',
'Lemonldap::NG::Common::PSGI::Router';
our $VERSION = '2.0.0';
sub init {
$_[0]->api('Lemonldap::NG::Handler::PSGI::API');
$_[0]->api('Lemonldap::NG::Handler::PSGI::Main');
my $tmp = ( $_[0]->Lemonldap::NG::Common::PSGI::Router::init( $_[1] )
and $_[0]->Lemonldap::NG::Handler::PSGI::Base::init( $_[1] ) );
and $_[0]->Lemonldap::NG::Handler::Lib::PSGI::init( $_[1] ) );
return $tmp;
}
......
package Lemonldap::NG::Handler::PSGI::Server;
package Lemonldap::NG::Handler::Server;
use strict;
use Mouse;
use Lemonldap::NG::Handler::PSGI::API::Server;
use Lemonldap::NG::Handler::Server::Main;
our $VERSION = '2.0.0';
......@@ -10,7 +10,7 @@ extends 'Lemonldap::NG::Handler::PSGI';
sub init {
my $self = shift;
$self->api('Lemonldap::NG::Handler::PSGI::API::Server');
$self->api('Lemonldap::NG::Handler::Server::Main');
my $tmp = $self->SUPER::init(@_);
}
......
# Auth-basic authentication with Lemonldap::NG rights management
# This specific handler is intended to be called directly by Apache
package Lemonldap::NG::Handler::Server::AuthBasic;
use strict;
use base 'Lemonldap::NG::Handler::Lib::AuthBasic',
'Lemonldap::NG::Handler::Server::Main';
our $VERSION = '2.0.0';
1;
package Lemonldap::NG::Handler::Server::Main;
use strict;
use base 'Lemonldap::NG::Handler::PSGI::Main';
# In server mode, headers are not passed to a PSGI application but returned
# to the server
## @method void set_header_in(hash headers)
# sets or modifies request headers
# @param headers hash containing header names => header value
sub set_header_in {
my ( $class, %headers ) = @_;
for my $k ( keys %headers ) {
$Lemonldap::NG::Handler::PSGI::Main::request->{ cgiName($k) } =
$headers{$k};
}
push @{ $Lemonldap::NG::Handler::PSGI::Main::request->{respHeaders} },
%headers;
}
sub unset_header_in {
my ( $class, $header ) = @_;
$Lemonldap::NG::Handler::PSGI::Main::request->{respHeaders} =
[ grep { $_ ne $header }
@{ $Lemonldap::NG::Handler::PSGI::Main::request->{respHeaders} } ];
$header =~ s/-/_/g;
delete $Lemonldap::NG::Handler::PSGI::Main::request->{ cgiName($header) };
}
# Inheritence is broken in this case with Debian >= jessie
*checkType = *Lemonldap::NG::Handler::PSGI::Main::checkType;
*setServerSignature = *Lemonldap::NG::Handler::PSGI::Main::setServerSignature;
*thread_share = *Lemonldap::NG::Handler::PSGI::Main::thread_share;
*newRequest = *Lemonldap::NG::Handler::PSGI::Main::newRequest;
*set_user = *Lemonldap::NG::Handler::PSGI::Main::set_user;
*header_in = *Lemonldap::NG::Handler::PSGI::Main::header_in;
*set_header_out = *Lemonldap::NG::Handler::PSGI::Main::set_header_out;