home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 18 REXX
/
18-REXX.zip
/
cpicsamp.zip
/
chat.cmd
< prev
next >
Wrap
OS/2 REXX Batch file
|
1995-02-22
|
34KB
|
846 lines
/* this is a REXX shell */
/* *******************************************************************/
/* */
/* MODULE NAME: chat */
/* */
/* MODULE TYPE: CPI-C REXX EXEC */
/* */
/* Source Library: $WKS.APPC.CNTL */
/* */
/* MODULE AUTHORIZATION: NONE */
/* */
/* ABENDS: NONE */
/* */
/* FUNCTION: This is an exec that supports cpi-c calls*/
/* in the TSO/E and the OS/2 environments. */
/* It is designed as an interactive chat */
/* with an appc partner. */
/* The TPNAME can be overriden in the exec. */
/* */
/* */
/* PARAMETERS: a) none -- accept a conversation and */
/* act accordingly */
/* b) symdest//tpname/ cmdstring */
/* */
/* */
/* */
/* example: */
/* */
/* %chat runblk */
/* data to send */
/* more data to send */
/* /over */
/* second batch of data to send */
/* more of the second */
/* /over */
/* /end */
/* */
/* %chat runl499/USA.xxxxxx.SPEAK */
/* */
/* */
/* */
/* INTERNAL TABLES: none */
/* */
/* CALLED MODULES: the CPICOMM environment modules: */
/* CMINIT CMALLC CMSEND CMRECV etc. */
/* */
/* */
/* CALLING MODULES/Env(s): Tsobatch */
/* Tso */
/* Batch */
/* NCCF exec */
/* Boole exec */
/* Tsobatch under ASCH init(s) */
/* */
/* OS/2 attach manager (rel 2.1) */
/* */
/* PROGRAM FLOW: This is a "State" driven process: */
/* */
/* State: activity: */
/* */
/* reset cmaccp or cminit */
/* initialize cmallc */
/* send cmsend "ISSUE" CMDSTRING */
/* receive cmrecv and display */
/* */
/* COPYRIGHT: Kirk Sticken */
/* November 29, 1994 */
/* */
/* AUTHOR: KIRK STICKEN */
/* */
/* */
/* MODIFICATION RECORD: NEW PROGRAM 09-15-93 KIRK STICKEN */
/* 09/27/93 added retry on alloc rc=2 */
/* 06/09/94 added auto-define process $wks */
/* 11/29/94 turned runpuppy into chat $wks */
/* 12/14/94 changed command line parms $wks */
/* */
/* */
/* */
/* */
/* *******************************************************************/
tracetype="normal"
select
when tracetype="normal" then trace normal
when tracetype="inter" then trace inter
when tracetype="all" then trace all
otherwise nop
end
/* conversation_type */
cm_basic_conversation = 0
cm_mapped_conversation = 1
/* data_received */
cm_no_data_received = 0
cm_data_received = 1
cm_complete_data_received = 2
cm_incomplete_data_received = 3
/* deallocate_type */
cm_deallocate_sync_level = 0
cm_deallocate_flush = 1
cm_deallocate_confirm = 2
cm_deallocate_abend = 3
/* error_direction */
cm_receive_error = 0
cm_send_error = 1
/* fill */
cm_fill_ll = 0
cm_fill_buffer = 1
/* prepare_to_recieve_type */
cm_prep_to_receive_sync_level = 0
cm_prep_to_receive_flush = 1
cm_prep_to_receive_confirm = 2
/* receive_type */
cm_receive_and_wait = 0
cm_receive_immediate = 1
/* request_to_send_received */
cm_request_to_send_not_received = 0
cm_request_to_send_received = 1
/* return_code */
cm_ok = 0
cm_allocate_failure_no_retry = 1
cm_allocate_failure_retry = 2
cm_conversion_type_mismatch = 3
cm_security_not_valid = 6
cm_sync_lvl_not_supported_pgm = 8
cm_tpn_not_recognized = 9
cm_tp_not_available_no_retry = 10
cm_tp_not_available_retry = 11
cm_deallocated_abend = 17
cm_deallocated_normal = 18
cm_parameter_error = 19
cm_product_specific_error = 20
cm_program_error_no_trunc = 21
cm_program_error_purging = 22
cm_program_error_trunc = 23
cm_program_parameter_check = 24
cm_program_state_check = 25
cm_resource_failure_no_retry = 26
cm_resource_failure_retry = 27
cm_unsuccessful = 28
cm_deallocated_abend_svc = 30
cm_deallocated_abend_timer = 31
cm_svc_error_no_trunc = 32
cm_svc_error_purging = 33
cm_svc_error_trunc = 34
/* return_control */
cm_when_session_allocated = 0
cm_immediate = 1
/* send_type */
cm_buffer_data = 0
cm_send_and_flush = 1
cm_send_and_confirm = 2
cm_send_and_prep_to_receive = 3
cm_send_and_deallocate = 4
/* status_received */
cm_no_status_received = 0
cm_send_received = 1
cm_confirm_received = 2
cm_confirm_send_received = 3
cm_confirm_dealloc_received = 4
/* sync_level */
cm_none = 0
cm_confirm = 1
TBC= "000102030405060708090A0B0C0D0E0F"X ||, /* 00 */
"101112131415161718191A1B1C1D1E1F"X ||, /* 10 */
"202122232425262728292A2B2C2D2E2F"X ||, /* 20 */
"303132333435363738393A3B3C3D3E3F"X ||, /* 30 */
"404142434445464748494A4B4C4D4E4F"X ||, /* 40 */
"505152535455565758595A5B5C5D5E5F"X ||, /* 50 */
"606162636465666768696A6B6C6D6E6F"X ||, /* 60 */
"707172737475767778797A7B7C7D7E7F"X ||, /* 70 */
"808182838485868788898A8B8C8D8E8F"X ||, /* 80 */
"909192939495969798999A9B9C9D9E9F"X ||, /* 90 */
"A0A1A2A3A4A5A6A7A8A9AAABACADAEAF"X ||, /* A0 */
"B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF"X ||, /* B0 */
"C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF"X ||, /* C0 */
"D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF"X ||, /* D0 */
"E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF"X ||, /* E0 */
"F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF"X /* F0 */
EBC= "00010203372D2E2F1605250B0C0D0E0F"X ||, /* 00 */
"101112133C3D322618193F271C1D1E1F"X ||, /* 10 */
"405A7F7B5B6C507D4D5D5C4E6B604B61"X ||, /* 20 */
"F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F"X ||, /* 30 */
"7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6"X ||, /* 40 */
"D7D8D9E2E3E4E5E6E7E8E9BAE0BBB06D"X ||, /* 50 */
"79818283848586878889919293949596"X ||, /* 60 */
"979899A2A3A4A5A6A7A8A9C04FD0A107"X ||, /* 70 */
"68DC5142434447485253545756586367"X ||, /* 80 */
"719C9ECBCCCDDBDDDFECFC70B180BFFF"X ||, /* 90 */
"4555CEDE49699A9BABAF5FB8B7AA8A8B"X ||, /* A0 */
"2B2C092128656264B4383134334AB224"X ||, /* B0 */
"22172906202A46661A35083936303A9F"X ||, /* C0 */
"8CAC7273740A757677231514046A783B"X ||, /* D0 */
"EE59EBEDCFEFA08EAEFEFBFD8DADBCBE"X ||, /* E0 */
"CA8F1BB9B6B5E19D90BDB3DAFAEA3E41"X /* F0 */
ASC= "00010203DC09C37FCAB2D50B0C0D0E0F"X ||, /* 00 */
"10111213DBDA08C11819C8F21C1D1E1F"X ||, /* 10 */
"C4B3C0D9BF0A171BB4C2C5B0B1050607"X ||, /* 20 */
"CDBA16BCBBC9CC04B9CBCEDF1415FE1A"X ||, /* 30 */
"20FF838485A0C68687A4BD2E3C282B7C"X ||, /* 40 */
"268288898AA18C8B8DE121242A293BAA"X ||, /* 50 */
"2D2FB68EB7B5C78F80A5DD2C255F3E3F"X ||, /* 60 */
"9B90D2D3D4D6D7D8DE603A2340273D22"X ||, /* 70 */
"9D616263646566676869AEAFD0ECE7F1"X ||, /* 80 */
"F86A6B6C6D6E6F707172A6A791F792CF"X ||, /* 90 */
"E67E737475767778797AADA8D1EDE8A9"X ||, /* A0 */
"5E9CBEFAB8F5F4ACABF35B5DEEF9EF9E"X ||, /* B0 */
"7B414243444546474849F0939495A2E4"X ||, /* C0 */
"7D4A4B4C4D4E4F505152FB968197A398"X ||, /* D0 */
"5CF6535455565758595AFDE299E3E0E5"X ||, /* E0 */
"30313233343536373839FCEA9AEBE99F"X /* F0 */
state="reset"
cm_rc.0 ="cm_ok "
cm_rc.1 ="cm_allocate_failure_no_retry "
cm_rc.2 ="cm_allocate_failure_retry "
cm_rc.3 ="cm_conversion_type_mismatch "
cm_rc.6 ="cm_security_not_valid "
cm_rc.8 ="cm_sync_lvl_not_supported_pgm "
cm_rc.9 ="cm_tpn_not_recognized "
cm_rc.10="cm_tp_not_available_no_retry "
cm_rc.11="cm_tp_not_available_retry "
cm_rc.17="cm_deallocated_abend "
cm_rc.18="cm_deallocated_normal "
cm_rc.19="cm_parameter_error "
cm_rc.20="cm_product_specific_error "
cm_rc.21="cm_program_error_no_trunc "
cm_rc.22="cm_program_error_purging "
cm_rc.23="cm_program_error_trunc "
cm_rc.24="cm_program_parameter_check "
cm_rc.25="cm_program_state_check "
cm_rc.26="cm_resource_failure_no_retry "
cm_rc.27="cm_resource_failure_retry "
cm_rc.28="cm_unsuccessful "
cm_rc.30="cm_deallocated_abend_svc "
cm_rc.31="cm_deallocated_abend_timer "
cm_rc.32="cm_svc_error_no_trunc "
cm_rc.33="cm_svc_error_purging "
cm_rc.34="cm_svc_error_trunc "
hadparms="N"
arg destname cmdline
tpn=""
if pos("/",destname)>0 then ,
do
i=pos("/",destname)
tpn=substr(destname,i+1)
destname=substr(destname,1,i-1)
end
if length(cmdline)=0 then cmdline="DIR"
else hadparms="Y"
if length(destname)=0 then ,
do
destname="RUNBLK"
hadparms="N"
end
wk=0
cmd.1=cmdline
cmd.2="/OVER"
cmd.3="/END"
cmdix=1
allocates=0
savedwt2=""
rck=0
wk=0
wrc=0
cminitk=0
sendfl="n"
rcvfl="n"
oldenv=address()
address cpicomm
qk=queued()
do i=1 to qk
pull
end
wt=time(r)
do until state="done"
select
when tracetype="normal" then nop
when tracetype="inter" then push substr(state"..........",1,10) ,
date() time(r)
when tracetype="all" then push substr(state"..........",1,10) ,
date() time(r)
otherwise nop
end
select
when state="send" then ,
do
if hadparms="Y" then ,
do
text=cmd.cmdix
cmdix=cmdix+1
if cmdix>3 then state="dealloc"
end
else ,
do
pull text
end
text=" "text
textl=length(text)
if text="/OVER" then state="receive"
else ,
if text="/END" then state="dealloc"
else ,
do
if oldenv="CMD" ,
| oldenv="PMREXX" then ,
text=translate(text,EBC,TBC)
"cmsend convid text textl rts_rcvd return_code"
if return_code=cm_ok then ,
if rts_rcvd = cm_req_to_send_received then
state="receive"
else nop
else state="error"
end
end
when state="receive" then ,
do
textl=500
"cmrcv convid text textl data_rcvd" ,
"textl status_rcvd rts_rcvd" ,
"return_code"
select
when status_rcvd=cm_send_received ,
& data_rcvd=cm_no_data_received ,
then state="send"
when status_rcvd=cm_send_received ,
& data_rcvd=cm_data_received ,
then state="send"
when status_rcvd=cm_send_received ,
& data_rcvd=cm_complete_data_received ,
then state="send"
when status_rcvd=cm_send_received ,
& data_rcvd=cm_incomplete_data_received ,
then state="send-pending"
when status_rcvd=cm_confirm_received ,
then state="confirm"
when status_rcvd=cm_confirm_send_received ,
then state="confirm-send"
when status_rcvd=cm_confirm_dealloc_received ,
then state="confirm-dealloc"
otherwise nop
end
select
when data_rcvd=cm_no_data_received then nop
when data_rcvd=cm_data_received ,
| data_rcvd=cm_complete_data_received then ,
do
rck=rck+1
if length(savedwt2)>0 then ,
txrcv.rck=savedwt2||substr(text,1,textl)
else ,
txrcv.rck=substr(text,1,textl)
savedwt2=""
if oldenv="CMD" ,
| oldenv="PMREXX" then ,
txrcv.rck=translate(txrcv.rck,ASC,TBC)
select
when tracetype="normal" then ,
do
wt1=txrcv.rck
do until wt1=" "
parse value wt1 with wt2";"wt1
wt2=strip(wt2,t)
say wt2
end
end
when tracetype="all" then ,
say "flm002i rcvd:("txrcv.rck")"
when tracetype="inter" then ,
say "flm003i rcvd:("txrcv.rck")"
otherwise say txrcv.rck
end
if word(txrcv.rck,1)="ISSUE" then ,
do
wt1=delword(txrcv.rck,1,1)
wt1=translate(wt1,"'","""")
address value oldenv
if oldenv="TSO" then ,
do
"execio 0 diskw sysprint (finis)"
"execio 0 diskw vtocout (finis)"
zz=outtrap("rslt.","*")
end
else ,
if oldenv="CMD" ,
| oldenv="PMREXX" then ,
wt1=wt1 "> c:\tmp\chat.rof"
else nop
wt1
wrc=rc
if oldenv="TSO" then ,
do
zz=outtrap("OFF")
do kk=1 to rslt.0
rck=rck+1
txrcv.rck=rslt.kk
end
"execio * diskr sysprint" ,
"(stem sysprint. finis)"
do kk=1 to sysprint.0
rck=rck+1
txrcv.rck=strip(sysprint.kk)
end
"execio * diskr vtocout" ,
"(stem vtocout. finis)"
do kk=1 to vtocout.0
rck=rck+1
txrcv.rck=strip(vtocout.kk)
end
rck=rck+1
txrcv.rck="rc="wrc
address cpicomm
end
else ,
if oldenv="CMD" ,
| oldenv="PMREXX" then ,
do
of="c:\tmp\chat.rof"
if exist(of) then ,
do
DO WHILE LINES(of) <> 0
oBuffer = LineIn(of)
rck=rck+1
txrcv.rck=oBuffer
END
end
address cpicomm
rck=rck+1
txrcv.rck="rc="wrc
end
else nop
end
end
when data_rcvd=cm_incomplete_data_received then ,
do
rck=rck+1
if length(savedwt2)>0 then ,
txrcv.rck=savedwt2||substr(text,1,textl)
else ,
txrcv.rck=substr(text,1,textl)
if oldenv="CMD" ,
| oldenv="PMREXX" then ,
txrcv.rck=translate(txrcv.rck,ASC,TBC)
select
when tracetype="normal" then ,
do
wt1=txrcv.rck
do until wt1=" "
parse value wt1 with wt2";"wt1
wt2=wt2
if length(wt1) > 0 then ,
do
wt2=strip(wt2,t)
say wt2
end
else ,
do
if oldenv="CMD" ,
| oldenv="PMREXX" then ,
wt2=translate(wt2,EBC,TBC)
savedwt2=wt2
end
end
end
when tracetype="all" then ,
say "flm002i rcvd:("txrcv.rck")"
when tracetype="inter" then ,
say "flm003i rcvd:("txrcv.rck")"
otherwise say txrcv.rck
end
if word(txrcv.rck,1)="ISSUE" then ,
do
wt1=delword(txrcv.rck,1,1)
wt1=translate(wt1,"'","""")
address value oldenv
if oldenv="TSO" then ,
do
"execio 0 diskw sysprint (finis)"
"execio 0 diskw vtocout (finis)"
zz=outtrap("rslt.","*")
end
else ,
if oldenv="CMD" ,
| oldenv="PMREXX" then ,
wt1=wt1 "> c:\tmp\chat.rof"
else nop
wt1
wrc=rc
if oldenv="TSO" then ,
do
zz=outtrap("OFF")
do kk=1 to rslt.0
rck=rck+1
txrcv.rck=rslt.kk
end
"execio * diskr sysprint" ,
"(stem sysprint. finis)"
do kk=1 to sysprint.0
rck=rck+1
txrcv.rck=strip(sysprint.kk)
end
"execio * diskr vtocout" ,
"(stem vtocout. finis)"
do kk=1 to vtocout.0
rck=rck+1
txrcv.rck=strip(vtocout.kk)
end
rck=rck+1
txrcv.rck="rc="wrc
address cpicomm
end
else ,
if oldenv="CMD" ,
| oldenv="PMREXX" then ,
do
of="c:\tmp\chat.rof"
if exist(of) then ,
do
DO WHILE LINES(of) <> 0
oBuffer = LineIn(of)
rck=rck+1
txrcv.rck=oBuffer
END
end
address cpicomm
rck=rck+1
txrcv.rck="rc="wrc
end
else nop
end
end
otherwise nop
end
if return_code=cm_ok then nop
else state="error"
end
when state="dealloc" then ,
do
"cmdeal convid return_code"
if return_code=cm_ok then state="done"
else state="error"
end
when state="confirm" then ,
do
"cmcfmd convid return_code"
if return_code=cm_ok then state="receive"
else state="error"
end
when state="confirm-send" then ,
do
"cmcfmd convid return_code"
if return_code=cm_ok then state="send"
else state="error"
end
when state="confirm-dealloc" then ,
do
"cmcfmd convid return_code"
if return_code=cm_ok then state="done"
else state="error"
end
when state="send-pending" then ,
do
textl=500
"cmrcv convid text textl data_rcvd" ,
"textl status_rcvd rts_rcvd" ,
"return_code"
select
when data_rcvd=cm_no_data_received then ,
state="send"
when data_rcvd=cm_data_received ,
| data_rcvd=cm_complete_data_received ,
| data_rcvd=cm_incomplete_data_received then ,
do
rck=rck+1
txrcv.rck=substr(text,1,textl)
if oldenv="CMD" ,
| oldenv="PMREXX" then ,
txrcv.rck=translate(txrcv.rck,ASC,TBC)
select
when tracetype="normal" then say txrcv.rck
when tracetype="all" then ,
say "flm005i rcvd:("txrcv.rck")"
when tracetype="inter" then ,
say "flm006i rcvd:("txrcv.rck")"
otherwise say txrcv.rck
end
if word(txrcv.rck,1)="ISSUE" then ,
do
wt1=delword(txrcv.rck,1,1)
wt1=translate(wt1,"'","""")
address value oldenv
if oldenv="TSO" then ,
do
"execio 0 diskw sysprint (finis)"
"execio 0 diskw vtocout (finis)"
zz=outtrap("rslt.","*")
end
else ,
if oldenv="CMD" ,
| oldenv="PMREXX" then ,
wt1=wt1 "> c:\tmp\chat.rof"
else nop
wt1
wrc=rc
if oldenv="TSO" then ,
do
zz=outtrap("OFF")
do kk=1 to rslt.0
rck=rck+1
txrcv.rck=rslt.kk
end
"execio * diskr sysprint" ,
"(stem sysprint. finis)"
do kk=1 to sysprint.0
rck=rck+1
txrcv.rck=strip(sysprint.kk)
end
"execio * diskr vtocout" ,
"(stem vtocout. finis)"
do kk=1 to vtocout.0
rck=rck+1
txrcv.rck=strip(vtocout.kk)
end
rck=rck+1
txrcv.rck="rc="wrc
address cpicomm
end
else ,
if oldenv="CMD" ,
| oldenv="PMREXX" then ,
do
of="c:\tmp\chat.rof"
if exist(of) then ,
do
DO WHILE LINES(of) <> 0
oBuffer = LineIn(of)
rck=rck+1
txrcv.rck=oBuffer
END
end
address cpicomm
rck=rck+1
txrcv.rck="rc="wrc
end
else nop
end
end
otherwise nop
end
if return_code=cm_ok then nop
else state="error"
end
when state="error" then ,
do
if return_code=cm_deallocated_normal then nop
else ,
do
say "error rc="return_code cm_rc.return_code
say "state footprints"
end
state="done"
end
when state="reset" then ,
do
cminitk=cminitk+1
if oldenv="TSO" then ,
do
"cmaccp convid return_code"
if return_code=cm_ok then state="receive"
else ,
do
sym_dest_name=destname
"cminit convid sym_dest_name return_code"
select
when tracetype="normal" then nop
when tracetype="all" then ,
say "init rc" ,
return_code ,
"for" sym_dest_name
when tracetype="inter" then ,
say "init rc" ,
return_code ,
"for" sym_dest_name
otherwise ,
say "init rc" ,
return_code ,
"for" sym_dest_name
end
if return_code = cm_ok then ,
do
state="initialize"
if length(tpn)>0 then ,
do
tpnl=length(tpn)
"cmstpn convid tpn tpnl return_code"
if return_code=cm_ok then nop
else ,
do
say "flt000i tpn error="return_code
state="error"
end
end
end
else state="error"
end
end
else ,
do
/* if hadparms="N" then ,
do
"cmaccp convid return_code"
if return_code=cm_ok then state="receive"
else state="error"
end
else ,
*/ do
sym_dest_name=destname
"cminit convid sym_dest_name return_code"
select
when tracetype="normal" then nop
when tracetype="all" then ,
say "init rc" ,
return_code ,
"for" sym_dest_name
when tracetype="inter" then ,
say "init rc" ,
return_code ,
"for" sym_dest_name
otherwise ,
say "init rc" ,
return_code ,
"for" sym_dest_name
end
if return_code = cm_ok then ,
do
state="initialize"
if length(tpn)>0 then ,
do
tpnl=length(tpn)
"cmstpn convid tpn tpnl return_code"
if return_code=cm_ok then nop
else ,
do
say "flt000i tpn error="return_code
state="error"
end
end
end
else ,
if cminitk<2 then ,
do
modename="LU62MVS "
key=substr(destname" ",1,8)
if length(tpn)>1 then nop
else ,
tpn="USA.xxxxxx.RED1.chat"
s.sym_dest_name=key
s.partner_LU_name="APPCMVS"
s.TP_name = tpn
s.mode_name=modename
s.TP_name_type=0
s.conversation_security_type=1
s.security_user_id="@boole8"
s.security_password="xxxxxxxx"
SIDEL=124
"XCMSSI key s sidel cmrc"
end
else ,
state="error"
end
end
end
when state="initialize" then ,
do
"cmallc convid return_code"
if return_code = cm_ok then state="send"
else ,
if return_code=cm_allocate_failure_retry ,
| return_code=cm_program_parameter_check then ,
do
allocates=allocates+1
if allocates>1 then state="error"
else nop
end
else state="error"
end
otherwise state="error"
end
end
address oldenv
if substr(txrcv.rck,1,10)="RESULT:rc=" then ,
do
wt1=substr(txrcv.rck,11)
num1=word(wt1,1)
wrc=num1+00
end
k=0
qk=queued()
do i=1 to qk
pull wt1
parse value wt1 with state dd mmm yyyy int
if k=0 then ,
do
k=1
stab.1=state
scnt.1=1
sint.1=int
end
else ,
do
found="N"
do j=1 to k
if stab.j=state then ,
do
found="Y"
scnt.j=1 + scnt.j
sint.j=int +sint.j
end
end
if found="N" then ,
do
k=k+1
stab.k=state
scnt.k=1
sint.k=int
end
end
say "..." format(1-i,4,0) wt1
end
do i=1 to k
avg=sint.i/scnt.i
say stab.i "average" avg
end
exit wrc
EXIST:
parse arg fname
IF LENGTH(STREAM(fname,'C','QUERY EXISTS')) > 0
THEN RC = 1
ELSE RC = 0
RETURN RC
