File Coverage

blib/lib/Apache/Auth/AuthMemCookie.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             package Apache::Auth::AuthMemCookie;
2              
3 1     1   1044 use strict;
  1         2  
  1         39  
4 1     1   1551 use CGI::Cookie ();
  1         15365  
  1         25  
5 1     1   1840 use Apache2::RequestUtil;
  0            
  0            
6             use Apache2::RequestIO;
7             use APR::Table;
8             use Apache2::RequestRec;
9             use Apache2::Const -compile => qw(OK REDIRECT FORBIDDEN AUTH_REQUIRED);
10             use Apache2::Log;
11             use Cache::Memcached;
12             use vars qw($VERSION);
13             $VERSION = '0.04';
14              
15             use Data::Dumper;
16              
17             =pod
18              
19             =head1 B
20              
21             =head2 B
22              
23             =over
24              
25             This module is used to take the place of Apache2 authmemcookie primarily for the use
26             of integration with simpleSAMLphp L .
27              
28             Alias /simplesaml /home/piers/git/public/simplesamlphp/www
29             perlModule Apache::Auth::AuthMemCookie
30             ErrorDocument 401 "/simplesaml/authmemcookie.php"
31             PerlRequire /path/to/authmemcookie/tools/startup.pl
32             perlModule Apache::Auth::AuthMemCookie
33              
34             # Prompt for authentication:
35            
36             AuthType Cookie
37             AuthName "My Service"
38             Require valid-user
39             PerlAuthenHandler Apache::Auth::AuthMemCookie::authen_handler
40             PerlSetVar AuthMemCookie "AuthMemCookie"
41             PerlSetVar AuthMemServers "127.0.0.1:11211, /var/sock/memcached"
42             PerlSetVar AuthMemAttrsInHeaders 1 # if you want to set headers instead of ENV vars
43             PerlSetVar AuthMemDebug 1 # if you want to debug
44            
45              
46             =back
47              
48             =cut
49              
50             our $memd = undef;
51             our $DEBUG = 0;
52              
53            
54             sub authen_handler {
55            
56             my $r = shift;
57             $DEBUG = $r->dir_config("AuthMemDebug") || 0;
58              
59             # first, remove all headers and env vars that might have been injected
60             foreach my $k (keys %ENV) {
61             delete $ENV{$k} if $k =~ /^(ATTR_|UserName)/;
62             }
63             foreach my $h (keys %{$r->headers_in}) {
64             $r->headers_in->unset($h) if $h =~ /^(ATTR_|UserName|X_REMOTE_USER|HTTP_X_REMOTE_USER)/;
65             }
66             $r->headers_in->unset('UserName');
67             $r->headers_in->unset('X_REMOTE_USER');
68             $r->headers_in->unset('X-Remote-User');
69              
70             # what is our cookie called
71             my $cookie_name = $r->dir_config("AuthMemCookie") ? $r->dir_config("AuthMemCookie") : 'AuthMemCookie';
72             mydebug("Headers in: ".Dumper($r->headers_in));
73              
74             # sort out our memcached connection
75             unless ($memd) {
76             my @memd_servers = split /\s*(?:,)\s*/, ($r->dir_config("AuthMemServers") ? $r->dir_config("AuthMemServers") : '127.0.0.1:11211, /var/sock/memcached');
77             $memd = new Cache::Memcached {
78             'servers' => [ @memd_servers ],
79             'debug' => 0,
80             'compress_threshold' => 10_000,
81             };
82             mydebug("memcache servers: ".Dumper(\@memd_servers));
83             }
84              
85             # get and process the cookies
86             my $cookies = $r->headers_in->get('Cookie');
87             $cookies = parse CGI::Cookie($cookies);
88             my $auth_cookie = exists $cookies->{$cookie_name} ? $cookies->{$cookie_name}->value() : "";
89              
90             # do we have the AuthMemCookie?
91             unless ($auth_cookie) {
92             mydebug("AuthMemCookie does not exist ($cookie_name) -> forcing login");
93             return Apache2::Const::AUTH_REQUIRED;
94             }
95             my $val = $memd->get($auth_cookie);
96              
97             # Do we have a valid Memcached session?
98             unless ($val) {
99             mydebug("Memcached session not found for AuthMemCookie ($cookie_name): $auth_cookie");
100             return Apache2::Const::AUTH_REQUIRED;
101             }
102              
103             mydebug("AuthMemCookie value: $val");
104              
105             # we found a valid MemCache session so push it into the environment and let them go
106             my %vars = map { my ($k, $v) = split(/=/, $_, 2); $k => $v } (split(/\r\n/, $val));
107              
108             # should the values be set in the headers
109             my $header_switch = $r->dir_config("AuthMemAttrsInHeaders") ? $r->dir_config("AuthMemAttrsInHeaders") : 0;
110             my $user = "";
111             foreach my $k (keys %vars) {
112             if ($k eq "UserName") {
113             $user = $vars{$k};
114             }
115             if ($header_switch) {
116             mydebug("setting Header $k => $vars{$k}");
117             if ($k eq "UserName") {
118             $r->headers_in->add('X-Remote-User' => $vars{$k});
119             }
120             else {
121             $r->headers_in->add($k => $vars{$k});
122             }
123             }
124             else {
125             mydebug("setting ENV $k => $vars{$k}");
126             $ENV{$k} = $vars{$k};
127             }
128             }
129             mydebug("The user name is: $user");
130             $r->user($user);
131             return Apache2::Const::OK;
132             }
133              
134             sub mydebug {
135             if ($DEBUG) {
136             warn @_;
137             }
138             }
139            
140             1;