diff --git a/lemonldap-ng-common/MANIFEST b/lemonldap-ng-common/MANIFEST index 332058729..75bc4cf91 100644 --- a/lemonldap-ng-common/MANIFEST +++ b/lemonldap-ng-common/MANIFEST @@ -9,7 +9,6 @@ lib/Lemonldap/NG/Common/Apache/Session/Serialize/JSON.pm lib/Lemonldap/NG/Common/Apache/Session/SOAP.pm lib/Lemonldap/NG/Common/Apache/Session/Store.pm lib/Lemonldap/NG/Common/Captcha.pm -lib/Lemonldap/NG/Common/CGI.pm lib/Lemonldap/NG/Common/Cli.pm lib/Lemonldap/NG/Common/Combination/Parser.pm lib/Lemonldap/NG/Common/Conf.pm @@ -65,7 +64,6 @@ t/02-Common-Conf-File.t t/03-Common-Conf-CDBI.t t/03-Common-Conf-RDBI.t t/05-Common-Conf-LDAP.t -t/20-Common-CGI.t t/30-Common-Safelib.t t/35-Common-Crypto.t t/36-Common-Regexp.t diff --git a/lemonldap-ng-common/lib/Lemonldap/NG/Common/CGI.pm b/lemonldap-ng-common/lib/Lemonldap/NG/Common/CGI.pm deleted file mode 100644 index ea8b9c750..000000000 --- a/lemonldap-ng-common/lib/Lemonldap/NG/Common/CGI.pm +++ /dev/null @@ -1,543 +0,0 @@ -## @file -# Base package for all Lemonldap::NG CGI - -## @class -# Base class for all Lemonldap::NG CGI -package Lemonldap::NG::Common::CGI; - -use strict; - -use File::Basename; -use MIME::Base64; -use Time::Local; -use CGI; -use utf8; -use Encode; -use Net::CIDR::Lite; - -#parameter syslog Indicates syslog facility for logging user actions - -our $VERSION = '2.0.0'; -our $_SUPER; -our @ISA; - -BEGIN { - if ( exists $ENV{MOD_PERL} ) { - if ( $ENV{MOD_PERL_API_VERSION} and $ENV{MOD_PERL_API_VERSION} >= 2 ) { - eval 'use constant MP => 2;'; - } - else { - eval 'use constant MP => 1;'; - } - } - else { - eval 'use constant MP => 0;'; - } - $_SUPER = 'CGI'; - @ISA = ('CGI'); -} - -sub import { - my $pkg = shift; - if ( $pkg eq __PACKAGE__ and @_ and $_[0] eq "fastcgi" ) { - eval 'use CGI::Fast'; - die($@) if ($@); - unshift @ISA, 'CGI::Fast'; - $_SUPER = 'CGI::Fast'; - } -} - -## @cmethod Lemonldap::NG::Common::CGI new(@p) -# Constructor: launch CGI::new() then secure parameters since CGI store them at -# the root of the object. -# @param p arguments for CGI::new() -# @return new Lemonldap::NG::Common::CGI object -sub new { - my $class = shift; - my $self = $_SUPER->new(@_) or return undef; - $self->{_prm} = {}; - my @tmp = $self->param(); - foreach (@tmp) { - $self->{_prm}->{$_} = $self->param($_); - $self->delete($_); - } - $self->{lang} = extract_lang(); - bless $self, $class; - return $self; -} - -## @method scalar param(string s, scalar newValue) -# Return the wanted parameter issued of GET or POST request. If $s is not set, -# return the list of parameters names -# @param $s name of the parameter -# @param $newValue if set, the parameter will be set to his value -# @return datas passed by GET or POST method -sub param { - my ( $self, $p, $v ) = @_; - $self->{_prm}->{$p} = $v if ($v); - unless ( defined $p ) { - return keys %{ $self->{_prm} }; - } - return $self->{_prm}->{$p}; -} - -## @method scalar rparam(string s) -# Return a reference to a parameter -# @param $s name of the parameter -# @return ref to parameter data -sub rparam { - my ( $self, $p ) = @_; - return $self->{_prm}->{$p} ? \$self->{_prm}->{$p} : undef; -} - -## @method void lmLog(string mess, string level) -# Log subroutine. Use Apache::Log in ModPerl::Registry context else simply -# print on STDERR non debug messages. -# @param $mess Text to log -# @param $level Level (debug|info|notice|error) -sub lmLog { - my ( $self, $mess, $level ) = @_; - my $call; - if ( $level eq 'debug' ) { - $mess = ( ref($self) ? ref($self) : $self ) . ": $mess"; - } - else { - my @tmp = caller(); - $call = "$tmp[1] $tmp[2]:"; - } - if ( $self->r and MP() ) { - $self->abort( "Level is required", - 'the parameter "level" is required when lmLog() is used' ) - unless ($level); - if ( MP() == 2 ) { - require Apache2::Log; - Apache2::ServerRec->log->debug($call) if ($call); - Apache2::ServerRec->log->$level($mess); - } - else { - Apache->server->log->debug($call) if ($call); - Apache->server->log->$level($mess); - } - } - else { - $self->{hideLogLevels} = 'debug|info' - unless defined( $self->{hideLogLevels} ); - my $re = qr/^(?:$self->{hideLogLevels})$/; - print STDERR "$call\n" if ( $call and 'debug' !~ $re ); - print STDERR "[$level] $mess\n" unless ( $level =~ $re ); - } -} - -## @method void setApacheUser(string user) -# Set user for Apache logs in ModPerl::Registry context. Does nothing else. -# @param $user data to set as user in Apache logs -sub setApacheUser { - my ( $self, $user ) = @_; - if ( $self->r and MP() ) { - $self->lmLog( "Inform Apache about the user connected", 'debug' ); - if ( MP() == 2 ) { - require Apache2::Connection; - $self->r->user($user); - } - else { - $self->r->connection->user($user); - } - } - $ENV{REMOTE_USER} = $user; -} - -##@method string getApacheHtdocsPath() -# Return absolute path to the htdocs directory where the current script is -# @return path string -sub getApacheHtdocsPath { - return dirname( $ENV{SCRIPT_FILENAME} || $0 ); -} - -## @method void soapTest(string soapFunctions, object obj) -# Check if request is a SOAP request. If it is, launch -# Lemonldap::NG::Common::CGI::SOAPServer and exit. Else simply return. -# @param $soapFunctions list of authorized functions. -# @param $obj optional object that will receive SOAP requests -sub soapTest { - my ( $self, $soapFunctions, $obj ) = @_; - - # If non form encoded datas are posted, we call SOAP Services - if ( $ENV{HTTP_SOAPACTION} ) { - require - Lemonldap::NG::Common::CGI::SOAPServer; #link protected dispatcher - require - Lemonldap::NG::Common::CGI::SOAPService; #link protected soapService - my @func = ( - ref($soapFunctions) ? @$soapFunctions : split /\s+/, - $soapFunctions - ); - my $dispatcher = - Lemonldap::NG::Common::CGI::SOAPService->new( $obj || $self, @func ); - Lemonldap::NG::Common::CGI::SOAPServer->dispatch_to($dispatcher) - ->handle($self); - $self->quit(); - } -} - -## @method string header_public(string filename) -# Implements the "304 Not Modified" HTTP mechanism. -# If HTTP request contains an "If-Modified-Since" header and if -# $filename was not modified since, prints the "304 Not Modified" response and -# exit. Else, launch CGI::header() with "Cache-Control" and "Last-Modified" -# headers. -# @param $filename Optional name of the reference file. Default -# $ENV{SCRIPT_FILENAME}. -# @return Common Gateway Interface standard response header -sub header_public { - my $self = shift; - my $filename = shift; - $filename ||= $ENV{SCRIPT_FILENAME}; - my @tmp = stat($filename); - my $date = $tmp[9]; - my $hd = gmtime($date); - $hd =~ s/^(\w+)\s+(\w+)\s+(\d+)\s+([\d:]+)\s+(\d+)$/$1, $3 $2 $5 $4 GMT/; - my $year = $5; - my $cm = $2; - - # TODO: Remove TODO_ for stable releases - if ( my $ref = $ENV{HTTP_IF_MODIFIED_SINCE} ) { - my %month = ( - jan => 0, - feb => 1, - mar => 2, - apr => 3, - may => 4, - jun => 5, - jul => 6, - aug => 7, - sep => 8, - oct => 9, - nov => 10, - dec => 11 - ); - if ( $ref =~ /^\w+,\s+(\d+)\s+(\w+)\s+(\d+)\s+(\d+):(\d+):(\d+)/ ) { - my $m = $month{ lc($2) }; - $year-- if ( $m > $month{ lc($cm) } ); - $ref = timegm( $6, $5, $4, $1, $m, $3 ); - if ( $ref == $date ) { - print $self->SUPER::header( -status => '304 Not Modified', @_ ); - $self->quit(); - } - } - } - return $self->SUPER::header( - '-Last-Modified' => $hd, - '-Cache-Control' => 'public; must-revalidate; max-age=1800', - @_ - ); -} - -## @method void abort(string title, string text) -# Display an error message and exit. -# Used instead of die() in Lemonldap::NG CGIs. -# @param title Title of the error message -# @param text Optional text. Default: "See Apache's logs" -sub abort { - my $self = shift; - my $cgi = CGI->new(); - my ( $t1, $t2 ) = @_; - - # Default message - $t2 ||= "See Apache's logs"; - - # Change \n into
for HTML - my $t2html = $t2; - $t2html =~ s#\n#
#g; - - print $cgi->header( -type => 'text/html; charset=utf-8', ); - print $cgi->start_html( - -title => $t1, - -encoding => 'utf8', - -style => { - -code => ' -body{ - background:#000; - color:#fff; - padding:10px 50px; - font-family:sans-serif; -} -a { - text-decoration:none; - color:#fff; -} - ' - }, - ); - print "

$t1

$t2html

"; - print - '
LemonLDAP::NG
'; - print STDERR ( ref($self) || $self ) . " error: $t1, $t2\n"; - print $cgi->end_html(); - $self->quit(); -} - -##@method private void startSyslog() -# Open syslog connection. -sub startSyslog { - my $self = shift; - return if ( $self->{_syslog} ); - eval { - require Sys::Syslog; - Sys::Syslog->import(':standard'); - openlog( 'lemonldap-ng', 'ndelay,pid', $self->{syslog} ); - }; - $self->abort( "Unable to use syslog", $@ ) if ($@); - $self->{_syslog} = 1; -} - -##@method void userLog(string mess, string level) -# Log user actions on Apache logs or syslog. -# @param $mess string to log -# @param $level level of log message -sub userLog { - my ( $self, $mess, $level ) = @_; - if ( $self->{syslog} ) { - $self->startSyslog(); - $level =~ s/^warn$/warning/; - syslog( $level || 'notice', $mess ); - } - else { - $self->lmLog( $mess, $level ); - } -} - -##@method void userInfo(string mess) -# Log non important user actions. Alias for userLog() with facility "info". -# @param $mess string to log -sub userInfo { - my ( $self, $mess ) = @_; - $mess = "Lemonldap::NG : $mess (" . $self->ipAddr . ")"; - $self->userLog( $mess, 'info' ); -} - -##@method void userNotice(string mess) -# Log user actions like access and logout. Alias for userLog() with facility -# "notice". -# @param $mess string to log -sub userNotice { - my ( $self, $mess ) = @_; - $mess = "Lemonldap::NG : $mess (" . $self->ipAddr . ")"; - $self->userLog( $mess, 'notice' ); -} - -##@method void userError(string mess) -# Log user errors like "bad password". Alias for userLog() with facility -# "warn". -# @param $mess string to log -sub userError { - my ( $self, $mess ) = @_; - $mess = "Lemonldap::NG : $mess (" . $self->ipAddr . ")"; - $self->userLog( $mess, 'warn' ); -} - -## @method protected scalar _sub(string sub, array p) -# Launch $self->{$sub} if defined, else launch $self->$sub. -# @param $sub name of the sub to launch -# @param @p parameters for the sub -sub _sub { - my ( $self, $sub, @p ) = @_; - if ( $self->{$sub} ) { - $self->lmLog( "processing to custom sub $sub", 'debug' ); - return &{ $self->{$sub} }( $self, @p ); - } - else { - $self->lmLog( "processing to sub $sub", 'debug' ); - return $self->$sub(@p); - } -} - -##@method string extract_lang -#@return array of user's preferred languages (two letters) -sub extract_lang { - my $self = shift; - - my @langs = split /,\s*/, ( shift || $ENV{HTTP_ACCEPT_LANGUAGE} || "" ); - my @res = (); - - foreach (@langs) { - - # Languages are supposed to be sorted by preference - my $lang = ( split /;/ )[0]; - - # Take first part of lang code (part before -) - $lang = ( split /-/, $lang )[0]; - - # Go to next if lang was already added - next if grep( /\Q$lang\E/, @res ); - - # Store lang only if size is 2 characters - push @res, $lang if ( length($lang) == 2 ); - } - - return \@res; -} - -##@method void translate_template(string text_ref, string lang) -# translate_template is used as an HTML::Template filter to tranlate strings in -# the wanted language -#@param text_ref reference to the string to translate -#@param lang optionnal language wanted. Falls to browser language instead. -#@return -sub translate_template { - my $self = shift; - my $text_ref = shift; - - # Decode UTF-8 - utf8::decode($$text_ref) unless ( $ENV{FCGI_ROLE} ); - - # Test if a translation is available for the selected language - # If not available, return the first translated string - # - foreach ( @{ $self->{lang} } ) { - if ( $$text_ref =~ m/$_=\"(.*?)\"/ ) { - $$text_ref =~ s//$1/gx; - return; - } - } - $$text_ref =~ s//$1/gx; -} - -##@method void session_template(string text_ref) -# session_template is used as an HTML::Template filter to replace session info -# by their value -#@param text_ref reference to the string to translate -#@return -sub session_template { - my $self = shift; - my $text_ref = shift; - - # Replace session information - $$text_ref =~ s/\$(\w+)/decode("utf8",$self->{sessionInfo}->{$1})/ge; -} - -## @method private void quit() -# Simply exit. -sub quit { - my $self = shift; - if ( $_SUPER eq 'CGI::Fast' ) { - next LMAUTH; - } - else { - exit; - } -} - -##@method string ipAddr() -# Retrieve client IP address from remote address or X-FORWARDED-FOR header -#@return client IP -sub ipAddr { - my $self = shift; - - unless ( $self->{ipAddr} ) { - $self->{ipAddr} = $ENV{REMOTE_ADDR}; - if ( my $xheader = $ENV{HTTP_X_FORWARDED_FOR} ) { - if ( $self->{trustedProxies} =~ /\*/ - or $self->{useXForwardedForIP} ) - { - $self->{ipAddr} = $1 if ( $xheader =~ /^([^,]*)/ ); - } - elsif ( $self->{trustedProxies} ) { - my $localIP = - Net::CIDR::Lite->new("127.0.0.0/8"); # TODO: add IPv6 local IP - my $trustedIP = - Net::CIDR::Lite->new( split /\s+/, $self->{trustedProxies} ); - while ( - ( - $localIP->find( $self->{ipAddr} ) - or $trustedIP->find( $self->{ipAddr} ) - ) - and $xheader =~ s/[,\s]*([^,\s]+)$// - ) - { - - # because it is of no use to store a local IP as client IP - $self->{ipAddr} = $1 unless ( $localIP->find($1) ); - } - } - } - } - return $self->{ipAddr}; -} - -1; - -__END__ - -=head1 NAME - -=encoding utf8 - -Lemonldap::NG::Common::CGI - Simple module to extend L. DEPRECATED - -=head1 SYNOPSIS - - use Lemonldap::NG::Common::CGI; - - my $cgi = Lemonldap::NG::Common::CGI->new(); - $cgi->header_public($ENV{SCRIPT_FILENAME}); - print "Static page"; - ... - -=head1 DESCRIPTION - -Lemonldap::NG::Common::CGI just add header_public subroutine to CGI module to -avoid printing HTML elements that can be cached. It manage HTTP -"If-Modified-Since / 304 Not Modified" system. - -This module has been deprecated, now use FastCGI/PSGI packages. - -=head1 METHODS - -=head2 header_public - -header_public works like header (see L) but the first argument has to be -a filename: the last modify date of this file is used for reference. - -=head1 SEE ALSO - -L, L, -L, L, -L, L, -L - -=head1 AUTHORS - -=over - -=item LemonLDAP::NG team L - -=back - -=head1 BUG REPORT - -Use OW2 system to report bug or ask for features: -L - -=head1 DOWNLOAD - -Lemonldap::NG is available at -L - -=head1 COPYRIGHT AND LICENSE - -See COPYING file for details. - -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. - -=cut diff --git a/lemonldap-ng-common/t/20-Common-CGI.t b/lemonldap-ng-common/t/20-Common-CGI.t deleted file mode 100644 index 23c148a3c..000000000 --- a/lemonldap-ng-common/t/20-Common-CGI.t +++ /dev/null @@ -1,116 +0,0 @@ -# Before `make install' is performed this script should be runnable with -# `make test'. After `make install' it should work as `perl Lemonldap-NG-Manager.t' - -######################### - -# change 'tests => 1' to 'tests => last_test_to_print'; -package My::Portal; - -use strict; -use Test::More tests => 22; -use_ok('Lemonldap::NG::Common::CGI'); - -#our @ISA = qw('Lemonldap::NG::Common::CGI'); -use base 'Lemonldap::NG::Common::CGI'; - -sub mySubtest { - return 'OK1'; -} - -sub abort { - shift; - $, = ''; - print STDERR @_; - die 'abort has been called'; -} - -sub quit { - 2; -} - -our $param; - -sub param { - return $param; -} - -our $buf; -our $lastpos = 0; - -sub diff { - my $str = $buf; - $str =~ s/^.{$lastpos}//s if ($lastpos); - $str =~ s/\r//gs; - $lastpos = length $buf; - return $str; -} - -SKIP: { - eval "use IO::String;"; - skip "IO::String not installed", 9 if ($@); - tie *STDOUT, 'IO::String', $buf; - -######################### - - # Insert your test code below, the Test::More module is use()ed here so read - # its man page ( perldoc Test::More ) for help writing this test script. - - my $cgi; - - $ENV{SCRIPT_NAME} = '/test.pl'; - $ENV{SCRIPT_FILENAME} = 't/20-Common-CGI.t'; - $ENV{REQUEST_METHOD} = 'GET'; - $ENV{REQUEST_URI} = '/'; - $ENV{QUERY_STRING} = ''; - - #$cgi = CGI->new; - ok( ( $cgi = Lemonldap::NG::Common::CGI->new() ), 'New CGI' ); - bless $cgi, 'My::Portal'; - - # Test header_public - ok( $buf = $cgi->header_public('t/20-Common-CGI.t'), 'header_public' ); - ok( $buf =~ /Cache-control: public; must-revalidate; max-age=\d+\r?\n/s, - 'Cache-Control' ); - ok( $buf =~ /Last-modified: /s, 'Last-Modified' ); - - # Test _sub mechanism - ok( $cgi->_sub('mySubtest') eq 'OK1', '_sub mechanism 1' ); - $cgi->{mySubtest} = sub { return 'OK2' }; - ok( $cgi->_sub('mySubtest') eq 'OK2', '_sub mechanism 2' ); - - # Test extract_lang - my $lang; - ok( $lang = $cgi->extract_lang(), - 'extract_lang 0 with void "Accept-language"' ); - ok( scalar(@$lang) == 0, 'extract_lang 1 with void "Accept-language"' ); - - my $cgi2; - $ENV{SCRIPT_NAME} = '/test.pl'; - $ENV{SCRIPT_FILENAME} = 't/20-Common-CGI.t'; - $ENV{REQUEST_METHOD} = 'GET'; - $ENV{REQUEST_URI} = '/'; - $ENV{QUERY_STRING} = ''; - $ENV{HTTP_ACCEPT_LANGUAGE} = 'fr,fr-fr;q=0.8,en-us;q=0.5,en;q=0.3'; - ok( ( $cgi2 = Lemonldap::NG::Common::CGI->new() ), 'New CGI' ); - ok( $lang = $cgi2->extract_lang(), 'extract_lang' ); - ok( $lang->[0] eq 'fr', 'extract_lang' ); - ok( $lang->[1] eq 'en', 'extract_lang' ); - ok( scalar(@$lang) == 2, 'extract_lang' ); - - # Extract lang Android (See #LEMONLDAP-530) - my $cgi3; - $ENV{HTTP_ACCEPT_LANGUAGE} = 'fr-FR, en-US'; - ok( ( $cgi3 = Lemonldap::NG::Common::CGI->new() ), 'New CGI' ); - ok( $lang = $cgi3->extract_lang(), 'extract_lang Android' ); - ok( $lang->[0] eq 'fr', 'extract_lang Android' ); - ok( $lang->[1] eq 'en', 'extract_lang Android' ); - ok( scalar(@$lang) == 2, 'extract_lang Android' ); - - # Extract lang with * value - my $cgi4; - $ENV{HTTP_ACCEPT_LANGUAGE} = "fr,en,*"; - ok( ( $cgi4 = Lemonldap::NG::Common::CGI->new() ), 'New CGI' ); - ok( $lang = $cgi4->extract_lang(), 'extract_lang with * value' ); - ok( scalar(@$lang) == 2, 'extract_lang with * value' ); - -} diff --git a/lemonldap-ng-handler/MANIFEST b/lemonldap-ng-handler/MANIFEST index c7dc58ff0..02c5f84a3 100644 --- a/lemonldap-ng-handler/MANIFEST +++ b/lemonldap-ng-handler/MANIFEST @@ -5,10 +5,8 @@ example/scripts/purgeLocalCache example/scripts/purgeLocalCache.cron.d lib/Lemonldap/NG/Handler.pm lib/Lemonldap/NG/Handler/ApacheMP2.pm -lib/Lemonldap/NG/Handler/API/CGI.pm lib/Lemonldap/NG/Handler/API/ExperimentalNginx.pm lib/Lemonldap/NG/Handler/AuthBasic.pm -lib/Lemonldap/NG/Handler/CGI.pm lib/Lemonldap/NG/Handler/Lib/AuthBasic.pm lib/Lemonldap/NG/Handler/Main.pm lib/Lemonldap/NG/Handler/Main/Init.pm @@ -37,7 +35,6 @@ t/05-Lemonldap-NG-Handler-Reload.t t/10-Lemonldap-NG-Handler-SharedConf.t t/12-Lemonldap-NG-Handler-Jail.t t/13-Lemonldap-NG-Handler-Fake-Safe.t -t/30-Lemonldap-NG-Handler-CGI.t t/50-Lemonldap-NG-Handler-SecureToken.t t/51-Lemonldap-NG-Handler-Zimbra.t t/52-Lemonldap-NG-Handler-AuthBasic.t diff --git a/lemonldap-ng-handler/lib/Lemonldap/NG/Handler/API/CGI.pm b/lemonldap-ng-handler/lib/Lemonldap/NG/Handler/API/CGI.pm deleted file mode 100644 index 054324105..000000000 --- a/lemonldap-ng-handler/lib/Lemonldap/NG/Handler/API/CGI.pm +++ /dev/null @@ -1,188 +0,0 @@ -package Lemonldap::NG::Handler::API::CGI; - -our $VERSION = '2.0.0'; - -# Specific modules and constants for Test or CGI -use constant FORBIDDEN => 403; -use constant HTTP_UNAUTHORIZED => 401; -use constant REDIRECT => 302; -use constant OK => 0; -use constant DECLINED => 0; -use constant DONE => 0; -use constant SERVER_ERROR => 500; -use constant AUTH_REQUIRED => 401; -use constant MAINTENANCE => 503; - -# Log level, since it can't be set in server config -# Default value 'notice' can be changed in lemonldap-ng.ini or in init args -our $logLevel = "notice"; - -my $request; # object to store data about current request - -## @method void setServerSignature(string sign) -# modifies web server signature -# @param $sign String to add to server signature -sub setServerSignature { - my ( $class, $sign ) = @_; - $ENV{SERVER_SOFTWARE} .= " $sign"; -} - -## @method void thread_share(string $variable) -# share or not the variable (if authorized by specific module) -# @param $variable the name of the variable to share -sub thread_share { - - # nothing to do in CGI -} - -sub newRequest { - my ( $class, $r ) = @_; - $request = $r; - $Lemonldap::NG::API::mode = 'CGI'; -} - -## @method void _lmLog(string $msg, string $level) -# logs message $msg to STDERR with level $level -# set Env Var lmLogLevel to set loglevel; set to "info" by default -# @param $msg string message to log -# @param $level string loglevel -sub _lmLog { - my ( $class, $msg, $level ) = @_; - print STDERR "[$level] $msg\n"; -} - -## @method void set_user(string user) -# sets remote_user -# @param user string username -sub set_user { - my ( $class, $user ) = @_; - $ENV{REMOTE_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 $ENV{ cgiName($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 ) { - $ENV{ cgiName($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 $h (@headers) { - $ENV{ cgiName($h) } = undef; - } -} - -## @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 ) { - push @{ $request->{respHeaders} }, "-$h" => $v; - } -} - -## @method string hostname -# returns host, as set by full URI or Host header -# @return host string Host value -sub hostname { - my $s = $ENV{SERVER_NAME}; - $s =~ s/:\d+$//; - return $s; -} - -## @method string remote_ip -# returns client IP address -# @return IP_Addr string client IP -sub remote_ip { - return $ENV{REMOTE_ADDR}; -} - -## @method boolean is_initial_req -# always returns true -# @return is_initial_req boolean -sub is_initial_req { - return 1; -} - -## @method string args(string args) -# gets the query string -# @return args string Query string -sub args { - return $ENV{QUERY_STRING}; -} - -## @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 $uri = $ENV{SCRIPT_NAME}; - $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 { - return &uri . ( $ENV{QUERY_STRING} ? "?$ENV{QUERY_STRING}" : "" ); -} - -## @method string unparsed_uri -# returns the full original request URI, with arguments -# @return full original request URI, with arguments -sub unparsed_uri { - return $ENV{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 { - return $ENV{SERVER_PORT}; -} - -## @method string method -# returns the request method -# @return port string server port -sub method { - return $ENV{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->{respBody} .= $data; -} - -sub cgiName { - my $h = uc(shift); - $h =~ s/-/_/g; - return "HTTP_$h"; -} - -1; diff --git a/lemonldap-ng-handler/lib/Lemonldap/NG/Handler/CGI.pm b/lemonldap-ng-handler/lib/Lemonldap/NG/Handler/CGI.pm deleted file mode 100644 index e51115937..000000000 --- a/lemonldap-ng-handler/lib/Lemonldap/NG/Handler/CGI.pm +++ /dev/null @@ -1,143 +0,0 @@ -# Auto-protected CGI mechanism -package Lemonldap::NG::Handler::CGI; - -use strict; - -use Lemonldap::NG::Common::CGI; -use Lemonldap::NG::Handler::Main; -use base qw(Lemonldap::NG::Common::CGI Lemonldap::NG::Handler::Main); - -our $VERSION = '2.0.0'; - -## @cmethod Lemonldap::NG::Handler::CGI new(hashRef args) -# Constructor. -# @param $args configuration parameters -# @return new object -sub new { - my ( $class, $args ) = @_; - my $self = $class->SUPER::new() or $class->abort("Unable to build CGI"); - Lemonldap::NG::Handler::Main->init($args); - Lemonldap::NG::Handler::Main->checkConf($self); - - # Get access control rule - my $rule = $self->{protection} - || Lemonldap::NG::Handler::Main->localConfig->{protection}; - $rule =~ s/^rule\s*:?\s*//; - return $self if ( $rule eq "none" ); - $rule = - $rule eq "authenticate" ? "accept" : $rule eq "manager" ? "" : $rule; - my $request = {}; - my $res = $self->run($rule); - - if ( $res == 403 ) { - $self->abort( 'Forbidden', - "You don't have rights to access this page" ); - } - elsif ($res) { - print $self->header( -status => $res, @{ $request->{respHeaders} } ); - $self->quit; - } - else { - return $self; - } -} - -## @method hashRef user() -# @return hash of user datas -sub user { - return Lemonldap::NG::Handler::Main->datas; -} - -## @method boolean group(string group) -# @param $group name of the Lemonldap::NG group to test -# @return boolean : true if user is in this group -sub group { - my ( $self, $group ) = @_; - return ( Lemonldap::NG::Handler::Main->datas->{groups} =~ /\b$group\b/ ); -} - -1; -__END__ - -=head1 NAME - -=encoding utf8 - -Lemonldap::NG::Handler::CGI - Perl extension for using Lemonldap::NG -authentication in Perl CGI without using Lemonldap::NG::Handler - -DEPRECATED - -=head1 SYNOPSIS - - use Lemonldap::NG::Handler::CGI; - my $cgi = Lemonldap::NG::Handler::CGI->new ( {} ); - - # See CGI(3) for more about writing HTML pages - print $cgi->header; - print $cgi->start_html; - - # Since authentication phase, you can use user attributes and macros - my $name = $cgi->user->{cn}; - - # Instead of using "$cgi->user->{groups} =~ /\badmin\b/", you can use - if( $cgi->group('admin') ) { - # special html code for admins - } - else { - # another HTML code - } - -=head1 DESCRIPTION - -Lemonldap::NG::Handler provides the protection part of Lemonldap::NG web-SSO -system. It can be used with any system used with Apache (PHP or JSP pages for -example). If you need to protect only few Perl CGI, you can use this library -instead. - -Warning, this module must not be used in a Lemonldap::NG::Handler protected -area because it hides Lemonldap::NG cookies. - -This package has been deprecated in favor of FastCGI/PSGI files. - -=head1 SEE ALSO - -L, L, -L, L, -L - -=head1 AUTHORS - -=over - -=item LemonLDAP::NG team L - -=back - -=head1 BUG REPORT - -Use OW2 system to report bug or ask for features: -L - -=head1 DOWNLOAD - -Lemonldap::NG is available at -L - -=head1 COPYRIGHT AND LICENSE - -See COPYING file for details. - -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. - -=cut diff --git a/lemonldap-ng-handler/t/30-Lemonldap-NG-Handler-CGI.t b/lemonldap-ng-handler/t/30-Lemonldap-NG-Handler-CGI.t deleted file mode 100644 index 7113672b5..000000000 --- a/lemonldap-ng-handler/t/30-Lemonldap-NG-Handler-CGI.t +++ /dev/null @@ -1,60 +0,0 @@ -# Before `make install' is performed this script should be runnable with -# `make test'. After `make install' it should work as `perl Lemonldap-NG-Handler-CGI.t' - -######################### - -# change 'tests => 1' to 'tests => last_test_to_print'; - -use Test::More tests => 1; -use Cwd 'abs_path'; -use File::Basename; -use File::Temp; - -my $ini = File::Temp->new(); -my $dir = dirname( abs_path($0) ); - -print $ini "[all] - -[configuration] -type=File -dirName=$dir -"; - -$ini->flush(); - -use Env qw(LLNG_DEFAULTCONFFILE); -$LLNG_DEFAULTCONFFILE = $ini->filename; - -use_ok('Lemonldap::NG::Handler::CGI'); - -# sub Lemonldap::NG::Handler::CGI::lmLog { } - -######################### - -# Insert your test code below, the Test::More module is use()ed here so read -# its man page ( perldoc Test::More ) for help writing this test script. - -__END__ -my $p; - -# CGI Environment -$ENV{SCRIPT_NAME} = '/test.pl'; -$ENV{SCRIPT_FILENAME} = '/tmp/test.pl'; -$ENV{REQUEST_METHOD} = 'GET'; -$ENV{REQUEST_URI} = '/'; -$ENV{QUERY_STRING} = ''; - -ok( - $p = Lemonldap::NG::Handler::CGI->new( - { - configStorage => { - confFile => 'undefined.xx', - }, - https => 0, - portal => 'http://auth.example.com/', - globalStorage => 'Apache::Session::File', - } - ), - 'Portal object' -); -