--- loncom/cgi/ping.pl 2002/02/18 20:59:36 1.1 +++ loncom/cgi/ping.pl 2008/12/25 01:56:03 1.8 @@ -1,46 +1,56 @@ #!/usr/bin/perl - -# The LearningOnline Network with CAPA # ping cgi-script +# $Id: ping.pl,v 1.8 2008/12/25 01:56:03 raeburn Exp $ +# +# Copyright Michigan State University Board of Trustees +# +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). +# +# LON-CAPA is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# LON-CAPA is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with LON-CAPA; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# /home/httpd/html/adm/gpl.txt +# +# http://www.lon-capa.org/ +# - +use strict; $|=1; -use IO::File; -use IO::Socket; - -# -------------------------------------------------- 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 lib '/home/httpd/lib/perl/'; +use Apache::lonnet; +use LONCAPA::loncgi; +use LONCAPA::lonauthcgi; + +print("Content-type: text/plain\n\n"); + +&main(); + +sub main { + if (!&LONCAPA::lonauthcgi::check_ipbased_access('ping')) { + if (!&LONCAPA::loncgi::check_cookie_and_load_env()) { + return; + } -# ------------------------------------------------------------ Read access.conf -{ - my $config=IO::File->new("/etc/httpd/conf/access.conf"); - - while (my $configline=<$config>) { - if ($configline =~ /PerlSetVar/) { - my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); - $perlvar{$varname}=$varvalue; + if (!&LONCAPA::lonauthcgi::can_view('ping')) { + return; } } - 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; + my $testhost=$ENV{'QUERY_STRING'}; + $testhost=~s/\W//g; -print "Content-type: text/plain\n\n". - &reply('ping',$testhost)."\n"; + print &Apache::lonnet::reply('ping',$testhost)."\n"; + return; +}