2008-12-29 15:34:08 +01:00
|
|
|
## @file
|
|
|
|
# Virtual host support mechanism
|
|
|
|
|
|
|
|
## @class
|
|
|
|
# This class adds virtual host support for Lemonldap::NG handlers.
|
2006-12-18 12:32:33 +01:00
|
|
|
package Lemonldap::NG::Handler::Vhost;
|
|
|
|
|
2010-10-28 20:19:25 +02:00
|
|
|
use strict;
|
|
|
|
use AutoLoader 'AUTOLOAD';
|
|
|
|
|
2010-09-29 14:59:35 +02:00
|
|
|
use Lemonldap::NG::Handler::Simple qw(:locationRules :headers :post :apache)
|
|
|
|
; #inherits
|
2006-12-18 12:32:33 +01:00
|
|
|
use MIME::Base64;
|
2010-09-16 10:44:56 +02:00
|
|
|
use constant SAFEWRAP => ( Safe->can("wrap_code_ref") ? 1 : 0 );
|
2006-12-18 12:32:33 +01:00
|
|
|
|
2011-10-05 16:33:05 +02:00
|
|
|
our $VERSION = '1.1.2';
|
2006-12-18 12:32:33 +01:00
|
|
|
|
2010-10-09 10:13:45 +02:00
|
|
|
## @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 @_;
|
2012-02-29 18:19:11 +01:00
|
|
|
foreach my $t (qw(https port maintenance)) {
|
2010-10-11 18:12:04 +02:00
|
|
|
|
|
|
|
# Skip Handler initialization (values not defined)
|
|
|
|
next unless defined $args->{$t};
|
|
|
|
|
|
|
|
# Record default value in key '_'
|
2010-10-10 09:25:28 +02:00
|
|
|
$args->{$t} = { _ => $args->{$t} } unless ( ref( $args->{$t} ) );
|
2010-10-11 18:12:04 +02:00
|
|
|
|
|
|
|
# Override with vhost options
|
|
|
|
if ( defined $args->{vhostOptions} ) {
|
2010-10-14 11:50:23 +02:00
|
|
|
my $n = 'vhost' . ucfirst($t);
|
2010-10-11 18:12:04 +02:00
|
|
|
foreach my $k ( keys %{ $args->{vhostOptions} } ) {
|
|
|
|
my $v = $args->{vhostOptions}->{$k}->{$n};
|
|
|
|
$class->lmLog( "Options $t for vhost $k: $v", 'debug' );
|
|
|
|
$args->{$t}->{$k} = $v
|
|
|
|
if ( $v >= 0 ); # Keep default value if $v is negative
|
2010-10-10 09:25:28 +02:00
|
|
|
}
|
2010-10-09 10:13:45 +02:00
|
|
|
}
|
|
|
|
}
|
|
|
|
$class->Lemonldap::NG::Handler::Simple::defaultValuesInit($args);
|
|
|
|
}
|
|
|
|
|
|
|
|
## @imethod void locationRulesInit(hashRef args)
|
2008-12-29 15:34:08 +01:00
|
|
|
# Compile rules.
|
2008-12-30 10:37:56 +01:00
|
|
|
# Rules are stored in $args->{locationRules}->{<virtualhost>} that contains
|
2008-12-29 15:34:08 +01:00
|
|
|
# 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
|
2006-12-18 12:32:33 +01:00
|
|
|
sub locationRulesInit {
|
2010-01-31 09:25:05 +01:00
|
|
|
my ( $class, $args ) = splice @_;
|
2006-12-18 12:32:33 +01:00
|
|
|
foreach my $vhost ( keys %{ $args->{locationRules} } ) {
|
|
|
|
$locationCount->{$vhost} = 0;
|
2009-06-09 07:29:39 +02:00
|
|
|
foreach ( sort keys %{ $args->{locationRules}->{$vhost} } ) {
|
2006-12-18 12:32:33 +01:00
|
|
|
if ( $_ eq 'default' ) {
|
2010-03-09 22:42:31 +01:00
|
|
|
( $defaultCondition->{$vhost}, $defaultProtection->{$vhost} ) =
|
2007-01-04 09:42:13 +01:00
|
|
|
$class->conditionSub(
|
|
|
|
$args->{locationRules}->{$vhost}->{$_} );
|
2006-12-18 12:32:33 +01:00
|
|
|
}
|
|
|
|
else {
|
2010-03-09 22:42:31 +01:00
|
|
|
(
|
|
|
|
$locationCondition->{$vhost}->[ $locationCount->{$vhost} ],
|
|
|
|
$locationProtection->{$vhost}->[ $locationCount->{$vhost} ]
|
|
|
|
)
|
|
|
|
= $class->conditionSub(
|
2010-03-01 21:32:28 +01:00
|
|
|
$args->{locationRules}->{$vhost}->{$_} );
|
|
|
|
$locationRegexp->{$vhost}->[ $locationCount->{$vhost} ] =
|
|
|
|
qr/$_/;
|
2006-12-18 12:32:33 +01:00
|
|
|
$locationCount->{$vhost}++;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
# Default police
|
2010-03-09 22:42:31 +01:00
|
|
|
( $defaultCondition->{$vhost}, $defaultProtection->{$vhost} ) =
|
|
|
|
$class->conditionSub('accept')
|
2006-12-18 12:32:33 +01:00
|
|
|
unless ( $defaultCondition->{$vhost} );
|
|
|
|
}
|
2007-04-15 14:44:29 +02:00
|
|
|
1;
|
2006-12-18 12:32:33 +01:00
|
|
|
}
|
|
|
|
|
2010-10-09 10:13:45 +02:00
|
|
|
## @imethod void forgeHeadersInit(hashRef args)
|
2008-12-30 10:37:56 +01:00
|
|
|
# Create the &$forgeHeaders->{<virtualhost>} subroutines used to insert
|
2008-12-29 15:34:08 +01:00
|
|
|
# headers into the HTTP request.
|
|
|
|
# @param $args reference to the configuration hash
|
2006-12-18 12:32:33 +01:00
|
|
|
sub forgeHeadersInit {
|
2010-01-31 09:25:05 +01:00
|
|
|
my ( $class, $args ) = splice @_;
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
# Creation of the subroutine who will generate headers
|
|
|
|
foreach my $vhost ( keys %{ $args->{exportedHeaders} } ) {
|
|
|
|
my %tmp = %{ $args->{exportedHeaders}->{$vhost} };
|
|
|
|
foreach ( keys %tmp ) {
|
|
|
|
$tmp{$_} =~ s/\$(\w+)/\$datas->{$1}/g;
|
|
|
|
$tmp{$_} = $class->regRemoteIp( $tmp{$_} );
|
|
|
|
}
|
|
|
|
|
|
|
|
my $sub;
|
|
|
|
foreach ( keys %tmp ) {
|
2010-11-02 22:10:26 +01:00
|
|
|
$sub .= "'$_' => join('',split(/[\\r\\n]+/,$tmp{$_})),";
|
2006-12-18 12:32:33 +01:00
|
|
|
}
|
2007-01-04 09:42:13 +01:00
|
|
|
|
2010-09-04 13:49:03 +02:00
|
|
|
$forgeHeaders->{$vhost} = (
|
|
|
|
SAFEWRAP
|
|
|
|
? $class->safe->wrap_code_ref( $class->safe->reval("sub {$sub}") )
|
2010-11-02 22:10:26 +01:00
|
|
|
: $class->safe->reval("sub {return($sub)}")
|
2010-09-04 13:49:03 +02:00
|
|
|
);
|
2007-01-04 09:42:13 +01:00
|
|
|
$class->lmLog( "$class: Unable to forge headers: $@: sub {$sub}",
|
|
|
|
'error' )
|
|
|
|
if ($@);
|
2006-12-18 12:32:33 +01:00
|
|
|
}
|
2007-04-15 14:44:29 +02:00
|
|
|
1;
|
2006-12-18 12:32:33 +01:00
|
|
|
}
|
|
|
|
|
2012-02-02 12:56:35 +01:00
|
|
|
## @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} } ) {
|
|
|
|
my @tmp = keys %{ $args->{exportedHeaders}->{$vhost} };
|
|
|
|
$headerList->{$vhost} = \@tmp;
|
|
|
|
}
|
|
|
|
1;
|
|
|
|
}
|
|
|
|
|
2010-10-09 10:13:45 +02:00
|
|
|
## @rmethod void sendHeaders()
|
2008-12-29 15:34:08 +01:00
|
|
|
# Launch function compiled by forgeHeadersInit() for the current virtual host
|
2006-12-18 12:32:33 +01:00
|
|
|
sub sendHeaders {
|
|
|
|
my $class = shift;
|
2012-02-02 12:56:35 +01:00
|
|
|
my $vhost = $apacheRequest->hostname;
|
2006-12-18 12:32:33 +01:00
|
|
|
if ( defined( $forgeHeaders->{$vhost} ) ) {
|
2011-10-05 16:33:05 +02:00
|
|
|
$class->lmSetHeaderIn( $apacheRequest, &{ $forgeHeaders->{$vhost} } );
|
2006-12-18 12:32:33 +01:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2012-02-02 12:56:35 +01:00
|
|
|
## @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 {
|
2010-03-09 22:42:31 +01:00
|
|
|
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};
|
|
|
|
}
|
|
|
|
|
2010-10-09 10:13:45 +02:00
|
|
|
## @rmethod boolean grant()
|
2008-12-29 15:34:08 +01:00
|
|
|
# Grant or refuse client using compiled regexp and functions
|
|
|
|
# @return True if the user is granted to access to the current URL
|
2006-12-18 12:32:33 +01:00
|
|
|
sub grant {
|
2010-01-31 09:25:05 +01:00
|
|
|
my ( $class, $uri ) = splice @_;
|
2006-12-18 12:32:33 +01:00
|
|
|
my $vhost = $apacheRequest->hostname;
|
|
|
|
for ( my $i = 0 ; $i < $locationCount->{$vhost} ; $i++ ) {
|
|
|
|
if ( $uri =~ $locationRegexp->{$vhost}->[$i] ) {
|
|
|
|
return &{ $locationCondition->{$vhost}->[$i] }($datas);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
unless ( $defaultCondition->{$vhost} ) {
|
2007-01-04 09:42:13 +01:00
|
|
|
$class->lmLog(
|
|
|
|
"User rejected because VirtualHost \"$vhost\" has no configuration",
|
|
|
|
'warn'
|
|
|
|
);
|
2007-04-14 15:12:11 +02:00
|
|
|
return 0;
|
2006-12-18 12:32:33 +01:00
|
|
|
}
|
2008-08-22 18:06:48 +02:00
|
|
|
return &{ $defaultCondition->{$vhost} }($datas);
|
2006-12-18 12:32:33 +01:00
|
|
|
}
|
|
|
|
|
2012-01-26 16:12:09 +01:00
|
|
|
## @rmethod protected $ fetchId()
|
|
|
|
# Get user cookies and search for Lemonldap::NG cookie.
|
|
|
|
# @return Value of the cookie if found, 0 else
|
|
|
|
sub fetchId {
|
2012-02-29 14:19:57 +01:00
|
|
|
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 );
|
2012-01-26 16:12:09 +01:00
|
|
|
return $value;
|
|
|
|
}
|
|
|
|
|
2010-10-09 10:13:45 +02:00
|
|
|
## @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;
|
2010-10-10 09:25:28 +02:00
|
|
|
my $portString =
|
|
|
|
$port->{$vhost}
|
|
|
|
|| $port->{_}
|
|
|
|
|| $apacheRequest->get_server_port();
|
2010-10-09 10:13:45 +02:00
|
|
|
my $_https =
|
|
|
|
( defined( $https->{$vhost} ) ? $https->{$vhost} : $https->{_} );
|
|
|
|
$portString =
|
|
|
|
( $_https && $portString == 443 ) ? ''
|
|
|
|
: ( !$_https && $portString == 80 ) ? ''
|
|
|
|
: ':' . $portString;
|
2010-10-11 18:12:04 +02:00
|
|
|
my $url = "http"
|
2010-10-09 10:13:45 +02:00
|
|
|
. ( $_https ? "s" : "" ) . "://"
|
|
|
|
. $apacheRequest->get_server_name()
|
|
|
|
. $portString
|
|
|
|
. $s;
|
2010-10-11 18:12:04 +02:00
|
|
|
$class->lmLog( "Build URL $url", 'debug' );
|
|
|
|
return $url;
|
2010-10-09 10:13:45 +02:00
|
|
|
}
|
|
|
|
|
2010-10-28 20:19:25 +02:00
|
|
|
## @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} } ) {
|
|
|
|
|
|
|
|
# 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->{$vhost}->{ $d->{postUrl} } =
|
|
|
|
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 $vhost)",
|
|
|
|
'debug' );
|
|
|
|
$transform->{$vhost}->{$url} = sub {
|
|
|
|
return $class->buildPostForm($url)
|
|
|
|
if ( $apacheRequest->method ne 'POST' );
|
2011-07-03 14:35:03 +02:00
|
|
|
$apacheRequest->add_input_filter(
|
|
|
|
sub {
|
|
|
|
$class->postFilter( $tmp, @_ );
|
|
|
|
}
|
|
|
|
);
|
2010-10-28 20:19:25 +02:00
|
|
|
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;
|
|
|
|
}
|
|
|
|
|
2012-03-01 12:04:49 +01:00
|
|
|
## @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;
|
|
|
|
}
|
|
|
|
|
2011-07-03 14:35:03 +02:00
|
|
|
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
|
|
|
|
|
|
|
|
Xavier Guimard, E<lt>x.guimard@free.frE<gt>
|
|
|
|
|
|
|
|
=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
|
|
|
|
|
|
|
|
Copyright (C) 2005, 2010 by Xavier Guimard E<lt>x.guimard@free.frE<gt>
|
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify
|
|
|
|
it under the same terms as Perl itself, either Perl version 5.10.0 or,
|
|
|
|
at your option, any later version of Perl 5 you may have available.
|
|
|
|
|
|
|
|
=cut
|