[LON-CAPA-cvs] cvs: loncom /cgi loncron.pl lonversions.pl metadata_harvest.pl metadata_keywords.pl ping.pl takeoffline.pl takeonline.pl
raeburn
raeburn@source.lon-capa.org
Fri, 28 Nov 2008 20:50:25 -0000
This is a MIME encoded message
--raeburn1227905425
Content-Type: text/plain
raeburn Fri Nov 28 20:50:25 2008 EDT
Modified files:
/loncom/cgi takeonline.pl takeoffline.pl ping.pl
metadata_keywords.pl metadata_harvest.pl lonversions.pl
loncron.pl
Log:
- Add localization
- Add &main() subroutine
- Access control uses routines from LONCAPA::loncgi
--raeburn1227905425
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20081128205025.txt"
Index: loncom/cgi/takeonline.pl
diff -u loncom/cgi/takeonline.pl:1.2 loncom/cgi/takeonline.pl:1.3
--- loncom/cgi/takeonline.pl:1.2 Thu Sep 11 20:54:11 2003
+++ loncom/cgi/takeonline.pl Fri Nov 28 20:50:25 2008
@@ -1,7 +1,8 @@
#!/usr/bin/perl
+$|=1;
# Take machine online
#
-# $Id: takeonline.pl,v 1.2 2003/09/11 20:54:11 www Exp $
+# $Id: takeonline.pl,v 1.3 2008/11/28 20:50:25 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -26,8 +27,34 @@
# http://www.lon-capa.org/
#
-print "Content-type: text/html\n\n".
- "<html><body bgcolor=#FFFFFF><h1>Take Online</h1>";
-system('cp /home/httpd/html/origindex.html /home/httpd/html/index.html');
-system('rm /home/httpd/html/lon-status/reroute.txt');
-print "</body></html>";
+use strict;
+use lib '/home/httpd/lib/perl/';
+use Apache::lonlocal;
+use LONCAPA::loncgi;
+
+print "Content-type: text/html\n\n";
+
+&main();
+
+sub main {
+ if (!&LONCAPA::loncgi::check_ipbased_access('takeonline')) {
+ if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
+ &Apache::lonlocal::get_language_handle();
+ print &LONCAPA::loncgi::missing_cookie_msg();
+ return;
+ }
+
+ if (!&LONCAPA::loncgi::can_view('takeonline')) {
+ &Apache::lonlocal::get_language_handle();
+ print &LONCAPA::loncgi::unauthorized_msg('takeonline');
+ return;
+ }
+ }
+
+ &Apache::lonlocal::get_language_handle();
+
+ print '<html><body bgcolor="#FFFFFF"><h1>'.&Apache::lonlocal::mt('Take Online').'</h1>';
+ system('cp /home/httpd/html/origindex.html /home/httpd/html/index.html');
+ system('rm /home/httpd/html/lon-status/reroute.txt');
+ print '</body></html>';
+}
Index: loncom/cgi/takeoffline.pl
diff -u loncom/cgi/takeoffline.pl:1.2 loncom/cgi/takeoffline.pl:1.3
--- loncom/cgi/takeoffline.pl:1.2 Thu Sep 11 20:54:11 2003
+++ loncom/cgi/takeoffline.pl Fri Nov 28 20:50:25 2008
@@ -1,7 +1,8 @@
#!/usr/bin/perl
+$|=1;
# Take machine offline, reroute traffic
#
-# $Id: takeoffline.pl,v 1.2 2003/09/11 20:54:11 www Exp $
+# $Id: takeoffline.pl,v 1.3 2008/11/28 20:50:25 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -26,31 +27,71 @@
# http://www.lon-capa.org/
#
-print "Content-type: text/html\n\n".
- "<html><body bgcolor=#FFFFFF><h1>Take Offline</h1>";
-unless ($ENV{'QUERY_STRING'}) {
- print 'No reroute server given, taking completely offline.';
- &dead();
-} else {
- ($otherserver,$domain)=split(/\&/,$ENV{'QUERY_STRING'});
- print 'Rerouting to '.$otherserver;
- &reroute();
-}
-open (STATUS,'>/home/httpd/html/lon-status/reroute.txt');
-print STATUS "status=rerouting&server=$otherserver&domain=$domain&time=".time."\n";
-close(STATUS);
+use strict;
+use lib '/home/httpd/lib/perl/';
+use Apache::lonlocal;
+use LONCAPA::loncgi;
+
+print "Content-type: text/html\n\n";
+
+&main();
+
+sub main {
+ if (!&LONCAPA::loncgi::check_ipbased_access('takeoffline')) {
+ if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
+ &Apache::lonlocal::get_language_handle();
+ print(&LONCAPA::loncgi::missing_cookie_msg());
+ return;
+ }
-print "</body></html>";
+ if (!&LONCAPA::loncgi::can_view('takeoffline')) {
+ &Apache::lonlocal::get_language_handle();
+ print(&LONCAPA::loncgi::unauthorized_msg('takeoffline'));
+ return;
+ }
+ }
+
+ &Apache::lonlocal::get_language_handle();
+
+ print '<html><body bgcolor="#FFFFFF"><h1>'.&Apache::lonlocal::mt('Take Offline').'</h1>';
+ my $statusmsg;
+ if ($ENV{'QUERY_STRING'}) {
+ my ($otherserver,$domain)=split(/\&/,$ENV{'QUERY_STRING'});
+ if (&reroute($otherserver,$domain)) {
+ print &Apache::lonlocal::mt('Rerouting to [_1]',$otherserver);
+ $statusmsg = "status=rerouting&server=$otherserver&domain=$domain&time=".time.
+ "by=$Apache::lonnet::env{'user.name'}:$Apache::lonnet::env{'user.domain'}";
+ }
+ } else {
+ if (&dead()) {
+ print &Apache::lonlocal::mt('No reroute server given, taking completely offline.');
+ $statusmsg = 'status=offline&time='.time."by=$Apache::lonnet::env{'user.name'}:$Apache::lonnet::env{'user.domain'}"
+ }
+ }
+ print "</body></html>";
+ if ($statusmsg) {
+ if (open (STATUS,'>/home/httpd/html/lon-status/reroute.txt')) {
+ print STATUS "$statusmsg\n";
+ close(STATUS);
+ } else {
+ print &Apache::lonlocal::mt('Logging of status change to [_1] failed.','reroute.txt');
+ }
+ }
+}
sub dead {
- open (OUT,'>/home/httpd/html/index.html');
- print OUT 'This LON-CAPA server is currently offline.';
- close(OUT);
+ if (open (OUT,'>/home/httpd/html/index.html')) {
+ print OUT &Apache::lonlocal::mt('This LON-CAPA server is currently offline.');
+ close(OUT);
+ return 'ok';
+ }
+ return;
}
sub reroute {
- open (OUT,'>/home/httpd/html/index.html');
- print OUT (<<ENDNEWINDEX);
+ my ($otherserver,$domain) = @_;
+ if (open (OUT,'>/home/httpd/html/index.html')) {
+ print OUT (<<ENDNEWINDEX);
<html>
<head>
<title>Welcome to the LearningOnline Network with CAPA</title>
@@ -63,5 +104,8 @@
</body>
</html>
ENDNEWINDEX
- close(OUT);
+ close(OUT);
+ return 'ok';
+ }
+ return;
}
Index: loncom/cgi/ping.pl
diff -u loncom/cgi/ping.pl:1.6 loncom/cgi/ping.pl:1.7
--- loncom/cgi/ping.pl:1.6 Tue Apr 17 23:18:42 2007
+++ loncom/cgi/ping.pl Fri Nov 28 20:50:25 2008
@@ -1,6 +1,6 @@
#!/usr/bin/perl
# ping cgi-script
-# $Id: ping.pl,v 1.6 2007/04/17 23:18:42 albertel Exp $
+# $Id: ping.pl,v 1.7 2008/11/28 20:50:25 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -30,9 +30,26 @@
use lib '/home/httpd/lib/perl/';
use Apache::lonnet;
+use LONCAPA::loncgi;
-my $testhost=$ENV{'QUERY_STRING'};
-$testhost=~s/\W//g;
+print("Content-type: text/plain\n\n");
-print("Content-type: text/plain\n\n".
- &Apache::lonnet::reply('ping',$testhost)."\n");
+&main();
+
+sub main {
+ if (!&LONCAPA::loncgi::check_ipbased_access('ping')) {
+ if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
+ return;
+ }
+
+ if (!&LONCAPA::loncgi::can_view('ping')) {
+ return;
+ }
+ }
+
+ my $testhost=$ENV{'QUERY_STRING'};
+ $testhost=~s/\W//g;
+
+ print &Apache::lonnet::reply('ping',$testhost)."\n";
+ return;
+}
Index: loncom/cgi/metadata_keywords.pl
diff -u loncom/cgi/metadata_keywords.pl:1.6 loncom/cgi/metadata_keywords.pl:1.7
--- loncom/cgi/metadata_keywords.pl:1.6 Mon Sep 1 03:37:27 2003
+++ loncom/cgi/metadata_keywords.pl Fri Nov 28 20:50:25 2008
@@ -1,6 +1,6 @@
#!/usr/bin/perl
# Gets keywords from metadata database.
-# $Id: metadata_keywords.pl,v 1.6 2003/09/01 03:37:27 albertel Exp $
+# $Id: metadata_keywords.pl,v 1.7 2008/11/28 20:50:25 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -61,49 +61,73 @@
# ------------------------------------------------- Modules used by this script
-use lib '/home/httpd/lib/perl/';
-use LONCAPA::Configuration;
+$|=1;
use strict;
use DBI;
+use lib '/home/httpd/lib/perl/';
+use Apache::lonlocal;
+use LONCAPA::Configuration;
+use LONCAPA::loncgi;
# ---------------------------- Print MIME Content-type and other initialization
-$|=1;
print 'Content-type: text/plain'."\n\n";
+&main();
+
+sub main {
+ if (!&LONCAPA::loncgi::check_ipbased_access('metadatakeywords')) {
+ if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
+ &Apache::lonlocal::get_language_handle();
+ print(&LONCAPA::loncgi::missing_cookie_msg());
+ return;
+ }
+
+ if (!&LONCAPA::loncgi::can_view('metadata_keywords')) {
+ &Apache::lonlocal::get_language_handle();
+ print(&LONCAPA::loncgi::unauthorized_msg('metadata_keywords'));
+ return;
+ }
+ }
+
+ &Apache::lonlocal::get_language_handle();
+
# --- Make sure that database can be accessed and that this is a library server
# library server test
# By default, loncapa_apache.conf is also read by the read_conf subroutine.
-my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
-my %perlvar=%{$perlvarref};
-undef($perlvarref);
-
-unless ($perlvar{'lonRole'} eq 'library') {
- print "This can only be run on a library server!\n";
- exit;
-}
+ my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
+ my %perlvar=%{$perlvarref};
+ undef($perlvarref);
+
+ unless ($perlvar{'lonRole'} eq 'library') {
+ print(&Apache::lonlocal::mt('This can only be run on a library server!)."\n");
+ return;
+ }
+
# database test
-my $dbh;
-{
- unless (
- $dbh = DBI->connect("DBI:mysql:loncapa","www",
- $perlvar{'lonSqlAccess'},
- { RaiseError =>0,PrintError=>0})
- ) {
- print "Cannot connect to database!\n";
- exit;
+ my $dbh;
+ {
+ unless (
+ $dbh = DBI->connect("DBI:mysql:loncapa","www",
+ $perlvar{'lonSqlAccess'},
+ { RaiseError =>0,PrintError=>0})
+ ) {
+ print "Cannot connect to database!\n";
+ return;
+ }
}
-}
-%perlvar=(); # undefine it
+ %perlvar=(); # undefine it
# ------------------------ Loop through database records and print out keywords
-my $sth=$dbh->prepare("select * from metadata");
-$sth->execute();
-my @row;
-while (@row=$sth->fetchrow_array) {
- print $row[4]."\n";
-}
+ my $sth=$dbh->prepare("select * from metadata");
+ $sth->execute();
+ my @row;
+ while (@row=$sth->fetchrow_array) {
+ print $row[4]."\n";
+ }
# --------------------------------------------------- Close database connection
-$dbh->disconnect();
+ $dbh->disconnect();
+ return;
+}
Index: loncom/cgi/metadata_harvest.pl
diff -u loncom/cgi/metadata_harvest.pl:1.3 loncom/cgi/metadata_harvest.pl:1.4
--- loncom/cgi/metadata_harvest.pl:1.3 Mon Sep 1 03:37:27 2003
+++ loncom/cgi/metadata_harvest.pl Fri Nov 28 20:50:25 2008
@@ -1,6 +1,6 @@
#!/usr/bin/perl
# Inserts metadata from .meta files into the mysql database
-# $Id: metadata_harvest.pl,v 1.3 2003/09/01 03:37:27 albertel Exp $
+# $Id: metadata_harvest.pl,v 1.4 2008/11/28 20:50:25 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -61,53 +61,75 @@
# ------------------------------------------------- Modules used by this script
-use lib '/home/httpd/lib/perl/';
-use LONCAPA::Configuration;
-
+$|=1;
use strict;
use DBI;
+use lib '/home/httpd/lib/perl/';
+use Apache::lonlocal;
+use LONCAPA::Configuration;
+use LONCAPA::loncgi;
# ---------------------------- Print MIME Content-type and other initialization
-$|=1;
print 'Content-type: text/plain'."\n\n";
+&main();
+
+sub main {
+ if (!&LONCAPA::loncgi::check_ipbased_access('metadata_harvest')) {
+ if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
+ &Apache::lonlocal::get_language_handle();
+ print(&LONCAPA::loncgi::missing_cookie_msg());
+ return;
+ }
+
+ if (!&LONCAPA::loncgi::can_view('metadata_harvest')) {
+ &Apache::lonlocal::get_language_handle();
+ print(&LONCAPA::loncgi::unauthorized_msg('metadata_harvest'));
+ return;
+ }
+ }
+
+ &Apache::lonlocal::get_language_handle();
+
# --- Make sure that database can be accessed and that this is a library server
# library server test
# By default, loncapa_apache.conf is also read by the read_conf subroutine.
-my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
-my %perlvar=%{$perlvarref};
-undef($perlvarref);
-
-unless ($perlvar{'lonRole'} eq 'library') {
- print "This can only be run on a library server!\n";
- exit;
-}
+ my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
+ my %perlvar=%{$perlvarref};
+ undef($perlvarref);
+
+ unless ($perlvar{'lonRole'} eq 'library') {
+ print(&Apache::lonlocal::mt('This can only be run on a library server!')."\n");
+ return;
+ }
# database test
-my $dbh;
-{
- unless (
- $dbh = DBI->connect("DBI:mysql:loncapa","www",
- $perlvar{'lonSqlAccess'},
- { RaiseError =>0,PrintError=>0})
- ) {
- print "Cannot connect to database!\n";
- exit;
+ my $dbh;
+ {
+ unless (
+ $dbh = DBI->connect("DBI:mysql:loncapa","www",
+ $perlvar{'lonSqlAccess'},
+ { RaiseError =>0,PrintError=>0})
+ ) {
+ print "Cannot connect to database!\n";
+ return;
+ }
}
-}
-%perlvar=(); # undefine it
+ %perlvar=(); # undefine it
# ------------------------ Loop through database records and print out keywords
-my $sth=$dbh->prepare("select * from metadata");
-$sth->execute();
-my @row;
-while (@row=$sth->fetchrow_array) {
- for (my $i=0;$i<=$#row;$i++) {
- $row[$i]=~s/\n/ /g;
- $row[$i]=~s/\|/ /g;
+ my $sth=$dbh->prepare("select * from metadata");
+ $sth->execute();
+ my @row;
+ while (@row=$sth->fetchrow_array) {
+ for (my $i=0;$i<=$#row;$i++) {
+ $row[$i]=~s/\n/ /g;
+ $row[$i]=~s/\|/ /g;
+ }
+ print join('|',@row)."\n";
}
- print join('|',@row)."\n";
-}
# --------------------------------------------------- Close database connection
-$dbh->disconnect();
+ $dbh->disconnect();
+ return;
+}
Index: loncom/cgi/lonversions.pl
diff -u loncom/cgi/lonversions.pl:1.4 loncom/cgi/lonversions.pl:1.5
--- loncom/cgi/lonversions.pl:1.4 Sat Sep 6 17:23:29 2003
+++ loncom/cgi/lonversions.pl Fri Nov 28 20:50:25 2008
@@ -1,7 +1,7 @@
#!/usr/bin/perl
$|=1;
# Prints ut the Id line from most files
-# $Id: lonversions.pl,v 1.4 2003/09/06 17:23:29 albertel Exp $
+# $Id: lonversions.pl,v 1.5 2008/11/28 20:50:25 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -26,13 +26,44 @@
# http://www.lon-capa.org/
#
-print "Content-type: text/html\n\n".
- "<html><body bgcolor=#FFFFFF><h1>Handler Versions</h1>".
- "<pre>\n";
-open (DFH,
-"grep '\$Id:' /home/httpd/perl/* /home/httpd/lib/perl/Apache/*.pm /home/httpd/html/res/adm/includes/* /home/httpd/html/res/adm/pages/*|");
-while ($line=<DFH>) {
- print "$line";
+use strict;
+
+use lib '/home/httpd/lib/perl/';
+use Apache::lonlocal;
+use LONCAPA::Configuration;
+use LONCAPA::loncgi;
+
+print("Content-type: text/html\n\n");
+
+&main();
+
+sub main {
+ if (!&LONCAPA::loncgi::check_ipbased_access('codeversions')) {
+ if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
+ &Apache::lonlocal::get_language_handle();
+ print(&LONCAPA::loncgi::missing_cookie_msg());
+ return;
+ }
+
+ if (!&LONCAPA::loncgi::can_view('codeversions')) {
+ &Apache::lonlocal::get_language_handle();
+ print(&LONCAPA::loncgi::unauthorized_msg('codeversions'));
+ return;
+ }
+ }
+
+ &Apache::lonlocal::get_language_handle();
+ &print_versions();
+ return;
+}
+
+sub print_versions {
+ print '<html><body bgcolor="#FFFFFF"><h1>'.&Apache::lonlocal::mt('Handler Versions').'</h1>'.
+ "<pre>\n";
+ open (DFH, "grep '\$Id:' /home/httpd/perl/* /home/httpd/lib/perl/Apache/*.pm /home/httpd/html/res/adm/includes/* /home/httpd/html/res/adm/pages/*|");
+ while (my $line=<DFH>) {
+ print "$line";
+ }
+ close(DFH);
+ print '</pre></body></html>';
}
-close(DFH);
-print "</pre></body></html>";
Index: loncom/cgi/loncron.pl
diff -u loncom/cgi/loncron.pl:1.5 loncom/cgi/loncron.pl:1.6
--- loncom/cgi/loncron.pl:1.5 Tue May 11 21:46:21 2004
+++ loncom/cgi/loncron.pl Fri Nov 28 20:50:25 2008
@@ -1,7 +1,7 @@
#!/usr/bin/perl
$|=1;
# Runs loncron
-# $Id: loncron.pl,v 1.5 2004/05/11 21:46:21 albertel Exp $
+# $Id: loncron.pl,v 1.6 2008/11/28 20:50:25 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,14 +25,47 @@
#
# http://www.lon-capa.org/
#
-print "Content-type: text/html\n\n".
- "<html><body bgcolor='#FFFFFF'><h1>Running loncron ...</h1>".
- "Please be patient<p><pre>\n";
-open (DFH,"/home/httpd/perl/loncron --noemail|");
-while ($line=<DFH>) {
- print "$line";
+
+use strict;
+
+use lib '/home/httpd/lib/perl/';
+use Apache::lonlocal;
+use LONCAPA::Configuration;
+use LONCAPA::loncgi;
+
+print("Content-type: text/html\n\n");
+
+&main();
+
+sub main {
+ if (!&LONCAPA::loncgi::check_ipbased_access('loncron')) {
+ if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
+ &Apache::lonlocal::get_language_handle();
+ print(&LONCAPA::loncgi::missing_cookie_msg());
+ return;
+ }
+
+ if (!&LONCAPA::loncgi::can_view('loncron')) {
+ &Apache::lonlocal::get_language_handle();
+ print(&LONCAPA::loncgi::unauthorized_msg('loncron'));
+ return;
+ }
+ }
+
+ &Apache::lonlocal::get_language_handle();
+ print '<html><body bgcolor="#FFFFFF"><h1>'.
+ &Apache::lonlocal::mt('Running loncron ...').'</h1>'.
+ &Apache::lonlocal::mt('Please be patient').'<p><pre>'."\n";
+ open (DFH,"/home/httpd/perl/loncron --noemail|");
+ while (my $line=<DFH>) {
+ print "$line";
+ }
+ close(DFH);
+ print '</pre></p><p><a href="/lon-status/">'.&Apache::lonlocal::mt('Status Report').
+ '</a></p>';
+ print '<p><a href="/lon-status/loncstatus.txt">'.&Apache::lonlocal::mt('LONC report.').
+ '</a></p>';
+ print '<p><a href="/lon-status/londstatus.txt">'.&Apache::lonlocal::mt('LOND report').
+ '</a></p></body></html>';
+ return;
}
-close(DFH);
-print "</pre></p><p><a href='/lon-status/'>Status Report</a></p>";
-print "<p><a href='/lon-status/loncstatus.txt'>LONC report</a></p>";
-print "<p><a href='/lon-status/londstatus.txt'>LOND report</a></p></body></html>";
--raeburn1227905425--