File:
[LON-CAPA] /
loncom /
cgi /
loncgi.pm
Revision
1.9:
download - view:
text,
annotated -
select for diffs
Fri Nov 28 20:39:43 2008 UTC (15 years, 7 months ago) by
raeburn
Branches:
MAIN
CVS tags:
HEAD
- Added subroutines: check_ipbased_access(), can_view(), missing_cookie_msg(),
serverstatus_titles(), and get_items() for use in checking access for a
number of server status scripts in /home/httpd/cgi-bin
- Added localization.
- Updated documentation.
1: #
2: # LON-CAPA helpers for cgi-bin scripts
3: #
4: # $Id: loncgi.pm,v 1.9 2008/11/28 20:39:43 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, retrieving arguments passed in via a CGI's Query String,
41: checking access controls, providing a user with an explanation
42: when access is denied, and descriptions of various server status pages
43: generated by CGI scripts which use these subroutines for authorization.
44:
45: =head1 Subroutines
46:
47: =over 4
48:
49: =cut
50:
51: #############################################
52: #############################################
53: package LONCAPA::loncgi;
54:
55: use strict;
56: use warnings FATAL=>'all';
57: no warnings 'uninitialized';
58:
59: use lib '/home/httpd/lib/perl/';
60: use CGI();
61: use CGI::Cookie();
62: use Fcntl qw(:flock);
63: use LONCAPA;
64: use LONCAPA::Configuration();
65: use GDBM_File;
66: use Apache::lonlocal;
67:
68: my $lonidsdir;
69:
70: BEGIN {
71: my $perlvar=LONCAPA::Configuration::read_conf('loncapa.conf');
72: delete $perlvar->{'lonReceipt'};
73: $lonidsdir = $perlvar->{'lonIDsDir'};
74: }
75:
76:
77: #############################################
78: #############################################
79:
80: =pod
81:
82: =item check_cookie_and_load_env()
83:
84: Inputs: none
85:
86: Returns: 1 if the user has a LON-CAPA cookie 0 if not.
87: Loads the users environment into the %env hash if the cookie is correct.
88:
89: =cut
90:
91: #############################################
92: #############################################
93: sub check_cookie_and_load_env {
94: my %cookies=fetch CGI::Cookie;
95: if (exists($cookies{'lonID'}) &&
96: -e "$lonidsdir/".$cookies{'lonID'}->value.".id") {
97: # cookie found
98: &transfer_profile_to_env($cookies{'lonID'}->value);
99: return 1;
100: } else {
101: # No cookie found
102: return 0;
103: }
104: }
105:
106: #############################################
107: #############################################
108:
109: =pod
110:
111: =item check_cookie()
112:
113: Inputs: none
114:
115: Returns: 1 if the user has a LON-CAPA cookie and 0 if not.
116:
117: =cut
118:
119: #############################################
120: #############################################
121: sub check_cookie {
122: my %cookies=fetch CGI::Cookie;
123: if (exists($cookies{'lonID'}) &&
124: -e "$lonidsdir/".$cookies{'lonID'}->value.".id") {
125: # cookie found
126: return 1;
127: } else {
128: # No cookie found
129: return 0;
130: }
131: }
132:
133: #############################################
134: #############################################
135:
136: =pod
137:
138: =item transfer_profile_to_env()
139:
140: Load the users environment into the %env hash.
141:
142: Inputs: $handle, the name of the users LON-CAPA cookie.
143:
144: Returns: undef
145:
146: =cut
147:
148: #############################################
149: #############################################
150: sub transfer_profile_to_env {
151: my ($handle)=@_;
152: if (tie(my %disk_env,'GDBM_File',"$lonidsdir/$handle.id",&GDBM_READER(),
153: 0640)) {
154: %Apache::lonnet::env = %disk_env;
155: untie(%disk_env);
156: }
157: $Apache::lonnet::env{'user.environment'} = "$lonidsdir/$handle.id";
158: return undef;
159: }
160:
161: #############################################
162: #############################################
163:
164: =pod
165:
166: =item check_ipbased_access()
167:
168: Inputs: $page, the identifier of the page to be viewed,
169: can be one of the keys in the hash from &serverstatus_titles()
170:
171: $ip, the IP address of the client requesting the page.
172:
173: Returns: 1 if access is permitted for the requestor's IP.
174: Access is allowed if on of the following is true:
175: (a) the requestor IP is the loopback address
176: (b) Domain configurations for domains hosted on this server include
177: the requestor's IP as one of the specified IPs with access
178: to this page. (does not apply to 'ping' page type)
179: =cut
180:
181: #############################################
182: #############################################
183: sub check_ipbased_access {
184: my ($page,$ip) = @_;
185: my $allowed;
186: if (!defined($ip)) {
187: $ip = $ENV{'REMOTE_ADDR'};
188: }
189: if (($page ne 'lonstatus') && ($page ne 'serverstatus')) {
190: if ($ip eq '127.0.0.1') {
191: $allowed = 1;
192: return $allowed;
193: }
194: }
195: if ($page ne 'ping') {
196: my @poss_domains = &Apache::lonnet::current_machine_domains();
197: foreach my $dom (@poss_domains) {
198: my %domconfig = &Apache::lonnet::get_dom('configuration',['serverstatuses'],$dom);
199: if (ref($domconfig{'serverstatuses'}) eq 'HASH') {
200: if (ref($domconfig{'serverstatuses'}{$page}) eq 'HASH') {
201: if ($domconfig{'serverstatuses'}{$page}{'machines'} ne '') {
202: my @okmachines = split(/,/,$domconfig{'serverstatuses'}{$page}{'machines'});
203: if (grep(/^\Q$ip\E$/,@okmachines)) {
204: $allowed = 1;
205: last;
206: }
207: }
208: }
209: }
210: }
211: }
212: return $allowed;
213: }
214:
215: #############################################
216: #############################################
217:
218: =pod
219:
220: =item can_view()
221:
222: Inputs: $page, the identifier of the page to be viewed,
223: can be one of the keys in the hash from &serverstatus_titles()
224:
225: Returns: 1 if access to the page is permitted.
226: Access allowed if one of the following is true:
227: (a) Requestor has LON-CAPA superuser role
228: (b) Requestor's role is Domain Coordinator in one of the domains
229: hosted on this server
230: (c) Domain configurations for domains hosted on this server include
231: the requestor as one of the named users (username:domain) with access
232: to the page.
233:
234: In the case of requests for the 'ping' page, and access is also allowed if
235: at least one domain hosted on requestor's server is also hosted on this server.
236:
237: =cut
238:
239: #############################################
240: #############################################
241: sub can_view {
242: my ($page) = @_;
243: my $allowed;
244: if ($Apache::lonnet::env{'request.role'} =~ m{^su\./}) {
245: $allowed = 1;
246: } elsif ($page eq 'ping') {
247: my @poss_domains = &Apache::lonnet::current_machine_domains();
248: my @hostids= &Apache::lonnet::get_hosts_from_ip($ENV{'REMOTE_ADDR'});
249: foreach my $hostid (@hostids) {
250: my $hostdom = &Apache::lonnet::host_domain($hostid);
251: if (grep(/^\Q$hostdom\E$/,@poss_domains)) {
252: $allowed = 1;
253: last;
254: }
255: }
256: } else {
257: my @poss_domains = &Apache::lonnet::current_machine_domains();
258: foreach my $dom (@poss_domains) {
259: my %domconfig = &Apache::lonnet::get_dom('configuration',['serverstatuses'],$dom);
260: if ($Apache::lonnet::env{'request.role'} eq "dc./$dom/") {
261: $allowed = 1;
262: } elsif (ref($domconfig{'serverstatuses'}) eq 'HASH') {
263: if (ref($domconfig{'serverstatuses'}{$page}) eq 'HASH') {
264: if ($domconfig{'serverstatuses'}{$page}{'namedusers'} ne '') {
265: my @okusers = split(/,/,$domconfig{'serverstatuses'}{$page}{'namedusers'});
266: if (grep(/^\Q$Apache::lonnet::env{'user.name'}:$Apache::lonnet::env{'user.domain'}\E$/,@okusers)) {
267: $allowed = 1;
268: }
269: }
270: }
271: }
272: last if $allowed;
273: }
274: }
275: return $allowed;
276: }
277:
278: #############################################
279: #############################################
280:
281: =pod
282:
283: =unauthorized_msg()
284:
285: Inputs: $page, the identifier of the page to be viewed,
286: can be one of the keys in the hash from &serverstatus_titles()
287:
288: Returns: A string explaining why access was denied for the particular page.
289:
290: =cut
291:
292: #############################################
293: #############################################
294: sub unauthorized_msg {
295: my ($page) = @_;
296: my $titles = &serverstatus_titles();
297: if ($page eq 'clusterstatus') {
298: return &mt('Your current role does not permit you to view the requested server status page: [_1]',$titles->{$page});
299: }
300: my @poss_domains = &Apache::lonnet::current_machine_domains();
301: if (@poss_domains == 1) {
302: my $domdesc = &Apache::lonnet::domain($poss_domains[0]);
303: return &mt('The configuration for domain: [_1] does not permit you to view the requested server status page: [_2].',"$domdesc ($poss_domains[0])",$titles->{$page});
304: } elsif (@poss_domains > 1) {
305: my $output = &mt('Configurations for the domains housed on this server: ').'<ul>';
306: foreach my $dom (@poss_domains) {
307: my $domdesc = &Apache::lonnet::domain($dom);
308: $output .= '<li>'.&Apache::lonnet::domain($dom).'('.$dom.')</li>';
309: }
310: $output .= '</ul>'.&mt('do not permit you to view the requested server status page: [_1]',$titles->{$page});
311: return $output;
312: } else {
313: return &mt('No domain information exists for this server');
314: }
315: }
316:
317: #############################################
318: #############################################
319:
320: =pod
321:
322: =item missing_cookie_msg()
323:
324: Inputs: none
325: Returns: HTML for a page indicating cookie information absent.
326:
327: =cut
328:
329: #############################################
330: #############################################
331: sub missing_cookie_msg {
332: my %lt = &Apache::lonlocal::texthash (
333: cook => 'Bad Cookie',
334: your => 'Your cookie information is incorrect.',
335: );
336: return <<END;
337: <html>
338: <head><title>$lt{'cook'}</title></head>
339: <body>
340: $lt{'your'}
341: </body>
342: </html>
343: END
344:
345: }
346:
347: #############################################
348: #############################################
349:
350: =pod
351:
352: =item serverstatus_titles()
353:
354: Inputs: none
355:
356: Returns: a reference to a hash of pages, where in the hash
357: keys are names of pages which employ loncgi.pm
358: or lonstatusacc.pm for access control,
359: and corresponding values are descriptions of each page
360:
361: =cut
362:
363: #############################################
364: #############################################
365: sub serverstatus_titles {
366: my %titles = &Apache::lonlocal::texthash (
367: 'userstatus' => 'User Status Summary',
368: 'lonstatus' => 'Display Detailed Report',
369: 'loncron' => 'Generate Detailed Report',
370: 'server-status' => 'Apache Status Page',
371: 'codeversions' => 'LON-CAPA Module Versions',
372: 'clusterstatus' => 'Domain status',
373: 'metadata_keywords' => 'Display Metadata Keywords',
374: 'metadata_harvest' => 'Harvest Metadata Searches',
375: 'takeoffline' => 'Offline - replace Log-in page',
376: 'takeonline' => 'Online - restore Log-in page',
377: 'showenv' => "Show user environment",
378: );
379: return \%titles;
380: }
381:
382: #############################################
383: #############################################
384:
385: =pod
386:
387: =cgi_getitems()
388:
389: Inputs: $query (the CGI query string), and $getitems, a reference to a hash
390:
391: Returns: nothing
392:
393: Side Effects: populates $getitems hash ref with key => value
394: where each key is the name of the form item in the query string
395: and value is an array of corresponding values.
396: =cut
397:
398: #############################################
399: #############################################
400: sub cgi_getitems {
401: my ($query,$getitems)= @_;
402: foreach (split(/&/,$query)) {
403: my ($name, $value) = split(/=/,$_);
404: $name = &unescape($name);
405: $value =~ tr/+/ /;
406: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
407: push(@{$$getitems{$name}},$value);
408: }
409: return;
410: }
411:
412: =pod
413:
414: =back
415:
416: =cut
417:
418: 1;
419:
420: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>