	.title	K1180S	Server things unique to the exec we are using
	.ident	/2.0.06/
	.include	/SY:[1,2]COMMON.MAC/


	.if ndf, K11INC
	.ift
	.include	/IN:K11MAC.MAC/
	.endc

	.iif ndf, xrb	, .error ; INCULDE for [1,2]COMMON.MAC failed
	.iif ndf, k11inc, .error ; INCLUDE for IN:K11MAC.MAC failed
	.title	K1180S

	.psect	$code
	.enabl	lc
	.enabl	gbl

	.macro	clrfqb
	call	$clrfq
	.endm	clrfqb

	.macro	clrxrb
	call	$clrxr
	.endm	clrxrb



;	do a SYSTAT (also host commands)
;
;	01-Feb-84  11:11:34  Brian Nelson
;
;	We have several options for doing the remote WHO command.
;	First of all, we could spawn a job on a PK (or VT for M+)
;	and get  the output sent to a disk file and then send the
;	disk file over to the  reqesting Kermit.  This would have
;	the  advantage of keeping the command consistant with the
;	system managers desires.
;	The other option,  of course, is to do it ourself via the
;	appropiate  monitor directives  to get  that information.
;	That  option is really  only available for RSTS since RSX
;	does not have the directives needed to get that info from
;	the exec.  For now, I will  use the second option.  To be
;	used,  Kermit must run with  temporary privileges (RSTS).
;	To  patch out,  add (at task build time) the following to
;	the tkb command file.
;
;	GBLPAT=K11WHO:SYSTAT+0:240
;
;	It would, of course, be fairly straight forward to do the
;	SYSTAT  on a PK as I already  have the code to log output
;	to disk.
;
;
;	input:	@r5	value of channel to do i/o on, zero --> terminal
;	output:	r0	rsts error code if any.
;
;
;	12-Sep-86  10:31:20  BDN	Convert to I/D space

	.macro	dosys	jobnum	,type
	mov	type	,-(sp)
	mov	jobnum	,-(sp)
	call	.dosys
	cmp	(sp)+	,(sp)+
	.endm	dosys




	.sbttl	the real work of systat

systat::br	5$			; skip the error exit
	mov	#10.	,r0		; return protection violation
	return				; bye

5$:	save	<r1,r2,r3,r4,r5>	; save all registers please
	sub	#120	,sp		; allocate a text buffer
	call	getprv			; we need temp privs
	mov	#512.	,xrb+0		; try a peek to see if we have
	.peek				; priv's to run with
	movb	firqb	,r0		; well ?
	bne	100$			; none, so exit please

	clr	r4			; index # of job to do


10$:	mov	sp	,r3		; point to our local buffer now
	inc	r4			; jobnumber := jobnumber+1
	dosys	r4	,#0		; do the uu.sys part 0 please
	tstb	r0			; did it work ?
	beq	20$			; yes
	cmpb	r0	,#10.		; no job of such number present?
	beq	80$			; yes, just do the next job then
	br	100$			; no, exit then as we are all done
20$:	tstb	firqb+5			; is the job we found attached ?
	bmi	80$			; yes, skip it then
	deccvt	r4,r3,#3		; convert job number to ascii
	add	#3	,r3		; and point to end of the string
	movb	#40	,(r3)+		; stuff a space in
	movb	#40	,(r3)+		; stuff a space in
	call	cvtppn			; convert the ppn next
	movb	#40	,(r3)+		; again a space please
	call	cvtkb			; get the kb number next
	mov	#firqb+22,r1		; get the program name next
	call	rad			; convert to ascii and fix pointer
	dosys	r4	,#1		; get the current size now
	movb	firqb+16,r0		; where it returned the size
	deccvt	r0,r3,#5		; convert with at least 3 spaces
	add	#5	,r3		; move the pointer right along
	movb	#'K	,(r3)+		; the size please
	movb	#40	,(r3)+		; spaces again
	movb	#40	,(r3)+		; spaces again
	movb	#40	,(r3)+		; spaces again
	dosys	r4	,#0		; get the info part zero back
	mov	#firqb+34,r1		; and the current RTS name now
	call	rad			; convert to ascii and fix pointer
	clrb	@r3			; all done at last
	mov	sp	,r3		; point back to the buffer
	call	doio			; do the i/o at last
80$:	br	10$			; next please


100$:	cmpb	r0	,#18.		; end of the table ?
	bne	110$			; no
	clr	r0			; yes
110$:	add	#120	,sp		; pop the local buffer
	unsave	<r5,r4,r3,r2,r1>	; pop temps and exit
	call	drpprv			; please do this
	return





	.sbttl	utilities and the actual i/o
	.enabl	lsb

doio:	tst	@r5			; channel zero today ?
	bne	10$			; no, assume disk then
	print	r3
	print	#200$
	br	100$
10$:	strlen	r3			; try to a disk file now
	calls	putrec	,<r3,r0,@r5>	; write to the passed LUN
100$:	return

	.save
	.psect	$pdata	,d
200$:	.byte	cr,lf,0
	.even
	.restore
	.dsabl	lsb


rad:	calls	rdtoa	,<r3,(r1)+>	; common code to to rad50 cvt
	add	#3	,r3		; pointer := pointer + 3
	calls	rdtoa	,<r3,(r1)+>	; common code to to rad50 cvt
	add	#3	,r3		; pointer := pointer + 3
	return




	.sbttl	misc utilities
	.enabl	lsb

cvtppn:	save	<r0,r1>			; save temps please
	sub	#20	,sp		; convert ppn to ascii next
	mov	sp	,r0		; a pointer to the ppn
	clr	r1			; get the project number now
	bisb	firqb+27,r1		; ok
	bne	10$			; if <> 0 then a real account
	mov	#200$	,r1		; if eq 0 then not logged it yet
	br	20$			; copy over *,*
10$:	deccvt	r1,r0,#3		; convert it to decimal
	add	#3	,r0
	movb	#',	,(r0)+		; stuff a comma in please
	clr	r1			; get the programmer number now
	bisb	firqb+26,r1		; ok
	deccvt	r1,r0,#3		; convert it to decimal
	mov	sp	,r1		; point to the buffer now
20$:	movb	#40	,(r3)+		; stuff a space into our result
	mov	#7	,r0		; seven characters to copy
30$:	movb	(r1)+	,(r3)+		; and copy the rest of it
	sob	r0	,30$		; simple
	movb	#40	,(r3)+		; stuff a space into our result
	movb	#40	,(r3)+		; stuff a space into our result
	movb	#40	,(r3)+		; stuff a space into our result
	add	#20	,sp		; pop the local buffer
	unsave	<r1,r0>
	return
	
	.save
	.psect	$pdata	,d
200$:	.asciz	/  *,  */
	.even
	.restore
	.dsabl	lsb

cvtkb:	save	<r0,r1>			; convert kb number to ascii
	sub	#10	,sp		; allocate a local buffer
	mov	sp	,r1		; point to it
	movb	firqb+5	,r0		; KB number to convert
	movb	#'K	,(r3)+		; insert a header
	movb	#'B	,(r3)+		; simple
	deccvt	r0,r1,#3		; can't ever be more than 127
	mov	r3	,-(sp)		; saev the output pointer now
	mov	#3	,r0		; three at most to copy over
10$:	cmpb	@r1	,#40		; a space present ?
	beq	20$			; yes, please ignore it
	movb	@r1	,(r3)+		; copy it over at last
20$:	inc	r1			; next ch please
	sob	r0	,10$		; simple
	movb	#40	,(r3)+		; insert some spaces now
	movb	#40	,(r3)+		; insert some spaces now
	movb	#40	,(r3)+		; insert some spaces now
	movb	#40	,(r3)+		; insert some spaces now
	mov	(sp)+	,r3		; restore the old pointer
	add	#5	,r3		; say we copied 5+2 characters over
	add	#10	,sp		; pop the local buffer and exit
	unsave	<r1,r0>			; pop registers
	return
	


$clrxr:	save	<r0>
	mov	#xrb	,r0
10$:	clr	(r0)+
	cmp	r0	,#xrb+14
	blos	10$
	unsave	<r0>
	return



$clrfq:	save	<r0>
	mov	#firqb	,r0
10$:	clr	(r0)+
	cmp	r0	,#firqb+36
	blos	10$
	unsave	<r0>
	return




.dosys:	clrfqb				; clear the firqb out first
	movb	#uu.sys	,firqb+fqfun	; do a systat call to RSTS
	movb	2(sp)	,firqb+4	; job number to do it for
	movb	4(sp)	,firqb+5	; which type (0 or 1)
	.uuo				; simple
	movb	firqb	,r0		; return with error code in r0
	return				; bye

	.sbttl	do the server C command for RSTS/E version 8

;	13-Apr-84  13:15:50  Brian Nelson
;
;	input:	@r5	address of command string
;		2(r5)	LUN to send the output to, zero implies TT:
;	output:	r0	error code (rms or RSTS/E)
;
;	Note:	This is a very SIMPLE version of the code I wrote
;		several years ago to do complete PK handling.  In
;		this version, we NEVER try to read anything  from
;		the users keyboard, nor do we EVER write anything
;		to it  since it is assumed that we are supporting
;		the server host command packet stuff. Any attempt
;		by the invoked CCL/DCL command to read input will
;		cause the program (and job) to be aborted.


	.iif ndf, corcom, corcom = 460

	.psect	pkbuff	,rw,lcl,rel,con,d

pkbuff:	.blkb	200
pkbufp:	.word	0
pkbufs:	.word	0
jobnum:	.word	0
	.even
pkbsiz	=	200


	.sbttl	the real work of sercmd
	.psect	$code

sercmd::clr	pkbufs			; insure no data is left in buffer
	mov	#jfsys	,xrb+0		; get temp privs back
	.set				; simple to do
	call	openpk			; find an available PK
	tst	r0			; perhaps we could not get one
	bne	100$			; r0 will have RSTS/E error code
	call	logv8			; get logged in on the PK
	tst	r0			; if it fails, it's the error code
	bne	100$			; oops
	mov	r1	,jobnum		; save the jobnumber please
	movb	#'c&37	,-(sp)		; no, force a control C
	call	putpk			; simple
	mov	#2	,xrb+0		; wait a moment
	.sleep				; simple. any i/o will wake us up
5$:	call	getpk			; eat the result of the control C
	tst	r0			; loop until eofeof error (11)
	beq	5$			; go back for more
	mov	#10	,r1		; wait for kmon
10$:	mov	jobnum	,-(sp)		; simple
	call	jobsts			; waiting for KB input now ?
	tst	r0			; well?
	bmi	15$			; ok
	mov	#1	,xrb+0		; wait a moment
	.sleep				; simple. any i/o will wake us up
	sob	r1	,10$		;

15$:	mov	@r5	,-(sp)		; do it
	call	sendcmd			; ok
	mov	#10	,xrb+0		; wait a little while before checking
	.sleep				; job status. any i/o will reset this


20$:	call	getpk			; now get the result of the command
	tst	r0			; did it work ?
	bne	30$			; no, find out why then
	call	output			; dump the ch read to somewhere
	br	40$
30$:	mov	jobnum	,-(sp)		; the job number
	call	jobsts			; find out what's happening here
	tst	r0			; if ge, then it's just running
	bmi	90$			; it's waiting for input or all done
	mov	#1	,xrb+0		; if ok, take a one second nap
	.sleep				; simple
40$:	br	20$			; try to get some more data now

90$:	mov	#377	,r0		; a fake error to return

100$:	mov	#jfsys	,xrb+0
	.clear
	call	killpk
	return



	.sbttl	where to put the output

output:	tst	2(r5)			; the LUN to use
	bne	10$			; a disk
	movb	r1	,-(sp)		; the terminal
	mov	sp	,r1		; a pointer
	print	r1	,#1		; dump it
	tst	(sp)+			; pop the buffer and exit
	br	100$			; bye
10$:	movb	r1	,r0		; rms output today
	mov	2(r5)	,r1		; the channel
	call	putcr0			; simple to do
100$:	return				; bye



	pk.lun	=	12.


openpk:	mov	r1	,-(sp)		; save this one today
	clr	r1			; start at PK0:
10$:	clrfqb				; insure no defaults
	movb	#opnfq	,firqb+fqfun	; open the thing up now
	movb	#pk.lun*2,firqb+fqfil	; channel number times 2
	movb	r1	,firqb+fqdevn	; device unit number please
	movb	#377	,firqb+fqdevn+1	; unit is for real here
	mov	#"PK	,firqb+fqdev	; device name also
	calfip				; try to open it up
	movb	firqb	,r0		; get the rsts error code if any
	beq	100$			; all is well
	cmpb	r0	,#6		; invalid device ?
	beq	100$			; yes exit with this error
	inc	r1			; else try again
	br	10$			; next please
100$:	mov	(sp)+	,r1		; pop r1 and exit
	return


	.sbttl	create a logged in job for the PK (version 8 only)

;	Creates a job under the current account for the PK that's
;	open on PK.LUN.
;
;	returns: r0	rsts error code
;		 r1	created job number


logv8:	movb	#uu.sys	,firqb+fqfun	; get the user's default RTS please
	clr	firqb+4			; current job, systat part 0
	.uuo				; simple, can't fail either
	mov	firqb+26,-(sp)		; save the user's account number
	mov	firqb+32,-(sp)		; save the user's defkbm
	mov	firqb+30,-(sp)		; save the user's defkbm
	clrfqb				; now get the kb number for the PK
	movb	#uu.fcb	,firqb+fqfun	; get the DDB returned for it
	movb	#pk.lun	,firqb+fqfun+1	; channel number that we want
	.uuo				; default to GET DDB info
	movb	firqb+14,-(sp)		; save it
	asrb	(sp)			; not times two please

	clrfqb				; version 8, enter a run time system
	mov	#firqb+fqfun,r0		; at the p.new entry point
	movb	#uu.job	,(r0)+		; create a job function for fip
	movb	#20!100!200,(r0)+	; create logged in @ defkbm always
	movb	(sp)+	,(r0)+		; kb number to attach to job
	clr	(r0)+			; unused field
	mov	(sp)+	,(r0)+		; user's default run time system
	mov	(sp)+	,(r0)+		; both rad50 words please
	clr	(r0)+			; unused field
	mov	(sp)+	,@r0		; account number also
	bisb	#40	,firqb+4	; set flag for account to login to
	movb	corcom	,-(sp)		; save this please
	clrb	corcom			; core common is also passed
	.uuo				; try to create the job now
	movb	(sp)+	,corcom		; restore first byte of core common
	movb	firqb+4	,r1		; created job number please
	asr	r1			; but not times two
	movb	firqb	,r0		; did it work?
	bne	110$			; no
	tstb	firqb			; huh
	clc				; yes, flag success and exit
	return				; bye

110$:	sec				; job creation failed, exit
	return				; set a flag and return


	

	.sbttl	pkread/write	i/o for the pk


getpk:	clrxrb				; clear xrb
	tst	pkbufs			; any buffered data left to get?
	bne	10$			; no
	call	200$			; reload the buffer please
	tst	r0			; get anything ?
	bne	100$			; no, exit
10$:	mov	pkbufp	,r0		; yes, get a pointer to the buffer
	clr	r1			; avoid sign extension
	bisb	pkbuff(r0),r1		; get the ch now
	inc	pkbufp			; advance the pointer for next time
	dec	pkbufs			; one less character left to get
	clr	r0			; say it worked
100$:	return				; bye

200$:	clr	pkbufp			; no data, clear buffer pointer
	clrxrb				; no defaults
	mov	#pkbsiz	,xrb+xrlen	; as many as we can grab
	mov	#pkbuff	,xrb+xrloc	; buffer location
	movb	#pk.lun*2,xrb+xrci	; channel #
	inc	xrb+xrtime		; wait at most one second
	.read				; read from pk
	movb	firqb	,r0		; get any error codes
	bne	210$			; no
	mov	xrb+xrbc,pkbufs		; it worked, init the bytes left
210$:	return				; back to work...


putpk:	clrxrb				; no odd things please
	inc	xrb+xrlen		; one ch to do
	mov	sp	,xrb+xrloc	; buffer location
	add	#2	,xrb+xrloc	; off by one
	mov	#1	,xrb+xrbc	; byte count
	movb	#pk.lun*2,xrb+xrci	; channel #
	mov	#9.	,xrb+xrmod	; record 9%
	.write				; write to pk
	movb	firqb	,r0		; result
	mov	(sp)+	,(sp)		; pop ch that we wrote
	return				; back to work...



	.sbttl	pk utilities


sendcmd:mov	r1	,-(sp)
	mov	4(sp)	,r1		; command address to send to PK
10$:	tstb	@r1			; done yet ?
	beq	100$			; yes, exit
	movb	(r1)+	,-(sp)		; loop until a null is found
	call	putpk			; simple
	br	10$			; next please
100$:	mov	(sp)+	,r1		; pop register we used
	mov	(sp)+	,(sp)		; pop address of string and exit
	mov	#cr	,-(sp)		; finish with a carriage return
	call	putpk			; simple
	return
	

waitpk:	clrxrb				; no odd things please
	mov	sp	,xrb+xrloc	; buffer location
	movb	#pk.lun*2,xrb+xrci	; channel #
	mov	#6.	,xrb+xrmod	; record 2+4
	.write				; write to pk
	tstb	firqb			; result
	beq	100$			; it's ready for a command
	cmpb	firqb	,#28.		; need a control C?
	beq	100$
	sec				; it's not ready	
	return
100$:	clc
	return				; back to work...


killpk:	clrxrb				; no odd things please
	mov	sp	,xrb+xrloc	; buffer location
	movb	#pk.lun*2,xrb+xrci	; channel #
	mov	#20	,xrb+xrmod	; record 2+4
	.write				; write to pk
	clrfqb				; now close it up
	movb	#clsfq	,firqb+fqfun	; simple
	movb	#pk.lun*2,firqb+fqfil	; channel to do
	calfip				; do it
	return				; back to work...

	

	.sbttl	jobsts	return status of the controlled job


;	input:	2(sp)	job number 
;	output:	r0	< 0 then kb stall, 0 waiting for tt output, > 0 running
;
;	This will be called to determine when the spawned job should
;	be aborted.
;
;	r0	= -2	the job is logged out, waiting for input or
;			in a kmon wait
;	r0	= -1	timeout
;	r0	= 0	job is waiting for output to the PK
;	r0	> 0	job is in a run state

	.jbstat	=	12
	.jbwait	=	14
	.iif ndf, j2con	,j2con	=	4
	.iif ndf, j2nopr,j2nopr	=	10000
	.iif ndf, js.kb	,js.kb	=	2
	.iif ndf, js.tel,js.tel	=	4000


jobsts:	mov	r1	,-(sp)		; we may access these here
	mov	r2	,-(sp)		; save these also
	movb	#uu.sys	,firqb+fqfun	; for looking up a job
	movb	6(sp)	,firqb+fqfun+1	; job number to do
	movb	#1	,firqb+fqfun+2	; part two to do please
	.uuo				; do it
	tstb	firqb			; did it work ?
	bne	90$			; no, return abort please
	bit	#jfnopr	,firqb+6	; logged in ?
	bne	90$			; no, return abort then
	mov	firqb+.jbstat,r1	; get the current jbstat word
	mov	firqb+.jbwait,r2	; get the current jbwait word
	com	r1			; and get the and of the two
	bic	r1	,r2		; if result <> 0 then job is
	bne	10$			; running ok
	bit	#js.kb	,firqb+.jbwait	; not running, stalled for kb input?
	bne	90$			; yes, abort the job then
	bit	#js.tel	,firqb+.jbwait	; waiting for tt output
	bne	80$			; yes

10$:	mov	firqb+34,xrb+0		; no, check the elapsed time please
	add	#j2con	,xrb+0		; simple
	.peek				; do it
	tstb	firqb			; did that work ?
	bne	90$			; no, die
	cmp	xrb+0	,#300		; allow three minutes at most
	bhis	95$			; no, die
	mov	#1	,r0		; all is well, exit
	br	100$

80$:	clr	r0			; job is waiting on tt output
	br	100$			; bye

90$:	mov	#-2	,r0		; waiting on KB or logged out
	br	100$			; bye

95$:	mov	#-1	,r0		; timeout
	br	100$			; exit

100$:	mov	(sp)+	,r2		; exit
	mov	(sp)+	,r1
	mov	(sp)+	,(sp)		; pop parameter and exit
	return

	.iif ndf , UU.CHK,	UU.CHK = 40
	.iif ndf , UU.PRV,	UU.PRV = 34
	.iif ndf , NOSUCH,	NOSUCH = 5
	.iif ndf , NOTAVL,	NOTAVL = 10
	.iif ndf , PRVIOL,	PRVIOL = 12
	.iif ndf , QUOTA ,	QUOTA  = 105



	.sbttl	LOGIN	Login from a remote server command


;	LOGIN	24-Sep-85  10:01:33  Brian Nelson (V9.x and later only)
;		Added on Edit 2.36
;
;
;	Passed:	0(r5)	Address (asciz) of PPN to log into
;		2(r5)	Address (asciz) of password
;		4(r5)	Address of where to return informative messages
;	Return:	R0	Zero for success, else the error code.

	.enabl	lsb

login::	save	<r1,r2>			; save work regs
	call	dolin			; try to switch
	tst	r0			; successful ?
	beq	100$			; yes
	clr	r1			; no, Reply with a reasonable error
10$:	tstb	200$(r1)		; end of the list
	beq	20$			; yes, use a catchall error
	cmpb	200$(r1),r0		; find the error yet ?
	beq	20$			; yes
	inc	r1			; no
	br	10$			; next please
20$:	asl	r1			; times two for word addressing
	mov	r0	,-(sp)		; save the error code
	strcpy	4(r5),210$(r1)		; simple
	mov	(sp)+	,r0		; restore the error code
100$:	unsave	<r2,r1>			; exit
	return				; and exit


	.save
	.psect	$PDATA	,D

200$:	.byte	NOSUCH,NOTAVL,PRVIOL,QUOTA,0
	.even
210$:	.word	220$  ,230$  ,240$  ,250$ ,220$
220$:	.asciz	/Invalid password or account, or system password needed/
230$:	.asciz	/Expired, non-interactive or non-dialup account/
240$:	.asciz	/WACNT privilege needed for REMOTE LOGIN/
250$:	.asciz	/Some quota is exceeded/
	.even
	.restore
	.dsabl	lsb


	.sbttl	really do the login now


;	DOLIN:
;
;	Passed:	0(r5)	Address of the PPN (.asciz) to log into
;		2(r5)	Address of the password (.asciz) to log into
;
;	Return:	r0	=  0 for success
;		r0	<> 0 with RSTS/E error code


dolin:	sub	#10	,sp		; allocate a buffer for use here
	mov	#WACNT	,-(sp)		; check to see if we have WACNT priv
	call	chkprv			; do it
	tst	r0			; do we have WACNT privilege ?
	beq	90$			; no
	clrxrb				; yes, continue on by clearing the
	clrfqb				; XRB and FIRQB
	movb	#UU.SWP	,FIRQB+FQFUN	; To find out the physical name of
	movb	#2	,FIRQB+FQFIL	; the system disk we will call the
	movb	#377	,FIRQB+5	; exec to find out the name of swap
	.UUO				; file 2, which is always on _SY0:
	mov	FIRQB+FQDEV,(sp)	; Also, no privilege is needed.
	mov	FIRQB+FQDEVN,2(sp)	; copy the device name and unit flags
	clrfqb				; clear things out again to do a .FSS
	mov	@r5	,r0		; on the passed PPN to convert it to
10$:	tstb	(r0)+			; the proper format.
	bne	10$			; Find the length of the string
	sub	@r5	,r0		; end of it, subtract starting address
	dec	r0			; and correct for autoincrement
	mov	r0	,XRB+0		; stuff the string length
	mov	r0	,XRB+2		; again
	mov	@r5	,XRB+4		; and the buffer address
	.FSS				; call the exec
	movb	FIRQB	,r0		; Did this work
	bne	100$			; If not, must be a invalid PPN format
	mov	FIRQB+FQPPN,4(sp)	; Save the parsed PPN please
	movb	#UU.LIN	,FIRQB+3	; Finally, do a password check on the
	movb	#1+<2*1>,FIRQB+5	; desired account to log into.
	mov	#FIRQB+FQNAM1,r1	; This presumes version 9.x, using
	mov	2(r5)	,r0		; ascii passwords.
20$:	movb	(r0)+	,(r1)+		; copy the password over to the FIRQB
	bne	20$			; not yet done
	mov	(sp)	,FIRQB+FQDEV	; Lastly, restore the system disk name
	mov	2(sp)	,FIRQB+FQDEVN	; unit number and units flags.
	.UUO				; Finally call the exec to check it.
	movb	FIRQB	,r0		; But did the passwords match ?
	bne	100$			; No, exit on error then
	clrfqb				; Next, we must log out to be able to
	incb	FIRQB+4			; Must NOT close i/o channels up.
	movb	#UU.BYE	,FIRQB+FQFUN	; log back in again (Remember, we need
	.UUO				; WACNT to avoid self kill by the exec)
	movb	FIRQB	,r0		; Did this work ?
	bne	100$			; no, exit please
	cmp	FIRQB+4	,#-1		; Did the logout succeed ?
	beq	80$			; no (quota exceeded)
	clrfqb				; Clear the FIRQB one last time
	movb	#UU.LIN	,FIRQB+FQFUN	; Login function for .UUO
	movb	#10*1	,FIRQB+5	; We can skip the password check as we
	mov	4(sp)	,FIRQB+FQPPN	; already checked and we needed WACNT
	.UUO				; at LAST .....
	movb	FIRQB	,r0		; save and exit
	bne	100$			; ....
	call	setprv			; set authorized privileges up
	clr	r0			; it's ok
	br	100$			; exit

80$:	mov	#QUOTA	,r0		; UU.BYE failed due to a quota
	br	100$
90$:	mov	#PRVIOL	,r0		; No WACNT--> protection violation
100$:	add	#10	,sp		; pop buffer and exit
	return

	.save
	.psect	$PDATA	,D
wacnt:	.asciz	/WACNT/
exqta:	.asciz	/EXQTA/	
	.even
	.restore



	.sbttl	detach the server


detach::clrfqb				; insure no defaults
	movb	#UU.SYS	,FIRQB+FQFUN	; do a systat and get the kb number
	.UUO				; simple to do
	movb	FIRQB+5	,r1		; save the kb number
	clrfqb				; insure no defaults
	movb	#clsfq	,FIRQB+FQFUN	; insure KB: is detached
	movb	#5*2	,FIRQB+FQFUN+1	; the lun for it
	CALFIP				; do it, skip any error codes
	clrfqb
	movb	#UU.DET	,FIRQB+FQFUN	; the uuo detach code
	movb	#200	,FIRQB+FQFUN+1	; close all luns for KB:
	.UUO				; simple to do
	movb	FIRQB	,r0		; return any errors
	bne	100$			; yep
	mov	#1	,xrb+0
	.sleep
	clrfqb				; now spawn a job attached
	mov	#FIRQB+FQFUN,r0		; to our old kb
	movb	#UU.JOB	,(r0)+		; create a job exec call
	movb	#20!100!200,(r0)+	; into def kbm, no logins is ok
	movb	r1	,@r0		; the kb number to attach to
	bne	10$			; not KB0:
	movb	#200	,@r0		; KB0:, must set flag for it
10$:	.UUO				; simple to do, ignore errors
	clr	r0			; return success
100$:	return



	.sbttl	check for AUTHOURIZED priv

;	This  is  again  different  from  CHKPRV,  which  checks for
;	CURRENT priv, and JOBPRV, which checks for JOB  priv  as  in
;	SET  JOB/[NO]PRIV.  This  one  goes out to disk and gets the
;	AUTHORIZED priv mask and checks for the passed priv. 
;
;	Passed:	2(sp)	Name of priv to check, upper case please
;	Return:	R0	1 for success or pre 9.x, zero for no priv
;
;	Example:
;
;	mov	#HWCFG	,-(sp)
;	call	JOBPRV
;	tst	r0
;	beq	error
;
;
; hwcfg:.asciz	/HWCFG/
;	.even


authpr::mov	r1	,-(sp)		; /41/ Save a register
	mov	r2	,-(sp)		; /41/ ... save another one
	sub	#10	,sp		; /41/ temp save area
	mov	#1	,r2		; /41/ Assume success
	tst	ver9.x			; /41/ version nine or later?
	beq	100$			; /41/ no, return( success )
	clrfqb				; /41/ Clear firqb out
	mov	#FIRQB+FQFUN,r1		; /41/ Read authorized priv mask
	movb	#UU.ATR	,(r1)+		; /41/ Function to perform
	movb	#377	,(r1)+		; /41/ Read function
	movb	#2	,(r1)+		; /41/ Read AUTHORIZED priv mask
	.UUO				; /41/ Go to it
	mov	#FIRQB+12,r0		; /41/ Where the priv mask is
	mov	sp	,r1		; /41/ Where to save it
	mov	(r0)+	,(r1)+		; /41/ Save it please
	mov	(r0)+	,(r1)+		; /41/ .Save it please
	mov	(r0)+	,(r1)+		; /41/ ..Save it please
	mov	(r0)+	,(r1)+		; /41/ ...Save it please
	clrfqb				; /41/ clear firqb out
	mov	#FIRQB+FQFUN,r0		; /41
	movb	#UU.CHK	,(r0)+		; /41/ Convert priv name to bitmask
	inc	(r0)+			; /41/ Subfunbction code = 1
	tst	(r0)+			; /41/ skip this field
	mov	2+14(sp),r1		; /41/ copy the priv over
10$:	movb	(r1)+	,(r0)+		; /41/ copy the asciz name over
	bne	10$			; /41/ simple
	.UUO				; /41/ convert NAME to MASK
	mov	sp	,r1		; /41/ point back to save area
	mov	#FIRQB+FQNAM1,r0	; /41/ Where the bit pattern is
	mov	#4	,r2		; /41/ Four words to check
20$:	bit	(r0)+	,(r1)+		; /41/ Any bit(s) set here ?
	bne	30$			; /41/ Yes, we have it
	sob	r2	,20$		; /41/ No, keep looking
	br	90$			; /41/ Failure
30$:	mov	#1	,r2		; /41/ Flag we have it
	br	100$			; /41/ exit

90$:	clr	r2			; /41/ failure
100$:	mov	r2	,r0		; /41/ Return the status now
	add	#10	,sp		; /41/ Pop buffer
	mov	(sp)+	,r2		; /41/ ...Pop a register
	mov	(sp)+	,r1		; /41/ Pop a register
	mov	(sp)+	,(sp)		; /41/ Pop over the parameter
	return				; /41/ At last




	.sbttl	Logout

;	LOGOUT
;
;	Logout from the RSTS/E host from the server
;
;	Rewritten 3.45 11-Feb-86  15:25:17  BDN for version 9.x
;
;	Check quotas, if ok, drop the line and logout


logout::save	<r0,r1,r2>		; /45/ Save registers
	clr	r2			; /45/ Preset EXQTA priv flag
	tst	ver9.x			; /45/ Version nine or later
	beq	50$			; /45/ No, skip the quota check
	mov	#exqta	,-(sp)		; /45/ V9, see if we have EXQTA
	call	chkprv			; /45/ ...
	mov	r0	,r2		; /45/ Save the flag
	bne	10$			; /45/ EXQTA, skip quota checks
					;
	clrfqb				; /45/ Ensure FIRQB is cleared out
	movb	#UU.ATR	,FIRQB+FQFUN	; /45/ Do some quota checks
	decb	FIRQB+4			; /45/ Read account attributes
	incb	FIRQB+5			; /45/ We want quota data
	.UUO				; /45/ Get the data
	tstb	FIRQB			; /45/ Did this work ?
	bne	50$			; /45/ No, just log out then
	cmpb	FIRQB+21,FIRQB+17	; /45/ Is MSB of quota OK ?
	bhi	100$			; /45/ No, exit
	cmp	FIRQB+24,FIRQB+12	; /45/ Is current usage < outquota?
	bhi	100$			; /45/ No
					;
10$:	clrfqb				; /45/ Yes, get keyboard number
	movb	#UU.SYS	,FIRQB+FQFUN	; /45/ UU.SYS part 0
	.UUO				; /45/ We have it now
	movb	FIRQB+5	,r1		; /45/ Save it
	bitb	#200	,r1		; /45/ Detached?
	bne	50$			; /45/ Yes, skip hangup
	clrfqb				; /45/ Get set to disconnect line
	movb	#UU.HNG	,FIRQB+FQFUN	; /45/ At last....
	movb	r1	,FIRQB+4	; /45/ Line to do it to
	incb	FIRQB+5			; /45/ Do it quickly (1 second)
	.UUO				; /45/ Drop the line, now log out
					;
50$:	clrfqb				; /45/ Clear FIRQB out
	movb	#UU.BYE	,FIRQB+FQFUN	; /45/ Log out now
	tst	r2			; /45/ Version 9 and EXQTA ?
	beq	60$			; /45/ No
	movb	#2	,FIRQB+4	; /45/ Yes, bypass quota checks
60$:	.UUO				; /45/ Call the EXEC
	cmp	FIRQB+4	,#-1		; /45/ Are we logged out ?
	beq	100$			; /45/ No
	call	exit			; /45/ Yes, exit please (never happen)
100$:	unsave	<r2,r1,r0>		; /45/ Pop registers
	return				; /45/ Quota must be exceeded




	.sbttl	Check current quotas to see if UU.BYE will succeed


quochk::tst	ver9.x			; /45/ Version nine or later
	beq	30$			; /45/ No, skip the quota check
	mov	#exqta	,-(sp)		; /45/ V9, see if we have EXQTA
	call	chkprv			; /45/ ...
	tst	r0			; /45/ Save the flag
	beq	10$			; /45/ No EXQTA, do quota checks
	clr	r0			; /45/ EXQTA, return(success)
	br	100$			; /45/ Exit
					;
10$:	clr	r0			; /45/ Assume SUCCESS
	clrfqb				; /45/ Ensure FIRQB is cleared out
	movb	#UU.ATR	,FIRQB+FQFUN	; /45/ Do some quota checks
	decb	FIRQB+4			; /45/ Read account attributes
	incb	FIRQB+5			; /45/ We want quota data
	.UUO				; /45/ Get the data
	tstb	FIRQB			; /45/ Did this work ?
	bne	100$			; /45/ No, just return(success)
	cmpb	FIRQB+21,FIRQB+17	; /45/ Is MSB of quota OK ?
	bhi	20$			; /45/ No, exit
	cmp	FIRQB+24,FIRQB+12	; /45/ Is current usage < outquota?
	blos	100$			; /45/ Yes
20$:	mov	sp	,r0		; /45/ No, return(nonzero)
	br	100$			; /45/ Exit

30$:	clrfqb				; /45/ Pre version 9 code
	movb	#UU.RAD	,FIRQB+FQFUN	; /45/ rad accounting data please
	.UUO				; /45/ simple
	clr	r0			; /45/ assume success
	tstb	FIRQB			; /45/ did it work ?
	bne	100$			; /45/ no
	tst	FIRQB+34		; /45/ unlimited quota here ?
	beq	100$			; /45/ yes
	cmp	FIRQB+6,FIRQB+34	; /45/ is used > allowed ?
	blos	100$			; /45/ quota is ok
	mov	sp	,r0		; /45/ quota is not ok, flag it

100$:	return				; /45/ Return to caller




	.sbttl	Return disk space usage

;	D S K U S E
;
;	input:	@r5	address of string to return the usage

	.enabl	lsb

dskuse::save	<r0,r1>
	clrfqb				; clear FIRQB out
	movb	#UU.RAD	,FIRQB+FQFUN	; uuo function, read accounting data
	.UUO				; do it
	mov	@r5	,r1		; point to the output string
	copyz	#120$	,r1		; copy a header over please
	strlen	r1			; get the current length
	add	r0	,r1		; point to the end of the string
	deccvt	<FIRQB+6>,r1,#6		; and convert used to string
	add	#6	,r1		; point to the end again
	copyz	#130$	,r1		; copy some more stuff
	strlen	r1			; get the count of chars we copied
	add	r0	,r1		; point to the end of the string
	mov	FIRQB+34,r0		; get the quota
	bne	10$			; not unlimited
	copyz	#140$	,r1		; unlimited, say so
	br	20$
10$:	sub	FIRQB+6	,r0		; and get the free space
	deccvt	r0	,r1		; copy the free space over now
	clrb	6(r1)			; make the string .asciz
20$:	unsave	<r1,r0>
	return				; bye


	.save
	.psect	$PDATA	,D
120$:	.asciz	/SY: Space used /
130$:	.asciz	/    Space free /
140$:	.asciz	/    Unlimited/
	.even
	.restore
	.dsabl	lsb

	.end
