OpenVMS Source-Code Demos

TCPIP$TCP_CLIENT_QIO_2014E

1000	%title "tcpip$tcp_client_qio_2014e_xxx.bas"
	%ident                      "version_107.2"
	declare string constant k_version = "107.2"	,			&
				k_program = "tcpip$tcp_client_qio_2014e"	!
	!========================================================================================================================
	! title      : tcpip$tcp_client_qio_2014e
	! author     : Neil Rieck ( http://neilrieck.net )
	!	     : (c) copyright 1999,2014  Neil Rieck
	!            : Waterloo, Ontario, Canada.
	! created    : 2014-08-04
	! OS         : OpenVMS (Alpha or Itanium) or VMS on VAX
	! Stack      : TCP/IP Services V5.0 or higher (but should work with any stack after a few mods)
	! compile    : $ bas	tcpip$tcp_client_qio_2014e_106.bas (where 106 is the version number)
	! link       : $ link	tcpip$tcp_client_qio_2014e_106
	! references : HP TCP/IP Services for OpenVMS
	!              Sockets API and System Services Programming (manual: BA548-90002)
	! notes      : 1. stack programming on VMS/OpenVMS can be done by "Sockets API" (easier) or using
	!		  "VMS System Services" (harder; a lot like building an Interociter)
	!	       2. A and B client demos employ sys$qiow (synchronous) via VMS System Services
	!	       3. The C client demo employs sys$qio (asynchronous) to provide even more control
	!	       4. The D client demo moves repetitive code to external functions
	!	       5. The E client demo adds NVT routines so we can telnet
	! Caveat     : after the NVT-handshake at the beginning of a telnet session, most stacks will already know the
	!	       TERMIMAL TYPE. However, many VMS/OpenVMS systems contain login scripts which always execute DCL
	!	       command "SET TERM/INQUIRE". This operation works as follows:
	!		a)	host sends:	<esc> [ c		(ANSI request to identify terminal type)
	!			expecting:	<esc> [ ? 1 ; 0 c	(for VT100 within 2 seconds)
	!			or:		<esc> [ ? 1 ; 2 c	(for VT102) within 2 seconds
	!		b)	if no terminal response after 2-seconds then you will see:
	!			host sends:	<esc> \			(clear character set)
	!			folowed by:	<esc> Z			(VT52 request to identify terminal type)
	!		c)	if no terminal response after 2-seconds then you will see:
	!			host sends:	<esc> [ 0 c		(alternate ANSI request to identify terminal)
	!		Obviously these 2-second delays will mess up my timers when set too low
	! history    :
	! ver who when   what
	! --- --- ------ --------------------------------------------------------------------------------------------------------
	! 105 NSR 140825 0. started with TCPIP$TCP_CLIENT_QIO_2014D_105.BAS
	!		 1. adding code to support NVT handshakes (see external function nsr_nvt_scan)
	!     NSR 140828 2. the saga continues
	! 106 NSR 140829 1. moved octets_to_quad into an external function
	!     NSR 140902 2. added nvt enhancements
	!		 3. introduced a little code mtce
	!     NSR 140903 4. introduced a tweak for the WONT/DONT problem with Solaris					bf_106.4
	! 107 NSR 140903 1. replace "any" with the correct data types in external function declarations
	!     NSR 140904 2. moved destination decoding into an external function (got to stick with the KISS principle)
	!========================================================================================================================
	option type=explicit							! formal coding
	set no prompt								!
	on error goto common_trap						! old school trapping for this demo
	!
	!	named constants
	!
	declare	long constant	TCPBUFSIZ	= 8192				! buffer size (no larger than 32767)
	declare long constant   k_os_vanilla	= 1			,	&
				k_os_openvms	= 2			,	&
				k_os_solaris	= 3			,	&
				k_os_windows	= 4
	!
	%include "TCPIP$TCP_CLIENT_QIO_2014E.INC"				!
	%include "nvt_definitions.inc"						! nvt = network virtual terminal
	!
	!	declare variables
	!
	map(recv)string	buffer_r = TCPBUFSIZ					!
	map(xmit)string buffer_w = TCPBUFSIZ					!
	!
	declare string		msg$					,	&
				keyboard$				,	&
				dest$					,	&
				path$					,	&
				tcp_proto$				,	&
				username$				,	&
				password$				,	&
				buffer$					,	&
				junk$					,	&
		long		ip_address				,	&
				first_time				,	&
				send_count				,	&
		word		tcp_port				,	&
		long		rc					,	&
				bytes_w					,	&
				readcount				,	&
				bytes_r					,	&
				nvt_msgs				,	&
				bytes_r_total				,	&
				os_type					,	&
				http%					,	&
				junk%					,	&
				try%					,	&
				junk1					,	&
				junk2					,	&
				dest_kind				,	&
				i%					,	&
				debug					,	&
		ncv_rec		ncv					,	! network connection variables		&
				ncv2						! support for a second connection
	!
	!=======================================================================
	!	main
	!=======================================================================
2000	main:
	print
	print k_program +"_"+ k_version						!
	!
	get_dest:
	print string$(len(k_program + k_version) + 1, asc("="))			!
	select tcp_port								!
	    case 23								!
		tcp_proto$ = "telnet"						!
	    case else								!
		tcp_port = 80							! default to HTTP
		tcp_proto$ = "http"						!
	end select								!
	print "-i-port:";tcp_port;"(";tcp_proto$;")"				!
	print "-i-debug:";debug
	print "-i-Menu:"
	print "   1 = 142.180.221.226   (OpenVMS-8.4 w/TCPware stack)"
	print "   2 = kawc96.on.bell.ca"
	print "   3 = 142.180.221.246   (Solaris-8                  )"
	print "   4 = kawc3w.on.bell.c"
	print "   5 = 142.180.221.220   (OpenVMS-8.4 w/native stack )"
	print "   6 = kawc0f.on.bell.ca"
	print "   or any string     (eg. www3.sympatico.ca          )"
	print "                     (eg. neilrieck.net/ )"
	print "   T = toggle tcp port between 80 (http) and 23 (telnet)"
	PRINT "   D = set debug level"
	print "   Q = quit (default)"
	print
	print "-?-";tcp_proto$;" destination? ";				!
	input dest$								!
	dest$ = edit$(dest$,2)							! no white space
	select dest$								!
	    case "T","t"							!
		if tcp_port = 80 then						!
		    tcp_port = 23						!
		else								!
		    tcp_port = 80						!
		end if								!
		goto get_dest							!
	    case "1"								!
		dest$ = "142.180.221.226"					!
	    case "2"								!
		dest$ = "kawc96.on.bell.ca"					!
	    case "3"								!
		dest$ = "142.180.221.246"					!
	    case "4"								!
		dest$ = "kawc3w.on.bell.ca"					!
	    case "5"								!
		dest$ = "142.180.221.220"					!
	    case "6"								!
		dest$ = "kawc0f.on.bell.ca"					!
	    case "D","d"							!
		when error in							!
		    input "-?-debug? (0-3) ";debug				!
		    debug = 0 if debug < 0					!
		use								!
		    debug = 0							!
		end when							!
		goto get_dest							!
	    case else								!
		goto fini	if len(dest$)<=1 				! "Q", "q"
	end select								!
	!
3000	ip_address = nsr_adr_prep(debug, dest$, path$, dest_kind)		! all params (except debug) may be modified
	select dest_kind							!
	    case 1								! we "know" this is an IPv4 address
		print "-i-you entered an IPv4 address"				!
		http% = 0							! only HTTP/1.0 requests are possible
	    case 2								! this might be a dns name
		print "-i-you entered a dns name"				!
		http% = 1							! HTTP/1.1 request is possible
	    case else								!
		print "-e-error, your input data is not useable"		!
		goto get_dest							!
	end select								!
	!
	!-----------------------------------------------------------------------
	!
	if tcp_port = 23 then							! telnet requires more information
	    input "-?-username: ";username$					!
	    goto get_dest	if edit$(username$,2) = ""			!
	    input "-?-password: ";password$					!
	    goto get_dest	if edit$(password$,2) = ""			!
	    try% = 200								! start with sequence 200
	else									!
	    sleep 1
	    try% = 100								! start with sequence 100
	end if									!
	!-----------------------------------------------------------------------
	!
	!	create socket
	!
	rc = nsr_tcp_prep(debug, ncv )						! allocate flags, allocate channel, etc.
	goto rc_exit	if (rc and 7%) <> 1					!
	!
	!	connect
	!
!~~~	tcp_port			= SERV_PORTNUM				x
	rc = nsr_tcp_open(debug, ncv, ip_address, tcp_port,"0 0:0:05.0")	! connect with 5 second time limit
	goto rc_exit	if (rc and 7%) <> 1					!
	!-----------------------------------------------------------------------
	!	send loop
	!-----------------------------------------------------------------------
	send_count = 0								! init
	!
	!	entry pt.
	!
	send_loop:								!
	send_count = send_count + 1								if debug > 0
	print "-i-SEND-try:";try%;" count:";send_count;" ############################>>>"	if debug > 0
	!
	!	action states (send)
	!	====================
	!	<=99	nothing
	!	100-199	http   handshake sequences
	!	200-299	telnet handshake sequences
	!	>=300	nothing
	!
	select try%								!
	    case <100								! this is more for information
		print "-e-try:";try%;"which is a programming error"
		rc = 2
		goto rc_exit
	    case 100								! http demo sequence starts here ------
		!-----------------------------------------------------------------------
		!	send a message to retrieve the default web page
		!
		!	eg. examples:	1	GET / HTTP/1.0
		!
		!			2	GET /n.rieck HTTP/1.0
		!
		!			3	GET /n.rieck HTTP/1.1
		!				host: www3.sympatico.ca
		!
		!	caveat: websevers sitting behind load balancers, or webservers in the cloud,
		!		usually will not accept requests employing HTTP/1.0
		!-----------------------------------------------------------------------
		path$ = "/" if path$ = ""					!
		if http% = 0 then						!
		    print "-i-sending this HTTP 1.0 request:"		if debug > 0
		    msg$ = "GET "+ path$ +" HTTP/1.0"	+ cr + lf +		&
				cr + lf						! blank line marks end of HTTP block
		else								!
		    print "-i-sending this HTTP 1.1 request:"		if debug > 0
		    msg$ = "GET "+ path$ +" HTTP/1.1"	+ cr + lf +		&
				"host: "+ dest$		+ cr + lf +		&
				cr + lf						! blank line marks end of HTTP block
		end if								!
		print msg$						if debug > 0
		bytes_w = len(msg$)						! determine the data length
		buffer_w = msg$							! xref data to buffer for qio
		!
		rc = nsr_tcp_send(debug, ncv, buffer_w, bytes_w, "0 0:0:05.0")	! xmit with 5 second time limit
		goto rc_exit	if (rc and 7%) <> 1				!
	    case 101								!
		if http% = 1 then						!
		    print
		    print "-i-since this is a persistent connection..."
		    print "-i-resending this HTTP 1.1 request:"
		    msg$ = "GET "+ path$ +" HTTP/1.0"	+ cr + lf +		&
				"host: "+ dest$		+ cr + lf +		&
				cr + lf						! blank line marks end of HTTP block
		    sleep 1
		    print msg$							!
		    bytes_w = len(msg$)						! determine the data length
		    buffer_w = msg$						! xref data to buffer for qio
		    !
		    rc = nsr_tcp_send(debug, ncv, buffer_w, bytes_w, "0 0:0:05.0") ! xmit with 5 second time limit
		    goto rc_exit	if (rc and 7%) <> 1			!
		end if								!
	    case 102								! http demo sequence ends here --------
		goto no_more_processing						!
	    case 103 to 199
		print "-e-try:";try%;"which is a programming error"
		rc = 2
		goto rc_exit
	    case 200								! telnet demo sequence starts here ----
		buffer$	= ""							! zap buffer
		print "-i-nothing to send"
										! telent usually starts nvt receive
	    case 201								!
		!
		! caveat: if you know this is a VMS system then you might wish to send:	username/nocommand
		!		to avoid processing startup scripts
		!
		print "-i-sending username"					!
		msg$ = username$ + cr						!
		bytes_w = len(msg$)						! determine the data length
		buffer_w = msg$							! xref data to buffer for qio
		rc = nsr_tcp_send(debug, ncv, buffer_w, bytes_w, "0 0:0:05.0")	! xmit with 5 second time limit
		goto rc_exit	if (rc and 7%) <> 1				!
	    case 202								!
		print "-i-sending password"					!
		msg$ = password$ + cr						!
		bytes_w = len(msg$)						! determine the data length
		buffer_w = msg$							! xref data to buffer for qio
		rc = nsr_tcp_send(debug, ncv, buffer_w, bytes_w, "0 0:0:05.0")	! xmit with 5 second time limit
		goto rc_exit	if (rc and 7%) <> 1				!
	    case 203 to 209							!
		print "-i-sending <cr>"						!
		msg$ = cr							!
		bytes_w = len(msg$)						! determine the data length
		buffer_w = msg$							! xref data to buffer for qio
		rc = nsr_tcp_send(debug, ncv, buffer_w, bytes_w, "0 0:0:05.0")	! xmit with 5 second time limit
		goto rc_exit	if (rc and 7%) <> 1				!
	    case 210
		select os_type							!
		    case k_os_openvms						! OpenVMS
			msg$ = "show symbol *"					! see DCL variables
		    case k_os_solaris						! Solaris
			msg$ = "set "						! see shell variables
		    case else							!
			msg$ = ""						!
		end select							!
		print "-i-sending: "; msg$					!
		msg$ = msg$ + cr						!
		bytes_w = len(msg$)						! determine the data length
		buffer_w = msg$							! xref data to buffer for qio
		rc = nsr_tcp_send(debug, ncv, buffer_w, bytes_w, "0 0:0:05.0")	! xmit with 5 second time limit
	    case 211								! LOGOUT
		select os_type							!
		    case k_os_vanilla						! Vanilla
			msg$ = "logout"						!
		    case k_os_openVMS						! OpenVMS
			msg$ = "logoutnow"					!
		    case k_os_solaris						! Solaris
			msg$ = "exit"						!
		    case k_os_windows						!
			msg$ = "log"						! Windows
		    case else							!
			msg$ = "exit"						!
		end select							!
		print "-i-sending: "; msg$					!
		msg$ = msg$ + cr						!
		bytes_w = len(msg$)						! determine the data length
		buffer_w = msg$							! xref data to buffer for qio
		rc = nsr_tcp_send(debug, ncv, buffer_w, bytes_w, "0 0:0:05.0")	! xmit with 5 second time limit
	    case 212								!
		goto no_more_processing						!
	    case else								!
		print "-e-try:";try%;"which is a programming error"
		rc = 2
		goto rc_exit
	end select
	!
	!-----------------------------------------------------------------------
	!	read the response
	!-----------------------------------------------------------------------
	receive_data:
	print "-i-RECV-try:";try%;" ######################################<<<"	if debug > 0
4040	print "-i-receiving data"						if debug > 0
	readcount = 0								! init loop counter
	bytes_r_total = 0							!
	!
	read_loop:
	bytes_r = 0								! init
	readcount =  readcount + 1
	print "-i-receiving count:";readcount	if debug > 0			!
	print "   -------------------"		if debug > 0			!
	rc = nsr_tcp_recv(debug,ncv,buffer_r,TCPBUFSIZ,bytes_r,"0 00:00:00.9")	! receive with 900 mS time limit
	if ((rc and 7%) <> 1) then						!
	    select rc								!
		case SS$_THIRDPARTY						! (8316) -f- (third party stack libraries)
		   print "-w-status:";rc;"network partner disconnected logical link"	if debug > 0
		case SS$_LINKDISCON						! (8428) -f- (native libraries)
		   print "-w-status:";rc;"network partner disconnected logical link"	if debug > 0
		case SS$_VCCLOSED						! (8612) -w-
		   print "-w-status:";rc;"network partner closed"			if debug > 0
		case SS$_TIMEOUT						! ( 556) -f
		   print "-w-status:";rc;"operation timeout"				if debug > 0
		case else							!
		   print "-e-error:";rc;"while reading from server"		!
	    end select								!
	    goto no_more_processing						!
	end if									!
	!
	!	action states (recv)
	!	====================
	!	<=99	nothing
	!	100-199	http   handshake sequences
	!	200-299	telnet handshake sequences
	!	>=300	nothing
	!
	select try%								!
	    case <100								! this is more for information
		goto no_more_processing						!
	    case 100 to 101							! http demo sequence starts here ------
		if bytes_r > 0 then						! if any data bytes
		    print left$(buffer_r,bytes_r)				! then output that amount
		    bytes_r_total = bytes_r_total + bytes_r			! also add to total
		end if								!
		if (bytes_r > 0)				and		! if we received something			&
		   (readcount < 150) then					! and we're not too crazy
			goto read_loop		 				! then read some more
		end if								!
		print
		print "------------------------------"
		sleep 1								!
		try% = try% + 1							! 100 -> 101
		goto send_loop							!
	    case 102								! http demo sequence ends here --------
		goto no_more_processing						!
	    case 103 to 199							! unsupported
		goto no_more_processing						!
	    case 200								! telnet demo sequence starts here ----
										! waiting for login prompt
		junk% = nsr_nvt_scan(						! 						&
			debug, ncv, buffer_w, bytes_w, "0 0:0:05.0",		! same params as nsr_tcp_send()			&
			buffer_r, bytes_r, nvt_msgs)				! params to test and set
		if bytes_r > 0 then						! if any data bytes (after nvt processing)
		    print left$(buffer_r,bytes_r)				! output that amount
		    bytes_r_total = bytes_r_total + bytes_r			! also add to total
		    buffer$ = buffer$ + left$(buffer_r,bytes_r)			!
		end if								!
		if ((bytes_r + nvt_msgs) > 0)		and			! if we received something			&
		    (readcount < 150) then					! and we're not too crazy
			goto read_loop		 				! then read some more
		end if								!
		junk$ = edit$(buffer$,128+32+16+8+4)				! trailing,ucase,compress,leading
		junk% = 0							! init
		junk% = 1 if pos(junk$,"USERNAME:",1)>0				! OpenVMS-8.4
		junk% = 1 if pos(junk$,"LOGIN:"   ,1)>0				! Solaris-8
		if junk% = 1 then						!
		    print "-i-detected login prompt"				!
		    try% = try% + 1						!
		    goto send_loop						!
		else								!
		    print "-w-oops, didn't detect a login prompt"		! just exit this demo
		end if								!
	    case 201								! waiting for password prompt
		junk% = nsr_nvt_scan(						! 						&
			debug, ncv, buffer_w, bytes_w, "0 0:0:05.0",		! same params as nsr_tcp_send()			&
			buffer_r, bytes_r, nvt_msgs)				! params to test and set
		if bytes_r > 0 then						! if any data bytes (after nvt processing)
		    print left$(buffer_r,bytes_r)				! output that amount
		    bytes_r_total = bytes_r_total + bytes_r			! also add to total
		    buffer$ = buffer$ + left$(buffer_r,bytes_r)			!
		end if								!
		if ((bytes_r + nvt_msgs) > 0)		and			! if we received something			&
		    (readcount < 150) then					! and we're not too crazy
			goto read_loop		 				! then read some more
		end if								!
		junk$ = edit$(buffer$,128+32+16+8+4)				! trailing,ucase,compress,leading
		junk% = 0							! init
		junk% = 1 if pos(junk$,"PASSWORD:",1)>0				! OpenVMS-8.4 (and Solaris-8)
		if junk% = 1 then						!
		    try% = try% + 1						!
		    goto send_loop						!
		else								!
		    print "-w-oops, didn't detect a password prompt"		! just exit this demo
		end if								!
	    case 202								! waiting for login success
		junk% = nsr_nvt_scan(						! 						&
			debug, ncv, buffer_w, bytes_w, "0 0:0:05.0",		! same params as nsr_tcp_send()			&
			buffer_r, bytes_r, nvt_msgs)				! params to test and set
		if bytes_r > 0 then						! if any data bytes (after nvt processing)
		    print left$(buffer_r,bytes_r)				! output that amount
		    bytes_r_total = bytes_r_total + bytes_r			! also add to total
		    buffer$ = buffer$ + left$(buffer_r,bytes_r)			!
		end if								!
		if ((bytes_r + nvt_msgs) > 0)		and			! if we received something			&
		    (readcount < 150) then					! and we're not too crazy
			goto read_loop		 				! then read some more
		end if								!
		junk$ = edit$(buffer$,128+32+16+8+4)				! trailing,ucase,compress,leading
		junk% = 0							! init
		junk% = k_os_vanilla	if pos(junk$,"WELCOME",1)>0		!
		junk% = k_os_openvms	if pos(junk$,"LAST INTERACTIVE LOGIN ON",1)>0
		junk% = k_os_solaris	if pos(junk$,"SUN MICROSYSTEMS",1)>0	!
		junk% = k_os_solaris	if pos(junk$,"SUNOS",1)>0		!
		junk% = k_os_windows	if pos(junk$,"MICROSOFT",1)>0		!
		junk% = 9 if pos(junk$,"BAD PASSWORD",1)>0			! vanilla
		junk% = 9 if pos(junk$,"USER AUTHORIZATION FAILURE",1)>0	! OpenVMS
		junk% = 9 if pos(junk$,"LOGIN INCORRECT",1)>0			! Solaris
		select junk%							!
		    case 0, 9							!
			print "-w-oops, didn't detect login success"		! just exit this demo (fall thru)
		    case else							!
			os_type = junk%						! rememeber OS type
			try% = try% + 1						!
			goto send_loop						!
		end select							!
	    case 202 to 299							!
		junk% = nsr_nvt_scan(						! 						&
			debug, ncv, buffer_w, bytes_w, "0 0:0:05.0",		! same params as nsr_tcp_send()			&
			buffer_r, bytes_r, nvt_msgs)				! params to test and set
		if bytes_r > 0 then						! if any data bytes (after nvt processing)
		    print left$(buffer_r,bytes_r)				! output that amount
		    bytes_r_total = bytes_r_total + bytes_r			! also add to total
		    buffer$ = buffer$ + left$(buffer_r,bytes_r)			!
		end if								!
		if ((bytes_r + nvt_msgs) > 0)		and			! if we received something			&
		    (readcount < 150) then					! and we're not too crazy
			goto read_loop		 				! then read some more
		end if								!
		junk$ = edit$(buffer$,128+32+16+8+4)				! trailing,ucase,compress,leading
		junk% = 0							! init
		!
		!	various tests could go here
		!
		junk% = 1
		if junk% = 1 then						!
		    try% = try% + 1						!
		    goto send_loop						! we'll just send <cr>
		else								!
		    print "-w-oops, didn't detect login success"		! just exit this demo
		end if								!
	    case else								!
		print "-e-try:";try%;"which is a programming error"		!
		rc = 2								!
		goto rc_exit							!
	end select								!
	no_more_processing:
	!
	!	but we still may have received something so test bytes_r
	!
	print "-i-total bytes received:";bytes_r_total	if debug > 0		!
	!
	rc = nsr_tcp_clos(debug, ncv )						! close the tcp connection
	goto rc_exit	if (rc and 7%) <> 1					!
	!
	rc = nsr_tcp_free(debug, ncv )						! release all allocated resources
	goto rc_exit	if (rc and 7%) <> 1					!
	!
	goto fini								! that's all she wrote...
	!-----------------------------------------------------------------------
	!	get keyboard
	!-----------------------------------------------------------------------
	get_keyboard:
	!
	!	Interactive Input is in this block of code but...
	!	while we are here we are not paying attention to the receive stream (bad)
	!
	keyboard$ = ""							!
	when error in							!
	    if first_time = 0 then					!
		print "Note: 1) don't enter anything until you see your prompt"
		print "      2) timeout applies to keystrokes; not the time until you hit <enter>"
		sleep 1							!
		first_time = 1						! don't come back this way
	    end if							!
	    wait 2							! enable keyboard timer (2-secs)
	    print "-?-text to send (blank line to exit) ";		!
	    linput keyboard$						!
	    junk% = 0							! not a timeout
	use								!
	    junk% = err							! probably a timeout
	end when							!
	wait 0								! disable timer
	if junk% = 15 then						!
		print cr + lf + "-w- timeout"				!
	end if								!
	return

	!
	!	old-school common trap (normally you would only use inline "when error / use / end when" blocks
	!
	common_trap:
	print
	print "common error trap"						!
	print "-i-line  ";erl							!
	print "-i-error ";err							!
	print "-i-text  ";ert$(err)						!
	rc = 2									! VMS-e-
	resume rc_exit								! fix the stack
	!
	fini:
	rc = 1									! VMS-s-
	rc_exit:								!
!~~~	junk% = nsr_tcp_release
	print "-i-adios..."							!
32000	end program rc								! <<<--- return exit code to DCL
	!
	!########################################################################################################################
	!	external functions
	!########################################################################################################################
	!
	!=======================================================================================
	!	<<< nsr_adr_prep >>>
	!
	!		dest$				path$		kind		function
	! 1	input:	"142.180.221.226"
	!	exit:	"142.180.221.226"		""		1 (numeric)	ip address
	! 2	input:	"www3.sympatico.ca"
	!	exit:	"www3.sympatico.ca"		""		2 (dns)		ip address
	! 3	input:	"142.180.221.226/n.rieck/"
	!	exit:	"142.180.221.226"		"/n.rieck/"	1 (numeric)	ip address
	! 4	input:	"neilrieck.net/"
	!	exit:	"www3.sympatico.ca"		"/n.rieck/"	2 (dns)		ip address
	! 5	input:	"junk"
	!	exit:	"junk"				""		0 (crud)	0
	! 6	input:	"www.nonexistant.com"
	!	exit:	"www.nonexistant.com"		""		0 (crud)	0
	! notes:
	! 1) input kind limits http (numeric=http/1.0; dns=http/1.1)
	! 2) path is only used with port 80 (http) but not port 23 (telnet)
	! 3) should only attempt to connect if the address <> 0
	!=======================================================================================
32701	function long nsr_adr_prep(long debug, string dest$, string path$, long kind)
	option type=explicit							!
	!
	%include "TCPIP$TCP_CLIENT_QIO_2014E.INC"				!
	!
	external long function nsr_dns_ghbn(long, string, long, string, long dim() by ref, string)
	external quad function octets_to_quad(long dim() by ref)		!
	external long function qtol(quad)					!
	!
	declare quad		junk64		,	&
		long		dots		,	&
				nums		,	&
				alph		,	&
				othe		,	&
				slash_pos	,	&
				i%		,	&
				rc		,	&
				junk1		,	&
				junk2		,	&
				addr		,	&
		long		octet(3)	,	! 0-3	&
		string		ip_address$		! only used in type-1 dns lookup
	!-----------------------------------------------------------------------
	main:
	kind = 0								! init(s)
	addr = 0								!
	!
	slash_pos = pos(dest$, "/", 1)						! any slashes here?
	if slash_pos > 0 then							! yes
	    path$ = right$(dest$,slash_pos)					! do this first
	    dest$ = left$( dest$,slash_pos - 1)					!
	else									! no
	    path$ = ""								!
	end if									!
	!
	for i% = 1 to len(dest$)						! prescan the destination
	    select mid$(dest$, i%, 1)						!
		case "."							!
		    dots = dots + 1						!
		case "0" to "9"							!
		    nums = nums + 1						!
		case "a" to "z"							!
		    alph = alph + 1						!
		case else							!
		    othe = othe + 1						!
	    end select								!
	next i%									!
	!
	goto data_unusable	if othe > 0					! we can't use this data
	!-----------------------------------------------------------------------
	!	eg. "142.180.221.226"
	!-----------------------------------------------------------------------
	if dots=3 and nums>=4 and alph=0 then					! hey, might be IP4
	    kind = 1								! input=NUMERIC
	    junk1 = 0								! init for octet scan
	    for i% = 0 to 3							! sc
		junk2 = pos(dest$, ".", junk1+1)				!
		junk2 = len(dest$)+1	if junk2 = 0				!
		octet(i%) = integer(seg$(dest$,junk1+1,junk2-1))		!
		select octet(i%)						!
		    case 0 to 255						!
		    case else							!
			print "-e-error, the value of octet:";i%;"is";octet(i%);"which is not in the range of 0-255"
			goto data_unusable					!
		end select							!
		junk1 = junk2							! reference pt moves along
	    next i%								!
	    junk64 = octets_to_quad(octet())					!
	    if junk64 = 0 then							!
		print "-e-error during octets-to-quad conversion"		!
		goto data_unusable						!
	    end if								!
	    addr = qtol(junk64)							!
	    if addr = 0 then							!
		print "-e-error during quad-to-long conversion"			!
	    end if								!
	    goto function_exit							!
	end if									!
	!
	!	eg. "bell.ca" or "www3.sympatico.ca"
	!
	if dots>0 and alph>=3 then						! hey, might be a dns
	    kind = 2								! INPUT=dns
	    !
	    !	this is a type-1 dns lookup (returns string)
	    !
!~~~	    rc = nsr_dns_ghbn(debug,dest$,0%,ip_address$,,"0 0:0:05.0")		x mode 0 = return string
	    !
	    !	this is a type-2 dns lookup (returns binary)
	    !
	    rc = nsr_dns_ghbn(debug,dest$,1%,,octet(),"0 0:0:05.0")		! mode 1 = return four octets
	    if ((rc and 7%) <> 1) then						!
		print "-e-dns lookup-2 failed with status:";rc			!
		goto data_unusable						!
	    end if								!
	    junk64 = octets_to_quad( octet() )					!
	    if junk64 = 0 then							!
		print "-e-error:";err;"during data conversion"			!
		goto data_unusable						!
	    end if								!
	    goto function_exit							!
	end if									!
	!
	data_unusable:
	kind	= 0								!
	addr	= 0								!
	!
	function_exit:								!
	nsr_adr_prep = addr							!
	end function								!

	!
	!=======================================================================
	!	nsr_tcp_prep()
	!
	!	1) allocate two event flags then store them in the passed ncv
	!	2) allocate a channel then use it to connect to the stack
	!	3) use $qio to set socket characteristics
	!=======================================================================
32702	function long nsr_tcp_prep(	long	debug		,		&
					ncv_rec	ncv	by ref			)
	option type=explicit							! formal declarations required
	!
	%include "TCPIP$TCP_CLIENT_QIO_2014E.INC"				!
	!
	declare long rc								!
	!-----------------------------------------------------------------------
	!	main (of function)
	!-----------------------------------------------------------------------
	print "-i->>> enter function: nsr_tcp_prep()"	if debug > 0		!
	!
	ncv::nvt_cycle				= 0				! init
	ncv::nvt_total_msgs_received		= 0				!
	ncv::nvt_total_bytes_sent		= 0				!
	!
	!	allocate event flags (if not already allocated)
	!
	if ncv::tcp_ef = 0 then							! if not yet allocated
	    print "-i-allocating EF for tcp"	if debug > 0			!
	    rc = lib$get_EF( ncv::tcp_ef )					! allocate ef for tcp
	    if ((rc and 7%) <> 1) then						!
		print "lib$get_EF-1 rc: ";str$(rc)				!
		goto rc_exit							!
	    end if								!
	end if									!
	!
	if ncv::tmr_ef = 0 then							! if not yet allocated
	    print "-i-allocating EF for timer"	if debug > 0			!
	    rc = lib$get_EF( ncv::tmr_ef )					! allocate ef for timer
	    if ((rc and 7%) <> 1) then						!
		print "lib$get_EF-2 rc: ";str$(rc)				!
		goto rc_exit							!
	    end if								!
	end if									!
	!
	!	create socket (part 1/2)
	!
	print "-i-creating socket (assign)"	if debug > 0			!
	rc = sys$assign("TCPIP$DEVICE:", ncv::vms_channel,,)			!
	if ((rc and 7%) <> 1) then						!
	    print "-e-error:";rc;"while assigning channel to TCPIP device"	!
	    goto rc_exit							!
	end if									!
	!
	!	create socket (part 2/2)
	!
	ncv::cscb::sc$w_prot	= TCPIP$C_TCP					! init (local) connection socket
	ncv::cscb::sc$b_type	= TCPIP$C_STREAM				!
	ncv::cscb::sc$b_af	= TCPIP$C_AF_INET				!
	!
	print "-i-creating socket (qiow)" if debug > 0 				! synchronous (no point changing to async)
	rc = sys$qiow(								&
		EFN$C_ENF,			! event flag			&
		ncv::vms_channel,		! i/o channel			&
		IO$_SETMODE,			! i/o function code		&
		ncv::iosb::iosb$bqw_quad,,,	! i/o status block		&
		ncv::cscb,,,,,)			! p1 - socket characteristics
	if ((rc and 7%) = 1) then						! if the system call queued properly
	   rc = ncv::iosb::iosb$w_status					! then check the operational result
	end if									!
	if ((rc and 7%) <> 1) then						!
	    print "-e-error:";rc;"while creating socket"			!
	    goto rc_exit							!
	end if									!
	!
	rc_exit:								!
	nsr_tcp_prep = rc							!
	print "-i-<<< exit function: nsr_tcp_prep() with status:";rc if debug > 0
	end function								!
	!
	!=======================================================================
	!	nsr_tcp_open (eg. connect to the desired destination)
	!=======================================================================
32703	function long nsr_tcp_open(	long	debug		,	&
					ncv_rec	ncv		,	&
					long	ip_address	,	&
					word	tcp_port	,	&
					string	time_limit$)
	option type=explicit							! formal declarations required
	!
	%include "TCPIP$TCP_CLIENT_QIO_2014E.INC"				!
	!
	external long function htonl(long)					! host to network long
	external long function htons(word)					! host to network short
	external long function qtol(quad)					! quad to long
	external long function get_ef_bit_vector(long)				! required for used with SYS$WFLOR
	!
	declare	long		rc					,	&
				junk%					,	&
		basic$QuadWord	DeltaQuad
	!-----------------------------------------------------------------------
	!	main (of function)
	!-----------------------------------------------------------------------
	print "-i->>> enter function: nsr_tcp_open()"		if debug > 0	!
	!
	ncv::nvt_cycle				= 0				! init (perhaps this is a reopen?)
	ncv::nvt_total_msgs_received		= 0				!
	ncv::nvt_total_bytes_sent		= 0				!
	!
	rc = sys$bintim(time_limit$, DeltaQuad )				! compute delta time
	print "-e-sys$bintim rc: "+ str$(rc) if ((rc and 1%) <> 1)		! oops, didn't work
	!
	print "-i-arming timer associated with ef:";ncv::tmr_ef	if debug > 0
	rc = sys$setimr(ncv::tmr_ef, DeltaQuad by ref,,,)			! use delta to schedule a wake up
	print "-e-sys$setimr rc: "+ str$(rc) if ((rc and 1%) <> 1)		! oops, didn't work
	!
	ncv::ip_address				= ip_address			! --+-- probably not required or necessary
	ncv::tcp_port				= tcp_port			! --+
	!
	ncv::serv_addr::SIN$W_FAMILY		= TCPIP$C_AF_INET		! data fill remote connection socket
	ncv::serv_addr::SIN$W_PORT		= htons(tcp_port)		!
	ncv::serv_addr::SIN$L_ADDR		= htonl (ip_address)		! eg. 142.180.221.226
	!
	ncv::serv_itemlst::il2$w_length		= SIN$K_LENGTH			! need size of serv_addr (SOCKADDRIN)
	ncv::serv_itemlst::il2$w_type		= TCPIP$C_SOCK_NAME		!
	ncv::serv_itemlst::il2$l_address	= loc(ncv::serv_addr)		! need addr of serv_addr
	!
	print "-i-connecting to server via qio associated with ef:";ncv::tcp_ef if debug > 0
	rc = sys$qio(								! async (no wait)	&
		ncv::tcp_ef,			! event flag			&
		ncv::vms_channel,		! i/o channel			&
		IO$_ACCESS,			! i/o function code		&
		ncv::iosb::iosb$bqw_quad,,,,,	! i/o status block		&
		loc(ncv::serv_itemlst),,,)	! p3 - remote socket info
	if ((rc and 7%) <> 1) then						! if system call failed (never happens)
	    print "-e-status:";rc;"while queuing server connect"		!
	    junk% = sys$cantim(,)						! cancel timers and bail
	    goto rc_exit							!
	end if									!
	!
	! note: for the SYS$WFLOR call to work, both event flags must be in the same event flag cluster.
	!	The first parameter is only used to determine which event flag cluster to test.
	!	The second parameter (mask) contains bits representing event flags within that cluster
	!
	ncv::mask =			get_ef_bit_vector(ncv::tcp_ef)		! insert vector 1 into mask
	ncv::mask = ncv::mask or	get_ef_bit_vector(ncv::tmr_ef)		! insert vector 2 into mask
	!
	!	wait for a response from one of the two event flags
	!
	print "-i-waiting for one of two event flags"	if debug > 0
	rc = sys$wflor( ncv::tcp_ef, ncv::mask)					! wait for a response from one of two flags
	print "-e-sys$wflor rc: "+ str$(rc) if ((rc and 1%) <> 1)		! oops, didn't work
	!
	!	which event flag is set? TCP or TIMER?
	!
	rc = sys$readEF(ncv::tcp_ef, junk%)					! test TCP event flag
	select rc								!
	    case SS$_WASCLR							!
		ncv::tcp_ef_state = 0						!
	    case SS$_WASSET							!
		print "-i-tcp ef was set"	if debug > 0			!
		ncv::tcp_ef_state = 1						!
	    case else								!
		print "-e-sys$readef-tcp rc: "+ str$(rc)			!
	end select								!
	!
	rc = sys$readEF(ncv::tmr_ef, junk%)					! test TIMER event flag
	select rc								!
	    case SS$_WASCLR							!
		ncv::tmr_ef_state = 0						!
	    case SS$_WASSET							!
		print "-w-timer ef was set (oops)"	if debug > 0		!
		ncv::tmr_ef_state = 1						!
	    case else								!
		print "-e-sys$readef-timer rc: "+ str$(rc)			!
	end select								!
	!
	if (ncv::tcp_ef_state = 1) then						! tcp fired so cancel timer
	    junk% = sys$cantim(,)						!
	end if									!
	!
	if (ncv::tmr_ef_state = 1)	then					! timer fired so cancel i/o
!~~~	    print "-e-did not open in time"		if debug > 0		!
	    print "-e-did not open in time"					!
	    junk% = sys$cancel(ncv::vms_channel)				!
	    rc = SS$_TIMEOUT							! vms-e-
	    goto rc_exit							!
	end if									!
	!
	!	At this point the qio has completed. so test operational status (iosb)
	!
	rc = ncv::iosb::iosb$w_status						! test the operational status
	if ((rc and 7%) <> 1) then						!
	    print "-e-error:";rc;"while connecting to server"			!
	    goto rc_exit							!
	else									!
	    print "-i-connection established"		if debug > 0		!
	end if									!
	!
	rc_exit:								!
	nsr_tcp_open = rc							!
	print "-i-<<< exit function: nsr_tcp_open() with status:";rc if debug > 0
	end function								!
	!=======================================================================
	!	nsr_tcp_send
	!=======================================================================
32704	function long nsr_tcp_send(	long	debug		,	&
					ncv_rec	ncv		,	&
					string	buffer_w	,	&
					long	bytes_w		,	&
					string	time_limit$)
	option type=explicit							! formal declarations required
	!
	%include "TCPIP$TCP_CLIENT_QIO_2014E.INC"				!
	!
	declare	long		rc					,	&
				junk%					,	&
		basic$QuadWord	DeltaQuad
	!-----------------------------------------------------------------------
	!	main (of function)
	!-----------------------------------------------------------------------
	print "-i->>> enter function: nsr_tcp_send()"		if debug > 0	!
	!
	rc = sys$bintim(time_limit$, DeltaQuad )				! compute delta time
	print "-e-sys$bintim rc: "+ str$(rc) if ((rc and 1%) <> 1)		! oops, didn't work
	!
	print "-i-arming timer associated with ef:";ncv::tmr_ef	if debug > 0
	rc = sys$setimr(ncv::tmr_ef, DeltaQuad by ref,,,)			! use delta to schedule a wake up
	print "-e-sys$setimr rc: "+ str$(rc) if ((rc and 1%) <> 1)		! oops, didn't work
	!
	print "-i-queuing i/o write associated with ef:";ncv::tcp_ef if debug > 0
	rc = sys$qio(								&
		ncv::tcp_ef,			! event flag			&
		ncv::vms_channel,		! i/o channel			&
		IO$_WRITEVBLK,			! i/o function code		&
		ncv::iosb::iosb$bqw_quad,,,	! i/o status block		&
		buffer_w,			! p1 buffer address		&
		bytes_w,,,,)			! p2 buffer length (to send)
	if ((rc and 7%) <> 1) then						! if system call failed (never happens)
	    print "-e-status:";rc;"while queuing writing to server"
	    junk% = sys$cantim(,)						! cancel timers and bail
	    goto rc_exit							!
	end if									!
	!
	! note: for the SYS$WFLOR call to work, both event flags must be in the same event flag cluster.
	!	The first parameter is only used to determine which event flag cluster to test.
	!	The second parameter (mask) contains bits representing event flags within that cluster
	!
	ncv::mask =			get_ef_bit_vector(ncv::tcp_ef)		! insert vector 1 into mask
	ncv::mask = ncv::mask or	get_ef_bit_vector(ncv::tmr_ef)		! insert vector 2 into mask
	!
	!	wait for a response from one of the two event flags
	!
	print "-i-waiting for one of two event flags"	if debug > 0
	rc = sys$wflor( ncv::tcp_ef, ncv::mask)					! wait for a response from one of two flags
	print "-e-sys$wflor rc: "+ str$(rc) if ((rc and 1%) <> 1)		! oops, didn't work
	!
	!	which event flag is set? TCP or TIMER?
	!
	rc = sys$readEF(ncv::tcp_ef, junk%)					! test TCP event flag
	select rc								!
	    case SS$_WASCLR							!
		ncv::tcp_ef_state = 0						!
	    case SS$_WASSET							!
		print "-i-tcp ef was set"	if debug > 0			!
		ncv::tcp_ef_state = 1						!
	    case else								!
		print "-e-sys$readef-tcp rc: "+ str$(rc)			!
	end select								!
	!
	rc = sys$readEF(ncv::tmr_ef, junk%)					! test TIMER event flag
	select rc								!
	    case SS$_WASCLR							!
		ncv::tmr_ef_state = 0						!
	    case SS$_WASSET							!
		print "-w-timer ef was set (oops)"	if debug > 0		!
		ncv::tmr_ef_state = 1						!
	    case else								!
		print "-e-sys$readef-timer rc: "+ str$(rc)			!
	end select								!
	!
	if (ncv::tcp_ef_state = 1) then						! tcp fired so cancel timer
	    junk% = sys$cantim(,)						!
	end if									!
	!
	if (ncv::tmr_ef_state = 1)	then					! timer fired so cancel i/o
	    print "-e-did not send in time"		if debug > 0		!
	    junk% = sys$cancel(ncv::vms_channel)				!
	    rc = 2								! vms-e-
	    goto rc_exit							!
	end if									!
	!
	!	At this point the qio has completed. so test operational status (iosb)
	!
	rc = ncv::iosb::iosb$w_status						! test the operational status
	if ((rc and 7%) <> 1) then						!
	    print "-e-error:";rc;"while sending to server"			!
	    goto rc_exit							!
	else									!
	    print "-i-message sent"				if debug > 0	!
	end if									!
	!
	rc_exit:								!
	nsr_tcp_send = rc							!
	print "-i-<<< exit function: nsr_tcp_send() with status:";rc if debug > 0
	end function								!

	!=======================================================================
	!	nsr_tcp_recv
	!=======================================================================
32705	function long nsr_tcp_recv(	long	debug		,	&
					ncv_rec	ncv		,	&
					string	buffer_r	,	&
					long	max_recv_size	,	&
					long	bytes_r		,	&
					string	time_limit$)
	option type=explicit							! formal declarations required
	!
	%include "TCPIP$TCP_CLIENT_QIO_2014E.INC"				!
	!
	declare	long		rc					,	&
				junk%					,	&
		basic$QuadWord	DeltaQuad
	!-----------------------------------------------------------------------
	!	main (of function)
	!-----------------------------------------------------------------------
	print "-i->>> enter function: nsr_tcp_recv()"		if debug > 0	!
	bytes_r = 0								! init
	!
	rc = sys$bintim(time_limit$, DeltaQuad )				! compute delta time
	print "-e-sys$bintim rc: "+ str$(rc) if ((rc and 1%) <> 1)		! oops, didn't work
	!
	print "-i-arming timer associated with ef:";ncv::tmr_ef	if debug > 0
	rc = sys$setimr(ncv::tmr_ef, DeltaQuad by ref,,,)			! use delta to schedule a wake up
	print "-e-sys$setimr rc: "+ str$(rc) if ((rc and 1%) <> 1)		! oops, didn't work
	!
	print "-i-queuing i/o read associated with ef:";ncv::tcp_ef if debug > 0
	rc = sys$qio(								&
		ncv::tcp_ef,			! event flag			&
		ncv::vms_channel,		! i/o channel			&
		IO$_READVBLK,			! i/o function code		&
		ncv::iosb::iosb$bqw_quad,,,	! i/o status block		&
		buffer_r,			! p1 buffer address		&
		max_recv_size,,,,)		! p2 buffer length (max space)
	if ((rc and 7%) <> 1) then						! if system call failed (never happens)
	    print "-e-status:";rc;"while queuing writing to server"		!
	    junk% = sys$cantim(,)						! cancel timers and bail
	    goto rc_exit							!
	end if									!
	!
	! note: for the SYS$WFLOR call to work, both event flags must be in the same event flag cluster.
	!	The first parameter is only used to determine which event flag cluster to test.
	!	The second parameter (mask) contains bits representing event flags within that cluster
	!
	ncv::mask =			get_ef_bit_vector(ncv::tcp_ef)		! insert vector 1 into mask
	ncv::mask = ncv::mask or	get_ef_bit_vector(ncv::tmr_ef)		! insert vector 2 into mask
	!
	!	wait for a response from one of the two event flags
	!
	print "-i-waiting for one of two event flags"	if debug > 0
	rc = sys$wflor( ncv::tcp_ef, ncv::mask)					! wait for a response from one of two flags
	print "-e-sys$wflor rc: "+ str$(rc) if ((rc and 1%) <> 1)		! oops, didn't work
	!
	!	which event flag is set? TCP or TIMER?
	!
	rc = sys$readEF(ncv::tcp_ef, junk%)					! test TCP event flag
	select rc								!
	    case SS$_WASCLR							!
		ncv::tcp_ef_state = 0						!
	    case SS$_WASSET							!
		print "-i-tcp ef was set"	if debug > 0			!
		ncv::tcp_ef_state = 1						!
	    case else								!
		print "-e-sys$readef-tcp rc: "+ str$(rc)			!
	end select								!
	!
	rc = sys$readEF(ncv::tmr_ef, junk%)					! test TIMER event flag
	select rc								!
	    case SS$_WASCLR							!
		ncv::tmr_ef_state = 0						!
	    case SS$_WASSET							!
		print "-w-timer ef was set (oops)"	if debug > 0		!
		ncv::tmr_ef_state = 1						!
	    case else								!
		print "-e-sys$readef-timer rc: "+ str$(rc)			!
	end select								!
	!
	if (ncv::tcp_ef_state = 1) then						! tcp fired so cancel timer
	    junk% = sys$cantim(,)						!
	end if									!
	!
	if (ncv::tmr_ef_state = 1)	then					! timer fired so cancel i/o
	    print "-e-did not recv in time"		if debug > 0		!
	    junk% = sys$cancel(ncv::vms_channel)				!
!~~~	    rc = 2								x vms-e-
	    rc = 8 + 1								! vms-w-
	    goto rc_exit							!
	end if									!
	!
	!	At this point the qio has completed so test operational status (iosb)
	!
	rc = ncv::iosb::iosb$w_status						! test the operational status
	if ((rc and 7%) = 1) then						!
	    print "-i-received:";ncv::iosb::iosb$w_bcnt;"characters"	if debug > 0
	    bytes_r = ncv::iosb::iosb$w_bcnt					!
	else									! oops
	    bytes_r = 0								! first off, signal crud data in buffer
	    select rc								!
		case SS$_THIRDPARTY						! (8316) -f- (third party stack libraries)
		   print "-w-status:";rc;"network partner disconnected logical link"
		case SS$_LINKDISCON						! (8428) -f- (native libraries)
		   print "-w-status:";rc;"network partner disconnected logical link"
		case SS$_VCCLOSED						! (8612) -w-
		   print "-w-status:";rc;"network partner closed"		!
		case SS$_TIMEOUT						! ( 556) -f
		   print "-w-status:";rc;"timeout"				!
		case else							!
		   print "-e-error:";rc;"while reading from server"		!
	    end select								!
	end if									!
	!
	rc_exit:								!
	nsr_tcp_recv = rc							!
	print "-i-<<< exit function: nsr_tcp_recv() with status:";rc if debug > 0
	end function								!

	!=======================================================================
	!	nsr_tcp_clos()
	!=======================================================================
32706	function long nsr_tcp_clos(	long	debug,				&
					ncv_rec	ncv				)
	option type=explicit							! formal declarations required
	!
	%include "TCPIP$TCP_CLIENT_QIO_2014E.INC"				!
	!
	declare long rc								!
	!-----------------------------------------------------------------------
	!	main (of function)
	!-----------------------------------------------------------------------
	print "-i->>> enter function: nsr_tcp_clos()"	if debug > 0		!
	!
	!	socket shutdown (really means "drop internet connection")
	!
	print "-i-shutting down the socket (connection close)"	if debug > 0	! no point changing to async
	rc = sys$qiow(								&
		EFN$C_ENF,			! event flag			&
		ncv::vms_channel,		! i/o channel			&
		IO$_DEACCESS or IO$M_SHUTDOWN,	! i/o function code		&
		ncv::iosb::iosb$bqw_quad,,,,,,	! i/o status block		&
		TCPIP$C_DSC_ALL,,)		! p5
	if ((rc and 7%) <> 1) then						!
	    print "-e-error:";rc;"during socket shutdown(1)"			!
	else									!
	    rc = ncv::iosb::iosb$w_status					! check the operational result
	    if ((rc and 7%) <> 1) then						!
		print "-w-error:";rc;"during socket shutdown(2)"		!
	    end if								!
	end if									!
	!
	rc_exit:								!
	nsr_tcp_clos = rc							!
	print "-i-<<< exit function: nsr_tcp_clos() with status:";rc if debug > 0
	end function								!

	!=======================================================================
	!	nsr_tcp_free()
	!=======================================================================
32707	function long nsr_tcp_free(	long	debug,				&
					ncv_rec	ncv				)
	option type=explicit							! formal declarations required
	!
	%include "TCPIP$TCP_CLIENT_QIO_2014E.INC"				!
	!
	declare long rc, junk%							!
	!-----------------------------------------------------------------------
	!	main (of function)
	!-----------------------------------------------------------------------
	print "-i->>> enter function: nsr_tcp_free()"	if debug > 0		!
	!
  %let %paranoid=0								! disabled
  %if  %paranoid=1 %then							!
	!
	!	close the socket (this is a paranoid close so write to junk%)
	!
	print "-i-closing the socket"						! no point changing to async
	junk% = sys$qiow(							&
		EFN$C_ENF,			! event flag			&
		ncv::vms_channel,		! i/o channel			&
		IO$_DEACCESS,			! i/o function code		&
		ncv::iosb::iosb$bqw_quad,	! i/o status block		&
		,,,,,,,)			!
	if ((junk% and 7%) <> 1) then						!
	    print "-e-error:";junk%;"during socket shutdown(1)"			!
	else									!
	    junk% = ncv::iosb::iosb$w_status					! check the operational result
	    if ((junk% and 7%) <> 1) then					!
		print "-w-error:";junk%;"during socket shutdown(2)"		!
	    end if								!
	end if									!
    %end %if									!
	!
	!	deassign the socket
	!
	rc = sys$dassgn(ncv::vms_channel)					!
	if ((rc and 7%) <> 1) then						!
	   print "-e-error:";rc;"during deassign"				!
	end if									!
	!
	!	release allocated event flags
	!
	if ncv::tcp_ef <> 0 then						! if allocated
	    junk% = lib$free_EF( ncv::tcp_ef )					! deallocate an event flag
	    ncv::tcp_ef = 0							! mark it released
	end if									!
	!
	if ncv::tmr_ef <> 0 then						! if allocated
	    junk% = lib$free_EF( ncv::tmr_ef )					! deallocate an event flag
	    ncv::tmr_ef = 0							! mark it released
	end if									!
	!
	rc_exit:								!
	nsr_tcp_free = rc							!
	print "-i-<<< exit function: nsr_tcp_free() with status:";rc if debug > 0
	end function								!

	!
	!=======================================================================
	!	nsr_dns_prep()
	!
	!	1) allocate two event flags then store them in the passed ncv
	!	2) allocate a channel then use it to connect to the stack
	!=======================================================================
32708	function long nsr_dns_prep(	long	debug,				&
					ncv_rec	ncv				)
	option type=explicit							! formal declarations required
	!
	%include "TCPIP$TCP_CLIENT_QIO_2014E.INC"				!
	!
	declare long rc								!
	!-----------------------------------------------------------------------
	!	main (of function)
	!-----------------------------------------------------------------------
	print "-i->>> enter function: nsr_dns_prep()"	if debug > 0		!
	!
	!	allocate event flags (if not already allocated)
	!
	if ncv::tcp_ef = 0 then							! if not yet allocated
	    print "-i-allocating EF for tcp"	if debug > 0			!
	    rc = lib$get_EF( ncv::tcp_ef )					! allocate ef for tcp
	    if ((rc and 7%) <> 1) then						!
		print "lib$get_EF-1 rc: ";str$(rc)				!
		goto rc_exit							!
	    end if								!
	end if									!
	!
	if ncv::tmr_ef = 0 then							! if not yet allocated
	    print "-i-allocating EF for timer"	if debug > 0			!
	    rc = lib$get_EF( ncv::tmr_ef )					! allocate ef for timer
	    if ((rc and 7%) <> 1) then						!
		print "lib$get_EF-2 rc: ";str$(rc)				!
		goto rc_exit							!
	    end if								!
	end if									!
	!
	!	open channel to stack (we don't go to the net, the resolver does)
	!
	print "-i-opening channel to the stack (assign)"	if debug > 0	!
	rc = sys$assign("TCPIP$DEVICE:", ncv::vms_channel,,)			!
	if ((rc and 7%) <> 1) then						!
	    print "-e-error:";rc;"while assigning channel to TCPIP device"	!
	    goto rc_exit							!
	end if									!
	!
	rc_exit:								!
	nsr_dns_prep = rc							!
	print "-i-<<< exit function: nsr_dns_prep() with status:";rc if debug > 0
	end function								!

	!=======================================================================
	! <<< nsr get-host-by-name (in VMS-BASIC) >>>
	!
	! author : Neil Rieck
	! created: 2014-08-04
	! notes  : derived from my demo: GET_HOST_BY_NAME_QIO.BAS
	! entry  : dns_name$	: desired fully qualified domain name
	!	   output_mode  : 0 = string, 1 = array of longs
	! exit   : octets array	: filled with 4 entries
	!=======================================================================
32709	function long nsr_dns_ghbn(	long	debug,			&
					string	dns_name$,		&
					long	output_mode,		&
					string	ip_address$,		&
					long	octets() by ref,	&
					string	time_limit$		)
	option type=explicit							! formal declarations required
	!
	%include "TCPIP$TCP_CLIENT_QIO_2014E.INC"				!
	!
	external long function nsr_dns_prep(long, ncv_rec )
	external long function nsr_tcp_clos(long, ncv_rec )
	external long function nsr_tcp_free(long, ncv_rec )
	!
	!	<<< variable declarations >>>
	!
	declare long		rc			,			! return code				&
				junk%			,			!					&
				ptr%			,			!					&
				i%			,			!					&
				j%			,			!					&
				timeout_count%		,			!					&
		basic$QuadWord	DeltaQuad		,			!					&
		word		bytecnt			,			!					&
		long		command			,			! INET command				&
		HostEntDef	myHostEnt		,			! see: sys$library:tcpip$inetdef.bas	&
		NetEntDef	myNetEnt		,			! see: sys$library:tcpip$inetdef.bas	&
		string		buffer$			,			!					&
				junk$			,			!					&
		ncv_rec		ncv						! nsr connection variables
	!-----------------------------------------------------------------------
	!	function main
	!-----------------------------------------------------------------------
	main:									!
	print "-i->>> enter function: nsr_dns_ghbn()"	if debug > 0		!
	!
	rc = nsr_dns_prep(debug, ncv)						! get event flags; connect to stack
	if ((rc and 7%) <> 1) then						!
	    print "-e-nsr_dns_prep rc: ";str$(rc)				!
	    goto rc_exit							!
	end if									!
	!
	command = inetacp_func$c_gethostbyname					! function:	gethostbyname
	if output_mode <> 0 then						! if array of longs
	    command = command or (inetacp$c_trans * 256%)			! sub-func:     binary address
	end if									!
	!
	!	we need a "long descriptor" to use io$_acpcontrol to call sys$qio
	!	(I wonder which bozo decided to use a descriptor to pass a long integer?)
	!
	declare dscdef1 cmd_descriptor						!
	cmd_descriptor::DSC$W_MAXSTRLEN	= 4					! 4 bytes = long
	cmd_descriptor::DSC$B_DTYPE	= DSC$K_DTYPE_DSC			! general descriptor
	cmd_descriptor::DSC$B_CLASS	= DSC$K_CLASS_S				! static
	cmd_descriptor::DSC$A_POINTER	= loc(command)				! yup, address of a long integer
	!
	!	pre-extend the buffer to accomodate the expected data
	!	note: IPv6 is coming soon so start thinking about it now)
	!
	if output_mode = 0 then							! string
	    !
	    !	142.180.221.226 (32-bits in octal)
	    !
!~~~	    buffer$ = space$((4*3)+3)						x space for 15 characters (IPv4)
	    !
	    !	abcd:abcd:abcd:abcd:abcd:abcd:abcd:abcd (128-bits in hex)
	    !
	    buffer$ = space$((8*4)+7)						! space for 39 characters (IPv6)
	    !
	else									! array of longs
!~~~	    buffer$ = space$( 32/ 8)						x space for  4 octal bytes (IPv4)
	    buffer$ = space$(128/ 8)						! space for 16 hex   bytes (IPv6)
	end if									!
	!
	!-----------------------------------------------------------------------
	!	perform a dns lookup asynchonously (guarenteed no-hang)
	!
	!	1. arm a 10-second timer
	!	2. enque the tcp operation
	!	3. wait for what whichever flag is rasied first
	!-----------------------------------------------------------------------
	rc = sys$bintim(time_limit$, DeltaQuad )				! compute delta time
	print "-e-sys$bintim rc: "+ str$(rc) if ((rc and 1%) <> 1)		! oops, didn't work
	!
	print "-i-arming timer associated with ef:";ncv::tmr_ef	if debug > 0	!
	rc = sys$setimr(ncv::tmr_ef, DeltaQuad by ref,,,)			! use delta to schedule a wake up
	print "-e-sys$setimr rc: "+ str$(rc) if ((rc and 1%) <> 1)		! oops, didn't work
	!
	!	note: here, we are not going out on the internet. We are calling io$_acpcontrol to request a
	!	connection to the BIND resolver (which may go to the internet after checking the local HOST file
	!	and recent caches)
	!
	print "-i-queuing dns lookup associated with ef:";ncv::tcp_ef	if debug > 0
	rc = sys$qio(								! sync (wait)				&
		ncv::tcp_ef			,				! Event flag				&
		ncv::vms_channel		,				! Channel number			&
		io$_acpcontrol			,				! I/O function				&
		ncv::iosb::iosb$bqw_quad	,,,				! I/O status block			&
		cmd_descriptor			,				! P1 needs to be a descriptor		&
		loc(dns_name$	)		,				! P2					&
		loc(bytecnt	)		, 				! P3					&
		loc(buffer$	)		,,)				! P4
	!
	!	once working properly, this little stub will never fire (but keep it around for future program changes)
	!
	if ((rc and 7%) <> 1) then 						! if system call failed
	    print "-e-status:";rc;"during qio in dns lookup"			!
	    junk% = sys$cantim(,)						!
	    goto shutdown							!
	end if									!
	!
	ncv::mask =			get_ef_bit_vector(ncv::tcp_ef)		! insert vector 1 into mask
	ncv::mask = ncv::mask or	get_ef_bit_vector(ncv::tmr_ef)		! insert vector 2 into mask
	!
	!	wait for a response from one of the two event flags
	!
	print "-i-waiting for one of two event flags"	if debug > 0
	rc = sys$wflor( ncv::tcp_ef, ncv::mask)					! wait for a response from one of two flags
	print "-e-sys$wflor rc: "+ str$(rc) if ((rc and 1%) <> 1)		! oops, didn't work
	!
	!	which event flag is set? TCP or TIMER?
	!
	rc = sys$readEF(ncv::tcp_ef, junk%)					! test TCP event flag
	select rc								!
	    case SS$_WASCLR							!
		ncv::tcp_ef_state = 0						!
		junk% = sys$cancel(ncv::vms_channel)				!
		print "-e-sys$cancel junk%: "+ str$(junk%) if ((junk% and 1%) <> 1)
	    case SS$_WASSET							!
		print "-i-tcp ef was set (good)"	if debug > 0		!
		ncv::tcp_ef_state = 1						!
	    case else								!
		print "-e-sys$readef-tcp rc: "+ str$(rc)			!
	end select								!
	!
	rc = sys$readEF(ncv::tmr_ef, junk%)					! test TIMER event flag
	select rc								!
	    case SS$_WASCLR							!
		ncv::tmr_ef_state = 0						!
		junk% = sys$cantim(,)						!
		print "-e-sys$cantim junk%: "+ str$(junk%) if ((junk% and 1%) <> 1)
	    case SS$_WASSET							!
		print "-w-timer ef was set (oops)"	if debug > 0
		ncv::tmr_ef_state = 1						!
	    case else								!
		print "-e-sys$readef-timer rc: "+ str$(rc)			!
	end select								!
	!
	if (ncv::tcp_ef_state = 1) then						! tcp fired so cancel timer
	    junk% = sys$cantim(,)						!
	end if									!
	!
	if (ncv::tmr_ef_state = 1) then						! timer fired so cancel i/o
	    print "-e-DNS lookup timed out"					!
	    junk% = sys$cancel(ncv::vms_channel)				!
	    rc = 2								! vms-e-
	    goto shutdown							!
	end if									!
	!
	!	At this point the qio has completed so test the operational status (iosb)
	!	Note: the iosb is not the same as what we normally see in VMS
	!		eg. status=2160 (EOF) could mean either one of:
	!			"not enough buffer space to store result"
	!			"dns lookup failed"
	!
	rc = ncv::iosb::iosb$w_status						!
!~~~	print "-i-iosb-iosb$w_status:"; str$(rc)
	if ((rc and 7%) = 1) then						!
	    if bytecnt = 0 then							!
		print "-w-no DNS data returned"					!
		rc = 2								! vms-error
	    else								!
		if output_mode = 0 then						! string
		    ip_address$ = left$(buffer$,bytecnt)			!
		else								!
		    for i% = 1 to bytecnt					! remember: we are "little endian"
!~~~			print "-i-octet"+str$(i%)+": "; asc(mid$(buffer$,i%,1))	!
			octets(i%-1) = asc(mid$(buffer$,i%,1))			! xfer binary bytes
		    next i%							!
		end if								!
	    end if								!
	else									!
	    print "-e-rc:";rc							!
	    print "-e-Failed to do the DNS lookup"				!
	end if									!
	!
	!	do not change rc after this point; use junk%
	!
	shutdown:								!
	cleanup:								!
	junk% = nsr_tcp_free(debug,ncv)						!
	if ((junk% and 1%) <> 1) then						!
	    print "-e-nsr_tcp_free rc:";rc					!
	end if									!
	!
	!	rc must be set up before this point
	!
	rc_exit:								!
	nsr_dns_ghbn = rc							! rc is returned to caller
	print "-i-<<< exit nsr_dns_ghbn() with status:";rc if debug > 0		!
	end function								!
	!

	!=======================================================================
	!	nsr_nvt_scan
	!=======================================================================
	! notes (one):
	! 1) telent sessions begin with a NVT handshake (see: rfc-854 to rfc-859)
	! 2) test for NVT chracter IAC (Interpet As Command)
	! 3) the next character will be one of WILL WONT DO DONT (or SB)
	! 4) if receiving WILL (offering) then reply with DO   (yes) or DONT (no)
	! 5) if receiving DO (requesting) then reply with WILL (yes) or WONT (no)
	! 6) you must agree to support DO TERM_TYPE to connect to Solaris
	! 7) then next msg might be:       IAC SB TT x01 IAC SE       (where: x01 = SEND)
	! 8) you reply with somthing like: IAC SB TT x00 VT100 IAC SE (where: x00 = IS)
	! 9) a quick scan of the RFCs indicates "WONT must be acked with DONT" and "DONT must be acked with WONT"
	!    but check out this a weird condition after connecting to Solaris-8 on port 23:
	!	a) solaris sends DO   whatever
	!	b) we reply with WONT whatever
	!	c) solaris acks with DONT whatever (note that OpenVMS stacks don't do this)
	!	d) should we re-respond with WONT whatever ? (beginning a potential handshake storm?)
	!    We could write some elaborate code to deal with this -OR- assume that the RFCs are wrong about acking WONT + DONT
	!
32710	function long nsr_nvt_scan(	long	debug		,		! common use		&
					ncv_rec	ncv		,		! common use		&
					string	buffer_w	,		! used if we send	&
					long	bytes_w		,		!	''		&
					string	time_limit$	,		!	''		&
					string	buffer_r	,		! used for scan		&
					long	bytes_r		,		!	''		&
					long	nvt_msgs			! use for exit		&
					)
	option type=explicit							! formal declarations required
	!
	%include "TCPIP$TCP_CLIENT_QIO_2014E.INC"				!
	%include "nvt_definitions.inc"						! IAC, WILL, WONT, DO, DONT
    %let %ack_wont_dont = 0							! disabled. (see note-9 above)		bf_106.4
	!
	external long function nsr_tcp_send(long, ncv_rec, string, long, string	)
	!
	declare	long		rc					,	&
				junk%					,	&
				i					,	&
				j					,	&
		string		q					,	&
				r					,	&
				s					,	&
				buf$					,	&
				out$					,	&
		basic$QuadWord	DeltaQuad					!
	!-----------------------------------------------------------------------
	!	main (of function)
	!-----------------------------------------------------------------------
	print "-i->>> enter function: nsr_nvt_scan()"		if debug > 0	!
	nvt_msgs = 0								! always zap this
	!
	if ncv::tcp_port <> 23 then						! if not telnet
	    print "-w-nvt scan only allowed on port 23"		if debug > 0	!
	    rc = 1								! VMS-s-
	    goto rc_exit							! then exit now
	end if									!
	!
	if bytes_r = 0 then							! if no data
	    rc = 1								! VMS-s- (just quietly exit)
	    goto rc_exit							!
	end if									!
	!-----------------------------------------------------------------------
	!
	!	scan the buffer_r looking for NVT sequeneces (see: rfc-854)
	!	1) IAC IAC				becomes one IAC (copy it to buf$)
	!	2) IAC WILL ECHO			process NVT (do not copy to buf$)
	!	3) IAC SB .. .. .. IAC SE		process NVT (do not copy to buf$)
	!	4) all else				copy to buf$
	!
	for i = 1 to bytes_r							! scan
	    q = mid$(buffer_r,i,1)						! extract
	    select asc(q)							! convert to ascii
		case kIAC							! I/nterpret A/s C/ommand
		    r = mid$(buffer_r, i+1, 1)					! verb (eg. DO)
		    s = mid$(buffer_r, i+2, 1)					! noun (eg. TERM_TYPE)
		    select asc(r)						!
			case kWILL						! server offers to ...
			    print "-i-NVT recv: WILL";asc(s)	if debug > 0	!
			    i = i + 2						! advance pointer by two
			    select asc(s)					!
				case kSGA					! server wants to supress go-ahead
				    out$ = out$ + chr$(kIAC) + chr$(kDO  ) + s	! ack his offer with DO
				!   will_do_sga = 1				x for future book-keeping
				case kECHO					!
				    out$ = out$ + chr$(kIAC) + chr$(kDO  ) + s	! ack his offer with DO
				case else					!
				    out$ = out$ + chr$(kIAC) + chr$(kDONT) + s	! do let him do anything else
			    end select						!
			    nvt_msgs = nvt_msgs + 1				! show us processing a message
			case kDO						! server requests ...
			    print "-i-NVT recv: DO";asc(s)	if debug > 0	!
			    i = i + 2						!
			    select asc(s)					!
				case kSGA					!
				    out$ = out$ + chr$(kIAC) + chr$(kWILL) + s	!
				!   do_will_sga = 1				x for future book-keeping
				case kTERM_TYPE					!
				    out$ = out$ + chr$(kIAC) + chr$(kWILL) + s	!
				case else					!
				    out$ = out$ + chr$(kIAC) + chr$(kWONT) + s	!
			    end select						!
			    nvt_msgs = nvt_msgs + 1				!
			case kWONT						!
			    print "-i-NVT recv: WONT";asc(s)	if debug > 0	!
			    i = i + 2						!
    %if %ack_wont_dont = 0 %then						!
			    print "-i-NVT skip: not sending DONT";asc(s)    if debug > 0
    %else
			    out$ = out$ + chr$(kIAC) + chr$(kDONT) + s		! ack WONT with DONT
    %end %if
			    nvt_msgs = nvt_msgs + 1				!
			case kDONT						!
			    print "-i-NVT recv: DONT";asc(s)	if debug > 0	!
			    i = i + 2						!
    %if %ack_wont_dont = 0 %then						!
			    print "-i-NVT skip: not sending DONT";asc(s)    if debug > 0
    %else
			    out$ = out$ + chr$(kIAC) + chr$(kWONT) + s		! ack the DONT with WONT
    %end %if
			    nvt_msgs = nvt_msgs + 1				!
			case kSB						! yep, SUB command
			    print "-i-NVT recv: SbCmd";asc(s)			!
			    junk% = pos(buffer_r,chr$(kSE),i)			! locate end-of-sequence
			    if	(junk% = 0	)	or			! if not found	&
				(junk% > bytes_r)	then			! or junk in buffer
				print "-e-oops, could not find NVT-IAC-SE"	!
				buf$ = buf$ + q					! just copy
			    else						!
				select asc(s)					!
				    case kTERM_TYPE				!
					out$ = out$ + chr$(kIAC) + chr$(kSB) +	&
						chr$(kTERM_TYPE)	+	&
						chr$(kIS) + "VT100"	+	&
						chr$(kIAC) + chr$(kSE)		!
					i = junk%				! bigger jump
				    case else					!
					print "-w-not responding to unsupported verb:";asc(s)
					buf$ = buf$ + q				!
				end select					!
			    end if						!
			    nvt_msgs = nvt_msgs + 1				!
			case kIAC						! two IACs means one escapes the next
			    print "-i-NVT recv: two IAC"    if debug > 0	!	(should be very rare)
			    buf$ = buf$ + q					! so tack one onto the temp buffer
			    i = i + 1						! advance pointer by one
			    nvt_msgs = nvt_msgs + 1				!
			case kGA						! GA is only used in half-duplex (plus,
			    print "-i-NVT recv: GA (discarded)"	if debug > 0	!	we should have supressed it)
			    i = i + 1						! advance pointer by one
			    nvt_msgs = nvt_msgs + 1				!
			case kNOP						! No operation
			    print "-i-NVT recv: NOP (discarded)" if debug > 0	!
			    i = i + 1						! advance pointer by one
			    nvt_msgs = nvt_msgs + 1				!
			case else						!
			    print "-i-NVT-recv-??";asc(r);" ";asc(s)		! this should never happen
		    end select							!
		case else							!
		    buf$ = buf$ + q						! just copy
	    end select								!
	next i									!
	!
	!	perform a little bookeeping
	!
	if nvt_msgs > 0 then							!
	    ncv::nvt_cycle = ncv::nvt_cycle + 1					!
	    ncv::nvt_total_msgs_received = ncv::nvt_total_msgs_received + nvt_msgs
	    ncv::nvt_total_bytes_sent = ncv::nvt_total_bytes_sent + len(out$)	!
	end if									!
	!
	if out$ <> "" then							! if we have somthing to send
	    buffer_w = out$							!
	    bytes_w = len(out$)							!
	    if debug > 0 then
		print "-i-sending";bytes_w;"byte nvt handshake"
		print "-i-nvt data out: ";
		for i = 1 to len(out$)						! scan outbound string
		    q = mid$(out$,i,1)
		    select asc(q)
			case kIAC
			    print "IAC ";
			case kWILL
			    print "WILL ";
			case kWONT
			    print "WONT ";
			case kDO
			    print "DO ";
			case kDONT
			    print "DONT ";
			case kSB
			    print "SB ";
			case kSE
			    print "SE ";
			case else
			    print str$(asc(q));" ";
		    end select
		next i
		print								! EOL
	    end if
	    rc = nsr_tcp_send(debug, ncv, buffer_w, bytes_w, "0 0:0:05.0")	! xmit with 5 second time limit
	    if (rc and 7%) <> 1 then						!
		print "-e-NVT send error:";rc					!
	    end if								!
	end if									!
	!
	buffer_r = buf$								! update the read buffer
	bytes_r  = len(buf$)							! update the count
	rc = 1									!
	!
	rc_exit:								!
	nsr_nvt_scan = rc							!
	print "-i-<<< exit function: nsr_nvt_scan() with status:";rc if debug > 0
	end function								!

	!=======================================================================
	!	host to network short (every stack has one of these)
	!	OpenVMS is little endian but the network is big endian
	!=======================================================================
32711	function word htons(word inbound)					!
	option type=explicit							!
	!
	map(htons0)	word	sw0_word0
	map(htons0)	byte	sw0_byte0	,	&
			byte	sw0_byte1
	!
	map(htons1)	word	sw1_word0
	map(htons1)	byte	sw1_byte0	,	&
			byte	sw1_byte1
	!
	sw0_word0	= inbound						!
	sw1_byte0	= sw0_byte1						!
	sw1_byte1	= sw0_byte0						!
	htons		= sw1_word0						! presto
	end function								!
	!
	!=======================================================================
	!	host to network long (every stack has one of these)
	!	OpenVMS is little endian but the network is big endian
	!=======================================================================
32712	function long htonl(long inbound)					!
	option type=explicit							!
	!
	map(htonl0)	long	sw0_long0
	map(htonl0)	word	sw0_word0	,	&
			word	sw0_word1
	map(htonl0)	byte	sw0_byte0	,	&
			byte	sw0_byte1	,	&
			byte	sw0_byte2	,	&
			byte	sw0_byte3
	!
	map(htonl1)	long	sw1_long0
	map(htonl1)	word	sw1_word0	,	&
			word	sw1_word1
	map(htonl1)	byte	sw1_byte0	,	&
			byte	sw1_byte1	,	&
			byte	sw1_byte2	,	&
			byte	sw1_byte3
	!
	sw0_long0	= inbound
	sw1_byte0	= sw0_byte3
	sw1_byte1	= sw0_byte2
	sw1_byte2	= sw0_byte1
	sw1_byte3	= sw0_byte0
	htonl		= sw1_long0						! presto
	end function								!

	!
	!=======================================================================
	!	quad to long
	!	OpenVMS BASIC has no unsigned integers but we sometimes need to
	!	do 32-bit unsigned math. The lazy way is to do 64-bit math then
	!	trucate back to 32-bits (okay if the value is not too large)
	!=======================================================================
32713	function long qtol(quad inbound)					!
	option type=explicit							!
	!
	map(qtol)	quad	sw0_quad0
	map(qtol)	long	sw0_long0	,	&
			long	sw0_long1
	!
	sw0_quad0	= inbound						!
	qtol		= sw0_long0						! presto
	if sw0_long1 <> 0 then							! this should never happen
	    print "-w-oops, information was lost during Quad->Long conversion)"	!
	    print "   quad  "; sw0_quad0
	    print "   long0 "; sw0_long0
	    print "   long1 "; sw0_long1
	end if									!
	end function								!

	!=======================================================================
	!	octets to quad
	!	caveat: we do this because this BASIC has no unsigned integers
	!=======================================================================
32714	function quad octets_to_quad(long octet() by ref)			!
	option type=explicit							!
	declare quad junk64							!
	!
	junk64 = 0								! init
	!
	when error in								!
    %let %convert_method=1							! stuffing is more efficient than math
    %if  %convert_method=0 %then						!
	    junk64 =	octet(0)) * 16777216	+ 				! 2^24			&
			octet(1)) * 65536	+ 				! 2^16			&
			octet(2)) * 256		+ 				! 2^8			&
			octet(3))						! 2^0
    %else
	    %include "TCPIP$TCP_CLIENT_QIO_2014E.INC"				!
	    declare stuffer32_rec	stuffer32				!
	    stuffer32::long_offset00 = octet(3)					!
	    stuffer32::long_offset08 = octet(2)					!
	    stuffer32::long_offset16 = octet(1)					!
	    stuffer32::long_offset24 = octet(0)					!
	    junk64 = stuffer32::quad0						!
    %end %if
	use									!
	    junk64 = 0								!
	end when								!
	octets_to_quad = junk64							!
	end function								!

	!=======================================================================
	!	get timer bit vector
	!	(see OpenVMS system systevices documentation for "sys$wflor")
	!
	!	notes:	cluster	event flags
	!		0	00- 31	(local  cluster)
	!		1	32- 63	(local  cluster)
	!		2	64- 95	(common cluster)
	!		3	96-127	(common cluster)
	!=======================================================================
32715	function long get_ef_bit_vector(long event_flag)			!
	option type = explicit							!
	declare long temp							!
	!
	select event_flag							!
	    case <= 31								!
		temp = event_flag						!
	    case <= 63								!
		temp = event_flag - 32						!
	    case <= 95								!
		temp = event_flag - 64						!
	    case else								!
		temp = event_flag - 96						!
	end select								!
	!
	select temp								! avoiding an integer overflow
	    case 31								! need to set bit #31
!					33222222222211111111110000000000
!					10987654321098765432109876543210
		get_ef_bit_vector =   B"10000000000000000000000000000000"L	! so return this
	    case else								!
		get_ef_bit_vector = (2% ^ temp)					! else return this
	end select								!
	!
	end function								! get_ef_bit_vector
	!=======================================================================