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.
The concept is that different processes map different section of their virtual memory to the same section of physical memory.
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 |
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.
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
The concept is the same as for shared memory except that the memory is backed by a file.
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.
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.
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
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.
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 |
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:
program p1
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)
integer*4 i,msglen
c write to shareable image
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 shareable image
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 p1
$ link p1 + sys$input/opt
PSECT_ATTR=msgpsect,SHR
msgsshr/SHARE
$
Run:
$ run p1
program p2(input,output);
const
blocksize = 8192;
blocks = 10;
memsiz = blocks * blocksize;
maxmsgsiz = 100;
maxmsgs = memsiz div maxmsgsiz;
type
msgtype = packed array [1..maxmsgsiz] of char;
memtype = record
case boolean of
true : ( dummy : packed array [1..memsiz] of char; );
false : ( msg : packed array [1..maxmsgs] of msgtype; );
end;
var
mem : [common(msgpsect)] memtype;
i, msglen : integer;
begin
(* write to shareable image *)
i := 1;
while mem.msg[i][1] <> chr(0) do i := i + 1;
mem.msg[i] := 'Hi from Pascal!' + chr(0);
(* dump shareable image *)
for i := 1 to maxmsgs do begin
if mem.msg[i][1] <> chr(0) then begin
msglen := index(mem.msg[i], chr(0));
writeln('|' + substr(mem.msg[i], 1, msglen) + '|');
end;
end;
end.
Build:
$ pas p2
$ link p2 + sys$input/opt
PSECT_ATTR=msgpsect,SHR
msgsshr/SHARE
$
Run:
$ run p2
#include <stdio.h>
#include <string.h>
#define BLOCKSIZE 8192
#define BLOCKS 10
#define MEMSIZ BLOCKS * BLOCKSIZE
#define MAXMSGSIZ 100
#define MAXMSGS MEMSIZ / MAXMSGSIZ
static union msgrec
{
char dummy[MEMSIZ];
char msg[MAXMSGS][MAXMSGSIZ];
};
#pragma extern_model save
#pragma extern_model common_block
extern union msgrec msgpsect;
#pragma extern_model restore
int main(int argc, char *argv[])
{
int i;
/* write to shareable image */
i = 0;
while(msgpsect.msg[i][0] != 0) i++;
strcpy(msgpsect.msg[i], "Hi from C!");
/* dump shareable image */
for(i = 0; i < MAXMSGS; i++)
{
if(strlen(msgpsect.msg[i]) > 0)
{
printf("|%s|\n", msgpsect.msg[i]);
}
}
return 0;
}
Build:
$ cc p3
$ link p3 + sys$input/opt
PSECT_ATTR=msgpsect,SHR
msgsshr/SHARE
$
Run:
$ run p3
program p4
declare integer constant blksiz = 8192
declare integer constant blocks = 10
declare integer constant memsiz = blocks * blksiz
declare integer constant maxmsgsiz = 100
declare integer constant maxmsgs = memsiz / maxmsgsiz
declare integer constant memsiz1 = memsiz - 1
declare integer constant maxmsgs1 = maxmsgs - 1
map (msgpsect) byte mem(memsiz1)
map (msgpsect) string msg(maxmsgs1) = maxmsgsiz
declare integer i, msglen
! write to shareable image
i = 0
while mid(msg(i), 1, 1) <> chr$(0)
i = i + 1
next
msg(i) = "Hi from Basic!" + chr$(0)
! dump shareable image
for i = 0 to maxmsgs1
if mid(msg(i), 1, 1) <> chr$(0) then
msglen = instr(1, msg(i), chr$(0))
print using "'E", "|" + mid(msg(i), 1, msglen) + "|"
end if
next i
end program
Build:
$ bas p4
$ link p4 + sys$input/opt
PSECT_ATTR=msgpsect,SHR
msgsshr/SHARE
$
Run:
$ run p4
The concept of a mailbox is an in memory only device that can be accesses through IO.
Very similar to pipes in other OS.
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.
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.
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.
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
The concept is that a client applications starts a remote server application and they communicate over DECnet using normal IO.
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:
Client activate server and write one line.
Server read line and write same line back.
Client read line and print it.
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 (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.
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..
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
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
Sockets are a wellknown concept in programming.
Sockets use a client/server 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:
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.
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 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"
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 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 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
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 (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 |
The relevant model is where the client application has an embedded HTTP client and the server application has an embedded HTTP server:
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:
For embedded server we will use:
Client side we will use:
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 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/");
}
}
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/')
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/');
?>
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
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 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.
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:
We will demo:
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"
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)
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)
<?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";
}
?>
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";
}
?>
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.
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.
We will demo:
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"
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
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
import xmlrpclib
cli = xmlrpclib.Server('http://localhost:8001')
msgs = cli.S.process('Hi from Python!')
for msg in msgs:
print(msg)
$ python c2.py
<?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
#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
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
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.
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.
Server side will be done using JAX-RS API and Jersey library. See more detail here.
Client side we will demo:
Note that we will only demo JSON/HTTP(S) not XML/HTTP(S). JSON is by far the most common today.
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.
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
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
<?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
#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 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.
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.
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.
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"
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
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
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
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 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.
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.
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.
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
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
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 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
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
Relational databases are widely used today and SQLite is probably the most common embedded relational database.
Usage is traditional embedded dataabase.
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.
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.
Init (define table):
CREATE TABLE msgs (
id INTEGER PRIMARY KEY AUTOINCREMENT,
msg VARCHAR(100)
);
Run:
$ pipe sqlite msgs.db < init.sql
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
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.
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 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 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
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
Relational databases are widely used today and MySQL is one of the most common relational database servers.
Usage is traditional server database.
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.
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.
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
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
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 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 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
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
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.
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.
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.
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
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
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
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
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
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 |
See list of all articles here
Please send comments to Arne Vajhøj