OpenVMS Source Code Demos
tcpip$tcp_client_qio_2014f
1000 %title "tcpip$tcp_client_qio_2014f_xxx.bas" !
%ident "version_108.1" !
declare string constant k_version = "108.1" , &
k_program = "tcpip$tcp_client_qio_2014f" !
!========================================================================================================================
! title : tcpip$tcp_client_qio_2014f
! author : Neil Rieck (mailto:n.rieck@bell.net)
! 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 1 : $ bas tcpip$tcp_client_qio_2014f_108.bas (where 108 is the version number)
! compile 2 : $ bas [.inc]wcsm_tcp_functions_108.bas
! link : $ link tcpip$tcp_client_qio_2014e_108, -
! wcsm_tcp_functions_108
! 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
! 6. The F clinet demo (non-public) breaks the code into maintainable pieces for the ICSIS system
! 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)
! 108 NSR 140905 1. break up the code into maintainable includes for the ICSIS system
! NSR 180111 2. added function ipv4_to_string()
!========================================================================================================================
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
!
external string function ipv4_to_string(long) !
%include "[.inc]wcsm_tcp_support_108.inc" ! constants, record defs, library defs
! nsr_adr_prep(), nsr_tcp_prep(), nsr_tcp_open(), etc.
!
! 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 ipv4_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
!=======================================================================
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-Destination Menu:"
print " 1 = 142.180.221.226 (OpenVMS-8.4)"
print " 2 = kawc96.on.bell.ca (OpenVMS-8.4)"
print " 3 = 142.180.221.246 (Solaris-8 )"
print " 4 = kawc3w.on.bell.ca (Solaris-8 )"
print " 5 = 142.180.221.251 (OpenVMS-8.4)"
print " 6 = kawc09.on.bell.ca (OpenVMS-8.4)"
print " or any string (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 !
!
ipv4_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" !
print "-i-ipv4_address: ";ipv4_address; !
print "(";ipv4_to_string(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" !
print "-i-ipv4_address: ";ipv4_address; !
print "(";ipv4_to_string(ipv4_address);")"
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 ! must be HTTP
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
!
rc = nsr_tcp_open(debug, ncv, ipv4_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
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 x
print "-i-error ";err !
print "-i-text ";ert$(err) !
rc = 2 ! VMS-e-
resume rc_exit ! fix the stack
!
32000 fini:
rc = 1 ! VMS-s-
rc_exit: !
!~~~ junk% = nsr_tcp_release
print "-i-adios..." !
end program rc ! <<<--- return exit code to DCL
!
!########################################################################################################################
! external functions
!########################################################################################################################
! vms-basic functions that used to be here were moved to file: [.inc]WCSM_TCP_FUNCTIONS_108.bas
! compile 1 : $ bas tcpip$tcp_client_qio_2014f_108.bas
! compile 2 : $ bas [.inc]wcsm_tcp_functions_108.bas
! link : $ link tcpip$tcp_client_qio_2014e_108, -
! wcsm_tcp_functions_108
!
!=======================================================================
! ip4v_to_string
32040 !=======================================================================
function string ipv4_to_string(long ipv4) !
option type=explicit !
record twoway !
variant
case
group zero
string hack = 4
end group zero
case
group one
long ip4v_address
end group one
end variant
end record twoway !
!
declare twoway hack
declare long i,j
declare string temp$
!
hack::ip4v_address = ipv4 ! xfer to overlay
temp$ = "" ! init
for i = 4 to 1 step -1 ! scan
j = ascii( mid$(hack::hack,i,1)) !
temp$ = temp$ + str$(j) !
temp$ = temp$ + "." if i <> 1 !
next i !
ipv4_to_string = temp$ ! xfer data back
end function !
!================================================================================
Back to HomeNeil Rieck
Waterloo, Ontario, Canada.