OpenVMS Source-Code Demos

TCPWARE_TELNET_SAMPLE

1000	%title "vms_basic_tcpware_telnet_sample"
	%ident                      "version_102.1"				! <<<---+---***
	declare string constant	k_version = "102.1"			,	! <<<---+					&
	    			k_program = "basic_tcpware_telnet_sample"	!
	!
	!0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
	!1         2         3         4         5         6         7         8         9         0         1         2         3
	!=========================================================================================================================
	! Title  : VMS_BASIC_TCPWARE_TELNET_SAMPLE.BAS
	! Author : Neil S. Rieck	(Kitchener/Waterloo/Cambridge, Ontario, Canada)
	!	 :			(http://www3.sympatico.ca/n.rieck) (mailto:n.rieck@sympatico.ca)
	! Purpose: to explore the possibility of doing TELNET from within VAX-BASIC applications
	! Notes  : 1.	written in VAX BASIC 3.8 running under OpenVMS 6.2 using Process Software's TCPware 5.3
	!	   2.	rewritten in OpenVMS Alpha V1.6 under OpenVMS 8.2 using Process Software's TCPware 5.7-2
	!	   3.	derived from file "telnet_sample.c" in TCPware's example directory which is
	!		copyrighted (c) by Process Software Corporation of Framingham, Massachusetts, USA.
	!	   4.	by declaring passing mechanisms in the "external" declarations we won't need to use VAX-BASIC's
	!		"LOC" function to substitute for DEC-Cs ampersand (address reference)
	!	   5.	optionally, rename this file to "telnet_sample.bas"
	!	   6.	this progarm must be built (from DCL) as follows:
	!			$ basic vms_basic_tcpware_telnet_sample_102.bas
	!			$ link  vms_basic_tcpware_telnet_sample_102,	-
	!					sys$input/options
	!						tcpware:tellib/lib
	!						sys$share:tcpware_socklib_shr/share
	!			$ exit
	!	   7.	interface to dcl as a foreign command like so:
	!			$telnet_sample :== $my$demos:basic_tcpware_telnet_sample_102.exe
	!			(where my$demos is a path specification)
	!	   8.   program usage from DCL:
	!			$telnet_sample desired-host  7 (echo service)
	!			$telnet_sample desired-host 13 (daytime service)
	!			$telnet_sample desired-host 19 (chargen service)
	!	   9. Since this is just a demo, please disregard some early exits from within sub routines
	!=========================================================================================================================
	! History:
	! ver who when   what
	! --- --- ------ ---------------------------------------------------------------------------------------------------------
	! 100 NSR 991112 1. original program (derived from tcpware:telnet_sample.c)
	! 101 NSR 070730 2. started added support for port 23 (but will not work as a DCL foreign command)
	!     NSR 070731 3. cleaned up the code in a few places
	!		 4. started cleanup of the telnet negotiator (see: port_23_user_cmd_proc)
	!     NSR 070801 5. more work
	!     NSR 070801 6. now send some telnet parameter negotiation requests when the connection is first opened
	!		 7. created a make-shift TELNET demo								bf_101.7
	!     NSR 070802 8. now pass a debug paramter into port_23_user_cmd_proc via map(debug)
	! 102 NSR 070806 1. added timer calls to the receive section to improve speed
	!=========================================================================================================================
	option type =explicit							! no kid stuff...
	set no prompt								!
	!
	declare string	constant											&
	    dq		= '34'C							! double quote (ascii 34)
	!
	declare long		rc%					,	! return code				&
				ccb%					,	! connection control block		&
				handler_error%				,	!					&
				tcp_event_flag%				,	!					&
				tcp_ef_state%				,	!					&
				timer_event_flag%			,	!					&
				timer_ef_state%				,	!					&
				char_count%				,	!					&
				junk%, i%, j%, k%			,	!					&
				delay_junk%				,	!					&
				fail_safe%				,	!					&
				read_stall%				,	!					&
				first_time%				,	!					&
				mask%					,	!					&
				pass_count%				,	!					&
		word		recvlen_w%				,	!					&
				sendbuf_w%				,	!					&
				service_port_w%				,	!					&
		string		buf$					,	!					&
				host_name$				,	!					&
				service_port$				,	!					&
				junk$					,	!					&
				p1$					,	! command line parameter #1		&
				p2$					,	! command line parameter #2		&
		basic$QuadWord	DeltaQuad					! for sys$bintim etc.
	!
	!	warning: these declarations should be the same in sub "port_23_user_cmd_proc"
	!
	declare word constant	k_xmit_size_w	= 1024			,	!					&
				k_recv_size_w	= 2048				!
	!
	map(xyz) string	sendbuf$	= k_xmit_size_w			,	! static string(s)			&
			recvbuf$	= k_recv_size_w		 		!
	!
	map(debug)	long	map_debug%					! this is shared with 'port_23_user_cmd_proc'
	!
	!	OpenVMS System Services
	!
	%include "starlet"      %from %library "sys$library:basic$starlet"	! system services
	%include "$ssdef"       %from %library "sys$library:basic$starlet"	! ss$
	!
	external long function sys$waitfr(		long by value	)	! wait for event flag
	!
	external string function wcsm_dt_stamp16				! ccyymmddHHMMSStt
	!
	external long   function get_timer_bit_vector(long)			! required for used with SYS$WFLOR
	!
	external long function sys$readef(		long by value	,	! read event flag	&
							long by ref	)	!
	!
	external long port_23_user_cmd_proc					! this is an external sub process (telnet use only)
	!
	!	see RFC-764, RFC-731 and RFC-854
	!	notes:
	!	    1. this is a partial list
	!	    2. if any of these conflict with BASIC keywords in the future then just add a "k" prefix ("k"=constant
	!		because "c"=char; maybe we should use "t"=TELNET). Note: I'm shocked we can use "DO" without a prefix.
	!	    3. Google this string for more information: "telnet iac sb se 250 240 nvt"
	!
	declare long constant	WILL		= 251	,! Sender "requests to begin" or "confirms" something	&
				WONT		= 252	,! Demands to stop or not start something		&
				DO		= 253	,! Requests other side to begin or confirm		&
				DONT		= 254	,! Demands other side to stop				&
				IAC		= 255	,! Interpret As Command					&
				kSB		= 250	,! sub command						&
				kGA		= 249	,! go ahead						&
				kSE		= 240	,! sub end						&
				kBINARY		= 0	,! binary transmission					&
				kECHO		= 1	,!							&
				RECCONECTION	= 2	,!							&
				SUPPRESS_GA	= 3	,! supress go-ahead					&
				kMSG_SIZ_NEG	= 4	,! approx message size negotiation			&
				kSTATUS		= 5	,!							&
				TIMING_MARK	= 6	,!							&
				EXTENDED_ASCII 	= 17	,!							&
				kLOGOUT		= 18	,!							&
				BM		= 19	,! Byte Macro						&
				kDET		= 20	,! Data Entry Terminal					&
				SUPDUP     	= 21	,!							&
				SUPDUP_OUT	= 22	,!							&
				SEND_LOCATION	= 23	,!							&
				TERM_TYPE	= 24	,! from RFC-884						&
				TACACS		= 25	,!							&
				Output_Marking	= 27	,!							&
				Term_Loc_Number	= 28	,!							&
				kEOR		= 35	,! end-of-record					&
				WINDOW_SIZE	= 31	,!							&
				TERM_SPEED	= 32	,!							&
				REMOTE_FLOW_CTL	= 33	,!							&
				LINE_MODE	= 34	,!							&
				ENVIRON		= 36	,!							&
				kAUTHENTICATION	= 37	,!							&
				kNEW_ENVIRONMENT= 39	,!							&
				kTN3270E	= 40	,!							&
				EXTENDED_OPTIONS=255	 !
	!
	!	VMS RTL (run time library) LIB$ Services
	!
	external long function lib$get_foreign(		string by desc	,	!			&
							string by desc	,	!			&
							word by ref	,	!			&
							long by ref	)	!
	!
	external long function lib$get_ef(		long by ref	)	! get event flag (from local pool)
	!
	external long function lib$free_ef(		long by ref	)	! release event flag
	!
	!	TCPware Telnet Services
	!
	external long function tel_allocate_ccb(	long by ref	,	! ccb-ptr		&
							word by ref	,	! rcv-buf-size		&
							word by ref	)	! snd-buf-size
	!
	external long function tel_deallocate_ccb(	long by ref	)	! ccb-ptr
	!
	external long function tel_abort_connection(	long by ref	)	! ccb-ptr
	!
	external long function tel_close_connection(	long by ref	)	! ccb-ptr
	!
	external long function tel_open_connection(	long by ref	,	! ccb-ptr					&
							long by ref	,	! ia						&
							string by desc	,	! host						&
						!	long by ref	,	x cmd-rtn (Oops. What is going on here?)	&
							long by value	,	! cmd-rtn (for port_23_user_cmd_proc)		&
							long by ref	,	! efn						&
							long by ref	,	! ast-addr					&
							word by ref	,	! port						&
							long by ref	)	! timeout
	!
	external long function tel_receive_data(	long by ref	,	! ccb-ptr		&
							word by ref	,	! buffer-size		&
							string by ref	,	! buffer		&
							word by ref	)	! byte-count
	!
	external long function tel_send_data(		long by ref	,	! ccb-ptr		&
							string by ref	,	! buffer		&
							word by ref	)	! byte-count
	!
	external long function tel_send_command(	long by ref	,	! ccb-ptr		&
							string by ref	,	! buffer		&
							word by ref	)	! byte-count
	!
	!================================================================================
	!	main
	!================================================================================
	main:
	margin #0, 132								!
	sendbuf$	= ""							! initialize
	recvbuf$	= ""							!
	map_debug%	= 1							! pass this to 'port_23_user_cmd_proc'
	first_time%	= 1							!
	rc%		= 1							! VMS-s-
	!
	print k_program +"_"+ k_version						!
	print string$(len(k_program +"_"+ k_version), asc("="))			! what will the optimzer do with this?
	!
	rc% = LIB$GET_FOREIGN( junk$,,, )					!
	junk$ = junk$ + " "							! make sure we have a trailing space
	junk$ = edit$( junk$, 16%)						! multiple spaces to one
	i% = 1%									! start at char #1
	j% = pos(junk$, " ", i%)						! find first space
	p1$ = seg$(junk$, i%, j%-1%)						! extract parameter #1
	i% = j% + 1%								! slide past space
	j% = pos(junk$, " ", i%)						! find next space
	p2$ = seg$(junk$, i%, j%-1%)						! extract parameter #2
	if p1$ <> "" and p2$ <> "" then						! if command line paramters exist...
	    when error in							!
		service_port_w% = integer(p2$)					!
		select service_port_w%						!
		    case 7, 13, 19, 23						! supported services
			host_name$ = p1$					!
			goto start_program					! so jump past interactive stuff
		    case else							!
			print "-e- unsupported service"				! illegal so fall thru
		end select							!
	    use									!
		print "-e- non numeric service"					! fall thru on error
	    end when								!
	end if									!
	!
	!	prompt for parameters
	!
	input "host name? (default=142.180.221.246) ";host_name$		!
	host_name$ = edit$(host_name$, 4%+2%)					! no controls, no white space
	host_name$ = "142.180.221.246" if host_name$ = ""			!
	!
	print "Supported TCP Service Ports:"
	print "   7 = echo (default)"
	print "  13 = daytime"
	print "  19 = chargen"
	print "  23 = telnet"
	input "Choice? (default=7) "; service_port$				!
	service_port$ = edit$(service_port$, 4+2)				! no controls, no white space
	select service_port$							!
	    case "7","13","19","23"						!
	    case "23"								!
	    case else								!
		service_port$ = "7"						! default to echo
	end select								!
	service_port_w% = integer(service_port$)				!
	!
	when error in								!
	    input "debug level? (0-3, default=0) ";junk%			!
	use									!
	    junk% = 0								! oops
	end when								!
	select junk%								!
	    case 0 to 3								!
	    case else								!
		junk% = 0							! oops
	end select								!
	map_debug% = junk%							! pass this to 'port_23_user_cmd_proc'
	start_program:								! <<< from foreign command
	!
	!	<<< have the system allocate a connection control block and save the address in ccb%
	!
	rc% = tel_allocate_ccb( ccb%, k_recv_size_w, k_xmit_size_w )		! allocate a ccb
	if (rc% and 1%) <> 1% then						!
	    print "-e-allo rc% ";rc%						!
	    goto fini								!
	end if									!
	!
	rc% = lib$get_EF( tcp_event_flag% )					! procure an event flag
	if (rc% and 1%) <> 1% then						!
	    print "-e-gef_ef rc% ";rc%						!
	    goto fini								!
	end if									!
	!
	rc% = lib$get_EF( timer_event_flag% )					! procure an event flag
	if (rc% and 1%) <> 1% then						!
	    print "-e-gef_ef rc% ";rc%						!
	    goto fini								!
	end if									!
	!
	!	<<< open a connection >>>
	!
	! notes:
	! 1. it isn't stated in the manual, but you'll get an error if timeout isn't >=20 or 0
	! 2. undefined or unused parameters must be left blank. The compiler will push the proper null which is
	!    not what happens when you replace the blank with a zero.
	!
	rc% = tel_open_connection(						!						&
	    ccb%							,	! ccb-ptr					&
									,	! ia		(use IA or HOST, not both)	&
	    host_name$							,	! host		(use IA or HOST, not both)	&
	    loc(port_23_user_cmd_proc) by value				,	! cmd-rtn	leave blank for NONE (TELNET)	&
	    tcp_event_flag%						,	! efn						&
	    								,	! ast-addr	leave blank for NONE		&
	    service_port_w%						,	! port						&
	    20%			 			 			! timeout (secs)				&
	)				 					!
	if (rc% and 1%) <> 1% then						!
	    print "-e-open rc% ";rc%						!
	    goto fini								!
	end if									!
	!
	!	<<< let's get on with it >>>
	!
	loop:									!
	select service_port_w%							!
	    case	13	,						! daytime					&
			19							! chargen -----------------------------------------
		while 1								!
		    rc% = sys$waitfr( tcp_event_flag% )				! wait for flag to be set
		    if (rc% and 1%) <> 1% then					!
			print "-e-wait rc% ";rc%				!
			goto fini						!
		    end if							!
		    gosub receive_data						!
		next								!
		!
	    case	7							! echo --------------------------------------------
		input "enter text to send? (default=exit) ";junk$		!
		if edit$(junk$, 4%+2%) = "" then				!
		    goto close_n_exit						!
		end if								!
		!
		!	<<< send the data >>>
		!
		! Note: Since junk$ could be much than sendbuf$, it would be better to test lengths and then send
		!       multiple fixed chunks of data; However, this is just a demo.
		!
		sendbuf$ = junk$						!
		sendbuf_w%	= len(edit$(sendbuf$, 128%))			! compute data string length
		rc% = tel_send_data( ccb%, sendbuf$, sendbuf_w% )		!
		if (rc% and 1%) <> 1% then					!
		    print "-e-send rc% ";rc%					!
		    goto fini							!
		end if								!
		!
		!	<<< wait for the event flag to be set >>>
		!
		gosub receive_data 						!
		goto loop							!
	    case	23							! TELNET ----------------------------	bf_101.7
		!
		! TELNET-Demo Implementation Notes:
		!
		! 1.	The proper way to do this is with Event Flags, Programmable Timers, and ASTs (I've already got it working
		!	in other programs) but doing that here would make you loose sight of how basic TELNET works
		!
		! 2.	No one will use "HP-BASIC for OpenVMS" to build a TELNET client (although it can be done) which means the
		!	"interative input and wait" stuff is not necessary. The actual reason for doing something like this is to
		!	provide TELNET capabilities to BATCH + DETACHED process which can programmatically communicate with another
		!	system
		!
		junk$ =	chr$(IAC) + chr$(DO  ) + chr$(SUPPRESS_GA) +		! DO  : SUPPRESS_GA				&
			chr$(IAC) + chr$(WILL) + chr$(SUPPRESS_GA)		! WILL: SUPPRESS_GA
		sendbuf$ = junk$						!
		sendbuf_w% = len(junk$)						!
		print "-i- sending initial handshakes" if map_debug% > 0	!
		rc% = tel_send_command( ccb%, sendbuf$, sendbuf_w% )		!
		if (rc% and 1%) <> 1% then					!
			print "-e-sndcmd rc% ";rc%				!
			goto fini						!
		end if								!
		gosub receive_data 						!
		!
		telnet_loop:							!
		rc% = sys$readef(tcp_event_flag% , tcp_ef_state%)		! test channel event flag (no hang method)
		if (rc% and 1%) <> 1% then					!
			print "-e-readef rc% ";rc%				!
			goto fini						!
		end if								!
		select rc%							!
		    case SS$_WASSET						! receive buffer not empty
			gosub receive_data 					!
			goto telnet_loop					! read until no more
		    case SS$_WASCLR						! receive buffer empty
		end select							!
		!
		!	Interactive Input is in this block of code but while we are here we are not paying attention to
		!	the receive stream.
		!
		when error in							!
		    if first_time% = 1 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% = 0						!
		    end if							!
		    wait 2							! enable keyboard timer
		    print "enter text to send followed by <enter> (blank line to exit; timeout in 2 seconds) ";
		    linput junk$						!
		    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"				!
		    goto telnet_loop						!
		end if								!
		goto close_n_exit	if len(junk$)=0				! blank line so exit
		!
		junk$		= junk$ + cr + lf				! tack on an EOL
		sendbuf$	= junk$						!
		sendbuf_w%	= len(junk$)					! compute data string length
		rc% = tel_send_data( ccb%, sendbuf$, sendbuf_w% )		!
		if (rc% and 1%) <> 1% then					!
		    print "-e-send rc% ";rc%					!
		    goto fini							!
		end if								!
		gosub delay_500							! let the message get to the far end
		goto telnet_loop						!
	end select								!
	!================================================================================
	!	<<< receive the data >>>
	!
	!	this entry point does not wait for an event flag to be set. It just polls
	!================================================================================
	receive_data:								!
	!
	!	<<< arm a timer to expire 'x' time from now >>>
	!
	pass_count% = 0									! init
	read_loop:									!
	pass_count% = pass_count% + 1							! advance
	if pass_count% = 1 then								! if first pass
	    declare string constant	k_delay5sec = "0 00:00:05.0"			! set delay time 5 sec from now
	    rc% = sys$bintim(k_delay5sec, DeltaQuad )					! init delta time ('x' time from now)
	else										!
	    declare string constant	k_delay500ms = "0 00:00:00.5"			! set delay time  500 ms from now
	    rc% = sys$bintim(k_delay500ms, DeltaQuad )					! init delta time ('x' time from now)
	end if										!
	print "-e- sys$bintim rc: "+ str$(rc%) if ((rc% and 1%) <> 1%)			!
	rc% = sys$setimr(timer_event_flag%,DeltaQuad by ref,,,)				! now use it to schedule a wake up
	print "-e- sys$setimr rc: "+ str$(rc%) if ((rc% and 1%) <> 1%)			!
	!
	! 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
	!
	mask% =			get_timer_bit_vector(  tcp_event_flag%)			! insert vector 1 into mask
	mask% = mask% or	get_timer_bit_vector(timer_event_flag%)			! insert vector 2 into mask
	!
	!	<<< wait for either the 'TCP event flag' or the 'TIMER event flag' to change state >>>
	!
	junk$ = wcsm_dt_stamp16								! current time: ccyymmddHHMMSStt
	junk$ = left$(junk$,8) +"."+ mid$(junk$,9,6) +"."+ right$(junk$,15)		! -> ccmmyydd.HHMMSS.tt
	print "-i- waiting for flag "+ str$(tcp_event_flag%) +" or flag "+ str$(timer_event_flag%) +" time: "+ junk$		&
	    if map_debug% > 0
	!
	rc% = sys$wflor( tcp_event_flag%, mask%)					! wait for a response from one of two flags
	print "-e- sys$waitfr rc: "+ str$(rc%) if ((rc% and 1%) <> 1%)			!
	goto close_connection if (rc% and 1%) <> 1%					!
	if map_debug% >= 1 then								!
	    junk$ = wcsm_dt_stamp16							! current time: ccyymmddHHMMSStt
	    junk$ = left$(junk$,8) +"."+ mid$(junk$,9,6) +"."+ right$(junk$,15)		! -> ccmmyydd.HHMMSS.tt
	    print "-i- waking from event some flag at time: "+ junk$			!					&
		if map_debug% > 0							!
	end if										!
	!
	!	<<< cancel all timer requests (if any) >>>
	!
	print "-i- Calling $CanTim"	if map_debug% > 0				!
	rc% = sys$cantim(,)								! cancel all timer requests
	print "-e- sys$cantim rc: "+ str$(rc%) if ((rc% and 1%) <> 1%)			!
	!
	!	which event flag is set? TCP or TIMER?
	!
	rc% = sys$readEF(tcp_event_flag%, junk%)					! test TCP event flag
	select rc%									!
	    case SS$_WASCLR								!
		tcp_ef_state% = 0							!
	    case SS$_WASSET								!
		tcp_ef_state% = 1							!
	    case else									!
		print "-e- sys$readef-tcp rc: "+ str$(rc%)				!
	end select									!
	print "-i- TCP EF State: ";str$(tcp_ef_state%);" ";	if map_debug% >= 1	! no BASIC EOL required here
	!
	rc% = sys$readEF(timer_event_flag%, junk%)					! test TIMER event flag
	select rc%									!
	    case SS$_WASCLR								!
		timer_ef_state% = 0							!
	    case SS$_WASSET								!
		timer_ef_state% = 1							!
	    case else									!
		print "-e- sys$readef-timer rc: "+ str$(rc%)				!
	end select									!
	print "-i- Timer EF State: ";str$(timer_ef_state%) if map_debug% >= 1		!
	!
	!	at this point either the TCP-EF or the TIMER-EF could be set
	!
	if (timer_ef_state% = 1)	and						! if the TIMER-EF is set		&
	   (  tcp_ef_state% = 0)							! and the TCP-EF is clear
	then										! then something timed out
	    print "-i- timer expired with no TCP data"	if map_debug% > 0		!
	    goto read_exit								!
	else										! we've got TCP data so fall thru
	    print "-i- TCP data detected in buffer"	if map_debug% > 0
	end if										!
	!
	!  read data from the TCP buffer
	!
	rc% = tel_receive_data( ccb%, k_recv_size_w, recvbuf$, recvlen_w%)		! receive data <<<------***
	select rc%									!
	    case SS$_VCCLOSED, SS$_TIMEOUT, SS$_THIRDPARTY				!
		print "-e- the connection closed unexpectedly ("+ str$(rc%) +")"	!
		goto close_connection							! cleanup etc.
	    case else									!
		goto close_connection if (rc% and 1%) <> 1%				!
		select map_debug%
		    case 0
			print "-i- recv>" +left$(recvbuf$, recvlen_w%)	+"<"		!
		    case 1
			print "============================================================vvv"
			print "-i- recv>" +left$(recvbuf$, recvlen_w%)			!
			print "============================================================^^^"
		    case else
			print "============================================================vvv"
			print "-i- recv data >"+ left$(recvbuf$, recvlen_w%);"<"	!
			print "============================================================^^^"
			print "-i- recv count: "+ str$(recvlen_w%)			!
		end select								!
		goto read_loop								! loop back until timeout
	end select									!
	!
	read_exit:									!
	return										!
	!================================================================================
	!	my delay (because we can't sleep for less than 1 second)
	!================================================================================
	delay_500:
	delay_junk% = sys$bintim("0 00:00:00.50", DeltaQuad )			! then init delta time to 500 mS
	goto delay_common							!
	!
	delay_250:
	delay_junk% = sys$bintim("0 00:00:00.25", DeltaQuad )			! then init delta time to 250 mS
	goto delay_common							!
	!
	delay_100:
	delay_junk% = sys$bintim("0 00:00:00.10", DeltaQuad )			! then init delta time to 100 mS
	!
	delay_common:
	delay_junk% = sys$schdwk(,,DeltaQuad by ref,)				! schedule a wakeup ? seconds from now
	delay_junk% = sys$hiber							! go to sleep
	return
	!
	!================================================================================
	!	<<< close the connection then exit >>>
	!
	!	note: don't change rc% after this point
	!================================================================================
	fini:
	close_n_exit:								!
	close_connection:
	!
	print "-i- closing connection"	if map_debug% > 0			!
	junk% = tel_close_connection( ccb% )					! this just closes my xmit
	if (junk% and 1%) <> 1% then						!
	    print "-e-close junk% ";junk%					!
	end if									!
	!
	fail_safe% = 0								! init fail safe counter
	buffer_purge:								!
	print "-i- purging receive buffer <<<---***"	if map_debug% > 0	!
	fail_safe% = fail_safe% + 1						!
	junk% = tel_receive_data( ccb%, k_recv_size_w, recvbuf$, recvlen_w%)	! clean out receive buffer
	print "-i- receive buffer purge. Bytes: "+ str$(recvlen_w%) +" rc: ";str$(junk%)	if map_debug% > 0
	select junk%								!
	    case SS$_VCCLOSED, SS$_TIMEOUT, SS$_THIRDPARTY			! now totally closed so fall thru
	    case else								!
		if (junk% and 7%) = 1 then					! if no errors
		    junk% = sys$bintim("0 00:00:00.10", DeltaQuad )		! then init delta time to 100 mS
		    junk% = sys$schdwk(,,DeltaQuad by ref,)			! schedule a wakeup ? seconds from now
		    junk% = sys$hiber						! go to sleep
		    goto buffer_purge if fail_safe% <= 50			! loop back (5 second worse case limit)
		    junk% = tel_abort_connection( ccb% )			! don't take any chances
		    sleep 5							!
		else								! some kind of error....
		    junk% = tel_abort_connection( ccb% )			! don't take any chances
		    sleep 1							!
		end if
	end select
	!
	if tcp_event_flag% <> 0 then						!
	    print "-i- releasing EF: "+str$( tcp_event_flag% )	if map_debug% > 0
	    junk% = lib$free_EF( tcp_event_flag% )				! get an event flag
	end if									!
	!
	if timer_event_flag% <> 0 then						!
	    print "-i- releasing EF: "+str$( timer_event_flag% ) if map_debug% > 0
	    junk% = lib$free_EF( timer_event_flag% )				! get an event flag
	end if									!
	!
	!	<<< deallocate the ccb >>>
	!
	if ccb% <> 0 then							!
	    print "-i- releasing CCB"	if map_debug% > 0			!
	    junk% = tel_deallocate_ccb( ccb% )					!
	    if (junk% and 1%) <> 1% then					!
		print "-e-deal junk% ";junk%					!
	    end if								!
	end if									!
	!
	print "-i- exiting with code: "+ str$(rc%)				!
30000	end program rc%								! rc% gets passed back to DCL
	!
	!========================================================================================================================
	!	port_23_user_cmd_proc
	!
	! notes:
	! 1. This routine is run when an IAC (255) character is received
	! 2. It is involved with the WILL-WONT-DO-DONT handshake that begins every telent session (see: RFC-764)
	! 3. If you find a system you can't connect to, use the TCPware Client's debug option to trace a connection
	! 4. Do not lie to the other end. Do not agree to do anything you aren't prepared to handle.
	! 5. A really simple interface will support SUPPRESS_GA and refuse to do everything else
	! 7. See RFC-764 at http://www.faqs.org/rfcs/rfc764.html for more details
	! 8. Warning: this is not a complete implementation (but it is enough to get you connected to a complete implementation).
	!    We are supposed to save parameter states and not ACK any request putting us into a state we are already in (this
	!    is required to prevent us from getting into an infinate ACK loop with the far end)
	!========================================================================================================================
32000	sub port_23_user_cmd_proc by ref( long ccb%, byte my_buf(), word my_length%)
	option type=explicit							!
	declare long	rc%						,	! return code			&
			cmd%						,	! command			&
			opt%						,	! option			&
			k%, z%						,	!				&
		word	recvlen_w%					,	!				&
			sendbuf_w%					,	!				&
			my_port_w%					,	!				&
		string	dest_node$					,	!				&
			user_fs1$					,	!				&
			junk$							!
	!
	declare word constant	k_xmit_size_w	= 32			,	!				&
				k_recv_size_w	= 32				!			superfluous?
	!
	!	use different maps so we don't clobber sendbuf$ above
	!
	map(private) string	sendbuf$	= k_xmit_size_w		,	!				&
				recvbuf$	= k_recv_size_w			!			superfluous?
	!
	map(debug)	long	map_debug%					! this is shared with 'the calling program'
	!
	external long function tel_send_command(	long by ref	,	! ccb-ptr			&
							string by ref	,	! buffer			&
							word by ref	)	! byte-count
	!
	!	see RFC-764, RFC-731 and RFC-854
	!	notes:
	!	    1. this is a partial list
	!	    2. if any of these conflict with BASIC keywords in the future then just add a "k" prefix ("k"=constant
	!		because "c"=char; maybe we should use "t"=TELNET). Note: I'm shocked we can use "DO" without a prefix.
	!	    3. Google this string for more information: "telnet iac sb se 250 240 nvt"
	!
	declare long constant	WILL		= 251	,! Sender "requests to begin" or "confirms" something	&
				WONT		= 252	,! Demands to stop or not start something		&
				DO		= 253	,! Requests other side to begin or confirm		&
				DONT		= 254	,! Demands other side to stop				&
				IAC		= 255	,! Interpret As Command					&
				kSB		= 250	,! sub command						&
				kGA		= 249	,! go ahead						&
				kSE		= 240	,! sub end						&
				kECHO		= 1	,!							&
				SUPPRESS_GA	= 3	,! supress go-ahead					&
				kSTATUS		= 5	,!							&
				TIMING_MARK	= 6	,!							&
				BM		= 19	,! Byte Macro						&
				kDET		= 20	,! Data Entry Terminal					&
				TERM_TYPE	= 24	,! from RFC-884						&
				WINDOW_SIZE	= 31	,!							&
				TERM_SPEED	= 32	,!							&
				REMOTE_FLOW_CTL	= 33	,!							&
				LINE_MODE	= 34	,!							&
				ENVIRON		= 36	 !
	!====================================================================================================
	!	main (of port_23_user_cmd_proc)
	!====================================================================================================
	main:									! for sub 'port_23_user_cmd_proc'
	!
	if map_debug% >= 1 then							!
	    print "=== port_23_user_cmd_proc ============================ begin"!
	end if									!
	if map_debug% >= 3 then							!
	    print "-i-user_cmd_proc (inbound: params ): ";			!
	    for z% = 0% to (my_length% -1%)					!
		print using "#### ";my_buf(z%);					!
	    next z%								!
	    print								!
	end if									!
	!
	cmd% = my_buf(0%)							! extract command byte
	cmd% = cmd% + 256%	if cmd% < 0%					! fix sign
	!
	opt% = my_buf(1%)							! extract option byte
	opt% = opt% + 256%	if opt% < 0%					! fix sign
	!
	if map_debug% >= 2 then							!
	    print "-i-user_cmd_proc (inbound: cmd/opt): ";			!
	    print using "#### ####"; cmd%; opt%					!
	end if									!
	!
	!	Example handshakes:
	!
	!	if we receive a DO TERM_TYPE command then we need to answer back with only one of the following:
	!		1. WONT TERM_TYPE (then do nothing)	or
	!		2. WILL TERM_TYPE (then actually send the TERM TYPE)
	!	if we receive a "WILL kECHO" query then we need to answer back with only one of the following:
	!		1. DO   kECHO
	!		2. DONT kECHO (this is preferred; we don't want the other end to echo everything)
	!	Echo:
	!		1. WILL ECHO - requests to begin echo or confirms do echo
	!		2. WONT ECHO - demands to stop echo
	!		3. DO   ECHO - requests other side to begin echo
	!		4. DONT ECHO - demand other side to stop echo
	!	Note: see RFC-764 at http://www.faqs.org/rfcs/rfc764.html for more details
	!
	!
	sendbuf_w% = 0								! initizlize...
	select cmd%								!
	    case WILL								! received WILL; so ack with DO or DONT (yes or no)
		print "-i-user_cmd_proc rcv-cmd   : WILL "+ str$(opt%)	if map_debug% >= 1
		select opt%							!
		    case SUPPRESS_GA, TERM_TYPE					! we want him to "supress go-ahead"
			sendbuf$ = chr$(IAC) + chr$(DO  ) + chr$(opt%)		! DO: SUPPRESS_GA
			sendbuf_w% = 3						!
		    case WINDOW_SIZE
			!
			!	I never see the server ever do a sub-negotiation of WINDOW_SIZE (could this be an old legacy
			!	mode?). In all the traces below after the server sends a DO WINDOW_SIZE size the client reponds
			!	with:	1) WILL WINDOW_SIZE
			!		2) followed immediately by a SB WINDOW_SIZE
			!
			junk$ =	chr$(IAC) + chr$(DO  ) + chr$(opt%) +		! WILL: window_size				&
				chr$(IAC) + chr$(kSB ) + chr$(opt%) +		!						&
				chr$(0  ) + chr$(132 ) + chr$(0   ) +chr$(24) +	!						&
				chr$(IAC) + chr$(kSE )				!
			sendbuf$ = junk$					!
			sendbuf_w% = len(junk$)					!
		    case kECHO, kSTATUS						! we don't want him to echo
			sendbuf$ = chr$(IAC) + chr$(DONT) + chr$(opt%)		! DONT: ECHO etc.
			sendbuf_w% = 3						!
		    case else							!
			sendbuf$ = chr$(IAC) + chr$(DONT) + chr$(opt%)		! DONT do anything else
			sendbuf_w% = 3						!
		end select							!
	    case DO								! received DO; so ack with WILL or WONT (yes or no)
		print "-i-user_cmd_proc rcv-cmd   : DO   "+ str$(opt%)	if map_debug% >= 1
		select opt%							!
		    case SUPPRESS_GA, TERM_TYPE					!
			sendbuf$ = chr$(IAC) + chr$(WILL) + chr$(opt%)		! WILL: suppress GA
			sendbuf_w% = 3						!
		    case WINDOW_SIZE						!
			!
			!	I never see the server ever do a sub-negotiation of WINDOW_SIZE (could this be an old legacy
			!	mode?). In all the traces below after the server sends a DO WINDOW_SIZE size the client reponds
			!	with:	1) WILL WINDOW_SIZE
			!		2) followed immediately by a SB WINDOW_SIZE
			!
			junk$ =	chr$(IAC) + chr$(WILL) + chr$(opt%) +		! WILL: window_size				&
				chr$(IAC) + chr$(kSB) + chr$(opt%) +		!						&
				chr$(0) + chr$(132) + chr$(0) +chr$(24) +	!						&
				chr$(IAC) + chr$(kSE)				!
			sendbuf$ = junk$					!
			sendbuf_w% = len(junk$)					!
		    case TERM_SPEED, ENVIRON, kSTATUS, kECHO			!
			sendbuf$ = chr$(IAC) + chr$(WONT) + chr$(opt%)		! WONT: TERM_SPEED
			sendbuf_w% = 3						!
		    case else							!
			sendbuf$ = chr$(IAC) + chr$(WONT) + chr$(opt%)		! WONT: everything else
			sendbuf_w% = 3						!
		end select							!
 	    case WONT								! WONT; must send DONT (as an ACK)
		!
		! note: we need to add code so we can tell the difference between a response and an ACK (see RFC-764)
		!
		print "-i-user_cmd_proc rcv-cmd   : WONT "+ str$(opt%)	if map_debug% >= 1
		sendbuf$ = chr$(IAC) + chr$(DONT) + chr$(opt%)			!
		sendbuf_w% = 3							!
	    case DONT								! DONT; must send WONT (as an ACK)
		!
		! note: we need to add code so we can tell the difference between a response and an ACK (see RFC-764)
		!
		print "-i-user_cmd_proc rcv-cmd   : DONT "+ str$(opt%)	if map_debug% >= 1
		sendbuf$ = chr$(IAC) + chr$(WONT) + chr$(opt%)			!
		sendbuf_w% = 3							!
 	    case kSB								! requested a suboption negotiation
		print "-i-user_cmd_proc rcv-cmd   : kSB  "+ str$(opt%);" "; if map_debug% >= 1
		select opt%							!
		    case TERM_TYPE						! he wants to know our terminal type
			print "TERM_TYPE"				if map_debug% >= 1
			junk$	=	chr$(IAC) + chr$(kSB) + chr$(opt%) + chr$(0) +				&
					"VT200" +				!				&
					chr$(IAC) + chr$(kSE)			!
			sendbuf$ = junk$
			sendbuf_w% = len(junk$)					!
		    case WINDOW_SIZE						! he wants to know our window size
			print "WINDOW_SIZE"				if map_debug% >= 1
			junk$	=	chr$(IAC) + chr$(kSB) + chr$(opt%) +	!				&
					chr$(0) + chr$(80) + chr$(0) +chr$(24) +!				&
					chr$(IAC) + chr$(kSE)			!
			sendbuf$ = junk$					!
			sendbuf_w% = len(junk$)					!
		    case TERM_SPEED						!
			print "TERM_SPEED"				if map_debug% >= 1
			sendbuf$ =	chr$(IAC) + chr$(kSB) + chr$(opt%) + chr$(0) +				&
					"9600,9600" +				!				&
					chr$(0) + chr$(IAC) + chr$(kSE)		!
			sendbuf$ = junk$
			sendbuf_w% = len(junk$)					!
		    case else							! oops...
			print " ???? unsupported SB: "; str$(opt%)	if map_debug% >= 1
			sendbuf$ = ""						!
			sendbuf_w% = 0						!
		end select							!
	    case else								! oops...
		print "-i-user_cmd_proc rcv-cmd   : ???? unsupported CMD: "+ str$(cmd%) +" OPT: "+str$(opt%)	if map_debug% >= 1
		sendbuf$ = ""							!
		sendbuf_w% = 0							!
	end select								!
	!
	if sendbuf_w% > 0 then							! if we have something to send...
	    rc% = tel_send_command( ccb%, sendbuf$, sendbuf_w% )		!
	    print "-i-user_cmd_proc snd-cmd rc: "+ str$(rc%)	if map_debug% >= 2
	    if map_debug% >= 1 then						! if debug...
		select asc( mid$(sendbuf$,2,1) )				!
		    case DO							!
			print "-i-user_cmd_proc snd-cmd   : DO   ";
		    Case WILL							!
			print "-i-user_cmd_proc snd-cmd   : WILL ";
		    case WONT							!
			print "-i-user_cmd_proc snd-cmd   : WONT ";
		    case DONT							!
			print "-i-user_cmd_proc snd-cmd   : DONT ";
		    case kSB							!
			print "-i-user_cmd_proc snd-cmd   : SB   ";
		    case else							!
			junk$ = str$( asc(mid$(sendbuf$,2,1)) )			!
			while len(junk$) < 4					!
			    junk$ = junk$ + " "					!
			next							!
			print "-i-user_cmd_proc snd-cmd   : ? ("; junk$ +")";	!
		end select							!
		select asc( mid$(sendbuf$,3,1) )				! test the 2cd character in the buffer
		    case	kECHO						!
			print	"ECHO           "
		    case	SUPPRESS_GA					!
			print	"SUPPRESS_GA    "
		    case	kSTATUS						!
			print	"STATUS         "
		    case	TIMING_MARK					!
			print	"TIMING_MARK    "
		    case	TERM_TYPE					!
			print	"TERM_TYPE      "
		    case	WINDOW_SIZE					!
			print	"WINDOW_SIZE    "
		    case	TERM_SPEED					!
			print	"TERM_SPEED     "
		    case	REMOTE_FLOW_CTL					!
			print	"REMOTE_FLOW_CTL"
		    case	LINE_MODE					!
			print	"LINE_MODE      "
		    case	ENVIRON						!
			print	"ENVIRON        "
		    case else							!
			junk$ = str$( asc(mid$(sendbuf$,3,1)) )			!
			while len(junk$) < 4					!
			    junk$ = junk$ + " "					!
			next							!
			print "?? ("; junk$ +")"				!
		end select							!
	    end if								! end if map_debug% >= 1
	end if									! end if sendbuf_w% > 0
	!
	if map_debug% >= 1 then							!
	    print "=== port_23_user_cmd_proc ============================ end"	!
	end if									!
	end sub									!
	!========================================================================================================================
	! trace-1
	! The following is a sample transaction from TCPware's TELNET-Client with debugging turned on (NSR - 000219)
	! Note: another sample follows this one
	!========================================================================================================================
	!%TCPWARE_TELNET-I-OPTRECV, received WILL ECHO				server says: I would like to ECHO
	!%TCPWARE_TELNET-I-SENT, sent DO ECHO					client says: I think you should ECHO
	!
	!	here we deal with SUPPRESS_GA in each direction
	!
	!%TCPWARE_TELNET-I-SENT, sent DO SUPPRESS-GO-AHEAD			client says: I think you should SUPPRESS-GA
	!%TCPWARE_TELNET-I-SENT, sent WILL SUPPRESS-GO-AHEAD			client says: I would also like to SUPPRESS-GA
	!%TCPWARE_TELNET-I-OPTRECV, received WILL SUPPRESS-GO-AHEAD		server says: I will SUPPRESS-GA
	!%TCPWARE_TELNET-I-OPTRECV, received DO SUPPRESS-GO-AHEAD		server says: I think you should SUPPRESS-GA
	!
	!	here the server asks the client if he is willing to describe his hardware
	!
	!%TCPWARE_TELNET-I-OPTRECV, received DO TERMINAL-TYPE			server says: I think you should do TERM-TYPE
	!%TCPWARE_TELNET-I-SENT, sent WILL TERMINAL-TYPE			client says: I will do TERM-TYPE if you ask me
	!%TCPWARE_TELNET-I-OPTRECV, received DO WINDOW-SIZE			server says: I think you should do WINDOW-SIZE
	!%TCPWARE_TELNET-I-SENT, sent WILL WINDOW-SIZE				client says: I will do WINDOW-SIZE if you ask me
	!
	!	here the client send the WINDOW SIZE (why didn't the server ask for it?)
	!
	!%TCPWARE_TELNET-I-SENTSUBOPT, sent suboption SB WINDOW-SIZE 132 24 IAC SE
	!
	!	here the server asks for the TERM-SPEED
	!
	!%TCPWARE_TELNET-I-OPTRECV, received DO TERMINAL-SPEED			server says: I think you should do TERMINAL-SPEED
	!%TCPWARE_TELNET-I-SENT, sent WILL TERMINAL-SPEED			client says: I will do TERMINAL-SPEED
	!
	!	here the server asks us to TOGGLE FLOW
	!	the client compiles
	!
	!%TCPWARE_TELNET-I-OPTRECV, received DO TOGGLE-FLOW-CONTROL		server says: I think you should do FLOW
	!%TCPWARE_TELNET-I-SENT, sent WILL TOGGLE-FLOW-CONTROL			client says: I will do FLOW
	!
	!	here the server asks for the TERM-TYPE
	!	the client compiles
	!
	!%TCPWARE_TELNET-I-SUBOPTRECV, received suboption SB TERMINAL-TYPE SEND SE	server says: what is your TERM-TYPE?
	!%TCPWARE_TELNET-I-SENTSUBOPT, sent suboption SB TERMINAL-TYPE IS VT400 SE	client says: TERM-TYPE is VT400
	!
	!	here the server asks for TERM-SPEED
	!	the client compiles
	!
	! *** WARNING ***
	!%TCPWARE_TELNET-I-SUBOPTRECV, received suboption SB TERMINAL-SPEED SEND SE	server says: what is you TERM-SPEED?
	!%TCPWARE_TELNET-I-SENTSUBOPT, sent suboption SB TERMINAL-SPEED IS 9600,9600 SE	client says: TERM-SPEED is...
	!
	!========================================================================================================================
	!	Trace-2
	!	The following is a sample transaction from TCPware's TELNET-Client with debugging turned on (NSR - 2007-07-30)
	!	I was connecting from TCPware-5.7-2 on OpenVMS-8.2 to Solaris-8
	!========================================================================================================================
	!TELNET> set DEBUG/class=all
	!%TCPWARE_TELNET-I-SHOWDBG, will show options processing
	!%TCPWARE_TELNET-I-SHOWDBG, will show terminal input
	!%TCPWARE_TELNET-I-SHOWDBG, will show network input
	!%TCPWARE_TELNET-I-SHOWDBG, will show network output
	!TELNET> connect 142.180.221.246						this is where I started the connection
	!%TCPWARE_TELNET-I-TRYING, trying kawc3w.on.bell.ca,telnet (142.180.221.246,23) ...
	!%TCPWARE_TELNET-I-ESCCHR, escape (attention) character is "^\"
	!
	!%TCPWARE_TELNET-I-OPTRECV, received DO TERMINAL-TYPE				Solaris asks if we can do TERMINAL-TYPE
	!%TCPWARE_TELNET-I-SENT, sent WILL TERMINAL-TYPE				TCPware says yes
	!%TCPWARE_TELNET-I-OPTRECV, received DO WINDOW-SIZE				Solaris asks if we can do  WINDOW-SIZE
	!%TCPWARE_TELNET-I-SENT, sent WILL WINDOW-SIZE					TCPware says yes
	!%TCPWARE_TELNET-I-SENTSUBOPT, sent suboption SB WINDOW-SIZE 132 24 IAC SE	then elaborates further
	!%TCPWARE_TELNET-I-OPTRECV, received DO X-DISPLAY-LOCATION			Solaris asks if we can do X-DISPLAY-LOCATION
	!%TCPWARE_TELNET-I-SENT, sent WON'T X-DISPLAY-LOCATION				TCPware say no
	!%TCPWARE_TELNET-I-OPTRECV, received DO  39 (unsupported)			I'm not sure about this
	!%TCPWARE_TELNET-I-SENT, sent WON'T  39 (unsupported)				But TCPware refused to do it
	!%TCPWARE_TELNET-I-OPTRECV, received DO  36 (unsupported)			I'm not sure about this
	!%TCPWARE_TELNET-I-SENT, sent WON'T  36 (unsupported)				But TCPware refused to do it
	!%TCPWARE_TELNET-I-OPTRECV, received DON'T X-DISPLAY-LOCATION			Solaris acks our WONT
	!%TCPWARE_TELNET-I-OPTRECV, received DON'T  39 (unsupported)			Solaris acks our WONT
	!%TCPWARE_TELNET-I-OPTRECV, received DON'T  36 (unsupported)			Solaris acks our WONT
	!%TCPWARE_TELNET-I-SUBOPTRECV, received suboption SB TERMINAL-TYPE SEND SE	Solaris wants to know about our terminal
	!%TCPWARE_TELNET-I-SENTSUBOPT, sent suboption SB TERMINAL-TYPE IS VT200 SE	TCPware tells Solaris is is a VT200
	!
	!SunOS 5.8
	!
	!
	!%TCPWARE_TELNET-I-OPTRECV, received WILL ECHO					far end offers to ECHO
	!%TCPWARE_TELNET-I-SENT, sent DO ECHO						we say OK
	!%TCPWARE_TELNET-I-SENT, sent DO SUPPRESS-GO-AHEAD				we command far-end to SUPPRESS-GO-AHEAD
	!%TCPWARE_TELNET-I-SENT, sent WILL SUPPRESS-GO-AHEAD				we say we will SUPPRESS-GO-AHEAD
	!%TCPWARE_TELNET-I-OPTRECV, received WILL SUPPRESS-GO-AHEAD			far end acks our SUPPRESS-GO-AHEAD
	!%TCPWARE_TELNET-I-OPTRECV, received DO ECHO					far end acks our DO ECHO
	!login:										received far-end prompt
	!%TCPWARE_TELNET-I-SENT, sent WON'T ECHO					(is this to hide the password?)
	!%TCPWARE_TELNET-I-OPTRECV, received DO SUPPRESS-GO-AHEAD
	!%TCPWARE_TELNET-I-OPTRECV, received DON'T ECHO					at this point I hit <enter>
	!login: ibam									far-end prompt is shown again
	!Password: 									I typed in our password
	!Last login: Tue Jul 31 11:59:06 from kawc09.on.bell.c
	!Sun Microsystems Inc.   SunOS 5.8       Generic Patch   October 2001
	!========================================================================================================================
	!	Trace-3
	!	The following is a sample transaction from TCPware's TELNET-Client with debugging turned on (NSR - 2007-08-01)
	!	I was connecting from "TCPware-5.7-2 on OpenVMS-8.2" to "TCPware-5.7-2 on OpenVMS-8.2"
	!========================================================================================================================
	!TELNET> set debug/class=all
	!%TCPWARE_TELNET-I-SHOWDBG, will show options processing
	!%TCPWARE_TELNET-I-SHOWDBG, will show terminal input
	!%TCPWARE_TELNET-I-SHOWDBG, will show network input
	!%TCPWARE_TELNET-I-SHOWDBG, will show network output
	!TELNET> open   142.180.39.15							this is where I started the connection
	!%TCPWARE_TELNET-I-TRYING, trying kawc15.on.bell.ca,telnet (142.180.39.15,23) ...
	!%TCPWARE_TELNET-I-ESCCHR, escape (attention) character is "^\"
	!
	!%TCPWARE_TELNET-I-OPTRECV, received WILL ECHO					far-end offers to ECHO
	!%TCPWARE_TELNET-I-SENT, sent DO ECHO						we say OK
	!%TCPWARE_TELNET-I-SENT, sent DO SUPPRESS-GO-AHEAD				we command far-end to SUPPRESS-GO-AHEAD
	!%TCPWARE_TELNET-I-SENT, sent WILL SUPPRESS-GO-AHEAD				we offer to SUPPRESS-GO-AHEAD
	!%TCPWARE_TELNET-I-OPTRECV, received WILL SUPPRESS-GO-AHEAD			we receive an ACK for DO SUPPRESS-GO-AHEAD
	!%TCPWARE_TELNET-I-OPTRECV, received DO SUPPRESS-GO-AHEAD			we receive an ACK
	!%TCPWARE_TELNET-I-OPTRECV, received DO TERMINAL-TYPE				we are asked if we can DO TERMINAL-TYPE
	!%TCPWARE_TELNET-I-SENT, sent WILL TERMINAL-TYPE				we say yes
	!%TCPWARE_TELNET-I-OPTRECV, received DO WINDOW-SIZE				we are asked if we can DO WINDOW-SIZE
	!%TCPWARE_TELNET-I-SENT, sent WILL WINDOW-SIZE					we say yes
	!%TCPWARE_TELNET-I-SENTSUBOPT, sent suboption SB WINDOW-SIZE 132 24 IAC SE	then elaborate further
	!%TCPWARE_TELNET-I-OPTRECV, received DO TERMINAL-SPEED				we are asked if we can DO TERMINAL-SPEED
	!%TCPWARE_TELNET-I-SENT, sent WILL TERMINAL-SPEED				we say yes
	!%TCPWARE_TELNET-I-OPTRECV, received DO TOGGLE-FLOW-CONTROL			we are requested to DO TOGGLE-FLOW-CONTROL
	!%TCPWARE_TELNET-I-SENT, sent WILL TOGGLE-FLOW-CONTROL				we ack that request
	!
	!
	!*** WARNING ***
	!
	!      THE  PROGRAMS  AND  DATA STORED ON THIS SYSTEM ARE LICENSED TO OR ARE
	!      PRIVATE  PROPERTY  OF THIS COMPANY AND ARE LAWFULLY AVAILABLE ONLY TO
	!%TCPWARE_TELNET-I-SUBOPTRECV, received suboption SB TERMINAL-TYPE SEND SE	we are asked our terminal type
	!%TCPWARE_TELNET-I-SENTSUBOPT, sent suboption SB TERMINAL-TYPE IS VT200 SE	so we send it
	!      AUTHORIZED  USERS  FOR  APPROVED PURPOSES. UNAUTHORIZED ACCESS TO ANY
	!      PROGRAM OR DATA ON THIS SYSTEM IS NOT PERMITTED, AND ANY UNAUTHORIZED
	!      ACCESS  BEYOND THIS POINT MAY LEAD TO PROSECUTION. THIS SYSTEM MAY BE
	!      MONITORED  AT ANY TIME FOR OPERATIONAL REASONS, THEREFORE, IF YOU ARE
	!      NOT AN AUTHORIZED USER, DO NOT ATTEMPT TO LOGIN.
	!
	!      LES  PROGRAMMES  ET  LES  DONNEES  STOCKES DANS CE SYSTEME SONT VISES
	!      PAR  UNE  LICENCE  OU SONT PROPRIETE PRIVEE DE CETTE COMPAGNIE ET ILS
	!      NE  SONT  ACCESSIBLES  LEGALEMENT QU'AUX USAGERS AUTORISES A DES FINS
	!      AUTORISEES.  IL  EST  INTERDIT D'Y ACCEDER SANS AUTORISATION, ET TOUT
	!      ACCES NON AUTORISE AU DELA DE CE POINT PEUT ENTRAINER DES POURSUITES.
	!      LE  SYSTEME  PEUT  EN TOUT TEMPS FAIRE L'OBJET D'UNE SURVEILLANCE. SI
	!      VOUS N'ETES PAS UN USAGER AUTORISE, N'ESSAYEZ PAS D'Y ACCEDER.
	!
	!%TCPWARE_TELNET-I-SUBOPTRECV, received suboption SB TERMINAL-SPEED SEND SE	we are asked our terminal speed
	!%TCPWARE_TELNET-I-SENTSUBOPT, sent suboption SB TERMINAL-SPEED IS 9600,9600 SE we send it
	!Username: neil									far-end prompt (from OpenVMS)
	!Password:
	!==========================================================================================
	!	get timer bit vector
	!	(see OpenVMS system systevices documentation for "sys$wflor")
	!
	!	notes:	cluster	event flags
	!		0	00- 31
	!		1	32- 63
	!		2	64- 95
	!		3	96-127
	!==========================================================================================
32010	function long get_timer_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								! this code will avoid an integer overflow
	    case 31								! need to set bit #31
!					 33222222222211111111110000000000
!					 10987654321098765432109876543210
		get_timer_bit_vector = B"10000000000000000000000000000000"L	! so return this
	    case else								!
		get_timer_bit_vector = (2% ^ temp)				! else return this
	end select								!
	!
	end function								! get_timer_bit_vector
	!
	!===================================================================================================================
	! Title  : Wcsm_DT_Stamp16.inc
	! Author : Neil S. Rieck
	! Purpose: an external function to return a y2k compliant system time in the form ccyymmddhhmmsstt (16 chars)
	! Notes  : all our programs call this function so optimizations here will speed up the whole system
	! History:
	! 100h NSR 070704 1. created this function from Wcsm_DT_Stamp15 by adding hundredth digit
	!===================================================================================================================
32020	function string Wcsm_DT_Stamp16						!
	option   type=explicit							! cuz tricks are for kids...
	declare long sys_status 						!
	!
	%include "starlet"      %from %library "sys$library:basic$starlet"	! system services
	%include "$ssdef"       %from %library "sys$library:basic$starlet"	! ss$
	!
	!	this map is required for the call to sys$asctim (format: 19-JUN-1998 23:59:59.1)
	!
	map (WcsmDTStamp0)	string	Sys_buf_23	= 23,	!	&
					Sys_align	=  0	!
	map (WcsmDTStamp0)	string	Sys_day		=  2,	!	&
					Sys_dash1	=  1,	!-	&
					Sys_month	=  3,	!	&
					Sys_dash2	=  1,	!-	&
					Sys_year	=  4,	!	&
					Sys_space	=  1,	!	&
					Sys_Hour	=  2,	!	&
					Sys_colon1	=  1,	!:	&
					Sys_Minute	=  2,	!	&
					Sys_colon2	=  1,	!:	&
					Sys_Second	=  2,	!	&
					Sys_period	=  1,	!.	&
					Sys_Tenth	=  1,	!	&
					Sys_Hundredth	=  1,   !	&
					Sys_align	=  0	!
	!
	!	map for Wcsm date (output)
	!
	map (WcsmDTStamp1)	string	Wcsm_buf_16	= 16,	!	&
					Wcsm_align	=  0	!
	map (WcsmDTStamp1)	string	Wcsm_year	=  4,	!	&
					Wcsm_month	=  2,	!	&
					Wcsm_day	=  2,	!	&
					Wcsm_Hour	=  2,	!	&
					Wcsm_Minute	=  2,	!	&
					Wcsm_Second	=  2,	!	&
					Wcsm_Fraction	=  2,	!	&
					Wcsm_align	=  0	!
	map (WcsmDTStamp1)	string	Wcsm_year	=  4,	!	&
					Wcsm_month_tens	=  1,	!	&
					Wcsm_month_ones	=  1,	!	&
					Wcsm_day_tens	=  1,	!	&
					Wcsm_day_ones	=  1,	!	&
					Wcsm_Hour	=  2,	!	&
					Wcsm_Minute	=  2,	!	&
					Wcsm_Second	=  2,	!	&
					Wcsm_Tenth	=  1,	!	&
					Wcsm_Hundredth	=  1,	!	&
					Wcsm_align	=  0	!
	!
	!	string constants
	!					  00000000011111111112222222222333333333
	!					  12345678901234567890123456789012345678
	declare string constant k_month_names$ = "XXJANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC"
	!					  ||
	!					  ++-- so I don't have to provide an offset in pos()
	declare string constant my_space = '32'C
	!
	!	<<< function 'code' starts here >>>
	!
	when error in								!
		!
		sys_status = sys$asctim(,Sys_buf_23,,)				! get ASCII time into sys_buf_23
!~~~		if (sys_status and 7%) <> 1% then cause error 11		x  not required - call will never fail
		!
		!	transfer data from one map to the other
		!
		Wcsm_year	= Sys_year					!
!~~~	rset	Wcsm_month	= str$( pos(k_month_names$,Sys_Month,1%) / 3%)	x					bf_100f
		Wcsm_day	= Sys_day					!
		Wcsm_hour	= Sys_hour					!
		Wcsm_minute	= Sys_minute					!
		Wcsm_second	= Sys_second					!
		Wcsm_tenth	= Sys_tenth					!					bf_100g
		Wcsm_hundredth	= Sys_Hundredth					!					bf_100h
		!
		declare long temp%						!					bf_100f
		temp% = pos(k_month_names$,Sys_Month,1%) / 3%			! compute month number			bf_100f
		if temp% < 10% then						! if less than 10...			bf_100f
		    Wcsm_month_ones	= str$(temp%)				! ...then this goes into ONES		bf_100f
		    Wcsm_month_tens	= "0"					! ...and this goes into TENS		bf_100f
		else								! else >= 10				bf_100f
		    Wcsm_month		= str$(temp%)				!					bf_100f
		end if
		!
		!	make sure there are no spaces in the TENS area of our mapped variables (pad with '0' if necessary)
		!
!~~~		Wcsm_month_tens = "0"	if Wcsm_month_tens	= my_space	x disabled - see above code		bf_100f
		Wcsm_day_tens	= "0"	if Wcsm_day_tens	= my_space	!
		!
		!	now pass result back to caller
		!
		Wcsm_DT_Stamp16 = Wcsm_Buf_16					! this is it folks
	use
		Wcsm_DT_Stamp16 = ""						! error so return blank
	end when
	!
	END Function