OpenVMS Source Code Demos
TCPIP$TCP_CLIENT_QIO_2014B
1000 %title "tcpip$tcp_client_qio_2014b.bas"
%ident "100.1"
declare string constant k_program = "tcpip$tcp_client_qio_2014b"
!========================================================================================================================
! title : tcpip$tcp_client_qio_2014b_100.bas
! author : Neil Rieck ( https://neilrieck.net )
! : (c) copyright 1999,2014 Neil Rieck
! : Waterloo, Ontario, Canada.
! created : 2014-07-31
! references : HP TCP/IP Services for OpenVMS
! Sockets API and System Services Programming (manual: BA548-90002)
! notes : 1. stack programming on VMS and OpenVMS can be done by "Sockets API" (easier) or
! "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
! OS : OpenVMS (Alpha or Itanium) or VMS on VAX
! Stack : TCP/IP Services V5.0 or higher (but should work with any stack after a few mods)
! compile : $ bas tcpip$tcp_client_qio_2014a_100.bas
! link : $ link tcpip$tcp_client_qio_2014a_100
! history :
! ver who when what
! --- --- ------ --------------------------------------------------------------------------------------------------------
! 100 NSR 140804 0. started with TCPIP$TCP_CLIENT_QIO_2014A_100.BAS
! 1. added code to perform gethostbyname
!========================================================================================================================
option type=explicit ! formal coding
set no prompt !
on error goto common_trap ! old school trapping for this demo
!
external long function htonl(long) ! host to network long
external long function htons(word) ! host to network short
external long function qtol(quad) ! quad to long
external long function parse_dest(string,string) !
external long function my_gethostbyname(string by desc, long dim() by ref)
!
%include "starlet" %from %library "sys$library:basic$starlet" ! system services
%include "$ssdef" %from %library "sys$library:basic$starlet" ! ss$
%include "$iodef" %from %library "sys$library:basic$starlet" ! io$
%include "$efndef" %from %library "sys$library:basic$starlet" ! efn$
%include "lib$routines" %from %library "sys$library:basic$starlet" ! lib$
%include "$libdef" %from %library "sys$library:basic$starlet" ! eg. lib$_normal
%include "$iledef" %from %library "sys$library:basic$starlet" ! ile3$ (Item List Entry 3 structures)
!~~~ %include "$iosbdef" %from %library "sys$library:basic$starlet" x iosb$ (iosb structures)
!
! I need the following iosb to get around a limitation found in the BASIC version of starlet
! (the library definition of sys$qio requires a quad datatype for iosb)
!
! question : How did I know?
! answer : Hacking
! reference: https://neilrieck.net/docs/openvms_notes_hacking_starlet.html
!
record my_iosb_rec !
variant !
case ! vanilla
group one !
word iosb$w_status !
word iosb$w_bcnt !
long iosb$l_dev_depend !
end group !
case ! used in sys$getqui
group two !
long iosb$l_getxxi_status !
long iosb$l_reserved !
end group !
case ! used to satisfy the compiler
group three !
basic$quadword iosb$quad ! unsigned quad word (system calls)
end group !
end variant !
end record !
%include "sys$library:TCPIP$INETDEF.BAS" ! need this for various inet constants etc.
!
record my_sockchar_rec ! socket characteristics (record definition)
word sc_prot ! protocol
byte sc_type ! type
byte sc_af ! address family
end record !
!
record my_itmlst2_rec ! item-list 2 descriptor
word il2_length ! length
word il2_type !
long il2_address !
end record !
!
! named constants
!
declare long constant TCPBUFSIZ = 8192 ! buffer size (no larger than 32767)
declare long constant USRBUFSIZ = 512 ! user input buffer size
declare word constant SERV_PORTNUM = 80 ! server port number (80=http)
!
! declare variables
!
map(recv)string buffer_r = TCPBUFSIZ !
map(xmit)string buffer_w = TCPBUFSIZ !
!
declare my_iosb_rec iosb ! i/o status block
declare my_sockchar_rec conn_sockchar ! connection socket characteristics buffer
declare SOCKADDRIN serv_addr ! server socket address inet structure
declare my_itmlst2_rec serv_itemlst !
declare word conn_channel !
declare quad junk64 !
declare long ip_address !
declare long rc !
declare long bytes_w !
declare long readcount !
declare long bytes_r !
declare long bytes_r_total !
declare string msg$ !
declare string inet_device !
declare string dest$ !
declare string path$ !
declare string octet$(3) !
declare long octet(3) !
declare long junk% !
declare long junk1 !
declare long junk2 !
declare long dest_kind !
declare long i% !
!
!=======================================================================
! main
!=======================================================================
2000 main:
print
print "-i-program: "+ k_program
print "-i-this program will connect to a website on port "+ str$(SERV_PORTNUM)
!
! initialize variables
!
inet_device = "TCPIP$DEVICE:" !
!
conn_sockchar::sc_prot = TCPIP$C_TCP ! init (local) connection socket
conn_sockchar::sc_type = TCPIP$C_STREAM !
conn_sockchar::sc_af = TCPIP$C_AF_INET !
!
declare word sck_parm(2)
sck_parm(0) = TCPIP$C_TCP
sck_parm(1) = INET_PROTYP$C_STREAM
!
serv_addr::SIN$W_FAMILY = TCPIP$C_AF_INET ! init (remote) connection socket
serv_addr::SIN$W_PORT = htons(SERV_PORTNUM) !
!
get_dest:
print "-i-Menu:"
print " 1 = 142.180.221.226"
print " 2 = kawc96.on.bell.ca"
print " Q = quit"
print " or anything else (eg. www3.sympatico.ca )"
print " (eg. neilrieck.net/)"
print
print "-?-destination? ";
input dest$
dest$ = edit$(dest$,2) ! no white space
select dest$ !
case "1" !
dest$ = "142.180.221.226" !
case "2" !
dest$ = "kawc96.on.bell.ca" !
case else !
goto fini if len(dest$) <= 1 ! "Q", "q", etc.
end select !
!
3000 dest_kind = parse_dest(dest$, path$) ! all three params will be modified
!
if dest_kind = 0 then !
print "-e-error, your input data is not useable" !
goto get_dest !
end if !
!-----------------------------------------------------------------------
if dest_kind = 1 then ! we "know" this is an IPv4 address
junk1 = 0 ! init
for i% = 0 to 3 ! sc
junk2 = pos(dest$, ".", junk1+1) !
junk2 = len(dest$)+1 if junk2 = 0 !
octet$(i%) = seg$(dest$,junk1+1,junk2-1) !
junk1 = junk2 ! reference pt moves along
next i% !
when error in !
junk64 = integer(octet$(0)) * 16777216 + ! 2^24 &
integer(octet$(1)) * 65536 + ! 2^16 &
integer(octet$(2)) * 256 + ! 2^8 &
integer(octet$(3)) ! 2^0
use !
junk64 = 0 !
end when !
if junk64 = 0 then !
print "-e-error:";err;"during data conversion" !
goto get_dest !
end if !
end if !
!-----------------------------------------------------------------------
if dest_kind = 2 then ! we think this might be a dns name
rc = my_gethostbyname(dest$, octet()) !
if ((rc and 7%) <> 1) then !
print "-e-dns lookup failed with status:";rc !
goto get_dest !
end if !
when error in !
junk64 = octet(0) * 16777216 + ! 2^24 &
octet(1) * 65536 + ! 2^16 &
octet(2) * 256 + ! 2^8 &
octet(3) ! 2^0
use !
junk64 = 0 !
end when !
if junk64 = 0 then !
print "-e-error:";err;"during data conversion" !
goto get_dest !
end if !
end if !
!-----------------------------------------------------------------------
ip_address = qtol (junk64) !
serv_addr::SIN$L_ADDR = htonl (ip_address) ! eg. 142.180.221.226
!
serv_itemlst::il2_length = SIN$K_LENGTH ! need size of serv_addr (SOCKADDRIN)
serv_itemlst::il2_type = TCPIP$C_SOCK_NAME !
serv_itemlst::il2_address = loc(serv_addr) ! need addr of serv_addr
!
! create socket (part 1/2)
!
4000 print "-i-creating socket (assign)" !
rc = sys$assign(inet_device, conn_channel,,) !
if (rc and 7%) <> 1% then !
print "-e-error:";rc;"while assigning channel to TCPIP device" !
end if !
!
! create socket (part 2/2)
!
4010 print "-i-creating socket (qio)"
rc = sys$qiow( EFN$C_ENF, ! event flag &
conn_channel, ! i/o channel &
IO$_SETMODE, ! i/o function code &
iosb::iosb$quad, ! i/o status block &
, ! ast service routine &
, ! ast parameter &
conn_sockchar, ! p1 - socket characteristics &
, ! p2 &
, ! p3 &
, ! p4 &
, ! p5 &
! p6 &
) !
if (rc and 7%) = 1% then ! if the system call queued properly
rc = iosb::iosb$w_status ! then we want to check the final result
end if !
if (rc and 7%) <> 1% then !
print "-e-error:";rc;"while creating socket" !
end if !
!
! connect to server
!
4020 print "-i-connecting to host"
rc = sys$qiow( EFN$C_ENF, ! event flag &
conn_channel, ! i/o channel &
IO$_ACCESS, ! i/o function code &
iosb::iosb$quad, ! i/o status block &
, ! ast service routine &
, ! ast parameter &
, ! p1 &
, ! p2 &
loc(serv_itemlst), ! p3 - remote socket info &
, ! p4 &
, ! p5 &
! p6 &
) !
if (rc and 7%) = 1% then ! if the system call queued properly
rc = iosb::iosb$w_status ! then we want to check the final result
end if !
if (rc and 7%) <> 1% then !
print "-e-error:";rc;"while connecting to server" !
end if !
!
! send a message to retrieve the default web page
!
! eg. something like: GET / HTTP/1.0"
! or: GET /n.rieck HTTP/1.0"
!
!~~~ msg$ = "GET / HTTP/1.0" + cr + lf + cr + lf x a blank line marks the end of an HTTP block
path$ = "/" if path$ = "" !
msg$ = "GET "+ path$ +" HTTP/1.0" + cr + lf + cr + lf ! a blank line marks the end of an HTTP block
bytes_w = len(msg$) ! determine the data length
buffer_w = msg$ ! xref data to buffer for qio
!
4030 print "-i-sending data: ";msg$
rc = sys$qiow( EFN$C_ENF, ! event flag &
conn_channel, ! i/o channel &
IO$_WRITEVBLK, ! i/o function code &
iosb::iosb$quad, ! i/o status block &
, ! ast service routine &
, ! ast parameter &
buffer_w, ! p1 buffer address &
bytes_w, ! p2 buffer length (to send) &
, ! p3 &
, ! p4 &
, ! p5 &
! p6 &
) !
if (rc and 7%) = 1% then ! if the system call queued properly
rc = iosb::iosb$w_status ! then we want to check the final result
end if !
if (rc and 7%) <> 1% then !
print "-e-error:";rc;"while sending to server" !
end if !
!
! read the response
!
4040 print "-i-receiving data"
readcount = 0 ! init loop counter
bytes_r_total = 0 !
!
read_loop:
bytes_r = 0 ! init
readcount = readcount + 1
print "-i-receiving count:";readcount
print " -------------------"
rc = sys$qiow( EFN$C_ENF, ! event flag &
conn_channel, ! i/o channel &
IO$_READVBLK, ! i/o function code &
iosb::iosb$quad, ! i/o status block &
, ! ast service routine &
, ! ast parameter &
buffer_r, ! p1 buffer address &
TCPBUFSIZ, ! p2 buffer length (to send) &
, ! p3 &
, ! p4 &
, ! p5 &
! p6 &
) !
if (rc and 7%) = 1% then ! if the system call queued properly
rc = iosb::iosb$w_status ! then we want to check the final result
end if !
if (rc and 7%) <> 1% then !
select rc !
case 8428 ! this fatal error is normal for the web
print "-w-status:";rc;"network partner disconnected logical link"
case else !
print "-e-error:";rc;"while reading from server" !
end select !
else !
bytes_r = iosb::iosb$w_bcnt ! get the actual number of bytes xfer'd
print left$(buffer_r,bytes_r) ! output that amount
bytes_r_total = bytes_r_total + bytes_r ! also add to total
if (bytes_r > 0) and &
(readcount < 100) then ! if not too crazy
goto read_loop ! yeah, I know, bad form (but this is just a demo)
end if !
end if !
print "-i-total bytes received:";bytes_r_total
!
! shutdown
!
print "-i-shutting down the socket"
rc = sys$qiow( EFN$C_ENF, ! event flag &
conn_channel, ! i/o channel &
IO$_DEACCESS or IO$M_SHUTDOWN, ! i/o function code &
iosb::iosb$quad, ! i/o status block &
, ! ast service routine &
, ! ast parameter &
, ! p1 &
, ! p2 &
, ! p3 &
, ! p4 &
TCPIP$C_DSC_ALL, ! p5 &
! p6 &
) !
if (rc and 7%) = 1% then ! if the system call queued properly
rc = iosb::iosb$w_status ! then we want to check the final result
end if !
if (rc and 7%) <> 1% then !
print "-e-error:";rc;"during socket shutdown" !
end if !
!
! close the socket
!
print "-i-closing the socket"
rc = sys$qiow( EFN$C_ENF, ! event flag &
conn_channel, ! i/o channel &
IO$_DEACCESS , ! i/o function code &
iosb::iosb$quad, ! i/o status block &
, ! ast service routine &
, ! ast parameter &
, ! p1 &
, ! p2 &
, ! p3 &
, ! p4 &
, ! p5 &
! p6 &
) !
if (rc and 7%) = 1% then ! if the system call queued properly
rc = iosb::iosb$w_status ! then we want to check the final result
end if !
if (rc and 7%) <> 1% then !
print "-e-error:";rc;"during socket shutdown" !
end if !
!
! deassign the socket
!
rc = sys$dassgn(conn_channel) !
if (rc and 7%) <> 1% then !
print "-e-error:";rc;"during deassign" !
end if !
!
goto fini ! that's all she wrote...
!
! old-school common trap (normally you would only use inline "when error / use / end when" blocks
!
common_trap:
print
print "common error trap" !
print "-i-line ";erl !
print "-i-error ";err !
print "-i-text ";ert$(err) !
resume fini ! fix the stack
!
fini:
print "-i-adios..." !
32000 end !
!
!########################################################################################################################
! external functions
!########################################################################################################################
!
!=======================================================================
! host to network short
! OpenVMS is little endian but the network is big endian
!=======================================================================
32010 function word htons(word inbound) !
option type=explicit !
!
map(htons0) word sw0_word0
map(htons0) byte sw0_byte0 , &
byte sw0_byte1
!
map(htons1) word sw1_word0
map(htons1) byte sw1_byte0 , &
byte sw1_byte1
!
sw0_word0 = inbound !
sw1_byte0 = sw0_byte1 !
sw1_byte1 = sw0_byte0 !
htons = sw1_word0 ! presto
end function !
!
!=======================================================================
! host to network long
! OpenVMS is little endian but the network is big endian
!=======================================================================
32020 function long htonl(long inbound) !
option type=explicit !
!
map(htonl0) long sw0_long0
map(htonl0) word sw0_word0 , &
word sw0_word1
map(htonl0) byte sw0_byte0 , &
byte sw0_byte1 , &
byte sw0_byte2 , &
byte sw0_byte3
!
map(htonl1) long sw1_long0
map(htonl1) word sw1_word0 , &
word sw1_word1
map(htonl1) byte sw1_byte0 , &
byte sw1_byte1 , &
byte sw1_byte2 , &
byte sw1_byte3
!
sw0_long0 = inbound
sw1_byte0 = sw0_byte3
sw1_byte1 = sw0_byte2
sw1_byte2 = sw0_byte1
sw1_byte3 = sw0_byte0
htonl = sw1_long0 ! presto
end function !
!
!=======================================================================
! quad to long
! OpenVMS BASIC has no unsigned integers but we sometimes need to
! do 32-bit unsigned math. The lazy way is to do 64-bit math then
! trucate back to 32-bits (okay if the value is not too large)
!=======================================================================
32030 function long qtol(quad inbound) !
option type=explicit !
!
map(qtol) quad sw0_quad0
map(qtol) long sw0_long0 , &
long sw0_long1
!
sw0_quad0 = inbound !
qtol = sw0_long0 ! presto
if sw0_long1 <> 0 then ! this should never happen
print "-w-oops, information was lost during Quad->Long conversion)" !
end if !
end function !
!
!=======================================================================
! <<< parse_dest >>>
!
! examples:
! 1 input: "142.180.221.226" ??
! return: 1 "142.180.221.226" ""
! 2 input: "www3.sympatico.ca" ??
! return: 2 "www3.sympatico.ca" ""
! 3 input: "142.180.221.226/n.rieck/" ??
! return: 1 "142.180.221.226" "/n.rieck/"
! 4 input: "neilrieck.net/" ??
! return: 2 "www3.sympatico.ca" "/n.rieck/"
! 5 input: "abcd" ??
! return: 0 "" ""
! 6 input: "http://www3.sympatico.ca" ??
! return: 0 "" ""
! +------ 0 = unusable address
! +------ 1 = IP address
! +------ 2 = dns name
!=======================================================================
32040 function long parse_dest(string dest$, string path$) !
option type=explicit !
declare long dots ,&
nums ,&
alph ,&
othe ,&
slash_pos ,&
i% ,&
result
!-----------------------------------------------------------------------
main:
result = 0 ! assume the worst (unusable)
!
print "-i-";dest$
slash_pos = pos(dest$, "/", 1) ! any slashes here?
if slash_pos > 0 then ! yes
path$ = right$(dest$,slash_pos) !
dest$ = left$( dest$,slash_pos - 1) !
else ! no
path$ = "" !
end if !
!
for i% = 1 to len(dest$) ! prescan the destination
select mid$(dest$, i%, 1) !
case "." !
dots = dots + 1 !
case "0" to "9" !
nums = nums + 1 !
case "a" to "z" !
alph = alph + 1 !
case else !
othe = othe + 1 !
end select !
next i% !
!
goto data_unusable if othe > 0 ! we can't use this data
!
! eg. "142.180.221.226"
!
if dots=3 and nums>=4 and alph=0 then ! hey, might be IP4
result = 1 !
goto function_exit !
end if !
!
! eg. "bell.ca" or "www3.sympatico.ca"
!
if dots>0 and alph>=3 then ! hey, might be a dns
result = 2 !
goto function_exit !
end if !
!
data_unusable:
dest$ = "" !
path$ = "" !
result = 0 !
!
! result must be set before this point
!
function_exit: !
parse_dest = result !
end function !
!
!=======================================================================
! <<< my get host by name >>>
!
! author : Neil Rieck
! created: 2014-08-04
! notes : derived from my demo: GET_HOST_BY_NAME_QIO.BAS
!=======================================================================
32050 function long my_gethostbyname(string dns_name$, long octets() by ref) !
option type=explicit ! cuz tricks are for kids
!
! <<< external declarations >>>
!
%include "starlet" %from %library "sys$library:basic$starlet" ! system services
%include "$ssdef" %from %library "sys$library:basic$starlet" ! ss$
%include "$iodef" %from %library "sys$library:basic$starlet" ! io$
%include "lib$routines" %from %library "sys$library:basic$starlet" ! lib$
%include "$dscdef" %from %library "sys$library:basic$starlet" ! descriptor stuff
!~~~ %include "sys$library:ucx$inetdef.bas" x ucx defs (for tcpip < v5.0)
%include "sys$library:tcpip$inetdef.bas" ! tcpip defs (for tcpip >= v5.0)
!~~~ %include "$iosbdef" %from %library "sys$library:basic$starlet" x iosb$ (iosb structures)
!
! I need this iosb to get around a limitation in the BASIC version of starlet
!
! question : How did I know?
! answer : Hacking
! reference: https://neilrieck.net/docs/openvms_notes_hacking_starlet.html
!
! my I/O Status Block (record)
!
record myIosbRec !
variant !
case !
group one ! 32-bit structure
!
! Manual: "Compaq TCP/IP Services for OpenVMS"
! Chapter "Sockets API and System Services Programming"
! Example 2-25: BIND Lookup (System Services)
!
word iosb$w_status ! 16-bit status
word iosb$w_bcnt ! 16-bit byte count
long iosb$l_dev_depend ! 32-bit device dependent data
end group one !
case !
group two !
basic$quadword iosb$quad ! unsigned quad word (system calls)
end group two !
end variant !
end record myIosbRec !
!
! <<< home brewed functions >>>
!
external long function get_timer_bit_vector(long) ! required for used with SYS$WFLOR
!
! <<< variable declarations >>>
!
declare long rc% , ! return code &
junk% , ! &
ptr% , ! &
i% , ! &
j% , ! &
timeout_count% , ! &
tcp_event_flag% , ! tcp event flag &
tcp_ef_state% , ! tcp event flag state &
mask% , ! &
my_switch% , ! &
word channel_0 , ! INET channel &
bytecnt , ! &
long command , ! INET command &
basic$QuadWord DeltaQuad , ! for sys$bintim &
myIosbRec myIosb , ! &
HostEntDef myHostEnt , ! see: sys$library:tcpip$inetdef.bas &
NetEntDef myNetEnt , ! see: sys$library:tcpip$inetdef.bas &
string buffer$ , ! &
junk$ !
!
!=======================================================================
! main
!=======================================================================
main: !
!
! <<< allocate some event flags for later use >>>
!
if tcp_event_flag% = 0 then ! if not yet allocated
rc% = lib$get_EF( tcp_event_flag% ) ! allocate an event flag
if ((rc% and 7%) <> 1) then !
print "lib$get_EF-1 rc: ";str$(rc%) !
goto rc_exit !
end if !
end if !
!
! <<< prep >>>
!
declare string inet_dev ! dynamic string descriptor (good)
inet_dev = "TCPIP$DEVICE:" !
!
! Assign a channel to the TCPIP device
!
rc% = sys$assign(inet_dev, channel_0,,,) ! assign a channel
if ((rc% and 7%) <> 1%) then !
print "-e-Failed to assign channel to TCPIP device." !
goto rc_exit !
end if !
!
! we need a "long descriptor" to use io$_acpcontrol in a call to sys$qiow
! (I wonder which idiot decided to use a descriptor to pass a long integer?)
!
declare dscdef1 cmd_descriptor !
cmd_descriptor::DSC$W_MAXSTRLEN = 4 ! 4 bytes = long
cmd_descriptor::DSC$B_DTYPE = DSC$K_DTYPE_DSC ! general descriptor
cmd_descriptor::DSC$B_CLASS = DSC$K_CLASS_S ! static
cmd_descriptor::DSC$A_POINTER = loc(command) !
!
command = inetacp_func$c_gethostbyname + &
(inetacp$c_trans * 256) ! trans (binary address)
!~~~ buffer$ = space$( 4) x space for 4 binary bytes (IPv4)
buffer$ = space$(16) ! space for 16 binary bytes (IPv6)
!
!=======================================================================
! do a dns lookup (not timed so use sys$qiow)
!=======================================================================
rc% = sys$qiow( tcp_event_flag% , ! Event flag &
channel_0 , ! Channel number &
io$_acpcontrol , ! I/O function &
myIosb::iosb$quad , ! I/O status block &
, ! &
, ! &
cmd_descriptor , ! P1 needs to be a descriptor &
loc(dns_name$ ) , ! P2 &
loc(bytecnt ) , ! P3 &
loc(buffer$ ) , ! P4 &
, ! P5 &
) ! P6
if ((rc% and 7%) = 1%) then ! if the system call suceeded
!
! At this point (after calling TCP/IP routines via qio), the whole
! of myIosb is not the same as what we normally see in VMS (eg. 2160 = EOF = not enough buffer space)
!
!~~~ print "-i-iosb-iosb$w_status:"; str$(myIosb::iosb$w_status)
rc% = myIosb::iosb$w_status !
if ((rc% and 7%) = 1%) then !
if bytecnt = 0 then !
print "-w-no data returned" !
else !
for i% = 1 to bytecnt ! remember: we are "little endian"
!~~~ print "-i-octet"+str$(i%)+": "; asc(mid$(buffer$,i%,1)) !
octets(i%-1) = asc(mid$(buffer$,i%,1)) ! xfer binary bytes
next i% !
end if !
end if !
else !
print "-e-rc% ";str$(rc%) !
print "-e-Failed to do the DNS lookup" !
end if !
!
! do not change rc% after this point; use junk%
!
!=======================================================================
! Shut down the socket (optional)
!=======================================================================
shutdown:
junk% = sys$qiow( tcp_event_flag% , ! &
channel_0 , ! &
(IO$_DEACCESS or IO$M_SHUTDOWN) , ! &
myIosb::iosb$quad , ! &
, , ! &
, , , ! &
TCPIP$C_DSC_ALL, ! P4 Discard all packets &
, ) !
if ((junk% and 1%) <> 1%) then !
print "-e-Failed to shut down the socket" !
end if !
!
! Close the sockets
!
junk% = sys$qiow( tcp_event_flag% , ! &
channel_0 , ! &
IO$_DEACCESS , ! &
myIosb::iosb$quad , ! &
, , , , , , , ) !
if ((junk% and 1%) <> 1%) then !
print "-e-Failed to close the socket." !
end if !
!
! Deassign the TCPIP device channels
!
junk% = sys$dassgn(channel_0) !
if ((junk% and 1%) <> 1%) then !
print "-e-Failed to deassign the channel" !
end if !
!
goto rc_exit
!=======================================================================
! cleanup
! caveat: rc% must be preserved so use junk%
!=======================================================================
cleanup:
if tcp_event_flag% <> 0 then ! if allocated
junk% = lib$free_EF( tcp_event_flag% ) ! allocate an event flag
tcp_event_flag% = 0 !
end if !
return !
!
! rc% must be set up before this point
!
rc_exit:
gosub cleanup !
my_gethostbyname = rc% !
end function !
!======================================================================
! 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
!======================================================================
32060 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
!------------------------------------------------------------------------------------------------------------------------