Annotation of loncom/cgi/lonauthcgi.pm, revision 1.7
1.1 raeburn 1: #
2: # LON-CAPA authorization for cgi-bin scripts
3: #
1.7 ! raeburn 4: # $Id: lonauthcgi.pm,v 1.6 2010/04/14 18:06:22 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:
35: loncgi
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;
1.7 ! raeburn 62: use LONCAPA::Configuration();
1.1 raeburn 63:
64: #############################################
65: #############################################
66:
67: =pod
68:
69: =item check_ipbased_access()
70:
71: Inputs: $page, the identifier of the page to be viewed,
72: can be one of the keys in the hash from &serverstatus_titles()
73:
74: $ip, the IP address of the client requesting the page.
75:
76: Returns: 1 if access is permitted for the requestor's IP.
77: Access is allowed if on of the following is true:
78: (a) the requestor IP is the loopback address
79: (b) Domain configurations for domains hosted on this server include
80: the requestor's IP as one of the specified IPs with access
81: to this page. (does not apply to 'ping' page type)
82:
83: =cut
84:
85: #############################################
86: #############################################
87: sub check_ipbased_access {
88: my ($page,$ip) = @_;
89: my $allowed;
90: if (!defined($ip)) {
91: $ip = $ENV{'REMOTE_ADDR'};
92: }
93: if (($page ne 'lonstatus') && ($page ne 'serverstatus')) {
94: if ($ip eq '127.0.0.1') {
95: $allowed = 1;
96: return $allowed;
97: }
98: }
1.7 ! raeburn 99: if (&is_manager_ip($ip)) {
! 100: $allowed = 1;
! 101: return $allowed;
! 102: }
1.1 raeburn 103: if ($page ne 'ping') {
104: my @poss_domains = &Apache::lonnet::current_machine_domains();
105: foreach my $dom (@poss_domains) {
106: my %domconfig = &Apache::lonnet::get_dom('configuration',['serverstatuses'],$dom);
107: if (ref($domconfig{'serverstatuses'}) eq 'HASH') {
108: if (ref($domconfig{'serverstatuses'}{$page}) eq 'HASH') {
109: if ($domconfig{'serverstatuses'}{$page}{'machines'} ne '') {
110: my @okmachines = split(/,/,$domconfig{'serverstatuses'}{$page}{'machines'});
111: if (grep(/^\Q$ip\E$/,@okmachines)) {
112: $allowed = 1;
113: last;
114: }
115: }
116: }
117: }
118: }
119: }
120: return $allowed;
121: }
122:
123: #############################################
124: #############################################
125:
1.7 ! raeburn 126: sub is_manager_ip {
! 127: my ($remote_ip) = @_;
! 128: return if ($remote_ip eq '');
! 129: my ($directory,$is_manager);
! 130: my $config=LONCAPA::Configuration::read_conf();
! 131: if (ref($config) eq 'HASH') {
! 132: $directory = $config->{'lonTabDir'};
! 133: }
! 134: if (defined($directory)) {
! 135: if (open(MANAGERS, "$directory/managers.tab")) {
! 136: while(my $host = <MANAGERS>) {
! 137: chomp($host);
! 138: next if ($host =~ /^\#/);
! 139: my $ip = &Apache::lonnet::get_host_ip($host);
! 140: if (defined($ip)) {
! 141: if ($remote_ip eq $ip) {
! 142: $is_manager = 1;
! 143: last;
! 144: }
! 145: } else {
! 146: my ($cluname,$dnsname) = split(/:/, $host);
! 147: $ip = gethostbyname($dnsname);
! 148: if (defined($ip)) {
! 149: my $hostip = inet_ntoa($ip);
! 150: if ($hostip = $remote_ip) {
! 151: $is_manager = 1;
! 152: }
! 153: }
! 154: }
! 155: }
! 156: close(MANAGERS);
! 157: }
! 158: }
! 159: return $is_manager;
! 160: }
! 161:
! 162: #############################################
! 163: #############################################
! 164:
1.1 raeburn 165: =pod
166:
167: =item can_view()
168:
169: Inputs: $page, the identifier of the page to be viewed,
170: can be one of the keys in the hash from &serverstatus_titles()
171:
172: Returns: 1 if access to the page is permitted.
173: Access allowed if one of the following is true:
174: (a) Requestor has LON-CAPA superuser role
175: (b) Requestor's role is Domain Coordinator in one of the domains
176: hosted on this server
177: (c) Domain configurations for domains hosted on this server include
178: the requestor as one of the named users (username:domain) with access
179: to the page.
180:
1.3 raeburn 181: In the case of requests for the 'ping' page, access is also allowed if
1.1 raeburn 182: at least one domain hosted on requestor's server is also hosted on this server.
183:
1.3 raeburn 184: In the case of requests for the 'showenv' page (/adm/test), the domains tested
185: are not the domains hosted on the server, but instead are a single domain -
186: the domain of the requestor. In addition, if the requestor has an active
187: Domain Coordinator role for that domain, access is permitted, regardless of
188: the requestor's current role.
1.1 raeburn 189: =cut
190:
191: #############################################
192: #############################################
193: sub can_view {
194: my ($page) = @_;
195: my $allowed;
196: if ($Apache::lonnet::env{'request.role'} =~ m{^su\./}) {
197: $allowed = 1;
198: } elsif ($page eq 'ping') {
199: my @poss_domains = &Apache::lonnet::current_machine_domains();
200: my @hostids= &Apache::lonnet::get_hosts_from_ip($ENV{'REMOTE_ADDR'});
201: foreach my $hostid (@hostids) {
202: my $hostdom = &Apache::lonnet::host_domain($hostid);
203: if (grep(/^\Q$hostdom\E$/,@poss_domains)) {
204: $allowed = 1;
205: last;
206: }
207: }
208: } else {
1.3 raeburn 209: my @poss_domains;
210: if ($page eq 'showenv') {
211: @poss_domains = ($env{'user.domain'});
212: my $envkey = 'user.role.dc./'.$poss_domains[0].'/';
213: if (exists($Apache::lonnet::env{$envkey})) {
214: my $livedc = 1;
215: my $then = $Apache::lonnet::env{'user.login.time'};
216: my ($tstart,$tend)=split(/\./,$Apache::lonnet::env{$envkey});
217: if ($tstart && $tstart>$then) { $livedc = 0; }
218: if ($tend && $tend <$then) { $livedc = 0; }
219: if ($livedc) {
220: $allowed = 1;
221: }
222: }
223: } else {
224: @poss_domains = &Apache::lonnet::current_machine_domains();
225: }
226: unless ($allowed) {
227: foreach my $dom (@poss_domains) {
228: my %domconfig = &Apache::lonnet::get_dom('configuration',['serverstatuses'],
229: $dom);
230: if ($Apache::lonnet::env{'request.role'} eq "dc./$dom/") {
231: $allowed = 1;
232: } elsif (ref($domconfig{'serverstatuses'}) eq 'HASH') {
233: if (ref($domconfig{'serverstatuses'}{$page}) eq 'HASH') {
234: if ($domconfig{'serverstatuses'}{$page}{'namedusers'} ne '') {
235: my @okusers = split(/,/,$domconfig{'serverstatuses'}{$page}{'namedusers'});
236: if (grep(/^\Q$Apache::lonnet::env{'user.name'}:$Apache::lonnet::env{'user.domain'}\E$/,@okusers)) {
237: $allowed = 1;
238: }
1.1 raeburn 239: }
240: }
241: }
1.4 raeburn 242: last if $allowed;
1.1 raeburn 243: }
244: }
245: }
246: return $allowed;
247: }
248:
249: #############################################
250: #############################################
251:
252: =pod
253:
254: =unauthorized_msg()
255:
256: Inputs: $page, the identifier of the page to be viewed,
257: can be one of the keys in the hash from &serverstatus_titles()
258:
259: Returns: A string explaining why access was denied for the particular page.
260:
261: =cut
262:
263: #############################################
264: #############################################
265: sub unauthorized_msg {
266: my ($page) = @_;
267: my $titles = &serverstatus_titles();
268: if ($page eq 'clusterstatus') {
269: return &mt('Your current role does not permit you to view the requested server status page: [_1]',$titles->{$page});
270: }
271: my @poss_domains = &Apache::lonnet::current_machine_domains();
272: if (@poss_domains == 1) {
273: my $domdesc = &Apache::lonnet::domain($poss_domains[0]);
274: 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});
275: } elsif (@poss_domains > 1) {
276: my $output = &mt('Configurations for the domains housed on this server: ').'<ul>';
277: foreach my $dom (@poss_domains) {
278: my $domdesc = &Apache::lonnet::domain($dom);
279: $output .= '<li>'.&Apache::lonnet::domain($dom).'('.$dom.')</li>';
280: }
281: $output .= '</ul>'.&mt('do not permit you to view the requested server status page: [_1]',$titles->{$page});
282: return $output;
283: } else {
284: return &mt('No domain information exists for this server');
285: }
286: }
287:
288: #############################################
289: #############################################
290:
291: =pod
292:
293: =item serverstatus_titles()
294:
295: Inputs: none
296:
297: Returns: a reference to a hash of pages, where in the hash
298: keys are names of pages which employ loncgi.pm
299: or lonstatusacc.pm for access control,
300: and corresponding values are descriptions of each page
301:
302: =cut
303:
304: #############################################
305: #############################################
306: sub serverstatus_titles {
307: my %titles = &Apache::lonlocal::texthash (
308: 'userstatus' => 'User Status Summary',
309: 'lonstatus' => 'Display Detailed Report',
310: 'loncron' => 'Generate Detailed Report',
311: 'server-status' => 'Apache Status Page',
312: 'codeversions' => 'LON-CAPA Module Versions',
313: 'clusterstatus' => 'Domain status',
314: 'metadata_keywords' => 'Display Metadata Keywords',
315: 'metadata_harvest' => 'Harvest Metadata Searches',
316: 'takeoffline' => 'Offline - replace Log-in page',
317: 'takeonline' => 'Online - restore Log-in page',
1.6 raeburn 318: 'showenv' => 'Show user environment',
319: 'toggledebug' => 'Toggle debug messages',
1.1 raeburn 320: );
321: return \%titles;
322: }
323:
324:
325: 1;
326:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>