SharedConf.pm 7.91 KB
Newer Older
1 2 3 4 5
package Lemonldap::NG::Portal::SharedConf;

use strict;
use Lemonldap::NG::Portal::Simple qw(:all);
use Lemonldap::NG::Manager::Conf;
Xavier Guimard's avatar
Xavier Guimard committed
6
use Safe;
7 8 9 10 11

*EXPORT_OK   = *Lemonldap::NG::Portal::Simple::EXPORT_OK;
*EXPORT_TAGS = *Lemonldap::NG::Portal::Simple::EXPORT_TAGS;
*EXPORT      = *Lemonldap::NG::Portal::Simple::EXPORT;

12
our $VERSION = "0.42";
13 14
our @ISA     = qw(Lemonldap::NG::Portal::Simple);

Xavier Guimard's avatar
Xavier Guimard committed
15 16 17
# Secure jail
our $safe = new Safe;

Xavier Guimard's avatar
Xavier Guimard committed
18
##################
19
# OVERLOADED SUB #
Xavier Guimard's avatar
Xavier Guimard committed
20 21 22 23 24
##################

# getConf: all parameters returned by the Lemonldap::NG::Manager::Conf object
#          are copied in $self
#          See Lemonldap::NG::Manager::Conf(3) for more
25 26
sub getConf {
    my $self = shift;
27 28 29 30 31 32 33 34
    my %args;
    if ( ref( $_[0] ) ) {
        %args = %{ $_[0] };
    }
    else {
        %args = @_;
    }
    %$self = ( %$self, %args );
35 36
    $self->{lmConf} =
      Lemonldap::NG::Manager::Conf->new( $self->{configStorage} )
Xavier Guimard's avatar
Xavier Guimard committed
37 38
      unless $self->{lmConf};
    return 0 unless ( ref( $self->{lmConf} ) );
39 40
    my $tmp = $self->{lmConf}->getConf;
    return 0 unless $tmp;
41 42
    # Local configuration prepends global
    $self->{$_} = $args{$_} || $tmp->{$_} foreach ( keys %$tmp );
Xavier Guimard's avatar
Xavier Guimard committed
43
    1;
44 45
}

46 47 48 49
# Here is implemented the 'macro' mechanism.
our $self; # Safe cannot share a variable declared with my
sub setMacros {
    local $self = shift;
50 51
    die __PACKAGE__ . ": Unable to get configuration"
      unless ( $self->getConf(@_) );
52 53 54 55 56 57 58 59 60 61 62 63
    while ( my($n, $e) = each ( %{ $self->{macros} } ) ) {
        $e =~ s/\$(\w+)/\$self->{sessionInfo}->{$1}/g;
        $safe->share( '$self', '&encode_base64' );
        $self->{sessionInfo}->{$n} = $safe->reval($e);
    }
    PE_OK;
}

# Here is implemented the 'groups' mechanism. See Lemonldap::NG::Portal for
# more.
sub setGroups {
    local $self = shift;
64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87
    my $groups;
    foreach ( keys %{ $self->{groups} } ) {
        my $filter = $self->scanexpr( $self->{groups}->{$_} );
        next if ( $filter eq "0" );
        if ( $filter eq "1" ) {
            $groups .= "$_ ";
            next;
        }
        else {
            $filter = "(&(uid=" . $self->{user} . ")$filter)";
        }
        my $mesg = $self->{ldap}->search(
            base   => $self->{ldapBase},
            filter => $filter,
            attrs  => ["uid"],
        );
        if ( $mesg->code() != 0 ) {
            print STDERR $mesg->error . "\n$filter\n";
            return PE_LDAPERROR;
        }
        my $entry = $mesg->entry(0);
        if ($entry) {
            $groups .= "$_ ";
        }
88 89 90 91 92 93 94 95 96 97 98 99 100
    }
    if ( $self->{ldapGroupBase} ) {
        my $mesg = $self->{ldap}->search(
            base   => $self->{ldapGroupBase},
            filter => "(|(member=" . $self->{dn} . ")(uniqueMember=" . $self->{dn} . "))",
            attrs  => ["cn"],
        );
        if ( $mesg->code() == 0 ) {
            foreach my $entry ($mesg->all_entries) {
                my @values = $entry->get_value("cn");
                $groups .= $values[0] . " ";
            }
        }
101 102 103 104 105
    }
    $self->{sessionInfo}->{groups} = $groups;
    PE_OK;
}

Xavier Guimard's avatar
Xavier Guimard committed
106
# Internal sub used to replace Perl expressions in 'groups' rules.
107 108 109
sub scanexpr {
    my $self = shift;
    local $_ = shift;
Xavier Guimard's avatar
Xavier Guimard committed
110
    my $result;
111 112

    # Perl expressions
Xavier Guimard's avatar
Xavier Guimard committed
113
    if ( s/^{(.*)}$/$1/ or $_ !~ /^\(.*\)$/ ) {
114
        s/\$(\w+)/\$self->{sessionInfo}->{$1}/g;
115
        $safe->share( '$self', '&encode_base64'  );
Xavier Guimard's avatar
Xavier Guimard committed
116 117
        $result = $safe->reval($_);
        return $result ? "1" : "0";
118 119 120 121 122 123 124 125 126 127 128 129 130
    }

    # Simple LDAP expression
    unless (/[^\\][\({]/) {
        return $_;
    }

    # Node
    my $brackets  = 0;
    my $exprCount = 0;
    my $tmp;
    my $subexpr;
    my $esc = 0;
Xavier Guimard's avatar
Xavier Guimard committed
131
    $result = "";
132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154
    my $cond = substr $_, 1, 1;
    my $or = ( $cond eq '|' );

    for ( my $i = 2 ; $i < ( length($_) - 1 ) ; $i++ ) {
        $tmp = substr $_, $i, 1;
        $subexpr .= $tmp;
        if ($esc) {
            $esc = 0;
            next;
        }
        $esc++ if ( $tmp eq "\\" );
        $brackets++ if ( $tmp =~ /^[\({]$/ );
        $brackets-- if ( $tmp =~ /^[\)}]$/ );
        unless ($brackets) {
            $subexpr = $self->scanexpr($subexpr);
            if ( $subexpr eq "1" ) {
                return "1" if ($or);
            }
            elsif ( $subexpr eq "0" ) {
                return "0" unless ($or);
            }
            else {
                $exprCount++;
Xavier Guimard's avatar
Xavier Guimard committed
155
                $result .= $subexpr;
156 157 158 159 160
            }
            $subexpr = '';
        }
    }
    die "Incorrect expression" if $brackets;
Xavier Guimard's avatar
Xavier Guimard committed
161 162 163
    return $result if ( $result eq "0" or $result eq "1" );
    return $result if ( $exprCount == 1 );
    return "($cond$result)";
164 165
}

166 167 168 169 170 171 172 173 174 175
# With SharedConf, $locationRules contains a hash table with virtual hosts as
# keys. So we can use it to know all protected virtual hosts.
sub getProtectedSites {
    my $self = shift;
    my @tab  = ();
    return ( keys %{ $self->{locationRules} } )
      if ( ref $self->{locationRules} );
    return ();
}

176 177 178 179 180 181 182 183 184 185
1;
__END__

=head1 NAME

Lemonldap::NG::Portal::SharedConf - Module for building Lemonldap::NG
compatible portals using a central configuration database.

=head1 SYNOPSIS

Xavier Guimard's avatar
Xavier Guimard committed
186 187 188 189 190 191 192 193 194 195
  use Lemonldap::NG::Portal::SharedConf;
  my $portal = new Lemonldap::NG::Portal::SharedConf( {
         configStorage => {
             type        => 'DBI',
             dbiChain    => "dbi:mysql:...",
             dbiUser     => "lemonldap",
             dbiPassword => "password",
             dbiTable    => "lmConfig",
         },
    } );
196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227

  if($portal->process()) {
    # Write here the menu with CGI methods. This page is displayed ONLY IF
    # the user was not redirected here.
    print $portal->header; # DON'T FORGET THIS (see L<CGI(3)>)
    print "...";

    # or redirect the user to the menu
    print $portal->redirect( -uri => 'https://portal/menu');
  }
  else {
    # Write here the html form used to authenticate with CGI methods.
    # $portal->error returns the error message if athentification failed
    # Warning: by defaut, input names are "user" and "password"
    print $portal->header; # DON'T FORGET THIS (see L<CGI(3)>)
    print "...";
    print '<form method="POST">';
    # In your form, the following value is required for redirection
    print '<input type="hidden" name="url" value="'.$portal->param('url').'">';
    # Next, login and password
    print 'Login : <input name="user"><br>';
    print 'Password : <input name="password" type="password" autocomplete="off">';
    print '<input type="submit" value="go" />';
    print '</form>';
  }

=head1 DESCRIPTION

Lemonldap::NG::Portal::SharedConf is the base module for building Lemonldap::NG
compatible portals using a central database configuration. You have to use by
inheritance.

Xavier Guimard's avatar
Xavier Guimard committed
228
See L<Lemonldap::NG::Portal::SharedConf> for a complete example.
229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255

=head1 METHODS

Same as L<Lemonldap::NG::Portal::Simple>, but Lemonldap::NG::Portal::SharedConf
adds a new sub:

=over

=item * scanexpr: used by setGroups to read combined LDAP and Perl expressions.
See L<Lemonldap::NG::Portal> for more.

=back

=head3 Args

Lemonldap::NG::Portal::SharedConf use the same arguments than
L<Lemonldap::NG::Portal::Simple>, but you can set them either using local
variables passed to C<new()> or using variables issued from the database.

=head2 EXPORT

=head3 Constants

Same as L<Lemonldap::NG::Portal::Simple>.

=head1 SEE ALSO

Xavier Guimard's avatar
Xavier Guimard committed
256
L<Lemonldap::NG::Portal>, L<Lemonldap::NG::Portal::SharedConf>,
257 258
L<Lemonldap::NG::Handler>, L<Lemonldap::NG::Manager>,
http://wiki.lemonldap.objectweb.org/xwiki/bin/view/NG/Presentation
259 260 261 262 263

=head1 AUTHOR

Xavier Guimard, E<lt>x.guimard@free.frE<gt>

Xavier Guimard's avatar
Xavier Guimard committed
264 265 266 267 268 269 270 271 272 273
=head1 BUG REPORT

Use OW2 system to report bug or ask for features:
L<http://forge.objectweb.org/tracker/?group_id=274>

=head1 DOWNLOAD

Lemonldap::NG is available at
L<http://forge.objectweb.org/project/showfiles.php?group_id=274>

274 275
=head1 COPYRIGHT AND LICENSE

276
Copyright (C) 2005-2007 by Xavier Guimard E<lt>x.guimard@free.frE<gt>
277 278 279 280 281 282

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.4 or,
at your option, any later version of Perl 5 you may have available.

=cut