Annotation of loncom/auth/lonacc.pm, revision 1.5
1.1 albertel 1: # The LearningOnline Network
2: # Cookie Based Access Handler
1.4 www 3: # 5/21/99,5/22,5/29,5/31,6/15,16/11,22/11,
1.5 ! www 4: # 01/06,01/13 Gerd Kortemeyer
1.1 albertel 5:
6: package Apache::lonacc;
7:
8: use strict;
9: use Apache::Constants qw(:common);
1.2 www 10: use Apache::File;
1.1 albertel 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 '')) {
1.2 www 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]);
1.4 www 33: $r->subprocess_env("$envname" => "$envvalue");
1.2 www 34: }
1.4 www 35: $r->subprocess_env("user.environment" => "$lonidsdir/$handle.id",
36: "request.state" => "published",
37: "request.filename" => $r->filename);
1.5 ! www 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: }
1.2 www 46: return OK;
1.1 albertel 47: } else {
1.5 ! www 48: $r->log_reason("Cookie $handle not valid", $r->filename)
1.1 albertel 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>