Annotation of loncom/cgi/listdomconfig.pl, revision 1.1
1.1 ! raeburn 1: #!/usr/bin/perl
! 2: $|=1;
! 3: # Domain Configuration Dump
! 4: # $Id: listdomconfig.pl,v 1.1 2011/10/19 19:30:49 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: listdomconfig.pl
! 36:
! 37: =head1 SYNOPSIS
! 38:
! 39: CGI script to display domain configuration as plain text.
! 40:
! 41: =head1 Subroutines
! 42:
! 43: =over 4
! 44:
! 45: =cut
! 46:
! 47: #############################################
! 48: #############################################
! 49:
! 50: use strict;
! 51:
! 52: use lib '/home/httpd/lib/perl/';
! 53: use LONCAPA::loncgi;
! 54: use LONCAPA::lonauthcgi;
! 55: use Apache::lonnet();
! 56: use Apache::lonlocal;
! 57: use LONCAPA;
! 58: use GDBM_File;
! 59: use Data::Dumper;
! 60: use Storable qw(thaw);
! 61: use GDBM_File;
! 62:
! 63: print &LONCAPA::loncgi::cgi_header('text/plain',1);
! 64:
! 65: &main();
! 66: exit 0;
! 67:
! 68: #############################################
! 69: #############################################
! 70:
! 71: =pod
! 72:
! 73: =item main()
! 74:
! 75: Inputs: None
! 76:
! 77: Returns: Nothing
! 78:
! 79: Description: Main program. Determines if requesting IP is allowed
! 80: to view domain configuration(s) for domains for
! 81: which this server is the primary library server.
! 82:
! 83: =cut
! 84:
! 85: #############################################
! 86: #############################################
! 87:
! 88: sub main {
! 89: my $remote_ip = $ENV{'REMOTE_ADDR'};
! 90: my $allowed;
! 91: if (&LONCAPA::lonauthcgi::check_ipbased_access('domconf',$remote_ip)) {
! 92: $allowed = 1;
! 93: } elsif (&LONCAPA::loncgi::check_cookie_and_load_env()) {
! 94: $allowed = &LONCAPA::lonauthcgi::can_view('domconf');
! 95: }
! 96: &LONCAPA::loncgi::check_cookie_and_load_env();
! 97: &Apache::lonlocal::get_language_handle();
! 98: if ($allowed ne '') {
! 99: my @okdoms;
! 100: unless ($allowed == 1) {
! 101: @okdoms = split(/\&/,$allowed);
! 102: }
! 103: my @hosts = &Apache::lonnet::current_machine_ids();
! 104: my $numshown = 0;
! 105: my $numnonprim = 0;
! 106: foreach my $lonhost (@hosts) {
! 107: my $dom = &Apache::lonnet::host_domain($lonhost);
! 108: unless ($allowed == 1) {
! 109: next unless (grep(/^\Q$dom\E$/,@okdoms));
! 110: }
! 111: my $prim_id = &Apache::lonnet::domain($dom,'primary');
! 112: if (($prim_id ne '') && (grep(/^\Q$prim_id\E$/,@hosts))) {
! 113: my $domdesc = &Apache::lonnet::domain($dom);
! 114: print &mt('Domain configuration for [_1]',"$domdesc ($dom)")."\n\n";
! 115: &show_config($dom);
! 116: print "\n";
! 117: $numshown ++;
! 118: } else {
! 119: $numnonprim ++;
! 120: }
! 121: }
! 122: if (!$numshown) {
! 123: if ($numnonprim) {
! 124: print &mt('This server is not a primary library server')."\n";
! 125: } else {
! 126: print &mt("You do not have access rights to view domain configuration for domain(s) hosted on this server.")."\n";
! 127: }
! 128: }
! 129: } else {
! 130: &LONCAPA::lonauthcgi::unauthorized_msg('domconf');
! 131: }
! 132: }
! 133:
! 134: #############################################
! 135: #############################################
! 136:
! 137: =pod
! 138:
! 139: =item show_config
! 140:
! 141: Inputs: $domain - domain for which domain configuration is to be shown
! 142:
! 143: Returns: Nothing
! 144:
! 145: Description: Displays plain text of domain configuration by dumping
! 146: contents of configuration.db
! 147:
! 148: =cut
! 149:
! 150: #############################################
! 151: #############################################
! 152:
! 153: sub show_config {
! 154: my ($dom) = @_;
! 155: my $lonusersdir = $Apache::lonnet::perlvar{'lonUsersDir'};
! 156: my $fname = $lonusersdir.'/'.$dom.'/configuration.db';
! 157: my $dbref=&LONCAPA::locking_hash_tie($fname,&GDBM_READER());
! 158: if (ref($dbref) eq 'HASH') {
! 159: foreach my $key (sort(keys(%{$dbref}))) {
! 160: my $value = $dbref->{$key};
! 161: if ($value =~ s/^__FROZEN__//) {
! 162: $value = thaw(&unescape($value));
! 163: }
! 164: $key = &unescape($key);
! 165: $value = &unescape($value) if (!ref($value));
! 166: print "$key = ".(ref($value)?Dumper($value):$value)."\n";
! 167: }
! 168: &LONCAPA::locking_hash_untie($dbref);
! 169: }
! 170: return;
! 171: }
! 172:
! 173: =pod
! 174:
! 175: =back
! 176:
! 177: =cut
! 178:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to listdomconfig.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / cgi