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