/* rrms.c - send packets to a remote rms server */
/*	pashunfingaz support for chris, rms 2.0 meets decus "C" */

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

#include	<algol68.h>

#define	EFN	12

#undef susmal
		/* #define this to check memory allocation */
		/* mnemonic is SUSpect Memory ALlocation */


int rmssts;	/* like rms.c */
int rmsstv;	/* like rms.c */
int	rmspac[256];	/* variable send/receive packet : talks to server task */

int	rmssrv[2] = {071535,074740};	/* default RRMST */
			/* rad50 name of server task */

/*	E D I T   H I S T O R Y

??-???-??	DLE	created
27-Sep-84	DLE	invented newmi_(lun,name,reclen,lenpos)
			for use in rrmst.c. also changed newmi() to
			use newmi_().
28-sep-84	DLE	invented "rms.h" and put all the boring functions
			in there. now rms.c has in-task rms, and rrms.c
			has ex-task rms.
28-sep-84	DLE	invent rmssts kludge: stop people perving in RABs
			FABs etc.
28-sep-84	DLE	invent rmsstv kludge: still stop people perving in fabs
28-sep-84	DLE	implement $WOTLI , wotli() so we know how big
			buffers are to copy from/to packets
			store wotli() info in single thread list rooted on 'root'
 1-Oct-84	DLE	Chris found an important bug: real RMS will not
			modify a (recieving) buffer if it returns ER$RNF
			so we must NOT copy to the recieving buffer if
			rmssts <=0 in getmi().

 1-Oct-84	DLE	invent rmscs() to select the name of the server
			that we should use: puts RRTTnn in rad50 into rmssrv
15-Jan-85	DLE	add xoldi() packeter, scrub oldi() packeter since
			oldi() & oldri() live in rms.h common code now.
*/

#include "rmsdoc.h"

struct	rabwot
{
	struct	rabwot	*	w_nxt;
	int			w_rab;
	int			w_len;	/* record length */
	int			w_nk;	/* number of keys */
	int			w_l[1];	/* lengths of key(s) */
};

struct	rabwot	*	rmsroo	=	0	;	/* root */



struct	rabsyn	*newmi_(lun,name,reclen,lenpos)	/* may return struct fab */
char		lun;				/* RMS channel number to use */
						/* "C" uses 1,2 & 3 !! */
char		*name;				/* ascii file name */
unsigned	reclen;				/* whole record length (bytes) */
int	*	lenpos;				/* variable-length argument list */
						/* each pair of list is 'length,position,'
						   of a key. list ends with '0' */
{
int	*ip;
int	*jp;
int	words;
int	texts;
int	r;
int	nrb;

	rmspac[4] = reclen;
	jp = rmspac+5;
	ip = lenpos;
	words = 1;
	FOR	(;	*ip;	ip++)
	DO	*jp++ = *ip++;			/* copy len,pos to rmspac */
		*jp++ = *ip;
		words+=2;			/* counting words as we go */
	OD;
	*jp=0;
	words++;
	strcpy(rmspac+4+words,name);
	texts = strlen(name)+1;
	rmspkt($NEWMI,words,texts,0123456,rmspac,EFN,rmssrv,&rmssts,&rmsstv,&r,&nrb);
	rmsnr();
	return(r);
}

struct	rabsyn	*xoldi(lun,name,rights)		/* may return struct fab * */
char		lun;				/* RMS channel number to use */
						/* "C" uses 1,2 & 3 !! */
char		*name;				/* ascii file name */
char		rights;				/* O$FAC access request mask */
{
int	nrb;
int	r;
int	texts;

	rmspac[4] = rights;
	strcpy(rmspac+5,name);
	texts = strlen(name)+1;
	rmspkt($XOLDI,1,texts,0123456,rmspac,EFN,rmssrv,&rmssts,&rmsstv,&r,&nrb);
	rmsnr();
	return(r);
}


char	*drop(r)				/* return 0 if OK,
						   return datablock if bad */
						/* if bad, rmssts says why */
struct	rabsyn	*r;				/* the RAB to lose */
{
int	nrb;
int	ret;

	rmsgr(r);	/* ensure this is a legal rab - don't trust our caller */
	rmspac[4] = r;
	rmspkt($DROP,1,0,0123456,rmspac,EFN,rmssrv,&rmssts,&rmsstv,&ret,&nrb);
	rmskr(r,ret);
	return(ret);
}

unsigned	puti(r,buf)			/* return o$sts */
struct	rabsyn	*r;				/* the rab */
char	*buf;					/* a record */
BEGIN
struct	rabwot	*w;
int	junk;
	rmspac[4] = r;
	w = rmsgr(r);
	copy(rmspac+5,buf,w->w_len);
	rmspkt($PUTI,1,w->w_len,0123456,rmspac,EFN,rmssrv,&rmssts,&rmsstv,&junk,&junk);
	return(rmssts);
END

unsigned	getmi(r,key,buf,keynum,match)	/* return o$sts */
struct	rabsyn	*r;
char		*key;				/* full key */
char		*buf;				/* full record appears here */
unsigned	keynum;				/* number of key to use */
int		match;				/* RB$KGE or RB$KGT */
{
int	nrb;
int	dumrab;
int	texts;
struct rabwot *w;

	rmspac[4] = r;
	rmspac[5] = keynum;
	rmspac[6] = match;
	w = rmsgr(r);
	texts = w -> w_l[keynum];
	copy(rmspac+7,key,texts);
	rmspkt($GETMI,3,texts,0123456,rmspac,EFN,rmssrv,&rmssts,&rmsstv,&dumrab,&nrb);
	IF	(rmssts>0)
	THEN	/* safe to copy result to user's buffer */
		copy(buf,rmspac+8,nrb);
	FI;
	return(rmssts);
}

unsigned	deli(r)				/* return o$sts */
struct	rabsyn	*r;
{
int	junk;

	rmsgr(r);	/* ensure this is a legal rab - don't trust our caller */
	rmspac[4] = r;
	rmspkt($DELI,1,0,0123456,rmspac,EFN,rmssrv,&rmssts,&rmsstv,&junk,&junk);
	return(rmssts);
}

unsigned	freeee(r)			/* return o$sts */
struct	rabsyn	*r;
{
int	junk;

	rmsgr(r);	/* ensure this is a legal rab - don't trust our caller */
	rmspac[4] = r;
	rmspkt($FREEEE,1,0,0123456,rmspac,EFN,rmssrv,&rmssts,&rmsstv,&junk,&junk);
	return(rmssts);
}

unsigned	updi(r,buf)			/* return o$sts */
struct	rabsyn	*r;				/* the rab */
char	*buf;					/* a record */
{
struct	rabwot	*w;
int	junk;

	rmspac[4] = r;
	w = rmsgr(r);	/* ensure this is a legal rab - don't trust our caller */
	copy(rmspac+5,buf,w->w_len);
	rmspkt($UPDI,1,w->w_len,0123456,rmspac,EFN,rmssrv,&rmssts,&rmsstv,&junk,&junk);
	return(rmssts);
}

unsigned	wotli(r,lans)		/* return lengths to lans */
struct rabsyn * r;
char	lans[];
BEGIN
int	junk;
int	nrb;	/* number of returned bytes */
	rmspac[4] = r;
	rmspkt($WOTLI,1,0,0123456,rmspac,EFN,rmssrv,&rmssts,&rmsstv,&junk,&nrb);
	copy(lans,rmspac+8,nrb);
	return(rmssts);
END

/***********************************************************************\
*									*
*	this garbage handles a list of all the rabs we know and their	*
*	lengths.							*
*									*
\***********************************************************************/

rmsnr()				/* new rab - find out about it */
BEGIN
struct rabwot *w;

	IF	(rmssts == SU$SUC)
	THEN	wotli(rmspac[4],rmspac+8);
#ifdef susmal
$$mchk();
#endif
		w = malloc(8+(rmspac[8]<<1));
		IF	(!w)
		THEN	rmssts = ER$DME;
		ELSE	w -> w_nxt = rmsroo;
			w -> w_rab = rmspac[4];
			w -> w_len = rmspac[9];
			w -> w_nk  = rmspac[8];
			copy(w->w_l,rmspac+10,rmspac[8]<<1);
			rmsroo = w;
		FI;
	FI;
END

int	rmsgr(r)		/* find this rab in our list */
int	r;
BEGIN
struct rabwot *w;

	FOR	(w=rmsroo;	w;	w=w->w_nxt)
	DO	IF	(w->w_rab == r)
		THEN	return(w);
		FI;
	OD;
	printf("RMSGR: \7not an open rab:%o rmsroo=%oo\nCall a Programmer\n",r,rmsroo);
	getchar();
END

rmskr(r,ret)			/* loose a rab from list, if ret==0 */
int	r;
int	ret;
BEGIN
struct	rabwot	*b;
struct	rabwot	*t;

/******** this assumes offset w_nxt == 0 !! SLEAZY !! *************/

	IF	(!ret)
	THEN	b = & rmsroo;
		FOR	(t=rmsroo;	t;	t=t->w_nxt)
		DO	IF	(t->w_rab==r)
			THEN	b->w_nxt = t->w_nxt;
#ifdef susmal
$$mchk();
#endif
				mfree(t);
				return(0);
			FI;
			b = t;
		OD;
		error("RMSKR:r=%oo rmsroo=%oo\7\n",r,rmsroo);
	FI;
END
/************************************* end of rab tracking *************/


rmscs()		/* choose name of server task */
BEGIN
	ascr50(6,"...RRT",rmssrv);	/* RSX-11M+ only code */
END

#include "rms.h"

/* end: rrms.c */
