LEMONLDAP::NG : customFunctions are now shared in macros, groups, headers and rules

This commit is contained in:
Xavier Guimard 2008-12-11 17:02:02 +00:00
parent 66fd842630
commit cc07eae107
3 changed files with 60 additions and 19 deletions

View File

@ -20,6 +20,28 @@ our @ISA;
our $VERSION = '0.87'; our $VERSION = '0.87';
# Secure jail
our $safe;
##@method private object safe()
# Provide the security jail.
#@return Safe object
sub safe {
my $self = shift;
return $safe if ($safe);
$safe = new Safe;
my @t =
$self->{customFunctions} ? split( /\s+/, $self->{customFunctions} ) : ();
foreach (@t) {
s/^.*:://;
next if ( $self->can($_) );
eval "sub $_ {1}";
print STDERR $@ if ($@);
}
$safe->share( '&encode_base64', @t );
return $safe;
}
sub new { sub new {
my ( $class, $args ) = @_; my ( $class, $args ) = @_;
my $self; my $self;
@ -544,14 +566,7 @@ sub checkConf {
} }
# Load and check macros # Load and check macros
my $safe = new Safe; $self->safe->reval($expr);
my @t = split /\s+/, $self->{customFunctions};
foreach(@t) {
s/^.*:://;
eval "sub $_ {1}";
}
$safe->share('&encode_base64', @t);
$safe->reval($expr);
if ($@) { if ($@) {
$result = 0; $result = 0;
$response->error( &txt_unknownErrorInVars . " ($@)" ); $response->error( &txt_unknownErrorInVars . " ($@)" );
@ -572,7 +587,7 @@ sub checkConf {
# Test macro values; # Test macro values;
$expr .= "my \$$k = $v;"; $expr .= "my \$$k = $v;";
$safe->reval($expr); $self->safe->reval($expr);
if ($@) { if ($@) {
$response->error( $response->error(
&txt_macro . " $k : " . &txt_syntaxError . " : $@" ); &txt_macro . " $k : " . &txt_syntaxError . " : $@" );
@ -604,7 +619,7 @@ sub checkConf {
} }
# Test boolean expression # Test boolean expression
$safe->reval( $expr . "\$groups = '$k' if($v);" ); $self->safe->reval( $expr . "\$groups = '$k' if($v);" );
if ($@) { if ($@) {
$response->error( &txt_group . " $k " . &txt_syntaxError ); $response->error( &txt_group . " $k " . &txt_syntaxError );
$result = 0; $result = 0;
@ -627,7 +642,7 @@ sub checkConf {
# Test regular expressions # Test regular expressions
unless ( $reg eq 'default' ) { unless ( $reg eq 'default' ) {
$reg =~ s/#/\\#/g; $reg =~ s/#/\\#/g;
$safe->reval( $expr . "my \$r = qr#$reg#;" ); $self->safe->reval( $expr . "my \$r = qr#$reg#;" );
if ($@) { if ($@) {
$response->error( $response->error(
&txt_rule . " $vh -> \"$reg\" : " . &txt_syntaxError ); &txt_rule . " $vh -> \"$reg\" : " . &txt_syntaxError );
@ -645,7 +660,7 @@ sub checkConf {
. &txt_containsAnAssignment ); . &txt_containsAnAssignment );
} }
$safe->reval( $expr . "my \$r=1 if($v);" ); $self->safe->reval( $expr . "my \$r=1 if($v);" );
if ($@) { if ($@) {
$response->error( $response->error(
&txt_rule . " $vh -> \"$reg\" : " . &txt_syntaxError ); &txt_rule . " $vh -> \"$reg\" : " . &txt_syntaxError );
@ -683,7 +698,7 @@ sub checkConf {
} }
# Perl expression # Perl expression
$safe->reval( $expr . "my \$r = $v;" ); $self->safe->reval( $expr . "my \$r = $v;" );
if ($@) { if ($@) {
$response->error( $response->error(
&txt_header . " $vh -> $header " . &txt_syntaxError ); &txt_header . " $vh -> $header " . &txt_syntaxError );

View File

@ -18,6 +18,7 @@ sub _safe {
my $self = shift; my $self = shift;
return $self->{_safe} if ( $self->{_safe} ); return $self->{_safe} if ( $self->{_safe} );
$self->{_safe} = new Safe; $self->{_safe} = new Safe;
$self->{customFunctions} ||= $self->{portalObject}->{customFunctions};
my @t = my @t =
$self->{customFunctions} ? split( /\s+/, $self->{customFunctions} ) : (); $self->{customFunctions} ? split( /\s+/, $self->{customFunctions} ) : ();
foreach (@t) { foreach (@t) {

View File

@ -75,7 +75,7 @@ our %EXPORT_TAGS = ( 'all' => [ @EXPORT, 'import' ], );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
# Secure jail # Secure jail
our $safe = new Safe; our $safe;
our $self; # Safe cannot share a variable declared with my our $self; # Safe cannot share a variable declared with my
## @cmethod new($args) ## @cmethod new($args)
@ -86,7 +86,7 @@ sub new {
binmode( STDOUT, ":utf8" ); binmode( STDOUT, ":utf8" );
my $class = shift; my $class = shift;
return $class if ( ref($class) ); return $class if ( ref($class) );
our $self = $class->SUPER::new(); $self = $class->SUPER::new();
$self->getConf(@_) $self->getConf(@_)
or $self->abort( "Configuration error", or $self->abort( "Configuration error",
"Unable to get configuration: $Lemonldap::NG::Common::Conf::msg" ); "Unable to get configuration: $Lemonldap::NG::Common::Conf::msg" );
@ -361,6 +361,33 @@ sub get_url {
return $self->param('url'); return $self->param('url');
} }
##@method private object safe()
# Provide the security jail.
#@return Safe object
sub safe {
my $self = shift;
return $safe if ($safe);
$safe = new Safe;
my @t =
$self->{customFunctions} ? split( /\s+/, $self->{customFunctions} ) : ();
foreach (@t) {
my $sub = $_;
unless (/::/) {
$sub = ref($self) . "::$_";
}
else {
s/^.*:://;
}
next if ( $self->can($_) );
eval "sub $_ {
return $sub( '$self->{portal}', \@_ );
}";
print STDERR $@ if ($@);
}
$safe->share( '$self', '&encode_base64', @t );
return $safe;
}
#################### ####################
# SOAP subroutines # # SOAP subroutines #
#################### ####################
@ -571,8 +598,7 @@ sub setMacros {
unless ( $self->getConf(@_) ); unless ( $self->getConf(@_) );
while ( my ( $n, $e ) = each( %{ $self->{macros} } ) ) { while ( my ( $n, $e ) = each( %{ $self->{macros} } ) ) {
$e =~ s/\$(\w+)/\$self->{sessionInfo}->{$1}/g; $e =~ s/\$(\w+)/\$self->{sessionInfo}->{$1}/g;
$safe->share( '$self', '&encode_base64' ); $self->{sessionInfo}->{$n} = $self->safe->reval($e);
$self->{sessionInfo}->{$n} = $safe->reval($e);
} }
PE_OK; PE_OK;
} }
@ -590,8 +616,7 @@ sub setGroups {
$expr =~ s/\$(\w+)/\$self->{sessionInfo}->{$1}/g; $expr =~ s/\$(\w+)/\$self->{sessionInfo}->{$1}/g;
# TODO : custom Functions # TODO : custom Functions
$safe->share( '$self', '&encode_base64' ); $groups .= "$group " if ( $self->safe->reval($expr) );
$groups .= "$group " if ( $safe->reval($expr) );
} }
if ( $self->{ldapGroupBase} ) { if ( $self->{ldapGroupBase} ) {
my $mesg = $self->{ldap}->search( my $mesg = $self->{ldap}->search(