Annotation of loncom/cgi/lonauthcgi.pm, revision 1.12
1.1 raeburn 1: #
2: # LON-CAPA authorization for cgi-bin scripts
3: #
1.12 ! raeburn 4: # $Id: lonauthcgi.pm,v 1.11 2013/10/27 17:16:36 raeburn Exp $
1.1 raeburn 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:
1.8 raeburn 35: lonauthcgi
1.1 raeburn 36:
37: =head1 SYNOPSIS
38:
39: Provides subroutines for checking if access to cgi pages is allowed
40: based on IP address, or for logged-in users based on role and/or
41: identity. Also provides subroutines to give a user 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:
54: package LONCAPA::lonauthcgi;
55:
56: use strict;
57: use lib '/home/httpd/lib/perl';
1.7 raeburn 58: use Socket;
1.1 raeburn 59: use Apache::lonnet;
60: use Apache::lonlocal;
61: use LONCAPA;
62:
63: #############################################
64: #############################################
65:
66: =pod
67:
68: =item check_ipbased_access()
69:
70: Inputs: $page, the identifier of the page to be viewed,
71: can be one of the keys in the hash from &serverstatus_titles()
72:
73: $ip, the IP address of the client requesting the page.
74:
75: Returns: 1 if access is permitted for the requestor's IP.
1.8 raeburn 76: Access is allowed if one of the following is true:
77: (a) the requestor IP is the loopback address.
78: (b) the requestor IP is the IP of the current server.
79: (c) the requestor IP is the IP of a manager,
80: if the page to view is not "takeoffline" or "toggledebug"
81: (d) the requestor IP is the IP of a server belonging
82: to a domain included in domains hosted on this server.
83: (e) Domain configurations for domains hosted on this server include
1.1 raeburn 84: the requestor's IP as one of the specified IPs with access
1.8 raeburn 85: to this page. (not applicable to 'ping' page).
1.1 raeburn 86:
87: =cut
88:
89: #############################################
90: #############################################
91: sub check_ipbased_access {
92: my ($page,$ip) = @_;
93: my $allowed;
94: if (!defined($ip)) {
95: $ip = $ENV{'REMOTE_ADDR'};
96: }
1.8 raeburn 97: if ($ip eq '127.0.0.1') {
98: $allowed = 1;
99: return $allowed;
100: } else {
101: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
102: my $host_ip = &Apache::lonnet::get_host_ip($lonhost);
103: if (($host_ip ne '') && ($host_ip eq $ip)) {
1.1 raeburn 104: $allowed = 1;
105: return $allowed;
106: }
107: }
1.7 raeburn 108: if (&is_manager_ip($ip)) {
1.8 raeburn 109: unless (($page eq 'toggledebug') || ($page eq 'takeoffline')) {
110: $allowed = 1;
111: return $allowed;
112: }
113: }
114: if (&check_domain_ip($ip)) {
1.7 raeburn 115: $allowed = 1;
116: return $allowed;
117: }
1.1 raeburn 118: if ($page ne 'ping') {
119: my @poss_domains = &Apache::lonnet::current_machine_domains();
120: foreach my $dom (@poss_domains) {
121: my %domconfig = &Apache::lonnet::get_dom('configuration',['serverstatuses'],$dom);
122: if (ref($domconfig{'serverstatuses'}) eq 'HASH') {
123: if (ref($domconfig{'serverstatuses'}{$page}) eq 'HASH') {
124: if ($domconfig{'serverstatuses'}{$page}{'machines'} ne '') {
125: my @okmachines = split(/,/,$domconfig{'serverstatuses'}{$page}{'machines'});
126: if (grep(/^\Q$ip\E$/,@okmachines)) {
127: $allowed = 1;
128: last;
129: }
130: }
131: }
132: }
133: }
134: }
135: return $allowed;
136: }
137:
138: #############################################
139: #############################################
140:
1.8 raeburn 141: =pod
142:
143: =item is_manager_ip()
144:
145: Inputs: $remote_ip, the IP address of the client requesting the page.
146:
147: Returns: 1 if the client IP address corresponds to that of a
148: machine listed in /home/httpd/lonTabs/managers.tab
149:
150: =cut
151:
152: #############################################
153: #############################################
1.7 raeburn 154: sub is_manager_ip {
155: my ($remote_ip) = @_;
156: return if ($remote_ip eq '');
157: my ($directory,$is_manager);
1.8 raeburn 158: foreach my $key (keys(%Apache::lonnet::managerstab)) {
159: my $manager_ip;
160: if ($key =~ /:/) {
161: my ($cluname,$dnsname) = split(/:/,$key);
162: my $ip = gethostbyname($dnsname);
163: if (defined($ip)) {
164: $manager_ip = inet_ntoa($ip);
165: }
166: } else {
167: $manager_ip = &Apache::lonnet::get_host_ip($key);
168: }
169: if (defined($manager_ip)) {
170: if ($remote_ip eq $manager_ip) {
171: $is_manager = 1;
172: last;
173: }
174: }
1.7 raeburn 175: }
1.8 raeburn 176: return $is_manager;
177: }
178:
179: #############################################
180: #############################################
181:
182: =pod
183:
184: =item check_domain_ip()
185:
186: Inputs: $remote_ip, the IP address of the client requesting the page.
187:
188: Returns: 1 if the client IP address is for a machine in the cluster
189: and domain in common for client machine and this machine.
190:
191: =cut
192:
193: #############################################
194: #############################################
195: sub check_domain_ip {
196: my ($remote_ip) = @_;
197: my %remote_doms;
198: my $allowed;
199: if ($remote_ip ne '') {
200: if (&Apache::lonnet::hostname($remote_ip) ne '') {
201: my @poss_domains = &Apache::lonnet::current_machine_domains();
202: if (@poss_domains > 0) {
203: my @remote_hosts = &Apache::lonnet::get_hosts_from_ip($remote_ip);
204: foreach my $hostid (@remote_hosts) {
205: my $hostdom = &Apache::lonnet::host_domain($hostid);
206: if ($hostdom ne '') {
207: if (grep(/^\Q$hostdom\E$/,@poss_domains)) {
208: $allowed = 1;
209: last;
1.7 raeburn 210: }
211: }
212: }
213: }
214: }
215: }
1.8 raeburn 216: return $allowed;
1.7 raeburn 217: }
218:
219: #############################################
220: #############################################
221:
1.1 raeburn 222: =pod
223:
224: =item can_view()
225:
226: Inputs: $page, the identifier of the page to be viewed,
227: can be one of the keys in the hash from &serverstatus_titles()
1.9 raeburn 228: $domain (optional), a specific domain for which the page is needed.
1.1 raeburn 229:
1.9 raeburn 230: Returns: 1 if access to the page is permitted, or &-separated list of domains
231: for which access is allowed, if $page is domconf, and not superuser.
1.1 raeburn 232: Access allowed if one of the following is true:
233: (a) Requestor has LON-CAPA superuser role
1.9 raeburn 234: (b) Requestor's role is Domain Coordinator in requested domain
235: (if specified) or (if unspecified) in one of the domains
1.1 raeburn 236: hosted on this server
1.9 raeburn 237: (c) The domain configuration for the particular domain (if specified),
238: or domain configurations for domains hosted on this server (if
239: specific domain not specified), include the requestor as one of
240: the named users (username:domain) with access to the page.
1.1 raeburn 241:
1.3 raeburn 242: In the case of requests for the 'showenv' page (/adm/test), the domains tested
243: are not the domains hosted on the server, but instead are a single domain -
244: the domain of the requestor. In addition, if the requestor has an active
245: Domain Coordinator role for that domain, access is permitted, regardless of
246: the requestor's current role.
1.8 raeburn 247:
1.1 raeburn 248: =cut
249:
250: #############################################
251: #############################################
252: sub can_view {
1.9 raeburn 253: my ($page,$domain) = @_;
1.1 raeburn 254: my $allowed;
255: if ($Apache::lonnet::env{'request.role'} =~ m{^su\./}) {
256: $allowed = 1;
257: } else {
1.3 raeburn 258: my @poss_domains;
259: if ($page eq 'showenv') {
260: @poss_domains = ($env{'user.domain'});
261: my $envkey = 'user.role.dc./'.$poss_domains[0].'/';
262: if (exists($Apache::lonnet::env{$envkey})) {
263: my $livedc = 1;
264: my $then = $Apache::lonnet::env{'user.login.time'};
265: my ($tstart,$tend)=split(/\./,$Apache::lonnet::env{$envkey});
266: if ($tstart && $tstart>$then) { $livedc = 0; }
267: if ($tend && $tend <$then) { $livedc = 0; }
268: if ($livedc) {
269: $allowed = 1;
270: }
271: }
272: } else {
273: @poss_domains = &Apache::lonnet::current_machine_domains();
1.9 raeburn 274: if ($domain ne '') {
275: if (grep(/^\Q$domain\E$/,@poss_domains)) {
276: @poss_domains = ($domain);
277: } else {
278: undef(@poss_domains);
279: }
280: }
1.3 raeburn 281: }
282: unless ($allowed) {
1.11 raeburn 283: my %alloweddoms;
1.3 raeburn 284: foreach my $dom (@poss_domains) {
285: my %domconfig = &Apache::lonnet::get_dom('configuration',['serverstatuses'],
286: $dom);
287: if ($Apache::lonnet::env{'request.role'} eq "dc./$dom/") {
1.9 raeburn 288: if ($page eq 'domconf') {
1.11 raeburn 289: $alloweddoms{$dom} = 1;
1.9 raeburn 290: } else {
291: $allowed = 1;
292: }
1.3 raeburn 293: } elsif (ref($domconfig{'serverstatuses'}) eq 'HASH') {
294: if (ref($domconfig{'serverstatuses'}{$page}) eq 'HASH') {
295: if ($domconfig{'serverstatuses'}{$page}{'namedusers'} ne '') {
296: my @okusers = split(/,/,$domconfig{'serverstatuses'}{$page}{'namedusers'});
297: if (grep(/^\Q$Apache::lonnet::env{'user.name'}:$Apache::lonnet::env{'user.domain'}\E$/,@okusers)) {
1.9 raeburn 298: if ($page eq 'domconf') {
1.11 raeburn 299: $alloweddoms{$dom} = 1;
1.9 raeburn 300: } else {
301: $allowed = 1;
302: }
303: }
304: unless ($page eq 'domconf') {
305: last if ($allowed);
1.3 raeburn 306: }
1.1 raeburn 307: }
308: }
309: }
310: }
1.11 raeburn 311: if (($page eq 'domconf') && (!$allowed)) {
312: $allowed = join('&',sort(keys(%alloweddoms)));
313: }
1.1 raeburn 314: }
315: }
316: return $allowed;
317: }
318:
319: #############################################
320: #############################################
321:
322: =pod
323:
1.8 raeburn 324: =item unauthorized_msg()
1.1 raeburn 325:
326: Inputs: $page, the identifier of the page to be viewed,
327: can be one of the keys in the hash from &serverstatus_titles()
328:
329: Returns: A string explaining why access was denied for the particular page.
330:
331: =cut
332:
333: #############################################
334: #############################################
335: sub unauthorized_msg {
336: my ($page) = @_;
337: my $titles = &serverstatus_titles();
338: if ($page eq 'clusterstatus') {
339: return &mt('Your current role does not permit you to view the requested server status page: [_1]',$titles->{$page});
340: }
341: my @poss_domains = &Apache::lonnet::current_machine_domains();
342: if (@poss_domains == 1) {
343: my $domdesc = &Apache::lonnet::domain($poss_domains[0]);
344: 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});
345: } elsif (@poss_domains > 1) {
346: my $output = &mt('Configurations for the domains housed on this server: ').'<ul>';
347: foreach my $dom (@poss_domains) {
348: my $domdesc = &Apache::lonnet::domain($dom);
349: $output .= '<li>'.&Apache::lonnet::domain($dom).'('.$dom.')</li>';
350: }
351: $output .= '</ul>'.&mt('do not permit you to view the requested server status page: [_1]',$titles->{$page});
352: return $output;
353: } else {
354: return &mt('No domain information exists for this server');
355: }
356: }
357:
358: #############################################
359: #############################################
360:
361: =pod
362:
363: =item serverstatus_titles()
364:
365: Inputs: none
366:
367: Returns: a reference to a hash of pages, where in the hash
368: keys are names of pages which employ loncgi.pm
369: or lonstatusacc.pm for access control,
370: and corresponding values are descriptions of each page
371:
372: =cut
373:
374: #############################################
375: #############################################
376: sub serverstatus_titles {
377: my %titles = &Apache::lonlocal::texthash (
378: 'userstatus' => 'User Status Summary',
379: 'lonstatus' => 'Display Detailed Report',
380: 'loncron' => 'Generate Detailed Report',
381: 'server-status' => 'Apache Status Page',
382: 'codeversions' => 'LON-CAPA Module Versions',
1.10 raeburn 383: 'checksums' => 'LON-CAPA Module Checking',
1.1 raeburn 384: 'clusterstatus' => 'Domain status',
385: 'metadata_keywords' => 'Display Metadata Keywords',
386: 'metadata_harvest' => 'Harvest Metadata Searches',
387: 'takeoffline' => 'Offline - replace Log-in page',
388: 'takeonline' => 'Online - restore Log-in page',
1.6 raeburn 389: 'showenv' => 'Show user environment',
390: 'toggledebug' => 'Toggle debug messages',
1.9 raeburn 391: 'ping' => 'Cause server to ping another server',
392: 'domconf' => 'Text Display of Domain Configuration',
1.12 ! raeburn 393: 'uniquecodes' => 'Six-character Course Codes',
1.1 raeburn 394: );
395: return \%titles;
396: }
397:
1.8 raeburn 398: =pod
399:
400: =back
401:
402: =cut
1.1 raeburn 403:
404: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonauthcgi.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / cgi