[LON-CAPA-cvs] cvs: loncom / londtest

[foxr]

foxr		Tue Mar 30 06:55:51 2004 EDT

  Modified files:              
    /loncom	londtest 
  Log:
  Added tests for ping/pong.
  
  
Index: loncom/londtest
diff -u loncom/londtest:1.1 loncom/londtest:1.2
--- loncom/londtest:1.1	Tue Mar 30 06:07:13 2004
+++ loncom/londtest	Tue Mar 30 06:55:51 2004
@@ -0,0 +1,177 @@
+#!/usr/bin/perl
+# The LearningOnline Network
+# lond "LON Daemon" Server (port "LOND" 5663)
+#
+# $Id: londtest,v 1.2 2004/03/30 11:55:51 foxr 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/
+#
+
+#  Exhaustively exercise the lond program.
+#
+
+use strict;
+use English;
+use IO::Socket::UNIX;
+
+#------------------------------ Transact with server --------------------------
+#
+#   Send a transaction and get reply
+#
+# Parameters:
+#    Socket   - Socket connected to host.
+#    String   - Transaction string.
+# Return:
+#    The string gotten from the server in reply (chomped).
+#
+sub Transact {
+    my $Socket = shift;
+    my $data = shift;
+    print $Socket "$data\n";
+
+    my $Reply = <$Socket>;
+    chomp($Reply);
+
+    return $Reply;
+}
+
+#------------------------------- Test ping/pong -------------------------------
+#
+#  Test the ping/pong functions.
+#   ping should return the name of the host.
+#   pong should return the name of the target host followed by
+#   either self_reply or the name of our host.. we don't have a mechanism to find that
+#   out at  this point.. so we only care about the first part.
+#
+# Parameters:
+#   TargetHost    - Host we're conected to.
+#   Socket        - Socket connected to that host.
+# Returns:
+#   Test status string.
+#
+sub PingPongTest {
+    my $TargetHost = shift;
+    my $Socket     = shift;
+    my $reply;
+    my $status     = "Pingpong: ";
+
+    # ping test.
+
+    $reply = Transact($Socket, "ping");
+    if($reply ne $TargetHost) {
+	$status .= "ping failed expected $TargetHost got $reply\n";
+    } else {
+	$status .= "ping - ok ";
+    }
+
+    # Pong test:
+
+    $reply = Transact($Socket, "pong");
+    my ($h1, $h2) = split(/:/,$reply);
+    if($h1 ne "$TargetHost") {
+	$status .= "pong failed expected $TargetHost got $h1\n";
+    }
+    else {
+	$status .= "pong ok ";
+    }
+
+    return $status
+}
+
+#------------------------------- Test driver ----------------------------------
+#
+#  Sequentially run the test groupings.
+#
+#  Parameters:
+#    TargetHost    - The loncapa cluster name of the target node.
+#    Socket        - The socket connected to the lonc connected in turn to the
+#                    target host.
+# Side-effects:
+#   Test output is written to stderr.
+sub Tests {
+    my $TargetHost = shift;
+    my $Socket     = shift;
+
+    print STDERR "Testing ping/pong\n";
+    my $TestOutput = PingPongTest($TargetHost, $Socket);
+    print STDERR "$TestOutput\n";
+
+}
+
+#-------------------------------- entry point ----------------------------------
+#
+#  Print program usage to stderr:
+#
+sub Usage {
+    print STDERR "Usage: \n";
+    print STDERR "     londtest loncapa-host\n";
+    print STDERR "Where: \n";
+    print STDERR "     loncapa-host - is the loncapa cluster name of the host to test\n";
+    print STDERR "NOTE:\n";
+    print STDERR "     Tests can only be done by cluster members to cluster members\n";
+    print STDERR "     Tests can only be run by the root user\n";
+
+}
+
+#
+#   Parse the command line arguments.  Print Usage if there's not a single argument
+#
+
+my $nArgs = scalar @ARGV;
+if($nArgs != 1) {
+    print STDERR "Incorrect number of command line arguments $nArgs\n";
+    Usage;
+    exit(-1);
+}
+
+my $TargetHost = $ARGV[0];
+
+#   Ensure that I am root... if not error  message and Usage.
+#
+if($EFFECTIVE_USER_ID != 0) {
+    print STDERR "Only root can run londtest!\n";
+    Usage;
+    exit(-1);
+
+}
+
+#   Connect to the local socket of the host in question
+
+
+#   Failure: error message and usage.
+
+my $Socket = IO::Socket::UNIX->new(Type    => SOCK_STREAM,
+				   Timeout => 10,
+				   Peer   => "/home/httpd/sockets/$TargetHost");
+if($Socket == undef) {
+    print STDERR "Failed to open host socket probably invalid host: $OS_ERROR\n";
+    Usage;
+    exit(-1);
+}
+
+
+#  Run the tests!!
+
+Tests($TargetHost, $Socket);