VMS Process Communication

Content:

  1. Introduction
  2. Shared Memory
    1. Concept
    2. Demo
    3. System Service (C, Fortran, Pascal, Cobol)
  3. Memory Mapped File
    1. Concept
    2. Demo
    3. System Service (C, Fortran, Pascal, Cobol)
  4. Writeable Shareable Image
    1. Concept
    2. Demo
    3. Linker/installer (Fortran, Pascal, C, Basic)
  5. Mailboxes
    1. Concept
    2. Demo
    3. Standard IO (C, Fortran, Pascal, Cobol, Basic, Java, Python, DCL)
  6. DECnet Task-to-Task
    1. Concept
    2. Demo
    3. RMS (DCL, C, Fortran, Pascal, Cobol, Basic, Python)
  7. ICC
    1. Concept
    2. Demo
    3. System Service (C, Fortran, Pascal)
  8. TCP/IP Socket
    1. Concept
    2. Demo
    3. Java API (Java)
    4. C API (C)
    5. Python API (Python, Jython)
    6. PHP API (PHP)
    7. Wrapper C API (Fortran, Pascal, Cobol, Basic)
  9. HTTP
    1. Concept
    2. Demo
    3. Embedded server (Java, Python)
    4. Java API (Java)
    5. urllib3 (Python)
    6. Curl (C, PHP)
    7. Direct socket (C)
    8. Wrapper direct socket (Fortran, Pascal, Cobol, Basic)
  10. SOAP Web Service
    1. Concept
    2. Demo
    3. JAX-WS embedded server (Java)
    4. JAX-WS (Java, Groovy, Jython)
    5. Zeep (Python)
    6. SoapClient (PHP)
    7. Spyne embedded server (Python)
  11. XML-RPC Web Service
    1. Concept
    2. Demo
    3. Embedded server (Java, Python)
    4. Apache XML-RPC (Java, Groovy)
    5. xmlrpc module (Python)
    6. xmlrpc encoder and decode (PHP)
    7. XMLRPC and PXMLRPC (C, Pascal)
    8. direct XML + HTTP wrapper (Fortran, Basic)
  12. RESTful Web Service
    1. Concept
    2. Demo
    3. Embedded server (Java)
    4. HttpURLConnection + GSon (Java, Groovy)
    5. request + json (Python)
    6. curl + json_encode/json_decode (PHP)
    7. socket + cJSON (C, Pascal)
  13. Message Queue
    1. Concept
    2. Demo
    3. JMS API (Java, Jython)
    4. STOMP C library (C)
    5. STOMP Python library (Python)
    6. Wrapper C STOMP library (Fortran, Pascal, Cobol, Basic)
  14. Index Sequential File
    1. Concept
    2. Demo
    3. Language builtin (Pascal, Cobol, Basic, Fortran, DCL)
    4. RMS API (C)
    5. VMS Python IndexedFile (Python)
    6. JVM ISAM library (Java, Jython)
  15. SQLite Database
    1. Concept
    2. Demo
    3. C API (C)
    4. Python API (Python, Jython)
    5. PDO API (PHP)
    6. JDBC API (Java)
    7. JPA API (Java, Jython)
    8. Wrapper C API (Pascal)
  16. MySQL Database
    1. Concept
    2. Demo
    3. C API (C)
    4. PDO API (PHP)
    5. JDBC API (Java)
    6. JPA API (Java, Jython)
    7. Wrapper C API (Pascal)
  17. Redis Cache
    1. Concept
    2. Demo
    3. Hiredis (C)
    4. Official VMS wrapper hiredis (Fortran, Pascal, Cobol, Basic)
    5. Custom VMS wrapper hiredis (Fortran, Pascal, Cobol, Basic)
    6. Jedis (Java, Jython)
    7. Python module (Python)

Introduction:

This article covers different ways to do commincation between processes on VMS.

Some skills are needed to get full benefit from this article:

The examples are very minimalistic (hello world level), but the context really require a VMS programmer to understand.

Some ways of process communication are not covered (yet), including:

The coding style of the examples can always be discussed, but the purpose is not to show best coding style in the language but to show how to do something specific in the language. Especially languages that I am not familiar with like Cobol and Basic may use an uncoventional coding style.

Shared Memory:

Concept:

The concept is that different processes map different section of their virtual memory to the same section of physical memory.

Shared memory model

The functionality is based on the VMS system services SYS$CRMPSC and SYS$MPGBLSC (the first create a section and map to it, the last map to an existing section).

Physical memory is handled as pages (units of 8192 bytes on Alpha/Itanium/x86-64). Sections has to be page aligned.

Sections can be permament or temporary. Sections can be system wide or group wide.

Access Direct memory
Supported languages Any language able to call system services, control alignment of memory and pass address of memory to system service
Persistence Tempororary section: only exist as long it is mapped by at least one process
Permanent section: exist until system reboot
Data not persisted across "sessions"
Scope Group wide section: visible to processes in same group
System wide section: visible to all processes on system
Concurrency No builtin controls - must be handled by applications. VMS DLM is an obvious choice.
Security All internal on system and in memory
Access to global section can be restricted

Demo:

We will map a section of 10 pages (81920 bytes).

Each message use a 100 byte slot.

Message is terminated with nul byte (C string).

The section is created and kept alive by a C program. The section is temporary and group wide.

Client programs add a new message in an unused slot and dump all messages present.

System Service:

Server (create and keep alive):

#include <stdio.h>

#include <descrip.h>
#include <secdef.h>
#include <starlet.h>

#define BLOCKSIZE 8192
#define BLOCKS 10
#define SHRMEMSIZ BLOCKS * BLOCKSIZE
#define MAXMSGSIZ 100
#define MAXMSGS SHRMEMSIZ / MAXMSGSIZ
#define DISKBLOCKSIZE 512

#define GLBSECNAM "M"

static union
{
   char dummy[SHRMEMSIZ];
   char msg[MAXMSGS][MAXMSGSIZ];
} __align(13) shrmem;

int main(int argc, char *argv[])
{
    $DESCRIPTOR(name, GLBSECNAM);
    void *range[2];
    long int stat;
    char dummy[2];
    /* create global section */
    range[0] = (char *)&shrmem;
    range[1] = (char *)&shrmem + sizeof(shrmem) - 1;
    stat = sys$crmpsc(range, 0, 0, SEC$M_PAGFIL | SEC$M_GBL | SEC$M_WRT | SEC$M_DZRO,
                      &name, 0, 0, 0, sizeof(shrmem) / DISKBLOCKSIZE, 0, 0, 0);
    if((stat & 1) == 0) printf("sys$crmpsc stat = %d\n", stat);
    /* wait for user input */
    printf("Press enter to exit");
    fgets(dummy, sizeof(dummy), stdin);
    return 0;
}

Build:

$ cc server
$ link server

Run:

$ run server

Client:

#include <stdio.h>
#include <string.h>

#include <descrip.h>
#include <secdef.h>
#include <starlet.h>

#define BLOCKSIZE 8192
#define BLOCKS 10
#define SHRMEMSIZ BLOCKS * BLOCKSIZE
#define MAXMSGSIZ 100
#define MAXMSGS SHRMEMSIZ / MAXMSGSIZ

#define GLBSECNAM "M"

static union
{
   char dummy[SHRMEMSIZ];
   char msg[MAXMSGS][MAXMSGSIZ];
} __align(13) shrmem;

int main(int argc, char *argv[])
{
    $DESCRIPTOR(name, GLBSECNAM);
    void *range[2];
    long int stat;
    int i;
    /* map global section */
    range[0] = (char *)&shrmem;
    range[1] = (char *)&shrmem + sizeof(shrmem) - 1;
    stat = sys$mgblsc(range, 0, 0, SEC$M_WRT,&name, 0, 0);
    if((stat & 1) == 0) printf("sys$mgblsc stat = %d\n", stat);
    /* write to global section */
    i = 0;
    while(shrmem.msg[i][0] != 0) i++;
    strcpy(shrmem.msg[i], "Hi from C!");
    /* dump global section */
    for(i = 0; i < MAXMSGS; i++)
    {
        if(strlen(shrmem.msg[i]) > 0)
        {
            printf("|%s|\n", shrmem.msg[i]);
        }
    }
    return 0;
}

Build:

$ cc p1
$ link p1

Run:

$ run p1
#include <stdio.h>
#include <string.h>

#include <descrip.h>
#include <secdef.h>
#include <starlet.h>

#define BLOCKSIZE 8192
#define BLOCKS 10
#define SHRMEMSIZ BLOCKS * BLOCKSIZE
#define MAXMSGSIZ 100
#define MAXMSGS SHRMEMSIZ / MAXMSGSIZ

#define GLBSECNAM "M"

typedef union
{
   char dummy[SHRMEMSIZ];
   char msg[MAXMSGS][MAXMSGSIZ];
} shrmem_t;

int main(int argc, char *argv[])
{
    shrmem_t *shrmem;
    $DESCRIPTOR(name, GLBSECNAM);
    void *range[2];
    long int stat;
    int i;
    /* map global section */
    range[0] = 0;
    range[1] = 0;
    stat = sys$mgblsc(range, range, 0, SEC$M_EXPREG | SEC$M_WRT,&name, 0, 0);
    if((stat & 1) == 0) printf("sys$mgblsc stat = %d\n", stat);
    shrmem = (shrmem_t *)range[0];
    /* write to global section */
    i = 0;
    while(shrmem->msg[i][0] != 0) i++;
    strcpy(shrmem->msg[i], "Hi from C (alt)!");
    /* dump global section */
    for(i = 0; i < MAXMSGS; i++)
    {
        if(strlen(shrmem->msg[i]) > 0)
        {
            printf("|%s|\n", shrmem->msg[i]);
        }
    }
    return 0;
}

Build:

$ cc p1z
$ link p1z

Run:

$ run p1z
      program p2
      implicit none
      include '($secdef)'
      integer*4 blocksize,blocks,shrmemsiz,maxmsgsiz,maxmsgs
      character*1 name
      parameter (blocksize=8192,
     +           blocks=10,
     +           shrmemsiz=blocks*blocksize,
     +           maxmsgsiz=100,
     +           maxmsgs=shrmemsiz/maxmsgsiz,
     +           name='M')
      byte shrmem(shrmemsiz)
      common /shrmempsect/shrmem
      character*100 msg(maxmsgs)
      equivalence (shrmem,msg)
      integer*4 range(2),stat,i,msglen
      integer*4 sys$mgblsc
      external sys$mgblsc
c  map global section
      range(1)=%loc(shrmem)
      range(2)=%loc(shrmem)+shrmemsiz-1
      stat=sys$mgblsc(%ref(range),,,%val(SEC$M_WRT),%descr(name),,)
      if((stat.and.1).eq.0) write(*,*) 'sys$mgblsc stat=',stat
c  write to global section
      i=0
100   i=i+1
      if(msg(i)(1:1).ne.char(0)) goto 100
      msg(i)='Hi from Fortran!'//char(0)
c  dump global section
      do 200 i=1,maxmsgs
        if(msg(i)(1:1).ne.char(0)) then
          msglen=index(msg(i),char(0))
          write(*,*) '|'//msg(i)(1:msglen)//'|'
        endif
200   continue
      end

Build:

$ for p2
$ link p2 + sys$input/opt
PSECT_ATTRIBUTE=shrmempsect,13
$

Run:

$ run p2
      program p2z
      implicit none
      include '($secdef)'
      character*1 name
      parameter (name='M')
      integer*4 range(2),stat
      integer*4 sys$mgblsc
      external sys$mgblsc
c  map global section
      range(1)=0
      range(2)=0
      stat=sys$mgblsc(%ref(range),%ref(range),,
     +                %val(SEC$M_EXPREG+SEC$M_WRT),%descr(name),,)
      if((stat.and.1).eq.0) write(*,*) 'sys$mgblsc stat=',stat
      call action(%val(range(1)))
      end
c
      subroutine action(shrmem)
      implicit none
      integer*4 blocksize,blocks,shrmemsiz,maxmsgsiz,maxmsgs
      parameter (blocksize=8192,
     +           blocks=10,
     +           shrmemsiz=blocks*blocksize,
     +           maxmsgsiz=100,
     +           maxmsgs=shrmemsiz/maxmsgsiz)
      structure /shrmemtyp/
        character*100 msg(maxmsgs)
      end structure
      record /shrmemtyp/shrmem
      integer*4 i,msglen
c  write to global section
      i=0
100   i=i+1
      if(shrmem.msg(i)(1:1).ne.char(0)) goto 100
      shrmem.msg(i)='Hi from Fortran (alt)!'//char(0)
c  dump global section
      do 200 i=1,maxmsgs
        if(shrmem.msg(i)(1:1).ne.char(0)) then
          msglen=index(shrmem.msg(i),char(0))
          write(*,*) '|'//shrmem.msg(i)(1:msglen)//'|'
        endif
200   continue
      end

Build:

$ for p2z
$ link p2z

Run:

$ run p2z
[inherit('sys$library:starlet')]

program p3(input,output);

const
   blocksize = 8192;
   blocks = 10;
   shrmemsiz = blocks * blocksize;
   maxmsgsiz = 100;
   maxmsgs = shrmemsiz div maxmsgsiz;
   name = 'M';

type
   msgtype = packed array [1..maxmsgsiz] of char;
   shrmemtype = record
                   case boolean of
                      true : ( dummy : packed array [1..shrmemsiz] of char; );
                      false : ( msg : packed array [1..maxmsgs] of msgtype; );
                end;

var
   shrmem : [static,aligned(13)] shrmemtype;
   range : array [1..2] of integer;
   stat, i, msglen : integer;

begin
   (* map global section *)
   range[1] := iaddress(shrmem);
   range[2] := iaddress(shrmem) + shrmemsiz - 1;
   stat := $mgblsc(inadr := range, flags := SEC$M_WRT, gsdnam := name);
   if not odd(stat) then writeln('sys$mgblsc stat=', stat:1);
   (* write to global section *)   
   i := 1;
   while shrmem.msg[i][1] <> chr(0) do i := i + 1;
   shrmem.msg[i] := 'Hi from Pascal!' + chr(0);
   (* dump global section *)
   for i := 1 to maxmsgs do begin
      if shrmem.msg[i][1] <> chr(0) then begin
         msglen := index(shrmem.msg[i], chr(0));
         writeln('|' + substr(shrmem.msg[i], 1, msglen) + '|');
      end;
   end;
end.

Build:

$ pas p3
$ link p3

Run:

$ run p3
[inherit('sys$library:starlet')]

program p3z(input,output);

const
   blocksize = 8192;
   blocks = 10;
   shrmemsiz = blocks * blocksize;
   maxmsgsiz = 100;
   maxmsgs = shrmemsiz div maxmsgsiz;
   name = 'M';

type
   msgtype = packed array [1..maxmsgsiz] of char;
   shrmemtype = record
                   case boolean of
                      true : ( dummy : packed array [1..shrmemsiz] of char; );
                      false : ( msg : packed array [1..maxmsgs] of msgtype; );
                end;

var
   shrmem : ^shrmemtype;
   range : array [1..2] of pointer;
   stat, i, msglen : integer;

begin
   (* map global section *)
   range[1] := nil;
   range[2] := nil;
   stat := $mgblsc(inadr := range, retadr := range, flags := SEC$M_EXPREG + SEC$M_WRT, gsdnam := name);
   if not odd(stat) then writeln('sys$mgblsc stat=', stat:1);
   shrmem := range[1];
   (* write to global section *)   
   i := 1;
   while shrmem^.msg[i][1] <> chr(0) do i := i + 1;
   shrmem^.msg[i] := 'Hi from Pascal (alt)!' + chr(0);
   (* dump global section *)
   for i := 1 to maxmsgs do begin
      if shrmem^.msg[i][1] <> chr(0) then begin
         msglen := index(shrmem^.msg[i], chr(0));
         writeln('|' + substr(shrmem^.msg[i], 1, msglen) + '|');
      end;
   end;
end.

Build:

$ pas p3z
$ link p3z

Run:

$ run p3z
identification division.
program-id.p4.
*
data division.
working-storage section.
01  SEC$M_WRT   pic 9(9) comp value is external SEC$M_WRT.
01  GBLSECNAM   pic x(1) value is "M".
01  range.
    03  range-start     pointer.
    03  range-end       pointer.
01  shrmem external.
    03  msg     pic x(100) occurs 819 times.
    03  padb    pic x(19).
    03  lastb   pic x(1).
01  stat        pic 9(9) comp.
01  stat2       pic 9(9) display.
01  i           pic 9(9) comp.
01  msglen      pic 9(9) comp.
*
procedure division.
main-paragraph.
    set range-start to reference of shrmem
    set range-end to reference of lastb
    call "sys$mgblsc"
        using
            by reference range,
            omitted,
            omitted,
            by value SEC$M_WRT,
            by descriptor GBLSECNAM,
            omitted,
            omitted
        giving stat
    end-call
    if stat is failure then
        move stat to stat2
        display "sys$mgblsc stat = ", stat2
        stop run
    end-if
    move 1 to i
    perform until function ord(msg(i)(1:1)) = 1
        compute i = i + 1
    end-perform
    string "Hi from Cobol!" delimited by size function char(1) delimited by size into msg(i)
    move 1 to i
    perform until function ord(msg(i)(1:1)) = 1
        perform varying msglen from 1 by 1 until function ord(msg(i)(msglen:1)) = 1
            continue
        end-perform
        display "|" msg(i)(1:msglen) "|"
        compute i = i + 1
    end-perform
    stop run.

Build:

$ cob p4
$ link p4 + sys$input/opt
PSECT_ATTRIBUTE=shrmem,13
$

Run:

$ run p4
identification division.
program-id.p4z.
*
data division.
working-storage section.
01  SEC$M_EXPREG pic 9(9) comp value is external SEC$M_EXPREG.
01  SEC$M_WRT   pic 9(9) comp value is external SEC$M_WRT.
01  GBLSECNAM   pic x(1) value is "M".
01  flag        pic 9(9) comp.
01  range.
    03  range-start     pic 9(9) comp.
    03  range-end       pic 9(9) comp.
01  stat        pic 9(9) comp.
01  stat2       pic 9(9) display.
*
procedure division.
main-paragraph.
    move 0 to range-start
    move 0 to range-end
    compute flag = SEC$M_EXPREG + SEC$M_WRT
    call "sys$mgblsc"
        using
            by reference range,
            by reference range,
            omitted,
            by value flag,
            by descriptor GBLSECNAM,
            omitted,
            omitted
        giving stat
    end-call
    if stat is failure then
        move stat to stat2
        display "sys$mgblsc stat = ", stat2
        stop run
    end-if
    call "ACTION"
        using
           by value range-start
    stop run.
identification division.
program-id.action.
*
data division.
working-storage section.
01  i           pic 9(9) comp.
01  msglen      pic 9(9) comp.
linkage section.
01  shrmem.
    03  msg     pic x(100) occurs 819 times.
*
procedure division using shrmem.
action-paragraph.
    move 1 to i
    perform until function ord(msg(i)(1:1)) = 1
        compute i = i + 1
    end-perform
    string "Hi from Cobol (alt)!" delimited by size function char(1) delimited by size into msg(i)
    move 1 to i
    perform until function ord(msg(i)(1:1)) = 1
        perform varying msglen from 1 by 1 until function ord(msg(i)(msglen:1)) = 1
            continue
        end-perform
        display "|" msg(i)(1:msglen) "|"
        compute i = i + 1
    end-perform.
end program action.

Build:

$ cob p4z
$ cob p4z_sup
$ link p4z + p4z_sup

Run:

$ run p4z

Memory Mapped File:

Concept:

The concept is the same as for shared memory except that the memory is backed by a file.

Memory mappped file model

The functionality is based on the same VMS system services SYS$CRMPSC and SYS$MPGBLSC as shared memory. In fact the only difference is in a few arguments to sys$crmpsc.

Physical memory is handled as pages (units of 8192 bytes on Alpha/Itanium/x86-64). Sections has to be page aligned.

Sections can be permament or temporary, but content is always preserved via the backing file. Sections can be system wide or group wide.

Access Direct memory
Supported languages Any language able to call system services, control alignment of memory and pass address of memory to system service
Persistence Tempororary section: only exist as long it is mapped by at least one process
Permanent section: exist until system reboot
Data persisted across "sessions"
Scope Group wide section: visible to processes in same group
System wide section: visible to all processes on system
Concurrency No builtin controls - must be handled by applications. VMS DLM is an obvious choice.
Security Access to global section and file can be restricted

This feature (memory mapped file) can also be used by a single process simply for IO. But here we will focus on its usage for communication between different processes.

Demo:

We will map a section of 10 pages (81920 bytes) to a disk file with fixed 512 bytes records.

Each message use a 100 byte slot in memory file.

Note that there is no correlation between file record structure and memory record structure. So it is possible to totally mess up a file via this method.

Message is terminated with nul byte (C string).

The section is created and kept alive by a C program. The section is temporary and group wide.

Client programs add a new message in an unused slot and dump all messages present.

System Service:

Server (create and keep alive):

#include <stdio.h>
#include <string.h>

#include <descrip.h>
#include <fabdef.h>
#include <secdef.h>
#include <starlet.h>

#define BLOCKSIZE 8192
#define BLOCKS 10
#define SHRMEMSIZ BLOCKS * BLOCKSIZE
#define MAXMSGSIZ 100
#define MAXMSGS SHRMEMSIZ / MAXMSGSIZ
#define DISKBLOCKSIZE 512

#define FNM "M.DAT"
#define GLBSECNAM "M"

static union
{
   char dummy[SHRMEMSIZ];
   char msg[MAXMSGS][MAXMSGSIZ];
} __align(13) shrmem;

int main(int argc, char *argv[])
{
    struct FAB myfab;
    $DESCRIPTOR(name, GLBSECNAM);
    void *range[2];
    unsigned short chan;
    long int stat;
    char dummy[2];
    /* open file */
    myfab = cc$rms_fab;
    myfab.fab$l_fna = FNM;
    myfab.fab$b_fns = strlen(FNM);
    myfab.fab$l_fop = FAB$M_UFO;
    myfab.fab$b_fac = FAB$M_GET | FAB$M_PUT | FAB$M_UPD;
    stat = sys$open(&myfab, 0, 0);
    if((stat & 1) == 0) printf("sys$open stat = %d\n", stat);
    /* create global section */
    range[0] = (char *)&shrmem;
    range[1] = (char *)&shrmem + sizeof(shrmem) - 1;
    chan = myfab.fab$l_stv;
    stat = sys$crmpsc(range, 0, 0, SEC$M_GBL | SEC$M_WRT,
                      &name, 0, 0, chan, sizeof(shrmem) / DISKBLOCKSIZE, 0, 0, 0);
    if((stat & 1) == 0) printf("sys$crmpsc stat = %d\n", stat);
    /* wait for user input */
    printf("Press enter to exit");
    fgets(dummy, sizeof(dummy), stdin);
    sys$close(&myfab, 0, 0);
    return 0;
}

Build:

$ cc server
$ link server

Run:

$ run server

Client:

#include <stdio.h>
#include <string.h>

#include <descrip.h>
#include <secdef.h>
#include <starlet.h>

#define BLOCKSIZE 8192
#define BLOCKS 10
#define SHRMEMSIZ BLOCKS * BLOCKSIZE
#define MAXMSGSIZ 100
#define MAXMSGS SHRMEMSIZ / MAXMSGSIZ

#define GLBSECNAM "M"

static union
{
   char dummy[SHRMEMSIZ];
   char msg[MAXMSGS][MAXMSGSIZ];
} __align(13) shrmem;

int main(int argc, char *argv[])
{
    $DESCRIPTOR(name, GLBSECNAM);
    void *range[2];
    long int stat;
    int i;
    /* map global section */
    range[0] = (char *)&shrmem;
    range[1] = (char *)&shrmem + sizeof(shrmem) - 1;
    stat = sys$mgblsc(range, 0, 0, SEC$M_WRT,&name, 0, 0);
    if((stat & 1) == 0) printf("sys$mgblsc stat = %d\n", stat);
    /* write to global section */
    i = 0;
    while(shrmem.msg[i][0] != 0) i++;
    strcpy(shrmem.msg[i], "Hi from C!");
    /* dump global section */
    for(i = 0; i < MAXMSGS; i++)
    {
        if(strlen(shrmem.msg[i]) > 0)
        {
            printf("|%s|\n", shrmem.msg[i]);
        }
    }
    return 0;
}

Build:

$ cc p1
$ link p1

Run:

$ run p1
#include <stdio.h>
#include <string.h>

#include <descrip.h>
#include <secdef.h>
#include <starlet.h>

#define BLOCKSIZE 8192
#define BLOCKS 10
#define SHRMEMSIZ BLOCKS * BLOCKSIZE
#define MAXMSGSIZ 100
#define MAXMSGS SHRMEMSIZ / MAXMSGSIZ

#define GLBSECNAM "M"

typedef union
{
   char dummy[SHRMEMSIZ];
   char msg[MAXMSGS][MAXMSGSIZ];
} shrmem_t;

int main(int argc, char *argv[])
{
    shrmem_t *shrmem;
    $DESCRIPTOR(name, GLBSECNAM);
    void *range[2];
    long int stat;
    int i;
    /* map global section */
    range[0] = 0;
    range[1] = 0;
    stat = sys$mgblsc(range, range, 0, SEC$M_EXPREG | SEC$M_WRT,&name, 0, 0);
    if((stat & 1) == 0) printf("sys$mgblsc stat = %d\n", stat);
    shrmem = (shrmem_t *)range[0];
    /* write to global section */
    i = 0;
    while(shrmem->msg[i][0] != 0) i++;
    strcpy(shrmem->msg[i], "Hi from C (alt)!");
    /* dump global section */
    for(i = 0; i < MAXMSGS; i++)
    {
        if(strlen(shrmem->msg[i]) > 0)
        {
            printf("|%s|\n", shrmem->msg[i]);
        }
    }
    return 0;
}

Build:

$ cc p1z
$ link p1z

Run:

$ run p1z
      program p2
      implicit none
      include '($secdef)'
      integer*4 blocksize,blocks,shrmemsiz,maxmsgsiz,maxmsgs
      character*1 name
      parameter (blocksize=8192,
     +           blocks=10,
     +           shrmemsiz=blocks*blocksize,
     +           maxmsgsiz=100,
     +           maxmsgs=shrmemsiz/maxmsgsiz,
     +           name='M')
      byte shrmem(shrmemsiz)
      common /shrmempsect/shrmem
      character*100 msg(maxmsgs)
      equivalence (shrmem,msg)
      integer*4 range(2),stat,i,msglen
      integer*4 sys$mgblsc
      external sys$mgblsc
c  map global section
      range(1)=%loc(shrmem)
      range(2)=%loc(shrmem)+shrmemsiz-1
      stat=sys$mgblsc(%ref(range),,,%val(SEC$M_WRT),%descr(name),,)
      if((stat.and.1).eq.0) write(*,*) 'sys$mgblsc stat=',stat
c  write to global section
      i=0
100   i=i+1
      if(msg(i)(1:1).ne.char(0)) goto 100
      msg(i)='Hi from Fortran!'//char(0)
c  dump global section
      do 200 i=1,maxmsgs
        if(msg(i)(1:1).ne.char(0)) then
          msglen=index(msg(i),char(0))
          write(*,*) '|'//msg(i)(1:msglen)//'|'
        endif
200   continue
      end

Build:

$ for p2
$ link p2 + sys$input/opt
PSECT_ATTRIBUTE=shrmempsect,13
$

Run:

$ run p2
      program p2z
      implicit none
      include '($secdef)'
      character*1 name
      parameter (name='M')
      integer*4 range(2),stat
      integer*4 sys$mgblsc
      external sys$mgblsc
c  map global section
      range(1)=0
      range(2)=0
      stat=sys$mgblsc(%ref(range),%ref(range),,
     +                %val(SEC$M_EXPREG+SEC$M_WRT),%descr(name),,)
      if((stat.and.1).eq.0) write(*,*) 'sys$mgblsc stat=',stat
      call action(%val(range(1)))
      end
c
      subroutine action(shrmem)
      implicit none
      integer*4 blocksize,blocks,shrmemsiz,maxmsgsiz,maxmsgs
      parameter (blocksize=8192,
     +           blocks=10,
     +           shrmemsiz=blocks*blocksize,
     +           maxmsgsiz=100,
     +           maxmsgs=shrmemsiz/maxmsgsiz)
      structure /shrmemtyp/
        character*100 msg(maxmsgs)
      end structure
      record /shrmemtyp/shrmem
      integer*4 i,msglen
c  write to global section
      i=0
100   i=i+1
      if(shrmem.msg(i)(1:1).ne.char(0)) goto 100
      shrmem.msg(i)='Hi from Fortran (alt)!'//char(0)
c  dump global section
      do 200 i=1,maxmsgs
        if(shrmem.msg(i)(1:1).ne.char(0)) then
          msglen=index(shrmem.msg(i),char(0))
          write(*,*) '|'//shrmem.msg(i)(1:msglen)//'|'
        endif
200   continue
      end

Build:

$ for p2z
$ link p2z

Run:

$ run p2z
[inherit('sys$library:starlet')]

program p3(input,output);

const
   blocksize = 8192;
   blocks = 10;
   shrmemsiz = blocks * blocksize;
   maxmsgsiz = 100;
   maxmsgs = shrmemsiz div maxmsgsiz;
   name = 'M';

type
   msgtype = packed array [1..maxmsgsiz] of char;
   shrmemtype = record
                   case boolean of
                      true : ( dummy : packed array [1..shrmemsiz] of char; );
                      false : ( msg : packed array [1..maxmsgs] of msgtype; );
                end;

var
   shrmem : [static,aligned(13)] shrmemtype;
   range : array [1..2] of integer;
   stat, i, msglen : integer;

begin
   (* map global section *)
   range[1] := iaddress(shrmem);
   range[2] := iaddress(shrmem) + shrmemsiz - 1;
   stat := $mgblsc(inadr := range, flags := SEC$M_WRT, gsdnam := name);
   if not odd(stat) then writeln('sys$mgblsc stat=', stat:1);
   (* write to global section *)   
   i := 1;
   while shrmem.msg[i][1] <> chr(0) do i := i + 1;
   shrmem.msg[i] := 'Hi from Pascal!' + chr(0);
   (* dump global section *)
   for i := 1 to maxmsgs do begin
      if shrmem.msg[i][1] <> chr(0) then begin
         msglen := index(shrmem.msg[i], chr(0));
         writeln('|' + substr(shrmem.msg[i], 1, msglen) + '|');
      end;
   end;
end.

Build:

$ pas p3
$ link p3

Run:

$ run p3
[inherit('sys$library:starlet')]

program p3z(input,output);

const
   blocksize = 8192;
   blocks = 10;
   shrmemsiz = blocks * blocksize;
   maxmsgsiz = 100;
   maxmsgs = shrmemsiz div maxmsgsiz;
   name = 'M';

type
   msgtype = packed array [1..maxmsgsiz] of char;
   shrmemtype = record
                   case boolean of
                      true : ( dummy : packed array [1..shrmemsiz] of char; );
                      false : ( msg : packed array [1..maxmsgs] of msgtype; );
                end;

var
   shrmem : ^shrmemtype;
   range : array [1..2] of pointer;
   stat, i, msglen : integer;

begin
   (* map global section *)
   range[1] := nil;
   range[2] := nil;
   stat := $mgblsc(inadr := range, retadr := range, flags := SEC$M_EXPREG + SEC$M_WRT, gsdnam := name);
   if not odd(stat) then writeln('sys$mgblsc stat=', stat:1);
   shrmem := range[1];
   (* write to global section *)   
   i := 1;
   while shrmem^.msg[i][1] <> chr(0) do i := i + 1;
   shrmem^.msg[i] := 'Hi from Pascal (alt)!' + chr(0);
   (* dump global section *)
   for i := 1 to maxmsgs do begin
      if shrmem^.msg[i][1] <> chr(0) then begin
         msglen := index(shrmem^.msg[i], chr(0));
         writeln('|' + substr(shrmem^.msg[i], 1, msglen) + '|');
      end;
   end;
end.

Build:

$ pas p3z
$ link p3z

Run:

$ run p3z
identification division.
program-id.p4.
*
data division.
working-storage section.
01  SEC$M_WRT   pic 9(9) comp value is external SEC$M_WRT.
01  GBLSECNAM   pic x(1) value is "M".
01  range.
    03  range-start     pointer.
    03  range-end       pointer.
01  shrmem external.
    03  msg     pic x(100) occurs 819 times.
    03  padb    pic x(19).
    03  lastb   pic x(1).
01  stat        pic 9(9) comp.
01  stat2       pic 9(9) display.
01  i           pic 9(9) comp.
01  msglen      pic 9(9) comp.
*
procedure division.
main-paragraph.
    set range-start to reference of shrmem
    set range-end to reference of lastb
    call "sys$mgblsc"
        using
            by reference range,
            omitted,
            omitted,
            by value SEC$M_WRT,
            by descriptor GBLSECNAM,
            omitted,
            omitted
        giving stat
    end-call
    if stat is failure then
        move stat to stat2
        display "sys$mgblsc stat = ", stat2
        stop run
    end-if
    move 1 to i
    perform until function ord(msg(i)(1:1)) = 1
        compute i = i + 1
    end-perform
    string "Hi from Cobol!" delimited by size function char(1) delimited by size into msg(i)
    move 1 to i
    perform until function ord(msg(i)(1:1)) = 1
        perform varying msglen from 1 by 1 until function ord(msg(i)(msglen:1)) = 1
            continue
        end-perform
        display "|" msg(i)(1:msglen) "|"
        compute i = i + 1
    end-perform
    stop run.

Build:

$ cob p4
$ link p4 + sys$input/opt
PSECT_ATTRIBUTE=shrmem,13
$

Run:

$ run p4
identification division.
program-id.p4z.
*
data division.
working-storage section.
01  SEC$M_EXPREG pic 9(9) comp value is external SEC$M_EXPREG.
01  SEC$M_WRT   pic 9(9) comp value is external SEC$M_WRT.
01  GBLSECNAM   pic x(1) value is "M".
01  flag        pic 9(9) comp.
01  range.
    03  range-start     pic 9(9) comp.
    03  range-end       pic 9(9) comp.
01  stat        pic 9(9) comp.
01  stat2       pic 9(9) display.
*
procedure division.
main-paragraph.
    move 0 to range-start
    move 0 to range-end
    compute flag = SEC$M_EXPREG + SEC$M_WRT
    call "sys$mgblsc"
        using
            by reference range,
            by reference range,
            omitted,
            by value flag,
            by descriptor GBLSECNAM,
            omitted,
            omitted
        giving stat
    end-call
    if stat is failure then
        move stat to stat2
        display "sys$mgblsc stat = ", stat2
        stop run
    end-if
    call "ACTION"
        using
           by value range-start
    stop run.
identification division.
program-id.action.
*
data division.
working-storage section.
01  i           pic 9(9) comp.
01  msglen      pic 9(9) comp.
linkage section.
01  shrmem.
    03  msg     pic x(100) occurs 819 times.
*
procedure division using shrmem.
action-paragraph.
    move 1 to i
    perform until function ord(msg(i)(1:1)) = 1
        compute i = i + 1
    end-perform
    string "Hi from Cobol (alt)!" delimited by size function char(1) delimited by size into msg(i)
    move 1 to i
    perform until function ord(msg(i)(1:1)) = 1
        perform varying msglen from 1 by 1 until function ord(msg(i)(msglen:1)) = 1
            continue
        end-perform
        display "|" msg(i)(1:msglen) "|"
        compute i = i + 1
    end-perform.
end program action.

Build:

$ cob p4z
$ cob p4z_sup
$ link p4z + p4z_sup

Run:

$ run p4z

Writeable Shareable Image:

Concept:

The concept to have processes/programs use a shareable image that is installed such that changes to data inside it are written back to the shareable image.

Writeable shareable image model

The functionality is based on the VMS linker and the VMS install utility.

The installation requires full system priviliges, which may limit the usefulness of this method.

Access Direct memory
Supported languages Any language able to create data structured in a named psect that the linker can manipulate
Persistence Data persisted
Scope Any process on system with access to shareable image
Concurrency No builtin controls - must be handled by applications. VMS DLM is an obvious choice.
Security Access to file can be restricted

Demo:

We create a shareable image with an array of message slots in its own psect.

Each message is a 100 byte.

Message is terminated with nul byte (C string).

The shareable image is done as a Fortran block data - an old but still viable construct.

Client programs add a new message in an unused slot and dump all messages present.

Shareable image:

      block data msgs
      implicit none
      integer*4 blocksize,blocks,memsiz,maxmsgsiz,maxmsgs
      parameter (blocksize=8192,
     +           blocks=10,
     +           memsiz=blocks*blocksize,
     +           maxmsgsiz=100,
     +           maxmsgs=memsiz/maxmsgsiz)
      byte mem(memsiz)
      common /msgpsect/mem
      character*100 msg(maxmsgs)
      equivalence (mem,msg)
      data mem/memsiz*0/
      end

Build:

$ for msgs
$ link msgs/share + sys$input/opt
SYMBOL_VECTOR=(msgpsect=PSECT)
PSECT_ATTR=msgpsect,SHR
$
$ set proc/priv=(cmkrnl,sysnam)
$ install
remove disk2:[arne.ipc.wrtshrimg]msgs.exe
add disk2:[arne.ipc.wrtshrimg]msgs.exe /share/write
exit
$ define/sys/exe/nolog msgsshr disk2:[arne.ipc.wrtshrimg]msgs.exe

Client:

Mailboxes

Concept

The concept of a mailbox is an in memory only device that can be accesses through IO.

Very similar to pipes in other OS.

Mailbox model
Access Message based
Supported languages Any language that can do IO (and does not make excessive checks on filename)
Persistence None
Scope Any process on system
Concurrency Different mailboxes are automatically separated, but concurrent access to same mailbox requires additional synchonization to be safe
Security All internal on system and in memory

Advanced access is possible via SYS$QIO(W) but normal language standard IO can be used for simple access.

Demo

We create two mailboxes:

Clients write one line to server.

Server read line and write back all lines received and a line with just "*" to mark the end.

Client read lines and print them.

Mailbox model

Mailboxes by themselves does not require priviliges, but in the example we will use a group logical to handle point to the actual mailbox names,w hich requires GRPNAM priviliges.

Standard IO

Server:

      program server
      implicit none
      integer*4 maxmsgs,fc2s,fs2c
      character*6 c2smbx,s2cmbx
      parameter (maxmsgs=100,
     +           fc2s=11,
     +           fs2c=12,
     +           c2smbx='C2SMBX',
     +           s2cmbx='S2CMBX')
      integer*2 c2s,s2c
      integer*4 stat,i,inmsglen,nmsg,outmsglen(maxmsgs)
      character*100 inmsg,outmsg(maxmsgs)
      integer*4 sys$crembx
      external sys$crembx
      nmsg=0
c  create mailboxes
100   stat=
     +  sys$crembx(,%ref(c2s),%val(1000),%val(10000),,,%descr(c2smbx),,)
      if((stat.and.1).eq.0) write(*,*) 'sys$crembx stat=',stat
      stat=
     +  sys$crembx(,%ref(s2c),%val(1000),%val(10000),,,%descr(s2cmbx),,)
      if((stat.and.1).eq.0) write(*,*) 'sys$crembx stat=',stat
c  open mailboxes
      open(fc2s,file=c2smbx//':',status='old')
      open(fs2c,file=s2cmbx//':',status='new')
c  read
200   read(unit=fc2s,fmt='(q,a)',end=400) inmsglen,inmsg
      nmsg=nmsg+1
      outmsg(nmsg)(1:inmsglen)=inmsg(1:inmsglen)
      outmsglen(nmsg)=inmsglen
      do 300 i=1,nmsg
        write(unit=fs2c,fmt='(a)') outmsg(i)(1:outmsglen(i))
300   continue
      write(unit=fs2c,fmt='(a)') '*'
      goto 200
c  close mailboxes
400   close(fc2s)
      close(fs2c)
      call sys$dassgn(%val(c2s))
      call sys$dassgn(%val(s2c))
      goto 100
c
      end

Build:

$ for server
$ link server

Run:

$ set proc/priv=grpnam
$ define/table=lnm$process_directory/nolog lnm$temporary_mailbox "LNM$GROUP"
$ run server

Client:

#include <stdio.h>
#include <string.h>

#include <descrip.h>

#define C2SMBX "C2SMBX"
#define S2CMBX "S2CMBX"

int main(int argc, char *argv[])
{
    FILE *fc2s, *fs2c;
    $DESCRIPTOR(dc2smbx, C2SMBX);   
    $DESCRIPTOR(ds2cmbx, S2CMBX);   
    char *outmsg, inmsg[1000];
    /* open mailboxes */
    fc2s = fopen(C2SMBX ":", "w"); 
    if(fc2s == NULL) printf("fopen %s failed\n", C2SMBX);
    fs2c = fopen(S2CMBX ":", "r"); 
    if(fs2c == NULL) printf("fopen %s failed\n", S2CMBX);
    /* write  */
    outmsg = "Hi from C!\r\n";
    fputs(outmsg, fc2s);
    /* read */
    while(fgets(inmsg, sizeof(inmsg), fs2c))
    {
        if(inmsg[0] == '*') break;
        inmsg[strlen(inmsg) - 1] = 0; /* strip newline */
        printf("%s\n", inmsg);
    }
    /* close */
    fclose(fc2s);
    fclose(fs2c);
    return 0;
}

Build:

$ cc p1
$ link p1

Run:

$ run p1
      program p2
      implicit none
      integer*4 fc2s,fs2c
      character*6 c2smbx,s2cmbx
      parameter (fc2s=11,
     +           fs2c=12,
     +           c2smbx='C2SMBX',
     +           s2cmbx='S2CMBX')
      integer*4 msglen
      character*100 outmsg
      character*1000 inmsg
c  silly hack to avoid breaking lines over 80 characters
      open(unit=6,file='sys$output',status='new',
     +  recl=132,carriagecontrol='list')
c  open mailboxes
      open(unit=fc2s,file=c2smbx//':',status='new')
      open(unit=fs2c,file=s2cmbx//':',status='old')
c  write
      outmsg='Hi from Fortran!'
      msglen=len('Hi from Fortran!')
      write(unit=fc2s,fmt='(a)') outmsg(1:msglen)
c  read
100   read(unit=fs2c,fmt='(q,a)',end=200) msglen,inmsg
      if(inmsg(1:msglen).eq.'*') goto 200
      write(unit=6,fmt='(a)') '|'//inmsg(1:msglen)//'|'
      goto 100
c  close mailboxes
200   close(unit=fc2s)
      close(unit=fs2c)
c
      end

Build:

$ for p2
$ link p2

Run:

$ run p2
program p3(input,output);

const
   c2smbx = 'C2SMBX';
   s2cmbx = 'S2CMBX';

var
   fc2s, fs2c : text;
   outmsg, inmsg : varying [1024] of char;
   done : boolean;

begin
   (* open mailboxes *)
   open(fc2s, c2smbx + ':', new);
   rewrite(fc2s);
   open(fs2c, s2cmbx + ':', old);
   reset(fs2c);
   (* write *)
   outmsg := 'Hi from Pascal!';
   writeln(fc2s, outmsg);
   (* read *)
   done := false;
   while (not done) and (not eof(fs2c)) do begin
      readln(fs2c, inmsg);
      if inmsg = '*' then begin
         done := true;
      end else begin
         writeln('|' + inmsg + '|');
      end;
   end;
   (* close mailboxes *)
   close(fc2s);
   close(fs2c);
end.

Build:

$ pas p3
$ link p3

Run:

$ run p3
identification division.
program-id.p4.
*
environment division.
input-output section.
file-control.
    select c2s-file assign to "C2SMBX:" organization is line sequential.
    select s2c-file assign to "S2CMBX:" organization is line sequential.
*
data division.
file section.
fd c2s-file.
01 c2s-record.
    03 outmsg pic x(100).
fd s2c-file record is varying in size depending on msglen.
01 s2c-record.
    03 inmsg pic x(1000).
working-storage section.
01  msglen pic 9(4) comp.
01  eof-flag pic x.
*
procedure division.
main-paragraph.
* open mailboxes
    open output c2s-file
    open input s2c-file
* write
    move "Hi from Cobol!" to outmsg
    write c2s-record
* read
    move 'N' to eof-flag
    perform until eof-flag = 'Y'
        read s2c-file
            at end move 'Y' to eof-flag
            not at end perform message-paragraph
        end-read
    end-perform
* close mailboxes
    close s2c-file.
    close c2s-file.
    stop run.
message-paragraph.
    if inmsg(1:msglen) = "*" then
       move 'Y' to eof-flag
    else
       display "|" inmsg(1:msglen) "|"
    end-if.

Build:

$ cob p4
$ link p4

Run:

$ run p4
program p5

declare string msg

! open mailboxes
open "C2SMBX:" for output as file #1
open "S2CMBX:" for input as file #2
! write
print #1, "Hi from Basic!"
! read
while 1 = 1
    input #2, msg
    if msg = "*" then
        goto done
    else
        print "|" + msg + "|"
    end if
next
done:
! close mailboxes
close #2
close #1

end program

Build:

$ bas p5
$ link p5

Run:

$ run p5
import java.io.BufferedReader;
import java.io.FileReader;
import java.io.FileWriter;
import java.io.IOException;
import java.io.PrintWriter;

public class P6 {
    private static final String C2SMBX = "C2SMBX";
    private static final String S2CMBX = "S2CMBX";
    public static void main(String[] args) throws IOException {
        // open mailboxes
        PrintWriter pw = new PrintWriter(new FileWriter(C2SMBX + ":"));
        BufferedReader br = new BufferedReader(new FileReader(S2CMBX + ":"));
        // write
        pw.println("Hi from Java!");
        pw.flush();
        // read
        String msg;
        while((msg = br.readLine()) != null) {
            if(msg.equals("*")) break;
            System.out.println(msg);
        }
        // close mailboxes
        br.close();
        pw.close();
    }
}

Build:

$ javac P6.java

Run:

$ java "P6"
# open mailboxes
fc2s = open('C2SMBX:', 'w')
fs2c = open('S2CMBX:', 'r')
# write
fc2s.write('Hi from Python!\n')
fc2s.flush()
# read
while fs2c:
   msg = fs2c.readline().rstrip()
   if msg == '*':
       break
   print('|' + msg + '|')
# close mailboxes
fc2s.close()
fs2c.close()

Run:

$ python p7.py

Jython cannot read from a mailbox - open fails because it cannot find the file.

$! open mailboxes
$ open/write fc2s C2SMBX:
$ open/read fs2c S2CMBX:
$! write
$  write fc2s "Hi from DCL!"
$! read
$ loop:
$    read/end=endloop fs2c msg
$    if msg .eqs. "*" then goto endloop
$    write sys$output "|" + msg + "|"
$    goto loop
$ endloop:
$! close mailboxes
$ close fc2s
$ close fs2c
$ exit

Run:

$ @p9

DECnet Task-to-Task

Concept

The concept is that a client applications starts a remote server application and they communicate over DECnet using normal IO.

DECnet model
Access IO stream (message support must be provided by applications on top of the stream)
Supported languages Any language that can do IO (and does not make excessive checks on filename)
Persistence None
Scope Any process on any networked system
Concurrency Strictly 1 client to 1 server
Security DECnet traffic not encrypted
Either password must be supplied or proxy access must be established

Client use IO to the starting pseudo-file and server use IO to the logical name SYS$NET.

The pseudo-file name to a server task is one of:

nodename"username password"::"task=taskname
if no proxy established
nodename"username"::task=taskname
if proxy established
nodename::"task=taskname
if default proxy established

Demo

Client activate server and write one line.

Server read line and write same line back.

Client read line and print it.

RMS

Server:

$ open/write f sys$net
$ write f "Hi from DCL!"
$ close f
$ exit
#include <stdio.h>

int main(int argc, char *argv[])
{
   FILE *fp;
   char buf[1000];
   fp = fopen("sys$net", "w");
   fputs("Hi from C!", fp);
   fclose(fp);   
   return 0;
}

Build:

$ cc s1
$ link s1
      program s2
      open(unit=1,file='sys$net',status='new')
      write(unit=1,fmt='(a)') 'Hi from Fortran!'
      close(unit=1)
      end

Build:

$ for s2
$ link s2
program s3(input,output);

var
   f : text;

begin
   open(f, 'sys$net', new);
   rewrite(f);
   writeln(f, 'Hi from Pascal!');
   close(f);
end.

Build:

$ pas s3
$ link s3
identification division.
program-id.s4.
*
environment division.
input-output section.
file-control.
    select out-file assign to "sys$net" organization is line sequential.
*
data division.
file section.
fd out-file.
01 out-record.
    03 msg pic x(100).
*
procedure division.
main-paragraph.
    open output out-file
    move "Hi from Cobol!" to msg
    write out-record
    close out-file
    stop run.

Build:

$ cob s4
$ link s4
program s5

open "sys$net" for output as file #1
print #1, "Hi from Basic!"
close #1

end program

Build:

$ bas s5
$ link s5

Java can not handle SYS$NET, but a workaround is possible by defining SYS$OUTPUT to point to SYS$NET.

$ set def [arne.ipc.dnet]
$ define sys$output sys$net
$ java "S6"
$ exit
public class S6 {
    public static void main(String[] args) {
        System.out.println("Hi from Java!");
    }
}

Build:

$ javac P6.java
$ set def [arne.ipc.dnet]
$ python s7.py
$ exit
with open('sys$net', 'w') as f:
    f.write('Hi from Python!')

Jython can not handle SYS$NET, but a workaround is possible by defining SYS$OUTPUT to point to SYS$NET.

$ set def [arne.ipc.dnet]
$ define sys$output sys$net
$ jython s8.py
$ exit
print('Hi from Jython!')

Setup of tasks via group logicals:

$ set proc/priv=grpprv
$ define/group/nolog s0task disk2:[arne.ipc.dnet]s0.com
$ define/group/nolog s1task disk2:[arne.ipc.dnet]s1.exe
$ define/group/nolog s2task disk2:[arne.ipc.dnet]s2.exe
$ define/group/nolog s3task disk2:[arne.ipc.dnet]s3.exe
$ define/group/nolog s4task disk2:[arne.ipc.dnet]s4.exe
$ define/group/nolog s5task disk2:[arne.ipc.dnet]s5.exe
$ define/group/nolog s6task disk2:[arne.ipc.dnet]s6.com
$ define/group/nolog s7task disk2:[arne.ipc.dnet]s7.com
$ define/group/nolog s8task disk2:[arne.ipc.dnet]s8.com
$ exit

Client:

$ call test "0::""task=s0task"""
$ call test "0::""task=s1task"""
$ call test "0::""task=s2task"""
$ call test "0::""task=s3task"""
$ call test "0::""task=s4task"""
$ call test "0::""task=s5task"""
$ call test "0::""task=s6task"""
$ call test "0::""task=s7task"""
$ call test "0::""task=s8task"""
$ exit
$!
$ test: subroutine
$! open task
$ open/read f 'p1'
$! read message from task
$ read f msg
$! print
$ write sys$output "|" + msg + "|"
$! close task
$ close f
$ return
$ endsubroutine

Run:

$ @p0
#include <stdio.h>
#include <string.h>

void test(const char *task)
{
   FILE *fp;
   char msg[1000];
   /* open task */
   fp = fopen(task, "r");
   /* read message from task */
   fgets(msg, sizeof(msg), fp);
   msg[strlen(msg) - 1] = 0; /* strip newline */
   /* print ,essage */
   printf("|%s|\n", msg);
   /* close task */
   fclose(fp);   
}

int main(int argc, char *argv[])
{
   test("0::\"task=s0task\"");
   test("0::\"task=s1task\"");
   test("0::\"task=s2task\"");
   test("0::\"task=s3task\"");
   test("0::\"task=s4task\"");
   test("0::\"task=s5task\"");
   test("0::\"task=s6task\"");
   test("0::\"task=s7task\"");
   test("0::\"task=s8task\"");
   return 0;
}

Build:

$ cc p1
$ link p1

Run:

$ run p1
      program p2
      call test('0::"task=s0task"')
      call test('0::"task=s1task"')
      call test('0::"task=s2task"')
      call test('0::"task=s3task"')
      call test('0::"task=s4task"')
      call test('0::"task=s5task"')
      call test('0::"task=s6task"')
      call test('0::"task=s7task"')
      call test('0::"task=s8task"')
      end
c
      subroutine test(task)
      character*(*) task
      integer*4 msglen
      character*1000 msg
c  silly hack to avoid breaking lines over 80 characters
      open(unit=6,file='sys$output',status='new',recl=132)
c  open task
      open(unit=1,file=task,status='old')
c  read message from task
      read(unit=1,fmt='(q,a)') msglen,msg
c  print
      write(unit=6,fmt='(A)') '|'//msg(1:msglen)//'|'
c  close task
      close(unit=1)
      return
      end

Build:

$ for p2
$ lin p2

Run:

$ run p2
program p3(input,output);

type
   pstr = varying [255] of char;

procedure test(task : pstr);

var
   f : text;
   msg : varying [1000] of char;

begin
   (* open task *)
   open(f, task, old);
   reset(f);
   (* read message from task *)
   readln(f, msg);
   (* print *)
   writeln('|' + msg + '|');
   (* close task *)
   close(f);
end;

begin
   test('0::"task=s0task"');
   test('0::"task=s1task"');
   test('0::"task=s2task"');
   test('0::"task=s3task"');
   test('0::"task=s4task"');
   test('0::"task=s5task"');
   test('0::"task=s6task"');
   test('0::"task=s7task"');
   test('0::"task=s8task"');
end.

Build:

$ pas p3
$ link p3

Run:

$ run p3
identification division.
program-id.p4.
*
environment division.
input-output section.
file-control.
    select task-file assign to "" organization is line sequential.
*
data division.
file section.
fd task-file record is varying in size depending on msglen value of id fnm.
01 task-record.
    03 msg pic x(1000).
working-storage section.
01  fnm pic x(255).
01  msglen pic 9(4) comp.
*
procedure division.
main-paragraph.
    move "0::""task=s0task""" to fnm
    perform test-paragraph
    move "0::""task=s1task""" to fnm
    perform test-paragraph
    move "0::""task=s2task""" to fnm
    perform test-paragraph
    move "0::""task=s3task""" to fnm
    perform test-paragraph
    move "0::""task=s4task""" to fnm
    perform test-paragraph
    move "0::""task=s5task""" to fnm
    perform test-paragraph
    move "0::""task=s6task""" to fnm
    perform test-paragraph
    move "0::""task=s7task""" to fnm
    perform test-paragraph
    move "0::""task=s8task""" to fnm
    perform test-paragraph
    stop run.
test-paragraph.
* open task
    open input task-file
* read message from task and print
    read task-file
        at end display "Ooops"
        not at end display "|" msg(1:msglen) "|"
    end-read
* close task
    close task-file.

Build:

$ cob p4
$ link p4

Run:

$ run p4
program p5

call test('0::"task=s0task"')
call test('0::"task=s1task"')
call test('0::"task=s2task"')
call test('0::"task=s3task"')
call test('0::"task=s4task"')
call test('0::"task=s5task"')
call test('0::"task=s6task"')
call test('0::"task=s7task"')
call test('0::"task=s8task"')

end program
!
sub test(string task)

declare string msg

! open task
open task for input as file #1
! read message from task
input #1, msg
! print
print "|" + msg + "|"
! close task
close #1

end sub

Build:

$ bas p5
$ link p5

Run:

$ run p5

Java cannot start task - open fails because it cannot find the file.

def test(task):
    # open task
    with open(task, 'r') as f:
        # read message from task
        msg = f.readline()
        # print
        print(msg.rstrip())

test('0::"task=s0task"')
test('0::"task=s1task"')
test('0::"task=s2task"')
test('0::"task=s3task"')
test('0::"task=s4task"')
test('0::"task=s5task"')
test('0::"task=s6task"')
test('0::"task=s7task"')
test('0::"task=s8task"')

Run:

$ python p7.py

Jython cannot start task - open fails because it cannot find the file.

ICC:

Concept:

ICC (Intra Cluster Communication) is a relative new feature of VMS.

It allows for process communication within a VMS cluster.

ICC use a client/server model.

ICC model
Access Message based
Supported languages Any language able to call system services
Persistence None
Scope Any process within cluster
Concurrency Different associations (named channels) are automatically separated, but concurrent access to same association (named channel) may require additional synchonization to be safe
Security No persistence
Local access is in memory only but remote access goes on the network unencrypted

ICC is highly efficient - the actual physical communication is direct memory access for local access and SCS (cluster) network traffic for remote access. The API is also very much geared towards asyncroneous programming.

But despite all this then it is rarely used. Old applications do not use it, because it was not available when they were created. New applications go for standard solutions: socket, HTTP, message queue etc..

Demo:

We will run an server that accumulates and reply with all received messages.

Clients will connect to the server, send a message and receive a response message.

All access is via the SYS$ICC_* system services.

The examples will be very simple - and not fully utilize the capabilities in ICC.

Note that this setup requires SYSPRV and SYSNAM priviliges, which may also limit the usability.

Server:

#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#include <iccdef.h>
#include <descrip.h>
#include <starlet.h>

static char outmsg[10000] = "";

static void handler(unsigned int evttyp, unsigned int con, unsigned int datlen, char *dat,
                    unsigned int p5, unsigned int p6, char *p7)
{
   long stat;
   struct _ios_icc rec_iosb, tra_iosb;
   char inmsg[1000];
   if(evttyp == ICC$C_EV_CONNECT)
   {
      printf("connect from user %s (pid %08X)\n", p7, p6);
      stat = sys$icc_accept(con, 0, 0, 0, 0);
      if((stat & 1) == 0) printf("sys$icc_accept stat = %d\n", stat);
      stat = sys$icc_receivew(con, &rec_iosb, 0, 0, inmsg, sizeof(inmsg));
      if((stat & 1) == 0) printf("sys$icc_receivew stat = %d\n", stat);
      if((rec_iosb.ios_icc$w_status & 1) == 0) printf("sys$icc_receivew iosb = %d\n", rec_iosb.ios_icc$w_status);
      inmsg[rec_iosb.ios_icc$l_rcv_len] = 0;
      if(strlen(outmsg) > 0) strcat(outmsg, "\r\n");
      strcat(outmsg, inmsg);
      stat = sys$icc_transmitw(con, &tra_iosb, 0, 0, outmsg, strlen(outmsg));
      if((stat & 1) == 0) printf("sys$icc_transmitw stat = %d\n", stat);
      if((tra_iosb.ios_icc$w_status & 1) == 0) printf("sys$icc_receivew iosb = %d\n", tra_iosb.ios_icc$w_status);
    }
   else if(evttyp == ICC$C_EV_DISCONNECT)
   {
      printf("disconnect\n");
   }
}

int main(int argc, char *argv[])
{
   long appid;
   long stat;
   char dummy[2];
   $DESCRIPTOR(APPID, "MYCHANNEL");
   /* open association (listener) */
   stat = sys$icc_open_assoc(&appid, &APPID, 0, 0, handler, handler, 0, 0, 0);
   if((stat & 1) == 0) printf("sys$icc_open_assoc stat = %d\n", stat);
   /* wait for user input */
   printf("Press enter to exit");
   fgets(dummy, sizeof(dummy), stdin);
   /* close association (listener) */
   stat = sys$icc_close_assoc(appid);
   if((stat & 1) == 0) printf("sys$icc_close_assoc stat = %d\n", stat);
   return 0;
}

Build:

$ cc server
$ link server

Run:

$ set process/priv=(sysprv,sysnam)
$ run server

System Service:

Client:

#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#include <iccdef.h>
#include <descrip.h>
#include <starlet.h>

int main(int argc, char *argv[])
{
   long stat;
   long con;
   struct _ios_icc con_iosb, tra_iosb, rec_iosb;
   short int dis_iosb[4];
   char *outmsg, inmsg[10000];
   $DESCRIPTOR(HOST, "ARNE1");
   $DESCRIPTOR(APPID, "MYCHANNEL");
   /* connect */
   stat = sys$icc_connectw(&con_iosb, 0, 0, ICC$C_DFLT_ASSOC_HANDLE, &con, &APPID, &HOST, 0, 0, 0, 0, 0, 0, 0);
   if((stat & 1) == 0) printf("sys$icc_connectw stat = %d\n", stat);
   if((con_iosb.ios_icc$w_status & 1) == 0) printf("sys$icc_receivew iosb = %d\n", con_iosb.ios_icc$w_status);
   /* write */
   outmsg = "Hi from C!";
   stat = sys$icc_transmitw(con, &tra_iosb, 0, 0, outmsg, strlen(outmsg));
   if((stat & 1) == 0) printf("sys$icc_transmitw stat = %d\n", stat);
   if((tra_iosb.ios_icc$w_status & 1) == 0) printf("sys$icc_receivew iosb = %d\n", tra_iosb.ios_icc$w_status);
   /* read */
   stat = sys$icc_receivew(con, &rec_iosb, 0, 0, inmsg, sizeof(inmsg));
   if((stat & 1) == 0) printf("sys$icc_receivew stat = %d\n", stat);
   if((rec_iosb.ios_icc$w_status & 1) == 0) printf("sys$icc_receivew iosb = %d\n", rec_iosb.ios_icc$w_status);
   inmsg[rec_iosb.ios_icc$l_rcv_len] = 0;
   printf("%s\n", inmsg);
   /* disconnect */
   stat = sys$icc_disconnectw(con, &dis_iosb, 0, 0, 0, 0);
   if((stat & 1) == 0) printf("sys$icc_disconnectw stat = %d\n", stat);
   if((dis_iosb[0] & 1) == 0) printf("sys$icc_disconnectw iosb = %d\n", dis_iosb[0]);
   return 0;
}

Build:

$ cc p1
$ link p1

Run:

$ set process/priv=(sysprv,sysnam)
$ run p1
      program p2
      implicit none
      include '($iccdef)'
c  note that trailing spaces seems to give problems
      character*5 host
      character*9 appid
      parameter (host='ARNE1',
     +           appid='MYCHANNEL')
      integer*4 stat,con
      record /ios_icc/con_iosb,tra_iosb,rec_iosb
      integer*2 dis_iosb(4)
      integer*4 outmsglen,inmsglen
      character*100 outmsg
      character*10000 inmsg
      integer*4 sys$icc_connectw,sys$icc_transmitw,
     +          sys$icc_receivew,sys$icc_disconnectw
c  connect
      stat=sys$icc_connectw(%ref(con_iosb),,,
     +  %val(ICC$C_DFLT_ASSOC_HANDLE),
     +  %ref(con),%descr(appid),%descr(host),,,,,,,)
      if((stat.and.1).eq.0) write(*,*) 'sys$icc_connectw stat=',stat
      if((con_iosb.ios_icc$w_status.and.1).eq.0)
     +  write(*,*) 'sys$icc_connectw iosb=',con_iosb.ios_icc$w_status
c  write
      outmsg='Hi from Fortran!'
      outmsglen=len('Hi from Fortran!')
      stat=sys$icc_transmitw(%val(con),%ref(tra_iosb),,,
     +  %ref(outmsg),%val(outmsglen))
      if((stat.and.1).eq.0) write(*,*) 'sys$icc_transmitw stat=',stat
      if((tra_iosb.ios_icc$w_status.and.1).eq.0)
     +  write(*,*) 'sys$icc_transmitw iosb=',tra_iosb.ios_icc$w_status
c  read
      stat=sys$icc_receivew(%val(con),%ref(rec_iosb),,,
     +  %ref(inmsg),%val(10000))
      if((stat.and.1).eq.0) write(*,*) 'sys$icc_receivew stat=',stat
      if((tra_iosb.ios_icc$w_status.and.1).eq.0)
     +  write(*,*) 'sys$icc_receivew iosb=',tra_iosb.ios_icc$w_status
      inmsglen=rec_iosb.ios_icc$l_rcv_len
      write(*,*) inmsg(1:inmsglen)
c  disconnect
      stat=sys$icc_disconnectw(%val(con),%ref(dis_iosb),,,,)
      if((stat.and.1).eq.0) write(*,*) 'sys$icc_disconnectw stat=',stat
      if((dis_iosb(1).and.1).eq.0) write(*,*)
     +   'sys$icc_disconnectw iosb=',dis_iosb(1)
      end

Build:

$ for p2
$ link p2

Run:

$ set process/priv=(sysprv,sysnam)
$ run p2

I could not get the Pascal example working using the $ICC_* definitions in SYS$LIBRARY:STARLET.*, so I had to created a modified version.

[ASYNCHRONOUS,EXTERNAL(SYS$ICC_CONNECTW)] FUNCTION HACK_ICC_CONNECTW (
    VAR IOS_ICC : [VOLATILE] IOS_ICC$TYPE;
    %IMMED [UNBOUND, ASYNCHRONOUS] PROCEDURE ASTADR := %IMMED 0;
    %IMMED ASTPRM : UNSIGNED := %IMMED 0;
    %IMMED ASSOC_HANDLE : UNSIGNED;
    VAR CONN_HANDLE : [VOLATILE] UNSIGNED;
    REMOTE_ASSOC : [CLASS_S] PACKED ARRAY [$l6..$u6:INTEGER] OF CHAR := %IMMED 0;
    REMOTE_NODE : [CLASS_S] PACKED ARRAY [$l7..$u7:INTEGER] OF CHAR := %IMMED 0;
    %IMMED USER_CONTEXT : UNSIGNED := %IMMED 0;
    %IMMED CONN_BUF : UNSIGNED := %IMMED 0;
    %IMMED CONN_BUF_LEN : UNSIGNED := %IMMED 0;
    %IMMED RETURN_BUF : UNSIGNED := %IMMED 0;
    %IMMED RETURN_BUF_LEN : UNSIGNED := %IMMED 0;
    VAR RETLEN_ADDR : [VOLATILE] UNSIGNED := %IMMED 0;
    %IMMED FLAGS : UNSIGNED := %IMMED 0) : INTEGER; EXTERNAL;
 
[ASYNCHRONOUS,EXTERNAL(SYS$ICC_DISCONNECTW)] FUNCTION HACK_ICC_DISCONNECTW (
    %IMMED CONN_HANDLE : UNSIGNED;
    VAR IOSB : [VOLATILE] IOS_ICC$TYPE;
    %IMMED [UNBOUND, ASYNCHRONOUS] PROCEDURE ASTADR := %IMMED 0;
    %IMMED ASTPRM : UNSIGNED := %IMMED 0;
    %IMMED DISC_BUF : UNSIGNED := %IMMED 0;
    %IMMED DISC_BUF_LEN : UNSIGNED := %IMMED 0) : INTEGER; EXTERNAL;
 
[ASYNCHRONOUS,EXTERNAL(SYS$ICC_RECEIVEW)] FUNCTION HACK_ICC_RECEIVEW (
    %IMMED CONN_HANDLE : UNSIGNED;
    VAR IOS_ICC : [VOLATILE] IOS_ICC$TYPE;
    %IMMED [UNBOUND, ASYNCHRONOUS] PROCEDURE ASTADR := %IMMED 0;
    %IMMED ASTPRM : UNSIGNED := %IMMED 0;
    %IMMED RECV_BUF : UNSIGNED;
    %IMMED RECV_BUF_LEN : UNSIGNED) : INTEGER; EXTERNAL;
 
[ASYNCHRONOUS,EXTERNAL(SYS$ICC_TRANSMITW)] FUNCTION HACK_ICC_TRANSMITW (
    %IMMED CONN_HANDLE : UNSIGNED;
    VAR IOS_ICC : [VOLATILE] IOS_ICC$TYPE;
    %IMMED [UNBOUND, ASYNCHRONOUS] PROCEDURE ASTADR := %IMMED 0;
    %IMMED ASTPRM : INTEGER := %IMMED 0;
    %IMMED SEND_BUF : UNSIGNED;
    %IMMED SEND_LEN : UNSIGNED) : INTEGER; EXTERNAL;
 
[inherit('starlet')]
program p3(input,output);

%include 'hack_icc.pas'

const
   host = 'ARNE1';
   appid = 'MYCHANNEL';

var
   stat, con : unsigned;
   con_iosb, tra_iosb, rec_iosb, dis_iosb : ios_icc$type;
   outmsg : varying [100] of char;
   inmsg : varying [10000] of char;

begin
   (* connect *)
   stat := hack_icc_connectw(ios_icc := con_iosb,
                             assoc_handle := ICC$C_DFLT_ASSOC_HANDLE,
                             conn_handle := con,
                             remote_assoc := appid,
                             remote_node := host);
   if not odd(stat) then writeln('sys$icc_connectw stat=', stat);
   if not odd(con_iosb.ios_icc$w_status) then
      writeln('sys$icc_connectw iosb=', con_iosb.ios_icc$w_status);
   (* write *)
   outmsg := 'Hi from Pascal!';
   stat := hack_icc_transmitw(conn_handle := con,
                              ios_icc := tra_iosb,
                              send_buf := iaddress(outmsg.body),
                              send_len := outmsg.length);
   if not odd(stat) then writeln('sys$icc_transmitw stat=', stat);
   if not odd(tra_iosb.ios_icc$w_status) then writeln('sys$icc_transmitw iosb=', tra_iosb.ios_icc$w_status);
   (* read *)
   INMSG := '';
   stat := hack_icc_receivew(conn_handle := con,
                             ios_icc := rec_iosb,
                             recv_buf := iaddress(inmsg.body),
                             recv_buf_len := 10000);
   if not odd(stat) then writeln('sys$icc_receivew stat=', stat);
   if not odd(con_iosb.ios_icc$w_status) then
      writeln('sys$icc_receivew iosb=', rec_iosb.ios_icc$w_status);
   inmsg.length := rec_iosb.ios_icc$l_rcv_len;
   writeln(inmsg);
   (* disconnect *)
   stat := hack_icc_disconnectw(conn_handle := con, iosb := dis_iosb);
   if not odd(stat) then writeln('sys$icc_disconnectw stat=', stat);
   if not odd(dis_iosb.ios_icc$w_status) then writeln('sys$icc_disconnectw iosb=', dis_iosb.ios_icc$w_status);
end.

Build:

$ set process/priv=(sysprv,sysnam)
$ pas p3
$ link p3

Run:

$ run p3

TCP/IP Socket:

Concept:

Sockets are a wellknown concept in programming.

Sockets use a client/server model.

Sockets model
Access IO stream (message support must be provided by applications on top of the stream)
Supported languages Any language with a socket library or a wrapper around a socket library
Persistence None
Scope Any process on any networked system
Concurrency Different connections/sockets are automatically separated, but concurrent access to same connection/socket requires additional synchonization to be safe
Security No persistence
Traffic can be encrypted via SSL

I have covered socket programming in other articles including:

Demo:

We will run an server that accumulates and reply with all received messages.

Clients will connect to the server, send a message and receive a response message.

For Java, C and Python the client will use the standard socket API for those languages.

For the traditional native languages (Fortram, Pascal, Cobol and Basic) the clients will use a custom C wrapper exposing a VMS friendly API and calling the standard C socket API.

Sockets stack

Server (receive and reply):

import java.io.BufferedReader;
import java.io.IOException;
import java.io.InputStreamReader;
import java.io.PrintStream;
import java.net.ServerSocket;
import java.net.Socket;
import java.util.ArrayList;
import java.util.List;

public class Server {
    private static final int PORT = 12345;
    private List<String> msgs = new ArrayList<String>();
    private void run() {
        try {
            // listen
            @SuppressWarnings("resource")
            ServerSocket ss = new ServerSocket(PORT);
            while(true) {
                // accept connection from client
                Socket s = ss.accept();
                BufferedReader br = new BufferedReader(new InputStreamReader(s.getInputStream(), "UTF-8"));
                PrintStream ps = new PrintStream(s.getOutputStream(), false,  "UTF-8");
                // receive and store message
                String inmsg = br.readLine();
                msgs.add(inmsg);
                // send all messages back
                for(String outmsg : msgs) {
                    ps.println(outmsg);
                }
                ps.flush();
                // close connection
                br.close();
                ps.close();
                s.close();
            }
        } catch (IOException e) {
            e.printStackTrace();
        }
    }
    public static void main(String[] args) {
        Server srv = new Server();
        srv.run();
    }
}

This server is single-threaded which will limit its usability for serious usage, but the articles on sockets linked above do have multi-threaded server examples.

Build:

$ javac Server.java

Run:

java "Server"

Java API:

Java comes with a socket API in the java.net apckage.

Client:

import java.io.BufferedReader;
import java.io.IOException;
import java.io.InputStreamReader;
import java.io.PrintStream;
import java.net.Socket;

public class P1 {
    private static final String HOST = "localhost";
    private static final int PORT = 12345;
    public static void main(String[] args) {
        try {
            // open connection
            Socket s = new Socket(HOST, PORT);
            BufferedReader br = new BufferedReader(new InputStreamReader(s.getInputStream(), "UTF-8"));
            PrintStream ps = new PrintStream(s.getOutputStream(), false,  "UTF-8");
            // send message
            ps.println("Hi from Java!");
            ps.flush();
            // receive all messages
            String msg;
            while((msg = br.readLine()) != null) {
                System.out.println("|" + msg + "|");
            }
            // close connection
            br.close();
            ps.close();
            s.close();
        } catch (IOException e) {
            e.printStackTrace();
        }
    }
}

Build:

$ javac P1.java

Run:

$ java "P1"

C API:

Client:

#include <stdioeve p.h>
#include <stdlib.h>
#include <string.h>

#include <sys/socket.h>
#include <netdb.h>
#include <unixio.h>
#include <errno.h>

#define HOST "localhost"
#define PORT "12345"

/* not super efficient to receive 1 char at a time, but it avoids a buffer */
int recv_line(int sd, char *buf, int buflen)
{
    int ix, len;
    ix = 0;
    buf[ix] = '\0';
    while(ix < buflen && strstr(buf, "\n") == NULL)
    {
        len = recv(sd, buf + ix, 1, 0);
        if(len == 0) return 0;
        ix = ix + len;
        buf[ix] = 0;
    }
    ix--;
    while(ix >= 0 && (buf[ix] == '\n' || buf[ix] == '\r'))
    {
        buf[ix] = 0;
        ix--;
    }
    return 1;
}

int main()
{
    int sd, stat;
    char *outmsg, inmsg[100];
    struct addrinfo hints, *res;
    /* lookup host */
    memset(&hints, 0, sizeof(hints));
    hints.ai_family = AF_UNSPEC;
    hints.ai_socktype = SOCK_STREAM;
    hints.ai_protocol = IPPROTO_TCP;
    hints.ai_flags = 0;
    stat = getaddrinfo(HOST, PORT, &hints, &res);
    if(stat != 0)  printf("getaddrinfo stat=%d\n", stat);
    /* create socket */
    sd = socket(res->ai_family, res->ai_socktype, res->ai_protocol);
    if(sd < 0) printf("socket stat=%d (%s)\n", errno, strerror(errno));
    /* connect to host */
    stat = connect(sd, res->ai_addr, res->ai_addrlen);
    if(stat != 0) printf("connect stat=%d (%s)\n", errno, strerror(errno));
    /* send message */
    outmsg = "Hi from C!\r\n";
    stat = send(sd, outmsg, strlen(outmsg), 0);
    if(stat < 0) printf("send stat=%d (%s)\n", errno, strerror(errno));
    /* receive all messages */
    while(recv_line(sd, inmsg, sizeof(inmsg)))
    {
        printf("|%s|\n", inmsg);
    }
    /* close socket */
    close(sd);
    return 0;
}

Build:

$ cc p2
$ link p2

Run:

$ run p2

Python API:

Python has a socket module.

Note that even though VMS Python (C Python) socket module use C socket API and Jython (JVM Python) use Java socket API, then they expose the same Python socket API.

Client:

import socket

HOST = 'localhost'
PORT = 12345
# open connection
s = socket.socket(socket.AF_INET, socket.SOCK_STREAM)
s.connect((HOST, PORT))
wf = s.makefile('w')
rf = s.makefile('r')
# send message
outmsg = 'Hi from Python!\n' 
wf.write(outmsg)
wf.flush()
# receive all messages
while True:
    inmsg = rf.readline().rstrip()
    if not inmsg: break
    print('|' + inmsg + '|')
# close connection
wf.close()
rf.close()
s.close()

Run:

$ python p3.py
import socket

HOST = 'localhost'
PORT = 12345
# open connection
s = socket.socket(socket.AF_INET, socket.SOCK_STREAM)
s.connect((HOST, PORT))
wf = s.makefile('w')
rf = s.makefile('r')
# send message
outmsg = 'Hi from Jython!\n' 
wf.write(outmsg)
wf.flush()
# receive all messages
while True:
    inmsg = rf.readline().rstrip()
    if not inmsg: break
    print('|' + inmsg + '|')
# close connection
wf.close()
rf.close()
s.close()

Run:

$ jython p4.py

PHP API:

PHP has both a fsockopen function and a full socket extension.

This example will use the fsockopen and normal IO as they are simpler.

Client:

<?php
define('HOST', 'localhost');
define('PORT', 12345);

// open copnnection
$f = fsockopen(HOST, PORT);
// send message
fwrite($f, "Hi from PHP!\r\n");
// receive all messages
while(($msg = fgets($f)) !== false) {
    $msg = rtrim($msg); // trim newline away
    echo "|$msg|\r\n";
}
// close connection
fclose($f)

?>

Run:

$ php p9.php

Wrapper C API:

The C socket API is not friendly for other languages.

One option for thos elanguages is to use the SYS$QIO(W) interface, but that is very low level.

I have created a little VMS friendly wrapper around the C socket API. Text line oriented only. It is available here - take the psocket library.

Client:

      program p5
      implicit none
      integer*4 port
      character*32 host
      parameter (port=12345,
     +           host='localhost')
      integer*4 sd,msglen
      character*100 outmsg
      character*10000 inmsg
      integer*4 vms_socket_open,vms_socket_recv
      external vms_socket_open,vms_socket_recv
c  open connection
      sd=vms_socket_open(host,port)
c  send message
      outmsg='Hi from Fortran!'
      call vms_socket_send(sd, outmsg)
c  reaceive all messages
100   if(vms_socket_recv(sd, inmsg, msglen).gt.0) then
        write(*,*) '|'//inmsg(1:msglen)//'|'
        goto 100
      end if
c  close connection
      call vms_socket_close(sd)
      end

Build:

$ for p5
$ link p5 + psocketdir:vms_socket

Run:

$ run p5

[inherit('psocketdir:psocket')]
program p6(input,output);

const
   host = 'localhost';
   port = 12345;

var
   sd : integer;
   outmsg, inmsg : pstr;
   msglen : integer;

begin
   (* open connection *)
   sd := socket_open(host, port);
   (* send message *)
   outmsg := 'Hi from Pascal!';
   socket_send(sd, fix(outmsg));
   (* reeceive all messages *)
   while socket_recv(sd, inmsg.body, msglen) > 0 do begin
     inmsg.length := msglen;
     writeln('|' + inmsg + '|');
   end;
   (* close connection *)
   socket_close(sd);
end.

Build:

$ pas p6
$ link p6 + psocketdir:psocket + psocketdir:vms_socket

Run:

$ run p6
identification division.
program-id.p7.
*
data division.
working-storage section.
01  host    pic x(32) value "localhost".
01  port    pic s9(9) comp value 12345.
01  xsd     pic s9(9) comp.
01  outmsg  pic x(100).
01  inmsg   pic x(10000).
01  msglen  pic s9(9) comp.
01  n       pic s9(9) comp.
*
procedure division.
main-paragraph.
* open connection
    call "VMS_SOCKET_OPEN"
        using
            by descriptor host
            by reference port
        giving
            xsd
    end-call
* send message
    move "Hi from Cobol!" to outmsg
    call "VMS_SOCKET_SEND"
        using
           by reference xsd
           by descriptor outmsg
    end-call
* receive all messages
    move 1 to n
    perform until n = 0
        call "VMS_SOCKET_RECV"
            using
               by reference xsd
               by descriptor inmsg
               by reference msglen
           giving
               n
        end-call
        if n > 0 then
            display "|" inmsg(1:msglen) "|"
        end-if
    end-perform
* close connection
    call "VMS_SOCKET_CLOSE"
        using
            by reference xsd
    end-call
    stop run.

Build:

$ cob p7
$ link p7 + psocketdir:vms_socket

Run:

$ run p7
program p8

option type = explicit

declare integer constant port = 12345
declare string constant host = "localhost"

declare integer sd, msglen
declare string outmsg
map (inmsg) string inmsg = 1000

external integer function vms_socket_open(string, integer)
external sub vms_socket_send(integer, string)
external integer function vms_socket_recv(integer, string, integer)
external sub vms_socket_close(integer)

! open connection
sd = vms_socket_open(host, port)
! send message
outmsg = "Hi from Basic!"
call vms_socket_send(sd, outmsg)
! receive all messages
while vms_socket_recv(sd, inmsg, msglen)
   print "|" + mid(inmsg, 1, msglen) + "|"
next
! close connction
call vms_socket_close(sd)

end program

Build:

$ bas p8
$ link p8 + psocketdir:vms_socket

Run:

$ run p8

HTTP:

Concept:

HTTP (and HTTPS when using SSL encryption) is an extremely widely use protocol.

HTTP provide some fixed structure on top of a plain TCP socket. It split messages in headers and body. It define standard headers. Etc..

An obvious question is: what value does HTTP provide over plain sockets for process communication? Its value for web browser web server interaction is wellknown, but why would two VMS programs that need to communicate use HTTP and not just plain socket?

First we should note that there is no problem using plain sockets for process communication (see previous section).

But two reasons for using HTTP comes to mind:

Access Message based
Supported languages Client: Any language with a HTTP client library or a suitable wrapper around a socket library
Server: Any language with an embedded HTTP server library
Persistence None
Scope Any process on any networked system
Concurrency Independent connections
Security Encryption can be used by switching from HTTP to HTTPS

Demo:

The relevant model is where the client application has an embedded HTTP client and the server application has an embedded HTTP server:

HTTP model

It is not the model where the client application has an embedded HTTP client and the server application is embedded in a web/application server:

HTTP non-model

For embedded server we will use:

Client side we will use:

HTTP stack

Embedded server:

There are a few options for embedded web server for Java including Tomcat and Jetty.

Here we will use Jetty.

import java.io.BufferedReader;
import java.io.IOException;
import java.io.PrintWriter;
import java.util.ArrayList;
import java.util.List;

import javax.servlet.ServletException;
import javax.servlet.http.HttpServletRequest;
import javax.servlet.http.HttpServletResponse;

import org.eclipse.jetty.server.Connector;
import org.eclipse.jetty.server.Request;
import org.eclipse.jetty.server.Server;
import org.eclipse.jetty.server.handler.AbstractHandler;
import org.eclipse.jetty.server.handler.ContextHandler;
import org.eclipse.jetty.server.handler.ContextHandlerCollection;
import org.eclipse.jetty.server.nio.SelectChannelConnector;

public class S1 {
    public static class S1Handler extends AbstractHandler {
        private List<String> msgs = new ArrayList<String>();
        // handle request
        public void handle(String target, Request arg1base, HttpServletRequest req, HttpServletResponse resp) throws IOException, ServletException {
            if(req.getMethod().equals("POST")) {
                // read message and add to list of messages
                BufferedReader br = req.getReader();
                String msg = br.readLine();
                msgs.add(msg);
                br.close();
                // write list of messages back
                resp.setStatus(HttpServletResponse.SC_OK);
                resp.setContentType("text/plain");
                PrintWriter pw = resp.getWriter();
                pw.println("Java server:");
                for(String s : msgs) {
                    pw.println(s);
                }
                pw.close();
            } else {
                resp.setStatus(HttpServletResponse.SC_BAD_REQUEST);
            }
        }
    }
    private static final int PORT = 12345;
    private static final String PATH = "/";
    public static void main(String[] args) throws Exception {
        // configure Jetty
        Connector con = new SelectChannelConnector();
        con.setPort(PORT);
        Server srv = new Server();
        srv.setConnectors(new Connector[] { con  });
        ContextHandlerCollection allctx = new ContextHandlerCollection();
        ContextHandler ctx = new ContextHandler();
        ctx.setContextPath(PATH);
        ctx.setHandler(new S1Handler());
        allctx.addHandler(ctx);
        srv.setHandler(allctx);
        // run Jetty
        srv.start();
    }
}

Build:

$ javac -classpath jetty-continuation-7_6_21.jar:jetty-http-7_6_21.jar:jetty-io-7_6_21.jar:jetty-security-7_6_21.jar:jetty-server-7_6_21.jar:jetty-util-7_6_21.jar:servlet-api-2_5.jar S1.java

Run:

$ java -classpath .:jetty-continuation-7_6_21.jar:jetty-http-7_6_21.jar:jetty-io-7_6_21.jar:jetty-security-7_6_21.jar:jetty-server-7_6_21.jar:jetty-util-7_6_21.jar:servlet-api-2_5.jar "S1"

Python comes with a builtin HTTP server.

Python 2 version:

from SimpleHTTPServer import SimpleHTTPRequestHandler
from SocketServer import TCPServer

outmsg = "Python server:\r\n"

# handle request
class S2(SimpleHTTPRequestHandler):
    def do_POST(self):
        global outmsg
        # read message and add to list of messages
        inmsg = self.rfile.readline().rstrip()
        outmsg = outmsg + inmsg + "\r\n"
        # write list of messages back
        self.send_response(200)
        self.send_header('Content-type', 'text/plain')
        self.end_headers()
        self.wfile.write(outmsg)
        return

# configure SimpleHTTPServer
PORT = 12346
srv = TCPServer(('0.0.0.0', PORT), S2)
# run SimpleHTTPServer
srv.serve_forever()

There are C++ libraries for embedding a HTTP server in a native application. Including libhttpserver and Drogon. But porting those to VMS is way beyond the scope of this article. And besides they may require newer C++ compiler than what is available on VMS.

Java API:

Java comes with builtin support for HTTP client.

Most use Apache HttpClient or the new HttpClient in Java 11+, but we will just use the traditional old HttpURLConnection.

P1.java:

import java.io.BufferedReader;
import java.io.IOException;
import java.io.InputStreamReader;
import java.io.PrintStream;
import java.net.HttpURLConnection;
import java.net.URL;

public class P1 {
    public static void test(String urlstr) throws IOException {
        // connect
        URL url = new URL(urlstr);
        HttpURLConnection con = (HttpURLConnection)url.openConnection();
        con.setRequestMethod("POST");
        con.setDoOutput(true);
        con.connect();
        // write request message
        PrintStream ps = new PrintStream(con.getOutputStream());
        String outmsg = "Hi from Java!";
        ps.println(outmsg);
        ps.close();
        if (con.getResponseCode() == HttpURLConnection.HTTP_OK) {
            // read response message
            BufferedReader br = new BufferedReader(new InputStreamReader(con.getInputStream()));
            String inmsg;
            while((inmsg = br.readLine()) != null) {
                System.out.println(inmsg);
            }
            br.close();
        } else {
            System.out.printf("HTTP error : %d %s\n", con.getResponseCode(), con.getResponseMessage());
        }
    }
    public static void main(String[] args) throws IOException {
        test("http://localhost:12345/");
        test("http://localhost:12346/");
    }
}

urllib3:

Python has a urllib3 library for HTTP client available via pip.

import urllib3

http = urllib3.PoolManager()

def test(urlstr):
    # write request message and read response message
    outmsg = 'Hi from Python!\r\n'
    r = http.request('POST', urlstr, body=outmsg)
    if r.status == 200:
        inmsg = r.data.rstrip()
        print(inmsg)
    else:
        print('HTTP error : %d' % (r.status))

test('http://localhost:12345/')
test('http://localhost:12346/')

Curl:

libcurl is a very widely used HTTP (and other protocols) client library.

It is very powerful and very flexible.

But also a bit complex to use. Even when using the socalled "easy" interface.

C code:

#include <stdio.h>
#include <string.h>
#include <stdlib.h>

#include <curl.h>

static done;

// function reading request message
size_t readcb(char *buf, size_t bufsiz, size_t nitem, void *usrdat)
{
   char *outmsg;
   int outmsglen;
   if(done) return 0;
   outmsg = (char *)usrdat;
   outmsglen = strlen(outmsg);
   if(outmsglen > bufsiz * nitem) outmsglen = bufsiz * nitem;
   strncpy(buf, outmsg, outmsglen);
   done = 1;
   return outmsglen;
}

typedef void (*handler)(const char * content);

void myhandler(const char *content)
{
   printf("%s", content);
}

// function writing response message
size_t writecb(char *buf, size_t bufsiz, size_t nitem, void *usrdat)
{
   char inmsg[10000];
   handler h;
   h = (handler)usrdat;
   strncpy(inmsg, buf, bufsiz * nitem);
   inmsg[bufsiz * nitem] = 0;
   h(inmsg);
   return bufsiz * nitem;
}

void test(const char *urlstr)
{
   CURL *con;
   CURLcode stat;
   struct curl_slist *hdrs = NULL;
   char *outmsg, msglen[4];
   int code;
   /* initialize */
   curl_global_init(CURL_GLOBAL_ALL);
   con = curl_easy_init();
   if(con == NULL) printf("curl_easy_init failed\n");
   /* message */
   outmsg = "Hi from C (Curl)!\r\n";
   sprintf(msglen, "%d", strlen(outmsg));
   /* configure */
   curl_easy_setopt(con, CURLOPT_URL, urlstr);
   curl_easy_setopt(con, CURLOPT_POST, 1);
   hdrs = curl_slist_append(hdrs, "Content-Type: text/plain");
   curl_easy_setopt(con, CURLOPT_HTTPHEADER, hdrs);
   curl_easy_setopt(con, CURLOPT_POSTFIELDSIZE, msglen); /* hack to prevent curl from using chunked format that Python 2 server does not handle */
   curl_easy_setopt(con, CURLOPT_READFUNCTION, readcb);
   curl_easy_setopt(con, CURLOPT_READDATA, outmsg);
   curl_easy_setopt(con, CURLOPT_WRITEFUNCTION, writecb);
   curl_easy_setopt(con, CURLOPT_WRITEDATA, myhandler);
   /* make call */
   done = 0;
   stat = curl_easy_perform(con);
   if(stat != CURLE_OK) printf("curl_easy_perform failed: %s\n", curl_easy_strerror(stat));
   curl_easy_getinfo(con, CURLINFO_RESPONSE_CODE, &code);
   if(code != 200)
   {
      printf("HTTP error : %d\n", code);
   }
   /* free memory */
   curl_slist_free_all(hdrs);
   curl_easy_cleanup(con);
   curl_global_cleanup();
   return;
}

int main(int argc, char *argv[])
{
   test("http://localhost:12345/");
   test("http://localhost:12346/");
   return 0;
}

Build:


$ cc/include=curldir/name=as_is p3.c
$ link p3 + sys$input/opt
curldir:curllib/lib
libzshr/share
sys$share:gss$rtl/share
ssldir:ossl$libssl.olb/lib
ssldir:ossl$libcrypto.olb/lib
$

Note that this code is built with the Curl in JFP Python, but the code should be standard and the same with VSI libcurl kit.

PHP has a curl extension using libcurl.

PHP code:

<?php

function test($urlstr) {
    // connect and write request message
    $outmsg = "Hi from PHP!\r\n";
    $curl = curl_init($urlstr);
    curl_setopt($curl, CURLOPT_HTTPHEADER, array('Content-Type: text/plain', 'Accept: */*'));
    curl_setopt($curl, CURLOPT_POST, true);
    curl_setopt($curl, CURLOPT_POSTFIELDS, $outmsg);
    curl_setopt($curl, CURLOPT_RETURNTRANSFER, true);
    $inmsg = curl_exec($curl);
    // read response message
    echo $inmsg;
    // disconnect
    curl_close($curl);
}

test('http://arne1:12345/');
test('http://arne1:12346/');

?>

Direct socket:

It is also possible to just use the general socket API to make HTTP requests.

Example:

#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#include <sys/socket.h>
#include <netdb.h>
#include <unixio.h>
#include <errno.h>

#define HOST "localhost"
#define PORT "12345"

void format_header(char *head,
                   const char *method,
                   const char *path,
                   const char *host,
                   const char *contyp,
                   int bodylen,
                   const char *acctyp)
{
   sprintf(head, "%s %s HTTP/1.1\r\n"
                 "Host: %s\r\n"
                 "Content_encoding: 8bit\r\n"
                 "Content-Type: %s\r\n"
                 "Content-Length: %d\r\n"
                 "Accept-Type: %s\r\n"
                 "Connection: close\r\n"
                 "\r\n", method, path, host, contyp, bodylen, acctyp);
}

/* not super efficient to receive 1 char at a time, but it avoids a buffer */
int recv_line(int sd, char *inmsg, int inmsglen)
{
    int ix, len;
    ix = 0;
    inmsg[ix] = '\0';
    while(ix < inmsglen && strstr(inmsg, "\n") == NULL)
    {
        len = recv(sd, inmsg + ix, 1, 0);
        if(len == 0)
        {
            if(strlen(inmsg) == 0)
            {
                return -1;
            }
            else
            {
                break;
            }
        }
        ix = ix + len;
        inmsg[ix] = 0;
    }
    while(ix > 0 && (inmsg[ix - 1] == '\n' || inmsg[ix - 1] == '\r'))
    {
        inmsg[ix - 1] = 0;
        ix--;
    }
    return ix;
}

void skip_head(int sd, int *numcode)
{
   char buf[1000];
   recv_line(sd, buf, sizeof(buf));
   sscanf(buf + 9, "%d", numcode);
   do
   {
      recv_line(sd, buf, sizeof(buf));
   } while(strlen(buf) > 0);
}

void test(const char *host, const char *port, const char *path)
{
    int sd, stat, code;
    char head[1000], *outmsg, inmsg[100];
    struct addrinfo hints, *res;
    /* lookup host */
    memset(&hints, 0, sizeof(hints));
    hints.ai_family = AF_UNSPEC;
    hints.ai_socktype = SOCK_STREAM;
    hints.ai_protocol = IPPROTO_TCP;
    hints.ai_flags = 0;
    stat = getaddrinfo(host, port, &hints, &res);
    if(stat != 0)  printf("getaddrinfo stat=%d\n", stat);
    /* create socket */
    sd = socket(res->ai_family, res->ai_socktype, res->ai_protocol);
    if(sd < 0) printf("socket stat=%d (%s)\n", errno, strerror(errno));
    /* connect to host */
    stat = connect(sd, res->ai_addr, res->ai_addrlen);
    if(stat != 0) printf("connect stat=%d (%s)\n", errno, strerror(errno));
    /* write request message */
    outmsg = "Hi from C (direct socket)!\r\n";
    format_header(head, "POST", path, host, "text/plain", strlen(outmsg), "*/*");
    stat = send(sd, head, strlen(head), 0);
    if(stat < 0) printf("send stat=%d (%s)\n", errno, strerror(errno));
    stat = send(sd, outmsg, strlen(outmsg), 0);
    if(stat < 0) printf("send stat=%d (%s)\n", errno, strerror(errno));
    /* read response message */
    skip_head(sd, &code);
    if(code == 200)
    {
        while(recv_line(sd, inmsg, sizeof(inmsg)) >= 0)
        {
            printf("%s\n", inmsg);
        }
    }
    else
    {
        printf("HTTP error : %d\n", code);
    }
    /* close socket */
    close(sd);
}

int main()
{
    test("localhost", "12345", "/");
    test("localhost", "12346", "/");
    return 0;
}

Build:

$ cc p3s
$ link p3s

Wrapper direct socket:

Other native languages need a wrapper around something.

Libcurl did not look like something that was easy to wrap for another language using VMS calling standard, so I decided to wrap direct socket API instead.

It is available here - take the phttp library.

[inherit('phttpdir:phttp')]
program p4(input,output);

procedure test(host : pstr; port : integer; path : pstr);

var
   con : http;
   outmsg, inmsg : pstr;

begin
   (* connect and write request message *)
   outmsg := 'Hi from Pascal!' + chr(13) + chr(10);
   con := http_post(fix(host), port, fix(path), 'text/plain', '*/*', fix(outmsg));
   (* read response message *)
   if http_numcode(con) = 200 then begin
      while http_recv(con, inmsg.body, inmsg.length) >= 0 do begin
         writeln(inmsg);
      end;
   end else begin
      writeln('HTTP error : ', http_numcode(con):1, ' (', http_txtcode2(con), ')');
   end;
   (* disconnect *)
   http_close(con);
end;

begin
   test('arne1', 12345, '/');
   test('arne1', 12346, '/');
end.

Build:

$ pas p4
$ link p4 + phttpdir:phttp + phttpdir:vms_http + phttpdir:vms_socket
      program p5
      implicit none
      call test('arne1',12345,'/');
      call test('arne1',12346,'/');
      end
c
      subroutine test(host,port,path)
      implicit none
      character*(*) host,path
      integer*4 port
      character*100 outmsg,inmsg
      integer*4 con
      integer*2 msglen
      integer*4 vms_http_post,vms_http_recv,vms_http_numcode
c  connect and write request message
      outmsg='Hi from Fortran!'//char(13)//char(10)
      msglen=len('Hi from Fortran!'//char(13)//char(10))
      con=vms_http_post(%descr(host),%ref(port),%descr(path),
     +  %descr('text/plain'),%descr('*/*'),
     +  %descr(outmsg(1:msglen)))
c  read response message
      if(vms_http_numcode(con).eq.200) then
100     if(vms_http_recv(con,inmsg,msglen).ge.0) then
          write(*,*) inmsg(1:msglen)
          goto 100
        end if
      else
        write(*,*) 'HTTP error: ',vms_http_numcode(con)
      end if
c  disconnect
      call vms_http_close(%ref(con))
      return
      end

Build:

$ for p5
$ link p5 + phttpdir:vms_http + phttpdir:vms_socket
identification division.
program-id.p6.
*
data division.
working-storage section.
01 host         pic x(32).
01 port         pic s9(9) comp.
01 path         pic x(255).
01 respline     pic x(100).
01 con          pic s9(9) comp.
01 linelen      pic s9(4) comp.
01 contyp       pic x(16) value "text/plain".
01 acctyp       pic x(16) value "*/*".
01 msg          pic x(100).
01 stat         pic s9(9) comp.
01 httpcode     pic 9(9) comp.
01 temp         pic 9(9) display.
*
procedure division.
main-paragraph.
    move "arne1" to host
    move 12345 to port
    move "/" to path
    perform test-paragraph
    move "arne1" to host
    move 12346 to port
    move "/" to path
    perform test-paragraph
    stop run.
test-paragraph.
* connect and write requets message
    string "Hi from Cobol!" delimited by size
           function char(14) delimited by size
           function char(11) delimited by size into msg
    call "VMS_HTTP_POST"
        using
           by descriptor host
           by reference port
           by descriptor path
           by descriptor contyp
           by descriptor acctyp
           by descriptor msg
        giving
           con
    end-call
* read response message
    call "VMS_HTTP_NUMCODE"
        using
            by reference con
        giving
            httpcode
    end-call
    if httpcode = 200
        move 1 to stat
        perform until stat < 0
            call "VMS_HTTP_RECV"
                using
                    by reference con
                    by descriptor respline
                    by reference linelen
                giving
                    stat
            end-call
            if stat >= 0
                display respline(1:linelen)
            end-if
        end-perform
    else
        move httpcode to temp
        display "HTTP error : " temp
    end-if
* disconnect
    call "VMS_HTTP_CLOSE"
        using
            by reference con
    end-call.

Build:

$ cob p6
$ link p6 + phttpdir:vms_http + phttpdir:vms_socket
program p7

option type = explicit

external sub test(string, integer, string)

call test("arne1", 12345, "/")
call test("arne1", 12346, "/")

end program
!
sub test(string host, integer port, string path)

declare integer httpcon, msglen
declare string outmsg
map (inmsg) string inmsg = 100

external integer function vms_http_post(string, integer, string, string, string, string)
external integer function vms_http_recv(integer, string, integer)
external sub vms_http_close(integer)
external integer function vms_http_numcode(integer)

! connect and write requets message
outmsg = "Hi from Basic!" + chr$(13) + chr$(10)
httpcon = vms_http_post(host, port, path, "text/plain", "*/*", outmsg)
! read response message
if vms_http_numcode(httpcon) = 200 then
   while vms_http_recv(httpcon, inmsg, msglen) >= 0
      print "|" + mid(inmsg, 1, msglen) + "|"
   next
else
   print "HTTP error : ", vms_http_numcode(httpcon)
end if
! disconnect
call vms_http_close(httpcon)

end sub

Build:

$ bas p7
$ link p7 + phttpdir:vms_http + phttpdir:vms_socket

SOAP Web Service:

Concept:

SOAP is an XML based message format typical used over HTTP/HTTPS transport.

Access RPC style
Supported languages Client: Any language with a SOAP client library
Server: Any language with a SOAP server library
(it can not be recommended to try and do SOAP using just a XML library and a HTTP library - SOAP is complicated
Persistence None
Scope Any process on any networked system
Concurrency Independent connections
Security Encryption can be used by switching from HTTP to HTTPS

For more information about SOAP in general see Web Service - SOAP.

For more information about Java SOAP web services on VMS see VMS Tech Demo 10 - Java SOAP web services.

Demo:

The basic model is the same as for plain HTTP, but instead of operating on request message and response message, then it is RPC style - the server exposes an API and the client calls an API:

SOAP model

We will demo:

SOAP stack

JAX-WS embedded server:

Java server using JAX-WS:

import java.util.ArrayList;
import javax.jws.WebMethod;
import javax.jws.WebService;
import javax.xml.ws.Endpoint;

@WebService(targetNamespace="vmsipc")
public class S1 {
    private ArrayList<String> msgs = new ArrayList<String>();
    @WebMethod
    public ArrayList<String> process(String msg) {
        msgs.add(msg);
        return msgs;
    }
    public static void main(String[] args) throws Exception {
        Endpoint.publish("http://localhost:8081/soap/S1", new S1());        
    }
}
$ javac S1.java
$ java "S1"

JAX-WS:

Java server:

import gen.*;

public class C1 {
    public static void main(String[] args) throws Exception {
        S1Service factory = new S1Service();
        S1 soap = factory.getPort(S1.class);
        for(String msg : soap.process("Hi from Java!")) {
            System.out.println(msg);
        }
    }
}

Java 5:

$ if f$search("gen.dir") .eqs. ""
$ then
$    java "com.sun.tools.ws.WsImport" "-keep" "-p" "gen" "http://localhost:8081/soap/S1?wsdl"
$ endif
$ javac C1.java
$ java "C1"

Java 8:

$ if f$search("gen.dir") .eqs. ""
$ then
$    wsimport "-keep" "-p" "gen" "http://localhost:8081/soap/S1?wsdl"
$ endif
$ javac C1.java
$ java "C1"
import gen.*

factory = new S1Service()
soap = factory.getPort(S1.class)
for(msg in soap.process("Hi from Groovy!")) {
    println(msg)
}
from gen import *

factory = S1Service()
soap = factory.getPort(S1)
for msg in soap.process('Hi from Jython!'):
    print(msg)

Zeep:

from zeep import Client

factory = Client('http://localhost:8081/soap/S1?wsdl')
soap = factory.service
for msg in soap.process('Hi from Python!'):
    print(msg)

SoapClient:

<?php

$soap = new SoapClient('http://localhost:8081/soap/S1?wsdl');
// note:
//   $soap->process((object)array('arg0' => 'Hi from PHP!'))->return
// should have been
//   $soap->process('Hi from PHP!')
// but somewhere Java and PHP did not agree on default SOAP standards
foreach($soap->process((object)array('arg0' => 'Hi from PHP!'))->return as $msg) {
    echo "$msg\r\n";
}
?>

Spyne embedded server:

Python server using Spyne should work on VMS. But I could not get it to work for me - some module dependency problem, but I assume that a more Python knowledgable person than me could get it working.

Python server using Spyne:

from spyne import Application, rpc, ServiceBase, Iterable, String
from spyne.protocol.soap import Soap11
from spyne.server.wsgi import WsgiApplication
from wsgiref.simple_server import make_server

class S2Service(ServiceBase):
    msgs = []
    @rpc(String, _returns=Iterable(String))
    def process(self, msg):
        S2Service.msgs.append(msg)
        return S2Service.msgs

app = Application([S2Service], tns='vmsipc', in_protocol=Soap11(), out_protocol=Soap11(), name='S2')
wsgi = WsgiApplication(app)
srv = make_server('localhost', 8000, wsgi)
srv.serve_forever()

Same clients as above:

import gen.*;

public class C1 {
    public static void main(String[] args) throws Exception {
        S2Service factory = new S2Service();
        S2 soap = factory.getPort(S2.class);
        // note:
        //   soap.process("Hi from Java!").getString()
        // should have been
        //   soap.process("Hi from Java!")
        // but somewhere Python and Java did not agree on default SOAP standards
        for(String msg : soap.process("Hi from Java!").getString()) {
            System.out.println(msg);
        }
    }
}
from zeep import Client

factory = Client('http://localhost:8000/soap/S2?wsdl')
soap = factory.service
for msg in soap.process('Hi from Python!'):
    print(msg)
<?php

$soap = new SoapClient('http://localhost:8000/soap/S2?wsdl');
// note:
//   $soap->process((object)array('msg' => 'Hi from PHP!'))->processResult->string
// should have been
//   $soap->process('Hi from PHP!')
// but somewhere Java and PHP did not agree on default SOAP standards
foreach($soap->process((object)array('msg' => 'Hi from PHP!'))->processResult->string as $msg) {
    echo "$msg\r\n";
}
?>

XML-RPC Web Service:

Concept:

Access RPC style
Supported languages Client: Any language with a XML-RPC client library or just a HTTP client library (and doing direct XML in application)
Server: Any language with a XML-RPC server library
Persistence None
Scope Any process on any networked system
Concurrency Independent connections
Security Encryption can be used by switching from HTTP to HTTPS if libraries support it

For more information about XML-RPC in general see Web Service - XML-RPC.

For more information about XML-RPC web services on VMS see VMS Tech Demo 11 - XML-RPC and VMS Tech Demo 12 - XML-RPC direct XML.

Demo:

The basic model is the same as for plain HTTP, but instead of operating on unstructured request message and response message, then it is RPC style with structured request message and response message.

XML-RPC model

We will demo:

XML-RPC stack

Embedded server:

Java / Apache XML-RPC:

import java.util.ArrayList;

import org.apache.xmlrpc.server.PropertyHandlerMapping;
import org.apache.xmlrpc.server.XmlRpcServer;
import org.apache.xmlrpc.webserver.WebServer;

public class S1 {
    private static ArrayList<String> msgs = new ArrayList<String>();
    public ArrayList<String> process(String msg) {
        synchronized(msgs) {
            msgs.add(msg);
            return msgs;
        }
    }
    public static void main(String[] args) throws Exception {
        WebServer srv = new WebServer(8001);
        XmlRpcServer xmlrpc = srv.getXmlRpcServer();
        srv.start();
        PropertyHandlerMapping phm = new PropertyHandlerMapping();
        phm.addHandler("S", S1.class);
        xmlrpc.setHandlerMapping(phm);
        System.out.print("Press enter to exit");
        System.in.read();
        srv.shutdown();
    }
}
$ cp = "/javalib/commons-logging-1_1.jar:/javalib/ws-commons-util-1_0_2.jar:/javalib/xmlrpc-client-3_1_2.jar:/javalib/xmlrpc-common-3_1_2.jar:/javalib/xmlrpc-server-3_1_2.jar"
$ javac -cp 'cp' *.java
$ define/nolog sys$input sys$command
$ java -cp .:'cp' "S1"

Python / xmlrpclib module:

import xmlrpclib
from SimpleXMLRPCServer import SimpleXMLRPCServer

msgs = []

def process(msg):
    msgs.append(msg)
    return msgs

server = SimpleXMLRPCServer(('localhost', 8001))
server.register_function(process, 'S.process')
server.serve_forever()
$ python s2.py

Apache XML-RPC:

import java.net.URL;

import org.apache.xmlrpc.client.XmlRpcClient;
import org.apache.xmlrpc.client.XmlRpcClientConfigImpl;

public class C1 {
    public static void main(String[] args) throws Exception {
        XmlRpcClientConfigImpl config = new XmlRpcClientConfigImpl();
        config.setServerURL(new URL("http://localhost:8001/"));
        XmlRpcClient client = new XmlRpcClient();
        client.setConfig(config);
        Object[] msgs = (Object[])client.execute("S.process", new Object[] { "Hi from Java!" });
        for(Object o : msgs) {
            String msg = (String)o;
            System.out.println(msg);
        }
    }
}
$ cp = "/javalib/commons-logging-1_1.jar:/javalib/ws-commons-util-1_0_2.jar:/javalib/xmlrpc-client-3_1_2.jar:/javalib/xmlrpc-common-3_1_2.jar:/javalib/xmlrpc-server-3_1_2.jar"
$ javac -cp 'cp' *.java
$ define/nolog sys$input sys$command
$ java -cp .:'cp' "C1"
import org.apache.xmlrpc.client.*

config = new XmlRpcClientConfigImpl()
config.setServerURL(new URL("http://localhost:8001/"))
client = new XmlRpcClient()
client.setConfig(config)
msgs = client.execute("S.process", new Object[] { "Hi from Groovy!" })
for(msg in msgs) {
    println(msg)
}
$ groovy_cp = "/javalib/commons-logging-1_1.jar:/javalib/ws-commons-util-1_0_2.jar:/javalib/xmlrpc-client-3_1_2.jar:/javalib/xmlrpc-common-3_1_2.jar:/javalib/xmlrpc-server-3_1_2.jar"
$ groovy c6.groovy

xmlrpc module:

import xmlrpclib

cli = xmlrpclib.Server('http://localhost:8001')
msgs = cli.S.process('Hi from Python!')
for msg in msgs:
    print(msg)
$ python c2.py

xmlrpc encoder and decode:

<?php

class Client {
    private $urlstr;
    public function __construct($urlstr) {
        $this->urlstr = $urlstr;
    }
    function execute($func, $args) {
       $ctx = stream_context_create(array('http' => array(
            'method' => 'POST',
            'header' => 'Content-Type: text/xml',
            'content' => xmlrpc_encode_request($func, $args)
        )));
       return xmlrpc_decode(file_get_contents($this->urlstr, false, $ctx));
    }
}

$cli = new Client('http://localhost:8001/');
$msgs = $cli->execute('S.process', array('Hi from PHP!'));
foreach($msgs as $msg) {
    echo "$msg\r\n";
}

?>
$ php c5.php

XMLRPC and PXMLRPC:

#include <stdio.h>
#include <string.h>
#include <stdlib.h>

#include "xmlrpc_format.h"
#include "vms_http.h"
#include "xmlrpc_parse.h"

int main()
{
    char req[1000];
    xmlrpc_request(req, sizeof(req), "S.process", 1, xmlrpc_string("Hi from C!"));
    struct vms_http *ctx = http_post("localhost", 8001, "/", "text/xml", "text/xml", req);
    char resp[100000];
    short resplen;
    http_recv_all(ctx, resp, sizeof(resp), &resplen);
    resp[resplen] = 0;
    http_close(ctx);
    char *msgs[1000];
    int nelm = xmlrpc_response(resp, msgs);
    for(int i = 0; i < nelm; i++) 
    {
        printf("%s\n", msgs[i]);
        free(msgs[i]);
    }
    return 0;
}
$ define/nolog xmlrpcdir disk2:[arne.xmlrpc]
$ cc/incl=xmlrpcdir c3
$ link c3 + xmlrpcdir:xmlrpc/lib
$ run c3
[inherit('pxmlrpcdir:common', 'pxmlrpcdir:xmlrpc_format', 'pxmlrpcdir:phttp', 'pxmlrpcdir:xmlrpc_parse')]
program c4(input,output);

var
   req : pstr;
   ctx : http;
   resp : pstr;
   msgs : array [1..1000] of c_str_t;
   msg : pstr;
   n, i : integer;

begin
   pxmlrpc_request(req, 'S.process', pxmlrpc_string('Hi from Pascal!'));
   ctx := http_post('localhost', 8001, '/', 'text/xml', 'text/xml', fix(req));
   http_recv_all(ctx, resp.body, resp.length);
   n := pxmlrpc_response(resp, iaddress(msgs));
   for i := 1 to n do begin
      msg := pas_str(msgs[i]);
      free_c_str(msgs[i]);
      writeln(msg);
   end;
end.
$ define/nolog xmlrpcdir disk2:[arne.xmlrpc]
$ define/nolog pxmlrpcdir disk2:[arne.vmspascal.pxmlrpc]
$ pas c4
$ link c4 + pxmlrpcdir:pxmlrpc/lib + xmlrpcdir:xmlrpc/lib
$ run c4

direct XML + HTTP wrapper:

      program c7
      character*1000 req, resp
      integer*4 ctx, resplen, n, ixstart, ixend
      character*100 msg
      integer*4 msglen
      integer*4 vms_http_post
      integer*4 vms_http_recv_all
      logical*4 grab
      req = '<methodCall>'//
     +      '<methodName>S.process</methodName>'//
     +      '<params>'//
     +      '<param><value><string>'//
     +      'Hi from Fortran!'//
     +      '</string></value></param>'//
     +      '</params>'//
     +      '</methodCall>'
      ctx = vms_http_post('localhost', 8001, '/',
     +                    'text/xml', 'text/xml', req)
      n = vms_http_recv_all(ctx, resp, resplen)
      call vms_http_close(ctx)
      ixstart = 1
      ixend = resplen
      if(grab(resp(1:resplen), ixstart, ixend, 'value', .true.)) then
        if(grab(resp(1:resplen), ixstart, ixend, 'array', .true.)) then
          ixstart2 = ixstart
          ixend2 = 0
100       if(grab(resp(1:resplen), ixstart2, ixend2,
     +            'value', .false.)) then
            ixstart3 = ixstart2
            ixend3 = ixend2
            if(grab(resp(1:resplen), ixstart3, ixend3,
     +              'string', .true.)) then
              msglen = ixend3 - ixstart3
              msg(1:msglen) = resp(ixstart3:ixend3-1)
              write(*,*) msg(1:msglen)
            else
              msglen = ixend3 - ixstart3
              msg(1:msglen) = resp(ixstart3:ixend3-1)
              write(*,*) msg(1:msglen)
            endif
            ixstart2 = ixend2
            ixend2 = ixend
            goto 100
          endif
        endif
      endif
      end
c
      logical*4 function grab(xmlstr, xstart, xend, tag, greedy)
      character*(*) xmlstr, tag
      integer*4 xstart, xend
      logical*4 greedy
      character*100 starttag, endtag
      integer*4 starttaglen, endtaglen, ixstart, ixend
      starttaglen = 1 + len(tag) + 1
      starttag(1:starttaglen) = '<'//tag//'>'
      endtaglen = 2 + len(tag) + 1
      endtag(1:endtaglen) = '</'//tag//'>'
      ixstart = xstart
100   if((ixstart.lt.(len(xmlstr)-starttaglen)).and.
     +   (xmlstr(ixstart:ixstart+starttaglen-1).ne.
     +   starttag(1:starttaglen))) then
        ixstart = ixstart + 1
        goto 100
      endif
      ixstart = ixstart + starttaglen
      if(greedy) then
        ixend = xend - endtaglen
200     if((ixend.gt.1).and.
     +     (xmlstr(ixend:ixend+endtaglen-1).ne.endtag(1:endtaglen)))then
          ixend = ixend - 1
          goto 200
        endif
      else
        ixend = ixstart
300     if((ixend.lt.(len(xmlstr)-starttaglen)).and.
     +     (xmlstr(ixend:ixend+endtaglen-1).ne.endtag(1:endtaglen)))then
          ixend = ixend + 1
          goto 300
        endif
      endif
      if((ixstart.lt.(len(xmlstr)-starttaglen)).and.(ixend.ge.1)) then
        xstart = ixstart
        xend = ixend
        grab = .true.
      else
        grab = .false.
      endif
      end
$ define/nolog xmlrpcdir disk2:[arne.xmlrpc]
$ for c7
$ link c7 + xmlrpcdir:xmlrpc/lib
$ run c7
program c8

declare string req, msg
map (resp) string resp = 1000
declare integer ctx, resplen, n, ixstart, ixend, ixstart2, ixend2, ixstart3, ixend3

external integer function vms_http_post(string, integer, string, string, string, string)
external integer function vms_http_recv_all(integer, string, integer)
external sub vms_http_close(integer)
external integer function grab(string, integer, integer, string, integer)

req = "<methodCall><methodName>S.process</methodName><params><param><value><string>Hi from Basic!</string></value></param></params></methodCall>"
ctx = vms_http_post("localhost", 8001, "/", "text/xml", "text/xml", req)
n = vms_http_recv_all(ctx, resp, resplen)
call vms_http_close(ctx)
ixstart = 1
ixend = len(resp)
if grab(mid$(resp, 1, resplen), ixstart, ixend, "value", 1) then
    if grab(mid$(resp, 1, resplen), ixstart, ixend, "array", 1) then
        ixstart2 = ixstart
        ixend2 = 0
        while grab(mid$(resp, 1, resplen), ixstart2, ixend2, "value", 0)
            ixstart3 = ixstart2
            ixend3 = ixend2
            if grab(mid$(resp, 1, resplen), ixstart3, ixend3, "string", 1) then
                msg = mid$(resp, ixstart3, ixend3 - ixstart3)
                print msg
            else
                msg = mid$(resp, ixstart3, ixend3 - ixstart3)
                print msg
            end if
            ixstart2 = ixend2
            ixend2 = ixend
        next
    end if
end if

end program
!
function integer grab(string xmlstr, integer xstart, integer xend, string tag, integer greedy)

declare string starttag, endtag
declare integer ixstart, ixend

starttag = "<" + tag + ">"
endtag = "</" + tag + ">"
ixstart = xstart
while (ixstart < (len(xmlstr) - len(starttag))) and (mid$(xmlstr, ixstart, len(starttag))) <> starttag
    ixstart = ixstart + 1
next
ixstart = ixstart + len(starttag)
if greedy <> 0 then
    ixend = xend - len(endtag)
    while (ixend > 1) and (mid$(xmlstr, ixend, len(endtag)) <> endtag)
        ixend = ixend - 1
    next
else
    ixend = ixstart
    while (ixend < (len(xmlstr) - len(starttag))) and (mid$(xmlstr, ixend, len(endtag)) <> endtag)
        ixend = ixend + 1
    next
end if
if (ixstart < len(xmlstr) - len(starttag)) and (ixend >= 1) then
    xstart = ixstart
    xend = ixend
    grab = 1
else
    grab = 0
end if

end function
$ define/nolog xmlrpcdir disk2:[arne.xmlrpc]
$ bas c8
$ link c8 + xmlrpcdir:xmlrpc/lib
$ run c8

RESTful Web Service:

Concept:

Access RESTful style messages
Supported languages Client: Any language with a HTTP client/library and JSON/XML library
Server: Any language with an embedded HTTP server library and JSON/XML library
Persistence None
Scope Any process on any networked system
Concurrency Independent connections
Security Encryption can be used by switching from HTTP to HTTPS if libraries support it

For more information about XML-RPC in general see Web Service - RESTful.

Demo:

The basic model is somewhat the same as for plain HTTP, but it follows the RESTful conventions for GET, POST, PUT and DELETE operations on items and collections of items.

XML-RPC model

Server side will be done using JAX-RS API and Jersey library. See more detail here.

Client side we will demo:

XML-RPC stack

Note that we will only demo JSON/HTTP(S) not XML/HTTP(S). JSON is by far the most common today.

Embedded server:

package server;

import javax.xml.bind.annotation.XmlRootElement;

@XmlRootElement
public class Message {
    private String text;
    public Message() {
        this("");
    }
    public Message(String text) {
        this.text = text;
    }
    public String getText() {
        return text;
    }
    public void setText(String text) {
        this.text = text;
    }
}
package server;

import java.util.ArrayList;
import java.util.List;

import javax.ws.rs.Consumes;
import javax.ws.rs.GET;
import javax.ws.rs.Path;
import javax.ws.rs.POST;
import javax.ws.rs.Produces;
import javax.ws.rs.core.MediaType;

import org.eclipse.jetty.server.Server;
import org.eclipse.jetty.servlet.ServletContextHandler;
import org.eclipse.jetty.servlet.ServletHolder;

import com.sun.jersey.spi.container.servlet.ServletContainer;

@Path("/msgs")
public class RestServer {
    private static List<Message> msgs = new ArrayList<Message>();
    @GET
    @Produces({MediaType.APPLICATION_JSON})
    @Path("")
    public List<Message> get() {
        return msgs;
    }
    @POST
    @Consumes({MediaType.APPLICATION_JSON})
    @Produces({MediaType.APPLICATION_JSON})
    @Path("")
    public Message add(Message msg) {
        synchronized(msgs) {
            msgs.add(msg);
        }
        return msg;
    }
    public static void main(String[] args) throws Exception {
        Server server = new Server(8001);
        ServletContextHandler ctx = new ServletContextHandler(ServletContextHandler.NO_SESSIONS);
        ctx.setContextPath("/");
        server.setHandler(ctx);
        ServletHolder srvlet = ctx.addServlet(ServletContainer.class, "/*");
        srvlet.setInitOrder(1);
        srvlet.setInitParameter("com.sun.jersey.config.property.packages", "server");
        srvlet.setInitParameter("com.sun.jersey.api.json.POJOMappingFeature", "true");
        server.start();
        server.join();
    }
}
$ jaxrslibloc = "DISK2:[ARNE.jaxrs]" ! change location
$ cp = f$parse("[]") - ".;"
$ loop:
$    jar = f$search("''jaxrslibloc'*.jar")
$    if jar .eqs. "" then goto endloop
$    cp = cp + "," + (jar - ";1")
$    goto loop
$ endloop:
$ define/nolog java$classpath 'cp'
$ exit
$ @cp
$ set def [.server]
$ javac *.java
$ set def [-]
$ java "server.RestServer"

Besides Java then Python should also work as server with the Flask module, but I do not have a VMS Python with Flask installed.

HttpURLConnection + GSon:

import java.io.IOException;
import java.io.InputStream;
import java.net.HttpURLConnection;
import java.net.MalformedURLException;
import java.net.URL;
import java.util.ArrayList;
import java.util.List;
import java.util.Map;
import java.util.TreeMap;
import java.lang.reflect.Type;

import javax.xml.bind.annotation.XmlRootElement;

import com.google.gson.reflect.TypeToken;
import com.google.gson.Gson;

public class Client {
    @XmlRootElement
    public static class Message {
        private String text;
        public Message() {
            this("");
        }
        public Message(String text) {
            this.text = text;
        }
        public String getText() {
            return text;
        }
        public void setText(String text) {
            this.text = text;
        }
    }
    private static String interact(String method, String urlstr, String typ, String body) {
        try {
            HttpURLConnection con = (HttpURLConnection)(new URL(urlstr)).openConnection();
            con.setRequestMethod(method);
            con.addRequestProperty("accept",  typ);
            if(body != null) {
                con.addRequestProperty("content-type", typ);
                con.setDoOutput(true);
                con.getOutputStream().write(body.getBytes());
            }
            StringBuilder sb = new StringBuilder();
            con.connect();
            if(con.getResponseCode() / 100 == 2) {
                InputStream is = con.getInputStream();
                byte[] b = new byte[1000];
                int n;
                while((n = is.read(b)) >= 0) {
                    sb.append(new String(b,0,n));
                }
                is.close();
            } else {
                System.out.printf("Error: %d %s\n", con.getResponseCode(), con.getResponseMessage());
            }
            con.disconnect();
            return sb.toString();
        } catch (MalformedURLException e) {
            e.printStackTrace();
            return null;
        } catch (IOException e) {
            e.printStackTrace();
            return null;
        }
    }
    public static void main(String[] args) {
        Gson gson = new Gson();
        String request1 = gson.toJson(new Message("Hi from Java!"));
        String response1 = interact("POST", "http://localhost:8001/msgs", "application/json", request1);
        String response2 = interact("GET", "http://localhost:8001/msgs", "application/json", null);
        Type t = new TypeToken<TreeMap<String,ArrayList<Message>>>(){}.getType();
        Map<String,List<Message>> msgs = gson.fromJson(response2, t);
        for(Message msg : msgs.get("message")) {
            System.out.println(msg.getText());
        }
    }
}
$ javac -cp .:/disk2/arne/jaxrs/gson-2_2_4.jar:/disk2/arne/jaxrs/jaxb-api-2_1.jar *.java
$ java -cp .:/disk2/arne/jaxrs/gson-2_2_4.jar:/disk2/arne/jaxrs/jaxb-api-2_1.jar "Client"
import com.google.gson.reflect.*
import com.google.gson.*

class Message {
    String text;
}

def interact(method, urlstr, typ, body) {
    con = (new URL(urlstr)).openConnection()
    con.setRequestMethod(method)
    con.addRequestProperty("accept",  typ)
    if(body != null) {
        con.addRequestProperty("content-type", typ)
        con.setDoOutput(true)
        con.outputStream.write(body.bytes)
    }
    sb = new StringBuilder()
    con.connect()
    if(con.responseCode.intdiv(100) == 2) {
        is = con.inputStream
        b = new byte[1000]
        while((n = is.read(b)) >= 0) {
            sb.append(new String(b, 0, n))
        }
        is.close()
    } else {
        println("Error: ${con.responseCode} ${con.responseMessage}")
    }
    con.disconnect()
    return sb.toString()
}

gson = new Gson()
msg = new Message(text: "Hi from Groovy!")
request1 = gson.toJson(msg)
response1 = interact("POST", "http://localhost:8001/msgs", "application/json", request1)
response2 = interact("GET", "http://localhost:8001/msgs", "application/json", null)
t = new TypeToken<TreeMap<String,ArrayList<Message>>>(){}.getType()
msgs = gson.fromJson(response2, t)
for(msg in msgs.get("message")) {
    println(msg.text)
}
$ groovy_cp = "/disk2/arne/jaxrs/gson-2_2_4.jar:/disk2/arne/jaxrs/jaxb-api-2_1.jar"
$ groovy client.groovy

request + json:

import requests
import json

o = {'text': 'Hi from Python!'}
request1 = json.dumps(o)
response1 = requests.post('http://localhost:8001/msgs', headers = { 'Content-Type': 'application/json', 'Accept': 'application/json'}, data = request1)
response2 = requests.get('http://localhost:8001/msgs', headers = { 'Accept': 'application/json'})
msgs = json.loads(response2.text)
for msg in msgs['message']:
    print(msg['text'])
$ python client.py

curl + json_encode/json_decode:

<?php

$msg = array('text' => 'Hi from PHP!');
$request1 = json_encode($msg);
$curl = curl_init('http://localhost:8001/msgs');
curl_setopt($curl, CURLOPT_HTTPHEADER, array('Accept: application/json', 'Content-Type: application/json'));
curl_setopt($curl, CURLOPT_POST, true);
curl_setopt($curl, CURLOPT_POSTFIELDS, $request1);
curl_setopt($curl, CURLOPT_RETURNTRANSFER, true);
$response1 = curl_exec($curl);
curl_close($curl);
$curl = curl_init('http://localhost:8001/msgs');
curl_setopt($curl, CURLOPT_HTTPHEADER, array('Accept: application/json'));
curl_setopt($curl, CURLOPT_RETURNTRANSFER, true);
$response2 = curl_exec($curl);
curl_close($curl);
$msgs = json_decode($response2);
foreach($msgs->message as $msg) {
    echo $msg->text . "\r\n";
}

?>
$ php client.php

socket + cJSON:

#include <stdio.h>
#include <string.h>
#include <stdlib.h>

#include "vms_http.h"
#include "cJSON.h"

int main()
{
    char request1[1000];
    sprintf(request1, "{\"text\": \"%s\"}", "Hi from C!");
    struct vms_http *ctx1 = http_post("localhost", 8001, "/msgs", "application/json", "application/json", request1);
    char response1[10000];
    short resp1len;
    http_recv_all(ctx1, response1, sizeof(response1), &resp1len);
    response1[resp1len] = 0;
    http_close(ctx1);
    struct vms_http *ctx2 = http_get("localhost", 8001, "/msgs", "application/json");
    char response2[10000];
    short resp2len;
    http_recv_all(ctx2, response2, sizeof(response2), &resp2len);
    response2[resp2len] = 0;
    http_close(ctx2);
    cJSON *resp = cJSON_Parse(response2);
    cJSON *msgs = cJSON_GetObjectItem(resp, "message");
    for(int i = 0; i < cJSON_GetArraySize(msgs); i++)
    {
        cJSON *msg = cJSON_GetArrayItem(msgs, i);
        cJSON *text = cJSON_GetObjectItem(msg, "text");
        printf("%s\n", text->valuestring);
    }
    cJSON_Delete(resp);
    return 0;
}
$ define/nolog xmlrpcdir disk2:[arne.xmlrpc]
$ define/nolog pjsondir disk2:[arne.vmspascal.pjson]
$ cc/incl=(xmlrpcdir,pjsondir) client
$ link client + xmlrpcdir:vms_http + xmlrpcdir:vms_socket + pjsondir:cjson
$ run client
[inherit('phttpdir:common','phttpdir:phttp','pjsondir:pjson')]
program test(input, output);

var
   con : http;
   request1, response1, response2 : pstr;
   resp, msgs, msg, xtext : cJSON_ptr;
   i : integer;

begin
   request1 := '{"text": "' + 'Hi from Pascal!' + '"}';
   con := http_post('localhost', 8001, '/msgs', 'application/json', 'application/json', fix(request1));
   http_recv_all(con, response1.body, response1.length);
   con := http_get('localhost', 8001, '/msgs', 'application/json');
   http_recv_all(con, response2.body, response2.length);
   resp := pJSON_Parse(response2);
   msgs := pJSON_GetObjectItem(resp, 'message');
   for i := 1 to pJSON_GetArraySize(msgs) do begin
      msg := pJSON_GetArrayItem(msgs, i - 1);
      xtext := pJSON_GetObjectItem(msg, 'text');
      writeln(pJSON_StringValue(xtext));
   end;
   pJSON_Delete(resp);
end.
$ define/nolog phttpdir disk2:[arne.vmspascal.phttp]
$ define/nolog pjsondir disk2:[arne.vmspascal.pjson]
$ pas client
$ link client + phttpdir:common + phttpdir:phttp + phttpdir:vms_http + phttpdir:vms_socket + pjsondir:pjson + pjsondir:cjson
$ run client

Message Queue:

Concept:

Message queues are a wellknown concept in programming.

Basically message queues are remote accessible FIFO data structures.

Access Message based
Supported languages Any language with a message queue library or a wrapper around a message queue library
Persistence Queues can be configured for persistence
Queues: messages are gone when read once
Topics: messages are gone when all subscribers have read
Scope Any process on any networked system
Concurrency Different queues are automatically separated and different queue connections to same queue are automatically separated, but concurrent access to same queue connection requires additional synchonization to be safe
Security Storage for persistent queues/topics are usualy not encrypted
Most servers and some (but definitely not all) client library support SSL

I have message queue programming in another article Message Queue.

Demo:

We will use ActiveMQ message queue and run a server that receive on one queue, accumulates messages and send to another queue.

ActiveMQ is a widely used message queue. It supports multiple protocols: OpenWire, AMQP and STOMP. It is available on VMS Itanium.

Clients will connect to the server, send a message and receive a response message.

Message queue model

Java and Jython will use the JMS provider for ActiveMQ (and the underlying OpenWire protocol).

Python will use a STOMP module.

C will use a simple C library.

The traditional VMS languages (Fortran, Pascal, Cobol, Basic) will use a wrapper around the simple C library.

Message queue stack

Note that even though the demo use the ActiveMQ message queue, then the client code is not ActiveMQ specific. Practically all message queues come with a Java library that exposes the standard JMS API. The STOMP protocol is supproted by many message queues including ActiveMQ/ArtemisMQ and RabbitMQ.

Server (receive and reply):

import java.util.ArrayList;
import java.util.List;
import javax.jms.JMSException;
import javax.jms.Message;
import javax.jms.Queue;
import javax.jms.QueueConnection;
import javax.jms.QueueConnectionFactory;
import javax.jms.QueueReceiver;
import javax.jms.QueueSender;
import javax.jms.QueueSession;
import javax.jms.Session;
import javax.jms.TextMessage;

import org.apache.activemq.ActiveMQConnectionFactory;

public class Server {
    private static final String SERVER = "tcp://arnepc4:61616";
    private static final String UN = "arne";
    private static final String PW = "topsecret";
    private static final String QC2S = "QC2S";
    private static final String QS2C = "QS2C";
    private List<String> msgs = new ArrayList<String>();
    private void run() {
        try {
            // connect
            QueueConnectionFactory qcf = new ActiveMQConnectionFactory(SERVER);
            QueueConnection con = qcf.createQueueConnection(UN, PW);
            con.start();
            QueueSession ses = con.createQueueSession(false, Session.AUTO_ACKNOWLEDGE);
            Queue qc2s = ses.createQueue(QC2S);
            Queue qs2c = ses.createQueue(QS2C);
            QueueReceiver recv = ses.createReceiver(qc2s);
            QueueSender send = ses.createSender(qs2c);
            // loop indefinitely
            while(true) {
                // receive message and add to all messages
                TextMessage rmsg = (TextMessage)recv.receive();
                msgs.add(rmsg.getText().replaceAll("[\r\n]", ""));
                // send all messages
                StringBuilder sb = new StringBuilder();
                for(String msg : msgs) {
                    if(sb.length() > 0) sb.append("\r\n");
                    sb.append(msg);
                }
                Message smsg = ses.createTextMessage(sb.toString());
                send.send(smsg);
            }
        } catch (JMSException e) {
            e.printStackTrace();
        }
    }
    public static void main(String[] args) {
        Server srv = new Server();
        srv.run();
    }
}

Build:

$ javac -classpath activemq-all-5_4_3.jar Server.java

Run:

$ java -classpath .:activemq-all-5_4_3.jar "Server"

JMS API:

ActiveMQ comes with JMS provider.

Client:

import javax.jms.JMSException;
import javax.jms.Message;
import javax.jms.Queue;
import javax.jms.QueueConnection;
import javax.jms.QueueConnectionFactory;
import javax.jms.QueueReceiver;
import javax.jms.QueueSender;
import javax.jms.QueueSession;
import javax.jms.Session;
import javax.jms.TextMessage;

import org.apache.activemq.ActiveMQConnectionFactory;

public class P1 {
    private static final String SERVER = "tcp://arnepc4:61616";
    private static final String UN = "arne";
    private static final String PW = "topsecret";
    private static final String QC2S = "QC2S";
    private static final String QS2C = "QS2C";
    private void run() {
        try {
            // connect
            QueueConnectionFactory qcf = new ActiveMQConnectionFactory(SERVER);
            QueueConnection con = qcf.createQueueConnection(UN, PW);
            con.start();
            QueueSession ses = con.createQueueSession(false, Session.AUTO_ACKNOWLEDGE);
            Queue qc2s = ses.createQueue(QC2S);
            Queue qs2c = ses.createQueue(QS2C);
            QueueSender send = ses.createSender(qc2s);
            QueueReceiver recv = ses.createReceiver(qs2c);
            // send
            Message smsg = ses.createTextMessage("Hi from Java!");
            send.send(smsg);
            // receive
            TextMessage rmsg = (TextMessage)recv.receive();
            System.out.println("|" + rmsg.getText() + "|");
            recv.close();
            // disconnect
            send.close();
            ses.close();
            con.close();
        } catch (JMSException e) {
            e.printStackTrace();
        }
    }
    public static void main(String[] args) {
        P1 cli = new P1();
        cli.run();
    }
}

Build:

$ javac -classpath activemq-all-5_4_3.jar P1.java

Run:

$ java -classpath .:activemq-all-5_4_3.jar "P1"
from javax.jms import Session

from org.apache.activemq import ActiveMQConnectionFactory

SERVER = 'tcp://arnepc4:61616'
UN = 'arne'
PW = 'topsecret'
QC2S = 'QC2S'
QS2C = 'QS2C'
# connect
qcf = ActiveMQConnectionFactory(SERVER)
con = qcf.createQueueConnection(UN, PW)
con.start()
ses = con.createQueueSession(False, Session.AUTO_ACKNOWLEDGE)
qc2s = ses.createQueue(QC2S)
qs2c = ses.createQueue(QS2C)
send = ses.createSender(qc2s)
recv = ses.createReceiver(qs2c)
# send
smsg = ses.createTextMessage('Hi from Jython!')
send.send(smsg)
# receive
rmsg = recv.receive()
print('|' + rmsg.getText() + '|')
# disconnect
recv.close()
send.close()
ses.close()
con.close()

Run:

$ define/nolog jython_libs "activemq-all-5_4_3.jar"
$ jython p8.py

STOMP C library:

Several STOMP libraries exist for C. The most widely used is probably libstomp. But many years ago I found a very simple library "simple_stomp" that I like. It is available here - take the pstomp library.

Client:

#include <stdio.h>

#include "simple_stomp.h"

void print(char *msg)
{
   printf("%s\n", msg);
}

#define HOST "arnepc4"
#define PORT 61613
#define UN "arne"
#define PW "topsecret"
#define QC2S "/queue/QC2S"
#define QS2C "/queue/QS2C"

int main(int argc, char *argv[])
{
    simple_stomp_t ctx;
    char *smsg;
    char rmsg[10000];
    simple_stomp_debug(0);
    /* connect */
    simple_stomp_init(&ctx, HOST, PORT, print); /* authentication not supported */
    /* send */
    smsg = "Hi from C!";
    simple_stomp_write(&ctx, QC2S, smsg);
    /* receive */
    simple_stomp_read(&ctx, QS2C, rmsg);
    printf("|%s|", rmsg);
    /* disconnect */
    simple_stomp_close(&ctx);
    return 0;
}

Build:

$ cc/include=pstompdir p2
$ link p2 + pstompdir:simple_stomp

Run:

$ run p2

STOMP Python library:

Client:

import stomp
import sys

class MyListener(object):
    # receive
    def on_message(self, headers, message):
        print('|' + message + '|')

HOST = 'arnepc4'
PORT = 61613
UN = 'arne'
PW = 'topsecret'
QC2S = '/queue/QC2S'
QS2C = '/queue/QS2C'

# connect
con = stomp.Connection([(HOST, PORT)])
con.set_listener('', MyListener())
con.start()
con.connect(UN, PW)
con.subscribe(destination=QS2C, id=0, ack='auto')
# send
smsg = 'Hi from Python!'
con.send(QC2S, smsg, headers={ "amq-msg-type" : "text" })
# wait
print('Press enter to exit')
sys.stdin.read(1)
# disconnect
con.disconnect()

Run:

$ python p7.py

Wrapper C STOMP library:

I have created a little VMS friendly wrapper around simple_stomp C library. It is available here - take the pstomp library.

Client:

      program p3
      implicit none
      integer* 4 port
      character*32 host,un,pw,qc2s,qs2c
      parameter (host='arnepc4',
     +           port=61613,
     +           un='arne',
     +           pw='topsecret',
     +           qc2s='QC2S',
     +           qs2c='QS2C')
      integer*4 ctx(2),msglen
      character*100 smsg
      character*10000 rmsg
      call vms_simple_stomp_debug(0)
c  connect
      call vms_simple_stomp_init(ctx, host, port)
c  send
      smsg='Hi from Fortran!'
      call vms_simple_stomp_write(ctx, qc2s, smsg);
c  receive
      call vms_simple_stomp_read(ctx, qs2c, rmsg, msglen);
      write(*,*) '|'//rmsg(1:msglen)//'|'
c  disconnect
      call vms_simple_stomp_close(ctx)
      end

p3.com:

$ for p3
$ link p3 + pstompdir:vms_simple_stomp + pstompdir:simple_stomp

Run:

$ run p3
[inherit('pstompdir:pstomp')]
program p4(input,output);

const
   host = 'arnepc4';
   port = 61613;
   un = 'arne';
   pw = 'topsecret';
   qc2s = 'QC2S';
   qs2c = 'QS2C';

var
   ctx : stomp_ctx;
   smsg, rmsg : pstr;
   msglen : integer;

begin
   stomp_debug(0);
   (* connect *)
   stomp_init(ctx, host, port);
   (* send *)
   smsg := 'Hi from Pascal!';
   stomp_write(ctx, qc2s, fix(smsg));
   (* receive *)
   stomp_read(ctx, qs2c, rmsg.body, msglen);
   rmsg.length := msglen;
   writeln('|' + rmsg + '|');
   (* disconnect *)
   stomp_close(ctx);
end.

p4.com:

$ pas p4
$ link p4 + pstompdir:pstomp + pstompdir:vms_simple_stomp + pstompdir:simple_stomp

Run:

$ run p4
identification division.
program-id.p5.
*
data division.
working-storage section.
01  nodbg   pic s9(9) comp value 0.
01  ctx.
    03  dummy   pic s9(9) comp occurs 2 times.
01  host    pic x(32) value "arnepc4".
01  port    pic s9(9) comp value 61613.
01  qc2s    pic x(4) value "QC2S".
01  qs2c    pic x(4) value "QS2C".
01  smsg    pic x(100).
01  rmsg    pic x(10000).
01  msglen  pic s9(9) comp.
*
procedure division.
main-paragraph.
    call "VMS_SIMPLE_STOMP_DEBUG"
        using
            by reference nodbg
    end-call
* connect
    call "VMS_SIMPLE_STOMP_INIT"
        using
            by reference ctx
            by descriptor host
            by reference port
    end-call
* send
    move "Hi from Cobol!" to smsg
    call "VMS_SIMPLE_STOMP_WRITE"
        using
           by reference ctx
           by descriptor qc2s
           by descriptor smsg
    end-call.
* receive
    call "VMS_SIMPLE_STOMP_READ"
        using
           by reference ctx
           by descriptor qs2c
           by descriptor rmsg
           by reference msglen
    end-call.
    display "|" rmsg(1:msglen) "|"
* disconnect
    call "VMS_SIMPLE_STOMP_CLOSE"
        using
            by reference ctx
    end-call
    stop run.

Build:

$ cob p5
$ link p5 + pstompdir:vms_simple_stomp + pstompdir:simple_stomp

Run:

$ run p5
program p6

option type = explicit

declare string constant host = "arnepc4"
declare integer constant port = 61613
declare string constant un = "arne"
declare string constant pw = "topsecret"
declare string constant qc2s = "QC2S"
declare string constant qs2c = "QS2C"

declare integer ctx(1), msglen
declare string smsg
map (rmsg) string rmsg = 1000

external sub vms_simple_stomp_debug(integer)
external sub vms_simple_stomp_init(integer dim(), string, integer)
external sub vms_simple_stomp_write(integer dim(), string, string)
external sub vms_simple_stomp_read(integer dim(), string, string, integer)
external sub vms_simple_stomp_close(integer dim())

call vms_simple_stomp_debug(0)
! connect
call vms_simple_stomp_init(ctx(), host, port)
! send
smsg = "Hi from Basic!"
call vms_simple_stomp_write(ctx(), qc2s, smsg)
! receive
call vms_simple_stomp_read(ctx(), qs2c, rmsg, msglen)
print "|" + mid(rmsg, 1, msglen) + "|"
! disconnect
call vms_simple_stomp_close(ctx())

end program

Build:

$ bas p6
$ link p6 + pstompdir:vms_simple_stomp + pstompdir:simple_stomp

Run:

$ run p6

Index Sequential File:

Concept:

Index-sequential files is a feature of RMS on VMS. They are generally known as ISAM files and are really a NoSQL database of the key value store type.

ISAM model
Access Database based
Supported languages Any language able to call RMS functions or a wrapper around RMS functions
Persistence Yes
Scope Any process in system/cluster with access to file
Concurrency Language libraries and RMS provide locking (based on VMS DLM) that can be used to synchronize access
Security Only local access, but not builtin encryption support

VMS index-sequential files are covered in NoSQL - Key Value Store and there are also examples in VMS Tech Demo 3 - from index-sequential file to SQLite database and VMS: Index-sequential file vs relational database.

Demo:

We will use an init program to define index-sequentil file.

Clients will open file, write a message and dump all messages.

Pascal, Cobol, Basic and Fortran has builtin language support.

C call RMS functions directly.

VMS Python has an IndexedFile module for access.

Java and Jython will use a custom wrapper.

ISAM stack

Init (create file):

program init(input, output);

const
   maxmsgsiz = 100;

type
   msgtyp = packed array [1..maxmsgsiz] of char;
   msgrectyp = packed record
                  id : [key(0,duplicates),aligned(2)] integer;
                  msg : msgtyp;
               end;
   msgfiltyp = file of msgrectyp;

var
   db : msgfiltyp; (* has to be global *)

begin
   open(db, 'msgs.isq', new, organization := indexed, access_method := keyed);
   close(db);
end.

Build:

$ pas init
$ link init

run:

$ run init

Language builtin:

Some languages has builtin support for index-sequential files and that is a big plus as it results in significant less and more readable code than RMS calls.

Client:

program p1(input, output);

const
   maxmsgsiz = 100;

type
   msgtyp = packed array [1..maxmsgsiz] of char;
   msgrectyp = packed record
                  id : [key(0,duplicates),aligned(2)] integer;
                  msg : msgtyp;
               end;
   msgfiltyp = file of msgrectyp;

var
   db : msgfiltyp; (* has to be global *)
   msg : msgrectyp;

begin
   (* open database *)
   open(db, 'msgs.isq', old, organization := indexed, access_method := keyed);
   (* write message to database *)
   msg.id := 1;
   msg.msg := 'Hi from Pascal!';
   db^ := msg;
   put(db);
   (* dump all messages in database *)
   resetk(db, 0);
   while not eof(db) do begin
      msg := db^;
      writeln('|' + msg.msg + '|');
      get(db);
   end;
   (* close database *)
   close(db);
end.

Build:

$ pas p1
$ link p1

Run:

$ run p1
identification division.
program-id. p2.
*
environment division.
input-output section.
file-control.
    select optional msg-file assign to "msgs.isq" organization is indexed access mode is dynamic record key is msg-id with duplicates.
*
data division.
file section.
fd msg-file.
01 msg-record.
    03 msg-id pic s9(9) comp.
    03 msg-msg pic x(100).
working-storage section.
01 eof-flag pic x.
*
procedure division.
main-paragraph.
* open database
    open i-o msg-file
* write message to database
    move 2 to msg-id
    move "Hi from Cobol!" to msg-msg
    write msg-record
        invalid key display "error writing"
        not invalid key continue
    end-write
* dump all messages in database
    move 0 to msg-id
    start msg-file key is greater than msg-id
        invalid key display "error rewinding"
        not invalid key continue
    end-start
    move 'n' to eof-flag
    perform until eof-flag = 'y'
        read msg-file next
            at end move 'y' to eof-flag
            not at end display "|" msg-msg "|"
        end-read
    end-perform
* close database
    close msg-file
    stop run.

Build:

$ cob p2
$ link p2

Run:

$ run p2
program p3

option type = explicit

record msgrectyp
    integer id
    string msg = 100
end record
map (msgrec) msgrectyp msg

! open database
open "msgs.isq" as file #1, indexed fixed, recordtype none, map msgrec, primary key msg::id duplicates
! write message to database
msg::id = 3
msg::msg = "Hi from Basic!"
put #1
! dump all messages in database
reset #1
handler eof_handler
end handler
when error use eof_handler
    while 1 = 1
        get #1
        print using "'E", "|" + msg::msg + "|"
    next
end when
! close database
close #1

end program

Build:

$ bas p3
$ link p3

Run:

$ run p3
      program p4
      implicit none
      integer*4 db
      parameter (db=21)
      structure /msgrectyp/
        integer*4 id
        character*100 msg
      end structure
      record /msgrectyp/msg
c  silly hack to avoid breaking lines over 80 characters
      open(unit=6,file='sys$output',status='new',recl=132) 
c  open database
      open(unit=db,file='msgs.isq',status='old',
     +     recordtype='fixed',form='unformatted',recl=26,
     +     organization='indexed',access='keyed',key=(1:4:integer))
c  write message to database
      msg.id=4
      msg.msg='Hi from Fortran!'
      write(unit=db) msg
c  dump all messages in database
      read(unit=db,keyge=0,keyid=0,err=200) msg
100   write(6,*) '|'//msg.msg//'|'
      read(unit=db,end=200) msg
      goto 100
200   continue
c  close database
      close(unit=db)
      end

Build:

$ for p4
$ link p4

Run:

$ run p4
$! open database for keyed read and write
$ open/read/write db msgs.isq
$! write message to database
$ id[0,32] = 9
$ msg = "Hi from DCL!"
$ msg = msg + f$extract(0, 100 - f$length(msg), "                                                                                                    ")
$ rec = id + msg
$ write db rec
$! close database
$ close db
$! open database for sequential read
$ open/read db msgs.isq
$! dump all messages in database
$ loop:
$    read/error=endloop db rec
$    msg = f$extraxt(4, f$length(rec) - 4, rec)
$    write sys$output "|" + msg + "|"
$    goto loop
$ endloop:
$! close database
$ close db
$ exit

Run:

$ @p9

RMS API:

Client:

#include <stdio.h>
#include <string.h>
#include <stdlib.h>

#include <starlet.h>
#include <rms.h>

#pragma member_alignment save
#pragma nomember_alignment
#define MAXMSGSIZ 100
struct MsgRec
{
    int id;
    char msg[MAXMSGSIZ];
};
#define RECSIZ sizeof(struct MsgRec)
#pragma member_alignment restore

#define FNM "msgs.isq"

int main()
{
    int stat, i;
    char buf[MAXMSGSIZ + 1];
    struct FAB fab;
    struct RAB rab;
    struct XABKEY xab;
    struct MsgRec msg;
    /* open database */
    fab = cc$rms_fab;
    fab.fab$l_fna = FNM;
    fab.fab$b_fns = strlen(FNM);
    fab.fab$b_org = FAB$C_IDX;
    fab.fab$b_rfm = FAB$C_FIX;
    fab.fab$w_mrs = RECSIZ;
    fab.fab$b_fac = FAB$M_GET | FAB$M_PUT | FAB$M_UPD | FAB$M_DEL;
    fab.fab$l_xab = (char *)&xab;
    xab = cc$rms_xabkey;
    xab.xab$b_flg = XAB$M_DUP;
    xab.xab$b_dtp = XAB$C_IN4;
    xab.xab$w_pos0 = 0;
    xab.xab$b_ref = 0;
    xab.xab$b_siz0 = sizeof(int);
    stat = sys$open(&fab, 0, 0);
    if((stat & 1) == 0) printf("sys$open stat = %d\n", stat);
    fab.fab$l_xab = 0;
    rab = cc$rms_rab;
    rab.rab$l_fab = &fab;
    rab.rab$b_rac = RAB$C_KEY;
    stat = sys$connect(&rab, 0 ,0);
    if((stat & 1) == 0) printf("sys$connect stat = %d\n", stat);
    /* write message to database */
    msg.id = 5;
    strcpy(msg.msg, "Hi from C");
    for(i = strlen(msg.msg); i < sizeof(msg.msg); i++) msg.msg[i] = ' '; /* manual padding necessary */
    rab.rab$l_rbf = (char *)&msg.id;
    rab.rab$w_rsz = RECSIZ;
    stat = sys$put(&rab, 0, 0);
    if((stat & 1) == 0) printf("sys$put stat = %d\n", stat);
    /* dump all messages in database */
    rab.rab$b_rac = RAB$C_SEQ;
    for(;;)
    {
        rab.rab$l_kbf = 0;
        rab.rab$b_ksz = 0;
        rab.rab$b_krf = 0;
        rab.rab$l_rop = 0;
        rab.rab$l_ubf = (char *)&msg.id;
        rab.rab$w_usz = RECSIZ;
        stat = sys$get(&rab, 0, 0);
        if((stat & 1) ==0) break;
        memcpy(buf, msg.msg, MAXMSGSIZ); /* handle missing nul termination */
        buf[MAXMSGSIZ] = 0;
        printf("|%s|\n", buf);
    }
    /* close database */
    stat = sys$disconnect(&rab, 0, 0);
    if((stat & 1) == 0) printf("sys$disconnect stat = %d\n", stat);
    stat = sys$close(&fab, 0, 0);
    if((stat & 1) == 0) printf("sys$close stat = %d\n", stat);
    return 0;
}

Build:

$ cc p5
$ link p5

Run:

$ run p5

VMS Python IndexedFile:

VMS Python comes with an IndexedFile module that uses RMS.

from construct import *
from vms.rms.IndexedFile import IndexedFile

class MsgRec:
    def __init__(self, id, msg):
        self.id = id
        self.msg = msg

class MsgFil(IndexedFile):
    def __init__(self, fnm):
        IndexedFile.__init__(self, fnm, Struct('msgrec', SNInt32('id'), String('msg', 100, padchar=' ')))
    def primary_keynum(self):
        return 0

# open database
db = MsgFil('msgs.isq')
# write message to database
db.put(MsgRec(6, 'Hi from Python!'))
# dump all messages in database
for msg in db:
    print('|' + msg.msg + '|')

Run:

$ python p6.py

JVM ISAM library:

As a non-native context JVM languages cannot call RMS directly. But I have created an ISAM library that allows JVM language access (using JNI). The library is available here.

Client:

import dk.vajhoej.isam.IsamException;
import dk.vajhoej.isam.IsamResult;
import dk.vajhoej.isam.IsamSource;
import dk.vajhoej.isam.Key0;
import dk.vajhoej.isam.local.LocalIsamSource;
import dk.vajhoej.record.RecordException;

public class P7 {
    public static void main(String[] args) throws IsamException, RecordException {
        try {
            // open database
            IsamSource db = new LocalIsamSource("msgs.isq", "dk.vajhoej.vms.rms.IndexSequential", false);
            // write message to database
            db.create(new MsgRec(7, "Hi from Java!"));
            // dump all messages in database
            IsamResult<MsgRec> it = db.readGE(MsgRec.class, new Key0<Integer>(0));
            while(it.read()) {
                MsgRec msg = it.current();
                System.out.println("|" + msg.getMsg() + "|");
            }
            // close database
            db.close();
        } catch (Exception ex) {
            ex.printStackTrace();
        }
    }
}

Build:

$ javac -classpath isam.jar:record.jar P7.java MsgRec.java

Run:

$ java -classpath .:isam.jar:isam-vms.jar:record.jar "P7"
from dk.vajhoej.isam import Key0
from dk.vajhoej.isam.local import LocalIsamSource

import MsgRec

# open database
db = LocalIsamSource('msgs.isq', 'dk.vajhoej.vms.rms.IndexSequential', False)
# write message to database
db.create(MsgRec(8, 'Hi from Jython!'))
# dump all messages in database
it = db.readGE(MsgRec, Key0(0))
while it.read():
    msg = it.current()
    print('|' + msg.msg + '|')
# close database
db.close()

Run:

$ define/nolog jython_libs "isam.jar:isam-vms.jar:record.jar"
$ jython p8.py

SQLite Database:

Concept:

Relational databases are widely used today and SQLite is probably the most common embedded relational database.

Usage is traditional embedded dataabase.

SQLite model
Access Database based
Supported languages Any language with a SQLite library or wrapper around SQLite library
Persistence Yes
Scope Any process in system/cluster with access to file
Concurrency SQLite supports traditional relational database transaction isolation level based on locking (based on VMS DLM) that can be used to synchronize access
Security Only local access, but not builtin encryption support (extensions available though)

Use of SQLite on VMS are covered in Access VMS database - native databases and there are also examples in VMS Tech Demo 3 - from index-sequential file to SQLite database and VMS: Index-sequential file vs relational database.

Demo:

We will use an init script to define the database structure.

Clients will open database, write a message and dump all messages.

C will use SQLite C API.

Python will use Python sqlite3 module.

Java will use SQLite JDBC driver and optionally JPA provider.

Pascal will use wrapper around SQLite C API.

SQLite stack

Init (define table):

CREATE TABLE msgs (
    id INTEGER PRIMARY KEY AUTOINCREMENT,
    msg VARCHAR(100)
);

Run:

$ pipe sqlite msgs.db < init.sql

C API:

Client:

#include <stdio.h>
#include <string.h>
#include <stdlib.h>

#include "sqlite3.h"

int main()
{
    sqlite3 *con;
    sqlite3_stmt *ins, *sel;
    char *insstr = "INSERT INTO msgs (msg) VALUES(?)";
    char *selstr = "SELECT msg FROM msgs";
    char *msg = "Hi from C!";
    int stat;
    /* open database */
    stat = sqlite3_open("msgs.db", &con);
    if(stat) printf("Error in open: %s\n",  sqlite3_errmsg(con));
    /* write message to database */
    stat = sqlite3_prepare(con, insstr, strlen(insstr), &ins, NULL);
    if(stat) printf("Error in prepare: %s\n",  sqlite3_errmsg(con));
    sqlite3_bind_text(ins, 1, msg, strlen(msg), NULL);
    stat = sqlite3_step(ins);
    sqlite3_finalize(ins);
    /* dump all messages in database */
    stat = sqlite3_prepare(con, selstr, strlen(selstr), &sel, NULL);
    if(stat) printf("Error in prepare: %s\n",  sqlite3_errmsg(con));
    while(sqlite3_step(sel) == SQLITE_ROW)
    {
        printf("|%s|\n", sqlite3_column_text(sel, 0));
    }
    sqlite3_finalize(sel);
    /* close database */
    sqlite3_close(con);
    return 0;
}

p1.com:

$ cc/include=sqlite3_include: p1.c
$ link p1 + sys$input/opt
sqlite3shr/share
$

Run:

$ run p1

Python API:

Client:

import sqlite3

# open database
con = sqlite3.connect('msgs.db')
# write message to database
c = con.cursor()
c.execute('INSERT INTO msgs (msg) VALUES (?)', ('Hi from Python!', ))
con.commit()
# dump all messages in database
c = con.cursor()
c.execute('SELECT msg FROM msgs')
for row in c.fetchall():
    print('|' + row[0] + '|')
# close database
con.close()

Run:

$ python p2.py
from com.ziclix.python.sql import zxJDBC

# open database
con = zxJDBC.connect('jdbc:sqlite:msgs.db', None, None, 'org.sqlite.JDBC')
# write message to database
c = con.cursor()
c.execute('INSERT INTO msgs (msg) VALUES (?)', ('Hi from Jython!', ))
con.commit()
# dump all messages in database
c = con.cursor()
c.execute('SELECT msg FROM msgs')
for row in c.fetchall():
    print('|' + row[0] + '|')
# close database
con.close()

Run:

$ define/nolog java$filename_controls 8
$ define/nolog decc$efs_charset true
$ define/nolog jython_libs "zxjdbc.jar:sqlite-jdbc-3_14_1-vms.jar"
$ jython p4.py

Note that even though Jython use SQLite JDBC driver like Java, then it uses standard DB API 2.0 via the zxJDBC module.

PDO API:

PHP has a sqlite3 extension, but SQLite can also be accessed via PDO, which will be used here.

Client:

<?php

// open database
$con = new PDO('sqlite:/disk2/arne/ipc/sqlite/msgs.db');
$con->setAttribute(PDO::ATTR_ERRMODE, PDO::ERRMODE_EXCEPTION);
$con->setAttribute(PDO::ATTR_DEFAULT_FETCH_MODE, PDO::FETCH_ASSOC);
// write message to database
$ins = $con->prepare('INSERT INTO msgs(msg) VALUES(:msg)');
$ins->execute(array(':msg' => 'Hi from PHP!'));
// dump all messages in database
$sel = $con->prepare('SELECT msg FROM msgs');
$sel->execute(array());
while($row = $sel->fetch()) {
    $msg = $row['msg'];
    echo "|$msg|\r\n";
}

?>
$ php p9.php

JDBC API:

JDBC is a Java standard for database access.

JDBC is covered here.

The VMS SQLite JDBC driver is available from vms2linux.de.

Client:

import java.sql.Connection;
import java.sql.DriverManager;
import java.sql.PreparedStatement;
import java.sql.ResultSet;
import java.sql.Statement;

public class P3 {
    public static void main(String[] args) throws Exception {
        // open database
        Class.forName("org.sqlite.JDBC");
        Connection con = DriverManager.getConnection("jdbc:sqlite:msgs.db");
        // write message to database
        PreparedStatement ins = con.prepareStatement("INSERT INTO msgs(msg) VALUES(?)");
        ins.setString(1, "Hi from Java!");
        ins.executeUpdate();
        ins.close();
        // dump all messages in database
        Statement sel = con.createStatement();
        ResultSet rs = sel.executeQuery("SELECT msg FROM msgs");
        while(rs.next()) {
            System.out.println(rs.getString(1));
        }
        rs.close();
        sel.close();
        // clsoe database
        con.close();
    }
}

Build:

$ javac P3.java

Run:

$ define/nolog java$filename_controls 8
$ define/nolog decc$efs_charset true
$ java -cp .:sqlite-jdbc-3_14_1-vms.jar "P3"

JPA API:

JPA is a Java standard for ORM.

JPA is covered here.

In this example we will use Hibernate as JPA provider.

META-INF/persistence.xml:

<persistence xmlns="http://java.sun.com/xml/ns/persistence"
             xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
             xsi:schemaLocation="http://java.sun.com/xml/ns/persistence http://java.sun.com/xml/ns/persistence/persistence_2_0.xsd"
             version="2.0">
   <persistence-unit name="msgs">
      <provider>org.hibernate.ejb.HibernatePersistence</provider>
      <class>MsgRec</class>
      <exclude-unlisted-classes/>
      <properties>
          <!--<property name="show_sql" value="true"/>-->
          <property name="hibernate.connection.driver_class" value="org.sqlite.JDBC"/>
          <property name="hibernate.connection.url" value="jdbc:sqlite:msgs.db"/>
          <property name="hibernate.connection.username" value=""/>
          <property name="hibernate.connection.password" value=""/>
          <property name="hibernate.dialect" value="org.hibernate.dialect.SQLiteDialect"/>
      </properties>
   </persistence-unit>
</persistence>

MsgRec.java:

import javax.persistence.Column;
import javax.persistence.Entity;
import javax.persistence.GeneratedValue;
import javax.persistence.GenerationType;
import javax.persistence.Id;
import javax.persistence.Table;

@Entity
@Table(name="msgs")
public class MsgRec {
    private int id;
    private String msg;
    public MsgRec() {
        this("");
    }
    public MsgRec(String msg) {
        this.msg = msg;
    }
    @Id
    @GeneratedValue(strategy = GenerationType.IDENTITY)
    @Column(name="id")
    public int getId() {
        return id;
    }
    public void setId(int id) {
        this.id = id;
    }
    @Column(name="msg")
    public String getMsg() {
        return msg;
    }
    public void setMsg(String msg) {
        this.msg = msg;
    }
}

Client:

import java.util.logging.Level;
import java.util.logging.Logger;

import javax.persistence.EntityManager;
import javax.persistence.EntityManagerFactory;
import javax.persistence.Persistence;
import javax.persistence.TypedQuery;

public class P3E {
    public static void main(String[] args) throws Exception {
        // silence logger
        Logger.getLogger("org.hibernate").setLevel(Level.OFF);
        // open database
        EntityManagerFactory emf = Persistence.createEntityManagerFactory("msgs");
        EntityManager em = emf.createEntityManager();
        // write message to database
        em.getTransaction().begin();
        em.persist(new MsgRec("Hi from Java/JPA!"));
        em.getTransaction().commit();
        // dump all messages in database
        TypedQuery<MsgRec> q = em.createQuery("SELECT o FROM MsgRec AS o", MsgRec.class);
        for(MsgRec o : q.getResultList()) {
            System.out.println("|" + o.getMsg() + "|");
        }
        // close database
        em.close();
        emf.close();
    }
}

Build:

$ hibpath = "antlr-2_7_6.jar:cglib-2_2.jar:commons-collections-3_1.jar:dom4j-1_6_1.jar:hibernate-jpa-2_0-api-1_0_0_final.jar:hibernate3.jar:javassist-3_12_0_ga.jar:jta-1_1.jar:slf4j-api-1_6_1.jar:slf4j-jdk14-1_6_1.jar"
$ javac -cp 'hibpath' P3E.java MsgRec.java

Run:

$ define/nolog java$filename_controls 8
$ define/nolog decc$efs_charset true
$ hibpath = "antlr-2_7_6.jar:cglib-2_2.jar:commons-collections-3_1.jar:dom4j-1_6_1.jar:hibernate-jpa-2_0-api-1_0_0_final.jar:hibernate3.jar:javassist-3_12_0_ga.jar:jta-1_1.jar:slf4j-api-1_6_1.jar:slf4j-jdk14-1_6_1.jar"
$ java -cp .:'hibpath':sqlite-jdbc-3_14_1-vms.jar:sqlitehib.jar "P3E"
from java.util.logging import Level
from java.util.logging import Logger
from javax.persistence import Persistence

import MsgRec

# silence logger
Logger.getLogger("org.hibernate").setLevel(Level.OFF)
# open database
emf = Persistence.createEntityManagerFactory("msgs")
em = emf.createEntityManager()
# write message to database
em.getTransaction().begin()
em.persist(MsgRec("Hi from Jython/JPA!"))
em.getTransaction().commit()
# dump all messages in database
q = em.createQuery("SELECT o FROM MsgRec AS o", MsgRec)
for o in q.getResultList():
    print(o.msg)
# close database
em.close()
emf.close()

Run:

$ define/nolog java$filename_controls 8
$ define/nolog decc$efs_charset true
$ hibpath = "antlr-2_7_6.jar:cglib-2_2.jar:commons-collections-3_1.jar:dom4j-1_6_1.jar:hibernate-jpa-2_0-api-1_0_0_final.jar:hibernate3.jar:javassist-3_12_0_ga.jar:jta-1_1.jar:slf4j-api-1_6_1.jar:slf4j-jdk14-1_6_1.jar"
$ jython_libs_prefix = hibpath + ":"
$ define/nolog jython_libs "sqlite-jdbc-3_14_1-vms.jar:sqlitehib.jar"
$ jython p4e.py

Wrapper C API:

I have created a Pascal wrapper for SQLite C API - it is available here - take the psqlite library.

[inherit('psqlitedir:sqlite', 'psqlitedir:psqlite')]
program p5(input, output);

var
   con : sqlite_ptr;
   ins, sel : sqlite_stmt_ptr;

begin
   (* open database *)
   con := psqlite_open('msgs.db');
   (* write message to database *)
   ins := psqlite_prepare(con, 'INSERT INTO msgs(msg) VALUES(?)');
   psqlite_bind_text(ins, 1, 'Hi from Pascal!');
   psqlite_step_nonquery(ins);
   psqlite_finalize(ins);
   (* dump all message sin database *)
   sel := psqlite_prepare(con, 'SELECT msg FROM msgs');
   while psqlite_step_query(sel) do begin
      writeln('|' + psqlite_column_text(sel, 0) + '|');
   end;
   psqlite_finalize(sel);
   (* close database *)
   psqlite_close(con);
end.

Build:

$ pas p5
$ link p5 + sys$input/opt + psqlitedir:sqlite/opt
psqlitedir:psqlite
psqlitedir:sqlite
$

Run:

$ run p5

MySQL Database:

Concept:

Relational databases are widely used today and MySQL is one of the most common relational database servers.

Usage is traditional server database.

MySQL model
Access Database based
Supported languages Any language with a MySQL library or wrapper around MySQL library
Persistence Yes
Scope Any process in any networked system
Concurrency MySQL supports traditional relational database transaction isolation level
Security Authentication required and encryption supported

Use of MySQL on VMS are covered in Access VMS database - native databases.

Demo:

We will use an init script to define the database structure.

Clients will open database, write a message and dump all messages.

C will use MySQL C API (libmysql).

Java will use MySQL JDBC driver and optionally JPA provider.

Pascal will use wrapper around MySQL C API.

MySQL stack

Init (define table):

USE test;
CREATE TABLE msgs (
    id INTEGER PRIMARY KEY AUTO_INCREMENT,
    msg VARCHAR(100)
);

Run:

$ pipe mysql -h localhost -u root < init.sql

C API:

Client:

#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#define SOCKET int
#include <mysql.h>

int main()
{
    MYSQL *con;
    MYSQL_STMT *stmt;
    MYSQL_BIND in[1];
    MYSQL_BIND out[1];
    char *insstr = "INSERT INTO msgs (msg) VALUES(?)";
    char *selstr = "SELECT msg FROM msgs";
    char *msg = "Hi from C!";
    char msgbuf[100];
    unsigned long msglen;
    int stat;
    /* connect to database */
    con = mysql_init(NULL);
    con = mysql_real_connect(con, "localhost", "root", "", "test", 3306, NULL, 0);
    /* write message to database */
    stmt = mysql_stmt_init(con);
    stat = mysql_stmt_prepare(stmt, insstr, strlen(insstr));
    if(stat != 0) printf("Connection error: %s\n", mysql_error(con));
    memset(in, 0, sizeof(in));
    in[0].buffer_type = MYSQL_TYPE_STRING;
    in[0].buffer = msg;
    in[0].buffer_length = strlen(msg);
    in[0].is_null = 0;
    stat = mysql_stmt_bind_param(stmt, in);
    if(stat != 0) printf("Statement error: %s\n", mysql_stmt_error(stmt));
    stat = mysql_stmt_execute(stmt);
    if(stat != 0) printf("Statement error: %s\n", mysql_stmt_error(stmt));
    /* dump all messages in database */
    stmt = mysql_stmt_init(con);
    stat = mysql_stmt_prepare(stmt, selstr, strlen(selstr));
    if(stat != 0) printf("Connection error: %s\n", mysql_error(con));
    stat = mysql_stmt_execute(stmt);
    if(stat != 0) printf("Statement error: %s\n", mysql_stmt_error(stmt));
    memset(out, 0, sizeof(out));
    out[0].buffer_type = MYSQL_TYPE_STRING;
    out[0].buffer = msgbuf;
    out[0].buffer_length = sizeof(msgbuf);
    out[0].length = &msglen;
    stat = mysql_stmt_bind_result(stmt, out);
    if(stat != 0) printf("Statement error: %s\n", mysql_stmt_error(stmt));
    stat = mysql_stmt_store_result(stmt);
    if(stat != 0) printf("Statement error: %s\n", mysql_stmt_error(stmt));
    while(!mysql_stmt_fetch(stmt))
    {
        msgbuf[msglen] = 0;
        printf("|%s|\n", msgbuf);
    }
    mysql_stmt_free_result(stmt);
    /* close database */
    mysql_close(con);
    return 0;
}

p1.com:

$ cc /include=mysql055_root:[include.mysql] /names=as_is p1.c
$ link p1 + sys$input/opt
mysql055_root:[lib.alpha]libclientlib/lib
mysql055_root:[lib.alpha]libsql/lib
mysql055_root:[lib.alpha]libmysys/lib
mysql055_root:[lib.alpha]libdbug/lib
mysql055_root:[lib.alpha]libstrings/lib
mysql055_root:[lib.alpha]libvio/lib
mysql055_root:[lib.alpha]libz/lib
mysql055_root:[lib.alpha]ssl_libssl32/lib
mysql055_root:[lib.alpha]ssl_libcrypto32/lib
$

Run:

$ run p1

PDO API:

PHP has a mysqli extension, but MySQL can also be accessed via PDO, which will be used here.

Client:

p9.php:

<?php

// open database
$con = new PDO('mysql:host=localhost;dbname=test', 'root', '');
$con->setAttribute(PDO::ATTR_ERRMODE, PDO::ERRMODE_EXCEPTION);
$con->setAttribute(PDO::ATTR_DEFAULT_FETCH_MODE, PDO::FETCH_ASSOC);
// write message to database
$ins = $con->prepare('INSERT INTO msgs(msg) VALUES(:msg)');
$ins->execute(array(':msg' => 'Hi from PHP!'));
// dump all messages in database
$sel = $con->prepare('SELECT msg FROM msgs');
$sel->execute(array());
while($row = $sel->fetch()) {
    $msg = $row['msg'];
    echo "|$msg|\r\n";
}

?>
$ php p9.php

JDBC API:

JDBC is a Java standard for database access.

JDBC is covered here.

Client:

import java.sql.Connection;
import java.sql.DriverManager;
import java.sql.PreparedStatement;
import java.sql.ResultSet;
import java.sql.Statement;

public class P3 {
    public static void main(String[] args) throws Exception {
        // open database
        Class.forName("com.mysql.jdbc.Driver");
        Connection con = DriverManager.getConnection("jdbc:mysql://localhost/test", "root", "");
        // write message to database
        PreparedStatement ins = con.prepareStatement("INSERT INTO msgs(msg) VALUES(?)");
        ins.setString(1, "Hi from Java!");
        ins.executeUpdate();
        ins.close();
        // dump all messages in database
        Statement sel = con.createStatement();
        ResultSet rs = sel.executeQuery("SELECT msg FROM msgs");
        while(rs.next()) {
            System.out.println(rs.getString(1));
        }
        rs.close();
        sel.close();
        // clsoe database
        con.close();
    }
}

Build:

$ javac P3.java

Run:

$ java -cp .:/javalib/mysql-connector-java-5_1_36-bin.jar "P3"

JPA API:

JPA is a Java standard for ORM.

JPA is covered here.

In this example we will use Hibernate as JPA provider.

META-INF/persistence.xml:

<persistence xmlns="http://java.sun.com/xml/ns/persistence"
             xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
             xsi:schemaLocation="http://java.sun.com/xml/ns/persistence http://java.sun.com/xml/ns/persistence/persistence_2_0.xsd"
             version="2.0">
   <persistence-unit name="msgs">
      <provider>org.hibernate.ejb.HibernatePersistence</provider>
      <class>MsgRec</class>
      <exclude-unlisted-classes/>
      <properties>
          <!--<property name="show_sql" value="true"/>-->
          <property name="hibernate.connection.driver_class" value="com.mysql.jdbc.Driver"/>
          <property name="hibernate.connection.url" value="jdbc:mysql://localhost/test"/>
          <property name="hibernate.connection.username" value="root"/>
          <property name="hibernate.connection.password" value=""/>
      </properties>
   </persistence-unit>
</persistence>

MsgRec.java:

import javax.persistence.Column;
import javax.persistence.Entity;
import javax.persistence.GeneratedValue;
import javax.persistence.GenerationType;
import javax.persistence.Id;
import javax.persistence.Table;

@Entity
@Table(name="msgs")
public class MsgRec {
    private int id;
    private String msg;
    public MsgRec() {
        this("");
    }
    public MsgRec(String msg) {
        this.msg = msg;
    }
    @Id
    @GeneratedValue(strategy = GenerationType.IDENTITY)
    @Column(name="id")
    public int getId() {
        return id;
    }
    public void setId(int id) {
        this.id = id;
    }
    @Column(name="msg")
    public String getMsg() {
        return msg;
    }
    public void setMsg(String msg) {
        this.msg = msg;
    }
}

Client:

import java.util.logging.Level;
import java.util.logging.Logger;

import javax.persistence.EntityManager;
import javax.persistence.EntityManagerFactory;
import javax.persistence.Persistence;
import javax.persistence.TypedQuery;

public class P3E {
    public static void main(String[] args) throws Exception {
        // silence logger
        Logger.getLogger("org.hibernate").setLevel(Level.OFF);
        // open database
        EntityManagerFactory emf = Persistence.createEntityManagerFactory("msgs");
        EntityManager em = emf.createEntityManager();
        // write message to database
        em.getTransaction().begin();
        em.persist(new MsgRec("Hi from Java/JPA!"));
        em.getTransaction().commit();
        // dump all messages in database
        TypedQuery<MsgRec> q = em.createQuery("SELECT o FROM MsgRec AS o", MsgRec.class);
        for(MsgRec o : q.getResultList()) {
            System.out.println("|" + o.getMsg() + "|");
        }
        // close database
        em.close();
        emf.close();
    }
}

Build:

$ hibpath = "/javalib/antlr-2_7_6.jar:/javalib/cglib-2_2.jar:/javalib/commons-collections-3_1.jar:/javalib/dom4j-1_6_1.jar:/javalib/hibernate-jpa-2_0-api-1_0_0_final.jar:/javalib/hibernate3.jar:/javalib/javassist-3_12_0_ga.jar:/javalib/jta-1_1.jar:/javalib/slf4j-api-1_6_1.jar:/javalib/slf4j-jdk14-1_6_1.jar"
$ javac -cp 'hibpath' P3E.java MsgRec.java

Run:

$ hibpath = "/javalib/antlr-2_7_6.jar:/javalib/cglib-2_2.jar:/javalib/commons-collections-3_1.jar:/javalib/dom4j-1_6_1.jar:/javalib/hibernate-jpa-2_0-api-1_0_0_final.jar:/javalib/hibernate3.jar:/javalib/javassist-3_12_0_ga.jar:/javalib/jta-1_1.jar:/javalib/slf4j-api-1_6_1.jar:/javalib/slf4j-jdk14-1_6_1.jar"
$ java -cp .:'hibpath':/javalib/mysql-connector-java-5_1_36-bin.jar "P3E"
from java.util.logging import Level
from java.util.logging import Logger
from javax.persistence import Persistence

import MsgRec

# silence logger
Logger.getLogger("org.hibernate").setLevel(Level.OFF)
# open database
emf = Persistence.createEntityManagerFactory("msgs")
em = emf.createEntityManager()
# write message to database
em.getTransaction().begin()
em.persist(MsgRec("Hi from Jython/JPA!"))
em.getTransaction().commit()
# dump all messages in database
q = em.createQuery("SELECT o FROM MsgRec AS o", MsgRec)
for o in q.getResultList():
    print(o.msg)
# close database
em.close()
emf.close()

Run:

$ hibpath = "/javalib/antlr-2_7_6.jar:/javalib/cglib-2_2.jar:/javalib/commons-collections-3_1.jar:/javalib/dom4j-1_6_1.jar:/javalib/hibernate-jpa-2_0-api-1_0_0_final.jar:/javalib/hibernate3.jar:/javalib/javassist-3_12_0_ga.jar:/javalib/jta-1_1.jar:/javalib/slf4j-api-1_6_1.jar:/javalib/slf4j-jdk14-1_6_1.jar"
$ jython_libs_prefix = hibpath + ":"
$ define/nolog jython_libs "/javalib/sqlite-jdbc-3_14_1-vms.jar:/javalib/mysql-connector-java-5_1_36-bin.jar"
$ jython p4e.py

Wrapper C API:

I have created a Pascal wrapper for SQLite C API - it is available here - take the pmysql library.

[inherit('pmysqldir:pmysql2', 'pmysqldir:pmysql', 'pmysqldir:mysql')]
program p5(input, output);

var
   con : mysql_ptr;
   ins, sel : mysql_stmt_ptr;
   inparam : array[1..1] of mysql_bind;
   msg : pstr;
   msgbuf : longpstr(255);
   stat : integer;

begin
   (* open database *)
   con := pmysql_init;
   con := pmysql_real_connect(con, 'localhost', 'root', '', 'test');
   (* write message to database *)
   ins := pmysql_prepare(con, 'INSERT INTO msgs(msg) VALUES(?)');
   if ins = 0 then writeln('Connection error: ' + pmysql_error(con));
   msg := 'Hi from Pascal!';
   pmysql_init_bind_string_in(inparam[1], msg);
   stat := pmysql_stmt_bind_param(ins, inparam);
   if stat <> 0 then writeln('Statement error: ' + pmysql_stmt_error(ins));
   stat := pmysql_stmt_execute(ins);
   if stat <> 0 then writeln('Statement error: ' + pmysql_stmt_error(ins));
   (* dump all messages in database *)
   sel := pmysql_prepare(con, 'SELECT msg FROM msgs');
   if sel = 0 then writeln('Connection error: ' + pmysql_error(con));
   stat := pmysql_get_result_start(sel, longstring_arg(msgbuf));
   if stat <> 0 then writeln('Statement error: ' + pmysql_stmt_error(sel));
   while pmysql_stmt_fetch(sel) = 0 do begin
      writeln('|' + stdstr(msgbuf) + '|');
   end;
   pmysql_stmt_free_result(sel);
   (* close database *)
   pmysql_close(con);
end.

Build:

$ define/nolog pmysqldir disk2:[arne.vmspascal.pmysql]
$ pascal p5
$ link p5 + sys$input/opt + pmysqldir:mysql55axp/opt
pmysqldir:pmysql2
pmysqldir:pmysql
pmysqldir:mysql
$

Run:

$ run p5

Redis Cache:

Concept:

Cache servers are really a form of in memory database.

One of the most common cache servers is Redis.

Redis is open source.

Redis is available for VMS from VSI.

Redis model
Access Database based
Supported languages Any language with a Redis client library or wrapper around Redis client library
Persistence Optional (default not enabled on VMS)
Scope Any process in any networked system
Concurrency Some features to handle concurrency (replace with check and atomic increment) but most concurrency handling is up to applications
Security Redis support SSL to encrypt network traffic
If persistence enabled securing database on disk is required

For more Redis examples see Distributed Cache.

Demo:

We will store messages in a given store under a given key.

The flow is standard open, put, get all and close.

The native languages will use the Hiredis client library that comes with VMS Redis.

The JVM languages will use the simple Jedis client (not the advanced Redisson client).

Python will use the redis module available via pip.

Redis stack

Hiredis:

Hiredis is a widely used C client library for Redis.

VMS Redis comes with hiredis.

Client:

#include <stdio.h>
#include <string.h>

#include "hiredis.h"

#define HOST "localhost"
#define PORT 6379
#define MSGS 10

int main(int argc, char *argv[])
{
    redisContext *cache;
    redisReply *reply, *reply2;
    char *key, *msg;
    int i;
    /* connect to cache */
    cache = redisConnect(HOST, PORT);
    reply = redisCommand(cache, "SELECT %d", MSGS);
    if (reply == NULL) printf("SELECT failed: %s\n", cache->errstr);
    freeReplyObject(reply);
    /* write message to cache */
    key = "C";
    msg = "Hi from C!";
    reply = redisCommand(cache, "SET %s %b", key, msg, strlen(msg));
    if (reply == NULL) printf("SET failed: %s\n", cache->errstr);
    freeReplyObject(reply);
    /* read all messages from cache */ 
    reply = redisCommand(cache, "KEYS *");
    if (reply == NULL) printf("KEYS failed: %s\n", cache->errstr);
    for(i = 0; i < reply->elements; i++)
    {
        reply2 = redisCommand(cache, "GET %s", reply->element[i]->str);
        if (reply2 == NULL) printf("GET failed: %s\n", cache->errstr);
        printf("|%s|\n", reply2->str);
        freeReplyObject(reply2);
    }
    freeReplyObject(reply);
    /* disconnect */
    redisFree(cache);   
    return 0;
}

Build:

$ cc/name=as_is/include=(sys$common:[redis.include],[]) p1
$ link p1 + sys$common:[redis.lib]libhiredis/libr + sys$common:[redis.lib]libredis/libr

On my system I had to create an empty alloc.h file in current directory to make it compile.

Run:

$ run p1

Official VMS wrapper hiredis:

VMS Redis also comes with a VMS friendly wrapper over hiredis for use by traditional VMS native languages.

I have not been able to find any documentation except the examples provided. And I definitely do not like how the API was VMSified - there are several things I would have done differently.

Client:

      program p2
      implicit none
      include 'sys$common:[redis.include]redisdef.for'
      integer*4 port,msgs
      character*32 host
      parameter (host='localhost',
     +           port=6379,
     +           msgs=10)
      integer*8 cache,reply,reply2
      character*32 key
      character*255 val
      integer*4 stat,n,i,keylen,vallen
c  connect to cache
      stat=redis$connect(%ref(cache),%descr(host),%val(port))
      if((stat.and.1).eq.0) write(*,*) 'redis$connect stat=',stat
      stat=redis$command(%val(cache),%ref(reply),%descr('SELECT %d'),
     +  %val(msgs))
      call redis$free_reply_object(%val(reply))
c  write message to cache
      key='Fortran'//char(0)
      val='Hi from Fortran!'//char(0)
      stat=redis$command(%val(cache),%ref(reply),%descr('SET %s %s'),
     +  %ref(key),%ref(val))
      if((stat.and.1).eq.0) write(*,*) 'redis$command stat=',stat
      call redis$free_reply_object(%val(reply))
c  read all messages from cache
      stat=redis$command(%val(cache),%ref(reply),%descr('KEYS *'))
      if((stat.and.1).eq.0) write(*,*) 'redis$command stat=',stat
      call redis$reply_get_array_length(%val(reply),%ref(n))
      do 200 i=1,n
        call redis$reply_get_string(%val(reply),%descr(key),%val(i-1))
        keylen=index(key,' ')-1
        key(keylen+1:keylen+1)=char(0)
        stat=redis$command(%val(cache),%ref(reply2),
     +    %descr('GET %s'),%ref(key))
        if((stat.and.1).eq.0) write(*,*) 'redis$command stat=',stat
        call redis$reply_get_string(%val(reply2),%descr(val),%val(-1))
        vallen=255
100     if(val(vallen:vallen).eq.' ') then
          vallen=vallen-1
          goto 100
        endif
        write(*,*) '|'//val(1:vallen)//'|'
        call redis$free_reply_object(%val(reply2))
200   continue
      call redis$free_reply_object(%val(reply))
c  disconnect
      call redis$free(%val(cache))
      end

Build:

$ for p2
$ link p2 + sys$common:[redis.lib]libhiredis/libr + sys$common:[redis.lib]libredis/libr

Run:

$ run p2
program p3(input,output);

const
   host = 'localhost';
   port = 6379;
   msgs = 10;

type
   pstr = varying [255] of char;

[external]
function redis$connect(%REF cache : integer64;
                       %STDESCR host : packed array[$l..$u:integer] of char;
                       %IMMED port : integer) : integer; external;
[external]
function redis$command(%IMMED cache : integer64;
                       %REF reply : integer64;
                       %STDESCR cmd : packed array[$l..$u:integer] of char;
                       %IMMED args : [LIST] integer) : integer; external;
[external]
function redis$reply_get_array_length(%IMMED reply : integer64;
                                      %REF n : integer) : integer; external;
[external]
function redis$reply_get_string(%IMMED reply : integer64;
                                %STDESCR str : packed array[$l..$u:integer] of char;
                                %IMMED ix : integer) : integer; external;
[external]
function redis$free_reply_object(%IMMED reply : integer64) : integer; external;
[external]
function redis$free(%IMMED cache : integer64) : integer; external;

var
   cache, reply, reply2 : integer64;
   key, val : pstr;
   stat, n, i : integer;

begin
   (* connect to cache *)
   stat := redis$connect(cache, host, port);
   if not odd(stat) then writeln('redis$connect stat=', stat);
   stat := redis$command(cache, reply, 'SELECT %d', msgs);
   if not odd(stat) then writeln('redis$command stat=', stat);
   (* write message to cache *)
   key := 'Pascal' + chr(0);
   val := 'Hi from Pascal!' + chr(0);
   stat := redis$command(cache, reply, 'SET %s %s', iaddress(key.body), iaddress(val.body));
   if not odd(stat) then writeln('redis$command stat=', stat);
   redis$free_reply_object(reply);
   (* read all messages from cache *)
   stat := redis$command(cache, reply, 'KEYS *');
   if not odd(stat) then writeln('redis$command stat=', stat);
   redis$reply_get_array_length(reply, n);
   for i := 1 to n do begin
      redis$reply_get_string(reply, key.body, i - 1);
      key.length := index(key.body, ' ') - 1;
      key := key + chr(0);
      stat := redis$command(cache, reply2, 'GET %s', iaddress(key.body));
      if not odd(stat) then writeln('redis$command stat=', stat);
      redis$reply_get_string(reply2, val.body, -1);
      val.length := 255;
      while val.body[val.length] = ' ' do val.length := val.length - 1;
      writeln('|' + val + '|');
      redis$free_reply_object(reply2);
   end;
   redis$free_reply_object(reply);
   (* disconnect *)
   redis$free(cache);
end.

Build:

$ pas p3
$ link p3 + sys$common:[redis.lib]libhiredis/libr + sys$common:[redis.lib]libredis/libr

Run:

$ run p3
identification division.
program-id.p4.
*
data division.
working-storage section.
01  cache   pic s9(18) comp.
01  reply   pic s9(18) comp.
01  reply2  pic s9(18) comp.
01  host    pic x(32) value "localhost".
01  port    pic s9(9) comp value 6379.
01  msgs    pic s9(9) comp value 10.
01  cmd     pic x(32).
01  rkey    pic x(32).
01  rkeylen pic s9(9) comp.
01  val     pic x(255).
01  vallen  pic s9(9) comp.
01  stat    pic s9(9) comp.
01  n       pic s9(9) comp.
01  i       pic s9(9) comp.
01  j       pic s9(9) comp.
01  tstat   pic 9(9) display.
*
procedure division.
main-paragraph.
* connect to cache
    call "REDIS$CONNECT"
        using
            by reference cache
            by descriptor host
            by value port
        giving
            stat
    end-call
    if function mod(stat, 2) = 0 then
        move stat to tstat
        display "redis$connect stat=" tstat
    end-if
    move "SELECT %d" to cmd
    call "REDIS$COMMAND"
        using
           by value cache
           by reference reply
           by descriptor cmd
           by value msgs
        giving
           stat
    if function mod(stat, 2) = 0 then
        move stat to tstat
        display "redis$command stat=" tstat
    end-if
    call "REDIS$FREE_REPLY_OBJECT"
        using
           by value reply
* write message to cache
    move "SET %s %s" to cmd
    string "Cobol" delimited by size function char(1) delimited by size into rkey
    string "Hi from Cobol!" delimited by size function char(1) delimited by size into val
    call "REDIS$COMMAND"
        using
            by value cache
            by reference reply
            by descriptor cmd
            by reference rkey
            by reference val
        giving
            stat
    if function mod(stat, 2) = 0 then
        move stat to tstat
        display "redis$command stat=" tstat
    end-if
    call "REDIS$FREE_REPLY_OBJECT"
        using
           by value reply
* read all messages from cache
    move "KEYS *" to cmd
    call "REDIS$COMMAND"
        using
            by value cache
            by reference reply
            by descriptor cmd
        giving
            stat
    if function mod(stat, 2) = 0 then
        move stat to tstat
        display "redis$command stat=" tstat
    end-if
    call "REDIS$REPLY_GET_ARRAY_LENGTH"
        using
            by value reply
            by reference n
    perform varying i from 1 by 1 until i > n
        compute j = i - 1
        call "REDIS$REPLY_GET_STRING"
            using
                by value reply
                by descriptor rkey
                by value j
        perform varying rkeylen from 1 by 1 until rkey(rkeylen:rkeylen) = " "
            continue
        end-perform
        compute rkeylen = rkeylen - 1
        string rkey(1:rkeylen) delimited by size function char(1) delimited by size into rkey
        move "GET %s" to cmd
        call "REDIS$COMMAND"
            using
                by value cache
                by reference reply2
                by descriptor cmd
                by reference rkey
            giving
                stat
        if function mod(stat, 2) = 0 then
            move stat to tstat
            display "redis$command stat=" tstat
        end-if
        call "REDIS$REPLY_GET_STRING"
            using
                by value reply2
                by descriptor val
                by value -1
        perform varying vallen from 255 by -1 until val(vallen:1) not = " "
            continue
        end-perform
        display "|" val(1:vallen) "|"
        call "REDIS$FREE_REPLY_OBJECT"
            using
               by value reply2
    end-perform
    call "REDIS$FREE_REPLY_OBJECT"
        using
           by value reply
* disconnect
    call "REDIS$FREE"
        using
           by value cache
    stop run.

Build:

$ cob p4
$ link p4 + sys$common:[redis.lib]libhiredis/libr + sys$common:[redis.lib]libredis/libr

Run:

$ run p4
program p5

option type = explicit

declare string constant host = "localhost"
declare integer constant port = 6379
declare integer constant msgs = 10

declare long cache, reply, reply2
declare string rkey, rval
declare integer stat, n, i, rkeylen, rvallen

external integer function redis$connect(long by ref, string by desc, integer by value)
external integer function redis$command(long by value, long by ref, string by desc, optional integer by value, integer by value)
external integer function redis$reply_get_array_length(long by value, integer by ref)
external integer function redis$reply_get_string(long by value, string by desc, integer by value)
external integer function redis$free_reply(long by value)
external integer function redis$free(long by value)

external integer function myloc(string by desc)

! connect to cache
stat = redis$connect(cache, host, port)
if mod(stat, "2"L) = 0 then
    print 'redis$connect stat=', stat
end if
stat = redis$command(cache, reply, 'SELECT %d', msgs)
if mod(stat, "2"L) = 0 then
    print 'redis$command stat=', stat
end if
call redis$free_reply_object(reply)
! write message to cache
rkey = 'Basic' + chr$(0)
rval = 'Hi from Basic!' + chr$(0)
stat = redis$command(cache, reply, 'SET %s %s', myloc(rkey), myloc(rval))
if mod(stat, "2"L) = 0 then
    print 'redis$command stat=', stat
end if
call redis$free_reply_object(reply)
! read all messages from cache
stat = redis$command(cache, reply, 'KEYS *')
if mod(stat, "2"L) = 0 then
    print 'redis$command stat=', stat
end if
call redis$reply_get_array_length(reply, n)
for i = 1 to n
    rkey = '                             '
    call redis$reply_get_string(reply, rkey, i - 1)
    rkeylen = instr(1, rkey, " ") - 1
    rkey = mid(rkey, 1, rkeylen) + chr$(0)
    stat = redis$command(cache, reply2, 'GET %s', myloc(rkey))
    rval = '                                                                                                    '
    call redis$reply_get_string(reply2, rval, -1)
    rvallen = 100
    while mid(rval, rvallen, 1) = " "
        rvallen = rvallen - 1
    next
    rval = mid(rval, 1, rvallen)
    print '|' + rval + '|'
    call redis$free_reply_object(reply2)
next i
call redis$free_reply_object(reply)
! disconnect
call redis$free(cache)

end program

The handles cache, reply and reply2 are 32 bit integers in Basic while 64 bit integers in Fortran, Pascal and Cobol. VMS Basic does not accept passing a 64 bit integer by value as the API requires for these handles. It work fine with 32 bit integers in Basic. I am confident that those variables are opaque representations of a C pointer and that Redis returns 32 bit pointers for these. So it works fine with just 32 bit. If Redis was ever changed to return 64 bit pointers then there would be a problem.

To get the address of the actual bytes of a string I had to write the following Macro-32 as the builtin loc returns the address of the descriptor.

        .title  myloc
        .psect  $CODE quad,pic,con,lcl,shr,exe,nowrt
        .entry  myloc,^m<>
        movl    4(ap), r0
        movl    4(r0), r0
        ret
        .end

Build:

$ macro myloc
$ bas p5
$ link p5 + myloc + sys$common:[redis.lib]libhiredis/libr + sys$common:[redis.lib]libredis/libr

Run:

$ run p5

Custom VMS wrapper hiredis:

I don't like the VMS wrapper that comes with VMS Redis, so I have created my own. It is available here - take the predis library.

Client:

      program p2e
      implicit none
      integer*4 port,msgs
      character*32 host
      parameter (host='localhost',
     +           port=6379,
     +           msgs=10)
      integer*8 cache,it
      character*32 key
      character*255 val
      integer*4 stat,n,i,keylen,vallen
      integer*4 vms_hiredis_connect,
     +          vms_hiredis_set_string,
     +          vms_hiredis_get_string,
     +          vms_hiredis_keys_lookup,
     +          vms_hiredis_keys_count
c  connect to cache
      stat=vms_hiredis_connect(host,port,msgs,cache)
      if((stat.and.1).eq.0) write(*,*) 'vms_hiredis_connect failed'
c  write message to cache
      key='Fortran/custom'
      val='Hi from Fortran/custom!'
      stat=vms_hiredis_set_String(cache,key,val)
      if((stat.and.1).eq.0) write(*,*) 'vms_hiredis_set_string failed'
c  read all messages from cache
      stat=vms_hiredis_keys_lookup(cache,'*',it)
      if((stat.and.1).eq.0) write(*,*) 'vms_hiredis_keys_lookup failed'
      n=vms_hiredis_keys_count(it)
      do 200 i=1,n
        call vms_hiredis_keys_get(it,i,key,keylen)
        stat=vms_hiredis_get_string(cache,key(1:keylen),val,vallen)
        if((stat.and.1).eq.0) write(*,*) 'vms_hiredis_get_string failed'
        write(*,*) '|'//val(1:vallen)//'|'
200   continue
      call vms_hiredis_keys_free(it)
c  disconnect
      call vms_hiredis_disconnect(cache)
      end

Build:

$ for p2e
$ link p2e + predisdir:vms_hiredis + sys$common:[redis.lib]libhiredis/libr + sys$common:[redis.lib]libredis/libr

Run:

$ run p2e
[inherit('predisdir:predis')]
program p3e(input,output);

const
   host = 'localhost';
   port = 6379;
   msgs = 10;

var
   cache : cache_ctx;
   it : it_ctx;
   key, val : pstr;
   stat, n, i, ix : integer;

begin
   (* connect to cache *)
   stat := predis_connect(host, port, msgs, cache);
   if not odd(stat) then writeln('predis_connect failed');
   (* write message to cache *)
   key := 'Pascal/custom';
   val := 'Hi from Pascal/custom!';
   stat := predis_set_string(cache, fix(key), fix(val));
   if not odd(stat) then writeln('predis_set_string failed');
   (* read all messages from cache *)
   stat := predis_keys_lookup(cache, '*', it);
   if not odd(stat) then writeln('predis_keys_lookup failed');
   n := predis_keys_count(it);
   for i := 1 to n do begin
      ix := i;
      predis_keys_get(it, ix, key.body, key.length);
      stat := predis_get_string(cache, fix(key), val.body, val.length);
      if not odd(stat) then writeln('predis_get_string failed');
      writeln('|' + val + '|');
   end;
   predis_keys_free(it);
   (* disconnect *)
   predis_disconnect(cache);
end.

Build:

$ pas p3e
$ link p3e + predisdir:predis + predisdir:vms_hiredis + sys$common:[redis.lib]libhiredis/libr + sys$common:[redis.lib]libredis/libr

Run:

$ run p3e
identification division.
program-id.p4e.
*
data division.
working-storage section.
01  cache   pic s9(18) comp.
01  it      pic s9(18) comp.
01  host    pic x(32) value "localhost".
01  port    pic s9(9) comp value 6379.
01  msgs    pic s9(9) comp value 10.
01  allk    pic x(1) value "*".
01  rkey    pic x(32).
01  rkeylen pic s9(9) comp.
01  val     pic x(255).
01  vallen  pic s9(9) comp.
01  stat    pic s9(9) comp.
01  n       pic s9(9) comp.
01  i       pic s9(9) comp.
*
procedure division.
main-paragraph.
* connect to cache
    call "VMS_HIREDIS_CONNECT"
        using
            by descriptor host
            by reference port
            by reference msgs
            by reference cache
        giving
            stat
    end-call
    if function mod(stat, 2) = 0 then
        display "vms_hiredis_connect failed"
    end-if
* write message to cache
    move "Cobol/custom" to rkey
    move "Hi from Cobol/custom!" to val
    call "VMS_HIREDIS_SET_STRING"
        using
            by reference cache
            by descriptor rkey
            by descriptor val
        giving
            stat
    if function mod(stat, 2) = 0 then
        display "vms_hiredis_set_string failed"
    end-if
* read all messages from cache
    call "VMS_HIREDIS_KEYS_LOOKUP"
        using
            by reference cache
            by descriptor allk
            by reference it
        giving
            stat
    if function mod(stat, 2) = 0 then
        display "vms_hiredis_keys_lookup failed"
    end-if
    call "VMS_HIREDIS_KEYS_COUNT"
        using
            by reference it
        giving
            n
    perform varying i from 1 by 1 until i > n
        call "VMS_HIREDIS_KEYS_GET"
            using
                by reference it
                by reference i
                by descriptor rkey
                by reference rkeylen
        call "VMS_HIREDIS_GET_STRING"
            using
                by reference cache
                by descriptor rkey(1:rkeylen)
                by descriptor val
                by reference vallen
            giving
                stat
        if function mod(stat, 2) = 0 then
            display "vms_hiredis_get_string"
        end-if
        display "|" val(1:vallen) "|"
    end-perform
    call "VMS_HIREDIS_KEYS_FREE"
        using
           by reference it
* disconnect
    call "VMS_HIREDIS_DISCONNECT"
        using
           by reference cache
    stop run.

Build:

$ cob p4e
$ link p4e + predisdir:vms_hiredis + sys$common:[redis.lib]libhiredis/libr + sys$common:[redis.lib]libredis/libr

Run:

$ run p4e
program p5e

option type = explicit

declare string constant host = "localhost"
declare integer constant port = 6379
declare integer constant msgs = 10

declare word rkeylen, rvallen
declare integer stat, n, i
declare quad cache, it
declare string rkey, rval

external integer function vms_hiredis_connect(string by desc, integer by ref, integer by ref, quad by ref)
external integer function vms_hiredis_set_string(quad by ref, string by desc, string by desc)
external integer function vms_hiredis_get_string(quad by ref, string by desc, string by desc, word by ref)
external integer function vms_hiredis_keys_lookup(quad by ref, string by desc, quad by ref)
external integer function vms_hiredis_keys_count(quad by ref)
external sub vms_hiredis_keys_get(quad by ref, integer by ref, string by desc, word by ref)
external sub vms_hiredis_keys_free(quad by ref)
external sub vms_hiredis_disconnect(quad by ref)

external integer function myloc(string by desc)

! connect to cache
stat = vms_hiredis_connect(host, port, msgs, cache)
if mod(stat, "2"L) = 0 then
    print 'vns_hiredis_connect failed'
end if
! write message to cache
rkey = 'Basic/custom'
rval = 'Hi from Basic/custom!'
stat = vms_hiredis_set_string(cache, rkey, rval)
if mod(stat, "2"L) = 0 then
    print 'vms_hiredis_set_string failed'
end if
! read all messages from cache
stat = vms_hiredis_keys_lookup(cache, '*', it)
if mod(stat, "2"L) = 0 then
    print 'vms_hiredis_keys_lookup failed'
end if
n = vms_hiredis_keys_count(it)
for i = 1 to n
    rkey = '                             '
    call vms_hiredis_keys_get(it, i, rkey, rkeylen)
    rval = '                                                                                                    '
    stat = vms_hiredis_get_string(cache, mid(rkey, 1, rkeylen), rval, rvallen)
    print '|' + mid(rval, 1, rvallen) + '|'
next i
call vms_hiredis_keys_free(it)
! disconnect
call vms_hiredis_disconnect(cache)

end program

Build:

$ bas p5e
$ link p5e + predisdir:vms_hiredis + sys$common:[redis.lib]libhiredis/libr + sys$common:[redis.lib]libredis/libr

Run:

$ run p5e

Jedis:

Client:

import redis.clients.jedis.Jedis;

public class P6 {
    private static final String HOST = "localhost";
    private static final int PORT = 6379;
    private static final int MSGS = 10;
    public static void main(String[] args) throws Exception {
        // connect to cache
        Jedis cache = new Jedis(HOST, PORT);
        cache.select(MSGS);
        // write message to cache
        cache.set("Java", "Hi from Java!");
        // read all messages from cache
        for(String key : cache.keys("*")) {
            String val = cache.get(key);
            System.out.println("|" + val + "|");
        }
    }
}

Build:

$ javac -classpath jedis-2_1_0.jar P6.java

Run:

$ java -classpath .:jedis-2_1_0.jar "P6"
from redis.clients.jedis import Jedis

HOST = 'localhost'
PORT = 6379
MSGS = 10

# connect to cache
cache = Jedis(HOST, PORT);
cache.select(MSGS);
# write message to cache
cache.set('Jython', 'Hi from Jython!')
# read all messages from cache
for key in cache.keys("*"):
    val = cache.get(key)
    print('|' + val + '|')

Run:

$ define/nolog jython_libs "jedis-2_1_0.jar"
$ jython p8.py

Python module:

Client:

import redis

HOST = 'localhost'
PORT = 6379
MSGS = 10

# connect to cache
cache = redis.Redis(host=HOST, port=PORT, db=MSGS)
# write message to cache
cache.set('Python', 'Hi from Python!')
# read all messages from cache
for key in cache.scan_iter("*"):
    val = cache.get(key)
    print('|' + val + '|')
# disconnect
cache.close()

Run:

$ python p7.py

Article history:

Version Date Description
1.0 September 12th 2022 Initial version
1.1 September 18th 2022 Add mailbox and DECnet task sections
1.2 September 20th 2022 Add PHP and more DCL examples
1.3 September 28th 2022 Add Redis section
1.4 October 4th 2022 Add ICC section
1.5 October 24th 2022 Add HTTP section
1.6 February 3rd 2023 Add MySQL section
1.7 September 10th 2023 Add more examples for shared memory and memory mapped file (Cobol and SEC$M_EXPREG)
1.8 January 28th 2024 Add SOAP section
1.9 February 14th 2024 Add XML-RPC section
1.10 February 194th 2024 Add RESTful section

Other articles:

See list of all articles here

Comments:

Please send comments to Arne Vajhøj