diff options
Diffstat (limited to 'torrus/perllib/Torrus/CGI.pm')
-rw-r--r-- | torrus/perllib/Torrus/CGI.pm | 423 |
1 files changed, 423 insertions, 0 deletions
diff --git a/torrus/perllib/Torrus/CGI.pm b/torrus/perllib/Torrus/CGI.pm new file mode 100644 index 000000000..574e87252 --- /dev/null +++ b/torrus/perllib/Torrus/CGI.pm @@ -0,0 +1,423 @@ +# Copyright (C) 2010 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: CGI.pm,v 1.1 2010-12-27 00:03:43 ivan Exp $ +# Stanislav Sinyagin <ssinyagin@yahoo.com> + +# Universal CGI handler for Apache mod_perl and FastCGI + +package Torrus::CGI; + +use strict; +use CGI; +use IO::File; + +# This modue is not a part of mod_perl +use Apache::Session::File; + + +use Torrus::Log; +use Torrus::Renderer; +use Torrus::SiteConfig; +use Torrus::ACL; + +## Torrus::CGI->process($q) +## Expects a CGI object as input + +sub process +{ + my($class, $q) = @_; + + my $path_info = $q->url(-path => 1); + + # quickly give plaintext file contents + { + my $pos = index( $path_info, $Torrus::Renderer::plainURL ); + if( $pos >= 0 ) + { + my $fname = $Torrus::Global::webPlainDir . '/' . + substr( $path_info, + $pos + length($Torrus::Renderer::plainURL) ); + + my $ok = 0; + + my $type; + if( $path_info =~ /\.css$/o ) + { + $type = 'text/css'; + } + else + { + $type = 'text/html'; + } + + if( -r $fname ) + { + my $fh = new IO::File( $fname ); + if( defined( $fh ) ) + { + print $q->header('-type' => $type, + '-expires' => '+1h'); + + $fh->binmode(':raw'); + my $buffer; + while( $fh->read( $buffer, 65536 ) ) + { + print( $buffer ); + } + $fh->close(); + $ok = 1; + } + } + + if( not $ok ) + { + print $q->header(-status=>400), + $q->start_html('Error'), + $q->h2('Error'), + $q->strong('Cannot retrieve file: ' . $fname); + } + + return; + } + } + + my @paramNames = $q->param(); + + if( $q->param('DEBUG') and not $Torrus::Renderer::globalDebug ) + { + &Torrus::Log::setLevel('debug'); + } + + my %options = (); + foreach my $name ( @paramNames ) + { + if( $name =~ /^[A-Z]/ and $name ne 'SESSION_ID' ) + { + $options{'variables'}->{$name} = $q->param($name); + } + } + + my( $fname, $mimetype, $expires ); + my @cookies; + + my $renderer = new Torrus::Renderer(); + if( not defined( $renderer ) ) + { + return report_error($q, 'Error initializing Renderer'); + } + + my $tree = $path_info; + $tree =~ s/^.*\/(.*)$/$1/; + + if( $Torrus::CGI::authorizeUsers ) + { + $options{'acl'} = new Torrus::ACL; + + my $hostauth = $q->param('hostauth'); + if( defined( $hostauth ) ) + { + my $uid = $q->remote_addr(); + $uid =~ s/\W/_/go; + my $password = $uid . '//' . $hostauth; + + Debug('Host-based authentication for ' . $uid); + + if( not $options{'acl'}->authenticateUser( $uid, $password ) ) + { + print $q->header(-status=>'403 Forbidden', + '-type' => 'text/plain'); + print('Host-based authentication failed for ' . $uid); + Info('Host-based authentication failed for ' . $uid); + return; + } + + Info('Host authenticated: ' . $uid); + $options{'uid'} = $uid; + } + else + { + + my $ses_id = $q->cookie('SESSION_ID'); + + my $needs_new_session = 1; + my %session; + + if( $ses_id ) + { + # create a session object based on the cookie we got from the + # browser, or a new session if we got no cookie + eval + { + tie %session, 'Apache::Session::File', $ses_id, { + Directory => $Torrus::Global::sesStoreDir, + LockDirectory => $Torrus::Global::sesLockDir } + }; + if( not $@ ) + { + if( $options{'variables'}->{'LOGOUT'} ) + { + tied( %session )->delete(); + } + else + { + $needs_new_session = 0; + } + } + } + + if( $needs_new_session ) + { + tie %session, 'Apache::Session::File', undef, { + Directory => $Torrus::Global::sesStoreDir, + LockDirectory => $Torrus::Global::sesLockDir }; + } + + # might be a new session, so lets give them their cookie back + + my %cookie = (-name => 'SESSION_ID', + -value => $session{'_session_id'}); + + if( $session{'uid'} ) + { + $options{'uid'} = $session{'uid'}; + if( $session{'remember_login'} ) + { + $cookie{'-expires'} = '+60d'; + } + } + else + { + my $needsLogin = 1; + + # POST form parameters + + my $uid = $q->param('uid'); + my $password = $q->param('password'); + if( defined( $uid ) and defined( $password ) ) + { + if( $options{'acl'}->authenticateUser( $uid, $password ) ) + { + $session{'uid'} = $options{'uid'} = $uid; + $needsLogin = 0; + Info('User logged in: ' . $uid); + + if( $q->param('remember') ) + { + $cookie{'-expires'} = '+60d'; + $session{'remember_login'} = 1; + } + } + else + { + $options{'authFailed'} = 1; + } + } + + if( $needsLogin ) + { + $options{'urlPassTree'} = $tree; + foreach my $param ( 'token', 'path', 'nodeid', + 'view', 'v' ) + { + my $val = $q->param( $param ); + if( defined( $val ) and length( $val ) > 0 ) + { + $options{'urlPassParams'}{$param} = $val; + } + } + + ( $fname, $mimetype, $expires ) = + $renderer->renderUserLogin( %options ); + + die('renderUserLogin returned undef') unless $fname; + } + } + untie %session; + + push(@cookies, $q->cookie(%cookie)); + } + } + + if( not $fname ) + { + if( not $tree or not Torrus::SiteConfig::treeExists( $tree ) ) + { + ( $fname, $mimetype, $expires ) = + $renderer->renderTreeChooser( %options ); + } + else + { + if( $Torrus::CGI::authorizeUsers and + not $options{'acl'}->hasPrivilege( $options{'uid'}, $tree, + 'DisplayTree' ) ) + { + return report_error($q, 'Permission denied'); + } + + if( $Torrus::Renderer::displayReports and + defined( $q->param('htmlreport') ) ) + { + if( $Torrus::CGI::authorizeUsers and + not $options{'acl'}->hasPrivilege( $options{'uid'}, $tree, + 'DisplayReports' ) ) + { + return report_error($q, 'Permission denied'); + } + + my $reportfname = $q->param('htmlreport'); + # strip off leading slashes for security + $reportfname =~ s/^.*\///o; + + $fname = $Torrus::Global::reportsDir . '/' . $tree . + '/html/' . $reportfname; + if( not -f $fname ) + { + return report_error($q, 'No such file: ' . $reportfname); + } + + $mimetype = 'text/html'; + $expires = '3600'; + } + else + { + my $config_tree = new Torrus::ConfigTree( -TreeName => $tree ); + if( not defined($config_tree) ) + { + return report_error($q, 'Configuration is not ready'); + } + + my $token = $q->param('token'); + if( not defined($token) ) + { + my $path = $q->param('path'); + if( not defined($path) ) + { + my $nodeid = $q->param('nodeid'); + if( defined($nodeid) ) + { + $token = $config_tree->getNodeByNodeid( $nodeid ); + if( not defined($token) ) + { + return report_error + ($q, 'Cannot find nodeid:' . $nodeid); + } + } + else + { + $token = $config_tree->token('/'); + } + } + else + { + $token = $config_tree->token($path); + if( not defined($token) ) + { + return report_error($q, 'Invalid path'); + } + } + } + elsif( $token !~ /^S/ and + not defined( $config_tree->path( $token ) ) ) + { + return report_error($q, 'Invalid token'); + } + + my $view = $q->param('view'); + if( not defined($view) ) + { + $view = $q->param('v'); + } + + ( $fname, $mimetype, $expires ) = + $renderer->render( $config_tree, $token, $view, %options ); + + undef $config_tree; + } + } + } + + undef $renderer; + &Torrus::DB::cleanupEnvironment(); + + if( defined( $options{'acl'} ) ) + { + undef $options{'acl'}; + } + + if( defined($fname) ) + { + if( not -e $fname ) + { + return report_error($q, 'No such file or directory: ' . $fname); + } + + Debug("Render returned $fname $mimetype $expires"); + + my $fh = new IO::File( $fname ); + if( defined( $fh ) ) + { + print $q->header('-type' => $mimetype, + '-expires' => '+'.$expires.'s', + '-cookie' => \@cookies); + + $fh->binmode(':raw'); + my $buffer; + while( $fh->read( $buffer, 65536 ) ) + { + print( $buffer ); + } + $fh->close(); + } + else + { + return report_error($q, 'Cannot open file ' . $fname . ': ' . $!); + } + } + else + { + return report_error($q, "Renderer returned error.\n" . + "Probably wrong directory permissions or " . + "directory missing:\n" . + $Torrus::Global::cacheDir); + } + + if( not $Torrus::Renderer::globalDebug ) + { + &Torrus::Log::setLevel('info'); + } +} + + +sub report_error +{ + my $q = shift; + my $msg = shift; + + print $q->header('-type' => 'text/plain', + '-expires' => 'now'); + + print('Error: ' . $msg); +} + + +1; + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: |