LEMONLDAP::NG : propagation of 0.9.3.4 changes

build/lemonldap-ng/debian/copyright

@@ -11,7 +11,7 @@ Licence:
 Lemonldap::NG is distributed under your choice under the GNU General Public
 License or the Artistic License.
 On Debian GNU/Linux systems, the complete text of the GNU General Public
-License version 2 can be found in `/usr/share/common-licenses/GPL' and the
+License version 2 can be found in `/usr/share/common-licenses/GPL-2' and the
 Artistic Licence in `/usr/share/common-licenses/Artistic'.
 
 File lemonldap-ng-manager/example/lemonldap-ng-manager.js is distributed under

modules/lemonldap-ng-common/MANIFEST

@@ -5,6 +5,7 @@ lib/Lemonldap/NG/Common/Apache/Session/SOAP.pm
 lib/Lemonldap/NG/Common/BuildWSDL.pm
 lib/Lemonldap/NG/Common/CGI.pm
 lib/Lemonldap/NG/Common/CGI/SOAPServer.pm
+lib/Lemonldap/NG/Common/CGI/SOAPService.pm
 lib/Lemonldap/NG/Common/Conf.pm
 lib/Lemonldap/NG/Common/Conf/Constants.pm
 lib/Lemonldap/NG/Common/Conf/DBI.pm

modules/lemonldap-ng-common/lib/Lemonldap/NG/Common/CGI.pm

@@ -16,23 +16,21 @@ our $VERSION = '0.31';
 
 use base qw(CGI);
 
-## @method void soapTest(string soapFunctions)
+## @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 = shift;
+    my($self, $soapFunctions, $obj) = @_;
-    my $soapFunctions = shift || $self->{SOAPFunctions};
 
     # If non form encoded datas are posted, we call SOAP Services
     if ( $ENV{HTTP_SOAPACTION} ) {
-	require Lemonldap::NG::Common::CGI::SOAPServer;
+        require Lemonldap::NG::Common::CGI::SOAPServer; #link protected dispatcher
-        my @func = ();
+        require Lemonldap::NG::Common::CGI::SOAPService; #link protected soapService
-        foreach ( ref($soapFunctions) ? @$soapFunctions : split /\s+/, $soapFunctions ) {
+        my @func = ( ref($soapFunctions) ? @$soapFunctions : split /\s+/, $soapFunctions );
-            $_ = ref($self) . "::$_" unless (/::/);
+        my $dispatcher = Lemonldap::NG::Common::CGI::SOAPService->new($obj||$self,@func);
-            push @func, $_;
+        Lemonldap::NG::Common::CGI::SOAPServer->dispatch_to($dispatcher)
-        }
-        Lemonldap::NG::Common::CGI::SOAPServer->dispatch_to(@func)
           ->handle($self);
         exit;
     }

modules/lemonldap-ng-common/lib/Lemonldap/NG/Common/CGI/SOAPServer.pm

@@ -63,7 +63,7 @@ sub handle {
                 $content,
             )
         );
-        $self->SUPER::handle;
+        $self->SUPER::handle();
     }
 
     print $cgi->header(

modules/lemonldap-ng-common/lib/Lemonldap/NG/Common/CGI/SOAPService.pm

@@ -0,0 +1,38 @@
+## @file
+# SOAP wrapper used to restrict exported functions
+
+## @class
+# SOAP wrapper used to restrict exported functions
+package Lemonldap::NG::Common::CGI::SOAPService;
+
+## @cmethod Lemonldap::NG::Common::CGI::SOAPService new(object obj,string @func)
+# Constructor
+# @param $obj object which will be called for SOAP authorizated methods
+# @param @fung authorizated methods
+# @return Lemonldap::NG::Common::CGI::SOAPService object
+sub new {
+    my($class, $obj, @func) = @_;
+    s/.*::// foreach(@func);
+    return bless {obj=>$obj,func=>\@func}, $class;
+}
+
+## @method datas AUTOLOAD()
+# Call the wanted function with the object given to the constructor.
+# AUTOLOAD() is a magic method called by Perl interpreter fon non existent
+# functions. Here, we use it to call the wanted function (given by $AUTOLOAD)
+# if it is authorizated
+# @return datas provided by the exported function
+sub AUTOLOAD {
+    my $self = shift;
+    $AUTOLOAD =~ s/.*:://;
+    if(grep {$_ eq $AUTOLOAD} @{$self->{func}}){
+        return $self->{obj}->$AUTOLOAD(@_);
+    }
+    elsif($AUTOLOAD ne 'DESTROY') {
+        die "$AUTOLOAD is an authorizated function";use Data::Dumper;
+    }
+    1;
+}
+
+1;
+

modules/lemonldap-ng-portal/lib/Lemonldap/NG/Portal.pm

@@ -75,7 +75,7 @@ SOAP mode authentication (client) :
   
   my $soap =
     SOAP::Lite->proxy('http://auth.example.com/')
-    ->uri('urn:/Lemonldap::NG::Portal::SharedConf');
+    ->uri('urn:/Lemonldap::NG::Common::::CGI::SOAPService');
   my $r = $soap->getCookies( 'user', 'password' );
   
   # Catch SOAP errors

modules/lemonldap-ng-portal/lib/Lemonldap/NG/Portal/SharedConf.pm

@@ -123,7 +123,7 @@ SOAP mode authentication (client) :
   
   my $soap =
     SOAP::Lite->proxy('http://auth.example.com/')
-    ->uri('urn:/Lemonldap::NG::Portal::SharedConf');
+    ->uri('urn:/Lemonldap::NG::Common::::CGI::SOAPService');
   my $r = $soap->getCookies( 'user', 'password' );
   
   # Catch SOAP errors

modules/lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Simple.pm

@@ -95,7 +95,7 @@ sub new {
     binmode( STDOUT, ":utf8" );
     my $class = shift;
     return $class if ( ref($class) );
-    $self = $class->SUPER::new();
+    my $self = $class->SUPER::new();
     $self->getConf(@_)
       or $self->abort( "Configuration error",
         "Unable to get configuration: $Lemonldap::NG::Common::Conf::msg" );
@@ -158,7 +158,7 @@ sub new {
     if ( $self->{notification} and $ENV{PATH_INFO} and $ENV{PATH_INFO} =~ "/notification" ) {
         require SOAP::Lite;
         $Lemonldap::NG::Portal::Notification::self = $self->{notifObject};
-        $self->soapTest('Lemonldap::NG::Portal::Notification::newNotification');
+        $self->soapTest('Lemonldap::NG::Portal::Notification::newNotification',$self->{notifObject});
         $self->abort('Bad request', 'Only SOAP requests are accepted with "/notification"');
     }
     if ( $self->{Soap} ) {
@@ -450,7 +450,7 @@ sub safe {
             }";
         print STDERR $@ if ($@);
     }
-    $safe->share( '$self', '&encode_base64', @t );
+    $safe->share( '&encode_base64', @t );
     return $safe;
 }
 
@@ -475,7 +475,7 @@ _RETURN $getCookieResponse Response
 #@param password password
 #@return session => { error => code , cookies => { cookieName1 => value ,... } }
 sub getCookies {
-    my $class = shift;
+    my $self = shift;
     $self->{error} = PE_OK;
     ( $self->{user}, $self->{password} ) = ( shift, shift );
     unless ( $self->{user} && $self->{password} ) {
@@ -549,7 +549,7 @@ sub controlUrlOrigin {
         if (
             $self->{urldc} =~ /(?:\0|<|'|"|`|\%(?:00|25|3C|22|27|2C))/
             or ( $self->{urldc} !~
-m#^https?://(?:$self->{reVHosts}|(?:[^/]*)?$self->{domain})(?:/.*)?$#
+m#^https?://(?:$self->{reVHosts}|(?:[^/]*)?$self->{domain})(?::\d+)?(?:/.*)?$#
                 and not $self->param('logout') )
           )
         {
@@ -698,6 +698,7 @@ sub setMacros {
     local $self = shift;
     $self->abort( __PACKAGE__ . ": Unable to get configuration" )
       unless ( $self->getConf(@_) );
+    $self->safe->share('$self');
     while ( my ( $n, $e ) = each( %{ $self->{macros} } ) ) {
         $e =~ s/\$(\w+)/\$self->{sessionInfo}->{$1}/g;
         $self->{sessionInfo}->{$n} = $self->safe->reval($e);
@@ -713,12 +714,9 @@ sub setMacros {
 sub setGroups {
     local $self = shift;
     my $groups;
-
+    $self->safe->share('$self');
-    #foreach ( keys %{ $self->{groups} } ) {
     while ( my ( $group, $expr ) = each %{ $self->{groups} } ) {
         $expr =~ s/\$(\w+)/\$self->{sessionInfo}->{$1}/g;
-
-        # TODO : custom Functions
         $groups .= "$group " if ( $self->safe->reval($expr) );
     }
     if ( $self->{ldapGroupBase} ) {
@@ -919,7 +917,7 @@ SOAP mode authentication (client) :
   
   my $soap =
     SOAP::Lite->proxy('http://auth.example.com/')
-    ->uri('urn:/Lemonldap::NG::Portal::SharedConf');
+    ->uri('urn:/Lemonldap::NG::Common::::CGI::SOAPService');
   my $r = $soap->getCookies( 'user', 'password' );
   
   # Catch SOAP errors