/* DVHXMIT EXEC */
/* modified to not use lasting globalv */
COPYRIGHT_NOTICE = ,
' LICENSED MATERIALS - PROGRAM PROPERTY OF IBM.' ,
' RESTRICTED MATERIALS OF IBM.' ,
' 5748-XE4M (C) COPYRIGHT IBM CORPORATION 1979, 1995.' ,
' All rights reserved.' ,
' US Government Users Restricted Rights -' ,
' Use, duplication, or disclosure restricted by GSA ADP' ,
' schedule contract with IBM Corporation.' ,
' Part Name:  DVHXMIT  EXEC' ,
' Interface:  199501 VM60575'
Address 'COMMAND'
Parse Arg cmdstring 1 cmd cmdparms
Upper cmd
global_group = 'DVH15'
global_get   = 'GLOBALV SELECT' global_group 'GET'
global_set   = 'GLOBALV SELECT' global_group 'SETL'
global_perm  = 'GLOBALV SELECT' global_group 'SETL'
Call DO_CMD global_get 'TRACE' ,
'INTERFACE ASUSER ATNODE BYUSER FORUSER IMMED LANG' ,
'MULTIUSER NEEDPASS PRESET PW_REQD REQUEST TEST TOSYS',
'XMITFILE'
Select
When Pos(' DVHXMIT=',' 'trace' ') ^= 0
Then Parse Var trace . 'DVHXMIT=' trace_opt .
When Pos(' DVH*=',' 'trace' ') ^= 0
Then Parse Var trace . 'DVH*=' trace_opt .
Otherwise trace_opt = ''
End
If trace_opt ^= ''
Then Do
'EXEC DVHMSG 116101 * DVHXMT' 'DVHXMIT' cmdstring
Trace Value trace_opt
End
Call BUILD_TRANSACTION
Call WHERE_TO
Call DETERMINE_PROTOCOL
Select
When protocol = '15FILE'
Then Do
Call SAVE_PUN_STAT
Call SPOOL_AND_TAG
Call SEND_FILE_COMMAND
If r = 0 & xmitfile ^= ''
Then Call SEND_FILE_DATA
Call RESTORE_PUN_STAT
End
When protocol = '14FILE'
Then Do
Call SAVE_PUN_STAT
Call SPOOL_AND_TAG
If xmitfile ^= ''
Then Call SEND_FILE_DATA
If r = 0
Then Call SEND_FILE_COMMAND
Call RESTORE_PUN_STAT
End
When protocol= 'SMSG'
Then Call SEND_SMSG
Otherwise Nop
End
If r = 0
Then 'EXEC DVHMSG 119101 * DVHXMT' cmd
Else 'EXEC DVHMSG 119201 * DVHXMT' r cmd
r = rc
Signal DONE
BUILD_TRANSACTION:
Select
When byuser ^= '*'
Then msguser = byuser
When asuser ^= '*'
Then msguser = asuser
Otherwise msguser = Userid()
End
If tosys ^= '*'
Then msgnode = tosys
Else Call DO_CMD 'PIPE (Name Find_Where_We_Are)' ,
'  COMMAND IDENTIFY' ,
'| SPECS W3 1' ,
'| VAR MSGNODE'
'ESTATE PWCHANGE PENDING *'
pwc_pending = rc
Select
When asuser ^= '*' | byuser ^= '*'
Then pw_prompt = 1
When tosys ^= '*'
Then pw_prompt = 0
When cmd = 'NEEDPASS' & Word(cmdparms,1) = '?'
Then pw_prompt = 0
When cmd = 'NEEDPASS'
Then pw_prompt = 1
When cmd = 'PW?' & pwc_pending ^= 0
Then pw_prompt = 0
When cmd = 'PW?'
Then pw_prompt = 1
When cmd = 'USEROPTN' ,
& Word(cmdparms,1) = '?'
Then pw_prompt = 0
When cmd = 'USEROPTN' & Word(cmdparms,1) = 'NEEDPASS'
Then pw_prompt = 1
When pw_reqd = 'N'
Then pw_prompt = 0
When needpass = 'NO'
Then pw_prompt = 0
Otherwise pw_prompt = 1
End
Select
When ^pw_prompt
Then oldpass = 'NOLOG'
When (preset ^= '' & preset ^= 'NOLOG')
Then oldpass = preset
Otherwise Do
'EXEC DVHMSG 118101 * DVHXMT' msguser msgnode
Parse Value Diag(8,'QUERY USER' Userid()) With . . status . '15'x
Select
When status = 'DSC' & Queued() = 0
Then Signal EXIT_CANCEL
When status = 'DSC'
Then Pull dvhinput
Otherwise Do
Call GET_PW
If rc ^= 0 | dvhinput = '*'
Then Signal EXIT_CANCEL
End
End
Parse Var dvhinput . oldpass extra
If oldpass = '' | extra ^= ''
Then Signal EXIT_CANCEL
End
End
If test ^= '' & test ^= 'OFF'
Then oldpass = Left('X',Length(oldpass),'X')
If request = '' ,
| Verify(request,'0123456789') ^= 0 ,
| request < 1 | request > 9998 ,
Then request = 1
Else request = request + 1
If test = '' | test = 'OFF'
Then Do
''global_perm 'REQUEST' request
If rc ^= 0
Then Do
Call DO_CMD global_set 'REQUEST' request
'EXEC DVHMSG 118501 * DVHXMT'
End
End
Select
When Right(interface,1) = 'X' & immed = 'YES'
Then interface = 'DIRMIMED'
When Right(interface,1) = 'X'
Then interface = 'DIRMAXMT'
When immed = 'YES'
Then cmdstring = 'IMMED' cmdstring
Otherwise Nop
End
If Left(interface,4) = 'DIRM'
Then prefix = interface oldpass lang
Else prefix = interface oldpass lang 'REQUEST' request
prefix_parms = 'AS' asuser 'BY' byuser 'FOR' foruser 'AT' atnode ,
'MULTIUSER' multiuser
Do While prefix_parms ^= ''
Parse Var prefix_parms prefix_keyword prefix_value prefix_parms
If prefix_value ^= '' & prefix_value ^= '*'
Then prefix = prefix prefix_keyword prefix_value
End
Return
WHERE_TO:
Select
When test = 'MSG'
Then Do
'CP MSG *' prefix cmdstring
r = rc
Signal DONE
End
When test = 'SAY'
Then Do
Say ''prefix cmdstring
r = 0
Signal DONE
End
Otherwise Nop
End
Call DO_CMD 'PIPE (NAME Where_Am_I End ?)' ,
'  COMMAND IDENTIFY (ALL)' ,
'| A: FANOUT' ,
'| SPECS W3 1 / / N' ,
'| JOIN * / /' ,
'| VAR USERNODE' ,
'? A:' ,
'| TAKE 1' ,
'| SPECS W5 1' ,
'| VAR NETMACH'
If Left(interface,4) = 'DIRM'
Then cms_cmd = 'PIPE (Name Read_DIRMSSI_RUNAT End ?)' ,
'  < DIRMSSI RUNAT *' ,
'| A: FANOUT' ,
'| TAKE 1' ,
'| SPECS WORD 4 1' ,
'| VAR DIRMMACH' ,
'? A:' ,
'| SPECS WORD 1 1' ,
'| JOIN * / /' ,
'| VAR DIRMNODE' ,
'? A:' ,
'| TAKE 1' ,
'| SPECS WORD 2 1' ,
'| VAR DIRMAUTH'
Else cms_cmd = 'PIPE (Name Read_WHERETO_DATADVH End ?)' ,
'  < WHERETO DATADVH *' ,
'| A: FANOUT' ,
'| TAKE 1' ,
'| SPECS WORD 1 1' ,
'| VAR DIRMMACH' ,
'? A:' ,
'| SPECS WORD 2 1' ,
'| JOIN * / /' ,
'| VAR DIRMNODE' ,
'? A:' ,
'| TAKE 1' ,
'| SPECS WORD 3 1' ,
'| VAR DIRMAUTH'
Call DO_CMD cms_cmd
If Symbol('DIRMNODE') ^= 'VAR' | dirmnode = ''
Then Do
'EXEC DVHMSG 118301 * DVHXMT' 'WHERETO DATADVH *' rc
r = rc
Signal DONE
End
'PIPE (Name Get_Routing_Info)' ,
'  COMMAND LISTFILE CONFIG* DATADVH *' ,
'| SORT UNIQUE 1.17 DESCENDING' ,
'| GETFILES' ,
'| STRIP' ,
'| FIND FROM='||,
'| STRIP LEADING STRING /FROM=/' ,
'| STRIP' ,
'| XLATE' ,
'| STEM ROUTE_INFO.'
If rc ^= 0
Then Do
'EXEC DVHMSG 118301 * DVHXMT CONFIG* DATADVH *' rc
r = rc
Signal DONE
End
If route_info.0 = 0
Then Do
route_info.0 = 1
route_info.1 = '* DEST= * S= * T= * U= *'
End
Do i = 1 To route_info.0
Parse Var route_info.i from_node . ,
1 . ' DEST=' dest_name . ,
1 . ' S=' spool_id     . ,
1 . ' T=' tag_node     . ,
1 . ' U=' tag_user     .
If from_node ^= '*' & WordPos(from_node,usernode) = 0
Then Iterate i
If tosys = '*'
Then Do
If dest_name ^= '*' & WordPos(dest_name,dirmnode) = 0 ,
& tag_node  ^= '*' & WordPos(tag_node,dirmnode) = 0
Then Iterate i
If spool_id = '*'
Then spool_id = netmach
If tag_node = '' | tag_node = '*'
Then tag_node = dest_name
If tag_node = '' | tag_node = '*'
Then Parse Var dirmnode tag_node .
If tag_user = '' | tag_user = '*'
Then tag_user = dirmmach
End
Else Do
If dest_name ^= '*' & dest_name ^= tosys ,
& tag_node  ^= '*' & tag_node ^= tosys
Then Iterate i
If spool_id = '*'
Then spool_id = netmach
If tag_node = '' | tag_node = '*'
Then tag_node = dest_name
If tag_node = '' | tag_node = '*'
Then tag_node = tosys
If tag_user = '' | tag_user = '*'
Then tag_user = 'DIRMAINT'
End
If WordPos(tag_node,usernode) ^= 0
Then spool_id = dirmmach
Return
End
If tosys = '*'
Then Do
spool_id = dirmmach
Parse Var dirmnode tag_node .
tag_user = dirmmach
End
Else Do
'EXEC DVHMSG 118401 * DVHXMT' tosys
r = rc
Signal DONE
End
Return
DETERMINE_PROTOCOL:
Select
When xmitfile ^= '' & Left(interface,4) = 'DIRM'
Then Do
protocol = '14FILE'
Parse Value Time() With hh ':' mm ':' ss .
If hh < 12 Then hh = hh + 12
If mm < 30 Then mm = mm + 30
If ss < 30 Then ss = ss + 30
fileauth = Left(hh*mm*ss,5) ,
||Right(request,3,'0')
fileclass = 'S'
End
When immed = 'YES'
Then Do
protocol = '15FILE'
fileauth = dirmauth
fileclass = '0'
End
When xmitfile ^= ''
Then Do
protocol = '15FILE'
fileauth = dirmauth
fileclass = '0'
End
When tosys ^= '*'
Then Do
protocol = '15FILE'
fileauth = dirmauth
fileclass = '0'
End
When WordPos(tag_node,usernode) = 0
Then Do
protocol = '15FILE'
fileauth = dirmauth
fileclass = '0'
End
When Length(spool_id 'CMD TAG-NODE SMSG' tag_user prefix cmdstring) ,
> 160
Then Do
protocol = '15FILE'
fileauth = dirmauth
fileclass = '0'
End
Otherwise protocol = 'SMSG'
End
Return
SAVE_PUN_STAT:
old_pun = ''
x = Diagrc(8,'QUERY V 00D')
Parse Var x rc .
If rc = 0
Then Do i = 1 To 99
x = Diagrc(8,'DEFINE 00D' i||'D')
Parse Var x rc .
If rc = 0
Then Do
old_pun = i||'D'
Leave i
End
End
Call DO_CMD 'EXECIO 0 CP (STRING DEFINE PUN 00D'
r = rc
Return
RESTORE_PUN_STAT:
If old_pun ^= ''
Then Do
Call DO_CMD 'EXECIO 0 CP (STRING DETACH 00D'
Call DO_CMD 'EXECIO 0 CP (STRING DEFINE' old_pun '00D'
End
Return
SPOOL_AND_TAG:
'CP SPOOL 00D CONT NOHOLD TO' spool_id 'FORM' Userid()
If rc = 0
Then 'CP TAG DEV 00D' tag_node tag_user ,
'48 (ENQ=NO SENT=NO FINAL=NO'
r = rc
Return
SEND_FILE_COMMAND:
punch = 'EXECIO 1 PUNCH (STRING'
smsg  = 'EXECIO 0 CP (STRING SMSG'
If Left(interface,4) = 'DIRM'
Then Do
cmdstring = cmdstring usernode.1 fileauth
''smsg dirmmach prefix cmdstring
If rc ^= 0
Then ''smsg dirmmach 'AT' tag_node prefix cmdstring
If rc ^= 0
Then Do
'CP SPOOL 00D CONT CLASS 0 DIST' dirmauth
prefix = Userid() usernode.1 dirmauth ,
'SYS' 'ONELINER' prefix
''punch ':READ D$I$R$M$ CLEARSYS A'
Do While rc = 0 & cmdstring ^= ''
Parse Var cmdstring cmdline 80 cmdstring
''punch cmdline
End
'CP SPOOL 00D NOCONT'
'CP CLOSE 00D NAME D$I$R$M$ CLEARSYS'
End
End
Else Do
'CP SPOOL 00D CONT CLASS 0 DIST' dirmauth
cmdstring = prefix cmdstring || ' '
lcs = Length(cmdstring)
cmdstring = Bitxor(cmdstring,Left('A5'X,lcs,'A5'X))
cmdstring = C2X(cmdstring)
lcs = Length(cmdstring)
If xmitfile = ''
Then ''punch 'DVH' interface 'NOFILE' lcs
Else ''punch 'DVH' interface 'FILE'   lcs
Call DO_CMD 'PIPE (Name Punch_The_Command)' ,
'  VAR CMDSTRING' ,
'| DEBLOCK 72' ,
'| PUNCH'
Call DO_CMD punch
End
Return
SEND_FILE_DATA:
'CP SPOOL 00D CLASS' fileclass 'DIST' fileauth
r = rc
If r = 0
Then Do
cms_cmd = 'NETDATA SEND' xmitfile ,
'TO' tag_user 'AT' tag_node ,
'(NOTYPE NOACK NOLOG NOSPOOL)'
cline=CURLINE();''cms_cmd
If rc ^= 0
Then Do
'EXEC DVHMSG 111901 * DVHXMT' cline rc cms_cmd
r = rc
End
End
If r = 0
Then 'CP SPOOL 00D NOCONT CLOSE'
Else 'CP SPOOL 00D NOCONT PURGE'
Return
SEND_SMSG:
smsg = 'EXECIO 0 CP (STRING SMSG'
If tosys = '*'
Then Do
''smsg tag_user prefix cmdstring
Do While rc ^= 0 & dirmnode ^= ''
Parse Var dirmnode tag_node dirmnode
''smsg tag_user 'AT' tag_node prefix cmdstring
End
End
Else Do
''smsg spool_id 'CMD' tag_node 'SMSG' tag_user ,
prefix cmdstring
End
r = rc
Return
GET_PW:
dvhinput = '*'
Call DO_CMD 'PIPE (Name Read_Password)' ,
'  CONSOLE DARK' ,
'| TAKE 1' ,
'| Literal * ' ,
'| JOIN' ,
'| STRIP' ,
'| VAR DVHINPUT'
Upper dvhinput
Return dvhinput
EXIT_CANCEL:
'EXEC DVHMSG 118201 * DVHXMT' cmd msguser msgnode
r = rc
DONE:
If trace_opt ^= ''
Then 'EXEC DVHMSG 116201 * DVHXMT' 'DVHXMIT' r
Exit r
DO_CMD:
Parse Arg cms_cmd
''cms_cmd
r = rc
If r ^= 0
Then Do
'EXEC DVHMSG 111901 * DVHXMT' sigl r cms_cmd
r = rc
Signal DONE
End
Return
CURLINE: Return sigl