--- loncom/cgi/ping.pl 2003/09/01 03:37:27 1.5 +++ loncom/cgi/ping.pl 2011/10/17 17:23:25 1.9 @@ -1,6 +1,6 @@ #!/usr/bin/perl # ping cgi-script -# $Id: ping.pl,v 1.5 2003/09/01 03:37:27 albertel Exp $ +# $Id: ping.pl,v 1.9 2011/10/17 17:23:25 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,42 +25,41 @@ # http://www.lon-capa.org/ # - +use strict; $|=1; use lib '/home/httpd/lib/perl/'; -use LONCAPA::Configuration; - -use IO::File; -use IO::Socket; - -my %perlvar; - -# -------------------------------------------------- Non-critical communication -sub reply { - my ($cmd,$server)=@_; - my $peerfile="$perlvar{'lonSockDir'}/$server"; - my $client=IO::Socket::UNIX->new(Peer =>"$peerfile", - Type => SOCK_STREAM, - Timeout => 10) - or return "con_lost"; - print $client "$cmd\n"; - my $answer=<$client>; - chomp($answer); - if (!$answer) { $answer="con_lost"; } - return $answer; +use Apache::lonnet; +use LONCAPA::loncgi; +use LONCAPA::lonauthcgi; + +print("Content-type: text/plain\n\n"); + +&main(); + +sub main { + my $remote_ip = $ENV{'REMOTE_ADDR'}; + my $allowed; + my @hosts = &Apache::lonnet::get_hosts_from_ip($remote_ip); + if (@hosts > 0) { + $allowed = 1; + } elsif (&LONCAPA::lonauthcgi::check_ipbased_access('ping',$remote_ip)) { + $allowed = 1; + } elsif (&LONCAPA::loncgi::check_cookie_and_load_env()) { + if (&LONCAPA::lonauthcgi::can_view('ping')) { + $allowed = 1; + } + } + if ($allowed) { + my $testhost=$ENV{'QUERY_STRING'}; + $testhost=~s/\W//g; + if (&Apache::lonnet::hostname($testhost) ne '') { + print &Apache::lonnet::reply('ping',$testhost)."\n"; + } else { + print 'unknown_host'; + } + } else { + print 'forbidden'; + } + return; } - - -# --------------------- Read loncapa.conf (and by default loncapa_apache.conf). -my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); -%perlvar=%{$perlvarref}; -undef $perlvarref; # remove since sensitive and not needed -delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed -delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed - -$testhost=$ENV{'QUERY_STRING'}; -$testhost=~s/\W//g; - -print "Content-type: text/plain\n\n". - &reply('ping',$testhost)."\n";