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:[email protected]) ! 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.