← Back to branch summary

~ubuntu-branches/ubuntu/wily/torrus/wily-proposed

« back to all changes in this revision

Viewing changes to perllib/Torrus/CGI.pm

  • Committer: Package Import Robot
  • Author(s): Marc Haber
  • Date: 2011-11-06 17:15:40 UTC
  • mto: (6.1.1 experimental) (1.3.1)
  • mto: This revision was merged to the branch mainline in revision 7.
  • Revision ID: package-import@ubuntu.com-20111106171540-myc0auwqqio8bmhl
Tags: upstream-2.01
Import upstream version 2.01

Show diffs side-by-side

added added

removed removed

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