.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' 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' 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 is the same ; as typing 'HELLO' ; ; log$cr 0 177777 0 if <> 0, then a null line typed ; (just a carriage return) will ; cause 'LOG' to be stuffed ; into the buffer, else 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 ,,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 , ,4 progdef , ,2 progdef , ,3 progdef , ,3 progdef , ,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' 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 , ; 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 .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 , ; 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 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, 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 , .ift save .iff .irp x, mov x,-(sp) .endr .endc .endm save .macro unsave list .if b , .ift unsave .iff .irp x, 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' to initiate auto ; baud checks if zero, else use ; 'I' just like 'HELLO'. log$cr::.word -1 ; if <>, convert only to ; HELLO, else 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 .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 call pcrlf return .dsabl lsb