Annotation of loncom/cgi/loncgi.pm, revision 1.11
1.1 matthew 1: #
2: # LON-CAPA helpers for cgi-bin scripts
3: #
1.11 ! raeburn 4: # $Id: loncgi.pm,v 1.10 2008/11/30 14:47:18 raeburn Exp $
1.1 matthew 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:
1.9 raeburn 39: Provides subroutines for checking a LON-CAPA cookie, loading the user's
1.11 ! raeburn 40: environment, and retrieving arguments passed in via a CGI's Query String.
1.1 matthew 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';
1.2 albertel 55:
1.7 albertel 56: use lib '/home/httpd/lib/perl/';
1.1 matthew 57: use CGI();
58: use CGI::Cookie();
59: use Fcntl qw(:flock);
1.7 albertel 60: use LONCAPA;
1.1 matthew 61: use LONCAPA::Configuration();
1.8 albertel 62: use GDBM_File;
1.9 raeburn 63: use Apache::lonlocal;
1.1 matthew 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:
1.9 raeburn 73:
1.1 matthew 74: #############################################
75: #############################################
76:
77: =pod
78:
1.9 raeburn 79: =item check_cookie_and_load_env()
1.1 matthew 80:
1.10 raeburn 81: Inputs: 1 ( optional). When called from a handler in mod_perl,
82: pass in the request object.
1.1 matthew 83:
84: Returns: 1 if the user has a LON-CAPA cookie 0 if not.
1.3 albertel 85: Loads the users environment into the %env hash if the cookie is correct.
1.1 matthew 86:
87: =cut
88:
89: #############################################
90: #############################################
91: sub check_cookie_and_load_env {
1.10 raeburn 92: my ($r) = @_;
93: my %cookies;
94: if (ref($r)) {
95: %cookies = CGI::Cookie->fetch($r);
96: } else {
97: %cookies = CGI::Cookie->fetch();
98: }
1.1 matthew 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:
1.9 raeburn 115: =item check_cookie()
1.1 matthew 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:
1.9 raeburn 142: =item transfer_profile_to_env()
1.1 matthew 143:
1.3 albertel 144: Load the users environment into the %env hash.
1.1 matthew 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)=@_;
1.8 albertel 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);
1.1 matthew 160: }
1.4 albertel 161: $Apache::lonnet::env{'user.environment'} = "$lonidsdir/$handle.id";
1.1 matthew 162: return undef;
163: }
164:
165: #############################################
166: #############################################
167:
1.9 raeburn 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.
1.11 ! raeburn 209:
1.9 raeburn 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: }
1.6 albertel 225:
1.1 matthew 226: =pod
227:
228: =back
229:
230: =cut
231:
232: 1;
233:
234: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to loncgi.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / cgi