OpenVMS Source-Code Demos

TCPIP$TCP_CLIENT_QIO_BASIC

1000	%title                              "TCPIP$TCP_CLIENT_QIO_BASIC"	!
	%ident                      "version_101.2"				! <---+--- must match
        declare string constant k_version = "101.2"			,	! <---+						&
                                k_program = "TCPIP$TCP_CLIENT_QIO_BASIC"	!
	!========================================================================================================================
	! Title  : TCPIP$TCP_CLIENT_QIO_BASIC.BAS
	! Author : Neil Rieck
	! Notes  : 1. this program is derived from "TCPIP$EXAMPLES:TCPIP$TCP_CLIENT_QIO.C"
	!		which is a TCP/IP (UCX) example program for DEC-C and VAX-C
	!		copyrighted in 1989 and 1998 by "Digital Equipment Corporation" and
	!		subsequently by "Compaq Computer Corporation".
	!		More 'C' programs were added to directory TCPIP$EXAMPLES in 2003 and 2008.
	! History:
	! ver who when   what
	! --- --- ------ --------------------------------------------------------------------------------------------------------
	! 100 NSR 001025 1. started conversion from DECC source (in my spare time)
	!     NSR 001027 2. finished conversion and testing (good enough for a demo)
	! 101 NSR 121230 1. fixed a few obvious bugs
	!		 2. brought a little more up-to-date
	!========================================================================================================================
	option type=explicit							! cuz tricks are for kids
	!
	on error goto trap							! old-school trapping
	!
	!	<<< external declarations >>>
	!
	%include "starlet"	%from %library "sys$library:basic$starlet"	! system services
	%include "$ssdef"	%from %library "sys$library:basic$starlet"	! ss$
	%include "$iodef"	%from %library "sys$library:basic$starlet"	! io$
	%include "lib$routines"	%from %library "sys$library:basic$starlet"	! lib$
	%include "sys$library:tcpip$inetdef.bas"				! tcp/ip network definitions for BASIC
	!
	!	<<< home brewed functions >>>
	!
	external word function htons(word by ref)				!
	external byte function long_to_byte( long by ref )			!
	!
	!	note: for the peek trick to work, we must...
	!
	!		1. declare LONG BY VALUE passing mechanisms here (we are passing 32-bit addresses)
	!		2. declare BY REF passing mechanisms in the receiving functions
	!
	external long function my_peek_L( long by value )			!
	external long function my_peek_W( long by value )			!
	external long function my_peek_B( long by value )			!
	!
	!	my I/O Status Block
	!
	record IosbRec								!
	    variant
		case
		    group one
			word		rc
			word		xfer_count
			long		long_0
		    end group one
		case
		    group two
			basic$quadword	quad_0
		    end group two
	    end variant
	end record IosbRec
	!
	!	my Item Record Block
	!
	record ItemRec								!
	    variant
		case
		    group one
			word		BuffLen
			word		ItemCode
			long		BuffAddr
			long		RtnLenAdr
		    end group one
		case
		    group two
			long		ListTerm
			long		junk1
			long		junk2
		    end group two
	    end variant
	end record ItemRec
	!
	!	<<< variable declarations >>>
	!
	declare long	rc_status	,				!				&
		word	channel_0	,				! INET channel			&
		word	sck_parm(2)	,				! Socket creation parameter	&
		IosbRec	myIosb						!
	!
	map(buf)string		buf	= 512
	declare	long		buflen
				buflen	= 512
	declare	word		port%
	declare long		dummy_ptr%				! in DECC was unsigned char *dummy
	declare long		r_retlen
	declare sockaddrin	remote_host				! was sockaddr_in in 'C'
	!
	record IL2							! input list 2 descriptor
		long il2_length
		long il2_address
	end record IL2
	declare IL2		rhst_adrs				! remote host address
	!
	!===============================================================
	!	main
	!===============================================================
1500	main:								!
	print k_program +"_"+ k_version					!
	print string$(len(k_program +"_"+ k_version), asc("="))		! how will this optimize on Alpha?
	!
	declare string	inet_dev					! dynamic string descriptor (good)
			inet_dev = "TCPIP$DEVICE:"			!
	buf = "Hi there"						! we will send this text
	!
	declare ItemRec	Item_List(1)					! 0->1
	item_list(0)::BuffLen	= 4%					! 4 bytes (the size of next param)
	item_list(0)::ItemCode	= TCPIP$C_REUSEADDR			!
        item_list(0)::BuffAddr	= 0%					! none
	item_list(0)::RtnLenAdr	= 0%					! no address given (so call will not store return length)
	item_list(1)::ListTerm	= 0%					! no more items...
	!
	declare ItemRec sock_opts(1)					!
	sock_opts(0)::BuffLen	= 4%					! 4 bytes
	sock_opts(0)::ItemCode	= TCPIP$C_SOCKOPT			!
	sock_opts(0)::BuffAddr	= loc( item_list(0) )			!
	sock_opts(0)::RtnLenAdr	= 0%					! no address given (so call will not store return length)
	sock_opts(1)::ListTerm	= 0%					! no more items...

	rhst_adrs::il2_length	= SIN$S_SOCKADDRIN			! size of local host sockaddrin
	rhst_adrs::il2_address	= loc( remote_host )			! address of local host sockaddrin

	sck_parm(0)			= TCPIP$C_TCP			! TCP/IP protocol
	sck_parm(1)			= INET_PROTYP$C_STREAM		! stream type of socket

	remote_host::sin$w_family	= TCPIP$C_AF_INET		! INET family		(in 'c' was: sin_family		)
	!
	!	Note:	both VAX + Alpha are little-endian architectures but network order requires that we send MSB first so
	!		we load structures as if we were big-endian
	!
	map(switch)	long	long0		 !
	map(switch)	byte	byte0		,! LSB (little-endian)		&
				byte1		,!				&
				byte2		,!				&
				byte3		 ! MSB (little-endian)
	!
2000	%let %loopback=1%						! 1=use loopback, 0=use other address
	%if  %loopback=1%						!
	%then
				byte0=	127%				! 127.0.0.1
				byte1=	0%				!
				byte2=	0%				!
				byte3=	1%				!
	%else
				byte0=	long_to_byte( 142%	)	! 142.180.39.57
				byte1=	long_to_byte( 180%	)	!
				byte2=	long_to_byte( 39%	)	!
				byte3=	long_to_byte( 57%	)	!
	%end %if
	!
3000	print "-i-address: "+ str$(byte0)+"."+str$(byte1)+"."+str$(byte2)+"."+str$(byte3)
	remote_host::sin$l_addr	= long0					! address		(in 'c' was: sin_addr.s_addr	)
	port% = 5321%							! hard code the port for now
	remote_host::sin$w_port = htons(port%)				!			(in 'c' was: sin_port		)
	print "-i-port: "+ str$(port%)					!

	!
	!	Assign a channel to the TCPIP device
	!
	rc_status = sys$assign(inet_dev, channel_0,,,)			! assign a channel
	if ((rc_status and 1%) <> 1%) then				!
		print "-e-Failed to assign channel to TCPIP device."	!
		call lib$stop(rc_status)				! death is rather abrupt :-)
	end if								!

	!
	rc_status = sys$qiow(	3%,					! Event flag						&
				channel_0,				! Channel number					&
				IO$_SETMODE,				! I/O function						&
				myIosb::quad_0,				! I/O status block					&
				, ,					!							&
				sck_parm(0%), ,				! P1 Socket creation parameter				&
				, ,					!							&
				, )					! P5 Socket option descriptor
	if ((rc_status and 1%) = 1%) then
		rc_status = myIosb::rc
	end if
	if ((rc_status and 1%) <> 1%) then
		print "-e-Failed to create the device socket"
		call lib$stop(rc_status)
	end if

	!
	!	Bind to chosen port number (after REUSEADDR is set above)
	!
	rc_status = sys$qiow(	3%,					! Event flag		&
				channel_0,				! Channel number	&
				IO$_ACCESS,				! I/O function		&
				myIosb::quad_0,				! I/O rc_status block	&
				, ,					!			&
				, ,					!			&
				loc(rhst_adrs::il2_length),		! P3 local socket name	&
				,					!			&
				, )					!
	if ((rc_status and 1%) = 1%) then
		rc_status = myIosb::rc
	end if
	if ((rc_status and 1%) <> 1%) then
		print "-e-Failed to connect to remote host"
		call lib$stop(rc_status)
	end if

	!
	!	Write I/O buffer
	!
	print "-i-calling qiow (sending text)"				!
	rc_status = sys$qiow(	3%,					! Event flag						&
				channel_0,				! Channel number					&
				IO$_WRITEVBLK,				! I/O function						&
				myIosb::quad_0,				! I/O rc_status block					&
				, ,					!							&
				buf,					! P1 buffer						&
	!~~~			buflen,					x P2 buffer length					&
				len( edit$(buf,128) ),			! P2 buffer length	(drop trailing white space)	&
				, , , )					!
	if ((rc_status and 1%) = 1%) then				!
		rc_status = myIosb::rc
	end if
	if ((rc_status and 1%) <> 1%) then
		print "-e-Failed to write to socket"
	end if

	!
	!	Shut down the socket (optional)
	!
	rc_status = sys$qiow(	3%,					!				&
				channel_0,				!				&
				(IO$_DEACCESS or IO$M_SHUTDOWN),	!				&
				myIosb::quad_0,				!				&
				, ,					!				&
				, , ,					!				&
				TCPIP$C_DSC_ALL,			! P4 Discard all packets	&
				, )					!
	if ((rc_status and 1%) = 1%) then				!
		rc_status = myIosb::rc
	end if
	if ((rc_status and 1%) <> 1%) then
		print "-e-Failed to shut down the socket"
	end if

	!
	!	Close the sockets
	!
10000	rc_status = sys$qiow(		3%,				!	&
					channel_0,			!	&
					IO$_DEACCESS,			!	&
					myIosb::quad_0,			!	&
					, ,				!	&
					, , , , , )			!
	if ((rc_status and 1%) = 1%) then
		rc_status = myIosb::rc
	end if
	if ((rc_status and 1%) <> 1%) then
		print "-e-Failed to close the socket."
	end if

	!
	!	Deassign the TCPIP device channels
	!
	rc_status = sys$dassgn(channel_0)
	if ((rc_status and 1%) <> 1%) then
		print "-e-Failed to deassign the channel"
	end if
	!
	goto fini

	!----------------------------------------------------------------------------------------------------
	!	<<< error trap >>>
	!----------------------------------------------------------------------------------------------------
31000	trap:
	print
	print "=== Common Error Trap ==="					!
	print "error num : "+ str$(err) +" on line "+ str$(erl)			!
	print "error text: "+ ert$(err)						!
	rc_status	= 2							! vms-e-
	resume fini2								! fix stack
	!----------------------------------------------------------------------------------------------------
	!	<<< adios >>>
	!----------------------------------------------------------------------------------------------------
	fini:									!
	rc_status	= 1							! vms-s-
	!
	!	rc_status must be set up before this point
	!
	fini2:
	print "-i-program exiting with status: "+str$(rc_status)		!
32000	end program rc_status							!
	!
	!#######################################################################
	!
	!----------------------------------------------------------------------------------------------------
	!	this BASIC function replaces the C-MACRO 'hton' (which is nothing more than a byte swap)
	!
	!	Notes:
	!	1. 'hton' means host-to-network byte order ('s' means 'short' or 'word')
	!	2. both VAX + Alpha are little-endian architectures but network order requires that we send
	!	   ports (and IP addresses) MSB first
	!----------------------------------------------------------------------------------------------------
32010	function word htons(word incoming_data by ref)				!
	option type=explicit
	!
	map(my_map)word	bits_F0		 ! Bits F->0
	map(my_map)byte	bits_70		,! Bits 7->0		&
			bits_F8		 ! Bits F->8
	declare byte temp%
	!
	bits_F0	= incoming_data
	temp%	= bits_70
	bits_70	= bits_F8
	bits_F8	= temp%
	htons	= bits_F0						! prepare to exit the function
	!
	end function
	!----------------------------------------------------------------------------------------------------
	!	peek LONG
	!----------------------------------------------------------------------------------------------------
32020	function long my_peek_L(long incoming by ref)
	option type=explicit
	my_peek_L =  incoming
	end function
	!----------------------------------------------------------------------------------------------------
	!	peek WORD
	!----------------------------------------------------------------------------------------------------
32030	function long my_peek_W(word incoming by ref)
	option type=explicit
	declare long temp%
	temp%		= incoming
	temp%		= abs( temp%) if temp% < 0%
	my_peek_W	= temp%
	end function
	!----------------------------------------------------------------------------------------------------
	!	peek BYTE
	!----------------------------------------------------------------------------------------------------
32040	function long my_peek_B(byte incoming by ref)
	option type=explicit
	declare long temp%
	temp%		= incoming
	temp%		= abs( temp%) if temp% < 0%
	my_peek_B	= temp%
	end function
	!
	!----------------------------------------------------------------------------------------------------
	!	long_to_byte
	!
	! Notes:
	! 1. when jamming bytes (as is the case with the octets in an I/P address) we may wish to poke an
	!    unsigned byte like 192 but all bytes in BASIC are signed so this little function will do the
	!    conversion for us with very little fuss.
	! 2. remember that we are little-endian
	!----------------------------------------------------------------------------------------------------
32050	function byte long_to_byte(long incoming by ref)
	option type=explicit
	!
	map(my_map)long	long0
	map(my_map)byte	byte0,	! LSB		&
			byte1,	!		&
			byte2,	!		&
			byte3	! MSB
	!
	long0		= incoming
	long_to_byte	= byte0
	end function
	!