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>