#28 in progress

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

@@ -4,14 +4,14 @@ use strict;
 use fields qw(_extensions);
 use Net::OpenID::Server;
 
-our @ISA = qw(Net::OpenID::Server);
+our @ISA     = qw(Net::OpenID::Server);
 our $VERSION = '0.1';
 
 sub new {
     my $class = shift;
-    my $self = fields::new($class);
-    my %opts = splice @_;
-    $self->$_(delete $opts{$_}) foreach (qw(extensions));
+    my $self  = fields::new($class);
+    my %opts  = splice @_;
+    $self->$_( delete $opts{$_} ) foreach (qw(extensions));
     return $self->SUPER::new(%opts);
 }
 
@@ -23,30 +23,74 @@ sub extensions {
 sub signed_return_url {
     my ( $self, %opts ) = splice @_;
     my $extra;
-    if(ref $self->{_extensions}){
+    if ( ref $self->{_extensions} ) {
         my $list = $self->args();
         my @list = $self->get_args();
         my %h;
         foreach my $arg (@list) {
-            next unless($arg =~/^openid\.(\w+)/);
+            next unless ( $arg =~ /^openid\.(\w+)(\.[\w\.]+)?/ );
             my $tmp = $1;
-            if(defined $self->{_extensions}->{$tmp}) {
-                push @{$h{$tmp}},$arg,scalar self->get_args($arg);
+            my $val = $2;
+            if ( defined $self->{_extensions}->{$tmp} ) {
+                push @{ $h{$tmp} }, $val, scalar self->get_args($arg);
             }
         }
         my %vars;
-        foreach my $ns (keys %h){
-            %vars = (%vars,$self->{_extensions}->{$ns}->(@{$h{$ns}}));
+        foreach my $ns ( keys %h ) {
+            my %h = $self->{_extensions}->{$ns}->( @{ $h{$ns} } );
+            while ( my ( $k, $v ) = each %h ) {
+                $vars{"openid.$ns.$k"} = $v;
+            }
         }
         $opts{extra_fields} = \%vars;
     }
     return $self->SUPER::signed_return_url(%opts);
 }
 
-#sub get_args {
-#    my ($self, $hash) = shift;
-#    return sub
-#}
+*args = \&get_args;
+
+sub get_args {
+    my $self = shift;
+
+    if ( my $what = shift ) {
+        Carp::croak("Too many parameters") if @_;
+
+        # Lemonldap::NG only (direct CGI)
+        $self->{get_args} = sub { $what->param( $_[0] ) };
+
+        # INCLUDE IN PROPOSED PATCH FOR Net::OpenID::Server
+        #my $getter;
+        #if ( !ref $what ) {
+        #    Carp::croak("No get_args defined") unless $self->{get_args};
+        #    return $self->{get_args}->($what) || "";
+        #}
+        #elsif ( ref $what eq "HASH" ) {
+        #    $getter = sub { $_[0] ? $what->{ $_[0] } : ( keys %$what ); };
+        #}
+        #elsif ( ref $what eq "Apache" ) {
+        #    my %get = $what->args;
+        #    $getter = sub { $_[0] ? $get{ $_[0] } : ( keys %get ); };
+        #}
+        #elsif ( ref $what eq "CODE" ) {
+        #    $getter = $what;
+        #}
+        #else {
+        #    my $r = eval { $what->can('param') };
+        #    if ( $@ or not $r ) {
+        #        Carp::croak("Unknown parameter type ($what)");
+        #    }
+        #    else {
+        #        $getter = sub {
+        #            $_[0] ? scalar $what->param( $_[0] ) : ( $what->param() );
+        #        };
+        #    }
+        #}
+        #if ($getter) {
+        #    $self->{get_args} = $getter;
+        #}
+    }
+    $self->{get_args};
+}
 
 1;
 __END__

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

@@ -101,6 +101,52 @@ sub restoreOpenIDprm {
     $self->{openIDRestored} = 1;
 }
 
+sub sregHook {
+    my ( $self, %prm ) = splice @_;
+    my ( %r, @req, @opt );
+    while ( my ( $k, $v ) = each %prm ) {
+        if ( $k eq 'policy_url' ) {
+            if ( $v =~ m{^https?://\S+} ) {
+                $self->{openIdCustomerPolicy} = $v;
+            }
+        }
+        elsif ( $k eq 'required' ) {
+            push @req, split( /,/, $v );
+        }
+        elsif ( $k eq 'optional' ) {
+            push @opt,
+              grep { defined $self->{"openIdSreg_$_"} } split( /,/, $v );
+        }
+        else {
+            $self->lmLog( "Unknown OpenID SREG request $k", 'error' );
+        }
+    }
+
+    # If a required data is not available, returns nothing
+    foreach my $k (@req) {
+        unless ( $self->{"openIdSreg_$k"} ) {
+            $self->lmLog(
+"Parameter $k is required by customer but not defined in configuration",
+                'notice'
+            );
+            return ();
+        }
+    }
+    foreach my $k ( @req, @opt ) {
+        unless ( $k =~
+/^(?:(?:(?:full|nick)nam|languag|postcod|timezon)e|country|gender|email|dob)$/
+          )
+        {
+            $self->lmLog(
+                "Requested parameter $k is not a valid OpenID SREG parameter",
+                'error' );
+            return ();
+        }
+        $r{$k} = $self->{sessionInfo}->{ $self->{"openIdSreg_$k"} };
+    }
+    return %r;
+}
+
 sub openIDServer {
     my $self = shift;
     return $self->{_openidserver} if ( $self->{_openidserver} );
@@ -151,7 +197,12 @@ sub openIDServer {
                 $self->{_openIdTrustRequired} = 1;
                 return 0;
             }
-        }
+        },
+        extensions => {
+            sreg => sub {
+                return $self->sregHook(@_);
+            },
+        },
     );
     return $self->{_openidserver};
 }