oqapi/webgui
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

classes under session should weaken their session references

Browse source
This commit is contained in:
Graham Knop 2010-04-16 19:29:18 -05:00
parent 241c94175f
commit 2b78fe913b
17 changed files with 81 additions and 248 deletions
Download patch file Download diff file Expand all files Collapse all files

2
lib/WebGUI/Session.pm
View file

@ -294,7 +294,7 @@ Returns a WebGUI::Session::Env object.
sub env {
my $self = shift;
unless (exists $self->{_env}) {
$self->{_env} = WebGUI::Session::Env->new;
$self->{_env} = WebGUI::Session::Env->new($self);
}
return $self->{_env};
}

20
lib/WebGUI/Session/DateTime.pm
View file

@ -21,7 +21,8 @@ use DateTime::Format::Mail;
use DateTime::TimeZone;
use Tie::IxHash;
use WebGUI::International;
use WebGUI::Utility;
use WebGUI::Utility qw(round);
use Scalar::Util qw(weaken);
=head1 NAME
@ -226,19 +227,6 @@ sub dayStartEnd {
#-------------------------------------------------------------------
=head2 DESTROY ( )
Deconstructor.
=cut
sub DESTROY {
my $self = shift;
undef $self;
}
#-------------------------------------------------------------------
=head2 epochToHttp ( [ epoch ] )
Converts and epoch date into an HTTP formatted date.
@ -808,7 +796,9 @@ A reference to the current session.
sub new {
my $class = shift;
my $session = shift;
bless {_session=>$session}, $class;
my $self = bless { _session => $session }, $class;
weaken $self->{_session};
return $self;
}
#-------------------------------------------------------------------

49
lib/WebGUI/Session/Env.pm
View file

@ -99,21 +99,6 @@ sub clientIsSpider {
}
#-------------------------------------------------------------------
=head2 DESTROY ( )
Deconstructor.
=cut
sub DESTROY {
my $self = shift;
undef $self;
}
#-------------------------------------------------------------------
=head2 get( varName )
@ -127,9 +112,9 @@ The name of the variable.
=cut
sub get {
my $self = shift;
my $var = shift;
return $self->{_env}{$var};
my $self = shift;
my $var = shift;
return $$self->{$var};
}
@ -137,16 +122,13 @@ sub get {
=head2 getIp ( )
Returns the user's real IP address. Normally this is REMOTE_ADDR, but if they go through a proxy server it might be in HTTP_X_FORWARDED_FOR. This method attempts to figure out what the most likely IP is for the user. Note that it's possible to spoof this and therefore shouldn't be used as your only security mechanism for validating a user.
Returns the user's IP address.
=cut
sub getIp {
my $self = shift;
if ($self->get("HTTP_X_FORWARDED_FOR") =~ m/(\d+\.\d+\.\d+\.\d+)/) {
return $1;
}
return $self->get("REMOTE_ADDR");
my $self = shift;
return $self->get('REMOTE_ADDR');
}
@ -159,8 +141,16 @@ Constructor. Returns an env object.
=cut
sub new {
my $class = shift;
bless {_env=>\%ENV}, $class;
my $class = shift;
my $session = shift;
my $env;
if ($session->request) {
$env = $session->request->env;
}
else {
$env = {};
}
return bless \$env, $class;
}
#-------------------------------------------------------------------
@ -195,12 +185,7 @@ was made via SSL.
sub sslRequest {
my $self = shift;
return (
$self->get('HTTPS') eq 'on'
|| $self->get('SSLPROXY')
|| $self->get('HTTP_SSLPROXY')
|| $self->get('HTTP_X_FORWARDED_PROTO') eq 'https'
);
return $self->get('psgi.url_scheme') eq 'https';
}

12
lib/WebGUI/Session/ErrorHandler.pm
View file

@ -17,13 +17,11 @@ package WebGUI::Session::ErrorHandler;
use strict;
use WebGUI::Paths;
use JSON;
use HTML::Entities qw(encode_entities);
use Log::Log4perl;
use WebGUI::Exception;
use Sub::Uplevel;
use Scalar::Util qw(weaken);
=head1 NAME
=head1 NAME
Package WebGUI::Session::ErrorHandler
@ -201,6 +199,8 @@ sub new {
my $class = shift;
my $session = shift;
my $self = bless { _session => $session }, $class;
weaken $self->{_session};
my $logger = $session->request && $session->request->logger;
if ( !$logger ) {
@ -215,8 +215,8 @@ sub new {
$log4perl->$level( $args->{message} );
};
}
bless { _session => $session, _logger => $logger }, $class;
$self->{_logger} = $logger;
return $self;
}
#----------------------------------------------------------------------------

1
lib/WebGUI/Session/Form.pm
View file

@ -15,7 +15,6 @@ package WebGUI::Session::Form;
=cut
use strict qw(vars subs);
use WebGUI::HTML;
use Encode ();
use Tie::IxHash;
use base 'WebGUI::FormValidator';

31
lib/WebGUI/Session/Http.pm
View file

@ -16,7 +16,8 @@ package WebGUI::Session::Http;
use strict;
use WebGUI::Utility;
use Scalar::Util qw(weaken);
use HTTP::Date ();
sub _deprecated {
my $alt = shift;
@ -59,21 +60,6 @@ These methods are available from this package:
=cut
#-------------------------------------------------------------------
=head2 DESTROY ( )
Deconstructor.
=cut
sub DESTROY {
my $self = shift;
undef $self;
}
#-------------------------------------------------------------------
=head2 getCacheControl ( )
@ -222,10 +208,9 @@ sub ifModifiedSince {
my $self = shift;
my $epoch = shift;
my $maxCacheTimeout = shift;
require APR::Date;
my $modified = $self->session->request->header('If-Modified-Since');
return 1 if ($modified eq "");
$modified = APR::Date::parse_http($modified);
$modified = HTTP::Date::str2time($modified);
##Implement a step function that increments the epoch time in integer multiples of
##the maximum cache time. Used to handle the case where layouts containing macros
##(like assetproxied Navigations) can be periodically updated.
@ -265,7 +250,9 @@ A reference to the current session.
sub new {
my $class = shift;
my $session = shift;
bless {_session=>$session}, $class;
my $self = bless { _session => $session }, $class;
weaken $self->{_session};
return $self;
}
@ -282,7 +269,7 @@ sub sendHeader {
return undef if ($self->{_http}{noHeader});
return $self->_sendMinimalHeader unless defined $self->session->db(1);
my ($request, $response, $datetime, $config, $var) = $self->session->quick(qw(request response datetime config var));
my ($request, $response, $config, $var) = $self->session->quick(qw(request response config var));
return undef unless $request;
my $userId = $var->get("userId");
@ -298,7 +285,7 @@ sub sendHeader {
} else {
$response->content_type($self->getMimeType);
my $cacheControl = $self->getCacheControl;
my $date = ($userId eq "1") ? $datetime->epochToHttp($self->getLastModified) : $datetime->epochToHttp;
my $date = ($userId eq "1") ? HTTP::Date::time2str($self->getLastModified) : HTTP::Date::time2str();
# under these circumstances, don't allow caching
if ($userId ne "1" || $cacheControl eq "none" || $self->session->setting->get("preventProxyCache")) {
$response->header("Cache-Control" => "private, max-age=1");
@ -315,7 +302,7 @@ sub sendHeader {
}
# do an extra incantation if the HTTP protocol is really old
if ($request->protocol =~ /(\d\.\d)/ && $1 < 1.1) {
my $date = $datetime->epochToHttp(time() + $cacheControl);
my $date = HTTP::Date::time2str(time() + $cacheControl);
$response->header( 'Expires' => $date );
}
}

19
lib/WebGUI/Session/Icon.pm
View file

@ -17,6 +17,7 @@ package WebGUI::Session::Icon;
use strict;
use WebGUI::International;
use Tie::IxHash;
use Scalar::Util qw(weaken);
=head1 NAME
@ -127,20 +128,6 @@ sub cut {
return $output;
}
#-------------------------------------------------------------------
=head2 DESTROY ( )
Deconstructor.
=cut
sub DESTROY {
my $self = shift;
undef $self;
}
#-------------------------------------------------------------------
=head2 delete ( urlParameters [, pageURL, confirmText ] )
@ -511,7 +498,9 @@ A reference to the current session.
sub new {
my $class = shift;
my $session = shift;
bless {_session=>$session}, $class;
my $self = bless { _session => $session }, $class;
weaken $self->{_session};
return $self;
}

22
lib/WebGUI/Session/Id.pm
View file

@ -16,9 +16,10 @@ package WebGUI::Session::Id;
=cut
use strict;
use Digest::MD5;
use Digest::MD5 ();
use Time::HiRes qw( gettimeofday usleep );
use MIME::Base64;
use MIME::Base64 qw(encode_base64 decode_base64);
use Scalar::Util qw(weaken);
my $idValidator = qr/^[A-Za-z0-9_-]{22}$/;
@ -44,19 +45,6 @@ These methods are available from this class:
#-------------------------------------------------------------------
=head2 DESTROY ( )
Deconstructor.
=cut
sub DESTROY {
my $self = shift;
undef $self;
}
#-------------------------------------------------------------------
=head2 fromHex ( hexId )
Returns the guid corresponding to hexId. Converse of toHex.
@ -121,7 +109,9 @@ A reference to the current session.
sub new {
my $class = shift;
my $session = shift;
bless {_session=>$session}, $class;
my $self = bless { _session => $session }, $class;
weaken $self->{_session};
return $self;
}
#-------------------------------------------------------------------

16
lib/WebGUI/Session/Os.pm
View file

@ -36,22 +36,6 @@ These methods are available from this package:
=cut
#-------------------------------------------------------------------
=head2 DESTROY ( )
Deconstructor.
=cut
sub DESTROY {
my $self = shift;
undef $self;
}
#-------------------------------------------------------------------
=head2 get( varName )

19
lib/WebGUI/Session/Output.pm
View file

@ -16,6 +16,7 @@ package WebGUI::Session::Output;
use strict;
use WebGUI::Macro;
use Scalar::Util qw(weaken);
=head1 NAME
@ -36,20 +37,6 @@ These methods are available from this package:
=cut
#-------------------------------------------------------------------
=head2 DESTROY ( )
Deconstructor.
=cut
sub DESTROY {
my $self = shift;
undef $self;
}
#-------------------------------------------------------------------
=head2 new ( session )
@ -65,7 +52,9 @@ A reference to the current session.
sub new {
my $class = shift;
my $session = shift;
bless {_session=>$session}, $class;
my $self = bless { _session => $session }, $class;
weaken $self->{_session};
return $self;
}
#-------------------------------------------------------------------

20
lib/WebGUI/Session/Privilege.pm
View file

@ -17,6 +17,7 @@ package WebGUI::Session::Privilege;
use strict;
use WebGUI::International;
use WebGUI::Operation::Auth;
use Scalar::Util qw(weaken);
=head1 NAME
@ -64,21 +65,6 @@ sub adminOnly {
return $self->session->style->userStyle($output);
}
#-------------------------------------------------------------------
=head2 DESTROY ( )
Deconstructor.
=cut
sub DESTROY {
my $self = shift;
undef $self;
}
#-------------------------------------------------------------------
=head2 insufficient ( )
@ -145,7 +131,9 @@ A reference to the current session.
sub new {
my $class = shift;
my $session = shift;
bless {_session=>$session}, $class;
my $self = bless { _session => $session }, $class;
weaken $self->{_session};
return $self;
}

21
lib/WebGUI/Session/Scratch.pm
View file

@ -16,6 +16,7 @@ package WebGUI::Session::Scratch;
use strict;
use WebGUI::International;
use Scalar::Util qw(weaken);
=head1 NAME
@ -138,21 +139,6 @@ sub deleteNameByValue {
$session->db->write("delete from userSessionScratch where name=? and value=?", [$name,$value]);
}
#-------------------------------------------------------------------
=head2 DESTROY ( )
Deconstructor.
=cut
sub DESTROY {
my $self = shift;
undef $self;
}
#-------------------------------------------------------------------
=head2 get( varName )
@ -198,11 +184,14 @@ The current session.
sub new {
my ($class, $session) = @_;
my $self = bless { _session => $session }, $class;
weaken $self->{_session};
my $scratch = eval{$session->cache->get(["sessionscratch",$session->getId])};
unless (ref $scratch eq "HASH") {
$scratch = $session->db->buildHashRef("select name,value from userSessionScratch where sessionId=?",[$session->getId], {noOrder => 1});
}
bless {_session=>$session, _data=>$scratch}, $class;
$self->{_data} = $scratch;
return $self;
}
#-------------------------------------------------------------------

22
lib/WebGUI/Session/Setting.pm
View file

@ -15,6 +15,7 @@ package WebGUI::Session::Setting;
=cut
use strict;
use Scalar::Util qw(weaken);
=head1 NAME
@ -67,21 +68,6 @@ sub add {
$self->set(@_);
}
#-------------------------------------------------------------------
=head2 DESTROY ( )
Deconstructor.
=cut
sub DESTROY {
my $self = shift;
undef $self;
}
#-------------------------------------------------------------------
=head2 get ( $param )
@ -145,8 +131,10 @@ A reference to the current WebGUI::Session.
sub new {
my $class = shift;
my $session = shift;
my $settings = $session->db->buildHashRef("select * from settings", [], {noOrder => 1});
bless {_settings=>$settings, _session=>$session}, $class;
my $self = bless { _session => $session }, $class;
weaken $self->{_session};
$self->{_settings} = $session->db->buildHashRef("select * from settings", [], {noOrder => 1});
return $self;
}

19
lib/WebGUI/Session/Stow.pm
View file

@ -15,6 +15,7 @@ package WebGUI::Session::Stow;
=cut
use strict;
use Scalar::Util qw(weaken);
=head1 NAME
@ -77,20 +78,6 @@ sub deleteAll {
}
#-------------------------------------------------------------------
=head2 DESTROY ( )
Deconstructor.
=cut
sub DESTROY {
my $self = shift;
undef $self;
}
#-------------------------------------------------------------------
=head2 get( varName )
@ -155,7 +142,9 @@ A reference to the session.
sub new {
my $class = shift;
my $session = shift;
bless {_session=>$session}, $class;
my $self = bless { _session => $session }, $class;
weaken $self->{_session};
return $self;
}

19
lib/WebGUI/Session/Style.pm
View file

@ -16,12 +16,12 @@ package WebGUI::Session::Style;
use strict;
use Tie::CPHash;
use WebGUI::International;
use WebGUI::Macro;
require WebGUI::Asset;
BEGIN { eval { require WebGUI; WebGUI->import } }
use HTML::Entities ();
use Scalar::Util qw(weaken);
=head1 NAME
@ -56,19 +56,6 @@ These methods are available from this class:
#-------------------------------------------------------------------
=head2 DESTROY ( )
Deconstructor.
=cut
sub DESTROY {
my $self = shift;
undef $self;
}
#-------------------------------------------------------------------
sub _generateAdditionalTags {
my $var = shift;
return sub {
@ -181,7 +168,9 @@ A reference to the current session.
sub new {
my $class = shift;
my $session = shift;
bless {_session=>$session}, $class;
my $self = bless { _session => $session}, $class;
weaken $self->{_session};
return $self;
}
#-------------------------------------------------------------------

19
lib/WebGUI/Session/Url.pm
View file

@ -20,6 +20,7 @@ use URI;
use URI::Escape;
use WebGUI::International;
use WebGUI::Utility;
use Scalar::Util qw(weaken);
=head1 NAME
@ -93,20 +94,6 @@ sub append {
return $url;
}
#-------------------------------------------------------------------
=head2 DESTROY ( )
Deconstructor.
=cut
sub DESTROY {
my $self = shift;
undef $self;
}
#-------------------------------------------------------------------
=head2 escape ( string )
@ -431,7 +418,9 @@ A reference to the current session.
sub new {
my $class = shift;
my $session = shift;
bless {_session=>$session}, $class;
my $self = bless { _session => $session }, $class;
weaken $self->{_session};
return $self;
}
#-------------------------------------------------------------------

18
lib/WebGUI/Session/Var.pm
View file

@ -15,6 +15,7 @@ package WebGUI::Session::Var;
=cut
use strict;
use Scalar::Util qw(weaken);
=head1 NAME
@ -46,19 +47,6 @@ These methods are available from this package:
=cut
#-------------------------------------------------------------------
=head2 DESTROY ( )
Deconstructor.
=cut
sub DESTROY {
my $self = shift;
}
#-------------------------------------------------------------------
=head2 end ( )
@ -75,7 +63,6 @@ sub end {
$session->scratch->deleteAll;
$session->db->write("delete from userSession where sessionId=?",[$id]);
delete $session->{_user};
$self->DESTROY;
}
#-------------------------------------------------------------------
@ -171,7 +158,8 @@ normally be used by anyone.
sub new {
my ($class, $session, $sessionId, $noFuss) = @_;
my $self = bless {_session=>$session}, $class;
my $self = bless { _session => $session }, $class;
weaken $self->{_session};
if ($sessionId eq "") { ##New session
$self->start(1);
}