zOs/REXX/CSM

/* copy csm begin *****************************************************
    interface to csm,
        it is integrate with adrTso, eg. dsnAlloc , 'RZ3/..' uses csm
**********************************************************************/
/*--- execute a single csmExec command ------------------------------*/
adrCsm:
    return csmEx2('csmExec' arg(1), arg(2))

/*--- execute a single csmAppc start command
      arg(1)=pgm, arg(2)=parm, arg(3)=rest, arg(4)=retOk ------------*/
csmAppc:
    appc_rc = 0 /* csmAppc erstellt diese Variable nicht immmer| */
    appc_msg.0 = 0
    if 0 <> csmEx2('csmAppc start pgm('arg(1)')' ,
                  copies("parm("quote(arg(2), "'")")",
                        , arg(2) <> '') arg(3) , arg(4)) then
        ggRc = m.tso_rc
    else if appc_rc = 0 then
        return 0
    else do
        ggRc = appc_rc
        m.csm_err = ''
        m.csm_errMsg = 'tso_rc=0'
        end
    ggMsg = 'csmAppc rc='ggRc 'appc_rc='appc_rc ,
        'reason='appc_reason 'state_c='appc_state_c appc_state_f ,
        '\n  SUBSYS_TSR15='subsys_tsr15 'tsRc='SUBSYS_TSRC  ,
                 'abend='subsys_tsAbend 'reason='subsys_tsReason
        do ggCsmIx=1 to appc_msg.0
            ggMsg = ggMsg '\n   ' appc_msg.ggCsmIx
            end
    m.csm_errMsg = ggMsg'\n'm.csm_errMsg
    return ggRc
endRoutine csmAppc

/*--- execute single command in arg(1) -----------------------------*/
csmEx2:
    if wordPos(translate(word(arg(1), 2)), 'COPY MBRLIST') > 0 then
       ggTO = ''
    else if pos('TIMEOUT(' , translate(arg(1))) > 0 then
       ggTO = ''
    else if symbol('m.csm_timeOut') == 'VAR' then
        ggTO = 'timeout('m.csm_timeOut')'
    else
        ggTO = 'timeout(30)'
    ggStart = time()
    if adrTso(arg(1) ggTO, '*') == 0 then
        return 0
    if pos('CSMXC43E NO CONNECTION TO S', m.tso_trap) > 0 ,
         | pos('CSMXC36E TIMEOUT LIMIT EXCEEDED DURING LOGON TO' ,
            , m.tso_trap) > 0 then
               /* CSMXC43E NO CONNECTION TO SYSPLEX:RR2 AVAILABLE
                  CSMXC36E TIMEOUT LIMIT EXCEEDED DURING LOGON TO SYS*/
        m.csm_err = 'noConn'
    else if pos('IKJ56225I', m.tso_trap) > 0             ,
               & ( pos('ALREADY IN USE', m.tso_trap) > 0 ,
                 | pos('CATED TO ANOTH', m.tso_trap) > 0) then
               /* 5 IKJ56225I DATA SET A540769.TMP.TEXT ALREADY IN USE,
                  6 IKJ56225I DATA SET IS ALLOCATED TO ANOTHER JOB */
        m.csm_err = 'inUse'
    else if pos('CSMAP47E TP timed out', m.tso_trap) > 0 then
        m.csm_err = 'timeout'
    else
        m.csm_err = ''
    m.csm_errMsg = strip('csm' m.csm_err) 'rc='m.tso_rc ,
            '\nstmt='m.tso_stmt m.tso_trap ,
            '\ntime='ggStart '-' time()
    if pos('*', arg(2)) <= 0 & wordPos(m.tso_rc, arg(2)) <= 0 then
        call err m.csm_errMsg
    return m.tso_rc
endRoutine csmEx2

csmDel: procedure expose m.
parse upper arg rz, dsn, aMbrs
    mbrs = dsnGetMbr(dsn) aMbrs
    lib = dsnSetMbr(dsn)
    dd = tsoDD(csmDel, 'a')
    if mbrs = '' then do
        dRc = adrCsm("allocate system("rz") dataset('"lib"')" ,
                         "disp(del) ddname("dd")", 8)
        end
    else do
        dRc = adrCsm("allocate system("rz") dataset('"lib"')" ,
                         "disp(shr) ddname("dd")", 8)
        if dRc == 0 then do
            do mx=1 to words(mbrs)
                m1 = word(mbrs, mx)
                dRc = adrCsm("mDelete ddName("dd") member("m1")", 8)
                if dRc <> 0 then do
                    if pos('CSMEX77E Member:'m1  'not f', m.tso_trap) ,
                            < 1 then
                        leave
                  say 'member not found, not deleted:' rz'/'dsn'('m1')'
                  dRc = 0
                  end
                end
            end
        end
    if dRc = 0 then
        return tsoFree(dd)
    if pos('CSMSV29E DATA SET' lib 'NOT IN CAT', m.tso_trap) >0 then do
        say 'dsn not found and not deleted:' rz'/'dsn
        call tsoFree dd
        return 4
        end
    eMsg = 'rc='m.tso_rc 'stmt='m.tso_stmt':' m.tso_trap
    call tsoFree dd
    return err('csmDel' eMsg)
endProcedure csmDel
/*--- copy members / datasets
      Vorlage: csrxUtil ---------------------------------------------*/
csmCopy: procedure expose m.
parse upper arg fr, to, mbrs
    say 'please use dsnCopy instead of depreceated csmCopy'
    return dsnCopy(fr, to, mbrs)

csmCop2: procedure expose m.
parse upper arg o1 o2, fr, to tA1 ':' tA2, mbrs
    frDD = tsoDD('csmFrDD', 'a')
    tAt =  strip(tA1 firstNS(tA2, ':D'frDD))
    toDD = tsoDD('csmToDD', 'a')
    mbr1 = abbrev(o2, '&') & words(mbrs) = 1
    if mbr1 then do
        parse value strip(mbrs) with fMb '>' tMb
        call csmAlloc fr'('fMb')', frDD, 'shr'
        tM2 = firstNS(tMb, copies(fMb, o2 <> '&-'))
        call csmAlloc dsnSetMbr(to, tM2), toDD, 'shr', , tAt
        end
    else do
        call csmAlloc fr, frDD, 'shr'
        call csmAlloc to, toDD, 'shr', , tAt
        end
    if      m.tso_recFM.frDD <> m.tso_recFM.toDD ,
          | m.tso_lRecL.frDD <> m.tso_lRecL.toDD then do
        call tsoFree frDD toDD
        return if(m.tso_lRecL.frDD <= m.tso_lRecL.toDD, 'W', 'T')
        end
    inDD = tsoDD('csmInDD', 'a')
    i.0 = 0
    if abbrev(o2, '&') & \ mbr1 then do
        i.0 = words(mbrs)
        do mx=1 to i.0
            parse value word(mbrs, mx) with mF '>' mT
            if mF = '' then
                call err 'bad mbr or mbrOld>mbrNew' word(mbrs, mx),
                          'in csmCopy('fr',' to','mbrs')'
            else if mT = '' then
                i.mx = ' S M='mF
            else
                i.mx = ' S M=(('mF','mT'))'
            end
        end
    if i.0 <= 0 then do
        call adrTso 'alloc dd('inDD') dummy'
        end
    else do
        call tsoAlloc ,inDD, 'NEW', , ':F'
        call writeDD inDD, 'I.', i.0
        call tsoCLose inDD
        end
    outDD = tsoDD('csmOuDD', 'a')
    call dsnAlloc('dd('outDD') new ::V137')
    cmdu = 'CSMUTIL CSM,COPYREPLACE,DD(,,,,'inDD','outDD ,
               ||  ',,'frDD','toDD'),MARC(0)'
    cRc = adrTso(cmdU, '*')
    if cRc <> 0 then do
        call readDD outDD, o.
        call tsoClose outDD
        say 'rc='cRc',' o.0 'outputlines for' cmdU
        do ox=1 to o.0
            say o.ox
            end
        end
    call tsoFree frDD toDD inDD outDD
    if cRc <> 0 then
        call err 'csmCopy rc='cRc
    return cRc
endProcedure csmCopy

csmAlloc: procedure expose m.
parse arg sysDsn, dd, disp, rest, nn, retRc
    upper dd disp
    parse value dsnCsmSys(sysDsn) with sys '/' dsn
    m.tso_dsn.dd = sys'/'dsn
    if disp = '' then
        disp = 'shr'
    else if words(disp) = 2 then
        disp = word(disp, 2)
    a1 = "SYSTEM("sys") DDNAME("dd")"
    if dsn == 'INTRDR' then do
        a1 = a1 'sysout(T) writer(intRdr)'
        end
    else do
        if dsn <> '' then do
            a1 = a1 "DATASET('"dsnSetMbr(dsn)"')"
            mbr = dsnGetMbr(dsn)
            if mbr <> '' then
                a1 = a1 'MEMBER('mbr')'
            end
        if abbrev(disp, 'SYSOUT(') then
            a1 = a1 disp
        else
            a1 = a1 "DISP("disp")"
        end
    isNew = wordPos(disp, 'NEW MOD CAT') > 0
    if isNew & nn \== '' then
        rest = dsnCreateAtts('-'dsn , nn) rest
    cx = pos(' UCOUNT(', ' 'translate(rest))
    if cx > 0 then do
         rest = left(rest, cx) || 'nitCnt(' || substr(rest, cx+7)
         end
    cx = pos(' RECFM(', ' 'translate(rest))
    if cx > 0 then do
        recFm = substr(rest, cx+6, 1)
        cy = pos(')', rest, cx)
        if cy > cx then
            rest = left(rest, cx+5) || space(substr(rest,cx+6,cy-cx-6),
                               , 0) || substr(rest,cy)
        end
    cx = pos(' CYLINDERS ', ' 'translate(rest)' ')
    if cx > 0 then do
        rest = delStr(rest, cx+8, 1)
        end
    cx = pos(' CYL ', ' 'translate(rest)' ')
    if cx > 0 then
        rest = insert('inder', rest, cx+2)
    if isNew then
         if pos(' BLKSIZE(', ' 'translate(rest)) <= 0 then do
             /* without blkSize csm will fail to read for rec < 272 */
             cx = pos(' LRECL(', ' 'translate(rest))
             lrecl = substr(rest, cx+6,
                           , max(0, pos(')', rest, cx+6) - cx - 6))
             blk = 32760
             if datatype(lRecl ,'n') & translate(recfm) = 'F' then
                 blk = blk - blk // lRecL
             rest = rest 'blkSize('blk')'
             end
    noRetry = retRc <> '' | isNew | nn == ''
    alRc = adrCsm('allocate' a1 rest, if(noRetry, retRc, '*'))
    m.tso_dsorg.dd = subsys_dsOrg
    m.tso_recFM.dd = subsys_recFM
    m.tso_blkSize.dd = subsys_blkSize
    m.tso_lRecL.dd = subsys_lRecL
    if alRc = 0 then
        return 0
    m.tso_dsnNF.dd = pos('CSMSV29E DATA SET' dsnSetMbr(dsn) ,
                         'NOT IN CATALOG', m.tso_trap) > 0
    if noRetry | \ m.tso_dsnNF.dd then
        if pos('*', retRc) > 0 | wordPos(alRc, retRc) > 0 then
            return alRc
        else
            return err(m.csm_errMsg)
    say 'csmAlloc rc' alRc 'for' a1 rest '...trying to create'
    call csmAlloc sysDsn, dd, 'CAT', rest ,nn
    call adrTso 'free  dd('dd')'
    return adrCsm('allocate' a1 rest)
endProcedure csmAlloc

csmLikeAtts: procedure expose m.
parse upper arg rz '/' dsn
    lc = adrCsm('dslist system('rz') dsnMask('dsnSetMbr(dsn)')')
    if stemsize <> 1 then
        call err 'csmLikeAtts stemSize='stemsize 'for dsn='dsn
    if abbrev(dsOrg.1, 'PO') then
        r = 'dsorg(po) dsnType(library)'
    else if abbrev(dsOrg.1, 'PS-') then
        r = 'dsorg(PS)'
    else
        r = 'dsorg('dsOrg.1')'
    r = r 'mgmtClas('mgmtClas.1')'                       ,
       /* 'dataClas('dataClas.1')'   */                  ,
          'recFM('strip(translate('1 2 3', recFm.1, '123'))')'  ,
          'lRecl('lRecl.1')'                         ,
          'space('fUnit2I('b', tracksused.1) ,
           || ',' fUnit2I('b', tracks.1)') tracks'
    /*    if \ datatype(tracksused.1, 'n') then do
              if \ datatype(tracks.1, 'n') then
                  r = r 'space('tracks.1',' tracks.1')'
              if \ datatype(tracks.1, 'n') then
                  tracks.1 = tracksUsed.1   */

    return r
endProcedure csmLikeAtts

csmMbrList: procedure expose m.
parse arg m, sys, dsn, msk
              /* attention mbrList dataset(....)
                 does not cleanup proberly if dsn is NOT PO
                 and much later on follow errors appear
                 which are hard to debug| */
    if dataType(dsnAlloc(sys'/'dsn, , mbrLisDD, 8), 'n') then do
        say sys dsn
        say m.tso_trap
        m.m.dsnNF = m.tso_dsnNF.mbrLisDD
        if \ m.m.dsnNF then
            call err m.csm_errMsg
        m.m.0 = -99
        end
    else do
        m.m.dsnNF   = 0
        m.m.RECFM   = m.tso_RECFM.mbrLisDD
        m.m.LRECL   = m.tso_LRECL.mbrLisDD
        m.m.BLKSIZE = m.tso_BLKSIZE.mbrLisDD
        m.m.DSORG   = m.tso_DSORG.mbrLisDD
        if m.m.DSORG \== 'PO' then
            m.m.0 = -98
        else do
            if msk <> '' then
                msk = 'member('translate(msk, '%', '?')')'
            call adrCsm "mbrList ddName(mbrLisDD)" msk ,
                        "index(' ') short"
            m.m.0 = mbr_name.0
            do mx=1 to mbr_name.0
                m.m.mx = strip(mbr_name.mx)
                end
            end
        call tsoFree mbrLisDD
        end
    return m.m.0
endProcedure csmMbrList

/*--- execute a rexx (under tso) in another rz
           here we use rexx TPSYSIKJ which was written for
           jcl procedure RM@IKJ01
arguments
rz   which rz to run rexx
proc the (remote) procedure library to use
cmd  the tso command to execute
---------------------------------------------------------------------*/
/*--- execute a rexx (under tso) in another rz
          directly (without TPSYSIKJ) -------------------------------*/
csmExRx: procedure expose m.
parse arg rz, proc, cmd, keepTsPrt, retOk
    do cx=1 to (length(cmd)-1) % 68       /* split tso cmd in linews */
        cmd.cx = substr(cmd, 68*cx-67,68)'-'
        end
    cmd.cx = substr(cmd, 68*cx-67)
    cmd.0 = cx
                                       /* alloc necessary dd */
    call dsnAlloc rz"/"proc "dd(rmSyPro) rmtDDn(sysProc)"
    call dsnAlloc rz"/tmp.tsin new dd(rmTsIn) rmtDdn(sysTsIn) ::f "
    call tsoOpen rmTsIn, 'w'           /* write tso cmd */
    call writeDD rmTsIn, cmd.
    call tsoClose rmtsin
    call dsnAlloc rz"/tmp.tsPrt new dd(rmTsPrt) rmtDdn(sysTsPrt)",
                    "::v"
    call dsnAlloc rz"/tmp.rmt new dd(rmtSys)"
    m.csm_exRxMsg = ''
    m.csm_exRxRc = csmappc("csmexec" ,
         , "select tsocmd('csmappc allocate plu(*.rmtSys)" ,
           "tpname(sysikj) dealloc')", , "*")
    if m.csm_exRxRc <> 0 then do /* handle csm error */
        call readDD 'rmTsPrt', 'M.CSM_TSPRT.', '*'
        call tsoClose rmTsPrt
        msg = '\n'left('remote sysTsPrt' ,
              m.csm_tsprt.0 'lines begin ', 79, '-')
        do lx=1 to min(100, m.csm_tsPrt.0)
             msg = msg'\n'strip(m.csm_tsPrt.lx, 't')
             end
        l2 = max(lx, m.csm_tsPrt.0-99)
        if l2 > lx then
            msg = msg'\n'left('remote sysTsPrt' ,
              m.csm_tsprt.0 'lines' l2 'to' m.csm_tsPrt.0, 79, '-')
        do lx=l2 to m.csm_tsPrt.0
             msg = msg'\n'strip(m, m.csm_tsPrt.lx, 't')
             end
        m.csm_exRxMsg = 'cmsExRx rc='ggRc m.csm_errMsg || msg ,
              '\n'left('remote sysTsPrt' ,
                  m.csm_tsprt.0 'lines end ', 79, '-')
    /*  call sayNl m.csm_exRxMsg */
        end
    call tsoFree rmSyPro rmtSys rmtsIn copies(rmTsPrt, keepTsPrt\==1)
    if pos(m.csm_exRxRc, 0 4) < 1 then do /* handle csm error */
        if pos('*', retOk) > 0 | wordPos(m.csm_exRxRc, retOk) > 0 then
            call sayNl m.csm_exRxMsg
        else
            call err m.csm_exRxMsg
        end
    return m.csm_exRxRc
endProcedure csmExRx


csmExWsh: procedure expose m.
parse arg rz, rdr, opt
    w = oNew(m.class_csmExWsh, rz, rdr, opt)
    call pipeWriteAll w
    return

csmExWshOpen: procedure expose m.
parse arg m, opt
     rz = m.m.rz
     if opt \== '<' then
         call err 'csmExWshOpen('opt') not read'
     a1 = dsnAlloc(rz"/tmp.wsh new dd(rmtWsh) rmtDdn(wsh) ::v",,, '*')
     if datatype(a1, 'n') then do
          call sayNl 'adrTso rc='a1 'stmt='m.tso_stmt m.tso_trap
          say 'trying to free'
          call tsoFree 'rmtSys rmTsPrt rmTsIn rmSyPro rmtWsh rmtOut'
          call dsnAlloc rz"/tmp.wsh new dd(rmtWsh) rmtDdn(wsh) ::v"
          end
     wsh = jOpen(file('dd(rmtWsh)'), '>')
     call jWriteNow wsh, in2file(m.m.rdr)
     call jClose wsh
     parse var m.m.wOpt oOpt wSpec
     if wSpec = '' then
         wSpec = '@'
     o2 = firstNS(oOpt, 'v')
     if oOpt == 'e' then do
         o2 = 'v'
         wSpec = '$#outFmt e $#'wSpec
         end
     if o2 == 'p' then do
         fo = file('dd(rmTsPrt)')
         end
     else do
         call dsnAlloc rz"/tmp.out new dd(rmtOut) rmtDdn(out) ::"o2
         fo = file('dd(rmtOut)')
         end
     if oOpt == 'e' then
         m.m.deleg = csvIntRdr(csvF2VRdr(fo))
     else
         m.m.deleg = fo
     say 'cmsExWsh sending to' rz wSpec
     if abbrev(m.myLib, A540769) then
         m.m.exRxRc = csmExRx(rz, m.myLib, m.myWsh wSpec,
             , o2 == 'p' , '*')
     else
         m.m.exRxRc = csmExRx(rz, 'DSN.DB2.EXEC', 'WSH' wSpec,
             , o2 == 'p' , '*')
     call tsoFree 'rmtWsh'
     call jOpen m.m.deleg, opt
     m.fo.free = m.fo.dd
     return m
endProcedure csmExWshOpen

csmIni: procedure expose m.
    if m.csm_ini == 1 then
        return
    m.csm_ini = 1
    call catIni
    call classNew 'n CsmExWsh u JRWDeleg', 'm'                   ,
        , "jReset m.m.deleg = ''; m.m.rz = arg; m.m.rdr = arg2"  ,
                               "; m.m.wOpt = arg(4)"             ,
        , "jOpen call csmExWshOpen m, opt"                       ,
        , "jClose call jClose m.m.deleg;" ,
              "if pos(m.m.exRxRc,0 4)<1 then call err m.csm_ExRxMsg;",
              "else say 'csm execute wsh rc =' m.m.exRxRc"
    return
endProcedure csmIni

/* copy csm end ******************************************************/