File:
[LON-CAPA] /
loncom /
cgi /
loncgi.pm
Revision
1.7:
download - view:
text,
annotated -
select for diffs
Thu May 18 14:24:06 2006 UTC (18 years, 4 months ago) by
albertel
Branches:
MAIN
CVS tags:
version_2_2_X,
version_2_2_2,
version_2_2_1,
version_2_2_0,
version_2_1_99_3,
version_2_1_99_2,
version_2_1_99_1,
version_2_1_99_0,
HEAD
- removal of extra escape/unescape
1: #
2: # LON-CAPA helpers for cgi-bin scripts
3: #
4: # $Id: loncgi.pm,v 1.7 2006/05/18 14:24:06 albertel Exp $
5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28: #############################################
29: #############################################
30:
31: =pod
32:
33: =head1 NAME
34:
35: loncgi
36:
37: =head1 SYNOPSIS
38:
39: Provides subroutines for checking a LON-CAPA cookie and loading the users
40: environment.
41:
42: =head1 Subroutines
43:
44: =over 4
45:
46: =cut
47:
48: #############################################
49: #############################################
50: package LONCAPA::loncgi;
51:
52: use strict;
53: use warnings FATAL=>'all';
54: no warnings 'uninitialized';
55:
56: use lib '/home/httpd/lib/perl/';
57: use CGI();
58: use CGI::Cookie();
59: use Fcntl qw(:flock);
60: use LONCAPA;
61: use LONCAPA::Configuration();
62:
63: my $lonidsdir;
64:
65: BEGIN {
66: my $perlvar=LONCAPA::Configuration::read_conf('loncapa.conf');
67: delete $perlvar->{'lonReceipt'};
68: $lonidsdir = $perlvar->{'lonIDsDir'};
69: }
70:
71: #############################################
72: #############################################
73:
74: =pod
75:
76: =item check_cookie_and_load_env
77:
78: Inputs: none
79:
80: Returns: 1 if the user has a LON-CAPA cookie 0 if not.
81: Loads the users environment into the %env hash if the cookie is correct.
82:
83: =cut
84:
85: #############################################
86: #############################################
87: sub check_cookie_and_load_env {
88: my %cookies=fetch CGI::Cookie;
89: if (exists($cookies{'lonID'}) &&
90: -e "$lonidsdir/".$cookies{'lonID'}->value.".id") {
91: # cookie found
92: &transfer_profile_to_env($cookies{'lonID'}->value);
93: return 1;
94: } else {
95: # No cookie found
96: return 0;
97: }
98: }
99:
100: #############################################
101: #############################################
102:
103: =pod
104:
105: =item check_cookie
106:
107: Inputs: none
108:
109: Returns: 1 if the user has a LON-CAPA cookie and 0 if not.
110:
111: =cut
112:
113: #############################################
114: #############################################
115: sub check_cookie {
116: my %cookies=fetch CGI::Cookie;
117: if (exists($cookies{'lonID'}) &&
118: -e "$lonidsdir/".$cookies{'lonID'}->value.".id") {
119: # cookie found
120: return 1;
121: } else {
122: # No cookie found
123: return 0;
124: }
125: }
126:
127: #############################################
128: #############################################
129:
130: =pod
131:
132: =item transfer_profile_to_env
133:
134: Load the users environment into the %env hash.
135:
136: Inputs: $handle, the name of the users LON-CAPA cookie.
137:
138: Returns: undef
139:
140: =cut
141:
142: #############################################
143: #############################################
144: sub transfer_profile_to_env {
145: my ($handle)=@_;
146: my @profile;
147: {
148: open(IDFILE, "<$lonidsdir/$handle.id");
149: flock(IDFILE,LOCK_SH);
150: @profile=<IDFILE>;
151: close(IDFILE);
152: }
153: foreach my $envrow (@profile) {
154: chomp($envrow);
155: my ($envname,$envvalue)=split(/=/,$envrow,2);
156: $envname = &unescape($envname);
157: $envvalue = &unescape($envvalue);
158: $Apache::lonnet::env{$envname} = $envvalue;
159: }
160: $Apache::lonnet::env{'user.environment'} = "$lonidsdir/$handle.id";
161: return undef;
162: }
163:
164: #############################################
165: #############################################
166:
167:
168: =pod
169:
170: =back
171:
172: =cut
173:
174: 1;
175:
176: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>