23rd January 2022, 5 min read

IMS/DC MFS To PHP

Original post is here eklausmeier.goip.de/blog/2022/01-23-ims-dc-mfs-to-php.

Task at hand: Convert IMS/DC MFS to PHP code. This is vaguely similar to the task that the MFS language utility DFSUPAA0 does. IMS/DC is a mainframe based transaction manager. MFS is an Assembler like description of the message format used in IMS/DC.

Parse MFS using Perl:

Screen layout is delimited by FMT and FMTEND
Expect one single FMT per file
Message format used by COBOL programs is delimited by MSG and MSGEND
Expect two MSGEND: one for input, one for output, i.e., two message formats per file
Each labeled field in FMT-specification will be stored in key of a hash. Value of hash contains:
1. X position
2. Y position
3. Length of field
4. ATTR attributes in a bit-field. Attributes are:
  1. 0x01: Protected or non-protected
  2. 0x02: Numeric or alpha
  3. 0x04: Highlighted or not
  4. 0x08: Displayable or not
Unlabeled fields are grouped in hash starting with __1, __2, __3, etc. Value of hash same as for labeled fields.

EATTR attributes are ignored. So are NODET, DET, IDET.

erDiagram hash { int x int y int len int attr }

MFS files with only one MSGEND, this is mostly print output, are ignored for the moment.

Generate PHP file using Perl:

In head: CSS code for each field, e.g., #TXCODE {width:6.0em}
In head: PHP functions for packing and unpacking the message format as parsed above
PHP function call for each field on the screen, e.g.:

<input class=X type=text maxlength=1 id=X name=X value=<?=$P["X"]?>>

For the hash $P see below -- pack() and unpack().

Packing is: Maps PHP variables to message format according input message (MSG TYPE=INPUT). In PHP we use pack() for this.

Unpacking is: Maps message format to PHP variables according output message (MSG TYPE=OUTPUT). In PHP we use unpack() for this. Result is in $P.

IMS emulation layer, which is part of the head of the generated PHP file, written in either PHP or C (PHP extension):

Creates and maintains IPC shared memory. This shared memory is also accessed via CBLTDLI calls from COBOL.
Maintains mapping between transaction code and COBOL program
Packing PHP variables $_POST[] into message format, as usually we are called as HTTP POST. Pushing message via CBLTDLI('ISRT',...).
Calls COBOL program which corresponds to the transaction; PHP would call FFI here
COBOL program calls CBLTDLI to get message and insert new message.
Fetching message via CBLTDLI('GU',...). Unpacking message format to PHP variables, which are then actually shown on web-page.

flowchart LR a([HTTP POST]) --> b(Pack PHP into IN-message\nISRT via CBLTDLI) --> c{{COBOL}} --> d(GU via CBLTDLI\nUnpack OUT-message into PHP)

For packing and unpacking we need either the COBOL copybook or the above message format, which contains information on:

Fieldname
Length of field
Start position in message

Perl script is here: ims2php, helper PHP script is here: ims2php.php.

The CBLTDLI routine, called from COBOL and PHP, is a tailor-made routine in C which responds to message types AUTH, GU, GHU, GN, GHN, INIT, ISRT, ROLB, and PPS. Below given routine is a proof-of-concept demonstration.

int CBLTDLI (const char fct[], struct IO_PCB *iopcb, char *msg, char *mfsmodn, void *nullp) {
    int size;
    char *pcb = NULL, *pcbname = "unknown";
    static int sizeErr = -20;	// that many non-positive sizes are o.k., thereafter exit
    static int runaway = -20;	// limit calls to CBLTDLI() to this many
        assert(mainp != NULL);
        assert(outmsg != NULL);
    if (++runaway > 0) exit(21);

    if (strncmp(fct,"AUTH",4) == 0) {
        puts("CBLTDLI: AUTH");
    } else if (strncmp(fct,"GU  ",4) == 0  ||  strncmp(fct,"GHU ",4) == 0
        || strncmp(fct,"GN  ",4) == 0  ||  strncmp(fct,"GHN ",4) == 0) {
        assert(msg != NULL);
        size = 0;
        if (iopcb == &global_iopcb) {
            pcb = mainp;
            pcbname = "IO-PCB";
            if (iopcb->io_segnr == 0) {
                iopcb->io_status[0] = ' ';
                iopcb->io_status[1] = ' ';
            } else {
                iopcb->io_status[0] = 'Q';
                iopcb->io_status[1] = 'C';
            }
            iopcb->io_segnr += 1;	// increment segment number
        } else if ((char*)iopcb == spa_pcb) {
            size = 4000;
            printf("CBLTDLI: %4.4s SPA-PCB %p.\n",fct,iopcb);
            pcb = (char*) shmp;
            pcbname = "SPA-PCB";
        } else if ((struct ALT_PCB *)iopcb == &global_altpcb) {
            printf("CBLTDLI: %4.4s ALT-PCB.\n",fct);
        } else {
            printf("CBLTDLI: %4.4s unknown IO-PCB %p\n", fct, iopcb);
        }
        if (size == 0) size = 256 * (unsigned char)(pcb[0]) + (unsigned char)(pcb[1]);
        printf("CBLTDLI: fct=%4.4s, segnr=%d, LENGTH(msg)=%d, %s=%p%s\n",
            fct, iopcb->io_segnr, size, pcbname,
            iopcb, size < 0 ? " ERROR" : "");
        if (size > 0) memcpy(msg, pcb, size);
        else if (++sizeErr > 0) exit(21);
        dbgputs(pcb,size);
    } else if (strncmp(fct,"INIT",4) == 0) {
        size = 256 * (unsigned char)(msg[0]) + (unsigned char)(msg[1]);
        printf("CBLTDLI: fct=%4.4s, segnr=%d, LENGTH(msg)=%d, %s=%p\n",
            fct, iopcb->io_segnr, size, "unused", iopcb);
    } else if (strncmp(fct,"ISRT",4) == 0) {
        assert(msg != NULL);
        size = 0;
        if (iopcb == &global_iopcb) {
            pcb = outmsg;
            pcbname = "IO-PCB";
            iopcb->io_status[0] = ' ';
            iopcb->io_status[1] = ' ';
        } else if ((char*)iopcb == spa_pcb) {
            size = 4000;
            printf("CBLTDLI: %4.4s SPA-PCB %p.\n",fct,iopcb);
            pcb = (char*) shmp;
            pcbname = "SPA-PCB";
        } else if ((struct ALT_PCB *)iopcb == &global_altpcb) {
            printf("CBLTDLI: %4.4s ALT-PCB.\n",fct);
        } else {
            printf("CBLTDLI: %4.4s unknown IO-PCB %p\n", fct, iopcb);
        }
        if (size == 0) size = 256 * (unsigned char)(msg[0]) + (unsigned char)(msg[1]);
        printf("CBLTDLI: fct=%4.4s, segnr=%d, LENGTH(msg)=%d, %s=%p%s\n",
            fct, iopcb->io_segnr, size, pcbname,
            iopcb, size < 0 ? " ERROR" : "");
        if (size > 0) memcpy(pcb, msg, size);
        else if (++sizeErr > 0) exit(21);
        dbgputs(msg,size);
    } else if (strncmp(fct,"ROLB",4) == 0) {
        if (iopcb == &global_iopcb) {
            if (iopcb->io_segnr > 0) iopcb->io_segnr -= 1;	// "roll back" segment number
            else puts("segnr already <= 0");
        }
        printf("CBLTDLI: fct=%4.4s, segnr=%d, iopcb=%p\n", fct, iopcb->io_segnr, iopcb);
    } else if (strncmp(fct,"CHKP",4) == 0) {
        printf("CBLTDLI(): Ignoring checkpointing, function fct=%c%c%c%c\n",fct[0],fct[1],fct[2],fct[3]);
    } else if (strncmp(fct,"PPS ",4) == 0) {
        pcb = (char*) shmp;
        pcbname = "SPA-PCB-special";
        size = 4000;	//256 * (unsigned char)(pcb[0]) + (unsigned char)(pcb[1]);
        printf("CBLTDLI(): fct=%s, size=%d, %s=%p%s\n",
            fct, size, pcbname, pcb, size < 0 ? " ERROR" : "");
        if (size > 0) memcpy(pcb+5000, msg, size);
        else if (++sizeErr > 0) exit(21);
        dbgputs(msg,size);
    } else {
        printf("CBLTDLI(): Unknown function fct=%c%c%c%c\n",fct[0],fct[1],fct[2],fct[3]);
        exit(21);
    }

    return 0;
}