File Coverage

blib/lib/Lemonldap/NG/Handler/CGI.pm
Criterion Covered Total %
statement 4 6 66.6
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 6 8 75.0


line stmt bran cond sub pod time code
1             ## @file
2             # Auto-protected CGI machanism
3              
4             ## @class
5             # Base class for auto-protected CGI
6             package Lemonldap::NG::Handler::CGI;
7              
8 1     1   1514 use strict;
  1         3  
  1         35  
9              
10 1     1   195 use Lemonldap::NG::Common::CGI;
  0            
  0            
11             use Lemonldap::NG::Common::Session;
12             use CGI::Cookie;
13             use MIME::Base64;
14              
15             use base qw(Lemonldap::NG::Common::CGI);
16              
17             use Lemonldap::NG::Handler::SharedConf qw(:all);
18              
19             #link Lemonldap::NG::Handler::_CGI protected _handler
20              
21             our $VERSION = '1.4.1';
22              
23             ## @cmethod Lemonldap::NG::Handler::CGI new(hashRef args)
24             # Constructor.
25             # @param $args hash passed to Lemonldap::NG::Handler::_CGI object
26             # @return new object
27             sub new {
28             my $class = shift;
29             my $self = $class->SUPER::new() or $class->abort("Unable to build CGI");
30             $Lemonldap::NG::Handler::_CGI::_cgi = $self;
31             unless ( $Lemonldap::NG::Handler::_CGI::tsv->{cookieName} ) {
32             Lemonldap::NG::Handler::_CGI->init(@_);
33              
34             #Lemonldap::NG::Handler::_CGI->initLocalStorage(@_); # already called by _CGI->init()
35             }
36             unless ( eval { Lemonldap::NG::Handler::_CGI->testConf() } == OK ) {
37             if ( $_[0]->{noAbort} ) {
38             $self->{_noConf} = $@;
39             }
40             else {
41             $class->abort( "Unable to get configuration", $@ );
42             }
43             }
44              
45             # Arguments
46             my @args = splice @_;
47             if ( ref( $args[0] ) ) {
48             %$self = ( %$self, %{ $args[0] } );
49             }
50             else {
51             %$self = ( %$self, @args );
52             }
53              
54             # Protection
55             if ( $self->{protection} and $self->{protection} ne 'none' ) {
56             $self->authenticate();
57              
58             # ACCOUNTING
59             if ( $self->{protection} =~ /^manager$/i ) {
60             $self->authorize()
61             or $self->abort( 'Forbidden',
62             "You don't have rights to access this page" );
63             }
64             elsif ( $self->{protection} =~ /rule\s*:\s*(.*)\s*$/i ) {
65             my $rule = $1;
66             $rule =~ s/\$date/&POSIX::strftime("%Y%m%d%H%M%S",localtime())/e;
67             $rule =~ s/\$(\w+)/\$datas->{$1}/g;
68             $rule = 0 if ( $rule eq 'deny' );
69             my $r;
70              
71             unless ( $rule eq 'accept'
72             or Lemonldap::NG::Handler::_CGI->safe_reval($rule) )
73             {
74             $self->abort( 'Forbidden',
75             "You don't have rights to access this page" );
76             }
77             }
78             elsif ( $self->{protection} !~ /^authenticate$/i ) {
79             $self->abort(
80             'Bad configuration',
81             "The rule " . $self->{protection} . " is not known"
82             );
83             }
84             }
85             return $self;
86             }
87              
88             ## @method boolean authenticate()
89             # Checks if user session is valid.
90             # Checks Lemonldap::NG cookie and search session in sessions database.
91             # If nothing is found, redirects the user to the Lemonldap::NG portal.
92             # @return boolean : true if authentication is good. Exit before else
93             sub authenticate {
94             my $self = shift;
95             $self->abort(
96             "Can't authenticate because configuration has not been loaded",
97             $self->{_noConf} )
98             if ( $self->{_noConf} );
99             my %cookies = fetch CGI::Cookie;
100             my $id;
101             unless ($cookies{ $tsv->{cookieName} }
102             and $id = $cookies{ $tsv->{cookieName} }->value )
103             {
104             return $self->goToPortal();
105             }
106             unless ( $datas and $id eq $datas->{_session_id} ) {
107              
108             my $apacheSession = Lemonldap::NG::Common::Session->new(
109             {
110             storageModule => $tsv->{globalStorage},
111             storageModuleOptions => $tsv->{globalStorageOptions},
112             cacheModule => $tsv->{localSessionStorage},
113             cacheModuleOptions => $tsv->{localSessionStorageOptions},
114             id => $id,
115             kind => "SSO",
116             }
117             );
118              
119             if ( $apacheSession->error ) {
120             Lemonldap::NG::Handler::Main::Logger->lmLog(
121             "Session $id can't be retrieved", 'info' );
122             Lemonldap::NG::Handler::Main::Logger->lmLog( $apacheSession->error,
123             'info' );
124             return $self->goToPortal();
125             }
126              
127             $datas->{$_} = $apacheSession->data->{$_}
128             foreach ( keys %{ $apacheSession->data } );
129             }
130              
131             # Accounting : set user in apache logs
132             $self->setApacheUser( $datas->{ $tsv->{whatToTrace} } );
133             $ENV{REMOTE_USER} = $datas->{ $tsv->{whatToTrace} };
134              
135             return 1;
136             }
137              
138             ## @method boolean authorize()
139             # Checks if user is authorized to access to the current request.
140             # Call Lemonldap::NG::Handler::_CGI::grant() function.
141             # @return boolean : true if user is granted
142             sub authorize {
143             my $self = shift;
144             return Lemonldap::NG::Handler::_CGI->grant( $ENV{REQUEST_URI} );
145             }
146              
147             ## @method int testUri(string uri)
148             # Checks if user is authorized to access to $uri.
149             # Call Lemonldap::NG::Handler::_CGI::grant() function.
150             # @param $uri URI or URL to test
151             # @return int : 1 if user is granted, -1 if virtual host has no configuration,
152             # 0 if user isn't granted
153             sub testUri {
154             my $self = shift;
155             $self->abort( "Can't test URI because configuration has not been loaded",
156             $self->{_noConf} )
157             if ( $self->{_noConf} );
158             my $uri = shift;
159             my $host =
160             ( $uri =~ s#^(?:https?://)?([^/]*)/#/# ) ? $1 : $ENV{SERVER_NAME};
161             return -1 unless ( Lemonldap::NG::Handler::_CGI->vhostAvailable($host) );
162             return Lemonldap::NG::Handler::_CGI->grant( $uri, $host );
163             }
164              
165             ## @method hashRef user()
166             # @return hash of user datas
167             sub user {
168             return $datas;
169             }
170              
171             ## @method boolean group(string group)
172             # @param $group name of the Lemonldap::NG group to test
173             # @return boolean : true if user is in this group
174             sub group {
175             my ( $self, $group ) = splice @_;
176             return ( $datas->{groups} =~ /\b$group\b/ );
177             }
178              
179             ## @method void goToPortal()
180             # Redirects the user to the portal and exit.
181             sub goToPortal {
182             my $self = shift;
183             my $tmp = encode_base64( $self->_uri, '' );
184             print CGI::redirect(
185             -uri => Lemonldap::NG::Handler::_CGI->portal() . "?url=$tmp" );
186             exit;
187             }
188              
189             ## @fn private string _uri()
190             # Builds current URL including "http://" and server name.
191             # @return URL_string
192             sub _uri {
193             my $vhost = $ENV{SERVER_NAME};
194             my $portString =
195             $tsv->{port}->{$vhost}
196             || $tsv->{port}->{_}
197             || $ENV{SERVER_PORT};
198             my $_https = (
199             defined( $tsv->{https}->{$vhost} )
200             ? $tsv->{https}->{$vhost}
201             : $tsv->{https}->{_}
202             );
203             $portString =
204             ( $_https && $portString == 443 ) ? ''
205             : ( !$_https && $portString == 80 ) ? ''
206             : ':' . $portString;
207             my $url = "http"
208             . ( $_https ? "s" : "" ) . "://"
209             . $vhost
210             . $portString
211             . $ENV{REQUEST_URI};
212             return $url;
213             }
214              
215             ## @class
216             # Private class used by Lemonldap::NG::Handler::CGI for his internal handler.
217             package Lemonldap::NG::Handler::_CGI;
218              
219             use strict;
220              
221             #use Lemonldap::NG::Handler::SharedConf qw(:locationRules :localStorage :traces);
222             use Lemonldap::NG::Handler::SharedConf qw(:tsv :ntsv :jailSharedVars);
223             use Lemonldap::NG::Handler::Main::Jail;
224              
225             use base qw(Lemonldap::NG::Handler::SharedConf);
226              
227             our $_cgi;
228              
229             sub safe_reval {
230             my $class = shift;
231             my $rule = shift;
232              
233             my $jail = Lemonldap::NG::Handler::Main::Jail->new(
234             'safe' => $ntsv->{safe},
235             'useSafeJail' => $tsv->{useSafeJail},
236             'customFunctions' => $tsv->{customFunctions}
237             );
238             $ntsv->{safe} = $jail->build_safe();
239              
240             return $ntsv->{safe}->reval($rule);
241             }
242              
243             ## @method boolean childInit()
244             # Since this is not a real Apache handler, childs have not to be initialized.
245             # @return true
246             sub childInit { 1 }
247              
248             ## @method boolean purgeCache()
249             # Since this is not a real Apache handler, it must not purge the cache at starting.
250             # @return true
251             sub purgeCache { 1 }
252              
253             ## @method void lmLog(string message,string level)
254             # Replace lmLog by "print STDERR $message".
255             # @param $message Message to log
256             # @param $level error level (debug, info, warning or error)
257             sub lmLog {
258             my $class = shift;
259             $_cgi->lmLog(@_);
260             }
261              
262             ## @method boolean vhostAvailable(string vhost)
263             # Checks if $vhost has been declared in configuration
264             # @param $vhost Virtual Host to test
265             # @return boolean : true if $vhost is available
266             sub vhostAvailable {
267             my ( $self, $vhost ) = splice @_;
268             return defined( $tsv->{defaultCondition}->{$vhost} );
269             }
270              
271             ## @method boolean grant(string uri, string vhost)
272             # Return true if user is granted to access.
273             # @param $uri URI string
274             # @param $vhost Optional virtual host (default current virtual host)
275             sub grant {
276             my ( $self, $uri, $vhost ) = splice @_;
277             $vhost ||= $ENV{SERVER_NAME};
278             $apacheRequest = Lemonldap::NG::Apache::Request->new(
279             {
280             uri => $uri,
281             hostname => $vhost,
282             args => '',
283             }
284             );
285             for ( my $i = 0 ; $i < $tsv->{locationCount}->{$vhost} ; $i++ ) {
286             if ( $uri =~ $tsv->{locationRegexp}->{$vhost}->[$i] ) {
287             return &{ $tsv->{locationCondition}->{$vhost}->[$i] }($datas);
288             }
289             }
290             unless ( $tsv->{defaultCondition}->{$vhost} ) {
291             $self->lmLog(
292             "User rejected because VirtualHost \"$vhost\" has no configuration",
293             'warn'
294             );
295             return 0;
296             }
297             return &{ $tsv->{defaultCondition}->{$vhost} }($datas);
298             }
299              
300             package Lemonldap::NG::Apache::Request;
301              
302             sub new {
303             my $class = shift;
304             my $self = shift;
305             return bless $self, $class;
306             }
307              
308             sub hostname {
309             return $_[0]->{hostname};
310             }
311              
312             sub uri {
313             return $_[0]->{uri};
314             }
315              
316             sub args {
317             return $_[0]->{args};
318             }
319              
320             1;
321             __END__