[LON-CAPA-cvs] cvs: loncom /cgi lonauthcgi.pm loncgi.pm
raeburn
raeburn at source.lon-capa.org
Fri Oct 21 16:00:30 EDT 2011
raeburn Fri Oct 21 20:00:30 2011 EDT
Modified files:
/loncom/cgi loncgi.pm lonauthcgi.pm
Log:
- New routine: loncgi::cgi_header() generates HTTP response headers using CGI.pm
- New arg in lonauthcgi::can_view() - $domain (optional),
used if $page is needed for a specific domain.
- New return value: either 1, or a &-separated list of domains for which access is
allowed.
Index: loncom/cgi/loncgi.pm
diff -u loncom/cgi/loncgi.pm:1.11 loncom/cgi/loncgi.pm:1.12
--- loncom/cgi/loncgi.pm:1.11 Thu Dec 25 01:51:03 2008
+++ loncom/cgi/loncgi.pm Fri Oct 21 20:00:30 2011
@@ -1,7 +1,7 @@
#
# LON-CAPA helpers for cgi-bin scripts
#
-# $Id: loncgi.pm,v 1.11 2008/12/25 01:51:03 raeburn Exp $
+# $Id: loncgi.pm,v 1.12 2011/10/21 20:00:30 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -54,8 +54,9 @@
no warnings 'uninitialized';
use lib '/home/httpd/lib/perl/';
-use CGI();
+use CGI qw(:standard);
use CGI::Cookie();
+use MIME::Types();
use Fcntl qw(:flock);
use LONCAPA;
use LONCAPA::Configuration();
@@ -223,6 +224,39 @@
return;
}
+#############################################
+#############################################
+
+=pod
+
+=cgi_header()
+
+Inputs: $contenttype - Content Type (e.g., text/html or text/plain)
+ $nocache - Boolean 1 = nocache
+Returns: HTTP Response headers constructed using CGI.pm
+
+=cut
+
+#############################################
+#############################################
+sub cgi_header {
+ my ($contenttype,$nocache) = @_;
+ my $mimetypes = MIME::Types->new;
+ my %headers;
+ if ($contenttype ne '') {
+ if ($mimetypes->type($contenttype) ne '') {
+ $headers{'-type'} = $contenttype;
+ }
+ }
+ if ($nocache) {
+ $headers{'-expires'} = 'now';
+ }
+ if (%headers) {
+ return CGI::header(%headers);
+ }
+ return;
+}
+
=pod
=back
Index: loncom/cgi/lonauthcgi.pm
diff -u loncom/cgi/lonauthcgi.pm:1.8 loncom/cgi/lonauthcgi.pm:1.9
--- loncom/cgi/lonauthcgi.pm:1.8 Mon Oct 17 17:23:25 2011
+++ loncom/cgi/lonauthcgi.pm Fri Oct 21 20:00:30 2011
@@ -1,7 +1,7 @@
#
# LON-CAPA authorization for cgi-bin scripts
#
-# $Id: lonauthcgi.pm,v 1.8 2011/10/17 17:23:25 raeburn Exp $
+# $Id: lonauthcgi.pm,v 1.9 2011/10/21 20:00:30 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -225,15 +225,19 @@
Inputs: $page, the identifier of the page to be viewed,
can be one of the keys in the hash from &serverstatus_titles()
+ $domain (optional), a specific domain for which the page is needed.
-Returns: 1 if access to the page is permitted.
+Returns: 1 if access to the page is permitted, or &-separated list of domains
+ for which access is allowed, if $page is domconf, and not superuser.
Access allowed if one of the following is true:
(a) Requestor has LON-CAPA superuser role
- (b) Requestor's role is Domain Coordinator in one of the domains
+ (b) Requestor's role is Domain Coordinator in requested domain
+ (if specified) or (if unspecified) in one of the domains
hosted on this server
- (c) Domain configurations for domains hosted on this server include
- the requestor as one of the named users (username:domain) with access
- to the page.
+ (c) The domain configuration for the particular domain (if specified),
+ or domain configurations for domains hosted on this server (if
+ specific domain not specified), include the requestor as one of
+ the named users (username:domain) with access to the page.
In the case of requests for the 'showenv' page (/adm/test), the domains tested
are not the domains hosted on the server, but instead are a single domain -
@@ -246,7 +250,7 @@
#############################################
#############################################
sub can_view {
- my ($page) = @_;
+ my ($page,$domain) = @_;
my $allowed;
if ($Apache::lonnet::env{'request.role'} =~ m{^su\./}) {
$allowed = 1;
@@ -267,25 +271,43 @@
}
} else {
@poss_domains = &Apache::lonnet::current_machine_domains();
+ if ($domain ne '') {
+ if (grep(/^\Q$domain\E$/, at poss_domains)) {
+ @poss_domains = ($domain);
+ } else {
+ undef(@poss_domains);
+ }
+ }
}
unless ($allowed) {
foreach my $dom (@poss_domains) {
my %domconfig = &Apache::lonnet::get_dom('configuration',['serverstatuses'],
$dom);
if ($Apache::lonnet::env{'request.role'} eq "dc./$dom/") {
- $allowed = 1;
+ if ($page eq 'domconf') {
+ $allowed .= $dom.'&';
+ } else {
+ $allowed = 1;
+ }
} elsif (ref($domconfig{'serverstatuses'}) eq 'HASH') {
if (ref($domconfig{'serverstatuses'}{$page}) eq 'HASH') {
if ($domconfig{'serverstatuses'}{$page}{'namedusers'} ne '') {
my @okusers = split(/,/,$domconfig{'serverstatuses'}{$page}{'namedusers'});
if (grep(/^\Q$Apache::lonnet::env{'user.name'}:$Apache::lonnet::env{'user.domain'}\E$/, at okusers)) {
- $allowed = 1;
+ if ($page eq 'domconf') {
+ $allowed .= $dom.'&';
+ } else {
+ $allowed = 1;
+ }
+ }
+ unless ($page eq 'domconf') {
+ last if ($allowed);
}
}
}
}
- last if $allowed;
}
+ $allowed =~ s/\&$//;
}
}
return $allowed;
@@ -362,6 +384,8 @@
'takeonline' => 'Online - restore Log-in page',
'showenv' => 'Show user environment',
'toggledebug' => 'Toggle debug messages',
+ 'ping' => 'Cause server to ping another server',
+ 'domconf' => 'Text Display of Domain Configuration',
);
return \%titles;
}
More information about the LON-CAPA-cvs
mailing list