File Coverage

blib/lib/Apache/AppSamurai/Tracker.pm
Criterion Covered Total %
statement 12 51 23.5
branch 0 32 0.0
condition n/a
subroutine 4 7 57.1
pod 0 3 0.0
total 16 93 17.2


line stmt bran cond sub pod time code
1             # Apache::AppSamurai:Tracker - Special case override for Apache::Session
2             # used for flexible, persistent, IPC tracking of events. Useful for
3             # brute force detection and other fun "stuff"
4              
5             # $Id: Tracker.pm,v 1.11 2008/04/30 21:40:06 pauldoom Exp $
6              
7             ##
8             # Copyright (c) 2008 Paul M. Hirsch (paul@voltagenoir.org).
9             # All rights reserved.
10             #
11             # This program is free software; you can redistribute it and/or modify it under
12             # the same terms as Perl itself.
13             ##
14              
15             # Includes code from Apache::Session developed by Jeffrey William Baker
16             # (jwbaker@acm.org) and others.
17              
18             package Apache::AppSamurai::Tracker;
19 1     1   65338 use strict;
  1         2  
  1         40  
20 1     1   6 use warnings;
  1         2  
  1         31  
21              
22 1     1   6 use vars qw($VERSION @ISA $incl);
  1         2  
  1         88  
23             $VERSION = substr(q$Revision: 1.11 $, 10, -1);
24              
25 1     1   1116 use Apache::Session;
  1         8803  
  1         2097  
26              
27             @ISA = qw( Apache::Session );
28             $incl = {};
29              
30             sub populate {
31 0     0 0   my $self = shift;
32              
33             # Allow standard Apache::Session syntax, special AppSamurai/
34             # syntax, or specifying a full module path.
35 0           my ($store, $lock, $gen, $ser);
36 0 0         if ($self->{args}->{Store} =~ /^AppSamurai\/([\w\d\_]+?)\s*$/i) {
    0          
37 0           $store = "Apache::AppSamurai::Session::Store::$1";
38             } elsif ($self->{args}->{Store} =~ /::/) {
39 0           $store = $self->{args}->{Store};
40             } else {
41 0           $store = "Apache::Session::Store::$self->{args}->{Store}";
42             }
43 0 0         if ($self->{args}->{Lock} =~ /^AppSamurai\/([\w\d\_]+?)\s*$/i) {
    0          
44 0           $lock = "Apache::AppSamurai::Session::Lock::$1";
45             } elsif ($self->{args}->{Lock} =~ /::/) {
46 0           $lock = $self->{args}->{Lock};
47             } else {
48 0           $lock = "Apache::Session::Lock::$self->{args}->{Lock}";
49             }
50 0 0         if ($self->{args}->{Serialize} =~ /^AppSamurai\/([\w\d\_]+?)\s*$/i) {
    0          
51 0           $ser = "Apache::AppSamurai::Session::Serialize::$1";
52             } elsif ($self->{args}->{Serialize} =~ /::/) {
53 0           $ser = $self->{args}->{Serialize};
54             } else {
55 0           $ser = "Apache::Session::Serialize::$self->{args}->{Serialize}";
56             }
57              
58 0 0         if (!exists $incl->{$store}) {
59 0 0         eval "require $store" || die $@;
60 0           $incl->{$store} = 1;
61             }
62            
63 0 0         if (!exists $incl->{$lock}) {
64 0 0         eval "require $lock" || die $@;
65 0           $incl->{$lock} = 1;
66             }
67            
68 0 0         if (!exists $incl->{$ser}) {
69 0 0         eval "require $ser" || die $@;
70 0 0         eval '$incl->{$ser}->[0] = \&' . $ser . '::serialize' || die $@;
71 0 0         eval '$incl->{$ser}->[1] = \&' . $ser . '::unserialize' || die $@;
72             }
73            
74 0           $self->{object_store} = new $store $self;
75 0           $self->{lock_manager} = new $lock $self;
76 0           $self->{serialize} = $incl->{$ser}->[0];
77 0           $self->{unserialize} = $incl->{$ser}->[1];
78              
79             # Generate is not used! A fixed ID needs to be passed in at all times
80 0           $self->{generate} = \&generate;
81             # Basic sanity check on passed in ID
82 0           $self->{validate} = \&validate;
83              
84 0           return $self;
85             }
86              
87             # Just plug the static "Name" value from the config in
88             sub generate {
89 0     0 0   my $session = shift;
90              
91 0 0         if ($session->{args}->{Name}) {
92 0           $session->{data}->{_session_id} = $session->{args}->{Name};
93             } else {
94 0           die "$session - Must pass in Name value! (No generator functionality supported)";
95             }
96             }
97              
98             # Just make sure it looks non-threatening
99             sub validate {
100 0     0 0   my $session = shift;
101 0 0         unless ($session->{data}->{_session_id} =~ /^([\w\d\_\-\.]+)$/) {
102 0           die "Invalid ID value";
103             }
104 0           return $1;
105             }
106              
107             1; # End of Apache::AppSamurai::Tracker
108              
109             __END__