1: # The LearningOnline Network
2: # Cookie Based Access Handler
3: # 5/21/99,5/22,5/29,5/31,6/15,16/11,22/11,
4: # 01/06,01/13 Gerd Kortemeyer
5:
6: package Apache::lonacc;
7:
8: use strict;
9: use Apache::Constants qw(:common);
10: use Apache::File;
11: use CGI::Cookie();
12:
13: sub handler {
14: my $r = shift;
15: my $requrl=$r->uri;
16: my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
17: my $lonid=$cookies{'lonID'};
18: my $cookie;
19: if ($lonid) {
20: my $handle=$lonid->value;
21: $handle=~s/\W//g;
22: my $lonidsdir=$r->dir_config('lonIDsDir');
23: if ((-e "$lonidsdir/$handle.id") && ($handle ne '')) {
24: my @profile;
25: {
26: my $idf=Apache::File->new("$lonidsdir/$handle.id");
27: @profile=<$idf>;
28: }
29: my $envi;
30: for ($envi=0;$envi<=$#profile;$envi++) {
31: chomp($profile[$envi]);
32: my ($envname,$envvalue)=split(/=/,$profile[$envi]);
33: $r->subprocess_env("$envname" => "$envvalue");
34: }
35: $r->subprocess_env("user.environment" => "$lonidsdir/$handle.id",
36: "request.state" => "published",
37: "request.filename" => $r->filename);
38: my $buffer;
39: $r->read($buffer,$r->header_in('Content-length'));
40: my @pairs=split(/&/,$buffer);
41: my $pair; my $name; my $value;
42: foreach $pair (@pairs) {
43: ($name,$value) = split(/=/,$pair);
44: $r->subprocess_env("form.$name" => $value);
45: }
46: return OK;
47: } else {
48: $r->log_reason("Cookie $handle not valid", $r->filename)
49: };
50: }
51: $cookie=CGI::Cookie->new(-name => 'lonURL',
52: -value => $requrl,
53: -path => '/');
54: $r->err_headers_out->add('Set-Cookie' => $cookie);
55: return FORBIDDEN;
56: }
57:
58: 1;
59: __END__
60:
61:
62:
63:
64:
65:
66:
67:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>