/*	RRMST.C	- remote RMS task
 * implement an RMS file server so a task may send/receive packets
 * to RMS I/O. This saves bulk memory in a DECUS C task - DECUS C
 * can't use supervisor mode and data space yet (!)
 * Under this regime, the RMS code and buffers live outside your task.
 */

/*
 *		E D I T   H I S T O R Y
 *
 * 15-Jan-85	DLE	add $XOLDI packet format: protocol still #1
 *
 * 07-Mar-85	DLE	(after wiping these mods when I formatted the wrong disk)
 *			add mnemonics to trace messages: give op-codes in words
 *			add selective tracing: trace only nominated opcodes
 *
 * 10-Jun-85	DLE	concept bug: lunused() allocates a lun. If we fail
 *			to open on that lun, we should mark that lun as
 *			free. Not only do we get to re-use the lun (important
 *			for those long-running R_RMS_Ts) but our QIT message
 *			will not contain false alarms about allegedly unclosed
 *			files (allocated luns actaually).
 *
 *
 * 16-Jun-85	DLE	Emit status after every transaction. In case some
 *			fool task wants us to do that before it proceeds.
 *			If we despise the protocol etc give WARN but
 *			for RMS etc errors give SUCCEED.
 *
 *			Since this gets RUN, SPAWNed REQUESTed etc.
 *			it sometimes has a GMCR$ command line and sometimes
 *			does not. Define $$narg=1 so that if it does not
 *			have a command line, then DECUS C runtime ($$init
 *			module) will not prompt user for a command line.
 *			Otherwise, RRMST will sit waiting to write to
 *			TI: "mumble>" and waiting for an answer. If the
 *			requesting task has grabbed TI: we then have a
 *			deadly embrace: user waits for master waits for
 *			RRMST waits for TI: waits for master to let go
 *			of TI:.
 */

	ident "16JN85";

/* This tries to use the same calls as rms.c - which is the in-task flavour
 * so see rms.c for documentation.
 * The logic is: receive-packet; do-job; send-reply-packet; forever.
 */

/* Incoming packets have this format:
 *
 *	+-------------------------------+-------------------------------+
 *	| operation code		| protocol level		|  2
 *	+-------------------------------+-------------------------------+
 *	|	an ID from the sender task (just returned)		|  3
 *	+-------------------------------+-------------------------------+
 *	| 0 for now			| number of WORDS in W part	|  4
 *	+-------------------------------+-------------------------------+
 *	|		number of bytes in T part			|  5
 *	+---------------------------------------------------------------+
 *	|								|  6
 *	.								.
 *	.		some words (maybe)				.
 *	.								.
 *	|								|
 *	+---------------------------------------------------------------+
 *	|								|
 *	.								.
 *	.		some text (maybe)				.
 *	.								.
 *	|								|
 *	+---------------------------------------------------------------+
 *
 * The ID is just attached to the reply packet as a courtesy to the master
 * task; it may help a master task track many requests of many servers.
 * Words area is dumped as octal words in trace mode.
 * Text area is dumped as ascii text in trace mode.
 * See <rrms.h> for opcode byte definitions.
 */

/* Reply packets look like this:
 *
 *	+-------------------------------+-------------------------------+
 *	| operation code		| protocol level		|  0
 *	+-------------------------------+-------------------------------+
 *	|	an ID from the sender task (just returned)		|  1
 *	+---------------------------------------------------------------+
 *	|			RAB address (or 0)			|  2
 *	+---------------------------------------------------------------+
 *	|    RMS status code (or -42[decimal] silly packet detected)	|  3
 *	+---------------------------------------------------------------+
 *	|			RMS status value			|  4
 *	+-------------------------------+-------------------------------+
 *	|			number of reply bytes			|  5
 *	+---------------------------------------------------------------+
 *	|								|  6
 *	.								.
 *	.			reply data (if any)			.
 *	.								.
 *	|								|
 *	+---------------------------------------------------------------+
 * Exactly one reply is given for each request packet.
 * The reply data is traced as ascii.
 * The RAB address is in the server's address space: so the master can
 * corrupt things very easily!
 */

/* bugs:
 *	obviously, won't work for records > about 490 bytes (they
 *	won't fit in a packet) .
 *
 *	RAB addresses should be checked for validity when examining a
 *	request packet. (RMS does some checking before use.)
 *
 *	for security, we should know which task 'owns' a rab and not
 *	allow any other task to fiddle it.
 *
 *	for sleaznosity, we should be able to find valid RAB addresses
 *	and diddle things, so we can make an RMSDDT
 *
 *	RMS only lets me use 16 (approx) logical channels at once.
 *	This is bad news for some applications. Will investigate.
 *
 *	When RMSQIT sends a packet to this, it should not only report
 *	what files are open, but should close them UNLOCKED as a
 *	'convenience' to naive users. What do you think? Is silent
 *	closing a bug or a feature? Code is easy (I think).
 *	(7mar85) code is NOT easy: server doesn't know which RABs belong
 *	to what. we know which luns are in use, but not their RABs.
 *	to implement this, first grow lunused to struct RAB * [].
 *	So mods are likely to have bugs, but not hard to understand.
 */

#include <stdio.h>
#include <cx.h>
#include <algol68.h>
#define decus

#define EFN 12
#define PACWRDS 256
#define LUNMAX 100
#define MAXOP (12)

#include <rms200.h>
#include "rrms.h"

int	$$narg = 1;	/* 16jun85 - tell DECUS C **NEVER** prompt user
			   for command line */


int	packet[PACWRDS];/* largest packet RSX M+ 2.1 admits to */
int	tracer;		/* TRUE when desperately debugging */
int	optrace[MAXOP];	/* [opcode] TRUE if tracing */
int	trace;		/* TRUE if tracing */
int	dsw;		/* directive status word */
char	ascii[7];	/* ascii from rad50 */
rad50	master[2];	/* master task name */
int	opcode;		/* what the master wants */
int	words;		/* how many ints came with request */
int	reqid;		/* master's request ID: returned in reply */
int	texts;		/* how many bytes of text in request */
int	i;		/* */
char **	pp;		/* */
char *	p;		/* */
char *	e;		/* end: when p>=e, quit */
extern int rmssts;	/* from rms.c */
extern int rmsstv;	/* from rms.c */
struct rabsyn *rab;	/* */
struct rmsfab *fab;	/* */
int	replys;		/* number of bytes in text part of reply packet */
int	reclen;		/* record length (bytes) */
int *	lenpos;		/* address of 1st of pairs of ints
			   each pair specifies length:position of a key
			   a zero int follows last pair */
char *	name;		/* file name */
char *	buf;		/* address of where to put record */
int	keynum;		/* 0... number of key to use to find a record */
int	match;		/* RB$KGE or RB$KGT */
char	mykey[512];	/* we make a copy of the key here, before
			   reading record into packet[] */
char	lunused[LUNMAX];/* TRUE if lun[i] is in use */
int	lun;		/* LUN (or Logical CHannel to RMS) */
int	protocol;	/* packet protocol level: helps reject
			   dangerous packets - this server doesn't
			   understand security !! */
int	living;		/* TRUE until $QUIT seen */
int	rights;		/* O$FAC access request mask */
char *	opcnam[MAXOP+1] = {
"unknown", "newmi", "oldi", "drop", "puti", "getmi", "deli",
"freeee", "updi", "trace", "wotli", "quit", "xoldi", ""
};
int	opcndx;		/* index opcnam[] safely */
BOOL	sick;		/* TRUE if we saw a bad packet */


main(argc,argv)
int	argc;
char ** argv;
BEGIN
	tracer = FALSE;
	trace = argc>1;
	/* first, emit status to tell our invoker to PISS OFF, don't wait
	for us to complete, we don't want to exit for a long time */
	emst(NULL,IO_SUCCESS);

	FOR	(i=0;	i<=MAXOP;	i++)
	DO	optrace[i] = FALSE;
	OD
	WHILE	(--argc)
	DO	p = *++argv;
		FOR	(pp=opcnam;	*pp;	pp++)
		DO	IF	(streq(*pp,p))
			THEN	optrace[pp-opcnam] = TRUE;
				break;
			FI
		OD
		IF	(!*pp)
		THEN	fprintf(stderr,"\7opcode trace name \"%s\" unknown\n",p);
		FI
	OD
	zero(lunused,LUNMAX);	/* assume all luns free */
	FOR	(p=lunused;	p<lunused+7;	p++)
	DO	*p = TRUE;
	OD;			/* but C uses lun 1:4 and DDT uses 5:6 */

	living = TRUE;
	WHILE	(living)
	DO	WHILE	( (dsw=vrcs(NULL,packet,PACWRDS)) == IS_SET )
		DO	/* ignore false alarms */
		OD
		sick = FALSE;
		protocol = packet[2] & 0xFF;
		IF	(protocol != 1)
		THEN	fprintf("stderr\7RRMST:protocol error\n");
			sick = TRUE;
			continue;
		FI
		opcode = packet[2]  >> 8;
		IF	(opcode<1 || opcode>MAXOP)
		THEN	opcndx = 0;
		ELSE	opcndx = opcode;
		FI	/* here with opcndx usable for opcnam[] */
		reqid = packet[3];
		words = packet[4];
		texts = packet[5];
		copy(master,packet,4);	/* remember requester name */
		IF	(trace&&optrace[opcndx])
		THEN	r50toa(ascii,master,2);
			ascii[6] = 0;
			printf("from task %s opcode=%oo(%s) words=%oo texts=%oo ID=%oo\n"
					,ascii,opcode,opcnam[opcndx],words,texts,reqid);
			FOR	(i=0;	i<words;	i++)
			DO	printf("word %d. is %oo\n",i,packet[6+i]);
			OD;
			printf("text=");
			p = packet + 6 + words;	/* start of text */
			e = p + texts;		/* end of text + 1 */
			FOR	(;	p<e;	p++)
			DO	cdump(*p);
			OD;
			putchar('\n');
		FI;
		rmssts = rmsstv = rab = replys = 0;
		switch	(opcode)
			{
		case $NEWMI:	IF	(!(words % 2))	/* must have even number of words */
				THEN	lun = getlun();
					reclen = packet[6];
					lenpos = packet+7;
					name = packet+6+words;
					rab = newmi_(lun,name,reclen,lenpos);
					lose(lun);
				ELSE	rmssts = -42;
				FI;
				break;
		case $OLDI:	IF	(!words)
				THEN	lun = getlun();
					name = packet+6+words;
					rab = oldi(lun,name);
					lose(lun);
				ELSE	rmssts = -42;
				FI;
				break;
		case $XOLDI:	IF	(words==1)
				THEN	lun = getlun();
					name = packet+6+words;
					rights = packet[6];
					rab = xoldi(lun,name,rights);
					lose(lun);
				ELSE	rmssts = -42;
				FI;
				break;
		case $DROP:	IF	(words==1)
				THEN	rab = packet[6];
					IF	(rab -> o$bid == RB$BID && rab -> o$bln == RB$BLN)
					THEN	fab = rab -> o$fab;
						lun = fab -> o$lch;
						rab = drop(rab);	/* 0 means OK */
						IF	(!rab)
						THEN	lunused[lun] = FALSE;
						FI;
					ELSE	rmssts = ER$RAB;
					FI;
				ELSE	rmssts = -42;
				FI;
				break;
		case $PUTI:	IF	(words==1)
				THEN	rab = packet[6];
					IF	(rab -> o$bid == RB$BID && rab -> o$bln == RB$BLN)
					THEN	buf = packet+6+words;
						puti(rab,buf);
					ELSE	rmssts = ER$RAB;
					FI;
				ELSE	rmssts = -42;
				FI;
				break;
		case $GETMI:	IF	(words==3)
				THEN	rab = packet[6];
					IF	(rab -> o$bid == RB$BID && rab -> o$bln == RB$BLN)
					THEN	keynum = packet[7];
						match = packet[8];
						copy(mykey,packet+6+words,texts);
						buf = packet+6;
						fab = rab -> o$fab;
						replys = fab -> o$mrs;
						getmi(rab,mykey,buf,keynum,match);
						IF	(rmssts<=0)
						THEN	replys = 0;
						FI;
					ELSE	rmssts = ER$RAB;
					FI;
				ELSE	rmssts = -42;
				FI;
				break;
		case $DELI:	IF	(words==1)
				THEN	rab = packet[6];
					IF	(rab -> o$bid == RB$BID && rab -> o$bln == RB$BLN)
					THEN	deli(rab);
					ELSE	rmssts = ER$RAB;
					FI;
				ELSE	rmssts = -42;
				FI;
				break;
		case $FREEEE:	IF	(words==1)
				THEN	rab = packet[6];
					IF	(rab -> o$bid == RB$BID && rab -> o$bln == RB$BLN)
					THEN	freeee(rab);
					ELSE	rmssts = ER$RAB;
					FI;
				ELSE	rmssts = -42;
				FI;
				break;
		case $UPDI:	IF	(words==1)
				THEN	rab = packet[6];
					IF	(rab -> o$bid == RB$BID && rab -> o$bln == RB$BLN)
					THEN	buf = packet+6+words;
						updi(rab,buf);
					ELSE	rmssts = ER$RAB;
					FI;
				ELSE	rmssts = -42;
				FI;
				break;
		case $TRACE:	trace = ! trace;
				break;
		case $WOTLI:	IF	(words==1)
				THEN	rab = packet[6];
					IF	(rab -> o$bid == RB$BID && rab -> o$bln == RB$BLN)
					THEN	IF	(wotli(rab,packet+6) == SU$SUC)
						THEN	replys = (packet[6]+2) << 1;
						FI;
					ELSE	rmssts = ER$RAB;
					FI;
				ELSE	rmssts = -42;
				FI;
				break;
		case $QUIT:	FOR	(p=lunused+7;	p<lunused+LUNMAX;	p++)
				DO	IF	(*p)
					THEN	/* we still have some open files */
						fprintf(stderr,"+%d.",p-lunused);
						 printf(       "+%d.",p-lunused);
						rmssts = ER$ABO;
						/* means we do it anyway - but warn master */
					FI;
				OD;
				IF	(rmssts == ER$ABO)
				THEN	fprintf(stderr,"\7WARNING: RRMST QUITS WITH SOME OPEN FILES\n");
					 printf(       "\7WARNING: RRMST QUITS WITH SOME OPEN FILES\n");
				FI;
				living = FALSE;
				/* always succeed */
				break;
		default:	rmssts = -42;
				sick = TRUE;
				break;
			}
		;
		packet[0] = (opcode<<8) | protocol;
		packet[1] = reqid;
		packet[2] = rab;
		packet[3] = rmssts;
		packet[4] = rmsstv;
		packet[5] = replys;
		dsw = vsda(master,packet,6+((replys+1)>>1),EFN);
		IF	(trace&&optrace[opcndx])
		THEN	r50toa(ascii,master,2);
			printf("reply to task %o,%o=%s;dsw=%oo replys=%d. status=%oo,%oo rab=%oo id=%oo\n",master[0],master[1],ascii,dsw,replys,rmssts,rmsstv,rab,reqid);
			printf("reply=");
			p=packet+6;
			e = p + replys;
			FOR	(;	p<e;	p++)
			DO	cdump(*p);
			OD;
			putchar('\n');
		FI
		IF	(dsw!=IS_SUC)
		THEN	printf("vsda:dsw=%oo replys=%oo master=%oo%oo\n",dsw,replys,master[0],master[1]);
		FI
/*
 * We try two different ways to wake up whatever sent the packet: emit
 * status AND unstop.
*/
		emst(NULL,sick?IO_WARNING:IO_SUCCESS);
		dsw = ustp(master) & 0xFF;
		IF	(dsw != IS_SUC && dsw != IE_ITS)
		THEN	printf("ustp:dsw=%oo master=%oo%oo\n",dsw,master[0],master[1]);
		FI
	OD
	/* here after master task said $QUIT */
END

cdump(c)				/* printf a character in sanitised form */
char	c;
BEGIN
register	char	d;
	d = c & 0xFF;
	IF	(d&0x80)
	THEN	putchar('%');
		d &= 0x7F;
	FI;
	IF	(d==0x7F)
	THEN	printf("\#");
	ELSE	IF	(d<' ')
		THEN	putchar('^');
			putchar('@'+d);
		ELSE	switch(d)
				{
			case '^':
			case '\\':
					putchar('\\');
			default:
					putchar(d);
					break;
				}
			;
		FI;
	FI;
END

int	getlun()		/* return 0 or 1st free LUN, which is marked used */
BEGIN
char	*q;
	FOR	(q=lunused;	q<lunused+LUNMAX;	q++)
	DO	IF	(!*q)
		THEN	*q = TRUE;
			return(q-lunused);
		FI;
	OD;
	return(0);
END

	lose(ln)		/* if open() etc failed, free up lun */
int	ln;			/* the lun to free up */
BEGIN				/* I know the code is slack: too bad */
	IF	(rmssts<0)
	THEN	/* open failed , so we want to free up the lun */
		IF	(ln)
		THEN	lunused[ln]=FALSE;
		ELSE	/* all is OK, we never got a lun to start with! */
		FI
	FI
END

/* end: rrmst.c */
