home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 1999 May / APC452.ISO / netkit / xitami / xitami.exe / XITEST < prev    next >
Encoding:
Text File  |  1998-11-23  |  9.2 KB  |  296 lines
  1. #! /usr/local/bin/perl
  2. #
  3. #   Name:       xitest
  4. #   Title:      Xitami regression test tool
  5. #
  6. #   Written:    98/03/15  Xitami team <xitami@imatix.com>
  7. #   Revised:    98/11/23
  8. #
  9. #   Copyright:  Copyright (c) 1991-98 iMatix Corporation
  10. #   License:    This is free software; you can redistribute it and/or modify
  11. #               it under the terms of the Xitami License Agreement as provided
  12. #               in the file LICENSE.TXT.  This software is distributed in
  13. #               the hope that it will be useful, but without any warranty.
  14. #
  15. #   Syntax:     Windows: perl xitest < xitest.dat
  16. #               Unix:    chmod +x xitest; xitest < xitest.dat
  17. #
  18.  
  19. require 5.002;
  20. use strict;
  21. use Socket;
  22.  
  23. #   http_request
  24. #
  25. #   Make a HTTP request to a given server and port, and return the result
  26. #   of having done so.
  27. #
  28. #   Expects:
  29.  
  30. sub http_request {
  31.     my ($request, $remote, $port, $sleep) = @_;
  32.     my ($iaddr, $paddr, $proto, $line);
  33.     my ($in_header);
  34.  
  35.     #   Return arguments
  36.     my ($header,                        #   HTTP header, one or more lines
  37.         $content,                       #   HTTP body, should be text
  38.         $status_code,                   #   HTTP status code, e.g. 200
  39.         $status_text,                   #   HTTP status text
  40.         $content_length,                #   Content-Length: value, if any
  41.         $location);                     #   Location: value, if any
  42.  
  43.     if (!defined ($request)) {
  44.         warn "http_request: no request to perform!\n";
  45.         return undef;
  46.     }
  47.     $remote = "localhost"  if (!defined ($remote));
  48.     $port   = "80"         if (!defined ($port));
  49.     $sleep  =  0           if (!defined ($sleep));
  50.  
  51.     if (!($iaddr = inet_aton ($remote))) {
  52.         warn "http_request: no such host: $remote\n";
  53.         return undef;
  54.     }
  55.     $paddr = sockaddr_in ($port, $iaddr);
  56.     $proto = getprotobyname ('tcp');
  57.     if (!socket (SOCK, PF_INET, SOCK_STREAM, $proto)) {
  58.         warn "[$remote:$port] socket: $!";
  59.         return undef;
  60.     }
  61.     if (!connect (SOCK, $paddr)) {
  62.         warn "[$remote:$port] connect: $!";
  63.         return undef;
  64.     }
  65.     send SOCK, "$request\n", 0;
  66.  
  67.     $header         = "";
  68.     $content        = "";
  69.     $status_code    = 0;
  70.     $status_text    = "";
  71.     $content_length = "";
  72.     $location       = "";
  73.  
  74.     $in_header      = 1;
  75.     while (<SOCK>) {
  76.         #   Collect line in header or body, delimited by a blank line
  77.         if ($in_header && /^\r\n/) {
  78.             $in_header = 0;
  79.         }
  80.         elsif ($in_header) {
  81.             $header .= $_;
  82.         }
  83.         else {
  84.             $content .= $_;
  85.         }
  86.  
  87.         if (/^HTTP\/1.\d+ (\d+)\s+(.*)\r\n/) {
  88.             $status_code = $1;
  89.             $status_text = $2;
  90.         }
  91.         elsif (/^Content-Length: /i) {
  92.             $content_length = $';
  93.         }
  94.         elsif (/^Location: /i) {
  95.             $location = $';
  96.         }
  97.     }
  98.     sleep $sleep if $sleep;
  99.     close (SOCK);
  100.     return ($header,
  101.             $content,
  102.             $status_code,
  103.             $status_text,
  104.             $content_length,
  105.             $location);
  106. }
  107.  
  108.  
  109. #---------------------------------------------------------------------------
  110. #   Read in the tests to perform, from the named input file (or stdin)
  111. #
  112. #   Tests are stored as references to anonymous hashes, which contain
  113. #   "Method", "URI", "HeaderLines", "RC", "CompareFile", "CompareRegex",
  114. #   "Description".
  115. #
  116. #   "Server" and "Port" are also used, but persist from one setting to
  117. #   the next.
  118.  
  119. my @TESTS;
  120.  
  121. my ($method, $URI, $headerlines, $rc, $comparefile, $compareregex,
  122.     $description, $eof, $repeat);
  123. my ($server, $port, $sleep) = ("localhost", 80, 0);
  124.  
  125. for (;;) {
  126.     $eof = 1
  127.         unless ($_ = <>);
  128.  
  129.     next if (/^\s*#/);                  #   Ignore comment lines
  130.     chomp;
  131.  
  132.     #   Handle joining lines
  133.     while (/\\$/) {
  134.         chop;
  135.         $_ .= <>;
  136.         chomp;
  137.     }
  138.     if    (/^UR[IL]=(.*)$/i) {
  139.        $URI          = $1;
  140.     }
  141.     elsif (/^Method=(.*)$/i) {
  142.        $method       = $1;
  143.     }
  144.     elsif (/^RC=(.*)$/i) {
  145.        $rc           = $1;
  146.     }
  147.     elsif (/^CompareFile=(.*)$/i) {
  148.         $comparefile  = $1;
  149.     }
  150.     elsif (/^CompareRegex=(.*)$/i) {
  151.         $compareregex = $1;
  152.     }
  153.     elsif (/^Description=(.*)$/i) {
  154.         $description  = $1;
  155.     }
  156.     elsif (/^Server=(.*)$/i) {
  157.         $server       = $1;
  158.     }
  159.     elsif (/^Port=(.*)$/i) {
  160.         $port         = $1;
  161.     }
  162.     elsif (/^Sleep=(.*)$/i) {
  163.         $sleep        = $1;
  164.     }
  165.     elsif (/^HeaderLine=(.*)$/i) {
  166.        $headerlines   = (defined($headerlines) ? $headerlines : "") .
  167.                       $1 . "\n";
  168.     }
  169.     elsif (/^Repeat=(.*)$/i) {
  170.         $repeat       = $1;
  171.     }
  172.     elsif (/^\s*$/) {
  173.         #   A blank line terminates the request.  Valid if URI and RC are
  174.         #   defined.  If one is defined, but not either, then rejected; if
  175.         #   neither defined then ignored (eg, stray blank line).
  176.         #
  177.         if (!defined ($URI) && !defined ($rc)) {
  178.             #   Stray blank line
  179.         }
  180.         elsif (!defined ($URI) || !defined ($rc)) {
  181.             # Invalid: only one of them defined (both undef is rejected above)
  182.             #
  183.             $URI = "" if (!defined ($URI));
  184.             $rc  = "" if (!defined ($rc));
  185.             warn "Invalid request: $URI -> $rc\n";
  186.         }
  187.         else {
  188.             # Valid request: have the two main components,
  189.             # URI, and result expected
  190.             #
  191.             $headerlines = "" if (!defined ($headerlines));
  192.             $repeat      = 1  if (!defined ($repeat));
  193.  
  194.             push (@TESTS, { 'Method'       => (defined ($method)
  195.                                                ? $method
  196.                                                : "GET"),
  197.                             'URI'          => $URI,
  198.                             'RC'           => $rc,
  199.                             'HeaderLines'  => $headerlines,
  200.                             'CompareFile'  => $comparefile,
  201.                             'CompareRegex' => $compareregex,
  202.                             'Description'  => $description,
  203.                             'Repeat'       => $repeat,
  204.                             'Server'       => $server,
  205.                             'Port'         => $port });
  206.         }
  207.  
  208.         # Clear out the per-entry settings.
  209.         undef $method;
  210.         undef $URI;
  211.         undef $rc;
  212.         undef $headerlines;
  213.         undef $comparefile;
  214.         undef $compareregex;
  215.         undef $description;
  216.         undef $repeat;
  217.     }
  218.     else {
  219.         warn "Invalid specification: $_\n";
  220.     }
  221.     last if $eof;
  222. }
  223.  
  224.  
  225. #---------------------------------------------------------------------------
  226. #   Now walk through the list of tests, and perform them.  (Not done
  227. #   interactively to ease entering some of the tests straight into
  228. #   stdin, eg from another program.)
  229.  
  230. my ($testref);
  231.  
  232. printf "%-40s %s\n", "Regression Tests", scalar localtime ();
  233. print  "-" x 75, "\n";
  234. open (ERRLOG, ">>xitest.log") || die "Can't write to xitest.log: $!";
  235.  
  236. foreach $testref (@TESTS) {
  237.     #
  238.     #   Assemble the request -- all these values are definitely defined.
  239.     #   We put a space after the method only if it has a non-zero length,
  240.     #   so that we can test badly misformed URLs.
  241.     #
  242.     my ($repeat) = ${$testref}{'Repeat'};
  243.     while ($repeat--) {
  244.         my ($request) = ${$testref}{'Method'} .
  245.                        (${$testref}{'Method'} ne "" ? " " : "") .
  246.                         ${$testref}{'URI'} . " HTTP/1.0\n" .
  247.                         ${$testref}{'HeaderLines'};
  248.         my ($header,
  249.             $content,
  250.             $status_code,
  251.             $status_text,
  252.             $content_length,
  253.             $location) = http_request ($request, $server, $port, $sleep);
  254.  
  255.         my ($description)  = ${$testref}{'Description'};
  256.         my ($compareregex) = ${$testref}{'CompareRegex'};
  257.         my ($comparefile)  = ${$testref}{'CompareFile'};
  258.  
  259.         #   Format comment from Description or from URL
  260.         my ($comment) = $description;
  261.         if (defined ($description)) {
  262.             $comment = $description;
  263.         }
  264.         else {
  265.             $comment = ${$testref}{'Method'} .
  266.                       (${$testref}{'Method'} ne "" ? " " : "") .
  267.                        ${$testref}{'URI'};
  268.         }
  269.         substr ($comment, 36) = "..." if (length ($comment) > 39);
  270.  
  271.         if (defined ($status_code)) {
  272.             printf ("%-40s -> %s", $comment, $status_code);
  273.  
  274.             #   Check that it worked -- check the status code, then if that's
  275.             #   okay, check the compareregex and/or comparefile.
  276.             #
  277.             if ($status_code == ${$testref}{'RC'}) {
  278.                 #
  279.                 #   compareregex and comparefile not yet implemented
  280.                 #
  281.                 print "  Pass.\n";
  282.             }
  283.             else {
  284.                 print "  $status_text; expected ${$testref}{'RC'}\n";
  285.                 print ERRLOG "$comment -> $status_code, expected ".
  286.                       "${$testref}{'RC'}\n";
  287.             }
  288.         }
  289.         else {
  290.             printf ("%-40s -> %s", $comment, "Unable to test\n");
  291.         }
  292.     }
  293. }
  294.  
  295. 1;
  296.