[Info-vax] message communication (VMS <> PC)
Richard Maher
maher_rj at hotspamnotmail.com
Wed Jan 27 07:06:34 EST 2010
Hi Rich,
"Rich Jordan" <jordan at ccs4vms.com> wrote in message
news:d2634eae-40f9-4105-abfb-6f6e52e3e1e9 at h9g2000yqa.googlegroups.com...
On Jan 22, 5:35 pm, "Richard Maher" <maher... at hotspamnotmail.com>
wrote:
[
The server was on a PC; I needed code to allow a VMS client (one per
customer) to talk to that server, and I needed it within a couple of
hours, and I hadn't written network code in 15 years, and it had to be
in BASIC. NETlib won; one neat little library with one include file
and very few simple calls just perfect for our application programmers
to use.
]
Sounds like a win to me, well done.
As one of the all time great VMSers once said to me (when I paid him the
money I owed him :-) "All's well that ends".
[
I have no doubt I could punch it out using QIOs ( and fairly
easily if they would let me use Fortran) but it would have taken quite
a bit longer and I'd have spent lots of time re-learning something I
probably won't get an opportunity to use again for a long, long time.
Just the way it is.
]
TCP/IP $QIOs are much easier than you think and there are people on the net
*even here* that could show you examples in BASIC that would make you kick
yourself, but the business requirement was satisfied and no one (outside of
HP/VMS that is) has a budget for tinkering anymore :-( so, again, well done.
[
As it was we did run into a BASIC limitation anyway; no UNSIGNED WORD
data type, which made even some of the NETlib interface code a little
clumsy. However that didn't pose a problem for the particular
application.
No thanks on the Cobol; gives me a headache and as you noted there are
copious examples around if I need to do some again.
]
Shame! COBOL, as of Alpha, supports unsigned integers but Rdb's lack of
support can be a pain. Anyway, I will include a simple COBOL client example
at the bottom so take a couple of Aspirin or look away now :-) Personally, I
also find BASIC's lack of local heap storage a pain in the arse!
[
Enjoy your vacation.
]
Had a ball! Couple of caves, several beaches, wineries and a brewery.
Ice-cream, cheese, and fudge eating. Live bands, fishing, heaps of stuff for
adults and kids. And it's not my fault that I've never heard of a Quenda
before. I defy any of you not to throw a thong at one if you find it
circling your esky! (I still think it's a sort of Madivian Tree Hampster
conspiracy)
Cheers Richard Maher
Here's an easy TCP/IP Client: -
****************************************************************************
********
*
*
* COPYRIGHT (c) BY TIER3 SOFTWARE LTD. ALL RIGHTS RESERVED.
*
*
*
* THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
ONLY *
* IN ACCORDANCE WITH THE TERMS AND CONDITIONS OF SUCH LICENSE AND WITH
THE *
* THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY
OTHER *
* COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO
ANY *
* OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS
HEREBY *
* TRANSFERRED.
*
*
*
* THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
AND *
* SHOULD NOT BE CONSTRUED AS A COMMITMENT BY TIER3 SOFTWARE LTD.
*
*
*
****************************************************************************
********
*+
* Facilility: DEMO_CLIENT_TCP_IP
*
* Abstract: This is an example of a VMS client program communicating with
a remote task
* via TIER3. This program accepts a queue entry number from the
user and sends
* it to the remote Tier3 communication server for this
application (T3_DEMO).
* After Tier3 has allocated an execution server to perform the
operation the
* USER_RECV routine is called to retrieve the job entry
information and return
* the results to the client.
*
* Overview: Due to the fact that client programs can communicate with
Tier3 servers using
* standard TCP/IP Socket Level programming, no Tier3 specific
software need be
* installed on the client node. In this example the client will
execute under
* the VMS operating system so VMS system services have been
used for client task
* development.
*
* Build example:
* $COBOL/LIST DEMO_CLIENT_TCP_IP
* $MACRO/LIST DEMO_TCP_IP_DEF
* $LINK DEMO_CLIENT_TCP_IP, DEMO_TCP_IP_DEF
* $SET TERM/WIDTH = 132
* $RUN DEMO_CLIENT_TCP_IP
*-
identification division.
program-id. demo_client_tcp_ip.
data division.
working-storage section.
01 io$_setmode pic s9(9) comp value external
io$_setmode.
01 io$_writevblk pic s9(9) comp value external
io$_writevblk.
01 io$_readvblk pic s9(9) comp value external
io$_readvblk.
01 ucx$c_msg_blockall pic s9(9) comp value external
ucx$c_msg_blockall.
01 io$_access pic s9(9) comp value external
io$_access.
01 lib$_normal pic s9(9) comp value external
lib$_normal.
01 ss$_linkdiscon pic s9(9) comp value external
ss$_linkdiscon.
01 ss$_bufferovf pic s9(9) comp value external
ss$_bufferovf.
01 ss$_abort pic s9(9) comp value external
ss$_abort.
01 ss$_reject pic s9(9) comp value external
ss$_reject.
01 ss$_nopriv pic s9(9) comp value external
ss$_nopriv.
01 ss$_normal pic s9(9) comp value external
ss$_normal.
01 sys_status pic s9(9) comp.
*
01 net_chan pic s9(4) comp.
01 iosb.
03 cond_val pic s9(4) comp.
03 byte_count pic s9(4) comp.
03 pic s9(9) comp.
*
01 create_socket.
03 pic s9(4) comp value external
ucx$c_tcp.
03 pic s9(4) comp value external
inet_protyp$c_stream.
*
01 local_sock_desc.
03 pic s9(9) comp value 16.
03 pointer value
reference local_addr.
01 local_addr.
03 pic s9(4) comp value external
ucx$c_af_inet.
03 local_port_number.
05 low_byte pic x value
low-values.
05 high_byte pic x value
low-values.
03 pic s9(9) comp value external
ucx$c_inaddr_any.
03 pic x(8).
*
01 rem_sock_desc.
03 pic s9(9) comp value 16.
03 pointer value
reference rem_addr.
*+
* In this example the T3_DEMO server is listening on port 1024 at node
address 1.2.3.4
* NB: The port number is specified in network byte order.
*-
01 rem_addr.
03 pic s9(4) comp value external
ucx$c_af_inet.
03 rem_port_number.
05 low_byte pic x value x"04".
05 high_byte pic x value x"00".
03 rem_node_addr.
05 pic x value x"01".
05 pic x value x"02".
05 pic x value x"03".
05 pic x value x"04".
03 pic x(8).
*
01 sock_opt_desc.
03 sock_opt_len pic s9(4) comp value 16.
03 pic s9(4) comp value external
ucx$c_sockopt.
03 pointer value
reference sock_opt.
01 sock_opt.
03 pic s9(4) comp value 4.
03 pic s9(4) comp value external
ucx$c_reuseaddr.
03 pointer value
reference opt_on.
03 pic s9(4) comp value 4.
03 pic s9(4) comp value external
ucx$c_keepalive.
03 pointer value
reference opt_on.
*
01 tcp_opt_desc.
03 pic s9(4) comp value 8.
03 pic s9(4) comp value external
ucx$c_tcpopt.
03 pointer value
reference tcp_opt.
01 tcp_opt.
03 pic s9(4) comp value 4.
03 pic s9(4) comp value external
ucx$c_tcp_probe_idle.
03 pointer value
reference connect_timeout.
*
01 opt_on pic s9(9) comp value 1.
01 opt_off pic s9(9) comp value 0.
01 connect_timeout pic s9(9) comp value 10.
*+
* The Access Control Information buffer must be the first buffer transmitted
to
* the communication server. This buffer will not be passed to an execution
server
* and is the only data message buffer whose format and content will be
scrutinized
* by Tier3.
*
* Each field must contain ascii coded text and may be null terminated or
space
* filled.
*-
01 aci_buffer.
03 aci_username pic x(40).
03 aci_password pic x(40).
*+
* The Tier3 Identification buffer is returned to the client, once access has
been
* authorized. The first three bytes will contain "T3$" and the next two
bytes will
* contain the major and minor version numbers of the Tier3 software
installed at
* the target node.
*-
01 t3_id_buffer.
03 t3_id pic xxx.
03 maj_vers pic x.
03 min_vers pic x.
03 scsnode pic x(6).
03 logfails pic 9(5).
03 last_login_i.
05 yyyy pic 9(4).
05 mt pic 9(2).
05 dd pic 9(2).
05 hh pic 9(2).
05 mn pic 9(2).
05 ss pic 9(2).
05 cc pic 9(2).
03 last_login_n.
05 yyyy pic 9(4).
05 mt pic 9(2).
05 dd pic 9(2).
05 hh pic 9(2).
05 mn pic 9(2).
05 ss pic 9(2).
05 cc pic 9(2).
*
01 time_vector_binary.
03 yyyy pic s9(4) comp.
03 mt pic s9(4) comp.
03 dd pic s9(4) comp.
03 hh pic s9(4) comp.
03 mn pic s9(4) comp.
03 ss pic s9(4) comp.
03 cc pic s9(4) comp.
01 vms_binary_time pic s9(18) comp.
01 vms_ascii_date pic x(17).
01 day_names_table.
03 pic x(9) value
"Monday".
03 pic 9(4) comp value 6.
03 pic x(9) value
"Tuesday".
03 pic 9(4) comp value 7.
03 pic x(9) value
"Wednesday".
03 pic 9(4) comp value 9.
03 pic x(9) value
"Thursday".
03 pic 9(4) comp value 8.
03 pic x(9) value
"Friday".
03 pic 9(4) comp value 6.
03 pic x(9) value
"Saturday".
03 pic 9(4) comp value 8.
03 pic x(9) value
"Sunday".
03 pic 9(4) comp value 6.
01 day_names_array redefines
day_names_table.
03 day_of_week occurs 7.
05 day_name pic x(9).
05 day_name_len pic 9(4) comp.
01 day_number pic 9(9) comp.
01 welcome_string pic x(65).
01 welcome_string_len pic 9(4) comp.
01 last_login_msg pic x(62).
01 logfails_msg.
03 out_logfails pic z(8)9.
03 pic x(37) value "
failures since last successful login".
*+
* The following buffers are application specific. In this DEMO example a
maximum
* buffer size of 510 bytes has been selected, and the first two bytes of
every
* message have been reserved for message identification. Note that this is
purely
* an application convention that needs to be observed by the programmers of
the
* client and server components of DEMO and is not a requirement of Tier3.
*-
01 reply_buffer.
03 msg_type pic xx.
88 valid_reply values "00",
"11", "99".
88 error_msg value "00".
88 entry_data value "11".
88 end_of_file value "99".
03 reply_body pic x(510).
*
01 error_buffer redefines
reply_buffer.
03 pic xx.
03 error_msg_len pic 999.
03 error_msg_text pic x(507).
*
01 entry_info_buffer redefines
reply_buffer.
03 pic xx.
03 entry_number pic z(9)9.
03 job_name pic x(39).
03 job_status pic x(15).
03 que_name pic x(31).
03 que_type pic x(10).
03 que_status pic x(10).
*
01 get_entry_buffer.
03 pic xx value "10".
03 user_entry pic 9(10).
03 max_entries pic 9(5) value 12.
*
01 reply_body_len pic 9(4) comp.
*+
* Application specific working-storage.
*-
01 screen_line_table.
03 screen_line occurs 12.
05 entry_number pic z(9)9.
05 job_name pic x(39).
05 job_status pic x(15).
05 que_name pic x(31).
05 que_type pic x(10).
05 que_status pic x(10).
01 screen_header.
03 pic x(13) value "
Entry#".
03 pic x(40) value "Job
Name".
03 pic x(16) value "Job
Status".
03 pic x(32) value "Queue
Name".
03 pic x(13) value "Queue
Type".
03 pic x(18) value "Queue
Status".
01 out_entry.
03 entry_number pic z(9)9.
03 pic xxx.
03 job_name pic x(39).
03 pic x.
03 job_status pic x(15).
03 pic x.
03 que_name pic x(31).
03 pic x.
03 que_type pic x(10).
03 pic xxx.
03 que_status pic x(10).
*
01 user_exit pic x value "N".
01 line_count pic 9(9) comp.
01 screen_index pic 9(9) comp.
01 end_key pic x(4).
*
procedure division.
kick_off section.
00.
perform socket_and_connect.
if sys_status not = ss$_normal go to fini.
perform application_logon.
if t3_id not = "T3$"
move ss$_abort to sys_status
go to fini.
perform display_welcome.
perform get_entry_info until user_exit = "Y" or sys_status not =
ss$_normal.
if sys_status not = ss$_normal go to fini.
perform socket_close.
*
fini.
call "sys$exit" using by value sys_status.
*
get_entry_info section.
00.
display "Enter job entry number (zero = wild, ctrl/z = exit): "
line 1 column 1 erase screen no advancing.
accept user_entry with conversion
reversed
bold
protected
default is zero
at end move "Y" to user_exit
go to fini.
*+
* Call my USER_RECV routine.
*-
call "sys$qiow"
using by value 0, net_chan, io$_writevblk
by reference iosb
by value 0, 0
by reference get_entry_buffer
by value 17, 0, 0, 0, 0
giving sys_status.
if sys_status = ss$_normal move cond_val to sys_status.
if sys_status not = ss$_normal go to fini.
move zeros to line_count.
perform load_entries with test after
until not entry_data or sys_status not = ss$_normal.
if sys_status not = ss$_normal go to fini.
if error_msg
display "Error retrieving job entry information,"
display error_msg_text(1:error_msg_len)
else display screen_header at line 1 column 1 reversed erase screen
perform varying screen_index from 1 by 1 until screen_index >
line_count
move corr screen_line (screen_index) to out_entry
display out_entry
end-perform.
display "Press RETURN to continue." no advancing.
accept key in end_key at end continue.
*
fini.
*
socket_and_connect section.
00.
call "sys$assign"
using by descriptor "_BG:"
by reference net_chan
by value 0, 0, 0
giving sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.
*
call "sys$qiow"
using by value 0, net_chan, io$_setmode
by reference iosb
by value 0, 0
by reference create_socket, omitted, local_sock_desc
by value 0
by reference sock_opt_desc
by value 0
giving sys_status.
if sys_status = ss$_normal move cond_val to sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.
*+
* Set the connect timeout to 10 secs. TCPWARE requires privilege to do this.
*-
call "sys$qiow"
using by value 0, net_chan, io$_setmode
by reference iosb
by value 0, 0, 0, 0, 0, 0
by reference tcp_opt_desc
by value 0
giving sys_status.
if sys_status = ss$_normal move cond_val to sys_status.
if sys_status not = ss$_normal and ss$_nopriv
call "lib$stop" using by value sys_status.
*+
* Request a logical link connection to the Tier3 communication server for
this application.
*-
call "sys$qiow"
using by value 0, net_chan, io$_access
by reference iosb
by value 0, 0, 0, 0
by reference rem_sock_desc
by value 0, 0, 0
giving sys_status.
if sys_status = ss$_normal move cond_val to sys_status.
if sys_status = ss$_reject
display "Access denied or the DEMO application is not running on
remote node."
else
if sys_status not = ss$_normal
call "lib$stop" using by value sys_status.
*
fini.
*
application_logon section.
00.
*+
* Once a logical link has been established, the communication server will be
* expecting access control information so that it can authorize client
access
* to the application.
*
* The aci_buffer allocates 40 bytes each for the username and password
fields but
* as VMS is currently the only supported server platform for Tier3 you
should limit
* usernames to 12 bytes and passwords to 32.
*-
display "Username: " erase screen no advancing.
accept aci_username protected size 12 editing at end go to fini.
display "Password: " no advancing.
accept aci_password protected size 32 editing no echo at end go to fini.
call "sys$qiow"
using by value 0, net_chan, io$_writevblk
by reference iosb
by value 0, 0
by reference aci_buffer
by value 80, 0, 0, 0, 0
giving sys_status.
if sys_status = ss$_normal move cond_val to sys_status.
if sys_status not = ss$_normal go to fini.
*+
* To complete the hand-shaking sequence the communication server will reply
* to a successfull access attempt with the Tier3 identification buffer.
*
* If the access control information was invalid the communication server
* will break the connection and the following read will return
ss$_linkdiscon.
* Before retrying a failed access attempt you must therefore re-connect
* (io$_access) the communication server. The communication server's log
* file will contain detailed information describing any authorization
* failures.
*
* The Tier3 Identification buffer for handshake 1 is 48 bytes long.
*-
call "sys$qiow"
using by value 0, net_chan, io$_readvblk
by reference iosb
by value 0, 0
by reference t3_id_buffer
by value 48, 0, ucx$c_msg_blockall, 0, 0
giving sys_status.
if sys_status = ss$_normal move cond_val to sys_status.
if sys_status = ss$_linkdiscon
display "User authorization failure"
move ss$_normal to sys_status.
*
fini.
*
load_entries section.
00.
*+
* As terminal i/o can take an indefinite amount of time to complete, once
* entry information is retrieved from the remote node it is deferred to
* working-storage rather than being sent directly to the screen. This
* strategy removes a potential cause of buffer starvation in the
communication
* server. If it is impractical to set a limit on the amount of information
to
* be returned from the execution server then the developer should consider
* deferring output to a temporary file, or expanding available memory via
* a routine such as LIB$GET_VM.
*
* Furthermore, if it is a requirement of your application that the
association
* between client and execution server persist during terminal i/o it may be
* necessary to modify the application's parameter record in the Tier3
* configuration file so that the "maximum servers" and "maximum links"
* parameters are set to the same value. This configuration would effectively
* dedicate a seperate execution server to each client and avoid potential
* delays in the servicing of client requests.
*-
call "sys$qiow"
using by value 0, net_chan, io$_readvblk
by reference iosb
by value 0, 0
by reference msg_type
by value 2, 0, ucx$c_msg_blockall, 0, 0
giving sys_status.
if sys_status = ss$_normal move cond_val to sys_status.
if sys_status not = ss$_normal go to fini.
*+
* TCP/IP is a stream oriented protocol and has no concept of record
boundries,
* therefore if you wish to exchange variable length records/messages (as is
the
* case with the DEMO example) then you have to read the first two bytes (ie:
the
* record header) of each message first, as this will tell us how many more
bytes
* we need to receive to complete a SINGLE message transfer.
*
* If this convention was not observed then a single network read of 510
bytes (the
* maximum buffer size for the demo example) could return multiple messages
in a
* single buffer, resulting in trailing messages being ignored.
*-
evaluate true
when entry_data move 115 to reply_body_len
when end_of_file move 3 to reply_body_len
when error_msg move 510 to reply_body_len
end-evaluate.
call "sys$qiow"
using by value 0, net_chan, io$_readvblk
by reference iosb
by value 0, 0
by reference reply_body
by value reply_body_len, 0, ucx$c_msg_blockall,
0, 0
giving sys_status.
if sys_status = ss$_normal move cond_val to sys_status.
if entry_data and sys_status = ss$_normal
add 1 to line_count
move corr entry_info_buffer to screen_line (line_count).
*
fini.
*
socket_close section.
00.
*+
* Break logical connection and dassign the network channel.
*
* The communication server will automatically deallocate any resources
* maintained on behalf of the client and will call, at AST level, the
* interrupt routine specified in the Tier3 configuration file if the
* client is currently associated with an execution server.
*-
call "sys$dassgn" using by value net_chan giving sys_status.
*
display_welcome section.
00.
call "sys$fao"
using by descriptor "Welcome to the DEMO application via TIER3
V!@UB.!@UB on node !AS"
by reference welcome_string_len
by descriptor welcome_string
by reference maj_vers, min_vers
by descriptor scsnode
giving sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.
display welcome_string (1:welcome_string_len).
move corr last_login_i to time_vector_binary.
perform cvt_lastlogin.
string " Last interactive login on ",
day_name (day_number) (1:day_name_len(day_number)),
" ", vms_ascii_date
delimited by size
into last_login_msg.
display last_login_msg.
move corr last_login_n to time_vector_binary.
perform cvt_lastlogin.
string " Last non-interactive login on ",
day_name (day_number) (1:day_name_len(day_number)),
" ", vms_ascii_date
delimited by size
into last_login_msg.
display last_login_msg.
if logfails > zeros
if logfails = 1
display " 1 failure since last successful login"
else
move logfails to out_logfails
display logfails_msg.
display "Press RETURN to continue." no advancing.
accept key in end_key at end continue.
go to fini.
*
cvt_lastlogin.
*
call "lib$cvt_vectim" using time_vector_binary, vms_binary_time giving
sys_status.
if sys_status not = lib$_normal call "lib$stop" using by value
sys_status.
call "sys$asctim"
using by value 0
by descriptor vms_ascii_date
by reference vms_binary_time
by value 0
giving sys_status.
if sys_status not = ss$_bufferovf call "lib$stop" using by value
sys_status.
call "lib$day_of_week" using vms_binary_time, day_number giving
sys_status.
if sys_status not = ss$_normal call "lib$stop" using by value
sys_status.
*
fini.
*
end program demo_client_tcp_ip.
Here's the macro definitions file: -
.title DEMO_TCP_IP_DEF Demo example tcp/ip external
data
;
; If the macro file sys$library:ucx$inetdef.mar exists on your VMS server
system
; then you can uncomment the following commands by removing the
semi-colons, and
; delete the DEMO example specific symbols - starting from
inet_protyp$c_stream.
;;+
;; The following command can be used to create a macro library INET in your
default
;; area if one does not already exist:-
;;
;; $library/create/macro inet.mlb sys$library:ucx$inetdef
;;-
; .library /inet/
; $inetsymdef GLOBAL
; $siocdef GLOBAL
; $inetacpfsymdef GLOBAL
; $inetacpsymdef GLOBAL
; $ineterrdef GLOBAL
;
inet_protyp$c_stream == 1
inet_protyp$c_dgram == 2
ucx$c_tcp == 6
ucx$c_udp == 17
ucx$c_af_inet == 2
ucx$c_inaddr_any == 0
ucx$c_sockopt == 1
ucx$c_reuseaddr == 4
ucx$c_full_duplex_close == 8192
ucx$c_keepalive == 8
ucx$c_tcpopt == 6
ucx$c_tcp_probe_idle == 128
ucx$c_msg_blockall == 128
inetacp$c_trans = 2
inetacp_func$c_gethostbyname = 1
acp_gethostbyname == <inetacp$c_trans * 256 +
inetacp_func$c_gethostbyname>
.end
More information about the Info-vax
mailing list