home *** CD-ROM | disk | FTP | other *** search
/ Programmer's ROM - The Computer Language Library / programmersrom.iso / ada / defdata / tcptest.src < prev    next >
Encoding:
Text File  |  1988-05-03  |  28.9 KB  |  937 lines
  1. -----------------------------------------------------------------------
  2. --
  3. --         DoD Protocols    NA-00003-200       80-01042-100(-)
  4. --         E-Systems, Inc.  August 07, 1985
  5. --
  6. --         tcp_ulp_tester.ada       Author : Jim Baldo
  7. --
  8. -----------------------------------------------------------------------
  9. with SYSTEM ;                           use SYSTEM ;
  10. with CONDITION_HANDLING ;               use CONDITION_HANDLING ;
  11. with STARLET ;                          use STARLET ;
  12. with WITH_ULP_COMMUNICATE ;             use WITH_ULP_COMMUNICATE ;
  13. with TEXT_IO ;                          use TEXT_IO ;
  14. with BUFFER_DATA ;                      use BUFFER_DATA ;
  15.      
  16. procedure TCP_ULP_TESTER is
  17.      
  18. package CONVERT_INT_16_TO_STRING is new INTEGER_IO( SIXTEEN_BITS ) ;
  19. package CONVERT_INT_32_TO_STRING is new INTEGER_IO( THIRTYTWO_BITS ) ;
  20.      
  21. package INT_IO_16 is new INTEGER_IO ( SIXTEEN_BITS ) ;
  22. package INT_IO_32 is new INTEGER_IO ( THIRTYTWO_BITS ) ;
  23.      
  24. type END_TEST_FLAG_TYPE is (END_TEST,TEST_RUNNING);
  25.      
  26. MENU_SELECTION : SIXTEEN_BITS := 0 ;
  27. END_TEST_FLAG : END_TEST_FLAG_TYPE := TEST_RUNNING;
  28. CONNECTION_LCN : LCN_TYPE ;
  29. WHOIAM : constant THIRTYTWO_BITS := 1 ;
  30.      
  31. --LCN storage
  32. type LCN_NAME_PTR_TYPE is record
  33.  LCN : LCN_PTR_TYPE;
  34.  LCN_NAME : STRING(1..6);
  35. end record;
  36.      
  37. MAX_NUM_OF_LCN : constant SIXTEEN_BITS := 10;
  38.      
  39. type ARRAY_OF_LCNS_TYPE is array(1..MAX_NUM_OF_LCN) of LCN_NAME_PTR_TYPE;
  40.      
  41. ARRAY_OF_LCNS : ARRAY_OF_LCNS_TYPE ;
  42.      
  43. procedure REVERSE_VIDEO is
  44.      
  45.         --This procedure selects a VT-100 like terminal into reverse video
  46.         --mode.
  47.      
  48. REVERSEVIDEO : STRING(1..4);
  49.      
  50. begin
  51.  REVERSEVIDEO(1) := ASCII.ESC;
  52.  REVERSEVIDEO(2..4) := "[7m";
  53.  PUT(REVERSEVIDEO);
  54. end REVERSE_VIDEO;
  55.      
  56. procedure ATTRIBUTES_OFF is
  57.      
  58. ATTRIBUTESOFF : STRING(1..3);
  59.      
  60. begin
  61.  ATTRIBUTESOFF(1) := ASCII.ESC;
  62.  ATTRIBUTESOFF(2..3) := "[m";
  63.  PUT(ATTRIBUTESOFF);
  64. end ATTRIBUTES_OFF;
  65.      
  66. procedure CLEAR_SCREEN is
  67.      
  68.         --This procedure selects a VT-100 like terminal to clear the screen.
  69.      
  70. CLEARSCREEN : STRING(1..4);
  71.      
  72. begin
  73.  CLEARSCREEN(1) := ASCII.ESC;
  74.  CLEARSCREEN(2..4) := "[2J";
  75.  PUT(CLEARSCREEN);
  76. end CLEAR_SCREEN;
  77.      
  78. procedure BOLD is
  79.      
  80.         --This procedure selects a VT-100 like terminal to turn-on the bold
  81.         --attribute.
  82.      
  83. BOLD_CHAR : STRING(1..4);
  84.      
  85. begin
  86.  BOLD_CHAR(1) := ASCII.ESC;
  87.  BOLD_CHAR(2..4) := "[1m";
  88.  PUT(BOLD_CHAR);
  89. end BOLD;
  90.      
  91. procedure BLINK is
  92.      
  93.         --This procedure selects a VT-100 like terminal to turn-on the blinking
  94.         --attribute
  95.      
  96. BLINK_CHAR : STRING(1..4);
  97.      
  98. begin
  99.  BLINK_CHAR(1) := ASCII.ESC;
  100.  BLINK_CHAR(2..4) := "[5m";
  101.  PUT(BLINK_CHAR);
  102. end BLINK;
  103.      
  104. procedure HOME_POSITION is
  105.      
  106.         --This procedure places the cursor in the home position.
  107.      
  108. HOMEPOSITION : STRING(1..4);
  109.      
  110. begin
  111.  HOMEPOSITION(1) := ASCII.ESC;
  112.  HOMEPOSITION(2) := 'H';
  113.  PUT(HOMEPOSITION);
  114. end HOME_POSITION;
  115.      
  116. procedure SKIP_LINES(NUMBER_OF_LINES_TO_SKIP : in SIXTEEN_BITS ) is
  117.      
  118.                 -- This procedure will skip lines
  119.      
  120. begin
  121.  for I in 1..NUMBER_OF_LINES_TO_SKIP loop
  122.   NEW_LINE;
  123.  end loop;
  124. end SKIP_LINES;
  125.      
  126. procedure REMOVE_LCN_RECORD(LCN_NAME : in STRING ) is
  127.      
  128. LCN_HOLDER : STRING(1..6) := "      ";
  129.      
  130. begin
  131.  for I in 1..MAX_NUM_OF_LCN loop
  132.   LCN_HOLDER := ARRAY_OF_LCNS(SIXTEEN_BITS(I)).LCN_NAME ;
  133.   if LCN_HOLDER = LCN_NAME then
  134.    ARRAY_OF_LCNS(I).LCN_NAME := "      ";
  135.    exit;
  136.   end if;
  137.  end loop;
  138. end REMOVE_LCN_RECORD;
  139.      
  140. procedure ADD_LCN_RECORD(LCN_NAME_PTR : in LCN_NAME_PTR_TYPE ) is
  141.      
  142. LCN_HOLDER : STRING(1..6) := "      ";
  143.      
  144. begin
  145.  for I in 1..MAX_NUM_OF_LCN loop
  146.   LCN_HOLDER := ARRAY_OF_LCNS(SIXTEEN_BITS(I)).LCN_NAME ;
  147.   if LCN_HOLDER = "      " then
  148.    ARRAY_OF_LCNS(I) := LCN_NAME_PTR;
  149.    exit;
  150.   end if;
  151.  end loop;
  152. end ADD_LCN_RECORD;
  153.      
  154. procedure OBTAIN_LCN(LCN_NAME_PTR : in out LCN_NAME_PTR_TYPE) is
  155.      
  156. LCN_NAME_STRING : STRING(1..6) := "      ";
  157.      
  158. begin
  159.  for I in 1..MAX_NUM_OF_LCN loop
  160.   LCN_NAME_STRING := ARRAY_OF_LCNS(I).LCN_NAME;
  161.   if LCN_NAME_STRING = LCN_NAME_PTR.LCN_NAME then
  162.    LCN_NAME_PTR := ARRAY_OF_LCNS(I);
  163.    exit;
  164.   end if;
  165.  end loop;
  166. end OBTAIN_LCN;
  167.      
  168. procedure INTIALIZE_LCNS is
  169.      
  170. begin
  171.  for I in 1..10 loop
  172.   ARRAY_OF_LCNS(SIXTEEN_BITS(I)).LCN.LCN_PTR := null;
  173.   ARRAY_OF_LCNS(SIXTEEN_BITS(I)).LCN_NAME := "      ";
  174.  end loop;
  175. end INTIALIZE_LCNS;
  176.      
  177. procedure TEST_MESSAGE_GENERATOR is
  178.      
  179. LCN : LCN_PTR_TYPE;
  180. MAX_MESSAGE_LENGTH : constant SIXTEEN_BITS  := 200; -- Maximum message size
  181.      
  182.    type GENERATE_ANOTHER_MESSAGE_TYPE is (YES,NO);
  183.    type MESSAGE_TYPE is array(1..MAX_MESSAGE_LENGTH) of CHARACTER;
  184.      
  185.    subtype INDEX_TYPE is SIXTEEN_BITS ;
  186.      
  187.    subtype PRECEDENCE_TYPE is SIXTEEN_BITS ;
  188.    subtype TIMEOUT_TYPE is SIXTEEN_BITS ;
  189.    subtype FOREIGN_PORT_TYPE is SIXTEEN_BITS ;
  190.    subtype FOREIGN_NET_HOST_TYPE is THIRTYTWO_BITS ;
  191.    subtype MY_PORT_TYPE is SIXTEEN_BITS ;
  192.    subtype REMOTE_PORT_TYPE is SIXTEEN_BITS ;
  193.      
  194.    RESULT : NATURAL;
  195.    MESSAGE_BUFFER : PACKED_BUFFER_PTR;
  196.    BUFFER_TYPE : SIXTEEN_BITS ;  --Temporary; Parameter should be removed
  197.                            --from BUFFGET
  198.    GENERATE_ANOTHER_MESSAGE : GENERATE_ANOTHER_MESSAGE_TYPE := YES;
  199.    INPUT_CHARACTER : CHARACTER := ASCII.NUL;
  200.    MESSAGE : MESSAGE_TYPE;
  201.    TYPE_OF_TCP_MESSAGE : STRING(1..7) := "       ";
  202.    SERVICE_REQUEST_PRIMITIVE : STRING(1..8) := "        ";
  203.    ACTIVE_OR_PASSIVE : STRING(1..7) := "       ";
  204.    COMPONENT_ACTIVE_OR_PASSIVE : ACKPASS ;
  205.    FOREIGN_PORT : FOREIGN_PORT_TYPE := 0;
  206.    FOREIGN_NET_HOST : FOREIGN_NET_HOST_TYPE := 0;
  207.    PRECEDENCE : PRECEDENCE_TYPE := 0;
  208.    TIMEOUT : TIMEOUT_TYPE := 15;
  209.    SCREEN_MESSAGE : STRING(1..50);
  210.    INDEX : INDEX_TYPE := 0;
  211.    OPEN_PARAMETERS : OPEN_PARAMS ;
  212.    RECEIVE_DATA : RECEIVE_PARAMS ;
  213.    SEND_PARAMETERS : SEND_PARAMS;
  214.    CLOSE_PARAMETERS : ABORT_CLOSE_PARAMS;
  215.    ABORT_PARAMETERS : ABORT_CLOSE_PARAMS;
  216.    STATUS_PARAMETERS : STATUS_PARAMS;
  217.    X : TCP_OPTION_TYPE;
  218.    MY_PORT : MY_PORT_TYPE ;
  219.    REMOTE_PORT : REMOTE_PORT_TYPE;
  220.    PTR : SIXTEEN_BITS  := 0;
  221.    YES_OR_NO : STRING(1..3);
  222.    TCP_MESSAGE : WITH_ULP_COMMUNICATE.MESSAGE ;
  223.    LCN_POINTER : LCN_PTR_TYPE ;
  224.    BUFFER : PACKED_BUFFER_PTR ;
  225.    REQUEST_OK : BOOLEAN := FALSE ;
  226.    CHAR : CHARACTER := ' ';
  227.    LCN_STRING : STRING(1..6) := "      ";
  228.    LCN_NAME_PTR : LCN_NAME_PTR_TYPE ;
  229.    LENGTH : NATURAL;
  230.      
  231.    begin
  232.     while GENERATE_ANOTHER_MESSAGE = YES loop
  233.      -- Obtain a buffer
  234.      BUFFGET(MESSAGE_BUFFER,BUFFER_TYPE);
  235.      HOME_POSITION;
  236.      CLEAR_SCREEN; -- Clear screen
  237.      SKIP_LINES(3);
  238.      SCREEN_MESSAGE := "                    ULP Message                   ";
  239.      REVERSE_VIDEO;
  240.      PUT_LINE(SCREEN_MESSAGE);
  241.      ATTRIBUTES_OFF;
  242.      SKIP_LINES(3);
  243.      loop
  244.       PUT_LINE("Input ULP service request primitive ");
  245.       PUT("( OPEN, SEND, RECEIVE ,ALLOCATE, CLOSE, RESET,");
  246.       PUT(" STATUS, EXIT) :");
  247.       SERVICE_REQUEST_PRIMITIVE := "        ";
  248.       BOLD;
  249.       TEXT_IO.GET_LINE(SERVICE_REQUEST_PRIMITIVE,RESULT);
  250.       ATTRIBUTES_OFF;
  251.       if SERVICE_REQUEST_PRIMITIVE(1..4) = "OPEN"
  252.        or SERVICE_REQUEST_PRIMITIVE(1..4) = "open" then
  253.        NEW_LINE ;
  254.        PUT("Enter Local Port := ") ;
  255.        BOLD ;
  256.        INT_IO_16.GET( MY_PORT ) ;
  257.        ATTRIBUTES_OFF ;
  258.        loop
  259.         NEW_LINE;
  260.         PUT("ACTIVE or PASSIVE OPEN : ");
  261.         ACTIVE_OR_PASSIVE := "       "; -- Null string
  262.         BOLD;
  263.         TEXT_IO.GET_LINE(ACTIVE_OR_PASSIVE,RESULT);
  264.         ATTRIBUTES_OFF;
  265.         if ACTIVE_OR_PASSIVE(1..6) = "ACTIVE"
  266.              or ACTIVE_OR_PASSIVE(1..6) = "active" then
  267.          COMPONENT_ACTIVE_OR_PASSIVE := ACTIVE;
  268.          NEW_LINE;
  269.          PUT("Input Foreign Net Host : ");
  270.          BOLD;
  271.          INT_IO_32.GET(FOREIGN_NET_HOST);
  272.          ATTRIBUTES_OFF;
  273.          exit;
  274.         elsif ACTIVE_OR_PASSIVE(1..7) = "PASSIVE"
  275.              or ACTIVE_OR_PASSIVE(1..7) = "passive" then
  276.          NEW_LINE;
  277.          PUT("Input Foreign Net Host : ");
  278.          BOLD;
  279.          INT_IO_32.GET(FOREIGN_NET_HOST);
  280.          ATTRIBUTES_OFF;
  281.          COMPONENT_ACTIVE_OR_PASSIVE := PASSIVE;
  282.          exit;
  283.         else
  284.          NEW_LINE;
  285.          PUT_LINE("Your input was not PASSIVE or ACTIVE");
  286.          PUT_LINE("Try again");
  287.         end if;
  288.        end loop;
  289.        loop
  290.         NEW_LINE;
  291.         PUT("Input Foreign_port : ");
  292.         BOLD;
  293.         INT_IO_16.GET(FOREIGN_PORT);
  294.         ATTRIBUTES_OFF;
  295.         if FOREIGN_PORT in -1..255 then
  296.          exit;
  297.         else
  298.          NEW_LINE;
  299.          PUT_LINE("Your input was not within -1 - 255 ");
  300.          PUT_LINE("Try again");
  301.         end if;
  302.        end loop;
  303.        loop
  304.         NEW_LINE;
  305.         PUT("Input Precedence(0 - 7) : ");
  306.         PRECEDENCE := 0; -- default
  307.         BOLD;
  308.         INT_IO_16.GET(PRECEDENCE);
  309.         ATTRIBUTES_OFF;
  310.         if PRECEDENCE in 0..7 then
  311.          exit;
  312.         else
  313.          NEW_LINE;
  314.          PUT_LINE("Your input was not within the range of 0-7 ");
  315.          PUT_LINE("Try again");
  316.         end if;
  317.        end loop;
  318.        loop
  319.         NEW_LINE;
  320.         PUT("Input Time out(15 - 255) :");
  321.         TIMEOUT := 15; -- default
  322.         BOLD;
  323.         INT_IO_16.GET(TIMEOUT);
  324.         ATTRIBUTES_OFF;
  325.         if TIMEOUT in 15..255 then
  326.          exit;
  327.         else
  328.          NEW_LINE;
  329.          PUT_LINE("Your input was not within the range of 15-255 ");
  330.          PUT_LINE("Try again");
  331.         end if;
  332.        end loop;
  333.        --intialize all options to zero for now
  334.        for I in 1..50 loop
  335.         x(I) := 0;
  336.        end loop;
  337.        OPEN_PARAMETERS := (MY_PORT,
  338.                            FOREIGN_PORT,
  339.                            FOREIGN_NET_HOST,
  340.                            COMPONENT_ACTIVE_OR_PASSIVE,
  341.                            0,
  342.                            TIMEOUT,
  343.                            LCN_POINTER,
  344.                            0,
  345.                            PRECEDENCE,
  346.                            X);
  347.        TCP_MESSAGE := ( OPEN, OPEN_PARAMETERS);
  348.        MESSAGE_FOR_TCP(TCP_MESSAGE , REQUEST_OK);
  349.        exit;
  350.       elsif SERVICE_REQUEST_PRIMITIVE(1..4) = "EXIT" or
  351.             SERVICE_REQUEST_PRIMITIVE(1..4) = "exit" then
  352.        exit;
  353.       elsif SERVICE_REQUEST_PRIMITIVE = "SEND    "
  354.                or SERVICE_REQUEST_PRIMITIVE = "send    " then
  355.        loop
  356.         NEW_LINE;
  357.         PUT("Input Time out(15 - 255) :");
  358.         TIMEOUT := 15; -- default
  359.         INT_IO_16.GET(TIMEOUT);
  360.         if TIMEOUT in 15..255 then
  361.          exit;
  362.         end if;
  363.        end loop;
  364.        PUT_LINE("Input message below(Terminate with """" # """")");
  365.        INDEX := 0; -- Intialize INDEX
  366.        BUFFGET( MESSAGE_BUFFER, BUFFER_TYPE);
  367.        INPUT_CHARACTER := ' ';
  368.        while INPUT_CHARACTER /= ASCII.SHARP  loop
  369.         GET(INPUT_CHARACTER);
  370.         INDEX := INDEX + 1;
  371.         MESSAGE(INDEX) := INPUT_CHARACTER;
  372.         end loop;
  373.         PTR := 255 - INDEX;
  374.       for I in 1.. INDEX loop
  375.       MESSAGE_BUFFER.BYTE( PTR + I) :=
  376.                                           CHARACTER'POS(MESSAGE(I));
  377.       end loop;
  378.       NEW_LINE;
  379.       PUT_LINE("READY TO SEND MESSAGE");
  380.       NEW_LINE;
  381.       MESSAGE_BUFFER.TELNET_PTR := PTR + 1;
  382.       MESSAGE_BUFFER.TCP_PTR := PTR;
  383.       LCN_STRING(1..6) := "      ";
  384.       NEW_LINE;
  385.       PUT("Input 6-character LCN name = ");
  386.       BOLD;
  387.       GET( LCN_STRING ) ;
  388.       ATTRIBUTES_OFF;
  389.       LCN_NAME_PTR.LCN_NAME(1..6) := LCN_STRING(1..6) ;
  390.       OBTAIN_LCN(LCN_NAME_PTR);
  391.       LCN_POINTER := LCN_NAME_PTR.LCN ;
  392.       MESSAGE_BUFFER.TCP_PTR := 255 - INDEX - 1;
  393.       SEND_PARAMETERS := ( LCN_POINTER, MESSAGE_BUFFER, INDEX - 1,
  394.                             0, 0, TIMEOUT);
  395.       TCP_MESSAGE := ( SEND, SEND_PARAMETERS);
  396.       MESSAGE_FOR_TCP(TCP_MESSAGE, REQUEST_OK );
  397.       NEW_LINE;
  398.       PUT_LINE("JUST SENT MESSAGE");
  399.       NEW_LINE;
  400.       BUFFGET( BUFFER, 1);
  401.       BUFFER.TCP_PTR := 1;
  402.       BUFFER.TELNET_PTR := 255;
  403.       LCN_POINTER.LCN_PTR := LCN_NAME_PTR.LCN.LCN_PTR ;
  404.       BUFFGET( BUFFER , 0 );
  405.       RECEIVE_DATA := ( LCN_POINTER, BUFFER, 190);
  406.       TCP_MESSAGE := ( RECEIVE, RECEIVE_DATA);
  407.       MESSAGE_FOR_TCP(TCP_MESSAGE, REQUEST_OK );
  408.      exit;
  409.     elsif SERVICE_REQUEST_PRIMITIVE(1..7) = "RECEIVE" or
  410.             SERVICE_REQUEST_PRIMITIVE(1..7) = "receive" then
  411.       LCN_STRING(1..6) := "      ";
  412.       PUT("Input 6-character LCN name = ");
  413.       BOLD;
  414.       GET( LCN_STRING ) ;
  415.       ATTRIBUTES_OFF;
  416.       LCN_NAME_PTR.LCN_NAME(1..6) := LCN_STRING(1..6) ;
  417.       OBTAIN_LCN(LCN_NAME_PTR);
  418.       LCN_POINTER := LCN_NAME_PTR.LCN ;
  419.       BUFFGET( BUFFER ,0 ) ;
  420.       RECEIVE_DATA := ( LCN_POINTER, BUFFER, 190);
  421.       TCP_MESSAGE := ( RECEIVE, RECEIVE_DATA);
  422.       MESSAGE_FOR_TCP(TCP_MESSAGE, REQUEST_OK );
  423.       exit;
  424.     elsif SERVICE_REQUEST_PRIMITIVE(1..5) = "CLOSE" or
  425.             SERVICE_REQUEST_PRIMITIVE(1..5) = "close" then
  426.       PUT("Input 6-character LCN name = ");
  427.       LCN_STRING(1..6) := "      ";
  428.       BOLD;
  429.       GET( LCN_STRING ) ;
  430.       ATTRIBUTES_OFF;
  431.       LCN_NAME_PTR.LCN_NAME(1..6) := LCN_STRING(1..6);
  432.       OBTAIN_LCN(LCN_NAME_PTR);
  433.       LCN_POINTER := LCN_NAME_PTR.LCN ;
  434.       CLOSE_PARAMETERS.LOCAL_CONNECTION_NAME := LCN_POINTER ;
  435.       TCP_MESSAGE := ( CLOSE, CLOSE_PARAMETERS);
  436.       MESSAGE_FOR_TCP(TCP_MESSAGE, REQUEST_OK );
  437.       exit;
  438.     elsif SERVICE_REQUEST_PRIMITIVE = "RESET   "
  439.           or SERVICE_REQUEST_PRIMITIVE = "reset   " then
  440.       PUT("Input 6-character LCN name = ");
  441.       LCN_STRING(1..6) := "      ";
  442.       BOLD;
  443.       GET( LCN_STRING ) ;
  444.       ATTRIBUTES_OFF;
  445.       LCN_NAME_PTR.LCN_NAME(1..6) := LCN_STRING(1..6);
  446.       OBTAIN_LCN(LCN_NAME_PTR);
  447.       LCN_POINTER := LCN_NAME_PTR.LCN ;
  448.       ABORT_PARAMETERS.LOCAL_CONNECTION_NAME := LCN_POINTER ;
  449.       TCP_MESSAGE := ( ABOR_T, ABORT_PARAMETERS);
  450.       MESSAGE_FOR_TCP(TCP_MESSAGE, REQUEST_OK );
  451.       exit;
  452.     elsif SERVICE_REQUEST_PRIMITIVE = "STATUS  "
  453.           or SERVICE_REQUEST_PRIMITIVE = "status  " then
  454.       PUT("Input 6-character LCN name = ");
  455.       LCN_STRING(1..6) := "      ";
  456.       BOLD;
  457.       GET( LCN_STRING ) ;
  458.       ATTRIBUTES_OFF;
  459.       LCN_NAME_PTR.LCN_NAME(1..6) := LCN_STRING(1..6);
  460.       OBTAIN_LCN(LCN_NAME_PTR);
  461.       STATUS_PARAMETERS.LOCAL_CONNECTION_NAME := LCN_NAME_PTR.LCN ;
  462.       TCP_MESSAGE := ( STATUS, STATUS_PARAMETERS);
  463.       MESSAGE_FOR_TCP(TCP_MESSAGE, REQUEST_OK );
  464.       exit;
  465.     else
  466.      NEW_LINE;
  467.      PUT_LINE("Bogus Service Request Primitive ");
  468.      PUT_LINE("Try again");
  469.     end if;
  470.    end loop;
  471.    loop
  472.     NEW_LINE;
  473.     PUT("Another message : ");
  474.     YES_OR_NO := "   ";
  475.     BOLD;
  476.     GET_LINE(YES_OR_NO,RESULT);
  477.     ATTRIBUTES_OFF;
  478.     if YES_OR_NO(1..3) = "YES" or YES_OR_NO(1..3) = "yes" then
  479.      GENERATE_ANOTHER_MESSAGE := YES;
  480.      exit;
  481.     elsif YES_OR_NO(1..2) = "NO" or YES_OR_NO(1..2) = "no" then
  482.      GENERATE_ANOTHER_MESSAGE := NO;
  483.      exit;
  484.     else
  485.      NEW_LINE;
  486.      PUT_LINE("Type Yes or No ");
  487.      PUT_LINE("Try again ");
  488.     end if;
  489.    end loop;
  490.   end loop;
  491.   end TEST_MESSAGE_GENERATOR;
  492.      
  493.    procedure OBTAIN_A_PACKET_FROM_TCP is
  494.      
  495.    subtype CHR_COUNT_TYPE is SIXTEEN_BITS ;
  496.    subtype TEMP_TYPE is SIXTEEN_BITS ;
  497.    subtype CHAR_TYPE is CHARACTER;
  498.    subtype CRLF_TYPE is STRING(1..2);
  499.      
  500.    MESSAGE_FOR_USER : USER_MESSAGE;
  501.    CHR_COUNT : CHR_COUNT_TYPE;
  502.    TEMP : TEMP_TYPE;
  503.    CHAR : CHAR_TYPE;
  504.    CRLF : CRLF_TYPE;
  505.    BUFFER : PACKED_BUFFER_PTR ;
  506.    TCP_MESSAGE : WITH_ULP_COMMUNICATE.MESSAGE ;
  507.    RECEIVE_DATA : RECEIVE_PARAMS ;
  508.    LCN_POINTER : LCN_PTR_TYPE ;
  509.    CHANNEL_NAME : STRING(1..30) ;
  510.    TO_CHANNEL : CHANNEL_TYPE;
  511.    RETURN_STATUS : COND_VALUE_TYPE;
  512.    FOREIGN_NET_HOST : THIRTYTWO_BITS := 0 ;
  513.    FOREIGN_PORT : SIXTEEN_BITS := 0 ;
  514.    LOCAL_NET_HOST : THIRTYTWO_BITS := 0 ;
  515.    LOCAL_PORT : SIXTEEN_BITS := 0 ;
  516.    FOREIGN_NET_HOST_STRING : STRING(1..5) := "     " ;
  517.    FOREIGN_PORT_STRING : STRING(1..5) := "     " ;
  518.    LOCAL_NET_HOST_STRING : STRING(1..5) := "     " ;
  519.    LOCAL_PORT_STRING : STRING(1..5) := "     " ;
  520.    DUMMY : CHARACTER ;
  521.    ULP_MESSAGE_SIZE : constant UNSIGNED_LONGWORD := 650 ;
  522.    INPUT_CHAR : CHARACTER := ' ';
  523.    LCN_STRING : STRING(1..6) := "      ";
  524.    LCN_NAME_PTR : LCN_NAME_PTR_TYPE;
  525.    LENGTH : NATURAL ;
  526.      
  527.    begin
  528.     -- Obtain a message from TCP
  529.     PUT( "Input Foreign_Net_Host := ") ;
  530.     INT_IO_32.GET(FOREIGN_NET_HOST) ;
  531.     NEW_LINE;
  532.     PUT("Input FOREIGN_PORT := ") ;
  533.     INT_IO_16.GET(FOREIGN_PORT) ;
  534.     NEW_LINE ;
  535.     PUT( "Input Local_Net_Host := ") ;
  536.     INT_IO_32.GET(LOCAL_NET_HOST) ;
  537.     NEW_LINE;
  538.     PUT("Input Local_Port := ") ;
  539.     INT_IO_16.GET(LOCAL_PORT) ;
  540.     NEW_LINE ;
  541.     CONVERT_INT_32_TO_STRING.PUT ( FOREIGN_NET_HOST_STRING ,
  542.                                    FOREIGN_NET_HOST ) ;
  543.     CONVERT_INT_16_TO_STRING.PUT ( FOREIGN_PORT_STRING ,
  544.                                    FOREIGN_PORT ) ;
  545.     CONVERT_INT_32_TO_STRING.PUT ( LOCAL_NET_HOST_STRING ,
  546.                                    WHOIAM ) ;
  547.     CONVERT_INT_16_TO_STRING.PUT ( LOCAL_PORT_STRING ,
  548.                                    LOCAL_PORT ) ;
  549.     CHANNEL_NAME(1..30) := "                              " ;
  550.     CHANNEL_NAME(1..3) := "MBX";
  551.     CHANNEL_NAME(4..8) := FOREIGN_NET_HOST_STRING ;
  552.     CHANNEL_NAME(9..13) := FOREIGN_PORT_STRING ;
  553.     CHANNEL_NAME(14..18) := LOCAL_NET_HOST_STRING ;
  554.     CHANNEL_NAME(19..23) := LOCAL_PORT_STRING ;
  555.     CREMBX( STATUS => RETURN_STATUS ,
  556.             PRMFLG => true       ,             -- permanent
  557.             CHAN   => TO_CHANNEL,
  558.             MAXMSG => ULP_MESSAGE_SIZE,        --size of message
  559.             BUFQUO => 5 * ULP_MESSAGE_SIZE ,  --size of queue
  560.             LOGNAM => CHANNEL_NAME(1..30) ) ;      -- fixed name
  561.     if NOT SUCCESS ( RETURN_STATUS ) then
  562.      PUT_LINE("Could not create tcp channel") ;
  563.     else
  564.      MESSAGE_FOR_USER.LOCAL_CONNECTION_NAME.CHANNEL_PTR := TO_CHANNEL ;
  565.      WAIT_FOR_TCP_MESSAGE(MESSAGE_FOR_USER);
  566.      NEW_LINE;
  567.      CLEAR_SCREEN;
  568.      HOME_POSITION;
  569.      case MESSAGE_FOR_USER.MESSAGE_NUMBER is
  570.       when -1 =>
  571.        NEW_LINE;
  572.        PUT_LINE("Packet from TCP queue is null");
  573.        NEW_LINE;
  574.       when 2 =>
  575.        NEW_LINE;
  576.        PUT_LINE("Connection illegal ");
  577.        NEW_LINE;
  578.       when 3 =>
  579.        NEW_LINE;
  580.        PUT_LINE("Connection does not exist ");
  581.        NEW_LINE;
  582.       when 4 =>
  583.        NEW_LINE;
  584.        PUT_LINE("Foreign Socket Unspecified ");
  585.        NEW_LINE;
  586.       when 5=>
  587.        NEW_LINE;
  588.        PUT_LINE("Insufficient Resources ");
  589.        NEW_LINE;
  590.       when 6 =>
  591.        NEW_LINE;
  592.        PUT_LINE("Connection Closing ");
  593.        NEW_LINE;
  594.       when 7 =>
  595.        NEW_LINE;
  596.        PUT_LINE("Urgent data is coming");
  597.        NEW_LINE;
  598.       when 8 =>
  599.        NEW_LINE;
  600.        PUT_LINE("Connection Aborted");
  601.        NEW_LINE;
  602.       when 9 =>
  603.        NEW_LINE;
  604.        PUT_LINE("Precedence not allowed");
  605.        NEW_LINE;
  606.       when 10 =>
  607.        NEW_LINE;
  608.        PUT_LINE("Message for user");
  609.        NEW_LINE;
  610.        PUT_LINE("Here's the message : ");
  611.        NEW_LINE;
  612.        CHR_COUNT := 0;
  613.        TEMP := MESSAGE_FOR_USER.DATA_BUFFER.TELNET_PTR -
  614.                MESSAGE_FOR_USER.DATA_BUFFER.TCP_PTR;
  615.        NEW_LINE;
  616.        PUT("NUMBER OF CHARS TRANSMITTED := ");
  617.        INT_IO_16.PUT(TEMP);
  618.        NEW_LINE;
  619.        begin
  620.         while CHR_COUNT <= TEMP loop
  621.          CHAR := CHARACTER'VAL(MESSAGE_FOR_USER.DATA_BUFFER.BYTE(
  622.                          MESSAGE_FOR_USER.DATA_BUFFER.TCP_PTR +
  623.                          CHR_COUNT));
  624.          if CHAR = ASCII.CR then -- Put LF
  625.           CRLF(1) := ASCII.CR;
  626.           CRLF(2) := ASCII.LF;
  627.           PUT(CRLF);
  628.          else
  629.           PUT(CHAR);
  630.          end if;
  631.          CHR_COUNT := CHR_COUNT + 1;
  632.         end loop;
  633.         BUFFGET( BUFFER, 1);
  634.         RECEIVE_DATA := ( LCN_POINTER, BUFFER, 190);
  635.         TCP_MESSAGE := ( RECEIVE, RECEIVE_DATA);
  636.                exception
  637.          when CONSTRAINT_ERROR =>
  638.           PUT_LINE("Constraint error in received data");
  639.           PUT("TCP_PTR := ");
  640.           INT_IO_16.PUT(MESSAGE_FOR_USER.DATA_BUFFER.TCP_PTR);
  641.           NEW_LINE;
  642.           PUT("TELNET_PTR := ");
  643.           INT_IO_16.PUT(MESSAGE_FOR_USER.DATA_BUFFER.TELNET_PTR);
  644.           NEW_LINE;
  645.           PUT("CHR_COUNT := ");
  646.           INT_IO_16.PUT(CHR_COUNT);
  647.           NEW_LINE;
  648.           PUT("TEMP");
  649.           INT_IO_16.PUT(TEMP);
  650.           NEW_LINE;
  651.         end;
  652.        when 11 =>
  653.         NEW_LINE;
  654.         PUT_LINE("Security/Compartment Illegal");
  655.         NEW_LINE;
  656.        when 12 =>
  657.         NEW_LINE;
  658.         PUT_LINE("Connection exisits");
  659.         NEW_LINE;
  660.        when 14 =>
  661.         NEW_LINE;
  662.         PUT_LINE("Map LCN to a Port number");
  663.         LCN_STRING := "      ";
  664.         PUT("INPUT 6-CHARACTER LCN NAME := ");
  665.         BOLD;
  666.         GET( LCN_STRING ) ;
  667.         ATTRIBUTES_OFF;
  668.         LCN_NAME_PTR.LCN_NAME := LCN_STRING ;
  669.         LCN_NAME_PTR.LCN.LCN_PTR :=
  670.                  MESSAGE_FOR_USER.LOCAL_CONNECTION_NAME.LCN_PTR;
  671.         ADD_LCN_RECORD(LCN_NAME_PTR);
  672.         NEW_LINE;
  673.        when 15 =>
  674.         NEW_LINE;
  675.         PUT_LINE("Status Information");
  676.         NEW_LINE;
  677.         PUT("Source Port := ");
  678.         INT_IO_16.PUT(MESSAGE_FOR_USER.STATUS_PARAMS.SOURCE_PORT);
  679.         NEW_LINE;
  680.         PUT("Source Address := ");
  681.         INT_IO_32.PUT(MESSAGE_FOR_USER.STATUS_PARAMS.SOURCE_ADDRESS);
  682.         NEW_LINE;
  683.         PUT("Destination Address := ");
  684.         INT_IO_32.PUT(MESSAGE_FOR_USER.STATUS_PARAMS.DESTINATION_ADDRESS);
  685.         NEW_LINE;
  686.         PUT("Destination Port := ");
  687.         INT_IO_16.PUT(MESSAGE_FOR_USER.STATUS_PARAMS.DESTINATION_PORT);
  688.         NEW_LINE;
  689.         PUT("Number of octets that can be accepted := ");
  690.         INT_IO_16.PUT(MESSAGE_FOR_USER.STATUS_PARAMS.LOCAL_RCV_WINDOW);
  691.         NEW_LINE;
  692.         PUT("Number of octets that can be sent := ");
  693.         INT_IO_16.PUT(MESSAGE_FOR_USER.STATUS_PARAMS.REMOTE_RCV_WINDOW);
  694.         NEW_LINE;
  695.         PUT("Precedence value := ");
  696.         INT_IO_16.PUT(MESSAGE_FOR_USER.STATUS_PARAMS.PRECEDENCE);
  697.         NEW_LINE;
  698.         if MESSAGE_FOR_USER.STATUS_PARAMS.STATUS =
  699.                  CONNECTION_OPEN then
  700.          NEW_LINE;
  701.          PUT_LINE("Connection open");
  702.          NEW_LINE;
  703.         else
  704.          NEW_LINE;
  705.          PUT_LINE("Connection close");
  706.          NEW_LINE;
  707.         end if;
  708.         case MESSAGE_FOR_USER.STATUS_PARAMS.CONNECTION_STATE is
  709.          when CLOSED =>
  710.           NEW_LINE;
  711.           PUT_LINE("TCB is in closed state");
  712.           NEW_LINE;
  713.          when LISTEN =>
  714.           NEW_LINE;
  715.           PUT_LINE("TCB is in listen state");
  716.           NEW_LINE;
  717.          when SYN_SENT =>
  718.           NEW_LINE;
  719.           PUT_LINE("TCB is in the SYN SENT state");
  720.           NEW_LINE;
  721.          when SYN_RECEIVED =>
  722.           NEW_LINE;
  723.           PUT_LINE("TCB is in the SYN RECEIVED state");
  724.           NEW_LINE;
  725.          when ESTABLISHED =>
  726.           NEW_LINE;
  727.           PUT_LINE("TCB is in the ESTABLISHED state");
  728.           NEW_LINE;
  729.          when FIN_WAIT_1 =>
  730.           NEW_LINE;
  731.           PUT_LINE("TCB is in the FIN_WAIT_1 state");
  732.           NEW_LINE;
  733.          when FIN_WAIT_2 =>
  734.           NEW_LINE;
  735.           PUT_LINE("TCB is in the FIN_WAIT_2 state");
  736.           NEW_LINE;
  737.          when CLOSE_WAIT =>
  738.           NEW_LINE;
  739.           PUT_LINE("TCB is in the CLOSE_WAIT state");
  740.           NEW_LINE;
  741.          when LAST_ACK =>
  742.           NEW_LINE;
  743.           PUT_LINE("TCB is in the LAST_ACK state");
  744.           NEW_LINE;
  745.          when TIME_WAIT =>
  746.           NEW_LINE;
  747.           PUT_LINE("TCB is in the TIME_WAIT state");
  748.           NEW_LINE;
  749.          when CLOSING =>
  750.           NEW_LINE;
  751.           PUT_LINE("TCB is in the CLOSING state");
  752.           NEW_LINE;
  753.         end case;
  754.         when 16 =>
  755.          NEW_LINE;
  756.          PUT_LINE("Connection reset by other host");
  757.          NEW_LINE;
  758.         when 17 =>
  759.          NEW_LINE;
  760.          PUT_LINE("Connection refused");
  761.          NEW_LINE;
  762.         when 18 =>
  763.          NEW_LINE;
  764.          PUT_LINE("OK on Close");
  765.          NEW_LINE;
  766.         when 19 =>
  767.          NEW_LINE;
  768.          PUT_LINE("Pushed buffer for user");
  769.          NEW_LINE;
  770.         when 20 =>
  771.          NEW_LINE;
  772.          PUT_LINE("Out of buffers in a lower layer");
  773.          NEW_LINE;
  774.         when 21 =>
  775.          NEW_LINE;
  776.          PUT_LINE("Unable to reset");
  777.          NEW_LINE;
  778.         when 22 =>
  779.          NEW_LINE;
  780.          PUT_LINE("IP is currently overloaded");
  781.          NEW_LINE;
  782.         when 23 =>
  783.          NEW_LINE;
  784.          PUT_LINE("Connection open for port");
  785.          NEW_LINE;
  786.         when 24 =>
  787.          NEW_LINE;
  788.          PUT_LINE("Connection aborted due to user timeout");
  789.          NEW_LINE;
  790.         when others =>
  791.          NEW_LINE;
  792.          PUT_LINE(" OOPS : NOT A VALID TELNET MESSAGE NUMBER !!!");
  793.          NEW_LINE;
  794.        end case;
  795.       end if ;
  796.       BOLD;
  797.       BLINK;
  798.       PUT("STRIKE ANY CHARACTER TO CONTINUE ");
  799.       GET(DUMMY);
  800.       ATTRIBUTES_OFF;
  801.       exception
  802.        when CONSTRAINT_ERROR =>
  803.         PUT_LINE("CONSTRAINT ERROR in USER CONTROLLER");
  804.        when others =>
  805.         PUT_LINE("Unknown error in USER CONTROLLER");
  806.       end OBTAIN_A_PACKET_FROM_TCP;
  807.      
  808.  procedure PRINT_TESTER_LOGO is
  809.      
  810.         -- This procedure clears the screen and prints
  811.         -- out a logo.
  812.      
  813.  ROW : STRING(1..65);
  814.  DUMMY : CHARACTER;--dummy character
  815.      
  816.  begin
  817.   HOME_POSITION;
  818.   CLEAR_SCREEN;
  819.   ROW := "                                                                 ";
  820.   REVERSE_VIDEO;--reverse video
  821.   for I in 1..10 loop
  822.    NEW_LINE;
  823.    PUT(ROW);
  824.   end loop;
  825.   NEW_LINE;
  826.   ROW := "          ****************************************               ";
  827.   PUT_LINE(ROW);
  828.   ROW := "          *                                      *               ";
  829.   PUT_LINE(ROW);
  830.   ROW := "          *                                      *               ";
  831.   PUT_LINE(ROW);
  832.   ROW := "          *              E-Systems               *               ";
  833.   PUT_LINE(ROW);
  834.   ROW := "          *             ECI Division             *               ";
  835.   PUT_LINE(ROW);
  836.   ROW := "          *             TCP/ TESTER              *               ";
  837.   PUT_LINE(ROW);
  838.   ROW := "          *                                      *               ";
  839.   PUT_LINE(ROW);
  840.   ROW := "          *                                      *               ";
  841.   PUT_LINE(ROW);
  842.   ROW := "          ****************************************               ";
  843.   PUT_LINE(ROW);
  844.   ROW := "                                                                 ";
  845.   for I in 1..3 loop
  846.    PUT_LINE(ROW);
  847.   end loop;
  848.   ROW := "          Please any character to continue :                     ";
  849.   REVERSE_VIDEO;--reverse video
  850.   BLINK;
  851.   PUT_LINE(ROW);
  852.   GET(DUMMY);--DELAY
  853.   ATTRIBUTES_OFF;
  854.  end PRINT_TESTER_LOGO;
  855.      
  856.  procedure PRINT_TESTER_MENU(MENU_SELECTION_INPUT :
  857.                         out SIXTEEN_BITS ) is
  858.      
  859.                 -- This procedure displays the menu and receives the
  860.                 -- the desired input to determine test selection.
  861.  ROW1 : STRING(1..24);
  862.  MENU_ROW : STRING(1..58);
  863.  MENU_SELECTION : SIXTEEN_BITS := 0 ;
  864.      
  865.  begin
  866.   loop
  867.    HOME_POSITION;
  868.    CLEAR_SCREEN; -- Clear screen
  869.    REVERSE_VIDEO;
  870.    for I in 1..5 loop
  871.     NEW_LINE;
  872.    end loop;
  873.    MENU_ROW := "                      TEST MENU                           ";
  874.    PUT_LINE(MENU_ROW);
  875.    for I in 1..3 loop
  876.     NEW_LINE;
  877.    end loop;
  878.    MENU_ROW := "1.) Create test packets                                   ";
  879.    PUT_LINE(MENU_ROW);
  880.    MENU_ROW := "2.) Listen for packet                                     ";
  881.    PUT_LINE(MENU_ROW);
  882.    MENU_ROW := "3.) Exit test program                                     ";
  883.    PUT_LINE(MENU_ROW);
  884.    for I in 1..7 loop
  885.     NEW_LINE;
  886.    end loop;
  887.    ROW1 := "     Input menu entry : ";
  888.    ATTRIBUTES_OFF;
  889.    BLINK;
  890.    BOLD;
  891.    PUT_LINE(ROW1);
  892.    INT_IO_16.GET(MENU_SELECTION);
  893.    MENU_SELECTION_INPUT := MENU_SELECTION ;
  894.    if MENU_SELECTION in 1..3 then
  895.     exit; --Go back to main and process selection
  896.    end if;
  897.    -- assert :user has input invalided selection,
  898.    -- force another input:
  899.    end loop;
  900.    ATTRIBUTES_OFF;
  901.  end PRINT_TESTER_MENU;
  902.      
  903. begin
  904.  INIT; --intialize buffers
  905.  INTIALIZE_LCNS;
  906.  PRINT_TESTER_LOGO;
  907.  loop
  908.   PRINT_TESTER_MENU(MENU_SELECTION);
  909.   case MENU_SELECTION is
  910.      
  911.    -- Create test packets
  912.    when 1 =>
  913.     TEST_MESSAGE_GENERATOR;
  914.      
  915.    when 2 =>
  916.     OBTAIN_A_PACKET_FROM_TCP ;
  917.      
  918.    -- Exit program
  919.     when 3 =>
  920.      END_TEST_FLAG := END_TEST ;
  921.      
  922.     when others =>
  923.      NEW_LINE;
  924.      PUT_LINE("Error in case statement of TCP Tester");
  925.      END_TEST_FLAG := END_TEST;
  926.    end case;
  927.    if END_TEST_FLAG = END_TEST then
  928.     exit; -- Quit
  929.    end if;
  930.   end loop;
  931.   exception
  932.    when CONSTRAINT_ERROR =>
  933.     PUT_LINE(" exception CONSTRAINT ERROR procedure TCP_TESTER");
  934.    when others =>
  935.     PUT_LINE(" exception OTHERS procedure TCP_TESTER ");
  936. end TCP_ULP_TESTER ;
  937.