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