MODULE DAPUID=
!Routines to handle special USERID message
!Environment:  FTS NETSPL (-10/20/??)
!The USERID message is not part of DAP 4.1(3)
!It has been included in DAP 5.0 as an application-specific message
! with the addition of a menu (just for the heck of it!)
BEGIN
FORWARD ROUTINE
SNDUID,	!Send out USERID message
DOUID;	!Process one

REQUIRE 'INTR.REQ';
LIBRARY 'DAPLIB';


THIS_IS[DAPU] VERSION [512] EDIT [5]	DATE[16,JAN,80]

![5]	Make nodeid ASCIZ so no garbage ever after nodeid in new UID message
![4]	Put Nodeid in Additional data field to satisfy RSX people
![3]	Make conform to DAP 5.0 fully




	LITERAL		DAP_UID		=	128,
			OLD_DAP_UID	=	129,
			ID_IDENT	=	0,
			ID_ACCOUNT	=	1,
			ID_OPTIONS	=	2;

	LITERAL		OS$TOPS10	=	9;

EXTERNAL ROUTINE
	CHACAZ,
	CHAZAC,
	MOVEAZ,
	RDSIX,
	RDSIXA,
	WRSIXA,
	GET_LOCAL_NODE;
GLOBAL ROUTINE SNDUID(NB)=
!Send a USERID message
!NB:  addr of NDB for transfer
BEGIN
MAP NB: REF NDB;
LOCAL	IDENT: VECTOR[CH$ALLOCATION(41)],	!includes nodeid in old vers
	ZSTRING: VECTOR[CH$ALLOCATION(41)];	!ASCIZ version of above
LOCAL	MFLAGS: EX[1];
LOCAL	MLENGTH;
LOCAL	IPTR;					!Pointer to IDENT field
LOCAL	IDMENU: EX[1];				!Menu for fields in message
LOCAL	OPTIONS: BYTE8VECTOR[133];		!OPTIONS field built here
LOCAL	NEWUID;

CLEARV(IDMENU,MFLAGS);				!Initialize these bitmaps

!See what version of USERID message to send
NEWUID=((.N[OSTYPE] NEQ OS$TOPS10)*3) OR .N[SOFTVER];
!Always use type 3 for other than TOPS-10, else go by SOFTVER

IPTR=CH$PTR(ZSTRING);
GET_LOCAL_NODE(IPTR,6);	!Get Nodeid

IF .NEWUID LSS 3	!Put NODEID before USER if before version 3
THEN	BEGIN
	CH$WCHAR_A(%C':',IPTR);
	CH$WCHAR_A(%C':',IPTR);			!Put in :: after NODEID
	MOVEAZ(%REF(CH$PTR(N[REQUESTOR])),IPTR);!Put in user identification
	IPTR=CH$PTR(ZSTRING);			!Here is our IDENT field
	END

ELSE	BEGIN
	CH$WCHAR_A(0,IPTR);			![5] Force nodeid to be ASCIZ
	IPTR=CH$PTR(N[REQUESTOR]);		!Use requestor in NDB	
	CHAZAC(CH$PTR(ZSTRING),CH$PTR(OPTIONS,1,8)); !Put NODEID in OPTIONS
	OPTIONS[0]=.OPTIONS[1]+1;		!Indicate length of field
	IDMENU[ID_OPTIONS]=1;			!OPTIONS field in v3
	END;

MFLAGS[MFLAGS_LENGTH]=1;			!Length field specified
IDMENU[ID_IDENT]=1;				!IDENT field present always

!Convert IDENT to ASCIC and calculate length
MLENGTH=CHAZAC(.IPTR,CH$PTR(IDENT))+1		!Length of IDENT field
 +(.NEWUID GEQ 2)				!Count menu if there is one
 +(IF .IDMENU[ID_OPTIONS] THEN .OPTIONS[0]+1);	!And OPTIONS if any

PUT_BYTE(IF (.NEWUID GEQ 2) THEN DAP_UID ELSE OLD_DAP_UID); !Operator field
PUTEX(MFLAGS);					!Length field follows
PUT_BYTE(.MLENGTH);				!Put out MLENGTH field
IF .NEWUID GEQ 2 THEN PUTEX(IDMENU);			!Menu for following fields
PUTVAR(IDENT,CH$SIZE());			!Put out IDENT field
IF .IDMENU[ID_OPTIONS] THEN PUTVAR(OPTIONS,8)	!Put out OPTIONS field
END; !SNDUID
GLOBAL ROUTINE DOUID(NB)=
!Routine to read USERID message
BEGIN
MAP NB: REF NDB;
LOCAL USER: VECTOR[CH$ALLOCATION(50)];
LOCAL PTR;
LOCAL NODEID;
LOCAL IDMENU: EX[1];

CLEARV(IDMENU); IDMENU[ID_IDENT]=1;	!Assume we will get IDENT

SELECT GET_HDR OF SET
[DAP_UID]:
	BEGIN
	CLEARV(IDMENU); GETEX(IDMENU,1); !See what fields to get
	END;	
[DAP_UID,OLD_DAP_UID]:
	BEGIN
	IF .IDMENU[ID_IDENT]
	THEN	BEGIN
		GETVAR(USER,49,CH$SIZE());	!Get USER field
		PTR=CH$PTR(USER);		!We will now scan off ...
		NODEID=RDSIXA(PTR);		!The NODEID
		IF (CH$RCHAR_A(PTR) EQL %C':') AND (CH$RCHAR_A(PTR) EQL %C':')
		THEN	BEGIN
			N[NODEID]=.NODEID;
			END
		ELSE	PTR=CH$PTR(USER);	!No nodeid, field is all user
		MOVEAZ(PTR,%REF(CH$PTR(N[REQUESTOR])));	!Get the ident field
					!Convert to ASCIZ string
		END;

	IF .IDMENU[ID_ACCOUNT]
	THEN	BEGIN			!ACCOUNT field given
		DECR C FROM GET_BYTE TO 0 DO GET_BYTE;	!Eat it
		END;

	IF .IDMENU[ID_OPTIONS]		!OPTIONS field given
	THEN	BEGIN
		LOCAL CNT;
		CNT=GET_BYTE;		!Length of entire OPTIONS field
		IF .CNT GTR 0		!Look for originating NODEID first
		THEN	BEGIN		! subfield
			LOCAL NODEID:VECTOR[CH$ALLOCATION(7)];
			CNT=.CNT-1-GETVAR(NODEID,6,CH$SIZE());	!Scan it off
			N[NODEID]=RDSIXA(%REF(CH$PTR(NODEID)));	!Store it
			END;
		DECR C FROM .CNT TO 1 DO GET_BYTE;	!Eat the rest
		END;
	RETURN WIN
	END;

![DAP_ATT,DAP_ACC]:	!What does he think this is? DECNET?
			!We could actually do it in 7.00

[DAP_CFG TO DAP_NAM]: SEND_STATUS(MAC$SYNC,DAP_UID);

[OTHERWISE]: 		SEND_STATUS(MAC$INVALID,DAP_UID); !?WHAT?
TES;

END; !DOUID
END ELUDOM