Commit 9e12c942 authored by Xavier Guimard's avatar Xavier Guimard

Remove old CGI files (#595)

parent 6cccc434
......@@ -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
......
This diff is collapsed.
# 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' );
}
......@@ -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
......
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;
# 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<http://lemonldap-ng.org/>, L<Lemonldap::NG::Handler::PSGI>,
L<Lemonldap::NG::Handler::PSGI::Router>, L<Lemonldap::NG::Handler::PSGI::Server>,
L<Lemonldap::NG::Handler::PSGI::Try>
=head1 AUTHORS
=over
=item LemonLDAP::NG team L<http://lemonldap-ng.org/team>
=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
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<http://www.gnu.org/licenses/>.
=cut
# 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'
);
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment