torrus/perllib/Torrus/CGI.pm

   1 #  Copyright (C) 2010  Stanislav Sinyagin
   2 #
   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.
   7 #
   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.
  12 #
  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.
  16
  17 # $Id: CGI.pm,v 1.2 2010-12-27 08:40:19 ivan Exp $
  18 # Stanislav Sinyagin <ssinyagin@yahoo.com>
  19
  20 # Universal CGI handler for Apache mod_perl and FastCGI
  21
  22 package Torrus::CGI;
  23
  24 use strict;
  25 use CGI;
  26 use IO::File;
  27
  28 # This modue is not a part of mod_perl
  29 use Apache::Session::File;
  30
  31
  32 use Torrus::Log;
  33 use Torrus::Renderer;
  34 use Torrus::SiteConfig;
  35 use Torrus::ACL;
  36
  37 ## Torrus::CGI->process($q)
  38 ## Expects a CGI object as input
  39
  40 our $q;
  41
  42 sub process
  43 {
  44     #my($class, $q) = @_;
  45     my $class = shift;
  46     $q = shift;
  47
  48     my $path_info = $q->url(-path => 1);
  49
  50     # quickly give plaintext file contents
  51     {
  52         my $pos = index( $path_info, $Torrus::Renderer::plainURL );
  53         if( $pos >= 0 )
  54         {
  55             my $fname = $Torrus::Global::webPlainDir . '/' .
  56                 substr( $path_info,
  57                         $pos + length($Torrus::Renderer::plainURL) );
  58
  59             my $ok = 0;
  60
  61             my $type;
  62             if( $path_info =~ /\.css$/o )
  63             {
  64                 $type = 'text/css';
  65             }
  66             else
  67             {
  68                 $type = 'text/html';
  69             }
  70
  71             if( -r $fname )
  72             {
  73                 my $fh = new IO::File( $fname );
  74                 if( defined( $fh ) )
  75                 {
  76                     print $q->header('-type' => $type,
  77                                      '-expires' => '+1h');
  78
  79                     $fh->binmode(':raw');
  80                     my $buffer;
  81                     while( $fh->read( $buffer, 65536 ) )
  82                     {
  83                         print( $buffer );
  84                     }
  85                     $fh->close();
  86                     $ok = 1;
  87                 }
  88             }
  89
  90             if( not $ok )
  91             {
  92                 print $q->header(-status=>400),
  93                 $q->start_html('Error'),
  94                 $q->h2('Error'),
  95                 $q->strong('Cannot retrieve file: ' . $fname);
  96             }
  97
  98             return;
  99         }
 100     }
 101
 102     my @paramNames = $q->param();
 103
 104     if( $q->param('DEBUG') and not $Torrus::Renderer::globalDebug )
 105     {
 106         &Torrus::Log::setLevel('debug');
 107     }
 108
 109     my %options = ();
 110     foreach my $name ( @paramNames )
 111     {
 112         if( $name =~ /^[A-Z]/ and $name ne 'SESSION_ID' )
 113         {
 114             $options{'variables'}->{$name} = $q->param($name);
 115         }
 116     }
 117
 118     my( $fname, $mimetype, $expires );
 119     my @cookies;
 120
 121     my $renderer = new Torrus::Renderer();
 122     if( not defined( $renderer ) )
 123     {
 124         return report_error($q, 'Error initializing Renderer');
 125     }
 126
 127     my $tree = $path_info;
 128     $tree =~ s/^.*\/(.*)$/$1/;
 129
 130     if( $Torrus::CGI::authorizeUsers )
 131     {
 132         $options{'acl'} = new Torrus::ACL;
 133
 134         my $hostauth = $q->param('hostauth');
 135         if( defined( $hostauth ) )
 136         {
 137             my $uid = $q->remote_addr();
 138             $uid =~ s/\W/_/go;
 139             my $password = $uid . '//' . $hostauth;
 140
 141             Debug('Host-based authentication for ' . $uid);
 142
 143             if( not $options{'acl'}->authenticateUser( $uid, $password ) )
 144             {
 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);
 149                 return;
 150             }
 151
 152             Info('Host authenticated: ' . $uid);
 153             $options{'uid'} = $uid;
 154         }
 155         else
 156         {
 157
 158             my $ses_id = $q->cookie('SESSION_ID');
 159
 160             my $needs_new_session = 1;
 161             my %session;
 162
 163             if( $ses_id )
 164             {
 165                 # create a session object based on the cookie we got from the
 166                 # browser, or a new session if we got no cookie
 167                 eval
 168                 {
 169                     tie %session, 'Apache::Session::File', $ses_id, {
 170                         Directory     => $Torrus::Global::sesStoreDir,
 171                         LockDirectory => $Torrus::Global::sesLockDir }
 172                 };
 173                 if( not $@ )
 174                 {
 175                     if( $options{'variables'}->{'LOGOUT'} )
 176                     {
 177                         tied( %session )->delete();
 178                     }
 179                     else
 180                     {
 181                         $needs_new_session = 0;
 182                     }
 183                 }
 184             }
 185
 186             if( $needs_new_session )
 187             {
 188                 tie %session, 'Apache::Session::File', undef, {
 189                     Directory     => $Torrus::Global::sesStoreDir,
 190                     LockDirectory => $Torrus::Global::sesLockDir };
 191             }
 192
 193             # might be a new session, so lets give them their cookie back
 194
 195             my %cookie = (-name  => 'SESSION_ID',
 196                           -value => $session{'_session_id'});
 197
 198             if( $session{'uid'} )
 199             {
 200                 $options{'uid'} = $session{'uid'};
 201                 if( $session{'remember_login'} )
 202                 {
 203                     $cookie{'-expires'} = '+60d';
 204                 }
 205             }
 206             else
 207             {
 208                 my $needsLogin = 1;
 209
 210                 # POST form parameters
 211
 212                 my $uid = $q->param('uid');
 213                 my $password = $q->param('password');
 214                 if( defined( $uid ) and defined( $password ) )
 215                 {
 216                     if( $options{'acl'}->authenticateUser( $uid, $password ) )
 217                     {
 218                         $session{'uid'} = $options{'uid'} = $uid;
 219                         $needsLogin = 0;
 220                         Info('User logged in: ' . $uid);
 221
 222                         if( $q->param('remember') )
 223                         {
 224                             $cookie{'-expires'} = '+60d';
 225                             $session{'remember_login'} = 1;
 226                         }
 227                     }
 228                     else
 229                     {
 230                         $options{'authFailed'} = 1;
 231                     }
 232                 }
 233
 234                 if( $needsLogin )
 235                 {
 236                     $options{'urlPassTree'} = $tree;
 237                     foreach my $param ( 'token', 'path', 'nodeid',
 238                                         'view', 'v' )
 239                     {
 240                         my $val = $q->param( $param );
 241                         if( defined( $val ) and length( $val ) > 0 )
 242                         {
 243                             $options{'urlPassParams'}{$param} = $val;
 244                         }
 245                     }
 246
 247                     ( $fname, $mimetype, $expires ) =
 248                         $renderer->renderUserLogin( %options );
 249
 250                     die('renderUserLogin returned undef') unless $fname;
 251                 }
 252             }
 253             untie %session;
 254
 255             push(@cookies, $q->cookie(%cookie));
 256         }
 257     }
 258
 259     if( not $fname )
 260     {
 261         if( not $tree or not Torrus::SiteConfig::treeExists( $tree ) )
 262         {
 263             ( $fname, $mimetype, $expires ) =
 264                 $renderer->renderTreeChooser( %options );
 265         }
 266         else
 267         {
 268             if( $Torrus::CGI::authorizeUsers and
 269                 not $options{'acl'}->hasPrivilege( $options{'uid'}, $tree,
 270                                                    'DisplayTree' ) )
 271             {
 272                 return report_error($q, 'Permission denied');
 273             }
 274
 275             if( $Torrus::Renderer::displayReports and
 276                 defined( $q->param('htmlreport') ) )
 277             {
 278                 if( $Torrus::CGI::authorizeUsers and
 279                     not $options{'acl'}->hasPrivilege( $options{'uid'}, $tree,
 280                                                        'DisplayReports' ) )
 281                 {
 282                     return report_error($q, 'Permission denied');
 283                 }
 284
 285                 my $reportfname = $q->param('htmlreport');
 286                 # strip off leading slashes for security
 287                 $reportfname =~ s/^.*\///o;
 288
 289                 $fname = $Torrus::Global::reportsDir . '/' . $tree .
 290                     '/html/' . $reportfname;
 291                 if( not -f $fname )
 292                 {
 293                     return report_error($q, 'No such file: ' . $reportfname);
 294                 }
 295
 296                 $mimetype = 'text/html';
 297                 $expires = '3600';
 298             }
 299             else
 300             {
 301                 my $config_tree = new Torrus::ConfigTree( -TreeName => $tree );
 302                 if( not defined($config_tree) )
 303                 {
 304                     return report_error($q, 'Configuration is not ready');
 305                 }
 306
 307                 my $token = $q->param('token');
 308                 if( not defined($token) )
 309                 {
 310                     my $path = $q->param('path');
 311                     if( not defined($path) )
 312                     {
 313                         my $nodeid = $q->param('nodeid');
 314                         if( defined($nodeid) )
 315                         {
 316                             $token = $config_tree->getNodeByNodeid( $nodeid );
 317                             if( not defined($token) )
 318                             {
 319                                 return report_error
 320                                     ($q, 'Cannot find nodeid:' . $nodeid);
 321                             }
 322                         }
 323                         else
 324                         {
 325                             $token = $config_tree->token('/');
 326                         }
 327                     }
 328                     else
 329                     {
 330                         $token = $config_tree->token($path);
 331                         if( not defined($token) )
 332                         {
 333                             return report_error($q, 'Invalid path');
 334                         }
 335                     }
 336                 }
 337                 elsif( $token !~ /^S/ and
 338                        not defined( $config_tree->path( $token ) ) )
 339                 {
 340                     return report_error($q, 'Invalid token');
 341                 }
 342
 343                 my $view = $q->param('view');
 344                 if( not defined($view) )
 345                 {
 346                     $view = $q->param('v');
 347                 }
 348
 349                 ( $fname, $mimetype, $expires ) =
 350                     $renderer->render( $config_tree, $token, $view, %options );
 351
 352                 undef $config_tree;
 353             }
 354         }
 355     }
 356
 357     undef $renderer;
 358     &Torrus::DB::cleanupEnvironment();
 359
 360     if( defined( $options{'acl'} ) )
 361     {
 362         undef $options{'acl'};
 363     }
 364
 365     if( defined($fname) )
 366     {
 367         if( not -e $fname )
 368         {
 369             return report_error($q, 'No such file or directory: ' . $fname);
 370         }
 371
 372         Debug("Render returned $fname $mimetype $expires");
 373
 374         my $fh = new IO::File( $fname );
 375         if( defined( $fh ) )
 376         {
 377             print $q->header('-type' => $mimetype,
 378                              '-expires' => '+'.$expires.'s',
 379                              '-cookie' => \@cookies);
 380
 381             $fh->binmode(':raw');
 382             my $buffer;
 383             while( $fh->read( $buffer, 65536 ) )
 384             {
 385                 print( $buffer );
 386             }
 387             $fh->close();
 388         }
 389         else
 390         {
 391             return report_error($q, 'Cannot open file ' . $fname . ': ' . $!);
 392         }
 393     }
 394     else
 395     {
 396         return report_error($q, "Renderer returned error.\n" .
 397                             "Probably wrong directory permissions or " .
 398                             "directory missing:\n" .
 399                             $Torrus::Global::cacheDir);
 400     }
 401
 402     if( not $Torrus::Renderer::globalDebug )
 403     {
 404         &Torrus::Log::setLevel('info');
 405     }
 406 }
 407
 408
 409 sub report_error
 410 {
 411     my $q = shift;
 412     my $msg = shift;
 413
 414     print $q->header('-type' => 'text/plain',
 415                      '-expires' => 'now');
 416
 417     print('Error: ' . $msg);
 418 }
 419
 420
 421 1;
 422
 423 # Local Variables:
 424 # mode: perl
 425 # indent-tabs-mode: nil
 426 # perl-indent-level: 4
 427 # End: