home *** CD-ROM | disk | FTP | other *** search
/ Programmer's ROM - The Computer Language Library / programmersrom.iso / ada / defdata / tcpstand.src < prev    next >
Encoding:
Text File  |  1988-05-03  |  17.3 KB  |  474 lines
  1. --::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  2. --new_ncommu_.ada
  3. --::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  4. -----------------------------------------------------------------------
  5. --
  6. --         DoD Protocols    NA-00002-200       80-01037-100(-)
  7. --         E-Systems, Inc.  August 07, 1985
  8. --
  9. --         NEW_NCOMMU_.ADA       Author : Jim Baldo
  10. --
  11. -----------------------------------------------------------------------
  12. with STARLET;                           use STARLET;
  13. with IP_GLOBALS;                        use IP_GLOBALS;
  14. with BUFFER_DATA;                       use BUFFER_DATA;
  15. with T_TCP_GLOBALS_DATA_STRUCTURES;     use T_TCP_GLOBALS_DATA_STRUCTURES;
  16.      
  17.                 package WITH_ULP_COMMUNICATE is
  18.      
  19.         ---------------------------------------------------------------
  20.         --This implementation is for use with DEC/Ada compiler.      --
  21.         ---------------------------------------------------------------
  22.      
  23. -------------------------------------------------------------------------------
  24. --This package contains all the data abstractions and operations necessary   --
  25. --to support the User/TCP interface and TCP/lower-level interface.           --
  26. --The enumerated type ACTION represents the type of request primitive        --
  27. --that is sent by the upper layer or lower layer protocols.                  --
  28. -------------------------------------------------------------------------------
  29.      
  30. type STATUS_TYPE is ( CONNECTION_OPEN, CONNECTION_CLOSED, OPENING, CLOSING);
  31. type SECURITIES is array(1..9) of SIXTEEN_BITS ;
  32. type STATE_TYPE is ( CLOSED, SYN_SENT, SYN_RECEIVED, ESTABLISHED, LISTEN,
  33.                      FIN_WAIT_1, CLOSE_WAIT, FIN_WAIT_2, CLOSING, TIME_WAIT,
  34.                      LAST_ACK); -- same as in TCPGLB
  35.      
  36. type STATUS_RECORD is
  37.  record
  38.   SOURCE_PORT : SIXTEEN_BITS ;
  39.   SOURCE_ADDRESS : THIRTYTWO_BITS ;
  40.   DESTINATION_PORT : SIXTEEN_BITS ;
  41.   DESTINATION_ADDRESS : THIRTYTWO_BITS ;
  42.   CONNECTION_STATE : STATE_TYPE;
  43.   STATUS : STATUS_TYPE;
  44.   LOCAL_RCV_WINDOW : SIXTEEN_BITS ;
  45.   REMOTE_RCV_WINDOW : SIXTEEN_BITS ;
  46.   OCTETS_ON_RETRANSMIT_QUEUE : SIXTEEN_BITS ;
  47.   DATA_WAITING_FOR_ULP : SIXTEEN_BITS ;
  48.   URGENT_STATE : BOOLEAN;
  49.   PRECEDENCE : SIXTEEN_BITS ;
  50.   SECURITY : SECURITIES;
  51.   ULP_TIMEOUT : SIXTEEN_BITS ;
  52. end record;
  53.      
  54. subtype LCN_TYPE is TCB_PTR;
  55.      
  56. type LCN_PTR_TYPE is
  57.  record
  58.   LCN_PTR : LCN_TYPE := null;
  59.   CHANNEL_PTR : CHANNEL_TYPE ;
  60.   CHANNEL_NAME : STRING(1..30) ;
  61.  end record;
  62.      
  63. -------------------------------------------------------------------------------
  64. -- THE MESSAGE NUMBERS FOR THE USER AND THEIR MEANING FOLLOW                 --
  65. -- -1 : NO USER ACTION                                                       --
  66. --                                                                           --
  67. -- 2: CONNECTION ILLEGAL                                                     --
  68. -- 3: CONNECTION DOES NOT EXIST                                              --
  69. -- 4: FOREIGN SOCKET UNSPECIFIED                                             --
  70. -- 5: INSUFFICIENT RESOURCES                                                 --
  71. -- 6: CONNECTION CLOSING                                                     --
  72. -- 7: URGENT DATA                                                            --
  73. -- 8: OK ON ABORT                                                            --
  74. -- 9: PRECEDENCE NOT ALLOWED                                                 --
  75. -- 10: BUFFER FOR USER                                                       --
  76. -- 11: SECURITY/COMPARTMENT ILLEGAL                                          --
  77. -- 12: CONNECTION EXISTS                                                     --
  78. -- 14: RETURN LCN                                                            --
  79. -- 15: TCB POINTER AND STATE                                                 --
  80. -- 16: CONNECTION RESET                                                      --
  81. -- 17: CONNECTION REFUSED                                                    --
  82. -- 18: OK ON CLOSE                                                           --
  83. -- 19: PUSHED BUFFER FOR USER                                                --
  84. -- 20: OUT OF BUFFERS                                                        --
  85. -- 21: COULDN'T DO RESET                                                     --
  86. -- 22: IP OVERLOADED.                                                        --
  87. -- 23: CONNECTION IS NOW OPEN.                                               --
  88. -------------------------------------------------------------------------------
  89.      
  90. type USER_MESSAGE(MESSAGE_NUMBER : SIXTEEN_BITS  := 0) is
  91.   record
  92.    LOCAL_CONNECTION_NAME : LCN_PTR_TYPE;
  93.     case MESSAGE_NUMBER is
  94.       when 10 | 19  =>
  95.                 DATA_BUFFER : PACKED_BUFFER_PTR;
  96.       when 15 =>
  97.                 -- STATUS PARAMETERS
  98.                 STATUS_PARAMS : STATUS_RECORD;
  99.       when others => null;
  100.     end case;
  101.   end record;
  102.      
  103. type ACTION is (OPEN,SEND,RECEIVE,ABOR_T,CLOSE,STATUS,DATA_FROM_IP,
  104.                 TIMER_TIMEOUT, ERROR_MESSAGE, TIMEOUT_IN_RETRANS_QUEUE,
  105.                 TIMEOUT_IN_TIME_WAIT, NO_TCP_ACTION);
  106.      
  107. subtype SECURITY_OPTION_ARRAY is SIXTEEN_BITS range 1..9;
  108.      
  109. type SECURITY_OPTION_TYPE is array( SECURITY_OPTION_ARRAY ) of SIXTEEN_BITS ;
  110.                                         -- EACH ELEMENT CONTAINS AN
  111.                                              -- OCTET OF SECURITY DATA.
  112. type TCP_OPTION_TYPE is array(1..50) of SIXTEEN_BITS ;
  113.      
  114. type ACKPASS is (PASSIVE, ACTIVE);
  115.      
  116. type TIMER_PARAMS is
  117.         record
  118.                 MESSAGE_NUMBER : SIXTEEN_BITS ;
  119.         end record;
  120.      
  121. type TIME_WAIT_PARAMS is
  122.         record
  123.          LOCAL_CONNECTION_NAME : LCN_PTR_TYPE;
  124.         end record;
  125.      
  126. type OPEN_PARAMS is
  127.  record
  128.   LOCAL_PORT, FOREIGN_PORT : SIXTEEN_BITS ;
  129.   FOREIGN_NET_HOST : THIRTYTWO_BITS ;
  130.   ACTIVE_PASSIVE : ACKPASS;
  131.   BUFFER_SIZE, TIMEOUT : SIXTEEN_BITS ;
  132.   LOCAL_CONNECTION_NAME : LCN_PTR_TYPE;
  133.   SECURITY, PRECEDENCE : SIXTEEN_BITS ;
  134.   OPTIONS : TCP_OPTION_TYPE;
  135. end record;
  136.      
  137. type STATUS_PARAMS is
  138.  record
  139.   LOCAL_CONNECTION_NAME : LCN_PTR_TYPE;
  140.  end record;
  141.      
  142. type ERROR_PARAMS is
  143.  record
  144.   ERROR_INDICATOR : SIXTEEN_BITS ; -- THIS MAY CHANGE.
  145.  end record;
  146.      
  147. type RETRANS_PARAMS is
  148.  record
  149.   QUEUE_NUM : SIXTEEN_BITS ;
  150.  end record;
  151.      
  152. type SEG_ARRIVE_PARAMS is
  153.  record
  154.   BUFPTR : PACKED_BUFFER_PTR;
  155.   BYTE_COUNT : SIXTEEN_BITS ;
  156.   SOURCE_ADDRESS, DESTINATION_ADDRESS : THIRTYTWO_BITS ;
  157.   PROTOCOL : SIXTEEN_BITS ;
  158.   TOS : SIXTEEN_BITS ;
  159.   SECURITY : SECURITY_OPTION_TYPE;
  160.  end record;
  161.      
  162. type SEND_PARAMS is
  163.  record
  164.   LOCAL_CONNECTION_NAME : LCN_PTR_TYPE;
  165.   BUFPTR : PACKED_BUFFER_PTR;
  166.   BYTE_COUNT, PUSH_FLAG, URG_FLAG, TIMEOUT : SIXTEEN_BITS ;
  167. end record;
  168.      
  169. type RECEIVE_PARAMS is
  170.  record
  171.   LOCAL_CONNECTION_NAME : LCN_PTR_TYPE;
  172.   BUFPTR : PACKED_BUFFER_PTR;
  173.   BYTE_COUNT : SIXTEEN_BITS ;
  174.  end record;
  175.      
  176. type ABORT_CLOSE_PARAMS is
  177.  record
  178.   LOCAL_CONNECTION_NAME : LCN_PTR_TYPE;
  179.  end record;
  180.      
  181. --TCP responds to message which are associated with a type of event.  The
  182. --data abstraction of MESSAGE creates the appropiate message for the given
  183. --event.
  184. type MESSAGE(EVENT : ACTION := OPEN) is
  185.  record
  186.   case EVENT is
  187.    when   ABOR_T |  CLOSE
  188.         => ABORT_CLOSE_PARAMETERS : ABORT_CLOSE_PARAMS;
  189.      
  190.    when DATA_FROM_IP
  191.         => DATA_FROM_IP_PARAMETERS : SEG_ARRIVE_PARAMS;
  192.      
  193.    when RECEIVE
  194.         => RECEIVE_PARAMETERS : RECEIVE_PARAMS;
  195.      
  196.    when SEND => SEND_PARAMETERS : SEND_PARAMS;
  197.      
  198.    when OPEN  => OPEN_PARAMETERS : OPEN_PARAMS;
  199.      
  200.    when STATUS
  201.               => STATUS_PARAMETERS : STATUS_PARAMS;
  202.      
  203.    when  TIMEOUT_IN_TIME_WAIT
  204.               =>  TIME_WAIT_PARAMETERS : TIME_WAIT_PARAMS;
  205.      
  206.    when TIMEOUT_IN_RETRANS_QUEUE
  207.               => RETRANS_PARAMETERS     : RETRANS_PARAMS;
  208.      
  209.    when ERROR_MESSAGE
  210.               => ERROR_PARAMETERS : ERROR_PARAMS;
  211.      
  212.    when TIMER_TIMEOUT
  213.               => TIMER_PARAMETERS : TIMER_PARAMS;
  214.      
  215.    when NO_TCP_ACTION => NULL;
  216.  end case;
  217. end record;
  218.      
  219. procedure  WAIT_FOR_TCP_MESSAGE(USER_MESS : in out USER_MESSAGE);
  220.      
  221.         --This procedure obtains a message in a queue for the ULP from TCP.
  222.      
  223. procedure MESSAGE_FOR_TCP( TCP_MESSAGE : in out MESSAGE;
  224.                            REQUEST_OK : out BOOLEAN ) ;
  225.      
  226.         --This procedure is used by ULP to put a message  for TCP.
  227.      
  228. end WITH_ULP_COMMUNICATE;
  229. --::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  230. --new_ncommu.ada
  231. --::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  232. -----------------------------------------------------------------------
  233. --
  234. --         DoD Protocols    NA-00002-200       80-01038-100(-)
  235. --         E-Systems, Inc.  August 07, 1985
  236. --
  237. --         NEW_NCOMMU.ADA       Author : Jim Baldo
  238. --
  239. -----------------------------------------------------------------------
  240. with CONDITION_HANDLING ;                       use CONDITION_HANDLING ;
  241. with UNCHECKED_CONVERSION ;
  242. with TEXT_IO ;                                  use TEXT_IO;
  243. with TASKING_SERVICES ;                         use TASKING_SERVICES ;
  244. with SYSTEM ;                                   use SYSTEM ;
  245.      
  246.                 package body WITH_ULP_COMMUNICATE is
  247.      
  248. package CONVERT_INT_16_TO_STRING is new INTEGER_IO( SIXTEEN_BITS ) ;
  249. package CONVERT_INT_32_TO_STRING is new INTEGER_IO( THIRTYTWO_BITS ) ;
  250.      
  251. MBX_STATUS  : COND_VALUE_TYPE ;
  252. TO_TCP_CHANNEL : CHANNEL_TYPE ;
  253. XMESSAGE : MESSAGE;
  254.      
  255. type XUSER_MESSAGE_TYPE is record
  256.   THE_USER_MESSAGE : USER_MESSAGE ;
  257.   THE_BUFFER       : PACKED_BUFFER ;
  258.   THE_STATUS_PARAMS : STATUS_RECORD ;
  259. end record ;
  260.      
  261. type XMESSAGE_TYPE  is record
  262.   THE_TCP_MESSAGE : MESSAGE ;
  263.   THE_BUFFER      : PACKED_BUFFER ;
  264. end record ;
  265.      
  266.      
  267.      
  268. function PHYSICAL_ADDRESS is new
  269.            UNCHECKED_CONVERSION ( ADDRESS, UNSIGNED_LONGWORD ) ;
  270.      
  271. procedure  WAIT_FOR_TCP_MESSAGE(USER_MESS : in out USER_MESSAGE) is
  272.      
  273.      
  274. XUSER_MESSAGE : XUSER_MESSAGE_TYPE ;
  275. BUFFER : PACKED_BUFFER_PTR ;
  276.      
  277. begin
  278.   TASK_QIOW ( STATUS  => MBX_STATUS ,
  279.               CHAN    => USER_MESS.LOCAL_CONNECTION_NAME.CHANNEL_PTR ,
  280.               FUNC    => IO_READVBLK ,
  281.               P1      => PHYSICAL_ADDRESS ( XUSER_MESSAGE'ADDRESS ) ,
  282.               P2      => UNSIGNED_LONGWORD (XUSER_MESSAGE'SIZE/8 ) ) ;
  283.  USER_MESS := XUSER_MESSAGE.THE_USER_MESSAGE ;
  284.  case USER_MESS.MESSAGE_NUMBER is
  285.    when 10 | 19 =>
  286.      BUFFGET( BUFFER, 1);
  287.      USER_MESS.DATA_BUFFER := BUFFER ;
  288.      USER_MESS.DATA_BUFFER.ALL := XUSER_MESSAGE.THE_BUFFER ;
  289.    when 15 =>
  290.      USER_MESS.STATUS_PARAMS := XUSER_MESSAGE.THE_STATUS_PARAMS ;
  291.    when 8 | 16 | 18 | 24 => --connection closed: aborted; reset;
  292.                             --connection timeout; delete mailbox
  293.      DELMBX( STATUS  => MBX_STATUS ,
  294.              CHAN    => USER_MESS.LOCAL_CONNECTION_NAME.CHANNEL_PTR ) ;
  295.    when others =>
  296.      null ;
  297.    end case ;
  298. end WAIT_FOR_TCP_MESSAGE;
  299.      
  300. procedure MESSAGE_FOR_TCP( TCP_MESSAGE : in out MESSAGE;
  301.                            REQUEST_OK : out BOOLEAN) is
  302.      
  303. CHANNEL : CHANNEL_TYPE ;
  304. FOREIGN_NET_HOST : STRING(1..5) ;
  305. FOREIGN_PORT : STRING(1..5) ;
  306. LOCAL_NET_HOST : STRING(1..5) ;
  307. LOCAL_PORT : STRING(1..5) ;
  308. CHANNEL_NAME : STRING(1..30) ;
  309. XTCP_MESSAGE : XMESSAGE_TYPE ;
  310.      
  311. begin
  312.  if TCP_MESSAGE.EVENT = OPEN then
  313.      -- Create a mailbox
  314.      CHANNEL_NAME := "                              " ;
  315.      FOREIGN_NET_HOST := "     " ;
  316.      FOREIGN_PORT := "     " ;
  317.      LOCAL_NET_HOST := "     " ;
  318.      LOCAL_PORT := "     " ;
  319.      CONVERT_INT_32_TO_STRING.PUT ( FOREIGN_NET_HOST ,
  320.                                     TCP_MESSAGE.OPEN_PARAMETERS.
  321.                                                  FOREIGN_NET_HOST ) ;
  322.      CONVERT_INT_16_TO_STRING.PUT ( FOREIGN_PORT ,
  323.                                     TCP_MESSAGE.OPEN_PARAMETERS.
  324.                                                  FOREIGN_PORT ) ;
  325.      CONVERT_INT_32_TO_STRING.PUT ( LOCAL_NET_HOST ,
  326.                                     WHOIAM ) ;
  327.      CONVERT_INT_16_TO_STRING.PUT ( LOCAL_PORT ,
  328.                                     TCP_MESSAGE.OPEN_PARAMETERS.
  329.                                                  LOCAL_PORT ) ;
  330.      CHANNEL_NAME(1..3) := "MBX";
  331.      CHANNEL_NAME(4..8) := FOREIGN_NET_HOST ;
  332.      CHANNEL_NAME(9..13) := FOREIGN_PORT ;
  333.      CHANNEL_NAME(14..18) := LOCAL_NET_HOST ;
  334.      CHANNEL_NAME(19..23) := LOCAL_PORT ;
  335.      CREMBX( STATUS => MBX_STATUS ,
  336.              PRMFLG => true       ,             -- permanent
  337.              CHAN   => CHANNEL    ,
  338.              MAXMSG => XUSER_MESSAGE_TYPE'SIZE/8,        --size of message
  339.              BUFQUO => 10 * XUSER_MESSAGE_TYPE'SIZE/8, --size of queue
  340.              LOGNAM => CHANNEL_NAME ) ;
  341.      if NOT SUCCESS(MBX_STATUS) then
  342.        PUT_LINE("Could not create tcp channel") ;
  343.      else
  344.       TCP_MESSAGE.OPEN_PARAMETERS.LOCAL_CONNECTION_NAME.CHANNEL_PTR :=
  345.                                                                 CHANNEL ;
  346.       TCP_MESSAGE.OPEN_PARAMETERS.LOCAL_CONNECTION_NAME.CHANNEL_NAME :=
  347.                                                              CHANNEL_NAME;
  348.       XTCP_MESSAGE.THE_TCP_MESSAGE := TCP_MESSAGE ;
  349.       TASK_QIOW ( STATUS  => MBX_STATUS,
  350.                   CHAN    => TO_TCP_CHANNEL ,
  351.                   FUNC    => IO_WRITEVBLK + IO_M_NOW,
  352.                   P1      => PHYSICAL_ADDRESS (XTCP_MESSAGE'ADDRESS),
  353.                   P2      => UNSIGNED_LONGWORD (XTCP_MESSAGE'SIZE/8 ) );
  354.       end if;
  355.      else
  356.       XTCP_MESSAGE.THE_TCP_MESSAGE := TCP_MESSAGE ;
  357.       if TCP_MESSAGE.EVENT = SEND then
  358.         XTCP_MESSAGE.THE_BUFFER  := TCP_MESSAGE.SEND_PARAMETERS.BUFPTR.ALL ;
  359.         BUFFREE( TCP_MESSAGE.SEND_PARAMETERS.BUFPTR, 0);
  360.       elsif TCP_MESSAGE.EVENT = RECEIVE then
  361.         BUFFREE( TCP_MESSAGE.RECEIVE_PARAMETERS.BUFPTR, 1);
  362.       end if ;
  363.       TASK_QIOW ( STATUS  => MBX_STATUS,
  364.                   CHAN    => TO_TCP_CHANNEL ,
  365.                   FUNC    => IO_WRITEVBLK + IO_M_NOW,
  366.                   P1      => PHYSICAL_ADDRESS (XTCP_MESSAGE'ADDRESS),
  367.                   P2      => UNSIGNED_LONGWORD (XTCP_MESSAGE'SIZE/8 ) );
  368.      
  369.      
  370.      end if ;
  371. REQUEST_OK := SUCCESS (MBX_STATUS) ;
  372. EXCEPTION
  373.   WHEN OTHERS =>
  374.     PUT_LINE("EXCEPTION IN MESSAGE_FOR_TCP") ;
  375. end MESSAGE_FOR_TCP;
  376.      
  377.      
  378. begin
  379.      CREMBX( STATUS => MBX_STATUS ,
  380.              PRMFLG => true       ,             -- permanent
  381.              CHAN   => TO_TCP_CHANNEL,
  382.              MAXMSG => XMESSAGE'SIZE,        --size of message
  383.              BUFQUO => 10 * XMESSAGE'SIZE ,  --size of queue
  384.              LOGNAM => "TO_TCP_CHANNEL") ;      -- fixed name
  385.      if NOT SUCCESS(MBX_STATUS) then
  386.        PUT_LINE("Could not assign tcp channel") ;
  387.      end if ;
  388. END WITH_ULP_COMMUNICATE;
  389. --::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  390. --tcp_standalone.ada
  391. --::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  392. -----------------------------------------------------------------------
  393. --
  394. --         DoD Protocols    NA-00001-200       80-01022-100(-)
  395. --         E-Systems, Inc.  August 07, 1985
  396. --
  397. --         TCP_STANDALONE.ADA       Author : Jim Baldo
  398. --
  399. -----------------------------------------------------------------------
  400. with BUFFER_DATA;
  401. with ip_tcp;
  402. with SUBNET_CALLS;      use SUBNET_CALLS;
  403. with TCP_Q_TASK;
  404. with GET_MESSAGES_FROM_ULP;
  405. with SEND_IP_TASK;
  406. with IP_FROM_SUBNET_TASK;
  407. with TCP_CONTROLLER_TASK;
  408.      
  409. procedure TCP_STANDALONE is
  410.      
  411. begin
  412.  START_SUBNET_DRIVER ;
  413. --  null;
  414. end TCP_STANDALONE ;
  415. --::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  416. --DELETE_MAILBOXES.ADA
  417. --::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  418. with SYSTEM ;                   use SYSTEM ;
  419. with TASKING_SERVICES;          use TASKING_SERVICES;
  420. with STARLET;                   use STARLET;
  421. with CONDITION_HANDLING;        use CONDITION_HANDLING;
  422. with TEXT_IO;                   use TEXT_IO;
  423.      
  424. procedure DELETE_MAILBOXES_FOR_TESTER is
  425.      
  426. -- This procedure is used to delete permanent mailboxes created by
  427. -- test programs.
  428.      
  429. MAILBOX_NAMES_CHANNEL : CHANNEL_TYPE;
  430. TO_TCP_CHANNEL : CHANNEL_TYPE;
  431. RETURN_STATUS : COND_VALUE_TYPE;
  432. MAILBOX_NAME : STRING(1..7) ;
  433. TEMP_MAILBOX_NAME : STRING(1..4);
  434. LENGTH : NATURAL ;
  435.      
  436. begin
  437.  loop
  438.   MAILBOX_NAME := "MBA    " ;
  439.   TEMP_MAILBOX_NAME := "    ";
  440.   PUT("Enter Mailbox Number := ") ;
  441.   GET_LINE(TEMP_MAILBOX_NAME, LENGTH) ;
  442.   if TEMP_MAILBOX_NAME(1) = '0' then
  443.    exit ;
  444.   end if ;
  445.   for I in 1..4 loop
  446.    if TEMP_MAILBOX_NAME(I) /= ' ' then
  447.     MAILBOX_NAME(3 + I) := TEMP_MAILBOX_NAME(I);
  448.    else
  449.     MAILBOX_NAME(3 + I) := ':';
  450.     exit;
  451.    end if;
  452.   end loop;
  453.   ASSIGN( STATUS => RETURN_STATUS,
  454.           CHAN   => TO_TCP_CHANNEL,
  455.           DEVNAM => MAILBOX_NAME);
  456.      
  457.   if SUCCESS ( RETURN_STATUS ) then
  458.    PUT_LINE ( "Successful assign TO MAILBOX " ) ;
  459.   else
  460.    PUT_LINE ( "Unsuccessful assign TO_MAILBOX " ) ;
  461.   end if ;
  462.      
  463.   DELMBX( STATUS => RETURN_STATUS,
  464.           CHAN   => TO_TCP_CHANNEL );
  465.      
  466.   if SUCCESS ( RETURN_STATUS ) then
  467.    PUT_LINE ( "Successful delete TO_MAILBOX " ) ;
  468.   else
  469.    PUT_LINE ( "Unsuccessful delete TO_MAILBOX " ) ;
  470.   end if ;
  471.  end loop ;
  472.      
  473. end DELETE_MAILBOXES_FOR_TESTER ;
  474.