1 # Copyright (C) 2010 Stanislav Sinyagin
3 # This program is free software; you can redistribute it and/or modify
4 # it under the terms of the GNU General Public License as published by
5 # the Free Software Foundation; either version 2 of the License, or
6 # (at your option) any later version.
8 # This program is distributed in the hope that it will be useful,
9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 # GNU General Public License for more details.
13 # You should have received a copy of the GNU General Public License
14 # along with this program; if not, write to the Free Software
15 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
17 # $Id: CGI.pm,v 1.1 2010-12-27 00:03:43 ivan Exp $
18 # Stanislav Sinyagin <ssinyagin@yahoo.com>
20 # Universal CGI handler for Apache mod_perl and FastCGI
28 # This modue is not a part of mod_perl
29 use Apache::Session::File;
34 use Torrus::SiteConfig;
37 ## Torrus::CGI->process($q)
38 ## Expects a CGI object as input
44 my $path_info = $q->url(-path => 1);
46 # quickly give plaintext file contents
48 my $pos = index( $path_info, $Torrus::Renderer::plainURL );
51 my $fname = $Torrus::Global::webPlainDir . '/' .
53 $pos + length($Torrus::Renderer::plainURL) );
58 if( $path_info =~ /\.css$/o )
69 my $fh = new IO::File( $fname );
72 print $q->header('-type' => $type,
77 while( $fh->read( $buffer, 65536 ) )
88 print $q->header(-status=>400),
89 $q->start_html('Error'),
91 $q->strong('Cannot retrieve file: ' . $fname);
98 my @paramNames = $q->param();
100 if( $q->param('DEBUG') and not $Torrus::Renderer::globalDebug )
102 &Torrus::Log::setLevel('debug');
106 foreach my $name ( @paramNames )
108 if( $name =~ /^[A-Z]/ and $name ne 'SESSION_ID' )
110 $options{'variables'}->{$name} = $q->param($name);
114 my( $fname, $mimetype, $expires );
117 my $renderer = new Torrus::Renderer();
118 if( not defined( $renderer ) )
120 return report_error($q, 'Error initializing Renderer');
123 my $tree = $path_info;
124 $tree =~ s/^.*\/(.*)$/$1/;
126 if( $Torrus::CGI::authorizeUsers )
128 $options{'acl'} = new Torrus::ACL;
130 my $hostauth = $q->param('hostauth');
131 if( defined( $hostauth ) )
133 my $uid = $q->remote_addr();
135 my $password = $uid . '//' . $hostauth;
137 Debug('Host-based authentication for ' . $uid);
139 if( not $options{'acl'}->authenticateUser( $uid, $password ) )
141 print $q->header(-status=>'403 Forbidden',
142 '-type' => 'text/plain');
143 print('Host-based authentication failed for ' . $uid);
144 Info('Host-based authentication failed for ' . $uid);
148 Info('Host authenticated: ' . $uid);
149 $options{'uid'} = $uid;
154 my $ses_id = $q->cookie('SESSION_ID');
156 my $needs_new_session = 1;
161 # create a session object based on the cookie we got from the
162 # browser, or a new session if we got no cookie
165 tie %session, 'Apache::Session::File', $ses_id, {
166 Directory => $Torrus::Global::sesStoreDir,
167 LockDirectory => $Torrus::Global::sesLockDir }
171 if( $options{'variables'}->{'LOGOUT'} )
173 tied( %session )->delete();
177 $needs_new_session = 0;
182 if( $needs_new_session )
184 tie %session, 'Apache::Session::File', undef, {
185 Directory => $Torrus::Global::sesStoreDir,
186 LockDirectory => $Torrus::Global::sesLockDir };
189 # might be a new session, so lets give them their cookie back
191 my %cookie = (-name => 'SESSION_ID',
192 -value => $session{'_session_id'});
194 if( $session{'uid'} )
196 $options{'uid'} = $session{'uid'};
197 if( $session{'remember_login'} )
199 $cookie{'-expires'} = '+60d';
206 # POST form parameters
208 my $uid = $q->param('uid');
209 my $password = $q->param('password');
210 if( defined( $uid ) and defined( $password ) )
212 if( $options{'acl'}->authenticateUser( $uid, $password ) )
214 $session{'uid'} = $options{'uid'} = $uid;
216 Info('User logged in: ' . $uid);
218 if( $q->param('remember') )
220 $cookie{'-expires'} = '+60d';
221 $session{'remember_login'} = 1;
226 $options{'authFailed'} = 1;
232 $options{'urlPassTree'} = $tree;
233 foreach my $param ( 'token', 'path', 'nodeid',
236 my $val = $q->param( $param );
237 if( defined( $val ) and length( $val ) > 0 )
239 $options{'urlPassParams'}{$param} = $val;
243 ( $fname, $mimetype, $expires ) =
244 $renderer->renderUserLogin( %options );
246 die('renderUserLogin returned undef') unless $fname;
251 push(@cookies, $q->cookie(%cookie));
257 if( not $tree or not Torrus::SiteConfig::treeExists( $tree ) )
259 ( $fname, $mimetype, $expires ) =
260 $renderer->renderTreeChooser( %options );
264 if( $Torrus::CGI::authorizeUsers and
265 not $options{'acl'}->hasPrivilege( $options{'uid'}, $tree,
268 return report_error($q, 'Permission denied');
271 if( $Torrus::Renderer::displayReports and
272 defined( $q->param('htmlreport') ) )
274 if( $Torrus::CGI::authorizeUsers and
275 not $options{'acl'}->hasPrivilege( $options{'uid'}, $tree,
278 return report_error($q, 'Permission denied');
281 my $reportfname = $q->param('htmlreport');
282 # strip off leading slashes for security
283 $reportfname =~ s/^.*\///o;
285 $fname = $Torrus::Global::reportsDir . '/' . $tree .
286 '/html/' . $reportfname;
289 return report_error($q, 'No such file: ' . $reportfname);
292 $mimetype = 'text/html';
297 my $config_tree = new Torrus::ConfigTree( -TreeName => $tree );
298 if( not defined($config_tree) )
300 return report_error($q, 'Configuration is not ready');
303 my $token = $q->param('token');
304 if( not defined($token) )
306 my $path = $q->param('path');
307 if( not defined($path) )
309 my $nodeid = $q->param('nodeid');
310 if( defined($nodeid) )
312 $token = $config_tree->getNodeByNodeid( $nodeid );
313 if( not defined($token) )
316 ($q, 'Cannot find nodeid:' . $nodeid);
321 $token = $config_tree->token('/');
326 $token = $config_tree->token($path);
327 if( not defined($token) )
329 return report_error($q, 'Invalid path');
333 elsif( $token !~ /^S/ and
334 not defined( $config_tree->path( $token ) ) )
336 return report_error($q, 'Invalid token');
339 my $view = $q->param('view');
340 if( not defined($view) )
342 $view = $q->param('v');
345 ( $fname, $mimetype, $expires ) =
346 $renderer->render( $config_tree, $token, $view, %options );
354 &Torrus::DB::cleanupEnvironment();
356 if( defined( $options{'acl'} ) )
358 undef $options{'acl'};
361 if( defined($fname) )
365 return report_error($q, 'No such file or directory: ' . $fname);
368 Debug("Render returned $fname $mimetype $expires");
370 my $fh = new IO::File( $fname );
373 print $q->header('-type' => $mimetype,
374 '-expires' => '+'.$expires.'s',
375 '-cookie' => \@cookies);
377 $fh->binmode(':raw');
379 while( $fh->read( $buffer, 65536 ) )
387 return report_error($q, 'Cannot open file ' . $fname . ': ' . $!);
392 return report_error($q, "Renderer returned error.\n" .
393 "Probably wrong directory permissions or " .
394 "directory missing:\n" .
395 $Torrus::Global::cacheDir);
398 if( not $Torrus::Renderer::globalDebug )
400 &Torrus::Log::setLevel('info');
410 print $q->header('-type' => 'text/plain',
411 '-expires' => 'now');
413 print('Error: ' . $msg);
421 # indent-tabs-mode: nil
422 # perl-indent-level: 4