src/lib/Torrus/PSGI.pm

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