From b4698f7725430a1324cf545fb0ed7adc7f9f839c Mon Sep 17 00:00:00 2001 From: Patrick Donelan Date: Sat, 10 Oct 2009 19:28:19 +1100 Subject: [PATCH] fixed cookie handling --- etc/dev.localhost.localdomain.psgi | 7 +- lib/WebGUI/Session/Http.pm | 20 ++-- lib/WebGUI/Session/Plack.pm | 146 +++++++++++++++++------------ 3 files changed, 99 insertions(+), 74 deletions(-) diff --git a/etc/dev.localhost.localdomain.psgi b/etc/dev.localhost.localdomain.psgi index df9d00c61..31a4e55c9 100644 --- a/etc/dev.localhost.localdomain.psgi +++ b/etc/dev.localhost.localdomain.psgi @@ -32,12 +32,11 @@ builder { path => qr{^/uploads/}, root => "$WEBGUI_DOMAINS/dev.localhost.localdomain/public/"; - add 'Plack::Middleware::XFramework', - framework => 'WebGUI'; + add 'Plack::Middleware::XFramework', framework => 'WebGUI'; # Already enabled by plackup script - # add 'Plack::Middleware::AccessLog', + # add 'Plack::Middleware::AccessLog', # format => "combined"; $app; -} \ No newline at end of file +} diff --git a/lib/WebGUI/Session/Http.pm b/lib/WebGUI/Session/Http.pm index 473d55835..0861d2d9f 100644 --- a/lib/WebGUI/Session/Http.pm +++ b/lib/WebGUI/Session/Http.pm @@ -93,7 +93,7 @@ sub getCookies { my $self = shift; if ($self->session->request) { if ($self->session->request->isa('WebGUI::Session::Plack')) { - return $self->session->request->request_cookies; + return $self->session->request->get_request_cookies; } # Have to require this instead of using it otherwise it causes problems for command-line scripts on some platforms (namely Windows) @@ -389,15 +389,17 @@ sub setCookie { $ttl = (defined $ttl ? $ttl : '+10y'); if ($self->session->request) { - if ($self->session->request->isa('WebGUI::Session::Plack')) { - $self->session->request->response_cookies->{$name} = { - value => $value, - path => '/', - expires => $ttl ne 'session' ? $ttl : undef, - domain => $domain, - }; + if ( $self->session->request->isa('WebGUI::Session::Plack') ) { + $self->session->request->set_response_cookie( + $name => { + value => $value, + path => '/', + expires => $ttl ne 'session' ? $ttl : undef, + domain => $domain, + } + ); return; - } + } require Apache2::Cookie; my $cookie = Apache2::Cookie->new($self->session->request, diff --git a/lib/WebGUI/Session/Plack.pm b/lib/WebGUI/Session/Plack.pm index 2a123207e..d0709c176 100644 --- a/lib/WebGUI/Session/Plack.pm +++ b/lib/WebGUI/Session/Plack.pm @@ -11,73 +11,78 @@ This class is used instead of WebGUI::Session::Request when wg is started via pl =cut sub new { - my ($class, %p) = @_; + my ( $class, %p ) = @_; # 'require' rather than 'use' so that non-plebgui doesn't freak out require Plack::Request; - my $request = Plack::Request->new( $p{env} ); + my $request = Plack::Request->new( $p{env} ); my $response = $request->new_response(200); - - my $self = bless { + + bless { %p, - pnotes => {}, - request => $request, - response => $response, - server => WebGUI::Session::Plack::Server->new( env => $p{env} ), - body => [], - sendfile => undef, + pnotes => {}, + request => $request, + response => $response, + server => WebGUI::Session::Plack::Server->new( env => $p{env} ), + headers_out => WebGUI::Session::Plack::HeadersOut->new( request => $request, response => $response ), + body => [], + sendfile => undef, }, $class; - - $self->{headers_out} = WebGUI::Session::Plack::HeadersOut->new( request => $request, response => $response ); - return $self; } our $AUTOLOAD; + sub AUTOLOAD { my $what = $AUTOLOAD; $what =~ s/.*:://; - carp "!!plack->$what(@_)"; + carp "!!plack->$what(@_)" unless $what eq 'DESTROY'; } # Emulate/delegate/fake Apache2::* subs -sub uri { shift->{request}->request_uri(@_) } -sub param { shift->{request}->param(@_) } -sub params { shift->{request}->params(@_) } -sub headers_in { shift->{request}->headers(@_) } -sub headers_out { shift->{headers_out} } -sub protocol { shift->{request}->protocol(@_) } -sub status { shift->{response}->status(@_) } -sub sendfile { $_[0]->{sendfile} = $_[1] } +sub uri { shift->{request}->request_uri(@_) } +sub param { shift->{request}->param(@_) } +sub params { shift->{request}->params(@_) } +sub headers_in { shift->{request}->headers(@_) } +sub headers_out { shift->{headers_out} } +sub protocol { shift->{request}->protocol(@_) } +sub status { shift->{response}->status(@_) } +sub sendfile { $_[0]->{sendfile} = $_[1] } sub content_type { shift->{response}->content_type(@_) } -sub status_line {} -sub DESTROY {} -sub auth_type {} # should we support this? +sub server { shift->{server} } +sub status_line { } +sub auth_type { } # should we support this? -sub server { shift->{server} } -sub request_cookies { shift->{request}->cookies } -sub response_cookies { shift->{response}->cookies(@_) } +# These two cookie subs are called from our wG Plack-specific code +sub get_request_cookies { shift->{request}->cookies } # returns hashref of all request cookies + +sub set_response_cookie { + my ( $self, $name, $val ) = @_; + + #warn "setting cookies $name => " . Data::Dumper::Dumper($val); + $self->{response}->cookies->{$name} = $val; +} # TODO: I suppose this should do some sort of IO::Handle thing -sub print { - my $self = shift; - push @{$self->{body}}, @_; +sub print { + my $self = shift; + push @{ $self->{body} }, @_; } sub dir_config { - my ($self, $c) = @_; + my ( $self, $c ) = @_; return $self->{env}->{"wg.DIR_CONFIG.$c"}; } sub pnotes { - my ($self, $key) = (shift, shift); - return wantarray ? %{$self->{pnotes}} : $self->{pnotes} unless defined $key; + my ( $self, $key ) = ( shift, shift ); + return wantarray ? %{ $self->{pnotes} } : $self->{pnotes} unless defined $key; return $self->{pnotes}{$key} = $_[0] if @_; return $self->{pnotes}{$key}; } sub user { - my ($self, $user) = @_; - if (defined $user) { + my ( $self, $user ) = @_; + if ( defined $user ) { $self->{user} = $user; } $self->{user}; @@ -85,35 +90,39 @@ sub user { sub push_handlers { my $self = shift; - my ($x, $sub) = @_; - + my ( $x, $sub ) = @_; + # log it # carp "push_handlers($x)"; - - # run it + + # run it # returns something like Apache2::Const::OK, which we just ignore because we're not modperl my $ret = $sub->($self); - + return; } sub finalize { - my $self = shift; + my $self = shift; my $response = $self->{response}; - if ($self->{sendfile} && open my $fh, '<', $self->{sendfile}) { - $response->body( $fh ); - } else { + if ( $self->{sendfile} && open my $fh, '<', $self->{sendfile} ) { + $response->body($fh); + } + else { $response->body( $self->{body} ); } return $response->finalize; } -# -#sub headers_in { -# my $self = shift; -# return unless $self->plack; -# return $self->plack->headers(@_); -#} +sub no_cache { + my ( $self, $doit ) = @_; + if ($doit) { + $self->{response}->headers->push_header( 'Pragma' => 'no-cache', 'Cache-control' => 'no-cache' ); + } + else { + $self->{response}->headers->remove_header( 'Pragma', 'Cache-control' ); + } +} ################################################ @@ -125,19 +134,19 @@ use Carp; sub new { my $class = shift; - bless { @_ }, $class; + bless {@_}, $class; } our $AUTOLOAD; + sub AUTOLOAD { my $what = $AUTOLOAD; $what =~ s/.*:://; - carp "!!server->$what(@_)"; + carp "!!server->$what(@_)" unless $what eq 'DESTROY'; } -sub DESTROY {} sub dir_config { - my ($self, $c) = @_; + my ( $self, $c ) = @_; return $self->{env}->{"wg.DIR_CONFIG.$c"}; } @@ -145,26 +154,41 @@ sub dir_config { package WebGUI::Session::Plack::HeadersOut; +=head1 DESCRIPTION + +This class is required so that wG can call: + + $session->response->headers_out->set('a' => 'b'); + +But for code under out control we just use: + + $response->headers->push_header('a' => 'b'); + $repsonse->headers->remove_header('a'); + +=cut + use strict; use warnings; use Carp; sub new { my $class = shift; - bless { @_ }, $class; + bless {@_}, $class; } our $AUTOLOAD; + sub AUTOLOAD { my $what = $AUTOLOAD; $what =~ s/.*:://; - carp "!!headers_out->$what(@_)"; + carp "!!headers_out->$what(@_)" unless $what eq 'DESTROY'; } -sub DESTROY {} - -# Called by wG as $session->response->headers_out->set('Content-Type' => 'text/html'); -sub set { shift->{response}->headers->header(@_) } +# This is the sub that wG calls +sub set { + my $self = shift; + $self->{response}->headers->push_header(@_); +} ################################################