Annotation of loncom/cgi/ping.pl, revision 1.1
1.1 ! www 1: #!/usr/bin/perl
! 2:
! 3: # The LearningOnline Network with CAPA
! 4: # ping cgi-script
! 5:
! 6:
! 7: $|=1;
! 8:
! 9: use IO::File;
! 10: use IO::Socket;
! 11:
! 12: # -------------------------------------------------- Non-critical communication
! 13: sub reply {
! 14: my ($cmd,$server)=@_;
! 15: my $peerfile="$perlvar{'lonSockDir'}/$server";
! 16: my $client=IO::Socket::UNIX->new(Peer =>"$peerfile",
! 17: Type => SOCK_STREAM,
! 18: Timeout => 10)
! 19: or return "con_lost";
! 20: print $client "$cmd\n";
! 21: my $answer=<$client>;
! 22: chomp($answer);
! 23: if (!$answer) { $answer="con_lost"; }
! 24: return $answer;
! 25: }
! 26:
! 27:
! 28: # ------------------------------------------------------------ Read access.conf
! 29: {
! 30: my $config=IO::File->new("/etc/httpd/conf/access.conf");
! 31:
! 32: while (my $configline=<$config>) {
! 33: if ($configline =~ /PerlSetVar/) {
! 34: my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
! 35: $perlvar{$varname}=$varvalue;
! 36: }
! 37: }
! 38: delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed
! 39: delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
! 40: }
! 41:
! 42: $testhost=$ENV{'QUERY_STRING'};
! 43: $testhost=~s/\W//g;
! 44:
! 45: print "Content-type: text/plain\n\n".
! 46: &reply('ping',$testhost)."\n";
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>