%TITLE 'XPORT_EXAMPLE - Example TCP/IP Communication Library' MODULE XPORT_EXAMPLE ( IDENT = 'V3.0', ADDRESSING_MODE(EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE) ) = BEGIN ! !**************************************************************************** !* * !* COPYRIGHT (c) 1989, 1991 BY * !* DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. * !* ALL RIGHTS RESERVED. * !* * !* THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED * !* ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE * !* INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER * !* COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY * !* OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY * !* TRANSFERRED. * !* * !* THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE * !* AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT * !* CORPORATION. * !* * !* DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS * !* SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. * !* * !* * !**************************************************************************** !++ ! FACILITY: VMS DECWindows TCP/IP Transport ! ! ABSTRACT: ! ! This module provides the communication routines required to perform ! network operations using Ultrix/Connection TCP/IP. ! ! ENVIRONMENT: ! ! VAX/VMS operating system. USER and EXEC mode. ! !-- ! ! INCLUDE FILES: ! LIBRARY 'SYS$LIBRARY:STARLET' ; ! VAX/VMS Service Definitions REQUIRE 'SYS$LIBRARY:UCX$INETDEF.R32' ; ! TCP/IP Definitions REQUIRE 'SRC$:XPORTEXAMPLEDEF.R32' ; ! XPort structure definitions REQUIRE 'SYS$LIBRARY:DECW$XPORTMAC.R32' ; ! Get the transport support macros REQUIRE 'SYS$LIBRARY:DECW$XPORTMSG.R32' ; ! Get the transport message symbols ! ! TABLE OF CONTENTS: ! ! ! FORWARD ROUTINES: ! FORWARD ROUTINE DECW$$TCPIP_EXECUTE_WRITE, DECW$$TCPIP_WRITE, WRITE_AST : NOVALUE, DECW$$TCPIP_WRITE_USER, DECW$$TCPIP_EXECUTE_FREE, DECW$$TCPIP_FREE_INPUT_BUFFER, FREE_INPUT_AST : NOVALUE, DECW$$TCPIP_ATTACH_TRANSPORT, PARSE_INTERNET_ADDRESS, DECW$$TCPIP_CLOSE, CLOSE_AND_DEALLOCATE_AST : NOVALUE, DECW$$TCPIP_OPEN, OPEN_AST1 : NOVALUE, OPEN_AST2 : NOVALUE, OPEN_AST3 : NOVALUE, TRANSPORT_READ_QUEUE, TRANSPORT_READ_AST : NOVALUE, TRANSPORT_OPEN_CALLBACK : NOVALUE, DETACH_AND_POLL : NOVALUE, REATTACH_AST: NOVALUE, DECW$$TCPIP_RUNDOWN : NOVALUE, DECW$TRANSPORT_INIT ; ! ! MACROS: ! MACRO ! ! Macro to help with debugging ! XPORT_FAO(control_string) = BEGIN EXTERNAL ROUTINE DECW$XPORT_FAO; LOCAL xport_fao_control_string_desc : $BBLOCK [DSC$K_S_BLN]; xport_fao_control_string_desc [DSC$W_LENGTH] = %CHARCOUNT( control_string ); xport_fao_control_string_desc [DSC$A_POINTER] = UPLIT( control_string ); DECW$XPORT_FAO ( xport_fao_control_string_desc %IF NOT %NULL(%REMAINING) %THEN ,%REMAINING %FI ) END %, inet_dev_str = 'UCX$DEVICE' %, inet_local_node = 'UCX$INET_HOST' %, swap_long( val ) = ( ( (val ^ 24) AND %X'FF000000') OR ( (val ^ 8 ) AND %X'FF0000') OR ( (val ^ -8) AND %X'FF00') OR ( (val ^ -24 ) AND %X'FF') ) %, swap_short( val ) = ( ( (val ^ 8) AND %X'FF00') OR ( (val ^ -8) AND %X'FF') ) %, ! ! set xtcc connection status ! xtcc_status( xtcc, status ) = IF NOT .xtcc [xtcc$v_err_sts_valid] THEN BEGIN xtcc [xtcc$l_err_status] = status ; xtcc [xtcc$v_err_sts_valid] = 1 ; END %, ! ! load a vector [2] descriptor ! load_desc( desc, string ) = BEGIN desc [0] = %CHARCOUNT( string ) ; desc [1] = UPLIT( string ) ; END % ; ! ! LITERALS: ! LITERAL REATTACH_INTERVAL_SECS = 60, ! Seconds between restart attempts USER_WRITE_BY_COPY = 1, ! if True, perform a DECW$XPORT_COPY_AND_WRITE for user writes ASYNC_EFN = 31, ! ASYNC EVENT FLAG USED BY MOST I/O'S IN THE TRANSPORT WRITE_MAXIMUM_LENGTH = 32768, ! maximum amount of data we're willing to $QIO at once INET_NODE_NAME_LEN = 256, ! possible length of an internet node name? BASE_TCP_PORT = 6000 ; ! TCP port used by server number 0. ! ! OWN STORAGE: ! OWN reattach_timer_id : INITIAL( 0 ), reattach_timer_delta : VECTOR[2] INITIAL( 0, 0 ), inet_dev_desc : VECTOR[2], tcpip_tft : $BBLOCK [xtft$c_length], ! Transport's xtft tcpip_tdb : REF $BBLOCK, ! points to tcpip xtdb local_node : $BBLOCK [INET_NODE_NAME_LEN], ! enough room for local node name lnn_desc : $BBLOCK [DSC$S_DSCDEF1] ; ! and a description of above ! ! EXTERNAL REFERENCES: ! EXTERNAL ROUTINE DECW$$XPORT_FREE_INPUT, DECW$XPORT_READ_COMPLETE, DECW$$XPORT_WRITE, DECW$$XPORT_OPEN_COMPLETE, DECW$XPORT_CLOSE, DECW$XPORT_FREE_INPUT_BUFFER, DECW$XPORT_COPY_AND_WRITE, DECW$XPORT_ALLOC_INIT_QUEUES, DECW$XPORT_DEALLOC_QUEUES, DECW$XPORT_ALLOC_PMEM, DECW$XPORT_DEALLOC_PMEM : NOVALUE, DECW$XPORT_VALIDATE_STRUCT, DECW$XPORT_VALIDATE_STRUCT_JSB : L_VALIDATE_STRUCT, DECW$XPORT_ACCEPT_FAILED, DECW$XPORT_ATTACHED, DECW$XPORT_ATTACH_LOST, DECW$XPORT_REATTACH_FAILED, DECW$XPORT_REFUSED_BY_SERVER ; %SBTTL 'DECW$$TCPIP_EXECUTE_WRITE - Write an xtcb' ROUTINE DECW$$TCPIP_EXECUTE_WRITE( xtcc: REF $BBLOCK, xtcb: REF $BBLOCK, mode ) = !++ ! FUNCTIONAL DESCRIPTION: ! Logically write the xtcb to a TCPIP logical link. ! ! FORMAL PARAMETERS: ! ! xtcc.mr.r Pointer to xtcc. ! ! xtcb.mr.r Pointer to xtcb. ! ! mode.rl.v Options. Not used by this transport. ! ! IMPLICIT INPUTS: ! None. ! ! IMPLICIT OUTPUTS: ! None. ! ! ENVIRONMENT: ! User mode. ! ! COMPLETION CODES: ! SS$_NORMAL Normal successful completion ! DECW$_CNXABORT Connection abort ! ! SIDE EFFECTS: ! None. !-- BEGIN BUILTIN REMQHI ; LOCAL tcb : REF $BBLOCK, status ; IF NOT xport_out_write_disable( xtcc ) THEN BEGIN WHILE ( status = REMQHI( .xtcc [xtcc$a_ow_queue], tcb ) ) EQL xport$k_queue_locked DO WHILE ..xtcc [xtcc$a_ow_queue] DO ; IF .status EQL xport$k_queue_no_entry THEN xport_out_write_enable( xtcc ) ELSE RETURN DECW$$XPORT_WRITE( .xtcc, .tcb, .mode ) ; END ; SS$_NORMAL END ; %SBTTL 'DECW$$TCPIP_WRITE - attempt to write an xtcb to the link' GLOBAL ROUTINE DECW$$TCPIP_WRITE( itcc : REF $BBLOCK VOLATILE, tcb : REF $BBLOCK, mode ) = !++ ! FUNCTIONAL DESCRIPTION: ! ! Attempt to write the xtcb to a TCPIP logical link. ! ! If the xtcb contains no data OR the connection is in a dying state, ! this routine will return the xtcb to the appropriate queue and return ! without executing any I/O operation. ! ! FORMAL PARAMETERS: ! ! itcc.mr.r ixtcc structure identifying the connection ! ! tcb.mr.r xtcb containing data to write to connection ! ! mode.rl.v options modifiying operation of write ! ! IMPLICIT INPUTS: ! ! xtcb$t_data is the starting location of the data to write ! xtcb$l_length is the number of bytes to write to the connection ! ! IMPLICIT OUTPUTS: ! ! If successful, xtcb is inserted on appropriate free queue. ! ! ENVIRONMENT: ! ! EXEC MODE ! ! COMPLETION CODES: ! ! SS$_NORMAL ! DECW$_cnxabort connection dying ! [ other VMS condition codes ] ! ! SIDE EFFECTS: ! ! Data sent out on wire. ! !-- BEGIN BUILTIN TESTBITCS, TESTBITCC ; BIND xtpb = .itcc [ixtcc$a_tpb] : $BBLOCK, xtcc = .itcc [ixtcc$a_tcc] : $BBLOCK, xtcb = .tcb : $BBLOCK ; LOCAL status ; ! ! Check connection condition ! IF .xtcc [xtcc$v_dying] THEN BEGIN $INSQHI( xtcb, .itcc [ixtcc$a_ow_queue] ) ; RETURN DECW$_CNXABORT ; END ; IF .xtcb [xtcb$l_length] GTRU xport_xtcb_total( xtcb ) THEN RETURN SS$_IVBUFLEN ; ! ! Ignore trivial cases ! IF .xtcb [xtcb$l_length] EQLU 0 THEN BEGIN IF .xtcb [xtcb$b_subtype] EQLU decw$c_dyn_xtcb_srp THEN status = $INSQHI( xtcb, .itcc [ixtcc$a_ofs_queue] ) ELSE status = $INSQHI( xtcb, .itcc [ixtcc$a_ofl_queue] ) ; IF .status EQL xport$k_queue_corrupted THEN BEGIN ! ! The queue has been corrupted. ! xtcc [xtcc$v_dying] = 1 ; xtcc_status( xtcc, DECW$_BADQUEUE ) ; RETURN DECW$_CNXABORT ; END ; RETURN SS$_NORMAL ; END ; ! ! Try to write it ! ! ! Queue the buffer ! xtcb [xtcb$l_rflink] = xtcc ; ! use this to pass two arguments to AST procedure IF NOT (status = $QIO( EFN =.itcc [ixtcc$w_efn], FUNC = IO$_WRITEVBLK, CHAN = .itcc [ixtcc$w_chan], IOSB = xtcb [xtcb$w_iosb], ASTADR = write_ast, ASTPRM = xtcb, P1 = xtcb [xtcb$t_data], P2 = .xtcb [xtcb$l_length] ) ) THEN ! ! couldn't queue the write, so return the buffer to the queue ! (ignoring any corruption) and shut down. ! BEGIN $INSQHI( xtcb, .itcc [ixtcc$a_ow_queue] ) ; xtcc [xtcc$v_dying] = 1 ; xtcc_status( xtcc, .status ) ; END ; ! ! Done ! .status END ; %SBTTL 'write_ast - process server and client write completion ASTs' ROUTINE write_ast( xtcb : REF $BBLOCK ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! AST completion routine for TCPIP write operations. ! ! Return the xtcb to the appropriate free queue. If the $QIO failed ! or the connection is dying, exit. Otherwise, remove an xtcb from the ! work queue. If empty, enable write operations on this connection and ! quit, otherwise, queue another I/O operation. ! ! FORMAL PARAMETERS: ! ! tcb.mr.r communication buffer ! ! IMPLICIT INPUTS: ! ! communication queues and wait bits ! ! tcb [xtcb$l_rflink] contains the xtcc for this connection ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! ENVIRONMENT: ! ! USER OR EXEC MODE ! ! COMPLETION CODES: ! ! NOVALUE ! ! SIDE EFFECTS: ! ! perform output notification ! !-- BEGIN BIND tcc = .xtcb [xtcb$l_rflink] : $BBLOCK, iosb = xtcb [xtcb$w_iosb] : VECTOR [4,WORD,UNSIGNED] ; BUILTIN TESTBITCS ; LOCAL itcc : REF $BBLOCK, tcb : REF $BBLOCK, status, type ; ! ! First, put the buffer back ! VALIDATE_XTCC( tcc, itcc ) ; IF .xtcb [xtcb$b_subtype] EQLU decw$c_dyn_xtcb_srp THEN BEGIN BIND xtpb = .itcc [ixtcc$a_tpb] : $BBLOCK ; status = $INSQHI( .xtcb, .itcc [ixtcc$a_ofs_queue] ) ; xport_out_notify_send( tcc, xtpb, decw$c_xport_buffer_srp ) ; END ELSE BEGIN BIND xtpb = .itcc [ixtcc$a_tpb] : $BBLOCK ; status = $INSQHI( .xtcb, .itcc [ixtcc$a_ofl_queue] ) ; xport_out_notify_send( tcc, xtpb, decw$c_xport_buffer_lrp ) ; END ; ! ! See if the free queue has been corrupted. ! IF .status EQL xport$k_queue_corrupted THEN BEGIN BIND xtpb = .itcc [ixtcc$a_tpb] : $BBLOCK ; IF TESTBITCS( tcc [xtcc$v_dying] ) THEN BEGIN ! ! Must detect link aborts in the read and write completion AST routines. ! xport_abort_send( tcpip_tdb, tcc ) ; IF .tcc [xtcc$v_lrp_on_output] THEN xport_out_notify_send( tcc, xtpb, decw$c_xport_buffer_lrp ) ELSE xport_out_notify_send( tcc, xtpb, decw$c_xport_buffer_srp ) ; xport_in_notify_send( tcc, xtpb ) ; END ; xport_out_write_enable( tcc ) ; xport_write_unwait( tcc, xtpb ) ; xtcc_status( tcc, DECW$_BADQUEUE ) ; RETURN ; END ; ! ! See if the write worked ! IF .tcc [xtcc$v_dying] OR NOT .iosb [0] THEN BEGIN BIND xtpb = .itcc [ixtcc$a_tpb] : $BBLOCK ; IF TESTBITCS( tcc [xtcc$v_dying] ) THEN BEGIN ! ! Must detect link aborts in the read and write completion AST routines. ! xport_abort_send( tcpip_tdb, tcc ) ; IF .tcc [xtcc$v_lrp_on_output] THEN xport_out_notify_send( tcc, xtpb, decw$c_xport_buffer_lrp ) ELSE xport_out_notify_send( tcc, xtpb, decw$c_xport_buffer_srp ) ; xport_in_notify_send( tcc, xtpb ) ; END ; xport_out_write_enable( tcc ) ; xport_write_unwait( tcc, xtpb ) ; xtcc_status( tcc, .iosb [0] ) ; RETURN ; END ; ! ! See if we have more ! status = $REMQHI( .itcc [ixtcc$a_ow_queue], tcb ) ; ! ! Has the work queue been corrupted? ! IF .status EQL xport$k_queue_corrupted THEN BEGIN BIND xtpb = .itcc [ixtcc$a_tpb] : $BBLOCK ; IF TESTBITCS( tcc [xtcc$v_dying] ) THEN BEGIN ! ! Must detect link aborts in the read and write completion AST routines. ! xport_abort_send( tcpip_tdb, tcc ) ; IF .tcc [xtcc$v_lrp_on_output] THEN xport_out_notify_send( tcc, xtpb, decw$c_xport_buffer_lrp ) ELSE xport_out_notify_send( tcc, xtpb, decw$c_xport_buffer_srp ) ; xport_in_notify_send( tcc, xtpb ) ; END ; xport_out_write_enable( tcc ) ; xport_write_unwait( tcc, xtpb ) ; xtcc_status( tcc, DECW$_BADQUEUE ) ; RETURN ; END ; ! ! Was there anything on the queue? ! IF .status EQL xport$k_queue_no_entry THEN BEGIN BIND xtpb = .itcc [ixtcc$a_tpb] : $BBLOCK ; ! ! Enable writes after exhausting work queue and wake anyone trying to perform ! a write from a user's buffer ! xport_out_write_enable( tcc ) ; xport_write_unwait( tcc, xtpb ) ; RETURN ; END ; ! ! Found something so queue it ! tcb [xtcb$l_rflink] = tcc ; ! use this to pass two arguments to AST procedure IF NOT ( status = $qio( EFN = .itcc [ixtcc$w_efn], FUNC = IO$_WRITEVBLK, CHAN = .itcc [ixtcc$w_chan], IOSB = tcb [xtcb$w_iosb], ASTADR = write_ast, ASTPRM = .tcb, P1 = tcb [xtcb$t_data], P2 = .tcb [xtcb$l_length] ) ) THEN BEGIN BIND xtpb = .itcc [ixtcc$a_tpb] : $BBLOCK ; $INSQHI( .tcb, .itcc [ixtcc$a_ow_queue] ) ; ! Ignoring any problems. IF TESTBITCS( tcc [xtcc$v_dying] ) THEN BEGIN xport_abort_send( tcpip_tdb, tcc ) ; xport_in_notify_send( tcc, xtpb ) ; xtcc_status( tcc, .status ) ; END ; xport_write_unwait( tcc, xtpb ) ; END ; END ; %SBTTL 'DECW$$TCPIP_WRITE_USER - attempt to write an xtcb to the link' GLOBAL ROUTINE DECW$$TCPIP_WRITE_USER( itcc : REF $BBLOCK VOLATILE, buffer : REF $BBLOCK, mode ) = !++ ! FUNCTIONAL DESCRIPTION: ! ! Attempt to write a buffer in the user's address space to a TCPIP logical link. ! ! This can be done two ways. First, by using the common routine $XPORT_COPY_AND_WRITE ! to copy the user's buffer into xtcb's and queue them for writing. Or, by waiting ! for the output work queue to empty and issuing $QIO's directly from the user's ! buffer. ! ! FORMAL PARAMETERS: ! ! ixtcc.mr.r ixtcc structure identifying the connection ! ! buffer.rt.dx buffer in user's space containing data to write to connection ! ! IMPLICIT INPUTS: ! ! xtcb$t_data is the starting location of the data to write ! xtcb$l_length is the number of bytes to write to the connection ! ! IMPLICIT OUTPUTS: ! ! If successful, xtcb is inserted on appropriate free queue. ! ! ENVIRONMENT: ! ! USER MODE ONLY !! ! ! COMPLETION CODES: ! ! SS$_NORMAL ! DECW$_cnxabort connection dying ! [ other VMS condition codes ] ! ! SIDE EFFECTS: ! ! Data sent out on wire. ! !-- BEGIN BUILTIN TESTBITCS, TESTBITCC, INSQTI, INSQHI, REMQHI ; BIND xtcc = .itcc [ixtcc$a_tcc] : $BBLOCK, xtpb = .itcc [ixtcc$a_tpb] : $BBLOCK ; LOCAL status, data_adr, data_len, size, lcl_iosb : VECTOR[4,WORD,UNSIGNED] ; ! ! User buffer to write ! IF .xtcc [xtcc$v_dying] THEN BEGIN RETURN DECW$_CNXABORT ; END ; IF (data_adr = .buffer [dsc$a_pointer]) EQLA 0 OR (data_len = .buffer [dsc$w_length]) EQLU 0 THEN RETURN SS$_NORMAL ; ! ! Real work to perform ! %IF USER_WRITE_BY_COPY %THEN status = DECW$XPORT_COPY_AND_WRITE( xtcc, 0, .data_adr, .data_len, size ) ; %ELSE ! ! To guarantee order of operation, we must first wait until the work ! queue is empty then perform I/O out of the user buffer. The wait ! for empty work buffer is a spin-and-wait on the write disable flag ! guarded by the process-private wait_on_write flag. This flag, ! when set, causes the write xtcb ast completion routine to generate ! a "wake-up" when the transition from write disable to write enable ! is made. This "wake-up" is identical to output notification except ! the caller's notification routine is not invoked. ! (xtcc [xtcc$w_ow_iosb])< 0,32, 0> = 0 ; (xtcc [xtcc$w_ow_iosb])<32,32, 0> = 0 ; TESTBITCS( (xtcc [xtcc$l_flags])<$BITPOSITION( xtcc$v_wait_on_write ), 1> ) ; WHILE (xport_out_write_disable( xtcc )) DO BEGIN xport_write_wait( xtcc, xtpb ) ; END ; xport_out_write_enable( xtcc ) ; TESTBITCC( (xtcc [xtcc$l_flags])<$BITPOSITION( xtcc$v_wait_on_write ), 1> ) ; ! ! Wakeup might be due to connection abort ! IF .xtcc [xtcc$v_dying] THEN BEGIN RETURN DECW$_CNXABORT ; END ; ! ! Wait is over, send the user's buffer, possibly piecemeal. ! We can do this in the current access mode as we're not interested in ! output notification and we're using the waiting form of the $QIO ! (required). ! DO BEGIN size = MINU( WRITE_MAXIMUM_LENGTH, .data_len ) ; IF (status = $QIOW( EFN = .itcc [ixtcc$w_efn], FUNC = IO$_WRITEVBLK, CHAN = .itcc [ixtcc$w_chan], IOSB = lcl_iosb, P1 = .data_adr, P2 = .size ) ) THEN status = .lcl_iosb [0] ; IF NOT .status THEN RETURN .status ; data_len = .data_len - .size ; data_adr = .data_adr + .size ; END WHILE .data_len NEQU 0 ; %FI ! ! Done, return with whatever appeared in status ! .status END ; %SBTTL 'DECW$$TCPIP_EXECUTE_FREE - Free an xtcb' ROUTINE DECW$$TCPIP_EXECUTE_FREE( tcc: REF $BBLOCK, tcb: REF $BBLOCK, type, free_queue ) = !++ ! FUNCTIONAL DESCRIPTION: ! Logically return an xtcb to a local logical link. ! ! FORMAL PARAMETERS: ! ! tcc.mr.r Pointer to xtcc. ! ! tcb.mr.r Pointer to xtcb. ! ! type.rl.v Type of xtcb. ! ! free_queue.ml.ra Pointer to free queue. ! ! IMPLICIT INPUTS: ! None. ! ! IMPLICIT OUTPUTS: ! None. ! ! ENVIRONMENT: ! User mode. ! ! COMPLETION CODES: ! SS$_NORMAL Normal successful completion ! DECW$_CNXABORT Connection abort ! ! SIDE EFFECTS: ! None. !-- BEGIN BUILTIN REMQHI ; LOCAL newtcb : REF $BBLOCK, status ; IF NOT xport_in_free_disable( tcc, .type ) THEN BEGIN ! ! This was the first entry and no I/O was outstanding. Take ! the element off of the head of the queue if it is still there and ! read into the buffer. It is possible for the input state (SRP vs. ! LRP) to change at any time but we will accept the consequences. ! WHILE (status = REMQHI( .free_queue, newtcb )) EQL xport$k_queue_locked DO WHILE ..free_queue DO ; IF .status EQL xport$k_queue_no_entry THEN BEGIN xport_in_free_enable( tcc, .type ) ; status = SS$_NORMAL ; END ELSE RETURN DECW$$XPORT_FREE_INPUT( .tcc, .newtcb ) ; END ; SS$_NORMAL END ; %SBTTL 'DECW$$TCPIP_FREE_INPUT_BUFFER - free an input buffer and conditionally start a read' GLOBAL ROUTINE DECW$$TCPIP_FREE_INPUT_BUFFER( itcc : REF $BBLOCK VOLATILE, tcb : REF $BBLOCK ) = !++ ! FUNCTIONAL DESCRIPTION: ! ! Initiate a read operation into the given xtcb. ! ! Note: an unfortunate name as this is a true read operation but gets its ! name from the common routine which invokes it. ! ! FORMAL PARAMETERS: ! ! itcc.mr.r describes the connection where communication takes place ! tcb.mr.r buffer to free ! ! IMPLICIT INPUTS: ! ! NONE ! ! IMPLICIT OUTPUTS: ! ! Communication queues are modified ! ! ENVIRONMENT: ! ! EXEC MODE ! ! COMPLETION CODES: ! ! SS$_NORMAL ! DECW$_cnxabort ! [qio and chmk errors] ! ! SIDE EFFECTS: ! !-- BEGIN BIND xtcb = .tcb : $BBLOCK, xtcc = .itcc [ixtcc$a_tcc] : $BBLOCK, xtpb = .itcc [ixtcc$a_tpb] : $BBLOCK ; LOCAL status, size, free_queue ; ! ! First, determine which free queue we're using ! IF .xtcb [xtcb$b_subtype] EQLU decw$c_dyn_xtcb_srp THEN free_queue = .itcc [ixtcc$a_ifs_queue] ELSE free_queue = .itcc [ixtcc$a_ifl_queue] ; ! ! Initiate I/O ! xtcb [xtcb$l_rflink] = xtcc ; ! tuck away the xtcc for the AST routine IF NOT (status = $QIO( EFN = .itcc [ixtcc$w_efn], CHAN = .itcc [ixtcc$w_chan], FUNC = IO$_READVBLK, IOSB = xtcb [xtcb$w_iosb], ASTADR = free_input_ast, ASTPRM = xtcb, P1 = xtcb [xtcb$t_data], P2 = xport_xtcb_total( xtcb ) ) ) THEN BEGIN ! ! It didn't go, put the buffer back on some queue ! $INSQHI( xtcb, .free_queue ) ; xtcc [xtcc$v_dying] = 1 ; xtcc_status( xtcc, .status ) ; END ; ! ! Done ! .status END ; %SBTTL 'free_input_ast - server and client read completion exec ast' ROUTINE free_input_ast( xtcb : REF $BBLOCK ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! Read completion ast routine. ! ! FORMAL PARAMETERS: ! ! XTCB Communication buffer which is was ! destination of the completed read. ! ! IMPLICIT INPUTS: ! ! Address of xtcc in XTCB$L_RFLINK field of XTCB ! ! IMPLICIT OUTPUTS: ! ! Communication queues modified ! ! ENVIRONMENT: ! ! EXEC MODE ! ! COMPLETION CODES: ! ! NOVALUE ! ! SIDE EFFECTS: ! ! Another IO may be started via an indirect call to ! DECW$$TCPIP_FREE_INPUT_BUFFER(). ! !-- BEGIN BIND iosb = xtcb [xtcb$w_iosb] : VECTOR [4,WORD,UNSIGNED], tcc = .xtcb [xtcb$l_rflink] : $BBLOCK ; LOCAL itcc : REF $BBLOCK, status : INITIAL(.iosb [0]) ; ! ! The connection context address is stored in the XTCB, an ! unprotected location. Use Validate_XTCC to confirm that ! the address is uncorrupted, and to get the address of the ! IXTCC. ! VALIDATE_XTCC( tcc, itcc ) ; ! ! The number of bytes read by the just completed IO is in ! the second word of the IOSB. Use that to set the length ! field of the XTCB. This must be done before calling ! READ_COMPLETE(), as it requires that field to be valid. ! xtcb [xtcb$l_length] = .iosb [1] ; ! ! Hand over most of the work to READ_COMPLETE. It will kill the ! connection if there was an error during the IO (as indicated ! by the STATUS variable. Otherwise, the XTCB will be placed on ! the input work queue and, if a free buffer is available, the ! routine identified by the XTFT$A_FREE_INPUT_BUFFER field in ! the XTFT will be called to start the next IO. ! status = DECW$XPORT_READ_COMPLETE(.itcc, .xtcb, .status) ; ! ! Nothing more to do. ! RETURN ; END ; %SBTTL 'parse_internet_address - convert text representation to binary' ROUTINE parse_internet_address( str_desc: REF $BBLOCK [DSC$C_S_BLN], address: REF VECTOR [4,BYTE,UNSIGNED] ) = !++ ! FUNCTIONAL DESCRIPTION: ! ! Parse an internet address string of the form "nnn.nnn.nnn.nnn", ! where nnn can be one from one to three decimal digits, and ! return the binary representation as a sequence of four bytes. ! ! FORMAL PARAMETERS: ! ! text ascii text string, by descriptor, input ! address binary internet address, by reference, output ! ! IMPLICIT INPUTS: ! ! NONE ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! COMPLETION CODES: ! ! SS$_NORMAL Normal successful completion ! SS$_BADPARAM Illegal internet address format ! ! ENVIRONMENT: ! ! ANY MODE ! ! SIDE EFFECTS: ! ! NONE ! !-- BEGIN LOCAL string : REF VECTOR [,BYTE], strlen, p ; ! ! Initialize string variables to point to beginning of string. ! string = .str_desc [DSC$A_POINTER] ; strlen = .str_desc [DSC$W_LENGTH] ; p = 0 ; ! ! Parse the four numbers, each delimited by dot or end of string. ! Accumulate the binary values in the address vector of four bytes. ! INCR i FROM 0 TO 3 DO BEGIN ! ! Initialize the next address byte to zero. ! address [.i] = 0 ; ! ! Make sure each number contains at least one digit. ! IF .strlen EQL 0 THEN RETURN SS$_BADPARAM ; IF .string [.p] EQL %C'.' THEN RETURN SS$_BADPARAM ; ! ! Accumulate each digit until we reach a non-digit. ! WHILE ( .string [.p] GEQU %C'0' ) AND ( .string [.p] LEQU %C'9' ) DO BEGIN address [.i] = .address [.i] * 10 + ( .string [.p] - %C'0' ) ; p = .p + 1 ; strlen = .strlen - 1 ; IF .strlen EQL 0 THEN EXITLOOP ; END ; ! ! Make sure number terminated in a dot (except the last number). ! IF .strlen NEQ 0 THEN BEGIN IF .string [.p] NEQ %C'.' THEN RETURN SS$_BADPARAM ; p = .p + 1 ; strlen = .strlen - 1 ; IF .strlen EQL 0 THEN RETURN SS$_BADPARAM ; END; END ; RETURN SS$_NORMAL ; END ; %SBTTL 'DECW$$TCPIP_CLOSE - close a logical link and release connection structures' GLOBAL ROUTINE DECW$$TCPIP_CLOSE( itcc : REF $BBLOCK VOLATILE) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This call explicitly closes the TCPIP logical link and releases any structures ! associated with the link. It will either be called as a result of a ! FailingConnection or FailingTransport notification or as a server operation ! resulting from resource starvation or client request. ! ! After calling, the xtcc and xtcq used by the link are no longer valid and ! should not be referenced. ! ! This implementation should NOT be called at AST level. ! ! FORMAL PARAMETERS: ! ! itcc.mr.r connection context to close ! ! IMPLICIT INPUTS: ! ! NONE ! ! IMPLICIT OUTPUTS: ! ! Communication queue flags are modified and buffers are released. ! ! ENVIRONMENT: ! ! EXEC MODE ! ! COMPLETION CODES: ! ! SS$_NORMAL ! vms status codes ! ! SIDE EFFECTS: ! ! Deassigns network channel ! !-- BEGIN LOCAL tcc : REF $BBLOCK INITIAL( .itcc [ixtcc$a_tcc] ), status ; ! ! First mark as dying so that completion AST's won't try to requeue ! tcc [xtcc$v_dying] = 1 ; ! ! Deassign causing $_Cancel I/O completion ! $CANCEL( CHAN = .itcc [ixtcc$w_chan] ) ; $DASSGN( CHAN = .itcc [ixtcc$w_chan] ) ; itcc [ixtcc$w_chan] = 0 ; ! ! Now declare an AST behind any others to deallocate connection resources ! status = $DCLAST( ASTADR = close_and_deallocate_ast, ASTPRM = .itcc ) ; ! ! Done ! .status END ; %SBTTL 'close_and_deallocate_ast - destroy connection resources after $DASSGN' ROUTINE close_and_deallocate_ast( itcc : REF $BBLOCK ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! Complete the close by deallocating connection resources. ! ! This is performed as an AST routine to allow the I/O completion ! AST's that resulted from the $DASSGN to execute first. ! ! FORMAL PARAMETERS: ! ! itcc.mr.r connection we are closing. ! ! IMPLICIT INPUTS: ! ! NONE ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! ENVIRONMENT: ! ! EXEC MODE ! ! COMPLETION CODES: ! ! NOVALUE ! ! SIDE EFFECTS: ! ! The connection is destroyed. All further references to the ! xtcc, xtpb, xtcq, or any xtcb is invalid. ! !-- BEGIN BUILTIN REMQUE ; LOCAL tdb : REF $BBLOCK INITIAL( .itcc [ixtcc$a_tdb] ), tpb : REF $BBLOCK INITIAL( .itcc [ixtcc$a_tpb] ), status ; ! ! Remove the connection from the TDB ! REMQUE( .itcc, itcc ) ; tdb [xtdb$l_ref_count] = .tdb [xtdb$l_ref_count] - 1 ; ! ! Deallocate all communication buffers, and other user mode memory. ! DECW$XPORT_DEALLOC_QUEUES( .itcc ) ; ! ! Destroy some important fields ! itcc [ixtcc$a_xport_table] = 0 ; ! ! Done with the ixtcc ! DECW$XPORT_DEALLOC_PMEM( .itcc ) ; ! ! Done with the parameter block ! DECW$XPORT_DEALLOC_PMEM( .tpb ) ; ! ! Done ! END ; %SBTTL 'DECW$$TCPIP_OPEN - try to connect to an X Server via TCPIP' GLOBAL ROUTINE DECW$$TCPIP_OPEN( workstation : REF $BBLOCK, server, itcc : REF $BBLOCK ) = !++ ! FUNCTIONAL DESCRIPTION: ! ! Attempt to establish a connection to a server via TCPIP. ! ! FORMAL PARAMETERS: ! ! workstation.rt.dx Name of the server object passed by ! descriptor. Contains network address ! and authentication information. ! ! server.rl.v Server to connect to. ! ! itcc.mr.r Location of preallocated ixtcc. This ixtcc ! will have an associated xtpb (ixtcc$a_tpb) ! which has been initialized. ! ! IMPLICIT INPUTS: ! ! XTDB for TCPIP transport ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! ENVIRONMENT: ! ! EXEC MODE ! ! COMPLETION CODES: ! ! SS$_NORMAL connection established ! SS$_INSFMEM couldn't allocate required structures ! ! SIDE EFFECTS: ! ! Creates channels and mailboxes, allocates memory. ! !-- BEGIN BUILTIN REMQUE, INSQUE ; BIND tpb = .itcc [ixtcc$a_tpb] : $BBLOCK ; LOCAL socktype : INITIAL( (UCX$C_STREAM ^ 16) + UCX$C_TCP ), status, saved_wkstn_space, tcc : REF $BBLOCK, saved_wkstn_name : REF $BBLOCK, sockaddrin : $BBLOCK [SIN$S_SOCKADDRIN] PRESET( [SIN$W_FAMILY] = INET$C_AF_INET, [SIN$W_PORT] = 0, [SIN$L_ADDR] = swap_long( INET$C_INADDR_ANY ) ), sin_desc : VECTOR [2] INITIAL( %ALLOCATION( sockaddrin ), sockaddrin ); LABEL connect; itcc [ixtcc$l_server_number] = .server; connect: BEGIN ! ! Check for node "0" ! IF .workstation [DSC$W_LENGTH] EQL 1 AND .(.workstation [DSC$A_POINTER])<0,8,0> EQL %C'0' THEN workstation = lnn_desc ; ! ! Allocate the user modifiable memory... ! status = DECW$XPORT_ALLOC_INIT_QUEUES( .itcc, .tcpip_tft[xtft$l_xtcc_length], ! Length of an XTCC .tpb [xtpb$w_srp_size], ! Data length of an SRP .tpb [xtpb$w_lrp_size], ! Data length of an LRP .tpb [xtpb$w_i_srp_count], ! Input (Event) SRP count .tpb [xtpb$w_i_lrp_count], ! Input (Event) LRP count .tpb [xtpb$w_o_srp_count], ! Output (Request) SRP count .tpb [xtpb$w_o_lrp_count], ! Output (Request) LRP count .workstation [DSC$W_LENGTH], ! Per-Specific, Per-Connection ! Extra Allocation saved_wkstn_space) ; ! Return Address for Extra Allocation IF NOT .status THEN RETURN .status ; tcc = .itcc[ixtcc$a_tcc] ; ! ! Pre-insert the ixtcc so that we can find it should the image exit ! before the connection is fully started. ! INSQUE( .itcc, tcpip_tdb [xtdb$a_itcc_flink] ) ; tcpip_tdb [xtdb$l_ref_count] = .tcpip_tdb [xtdb$l_ref_count] + 1 ; ! ! Save the name of the workstation to which we are connecting. ! CH$MOVE( .workstation [DSC$W_LENGTH], .workstation [DSC$A_POINTER], .saved_wkstn_space ) ; saved_wkstn_name = itcc [ixtcc$q_xport_reserved] ; saved_wkstn_name [DSC$W_LENGTH] = .workstation [DSC$W_LENGTH] ; saved_wkstn_name [DSC$A_POINTER] = .workstation [DSC$A_POINTER] ; ! ! Open a channel to UCX. ! IF NOT (status = $assign( DEVNAM = inet_dev_desc, CHAN = itcc [ixtcc$w_chan], ACMODE = psl$c_user ) ) THEN LEAVE connect ; ! ! Setup socket options and attach it to the correct port. ! ! This is an operation which is not guaranteed to complete immediately. ! Thus we can either wait in EXEC mode (doing a $QIOW call), or we can ! make an asynchronous call ($QIO), and allow the waiting to take ! place in USER mode. This allows the user to Control-Y out of the ! application even during this wait. ! status = $QIO( EFN = .tcpip_tdb [xtdb$w_efn], CHAN = .itcc [ixtcc$w_chan], FUNC = IO$_SETMODE, IOSB = itcc [ixtcc$q_iosb], ASTADR = OPEN_AST1, ASTPRM = .itcc, P1 = socktype, P2 = ( %X'01000000' OR INET$M_LINGER ), P3 = sin_desc ) ; ! ! Example of show to use XPORT_FAO to output debugging data. ! To invoke the code, just delete the comment delimiter (!). ! ! XPORT_FAO('Open $QIO status = !XL, iosb = !XL', .status, .itcc [ixtcc$l_iosb]) ; ! IF NOT .status THEN LEAVE connect ; ! ! Now we're 'waiting' for the above $QIO to complete. We can make NO ! assumptions about when it will complete. It may have already completed. ! RETURN DECW$_STALL ; ! ! End of named block CONNECT. ! END; ! ! We only reach here if we encounter an error during connection setup. ! Deassign the channel and remove this connection from the list of ! connections. The common layer will deallocate the user memory ! allocated by DECW$XPORT_ALLOC_INIT_QUEUES. ! IF .itcc [ixtcc$w_chan] NEQU 0 THEN $DASSGN( CHAN = .itcc [ixtcc$w_chan] ) ; REMQUE( .itcc, itcc ) ; tcpip_tdb [xtdb$l_ref_count] = .tcpip_tdb [xtdb$l_ref_count] - 1 ; RETURN .status ; END ; %SBTTL 'OPEN_AST1 - continue setting up a connection to an X Server via TCPIP' GLOBAL ROUTINE OPEN_AST1( itcc : REF $BBLOCK ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! After setting up the socket options, get the address of the server. ! ! FORMAL PARAMETERS: ! ! itcc.mr.r Location of preallocated ixtcc. This ixtcc will have ! an associated xtcc (pointed to by $a_tcc), an xtpb ! ($a_tpb) which has been initialized. ! ! IMPLICIT INPUTS: ! ! XTDB for TCPIP transport ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! ENVIRONMENT: ! ! EXEC MODE ! ! COMPLETION CODES: ! ! NONE ! ! SIDE EFFECTS: ! !-- BEGIN BUILTIN REMQUE; LOCAL net_addr_desc : $BBLOCK[DSC$S_DSCDEF1] PRESET ( [DSC$W_LENGTH] = ixtcc$s_server_addr - 1, [DSC$B_CLASS] = DSC$K_CLASS_S, [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER] = itcc [ixtcc$t_server_addr] ), func_code : INITIAL( INETACP_FUNC$C_GETHOSTBYNAME ), func_code_desc : VECTOR [2] INITIAL( %ALLOCATION( func_code ), func_code ), status ; ! ! Check the status of the $QIO(SETMODE) operation which just completed. ! status = .itcc [ixtcc$l_iosb] ; IF .status THEN ! ! It went fine. Get the address of the remote server. ! IF (status = $qio( EFN = .tcpip_tdb [xtdb$w_efn], CHAN = .itcc [ixtcc$w_chan], FUNC = IO$_ACPCONTROL, IOSB = itcc [ixtcc$q_iosb], ASTADR = OPEN_AST2, ASTPRM = .itcc, P1 = func_code_desc, P2 = itcc [ixtcc$q_xport_reserved], P3 = itcc [ixtcc$l_server_addr_len], P4 = net_addr_desc ) ) THEN ! ! Let OPEN_AST2 complete the connection setup. ! RETURN ; ! ! An error occurred, either during the SETMODE, or while checking the ! arguments to the GETHOSTBYNAME call. Deassign the channel to UCX, ! remove the connection from the list of connections, and tell the ! common layer of the failure. ! $DASSGN( CHAN = .itcc [ixtcc$w_chan] ) ; REMQUE( .itcc, itcc ) ; tcpip_tdb [xtdb$l_ref_count] = .tcpip_tdb [xtdb$l_ref_count] - 1 ; DECW$$XPORT_OPEN_COMPLETE( .itcc, .status ) ; RETURN; END ; %SBTTL 'OPEN_AST2 - continue setting up a connection to an X Server via TCPIP' GLOBAL ROUTINE OPEN_AST2( itcc : REF $BBLOCK ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This is the completion routine for the $QIO(ACPCONTROL) which gets ! the workstation's address. Convert the text result to an address, ! and attempt to connect to the workstation. ! ! FORMAL PARAMETERS: ! ! itcc.mr.r Location of preallocated ixtcc. This ixtcc will have ! an associated xtcc (pointed to by $a_tcc), an xtpb ! ($a_tpb) which has been initialized. ! ! IMPLICIT INPUTS: ! ! XTDB for TCPIP transport ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! ENVIRONMENT: ! ! EXEC MODE ! ! COMPLETION CODES: ! ! NONE ! ! SIDE EFFECTS: ! ! Creates channels and mailboxes, allocates memory. ! !-- BEGIN BUILTIN REMQUE ; BIND workstation = itcc [ixtcc$q_xport_reserved] : $BBLOCK[DSC$S_DSCDEF1] ; LOCAL status, net_addr_desc : $BBLOCK[DSC$S_DSCDEF1] PRESET ( [DSC$W_LENGTH] = .itcc [ixtcc$l_server_addr_len], [DSC$B_CLASS] = DSC$K_CLASS_S, [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$A_POINTER] = itcc [ixtcc$t_server_addr] ), sockaddrin : $BBLOCK [SIN$S_SOCKADDRIN] PRESET( [SIN$W_FAMILY] = INET$C_AF_INET ), sin_desc : VECTOR [2] INITIAL( %ALLOCATION( sockaddrin ), sockaddrin ) ; LABEL connect; connect: BEGIN ! ! Check the status of the $QIO(ACPCONTROL) operation. ! status = .itcc [ixtcc$l_iosb] ; IF NOT .status THEN IF .status NEQU SS$_ENDOFFILE THEN LEAVE connect ELSE BEGIN ! ! SS$_ENDOFFILE is the status returned when the GETHOSTBYNAME function ! fails to find a name address translation. In this case, try to convert ! the given node as if it were an internet address, i.e. nnn.nnn.nnn.nnn. ! IF .workstation [DSC$W_LENGTH] GEQU ixtcc$s_server_addr THEN BEGIN status = DECW$_INVSRVNAM ; LEAVE connect ; END ; CH$MOVE( .workstation [DSC$W_LENGTH], .workstation [DSC$A_POINTER], itcc [ixtcc$t_server_addr] ) ; net_addr_desc [DSC$W_LENGTH] = .workstation [DSC$W_LENGTH] ; END ; ! ! Convert text address to binary address. ! status = parse_internet_address( net_addr_desc, sockaddrin [SIN$L_ADDR] ); IF NOT .status THEN BEGIN status = DECW$_INVSRVNAM ; LEAVE connect ; END; ! ! Try to connect to the server. ! sockaddrin [SIN$W_PORT] = SWAP_SHORT( ( BASE_TCP_PORT + .itcc [ixtcc$l_server_number] ) ) ; status = $QIO( EFN = .tcpip_tdb [xtdb$w_efn], CHAN = .itcc [ixtcc$w_chan], FUNC = IO$_ACCESS, IOSB = itcc [ixtcc$q_iosb], ASTADR = OPEN_AST3, ASTPRM = .itcc, P3 = sin_desc ) ; IF NOT .status THEN LEAVE connect ; ! ! Leave the remaining work (starting the first read) to OPEN_AST3. ! RETURN ; ! ! End of the named block CONNECT. ! END; ! ! An error occurred. Deassign the channel to UCX, remove the ! connection from the list of connections, and tell the common ! layer of the failure. ! $DASSGN( CHAN = .itcc [ixtcc$w_chan] ) ; REMQUE( .itcc, itcc ) ; tcpip_tdb [xtdb$l_ref_count] = .tcpip_tdb [xtdb$l_ref_count] - 1 ; DECW$$XPORT_OPEN_COMPLETE( .itcc, .status ) ; RETURN; END ; %SBTTL 'OPEN_AST3 - continue setting up a connection to an X Server via TCPIP' GLOBAL ROUTINE OPEN_AST3( itcc : REF $BBLOCK ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! Confirm that a connection has been established, and start the first read. ! ! FORMAL PARAMETERS: ! ! itcc.mr.r Location of this connection's IXTCC. ! ! IMPLICIT INPUTS: ! ! XTDB for TCPIP transport ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! ENVIRONMENT: ! ! EXEC MODE ! ! COMPLETION CODES: ! ! NONE ! ! SIDE EFFECTS: ! !-- BEGIN BUILTIN REMQUE ; BIND tcc = .itcc [ixtcc$a_tcc] : $BBLOCK, tpb = .itcc [ixtcc$a_tpb] : $BBLOCK ; LOCAL tcb, status; LABEL connect; connect: BEGIN status = .itcc [ixtcc$l_iosb] ; IF NOT .status THEN LEAVE connect ; ! ! The connection was established. Finish setting the context for ! this connection. ! tcc [xtcc$l_flags] = xtcc$m_active ; tcc [xtcc$v_mode] = DECW$K_XPORT_REMOTE_CLIENT ; itcc [ixtcc$a_tdb] = .tcpip_tdb ; itcc [ixtcc$w_efn] = .tcpip_tdb [xtdb$w_efn] ; itcc [ixtcc$a_xport_table] = .tcpip_tdb [xtdb$a_xport_table] ; ! ! XTCC setup. Now set communication state so that the SRPs are in ! use, not the LRPs. ! xport_in_state_srp( tcc ) ; xport_out_state_srp( tcc ) ; xport_in_free_disable( tcc, decw$c_xport_buffer_lrp ) ; ! ! The transport buffers are all on the free queues. Remove ! one input SRP and read into it. ! status = $REMQTI( .itcc [ixtcc$a_ifs_queue], tcb ) ; ! ! Has the queue been corrupted? Or is it empty! ! IF (.status EQL xport$k_queue_corrupted) OR (.status EQL xport$k_queue_no_entry) THEN BEGIN status = DECW$_BADQUEUE ; LEAVE connect ; END ; ! ! Initiate the read. ! xport_in_free_disable( tcc, decw$c_xport_buffer_srp ) ; status = DECW$$TCPIP_FREE_INPUT_BUFFER( .itcc, .tcb ) ; IF NOT .status THEN LEAVE connect ; ! ! The connection is all setup. Tell the common layer. ! DECW$$XPORT_OPEN_COMPLETE( .itcc, .status ); RETURN; ! ! End of the named block CONNECT. ! END; ! ! An error occurred. Deassign the channel to UCX, remove the ! connection from the list of connections, and tell the ! common layer of the failure. ! $DASSGN( CHAN = .itcc [ixtcc$w_chan] ) ; REMQUE( .itcc, itcc ) ; tcpip_tdb [xtdb$l_ref_count] = .tcpip_tdb [xtdb$l_ref_count] - 1 ; DECW$$XPORT_OPEN_COMPLETE( .itcc, .status ) ; RETURN; END ; %SBTTL 'DECW$$TCPIP_ATTACH_TRANSPORT - connect the TCPIP transport code to the process' GLOBAL ROUTINE DECW$$TCPIP_ATTACH_TRANSPORT( tdb : REF $BBLOCK ) = !++ ! FUNCTIONAL DESCRIPTION: ! ! Perform the transport-specific initialization functions required for ! TCPIP. For the server this will: assign a channel to the network, ! create a known object, start a read on the net device. For the ! client, nothing is required. ! ! FORMAL PARAMETERS: ! ! tdb.mr.r xtdb structure. This will have been initialized by the ! caller prior to entry. ! ! IMPLICIT INPUTS: ! ! NONE ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! COMPLETION CODES: ! ! vms status codes ! ! ENVIRONMENT: ! ! USER OR EXEC MODE ! ! SIDE EFFECTS: ! ! assigns a channel, creates a temporary mailbox, initiates a read on the ! mailbox. ! !-- BEGIN BIND iosb = tdb [xtdb$w_iosb] : VECTOR [4,WORD], xtpb = .tdb [xtdb$a_tpb] : $BBLOCK ; LABEL attach ; OWN socktype : INITIAL( (UCX$C_STREAM ^ 16) + UCX$C_TCP ), sockaddrin : $BBLOCK [SIN$S_SOCKADDRIN] PRESET( [SIN$W_FAMILY] = INET$C_AF_INET, [SIN$W_PORT] = 0, [SIN$L_ADDR] = swap_long( INET$C_INADDR_ANY ) ) ; LOCAL sin_desc : VECTOR [2] INITIAL( SIN$S_SOCKADDRIN, sockaddrin ), log_desc : $BBLOCK [DSC$S_DSCDEF1], tab_desc : $BBLOCK [DSC$S_DSCDEF1], items : BLOCKVECTOR [2, ITM$S_ITEM, 1], host_addr : VECTOR [16,BYTE,UNSIGNED], host_desc : VECTOR [2] INITIAL( %ALLOCATION( host_addr ) - 1, host_addr ), host_len : INITIAL( 0 ), func_code : INITIAL( INETACP_FUNC$C_GETHOSTBYNAME ), func_code_desc : VECTOR [2] INITIAL( %ALLOCATION( func_code ), func_code ), retlen, status ; ! ! do at run-time what image activation can't do ! inet_dev_desc [0] = %CHARCOUNT( inet_dev_str ) ; inet_dev_desc [1] = UPLIT( inet_dev_str ) ; ! ! make it known module-wide ! tcpip_tdb = .tdb ; tdb [xtdb$w_efn] = ASYNC_EFN ; ! ! Get the local host name ! lnn_desc [DSC$A_POINTER] = local_node ; items [0,ITM$W_ITMCOD] = LNM$_STRING ; items [0,ITM$W_BUFSIZ] = %ALLOCATION( local_node ) ; items [0,ITM$L_BUFADR] = local_node ; items [0,ITM$L_RETLEN] = lnn_desc [DSC$W_LENGTH] ; items [1,ITM$W_ITMCOD] = 0 ; items [1,ITM$W_BUFSIZ] = 0 ; items [1,ITM$L_BUFADR] = 0 ; items [1,ITM$L_RETLEN] = 0 ; log_desc [DSC$W_LENGTH] = %CHARCOUNT( inet_local_node ) ; log_desc [DSC$B_DTYPE] = DSC$K_DTYPE_T ; log_desc [DSC$B_CLASS] = DSC$K_CLASS_S ; log_desc [DSC$A_POINTER] = UPLIT( inet_local_node ) ; tab_desc [DSC$W_LENGTH] = %CHARCOUNT( 'LNM$FILE_DEV' ) ; tab_desc [DSC$B_DTYPE] = DSC$K_DTYPE_T ; tab_desc [DSC$B_CLASS] = DSC$K_CLASS_S ; tab_desc [DSC$A_POINTER] = UPLIT( 'LNM$FILE_DEV' ) ; status = $TRNLNM( TABNAM = tab_desc, LOGNAM = log_desc, ITMLST = items ) ; ! ! nothing more required for clients ! IF ( .tdb [xtdb$v_mode] AND DECW$M_XPORT_CLIENT ) NEQ 0 THEN RETURN .status ; ! ! Do all the transport-specific initialization. ! attach: BEGIN ! ! See if local host name was found. ! IF NOT .status THEN LEAVE attach ; ! ! Get a channel to the internet device ! IF NOT (status = $ASSIGN( DEVNAM = inet_dev_desc, CHAN = tdb [xtdb$w_chan], ACMODE = psl$c_user ) ) THEN LEAVE attach ; ! ! Get address of server ! IF (status = $qiow( EFN = .tdb [xtdb$w_efn], CHAN = .tdb [xtdb$w_chan], FUNC = IO$_ACPCONTROL, IOSB = iosb, P1 = func_code_desc, P2 = lnn_desc, P3 = host_len, P4 = host_desc ) ) THEN status = .iosb [0] ; IF NOT .status THEN LEAVE attach ; ! ! Convert text to binary address ! host_desc [0] = .host_len ; status = parse_internet_address( host_desc, sockaddrin [SIN$L_ADDR] ) ; IF NOT .status THEN LEAVE attach ; ! ! Set protocol type, port number and local address ! sockaddrin [SIN$W_PORT] = swap_short( ( BASE_TCP_PORT + .xtpb [xtpb$w_display_num] ) ) ; IF (status = $QIOW( EFN = .tdb [xtdb$w_efn], CHAN = .tdb [xtdb$w_chan], FUNC = IO$_SETMODE, IOSB = iosb, P1 = socktype, P2 = ( %X'01000000' OR INET$M_LINGER OR INET$M_KEEPALIVE ), P3 = sin_desc, P4 = 5 ) ) THEN status = .iosb [0] ; IF NOT .status THEN LEAVE attach ; ! ! Start the connection ! IF NOT ( status = transport_read_queue( .tdb ) ) THEN LEAVE attach ; ! ! Done attaching. Say so in the log file. ! DECW$XPORT_ATTACHED( .tdb ) ; reattach_timer_id = 0 ; RETURN SS$_NORMAL ; END ; ! attach ! ! Something went wrong. Deassign any channels, and start polling. ! detach_and_poll( .tdb ) ; RETURN .status ; END ; %SBTTL 'transport_read_queue - start reading the TCPIP control channel' ROUTINE transport_read_queue( tdb : REF $BBLOCK ) = !++ ! FUNCTIONAL DESCRIPTION: ! ! Initiate a read on the transport control channel. We will receive ! connect notifications through this channel. ! ! FORMAL PARAMETERS: ! ! tdb.mr.r The xtdb associated with TCPIP. We can pick up ! the network channels here. ! ! IMPLICIT INPUTS: ! ! NONE ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! ENVIRONMENT: ! ! EXEC MODE ! ! COMPLETION CODES: ! ! VMS condition code ! ! SIDE EFFECTS: ! ! queues a read to the network mailbox. ! !-- BEGIN LOCAL item3 : VECTOR [3], status ; IF NOT .tdb [xtdb$v_dying] THEN BEGIN ! ! Get a channel for $_access $qio ! IF NOT (status = $ASSIGN( DEVNAM = inet_dev_desc, CHAN = tdb [xtdb$w_acc_chan], ACMODE = psl$c_user ) ) THEN BEGIN tdb [xtdb$v_dying] = 1 ; RETURN .status END ; ! ! Queue a connect accept ! item3 [0] = xtdb$s_acc_inaddr ; item3 [1] = tdb [xtdb$t_acc_inaddr] ; item3 [2] = tdb [xtdb$l_acc_inaddr_len] ; status = $qio( EFN = .tdb [xtdb$w_efn], CHAN = .tdb [xtdb$w_chan], FUNC = IO$_ACCESS OR IO$M_ACCEPT, IOSB = tdb [xtdb$w_acc_iosb], ASTADR = transport_read_ast, ASTPRM = .tdb, P3 = item3, P4 = tdb [xtdb$w_acc_chan] ) ; IF NOT .status THEN BEGIN $DASSGN( CHAN = .tdb [xtdb$w_acc_chan] ) ; tdb [xtdb$v_dying] = 1 ; END END ELSE status = DECW$_CNXABORT ; RETURN .status ; END ; %SBTTL 'transport_read_ast - process read completion on the network mailbox' ROUTINE transport_read_ast( tdb : REF $BBLOCK ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! Read completion AST routine for network device. ! ! This routine will receive connect request and link abort notification. ! We must parse the mailbox message and perform the correct function. ! ! For connect requests, we must allocated and initialize an xtcc, put ! it on the TCPIP xtdb, then call the connect request action routine ! provided by the transport user. ! ! For link aborts, we mark the connection as dying then call the ! dying connection action routine. ! ! FORMAL PARAMETERS: ! ! tdb.mr.r tdb structure for this transport. ! ! IMPLICIT INPUTS: ! ! NONE ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! ENVIRONMENT: ! ! EXEC MODE AST ! ! COMPLETION CODES: ! ! NOVALUE ! ! SIDE EFFECTS: ! ! will call appropriate action routine of transport user ! initiates a read before returning ! !-- BEGIN BUILTIN MOVPSL, REMQUE, INSQTI, INSQUE ; BIND xtpb = .tcpip_tdb [xtdb$a_tpb] : $BBLOCK, acc_iosb = tcpip_tdb [xtdb$w_acc_iosb] : VECTOR [4,WORD,UNSIGNED] ; LOCAL psl : $BBLOCK [4], found : INITIAL( 0 ), iosb : VECTOR [4,WORD,UNSIGNED] ; ! ! If the network is shutting down, poll for its return. ! IF .acc_iosb [0] EQL SS$_SHUT THEN BEGIN DECW$XPORT_ATTACH_LOST( .tdb , 0 ) ; detach_and_poll( .tdb ) ; RETURN ; END ; IF .acc_iosb [0] THEN ! ! Successful connection. Build connection descriptor. ! BEGIN MACRO ctrstr = '!UB.!UB.!UB.!UB' % ; LOCAL tcq : REF $BBLOCK INITIAL( 0 ), tcc : REF $BBLOCK INITIAL( 0 ), itcc : REF $BBLOCK INITIAL( 0 ), tcc_id : INITIAL( 0 ), tpb : REF $BBLOCK INITIAL( 0 ), fail : INITIAL( 1 ), status, il_count : INITIAL( .xtpb [xtpb$w_i_lrp_count] ), is_count : INITIAL( .xtpb [xtpb$w_i_srp_count] ), ol_count : INITIAL( .xtpb [xtpb$w_o_lrp_count] ), os_count : INITIAL( .xtpb [xtpb$w_o_srp_count] ), at_tcb, tcb_count, tcb_array : REF VECTOR [] INITIAL( 0 ), func_code : INITIAL( INETACP_FUNC$C_GETHOSTBYADDR ), func_code_desc : VECTOR [2] INITIAL( %ALLOCATION( func_code ), func_code ), inaddr : $BBLOCK [16], inaddr_len, inaddr_desc : VECTOR [2] INITIAL( %ALLOCATION( inaddr ), inaddr ), client_desc : VECTOR [2], ctr_desc : VECTOR [2] INITIAL( %CHARCOUNT( ctrstr ), UPLIT( ctrstr ) ), info_size, info_ptr, client_len ; LABEL connect ; connect: BEGIN ! ! Record how much extra memory must be allocated in ! the user region to store the user and node names. ! info_size = INET_NODE_NAME_LEN ; ! ! Allocate the exec mode connection context. ! IF (itcc = DECW$XPORT_ALLOC_PMEM( ixtcc$c_tcpip_length, DECW$C_DYN_IXTCC )) EQLA 0 THEN BEGIN status = SS$_INSFMEM ; LEAVE connect ; END ; ! ! Pre-insert connection so that it can be found in case of image rundown ! before connection is fully established. ! tcpip_tdb [xtdb$l_ref_count] = .tcpip_tdb [xtdb$l_ref_count] + 1 ; INSQUE( .itcc, tcpip_tdb [xtdb$a_itcc_flink] ) ; ! ! Allocate a connection specific copy of the transport ! parameter block. ! IF (tpb = DECW$XPORT_ALLOC_PMEM( xtpb$c_tcpip_length, DECW$C_DYN_XTPB )) EQLA 0 THEN BEGIN status = SS$_INSFMEM ; LEAVE connect ; END ; ! ! Copy the contents of the transport specific parameter block ! into the connection specific parameter block. ! CH$MOVE( xtpb$c_tcpip_length, .tcpip_tdb [xtdb$a_tpb], .tpb ) ; itcc [ixtcc$a_tpb] = .tpb ; ! ! Allocate the user modifiable memory. ! status = DECW$XPORT_ALLOC_INIT_QUEUES( .itcc, .tcpip_tft[xtft$l_xtcc_length], ! Length of an XTCC .tpb [xtpb$w_srp_size], ! Data length of an SRP .tpb [xtpb$w_lrp_size], ! Data length of an LRP .tpb [xtpb$w_i_srp_count], ! Input (Request) SRP count .tpb [xtpb$w_i_lrp_count], ! Input (Request) LRP count .tpb [xtpb$w_o_srp_count], ! Output (Event) SRP count .tpb [xtpb$w_o_lrp_count], ! Output (Event) LRP count .info_size, ! Per-Specific, Per-Connection Extra Allocation info_ptr) ; ! Return Address for Extra Allocation IF NOT .status THEN LEAVE connect ; tcc = .itcc[ixtcc$a_tcc] ; ! ! get peer name ! inaddr_len = 0 ; IF NOT (status = $FAO( ctr_desc, inaddr_len, inaddr_desc, .(tdb [xtdb$t_acc_inaddr])<32,8,0>, .(tdb [xtdb$t_acc_inaddr])<40,8,0>, .(tdb [xtdb$t_acc_inaddr])<48,8,0>, .(tdb [xtdb$t_acc_inaddr])<56,8,0> ) ) THEN BEGIN LEAVE connect ; END ; inaddr_desc [0] = .inaddr_len ; client_desc [0] = INET_NODE_NAME_LEN - 1 ; client_desc [1] = .info_ptr + 1 ; client_len = 0 ; IF (status = $QIOW( EFN = .tdb [xtdb$w_efn], CHAN = .tdb [xtdb$w_chan], FUNC = IO$_ACPCONTROL, IOSB = iosb, P1 = func_code_desc, P2 = inaddr_desc, P3 = client_len, P4 = client_desc ) ) THEN status = .iosb [0] ; IF NOT .status THEN BEGIN IF .status NEQU SS$_ENDOFFILE THEN BEGIN LEAVE connect ; END ELSE BEGIN ! ! If node is not known locally, then use the common address form ! as the client node name. ! CH$MOVE( .inaddr_len, .inaddr_desc [1], .client_desc [1] ) ; client_desc [0] = .inaddr_len ; client_len = .inaddr_len ; END ; END ELSE BEGIN ! ! Check if from local node ! IF CH$EQL( .client_len, .client_desc [1], .lnn_desc [DSC$W_LENGTH], .lnn_desc [DSC$A_POINTER], %C' ' ) THEN BEGIN (.client_desc [1])<0,8,0> = %C'0' ; client_desc [0] = 1 ; client_len = 1 ; END ; END ; ! ! Now get remote user name ! (.info_ptr)<0,8,0> = %C'?' ; ! ! Point the xtcc to the remote user name and node fields. ! IF .info_size GTR 0 THEN BEGIN tcc [xtcc$a_rem_user] = .info_ptr ; tcc [xtcc$l_rem_user_len] = 1 ; tcc [xtcc$a_rem_node] = .info_ptr + 1 ; tcc [xtcc$l_rem_node_len] = .client_len ; END ; ! ! copy accepted channel from tdb to ixtcc. ! itcc [ixtcc$w_chan] = .tcpip_tdb [xtdb$w_acc_chan] ; tcpip_tdb [xtdb$w_acc_chan] = 0 ; ! ! make connection formal then notify transport user ! tcc [xtcc$l_flags] = xtcc$m_active ; tcc [xtcc$v_mode] = DECW$K_XPORT_REMOTE_SERVER ; itcc [ixtcc$w_efn] = .tcpip_tdb [xtdb$w_efn] ; itcc [ixtcc$a_tdb] = .tcpip_tdb ; itcc [ixtcc$a_xport_table] = .tcpip_tdb [xtdb$a_xport_table] ; ! ! At this point, all structures are allocated and connected ! together. None of the XTCBs are in use (they are on the free ! queues). ! ! Complete acceptance of the connection in user mode. ! IF NOT (status = $DCLAST( ASTADR = transport_open_callback, ASTPRM = .itcc, ACMODE = psl$c_user ) ) THEN LEAVE connect ; ! ! Done ! fail = 0 ; END ; ! ! Clean up if something went wrong. ! IF .fail THEN BEGIN IF .itcc NEQA 0 THEN BEGIN IF .itcc [ixtcc$w_chan] NEQU 0 THEN $DASSGN( CHAN = .itcc [ixtcc$w_chan] ) ; REMQUE( .itcc, itcc ) ; tcpip_tdb [xtdb$l_ref_count] = .tcpip_tdb [xtdb$l_ref_count] - 1 ; DECW$XPORT_DEALLOC_QUEUES( .itcc ) ; DECW$XPORT_DEALLOC_PMEM( .itcc ) ; END ; IF .tpb NEQA 0 THEN DECW$XPORT_DEALLOC_PMEM( .tpb ) ; ! ! Report that we could not accept the link request ! DECW$XPORT_ACCEPT_FAILED ( .tcpip_tdb [xtdb$l_acc_inaddr_len], tcpip_tdb [xtdb$t_acc_inaddr], .status ) ; END ; END ; ! IF .acc_iosb [0] ... ! ! Common exit point ! ! Re-queue the mailbox read ! transport_read_queue( .tcpip_tdb ) ; ! ! Done ! END ; %SBTTL 'transport_open_callback - perform callback to user during open sequence' ROUTINE transport_open_callback( itcc : REF $BBLOCK ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! Perform a callback to the user during a connection initiation sequence. ! ! Transport semantics require a callback, as opposed to a simple AST, during ! the connection initiation sequence of a connect-to-server operation. ! As this cannot be performed in exec mode, we declare a user-mode AST ! to complete this operation. If the user accepts the connection, we ! must populate the communication queue with transport buffers and initiate ! I/O. If it fails, generate a message, and release the resources. ! ! Note: I'd much rather allow $XPORT_CLOSE to be called. Oh, well. ! ! FORMAL PARAMETERS: ! ! itcc.mr.r The proposed connection. ! ! IMPLICIT INPUTS: ! ! NONE ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! ENVIRONMENT: ! ! USER MODE AST ! ! COMPLETION CODES: ! ! NONE ! ! SIDE EFFECTS: ! ! queues a read to the network mailbox. ! !-- BEGIN BUILTIN REMQTI ; LOCAL tcc: REF $BBLOCK INITIAL ( .itcc [ixtcc$a_tcc] ), free_queue: REF VECTOR[2], status ; LABEL start_reading ; start_reading: BEGIN ! ! Peform callback. If the connection is accepted, start ! the initial read. ! IF NOT (status = (.tcpip_tdb [xtdb$a_connect_request])( .tcc )) THEN LEAVE start_reading ; ! ! Transport user accepted the connection ! xport_in_state_srp( tcc ) ; xport_out_state_srp( tcc ) ; xport_in_free_disable( tcc, decw$c_xport_buffer_lrp ) ; ! ! The transport buffers are all on the free queues. ! free_queue = .tcc [xtcc$a_ifs_queue] ; IF .free_queue[0] EQLA 0 THEN BEGIN free_queue = .tcc [xtcc$a_ifl_queue] ; IF .free_queue[0] EQLA 0 THEN BEGIN status = DECW$_BADQUEUE ; LEAVE start_reading ; END ; END ; ! ! Start the initial read. ! status = DECW$$TCPIP_EXECUTE_FREE ( .tcc, 0, decw$c_xport_buffer_srp, .free_queue ) ; IF .status THEN RETURN ; END ; ! ! Transport user rejected the connect so release resources ! DECW$XPORT_CLOSE( .tcc ) ; ! ! report server rejection ! DECW$XPORT_REFUSED_BY_SERVER ( .status ) ; RETURN ; END ; %SBTTL 'detach_and_poll - detach from the network, and start polling for network restart' ROUTINE detach_and_poll( tdb : REF $BBLOCK ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! Called from transport_read_ast or ATTACH_TRANSPORT to start polling for ! network restart. ! ! FORMAL PARAMETERS: ! ! tdb.mr.r tdb structure for this transport. ! ! IMPLICIT INPUTS: ! ! NONE ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! ENVIRONMENT: ! ! EXEC MODE AST ! ! COMPLETION CODES: ! ! NOVALUE ! ! SIDE EFFECTS: ! !-- BEGIN BUILTIN EMUL ; LOCAL status ; ! ! Don't do any more if we are in image rundown or process termination. ! IF .tdb [xtdb$v_dying] THEN RETURN ; ! ! Get rid of the channel to the internet device. ! IF .tdb [xtdb$w_chan] NEQ 0 THEN BEGIN $CANCEL( CHAN = .tdb [xtdb$w_chan] ) ; $DASSGN( CHAN = .tdb [xtdb$w_chan] ) ; tdb [xtdb$w_chan] = 0 ; END ; ! ! Get rid of the channel to the accept connect channel. ! IF .tdb [xtdb$w_acc_chan] NEQ 0 THEN BEGIN $CANCEL( CHAN = .tdb [xtdb$w_acc_chan] ) ; $DASSGN( CHAN = .tdb [xtdb$w_acc_chan] ) ; tdb [xtdb$w_acc_chan] = 0 ; END ; ! ! How long between polls? ! IF .reattach_timer_id EQL 0 THEN BEGIN reattach_timer_id = .tdb ; EMUL( %REF( REATTACH_INTERVAL_SECS ), %REF( -10000000 ), %REF( 0 ), reattach_timer_delta ) ; END ; ! ! Make sure that the transport is still alive. ! IF .tcpip_tdb [xtdb$v_dying] THEN RETURN ; ! ! Now start polling for network restart. ! status = $SETIMR( EFN = 31, DAYTIM = reattach_timer_delta, ASTADR = reattach_ast, REQIDT = .reattach_timer_id ) ; IF NOT .status THEN DECW$XPORT_REATTACH_FAILED( .tdb, .status ) ; RETURN ; END ; %SBTTL 'reattach_ast - restart timer ast completion routine' ROUTINE reattach_ast( tdb : REF $BBLOCK ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! Timer expired, attempt to reattach to the network. ! ! FORMAL PARAMETERS: ! ! tdb.mr.r xtdb structure for this transport ! ! IMPLICIT INPUTS: ! ! NONE ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! ENVIRONMENT: ! ! EXEC MODE, AST ROUTINE ! ! COMPLETION CODES: ! ! NONE ! ! SIDE EFFECTS: ! ! May reconnect to the network ($ASSIGN channels, etc.) ! Or may queues another timer event. ! !-- BEGIN LOCAL status; ! ! Try to re-attach to the network. ! status = DECW$$TCPIP_ATTACH_TRANSPORT( .tdb ) ; RETURN ; END ; %SBTTL 'DECW$$TCPIP_RUNDOWN - image rundown processing' GLOBAL ROUTINE DECW$$TCPIP_RUNDOWN( tdb : REF $BBLOCK ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! Perform the transport-specific rundown functions required during ! image rundown. ! ! FORMAL PARAMETERS: ! ! tdb.mr.r xtdb structure. This will have been initialized by the ! caller prior to entry. ! ! IMPLICIT INPUTS: ! ! NONE ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! COMPLETION CODES: ! ! VMS condition codes ! ! ENVIRONMENT: ! ! EXEC MODE ! ! SIDE EFFECTS: ! ! Cancels I/O, Deassigns channels, deletes mailboxes ! !-- BEGIN BIND iosb = tdb [xtdb$w_iosb] : VECTOR [4,WORD], xtpb = .tdb [xtdb$a_tpb] : $BBLOCK ; LOCAL itcc : REF $BBLOCK INITIAL( .tdb [xtdb$a_itcc_flink] ), status ; ! ! Mark transport as dying ! tdb [xtdb$v_dying] = 1 ; ! ! Mark each connection as dying and cancel all I/O ! WHILE .itcc NEQA tdb [xtdb$a_itcc_flink] DO BEGIN BIND xtcc = .itcc [ixtcc$a_tcc] : $BBLOCK ; xtcc [xtcc$v_dying] = 1 ; $CANCEL( CHAN = .itcc [ixtcc$w_chan] ) ; $DASSGN( CHAN = .itcc [ixtcc$w_chan] ) ; itcc [ixtcc$w_chan] = 0 ; itcc = .itcc [xtcc$a_flink] ; END ; ! ! nothing more required for clients ! IF ( .tdb [xtdb$v_mode] AND DECW$M_XPORT_CLIENT ) NEQ 0 THEN RETURN ; ! ! Cancel outstanding I/O ! $CANCEL( CHAN = .tdb [xtdb$w_chan] ) ; $CANCEL( CHAN = .tdb [xtdb$w_acc_chan] ) ; ! ! Destroy channels ! $DASSGN( CHAN = .tdb [xtdb$w_acc_chan] ) ; tdb [xtdb$w_acc_chan] = 0 ; $DASSGN( CHAN = .tdb [xtdb$w_chan] ) ; tdb [xtdb$w_chan] = 0 ; ! ! If there is a reattach timer, cancel it. ! IF .reattach_timer_id NEQ 0 THEN $CANTIM( REQIDT = .reattach_timer_id ) ; ! ! Done ! RETURN ; END ; %SBTTL 'DECW$TRANSPORT_INIT - Initialize transport' GLOBAL ROUTINE DECW$TRANSPORT_INIT = !++ ! FUNCTIONAL DESCRIPTION: ! Initialize and return the address of the xtft. ! ! FORMAL PARAMETERS: ! None. ! ! IMPLICIT INPUTS: ! None. ! ! IMPLICIT OUTPUTS: ! None. ! ! RETURN VALUE: ! Pointer to the xtft. ! ! ENVIRONMENT: ! EXEC OR USER MODE ! ! SIDE EFFECTS: ! None. !-- BEGIN LOCAL tft: REF $BBLOCK ; ! Pointer to xtft ! Initialize and return the xtft. ! tft = tcpip_tft ; tft[xtft$l_required0] = xtft$k_required0 ; tft[xtft$l_reserved0] = 0 ; tft[xtft$a_execute_write] = decw$$tcpip_execute_write ; tft[xtft$a_write] = decw$$tcpip_write ; tft[xtft$a_write_user] = decw$$tcpip_write_user ; tft[xtft$a_execute_free] = decw$$tcpip_execute_free ; tft[xtft$a_free_input_buffer] = decw$$tcpip_free_input_buffer ; tft[xtft$a_close] = decw$$tcpip_close ; tft[xtft$a_open] = decw$$tcpip_open ; tft[xtft$a_attach_transport] = decw$$tcpip_attach_transport ; tft[xtft$a_rundown] = decw$$tcpip_rundown ; tft[xtft$l_xtcc_length] = xtcc$c_tcpip_length ; tft[xtft$l_xtpb_length] = xtpb$c_tcpip_length ; tft[xtft$l_xtdb_length] = xtdb$c_tcpip_length ; tft[xtft$l_ixtcc_length] = ixtcc$c_tcpip_length ; tft[xtft$l_required1] = xtft$k_required1 ; .tft END ; END ELUDOM