504 lines
15 KiB
Perl
504 lines
15 KiB
Perl
## @file
|
|
# Virtual host support mechanism
|
|
|
|
## @class
|
|
# This class adds virtual host support for Lemonldap::NG handlers.
|
|
package Lemonldap::NG::Handler::Vhost;
|
|
|
|
use strict;
|
|
use AutoLoader 'AUTOLOAD';
|
|
|
|
use Lemonldap::NG::Handler::Simple qw(:locationRules :headers :post :apache)
|
|
; #inherits
|
|
use MIME::Base64;
|
|
use constant SAFEWRAP => ( Safe->can("wrap_code_ref") ? 1 : 0 );
|
|
|
|
our $VERSION = '1.3.0';
|
|
|
|
## @imethod protected void defaultValuesInit(hashRef args)
|
|
# Set default values for non-customized variables
|
|
# @param $args reference to the configuration hash
|
|
sub defaultValuesInit {
|
|
my ( $class, $args ) = splice @_;
|
|
foreach my $t (qw(https port maintenance)) {
|
|
|
|
# Skip Handler initialization (values not defined)
|
|
next unless defined $args->{$t};
|
|
|
|
# Record default value in key '_'
|
|
$args->{$t} = { _ => $args->{$t} } unless ( ref( $args->{$t} ) );
|
|
|
|
# Override with vhost options
|
|
if ( defined $args->{vhostOptions} ) {
|
|
my $n = 'vhost' . ucfirst($t);
|
|
foreach my $k ( keys %{ $args->{vhostOptions} } ) {
|
|
foreach my $alias (
|
|
@{ $class->getAliases( $k, $args->{vhostOptions} ) } )
|
|
{
|
|
my $v = $args->{vhostOptions}->{$k}->{$n};
|
|
$class->lmLog( "Options $t for vhost $alias: $v", 'debug' );
|
|
$args->{$t}->{$alias} = $v
|
|
if ( $v >= 0 ); # Keep default value if $v is negative
|
|
}
|
|
}
|
|
}
|
|
}
|
|
$class->Lemonldap::NG::Handler::Simple::defaultValuesInit($args);
|
|
}
|
|
|
|
## @imethod void locationRulesInit(hashRef args)
|
|
# Compile rules.
|
|
# Rules are stored in $args->{locationRules}->{<virtualhost>} that contains
|
|
# regexp=>test expressions where :
|
|
# - regexp is used to test URIs
|
|
# - test contains an expression used to grant the user
|
|
#
|
|
# This function creates 2 hashRef containing :
|
|
# - one list of the compiled regular expressions for each virtual host
|
|
# - one list of the compiled functions (compiled with conditionSub()) for each
|
|
# virtual host
|
|
# @param $args reference to the configuration hash
|
|
sub locationRulesInit {
|
|
my ( $class, $args ) = splice @_;
|
|
foreach my $vhost ( keys %{ $args->{locationRules} } ) {
|
|
foreach
|
|
my $alias ( @{ $class->getAliases( $vhost, $args->{vhostOptions} ) } )
|
|
{
|
|
$locationCount->{$alias} = 0;
|
|
foreach ( sort keys %{ $args->{locationRules}->{$vhost} } ) {
|
|
if ( $_ eq 'default' ) {
|
|
(
|
|
$defaultCondition->{$alias},
|
|
$defaultProtection->{$alias}
|
|
)
|
|
= $class->conditionSub(
|
|
$args->{locationRules}->{$vhost}->{$_} );
|
|
}
|
|
else {
|
|
(
|
|
$locationCondition->{$alias}
|
|
->[ $locationCount->{$alias} ],
|
|
$locationProtection->{$alias}
|
|
->[ $locationCount->{$alias} ]
|
|
)
|
|
= $class->conditionSub(
|
|
$args->{locationRules}->{$vhost}->{$_} );
|
|
$locationRegexp->{$alias}->[ $locationCount->{$alias} ] =
|
|
qr/$_/;
|
|
$locationConditionText->{$alias}
|
|
->[ $locationCount->{$alias} ] =
|
|
/^\(\?#(.*?)\)/ ? $1 : /^(.*?)##(.+)$/ ? $2 : $_;
|
|
$locationCount->{$alias}++;
|
|
}
|
|
}
|
|
|
|
# Default police
|
|
( $defaultCondition->{$alias}, $defaultProtection->{$alias} ) =
|
|
$class->conditionSub('accept')
|
|
unless ( $defaultCondition->{$alias} );
|
|
}
|
|
|
|
}
|
|
|
|
1;
|
|
}
|
|
|
|
## @imethod void forgeHeadersInit(hashRef args)
|
|
# Create the &$forgeHeaders->{<virtualhost>} subroutines used to insert
|
|
# headers into the HTTP request.
|
|
# @param $args reference to the configuration hash
|
|
sub forgeHeadersInit {
|
|
my ( $class, $args ) = splice @_;
|
|
|
|
# Creation of the subroutine who will generate headers
|
|
foreach my $vhost ( keys %{ $args->{exportedHeaders} } ) {
|
|
foreach
|
|
my $alias ( @{ $class->getAliases( $vhost, $args->{vhostOptions} ) } )
|
|
{
|
|
my %tmp = %{ $args->{exportedHeaders}->{$vhost} };
|
|
foreach ( keys %tmp ) {
|
|
$tmp{$_} =~ s/\$(\w+)/\$datas->{$1}/g;
|
|
$tmp{$_} = $class->regRemoteIp( $tmp{$_} );
|
|
}
|
|
|
|
my $sub;
|
|
foreach ( keys %tmp ) {
|
|
$sub .= "'$_' => join('',split(/[\\r\\n]+/,$tmp{$_})),";
|
|
}
|
|
|
|
$forgeHeaders->{$alias} = (
|
|
SAFEWRAP
|
|
? $class->safe->wrap_code_ref(
|
|
$class->safe->reval("sub {$sub}")
|
|
)
|
|
: $class->safe->reval("sub {return($sub)}")
|
|
);
|
|
$class->lmLog( "$class: Unable to forge headers: $@: sub {$sub}",
|
|
'error' )
|
|
if ($@);
|
|
}
|
|
|
|
}
|
|
|
|
1;
|
|
}
|
|
|
|
## @imethod void headerListInit(hashRef args)
|
|
# Lists the exported HTTP headers into $headerList
|
|
# @param $args reference to the configuration hash
|
|
sub headerListInit {
|
|
my ( $class, $args ) = splice @_;
|
|
|
|
foreach my $vhost ( keys %{ $args->{exportedHeaders} } ) {
|
|
foreach
|
|
my $alias ( @{ $class->getAliases( $vhost, $args->{vhostOptions} ) } )
|
|
{
|
|
my @tmp = keys %{ $args->{exportedHeaders}->{$vhost} };
|
|
$headerList->{$alias} = \@tmp;
|
|
}
|
|
}
|
|
1;
|
|
}
|
|
|
|
## @rmethod void sendHeaders()
|
|
# Launch function compiled by forgeHeadersInit() for the current virtual host
|
|
sub sendHeaders {
|
|
my $class = shift;
|
|
my $vhost = $apacheRequest->hostname;
|
|
if ( defined( $forgeHeaders->{$vhost} ) ) {
|
|
$class->lmSetHeaderIn( $apacheRequest, &{ $forgeHeaders->{$vhost} } );
|
|
}
|
|
}
|
|
|
|
## @rmethod void cleanHeaders()
|
|
# Unset HTTP headers for the current virtual host, when sendHeaders is skipped
|
|
sub cleanHeaders {
|
|
my $class = shift;
|
|
my $vhost = $apacheRequest->hostname;
|
|
if ( defined( $forgeHeaders->{$vhost} ) ) {
|
|
$class->lmUnsetHeaderIn( $apacheRequest, @{ $headerList->{$vhost} } );
|
|
}
|
|
}
|
|
|
|
## @rmethod protected int isUnprotected()
|
|
# @return 0 if URI is protected,
|
|
# UNPROTECT if it is unprotected by "unprotect",
|
|
# SKIP if is is unprotected by "skip"
|
|
sub isUnprotected {
|
|
my ( $class, $uri ) = splice @_;
|
|
my $vhost = $apacheRequest->hostname;
|
|
for ( my $i = 0 ; $i < $locationCount->{$vhost} ; $i++ ) {
|
|
if ( $uri =~ $locationRegexp->{$vhost}->[$i] ) {
|
|
return $locationProtection->{$vhost}->[$i];
|
|
}
|
|
}
|
|
return $defaultProtection->{$vhost};
|
|
}
|
|
|
|
## @rmethod boolean grant()
|
|
# Grant or refuse client using compiled regexp and functions
|
|
# @return True if the user is granted to access to the current URL
|
|
sub grant {
|
|
my ( $class, $uri ) = splice @_;
|
|
my $vhost = $apacheRequest->hostname;
|
|
for ( my $i = 0 ; $i < $locationCount->{$vhost} ; $i++ ) {
|
|
if ( $uri =~ $locationRegexp->{$vhost}->[$i] ) {
|
|
$class->lmLog(
|
|
'Regexp "' . $locationConditionText->{$vhost}->[$i] . '" match',
|
|
'debug'
|
|
);
|
|
return &{ $locationCondition->{$vhost}->[$i] }($datas);
|
|
}
|
|
}
|
|
unless ( $defaultCondition->{$vhost} ) {
|
|
$class->lmLog(
|
|
"User rejected because VirtualHost \"$vhost\" has no configuration",
|
|
'warn'
|
|
);
|
|
return 0;
|
|
}
|
|
$class->lmLog( "$vhost: Apply default rule", 'debug' );
|
|
return &{ $defaultCondition->{$vhost} }($datas);
|
|
}
|
|
|
|
## @rmethod protected $ fetchId()
|
|
# Get user cookies and search for Lemonldap::NG cookie.
|
|
# @return Value of the cookie if found, 0 else
|
|
sub fetchId {
|
|
my $t = lmHeaderIn( $apacheRequest, 'Cookie' );
|
|
my $vhost = $apacheRequest->hostname;
|
|
my $lookForHttpCookie = $securedCookie =~ /^(2|3)$/
|
|
&& !(
|
|
defined( $https->{$vhost} )
|
|
? $https->{$vhost}
|
|
: $https->{_}
|
|
);
|
|
my $value =
|
|
$lookForHttpCookie
|
|
? ( $t =~ /${cookieName}http=([^,; ]+)/o ? $1 : 0 )
|
|
: ( $t =~ /$cookieName=([^,; ]+)/o ? $1 : 0 );
|
|
|
|
$value = $cipher->decryptHex( $value, "http" )
|
|
if ( $value && $lookForHttpCookie && $securedCookie == 3 );
|
|
return $value;
|
|
}
|
|
|
|
## @cmethod private string _buildUrl(string s)
|
|
# Transform /<s> into http(s?)://<host>:<port>/s
|
|
# @param $s path
|
|
# @return URL
|
|
sub _buildUrl {
|
|
my ( $class, $s ) = splice @_;
|
|
my $vhost = $apacheRequest->hostname;
|
|
my $portString =
|
|
$port->{$vhost}
|
|
|| $port->{_}
|
|
|| $apacheRequest->get_server_port();
|
|
my $_https = (
|
|
defined( $https->{$vhost} )
|
|
? $https->{$vhost}
|
|
: $https->{_}
|
|
);
|
|
$portString =
|
|
( $_https && $portString == 443 ) ? ''
|
|
: ( !$_https && $portString == 80 ) ? ''
|
|
: ':' . $portString;
|
|
my $url = "http"
|
|
. ( $_https ? "s" : "" ) . "://"
|
|
. $apacheRequest->get_server_name()
|
|
. $portString
|
|
. $s;
|
|
$class->lmLog( "Build URL $url", 'debug' );
|
|
return $url;
|
|
}
|
|
|
|
## @imethod protected void postUrlInit()
|
|
# Prepare methods to post form attributes
|
|
sub postUrlInit {
|
|
my ( $class, $args ) = splice @_;
|
|
|
|
# Do nothing if no POST configured
|
|
return unless ( $args->{post} );
|
|
|
|
# Load required modules
|
|
eval 'use Apache2::Filter;use URI';
|
|
|
|
# Prepare transform sub
|
|
$transform = {};
|
|
|
|
# Browse all vhost
|
|
foreach my $vhost ( keys %{ $args->{post} } ) {
|
|
|
|
foreach
|
|
my $alias ( @{ $class->getAliases( $vhost, $args->{vhostOptions} ) } )
|
|
{
|
|
|
|
# Browse all POST URI
|
|
while ( my ( $url, $d ) = each( %{ $args->{post}->{$vhost} } ) ) {
|
|
|
|
# Where to POST
|
|
$d->{postUrl} ||= $url;
|
|
|
|
# Register POST form for POST URL
|
|
$transform->{$alias}->{$url} =
|
|
sub { $class->buildPostForm( $d->{postUrl} ) }
|
|
if ( $url ne $d->{postUrl} );
|
|
|
|
# Get datas to POST
|
|
my $expr = $d->{expr};
|
|
my %postdata;
|
|
|
|
# Manage old and new configuration format
|
|
# OLD: expr => 'param1 => value1, param2 => value2',
|
|
# NEW : expr => { param1 => value1, param2 => value2 },
|
|
if ( ref $expr eq 'HASH' ) {
|
|
%postdata = %$expr;
|
|
}
|
|
else {
|
|
%postdata = split /(?:\s*=>\s*|\s*,\s*)/, $expr;
|
|
}
|
|
|
|
# Build string for URI::query_form
|
|
my $tmp;
|
|
foreach ( keys %postdata ) {
|
|
$postdata{$_} =~ s/\$(\w+)/\$datas->{$1}/g;
|
|
$postdata{$_} = "'$postdata{$_}'"
|
|
if ( $postdata{$_} =~ /^\w+$/ );
|
|
$tmp .= "'$_'=>$postdata{$_},";
|
|
}
|
|
|
|
$class->lmLog( "Compiling POST request for $url (vhost $alias)",
|
|
'debug' );
|
|
$transform->{$alias}->{ $d->{postUrl} } = sub {
|
|
return $class->buildPostForm( $d->{postUrl} )
|
|
if ( $apacheRequest->method ne 'POST' );
|
|
$apacheRequest->add_input_filter(
|
|
sub {
|
|
$class->postFilter( $tmp, @_ );
|
|
}
|
|
);
|
|
OK;
|
|
}
|
|
}
|
|
|
|
}
|
|
}
|
|
}
|
|
|
|
## @rmethod protected transformUri(string uri)
|
|
# Transform URI to replay POST forms
|
|
# @param uri URI to catch
|
|
# @return Apache2::Const
|
|
sub transformUri {
|
|
my ( $class, $uri ) = splice @_;
|
|
my $vhost = $apacheRequest->hostname;
|
|
|
|
if ( defined( $transform->{$vhost}->{$uri} ) ) {
|
|
return &{ $transform->{$vhost}->{$uri} };
|
|
}
|
|
|
|
OK;
|
|
}
|
|
|
|
## @rmethod protected boolean checkMaintenanceMode
|
|
# Check if we are in maintenance mode
|
|
# @return true if maintenance mode
|
|
sub checkMaintenanceMode {
|
|
my ($class) = splice @_;
|
|
my $vhost = $apacheRequest->hostname;
|
|
my $_maintenance =
|
|
( defined $maintenance->{$vhost} )
|
|
? $maintenance->{$vhost}
|
|
: $maintenance->{_};
|
|
|
|
if ($_maintenance) {
|
|
$class->lmLog( "Maintenance mode activated", 'debug' );
|
|
return 1;
|
|
}
|
|
|
|
return 0;
|
|
}
|
|
|
|
## @method arrayref getAliases(scalar vhost, hashref options)
|
|
# Check aliases of a vhost
|
|
# @param vhost vhost name
|
|
# @param options vhostOptions configuration item
|
|
# @return arrayref of vhost and aliases
|
|
sub getAliases {
|
|
my ( $class, $vhost, $options ) = splice @_;
|
|
my $aliases = [$vhost];
|
|
|
|
if ( $options->{$vhost}->{vhostAliases} ) {
|
|
foreach ( split /\s+/, $options->{$vhost}->{vhostAliases} ) {
|
|
push @$aliases, $_;
|
|
$class->lmLog( "$_ is an alias for $vhost", 'debug' );
|
|
}
|
|
}
|
|
|
|
return $aliases;
|
|
}
|
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
=encoding utf8
|
|
|
|
Lemonldap::NG::Handler::Vhost - Perl extension for building a Lemonldap::NG
|
|
compatible handler able to manage Apache virtual hosts.
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
Create your own package:
|
|
|
|
package My::Package;
|
|
use Lemonldap::NG::Handler::Vhost;
|
|
|
|
# IMPORTANT ORDER
|
|
our @ISA = qw (Lemonldap::NG::Handler::Vhost Lemonldap::NG::Handler::Simple);
|
|
|
|
__PACKAGE__->init ( { locationRules => {
|
|
'vhost1.dc.com' => {
|
|
'default' => '$ou =~ /brh/'
|
|
},
|
|
'vhost2.dc.com' => {
|
|
'^/pj/.*$' => '$qualif="opj"',
|
|
'^/rh/.*$' => '$ou=~/brh/',
|
|
'^/rh_or_opj.*$' => '$qualif="opj" or $ou=~/brh/',
|
|
default => 'accept',
|
|
},
|
|
# Put here others Lemonldap::NG::Handler::Simple options
|
|
}
|
|
);
|
|
|
|
Call your package in <apache-directory>/conf/httpd.conf
|
|
|
|
PerlRequire MyFile
|
|
PerlHeaderParserHandler My::Package
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This library provides a way to protect Apache virtual hosts with Lemonldap::NG.
|
|
|
|
=head2 INITIALISATION PARAMETERS
|
|
|
|
Lemonldap::NG::Handler::Vhost splits the locationRules parameter into a hash
|
|
reference which contains anonymous hash references as used by
|
|
L<Lemonldap::NG::Handler::Simple>.
|
|
|
|
=head1 SEE ALSO
|
|
|
|
L<Lemonldap::NG::Handler(3)>,
|
|
L<http://lemonldap-ng.org/>
|
|
|
|
=head1 AUTHOR
|
|
|
|
=over
|
|
|
|
=item Clement Oudot, E<lt>clem.oudot@gmail.comE<gt>
|
|
|
|
=item François-Xavier Deltombe, E<lt>fxdeltombe@gmail.com.E<gt>
|
|
|
|
=item Xavier Guimard, E<lt>x.guimard@free.frE<gt>
|
|
|
|
=back
|
|
|
|
=head1 BUG REPORT
|
|
|
|
Use OW2 system to report bug or ask for features:
|
|
L<http://jira.ow2.org>
|
|
|
|
=head1 DOWNLOAD
|
|
|
|
Lemonldap::NG is available at
|
|
L<http://forge.objectweb.org/project/showfiles.php?group_id=274>
|
|
|
|
=head1 COPYRIGHT AND LICENSE
|
|
|
|
=over
|
|
|
|
=item Copyright (C) 2006, 2007, 2008, 2009, 2010 by Xavier Guimard, E<lt>x.guimard@free.frE<gt>
|
|
|
|
=item Copyright (C) 2012 by François-Xavier Deltombe, E<lt>fxdeltombe@gmail.com.E<gt>
|
|
|
|
=item Copyright (C) 2006, 2010, 2011, 2012, 2013 by Clement Oudot, E<lt>clem.oudot@gmail.comE<gt>
|
|
|
|
=back
|
|
|
|
This library is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation; either version 2, or (at your option)
|
|
any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program. If not, see L<http://www.gnu.org/licenses/>.
|
|
|
|
=cut
|