File:
[LON-CAPA] /
loncom /
cgi /
loncgi.pm
Revision
1.11:
download - view:
text,
annotated -
select for diffs
Thu Dec 25 01:51:03 2008 UTC (15 years, 7 months ago) by
raeburn
Branches:
MAIN
CVS tags:
version_2_9_X,
version_2_9_99_0,
version_2_9_1,
version_2_9_0,
version_2_8_X,
version_2_8_99_1,
version_2_8_99_0,
version_2_8_2,
version_2_8_1,
version_2_8_0,
version_2_7_99_1,
version_2_7_99_0,
version_2_10_0_RC2,
version_2_10_0_RC1,
version_2_10_0,
bz6209-base,
bz6209,
bz5969,
bz2851,
PRINT_INCOMPLETE_base,
PRINT_INCOMPLETE,
HEAD,
GCI_3,
GCI_2,
GCI_1,
BZ5971-printing-apage,
BZ5434-fox
- Create new module - lonauthcgi.pm -to contain modules previously in loncgi.pm
which require lonnet.pm, so loncgi.pm need not import lonnet.pm.
- Moved &check_ipbased_access(), &can_view(), &unauthorized_msg(), and
&serverstatus_titles() from loncgi.pm to lonauthcgi.pm.
1: #
2: # LON-CAPA helpers for cgi-bin scripts
3: #
4: # $Id: loncgi.pm,v 1.11 2008/12/25 01:51:03 raeburn 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, loading the user's
40: environment, and retrieving arguments passed in via a CGI's Query String.
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: use GDBM_File;
63: use Apache::lonlocal;
64:
65: my $lonidsdir;
66:
67: BEGIN {
68: my $perlvar=LONCAPA::Configuration::read_conf('loncapa.conf');
69: delete $perlvar->{'lonReceipt'};
70: $lonidsdir = $perlvar->{'lonIDsDir'};
71: }
72:
73:
74: #############################################
75: #############################################
76:
77: =pod
78:
79: =item check_cookie_and_load_env()
80:
81: Inputs: 1 ( optional). When called from a handler in mod_perl,
82: pass in the request object.
83:
84: Returns: 1 if the user has a LON-CAPA cookie 0 if not.
85: Loads the users environment into the %env hash if the cookie is correct.
86:
87: =cut
88:
89: #############################################
90: #############################################
91: sub check_cookie_and_load_env {
92: my ($r) = @_;
93: my %cookies;
94: if (ref($r)) {
95: %cookies = CGI::Cookie->fetch($r);
96: } else {
97: %cookies = CGI::Cookie->fetch();
98: }
99: if (exists($cookies{'lonID'}) &&
100: -e "$lonidsdir/".$cookies{'lonID'}->value.".id") {
101: # cookie found
102: &transfer_profile_to_env($cookies{'lonID'}->value);
103: return 1;
104: } else {
105: # No cookie found
106: return 0;
107: }
108: }
109:
110: #############################################
111: #############################################
112:
113: =pod
114:
115: =item check_cookie()
116:
117: Inputs: none
118:
119: Returns: 1 if the user has a LON-CAPA cookie and 0 if not.
120:
121: =cut
122:
123: #############################################
124: #############################################
125: sub check_cookie {
126: my %cookies=fetch CGI::Cookie;
127: if (exists($cookies{'lonID'}) &&
128: -e "$lonidsdir/".$cookies{'lonID'}->value.".id") {
129: # cookie found
130: return 1;
131: } else {
132: # No cookie found
133: return 0;
134: }
135: }
136:
137: #############################################
138: #############################################
139:
140: =pod
141:
142: =item transfer_profile_to_env()
143:
144: Load the users environment into the %env hash.
145:
146: Inputs: $handle, the name of the users LON-CAPA cookie.
147:
148: Returns: undef
149:
150: =cut
151:
152: #############################################
153: #############################################
154: sub transfer_profile_to_env {
155: my ($handle)=@_;
156: if (tie(my %disk_env,'GDBM_File',"$lonidsdir/$handle.id",&GDBM_READER(),
157: 0640)) {
158: %Apache::lonnet::env = %disk_env;
159: untie(%disk_env);
160: }
161: $Apache::lonnet::env{'user.environment'} = "$lonidsdir/$handle.id";
162: return undef;
163: }
164:
165: #############################################
166: #############################################
167:
168: =pod
169:
170: =item missing_cookie_msg()
171:
172: Inputs: none
173: Returns: HTML for a page indicating cookie information absent.
174:
175: =cut
176:
177: #############################################
178: #############################################
179: sub missing_cookie_msg {
180: my %lt = &Apache::lonlocal::texthash (
181: cook => 'Bad Cookie',
182: your => 'Your cookie information is incorrect.',
183: );
184: return <<END;
185: <html>
186: <head><title>$lt{'cook'}</title></head>
187: <body>
188: $lt{'your'}
189: </body>
190: </html>
191: END
192:
193: }
194:
195: #############################################
196: #############################################
197:
198: =pod
199:
200: =cgi_getitems()
201:
202: Inputs: $query (the CGI query string), and $getitems, a reference to a hash
203:
204: Returns: nothing
205:
206: Side Effects: populates $getitems hash ref with key => value
207: where each key is the name of the form item in the query string
208: and value is an array of corresponding values.
209:
210: =cut
211:
212: #############################################
213: #############################################
214: sub cgi_getitems {
215: my ($query,$getitems)= @_;
216: foreach (split(/&/,$query)) {
217: my ($name, $value) = split(/=/,$_);
218: $name = &unescape($name);
219: $value =~ tr/+/ /;
220: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
221: push(@{$$getitems{$name}},$value);
222: }
223: return;
224: }
225:
226: =pod
227:
228: =back
229:
230: =cut
231:
232: 1;
233:
234: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>