* Doxygen doc update
* More tests * perltidy on tests
This commit is contained in:
Xavier Guimard
parent
6307a00750
commit
859be3923f
|
|
@ -9,7 +9,7 @@ Standards-Version: 3.8.0
|
|||
|
||||
Package: lemonldap-ng
|
||||
Architecture: all
|
||||
Depends: liblemonldap-ng-handler-perl (= ${binary:Version}), liblemonldap-ng-manager-perl (= ${binary:Version}), liblemonldap-ng-portal-perl (= ${binary:Version})
|
||||
Depends: ${misc:Depends}, liblemonldap-ng-handler-perl (= ${binary:Version}), liblemonldap-ng-manager-perl (= ${binary:Version}), liblemonldap-ng-portal-perl (= ${binary:Version})
|
||||
Description: Lemonldap::NG Web-SSO system
|
||||
Lemonldap::NG is a complete Web-SSO system that can run with reverse-proxies
|
||||
or directly on application Apache servers.
|
||||
|
|
@ -19,6 +19,7 @@ Description: Lemonldap::NG Web-SSO system
|
|||
Package: lemonldap-ng-doc
|
||||
Section: doc
|
||||
Architecture: all
|
||||
Depends: ${misc:Depends}
|
||||
Description: Lemonldap::NG Web-SSO system documentation
|
||||
Lemonldap::NG is a complete Web-SSO system that can run with reverse-proxies
|
||||
or directly on application Apache servers.
|
||||
|
|
@ -27,7 +28,7 @@ Description: Lemonldap::NG Web-SSO system documentation
|
|||
|
||||
Package: liblemonldap-ng-handler-perl
|
||||
Architecture: all
|
||||
Depends: libapache-session-perl, libwww-perl, libcache-cache-perl, liblemonldap-ng-conf-perl (= ${binary:Version}), libapache2-mod-perl2 | libapache-mod-perl
|
||||
Depends: ${misc:Depends}, libapache-session-perl, libwww-perl, libcache-cache-perl, liblemonldap-ng-conf-perl (= ${binary:Version}), libapache2-mod-perl2 | libapache-mod-perl
|
||||
Suggests: liblemonldap-ng-portal-perl
|
||||
Description: Lemonldap::NG Apache module part
|
||||
Lemonldap::NG is a complete Web-SSO system that can run with reverse-proxies
|
||||
|
|
@ -49,7 +50,7 @@ Description: Lemonldap::NG Apache administration interface part
|
|||
|
||||
Package: liblemonldap-ng-manager-perl
|
||||
Architecture: all
|
||||
Depends: libxml-simple-perl, liblemonldap-ng-conf-perl (= ${binary:Version}), libjs-jquery, liblemonldap-ng-handler-perl (= ${binary:Version})
|
||||
Depends: ${misc:Depends}, libxml-simple-perl, liblemonldap-ng-conf-perl (= ${binary:Version}), libjs-jquery, liblemonldap-ng-handler-perl (= ${binary:Version})
|
||||
Recommends: libcache-cache-perl, libapache-session-perl, libsoap-lite-perl
|
||||
Description: Lemonldap::NG Apache manager part
|
||||
Lemonldap::NG is a complete Web-SSO system that can run with reverse-proxies
|
||||
|
|
@ -59,7 +60,7 @@ Description: Lemonldap::NG Apache manager part
|
|||
|
||||
Package: liblemonldap-ng-portal-perl
|
||||
Architecture: all
|
||||
Depends: libapache-session-perl, libnet-ldap-perl, liblemonldap-ng-conf-perl (= ${binary:Version}), libhtml-template-perl, libjs-jquery, liblemonldap-ng-handler-perl (= ${binary:Version}), libxml-libxml-perl, libxml-libxslt-perl
|
||||
Depends: ${misc:Depends}, libapache-session-perl, libnet-ldap-perl, liblemonldap-ng-conf-perl (= ${binary:Version}), libhtml-template-perl, libjs-jquery, liblemonldap-ng-handler-perl (= ${binary:Version}), libxml-libxml-perl, libxml-libxslt-perl
|
||||
Suggests: liblasso-perl, libcgi-session-perl, slapd
|
||||
Description: Lemonldap::NG Apache authentication portal part
|
||||
Lemonldap::NG is a complete Web-SSO system that can run with reverse-proxies
|
||||
|
|
|
|||
|
|
@ -12,6 +12,7 @@ requires:
|
|||
CGI: 3.08
|
||||
Crypt::Rijndael: 0
|
||||
DBI: 0
|
||||
IO::String: 0
|
||||
Regexp::Assemble: 0
|
||||
SOAP::Lite: 0
|
||||
Storable: 0
|
||||
|
|
|
|||
|
|
@ -27,6 +27,7 @@ WriteMakefile(
|
|||
'Storable' => 0,
|
||||
'Regexp::Assemble' => 0,
|
||||
'Cache::Cache' => 0,
|
||||
'IO::String' => 0,
|
||||
'SOAP::Lite' => 0,
|
||||
'Crypt::Rijndael' => 0,
|
||||
}, # e.g., Module::Name => 1.1
|
||||
|
|
|
|||
|
|
@ -91,7 +91,7 @@ sub soapTest {
|
|||
Lemonldap::NG::Common::CGI::SOAPService->new( $obj || $self, @func );
|
||||
Lemonldap::NG::Common::CGI::SOAPServer->dispatch_to($dispatcher)
|
||||
->handle($self);
|
||||
exit;
|
||||
$self->quit();
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -179,7 +179,7 @@ sub startSyslog {
|
|||
$self->{_syslog} = 1;
|
||||
}
|
||||
|
||||
##@method protected void userLog(string mess, string level)
|
||||
##@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
|
||||
|
|
@ -195,7 +195,7 @@ sub userLog {
|
|||
}
|
||||
|
||||
##@method void userInfo(string mess)
|
||||
# Log user errors like "bad password".
|
||||
# Log non important user actions. Alias for userLog() with facility "info".
|
||||
# @param $mess string to log
|
||||
sub userInfo {
|
||||
my ( $self, $mess ) = @_;
|
||||
|
|
@ -204,7 +204,8 @@ sub userInfo {
|
|||
}
|
||||
|
||||
##@method void userNotice(string mess)
|
||||
# Log user actions like access and logout.
|
||||
# Log user actions like access and logout. Alias for userLog() with facility
|
||||
# "warn".
|
||||
# @param $mess string to log
|
||||
sub userNotice {
|
||||
my ( $self, $mess ) = @_;
|
||||
|
|
@ -213,7 +214,8 @@ sub userNotice {
|
|||
}
|
||||
|
||||
##@method void userError(string mess)
|
||||
# Log user errors like "bad password".
|
||||
# Log user errors like "bad password". Alias for userLog() with facility
|
||||
# "error".
|
||||
# @param $mess string to log
|
||||
sub userError {
|
||||
my ( $self, $mess ) = @_;
|
||||
|
|
@ -237,6 +239,12 @@ sub _sub {
|
|||
}
|
||||
}
|
||||
|
||||
## @method private void quit()
|
||||
# Simply exit.
|
||||
sub quit {
|
||||
exit;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
|
|
|||
|
|
@ -12,6 +12,8 @@ use base qw(SOAP::Transport::HTTP::Server);
|
|||
|
||||
our $VERSION = '0.2';
|
||||
|
||||
## @method protected void DESTROY()
|
||||
# Call SOAP::Trace::objects().
|
||||
sub DESTROY { SOAP::Trace::objects('()') }
|
||||
|
||||
## @cmethod Lemonldap::NG::Common::CGI::SOAPServer new(@param)
|
||||
|
|
|
|||
|
|
@ -17,10 +17,10 @@ my $h;
|
|||
|
||||
ok(
|
||||
$h = new Lemonldap::NG::Common::Conf(
|
||||
{
|
||||
type => 'File',
|
||||
dirName => ".",
|
||||
}
|
||||
{
|
||||
type => 'File',
|
||||
dirName => ".",
|
||||
}
|
||||
),
|
||||
'type => file',
|
||||
);
|
||||
|
|
|
|||
|
|
@ -17,13 +17,13 @@ my $h;
|
|||
@ARGV = ("help=groups");
|
||||
ok(
|
||||
$h = new Lemonldap::NG::Common::Conf(
|
||||
{
|
||||
type => 'DBI',
|
||||
dbiChain => "DBI:mysql:database=lemonldap-ng",
|
||||
dbiUser => 'lemonldap-ng',
|
||||
}
|
||||
{
|
||||
type => 'DBI',
|
||||
dbiChain => "DBI:mysql:database=lemonldap-ng",
|
||||
dbiUser => 'lemonldap-ng',
|
||||
}
|
||||
)
|
||||
);
|
||||
|
||||
ok( $h->can( 'dbh' ) );
|
||||
ok( $h->can('dbh') );
|
||||
|
||||
|
|
|
|||
|
|
@ -19,14 +19,14 @@ SKIP: {
|
|||
my $h;
|
||||
ok(
|
||||
$h = new Lemonldap::NG::Common::Conf(
|
||||
{
|
||||
type => 'SOAP',
|
||||
proxy => 'http://localhost',
|
||||
}
|
||||
{
|
||||
type => 'SOAP',
|
||||
proxy => 'http://localhost',
|
||||
}
|
||||
)
|
||||
);
|
||||
ok( $h->can( '_connect' ) );
|
||||
ok( $h->can( '_soapCall' ) );
|
||||
ok( $h->can('_connect') );
|
||||
ok( $h->can('_soapCall') );
|
||||
}
|
||||
|
||||
#########################
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
# change 'tests => 1' to 'tests => last_test_to_print';
|
||||
|
||||
use Test::More tests => 1;
|
||||
BEGIN { use_ok('Lemonldap::NG::Common') };
|
||||
BEGIN { use_ok('Lemonldap::NG::Common') }
|
||||
|
||||
#########################
|
||||
|
||||
|
|
|
|||
|
|
@ -6,15 +6,51 @@
|
|||
# change 'tests => 1' to 'tests => last_test_to_print';
|
||||
package My::Portal;
|
||||
|
||||
use Test::More tests => 7;
|
||||
use strict;
|
||||
use IO::String;
|
||||
use Test::More tests => 10;
|
||||
BEGIN { use_ok('Lemonldap::NG::Common::CGI') }
|
||||
|
||||
our @ISA = ('Lemonldap::NG::Common::CGI');
|
||||
use base ('Lemonldap::NG::Common::CGI');
|
||||
|
||||
sub subtest {
|
||||
return 'OK1';
|
||||
}
|
||||
|
||||
sub abort {
|
||||
shift;
|
||||
$, = '';
|
||||
print STDERR @_;
|
||||
die 'abort has been called';
|
||||
}
|
||||
|
||||
sub quit {
|
||||
2;
|
||||
}
|
||||
|
||||
our $param;
|
||||
|
||||
sub param {
|
||||
return $param;
|
||||
}
|
||||
|
||||
sub soapfunc {
|
||||
return 'SoapOK';
|
||||
}
|
||||
|
||||
our $buf;
|
||||
|
||||
tie *STDOUT, 'IO::String', $buf;
|
||||
our $lastpos = 0;
|
||||
|
||||
sub diff {
|
||||
my $str = $buf;
|
||||
$str =~ s/^.{$lastpos}//s if ($lastpos);
|
||||
$str =~ s/\r//gs;
|
||||
$lastpos = length $buf;
|
||||
return $str;
|
||||
}
|
||||
|
||||
#########################
|
||||
|
||||
# Insert your test code below, the Test::More module is use()ed here so read
|
||||
|
|
@ -22,19 +58,16 @@ sub subtest {
|
|||
|
||||
my $cgi;
|
||||
|
||||
ok( ( $cgi = My::Portal->new() ), 'New CGI' );
|
||||
|
||||
use IO::String;
|
||||
|
||||
our $buf;
|
||||
|
||||
#tie *STDOUT, 'IO::String', $buf;
|
||||
$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,
|
||||
|
|
@ -46,3 +79,19 @@ ok( $cgi->_sub('subtest') eq 'OK1', '_sub mechanism 1' );
|
|||
$cgi->{subtest} = sub { return 'OK2' };
|
||||
ok( $cgi->_sub('subtest') eq 'OK2', '_sub mechanism 2' );
|
||||
|
||||
# SOAP
|
||||
SKIP: {
|
||||
eval { require SOAP::Lite };
|
||||
skip
|
||||
"SOAP::Lite is not installed, so CGI SOAP functions will not work", 3
|
||||
if ($@);
|
||||
$ENV{HTTP_SOAPACTION} =
|
||||
'http://localhost/Lemonldap/NG/Common/CGI/SOAPService#soapfunc';
|
||||
$param =
|
||||
'<?xml version="1.0" encoding="UTF-8"?><soap:Envelope xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" xmlns:xsd="http://www.w3.org/2001/XMLSchema" soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"><soap:Body><soapfunc xmlns="http://localhost/Lemonldap/NG/Common/CGI/SOAPService"><var xsi:type="xsd:string">fr</var></soapfunc></soap:Body></soap:Envelope>';
|
||||
ok( $cgi->soapTest('soapfunc') == 2, 'SOAP call exit fine' );
|
||||
my $tmp = diff();
|
||||
ok( $tmp =~ /^Status: 200/s, 'HTTP response 200' );
|
||||
ok( $tmp =~ /<result xsi:type="xsd:string">SoapOK<\/result>/s,
|
||||
'result of SOAP call' );
|
||||
}
|
||||
|
|
|
|||
|
|
@ -32,7 +32,7 @@ BEGIN {
|
|||
}
|
||||
}
|
||||
|
||||
## @cmethod int run(Apache2::RequestRec apacheRequest)
|
||||
## @rmethod int run(Apache2::RequestRec apacheRequest)
|
||||
# overload run subroutine to implement Auth-Basic mechanism.
|
||||
# @param $apacheRequest current request
|
||||
# @return Apache constant
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@ use base qw(Lemonldap::NG::Handler::SharedConf);
|
|||
*EXPORT_TAGS = *Lemonldap::NG::Handler::SharedConf::EXPORT_TAGS;
|
||||
*EXPORT_OK = *Lemonldap::NG::Handler::SharedConf::EXPORT_OK;
|
||||
|
||||
## @cmethod int run(Apache2::RequestRec apacheRequest)
|
||||
## @rmethod int run(Apache2::RequestRec apacheRequest)
|
||||
# overload run subroutine to implement cross-domain mechanism.
|
||||
# @param $apacheRequest
|
||||
# @return Apache constant
|
||||
|
|
|
|||
|
|
@ -146,7 +146,7 @@ sub goToPortal {
|
|||
exit;
|
||||
}
|
||||
|
||||
## @fn string private _uri()
|
||||
## @fn private string _uri()
|
||||
# Builds current URL including "http://" and server name.
|
||||
# @return URL_string
|
||||
sub _uri {
|
||||
|
|
|
|||
|
|
@ -6,11 +6,11 @@
|
|||
# change 'tests => 1' to 'tests => last_test_to_print';
|
||||
|
||||
BEGIN {
|
||||
our $home=0;
|
||||
$home++ if($ENV{DEBFULLNAME} and $ENV{DEBFULLNAME} eq 'Xavier Guimard');
|
||||
our $home = 0;
|
||||
$home++ if ( $ENV{DEBFULLNAME} and $ENV{DEBFULLNAME} eq 'Xavier Guimard' );
|
||||
}
|
||||
|
||||
use Test::More tests => 1 + 8*$home;
|
||||
use Test::More tests => 1 + 8 * $home;
|
||||
BEGIN { use_ok( 'Lemonldap::NG::Handler::Simple', ':all' ) }
|
||||
|
||||
#########################
|
||||
|
|
@ -18,7 +18,7 @@ BEGIN { use_ok( 'Lemonldap::NG::Handler::Simple', ':all' ) }
|
|||
# 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.
|
||||
|
||||
exit unless($home);
|
||||
exit unless ($home);
|
||||
|
||||
my $h;
|
||||
$h = bless {}, 'Lemonldap::NG::Handler::Simple';
|
||||
|
|
@ -50,8 +50,10 @@ ok( close($statusPipe) );
|
|||
|
||||
sub read {
|
||||
my $ok = 0;
|
||||
|
||||
#open LOG, '>/tmp/log';
|
||||
while (<$statusOut>) {
|
||||
|
||||
#print LOG $_;
|
||||
$ok++ if (/^OK\s+:\s*2\s*\(2\.00\s*\/\s*mn\)$/);
|
||||
$ok++ if (/^REJECT\s+:\s*1\s*\(1\.00\s*\/\s*mn\)$/);
|
||||
|
|
@ -60,6 +62,7 @@ sub read {
|
|||
last;
|
||||
}
|
||||
}
|
||||
|
||||
#print LOG "$ok\n";
|
||||
#close LOG;
|
||||
return ( $ok == 3 );
|
||||
|
|
|
|||
|
|
@ -29,9 +29,9 @@ ok(
|
|||
type => "File",
|
||||
dirName => '/tmp/',
|
||||
},
|
||||
https => 0,
|
||||
portal => 'http://auth.example.com',
|
||||
globalStorage => 'Apache::Session::File',
|
||||
https => 0,
|
||||
portal => 'http://auth.example.com',
|
||||
globalStorage => 'Apache::Session::File',
|
||||
}
|
||||
),
|
||||
'Portal object'
|
||||
|
|
|
|||
|
|
@ -233,7 +233,7 @@ sub printXmlConf {
|
|||
);
|
||||
}
|
||||
|
||||
# @method protected hashRef buildTree(array p)
|
||||
## @method protected hashRef buildTree(array p)
|
||||
# Transform Lemonldap::NG configuration into a tree that javascript library can
|
||||
# understand.
|
||||
# @param @p parameters given to Lemonldap::NG::Common::Conf::getConf()
|
||||
|
|
|
|||
|
|
@ -40,7 +40,7 @@ sub new {
|
|||
return $self;
|
||||
}
|
||||
|
||||
## @rmethod void process()
|
||||
## @method void process()
|
||||
# Main method.
|
||||
sub process {
|
||||
my $self = shift;
|
||||
|
|
@ -375,7 +375,7 @@ sub process {
|
|||
}
|
||||
}
|
||||
|
||||
## @rfn protected string htmlquote(string s)
|
||||
## @fn protected string htmlquote(string s)
|
||||
# Change <, > and & to HTML encoded values in the string
|
||||
# @param $s HTML string
|
||||
# @return HTML string
|
||||
|
|
@ -387,7 +387,7 @@ sub htmlquote {
|
|||
return $s;
|
||||
}
|
||||
|
||||
## @rfn protected void start()
|
||||
## @fn protected void start()
|
||||
# Display HTTP and HTML headers.
|
||||
sub start {
|
||||
my $self = shift;
|
||||
|
|
@ -446,7 +446,7 @@ sub start {
|
|||
);
|
||||
}
|
||||
|
||||
## @rfn protected void ajaxnode(string id, string text, string param)
|
||||
## @fn protected void ajaxnode(string id, string text, string param)
|
||||
# Display tree node with Ajax functions inside for opening the node.
|
||||
# @param $id HTML id of the element.
|
||||
# @param $text text to display
|
||||
|
|
@ -457,7 +457,7 @@ sub ajaxNode {
|
|||
"<li id=\"$id\"><span>$text</span>\n<ul class=\"ajax\"><li id=\"sub_$id\">{url:$ENV{SCRIPT_NAME}?$param}</li></ul></li>\n";
|
||||
}
|
||||
|
||||
## @rfn protected void window(string root)
|
||||
## @fn protected void window(string root)
|
||||
# Design the main window
|
||||
# @param $root Text to display in the root node of the tree
|
||||
sub window {
|
||||
|
|
@ -481,7 +481,7 @@ sub window {
|
|||
. '</span><ul>';
|
||||
}
|
||||
|
||||
## @rfn protected void end()
|
||||
## @fn protected void end()
|
||||
# Display the end of HTML page.
|
||||
sub end {
|
||||
my $self = shift;
|
||||
|
|
@ -492,7 +492,7 @@ sub end {
|
|||
|
||||
1;
|
||||
|
||||
## @rfn protected css()
|
||||
## @fn protected css()
|
||||
# Display the main CSS file (called by http://manager.example.com/sessions.pl/css)
|
||||
sub css {
|
||||
my $self = shift;
|
||||
|
|
@ -679,7 +679,7 @@ body
|
|||
EOF
|
||||
}
|
||||
|
||||
## @rfn protected js()
|
||||
## @fn protected js()
|
||||
# Display the main javascript file (called by http://manager.example.com/sessions.pl/js)
|
||||
sub js {
|
||||
my $self = shift;
|
||||
|
|
|
|||
|
|
@ -25,10 +25,9 @@ our $lastpos = 0;
|
|||
|
||||
sub diff {
|
||||
my $str = $buf;
|
||||
$str =~ s/^.{$lastpos}//s if($lastpos);
|
||||
$str =~ s/^.{$lastpos}//s if ($lastpos);
|
||||
$str =~ s/\r//gs;
|
||||
$lastpos = length $buf;
|
||||
print STDERR "DEBUG $str\n";
|
||||
return $str;
|
||||
}
|
||||
|
||||
|
|
@ -52,13 +51,8 @@ ok( $h->start_html() =~ /<html/s, 'start_html' );
|
|||
ok( ( $h->main() and diff() =~ m#<script type="text/javascript"# ), 'main' );
|
||||
ok( $h->end_html() =~ m#</html>#, 'end_html' );
|
||||
ok( ( $h->print_css() and diff() =~ m#Content-Type:\s+text/css#s ), 'css' );
|
||||
ok(
|
||||
(
|
||||
$h->print_lmjs()
|
||||
and diff() =~ m#Content-Type:\s+text/javascript#s
|
||||
),
|
||||
'javascript'
|
||||
);
|
||||
ok( ( $h->print_lmjs() and diff() =~ m#Content-Type:\s+text/javascript#s ),
|
||||
'javascript' );
|
||||
ok( $h->print_help(), 'help' );
|
||||
ok( ref( $h->buildTree() ) eq 'HASH', 'buildTree' );
|
||||
my $tmp = &xml;
|
||||
|
|
|
|||
|
|
@ -16,9 +16,9 @@ use Test::More tests => ( keys(%lang) + 4 );
|
|||
use_ok('Lemonldap::NG::Manager');
|
||||
|
||||
my $win = 0;
|
||||
$win ++ unless( -e '/dev/null' );
|
||||
$win++ unless ( -e '/dev/null' );
|
||||
|
||||
if($win) {
|
||||
if ($win) {
|
||||
open STDOUT, '>test_stdout.txt';
|
||||
}
|
||||
else {
|
||||
|
|
@ -53,7 +53,7 @@ ok( $h->main(), "HTML code" );
|
|||
ok( $h->print_help(), "Help page" );
|
||||
ok( $h->buildTree(), "XML tree" );
|
||||
|
||||
unlink('test_stdout.txt') if($win);
|
||||
unlink('test_stdout.txt') if ($win);
|
||||
|
||||
sub compare {
|
||||
my ( $l1, $l2 ) = @_;
|
||||
|
|
|
|||
|
|
@ -11,27 +11,31 @@ use Test::More tests => 3;
|
|||
# not run.
|
||||
SKIP: {
|
||||
eval { require SOAP::Transport::HTTP };
|
||||
skip "SOAP::Transport::HTTP is not installed, so Lemonldap::NG::Manager::SOAPServer will not be useable",
|
||||
skip
|
||||
"SOAP::Transport::HTTP is not installed, so Lemonldap::NG::Manager::SOAPServer will not be useable",
|
||||
3
|
||||
if ($@);
|
||||
use_ok('Lemonldap::NG::Manager::SOAPServer');
|
||||
my $s;
|
||||
ok ( $s = Lemonldap::NG::Manager::SOAPServer->new (
|
||||
type => 'config',
|
||||
ok(
|
||||
$s = Lemonldap::NG::Manager::SOAPServer->new(
|
||||
type => 'config',
|
||||
configStorage => {
|
||||
type => 'File',
|
||||
dirName => '.',
|
||||
}
|
||||
)
|
||||
)
|
||||
);
|
||||
eval { require Apache::Session::File };
|
||||
skip "Apache::Session::File is not installed. Lemonldap::NG::Manager::SOAPServer will not be tested in 'sessions' mode",
|
||||
skip
|
||||
"Apache::Session::File is not installed. Lemonldap::NG::Manager::SOAPServer will not be tested in 'sessions' mode",
|
||||
1
|
||||
if ($@);
|
||||
ok ( $s = Lemonldap::NG::Manager::SOAPServer->new (
|
||||
type => 'sessions',
|
||||
ok(
|
||||
$s = Lemonldap::NG::Manager::SOAPServer->new(
|
||||
type => 'sessions',
|
||||
realSessionStorage => 'Apache::Session::File',
|
||||
)
|
||||
)
|
||||
);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -107,6 +107,7 @@ README
|
|||
t/01-Lemonldap-NG-Portal-Simple.t
|
||||
t/02-Lemonldap-NG-Portal-SharedConf.t
|
||||
t/03-XSS-protection.t
|
||||
t/04-Lemonldap-NG-Portal-SOAP.t
|
||||
t/10-Lemonldap-NG-Portal-i18n.t
|
||||
t/20-Lemonldap-NG-Portal-AuthApache.t
|
||||
t/21-Lemonldap-NG-Portal-AuthSSL.t
|
||||
|
|
|
|||
|
|
@ -12,6 +12,7 @@ requires:
|
|||
CGI: 3.08
|
||||
CGI::Session: 0
|
||||
HTML::Template: 0
|
||||
IO::String: 0
|
||||
Lemonldap::NG::Common: 0.9
|
||||
Lemonldap::NG::Handler: 0.9
|
||||
Net::LDAP: 0
|
||||
|
|
|
|||
|
|
@ -41,7 +41,7 @@ sub extractFormInfo {
|
|||
PE_OK;
|
||||
}
|
||||
|
||||
# @apmethod int authenticate()
|
||||
## @apmethod int authenticate()
|
||||
# Does nothing.
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub authenticate {
|
||||
|
|
|
|||
|
|
@ -1,8 +1,3 @@
|
|||
##@file
|
||||
# Cross domain extension for Lemonldap::NG portals.
|
||||
|
||||
##@class
|
||||
# Cross domain extension for Lemonldap::NG portals.
|
||||
package Lemonldap::NG::Portal::CDA;
|
||||
|
||||
use strict;
|
||||
|
|
@ -19,8 +14,6 @@ use base ('Lemonldap::NG::Portal::SharedConf');
|
|||
# OVERLOADED SUB #
|
||||
##################
|
||||
|
||||
## @cmethod Lemonldap::NG::Portal::CDA new()
|
||||
# @return Lemonldap::NG::Portal::CDA object
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $self = $class->SUPER::new(@_);
|
||||
|
|
|
|||
|
|
@ -43,10 +43,9 @@ sub getConf {
|
|||
}
|
||||
|
||||
## @method list getProtectedSites()
|
||||
# @return list list of protected virtual hosts.
|
||||
|
||||
# With SharedConf, $locationRules contains a hash table with virtual hosts as
|
||||
# keys. So we can use it to know all protected virtual hosts.
|
||||
# @return list list of protected virtual hosts.
|
||||
sub getProtectedSites {
|
||||
my $self = shift;
|
||||
my @tab = ();
|
||||
|
|
@ -55,6 +54,9 @@ sub getProtectedSites {
|
|||
return ();
|
||||
}
|
||||
|
||||
## @method private hashref _getLmConf()
|
||||
# Call and return Lemonldap::NG::Common::Conf::getConf() value.
|
||||
# @return Lemonldap::NG shared configuration
|
||||
sub _getLmConf {
|
||||
my $self = shift;
|
||||
$self->{lmConf} = Lemonldap::NG::Common::Conf->new( $self->{configStorage} )
|
||||
|
|
|
|||
|
|
@ -19,13 +19,16 @@ use Lemonldap::NG::Portal::_i18n; #inherits
|
|||
use Safe;
|
||||
|
||||
# Special comments for doxygen
|
||||
#inherits Lemonldap::NG::Portal::_SOAP
|
||||
#inherits Lemonldap::NG::Portal::AuthApache
|
||||
#inherits Lemonldap::NG::Portal::AuthCAS
|
||||
#inherits Lemonldap::NG::Portal::AuthLDAP
|
||||
#inherits Lemonldap::NG::Portal::AuthRemote
|
||||
#inherits Lemonldap::NG::Portal::AuthSSL
|
||||
#inherits Lemonldap::NG::Portal::Menu
|
||||
#link Lemonldap::NG::Portal::Notification protected notification
|
||||
#inherits Lemonldap::NG::Portal::UserDBLDAP
|
||||
#inherits Lemonldap::NG::Portal::UserDBRemote
|
||||
#inherits Apache::Session
|
||||
#link Lemonldap::NG::Common::Apache::Session::SOAP protected globalStorage
|
||||
|
||||
|
|
|
|||
|
|
@ -12,10 +12,12 @@ require SOAP::Lite;
|
|||
## @method void startSoapServices()
|
||||
# Check the URI requested (PATH_INFO environment variable) and launch the
|
||||
# corresponding SOAP methods using soapTest().
|
||||
# If "soapOnly" is set, reject otehr request. Else, simply return.
|
||||
sub startSoapServices {
|
||||
my $self = shift;
|
||||
if (
|
||||
my $tmp = {
|
||||
$ENV{PATH_INFO}
|
||||
and my $tmp = {
|
||||
'/sessions' => 'getAttributes',
|
||||
'/adminSessions' => 'setAttributes newSession',
|
||||
'/config' => 'getConfig'
|
||||
|
|
@ -142,15 +144,13 @@ sub _buildSoapHash {
|
|||
my @tmp = ();
|
||||
@keys = keys %$h unless (@keys);
|
||||
foreach (@keys) {
|
||||
if ( ref( $h->{$_} ) eq 'HASH' ) {
|
||||
die;
|
||||
push @tmp, SOAP::Data->name( $_ => _buildSoapHash( $h->{$_} ) );
|
||||
}
|
||||
elsif ( ref( $h->{$_} ) eq 'ARRAY' ) {
|
||||
die;
|
||||
if ( ref( $h->{$_} ) eq 'ARRAY' ) {
|
||||
push @tmp,
|
||||
SOAP::Data->name( $_, \SOAP::Data->value( @{ $h->{$_} } ) );
|
||||
}
|
||||
elsif ( ref( $h->{$_} ) ) {
|
||||
push @tmp, SOAP::Data->name( $_ => _buildSoapHash( $h->{$_} ) );
|
||||
}
|
||||
else {
|
||||
push @tmp, SOAP::Data->name( $_, $h->{$_} )->type('string')
|
||||
if ( defined( $h->{$_} ) );
|
||||
|
|
|
|||
84
modules/lemonldap-ng-portal/t/04-Lemonldap-NG-Portal-SOAP.t
Normal file
84
modules/lemonldap-ng-portal/t/04-Lemonldap-NG-Portal-SOAP.t
Normal file
|
|
@ -0,0 +1,84 @@
|
|||
# Before `make install' is performed this script should be runnable with
|
||||
# `make test'. After `make install' it should work as `perl Lemonldap-NG-Portal.t'
|
||||
|
||||
#########################
|
||||
|
||||
# change 'tests => 1' to 'tests => last_test_to_print';
|
||||
package My::Portal;
|
||||
|
||||
use strict;
|
||||
use IO::String;
|
||||
use Test::More tests => 2;
|
||||
|
||||
BEGIN { use_ok( 'Lemonldap::NG::Portal::Simple', ':all' ) }
|
||||
our @ISA = qw(Lemonldap::NG::Portal::Simple);
|
||||
|
||||
sub abort {
|
||||
shift;
|
||||
$, = '';
|
||||
print STDERR @_;
|
||||
die 'abort has been called';
|
||||
}
|
||||
|
||||
sub quit {
|
||||
2;
|
||||
}
|
||||
|
||||
our $param;
|
||||
|
||||
sub param {
|
||||
return $param;
|
||||
}
|
||||
|
||||
sub soapfunc {
|
||||
return 'SoapOK';
|
||||
}
|
||||
|
||||
our $buf;
|
||||
|
||||
tie *STDOUT, 'IO::String', $buf;
|
||||
our $lastpos = 0;
|
||||
|
||||
sub diff {
|
||||
my $str = $buf;
|
||||
$str =~ s/^.{$lastpos}//s if ($lastpos);
|
||||
$str =~ s/\r//gs;
|
||||
$lastpos = length $buf;
|
||||
return $str;
|
||||
}
|
||||
|
||||
#########################
|
||||
|
||||
# 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 $p;
|
||||
|
||||
# CGI Environment
|
||||
$ENV{SCRIPT_NAME} = '/test.pl';
|
||||
$ENV{SCRIPT_FILENAME} = '/tmp/test.pl';
|
||||
$ENV{REQUEST_METHOD} = 'GET';
|
||||
$ENV{REQUEST_URI} = '/';
|
||||
$ENV{QUERY_STRING} = '';
|
||||
|
||||
SKIP: {
|
||||
eval { require SOAP::Lite };
|
||||
skip "SOAP::Lite is not installed, so CGI SOAP functions will not work", 1
|
||||
if ($@);
|
||||
|
||||
ok(
|
||||
$p = Lemonldap::NG::Portal::Simple->new(
|
||||
{
|
||||
globalStorage => 'Apache::Session::File',
|
||||
globalStorageOptions => {
|
||||
Directory => '/tmp/',
|
||||
LockDirectory => '/tmp/',
|
||||
},
|
||||
domain => 'example.com',
|
||||
soap => 1,
|
||||
}
|
||||
),
|
||||
'Portal object'
|
||||
);
|
||||
bless $p, 'My::Portal';
|
||||
}
|
||||
|
|
@ -25,7 +25,7 @@ our $lastpos = 0;
|
|||
|
||||
sub diff {
|
||||
my $str = $buf;
|
||||
$str =~ s/^.{$lastpos}//s if($lastpos);
|
||||
$str =~ s/^.{$lastpos}//s if ($lastpos);
|
||||
$str =~ s/\r//gs;
|
||||
$lastpos = length $buf;
|
||||
return $str;
|
||||
|
|
@ -33,7 +33,7 @@ sub diff {
|
|||
|
||||
sub abort {
|
||||
shift;
|
||||
local $,=' ';
|
||||
local $, = ' ';
|
||||
print STDERR @_;
|
||||
}
|
||||
|
||||
|
|
@ -53,19 +53,18 @@ $ENV{QUERY_STRING} = '';
|
|||
ok(
|
||||
$p = My::Portal->new(
|
||||
{
|
||||
globalStorage => 'Apache::Session::File',
|
||||
domain => 'example.com',
|
||||
authentication => 'Remote',
|
||||
portal => 'http://abc',
|
||||
remotePortal => 'http://zz/',
|
||||
remoteGlobalStorage => 'Apache::Session::File',
|
||||
remoteGlobalStorageOptions => {
|
||||
dirName => '.',
|
||||
},
|
||||
globalStorage => 'Apache::Session::File',
|
||||
domain => 'example.com',
|
||||
authentication => 'Remote',
|
||||
portal => 'http://abc',
|
||||
remotePortal => 'http://zz/',
|
||||
remoteGlobalStorage => 'Apache::Session::File',
|
||||
remoteGlobalStorageOptions => { dirName => '.', },
|
||||
}
|
||||
),
|
||||
'Portal object'
|
||||
);
|
||||
|
||||
ok(($p->process()==0 and $p->{error} == PE_BADCREDENTIALS), 'call goToPortal');
|
||||
ok( ( $p->process() == 0 and $p->{error} == PE_BADCREDENTIALS ),
|
||||
'call goToPortal' );
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user