Commit 820691df authored by Xavier Guimard's avatar Xavier Guimard

Start handler reorganization (#1160)

parent 554cd5e7
......@@ -209,7 +209,7 @@ sub virtualHosts {
}
return $self->sendJSONresponse( $req, $resp );
}
elsif ( $query =~ /^vhost(?:(?:Aliase|Http)s|Maintenance|Port)$/ ) {
elsif ( $query =~ /^vhost(?:(?:Aliase|Http)s|Maintenance|Port|Type)$/ ) {
$self->lmLog( "Query for $vh/$query key", 'debug' );
# TODO: verify how this is done actually
......
......@@ -26,7 +26,7 @@ our $oidcOPMetaDataNodeKeys = 'oidcOPMetaData(?:Options(?:C(?:lient(?:Secret|ID)
our $oidcRPMetaDataNodeKeys = 'oidcRPMetaData(?:Options(?:I(?:DToken(?:Expiration|SignAlg)|con)|(?:RedirectUri|ExtraClaim)s|AccessTokenExpiration|Client(?:Secret|ID)|BypassConsent|DisplayName|UserIDAttr)|ExportedVars)';
our $samlIDPMetaDataNodeKeys = 'samlIDPMetaData(?:Options(?:(?:Check(?:S[LS]OMessageSignatur|Audienc|Tim)|EncryptionMod|IsPassiv)e|A(?:llow(?:LoginFromIDP|ProxiedAuthn)|daptSessionUtime)|Re(?:questedAuthnContext|solutionRule|layStateURL)|S(?:ignS[LS]OMessage|toreSAMLToken|[LS]OBinding)|Force(?:Authn|UTF8)|NameIDFormat)|ExportedAttributes|XML)';
our $samlSPMetaDataNodeKeys = 'samlSPMetaData(?:Options(?:N(?:ameID(?:SessionKey|Format)|otOnOrAfterTimeout)|S(?:essionNotOnOrAfterTimeout|ignS[LS]OMessage)|(?:CheckS[LS]OMessageSignatur|OneTimeUs)e|En(?:ableIDPInitiatedURL|cryptionMode)|ForceUTF8)|ExportedAttributes|XML)';
our $virtualHostKeys = '(?:vhost(?:(?:Aliase|Http)s|Maintenance|Port)|(?:exportedHeader|locationRule)s|post)';
our $virtualHostKeys = '(?:vhost(?:(?:Maintenanc|Typ)e|(?:Aliase|Http)s|Port)|(?:exportedHeader|locationRule)s|post)';
our $authParameters = {
adParams => [qw(ADPwdMaxAge ADPwdExpireWarning)],
......
......@@ -5,8 +5,9 @@ example/scripts/purgeLocalCache
example/scripts/purgeLocalCache.cron.d
lib/Lemonldap/NG/Handler.pm
lib/Lemonldap/NG/Handler/ApacheMP2.pm
lib/Lemonldap/NG/Handler/ApacheMP2/AuthBasic.pm
lib/Lemonldap/NG/Handler/ApacheMP2/Main.pm
lib/Lemonldap/NG/Handler/API/ExperimentalNginx.pm
lib/Lemonldap/NG/Handler/AuthBasic.pm
lib/Lemonldap/NG/Handler/Lib/AuthBasic.pm
lib/Lemonldap/NG/Handler/Main.pm
lib/Lemonldap/NG/Handler/Main/Init.pm
......@@ -37,7 +38,6 @@ t/12-Lemonldap-NG-Handler-Jail.t
t/13-Lemonldap-NG-Handler-Fake-Safe.t
t/50-Lemonldap-NG-Handler-SecureToken.t
t/51-Lemonldap-NG-Handler-Zimbra.t
t/52-Lemonldap-NG-Handler-AuthBasic.t
t/60-Lemonldap-NG-Handler-PSGI.t
t/61-Lemonldap-NG-Handler-PSGI-Server.t
t/62-Lemonldap-NG-Handler-Nginx.t
......
package Lemonldap::NG::Handler::ApacheMP2;
use strict;
use AutoLoader 'AUTOLOAD';
use Apache2::RequestUtil;
use Apache2::RequestRec;
use Apache2::Log;
use Apache2::ServerUtil;
use Apache2::Connection;
use Apache2::RequestIO;
use Apache2::Const;
use Apache2::Filter;
use APR::Table;
use Apache2::Const -compile =>
qw(FORBIDDEN HTTP_UNAUTHORIZED REDIRECT OK DECLINED DONE SERVER_ERROR AUTH_REQUIRED HTTP_SERVICE_UNAVAILABLE);
use Lemonldap::NG::Handler::Main;
use constant FORBIDDEN => Apache2::Const::FORBIDDEN;
use constant HTTP_UNAUTHORIZED => Apache2::Const::HTTP_UNAUTHORIZED;
use constant REDIRECT => Apache2::Const::REDIRECT;
use constant OK => Apache2::Const::OK;
use constant DECLINED => Apache2::Const::DECLINED;
use constant DONE => Apache2::Const::DONE;
use constant SERVER_ERROR => Apache2::Const::SERVER_ERROR;
use constant AUTH_REQUIRED => Apache2::Const::AUTH_REQUIRED;
use constant MAINTENANCE => Apache2::Const::HTTP_SERVICE_UNAVAILABLE;
use constant BUFF_LEN => 8192;
eval { require threads::shared; };
print STDERR
"You probably would have better perfs by enabling threads::shared\n"
if ($@);
our @ISA = qw(Lemonldap::NG::Handler::Main);
use Lemonldap::NG::Handler::ApacheMP2::Main;
our $VERSION = '2.0.0';
our $request; # Apache2::RequestRec object for current request
# PUBLIC METHODS
sub handler {
my $class;
$class = $#_ ? shift : __PACKAGE__;
shift if($#_);
my $type = Lemonldap::NG::Handler::ApacheMP2::Main->checkType(@_);
my $class = "Lemonldap::NG::Handler::ApacheMP2::$type";
eval "require $class";
die $@ if($@);
my ($res) = $class->run(@_);
return $res;
}
## @rmethod protected int redirectFilter(string url, Apache2::Filter f)
# Launch the current HTTP request then redirects the user to $url.
# Used by logout_app and logout_app_sso targets
# @param $url URL to redirect the user
# @param $f Current Apache2::Filter object
# @return Constant $class->OK
sub redirectFilter {
my $class = shift;
my $url = shift;
my $f = shift;
unless ( $f->ctx ) {
# Here, we can use Apache2 functions instead of set_header_out
# since this function is used only with Apache2.
$f->r->status( $class->REDIRECT );
$f->r->status_line("303 See Other");
$f->r->headers_out->unset('Location');
$f->r->err_headers_out->set( 'Location' => $url );
$f->ctx(1);
}
while ( $f->read( my $buffer, 1024 ) ) {
}
$class->updateStatus( $f->r, '$class->REDIRECT',
$class->datas->{ $class->tsv->{whatToTrace} }, 'filter' );
return $class->OK;
}
__PACKAGE__->init();
# INTERNAL METHODS
## @method void thread_share(string $variable)
# try to share $variable between threads
# note: eval is needed,
# else it fails to compile if threads::shared is not loaded
# @param $variable the name of the variable to share
sub thread_share {
my ( $class, $variable ) = @_;
eval "threads::shared::share(\$variable);";
}
## @method void setServerSignature(string sign)
# modifies web server signature
# @param $sign String to add to server signature
sub setServerSignature {
my ( $class, $sign ) = @_;
eval {
Apache2::ServerUtil->server->push_handlers(
PerlPostConfigHandler => sub {
my ( $c, $l, $t, $s ) = @_;
$s->add_version_component($sign);
}
);
};
}
sub newRequest {
my ( $class, $r ) = @_;
$request = $r;
}
## @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: remove the useless tag 'ApacheMP2.pm(70):' in debug logs
Apache2::ServerRec->log->$level($msg);
}
## @method void set_user(string user)
# sets remote_user
# @param user string username
sub set_user {
my ( $class, $user ) = @_;
$request->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->headers_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 ) {
$request->headers_in->set( $h => $v );
}
}
## @method void unset_header_in(array headers)
# removes request headers
# This function looks a bit heavy: it is to ensure that if a request
# header 'Auth-User' is removed, 'Auth_User' be removed also
# @param headers array with header names to remove
sub unset_header_in {
my ( $class, @headers ) = @_;
foreach my $h1 (@headers) {
$h1 = lc $h1;
$h1 =~ s/-/_/g;
$request->headers_in->do(
sub {
my $h = shift;
my $h2 = lc $h;
$h2 =~ s/-/_/g;
$request->headers_in->unset($h) if ( $h1 eq $h2 );
return 1;
}
);
}
}
## @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 ) {
$request->err_headers_out->set( $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->hostname;
}
## @method string remote_ip
# returns client IP address
# @return IP_Addr string client IP
sub remote_ip {
my $class = shift;
my $remote_ip = (
$request->connection->can('remote_ip')
? $request->connection->remote_ip
: $request->connection->client_ip
);
return $remote_ip;
}
## @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 $request->is_initial_req;
}
## @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;
my $uri = $request->uri;
$uri =~ s#//+#/#g;
$uri =~ s#\?#%3F#g;
return $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->unparsed_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->get_server_port;
}
## @method string method
# returns the port the server is receiving the current request on
# @return port string server port
sub method {
my $class = shift;
return $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);
}
1;
__END__
## @method void addToHtmlHead(string data)
# add data at end of html head
# @param data Text to add in html head
sub addToHtmlHead {
use APR::Bucket ();
use APR::Brigade ();
my ( $class, $data ) = @_;
$request->add_output_filter(
sub {
my $f = shift;
my $bb = shift;
my $ctx = $f->ctx;
#unless ($ctx) {
# $f->r->headers_out->unset('Content-Length');
#}
my $done = 0;
my $buffer = $ctx->{data} ? $ctx->{data} : '';
my ( $bdata, $seen_eos ) = flatten_bb($bb);
unless ($done) {
$done = 1
if ( $bdata =~ s/(<\/head>)/$data$1/si
or $bdata =~ s/(<body>)/$1$data/si );
}
$buffer .= $bdata if ($bdata);
if ($seen_eos) {
my $len = length $buffer;
$f->r->headers_out->set( 'Content-Length', $len );
$f->print($buffer) if ($buffer);
}
else {
$ctx->{data} = $buffer;
$f->ctx($ctx);
}
return OK;
}
);
}
sub flatten_bb {
my ($bb) = shift;
my $seen_eos = 0;
my @data;
for ( my $b = $bb->first ; $b ; $b = $bb->next($b) ) {
$seen_eos++, last if $b->is_eos;
$b->read( my $bdata );
push @data, $bdata;
}
return ( join( '', @data ), $seen_eos );
}
## @method void setPostParams(hashref $params)
# add or modify parameters in POST request body
# @param $params hashref containing name => value
sub setPostParams {
my ( $class, $params ) = @_;
$request->add_input_filter(
sub {
my $f = shift;
my $buffer;
# Filter only POST request body
if ( $f->r->method eq "POST" ) {
my $body;
while ( $f->read($buffer) ) { $body .= $buffer; }
while ( my ( $name, $value ) = each(%$params) ) {
$body =~ s/((^|&))$name=[^\&]*/$1$name=$value/
or $body .= "&$name=$value";
}
$body =~ s/^&//;
$f->print($body);
}
else {
$f->print($buffer) while ( $f->read($buffer) );
}
return OK;
}
);
}
# Auth-basic authentication with Lemonldap::NG rights management
# This specific handler is intended to be called directly by Apache
package Lemonldap::NG::Handler::ApacheMP2::AuthBasic;
use strict;
use base 'Lemonldap::NG::Handler::Lib::AuthBasic',
'Lemonldap::NG::Handler::ApacheMP2::Main';
our $VERSION = '2.0.0';
1;
package Lemonldap::NG::Handler::ApacheMP2::Main;
use strict;
use AutoLoader 'AUTOLOAD';
use Apache2::RequestUtil;
use Apache2::RequestRec;
use Apache2::Log;
use Apache2::ServerUtil;
use Apache2::Connection;
use Apache2::RequestIO;
use Apache2::Const;
use Apache2::Filter;
use APR::Table;
use Apache2::Const -compile =>
qw(FORBIDDEN HTTP_UNAUTHORIZED REDIRECT OK DECLINED DONE SERVER_ERROR AUTH_REQUIRED HTTP_SERVICE_UNAVAILABLE);
use base 'Lemonldap::NG::Handler::Main';
use constant FORBIDDEN => Apache2::Const::FORBIDDEN;
use constant HTTP_UNAUTHORIZED => Apache2::Const::HTTP_UNAUTHORIZED;
use constant REDIRECT => Apache2::Const::REDIRECT;
use constant OK => Apache2::Const::OK;
use constant DECLINED => Apache2::Const::DECLINED;
use constant DONE => Apache2::Const::DONE;
use constant SERVER_ERROR => Apache2::Const::SERVER_ERROR;
use constant AUTH_REQUIRED => Apache2::Const::AUTH_REQUIRED;
use constant MAINTENANCE => Apache2::Const::HTTP_SERVICE_UNAVAILABLE;
use constant BUFF_LEN => 8192;
eval { require threads::shared; };
our $request; # Apache2::RequestRec object for current request
#*run = \&Lemonldap::NG::Handler::Main::run;
## @rmethod protected int redirectFilter(string url, Apache2::Filter f)
# Launch the current HTTP request then redirects the user to $url.
# Used by logout_app and logout_app_sso targets
# @param $url URL to redirect the user
# @param $f Current Apache2::Filter object
# @return Constant $class->OK
sub redirectFilter {
my $class = shift;
my $url = shift;
my $f = shift;
unless ( $f->ctx ) {
# Here, we can use Apache2 functions instead of set_header_out
# since this function is used only with Apache2.
$f->r->status( $class->REDIRECT );
$f->r->status_line("303 See Other");
$f->r->headers_out->unset('Location');
$f->r->err_headers_out->set( 'Location' => $url );
$f->ctx(1);
}
while ( $f->read( my $buffer, 1024 ) ) {
}
$class->updateStatus( $f->r, '$class->REDIRECT',
$class->datas->{ $class->tsv->{whatToTrace} }, 'filter' );
return $class->OK;
}
__PACKAGE__->init();
# INTERNAL METHODS
## @method void thread_share(string $variable)
# try to share $variable between threads
# note: eval is needed,
# else it fails to compile if threads::shared is not loaded
# @param $variable the name of the variable to share
sub thread_share {
my ( $class, $variable ) = @_;
eval "threads::shared::share(\$variable);";
}
## @method void setServerSignature(string sign)
# modifies web server signature
# @param $sign String to add to server signature
sub setServerSignature {
my ( $class, $sign ) = @_;
eval {
Apache2::ServerUtil->server->push_handlers(
PerlPostConfigHandler => sub {
my ( $c, $l, $t, $s ) = @_;
$s->add_version_component($sign);
}
);
};
}
sub newRequest {
my ( $class, $r ) = @_;
$request = $r;
}
## @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: remove the useless tag 'ApacheMP2.pm(70):' in debug logs
Apache2::ServerRec->log->$level($msg);
}
## @method void set_user(string user)
# sets remote_user
# @param user string username
sub set_user {
my ( $class, $user ) = @_;
$request->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->headers_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 ) {
$request->headers_in->set( $h => $v );
}
}
## @method void unset_header_in(array headers)
# removes request headers
# This function looks a bit heavy: it is to ensure that if a request
# header 'Auth-User' is removed, 'Auth_User' be removed also
# @param headers array with header names to remove
sub unset_header_in {
my ( $class, @headers ) = @_;
foreach my $h1 (@headers) {
$h1 = lc $h1;
$h1 =~ s/-/_/g;
$request->headers_in->do(
sub {
my $h = shift;
my $h2 = lc $h;
$h2 =~ s/-/_/g;
$request->headers_in->unset($h) if ( $h1 eq $h2 );
return 1;
}
);
}
}
## @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 ) {
$request->err_headers_out->set( $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->hostname;
}
## @method string remote_ip
# returns client IP address
# @return IP_Addr string client IP
sub remote_ip {
my $class = shift;
my $remote_ip = (
$request->connection->can('remote_ip')
? $request->connection->remote_ip
: $request->connection->client_ip
);
return $remote_ip;
}
## @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 $request->is_initial_req;
}
## @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;
my $uri = $request->uri;
$uri =~ s#//+#/#g;
$uri =~ s#\?#%3F#g;
return $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->unparsed_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->get_server_port;
}
## @method string method
# returns the port the server is receiving the current request on
# @return port string server port
sub method {
my $class = shift;
return $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);
}
1;
__END__
## @method void addToHtmlHead(string data)
# add data at end of html head
# @param data Text to add in html head
sub addToHtmlHead {
use APR::Bucket ();
use APR::Brigade ();
my ( $class, $data ) = @_;
$request->add_output_filter(
sub {
my $f = shift;
my $bb = shift;
my $ctx = $f->ctx;