FastMmap.pm

   1 package Catalyst::Plugin::Session::FastMmap;
   2
   3 use strict;
   4 use base qw/Class::Data::Inheritable Class::Accessor::Fast/;
   5 use NEXT;
   6 use Cache::FastMmap;
   7 use Digest::MD5;
   8 use URI;
   9 use URI::Find;
  10 use File::Temp 'tempdir';
  11
  12 our $VERSION = '0.13';
  13
  14 __PACKAGE__->mk_classdata('_session');
  15 __PACKAGE__->mk_accessors('sessionid');
  16
  17 =head1 NAME
  18
  19 Catalyst::Plugin::Session::FastMmap - FastMmap sessions for Catalyst
  20
  21 =head1 SYNOPSIS
  22
  23     use Catalyst 'Session::FastMmap';
  24
  25     MyApp->config->{session} = {
  26         expires => 3600,
  27         rewrite => 1,
  28         storage => '/tmp/session'
  29     };
  30
  31     $c->session->{foo} = 'bar';
  32     print $c->sessionid;
  33
  34 =head1 DESCRIPTION
  35
  36 C<Catalyst::Plugin::Session::FastMmap> is a fast session plugin for
  37 Catalyst that uses an mmap'ed file to act as a shared memory
  38 interprocess cache.  It is based on C<Cache::FastMMap>.
  39
  40
  41 =head2 EXTENDED METHODS
  42
  43 =over 4
  44
  45 =item finalize
  46
  47 =cut
  48
  49 sub finalize {
  50     my $c = shift;
  51     if ( $c->config->{session}->{rewrite} ) {
  52         my $redirect = $c->response->redirect;
  53         $c->response->redirect( $c->uri($redirect) ) if $redirect;
  54     }
  55     if ( my $sid = $c->sessionid ) {
  56         $c->_session->set( $sid, $c->session );
  57         my $set = 1;
  58         if ( my $cookie = $c->request->cookies->{session} ) {
  59             $set = 0 if $cookie->value eq $sid;
  60         }
  61         if ( $set ) {
  62             $c->response->cookies->{session} = {
  63                 value => $sid
  64             };
  65         }
  66         if ( $c->config->{session}->{rewrite} ) {
  67             my $finder = URI::Find->new(
  68                 sub {
  69                     my ( $uri, $orig ) = @_;
  70                     my $base = $c->request->base;
  71                     return $orig unless $orig =~ /^$base/;
  72                     return $orig if $uri->path =~ /\/-\//;
  73                     return $c->uri($orig);
  74                 }
  75             );
  76             $finder->find( \$c->res->{body} ) if $c->res->body;
  77         }
  78     }
  79     return $c->NEXT::finalize(@_);
  80 }
  81
  82 =item prepare_action
  83
  84 =cut
  85
  86 sub prepare_action {
  87     my $c = shift;
  88     if ( $c->request->path =~ /^(.*)\/\-\/(.+)$/ ) {
  89         $c->request->path($1);
  90         $c->sessionid($2);
  91         $c->log->debug(qq/Found sessionid "$2" in path/) if $c->debug;
  92     }
  93     if ( my $cookie = $c->request->cookies->{session} ) {
  94         my $sid = $cookie->value;
  95         $c->sessionid($sid);
  96         $c->log->debug(qq/Found sessionid "$sid" in cookie/) if $c->debug;
  97     }
  98     $c->NEXT::prepare_action(@_);
  99 }
 100
 101 sub session {
 102     my $c = shift;
 103     return $c->{session} if $c->{session};
 104     my $sid = $c->sessionid;
 105     if (   $sid
 106         && $c->_session
 107         && ( $c->{session} = $c->_session->get($sid) ) )
 108     {
 109         $c->log->debug(qq/Found session "$sid"/) if $c->debug;
 110         return $c->{session};
 111     }
 112     else {
 113         my $sid = Digest::MD5::md5_hex( time, rand, $$, 'catalyst' );
 114         $c->sessionid($sid);
 115         $c->log->debug(qq/Created session "$sid"/) if $c->debug;
 116         return $c->{session} = {};
 117     }
 118 }
 119
 120 =item setup
 121
 122 Sets up the session cache file.
 123
 124 =cut
 125
 126 sub setup {
 127     my $self = shift;
 128     $self->config->{session}->{storage} ||= '/tmp/session';
 129     $self->config->{session}->{expires} ||= 60 * 60 * 24;
 130     $self->config->{session}->{rewrite} ||= 0;
 131
 132     $self->_session(
 133         Cache::FastMmap->new(
 134             share_file  => $self->config->{session}->{storage},
 135             expire_time => $self->config->{session}->{expires}
 136         )
 137     );
 138
 139     return $self->NEXT::setup(@_);
 140 }
 141
 142 =back
 143
 144 =head2 METHODS
 145
 146 =over 4
 147
 148 =item session
 149
 150 =item uri
 151
 152 Extends an uri with session id if needed.
 153
 154     my $uri = $c->uri('http://localhost/foo');
 155
 156 =cut
 157
 158 sub uri {
 159     my ( $c, $uri ) = @_;
 160     if ( my $sid = $c->sessionid ) {
 161         $uri = URI->new($uri);
 162         my $path = $uri->path;
 163         $path .= '/' unless $path =~ /\/$/;
 164         $uri->path( $path . "-/$sid" );
 165         return $uri->as_string;
 166     }
 167     return $uri;
 168 }
 169
 170 =back
 171
 172 =head2 CONFIG OPTIONS
 173
 174 =over 4
 175
 176 =item rewrite
 177
 178 If set to a true value sessions are automatically stored in the url;
 179 defaults to false.
 180
 181 =item storage
 182
 183 Specifies the file to be used for the sharing of session data;
 184 defaults to C</tmp/session>.
 185
 186 Note that the file will be created with mode 0640, which means that it
 187 will only be writeable by processes running with the same uid as the
 188 process that creates the file.  If this may be a problem, for example
 189 if you may try to debug the program as one user and run it as another,
 190 specify a filename like C<< /tmp/session-$> >>, which includes the
 191 UID of the process in the filename.
 192
 193
 194 =item expires
 195
 196 Specifies the session expiry time in seconds; defaults to 86,400,
 197 i.e. one day.
 198
 199 =back
 200
 201 =head1 SEE ALSO
 202
 203 L<Catalyst>, L<Cache::FastMmap>.
 204
 205 =head1 AUTHOR
 206
 207 Sebastian Riedel E<lt>C<sri@cpan.org>E<gt>,
 208 Marcus Ramberg E<lt>C<mramberg@cpan.org>E<gt>,
 209 Andrew Ford E<lt>C<andrewf@cpan.org>E<gt>
 210
 211 =head1 COPYRIGHT
 212
 213 This program is free software, you can redistribute it and/or modify it
 214 under the same terms as Perl itself.
 215
 216 =cut
 217
 218 1;