	.title	login	custom version for U of Toledo
	.ident	/7.0.01/

;	copyright (C) 1981 brian nelson

;	********************************************
;	*					   *
;	*	    Brian Nelson		   *
;	*	    Computer Services		   *
;	*	    University of Toledo	   *
;	*	    2801 West Bancroft		   *
;	*	    Toledo , Ohio 43606		   *
;	*	    (419) 537-2511		   *
;	*					   *
;	********************************************
;
;
;	
;	This software is furnished under a license and may
;	be  used  and  copied  only in accordance with the
;	terms of such license and with  the  inclusion  of
;	the  above copyright notice.  This software or any
;	other copies thereof may not be provided or other-
;	wise made available to any other person.  No title
;	to and ownership of the software is hereby  trans-
;	ferred. No SOURCE code can be copied.
;	
;	The information in this  software  is  subject  to
;	change  without notice and should not be construed
;	as a commitment by the University of Toledo or  by
;	the author.
;	
;
;
;   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
;   !!								!!
;   !!			W A R N I N G				!!
;   !!								!!
;   !!	This can not be linked with 'iolib' as all variables	!!
;   !!	are referenced off of the stack,  and iolib  modules	!!
;   !!	often return error codes in a global. External modules	!!
;   !!  should be able to, however, as long as there are no	!!
;   !!	references to global names in this module		!!
;   !!								!!
;   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
;
;
;	edit history
;
;	21-sep-81	bdn	initial coding
;	13-oct-81	bdn	mods for using $common.mac
;				changed 'usrppn' to 'myppn'
;				included src of some macros
;	04-may-82	bdn	add ext call to LINCC to stuff
;				core common before .rts call.
;				normally patched out by TKB
;				gblpat option. patch .rtscc+0
;				and .rtscc+2 to 240
;	04-may-82	bdn	commercial license checking,
;				patch .logok offset 0 and 2 to
;				240 to disable.

	.sbttl	features of this login

;	optional things
;
;  1.	logging of privledged logins to opser
;
;  2.	logging of privledged logins to other priv users, patch
;
;  3.	lookup of secondary password for priv logins
;
;  4.	force of notice.txt to print using binary opens
;	and buffer chain checks.
;
;  5.	treat '/' the same as ',' in account number field
;
;  6.	control opser logging for all users by adding/removing a
;	systemwide logical name called 'OPSEND:'
;
;  7.	autobaud rate select for 110, 300, 600 and 1200 (see below)
;	note that this requires that 'I' <lf> from the ring interupt
;	be ignored and instead used to start a binary read sequence.
;	Thus for this to work 'LOG$I' offset 0 must be 0.
;
;  8.	switching to a new private default RTS if one is patched in.
;
;  9.	running a program at exit if one is patched in.
;
; 10.	executing a login command file after a successful login by
;	spawning itself at line 29500.
;
; 11.	chaining to 'cookie' (?)
;
; 12.	completely control C proof (^C is turned into ^Z)
;
; 13.	small and many times faster than DEC Login.
;
; 14.	will try to print, in addition to NOTICE.TXT, a file with
;	the name of MSG:MSGproject.programmer, as in MSG:MSG1.8 for
;	account (1,8) (my account).
;
; 15.	checks quotas on up to 5 disk drives (defined by sys manager)
;
; 16.	handle non-existent accounts as a separate case from invalid
;	passwords.
;


	.sbttl	patchable things to control login functions

;	symbol	offset	default  new	patch to result
;			value	value
;
;	log$op	0	177777	  0	stop opser logging of all
;					priv logins
;
;	log$pr	0	177777	  0	stop broadcasts to all
;					operator accounts.
;
;	ext$ps	0	177777	  0	skip extra password lookup
;					for priv login attempts. See
;					method used in 'EXTPAS:'
;
;	frc$tx	0	177777	  0	skip buffer chain checks for
;					completion of notice.txt print
;
;	byp$tx	0	177777	  0	treat nn/mm the documented way
;
;	chnlin	0	0	 ?????	line number for chain at exit
;
;	chnprg	0	nulls	 ?????	filespec for program chain at
;					exit
;
;	stduic	0	128	 ?????	programmer number for student
;					accounts. Used to skip execution
;					of LOGIN.COM at exit.
;
;	devlst	0	_SY0:		disk names to check quotas on.
;		6	_DB1:		are always 5 characters followed
;		12.	_DB2:		by a null byte.
;
;	runcmd	0	4767	  240	patching the 3 words to 'nop'
;		2	??????	  240	will cause login to look for
;		4	207	  240	'@' ccl instead of spawning
;					itself for command file exec.
;
;	log$i	0	0	177777	if zero, the 'I' <lf> sequence
;					put into the terminal buffer by
;					the exec on a ring interupt  is
;					ignored and instead used to get
;					the autobaud code started else
;					if <> 0 then I<lf> is the same
;					as typing 'HELLO'<cr>
;
;	log$cr	0	177777	0	if <> 0, then a null line typed
;					(just a carriage return) will
;					cause 'LOG'<cr> to be stuffed
;					into the buffer, else <cr> will
;					exit login.
;
;	log$en	0	0	177777	if <> 0, then opser will ALWAYS
;					be informed after a successful
;					login to an account.
;
;	tmo$bn	0	10.	??????	timeout for binary mode reads in
;					'dobaud'
;
;	run$pg	0	-1	0	if <> 0, allow the program in
;					the prgdef macro calls to run
;					logged out, else do nothing.
;
;	kil$kb	0	-1	0	if <> 0, hangup the line if the
;					login fails.


	.sbttl	creation of login and patching INIT.BAC


;
;	how to create login from source,  and get the  symbol  table
;	into it for patching with ONLPAT, thus allowing distribution
;	of the task without source.  note  that all of  the options,
;	like chaining, new rts  switch,  calling  cookie, logging to
;	opser,  extra stuff  for  priv login attempts are pachtable.
;
;
;	$job/nolimit/error:fatal (1,99)
;	
;	zap pas:[1,8]lin.mac
;	pip pas:[1,8]/cl:1=dk0:[1,8]lin?.mac
;	ut flag dk0:[1,8]lin.mac/cache/seq
;	run $mac
;	linx=$common,lb:[1,200]rmsmac.mlb/ml,dk0:[1,8]linx
;	lin=$common,dk0:[1,8]lin
;	$eod
;	tkb
;	lin,lin,lin=lin,linx,lb:rmslib/lb
;	/
;	; next 3 lines disable core common stuffing at .rts point
;	gblpat=lin:.rtscc+0:240
;	gblpat=lin:.rtscc+2:240
;	gbldef=lincc:0
;	; next 2 lines disable special site id and date checking
;	gblpat=lin:.logok+0:240
;	gblpat=lin:.logok+2:240
;	//
;	RUN $MAKSIL
;	LIN
;	LIN.TSK
;	YES
;	LIN.STB
;	LIN.SIL
;	$eod
;	pip dk0:[1,8]login.tsk=lin.sil
;	pip dk0:[1,8]login.map=lin.map/rms:fa
;	pip
;	lin.tsk/de/wo
;	lin.tsk=lin.sil/re
;	lin.obj/de/wo
;	lin.map/de/wo
;	lin.stb/de/wo
;	$eod
;	$eoj



	.sbttl	patch for version 7.07 of INIT.BAS to add RTS RSX
;		from R. Webster, Arizona State University
;
;	10	extend
;	1530	wait 0%
;		\ print if pos(0%)
;		\ on error go to 19000
;		\ f$ = "SY0:$START.CTL" if f$ = ""
;		\ x$ = fnload$("RSX")
;		!Logins is modified and runs under RSX.
;		!Before we can log a job in  it must be installed.
;		!and re-install.
;	
;	1590	c$ = "@"+f$
;		\if e0% then
;			x$ = fnload$("RSX")
;	1591	e0% = 2%
;		!On a crash INIT is entered at line 100 and switch e0% is
;		!turned on.  Lines 1590-1591 will handle this.
;	
;	16000	def fnload$(nm$)
;		!This function will load a RTS in (0,1)
;	
;	16005	print "Adding a RTS named ";nm$
;		\on error go to 16200
;		\open "(0,1)"+nm$+".RTS" for input as file 9%
;		!Print the message and opent the RTS file.
;		!We will read directly from the RTS file to find
;		!the thing we need to know.  This method is used in
;		!UTILITY.
;	
;	16010	dim #9%, v%(112%,255%)
;		\ix% = (swap%(v%(0%,9%)+511%) and 255%) / 2%
;		\change sys(chr$(6%)+chr$(-10%)+nm$) to m%
;		!Set up virtual array on the RTS file.
;		!Get RTS name in rad format
;	
;	16015	m%(0%) = 30%
;		\m%(1%) = 6%
;		\m%(2%) = -18%
;		\m%(3%) = 0%
;	
;	16020	m%(11%),m%(12%) = 0%
;	
;	16025	m%(13%) = v%(ix%,254%)
;		\m%(15%) = v%(ix%,240%)
;		\m%(17%) = 255%
;		\m%(19%) = v%(ix%,237%)
;		\m%(20%) = swap%(m%(19%))
;		\m%(21%) = v%(ix%,238%)
;		\m%(22%) = swap%(m%(21%))
;	
;	16030	m%(18%) = 0%
;		\m%(23%) = 0%
;		\m%(24%) = 0%
;		\m%(25%) = 0%
;	
;	16035	close #9%
;	
;	16040	change m% to i$
;		\i$ = sys(i$)
;		!Do the install of the RTS
;	
;	16045	goto 16500
;	
;	16200	print "Error in adding RTS "+nm$
;	
;	16205	if err = 5 then
;			print "File not found in (0,1). "+nm$
;			\resume 16500
;	
;	16210	print "error ";err;" line ";erl
;		\resume 16500
;	
;	16500	on error goto 19000
;	
;	16505	fnload$ = ""
;	
;	16510	fnend
;	
;	32767	end
;	

	.sbttl	important preliminary definitions

;	to overlay with rms code easily, we MUST have GLOBAL
;	attributes for MAIN, STACK, $TRAP and $PDATA psects.
;	can then be forced into the root with TKB directives.

	.psect	main	,ro,i,gbl,rel,con	; main program,overlayed
	.psect	stack	,rw,d,gbl,rel,ovr	; stack and local data
	.psect	$pdata	,ro,d,gbl,rel,con	; readonly ascii data
	.psect	$trap	,ro,i,gbl,rel,con	; trap and control c's


;	these ($CODE,$DATAL,.99998 and .99999) should be LOCAL.

	.psect	$datal	,ro,d,lcl,rel,con	; local r/o data
	.psect	$code	,ro,i,lcl,rel,con	; all executable code
	.psect	.99998	,ro,d,lcl,rel,con	; patch area
	.psect	.99999	,ro,d,lcl,rel,con	; RTS psuedo vector


	.psect	$pdata

	$$$rsx	=	1		; use rsx emulation on RSTS
	.iif ndf, $$$rsx , $$$rsx = 0	;
	global	<$$$rsx>		; make it show up in the map
	r.parm	=	30		; where RSX stuffs line number
	r.flag	=	32		; xrb+0 entry flag word
	.even

	spnlin::.word	29000.		; spawned entry point
	comlin:	.word	29500.		; spawned ourself here
	attlin::.word	30000.		; for attach command
	loglin::.word	32000.		; for logged out entry
	ba7spl::.word	4		; kb number for batch unit 7
					; which a priv only batch
	ba7ppn::.word	1*400+99.	; account for ba7 batch jobs

	.if ne	,$$$rsx
	.ift
	 .priv	=	240
	.endc

	.sbttl	macro to define logged out programs


;	as in:
;
;	progdef	<HELP>,<SYSLIB:[1,22]HELP.TSK>,4
;	progdef
;
;
;	the macro invoked without arguments terminates the
;	table


	.macro	progdef cmd , name , minlen

	.psect	$datal			; insert the asciz of the cmd
	.even				; name and also of the program
	.if b	,cmd			; name in $pdata psect.
	.iff				; if macro invoked without args
	$$n	=	.		; then terminate the table.
	.asciz	\cmd\			; command name
	.even
	$$p	=	.		; save address of both the cmd
	.asciz	\name\			; name and the program name.
	.even				; nicities
	.ift				; null invokation, point to
	$$n	=	.		; null strings.
	$$p	=	.
	.byte	0,0
	.endc				; thats it

	.psect	prglst	,con,rel,d,lcl,ro
	.iif ndf ,prglst, prglst::	; build table of command table
	.word	$$n			; names, indexed like an array
					; of addresses
	.psect	prgnam	,con,rel,d,lcl,ro
	.iif ndf ,prgnam, prgnam::	; build table of program names
	.word	$$p

	.psect	prgmin	,con,rel,d,lcl,ro
	.iif ndf ,prgmin, prgmin::	; build table of minimum lengths
	.if b	,minlen
	.ift				; if null invokation, nothing.
	.word	0			;
	.iff				; if nonnull, append cmd minimum
	.word	minlen			; length to the table.
	.endc				; if b, minlen

	.psect				; resume a psect

	.endm	progdef			; and thats all for now

	.sbttl	the list of programs that can run logged out


	progdef	<HELP>,<SYSLIB:[1,2]HELP.TSK>	,4
	progdef	<QUE>, <SYSLIB:[1,2]QUE.TSK> 	,2
	progdef	<SET>, <SYSLIB:[1,2]TTYSET.BAC>	,3
	progdef	<NIP>, <SYSLIB:[1,2]NIP>	,3
	progdef	<DOC>, <SYSLIB:[1,3]DOCPR.BAC>	,3
	progdef

	.psect	$pdata




	.sbttl	list of characters read @300 baud ring for setting baud


	ring300	=	1
	ring600	=	0
	.iif ndf, ring300, ring300 = 1
	.iif ndf, ring600, ring600 = 0


bdebug::.word	0

;	first dh11ad interface with ring speed @ 300 baud

	.if ne	,ring300
	.ift

distdh::.byte	140.			; 110  baud with carriage return
	.byte	254.			; 600  baud with carriage return
	.byte	255.			; 1200 baud with carriage return
	.byte	27.			; 1200 baud other
	.byte	28.			; 110  baud other
	.byte	'c&37			; control C is a no-op
	.byte	'z&37			; control Z is a no-op
	.byte	'u&37			; control U clears line buffer
	.byte	177			; rubout deletes a character
	.byte	'F			; 600 baud
dhlen	=	. - distdh


;	next dz11e interface with ring speed @ 300 baud
	
distdz::.byte	140.			; 110  baud with carriage return
	.byte	254.			; 600  baud with carriage return
	.byte	255.			; 1200 baud with carriage return
	.byte	27.			; 1200 baud other
	.byte	28.			; 110  baud other
	.byte	'c&37			; control C is a no-op
	.byte	'z&37			; control Z is a no-op
	.byte	'u&37			; control U clears line buffer
	.byte	177			; rubout deletes a character
	.byte	'F			; 600 baud
dzlen	=	. - distdz

	.even
baudset:.word	set110			; these must be in correct order
	.word	set600			; set speed 600
	.word	set1200			; set speed 1200
	.word	set1200			; set speed 1200
	.word	set110			; 110
	.word	setnop			; do nothing (^C or ^Z)
	.word	setnop			; do nothing (^C or ^Z)
	.word	setdel			; delete buffer for control U
	.word	setrub			; remove character for rubout
	.word	set600			; set speed 600 again

	.endc				; ring speed default @ 300

	.assume	dzlen eq dhlen		; vital that these are same
	dstlen	=	dhlen

; note:	for KBxx:/ring speed 300, the characters are generated as:
;
;
;
;	110  baud,  600  baud  and 1200 baud are set by going into a
;	binary read  wait  and  looking  for  a  distorted  carraige
;	return.  At  entry,  the  sequence 'I' <lf> sent by the exec
;	upon a ring interupt is eaten  up,  followed  by  a  timeout
;	binary  read  to  attempt to get a character to set the baud
;	rate with. All characters not found in the baud  rate  table
;	are  copied  into core common to allow the typing of 'HELLO'
;	or whatever. Note that this will not work if 'LOG$I'  offset
;	zero is patched or changed to be non-zero.
;
;
;	these 2 are here for historical reasons
;
;	110  baud --> ascii 28	by typing control U
;	1200 baud --> ascii 27	by typing control A or control D


	.sbttl	local macros

	.enabl	lc


	.macro	.chksp	arg
	.ntype	$$5	,arg
	.iif eq,<$$5 & 7>-6, .error arg ; Illegal use of SP(r6) in call
	.endm	.chksp


;	the CALLS macro (call with param on stack)

;	CALLS macro
;
;	subroutine call with arguements passed in an area
;	pointed to by R5 (similiar to F4 and BP2). All args
;	are pushed onto the stack, with the first args  at
;	the lower address and the last ones at the  higher
;	addresses. R5 will point to the SP before the call.
;	R5 is saved and restored.


	.macro	calls	name,arglst	; standard  call  macro using
					; the hardware stack (%6) for
	 .globl	name
	 $$	=	0		; arguement transmission with
	 .irp	x	,<arglst>	; r5 passed as  a pointer  to
	  $$	=	$$ + 1		; to the arguement list.  The
	 .endr				; called name is declared globl

	 .if eq	,$$			; No args present ? If so, gen
	 .ift				; a simple jsr pc call to sub.
	  jsr	pc	,name		; No argument list given.
	 .iff

	  mov	r5	,-(sp)		; At least one arg in <arglst>
	  .if eq , $$ - 1		; One arguement in the list
	  .ift
	   mov	arglst	,-(sp)		; One arg. Generate less code
	   .chksp	arglst		; Check for SP modes on param.
	   mov	sp	,r5		; Set pointer to argument list
	   jsr	pc	,name		; call the subroutine
	   tst	(sp)+			; pop parameter list from stack
	   mov	(sp)+	,r5		; restore r5 pointer

	  .iff				; argcount > 1

	   $$2	=	$$		; more than 1 arguement. Thus
	   .rept	$$		; extract the args in reverse
	   $$1	=	0		; order so that we might save
	   .irp x	,<arglst>	; a little core (4 words).
	   $$1	=	$$1 + 1		; Scan the arg list until we
	   .if eq	, $$2 - $$1	; we come to the last one we
	    .ift			; before the one we just did.
	    .chksp	x		; Check for SP addressing mode.
	    mov	x	,-(sp)		; Push it, and exit the .irp.
	    .mexit			; exit from irp loop please.
	    .endc
	   .endr			; end of .irp loop
	   $$2 = $$2 - 1		; backwards to previous arg.
	   .endr			; end if .retp <n of args>

	   mov	sp	,r5		; Set up the argument lst ptr.
	   jsr	pc	,name		; and go to the routine.
	   .if ne , $$ - 2		; Gen 'Add 2*argnum, sp' ?
	   .ift				; yes, else gen CMP (sp)+,(sp)+
	   add	#$$*2	,sp		; fix the stack up, restore r5
	   .iff				; two args
	   cmp	(sp)+	,(sp)+
	   .endc			; if ne, <n of args - 2>
	   mov	(sp)+	,r5		; restore r5 pointer

	  .endc				; if one arguement for macro
	 .endc				; if no args for macro line

	.endm	calls			; thats all


	.sbttl	yet some more macros


	.macro	errprt	ern
	.if b	,ern
	.ift
	movb	firqb	,-(sp)
	call	$errprt
	.iff
	mov	ern	,-(sp)
	call	$errprt
	.endc
	.endm	errprt

	.macro	clrfqb
	call	$zapfqb
	.endm	clrfqb

	.macro	clrxrb
	call	$zapxrb
	.endm	clrxrb

	.macro	dosys	mode
	mov	mode	,-(sp)
	call	uusys
	.endm	dosys

	.macro	message	txt
	.psect	$datal
	$$ = .
	.asciz	@txt@
	.psect	$code			; a rash assumption ?
	mov	#$$	,-(sp)		; dump the text next please
	call	mout			; to the terminal
	.globl	mout			; perhaps
	.endm	message

	.macro	movtxt	txt		; copy .asciz string over and
	.psect	$datal			; leave the dest pointer at the
	$$ = .				; null byte
	.asciz	@txt@			;
	.psect	$code			; resume code psect
	mov	#$$	,-(sp)		; always assumes r2 points to
	call	mtxt			; a buffer
	.endm	movtxt

	.macro	movz	addr		; copy .asciz by address
	mov	addr	,-(sp)		; same code though
	call	mtxt			; simple
	.endm	movz			; all done

	.macro	sendtxt	txt		; copy .asciz string over and
	.psect	$datal			; leave the dest pointer at the
	$$ = .				; null byte
	.ascii	@txt@			;
	.byte	40,0
	.psect	$code			; resume code psect
	mov	#$$	,-(sp)		; always assumes r2 points to
	call	dosend			; a buffer
	.endm	sendtxt			; log this to opser please


	.macro	.len	addr
	mov	addr	,r0
	call	strlen
	.endm


	.macro	exit
	jmp	uexit
	.endm	exit

	.macro	abort
	jmp	uabort
	.endm	abort

	.macro	lmargin
	call	$lmarg
	.endm	lmargin


	.sbttl	more macros, continued

	.macro	iferr	lab
	tstb	er$sav(r4)
	bne	lab
	.endm	iferr


	.macro	ifnoerr	lab
	tstb	er$sav(r4)
	beq	lab
	.endm	ifnoerr


	.macro	save	list
	.if b , <list>
	.ift
	 save	<r0,r1,r2,r3,r4,r5>
	.iff
	.irp	x,<list>
	 mov	x,-(sp)
		.endr
	.endc
	.endm	save


	.macro	unsave	list
	.if b , <list>
	.ift
	unsave	<r5,r4,r3,r2,r1,r0>
	.iff
	.irp	x,<list>
	 mov	(sp)+,x
		.endr
	.endc
	.endm	unsave


	.macro	kbpeek	offset,result	; this macro is used by the
	mov	offset	,-(sp)		; code that tries to run a
	call	.kbpeek			; login command file from
	.if nb, result			; a spawned login
	.ift				; look at various offsets in
	mov	(sp)+	,result		; the spawner's kb ddb
	.iff
	mov	(sp)+	,r0
	.endc
	.endm



	kb.lun	=	1
	tx.lun	=	2		; for notice.txt printing
	pr.lun	=	3		; for priv disk logging?
	bn.lun	=	4		; for kb open binary mode
	dk.lun	=	5		; for misc disk i/o
	kb.tmo	=	30.		; timeout
	maxtry	=	6.
	cvtarg	=	1+4+8.+16.+32.+128.
	bell	=	7.
	eofeof	=	11.		; end of file on device
	daterr	=	13.		; user data error on device
	hngtty	=	15.		; keyboard timeout exhausted
	jb.st	=	12		; offset for jbstat word uu.sys
	jb.wa	=	14		; offset for kbwait word uu.sys


	.iif ndf,tab	,tab = 11
	.iif ndf,cr	,cr  = 15
	.iif ndf,lf	,lf  = 12
	.iif ndf,space	,space = 40
	.iif ndf,fqent	,fqent = fqnent
	.iif ndf,corcom	,corcom= corcmn
	.iif ndf,uu.tb3 ,uu.tb3= -29.


	kl11	=	0		; interface types here
	dc11	=	2
	dl11c	=	4
	dl11e	=	6
	pk11	=	8.
	dh11	=	12.
	dz11	=	14.

	.iif ndf,nulhnd	,nulhnd = 22.

	.sbttl	data defs


;	All  read/write data in login is allocated from the stack, which
;	is (for RSX emulation version) allocated in the  psect  'STACK'.
;	From  this  stack,  an  amount  equal to the total r/w data size
;	plus a small gaurd area is subtracted from the stack,  and  then
;	pointed  to by R4. All data can be accessed then by indexing off
;	of R4.  In those cases where a line or  buffer  string  must  be
;	addressed,  the proper method would be to move r4 into a scratch
;	register and add the offset to that register to be able  to  use
;	autoincrement  addressing.  For  example  to  access the command
;	line buffer, copying core common to it, one would use: 
;
;		mov	r4	,r1		; address of r/w area
;		add	#buffer	,r1		; line buffer offset
;		mov	#corcom+1,r2		; core common text
;	10$:	movb	(r2)+	,(r1)+		; copy until chr(0)
;		bne	10$
;
;
;	scalar variables would be accessed as in:
;
;		cmp	lineno(r4),spnlin	; spawn entry ?
;		bne	10$			; no
;		call	spawn			; yes, spawned entry

	.asect
	.	=	0
	rwa	=	.

sp.jdb:	.blkw	1			; jdb addr of job who spawned
sp.kb:	.blkw	1			; kb# of login that spawned us
sp.j2:	.blkw	1			; job number times 2
sp.job:	.blkw	1			; job number
sp.ddb:	.blkw	1			; kb ddb from previous login
sp.fir:	.blkw	1			; flag word
hangtt:	.blkw	1			; drop line at exit if ne 0
rsts71:	.blkw	1			; if version 7.1
myname:	.blkb	fqbsiz			; where we came from
er$sav:	.blkw	1			; save last error
by$cnt:	.blkw	1			; byte counts
ccok:	.blkw	1			; if control c is ok now
opflag:	.blkw	1			; if <> 0 then log to opser
okcmd:	.blkw	1			; ccl cmd was 'hello' or 'login'
fchar:	.blkw	1			; first ch on logged out line
attflg:	.blkw	1			; attaching or logging in ?
attjob:	.blkw	1			; job number attach is for
prgnum:	.blkw	1			; chain program logged out
ppn:	.blkw	1			; ppn, offset 0 from r4
pas:	.blkw	3			; and the password given
rpas:	.blkw	3			; and the real password?
delim:	.blkw	1			; and delimiter inside the ppn
ntimes:	.blkw	1			; number of attempts to get in
lineno:	.blkw	1			; line number (@firqb+fqent)
bufadr:	.blkw	1			; stuff buffer address in here
buffer:	.blkb	130.			; a buffer for command lines.
ban:	.blkb	134.
savcmd:	.blkb	134.			; save copy of the command line
myppn:	.blkw	1			; users ppn
job:	.blkw	1			; job number times 2
kb:	.blkw	1			; kb number
njobs:	.blkw	1			; number of logins allowed now.
jdba:	.blkw	1			; address of job data block one
jdb2a:	.blkw	1			; address of job data block two
kbddb:	.blkw	1			; address of ddb for this line
ttintf:	.blkw	1			; interface characteristics
stallf:	.blkw	1			; set stall flag byte
kbtype:	.blkw	1			; interface type
chkbuf:	.blkw	1			; flag for buffer chain checks
dkbuff:	.blkb	1000+2			; disk buffer here please
detjob:	.blkb	40			; list of detached jobs for ppn
fqsave:	.blkb	42
rwaend:	.blkw	1

	lsize	=	rwaend - rwa

	.psect	stack,rw,d,gbl,rel,ovr	; for now

stklim:	.blkb	lsize + 1000		; lots of it
stack	=	. - 2

	.sbttl	read only text data

	.psect	$pdata


;	chain @ exit program for (1,*) and > (198,*)

cookie::.asciz	/SYSLIB:[1,0]COOKIE.SAV/
	.even


;	chain @ exit priority 1 (for all users)


chnlin::.word	0			; patchable via onlpat
chnprg::.rept	50			; patchable via onlpat
	.byte	0			; nothing here today please
	.endr				; end of filename (40 bytes)
	.even


;	system wide logical name, such than when set to be
;	the null device, as in  UT ADD LOGICAL  NL:OPSEND,
;	login will automatically log things to OPSER.

opname::.asciz	/OPSEND:/		; if set as a system logical
	oplen	= . - opname		; log all invocations to opser.
	.even


;	the name of the login message file, NOTICE.TXT

notice::.asciz	/_SY:[1,2]NOTICE.TXT/
	.even


;	the name of a command file to spawn to ourself

cmdfil::.asciz	/_SY:LOGIN.COM/
	.rept	20
	.byte	0
	.endr
	.even
stduic::.byte	200			; no chain if programmer # ge
	.even


	.sbttl	more read only ascii data


;	temp file wildcard spec to zap

tmpnam:	.asciz	/_SY:??????.TMP/	; need to stuff job number in
tmplen	=	. - tmpnam		; which is done in FPURGE
	.even



;	list of devices to check quota if logging into a
;	new account. the length of each string MUST be 5
;	+ the null byte added on by the .asciz directive.

devlst::.asciz	/_SY0:/			; syspac
devlen	=	. - devlst		; length (eq 6)
	.asciz	/_DB1:/			; user disk
	.asciz	/_DB2:/			; system library disk
	.byte	0,0,0,0,0,0		; mark the last entry
	.byte	0,0,0,0,0,0		; mark the last entry
	.byte	0,377
	.even				; thats all



;	rts to optionally switch to at exit

newrts::.byte	0,0,0,0,0,0,0		; nothing for now
	.even



;	legal digits

digits:	.ascii	#0123456789#
digdlm:	.ascii	#,/#
kbname:	.asciz	#_KB:JUNK.DAT/MO:0#
	.even
star:	.word	-17947.

nullog:	.rept	44			; to avoid a user reassigning
	.byte	0			; 'opsend:' to something other
	.endr				; than 'NL:', define a dummy and

	.sbttl	option directives. can be patched via onlpat

	.psect	$pdata

log$en::.word	0			; always tell opser about login
log$op::.word	-1			; log priv logins to opser
log$pr::.word	-1			; log priv logins to priv kbs
ext$ps::.word	-1			; second password for priv ppn
frc$tx::.word	-1			; disallow ^C for notice.txt
byp$tx::.word	-1			; do not treat '/' to skip print
log$i::	.word	0			; use 'I' <lf> to initiate auto
					; baud checks if zero, else use
					; 'I' just like 'HELLO'.
log$cr::.word	-1			; if <>, convert <cr> only to
					; HELLO<cr>, else <cr> will get
					; the banner printed.

run$pg::.word	-1			; if ne, allow usual loggedout
					; programs, else none available

kil$kb::.word	-1			; if ne, drop modem line on an
					; unsuccessful login, else not.

tmo$bn::.word	8.			; timeout for binary reads in
					; 'dobaud' in seconds.

maxrpt::.word	10.			; loop factor for buffer clear

opr$ac::.word	1*400+2,1*400+20.	; operator accounts

	.psect

	.sbttl	start us up please
	.enabl	lsb
	.psect	main			; force into the root please

lin:	call	trpini			; lock control C's, set SST's
	mov	#stack	,sp		; reset the stack pointer and
	sub	#lsize	,sp		; allocate our work space.
	mov	sp	,r4		; r4 points to bottom of work
	call	login			; do the att, spawn or login
	bcs	110$			; login did not work ?
	tstb	kb(r4)			; do not do cookie for kb0
	beq	100$			; also no rts switches

	 clr	r0
	 call	getprv
..logu:: call	loguser			; special local type things?
	 call	drpprv
	 tst	r0			; check return codes from it
	 ble	5$			; oops
	 call	bye			; log them out
	 mov	sp	,hangtt(r4)	; kill them
	 br	110$			; bye
5$:	 tstb	newrts			; try a switch to new rts?
	 beq	10$			; no
	 calls	fss	,<#newrts>	; yes, convert to rad50 and
	 iferr	10$			; switch to it
	 mov	#-1	,firqb+fqnam1+4	; make it private default
	 call	lincc			; do any preliminary things
.rtscc	==	. - 4			; but let tkb patch it out.
	 .priv	,.rts			; try it, ignore errors.

10$:	 tstb	chnprg			; a program to chain to ?
	 beq	20$			; no
	 calls	fss	,<#chnprg>	; try to run this program
	 iferr	20$			; oops
	 mov	chnlin	,firqb+fqent	; line number to do it at
	 .priv	,.run			; try it out

20$:	 cmpb	myppn(r4),stduic	; was this a student account?
	 bhis	30$			; yep
	 call	runcmd			; try to run cmd file

30$:	 cmpb	myppn+1(r4),#1		; priv user gets chained to
	 beq	40$			; cookie
	 cmpb	myppn+1(r4),#199.	; so do staf accounts
	 blo	100$			; nope
40$:	 call	pcrlf
	 calls	fss	,<#cookie>	; chain to cookie at exit ?
	 iferr	100$			; no
	 .priv	,.run			; try to go and get cookie

100$:	exit
110$:	tst	hangtt(r4)		; should we get rid of line?
	beq	120$			; no
	tst	kil$kb			; really do this today ?
	beq	120$			; no
	call	hangup			; yes
120$:	dosys	#0			; still logged in here ?
	tst	firqb+26		; well ?
	beq	130$			; no, kill the job off then
	exit				; yes, exit gracefully please
130$:	abort

	global	<loguser,trpini,fss,lincc>

	.psect	$code

	.dsabl	lsb

	.sbttl	the real work of login

	.enabl	lsb


login:	call	setup			; start things rolling
	call	logent			; maybe log this to opser
	call	check
.logok	==	. - 4
	tst	lineno(r4)		; normal entry type here ?
	beq	80$			; yes
	tst	attflg(r4)		; command was 'attach' ?
	bne	5$			; yes	

	cmp	lineno(r4),attlin	; attach entry ?
	bne	10$			; yes, a legitimate line number
5$:	 call	attach			; try to do the attach then
	 clc				; exit but no aborts please
	 br	200$			; the attach must have failed.

10$:	cmp	lineno(r4),spnlin	; spawned for PK login ?
	bne	15$			; no
	 call	spawn			; yes, login is automatic
	 br	200$			;
15$:	cmp	lineno(r4),comlin	; did we spawn ourself in
	bne	20$			; order to execute login
	 call	docomf			; command file ?
	 sec				; fake it did not work
	 br	200$			;

20$:	cmp	lineno(r4),loglin	; logged out entry ?
	bne	210$			; yes
	 tst	prgnum(r4)		; are we supposed to run a
	 beq	30$			; program ? if eq, then no.
	 call	runprg			; yes, try to run it
	 br	210$			; can't find it

30$:	 tstb	buffer(r4)		; anything in the buffer ?
	 bne	90$			; yes, try to log in
	 tst	okcmd(r4)		; 'setup' strips the ccl name
	 beq	40$			; command was 'hello' or 'login'
	  call	banner			; print the banner and log in.
	  br	90$			; 

40$:	 call	ack			; and a small banner	
	 sec				; say it failed
	 br	lexit			; and exit

80$:	tstb	buffer(r4)		; anything passed in core com?
	bne	90$			; yes
	 call	banner			; no print a banner out then.
	 call	attach			; the attach thing if logged in
	 br	200$			; and exit
90$:	tst	myppn(r4)		; already logged in here ?
	beq	100$			; no
	call	lin1			; yes, handle separately
	br	lexit
100$:	call	lin2			; not logged in yet
	bcc	200$			; it worked so exit
	clc				; clear the 'worked' flag
	dec	ntimes(r4)		; first time abort (control C)
	beq	200$			; yes, thats ok to do then.
	sec				; no, so abort and drop the line
	mov	sp	,hangtt(r4)	; simple
200$:	br	lexit			; bye

210$:	call	sayhel
	sec
;	br	lexit

lexit:	return

sayhel:	message	<Please type HELLO or HELP>
	call	pcrlf
	return

	.dsabl	lsb
