;<PUP>PLFSUP.MAC.3, 10-Apr-82 20:53:44, Edit by SCHOEN
; PSQVAR, PSQPVF -> TOPVAR, TOPPVR so PUPUUO loads correctly
;<PUP>PLFSUP.MAC	some time ago	Edit by SCHOEN
; Incorporated into Leaf server, C.CNAM,C.CDRN -> CONNUM(CX)
;				 C.UNAM,C.UDRN -> USRNUM(CX)
;<PUP>PUPSUP.MAC.4	1/26/81			Edit by SCHOEN
; Changed TEMP to SFTEMP to avoid conflict with PUPFTP
;<PUP>PUPSUP.MAC.3	1/10/81			Edit by RINDFLEISCH
; Added routines to undelete a file and to set the author for a file
;<PUP>PUPSUP.MAC.2	1/8/81			Edit by RINDFLEISCH
; Made all TENEX/TOPS20 differences come here for resolution
;<PUP>JSIM.MAC.7, 24-Sep-80 23:41:32, Edit by SCHOEN
; Fix bug in CHKALL to handle non-directory files
; Change PPC to MPP in .MENTR, .MRETN
;<PUP>JSIM.MAC.6, 12-Jun-80 16:36:17, Edit by SCHOEN
;<PUP>JSIM.MAC;4  12-Jun-80 12:46:30  Edit by SCHOEN
; Made PS: default for user name specified to .CNPXY
;<PUP>JSIM.MAC.2, 18-Apr-80 16:21:40, Edit by SCHOEN
;<SCHOEN>JSIM.MAC;2     6-Apr-80 08:47:35    EDIT BY SCHOEN

	TITLE PUPSUP
	SUBTTL Simulate some TENEX JSYS's on TOPS20 for PUP code

	SEARCH PUPDEF,PSQDEF,PLFDEF
TENEX,<	SEARCH STENEX >
TOPS20,<SEARCH MONSYM >

ifndef sumex,<SUMEX==1>

	USEVAR TOPVAR,TOPPVR

	EXTERN CONNUM,USRNUM

	INTERN .cnpsw,.cncon,.cnpxy,.gdacc,.vacct,.cfgrp,.oprfn
	INTERN cpydrn,.atpty,.stdir,.stusr,.udelf,.sfust,bkton,bktoff
TOPS20,<		; If TOPS-20 system
	INTERN chkwr,chkrd,chkwrd,chkdr
>

TENEX,<			; If TENEX system
ifndef gdacc,<
; Macros for 134 accounting JSYS's at SUMEX
opdef	gdacc [pushj p,$gdacc##]
opdef	vacct [pushj p,$vacct##]
>
>

; macro to define JSYS error returns
define reterr (error,errac<1>),<
	jrst  [movei 1,error
	       movem 1,errac+pac
	       jsr .mretn
	       move p,mpp
	       ret] 
>
define retgd,<
	jsr .mretn
	jrst skpret##
>

; Standard entry/exit routines for simulated JSYS's
; ac save/restore
; saves/restores 0 - 7
highac==7		;last ac to save
.mentr:	0
	movem highAC,pac+highAC
	movei highAC,pac
	blt highAC,highAC-1+pac
	movem p,mpp
	jrst @.mentr

.mretn:	0
	movsi highAC,pac
	blt highAC,highAC
	jrst @.mretn

ls pac,20
ls mpp


; Implementation of TENEX OPRFN and TOPS-20 SMON functions.
; Entry:   a = sixbit operation code
; Call:    PUSHJ P,.OPRFN
; Return:  +1, error
;	   +2, success
.OPRFN:
TENEX,<			; If TENEX system
	OPRFN 			; TENEX, do OPRFN
	 POPJ P,		; Error, return +1
	JRST SKPRET##
>
TOPS20,<		; If TOPS-20 system
	SMON
	 ERJMP CPOPJ##		; If error, return +1
	JRST SKPRET##
>


; Routine to attach JFN's to NVT
; Entry:   a = receive jfn
;	   b = send jfn
; Return:  +1, error
;	   +2, ok
.ATPTY:
TENEX,<			; If TENEX system
	ATPTY			; Attach JFNs to NVT
	 POPJ P,
	JRST SKPRET##
>
TOPS20,<		; If TOPS-20 system
	ATNVT			; Attach JFN's to NVT
	 ERJMP CPOPJ##		; Failed
	JRST SKPRET##
>


; Routine to undelete a file
; Entry:   a = file jfn
; Return:  +1, file undeleted
.UDELF:	PUSH P,B		; Save ac's
	PUSH P,C
	HRLI A,1		; a ← fdbctl,,jfn
	MOVSI B,(1B3)		; Change deleted bit
	SETZ C,			; To off
	CHFDB
	POP P,C			; Restore ac's
	POP P,B
	HRRZS A			; a ← 0,,jfn
	POPJ P,

; Routine to convert string to directory #.  Makes sure string has <> if
; running on TOPS-20 and does not have <> on TENEX.
; Entry:   b = ptr to directory name string
; Return:  +1, error
;	   +2, b = flags, c = directory #
.STDIR:	
TENEX,<			; If TENEX system
	PUSHJ P,BKTOFF		; TENEX, make sure no <>
.STDI1:	SETZ A,			; Exact match required
	STDIR			; Look up directory
	 JRST CPOPJ##		; Not found, return +1
	 JRST CPOPJ##		; Ambiguous, return +1
	HLLZ B,A		; Ok, b ← flag bits
	HRRZ C,A		; c ← dir #
	JRST SKPRET##		; Skip return
>
TOPS20,<		; If TOPS-20 system
	PUSHJ P,BKTON		; Be sure brackets are on
	MOVSI A,(RC%EMO)	; Exact match required
	RCDIR			; Look up directory
	 ERJMP CPOPJ##		; Error, return +1
.STDI1:	TLNE A,(RC%NOM)		; No match?
	 JRST CPOPJ##		; Return +1
	MOVE B,A		; Ok, b ← flags (c = resulting dir #)
	JRST SKPRET##		; Skip return
>


; Routine to convert string to user #.
; Entry:   b = ptr to user name string
; Return:  +1, error
;	   +2, b = flags, c = user #
.STUSR:
TENEX,<			; If TENEX system
	JRST .STDI1		; Do STDIR
>
TOPS20,<		; If TOPS-20 system
	MOVSI A,(RC%EMO)	; Exact match required
	RCUSR			; Look up directory
	 ERJMP CPOPJ##		; Return +1 if error
	JRST .STDI1		; Check out the return
>

; Routine to ensure <> surround the name string
; Entry:   b = ptr to name str
; Return:  +1, b = ptr to modified string (in SPTEMP if needed)
BKTON:	PUSH P,C		; Save working ac
	TLC B,-1		; Be sure ptr is valid
	TLCN B,-1
	 HRLI B,(<POINT 7,0>)
	PUSH P,B		; Save the starting ptr
	PUSH P,[0]		; And place for edited str ptr
	ILDB C,B		; c ← 1st char
	CAIN C,"<"		; Starting bracket?
	 JRST BKTDON		; Yes, just return it as is
	MOVE A,[POINT 7,ONTEMP]	; No, get a temp area
	MOVEM A,0(P)		; Also save as new starting ptr
	PUSH P,C		; Save first char
	MOVEI C,"<"		; Tack on left bracket
	IDPB C,A
	POP P,C			; Recover 1st char
BKTON0:	IDPB C,A		; Save it
	ILDB C,B		; c ← next char
	CAIE C,"<"		; Start of dir field?
	CAIN C,":"		; Or colon, as in PS:?
	 JRST [ SETZM 0(P)	; Yes, assume he knew what he was doing
		JRST BKTDON ]	; Keep the original string
	JUMPN C,BKTON0		; Continue to null
	MOVEI C,">"		; Install closing bracket
	IDPB C,A
	MOVEI C,0		; And make it ASCIZ
	IDPB C,A
	JRST BKTDON


; Routine to ensure <> do not surround the name string
; Entry:   b = ptr to name str
; Return:  +1, b = ptr to modified string (in SPTEMP if needed)
BKTOFF:	PUSH P,C		; Save working ac
	TLC B,-1		; Be sure ptr is valid
	TLCN B,-1
	 HRLI B,(<POINT 7,0>)
	PUSH P,B		; Save starting ptr
	PUSH P,[0]		; And place for ptr to edited string
	MOVE A,[POINT 7,OFTEMP]	; Get a temp area
	SKIPA
BKTOF0:	 IDPB C,A		; Store a char
	ILDB C,B		; c ← next char
	CAIN C,"<"		; Start of directory part?
	 JRST [ MOVEM A,0(P)	; Yes, save the new ptr
		JRST .-2 ]	; Get the next char
	CAIE C,">"		; Quit on ending bracket?
	JUMPN C,BKTOF0		; Or null
	MOVEI C,0		; Terminate string before bracket
	IDPB C,A

; Here to leave things as they are
BKTDON:	SKIPN B,0(P)		; b ← ptr to edited str if set
	 MOVE B,-1(P)		; Otherwise, use the original
	SUB P,[2,,2]		; Reset the stack
	POP P,C			; Recover working ac
	POPJ P,

; Routine to update the last writer of a file
; Entry:   a = jfn for the file
;	   b = str ptr to new writer
; Return:  +1, writer updated if possible
.SFUST:	TLC B,-1		; Form proper string ptr
	TLCN B,-1
	 HRLI B,(<POINT 7,0>)
	PUSH P,B		; Save the ptr
	ILDB C,B		; c ← first string char
	POP P,B
	JUMPE C,CPOPJ##		; Quit if null string
	CAIN C,"@"		; Just host part of name?
	 POPJ P,		; Yes, quit too
TENEX,<			; If TENEX system
	PUSH P,A		; Save the jfn
	MOVE A,[POINT 7,SFTEMP]	; Place for edited string
.SFUS0:	ILDB C,B		; c ← string char
	CAIN C,"@"		; Start of host name?
	 MOVEI C,0		; Yes, terminate things
	IDPB C,A		; Copy char to temp string
	JUMPN C,.SFUS0		; Finish the string
	HRROI B,SFTEMP		; Now try to convert to user #
	PUSHJ P,.STUSR
	 JRST [ POP P,A		; No go
		POPJ P, ]
	POP P,A			; a ← fdbuse,,jfn
	HRLI A,6
	MOVSI B,-1		; Change lh = author
	HRLZS C			; New author
	CHFDB			; Change it
	HRRZS A			; Leave clean jfn
	POPJ P,
>
TOPS20,<		; If TOPS-20 system
	HRLI A,.SFLWR		; Set to change last writer
	SFUST
	ERJMP .+1		; Just ignore errors
	HRRZS A			; Leave clean jfn
	POPJ P,
>


; CNDIR simulations

TOPS20,<		; If TOPS-20 system
; ERROR MNEMONICS:
CNDIX1=600200		;invalid password
CNDIX3=600202		;invalid directory #
CNDIX4=600203		;logged in  (strange error)
CNDIX5=600204		;not logged in
>

; Connect to a directory.  Changes the fork's entry in the
; connected-directory table but not the login table.  Allows connect if
; group privileges sufficient, but does NOT take into account enabled
; status of fork.
; accepts 1/36-bit directory number
;	  2/pointer to password
; returns +1 if failure; ac1 = failure code (tenex CNDIR JSYS code)
; returns +2 if successful.
.cncon:
TENEX,<			; If TENEX system
	hrrzs 1			; Be sure TENEX dir # with no flags
.cnco0:	cndir
	 popj p,		; No go
	jrst skpret##		; Got it
>
TOPS20,<		; If TOPS-20 system
	jsr .mentr		;save ACs
	tlnn 1,77777
	 tlo 1,(1b3)		;if no structure, assume PS:
	movsi 3,(1b0)		; Flag to check group privs for password
	call .cnchk
	 call screwup##
	retgd			;leave good
>


; routine to implement TENEX CNDIR "proxy login."  Changes entries in
; both connected and login directory tables
; accepts in 1/36-bit directory number
;	     2/pointer to password
; returns +1 on failure, Tenex error code in AC1
; returns +2 on success
.cnpxy:
TENEX,<			; If TENEX system
	hrli 1,(1b1)		; 1 ← flag,,dir #
	jrst .cnco0		; Do the JSYS
>
TOPS20,<		; If TOPS-20 system
	jsr .mentr		; save acs, stack
	tlnn 1,77777
	 tlo 1,(1b3)		;if no structure, assume PS:
	setz 3,			; Don't worry about group privs
	call .cnchk		; check password, directory name
	 call screwup##		; shouldn't happen
	retgd			; leave good
>

; routine to check a password. Simulates TENEX CNDIR with B0 in AC1
; accepts 1/36-bit directory number
;	  2/pointer to password
; returns +1 if failure, Tenex error code in ac1
; returns +2 on success
.cnpsw:
TENEX,<			; If TENEX system
	hrli 1,(1b0)		; No, 1 ← flag,,dir #
	jrst .cnco0		; Do the JSYS
>
TOPS20,<		; If TOPS-20 system
	jsr .mentr		; save stats
	tlnn 1,77777
	 tlo 1,(1b3)		; If no structure, assume PS:
	setz 3,
	call .cnchk		; check password, dir #
	 call screwup##		; shouldn't happen
	retgd			; return good


; routine to check if connect is possible for this user
; called with 1/36-bit directory #
;	      2/pointer to password
;	      3/special bits:
;		B0 - Check group privileges and don't require
;		     password unless group priv insufficient
.cnchk::call chkdir		;make sure directory exists
	 reterr (CNDIX3)	;return with bad directory #
	tlne 3,(1b0)		;check group?
	 call chkgrp		; yes
	  caia			; failed, check password
	 jrst skpret##		; succeeded, leave good
	call chkpsw		;check password supplied
	 reterr (CNDIX1)	;return with bad password
	jrst skpret##		; Good


; routine to check for legal directory number
; accepts directory # in ac1
; returns +1 on failure, +2 on success
chkdir:	push p,2		; save password pointer
	move 2,1
	movei 1,.nulio
	dirst			; check dir # by DIRSTing to NUL:
	 jrst .chk1		; failed
	move 1,2		; success, restore acs
	pop p,2
	jrst skpret##

.chk1:	pop p,2			; failure, ret +1
	ret
>

TOPS20,<		; If TOPS-20 system
; routine to check for sufficient privileges for connect
; does NOT consider enabledness as privilege
; accepts 1/36-bit directory number of directory to connect to
;   USRNUM(CX)/current login directory
;   CONNUM(CX)/current connected directory
;
; returns +1 on insufficient privileges for non-password connect
;	  +2 on password unnecessary
chkgrp:	setom chkjfn		; not supplying a JFN in .CKAUD
	push p,1
	push p,2
	movei 2,.charg		; address of CHKAC arg block
	movei 1,.ckacn		; check for legal connect
	movem 1,.ckaac(2)
	move 1,-1(p)		; retrieve .ckaud arg
	call chkall
	 jrst chkdn1		; return +1
	jrst chkdne		; succeed, return +2

	
; routine to check for legal password
; accepts 1/36-bit directory number
;	  2/pointer to password
; returns +1 on illegal password, +2 on password OK
chkpsw:	push p,1
	push p,2
	call getpsw		; get password from directory
	hrroi 1,usepsw		; pointer to directory's psw in 1
	stcmp			; compare strings
	cain 1,0		; must be exact match
	 aos -2(p)
	pop p,2
	pop p,1
	ret
	

; routine to get a directory's password
; returns password in usepsw
; accepts 1/36-bit directory number
; returns +1 always
getpsw:	push p,2		; save password pointer
	movsi 2,(cd%psw)
	call getdir		; get directory info
	pop p,2
	ret
>

TOPS20,<		; If TOPS-20 system
; routine to get directory data block
; accepts 1/36-bit directory number
;	  2/LH: GTDIR bits (from CRDIR JSYS)
; returns +1 always (or jumps to SCREWUP##)
;	     directory in USRDIR
;	     password, if requested, in usepsw
;	     directory groups, if requested, in USRDGP
;	     user groups, if requested, in USRUGP
;	     default account, if requested, in useact
getdir:	push p,3
	push p,4
	move 3,[usrdir,,usrdir+1]
	setzm usrdir		; Clear the directory buffer
	blt 3,usrdir+gtdlen-1
	move 3,[usrugp,,usrugp+1]
	setzm usrugp		; And the user group table
	blt 3,usrugp+gtdlen-1
	move 3,[usrdgp,,usrdgp+1]
	setzm usrdgp		; And the directory group table
	blt 3,usrdgp+gtdlen-1
	hrrzi 4,usrdir
	hrri 3,gtdlen
	hrrzm 3,.cdlen(4)	; set data block length
	setz 3,	
	tlne 2,(cd%psw)		; want password?
	 move 3,[point 7,usepsw]
	movem 3,.cdpsw(4)
	setz 3,
	tlne 2,(cd%ugp)		; want user groups?
	 movei 3,usrugp
	movem 3,.cdugp(4)
	setz 3,
	tlne 2,(cd%dgp)		; want directory groups?
	 movei 3,usrdgp
	movem 3,.cddgp(4)
	setz 3,
	tlne 2,(cd%dac)		; want default account?
	 move 3,[point 7,useact]
	movem 3,.cddac(4)
	movei 3,10		; up to 10 dir/user groups
	tlne 2,(cd%ugp)
	 movem 3,usrugp
	tlne 2,(cd%dgp)
	 movem 3,usrdgp
	setz 3,
	tlne 2,(cd%psw)
	 move 3,usrdir+.cdpsw
	exch 4,2
	gtdir
	 ercal screwup##
	tlne 4,(cd%dpt)		; was want directory protection on?
	 jrst  [move 3,.cddpt(2)	; put it in safe place
		movem 3,usrdpt
		jrst .+1]
	pop p,4
	pop p,3
	ret
>

; routines to put directory names into strings
; accepts:  1 = dest ptr for string
;	    2 = 36 bit directory number
; both return +1 always
cpydrn:
TOPS20,<		; If TOPS-20 system
	 tlz 2,77777		; Yes, make dir # a user number
>
	dirst
	 call screwup##
	ret


; routine to simulate TENEX GDACC JSYS
; accepts 1/Address of 8 word string block in which to store
; 	    default account string
;	  2/36-bit directory number (-1 for self)
;returns +1 on failure, error code in AC1
;	 +2 successful
;GDACC ERROR MNEMONICS
GDACX2=601031			; No default account for this user

.GDACC:
TENEX,<			; If TENEX system
	gdacc			; Do the TENEX version
	 popj p,
	jrst skpret##
>
TOPS20,<		; If TOPS-20 system
	jsr .mentr
	camn 2,[-1]		; given -1 for directory?
	 move 2,usrnum(cx)	; use login directory #
	tlnn 2,77777
	 tlo 2,(1b3)		; If no structure, assume PS:
	push p,1		; save account string destination address
	setzm useact		; clear out last account string
	move 1,[useact,,useact+1]
	blt 1,useact+usrstl/5+1
	move 1,2
	movsi 2,(cd%dac)
	call getdir		; get the account string
	skipn useact
	 reterr (GDACX2)	; nothing was put there, must be no default
	pop p,1			; transfer file to destination block
	hrli 1,useact
	blt 1,usrstl/5(1)
	retgd			; and leave
>


; Routine for VACCT JSYS.  For TOPS-20, have to skip return on success.
; Entry:   1 = user #
;	   2 = acct designator
; Return:  +1, error in a
;	   +2, success
.vacct:
TENEX,<			; If TENEX system
	vacct			; TENEX JSYS
	 popj p,
	jrst skpret##
>
TOPS20,<		; If TOPS-20 system
	vacct			; Do the JSYS
	erjmp cpopj##		; Return +1 on error
	jrst skpret##		; And +2 on success
>

; routine to simulate TENEX CFGRP JSYS
; currently, no use for this exists in Tops20 implementation,
; so no code is written.
.cfgrp:
TENEX,<			; If TENEX system
	cfgrp			; TENEX, do the JSYS
	 popj p,		; No go
>
	jrst skpret##		; TOPS-20 just returns +2


TOPS20,<		; If TOPS-20 system
; routines to check for file access permission
; Since Tops20 PUPSRV doesn't have fork groups, we have to check
; to see if files can be read/written by user

; routine to check for read access of file
; accepts in 1/ JFN of file
;	USRNUM(CX)/ login user #
;	CONNUM(CX)/ connected directory # of user
; returns +1/ read access not allowed
;	  +2/ read access allowed

chkrd:	setzm chkjfn
	push p,1
	push p,2
	movei 2,.charg
	setzm .ckaac(2)
	call chkall
	 jrst chkf
	jrst chkdne

; routine to check for directory listing access
; accepts 1/JFN of file
chkdr:	setzm chkjfn
	push p,1
	push p,2
	movei 2,.charg
	movei 1,.ckadl
	movem a,.ckaac(2)
	move 1,-1(p)
	call chkall
	 jrst chkf
	jrst chkdne
>

TOPS20,<		; If TOPS-20 system
; routines to check for write access to file
; call chkwrd for directory, chkwr for file
; CHKWR is intended to be called for delete/rename, and CHKWRD for 
;  creating new files in directory

chkwrd:	setom chkjfn		; means checking directory (dir in 1)
	caia
chkwr:	setzm chkjfn		; means checking file (JFN in 1)
	push p,1
	push p,2
	movei 2,.charg
	movei 1,.ckawr
	skipge chkjfn		; checking directory write privs?
	 movei 1,.ckacf
	movem 1,.ckaac(2)
	move 1,-1(p)
	call chkall
	 jrst chkf		; failed
chkdne:	aos -2(p)
chkdn1:	pop p,2
	pop p,1
	ret

chkf:	movei 1,GJFX35		; say invalid directory access
	movem 1,-1(p)
	jrst chkdn1
	

; common routine to call CHKAC
; accepts 1/ word to go into .CKAUD in arg block
; .ckaac having already been set up by caller

chkall:	movem 1,.ckaud(2)	; save dest directory in arg block
	move 1,USRNUM(CX)				; And the login user #
	movem 1,.ckald(2)
	move 1,connum(cx)		; And the connected dir #
	movem 1,.ckacd(2)
	movsi 1,777000		; standard privilege word
	movem 1,.ckaec(2)
	setzm .ckapr(2)		; shouldn't need file protection
	movei 1,6		; length of arg block
	skipl chkjfn
	tlo 1,(ck%jfn)		; .CKAUD contains a JFN
	chkac
	 erjmp chkal1		; failed
	jumpe 1,cpopj##		; or not Allowed
	jrst skpret##		; return +2

; here if CHKAC failed
chkal1:	caie 1,ckax4		; file not on disk?
	 error <CHKAC failure: %1J> ; not the error, type out a message
	seto 1,			; make sure CHKALL succeeds
	popj p,			; return
>

ls usrlgn,usrstl/5+1		; login directory string
ls usrcdn,usrstl/5+1		; connected directory string
ls sftemp,usrstl/5+2		; Temp string for user name with @ on end
ls oftemp,usrstl/5+2		; Temp for dir string w/o brackets
ls ontemp,usrstl/5+2		; Temp for dir string with brackets

TOPS20,<		; If TOPS-20 system
ls usepsw,usrstl/5+1		; user password
ls useact,usrstl/5+1		; default account string
ls usrdpt			; directory protection of destination dir
gtdlen==20			; length of GTDIR data block
ls usrdir,gtdlen		; GTDIR data block
ls usrugp,gtdlen		; user group list
ls usrdgp,gtdlen		; directory group list
ls .charg,6			; CHKAC arg block
ls chkjfn			; flag to check JFN or directory in CHKAC
>

	end