CGI.pm 10.6 KB
Newer Older
Yadd's avatar
Yadd committed
1
2
3
4
5
## @file
# Auto-protected CGI machanism

## @class
# Base class for auto-protected CGI
Yadd's avatar
Yadd committed
6
7
8
9
package Lemonldap::NG::Handler::CGI;

use strict;

10
use Lemonldap::NG::Common::CGI;
Yadd's avatar
Yadd committed
11
12
13
use CGI::Cookie;
use MIME::Base64;

14
use base qw(Lemonldap::NG::Common::CGI);
Yadd's avatar
Yadd committed
15
16
17

use Lemonldap::NG::Handler::SharedConf qw(:all);

18
#link Lemonldap::NG::Handler::_CGI protected _handler
19

20
our $VERSION = '1.0.2';
Yadd's avatar
Yadd committed
21

22
## @cmethod Lemonldap::NG::Handler::CGI new(hashRef args)
Yadd's avatar
Yadd committed
23
24
25
# Constructor.
# @param $args hash passed to Lemonldap::NG::Handler::_CGI object
# @return new object
Yadd's avatar
Yadd committed
26
27
sub new {
    my $class = shift;
Yadd's avatar
Yadd committed
28
    my $self = $class->SUPER::new() or $class->abort("Unable to build CGI");
29
30
31
32
    $Lemonldap::NG::Handler::_CGI::_cgi = $self;
    unless ($Lemonldap::NG::Handler::_CGI::cookieName) {
        Lemonldap::NG::Handler::_CGI->init(@_);
        Lemonldap::NG::Handler::_CGI->initLocalStorage(@_);
33
    }
34
35
    unless ( eval { Lemonldap::NG::Handler::_CGI->testConf() } == OK ) {
        if ( $_[0]->{noAbort} ) {
36
            $self->{_noConf} = $@;
37
38
39
40
41
        }
        else {
            $class->abort( "Unable to get configuration", $@ );
        }
    }
42

43
    # Arguments
Yadd's avatar
Yadd committed
44
    my @args = splice @_;
45
46
    if ( ref( $args[0] ) ) {
        %$self = ( %$self, %{ $args[0] } );
47
48
    }
    else {
49
        %$self = ( %$self, @args );
50
    }
51

52
53
54
    # Protection
    if ( $self->{protection} ) {
        $self->authenticate();
55

56
        # ACCOUNTING
57
        if ( $self->{protection} =~ /^manager$/i ) {
58
59
            $self->authorize()
              or $self->abort( 'Forbidden',
60
                "You don't have rights to access this page" );
61
62
63
64
65
        }
        elsif ( $self->{protection} =~ /rule\s*:\s*(.*)\s*$/i ) {
            my $rule = $1;
            $rule =~ s/\$date/&POSIX::strftime("%Y%m%d%H%M%S",localtime())/e;
            $rule =~ s/\$(\w+)/\$datas->{$1}/g;
66
            $rule = 0 if ( $rule eq 'deny' );
67
            my $r;
68
69
70
            unless ( $rule eq 'accept'
                or Lemonldap::NG::Handler::_CGI->safe->reval($rule) )
            {
71
72
73
74
                $self->abort( 'Forbidden',
                    "You don't have rights to access this page" );
            }
        }
75
        elsif ( $self->{protection} !~ /^authenticate$/i ) {
76
77
78
79
            $self->abort(
                'Bad configuration',
                "The rule <code>" . $self->{protection} . "</code> is not known"
            );
80
81
        }
    }
Yadd's avatar
Yadd committed
82
83
84
    return $self;
}

Yadd's avatar
Yadd committed
85
86
87
88
89
## @method boolean authenticate()
# Checks if user session is valid.
# Checks Lemonldap::NG cookie and search session in sessions database.
# If nothing is found, redirects the user to the Lemonldap::NG portal.
# @return boolean : true if authentication is good. Exit before else
Yadd's avatar
Yadd committed
90
sub authenticate {
Yadd's avatar
Yadd committed
91
    my $self = shift;
92
93
    $self->abort(
        "Can't authenticate because configuration has not been loaded",
94
95
        $self->{_noConf} )
      if ( $self->{_noConf} );
Yadd's avatar
Yadd committed
96
97
    my %cookies = fetch CGI::Cookie;
    my $id;
Yadd's avatar
Yadd committed
98
    unless ( $cookies{$cookieName} and $id = $cookies{$cookieName}->value ) {
Yadd's avatar
Yadd committed
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
        return $self->goToPortal();
    }
    unless ( $datas and $id eq $datas->{_session_id} ) {
        unless ( $refLocalStorage and $datas = $refLocalStorage->get($id) ) {
            my %h;
            eval { tie %h, $globalStorage, $id, $globalStorageOptions; };
            if ($@) {
                return $self->goToPortal();
            }
            $datas->{$_} = $h{$_} foreach ( keys %h );
            if ($refLocalStorage) {
                $refLocalStorage->set( $id, $datas, "10 minutes" );
            }
        }
    }
114

115
    # Accounting : set user in apache logs
116
    $self->setApacheUser( $datas->{$whatToTrace} );
Yadd's avatar
Yadd committed
117
    $ENV{REMOTE_USER} = $datas->{$whatToTrace};
118

Yadd's avatar
Yadd committed
119
120
121
    return 1;
}

Yadd's avatar
Yadd committed
122
123
124
125
## @method boolean authorize()
# Checks if user is authorized to access to the current request.
# Call Lemonldap::NG::Handler::_CGI::grant() function.
# @return boolean : true if user is granted
Yadd's avatar
Yadd committed
126
127
sub authorize {
    my $self = shift;
128
    return Lemonldap::NG::Handler::_CGI->grant( $ENV{REQUEST_URI} );
Yadd's avatar
Yadd committed
129
130
}

131
## @method int testUri(string uri)
Yadd's avatar
Yadd committed
132
133
134
135
136
# Checks if user is authorized to access to $uri.
# Call Lemonldap::NG::Handler::_CGI::grant() function.
# @param $uri URI or URL to test
# @return int : 1 if user is granted, -1 if virtual host has no configuration,
# 0 if user isn't granted
Yadd's avatar
Yadd committed
137
138
sub testUri {
    my $self = shift;
Yadd's avatar
Yadd committed
139
    $self->abort( "Can't test URI because configuration has not been loaded",
140
141
        $self->{_noConf} )
      if ( $self->{_noConf} );
Yadd's avatar
Yadd committed
142
    my $uri = shift;
143
144
145
146
    my $host =
      ( $uri =~ s#^(?:https?://)?([^/]*)/#/# ) ? $1 : $ENV{SERVER_NAME};
    return -1 unless ( Lemonldap::NG::Handler::_CGI->vhostAvailable($host) );
    return Lemonldap::NG::Handler::_CGI->grant( $uri, $host );
Yadd's avatar
Yadd committed
147
148
}

Yadd's avatar
Yadd committed
149
150
## @method hashRef user()
# @return hash of user datas
Yadd's avatar
Yadd committed
151
152
153
154
sub user {
    return $datas;
}

155
## @method boolean group(string group)
Yadd's avatar
Yadd committed
156
157
# @param $group name of the Lemonldap::NG group to test
# @return boolean : true if user is in this group
Yadd's avatar
Yadd committed
158
sub group {
Yadd's avatar
Yadd committed
159
    my ( $self, $group ) = splice @_;
Yadd's avatar
Yadd committed
160
    return ( $datas->{groups} =~ /\b$group\b/ );
Yadd's avatar
Yadd committed
161
162
}

Yadd's avatar
Yadd committed
163
164
## @method void goToPortal()
# Redirects the user to the portal and exit.
Yadd's avatar
Yadd committed
165
166
sub goToPortal {
    my $self = shift;
167
168
169
    my $tmp = encode_base64( $self->_uri, '' );
    print CGI::redirect(
        -uri => Lemonldap::NG::Handler::_CGI->portal() . "?url=$tmp" );
Yadd's avatar
Yadd committed
170
171
172
    exit;
}

Yadd's avatar
Yadd committed
173
## @fn private string _uri()
Yadd's avatar
Yadd committed
174
175
# Builds current URL including "http://" and server name.
# @return URL_string
Yadd's avatar
Yadd committed
176
sub _uri {
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
    my $vhost = $ENV{SERVER_NAME};
    my $portString =
         $port->{$vhost}
      || $port->{_}
      || $ENV{SERVER_PORT};
    my $_https =
      ( defined( $https->{$vhost} ) ? $https->{$vhost} : $https->{_} );
    $portString =
        ( $_https  && $portString == 443 ) ? ''
      : ( !$_https && $portString == 80 )  ? ''
      :                                      ':' . $portString;
    my $url = "http"
      . ( $_https ? "s" : "" ) . "://"
      . $vhost
      . $portString
Yadd's avatar
Yadd committed
192
      . $ENV{REQUEST_URI};
193
    return $url;
Yadd's avatar
Yadd committed
194
195
}

Yadd's avatar
Yadd committed
196
197
## @class
# Private class used by Lemonldap::NG::Handler::CGI for his internal handler.
Yadd's avatar
Yadd committed
198
199
package Lemonldap::NG::Handler::_CGI;

Yadd's avatar
Yadd committed
200
use strict;
201
use Lemonldap::NG::Handler::SharedConf qw(:locationRules :localStorage :traces);
Yadd's avatar
Yadd committed
202

203
use base qw(Lemonldap::NG::Handler::SharedConf);
Yadd's avatar
Yadd committed
204

205
206
our $_cgi;

Yadd's avatar
Yadd committed
207
208
209
## @method boolean childInit()
# Since this is not a real Apache handler, childs have not to be initialized.
# @return true
210
sub childInit { 1 }
211

Yadd's avatar
Yadd committed
212
213
214
## @method boolean purgeCache()
# Since this is not a real Apache handler, it must not purge the cache at starting.
# @return true
215
sub purgeCache { 1 }
216

217
## @method void lmLog(string message,string level)
Yadd's avatar
Yadd committed
218
219
220
# Replace lmLog by "print STDERR $message".
# @param $message Message to log
# @param $level error level (debug, info, warning or error)
Yadd's avatar
Yadd committed
221
sub lmLog {
222
223
    my $class = shift;
    $_cgi->lmLog(@_);
Yadd's avatar
Yadd committed
224
225
}

226
## @method boolean vhostAvailable(string vhost)
Yadd's avatar
Yadd committed
227
228
229
# Checks if $vhost has been declared in configuration
# @param $vhost Virtual Host to test
# @return boolean : true if $vhost is available
Yadd's avatar
Yadd committed
230
sub vhostAvailable {
Yadd's avatar
Yadd committed
231
    my ( $self, $vhost ) = splice @_;
Yadd's avatar
Yadd committed
232
    return defined( $defaultCondition->{$vhost} );
Yadd's avatar
Yadd committed
233
234
}

235
## @method boolean grant(string uri, string vhost)
Yadd's avatar
Yadd committed
236
237
238
# Return true if user is granted to access.
# @param $uri URI string
# @param $vhost Optional virtual host (default current virtual host)
Yadd's avatar
Yadd committed
239
sub grant {
Yadd's avatar
Yadd committed
240
    my ( $self, $uri, $vhost ) = splice @_;
Yadd's avatar
Yadd committed
241
    $vhost ||= $ENV{SERVER_NAME};
242
243
    $apacheRequest = Lemonldap::NG::Apache::Request->new(
        {
Yadd's avatar
Yadd committed
244
245
246
            uri      => $uri,
            hostname => $vhost,
            args     => '',
247
248
        }
    );
Yadd's avatar
Yadd committed
249
250
251
252
253
254
255
256
257
258
259
260
    for ( my $i = 0 ; $i < $locationCount->{$vhost} ; $i++ ) {
        if ( $uri =~ $locationRegexp->{$vhost}->[$i] ) {
            return &{ $locationCondition->{$vhost}->[$i] }($datas);
        }
    }
    unless ( $defaultCondition->{$vhost} ) {
        $self->lmLog(
            "User rejected because VirtualHost \"$vhost\" has no configuration",
            'warn'
        );
        return 0;
    }
261
    return &{ $defaultCondition->{$vhost} }($datas);
Yadd's avatar
Yadd committed
262
263
}

Yadd's avatar
Yadd committed
264
265
266
267
package Lemonldap::NG::Apache::Request;

sub new {
    my $class = shift;
Yadd's avatar
Yadd committed
268
    my $self  = shift;
Yadd's avatar
Yadd committed
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
    return bless $self, $class;
}

sub hostname {
    return $_[0]->{hostname};
}

sub uri {
    return $_[0]->{uri};
}

sub args {
    return $_[0]->{args};
}

Yadd's avatar
Yadd committed
284
285
1;
__END__
286

Yadd's avatar
Yadd committed
287
288
=head1 NAME

Yadd's avatar
Yadd committed
289
290
=encoding utf8

Yadd's avatar
Yadd committed
291
292
293
294
295
296
297
298
Lemonldap::NG::Handler::CGI - Perl extension for using Lemonldap::NG
authentication in Perl CGI without using Lemonldap::NG::Handler

=head1 SYNOPSIS

  use Lemonldap::NG::Handler::CGI;
  my $cgi = Lemonldap::NG::Handler::CGI->new ( {
      # Local storage used for sessions and configuration
299
      localStorage        => "Cache::FileCache",
Yadd's avatar
Yadd committed
300
301
302
303
304
305
306
307
308
      localStorageOptions => {...},
      # How to get my configuration
      configStorage       => {
          type                => "DBI",
          dbiChain            => "DBI:mysql:database=lemondb;host=$hostname",
          dbiUser             => "lemonldap",
          dbiPassword          => "password",
      },
      https               => 0,
Yadd's avatar
Yadd committed
309
      # Optional
310
311
312
313
314
      protection    => 'rule: $uid eq "admin"',
      # Or to use rules from manager
      protection    => 'manager',
      # Or just to authenticate without managing authorization
      protection    => 'authenticate',
Yadd's avatar
Yadd committed
315
316
317
    }
  );
  
318
  # Lemonldap::NG cookie validation (done if you set "protection")
Yadd's avatar
Yadd committed
319
320
  $cgi->authenticate();
  
Yadd's avatar
Yadd committed
321
  # Optional Lemonldap::NG authorization (done if you set "protection")
Yadd's avatar
Yadd committed
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
  $cgi->authorize();
  
  # See CGI(3) for more about writing HTML pages
  print $cgi->header;
  print $cgi->start_html;
  
  # Since authentication phase, you can use user attributes and macros
  my $name = $cgi->user->{cn};
  
  # Instead of using "$cgi->user->{groups} =~ /\badmin\b/", you can use
  if( $cgi->group('admin') ) {
    # special html code for admins
  }
  else {
    # another HTML code
  }

=head1 DESCRIPTION

Lemonldap::NG::Handler provides the protection part of Lemonldap::NG web-SSO
system. It can be used with any system used with Apache (PHP or JSP pages for
example). If you need to protect only few Perl CGI, you can use this library
instead.

Warning, this module must not be used in a Lemonldap::NG::Handler protected
area because it hides Lemonldap::NG cookies. 

=head1 SEE ALSO

Yadd's avatar
Yadd committed
351
L<http://lemonldap-ng.org/>
Yadd's avatar
Yadd committed
352
353
354
355
356
357
358
359
360
361
L<CGI>, L<Lemonldap::NG::Handler>, L<Lemonldap::NG::Manager>,
L<Lemonldap::NG::Portal>

=head1 AUTHOR

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

=head1 BUG REPORT

Use OW2 system to report bug or ask for features:
Yadd's avatar
Yadd committed
362
L<http://jira.ow2.org>
Yadd's avatar
Yadd committed
363
364
365
366
367
368
369
370

=head1 DOWNLOAD

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

=head1 COPYRIGHT AND LICENSE

Yadd's avatar
Yadd committed
371
Copyright (C) 2007, 2010 by Xavier Guimard
Yadd's avatar
Yadd committed
372
373

This library is free software; you can redistribute it and/or modify
Yadd's avatar
Yadd committed
374
it under the same terms as Perl itself, either Perl version 5.10.0 or,
Yadd's avatar
Yadd committed
375
376
377
at your option, any later version of Perl 5 you may have available.

=cut