From 140f06384fd4c678545bc3563a79189f7255969f Mon Sep 17 00:00:00 2001 From: Dean Hamstead Date: Tue, 10 Jan 2012 16:52:49 +1100 Subject: [PATCH] updates --- src/ChangeLog.dean | 3 + src/TODO | 4 ++ src/configs/torrus-config.pl | 1 - src/lib/Torrus/PSGI.pm | 108 ++++++++++++++------------------ src/lib/Torrus/Renderer/Cache.pm | 115 +++++++++-------------------------- src/lib/Torrus/Renderer/Frontpage.pm | 60 +++++++----------- 6 files changed, 101 insertions(+), 190 deletions(-) diff --git a/src/ChangeLog.dean b/src/ChangeLog.dean index eb74fd8..74eb85e 100644 --- a/src/ChangeLog.dean +++ b/src/ChangeLog.dean @@ -57,3 +57,6 @@ * ApacheHandler.pm, Apache2Handler.pm: gone, and good ridance. they both give mod_perl a bad name. * PowerNet.pm: dropped in favor of upstreams APC_PowerNet... free labor is nice * Zapped whitespace: Emacs sure loves to dump whitespace everywhere, find . -type f -exec sed -i 's/\s\s*$//' {} \; + * Renderer/Cache.pm: added, removed all the BDB cruft and replaced it with Cache::FastMmap. The API is also now sensible, and doesnt spill its guts all around the rest of the application. + * Renderer/Frontpage.pm: Uses the new Cache.pm module. Much less code, much more simple and maintainable :) + * All the fastcgi and mod_perl(1/2) cruft removed: Now uses plack instead, see Torrus::PSGI and Torrus.psgi diff --git a/src/TODO b/src/TODO index 23ff87d..d9063b1 100644 --- a/src/TODO +++ b/src/TODO @@ -1,2 +1,6 @@ Torrus to-do list +- Make authorisation sensible +- Fix up the sessions so they are in a shared cache, and using something more lite-weight +- Dont serve static files through perl - apache (etc) is very good at that, why not let it? +- use Module::Install diff --git a/src/configs/torrus-config.pl b/src/configs/torrus-config.pl index 20e0e2b..17fb297 100644 --- a/src/configs/torrus-config.pl +++ b/src/configs/torrus-config.pl @@ -30,7 +30,6 @@ $Torrus::Global::cfgSiteDir = '@siteconfdir@'; $Torrus::Global::pkgbindir = '@pkgbindir@'; $Torrus::Global::templateDirs = ['@tmpldir@', '@tmpluserdir@']; $Torrus::Global::stylingDir = '@styldir@'; -$Torrus::Global::cacheDir = '@cachedir@'; $Torrus::Global::pidDir = '@piddir@'; $Torrus::Global::logDir = '@logdir@'; $Torrus::Global::reportsDir = '@reportsdir@'; diff --git a/src/lib/Torrus/PSGI.pm b/src/lib/Torrus/PSGI.pm index 16c25cc..1a2af80 100644 --- a/src/lib/Torrus/PSGI.pm +++ b/src/lib/Torrus/PSGI.pm @@ -69,8 +69,8 @@ sub do_process if $name =~ m/^[A-Z]/; } - my( $fname, $mimetype, $expires ); - my @cookies; + my( $content, $mimetype, $expires ); + my %cookies; my $renderer = Torrus::Renderer->new(); if( not defined( $renderer ) ) @@ -80,13 +80,13 @@ sub do_process my $tree = _path_to_tree($q); - _determine_uid($q,\%options,\@cookies); + _determine_uid($q,\%options,\%cookies); - if( not $fname ) + if( not $content ) { if( not $tree or not Torrus::SiteConfig::treeExists( $tree ) ) { - ( $fname, $mimetype, $expires ) = + ( $content, $mimetype, $expires ) = $renderer->renderTreeChooser( %options ); } else @@ -101,25 +101,25 @@ sub do_process 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; - - return report_error($q, 'No such file: ' . $reportfname) - if not -f $fname; - - $mimetype = 'text/html'; - $expires = '3600'; +# 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; +# +# return report_error($q, 'No such file: ' . $reportfname) +# if not -f $fname; +# +# $mimetype = 'text/html'; +# $expires = '3600'; } else { @@ -165,7 +165,7 @@ sub do_process return report_error($q, 'Invalid view name: ' . $view) if( defined $view and not $config_tree->viewExists($view) ); - ( $fname, $mimetype, $expires ) = + ( $content, $mimetype, $expires ) = $renderer->render( $config_tree, $token, $view, %options ); undef $config_tree; @@ -180,48 +180,31 @@ sub do_process undef $options{'acl'}; } - if( defined($fname) ) + if( defined($content) ) { - if( not -e $fname ) - { - return report_error($q, 'No such file or directory: ' . $fname); - } - Debug("Render returned $fname $mimetype $expires"); + Debug("Render returned |$content| |$mimetype| |$expires|"); - my $fh = IO::File->new( $fname ); - if( defined( $fh ) ) - { - print $q->header('-type' => $mimetype, - '-expires' => '+'.$expires.'s', - '-cookie' => \@cookies); + my $res = Plack::Response->new(200,{'Content-type' => $mimetype, 'Expires' => $expires,}); + $res->cookies(%cookies); + $res->body($content); + return $res - $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); + "directory missing:\n" ) } - if( not $Torrus::Renderer::globalDebug ) - { - &Torrus::Log::setLevel('info'); - } +# if( not $Torrus::Renderer::globalDebug ) +# { +# &Torrus::Log::setLevel('info'); +# } + return; + } @@ -323,15 +306,16 @@ sub _determine_uid # might be a new session, so lets give them their cookie back - my %cookie = (-name => 'SESSION_ID', - -value => $session{'_session_id'}); + my %cookie = (name => 'SESSION_ID', + value => $session{'_session_id'}); + $cookies->{SESSION_ID} = \%cookie; if( $session{'uid'} ) { $options->{'uid'} = $session{'uid'}; if( $session{'remember_login'} ) { - $cookie{'-expires'} = '+60d'; + $cookie{'expires'} = time + 24 * 60 * 60 * 60; } } else @@ -352,7 +336,7 @@ sub _determine_uid if( $q->param('remember') ) { - $cookie{'-expires'} = '+60d'; + $cookie{'expires'} = time + 24 * 60 * 60 * 60; $session{'remember_login'} = 1; } } @@ -373,16 +357,14 @@ sub _determine_uid # if defined $val and $val ne '' # } # -# ( $fname, $mimetype, $expires ) = +# ( $content, $mimetype, $expires ) = # $renderer->renderUserLogin( %$options ); # -# die('renderUserLogin returned undef') unless $fname; +# die('renderUserLogin returned undef') unless $content; # } } untie %session; - push(@$cookies, $q->cookie(%cookie)); - } return $uid diff --git a/src/lib/Torrus/Renderer/Cache.pm b/src/lib/Torrus/Renderer/Cache.pm index 07349c7..7889e53 100644 --- a/src/lib/Torrus/Renderer/Cache.pm +++ b/src/lib/Torrus/Renderer/Cache.pm @@ -24,8 +24,8 @@ use strict; use warnings; use Digest::MD5 qw(md5_hex); -use File::Spec; -use IO::File; +use Cache::FastMmap; +use FreezeThaw qw(freeze thaw); use Torrus::DB; use Torrus::TimeStamp; @@ -39,27 +39,11 @@ sub new my $self = {}; bless $self, $class; - if( not defined $Torrus::Global::cacheDir ) - { - Error('$Torrus::Global::cacheDir must be defined'); - return - } - elsif( not -d $Torrus::Global::cacheDir ) - { - Error("No such directory: $Torrus::Global::cacheDir"); - return - } + $self->{store} = Cache::FastMmap->new( + expire_time => $Torrus::Renderer::cacheMaxAge || 60, + ); - $self->{'cachedir'} = $Torrus::Global::cacheDir; - $self->{'cachemaxage'} = $Torrus::Renderer::cacheMaxAge || 60; - - $self->{'db'} = Torrus::DB->new('render_cache', -WriteAccess => 1); - if( not defined( $self->{'db'} ) ) - { - die 'Failed to create render cache'; - } - - srand( time() * $$ ); + die 'Couldnt create cache object?' unless $self->{store}; return $self } @@ -104,25 +88,15 @@ sub getCache $keystring = $self->cacheKey($keystring,$options); - my $cacheval = $self->{db}->get( $keystring ); + my $cacheval = $self->{store}->get( $keystring ); if( defined($cacheval) ) { - my ($t_render, $t_expires, $filename, $mime_type) = split(':', $cacheval); - - my $cachefile = File::Spec->catfile($Torrus::Global::cacheDir,$filename); + my $o = thaw( $cacheval ); - if ($t_expires >= time() and -f $cachefile) { # if we delete the cache files we are ok + return @{$o}[qw(t_render t_expires content mime_type)] + if ($o->{t_expires} >= time()); - my $fh = IO::File->new($cachefile, '<'); - if( defined($fh) ) - { - my $content = <$fh>; - $fh->close(); - return ($t_render, $t_expires, $content, $mime_type) - } - - } # otherwise we go to the end and return nothing } @@ -132,7 +106,7 @@ sub getCache } -=head2 setCache($keystring, $t_render, $t_expires, $filename, $mime_type) +=head2 setCache($keystring, $options, $t_render, $t_expires, $filename, $mime_type) Sets a value in the cache based on the provided arguments @@ -150,74 +124,41 @@ sub setCache $keystring = $self->cacheKey($keystring,$options); - my $filename = $self->newCacheFileName($keystring); - - my $fh = IO::File->new($filename, '>') or return; - print $fh $content; - $fh->close(); - - $self->{db}->put( $keystring, - join(':', - ($t_render, $t_expires, $filename, $mime_type))); - return 1 -} + my $o = { + t_render => $t_render, + t_expires => $t_expires, + content => $content, + $mime_type => $mime_type, -sub checkAndClearCache -{ - my $self = shift; - my $config_tree = shift; + }; - my $tree = $config_tree->treeName(); + $self->{store}->set( $keystring, freeze($o) ); - my $ts = Torrus::TimeStamp->new(); - my $known_ts = $ts->get($tree . ':renderer_cache'); - my $actual_ts = $config_tree->getTimestamp($ts); - if( $actual_ts >= $known_ts or - time() >= $known_ts + $self->{'cachemaxage'} ) - { - $self->clearcache(); - $ts->setNow($tree . ':renderer_cache'); - } return 1 } +=head2 checkAndClearCache -sub clearcache -{ - my $self = shift; - - Debug('Clearing renderer cache'); - my $cursor = $self->{'db'}->cursor( -Write => 1 ); - sleep(1); - while( my ($key, $val) = $self->{'db'}->next( $cursor ) ) - { - my($t_render, $t_expires, $filename, $mime_type) = split(':', $val); +Stub. - unlink File::Spec->catfile($self->{cachedir},$filename); - $self->{'db'}->c_del( $cursor ); - } - $self->{'db'}->c_close($cursor); - Debug('Renderer cache cleared'); +=cut - return 1 +sub checkAndClearCache +{ +return 1 } -=head newCacheFileName +=head2 clearcache -Returns a new cachefilename based on the provided args $cachekey and -a random number - -It would be far better if this used File::Temp +Stub. =cut -sub newCacheFileName +sub clearcache { - my $cachekey = shift; - return sprintf('%s_%.5d', md5_hex($cachekey), rand(1e5)); + return 1 } - 1; diff --git a/src/lib/Torrus/Renderer/Frontpage.pm b/src/lib/Torrus/Renderer/Frontpage.pm index 606b9e8..52e0a6a 100644 --- a/src/lib/Torrus/Renderer/Frontpage.pm +++ b/src/lib/Torrus/Renderer/Frontpage.pm @@ -42,19 +42,10 @@ sub renderUserLogin my($t_render, $t_expires, $filename, $mime_type); - my $cachekey = $cache->cacheKey( 'LOGINSCREEN', $self->{options} ); + my $cachekey = 'LOGINSCREEN'; ($t_render, $t_expires, $filename, $mime_type) = - $cache->getCache( $cachekey ); - - # We don't check the expiration time for login screen - if( not defined( $filename ) ) - { - $filename = $cache->newCacheFileName($cachekey, - $self->{options} ); - } - - my $outfile = File::Spec->catfile($Torrus::Global::cacheDir,$filename); + $cache->getCache( $cachekey, $self->{options} ); $t_expires = time(); $mime_type = $Torrus::Renderer::LoginScreen::mimeType; @@ -87,9 +78,8 @@ sub renderUserLogin $ttvars->{$opt} = $val; } - my $result = $self->{'tt'}->process( $tmplfile, $ttvars, $outfile ); - - undef $ttvars; + my $content; + my $result = $self->{'tt'}->process( $tmplfile, $ttvars, \$content ); my @ret; if( not $result ) @@ -99,13 +89,14 @@ sub renderUserLogin } else { - $cache->setCache($cachekey, time(), $t_expires, $filename, $mime_type); - @ret = ($outfile, $mime_type, $t_expires - time()); + $cache->setCache($cachekey, $self->{options}, time(), $t_expires, $content, $mime_type); + @ret = ($content, $mime_type, $t_expires - time()); } $self->{'options'} = undef; - return @ret; + return @ret + } @@ -118,31 +109,23 @@ sub renderTreeChooser $self->{'options'} = \%new_options if( %new_options ); - my($t_render, $t_expires, $filename, $mime_type); + my($t_render, $t_expires, $content, $mime_type); my $uid = $self->{'options'}->{'uid'} || ''; - my $cachekey = $cache->cacheKey( $uid . ':' . 'TREECHOOSER', - $self->{options} ); + my $cachekey = $uid . ':' . 'TREECHOOSER'; - ($t_render, $t_expires, $filename, $mime_type) = - $cache->getCache( $cachekey ); + ($t_render, $t_expires, $content, $mime_type) = + $cache->getCache( $cachekey, $self->{options} ); - if( defined( $filename ) ) + if( defined( $content ) ) { if( $t_expires >= time() ) { - return (File::Spec->catfile($Torrus::Global::cacheDir,$filename), - $mime_type, $t_expires - time()); + return ($content,$mime_type, $t_expires - time()); } # Else reuse the old filename } - else - { - $filename = $cache->newCacheFileName( $cachekey ); - } - - my $outfile = File::Spec->catfile($Torrus::Global::cacheDir,$filename); $t_expires = time() + $Torrus::Renderer::Chooser::expires; $mime_type = $Torrus::Renderer::Chooser::mimeType; @@ -194,9 +177,7 @@ sub renderTreeChooser $ttvars->{$opt} = $val; } - my $result = $self->{'tt'}->process( $tmplfile, $ttvars, $outfile ); - - undef $ttvars; + my $result = $self->{'tt'}->process( $tmplfile, $ttvars, \$content ); my @ret; if( not $result ) @@ -206,13 +187,13 @@ sub renderTreeChooser } else { - $cache->setCache($cachekey, time(), $t_expires, $filename, $mime_type); - @ret = ($outfile, $mime_type, $t_expires - time()); + $cache->setCache($cachekey, $self->{options}, time(), $t_expires, $content, $mime_type); + @ret = ($content, $mime_type, $t_expires - time()); } $self->{'options'} = undef; - return @ret; + return @ret } @@ -222,7 +203,7 @@ sub mayGlobalSearch return ( $Torrus::Renderer::globalSearchEnabled and ( not $Torrus::CGI::authorizeUsers or - ( $self->hasPrivilege( '*', 'GlobalSearch' ) ) ) ); + ( $self->hasPrivilege( '*', 'GlobalSearch' ) ) ) ) } =head2 doGlobalSearch @@ -259,7 +240,8 @@ sub doGlobalSearch } } - return $ret; + return $ret + } -- 2.11.4.GIT