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.2 2010-12-27 08:40:19 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
48 my $path_info = $q->url(-path => 1);
50 # quickly give plaintext file contents
52 my $pos = index( $path_info, $Torrus::Renderer::plainURL );
55 my $fname = $Torrus::Global::webPlainDir . '/' .
57 $pos + length($Torrus::Renderer::plainURL) );
62 if( $path_info =~ /\.css$/o )
73 my $fh = new IO::File( $fname );
76 print $q->header('-type' => $type,
81 while( $fh->read( $buffer, 65536 ) )
92 print $q->header(-status=>400),
93 $q->start_html('Error'),
95 $q->strong('Cannot retrieve file: ' . $fname);
102 my @paramNames = $q->param();
104 if( $q->param('DEBUG') and not $Torrus::Renderer::globalDebug )
106 &Torrus::Log::setLevel('debug');
110 foreach my $name ( @paramNames )
112 if( $name =~ /^[A-Z]/ and $name ne 'SESSION_ID' )
114 $options{'variables'}->{$name} = $q->param($name);
118 my( $fname, $mimetype, $expires );
121 my $renderer = new Torrus::Renderer();
122 if( not defined( $renderer ) )
124 return report_error($q, 'Error initializing Renderer');
127 my $tree = $path_info;
128 $tree =~ s/^.*\/(.*)$/$1/;
130 if( $Torrus::CGI::authorizeUsers )
132 $options{'acl'} = new Torrus::ACL;
134 my $hostauth = $q->param('hostauth');
135 if( defined( $hostauth ) )
137 my $uid = $q->remote_addr();
139 my $password = $uid . '//' . $hostauth;
141 Debug('Host-based authentication for ' . $uid);
143 if( not $options{'acl'}->authenticateUser( $uid, $password ) )
145 print $q->header(-status=>'403 Forbidden',
146 '-type' => 'text/plain');
147 print('Host-based authentication failed for ' . $uid);
148 Info('Host-based authentication failed for ' . $uid);
152 Info('Host authenticated: ' . $uid);
153 $options{'uid'} = $uid;
158 my $ses_id = $q->cookie('SESSION_ID');
160 my $needs_new_session = 1;
165 # create a session object based on the cookie we got from the
166 # browser, or a new session if we got no cookie
169 tie %session, 'Apache::Session::File', $ses_id, {
170 Directory => $Torrus::Global::sesStoreDir,
171 LockDirectory => $Torrus::Global::sesLockDir }
175 if( $options{'variables'}->{'LOGOUT'} )
177 tied( %session )->delete();
181 $needs_new_session = 0;
186 if( $needs_new_session )
188 tie %session, 'Apache::Session::File', undef, {
189 Directory => $Torrus::Global::sesStoreDir,
190 LockDirectory => $Torrus::Global::sesLockDir };
193 # might be a new session, so lets give them their cookie back
195 my %cookie = (-name => 'SESSION_ID',
196 -value => $session{'_session_id'});
198 if( $session{'uid'} )
200 $options{'uid'} = $session{'uid'};
201 if( $session{'remember_login'} )
203 $cookie{'-expires'} = '+60d';
210 # POST form parameters
212 my $uid = $q->param('uid');
213 my $password = $q->param('password');
214 if( defined( $uid ) and defined( $password ) )
216 if( $options{'acl'}->authenticateUser( $uid, $password ) )
218 $session{'uid'} = $options{'uid'} = $uid;
220 Info('User logged in: ' . $uid);
222 if( $q->param('remember') )
224 $cookie{'-expires'} = '+60d';
225 $session{'remember_login'} = 1;
230 $options{'authFailed'} = 1;
236 $options{'urlPassTree'} = $tree;
237 foreach my $param ( 'token', 'path', 'nodeid',
240 my $val = $q->param( $param );
241 if( defined( $val ) and length( $val ) > 0 )
243 $options{'urlPassParams'}{$param} = $val;
247 ( $fname, $mimetype, $expires ) =
248 $renderer->renderUserLogin( %options );
250 die('renderUserLogin returned undef') unless $fname;
255 push(@cookies, $q->cookie(%cookie));
261 if( not $tree or not Torrus::SiteConfig::treeExists( $tree ) )
263 ( $fname, $mimetype, $expires ) =
264 $renderer->renderTreeChooser( %options );
268 if( $Torrus::CGI::authorizeUsers and
269 not $options{'acl'}->hasPrivilege( $options{'uid'}, $tree,
272 return report_error($q, 'Permission denied');
275 if( $Torrus::Renderer::displayReports and
276 defined( $q->param('htmlreport') ) )
278 if( $Torrus::CGI::authorizeUsers and
279 not $options{'acl'}->hasPrivilege( $options{'uid'}, $tree,
282 return report_error($q, 'Permission denied');
285 my $reportfname = $q->param('htmlreport');
286 # strip off leading slashes for security
287 $reportfname =~ s/^.*\///o;
289 $fname = $Torrus::Global::reportsDir . '/' . $tree .
290 '/html/' . $reportfname;
293 return report_error($q, 'No such file: ' . $reportfname);
296 $mimetype = 'text/html';
301 my $config_tree = new Torrus::ConfigTree( -TreeName => $tree );
302 if( not defined($config_tree) )
304 return report_error($q, 'Configuration is not ready');
307 my $token = $q->param('token');
308 if( not defined($token) )
310 my $path = $q->param('path');
311 if( not defined($path) )
313 my $nodeid = $q->param('nodeid');
314 if( defined($nodeid) )
316 $token = $config_tree->getNodeByNodeid( $nodeid );
317 if( not defined($token) )
320 ($q, 'Cannot find nodeid:' . $nodeid);
325 $token = $config_tree->token('/');
330 $token = $config_tree->token($path);
331 if( not defined($token) )
333 return report_error($q, 'Invalid path');
337 elsif( $token !~ /^S/ and
338 not defined( $config_tree->path( $token ) ) )
340 return report_error($q, 'Invalid token');
343 my $view = $q->param('view');
344 if( not defined($view) )
346 $view = $q->param('v');
349 ( $fname, $mimetype, $expires ) =
350 $renderer->render( $config_tree, $token, $view, %options );
358 &Torrus::DB::cleanupEnvironment();
360 if( defined( $options{'acl'} ) )
362 undef $options{'acl'};
365 if( defined($fname) )
369 return report_error($q, 'No such file or directory: ' . $fname);
372 Debug("Render returned $fname $mimetype $expires");
374 my $fh = new IO::File( $fname );
377 print $q->header('-type' => $mimetype,
378 '-expires' => '+'.$expires.'s',
379 '-cookie' => \@cookies);
381 $fh->binmode(':raw');
383 while( $fh->read( $buffer, 65536 ) )
391 return report_error($q, 'Cannot open file ' . $fname . ': ' . $!);
396 return report_error($q, "Renderer returned error.\n" .
397 "Probably wrong directory permissions or " .
398 "directory missing:\n" .
399 $Torrus::Global::cacheDir);
402 if( not $Torrus::Renderer::globalDebug )
404 &Torrus::Log::setLevel('info');
414 print $q->header('-type' => 'text/plain',
415 '-expires' => 'now');
417 print('Error: ' . $msg);
425 # indent-tabs-mode: nil
426 # perl-indent-level: 4