diff --git a/Makefile b/Makefile index 01793aff..b8b334d8 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,6 @@ EMULATOR ?= simh -SRC = system syseng sysen1 sysen2 sysnet kshack dragon channa midas _teco_ emacs rms klh syshst sra mrc ksc cstacy gren bawden emacs1 _mail_ l lisp liblsp libdoc comlap lspsrc nilcom rwk inquir +SRC = system syseng sysen1 sysen2 sysnet kshack dragon channa midas _teco_ emacs rms klh syshst sra mrc ksc cstacy gren bawden emacs1 _mail_ l lisp liblsp libdoc comlap lspsrc nilcom rwk inquir acount DOC = info _info_ sysdoc kshack _teco_ emacs emacs1 MINSYS = _ sys sys2 sys3 device emacs _teco_ sysbin inquir diff --git a/README.md b/README.md index 61cd6b94..1b82f6fe 100644 --- a/README.md +++ b/README.md @@ -103,6 +103,8 @@ from scratch. - COMPLR, lisp compiler - BINPRT, display information about binary executable file - INQUIR, user account database + - PWORD, replacement for sys;atsign hactrn that requires registered logins + - PANDA, user account management program 6. A brand new host table is built from the host table source and installed into SYSBIN; HOSTS3 > using H3MAKE. diff --git a/build/build.tcl b/build/build.tcl index 8cde65fa..84c96415 100644 --- a/build/build.tcl +++ b/build/build.tcl @@ -556,6 +556,28 @@ respond "*" ":lisp inquir;inquir (dump)\r" respond "*" ":link inquir;ts inquir,inquir;inqbin >\r" respond "*" ":link sys;ts inquir,inquir;ts inquir\r" +# pword/panda +respond "*" ":midas sysbin;pword bin_sysen1;pword\r" +respond "Is this to be a PANDA?" "yes\r" +expect ":KILL" +respond "*" ":midas sysbin;panda bin_sysen1;pword\r" +respond "Is this to be a PANDA?" "no\r" +expect ":KILL" +respond "*" ":midas sysbin;pwinit bin_sysen1;pwinit\r" +expect ":KILL" +respond "*" ":job pwinit\r" +respond "*" ":load sysbin;pwinit\r" +respond "*" "\033g" +respond "*" ":copy cstacy;big dat,sysbin;\021 \021 \021 big \021 \021 0dat\r" +respond "*" ":job panda\r" +respond "*" ":load sysbin;panda bin\r" +# set password to "panda" +respond "*" "spword/107150326162\r" +type "purify\033g" +respond "*" ":pdump sysbin;panda bin\r" +respond "*" ":link sys;atsign pword,sysbin;pword bin\r" +respond "*" ":link sys;ts panda,sysbin;panda bin\r" + # ndskdmp tape respond "*" ":link kshack;good ram,.;ram ram\r" diff --git a/src/acount/-read-.-this- b/src/acount/-read-.-this- new file mode 100755 index 00000000..ed57baea --- /dev/null +++ b/src/acount/-read-.-this- @@ -0,0 +1,3 @@ +This directory is for purposes of the password system. +Please do not delete any files on it. +--RWK diff --git a/src/sysen1/pwfile.60 b/src/sysen1/pwfile.60 new file mode 100644 index 00000000..1e4a5947 --- /dev/null +++ b/src/sysen1/pwfile.60 @@ -0,0 +1,170 @@ +;-*-MIDAS-*- + +subttl PWFILE -- Define format of the password file + +;PRINT VERSION NUMBER +.TYO6 .IFNM1 +.TYO 40 +.TYO6 .IFNM2 +PRINTX/ INCLUDED IN THIS ASSEMBLY. +/ + +pwfile=:pwpage*2000 ; Where we put it + +pwinit==:pwpage*2000 ;time of system invocation for locks feature +pwdone=:pwpage*2000+1 ;time of system invocation for locks feature +pwlock=:pwpage*2000+2 ;lock. If locked, database is closed for + ;writing. +pwunkl=:pwpage*200+3 ;must be pwlock+1 ... this gets unlink inst. +pwlkid=:pwpage*2000+4 ;UIND of job doing the locking +pwtime=:pwpage*2000+5 ;time of last update + +pwuhak=:pwpage*2000+11 ;UNAME of last person to update, other than + ;INIT +pwjhak=:pwpage*2000+12 ;JNAME of last person to update, other than + ;an INIT. +pwaccc=:pwpage*2000+13 ;# of times database has been accessed +pwordc==:6 ; # of override tables +pwordt=:pwpage*2000+14 ; Date override tables are in effect + ; In halfword disk-date form, 1 date per + ; halfword. +pwcnt=:pwpage*2000+17 ;# of passwords we have in our database, *10 + +pwrbfp=:pwpage*2000+20 ;pointer into buffer + +pfgrp=:pwpage*2000+21 ; Default user group + +ddtty0=:pwpage*2000+22 ; 0-43 TTY #'s to get DDT directly. +ddtty1=:pwpage*2000+23 ; 44-107 TTY #'s to get DDT directly. +dltty0=:pwpage*2000+24 ; 0-43 TTY #'s to not let randoms use +dltty1=:pwpage*2000+25 ; 44-107 TTY #'s to not let randoms use + +pwsptr=:pwpage*2000+26 ; AOBJN ptr to free area in PWSTR area. + +atoapl=:pwpage*2000+27 ; -1 ==> Allow applications + +pwgdil=:pwpage*2000+30 ; Dialup restriction for each group, a 1 + ; bit n from the right marks that group as + ; priveleged. This bit is overridden + ; by the %PFDIL bit in the individual's flag + ; word, which says the individual is + ; priveleged to use the dialups + +pwsgcp=:pwpage*2000+31 ; -1 iff incomplete GC performed. + ; If incomplete GC has been performed, + ; it must be done before adding a string. + +pwholp=:pwpage*2000+32 ; -1 ==> Today is a holiday. + ; Turn this on to ignore time restrictions. + +pwrbfl==:200 ;length of buffer +pwrbuf=:pwpage*2000+100 ;password data entry history buffer + +pwgrct=:20 ; # of possible groups +pwgrdm=:pwpage*2000+300 ; 1 entry per group + dm$wds=:360600,,0 ; 1.1-1.6 When restriction starts, weekday + ; # of half-hours after midnight + ; 77 = no restriction + dm$sts=:300600,,0 ; 1.7-2.3 When restriction starts, Saturday + dm$sns=:220600,,0 ; 2.4-2.9 When restriction starts, Sunday + dm$wde=:140600,,0 ; 3.1-3.6 When restriction ends, weekday + dm$ste=:060600,,0 ; 3.7-4.3 When restriction ends, Saturday + dm$sne=:000600,,0 ; 4.4-4.9 When restriction ends, Sunday + + +pwgors=:pwpage*2000+320 ; This table contains the override start + ; times for each of the 20 groups. Each + ; word is divided into six 6-bit bytes, + ; one for each override date, and contains + ; the start time in 1/2 hour past 0000 units +pwgore=:pwpage*2000+340 ; Same, override restriction end times. +pwgnam=:pwpage*2000+360 ; SIXBIT name of group + +pwstbg==:pwpage*2000+1000 ; Start of string-space AOBJN ptrs + ; From here to PWSTBG are ptrs into the + ; database... +timmsg=:pwpage*2000+1000 ; Message for each group for logging in + ; during the wrong time. +dilmsg=:pwpage*2000+1020 ; Message for each group for using dialups +ovrmsg=:pwpage*2000+1040 ; 20 x 6 table of messages for each group + ; on each override date +pwadmn=:pwpage*2000+1200 ; AOBJN ptr (into string space) of people + ; who have created/modified accounts +lucktb=:pwpage*2000+1201 ; Table of lucky sites that don't get PWORD +losers=:pwpage*2000+1202 ; Table of sites we need protection from +phone=:pwpage*2000+1203 ; cnt,,offset string phone number for help +naplmg=:pwpage*2000+1204 ; Message to print why no applications +nocmnd=:pwpage*2000+1205 ; Commands to disable + +pwstln==:205 ; # of strings to update + +pwstpg==:1 ; Page # of string space +pwstr=:*2000 ; String Space. This is divided into thre + ; consing areas, NEW, OLD, and NEXT + ; When NEW is filled, all pointers into + ; OLD are copied into NEXT space, which + ; then becomes the NEW space. The old NEW + ; space, not suprisingly, becomes the OLD + ; space. This is done to avoid half-move + ; strings, to guarantee consistancy at all + ; times. Strings are pointed to by AOBJN + ; ptrs, relative to PWSTR. The AOBJN ptrs + ; are examined and updated only with the + ; database locked, and are updated only + ; after any necessary copying is done. + ; Each consing area is 2 pgs long. +pstrln==:4000 ; Length of a string space +pistr0==:0 +pwstr0==:*2000 ; String Space 0 +pistr1==:pistr0+pstrln +pwstr1=:*2000+pstrln ; String Space 1 +pistr2==:10000 +pwstr2=:*2000+2*pstrln ; String Space 2 + +pdpage==:7 ; Page # of UNAME data in file + +pwdata=:pwpage*2000+16000 +pwname=:pwpage*2000+16000 ;location of first UNAME entry +pwpass=:pwpage*2000+16001 ;location of first password entry +pwflag=:pwpage*2000+16002 ;location of first flag entry + +%pf==:1,,525252 ; bit typeout mask +%pfnew==:400000 ; This account has never logged in +%pfdil==:200000 ; is permitted to use dialups. +%pfday==:100000 ; can use it in the daytime. +%pfbad==:040000 ; Means that this name shouldn't be able to + ; log in from loser sites. +%pfmsg==:020000 ; Means that he has seen the REFUSE or OFF + ; message + +pwinfo=:pwpage*2000+16003 ; Various miscellaneous info +pi$==:777400,,170677 +pi$crt==:321200,,0 ; 3.9-4.9 Index into creator table for + ; who created this account +pi$mod==:201200,,0 ; 2.8-3.8 who last modified this account +pi$grp==:140400,,0 ; 2.4-2.7 access-control group + +pi$sta==:100400,,0 ; 1.9-2.3 state of this account +ps%==:400000,,0 ; typeout mask +ps%new==:0 ; Account is nonexistant +ps%apl==:1 ; Account is applied for +ps%hld==:2 ; Account is being held +ps%off==:3 ; Account is turned off +ps%rfs==:4 ; Account is refused +ps%ok==:5 ; Account is OK +ps%sys==:6 ; Account is a system account +ps%del==:7 ; Account is being deleted + ; (should never actually be in file) + +pi$nul==:001000,,0 ; 1.1-1.8 MBZ + +pwdate=:pwpage*2000+16004 ;,, +pd$crt==:222200,,0 +pd$log==:002200,,0 + +pwmod=:pwpage*2000+16005 ;,,0 +pm$mod=:222200,,0 + +pwmore=:pwpage*2000+16007 ;this slot reserved for debugging, etc. +pwleng==:10 ;entries are 8 long + diff --git a/src/sysen1/pwinit.1 b/src/sysen1/pwinit.1 new file mode 100644 index 00000000..4760d484 --- /dev/null +++ b/src/sysen1/pwinit.1 @@ -0,0 +1,145 @@ +;-*-MIDAS-*- + +title initialize PWORD database + +x=:0 ;super temporary +a=:1 +b=:2 +c=:3 +d=:4 +e=:5 +ct=:6 +t=:7 ;temporary arithmetic register +tt=:10 ;temporary arithmetic register, T+1 + +dski=:11 +dsko=:12 +lsrc==13 ;channel for LSRTNS + +sp=:17 +p==:sp + +call=:pushj sp, + + +DEFINE SYSCAL A,B + .CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))] TERMIN + +loc 2000 + +buffer: block 2000 + +pwpage==buffer/2000 + +.insrt SYSEN1;PWFILE > + +pdl: -100,,pdl + block 100 + +go: move sp,pdl + movei a,lsrc ;A <- channel for LSRTNS + syscal OPEN,[ %clbit,,.uio ? %climm,,dsko ? [sixbit /DSK/] + [sixbit /BIG/] ? [sixbit /DAT/] ? [sixbit /CSTACY/] ] + .lose %lsfil + move t,[444400,,buffer] + setzm pwcnt ;Nothing yet. + setom atoapl ;We allow applications + setom pwordt ;Set no date override + setom pwordt+1 + setom pwordt+2 + setom pwinit + setom pwdone + setzm pwrbfp + setom pwgrdm + setom pwgrdm+1 + setom pwgrdm+2 + setom pwgrdm+3 + setom pwgrdm+4 + setom pwgrdm+5 + setom pwgrdm+6 + setom pwgrdm+7 + setom pwgrdm+10 + setom pwgrdm+11 + setom pwgrdm+12 + setom pwgrdm+13 + setom pwgrdm+14 + setom pwgrdm+15 + setom pwgrdm+16 + setom pwgrdm+17 +..foo==0 +irp gr,,[USER,DAY,DIAL,TURIST,GRP.04,GRP.05,GRP.06,GRP.07,GRP.08,GRP.09,GRP.10,GRP.11,GRP.12,GRP.13,GRP.14,GRP.15] + move x,[sixbit /gr/] + movem x,pwgnam+..foo + ..foo==..foo+1 +TERMIN + + .suset [.runame,,pwuhak] + .suset [.rjname,,pwjhak] + + move t,[444400,,buffer] + movei tt,2000 + syscal SIOT,[ %climm,,dsko ? t ? tt] + .lose %lsfil + setzm buffer ; Clear the buffer + move x,[buffer,,buffer+1] + blt x,buffer+1777 + move t,[444400,,buffer] ; Write 6 blank pages to disk + movei tt,2000 + syscal SIOT,[ %climm,,dsko ? t ? tt] + .lose %lsfil + move t,[444400,,buffer] + movei tt,2000 + syscal SIOT,[ %climm,,dsko ? t ? tt] + .lose %lsfil + move t,[444400,,buffer] + movei tt,2000 + syscal SIOT,[ %climm,,dsko ? t ? tt] + .lose %lsfil + move t,[444400,,buffer] + movei tt,2000 + syscal SIOT,[ %climm,,dsko ? t ? tt] + .lose %lsfil + move t,[444400,,buffer] + movei tt,2000 + syscal SIOT,[ %climm,,dsko ? t ? tt] + .lose %lsfil + move t,[444400,,buffer] + movei tt,2000 + syscal SIOT,[ %climm,,dsko ? t ? tt] + .lose %lsfil + move t,[444400,,buffer] ; Provide 8 pages of emptyness + movei tt,2000 + syscal SIOT,[ %climm,,dsko ? t ? tt] + .lose %lsfil + move t,[444400,,buffer] + movei tt,2000 + syscal SIOT,[ %climm,,dsko ? t ? tt] + .lose %lsfil + move t,[444400,,buffer] + movei tt,2000 + syscal SIOT,[ %climm,,dsko ? t ? tt] + .lose %lsfil + move t,[444400,,buffer] + movei tt,2000 + syscal SIOT,[ %climm,,dsko ? t ? tt] + .lose %lsfil + move t,[444400,,buffer] + movei tt,2000 + syscal SIOT,[ %climm,,dsko ? t ? tt] + .lose %lsfil + move t,[444400,,buffer] + movei tt,2000 + syscal SIOT,[ %climm,,dsko ? t ? tt] + .lose %lsfil + move t,[444400,,buffer] + movei tt,2000 + syscal SIOT,[ %climm,,dsko ? t ? tt] + .lose %lsfil + move t,[444400,,buffer] + movei tt,2000 + syscal SIOT,[ %climm,,dsko ? t ? tt] + .lose %lsfil + .close dsko, + .logout 1, + +end go diff --git a/src/sysen1/pword.2661 b/src/sysen1/pword.2661 new file mode 100644 index 00000000..2ad87ffc --- /dev/null +++ b/src/sysen1/pword.2661 @@ -0,0 +1,10441 @@ +; -*- MIDAS -*- + +.symtab 3537.,7942. + +.lstoff +ifndef $$pand,[ +if1 [ +define getpnd + .tag retry + printx /Is this to be a PANDA? / + .ttymac foo + irpnc 0,1,1,bar,,foo + ifse bar,Y,[$$pand==1] + ifse bar,y,[$$pand==1] + ifse bar,N,[$$pand==0] + ifse bar,n,[$$pand==0] + termin + termin + ifndef $$pand,[printx / +Answer Yes or No. +/ + .go retry] + +ifn $$pand,[ .ofnm1==sixbit /PANDA/ ? .ofnm2==sixbit /BIN/] +ife $$pand,[ .ofnm1==sixbit /PWORD/ ? .ofnm2==sixbit /BIN/] + +termin + +getpnd + +expunge getpnd +];end IF1 +];end IFNDEF $$PAND, + +ifndef $$DBUG,$$DBUG==0 ;debuggin? Don't hack real thing! + +ife $$PAND,title PWORD -- Passwords for ITS +ifn $$PAND,title PANDA -- Password Manipulations + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; +;;; Conventions to be rigidly adhered to!!!!!!!! +;;; Under penalty of bugs and hassles!!! +;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; 1) Do not use ERROR lightly. It is for true internal errors, and +;;; will write crash files! +;;; 2) Put all conventions to be rigidly adhered to here! +;;; 3) Document all that you do! +;;; 4) Do more than that, TELL me all that you do. I.e. :BUG PWORD +;;; 7) I'd prefer to make whatever changes myself, on grounds that I know +;;; more of what is involved. At least, make an attempt to ask me first! +;;; 8) Make no patches to the binary without also modifying the source and +;;; doing :BUG PWORD .... +;;; 9) All typeout of strings is done by the TYPE macro. The first argument +;;; is the channel on which it should be output. Use DSPC if ^P codes are +;;; to be included, otherwise TYOC should be used, if output is to the +;;; TTY. +;;; 10) ECHOCH is for echoing the character contained in CH .... $ECHO is for +;;; "echoing" arbitrary characters, it takes a character +;;; as an argument. $ECHO ["A] will "echo" an "A". It echos tab, LF +;;; and backspace as uparrow-frobby, and on sail-able TTY's it uses ^KA +;;; type stuff. +;;; 12) Any code which deigns to type out on it's own (as opposed to the +;;; TYPE etc. macros, which do this on their own) should refrain from +;;; doing so if TTYFLG is non-zero. This indicates an output reset +;;; is in progress, and all output should be flushed until something +;;; of the nature of a prompt occurs, which should zero TTYFLG and then +;;; type out. +;;; 13) Do not use DSKLOS for OPEN's that can fail letigimately. +;;; It generates crash files. Use FILOSS +;;; 14) All interrupt routines *MUST* save UUO and UUOH if they use any +;;; user UUO's. The same is true of any UUO's that call UUO's +;;; recursively. Also, UUOAC. They should use the UUOPSH or UUOPOP +;;; macros. +;;; 15) Any UUO's that may use AC's in effective address calculations +;;; move tt,(sp) ? move t,-1(sp) to recover their original contents +;;; the AC field may be saved in UUOAC +;;; 16) 17 (SP) cannot be used as the data address of a UUO. (obviously) +;;; 17) UUO's clobber no AC's +;;; +;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +SUBTTL Basic Definitions + +x=:0 ;super temporary +a=:1 +b=:2 +c=:3 +d=:4 +e=:5 + +t=:7 ;temporary arithmetic register +tt=:10 ;temporary arithmetic register, T+1 +ch=:11 ;Character being manipulated. +count=:12 ;count into string being manipulated +bp=:13 ;byte pointer into string being read +ct=:14 ;count of characters read in this part + ;of the reader. If it goes negative, + ;the reader will fail-return + ;when this happens, the caller should + ;consider itself to have gotten a rubout, + ;rubbing out it's terminating character. +sp=:17 + +lodc==1 ;channel to load DDT from +dspc==2 ;TTY out channel, display mode +tyic==3 ;TTY input channel, 12-bit input +tyoc==4 ;TTY out channel, non-display +lsrc==5 ;channel for LSRTNS +pwdc==6 ;channel for maping in pword database +dski==7 ;channel for disk input +hstc==10 ;channel for NETWRK to use for HOSTS3 table +dsko==14 ;channel to do mail output on +logc==15 ;channel for log file output +tlnc==16 ;USR device channel for STY owner +usrc==17 ;USR device channel + + +c.op==42 ;opcode for .OPER's +;;; random data area lengths + +pdllen==100. ;large pdl +msgbfl==1400*5 ;>2 * # of chars on VT52 screen! (79. x 24.) +cargmx==3 ;maximum control arguments. +cargct==10 ;must be greater than the most # of + ;control arguments known to any command + +buflen==100 ;buffer for reading from disk +luckln==100 ;# of spaces to reserve for friendly sites +loseln==20 ;# of spaces to reserve for unfriendly sites + +.purpg==13 ;first pure page + +cnt==%CLBTW,,0 ;control +cnti==%CLBIT,,0 ;control immediate +argi==%CLIMM,,0 ;immediate argument +val==%CLOUT,,0 ;value return +errret==%CLERR,,0 ;error return + +DEFINE SYSCAL A,B,C= + .CALL [SETZ ? SIXBIT/A/ ? B ? setz+errret+c] TERMIN + +define .pure +ifn .pure.,.err Two .PURE's without a corresponding .UPURE +.pure.==-1 +..unpr==. +loc ..pure +termin + +define .upure +ife .pure.,.err Two .UPURE's without a correspponding .PURE +.pure.==0 +..pure==. +loc ..unpr +termin + + +..unpr==100 +..pure==2000*.purpg +.pure.==0 ; initially allocating impure + +;; Macro to check for overlap of pure and impure +define .perch +define .pch. xx,yy,zz +printc \ +Impure storage from 0 to yy +Pure storage from xx to zz +\ +termin +.pch. \.purpg*2000,\..unpr,\..pure +ifl .purpg*2000-..unpr,.err UNPURE overlaps with PURE +termin + +define norm7 c ;normallize a 7-bit byte pointer + skipge c + sub c,[430000,,1] +termin + +define decbp c ;decrement byte pointer + add c,[70000,,] ;back up the byte pointer + skipge c ;did we cross a word boundary? + sub c,[430000,,1] ;then fix it +termin + +define decbp6 c ;decrement byte pointer + add c,[60000,,] ;back up the byte pointer + skipge c ;did we cross a word boundary? + sub c,[440000,,1] ;then fix it +termin + +;;; This macro takes two arguments, the first is a starting location in +;;; memory, and the second is a # of characters after that. +;;; It returns the BP that you'd get after that # of IDPB's into that buffer +define bpend buf,ln +<<000700+<<<<5-*5>>*7>+1>_14>>,,>> termin + +define upper chr ;uppercase a character + cail chr,141 ;lower "a" + caile chr,172 ;lower "z" + caia ;if got here, it's not lower a-z, skip + subi chr,40 ;convert case +termin + +define type chan=tyoc,&STRING + output chan,[asciz string] +termin + +define ask &string + askusr [asciz string] +termin + +;; WRITE clobbers X, writes string to bp +define write bp,&string + move x,[440700,,[asciz string]] + copy x,bp +termin + +define tyobpi bp,ch + movei x,ch + idpb x,bp +termin + +define do stuff,else,\label +define ddoo exit + jrst [stuff +jrst label] +!else! + +label:: +termin + +ddoo + +termin + +pjrst==jrst ;for pushj sp, ? popj sp, sequences. +call=pushj sp, +ret=popj sp, + +;;; macros to evaluate system symbols and locations + +define seval a,b ;get value of symbol B in A + move a,[squoze 0,/b/] + .eval a, + loss +termin + +define eval a,b + seval a,b + hrl a,a ;move to left + hrri a,a ;destination is a + .getloc a, ;get it into a +termin ;done! + +define save objs + irp x,,[objs] + push sp,x + termin +termin + +define restore objs + irp x,,[objs] + pop sp,x + termin + +termin + +%TCCOM==400000 ;Comm mode bit in %TCCOM + +;;; definitions of data-structures in command table. + +; CO <=> Command Option +%CO==:1,,525252 ;bit mask for %CO bit-typeout +%COJCL==:400000 ;says command accepts JCL +%COTOP==:200000 ;Says is a topic, not a command +%COOPT==:100000 ;says that the %COARG argument is optional +%COARG==:040000 ;says that the first word of JCL is 6bit +%COCRG==:020000 ;says that this command expects control + ;arguments +%CONLS==:010000 ;says don't list this among the commands. + ;useful for establishing aliases among + ;commands. +%COFIL==:004000 ;Says this command may use ^X or ^Y +%COSND==:002000 ;Says this command needs :SEND type rubout + ;hackery, including updating SNAPTR + +;Command table entry format +CM$NAM==:0 ; SIXBIT /NAME/ +CM$RTN==:1 ; Routine to run +CM$FLG==:2 +CM$OPT==:3 ; AOBJN ptr to OPTIONS +CM$HLP==:4 ; Helper +CM$SDC==:5 ; AOBJN ptr to short documentation +CM$LDC==:6 ; AOBJN ptr to long doc +CM$LEN==:7 + +cmdcnt==0 + +define COMMAND name,aname,routin,flags,options,helper,&short,long +cmdcnt==cmdcnt+1 +ifb aname, Z$!NAME: +ifnb aname, Z$!ANAME: + SIXBIT /name/ +ifnb routin, routin +.else 0 +ifnb flags, flags +.else 0 + optexp [options] + 0 + <.length short>,,[asciz short] + <.length long>,,[asciz long] +termin + + +;; hack an expression of OPTIONS +define OPTEXP options,\.bar + -.bar,,[ + .foo==0 + .bar==0 + irpw x,y,[options] + optex1 .bar,\<1_.foo>,x,[y] + .foo==.foo+1 + termin + ] +termin + +define optex1 .bar,val,symbol,strings +; The following IRPS is to strip trailing blanks off the symbol (termin) +IRPS x,,[symbol] +x==:val +termin + irp x,,[strings] + <.length /x/>,,[ascii /x/] + val + <.length /-x/>,,[ascii /-x/] + val + .bar==.bar+2 + termin +termin + +;;; Macro to print error message and write crash file. + +define error &mesage + errdmp [asciz mesage] +termin + +;;; in SIOTO, the AC is assummed to contain the count initially. It is +;;; clobbered. The channel defaults to TYOC + +define sioto ac,[bp],chan=tyoc + movem ac,siotct ;save the SIOT count + move ac,bp + syscal siot,[argi chan ? ac ? siotct] + loss +termin + + +define $echo .ch. + + push sp,ch + move ch,[.ch.] + echoch + pop sp,ch +termin + + +;;;; ***** MEMORY MAP ***** +;;;; +;;;; Data is assigned to one of two areas according to whether it follows +;;;; one of two macros, .PURE and .UPURE +;;;; Things following .UPURE are allocated in the unpure core, at the lowest +;;;; extreme of the job. Things following .PURE are allocated in the pages +;;;; following the impure. See the macro definitions for more details +;;;; +;;;; 0-13 impure data space +;;;; Pure code space +;;;; LSRTNS space +;;;; HOSTS3 table +;;;; password database (54-200) +;;;; +;;;; 360-363 badpag -- pages loaded into by DBGHAK. When anylyzing crash files +;;;; these pages are also mapped into the impure data area +;;;; (0-3) +;;;; 364-370 goodpg -- This is where DBGHAK saves it's own good pages when it +;;;; has BADPAG mapped into the impure data area +;;;; 375 dpdlpg -- debuging pdl allocated by DBGHAK +;;;; 376 tmpag1 -- temporary page # 1, must be contiguous with tmpag2 +;;;; 377 tmpag2 -- temporary page # 2, must be contiguous with tmpag1 + +lsrpag==32 ;first page for LSRTNS to hack +lsrpgc==16. ;# pages for LSR1 + +hstpag==lsrpag+lsrpgc ;first page for NETWRK to hack +hstpgc==80. ;# pages for HOSTS3 + +pwpage==hstpag+hstpgc ;page where we map the password file + +badpag==360 +badloc==2000*badpag + +goodpg==364 +good=goodpg*2000 + +dpdlpg==375 ;page to use as debugging PDL +dpdl=2000*dpdlpg ;location of debugging pdl + +tmpag1==376 +tmpag2==377 + + +SUBTTL UUO Routines etc. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; +;;; UUO routines etc. ;;; +;;; ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +loc 35 ;in case get's switched in middle of an $X +.break 16,500000 +.break 16,70000 + +loc 40 +uuo: 0 ;location for UUO's + JSR UUOH ;go handle UUO's +loc 60 +suuo: 0 + jsr suuoh ;go handle system-returned UUO's + -intlng,,tsint ;abjon ptr to interrupt table +loclst: 0 ;nothing on locked switch list yet + -6,,critic ;Critical Routine table + + +loc 100 +uuoh: 0 ;foo! Where did this come from? + jrst uuodsp ;go dispatch on the UUO + +uuoac: 0 ;saved AC of UUO +uuoarg: 0 ;saved arg of UUO +suuoh: 0 + jrst errfoo +.pure + +errfoo: movem tt,ac.tt ;save an AC to hack with + ldb tt,[opcode suuo] ;check it for legitness + caie tt,<.ldb opcode,errdmp> ;is it real? + jrst [movei tt,[440700,,[asciz /Bad SUUO/]] + movem tt,errmsg + movem x,ac.x + jrst errput] + ldb tt,[accum suuo] + movei tt,@erruuo (tt) ;get address of handler + exch tt,uuoac ;recover the orriginal AC + jrst @uuoac ; yes, hack the error + +;;; this is the magical dispatch for the ERRDMP uuo +;;; it is indexed by AC field of the ERRDMP uuo + +;;; ERRDMP <0 to 4>,[ASCIZ /STRING/] +;;; if 0, ordinary error +;;; if 1, it's a LOSS, I.e. random error +;;; if 2, it's an OPEN that failed that +;;; shouldn't have, and should dump +;;; if 3, it's an I/O operation that should +;;; print the error and filename, the +;;; effective address of this should be +;;; a file block instead. +;;; if 4, AC's have already been saved, don't +;;; clobber. + + +erruuo: errmng ;basic ERROR uuo + loserr + dskerr ;disk error + opfail ;OPEN failure? + errmn1 ;AC's already saved ERROR? + repeat <20-<.-erruuo>>,baduer + +baduer: movem x,ac.x + move tt,ac.tt + movei x,[asciz /ERRDMP with bad AC field!/] + movem x,errmsg + jrst errput + +errdmp=50000,,0 ;UUO that goes through system, don't clobber + ;.JPC !! +loss=errdmp 1, +dsklos=errdmp 2, +filoss=errdmp 3, + + +;;; macros to save and restore locations needed for UUO handler +;;; (for interrupts) +define uuopsh + save [UUO,UUOH,UUOAC] +termin + +define uuopop + restore [uuoac,uuoh,uuo] +termin + +uuodsp: save [T,TT] ;save a few AC's to work with + ldb t,[opcode uuo] ;get the opcode + ldb tt,[accum uuo] ;and the accumulator + caige t,uuomax ;legal? + jrst @optab(t) ; yes, hack it +uuoerr: error /Internal Error: Unknown UUO/ + + +uxuuor: restore [uuoh] ;restore our return address! +xuuort: restore [x] ;restore our borrowed AC +uuoret: restor [tt,t] ;restore the stolen AC's + jrst @uuoh ;return + +define uuodef name,loc + loc +name=<.-optab-1>_33 +termin + +optab: uuoerr ;no 0's allowed! + uuodef output,strt ;OUTPUT ,[ASCIZ /STRING/] + uuodef outstr,istrt ;OUTSTR ,[]] + uuodef 6type,type6 ;6type chan,loc + uuodef 8type,type8 ;8type chan,loc + uuodef htype,typeh ;htype chan,loc + uuodef 10type,type10 ;10type chan,loc + uuodef aiot,aciot ;AIOT ac,loc (ac contains channel) +ifn $$PAND,uuodef tyo,utyo ;TYO chan,loc +ife $$PAND,tyo==.iot + uuodef idpb6,uidpb6 ;IDPB6 ac,[bp for output] (AC contains 6bit) + uuodef idpb8,uidpb8 ;IDPB8 ac,[bp for output] (AC has octal) + uuodef idpb10,udpb10 ;IDPB10 ac,[bp for output] (AC has decimal) + uuodef typout,outtyp ;TYPOUT chan,[spec] (see spec format below) + uuodef .mail,mailit ;.MAIL [mail-spec] + uuodef copy,scopy ;COPY ac,[bp] (ac contains from bp) + uuodef askusr,usrask ;ASKUSR [ASCIZ /STRING/] + ;documentation for command +uuomax==.-optab + +; DSKLOS is for dsk output opens that fail and shouldn't + + +;;; TYPOUT expects the EA to contain a frob as follows: + +; 1) Byte pointers +; 2) 0, in which case it returns without doing anything +; 3) one of the following opcodes. These are indirected with, so indirection +; or indexing may be used. + +typcod: +tp$ind==730000,,0 ;points to a footyp word to be interpreted + error /TP$IND not handled/ +tp$dec=740000,,0 ;output word as decimal + 10type @uuoarg +tp$htp=750000,,0 ;output word as half-words + htype @uuoarg +tp$oct=760000,,0 ;output the word as octal + 8type @uuoarg +tp$6bt=770000,,0 ;6bit word to be output as 6bit + 6type @uuoarg + +outtyp: movem tt,uuoac ;remember the channel we hack + move tt,(sp) ;in case the argument lives in an AC + move t,-1(sp) ;gotta get the original vals for AC's +typot0: skipn t,@uuo ;get the argument + jrst uuoret ; null argument, just return + call typdsp ;dispatch on the type + jrst uuoret ;return + +typdsp: hlrz tt,t ;get the argument type + andi tt,777740 ;clear out any indirection, etc. + + cain t,0 ;is the whole thing 0? + ret ; yes, don't do anything at all. + cain tt,0 ;is it 0? + error /Null type code in TYPOUT/ + cain tt,(tp$ind) ;is it indirect? + jrst [movem t,uuo ; substitute it for the UUO + move t,-2(sp) ; recover old AC values for indirection + move tt,-1(sp) + skipn t,@uuo ; perform the indirection + ret ; nothing there, don't do a thing + jrst typdsp] ; and re-do argument checking + caile tt,770000 ;is it too large + jrst typabj ; it's an AOBJN ptr + caige tt,450000 ;or too small? + jrst typbp ; it's a byte pointer + caige tt,720000 ;is it out of our range? + error /Bad argument to TYPOUT/ + movem t,uuoarg ;remember the arg, to indirect through + ldb tt,[360300,,t] ;get the type-code of the arg + subi tt,3 ;three unused ones + move tt,typcod(tt) ;get the UUO to do that operation + move t,uuoac ;recover our AC + dpb t,[accum tt] ;and insert it into our consed up instr + movem tt,uuo ;store in convenient slot + move tt,-1(sp) ;recover the original contents of the AC's + move t,-2(sp) ;except for the stack, of course + push sp,uuoh ;remember where we're from + xct uuo ;perform the new UUO + pop sp,uuoh + ret + +;;; handle the AOBJN ptr case +.upure +ABJSAV: 0 ;storage for our AOBJN ptr +.pure + +typabj: push sp,abjsav ;we may be recursive + push sp,uuoac +typlop: movem t,abjsav ;remember our AOBJN ptr + hrrzm t,uuoarg ;cons up address of arg + move t,(sp) ;recover UUOAC + movem t,uuoac + move t,-2(sp) ;recover AC values + move tt,-3(sp) + move t,@uuoarg ;get the actual argument + call typdsp ; dispatch on the type of argument + move t,abjsav ;recall our AOBJN ptr + aobjn t,typlop ;if there are more args, get the next + pop sp,uuoac + pop sp,abjsav ;back to the way the world was + ret + +;;; Cons up and execute a OUTSTR to type out from our Byte Pointer! +typbp: move tt,[outstr t] ;basic instruction + movem tt,uuo ;convenient place to put it! + move tt,uuoac ;get the AC field + dpb tt,[accum uuo] ;and add it into the instruction + push sp,uuoh ;remember where we're from! + xct uuo ;Do it! + pop sp,uuoh ;restore OUR return! + ret ;all done, return! + +;;; STRT expects the UUO to have had the string at it's E.A, and it to start +;;; on a word boundary. +;;; ISTRT expects it to have had the byte pointer as it's E.A. and not start on +;;; a word boundary + +.upure +mdlflg: 0 ;non-zero if we're to type MUDDLE strings +.pure + +istrt: movem tt,uuoac ;remember the channel we hack + move tt,(sp) ;in case the B.P. lives in an AC + move t,-1(sp) + move t,@uuo ;get the B.P. +istrt0: move tt,uuoac ;recover the channel we hack + jrst strt1 ;and hack the rest of it. + +strt: hrlzi t,440700 + hrr t,uuo ;cons up a byte pointer to the string + +strt1: save [count,t] + setz count, ;prepare to count characters + +strt3: ildb ch,t ;grab the char + cain ch,^L ;is it ^L? + jrst strt4 ; ^L ends a file too, for us + caie ch,^C ;is it a ^C? + cain ch,0 ; is it null? + jrst strt4 ; one or the other, exit loop + skipn mdlflg ;are we hacking MUDDLE strings? + jrst strt39 + caie ch,"" ;is it a " ? + cain ch,"\ ; or a \ ? + jrst strt40 ; take funny exit + +strt39: aoja count,strt3 ;nope, keep on trucking + +strt40: seto ch, ;note that this is a funny case! + +strt4: syscal rfname,[tt ? val t] ;get the device this is to. + error /OUTPUT called on closed channel/ + camn t,[sixbit /TTY/] ;Is this TTY output? + jrst typer ; yes, type it instead + pop sp,t ;recover the byte pointer + syscal siot,[tt ? t ? count] ;type it + loss + +typecs: restore [count] + skipl ch ;was this a funny case? + jrst uuoret ; no, just return + ildb ch,t ;yes, get the funny character + push sp,uuoh ;remember our return address! + aiot tt,ch ;send it out quoted + pop sp,uuoh ;restore our return address! + jrst strt1 ;and continue typing from there! + +typer: pop sp,t ;recover the byte pointer + save [siotct] ;save it in case we're at interrupt level + movem count,siotct ;put it in SIOTCT so ^S can clear + syscal siot,[tt ? t ? siotct] + .lose 1400 ; We must be losing to badly! + restore [siotct] + jrst typecs ;return or loop as needed + + +type6: movem tt,uuoac ;remember the channel to hack + restore [tt,t] ;in case the word is in an AC + save [t,tt,x] + + move tt,@uuo ;byte pointer to our arg on our stack + move x,uuoac + push sp,uuoh ;remember where we came from, we want to + ;go back! + +type60: setz t, ;clelar out cruft in T for new char + lshc t,6 ;get the first character + skipn t ;is there something there? + aiot x,[^Q] ; no, quote the space + addi t,40 ;convert to ascii + aiot x,t ;type char in CH to channel in X + jumpn tt,type60 ;if there's more to type, type it + jrst uxuuor ;and return + + +uidpb6: movem tt,uuoac ;remember our ac + restore [tt,t] ;in case the word is in an AC + + save [x,t,tt] ;Save the AC's we need..note not in usual + ;order + push sp,@uuoac ;AC contains the data. Put it on the stack + move x,@uuo ;;get the byte pointer + pop sp,tt ;get the 6bit in our AC + +idpb60: setz t, ;no garbage to throw us off. + lshc t,6 ;pick off a character + skipn t ;iff it's a blank + do [movei t,^Q ; grab a ^&Q + idpb t,x ; and stuff it down the Byte Pointer + setz t,] ; and restore the state of the world + addi t,40 ;convert to ascii + idpb t,x ;deposit it + jumpn tt,idpb60 ;if there's any more to output, hack it +wbackx: restore [tt,t] ;recover the temporary AC's + exch x,(sp) ;recover original contents of X + pop sp,@uuo ;and write back our Byte Pointer to wherever + jrst @uuoh ;and return + +type10: movem tt,uuoac ;remember our AC + restore [tt,t] ;restore AC's in case data in AC's + save [t,tt,x] ;borrow another AC + move t,@uuo ;get our data + move x,uuoac ;get the channel to type to + save [uuoh] ;save our return address + call decpnt ;do the printing + jrst uxuuor ;and return to caller + +decpnt: idivi t,10. ;figure first digit + push sp,tt ;push remainder + skipe t ;done? + call decpnt ; no compute next one + +decpn1: pop sp,t ;yes, take out in opposite order + addi t,60 ;make ascii + aiot x,t ;type char in T to channel in X + ret ;and return for the next one. + +udpb10: movem tt,uuoac ;remember our AC + restore [tt,t] ;restore AC's in case data in AC's + save [x,t,tt] ;borrow another AC + push sp,@uuo ; Get our byte pointer + move t,@uuoac ;get our data + pop sp,x ; Get our byte pointer into X + call decdpb ;do the writing + jrst wbackx ; write back X and exit + +decdpb: idivi t,10. ;figure first digit + push sp,tt ;push remainder + skipe t ;done? + call decdpb ; no compute next one + +decdp1: pop sp,t ;yes, take out in opposite order + addi t,60 ;make ascii + idpb t,x ; write character in T to BP in X + ret ;and return for the next one. + +type8: movem tt,uuoac ;remember what AC field we had + restore [tt,t] ;restore val of AC's, in case data resides + save [t,tt,x,uuoh] ;therein. Borrow X, and save return addr. + move t,@uuo ;get our argument + move x,uuoac ;get channel to hack + call octpnt ;do the typing + jrst uxuuor ;and return to caller + +octpnt: setz tt, + lshc t,-3 ;shift instead of IDIVI, don't forget + lsh tt,-41 ;negative! + push sp,tt ;push remainder + skipe t ;done? + call octpnt ;no compute next one + +octpn1: pop sp,tt ;yes, take out in opposite order + addi tt,60 ;make ascii + aiot x,tt + ret ;and return for the next one. + +;;; like OCTPRT except deposits down byte pointer in E.A. and gets data in AC + +uidpb8: movem tt,uuoac ;remember what AC has the data + restore [tt,t] ;restore val of AC's, in case data resides + save [x,t,tt] ;therein. Also, borrow X. Note unusual + ;order for things going to WBACKX + push sp,@uuo ;get our argument Byte pointer + move t,@uuoac ;Get contents of AC + pop sp,x ;Byte Pointer to X + call octdpb ;do the typing + jrst wbackx + +octdpb: setz tt, + lshc t,-3 ;shift instead of IDIVI, don't forget + lsh tt,-41 ;negative! + push sp,tt ;push remainder + skipe t ;done? + call octdpb ;no compute next one + + pop sp,tt ;yes, take out in opposite order + addi tt,60 ;make ascii + idpb tt,x ;output down the Byte pointer + ret ;and return for the next one. + +typeh: movem tt,uuoac ; Remember the AC + restore [tt,t] ;restore the vals of AC's in case the data + save [tt,t,x,uuoh] ;resides therein. Borrow X, save return + push sp,@uuo ;recover the data without clobbering AC's + hlrz t,(sp) ;get left half + move x,uuoac ;remember the channel + call octpnt ;print it + aiot x,[",] ;,, + aiot x,[",] + hrrz t,(sp) ;get the right half + call octpnt ;print it + pop sp,x + jrst uxuuor ;return + +;;; one instruction SYSCAL IOT that checks for TTYFLG if TTY channel + +aciot: movem tt,uuoac ;remember the AC with the info + move tt,(sp) ;recover original data of AC's + move t,-1(sp) + + push sp,@uuo ;fetch the value, but don't clobber AC's + move tt,@uuoac ; has channel, not is channel + pop sp,t ;and recover the value + + cain tt,tyoc ;is it neither TTY channel? + caie tt,dspc + jrst aiot66 ; no, don't check for TTY turned off + + skipe ttyflg ;has the TTY ben turned off? + jrst uuoret ; yep, just return +aiot66: call mmquot ;maybe muddle quote the character! + syscal iot,[tt ? t] ;actually do it + loss + jrst uuoret ;and return from the UUO + +;;; Maybe Muddle Quote ! +mmquot: skipn mdlflg ;hacking muddle strings? + ret + caie t,"\ ;is it a special char? + cain t,"" + caia ; yep, gotta hack specially + ret ; nope, just output it + syscal iot,[tt ? ["\]] ;quote the frob first! + loss + ret + +utyo: movem tt,uuoac ;remember the channel + move tt,(sp) ;recover original data of AC's + move t,-1(sp) + move t,@uuo ;get the data + move tt,uuoac ;and the channel + cain tt,tyoc ;is it neither TTY channel? + caie tt,dspc + jrst utyo66 ; no, don't check for TTY turned off + + skipe ttyflg ;has the TTY ben turned off? + jrst uuoret ; yep, just return + +utyo66: call mmquot ;maybe muddle quote the character! + syscal iot,[tt ? t] ;actually do it + loss + skipn logflg ;are we logging? + jrst uuoret ; no, return from the UUO + caie tt,tyoc ;is it either TTY channel? + cain tt,dspc + caia ; yes, don't stop now! + jrst uuoret ; no, don't log it! + syscal iot,[argi logc ? x] ;yes, log it + loss + jrst uuoret ;return + + +scopy: movem tt,uuoac ;remember which AC has our FROM pointer + move tt,(sp) ;recover original data of AC's + move t,-1(sp) + move tt,@uuoac ;get from pointer + move t,@uuo ;get TO pointer + save [ch] ;get a temporary AC to hack with! +scopy0: ildb ch,tt ;get a character + caie ch,^C ;is it a ^C + cain ch,0 ; or a ^@? + jrst scopy9 ; yes, end of loop + idpb ch,t ;deposit, and + jrst scopy0 ;do it again + +scopy9: push sp,t ; Without advancing the BP + setz ch, ; follow the string with a ^@ + idpb ch,t ; where it will be clobbered if further + pop sp,t ; copying is done + restore [ch] ; restore borrowed AC +bpback: exch tt,(sp) ; get back the original contents of the ACs + exch t,-1(sp) ; while saving the modified Byte pointer's + pop sp,@uuoac ; write back the modifed Byte Pointer's + pop sp,@uuo ; from whence they came + jrst @uuoh ; and return. + +;;; ASKUSR [ASCIZ /STRING/] types string and reads a char, echoing Yes or No. +;;; it skips if the answer is Yes. + +usrask: save [ch,dsprmp,uuo,uuoh] + move t,[output dspc,] ;cons up a display UUO + hrri t,@uuo ;with the right effective address + movem t,dsprmp +usras1: output dspc,@uuo + type tyoc,/ (Y or N) / + tyi + jrst usrext ; We'll take that as NO + jrst usras1 ; Help out + jrst usrext ; ditto + cain ch,40 ; Pretend that a space is a Yes also. + movei ch,"Y + caie ch,"y ;is it yes? + cain ch,"Y + jrst [type tyoc,/Yes. / ; successful + restore [uuoh] ; recover our return address + aos uuoh ; skip + jrst usrex1] ; and return +usrext: type dspc,/No. / + restore [uuoh] +usrex1: restore [uuo,dsprmp,ch] + jrst uuoret ;fail return + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; +;;; Password routines. ;;; +;;; ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +%COHLP==1 ;says command is not to be documented + +byebye: ;this is the location to use instead of + ;.logout, to avoid people logging out and + ;linking +phaser==.suset [.spirqc,,[%piltp]] ;sneaky way to get here +clock: +klock:: syscal finish,[argi tyoc] ;finish up our output + jfcl +IFN 1,[ skipn debug + .logout 1, + .break 16,100000 + .logout 1, +]; END IFN 1, + +IFN 0,[ .suset [.rsuppro,,tt] + cail tt,0 ;Are we running as an inferior? + .logout 1, ; Go away, but don't gun TELSER + syscal rfname,[argi tlnc ;is there a job open on this channel? + val t ; device + val x ; UNAME + val tt] ; JNAME + loss ; eh? + cain t,0 ;is the Device 0? + .logout 1, ; yes, there is no job there + tlz x,777700 ;clear out the TTY # part of nnTLNT + came x,[sixbit / TLNT/] ;is it really a telser? + .logout 1, ; nope + came tt,[sixbit /TELSER/] ;including JNAME? + .logout 1, ; nope + .uset tlnc,[.ruind,,t] ;get his index + .gun t, ;make it go away +]; END IFN 0, + +telbye: .logout 1, ;Bye-bye! + .logout 1, + +jtingl: type tyoc,/The TINGLE command does not yet exist +/ + ret + +init: syscal corblk,[cnti %cbndw ;need to write to initialize + argi 0 + argi %jself + argi pwpage ;just the first page + argi pwdc ;from the file + argi 0] + loss + + syscal RQDATE,[val x ? val t] + loss + jumpl t,[type dspc,/AThe system doesn't know the time yet, please +wait. +/ + movei t,300. ;system doesn't know time, + .sleep t, ;sleep 10. sec and hope it + jrst init] ;finds out the time. +init0: move tt,t + exch t,pwinit ;claim privilege of init'ing. +init1: camn t,pwinit ;should we init? + jrst initw ; no, someone else is, wait for him + setom pwlock ;unlock the lock + move x,pwcnt ;check the count, must be even + trz x,3 ;flush any odd words + movem x,pwcnt ;and save it back again + +init2: movem tt,pwdone ;mark init complete. + jrst initd ;We're all done. + +initw: camn tt,pwdone ;wait till someone else's init is finished. + jrst initd ; yes, they finished already. + type dspc,/APassword database being initialized by another program. +Please wait. +/ + movei t,30. + .sleep a, ;also consider that the job doing the + move t,tt ;init'ing may have aborted. + jrst init0 ;so go back to try it again just in case. + +initd: syscal corblk,[cnti %cbndr ;back to read-only + argi 0 + argi %jself + argi pwpage] + loss + syscal pgwrit,[argi pwpage] ; Make sure the disk copy is up to date + loss ; too + syscal dskupd,[argi pwdc] ;update creation date, etc. + loss ; Why would this fail? + ret + +constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; Lock manipulation routines. +;;;; +;;;; LOCK is the multi-purpose entry, which takes the address of the lock in D +;;;; PLOCK is the entry for locking the password database. +;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +plock: .suset [.sdf1,,[-1]] ;prepare to lock the database + .suset [.sdf2,,[-1]] ;defer interrupts + call pwdopn ;access the database again + movei d,pwlock ;lock the database +lock: syscal corblk,[cnti %cbndw ;make it writeable again + argi 0 + argi %jself ;get into self + argi pwpage ;at our password file location + argi pwdc ;the 0th page of the pword file + argi 0] + loss + .suset [.ruind,,tt] ;get our user-index to identify ourself + skipl (d) ;wait for switch to be free. + .hang + aose (d) ;try to lock it. + jrst lock ;(somone else grabbed it between + ;our .hang and our aose) +lock1: movem tt,pwlkid ;identify ourself as the culprit + move tt,loclst ;put the switch on the + hrli tt,(setom) ;locked switch list + movem tt,1(d) ;link it in + movem d,loclst ;and install it in the chain + +lock2: .suset [.runame,,t] ;record who we are + movem t,pwuhak ;for debugging and delousing + .suset [.rjname,,t] ;ditto for JNAME + movem t,pwjhak + aos pwaccc ;count accesses, for STAT command + move t,pwrbfp + aobjp t,.+1 + aobjp t,[movsi t,-pwrbfl ? jrst .+1] + movem t,pwrbfp + move x,pwuhak + movem x,pwrbuf(t) + move x,pxunam + movem x,pwrbuf+1(t) + + ret ;it's locked, continue + +;; This routine will set up the switch as a switch block, and make +;; loclst point to it. The contents of the switch block will be: +;; +;; 0 ;This word is the switch itself! +;; SETOM +;; ;The SETOM is the unlock instruction. +;; ;The RH has nothing to do with the SETOM; +;; ;it points to the next block of the list. +;; +;; Note that the HRLI instruction is superfluous, because 0 in the +;; left half of the second word of the block is the same as (SETOM). +;; +;; The three instructions starting at LOCK1 are critical because +;; the switch has been locked but is not on the locked switch list. +;; Therefore, an entry in the critical routine table of the form +;; +;; LOCK1,,LOCK2 +;; SETOM @t +;; +;; is needed, in case the job is killed while executing there. + + +;;;; 2. UNLOCKING AN AOSE-STYLE SWITCH. + +;; The correct way to unlock a switch follows: +;; (assuming that A points to the switch block and that +;; the switch block is the first item on the locked switch list). + +;; This has gross bug of removing anything on the list from top to the +;; switch being removed. Thus, before using any more locks, I should fix +;; it. but it came from .INFO.;ITS LOCKS, so foo! + +unlock: save [tt] + hrrz tt,1(d) ;remove the switch from the + movem tt,loclst ;locked switch list. +unloc1: setom (d) ;then unlock the switch. +unloc2: syscal corblk,[cnti %cbndr ;make read only + argi 0 + argi %jself + argi pwpage] + loss + syscal pgwrit,[argi pwpage] ; Update the lock page on disk + loss + restore [tt] + ret + +pulock: save [d] + movei d,pwlock ;unlock the database + call unlock + syscal pgwrit,[argi pwpage] ; Make sure the disk copy is up to date + loss + .suset [.sdf1,,[0]] + .suset [.sdf2,,[0]] ;undefer interruputs + syscal dskupd,[argi pwdc] ;update creation date, etc. + loss ; Why would this fail? + .close pwdc, + restore [d] + ret + +;; The instruction at UNLOC1 is critical because the switch is +;; locked but not on the locked switch list. Therefore, an entry +;; is needed in the critical routine table as follows: + +;; UNLOC1,,UNLOC2 +;; SETOM @t + + +;;;; This is the critical routine table + +critic: init1,,init2 ;from init1 to init2 the database has been + movem tt,pwinit ;marked as being inited. If killed undo it + + unloc1,,unloc2 ;Here the lock has been removed from chain + setom @tt ;but is still locked. + lock1,,lock2 ;Here, the switch is locked, but we are + setom @tt ;still in the process of putting it on the + ;chain + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; Password encryption and lookup/insert routines. +;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +;;; This encrypts the contents of PWBUF into the format it is in the file +;;; The result is returned in T and in PDPASS + +pwdmak: save [a,b,c,d] + call ustrip ;get the UNAME in TT, stripped of digits + skipn tt ;is there something there? + error /Null UNAME!/ + movem tt,pxunam ;remember who we're hacking + move x,pwbuf ;grab the pword into one word + xor x,pwbuf+1 ;xor'd into the other + rot x,31 ;rotate it oddly + add x,TT ;mix the UNAME in with the mess + addi x,736251 ;garble it some more + setz a, ;clear what we'll accumulate + setz b, + move c,pwbuf ;gobble them down + move d,pwbuf+1 + movei e,110 ;Stir well +pwdma0: trnn x,1 ;odd? + jrst [rot x,-1 ; not odd enough, make it odder + rotc a,1 ; gyrate wildly + sojg e,pwdma0 ; rock and roll + move t,a ; T is answer + movem t,pdpass + jrst pwdma9 ] + add a,c + add b,d + rotc a,1 ;mixed up? + rot x,-1 ;you ain't seen nothing yet + sojge e,pwdma0 ;brain salad surgery + move t,a ;T is the answer + add t,b ; But the T shuts down by 1:00 am + movem t,pdpass +pwdma9: restore [d,c,b,a] + ret ;that's the whole password + +;;; PWDUMK encodes the UNAME in it's trivial reversable fashion +;;; returns result in TT, and PDUNAM +;;; PWDUMS is the same, bug first strips off any final digit. + +pwdums: call ustrip ;strip the UNAME + caia ;got it already, don't gobble again +pwdumk: move tt,uname ;gobble down the UNAME + rot tt,13 ;mix it up a bit too + add tt,[742532,,732643] ;Will oddities never cease? + ret ;return for refund + + +ustrip: save [T,A] ;a couple of AC's to play with + move t,uname ;gobble UNAME + movei a,5 ;don't strip single character frobs! + setz tt, +ustrp0: lshc t,-6 ;check final position + caie tt, ;Got the last character? + jrst [lsh tt,-36 ; right-align it + cail tt,'0 ; is it a digit? + caile tt,'9 + caia ; nope + jrst [move tt,t ; get it in TT, where we expect it + movei t,6 + sub t,a + imuli t,6 ; yep, calculate how many real bits + lsh tt,(t) ; re-align left, without digit + restore [A,T] + ret] ; and take the express bus, we're set + move tt,uname ; not ending in digit, return whole UNAME + restore [A,T] + ret] ; It doesn't end in a digit, so OK. + sojge a,ustrp0 ; do it again! + move tt,uname ; not ending in digit, return this tiny + ;UNAME + restore [A,T] + ret + +;;; PWDCNS conses up an entry in PDATA buffer. It takes a UNAME +;;; un UNAME, a password in PWBUF, and initializes the flags according +;;; to the machine's defaults. +;;; PWDCID sets the creator and creation-date fields. + +pwdcid: save [x,tt] + jrst pwdcd0 + +pwdcns: save [x,tt] + call pwdums ;cons UNAME + call pwdmak ;cons password + setzm pdmore ;extra word initially 0 + hrlzi x,%pfnew ;get the default flags + movem pdflag ;and make them ours + setzm pdinfo + setom pddate +pwdcd0: call crtidx ; Get our creator index into TT + dpb tt,[pi$crt pdinfo] ; put that into the entry + syscal RQDATE,[val x] + loss + hllm x,pddate ; Put today's date in creator date + restore [tt,x] + ret + +;;; PWDINI expects a UNAME in UNAME, and a password in PWBUF, and either +;;; returns the entry for that UNAME in PDATA or a new entry in PDATA if there +;;; was no entry for that UNAME + +PWDINI: call pwdlok ;find it + pjrst pwdcns ; not there, cons it up + pjrst pwdget ;It's there, get it + + +;;; this opens the password file +;;; It must be done before any attempt can be made to make it writable + +pwdopn: syscal open,[cnti .uii ;for input + argi pwdc ;open on the p-word channel + pw.dev + pw.fn1 + pw.fn2 + pw.snm] + ERROR /Can't access password file!/ + syscal sdmpbt,[argi pwdc ? argi 0] ;clear dump bit, so always back up + loss + ret + +;;; this maps in the password file for reading +.upure +pwmapd: 0 ; -1 if file mapped +.pure + +pwdmap: skipe pwmapd ; Have we already mapped it? + ret ; Yes, don't bother repeating + call pwdopn ;open the file + syscal fillen,[argi pwdc ? val t] ;get how long the bastard is + ERROR /Can't get length of password file!/ + save [t,tt] + addi t,1777 ;convert words to pages + idivi t,2000 + movn tt,t ;and convert to AOBJN ptr to file + hrlz tt,tt ;, length in left half + movei t,pwpage ;and do same for the core side of things + hll t,tt ;from there to here + syscal corblk,[cnti %cbndr ;get read access. + argi 0 + argi %jself + t + argi pwdc + tt] + ERROR /Can't map password file!/ + + call init ;make sure it's up to date. + .close pwdc, ;close it up, we don't need it any more! + setom pwmapd ; Note we've mapped it + restore [tt,t] + ret + +;;; PWDLOK looks up a UNAME in the database, returns the pointer to +;;; the entry in A +;;; PWDLK0 is an alternate entry for pre-computed UNAMEs +;;; PWDLKX is alternate entry for not striping the UNAME. for PWDEL. + +pwdlkx: call pwdumk ;don't strip uname + jrst pwdlk5 + +pwdlk0: move tt,pdunam ;get the pre-computed UNAME garbled in TT + caia ;don't get it again. + +pwdlok: call pwdums ;get the UNAME garbled in TT +pwdlk5: setz a, ;count the entries +pwdlk1: camn tt,pwname(a) ;is this our UNAME? + jrst popj1 ; just find it, don't move it + addi a,pwleng ;move to next entry + camle a,pwcnt ;have we reached the end? + jrst [movem tt,pdunam ; failure return, remember who we wanted + ret] ; failed + jrst pwdlk1 ;not at end, keep looking + + +;;; PWDGET takes a pointer to the entry in A, and moves it to the buffer +;;; it first does an error check. +pwdget: movem a,pdloc ; Remember where we got it from + trne a,3 ;Is this a multiple of 4? + ERROR /Bad database pointer in PWDGET/ + hrlzi x,pwname(a) ;set up to BLT + hrri x,pdata ;the info on this person to our buffer + blt x,pdata+pwleng-1 ;to the Bahamas + move x,pwname(a) ;get the name... +pwdunm: sub x,[742532,,732643] ;Will oddities never cease? + rot x,-13 + movem x,uname ;save it for later + ret + +;;; This routine computes our creator index, adding us to the table of +;;; administrators if needed + +crtidx: save [x,t,a,b] + movei a,pwadmn ; table of people who have modified entries + call pwsget ; Get the table of entries + hlre b,runame ; Check out this for unloggedinness + aoje b,[ move x,[sixbit /___NNN/] + jrst crtida ] + move x,runame +crtida: move b,t ; Remember this AOBJN ptr + setz tt, ; Entry # +crtid0: camn x,(t) ; Is this us? + jrst crtid1 ; Yes + aos tt ; count the entries + aobjn t,crtid0 ; Next entry + movem x,tmpbuf(tt) ; Make this the next entry + sub b,[1,,0] ; grow the AOBJN ptr + movei a,pwadmn + call pwsput ; put the table back into the database +crtid1: restore [b,a,t,x] + aos tt ; 0 means unknown + ret + +;;; This routine installs a password into the database. +;;; It takes it's data in the PDATA buffer. +;;; The protocol is to ALWAYS look up the entry AFTER +;;; locking the database. + +pwdput: save [x,t,tt,a,b] +IFN $$PAND,[ + syscal RQDATE,[val t] + loss + hllm t,pdmod ; Remember the modification date + call crtidx ; Get the creator index in TT + +pwdpt1: dpb tt,[pi$mod pdinfo] ; Store who modified this entry + +] ; END of IFN $$PAND, + + call plock ;Open and lock the password database + call pwdlk0 ;does the entry exist? + do [ move a,pwcnt ; so grab the count + movei a,pwleng(a)] ; and move to the next case + + movei t,(a) ;Get pointer where we expect it + tlze t,pwleng-1 ;it must not be odd + jrst [ movem t,pwcnt ; so straighten it out + call pulock ; close up the database + error /Odd length password file./] + + idivi t,2000 ;T now has page # wrt pwdata + movei t,pdpage(t) ;Get page # in the file + hrlzi x,pdata ;construct a BLT word for the password data + hrri x,pwname(a) ;to where we want to put it. + syscal corblk,[cnti %cbndw ;gotta write it. + argi 0 + argi %jself + argi pwpage(t) + argi pwdc + argi (t)] + jrst [call pulock + error /Can't write password file./] + + blt x,pwdata+pwleng-1(a) + + syscal corblk,[cnti %cbndr ;make read-only again + argi 0 + argi %jself + argi pwpage(t)] + loss ;eh? We're all fucked up! + syscal pgwrit,[argi pwpage(t)] ; Update the disk copy + loss + camle a,pwcnt ;have we added anything? + movem a,pwcnt ; yes, be sure to save that + call pulock ; Unlock the database + restore [b,a,tt,t,x] + ret + +;;; PWSGET -- get a string from the database string area. +;;; address of string pointer is taken in A, length is returned in A. +;;; T gets an AOBJN ptr to the data. +;;; Data is copied into TMPBUF. + +PWSGET: save [d,x,tt] + call plock ; lock the database + move a,(a) ; Get the string pointer + hrli x,pwstr(a) ; Get address of string + hrri x,tmpbuf ; where to put it + hlre a,a ; - + movns a ; + setzm tmpbuf ; Always have a 0 there in case null string + jumpe a,pwsgt0 ; if nothing to move, don't try + blt x,tmpbuf-1(a) ; Move the data into TMPBUF +pwsgt0: movn t,a ; create an AOBJN ptr to data for T + hrl t,t + hrri t,tmpbuf + call pulock ; Unlock the database + restore [tt,x,d] + ret + +;;; PWSPUT writes data into the database string area. +;;; IN A is the address of the database entry to store ptr into. +;;; IN B is AOBJN to data to be installed + +; String Space. This is divided into thre consing areas, NEW, OLD, and NEXT +; When NEW is filled, all pointers into OLD are copied into NEXT space, which +; then becomes the NEW space. The old NEW space, not suprisingly, becomes the +; OLD space. This is done to avoid half-moved strings, to guarantee consistancy +; at all times. Strings are pointed to by AOBJN ptrs, relative to PWSTR. The +; AOBJN ptrs are examined and updated only with the database locked, and are +; updated only after any necessary copying is done. Each consing area is 2 pgs +; long. + +PWSPUT: save [d,x,t,tt] + push sp,a + call plock ; Database MUST BE LOCKED + skipe pwsgcp ; Is there a GC in progess? + call pwsgc ; Yes, GC first! + setz a, ; No full GC done yet +pwspt0: hlre t,b ; get - + jumpge t,pwspte ; empty, just zero it + hlre x,pwsptr ; Get - + sub x,t ; get - + jumpg x,[ caile a,1 ; GC failed? + jrst pwsgcf ; Complain about it + call pwsgc ; full, gotta GC first + aos a ; say we've already GC'd + jrst pwspt0] + hrrz tt,pwsptr ; get pwstr offset of free area + movei d,(tt) ; copy for our consed ptr + sub tt,t ; get new pwstr offset of remaining free + hrl tt,x ; get new free AOBJN ptr + movem tt,pwsptr ; update it in single instruction + hrli d,(t) ; get AOBJN ptr to newly consed string + movei x,pwstr(d) ; prepare to put the data there + hrl x,b ; from our given string + move tt,d ; Copy our AOBJN ptr to store when done + sub d,t ; get idx of word after our string + save [t,tt] + hrrz t,x ; first page to be hacked + lsh t,-12 ; page # within job + subi t,pwpage ; page # within file + movei tt,pwstr-1(d) ; addr within job of last word + lsh tt,-12 ; page # within job of last word + subi tt,pwpage ; page # of last word + syscal corblk,[ argi %cbndr\%cbndw + argi %jself + argi pwpage(t) ; page # within job + argi pwdc + argi (t)] + loss + camn t,tt ; are they on the same page? + jrst pwspt2 + syscal corblk,[ argi %cbndr\%cbndw + argi %jself + argi pwpage(tt) ; page # within job + argi pwdc + argi (tt)] ; page # within file + loss +pwspt2: blt x,pwstr-1(d) ; Move it! + syscal pgwrit,[ argi pwpage(t) ] ; Write the page + loss + camn t,tt ; Are they on the same page? + jrst pwspt3 ; yes + syscal pgwrit,[ argi pwpage(tt) ] ; no, hack the second one too + loss +pwspt3: restore [tt,t] + pop sp,a + movem tt,(a) ; Store our now-valid pointer +pwspt4: call pulock ; unlock the database + restore [tt,t,x,d] + ret + +pwspte: pop sp,a + setzm (a) ; No more string + jrst pwspt4 + +;; now we gotta GC +pwsgc: save [x,t,tt,a,b,c,d,e] + hrrz d,pwsptr ; Let's see which space is NEW + caige d,pistr0+pstrln ; Is NEW space = 0? + jrst [ movei d,pistr0 ; NEW space = 0 + movei a,pistr1 ; NEXT space = 1 + movei b,pistr2 ; and OLD space = 2 + jrst pwsgca] + caige d,pistr1+pstrln ; Is NEW space = 1 + jrst [ movei d,pistr1 ; NEW space = 1 + movei a,pistr2 ; NEXT space = 2 + movei b,pistr0 ; and OLD space = 0 + jrst pwsgca] + caige d,pistr2+pstrln + jrst [ movei d,pistr2 ; NEW space = 2 + movei a,pistr0 ; NEXT space = 0 + movei b,pistr1 ; and OLD space = 1 + jrst pwsgca] + error /Illegal String space pointer in PWSGC/ + +;; state now is that OLD is in B, NEW in D, and NEXT in A +pwsgca: hrli a,-pstrln ; make an AOBJN ptr to NEXT space + skipn c,pwsgcp ; If GC not in progress + movem a,pwsgcp ; remember our GC pointer + skipe c ; If GC *WAS in progress + move a,c ; use the old GC pointer + movei t,(a) ; Compute page # of NEXT space in string + idivi t,2000 ; space + syscal CORBLK,[ argi %cbndr\%cbndw ; Need read and write + argi %jself + argi pwpage+pwstpg(t) ; NEXT space page 0 + argi pwdc + argi pwstpg(t)] + loss + syscal CORBLK,[ argi %cbndr\%cbndw + argi %jself + argi pwpage+pwstpg+1(t) ; NEXT space page 1 + argi pwdc + argi pwstpg+1(t)] + loss + + move t,[-pwstln,,pwstbg] ; AOBJN ptr to strings to be GC'ed + +pwsgc0: skipl c,(t) ; Is there a string here? + jrst pwsgc1 ; no, ignore it + movei x,(c) ; Get the index portion + trz x,pstrln-1 ; Flush where in space it is + caie x,(a) ; Is it already in NEXT space? Aborted GC + cain x,(d) ; Is it in NEW space? + jrst pwsgc1 ; yes, ignore it + caie x,(b) ; Is it in OLD space? + error /Gubbish database-string pointer./ + move e,a ; Remember un-updated pointer + hlre x,a ; Get - + hlre tt,c ; Get - + movns tt ; + add x,tt ; Get - + jumpge x,pwsgcf ; If no room, go complain + hrl a,x ; Update the amount of room + addi a,(tt) ; Update the pointer + movem a,pwsgcp ; Update it in memory + movei x,pwstr(e) ; Get address to move to + hrli x,pwstr(c) ; Address to move from + blt x,pwstr-1(a) ; Move it! + hll e,c ; Put length into AOBJN ptr + movem e,(t) ; store the updated pointer +pwsgc1: aobjn t,pwsgc0 ; Next! + movem a,pwsptr ; Be sure pointer is updated in memory + setzm pwsgcp ; Saw we've finished our GC + restore [e,d,c,b,a,tt,t,x] + ret + +; GC failure +pwsgcf: type dspc,/AString space in the database is full. You'll have +to make room first. +/ + call pulock + jrst quit + + +ifn $$PAND,[ + +;;; PWSTXT reads text from the terminal and stores it into string space +;;; A contains address of AOBJN ptr to hack +;;; Skip-returns if successful + +pwstxt: save [b] + save [a] + type dspc,/Enter text, end with ^C +/ + call readtx ; Read in the text + jrst pwstxx +pwstx0: restore [a] ; where to put it + movn t,argcnt + subi t,4 + idivi t,5 ; get -<# of words required> + camn tt,[-4] ; Was it a multiple of 5 characters? + jumpn t,[ movns t ; <# of words required> + setzm msgbuf(t) ; make into an ASCIZ string + aos t ; including room for it + movns t + jrst pwstx1] +pwstx1: hrl b,t ; build an AOBJN ptr + hrri b,msgbuf + call pwsput ; put it into the database + restore [b] + jrst popj1 + +pwstxx: restore [a] + restore [b] + ret + +pwslin: save [b] + save [a] + type dspc,/AEnter 1 line of text: / + move bp,[440700,,msgbuf] + call readln + jrst pwstxx + jrst pwstx0 + + +] ; END -- IFN $$PAND, + +pwgtxt: save [a,b] + call pwsget +ifn $$PAND,[ + type dspc,/A [/ + 10type tyoc,a + type tyoc,/ words long] +/ +] ; END of IFN $$PAND, + + output tyoc,tmpbuf + restore [b,a] + ret + + +ife $$PAND,[ +;;; This routine expects that PWDGET has been called + +syschk: move x,pdflag ;fetch the flag word + tlne x,%pfbad ;is logging in from loser sites ok? + call sitchk ; no, check it out! + + ldb x,[pi$sta pdinfo] ; Get the account state + cain x,ps%new ; State=new? + error /State = PS%NEW, account should never be in this state/ + cain x,ps%apl ;has he applied for an account? + jrst [setzm ttyflg ; be sure he sees this + type dspc,/AYour application has not yet been processed. +Please try later. +/ + jrst sysrfs] + cain x,ps%sys ;is it a system name? + jrst [type dspc,/AThat is a reserved name, please choose another. +/ + jrst sysrfs] + + caie x,ps%rfs + cain x,ps%hld + jrst prob + cain x,ps%off + jrst prob + jrst popj1 ; nope, no problem + cain x,ps%off ; Is it turned off? + jrst popj1 ; nope, no problem +prob: type dspc,/AThat account has been / + move t,uname ; UNAME will be used as the FN2 + cain x,ps%rfs ;refused? + jrst [ type tyoc,/denied. +/ + movei b,rfsnam + call prtrsn + jrst rfsnot] ; Note that the refuse has been seen + cain x,ps%off + jrst [ type tyoc,/temporarily turned off. +/ + movei b,offnam + call prtrsn + jrst rfsnot] ; Note that the refuse has been seen + + cain x,ps%hld + jrst [ type tyoc,/placed on hold. +/ + movei b,hldnam + call prtrsn + jrst rfsnot] + + error /Unknown account state/ + +prtrsn: call fn2opn + jrst sysrfs + type tyoc,/Reason: +/ + call printf + +sysrfs: type dspc,/AAny questions may be directed to USER-ACCOUNTS +/ + ret + + +;; Note in flag word that he's seen this message + +rfsnot: movsi x,%pfmsg + iorm x,pdflag + jrst pwdput + +;;; SITCHK checks if a login is from a bad site and if it is, it flushes the +;;; imposter. + +sitchk: movei a,losers ; AOBJN ptr for the table of losers + call pwsget ; get the data from the database + jumpe a,cpopj ; Check for empty BAD sites list. + move tt,fhost ;where are we from? +sitch1: camn tt,(t) ;is it a loser? + jrst [.suset [.smsk2,,[0]] ;no interrupts! + .reset dspc, ;reset output + .reset tyic, ;reset input + terpri + 6type tyoc,uname + type tyoc,/ is restricted to the local area. +/ + move x,uname ;pretend the xuname is the uname + movem x,pxuname + call pwdwrn ;note this failure + phaser] + aobjn t,sitch1 + ret ;ok! + +;;; DILTIM fails if a user is not authorized for this system load or this +;;; line. It expects PWDGET to have been called + +diltim: ldb x,[pi$sta pdinfo] ; Get the account state + cain x,ps%apl ;has he just applied? + jrst popj1 ; don't hack him + move x,pdflag + tlne x,%pfdil ;is he authorized for dialup? + pjrst timchk ; yes, just check on the time + ldb a,[pi$grp pdinfo] ; Get our group + movei tt,1 ; start with one bit + lsh tt,(a) ; get the bit to check + tdnn tt,pwgdil ; Is this group priveleged? + pjrst timchk ; yes, let him on + + movei tt,1 ;start with one bit + + move a,consol ;get consol # for bit shift + lshc t,(a) ;shift it to it's position + tdnn tt,dltty0 ;is it a dialup? + tdne t,dltty1 + jrst [ ldb a,[pi$grp pdinfo] ; Get our group + movei a,dilmsg(a) ; Get address of message AOBJN ptr + call pwgtxt ; Print the message + jrst sysrfs] + +timchk: skipn pwholp ;If this is a holiday + tlne x,%pfday ; Or if he authorized for daytime + jrst popj1 ; Let him go + .ryear t, ;Check out the date + ldb x,[320300,,t] ;Get the day of the week + syscal rqdate,[val b] ; Disk date + seto b, + camn b,[-1] ;Does the system know the time? + jrst [type dspc,/AThe system does not yet know the time, you cannot yet log in. +Please wait. Someone is still in the process of bringing up the system, +and will soon fix the them, when you can log in. +/ + jrst sysrfs] + ldb a,[pi$grp pdinfo] ; Get the group index for this user + movei t,(b) ; Get the time of day + movss b ; Get the date in RH + idivi t,2*60.*30. ; get # of 1/2 hours after midnight + movei ct,6 ; let's look at the six exception dates + move d,[442200,,pwordt] ; Byte Pointer to exception dates +exday0: ldb tt,d ; Get an exception date + cain tt,(b) ; Is this the exception date? + jrst exday ; yes, handle as exception + sojg ct,exday0 + + setz d, ; assume weekday + cain x,0 ; is it Sunday? + movei d,1 + cain x,6 ; or Saturday? + movei d,2 + ldb c,[ dm$wds pwgrdm(a) ; Get start time + dm$sns pwgrdm(a) + dm$sts pwgrdm(a)](d) + + ldb d,[ dm$wde pwgrdm(a) ; Get end time + dm$sne pwgrdm(a) + dm$ste pwgrdm(a)](d) + cain c,77 ; no restriction on time-of-day? + jrst popj1 ; Yes, let him on! + caml t,c ; Is it earlier than the restricted period? + caml t,d ; or later than it? + jrst popj1 ; yes, let him on. + terpri + movei a,timmsg(a) + call pwgtxt ; type it + jrst sysrfs + +exday: movei tt,6 ; # of override dates + sub tt,ct ; get override date # + imuli tt,-6 ; # of bits + move c,pwgors(a) ; Get the override start times for our grp + lsh c,(tt) ; Position this date's at bottom + move d,pwgore(a) ; Get the override end times + lsh d,(tt) ; Position this date's at bottom + andi c,77 ; Flush all others + andi d,77 + cain c,77 ; no restriction on time-of-day? + jrst popj1 ; Yes, let him on! + caml t,c ; Is it earlier than the restricted period? + camle t,d ; or later than it? + jrst popj1 ; yes, let him on. + terpri + + imuli tt,20 ; get idx for table of grp*date messages + addi tt,a ; get index of our message + movei a,timmsg(a) ; If no special message, print the usual... + skipe ovrmsg(tt) ; Get the message for this group today + movei a,ovrmsg(tt) + call pwgtxt + jrst sysrfs + +] ; END IFE $$PAND + +ifn $$pand,[ +spew: call pwread + .logout 1, + move x,[sixbit /FOO/] + movem x,uname + call pwdmak + ret +]; end ifn $$pand + + +;;; Routine to read a password. + +pwprmp: type dspc,/APassword: / +ife $$PAND,[ + move x,crgbts ;gotta get it again, TYPE flushes X + trne x,cf$lms ;is he paranoid? + type dspc,/##%##&##$##=H*%**&**$**=*H%@#&@#$@#=@#H/ +] + ret + +pwread: setzm ttyflg ;turn on typeout so this is sure to be seen! + move x,[call pwprmp] ;on re-display, re-prompt + movem x,dsprmp + call pwprmp + setz count, ;count them + move t,[440600,,pwbuf] ;point into our buffer + setzm pwbuf ;clear out our buffer + setzm pwbuf+1 ;so that anything at the end is blank + +pwrlop: tyi ;get a character + ret ; quiting, return + jrst [type dspc,/A(Enter your password, end with a carriage return)/ + jrst pwread] ;tell him what's what and ask again + + jrst [sosge count ; keep track of count + jrst [movei d,11. ; over-rubout + call wipe ; so wipe it out + setzm dsprmp ; and no more funny prompt + terpri ; don't wait to go to next line + ret] ; return to caller as failure + setz ch, ; clear out that char from our buffer + dpb ch,t ; so that it doesn't lose if end + decbp6 t ; and back up. + jrst pwrlop] ; still in the running, gobble another + + caie ch,^M ;is it a CR + cain ch,^C ; or a ^C + jrst [setzm dsprmp ; yes, no more funny prompt + jrst popj1] ; then we've won! + + caige ch,140 ;Convert to 6bit: if it's small + subi ch,40 ;convert it so numbers work out right + + aos count + caig count,14 ;if we've not had our fill + idpb ch,t ; deposit this in our account + jrst pwrlop ;and gobble down more. + +;;; PWASK asks for a password, and skips if correct, and tries again if not + +pwask: call pwdak1 + jrst [type dspc,/AIncorrect. +/ + call pwdwrn + call pwdak1 + pjrst pwdwrn ; warn account of lossage! + jrst popj1] + jrst popj1 + +pwdak1: call pwread ;read the password + jrst pwdak1 ; just return if he quits or rubs out + push sp,pdpass ;save the real password + call pwdmak ;create the password he just gave + came t,(sp) ;is it the same as the saved one? + jrst [pop sp,pdpass ; restore real password + .reset tyic, ; flush typeahead, like multi-CR lossage + ret] ; and fail-return + pop sp,pdpass ;restore real password + jrst popj1 ;and success return + +pwdwrn: skipn t,pxunam ;do we have a bug? + error /PWDWRN detected null PXUNAM/ + +logit: movei b,lognam + syscal open,[cnti .uao\100000 ;write over mode + argi dsko + (b) + 1(b) + 2(b) + 3(b)] + ret ; if failed, don't bother. + syscal fillen,[argi dsko ? val x] ;get end position + ret + syscal access,[argi dsko ? x] ;and go there + ret + 6type dsko,uname + .iot dsko,[^I] + output dsko,hstnam ; Output the foreign host name + skipe tipnum + jrst [ tyo dsko,["#] + 8type dsko,tipnum + jrst .+1] + .iot dsko,[40] + 8type dsko,consol + .iot dsko,[40] + call datime"timget ;get the time + push sp,a ;save the time word for later + call datime"timdow ;convert to day of week + + output dsko,@datime"dowlng(b) ;print it into the file + type dsko,/, / + + move d,[440700,,msgbuf] ;put the date down msgbuf + pop sp,a ;get thhe time word + call datime"timexp + output dsko,msgbuf ;output the stuff in the input buffer + skipl linkno ; is this under link? + call lnklog + type dsko,/ +/ + .close dsko, + ret + +lnklog: type dsko,/ Link from TTY #/ + 8type dsko,linkno + type dsko,/, UNAME = / + 6type dsko,linker + ret + +ifn $$pand,[ + +pwdel: call plock ;lock the password database + call pwdlkx ;find the beggar + pjrst pulock ; trivial case, not there + movei t,(a) ;Get pointer where we expect it + tlne t,3 ;it must not be odd + jrst [call pulock ; unlock the password database + error /Odd length password file./] + idivi t,2000 ; T <= page # in data area + movei t,pdpage(t) ; Get page # in file + movei b,(t) ;save it for when we re-purify + syscal corblk,[cnti %cbndw ;gotta write it. + argi 0 + argi %jself + argi pwpage(t) + argi pwdc + argi (t)] + jrst [call pulock ;unlock the password database + error /Can't write password file./] + move t,pwcnt + hrlzi tt,pwdata(t) ;LH(TT) <- pointer to last password + hrri tt,pwdata(a) ;RH(TT) <- new home for last password + blt tt,pwdata+pwleng-1(a) ;move one entry + move x,pwcnt + subi x,pwleng ;subtract off one entry from total + movem x,pwcnt + syscal corblk,[cnti %cbndr ;make read-only again + argi 0 + argi %jself + argi pwpage(b)] + loss ;eh? We're all fucked up! + call pulock ;all done, unlock the database + jrst popj1 ;successful return + +pwprul: call stinit + jfcl + call maplsr + setz d, ; start counting +pwpru0: movei a,lsrc + move x,pwname(d) ; Get the UNAME + call pwdunm ; un-decode it + move b,uname ; store it + call lsrtns"lsrunm ; Is he in INQUIR? + caia + jrst pwpru9 ; Yes, don't print it + call usrprt ; print the info on this user + ret ; typeing flushed +pwpru9: addi d,pwleng ; Next user + camg d,pwcnt ; are we at the end yet? + jrst pwpru0 ; Nope, keep on trukin' + pjrst pstats ; Yep, all done, so let's print some stats + + +;;; Routine to print out null-passwords users. + +pwprnl: save [a,b] + call maplsr ; Ensure INQUIR mapped + setz d, ; D points to account entry +pwprn1: move a,d + call pwdget ; Fetch password and UNAME + move b,pdpass + setzm pwbuf ; Null password + setzm pwbuf+1 + call pwdmak ; Get the encrypted form into T + camn t,b ; Same? + jrst [ call usrprt ; Yes - print info for this luser + jrst pwprn9 ; (typing flushed) + jrst .+1 ] + addi d,pwleng ; Pointer to next luser + camg d,pwcnt ; Are we at the end yet? + jrst pwprn1 ; Nope, keep on trukin' +pwprn9: restore [b,a] + ret + + +;;; Routine to print out never-logged-in users. + +pwprnw: call stinit + jfcl + call maplsr + setz d, ; start counting +pwprw0: move x,pwflag ; Check the flags + tlnn x,%pfnew ; Has he ever logged in? + jrst pwprw9 ; Yes, don't print him + call usrprt ; print the info on this user + ret ; typeing flushed +pwprw9: addi d,pwleng ; Next user + camg d,pwcnt ; are we at the end yet? + jrst pwprw0 ; Nope, keep on trukin' + pjrst pstats ; Yep, all done, so let's print some stats + + +pwdprt: call stinit ;initialize statistics and print leading + ;info + jfcl ; We've gotta grovel over them anyway... + type tyoc,/ +Data follows: +/ + setz d, ;start counting, bud. + move c,crgbts ;check out whether we are brief mode + trnn c,CF$PBF ;are we? + call maplsr + +prtlop: skipe allflg ;are we printin extra info? + type dspc,/A_________________________ + +/ + call usrprt ;print out the entry + ret ; typeing flushed + addi d,pwleng ;next entry + camg d,pwcnt ;are we at the end yet? + jrst prtlop ;keep on trukin' + pjrst pstats ; yep, all done, so let's print some stats + + +pwdsts: call stinit ;initialize status counts and print leading + pjrst pstats ;info + setz d, ;start counting, bud. + call maplsr + +psdst1: move a,d ;PWDGET expects pointer in A + call pwdget ;get the entry to have stats counted + call gstats ;get the flag stats + movei a,lsrc ;tell LSRTNS what channel it can hack + move b,uname ;ask about this UNAME + call lsrtns"lsrunm ;is it there? + jrst [aos pnonam ; count how many of these there are + jrst psdst3] ; Don't hack INQUIR any more! + movem b,lsrptr ;save pointer to this entry + movei a,lsrtns"i$grp ;find his group + call lsrtns"lsritm + jrst [aos ptype ; count it + jrst psdst3] ; nothing to do + + move t,a ;copy it + ildb ch,t ;check it out + cain ch,0 ;is it null? + jrst [aos ptype ; count it + jrst psdst3] ; and don't bother otherwise + + cail ch,140 ;upper-casify + subi ch,100 + subi ch,40 ;make it into 6bit + skipge ch ;make ssure it's in range + setz ch, + aos ptype(ch) ;count the beggar +psdst3: addi d,pwleng ;net one! + camg d,pwcnt ;are we at the end yet? + jrst psdst1 ;keep on trukin' + pjrst pstats ; yep, all done, so let's print some stats + + +stinit: tyo dspc,[^P] ;clear the screen + tyo dspc,["C] + move x,pwcnt ;check the count + trne x,3 ;is it off? + do [type tyoc,/ +The count is out of phase! +Count = / + 8type tyoc,pwcnt +] + type tyoc,/ +Last modified by: / + 6type tyoc,pwuhak + tyo tyoc,[40] + 6type tyoc,pwjhak + type tyoc,/ +Access count: / + 10type tyoc,pwaccc + terpri + move x,pwaccc ;get this access count + camn x,opwacc ;is it still the same? + ret ; yes, don't bother + movem x,xpwacc ;remember... + setzm ptype ;clear ptype + move x,[ptype,,ptype+1] + blt x,cntend ;all of them! + + jrst popj1 + + +pstats: move x,xpwacc ;remember when we started + movem x,opwacc + type tyoc,/ +*** Statistics *** + +Total users: / + move x,pwcnt ;calculate # of entries + idivi x,pwleng + movem pwbuf ;temporary spot + 10type tyoc,pwbuf ;# of users in decimal! + type tyoc,/ +*'s: / + 10type tyoc,pnull + type tyoc,/ +'s:/ + 10type tyoc,pzunam + type tyoc,/ +Flag counts: +SYSTEM APPLIED NEW REFUSED NODAY NODIAL +/ +irp flg,,[sys,apl,new,rfs,day,dil] + 10type tyoc,pz%!flg + tyo tyoc,[^I] +termin + + type tyoc,/ +1 +Breakdown by INQUIR group: +Group Count +----- ----- +/ + move t,[-100,,0] ;index into PTYPE table + +pstat1: skipe ttyflg ;if TTY is off + ret ; don't bother any more + skipn ptype(t) ;if it's zero + jrst [aobjn t,pstat1 ; loop + terpri ; until the end + ret] + hrrz ch,t ;get the character + addi ch,40 ;convert to ascii again + tyo tyoc,ch ;type it out + tyo tyoc,[^I] ;tab over for count + + push sp,t ;save T, we need it! + 10type tyoc,ptype(t) ;type it out + pop sp,t ;restore T + + terpri ;new line + aobjn t,pstat1 ;loop until the end + ret ; that's it. + +;;; print out the database data for a user. USRWHO is for pre-calculated UNAME +;;; and USRPRT is for having a pointer to entry in D. + +usrprt: skipe ttyflg ;was the TTY turned off? + ret ; yes, stop printing + push sp,a ;takes pointer in A + move a,d + call pwdget ;get the entire entry + pop sp,a + call usrwho ;print out the stuff! + aos pnonam ; count how many of these there are +pwprt8: call fstats ;get the stats for the flags + jrst popj1 ;skip return + +;;; USRPRI skips if there is an INQUIR entry, and prints the name, etc. +;;; takes uname in UNAME +;;; clobbers PWBUF + +usrpri: move bp,[440700,,msgbuf] + aos (sp) ; Skip unless USRPR2 doesn't + call usrpr2 ; compute up the text + sos (sp) ; (no INQUIR entry) + setz ch, ; be sure to end with NUL + idpb ch,bp + output tyoc,msgbuf ; output it to the TTY + ret + + +;;; USRDAT skips if there is an INQUIR entry, +;;; takes UNAME in UNAME +;;; clobbers PWBUF +;;; assumes password info already in PDBUF +usrdat: move x,uname + idpb6 x,bp ; write the uname + tyobpi bp,^I + setom nodate ; suppress creator/modifier date info + jrst usrdt0 + +;;; USRPR1 skips if there is an INQUIR entry. +;;; takes uname in UNAME +;;; clobbers PWBUF + +usrpr1: move tt,uname ;get it + movem tt,pwbuf ;as password as well + setzm pwbuf+1 ; (second word 0) + move x,uname ; Get the uname + idpb6 x,bp ;type it out + tyobpi bp,^I ;space over to column for that + call pwdlok ;find this user + pjrst [write bp,/ [NEW] / + call pwdcns ; cons up an entry + jrst usrpr2] ; go handle the INQUIR end of it + call pwdget ;and get his data +usrdt0: call uflgp0 ;print his flags +usrpr2: skipe brfflg ;are we supposed to be brief? + ret ; yes, just return + tyobpi bp,^I ;Tab over to NAME column! + call grplsr ;get the group for this loser + jrst [write bp,/ (No INQUIR entry)/ + jrst usrdpr] ; and just print his name + idpb ch,bp + movem ch,lstgrp ;remember it for SCAN + subi ch,40 ;make it into 6bit + skipge ch ;make ssure it's in range + setz ch, + aos ptype(ch) ;count the beggar + +pwprt3: movei a,lsrtns"i$rel ;find his relationship + call lsrget + movei ch,40 ; substitute a space + upper ch + idpb ch,bp + tyobpi bp,40 + move b,lsrptr + movei a,lsrtns"i$name ;find his name + call lsrtns"lsritm + jrst [write bp,/-=> [His INQUIR entry is missing his NAME!!]/ + jrst usrdpr] ; unsuccessful + move b,bp ;where to get his name + call lsrtns"lsrnam ;get his name in human-readable form + jfcl ; eh? + move bp,b ; Recover the byte pointer + decbp bp ; back over the null +usrdpr: hrlz a,pddate ; Get last login date + tyobpi bp,^I + call datwrt + skipe nodate ; If we don't want the date, + ret ; don't print the rest of this stuff + movei a,pwadmn + call pwsget ; Get the table of creators + write bp,/ + Creator: / + ldb tt,[pi$crt pdinfo] ; Get the creator index + jumpe tt,[ write bp,/Unknown / + jrst usrpx0] + move tt,tmpbuf-1(tt) ; Get the name + idpb6 tt,bp ; Include it in our output + write bp,/ / +usrpx0: hllz a,pddate + call datwrt + write bp,/, Last Mod: / + ldb tt,[pi$mod pdinfo] ; Get the last modification index + jumpe tt,[ write bp,/Unknown / + jrst usrpx1] + move tt,tmpbuf-1(tt) + idpb6 tt,bp + write bp,/ / +usrpx1: hllz a,pdmod + call datwrt + write bp,/ +/ + jrst popj1 + + +datwrt: save [d] + hlre d,a + skipe d + aosn d + jrst [ write bp,/[Date Unknown]/ + jrst datwrx] + move d,bp + call datime"datasc + move bp,d +datwrx: restore [d] + ret + +datprt: save [d] + hlre d,a ; If date part is -1 + skipe d + aosn d + jrst [ type tyoc,/[Date Unknown]/ + jrst datprx] + move d,[440700,,msgbuf] + call datime"datasc ; deposit date into MSGBUF + output tyoc,msgbuf ; Type it +datprx: restore [d] + ret + +;;; UFLGPR prints the user's flags +uflgpr: move bp,[440700,,msgbuf] + call uflgp0 + setz t, + idpb t,bp + output tyoc,msgbuf + ret + +uflgp0: ldb t,[pi$grp pdinfo] ; Get his group + move t,pwgnam(t) ; get the group's name + idpb6 t,bp + tyobpi bp,^I + + ldb tt,[pi$sta pdinfo] ; Get the state of this account + cain tt,ps%del ; if this account is deleted + move tt,delsta ; Get the state before deletion + cain tt,ps%new ; Is this a new account? + jrst [ write bp,/[NEW] / ; note the fact + jrst .+1] + cain tt,ps%sys ;is this a system name? + jrst [ write bp,/[SYS] / ; note the fact + jrst .+1] + cain tt,ps%rfs ;is he refused? + jrst [ write bp,/[RFS] / + jrst .+1] + cain tt,ps%off ; Temporary hold? + jrst [ write bp,/[OFF] / + jrst .+1] + cain tt,ps%hld ;account on hold? + jrst [ write bp,/[HLD] / + jrst .+1] + cain tt,ps%apl + jrst [ write bp,/[APL] / + jrst .+1] + cain tt,ps%ok + jrst [ write bp,/[OK] / + jrst .+1] + push sp,pdpass ;save the users password + call pwdmak ;cons up the password + pop sp,pdpass ;restore the world + camn t,pdpass ;is it the same Pword and UNAME? + jrst [ tyobpi bp,"+ ; yes, print + to note it + aos pzunam ; and count it + jrst uflgp1] + skipn pdpass ;is the password null? + jrst [ tyobpi bp,52 ; and mark this oddity + aos pnull ; count the odities + jrst uflgp1] + + tyobpi bp,40 + +uflgp1: tyobpi bp,40 + move tt,pdflag ;check the flags + tlze tt,%pfnew ;is this new? + jrst [ tyobpi bp,"! + jrst .+1] + tlze tt,%pfday ;daytime? + jrst [ tyobpi bp,"L ; (L for Load) + jrst .+1] + tlze tt,%pfdil ;dialups? + jrst [ tyobpi bp,"T ; (T for Telephone) + jrst .+1] + tlze tt,%pfbad ;forbid bad sites? + jrst [ tyobpi bp,"B ; (B for Bad) + jrst .+1] + tlze tt,%pfmsg ; Seen REFUSE/OFF message? + jrst [ tyobpi bp,"S ; (S for Seen) + jrst .+1] + skipe tt ;Other bits on? + call flgerr ; Yes! Warn of it! + ret + +;;; GSTATS takes stats on an entry in PDATA buffer +;;; FSTATS takes just the flag stats. + +gstats: move tt,pdunam ;get the name... + sub tt,[742532,,732643] ;Will oddities never cease? + rot tt,-13 + movem tt,uname ;save it for later + movem tt,pwbuf ;as password as well + setzm pwbuf+1 ; (second word 0) + skipn pdpass ;is the password null? + aos pnull ; count the odities + push sp,pdpass ;save the real password + call pwdmak ;cons up the password + pop sp,pdpass ;restore the original password + camn t,pdpass ;is this the original password? + aos pzunam ; count how many of these there are +fstats: ldb x,[pi$sta pdinfo] ; Get the state + cain x,ps%apl ; PS%APL? + aos pz%apl + cain x,ps%rfs ; PS%RFS? + aos pz%rfs + cain x,ps%off ; PS%OFF? + aos pz%off + cain x,ps%hld ; PS%HLD? + aos pz%hld + cain x,ps%sys ; PS%SYS? + aos pz%sys + move x,pdflag ; check out the flag word + tlze x,%pfnew ; %PFNEW? + aos pz%new + tlze x,%pfday ; %PFDAY? + aos pz%day + tlze x,%pfdil ; %PFDIL? + aos pz%dil + tlze x,%pfbad ; %PFBAD? + aos pz%bad + tlze x,%pfmsg ; %PSMSG? + aos pz%msg + skipe x ;that should be all + call flgerr ; It's not, warn of it + ret + + + +;;; routine to warn of a flag word having bits on that it's not supposed to +flgerr: type dspc,/AFIE!!! Bad flag word found. +Index = / + 8type tyoc,pdloc ; It may change, but... + type dspc,/AUNAME = / + 6type tyoc,uname + type dspc,/APDFLAG = / + htype tyoc,pdflag ; type it out in half-words + type dspc,/ACall CSTACY!! +/ + ret + +.upure + +ptype: block 100 ;count of each group + +pnonam: 0 ; count of no-names +pzunam: 0 ; count of entries with UNAME=Password +pnull: 0 ; count of null entries +pz%apl: 0 ; count of PS%APL's seen +pz%sys: 0 ; count of PS%SYS's seen +pz%new: 0 ; count of %PFNEW's seen +pz%rfs: 0 ; count of PS%RFS's seen +pz%off: 0 ; count of PS%OFF's seen +pz%hld: 0 ; count of PS%HLD's seen +pz%dil: 0 ; count of %PFDIL's seen +pz%day: 0 ; count of %PFDAY's seen +pz%bad: 0 ; count of %PFBAD's seen +pz%msg: 0 ; count of %PFMSG's seen + +cntend: 0 ;dummy, end of cleared entries + +pwaddf: 0 ;non-zero if we want to append rather than + ;replace + +opwacc: 0 ;stats uses this to notice changes +xpwacc: 0 ;count when STATS was started + +.pure + +] ; END IFN $$PAND, + +.upure +lsrptr: 0 ;pointer into INQUIR database + +pxunam: 0 ;UNAME being hacked +pdloc: 0 ; Where this entry was found + +delsta: 0 ; State of account before deletion +popass: 0 ; Password before setting + +pdata:: ;block of data containing info for one user +pdunam: 0 ;temporary for encoded uname word +pdpass: 0 ;temporary for encoded password word +pdflag: 0 ;temporary for database flag word +pdinfo: 0 ; temporary for misc. info word +pddate: 0 ; temporary for creation/login date word +pdmod: 0 ; temporary for modification date word + 0 ; empty +pdmore: 0 ;temporary for database extra word + +newflg: 0 ;new flag for PWDCHG to use in place of old + + +.pure +p==sp ;synonym for LSRTNS and RFN + + +$$ulnp==0 ;don't assemble in last-name prefix-matcher +$$ulnm==0 ;Don't assemble in last-name finder +$$hsnm==1 ; DO assemble in HSNAME hackery +.insrt syseng;lsrtns + +;;; Basically wining file name reader goes here. + +$$MNAME==0 ;We want DSK: to print as DSK: +$$RFN==1 ;we want to read them. +$$PFN==1 ;we want to print them +$$SWITCH==0 ;we don't allow switches +$$PFNBRF==0 ;we don't use short forms. +$$RUC==0 ;the default means of reading is adaquate. + +.insrt syseng;rfn + +;;; basically winning time printer goes here. +$$out==1 ;we want the output routines. +$$outz==1 ;fancy time zones, etc. +$$outt==1 ;and the tables of days of the week + +.insrt syseng;datime + +.insrt sysen1;pwfile + +$$HST3==1 ; Use HOSTS3 database +$$ARPA==1 ; Support ARPA hosts +$$CHAOS==1 ; Support CHAOS hosts +$$HSTCMP==1 ; Routine to compare host addresses +$$OWNHST==1 ; Routine to get our host address +$$HSTMAP==1 ; Host table routines +$$SYMGET==1 ; Completing host-name reader +$$HOSTNM==1 ; Host-name lookup + +.insrt syseng;netwrk + +popj1: aos (sp) ;popskip +cpopj: ret + +;;; Input/Output Routines for NETWRK package. + +netwrk"getchr: + tyi + caia + movei ch,"? + jfcl + movei t,(ch) + jrst popj1 + +netwrk"putchr: + tyo tyoc,t + idpb t,bp ; Remember it for the mail + ret + +netwrk"spchan: + caie ch,^G + cain ch,^D + ret + jrst popj1 + + + + + +;;;; Command table definitions go here +cmdtab: + +ife $$pand,[ +command ACOUNT,,kacount,,,,/For information about getting an account, do +:ACOUNT +/,/Applications for accounts can sometimes be done online. +Do :ACOUNT to find out if online applications are being accepted. +If they are, simply answer the questions which :ACOUNT asks you, +and a USER-ACCOUNTS person will process your application quickly. +If you are in a particular hurry, you may contact USER-ACCOUNTS +people by sending network mail to USER-ACCOUNTS. +You should come back later and check if your account has been approved +by attempting to log in. +/ + +command LOGIN,,klogin,(%cocrg+%coarg),[ +CF$LPW ;password,pw,change +CF$LNI ;noinit,brief,bf +CF$LMS ;mask + +],/Identify yourself to the machine. +Type :LOGIN + +(If you do not have a password, do :HELP ACOUNT +for information.) +/,/ +The LOGIN command takes any of the following optional arguments: +-change or -ch change your password after you log in +-password or -pw change your password after you log in +-brief or -bf don't run your init file +-noinit same as -brief +-mask print a mask over where the password will print +/ +command TCTYP,,jtctyp,(%cojcl),,,/Set terminal type +/,/Runs the TCTYP program to set your terminal type. +Do :TCTYP HELP +for more info. +/ + +command LUSER,,jluser,(%cojcl),,,/Ask people for help. +/,/Asks certain people (if they're logged in) for help. +/ + +command ITS,,,(%cotop),,,/Information about this system. +/,/You are connected to a PDP-10 computer running the ITS operating +system. ITS stands for Incompatible Timesharing System, and was +written at the MIT Artificial Intelligence Laboratory. + +To request assistance from any available user, you may do :LUSER. +/ + +command JCL,,,(%cotop),,,/JCL is additional information that you give a command. +(Note: This is not like IBM Job Control Language!) +/,/It is typed on the same line following the command, and is usually +terminated with a carriage return. The only common exception to +this is terminating the :SEND and :MAIL commands with ^C (control-C) +causes them to send immediately. +/ + +command PRINT,,kprint,(%cojcl\%cofil),,,/Print a file. +/,/:print +prints a file. Files are in the format :; +where each field is six characters or less. + +Device defaults to DSK:, defaults initially to a user's +directory, or USERS for people without directories, or .INFO. if you aren't +logged in yet. + +You may use an [ALTMODE] (sometimes labelled ESC or ESCAPE) to print the +defaults. [ALTMODE] prints as a dollar sign. + +/ + +;;; QUIT will tell him how to do what's he's looking for. +;;; also in LOGOFF, BYE, etc. variations + +command QUIT,,kquit,(%conls\%cohlp),,,//,// + +command LOGOUT,,klogout,(%cocrg),[ +CF$LBY ;bye +],/Terminate connection with this machine. +/,/The :LOGOUT command should always be given when you are done +using the system to clean up any jobs you may have and close your +connection. +The -bye option runs the BYE program before logging you out. +/ + +]; END IFE $$PAND + +ifn $$PAND,[ + +command quit,,klogou,(%cocrg),,,/Quit out of the program +/,// + +command DELETE,,kkill,(%coarg),,,/Delete a name from the database +/,/Takes the name as an argument. +/ + +command SET,,USRSET,(%COARG\%COCRG),[ +CF$SSY ;system +CF$SPW ;password,pwd,p +CF$SDY ;day +CF$SND ;nday +CF$STL ;dial +CF$SNT ;ndial +CF$SRF ;rfs,refuse +CF$SHL ;hold,hld +CF$SBD ;bad +CF$SNB ;nbad +CF$SOF ;off +CF$SOK ;ok,on +CF$GRP ;group,grp,gr +],/Set a user's password and other attributes. +/,/If the user is not in the database, it defaults his password to his UNAME +Control arguments: + +PASSWORD + -pass, -pw, -pwd Set his password +FLAGS + -day Override group restriction for daytime use + -nday Remove override of group restriction for daytime use + -dial Override group restriction for dialup use + -ndial Remove override of group restriction for dialup use + -bad don't allow to log in from bad sites + -nbad undo a -bad +GROUP + -group, -grp User Group +STATE + -ok, -on Turn an account on + -off Turn an account off + -refuse, -rfs Denies this user an account. + -hold, -hld hold this account for more info + -system, -sys This is a reserved system name. +/ + +command VAR,,kvar,%coarg,,,\Examine/Set a database variable. +\,\VAR +You will be asked if you wish to set it. If so, you will be +prompted for additional information. + +Do "VAR " to list variables which can be examined/modified. +\ + +command GROUP,,grpset,%coarg,,,\Examine/Modify group characteristics. +\,\Interactively examine and modify groups' restrictions. +\ + +command FIND,,kfind,(%cojcl\%coarg\%cocrg),[ +CF$PBF ;bf,brf,brief +],\Find out which accounts someone has created. +\,\ FIND [-BRIEF] + +All the accounts created by are listed in the output file +which you will be asked for. If you specify the -BRIEF option, only +the unames will be listed; otherwise you will also get their names and +status of the account. +\ + +command CHECK,,kcheck,,,,\Checks a list of users to see if they are accounts. +\,/CHECK reads a file of UNAMES (there should be one on each line) and +produces another file which tells you which UNAME's corrsponded to +valid accounts in the PWORD database. You are prompted for both the +input and output file. You are also asked if the output file should +list people with accounts, or the unknown UNAMEs. +/ + +command PRINT,,kuprin,(%coarg\%cocrg),[ +CF$PBF ;bf,brf,brief +CF$PAL ;all +CF$PND ;nodate + +],\Print out the users in the database. +\,\Also gives various statistics as in the STATS command +PRINT prints info on a single user. +PRINT * or :PRINT prints out data on all users. +PRINT *UNKNOWN prints information on users without INQUIR entries +PRINT *NEW prints information on people who have never logged in. +PRINT *NULL prints information on people with null passwords. + +Optional control args: +-all list all of the information from INQUIR on this person + If the -ALL option is given, the HOLD or REFUSE or APPLY file + for this user will be printed. +-brief Don't even list his name! Much faster if you are listing all + users with :PRINT ALL or :PRINT +-nodate Don't list the creator and modifier (and dates) + +What is printed for a user without the -ALL option is as follows + TU + Creator: + +The T column is his INQUIR group, the U column is his INQUIR affiliation. + is one of the 16 different user groups listed by the GROUP command. + is one of the following: [NEW] [APL] [OK] [RFS] [HLD] [OFF] [SYS] + is *, +, or blank, for a password of null, UNAME, or other + +Flags are as follows: +! Never logged in. +L Allowed daytime use, overriding his GROUP. [-NDAY] +T Allowed dialup (Telephone) use, overriding his group [-NDIAL] +B Don't allow this person on from bad sites. +S Has seen his REFUSE/OFF/HOLD file. +\ + + +command SCAN,,KSCAN,(%COARG),,,/Map over the database, asking what to do with each +user matching a given condition. +/,/ +Conditions currently include ALL, NEW, APPLY (APL), SYSTEM (SYS), +REFUSE (RFS), and HOLD (HLD), unknown users (UNK), and INQUIR +(INQ) which reads a line of INQUIR groups to scan for. +Options for actions are: + +N -- Not. Do the opposite of next given option. Reads another char. +A -- Authorize +B -- Bad ... disallow logins for this name from bad sites +D -- Delete +R -- Refuse account +H -- Put on hold +O -- Temporarily turn account OFF +T -- Authorize for Telephone +L -- Authorize for Loaded Hours +I -- Ignore this entry (Go on to next) +X -- Perform the operations. +^D and [RUBOUT] reset the entry +[RETURN] simply allows the entry +[SPACE] goes onto next entry + +USAGE: ":SCAN APPLY" +It will then print out info on each user who has applied but not been +processed, then prompt for one of the above characters. +/ + +command STATS,,pwdsts,,,,/Print out statistics on the password database. +/,/Includes such things as # of people in each INQUIR group. +/ + +] ; END IFN $$PAND + +command SEND,,KSEND,(%COSND),,,/SEND a message to a user. +/,/:SEND ^C sends to immediately +if he is logged in. If he is not logged in or is not receiving +messages, it will be mailed. The may be more than +one line long. The form "User@Host" does not work for SEND. +type ":SEND ?" for more help. +/ + +command NAME,,J.NAME,(%COJCL),,,/See what users are running what jobs. (FINGER) +/,/If given no JCL (do :HELP JCL), it prints TTY #'s, user-names (UNAME's), +full names, the job they are currently running, and where they are from. +If given JCL, that should be in the form +NAME @,@,.... + is the user you want to find out about, or everyone at that site +if you omit it. "@" if omitted defaults to the site you are on. +/ + +command host,,J.HST,(%COJCL),,,/Look up information about a network host. +/,/Given a host name or host address, tells you all the names and addresses +of the host and what protocols it supports. +/ + +command sstatu,,ksstat,,,,\Print out info on system/version etc. +\,/This is like the :VERSIO and :SSTATU commands combined. +Fair share is a measure of system load, if it is less than +about 40% you might wish to try when it is less crowded. +/ + +command loadp,,jloadp,,,,/See how loaded the system is. +/,/This prints out various pieces of information about how +many system resources are in use. +/ + +command whoj,,jwho,(%COJCL),,,/See what users are running what jobs. +/,/This is like WHO except that it prints out what job +a person is currently in. +/ + +command bug,,jmail,(%cojcl),,,/Mail a bug report to a program's maintainers. +/,/Runs the mail program, but it takes the name of a program instead of a +person. It will send mail to the people who maintain a given program. +You should try to give any information that would help reproduce the problem. +Usage is: +:BUG MACSYMA +The MACSYMA program has gross bugs. +^C +/ + +command who,,jwho,(%COJCL),,,/See who is logged in at a site. +/,/Differs from :WHOJ and :FINGER in that it only prints TTY# and user-name, +The format of the JCL (See :HELP JCL) is: +:WHO AI +to find out who is on AI. +/ + +command date,,jdate,(%cojcl),,,/Types time and date. +/,// + +command time,,jtime,(%cojcl),,,/Types the time of day. +/,// + +command times,stime,jtimes,(%cojcl),,,/Types times from several different machines. +/,// + +command timoon,,jtimoo,(%cojcl),,,/Types time of day, and the phase of the moon. +/,// + +command octpus,,joctps,(%cojcl),,,/A program to read and echo characters. +/,/For testing terminals and finding out what your terminal sends. +/ + +command WHOIS,,j.name,(%cojcl),,,/Print out info on who a person is. +/,/If given no JCL (Do :HELP JCL), it does it for everyone who is logged in. +If given JCL, it should be the login name of a person, or his last name. +It will print out relevant info on that person. (A more extreme :NAME) +/ + +command help,,khelp,(%coarg\%cocrg\%coopt),[ +CF$HAL ;all +CF$HBF ;bf,brief + +],/Print help on commands and concepts. +Takes a single argument of the command to print help on. +/,/ +This command only exists before you log in. + +:HELP optionally takes the following after it's argument: + +-bf Brief. This just prints the first line of the documentation. + :HELP ALL -bf just prints the names of the commands. + +Also, there is often help available by typeing H or ?, until you log in. +/ + +command mail,,jmail,(%cojcl),,,/Send mail to a user or users. +/,/This runs the mail program. It takes a login-name as JCL +(See :HELP JCL) and sends mail to that user. Terminate the message +with a Control-C. More documentation on the :MAIL program may be +obtained by doing: +:MAIL +H? +/ + +command prmail,,kprmai,(%coarg),,,/Read a user's mail. +/,/:PRMAIL +prints a users mail file. +/ + +command prsend,,kprsen,(%coarg),,,/Print a user's SENDS file. +/,/:PRSEND +prints a users SEND's, that is the messages that he has been sent while he +has been logged in. +/ + +command listf,,klistf,(%cojcl),,,/List a directory. +/,/:listf +prints a file. must me six characters or less. +/ + +command users,,jusers,(%cojcl),,,/List the users on the system. Nice for printing terminals. +/,// + +define equiv a,b +sixbit /a/ +sixbit /b/ +termin + +eqvtab: equiv M,MAIL + equiv W,WHO + equiv F,NAME + equiv FINGER,NAME + equiv WHEN,NAME + equiv FING,NAME + equiv ACCOUN,ACOUNT + equiv S,SEND + equiv VERSIO,SSTATU + equiv U,USERS + +ife $$PAND,[ + equiv TCTYPE,TCTYP + equiv BYE,QUIT + equiv LOGOFF,QUIT + equiv KJOB,QUIT +]; END IFE $$PAND, + +ifn $$PAND,[ + equiv ADD,SET + equiv DEL,DELETE + equiv SCN,SCAN + equiv PR,PRINT + equiv STAT,STATS + equiv LOGOUT,QUIT + equiv BYE,QUIT + equiv KILL,QUIT + equiv DONE,QUIT + equiv Q,QUIT + equiv EXIT,QUIT +]; END IFN $$PAND, + +eqvlen==.-eqvtab + .upure + +;;;; data areas + +msgbuf: block /5 ;input buffer. + +tmpbuf: block 4000 ; Temporary buffer + +jclbuf: block 100 ;JCL buffer, input and output. + +outbuf: block 200 ; buffer for generating output + +dsprmp: 0 ;if non-zero, XCT it instead of usual + ;prompting + +morflg: 0 ;-1 if at a --MORE--. TYI will take + ;non-skip on ^L. + +jclct: 0 ;# of chars in JCL + +pwbuf: block 2 ;two words for a password in clear +hispas: block 2 ;similarly. Set by PWDCHG, used by KACOUN + +uname: 0 ;UNAME he wants to log in as +linker: 0 ; Who did the linking +linkno: -1 ; TTY no of who did the linking +cretor: 0 ; Creator uname to FIND. +checkp: 0 ; -1 if CHECK looks for non-accounts. + +;;; reader switches go here + +logflg: 0 ;-1 if keeping log file +hfdupf: 0 ;half duplex switch +sailp: 0 ; -1 if TTY understands sail chars +bsflag: 0 ;non-zero if terminal can backspace + +helper: call bhelp ;the routine to call to respond to a HELP + ;typed. +vpos: 0 ;current vertical position +hpos: 0 ;current horizontal position + +lfflag: 0 ;set non-zero if we have just rubbed out + ;means to LF when get a real char. + +jlflag: 0 ;set non-zero if last char rubbed out was a + ;LF. For avoiding double-lf's + + +cliarg:: +nuprt: 0 ;UNAME read in from CLA device +njprt: 0 ;JNAME read in from CLA device +savewd: 0 ;saved word, read in from CLI for to check + ;first char for being a rubout +chsave: 0 ;saved first char, in case it wasn't a + ;rubout + + +crgbts: 0 ;These bits correspond to which + ;control-arguments were found by RCARG + +cargbf: block cargct ;buffer for control-arguments +acrgbf: block 30 ;ascii chars read by RCARG + +cladir: sixbit /.TEMP./ ;directory that SENDS files are found on. + + +;;; call block to open a .UAI file on DSKI +.pure +uaiopn: setz ? sixbit /OPEN/ ? cnti .uai ? argi dski + (b) + 1(b) + 2(b) + 3(b) + ++calerr + + +;;; filename block for application message in lieu of application proceedure + +mlname: sixbit /DSK/ + sixbit / APPLY/ + sixbit / MSG/ + sixbit /ACOUNT/ + +.upure + +;;; filename block for application file +aplnam: +fa.dev: sixbit /DSK/ +fa.fn1: sixbit /APPLY/ +fa.fn2: 0 +fa.snm: sixbit /ACOUNT/ + + +;;; filename block for :PRINT defaults +filnam: ;block of 4 words: +ife $$PAND,[ +fi.dev: sixbit /DSK/ ;DEVICE +fi.fn1: sixbit /ITS/ ;FN1 +fi.fn2: sixbit /NEW/ ;FN2 +fi.snm: sixbit /.INFO./ ;SNAME +] +ifn $$PAND,[ +fi.dev: sixbit /DSK/ +fi.fn1: sixbit /USER/ +fi.fn2: sixbit /ACOUNT/ +fi.snm: sixbit /ACOUNT/ + +;;; Filename blocks for FIND and CHECK commands. +outfil: +ot.dev: sixbit /DSK/ +ot.fn1: sixbit /ACCTS/ +ot.fn2: sixbit />/ +ot.snm: sixbit /ACOUNT/ ; Gets changed to our hsname. +infil: +in.dev: sixbit /DSK/ +in.fn1: sixbit /.FOO./ +in.fn2: sixbit /.BAR./ +in.snm: sixbit /ACOUNT/ +] +;;; filename block used for :LISTF +dirnam: ;block of 4 words: +fd.dev: 0 ;DEVICE read by a :LISTF FOO: +fd.fn1: 0 ;:LISTF FOO or FOO^F +fd.fn2: 0 ;ignored +fd.snm: 0 ;:LISTF FOO; + +;;; filename block for the log file +.pure +lognam: +fl.dev: sixbit /DSK/ +fl.fn1: sixbit /FAILED/ +fl.fn2: sixbit /LOGINS/ +fl.snm: sixbit /ACOUNT/ +.upure + +;;; filname block for file names in error +errnam: ;block of 4 words: +fe.dev: 0 +fe.fn1: 0 +fe.fn2: 0 +fe.snm: 0 + +;;; filename block for refusal reason file +rfsnam: +fr.dev: sixbit /DSK/ +fr.fn1: sixbit /REFUSE/ +fr.fn2: 0 +fr.snm: sixbit /ACOUNT/ + +;;; filename block for OFF reason file +offnam: +ft.dev: sixbit /DSK/ +ft.fn1: sixbit /OFF/ +ft.fn2: 0 +ft.snm: sixbit /ACOUNT/ + +;;; filename block for a HOLD file +hldnam: +fh.dev: sixbit /DSK/ +fh.fn1: sixbit /HOLD/ +fh.fn2: 0 +fh.snm: sixbit /ACOUNT/ + +;;; filename block for output files +outnam: +fo.dev: sixbit /DSK/ +fo.fn1: +ifn $$PAND,sixbit /_PANDA/ +ife $$PAND,sixbit /_PWORD/ +fo.fn2: sixbit /OUTPUT/ +fo.snm: 0 + + +;;; filename block for :PRINT-style opens (CALL PRTOPN) +fdxnam: +fx.dev: 0 +fx.fn1: sixbit /.FILE./ +fx.fn2: sixbit /(DIR)/ +fx.snm: 0 + +;;; the info to be passed to DDT goes here. +altusw: 0 ;if -1, we logged in with $U +lbrief: 0 ;if -1, we used $0U or -BF in login. + +;;; Stuff for the inferior handlers goes here. + +infp: 0 ;-1 if we are in an inferior +j.file: +infdev: sixbit /DSK/ +inffn1::sixbit /TS/ ;FN1 of the file to load inferior + ;from +inffn2: 0 ;FN2 +infsnm: sixbit /SYS/ ;sname + +j.upc: 0 ;location of interrupt +jinstr: 0 ;instruction causing interrupt +jaddr: 0 ;address field of instruction +jindex: 0 ;index field of instruction +jindrp: 0 ;non-zero if indirect +jopcod: 0 ;operation code of inferior +jaccum: 0 ;accumulator field of operation in inferior + +jclpag: 0 ;the page # that JCL is to be moved to +jclloc: 0 ;the offset from the begging of that page + +;;; random parameters go here +cmhcnt: 6 ;initially 6 commands per line. +hcnt: 0 ;# of commands still room for on line +failct: 2 ;the number of failures allowed before + ;logging the loser out +failun: 0 ;# of times loser has tried unkown account + +;;; Data collected by the error handler goes here. +dbgdir: +ifn $$DBUG,sixbit /CSTACY/ +ife $$DBUG,sixbit /CRASH/ ;where to write crash files +dbgfn1: +ifn $$PAND,sixbit /PANDA/ +.else sixbit /PWORD/ +dbgfn2: sixbit />/ + +iocchn: 0 ;channel that had an IOC error +iocsts: 0 ;STATUS of channel that had IOC error + +erracs:: block 20 ;saved AC's in event of error + irp ZZ,,[x,a,b,c,d,e,t,tt,ch,count,bp,ct,sp] +ac.!zz=erracs+zz + termin + +erradr: 0 ;address of the error +ebsts: 0 ;status word of bad channel +ebchn: 0 ;collect the bad channel +empva: 0 ;when we get around to catching MPV's +euind: 0 ;get user index, for identification if we + ;get it before it is killed! +euname: 0 ;get worthless data, usually +ejname: 0 +etty: 0 +epirqc: 0 ;interrupts? +eifpir: 0 ;inferiority complex? +ecnsl: 0 ;what TTY .... +esv40: 0 + +baderr: 0 ;a saved error from the system +deathp: +ifn $$pand,-1 +.else 0 + +pat:: +patch: block 100 ;a large patch area + +calerr: 0 ;.CALL errors +debug: 0 ;set -1 if debuging. +noddt: 0 ;set -1 if noone is to get DDT (debugging) +startd: 0 ;set -1 if initialization has been done +vrsadr: .fnam1 ;same as DDT's in purpose, so DBGHAK can + .fnam2 ;know if it won or not + +goodf:0 ;-1 if this is our good working set, and we + ;have a crash file loaded +puname: 0 ;UNAME of person who purified us last +;;; various ITS data goes here. +consol: 0 ;our console # +ttycom: 0 ;the TTYCOM variable +vsize: 0 +hsize: 0 +ttyopt: 0 +ttytyp: 0 ;TTYTYP variable, for testing various things + + +tsrtab: 0 ; Magic identifier (should be 'TERMID) +termid: block 8 ; If non-zero, an ASCIZ terminal name +hstnam: ascii /LOCAL/ ; If non-zero, the name of the host in ASCIZ + block 7 +tipnum: 0 ; If non-zero, port number on TIP +fhost: 0 ; Foreign host connected to +hstsix: 0 ; Sixbit name of host +funame: 0 ; sixbit name of user at foreign site + +tsrloc==:100 ; Where data lives in TELSER +tsrcnt==:funame-tsrtab+1 ; # of words of data in TELSER + +ife $$PAND,lclsit: 0 ;site this host is + +machin: 0 ;sixbit machine name +dm.flg: 0 ;-1 if this is DM +itsver: 0 ;sixbit ITS version +susrs: 0 ;count of users on system +sysdbg: 0 ;SYSDBG in system +parnxm: 0 ;sum of parity errors and NXM's +time: 0 ;time system has been up +shutdn: 0 ;time till system goes down. +xuname: 0 ;the initial uname login is attempted as +runame: 0 ;UNAME of this job + +;;; This location is only written, never read +nul: 0 + +;;; PDL +pdl: block pdllen + block 30 ;lots of room for PDL over flow handling. +qitpdl: block 30 ;PDL for things to XCT on unwinding of the + ;pdl. + +vpatch: block 10 ;an extra patch areea +.pure + +ifn $$pand,[ + +usrwho: move bp,[440700,,msgbuf] + push sp,[-1] + call usrpr1 ;print out the info on this user + setz (sp) ; Say we didn't see any INQUIR info + setz ch, + idpb ch,bp ; end text with a nul + terpri + output tyoc,msgbuf + pop sp,t + skipn allflg ; Is that all? + jrst [ jumpe t,cpopj ; Yes, just fail-return, no INQUIR entry + jrst popj1] ; INQUIR entry, success return + jumpe t,usrnm7 ; No INQUIR entry, just type other info + +usrnm2: movei a,lsrtns"i$nick ;get his nickname + move b,lsrptr + call lsrget + jrst inqr04 ; yes, don't bother + type tyoc,/ (/ + outstr tyoc,a + tyo tyoc,[")] +inqr04: movei a,lsrtns"I$neta ;find his net address + move b,lsrptr + call lsrget + jrst inqr06 ; not there + type tyoc,/ [/ + outstr tyoc,a + type tyoc,/]/ +inqr06: movei a,lsrtns"i$mitt ;find his MIT Tel. + move b,lsrptr + call lsrget + jrst inqr12 + type tyoc,/(MIT: / + outstr tyoc,a + type tyoc,/) / +inqr12: movei a,lsrtns"i$homt ;find his home tel. + move b,lsrptr + call lsrget + jrst inqr14 + type tyoc,/(Home: / + outstr tyoc,a + tyo tyoc,[")] +inqr14: terpri + movei a,lsrtns"i$proj ;find his project + move b,lsrptr + call lsrget + jrst inqr08 ; not there + type tyoc,/Hacking / + outstr tyoc,a + tyo tyoc,[40] +inqr08: movei a,lsrtns"i$supr ;find his supervisor + move b,lsrptr + call lsrget + jrst inqr10 + type tyoc,/for / + outstr tyoc,a +inqr10: terpri + movei a,lsrtns"i$mita ;get his MIT address + move b,lsrptr + call lsrget + jrst inqr16 + outstr tyoc,a + terpri +inqr16: movei a,lsrtns"i$homa ;get his home address + move b,lsrptr + call lsrget + jrst inqr18 + outstr tyoc,a + terpri +inqr18: movei a,lsrtns"i$rem ;get remarks + move b,lsrptr + call lsrget + jrst inqr20 + outstr tyoc,a + terpri +inqr20: movei a,lsrtns"i$altr ;get alterer + move b,lsrptr + call lsrget + jrst usrnm7 + outstr tyoc,a + call usrnm7 ;USRNM7 prints APPLY file, and no more + jrst popj1 ;success return + +;; USRNM7 is internal for USRWHO, prints APPLY files, or REFUSE files +usrnm7: type dspc,/A====================================== +/ + call pwdlok ;check for already there + jrst [type dspc,/A[Not in database] +/ + ret] ; it isn't there, but no problem + + type dspc,/A[In database] +/ + call pwdget ;get this entry + move t,uname + ldb x,[pi$sta pdinfo] ;and gobble the account state + cain x,ps%apl ;applied? + pjrst [type dspc,/AThis person has applied./ + movei b,aplnam ;fileblock for applications + jrst usrnmx] + cain x,ps%rfs ;has he been put on hold or refused? + pjrst [type dspc,/AThis person has been refused +/ + movei b,rfsnam ;we want the REFUSE file + jrst usrnmx] + cain x,ps%off ; temporarily held + jrst [type tyoc,/temporarily held. +/ + movei b,offnam + jrst usrnmx] + cain x,ps%hld + jrst [type tyoc,/held for more info. +/ + movei b,hldnam ;we want the HOLD file + jrst usrnmx] + + caie x,ps%sys + cain x,ps%ok + ret + + error /Illegal account state found./ + +usrnmx: move t,uname + call fn2opn + pjrst [type dspc,/ANo info on file. +/ + ret] + terpri + pjrst printf + +usrnam: setom allflg ;note we want it all + setzm brfflg ;not brief + call usrwho + jfcl ; ignore non-presense in INQUIR +usrnm8: ask /AIs this OK?/ + jrst [type dspc,/ Left alone./ + ret] ; fail return + call pwdmap ;so map it in and skip + jrst popj1 + +;;; get lsr item, skiping if present +lsrget: call lsrtns"lsritm + ret + move t,a + ildb ch,t + cain ch,0 + ret + jrst popj1 + + +usrset: call r6arg ; Parse the command + call rcarg + ret + + skipn t,arg6 ;get the argument + jrst [type dspc,/AType "SET []" +/ + ret] + movem t,uname ;UNAME to hack + movem t,pwbuf ;and it serves as a default password + setzm t,pwbuf+1 + type dspc,/CSETTING: / + tyo tyoc,[133] ;open-square-bracket + + move x,crgbts + trze x,CF$SOK ;Turning this account on? + do [type tyoc,/-on/ ; more to come, space between!/ + tyo tyoc,[40]] + trze x,CF$SBD + do [type tyoc,/-bad/ + tyo tyoc,[40]] + trze x,CF$SNB ; OK from bad site? + do [type tyoc,/-nbad/ + tyo tyoc,[40]] + trze x,CF$SRF + do [type tyoc,/-refuse/ + tyo tyoc,[40]] + trze x,CF$SHL + do [type tyoc,/-hold/ + tyo tyoc,[40]] + trze x,CF$SOF + do [type tyoc,/-off/ + tyo tyoc,[40]] + trze x,CF$SDY + do [type tyoc,/-day/ + tyo tyoc,[40]] + trze x,CF$SPW + do [type tyoc,/-pw/ + tyo tyoc,[40]] + trze x,CF$SND + do [type tyoc,/-nday/ + tyo tyoc,[40]] + trze x,CF$STL + do [type tyoc,/-dial/ + tyo tyoc,[40]] + trze x,CF$SNT + do [type tyoc,/-ndial/ + tyo tyoc,[40]] + trze x,CF$SSY + do [type tyoc,/-system/ + tyo tyoc,[40]] + trze x,CF$GRP + do [type tyoc,/-group/ + tyo tyoc,[40]] + trze x,CF$SHL + type tyoc,/-hold/ +argdef: skipn crgbts + type tyoc,/DEFAULT/ + tyo tyoc,[135] ;close-square-bracket + terpri + call maplsr ;map in the INQUIR database + call usrnam ;check his name, etc + ret ; not right + setzm usrrsn ; so that .MAIL NOTMAL will win + move bp,[440700,,usrbfr] ; Remember how it was for the notification + call usrdat + jfcl + setzm msgbuf ; make sure empty at start + move x,pdpass ; remember the old password + movem x,popass + move x,crgbts ;check the control arguments + trne x,CF$SPW ;set password? + do [type tyoc,/ +Enter new password. +/ + call pwadd5 ;do the work of asking + ret ; lost +][ call pwdini] ;cons/get the entry + move a,crgbts ;check the control arguments + trne a,CF$SOK ; Turning on this user? + jrst [ movei x,ps%ok + ldb t,[pi$sta pdinfo] + dpb x,[pi$sta pdinfo] + movsi x,%pfmsg ; Say we've not seen any refuse message + andcam x,pdflag ; since the flag isn't aplicable + cain t,ps%apl ; If this was an application + call pwdcid ; Set the creator field + jrst daydel] + trne a,CF$SOF ; Temporarily hold this user? + jrst [ call offwrt ; write the message + movsi x,%pfmsg ; Say he's not seen the message + andcam x,pdflag ; since it was just written + jrst dayp] ; and don't delete anything + trne a,CF$SRF ;refuse this user? + jrst [ call rfswrt ; yes, write the refusal + movsi x,%pfmsg ; Say he's not seen the message + andcam x,pdflag + jrst dayp] ; and don't delete anything + trne a,CF$SHL ;put this user on hold? + jrst [ call hldwrt ; yes, write the HOLD file + movsi x,%pfmsg ; Say he's not seen the message + andcam x,pdflag + jrst dayp] ; and don't delete anything +daydel: call acdel ;delete any left over APLY or REFUSE files +dayp: move x,pdflag ; Check the flag bits + trne a,CF$SBD ;Prohibit bad sites? + tlo x,%pfbad + trne a,CF$SNB ; bad site OK? + tlz x,%pfbad + trne a,CF$SDY ;daytime OK? + tlo x,%pfday + trne a,CF$SND ;daytime not ok? + tlz x,%pfday + trne a,CF$STL ;Dialups? + tlo x,%pfdil + trne a,CF$SNTL ;Dialups NOT ok? + tlz x,%pfdil + movem x,pdflag ;in the flag word + trne a,CF$SSY ;Is it supposed to be system reserved name? + do [movei x,ps%sys ; note this fact + dpb x,[pi$sta pdinfo] + movsi x,%pfmsg ; Flush inapplicable flag + andcam x,pdflag + setom pdpass] ; no password in particular + ldb x,[pi$sta pdinfo] ; Check the state for being PS%NEW + cain x,ps%new ; which isn't legal. This can happen + jrst [ movei x,ps%ok ; when creating an account + dpb x,[pi$sta pdinfo] ; via SET FOO. + jrst .+1] + trne a,CF$GRP + do [ call rdgrp ; Read in the group + ret + dpb a,[pi$grp pdinfo]] + move bp,[440700,,usraft] + call usrdat ; Get the new state of the user + jfcl + move x,popass + came x,pdpass ; Has the password been changed? + jrst [ write bp,/ + [new password] +/ + jrst .+1] + call malset ;send off a note + pjrst pwdput ;put this entry in the database + +rdgrp: call grpprt ; Print the group names + type dspc,/AGroup: / + save [bp] + move bp,[440700,,msgbuf] + call read6 ; Read in the 6bit name of the group + jrst [ restore [bp] + ret] + restore [bp] +rdgrp6: save [x] + movsi a,-20 ; AOBJN ptr to group names + move x,arg6 +rdgrp0: camn x,pwgnam(a) ; Is this our group? + jrst rdgrp1 ; Yep + aobjn a,rdgrp0 ; Nope + + type dspc,/AThat group is not known. +/ + + restore [x] + ret + +rdgrp1: movei a,(a) ; Eliminate the count + restore [x] + jrst popj1 + + +;;; local function for SET and SCAN. X contains future flag word (PWFLAG) +;;; writes ACOUNT;REFUSE file + +rfswrt: push sp,x ;save X + movei x,ps%rfs ; Set the state to REFUSE + dpb x,[pi$sta pdinfo] + call acdel + push sp,[440700,,[asciz / +Has been denied /]] + call aplcop ;copy over the apply file with + pop sp,nul + move t,uname ;rename with FN2 of UNAME + movei b,rfsnam + pop sp,x + call rnmfn2 ;rename the file + pjrst apldel ;and flush the old cruft + +;;; local function for SET and SCAN. X contains future flag word (PWFLAG) +;;; writes ACOUNT;REFUSE file + +offwrt: push sp,x ;save X + movei x,ps%off ; Put into OFF state + dpb x,[pi$sta pdinfo] + call acdel + push sp,[440700,,[asciz / +Has been denied /]] + call aplcop ;copy over the apply file with + pop sp,nul + move t,uname ;rename with FN2 of UNAME + movei b,offnam + pop sp,x + call rnmfn2 ;rename the file + pjrst apldel ;and flush the old cruft + +;;; HLDWRT is like RFSWRT except for HOLD files + +hldwrt: push sp,x ;save x + movei x,ps%hld + dpb x,[pi$sta pdinfo] + call acdel + push sp,[440700,,[asciz / +Has been held /]] + call aplcop ;copy the apply file to a new file + pop sp,nul + move t,uname ;rename with FN2 of UNAME + movei b,hldnam + pop sp,x + call rnmfn2 ;rename the file + pjrst apldel ;and flush the old + +aplcop: move b,[sixbit /ACOUNT/] ;output directory is ACOUNT + call opnout ;output a file to it + movei b,aplnam ;file with the applicatiton + move t,uname + call fn2opn ;open application file + jrst filwrt ; Not there + type dsko,/The following application: +/ + call copyf +aplwrt: outstr dsko,(sp) +filwrt: move t,[type dspc,/CThe user will se this when he tries to log in. +End with a ^C. +Because: /] + movem t,helper ;set up some help for the user + call becaus ; get the reason from the user + output dsko,usrrsn ;output our reason + ret + +becaus: setzm usrrsn + move t,[usrrsn,,usrrsn+1] + blt t,usrrsn+400-1 ;clear out the previous contents + move t,[440700,,[asciz /Because: /]] + move bp,[440700,,usrrsn] ;place to put the input! + copy t,bp + type dspc,/ABecause: / + save [a,x] + call readsn ;read the message + jrst [restore [x,a] + syscal delewo,[argi dsko] ;don't leave garbage around + ret + ret] + restore [x,a] + ret + +kkill: call r6arg + skipn t,arg6 ;ARG6 is the one to delete + jrst [type dspc,/AType ":DELETE " +/ + ret] ; explain it to him! + movem t,uname + type dspc,/CDELETING: / + call maplsr + call usrnam + ret + ldb x,[pi$sta pdinfo] + movem x,delsta + movei x,ps%del + dpb x,[pi$sta pdinfo] + call acdel + move bp,[440700,,usrbfr] + setzm usraft + call usrdat + call pwdel ;delete it + jrst [type dspc,/ANot found. +/ + ret] + call becaus ; get the reason + call maldel ;set a note + type dspc,/ADone./ + ret + +acdel: syscal delete,[[sixbit /DSK/] + [sixbit /REFUSE/] + uname + [sixbit /ACOUNT/]] + jfcl + syscal delete,[[sixbit /DSK/] + [sixbit /HOLD/] + uname + [sixbit /ACOUNT/]] + jfcl + + syscal delete,[[sixbit /DSK/] + [sixbit /OFF/] + uname + [sixbit /ACOUNT/]] + jfcl +apldel: syscal delete,[[sixbit /DSK/] + [sixbit /APPLY/] + uname + [sixbit /ACOUNT/]] + jfcl + ret + +;;; SCAN command + +define scanop [names],init,pred +irp name,,names +irps x,,[name] + sixbit /x/ +termin +ifnb init,init,,pred +.else popj1,,pred + +termin +termin + +SCNOPS: + +irp x,,[[NEW,,scnnew],[ALL,,popj1],[[APPLY,APL,APPLY],,scnapl],[UNK,sinunk,scnunk], + [[SYS,SYSTEM],,scnsys],[[REFUSE,RFS],,scnrfs],[[HOLD,HLD],,scnhld], + [[OFF,TOFF],,scnoff],[[INQUIR,INQ],sininq,scninq],[BAD,,scnbad]] + scanop x +termin + +scnlng==.-scnops +.upure +notsw: 0 ; Initially NOT NOT + +;; the next 3 should be together in the same order. They are sometimes used +;; together as a single buffer, i.e. for the GROUP command + +usrbfr: block 40 ; Buffer for user status BEFORE we modify +usraft: block 40 ; Buffer for user status AFTER we modify +usrrsn: block 400 ; text of reason for refusal + +.pure +kscan: setzm notsw ;NOT NOT + call r6arg ; Hack the JCL + skipn t,arg6 ;get the argument + move t,[sixbit /APPLY/] ;default to searching applications + movsi b,-scnlng +kscan1: camn t,scnops(b) ;is this the command? + jrst kscan2 ; yes, let's to hack! + add b,[1,,1] ;skip the address + aobjn b,kscan1 ;and hack the next command name + type dspc,/Foo! I don't know that sub-command!/ + ret + +kscan2: hlrz t,scnops+1(b) ;get the initialization routine + call (t) ;initialize it + ret ; he flushed it + setz a, ;start counting entries +krscan: call pwdget ;get this entry + move x,pdflag ;get the flags + movem x,opdflg ;remember the way they were + move x,pdinfo + movem x,opdinf + move x,pdunam ;convert his name to normal 6bit + sub x,[742532,,732643] ;Will oddities never cease? + rot x,-13 + movem x,uname ;save it for later + save [b,a] ;save our AC's for later + hrrz t,scnops+1(b) ;get the predicate + call (t) ;and call it + jrst kscan9 ; nope, get next + call maplsr ;map in the INQUIR database +kscask: tyo dspc,[^P] ;clear the screen + tyo dspc,["C] + setom allflg ;make sure we get all the info! + setzm nodate + call usrwho ;print out loads of info + jfcl + move bp,[440700,,usrbfr] ; let's remember state before hackery + call usrdat + jfcl +ksask1: type dspc,/ALZUUUE/ + 6type tyoc,uname + tyo tyoc,[^I] + call uflgpr ;print his flags + call usrpri ;print his name etc. + jfcl + setzm ttyflg ;turn on the TTY... + type dspc,/ALWhat now boss? (A,N,I,D,T,L,B,H,O,R,S,X,?,,^D) / + setzm notsw ;not negative + +ksask2: move x,[call [movei ch,^D ;pretend it's a ^D instead + movem ch,reread + ret]] + movem x,dsprmp + tyi + jrst [pop sp,a + call pwdget ;back to the way we were + move x,pdflag ;get the flags + movem x,opdflg ;remember the way we were + move x,pdinfo + movem x,opdinf + push sp,a + jrst kscask] + jrst [type dspc,/CA -- Authorize +A -- Accept application. +N -- Not (negate next character) +I -- Ignore, go to next entry +D -- Delete this entry +T -- Telephone usage +L -- Loaded usage (daytime) +B -- Disallow bad sites +H -- Put on hold +R -- Refuse this account +S -- SYSTEM name +O -- Temporarily Off +X -- Done, make changes permanent. +^D, [RUBOUT] -- reset + -- do the default +? -- This help. + +---type space to redisplay--- +/ + + .iot tyic,ch + jrst kscask] + jrst [pop sp,a + call pwdget + push sp,a + jrst kscask] + setzm dsprmp ;no more funny stuff! + upper ch ;uuppercasify + cain ch,"A ; Approved? + jrst [ type tyoc,/Approved./ + skipe notsw ; Not? + jrst kscask ; Then don't do it! + call rdgrp ; Get the group + jrst kscask ; Punt + dpb a,[pi$grp pdinfo] ; Store the group + movei x,ps%ok + ldb t,[pi$sta pdinfo] ; check out the old state + dpb x,[pi$sta pdinfo] ; Set the state to OK + cain t,ps%apl ; Was this new application? + call pwdcid ; Set the creator field. + jrst kscan8] ; Next + + cain ch,"I + jrst [type tyoc,/Ignored./ + skipe notsw ;not? + jrst kscask ; don't ignore it! + jrst kscan9] + cain ch,"D + jrst [type tyoc,/Delete/ + skipn notsw ; positive? + jrst [tyo tyoc,[".] ;yes, period + move x,[sixbit /DELETE/] ;pretend we are a DELETE + movem x,comand + ask /ADelete this user?/ + jrst [type dspc,/ANot Deleted./ + jrst ksask1] + ldb x,[pi$sta pdinfo] + movem x,delsta ; remember the old state for printing + movei x,ps%del ; Set the state to something random + dpb x,[pi$sta pdinfo] + call acdel ;flush files + call pwdel + type tyoc,/(Not found????)/ + jrst kscanx] + type tyoc,/d./ + jrst ksask1] + cain ch,"R + jrst [type tyoc,/Refuse/ + skipe notsw ; negative? + jrst kscnok + movei x,ps%rfs ; New state = REFUSE + jrst kscan4] ; and re-save in database + cain ch,"O + jrst [type tyoc,/Temporary Hold (off)./ + skipe notsw ; negative? + jrst kscnok + movei x,ps%off + jrst kscan4] + cain ch,"H ;hold? + jrst [type tyoc,/Hold./ + skipe notsw ; negative? + jrst kscnok + movei x,ps%hld ; Make state HOLD + jrst kscan4] + cain ch,"S ;system? + jrst [type tyoc,/SYSTEM./ + skipe notsw ; negative? + jrst kscan5 ; turn off PS%SYS + setzm pdflag ; No flags on, please + setom pdpass ;no password in particular + movei x,ps%sys ; Make the state SYSTEM + jrst kscan4] + cain ch,"T ;turn off telephone authorization + jrst [type tyoc,/Telephone./ + move x,pdflag ;get the flags + skipn notsw ;if positive + tlo x,%pfdil ; allow telephone + skipe notsw ;if negative + tlz x,%pfdil ; don't allow telephone + movem x,pdflag ;use new + jrst kscan5] ;and re-save in database + cain ch,"L + jrst [type tyoc,/Loaded use./ + move x,pdflag ;;get the flags + skipn notsw ;if positive + tlo x,%pfday ; turn off daytime prohibition + skipe notsw ;if negative + tlz x,%pfday ; prohibit daytime use + movem x,pdflag + jrst kscan5] ; and re-save in database + + cain ch,"B ;Badness? + jrst [type tyoc,/Bad site prohibit. / + move x,pdflag ; get the flags + tlo x,%pfbad ; turn on prohibition + skipe notsw ; unless negative + tlz x,%pfbad ; turn it off + movem x,pdflag + jrst kscan5] ; and re-save in database. + + cain ch,"N ;Not? + jrst [type tyoc,/Not / + move x,notsw + xori x,-1 + movem x,notsw + jrst ksask2] + + cain ch,"X ;X ? + jrst kscan8 ; deposit and go. + + skipe crgbts ;have we done anything? + jrst ksask1 ; yes, none of the rest should exit then. + + cain ch,^M ;CR? + jrst kscnok ; just do the minimum + + cain ch,40 ;space? + jrst kscan9 ; on to the next one! + + + type tyoc,/Huh?/ + jrst kscask ;ask again + +kscnok: movei x,ps%ok +kscan4: dpb x,[pi$sta pdinfo] +kscan5: movsi x,%pfmsg ; We're setting the state, say we've not + andcam x,pdflag ; seen this message yet + jrst ksask1 + +kscan8: setzm usrrsn ; no reason given yet + ldb x,[pi$sta opdinf] ; compare with the old flags + ldb t,[pi$sta pdinfo] ; with what we have now. + camn x,t ; are they the same? + jrst kscn8a ; yes, don't send any mail or anything + cain t,ps%rfs ; Did we refuse him? + jrst [ call rfswrt ; yes, write a refuse file + jrst kscn8a] + cain t,ps%hld ; Did we put him on hold? + jrst [ call hldwrt ; yes, write a hold file + jrst kscn8a] + cain t,ps%off ; Did we turn him off? + jrst [ call offwrt ; yes, write a off file + jrst kscn8a] + call acdel ; Else clean up special files + +kscn8a: move bp,[440700,,usraft] ; now get new state of account + call usrdat + jfcl + call malset ; Send out mail about it + call pwdput ;put it back +kscan9: restore [a,b] + addi a,pwleng ;point to next entry + camg a,pwcnt ;is this all? + jrst krscan ; nope, loop + ret ;yes, that's all folks! + +;; for after deletion, re-tries same entry slot, since it has changed who +;; is in it! +kscanx: call becaus ; find out why + call maldel ; Send mail about it + restore [a,b] ;restore the world + camg a,pwcnt ;if we haven't flushed the last entry + jrst krscan ; loop around hitting this one first + ret ;else done. + +;;; SCNNEW skips if this is a new entry +scnnew: move x,pdflag ;get the flag + tlnn x,%pfnew ;is it new? + ret ; nope, no skip + jrst popj1 ;yes, skip + +scnapl: ldb x,[pi$sta pdinfo] ;get the flag + cain x,ps%apl ; Has he only applied? + jrst popj1 ; Yes, this is it + ret ; nope, no patch + +scnbad: move x,pdflag ;get the flag + tlnn x,%pfbad ;is he forbidden from bad sites? + ret ; nope + jrst popj1 ;yep + +scnrfs: ldb x,[pi$sta pdinfo] + cain x,ps%rfs ;has he been refused? + jrst popj1 + ret + +scnoff: ldb x,[pi$sta pdinfo] + cain x,ps%off ; Is it off? + jrst popj1 + ret + +scnhld: ldb x,[pi$sta pdinfo] + cain x,ps%hld ; Is he on hold? + jrst popj1 + ret + +scnsys: ldb x,[pi$sta pdinfo] + cain x,ps%sys ;is it a system name? + jrst popj1 + ret + +sininq: setz count, + move bp,[440700,,inqbuf] +sin0: type dspc,/AEnter INQUIR groups to scan for: / +sin3: tyi + ret ;^D typed + jrst [type dspc,/AType as many groups as you wish, end with +a CR. Null group is the same as [SPACE]. +/ + jrst sin0] + jrst [sojl count,[ret] + decbp bp + call 1wipe ;wipe it from the screen + jrst sin3] + + cain ch,^M ;is it the end? + jrst sin9 ; yes, remember this + upper ch ;uppercasify + echoch + idpb ch,bp + aos count + + caige count,24 ;are there too many of them? + jrst sin3 ; nope, ask for more +sin9: terpri ;let him know he got it. + movem count,inqcnt + save [a,b] ;save important stuff + call maplsr ;map in the INQUIR database + restore [b,a] + jrst popj1 ;yes, don't take any more + +scninq: move count,inqcnt ;set up for count + jumpe count,[ret] + move bp,[440700,,inqbuf] + call grplsr + movei ch,40 ;pretend it's a space +scinq0: ildb x,bp ;get a character + camn ch,x ;is it one of them? + jrst popj1 ; yes. Win win. + sojg count,scinq0 ;keep on trying + ret ;not there. + +.upure +inqbuf: block 4 ; 20. groups max +inqcnt: 0 ; count of groups searched for +lstgrp: 0 ; remembered group from USRPR1 +opdflg: 0 ; old PDFLAG word for this user +opdinf: 0 ; old PDINFO word for this user +sukchk: 0 ; -1 if should ignore special unknowns +.pure + +;;; SCNUNK skips iff luser has no INQUIR entry (SINUNK inits) + +sinunk: setzm sukchk ;Normally process everyone. + ask /AIgnore special users (reserved names, people on HOLD, etc.)? / + caia + setom sukchk ;Yes - ignore them. + save [a,b] + call maplsr ;Map in the INQUIR database. + restore [b,a] + jrst popj1 + +scnunk: skipn sukchk ;Ignoring special entries? + jrst scnun1 ; No, go process everyone. + move x,pdflag +; tlne x,%pfnew ;New account? +; ret ; Yes, ignore it. + ldb x,[pi$sta pdinfo] + caie x,ps%apl ;Applicant? + cain x,ps%rfs ; Or refusal? + ret ; Yes, leave alone. + caie x,ps%off ;Off? + cain x,ps%hld ; Or held? + ret ; Yes, leave alone. + cain x,ps%sys ;If this is a system name + ret ; ignore it. +scnun1: movei a,lsrc ;Tell LSRTNS what channel it can hack. + move b,uname ;Ask about this UNAME. + call lsrtns"lsrunm ;Is it there? + jrst popj1 ; No - hack this guy. + ret ;Yes, leave alone. + + + +SUBTTL Parameters, Variables, Tables + +.upure +varnam: 0 ; Name of variable set +.pure + +;;; Macro for defining parameters. + +parcnt==0 ;Number of PANDA parameters defined. + +define param name,erout,srout,arg,mail,&doc + sixbit /NAME/ ;Name + erout ;Examining routine + srout ;Setting routine + arg ;Argument (passed in A) for above + mail ;Argument for .MAIL + [asciz doc] ;Parameter documentation +parcnt==parcnt+1 +termin +parlen==:6 + +partab: +parnam=:partab +parex=:partab+1 +parset=:partab+2 +pararg=:partab+3 +parmal=:partab+4 +pardoc=:partab+5 + +param GOOD,enet,snet,lucktb,varmml,/Hosts which get DDT instead of PWORD/ +param BAD,enet,snet,losers,varmml,/Hosts to check the -BAD bit on/ +param PEOPLE,e6tab,0,pwadmn,0,/People who have run PANDA/ +param APPLY,flgprt,flgset,atoapl,varmml,/When true, allow applications/ +param APLTXT,pwgtxt,pwstxt,naplmg,varmml,/Message to print in lieu of accepting applications/ +param PHONE,pwgtxt,pwslin,phone,varmml,/Phone number for users to call for help/ +param DDTTTY,ttylis,ttyset,ddtttb,varmml,/TTY lines to get DDT instead of PWORD/ +param DILTTY,ttylis,ttyset,dilttb,varmml,/TTY lines to be considered reserved dialups/ +param BADCMD,e6tab,s6tab,nocmnd,varmml,/PWORD commands to suppress/ +param HOLDAY,flgprt,flgset,pwholp,varmml,/When true, PWORD ignores login time restrictions./ + + +;;; .MAIL text to type variable name and ASCIZ text from MSGBUF. +varmml: -4,,[ 440700,,[asciz /Variable: /] + tp$6bt varnam + 440700,,[asciz / +Value: /] + 440700,,msgbuf] + +.upure +varmal: 440700,,[asciz /USER-ACCOUNTS/] + tp$6bt runame + 0 + 440700,,[asciz /New Variable setting in PWORD/] +varinf: 0 +.pure + +;;; Implement the VAR command for PANDA. + + +;;; Routine to handle VAR command in PANDA. + +kvar: call r6arg ; Parse the command + skipn t,arg6 ; Did we get an argument? + jrst kvarh ; No - just list the variables. + movem t,varnam ; Remember the name for the mail + call kvar0 ; Find the parameter + ret ; No such var! + move a,pararg(tt) ; argument to the routine + save [tt] + call @parex(tt) ; Do it + jfcl ; Maybe it might skip-return + restore [tt] + skipn parset(tt) ; is there a routine to set it? + ret ; no, that's it. + ask /ADo you wish to set it?/ + ret + move a,pararg(tt) ; argument to the routine + save [tt] + move bp,[440700,,msgbuf] + call @parset(tt) + jfcl + restore [tt] + setz ch, ; Ensure everything ends with a nul + idpb ch,bp + move t,parmal(tt) ; tell the .MAIL what to hack + movem t,varinf + movei t,(tp$ind) + hrlm t,varinf + .mail varmal ; Mail notification + ret + + +kvar0: movei t,parcnt + setz tt, + move x,arg6 +kvar1: camn x,partab(tt) ; Is this the parameter? + jrst popj1 + addi tt,parlen + sojg t,kvar1 + type dspc,/AI never heard of that variable! +/ + ret + + +kvarh: type dspc,/CThe VAR command will examine any of the following vars: + +/ + movei t,parcnt + setz tt, +kvarh0: skipn parset(tt) ; * if setable + type tyoc,/ / + skipe parset(tt) + type tyoc,/* / + 6type tyoc,parnam(tt) + type tyoc,/ -- / + output tyoc,@pardoc(tt) + terpri + addi tt,parlen + sojg t,kvarh0 + type tyoc,/ +* ==> Variable can be set. +/ + ret + + + +;;; Flags are a simple kind variable. +;;; Here are the routines to Examine and Set a flag variable. + +flgprt: skipn (a) + jrst [ type dspc,/AValue = FALSE +/ + ret] + type dspc,/AValue = TRUE +/ + ret + +;;; Set a flag-style variable. + +flgset: call plock ; Lock database for unpurity. + aose (a) ; if -1, make it zero + setom (a) ; Else -1 + move t,[440700,,[asciz /TRUE/]] + skipn (a) + move t,[440700,,[asciz /FALSE/]] + copy t,bp + call pulock ; unlock it and repurify. + ret + + + +;;; HAKTAB is a utility for hacking tables. +;;; It can be called by parameter setting routines such as SNET. + +;;; The argument table for HAKTAB describes useful combinations of +;;; object-reading, object-comparing, and table-printing routines. + +hk%rd==:0 ;Function to call to read object. +hk%dsp==:1 ;Function to call to display table. +hk%cmp==:2 ;Function to call to compare objects. + ; A and B and skip if they are equal. +define hakdef read,prt,cmp + read + prt +IFSE cmp,EQ, [ came a,b ? jrst cpopj ? jrst popj1 ] + .ELSE cmp +termin + +6tabtb: hakdef tread6,e6tab,EQ +snthtb: hakdef rdhost,enet,netwrk"hstcmp + +;;; Routines called from HAKTAB for various kinds of objects. +;;; Readers skip return with the frob in A, else non-skip. + +;;; Read a sixbit frob. + +tread6: type dspc,/AEntry: / + call read6 ; Read it. + ret + move a,arg6 ; Get it to return. +IFN 0,[ + idpb6 a,bp ; Output it to mail + move t,[440700,,[asciz / +/]] + copy t,bp +] ;IFN 0 + jrst popj1 ;Win. + + +;;; Routine to read a network host name. +;;; Returns a host number. + +rdhost: save [d] + terpri + call netwrk"hostnm ; Read in the host name. + jrst [ type dspc,/ANo such host. +/ + movei t,30. + .sleep t, + restore [d] + ret ] +rdhos9: restore [d] + jrst popj1 + + + +;;; HAKTAB - Add or Delete an item from a table. +;;; The user types in an object, and it is added or delete to a table. +;;; Takes address in database of table (ie., LUCKTB) in A. +;;; Requires HAKDEF pointer in D. +;;; (Note: BP should point to MSGBUF for logging. KVAR does this.) + +.upure +tabptr: 0 ;Table pointer +tabadr: 0 ;Table address. +.pure + +haktab: save [a,b,c,d,e] + movem a,tabadr + call pwsget ; Get the table from the database. + movem t,tabptr +hakta1: ask /ADo you wish to add an entry?/ + caia ; Maybe he wants to delete. + jrst hakadd ; He wants to add. + skipe a ; If no entries, can't delete. + ask /ADo you wish to delete an entry?/ + jrst [ type dspc,/AYou're confused! +/ + jrst hakta9 ] ; Maybe he was just confused. + ; Fall through for deletion. + +;;; Here to delete an entry. + +hakdel: move tt,[440700,,[asciz /Deleting /]] + copy tt,bp ; Log what we are doing. + call @hk%rd(d) ; A gets user object. + jrst hakta9 ; Reading failed? + move c,tabptr +hakde0: move b,(c) ; B gets table object. + call @hk%cmp(d) ; Compare them. + jrst [ aobjn c,hakde0 ; No match - try another. + type dspc,/ANot found. +/ + movei a,30. + .sleep a, ; Pause a moment. + jrst hakde9 ] ; Give up if frob not in table. +hakde2: hlre a,c ; Now move stuff around. + movns a ; Get the count remaining (positive). + soje a,hakde3 ; If last entry, just update pointer. + hrli b,1(c) ; Where to get entries. + hrri b,(c) ; Where to put them. + addi a,-1(c) ; Where to end. + blt b,(a) ; Move them. +hakde3: move b,tabptr ; AOBJN ptr to data. + add b,[1,,0] ; Shrink the table ptr by one. + movem b,tabptr + move a,tabadr ; Retrieve address of table. + call pwsput ; Store the shrunken table + +hakde9: type dspc,/C/ ; Display the table + move a,tabadr ; Retrieve table address + call @hk%dsp(d) + ask /AWould you like to delete another entry?/ + caia ; No. Maybe add? + jrst hakdel ; Go delete another. + ask /AWould you like to add a entry?/ + caia ; No. all done. + jrst hakadd ; Go to addition loop + jrst hakta9 ; All done. + +;;; Here to add an entry. + +hakadd: move tt,[440700,,[asciz /Adding /]] + copy tt,bp ; Log what we are doing. + call @hk%rd(d) ; A gets user object. + jrst hakta9 ; Reading failed? + move c,tabptr ; Check table for the object. +hakad0: move b,(c) ; B gets table object. + call @hk%cmp(d) ; Compare them. + jrst [ aobjn c,hakad0 ; No match - try another. + jrst hakad1 ] ; OK - it's not already there. + type dspc,/AAlready in table. +/ + movei a,30. + .sleep a, ; Pause a moment. + jrst hakad9 ; It's already there? + +hakad1: movem a,(c) ; Store the host in the table + move b,tabptr ; AOBJN ptr to data. + sub b,[1,,0] ; Grow the table ptr by one. + movem b,tabptr + move a,tabadr ; Retrieve table address + call pwsput ; Store updated table +hakad9: type dspc,/C/ ; Display the table. + move a,tabadr ; Retrieve table address + call @hk%dsp(d) + ask /AWould you like to add another entry?/ + caia + jrst hakadd + ask /AWould you like to delete a entry?/ + jrst hakta9 + jrst hakdel +hakta9: restore [e,d,c,b,a] ; Exit. + ret + + + + +;;; These routines Examine and Set parameters. +;;; (Reference these in PARAM declarations.) +;;; All these routines expect a pointer to the table in A. + +;;; Examine a table of 6bit items. + +e6tab: save [t,a] + call pwsget ; Get the table + movei t,tmpbuf ; ptr into TMPBUF of items + call e6tab0 ; Print them all + restore [a,t] + ret + +e6tab0: save [t,tt,a] +e6taba: jumpe a,e6tab3 ; if no items, just return + movei tt,8 ; 8 items accross +e6tab1: 6type tyoc,(t) ; type this item + aos t + sojg tt,e6tab2 ; one item typed + terpri ; End of line + sojg a,e6taba + jrst e6tab3 +e6tab2: tyo tyoc,[^I] ; tab to next position + sojg a,e6tab1 ; next item +e6tab3: restore [a,tt,t] + ret + +;;; Set 6bit table. + +s6tab: save [d] + movei d,6tabtb + call haktab + caia + aos -1(p) + restore [d] + ret + + +;;; Examine Network Host Table. + +enet: save [a,b,d,bp] + call pwsget ; Get table from database. + jumpe a,enet5 ; If zero length, all done. + move ct,(a) ; Count in A, AOBJN in T. + seto tt, +enet0: move b,(t) ; Get host address. + jumpe b,enet4 + save [t,tt] ; (Save temps from NETWRK.) + move bp,[440700,,outbuf] ; BP to typeout buffer. + call netwrk"hstsrc ; Look up this host address + jrst [ idpb8 a,bp ; No name - just print its number. + tyobpi bp,0 ; Tie off the BP. + jrst enet1 ] ; Found it! + hrr x,a ; Get BP to host name. + hrli x,440700 + copy x,bp ; Copy host name into output buffer. +enet1: move bp,[440700,,outbuf] ; Reset the byte pointer. + restore [tt,t] ; (Get back temps.) + jumpl tt,[ terpri ; First position + jrst enet3] + JUMPE tt,[ type dspc,/H!/ + jrst enet3] ; Second position + + type dspc,/H@/ ; Last position + seto tt, ; First position again + caia +enet3: aos tt ; Next position + outstr tyoc,bp ; Type out the host name. +enet4: aobjn t,enet0 ; Get another entry. + terpri +enet5: restore [bp,d,b,a] + ret + +;;; Set Network Host table. + +snet: save [d] + movei d,snthtb + call haktab + caia + aos -1(p) + restore [d] + ret + + + + +;;; Print the table of TTY lines + +ttylis: move tt,@ttyin0(a) + move t,@ttyin1(a) + setz x, ; TTY # + setz a, ; # of tty's typed +ttyls0: caile x,77 ; Last TTY? + jrst ttyls3 + trnn tt,1 ; Is this one in the table? + jrst ttyls2 ; Nope, don't print + skipe a ; If not first, separate + type tyoc,/, / + tyo tyoc,["T] ; TTY number, + caige x,10 + tyo tyoc,["0] ; complete with no leading zero suppression + 8type tyoc,x + aos a ; count # printed on this line + caige a,20 ; Line full? + jrst ttyls2 ; line not full + setz a, ; start + terpri ; a new line +ttyls2: lshc t,-1 ; next TTY + aoja x,ttyls0 +ttyls3: terpri + ret + +DDTTTB: +ttyms0==:0 + 440700,,[asciz /ADo you wish to make some TTY's get DDT?/] + 440700,,[asciz /ADo you wish to make some TTY's get PWORD?/] +ttyms1==:2 + 440700,,[asciz /The following TTY's now get DDT: +/] + 440700,,[asciz /The following TTY's now get PWORD: +/] +ttyin0==:4 + iorm tt,ddtty0 + andcam tt,ddtty0 +ttyin1==:6 + iorm t,ddtty1 + andcam t,ddtty1 + + +DILTTB: + 440700,,[asciz /ADo you wish to make some TTY's reserved?/] + 440700,,[asciz /ADo you wish to make some TTY's not reserved?/] + + 440700,,[asciz /The following TTY's are now reserved: +/] + 440700,,[asciz /The following TTY's are no longer reserved: +/] + + iorm tt,dltty0 + andcam tt,dltty0 + + iorm t,dltty1 + andcam t,dltty1 + +; END of DILTTB + +ttyset: move bp,[440700,,msgbuf] + move b,a ; Remember the address of our info block + askusr @ttyms0(b) + jrst ttyttp + jrst ttyttx + +ttyttp: aos b ; Let's get the alternate version + askusr @ttyms0(b) ; Ask about it + ret +ttyttx: move t,ttyms1(b) ; Get the informative message + copy t,bp ; and copy to mail output + type dspc,/ATTY #'s (Tnn, Tnn): / + call readln ; Read in a line + ret + move bp,argloc +ttyst0: sosge argcnt ; Take one character + ret ; Nothing left + ildb ch,bp + caie ch,40 ; space + cain ch,", + jrst ttyst0 ; Ignore + caie ch,"t + cain ch,"T + jrst ttyst1 ; Ignore, number follows + cain ch,^I + jrst ttyst0 ; Ignore + jrst ttyst2 + +ttyst1: sosge argcnt ; Take one character + jrst ttystx + ildb ch,bp +ttyst2: cail ch,"0 ; Digit-p? + caile ch,"9 + jrst ttystx ; No, lose + subi ch,"0 + movei a,(ch) + sosge argcnt ; Take one character + jrst ttyst3 ; Nothing left + ildb ch,bp ; Next character + caie ch,", ; Terminator? + cain ch,40 + jrst ttyst3 + cain ch,^I + jrst ttyst3 + cail ch,"0 ; Digit-p? + caile ch,"9 + jrst ttystx ; No, lose + subi ch,"0 ; convert to number + lsh a,3 + addi a,(ch) ; full 2-digit octal number +ttyst3: movei tt,1 ; get the bit + setz t, + lshc t,(a) ; refering to this TTY number + save [t,tt] + call plock ; Lock the database + restore [tt,t] + xct ttyin0(b) + xct ttyin1(b) + call pulock ; unlock the database + jrst ttyst0 + +ttystx: type dspc,/AInvalid TTY # +/ + ret + + +SUBTTL Hacking Groups + +grpprt: save [t,a] + terpri + movei t,pwgnam ; Table of group names + movei a,pwgrct ; Count of entries + call e6tab0 ; Print the table + restore [a,t] + ret + +;; Print the status of a group, offering to set it + +grpset: save [x,ch,t,a,c] + call r6arg ; Parse our argument +grpstr: move bp,[440700,,usrbfr] + skipe arg6 + jrst [ call rdgrp6 ; Look up the group + jrst grpst ; Lost... + jrst grpst1] +grpst: type dspc,/C/ + call rdgrp ; List all the groups + jrst grpstx +grpst1: movei c,(a) ; Get group # + save [bp] + move bp,[440700,,msgbuf] + call grpdsc ; Describe the group + restore [bp] + terpri + output tyoc,msgbuf ; print the description on the screen + ask /ADo you wish to modify anything?/ + jrst grpst + + call grpdsc + +grpst2: type dspc,/C/ + movei a,(c) + save [bp] + move bp,[440700,,msgbuf] + call grpdsc ; Describe the group in the mail + restore [bp] + output tyoc,msgbuf ; put description at top of screen + type dspc,/A +1 -- Weekday time restriction +2 -- Saturday time restriction +3 -- Sunday time restriction +4 -- Name of group +5 -- Daytime use message +6 -- Dialup use message +7 -- Dialup permission +8 -- Choose another Group +9 -- Quit + +Enter one: / + .iot tyic,ch + cain ch,"1 + jrst [ call gtimrd ; Read the date + jrst grpstf ; Failed, retry + call plock ; Make the page writable + dpb a,[dm$wds pwgrdm(c)] ; Set the start time + dpb b,[dm$wde pwgrdm(c)] ; and the unstart time + call pulock ; Repurify the page + jrst grpst9] ; More! + cain ch,"2 ; saTurday time restriction + jrst [ call gtimrd ; Read the date + jrst grpstf ; Failed, retry + call plock ; Make the page writable + dpb a,[dm$sts pwgrdm(c)] + dpb b,[dm$ste pwgrdm(c)] + call pulock + jrst grpst9] + cain ch,"3 + jrst [ call gtimrd + jrst grpstf + call plock + dpb a,[dm$sns pwgrdm(c)] + dpb b,[dm$sne pwgrdm(c)] + call pulock + jrst grpst9] + cain ch,"4 ; Change the name of the group? + jrst [ type dspc,/AEnter new name for this group: / + save [bp] + call read6 ; Read a 6bit name + jrst [ restore [bp] + jrst grpst2] + restore [bp] + skipn a,arg6 ; The new name! + jrst grpst2 ; A Real Nothing + call plock ; Depurify it + movem a,pwgnam(c) ; update the name! + call pulock + jrst grpst9] + cain ch,"5 ; Daytime message? + movei a,timmsg(c) ; Address of where to put it + cain ch,"6 ; Dialup message? + movei a,dilmsg(c) ; Address of where to put it + caie ch,"5 + cain ch,"6 + jrst [ type dspc,/AEnter new message: / + save [bp] + call pwstxt ; Read in the message + jfcl + restore [bp] + jrst grpst9] ; Abort, keep hacking + cain ch,"7 + jrst grpsdl + cain ch,"8 ; Choose another group? + jrst grpstn ; yep! + caie ch,"9 + cain ch,"Q ; Quit? + jrst grpstx + cain ch,"q + jrst grpstx + type tyoc,/ Huh?? / + jrst grpst2 ; try again! + +grpstn: skipn rdxct ; Have we done anything yet? + jrst grpstr ; nope, just keep trying + call grpsml ; send the mail + jrst grpstr ; reset! + +grpsml: write bp,/ +---- becomes ---- +/ + call grpdsc ; Describe the new state + .mail grpmal ; Send the mail + setzm rdxct + ret + + +grpst9: movem c,rdxarg ; Remember the group for sending mail + movem bp,rdxbp + move x,[call grpsml] + movem x,rdxct ; make sure this gets sent when done + jrst grpst2 + +grpstf: type dspc,/AIllegal date format!/ + movei x,15. + .sleep x, + jrst grpst2 ; loop + +; hack dialup toggling +grpsdl: call plock + movei t,1 ; Bit for group # to mask in dialup + lsh t,(c) ; restriction test + tdne t,pwgdil ; Check against database + jrst grpsdn + iorm t,pwgdil + call pulock + jrst grpst9 + +grpsdn: andcam t,pwgdil + call pulock + jrst grpst9 + +grpstb: restore [bp] +grpstx: restore [c,a,t,ch,x] + ret + +;; GRPDSC takes a group in A, and describes that group + +grpdsc: save [x,t,tt,a] + move x,pwgnam(a) ; include the group name + idpb6 x,bp + write bp,/ Weekday: / + ldb t,[dm$wds pwgrdm(a)] ; Get when it starts + ldb tt,[dm$wde pwgrdm(a)] ; Get when it ends + call gprtim + write bp,/; Saturday: / + ldb t,[dm$sts pwgrdm(a)] + ldb tt,[dm$ste pwgrdm(a)] + call gprtim + write bp,/; Sunday: / + ldb t,[dm$sns pwgrdm(a)] + ldb tt,[dm$sne pwgrdm(a)] + call gprtim + push sp,a + skipn timmsg(a) ; Does this group have a restriction + jrst grdsc2 ; message? + movei a,timmsg(a) + write bp,/ +This group's daytime restriction message is: +/ + call pwsget ; get the message + move x,[440700,,tmpbuf] + copy x,bp ; copy it into the text + +grdsc2: pop sp,a + movei t,1 ; Bit for group # to mask in dialup + lsh t,(a) ; restriction test + tdne t,pwgdil ; Check against database + jrst [ write bp,/ +This group is NOT allowed to use the dialups. +Message: +/ + movei a,dilmsg(a) ; Get the dialup message + call pwsget + move x,[440700,,tmpbuf] + copy x,bp + jrst grdsc3] + write bp,/ +This group IS allowed to use the dialups. +/ +grdsc3: setz x, ; Follow the output with a NUL to be IDPB'd + move t,bp + idpb x,t + restore [a,tt,t,x] + ret + + +;; Take start time in T and end time in TT (group restriction format, of +;; # of 1/2 hours past midnight; 77 ==> no restriction). Write the time to BP + +gprtim: save [x,t] + cain t,77 ; No restriction? + jrst [ write bp,/NONE/ + restore [t,x] + ret] + lsh t,-1 ; Get # of hours past midnite + caige t,10. ; If < 10, type leading zero explicitly + jrst [ tyobpi bp,"0 + jrst .+1] + idpb10 t,bp ; Write the time to the BP + restore [t] + trne t,1 ; 1/2 hour? + jrst [ write bp,/30-/ + jrst .+1] + trnn t,1 ; On the hour? + jrst [ write bp,/00-/ + jrst .+1] + save [tt] + lsh tt,-1 ; Get # of hours past midnite + caige tt,10. ; If < 10, type leading zero explicitly + jrst [ tyobpi ,"0 + jrst .+1] + idpb10 tt,bp + restore [tt] + trne tt,1 ; 1/2 hour? + jrst [ write bp,/30/ + jrst .+1] + trnn tt,1 ; On the hour? + jrst [ write bp,/00/ + jrst .+1] + restore [x] + ret + +;;; GTIMRD reads in a restriction-format time rage into A and B. +;;; Allowable formats are: NONE; 6-12; 600-1230 + +gtimrd: save [bp] + type dspc,\AEnter time range accurate to 1/2 hour (i.e. 6-1430) or NONE +Time: \ + move bp,[440700,,msgbuf] + call readln ; Read in a line + jrst gtimrx + move bp,argloc + move ct,argcnt + cain ct,4 ; Is this 4 long? + jrst gtimra ; Maybe it's NONE? +gtimr0: setzb a,b + call gtimrn ; Get the first # + jrst gtimrx + ildb ch,bp ; Advance past the termination + soje ct,cpopj + exch a,b + call gtimrn ; Get the second # + jrst gtimrx + exch a,b + caile a,48. ; Had better be less than or = midnight + jrst gtimrx + caile b,48. + jrst gtimrx + cain a,77 ; If this is ALL, they can be the same + jrst gtimwn + caml a,b ; Otherwise + jrst gtimrx ; A had better be less than B +gtimwn: skipn ct ; Is there still more stuff? +gtimx1: aos -1(sp) ; No, fine, skip return +gtimrx: restore [bp] + ret + +gtimra: push sp,bp + ildb ch,bp ; Check first char + caie ch,"n + cain ch,"N + caia + jrst gtima0 + ildb ch,bp + caie ch,"o + cain ch,"O + caia + jrst gtima0 + ildb ch,bp + caie ch,"n + cain ch,"N + caia + jrst gtima0 + ildb ch,bp + caie ch,"e + cain ch,"E + caia + jrst gtima0 + movei a,77 ; Return ALL time + movei b,77 + pop sp,bp + jrst gtimx1 + +gtima0: pop sp,bp + jrst gtimr0 + +;; Gobble one number +gtimrn: call gtimrp ; Count the digits + ret ; Syntax error + cain x,1 ; 1 is simple + jrst gtimn1 + cain x,2 ; 2 is also fairly simply + jrst gtimn2 + cain x,3 ; 3 is of 100 or 130 variety + jrst gtimn3 + cain x,4 ; 4 is full 24 hr time + jrst gtimn4 + ret ; Too many digits, syntax error + +gtimn2: ildb ch,bp ; Get 10's digit + cail ch,"3 ; Illegal digit? + ret + subi ch,"0 ; DIGIT-WEIGHT + movei a,(ch) ; accumulate in A + imuli a,10. ; 10's digit +gtimn1: ildb ch,bp ; Next digit + subi ch,"0 + addi a,(ch) ; That's the number! + imuli a,2 ; convert to # of half-hours + jrst popj1 + +gtimn3: call gtimn1 ; Gobble down the hour's digit + ret + caia +gtimn4: call gtimn2 ; Gobble down the hour's digits + jfcl + ildb ch,bp ; Get the 10-minute digit + cain ch,"3 ; 1/2 hour? + aos a ; Count it + caie ch,"0 ; Is it a legal time? + cain ch,"3 + caia + ret ; Nope! + ildb ch,bp ; Is it a legal time? + cain ch,"0 ; Either 00 or 30 + jrst popj1 ; yes + ret ; no + +;; Count off the digits of one number +gtimrp: move t,bp ; Remember where our number begins + setz x, ; # of characters in this number +gtimp0: ildb ch,bp ; or maybe not + cain ch,"- ; -? + jrst gtimp1 + caig ch,"9 ; Digitp? + caige ch,"0 + ret ; Nope, syntax error + aos x + sojg ct,gtimp0 + +gtimp1: move bp,t ; Back up our BP + jrst popj1 + + + +SUBTTL Assorted Commands + +;;; Implement the FIND command in PANDA. + +kfind: call r6arg ; Parse out "creator" arg. + call rcarg ; Parse out control args. + ret + move x,crgbts ; Check out control options. + setzm brfflg ; Assume we want verbosity. + trne x,CF$PBF ; If we want it brief + setom brfflg ; remember so. + skipn t,arg6 ;check for an argument. + jrst [ type dspc,/AHuh? I dont know who to look for. +/ + ret ] + movem t,cretor ; Remember the target creator. +kfind1: .suset [.rhsname,,ot.snm] ; Change output sname to our own dir. + movei x,[asciz /AWhere should I file the list?/] + movem x,filprm ; Set up prompt. + movei x,outfil ; Say this is the default. + call flprmp ; Prompt for file name with default. + call readfi ; Read the file name. + jfcl ; Eh? + move d,argptr ; Pointer to the file name string. + movei b,outfil ; Where to put the file name. + call rfn"rfn ; Parse file name. + syscal open,[cnti .uao ; Open our output file. + argi dsko + ot.dev + ot.fn1 + ot.fn2 + ot.snm ] + jrst [ type dspc,/ACannot open output file. +/ + ret ] + call maplsr ; Map in the INQUIR database. + setz a, ; Begin counting entries. +kfind2: call pwdget ; Get an entry. + move x,pdunam ; Convert his name to normal 6bit. + sub x,[742532,,732643] ; Will oddities never cease? + rot x,-13 ; (obviously not). + movem x,uname ; Save it for later. + save [b,a] ; Save our AC's for later. + movei a,pwadmn ; Get the table of creators. + call pwsget + ldb tt,[pi$crt pdinfo] ; Get the creator index. + jumpe tt,kfind9 ; Cannot match unknown creator. + move tt,tmpbuf-1(tt) ; Get this entry's creator name. + came tt,cretor ; If this is not the target creator + jrst kfind9 ; try another entry. +kfind3: move bp,[440700,,msgbuf] ; Bp to information we find. + tyobpi bp,^M + tyobpi bp,^J + move x,uname + idpb6 x,bp ; Write the uname. + skipe brfflg ; If we are being brief + jrst kfind8 ; dont print anything else. + tyobpi bp,^I + ldb tt,[pi$sta pdinfo] ; Get the state of this account + cain tt,ps%sys ; Is this a system name? + jrst [ write bp,/[sys]/ + jrst .+1] + cain tt,ps%rfs ; Is he refused? + jrst [ write bp,/[rfs]/ + jrst .+1] + cain tt,ps%off ; Turned off? + jrst [ write bp,/[off]/ + jrst .+1] + cain tt,ps%hld ; On hold? + jrst [ write bp,/[hld]/ + jrst .+1] + cain tt,ps%ok + jrst [ write bp,/[ok]/ ; Would you believe, normal? + jrst .+1] + tyobpi bp,^I +kfind4: movei a,lsrc ; Tell LSRTNS what channel it can hack. + move b,uname ; Get Inquire entry address. + call lsrtns"lsrunm ; Is it there? + jrst [ write bp,/ --> Not in Inquire database <--/ + jrst kfind8 ] + movem b,lsrptr ; Save pointer to this Inquire entry. + movei a,lsrtns"i$name ; Find his name. + call lsrtns"lsritm + jrst [write bp,/ --> Name Missing in Inquire <--/ + jrst kfind8 ] ; unsuccessful. + move b,bp ; Where to get his name. + call lsrtns"lsrnam ; Write his name nicely. + jfcl ; eh? + move bp,b ; Recover the byte pointer. + decbp bp ; Back over the null. +kfind8: setz ch, ; End text with a nul. + idpb ch,bp + output dsko,msgbuf ; Write text to file. +kfind9: restore [a,b] ; Pick up count where we left off. + addi a,pwleng ; Point to next entry. + camg a,pwcnt ; Is this all? + jrst kfind2 ; Nope, loop for another one. + .close dsko, ; All done. Close output file. + ret + + +;;; Implement the CHECK command in PANDA. + +kcheck: save [a,b,c,d,e] + movei x,[asciz /AInput file of alleged users?/] + movem x,filprm ; Set up prompt. + movei x,infil ; Say this is the default. + call flprmp ; Prompt for file name with default. + call readfi ; Read the file name. + jfcl ; Eh? + move d,argptr ; Pointer to the file name string. + movei b,infil ; Where to put the file name. + call rfn"rfn ; Parse file name. + syscal open,[cnti .uai ; Open our input file. + argi dski + in.dev + in.fn1 + in.fn2 + in.snm ] + jrst [ type dspc,/AUnable to open the file! +/ + jrst kchec9 ] + setzm checkp ; Assume we are looking for accounts. + ask /ALooking for valid accounts?/ + jrst [ setom checkp + type dspc,/AOK, listing unknown UNAMEs./ + jrst .+1 ] + movei x,[asciz /AFile to list invalid UNAMEs in:/] + skipn checkp ; Alter prompt if looking for winners. + movei x,[asciz /AFile to list valid accounts in:/] + movem x,filprm ; Set up prompt. + movei x,outfil ; Say this is the default. + call flprmp ; Prompt for file name with default. + call readfi ; Read the file name. + jfcl ; Eh? + move d,argptr ; Pointer to the file name string. + movei b,outfil ; Where to put the file name. + call rfn"rfn ; Parse file name. + syscal open,[cnti .uao ; Open our output file. + argi dsko + ot.dev + ot.fn1 + ot.fn2 + ot.snm ] + jrst [ type dspc,/ACannot open output file. +/ + jrst kchec9 ] + setz e, ; Count UNAMEs read from file. + setz d, ; Count UNAMEs which are really accounts. +kchec1: setz a, ; Accumulate uname from DSKI. + move b,[440600,,a] ; Sixbit BP to result. +kchec2: .iot dski,ch + cain ch,^M ; Check for CR + jrst [ .iot dski,ch ; Gobble LF. + jrst kchec3 ] ; End of UNAME. + andi ch,-1 + cain ch,^C + jrst kchec7 ; EOF - no more names. + cail ch,140 ; Hack case. + subi ch,40 ; To sixbit. + tlnn b,770000 ; Gobble only six characters. + jrst kchec3 + subi ch,40 + idpb ch,b ; Remember this char. + jrst kchec2 ; Go get another. +kchec3: aos e ; Count each UNAME + movem a,uname +kchec4: call pwdlok ; Check for uname in A. + jrst [ skipn checkp ; No account. + jrst kchec6 ; (We're looking for accounts.) + jrst kchec5 ] ; (We're looking for others.) + skipe checkp ; Has account. + jrst kchec6 ; (We're looking for others.) +kchec5: aos d ; Write down this UNAME. + 6type dsko,uname ; Type uname in file. + tyo dsko,[^M] + tyo dsko,[^J] +kchec6: jrst kchec1 ; Get another. + +kchec7: type dspc,/AChecked / + 10type tyoc,e + type dspc,/ UNAMEs; / + 10type tyoc,d + skipn checkp + jrst [ type dspc,/ corresponded to real accounts./ + jrst kchec9 ] + type dspc,/ did not correspond to accounts./ +kchec9: .close dski, ; All done. + .close dsko, ; Close files. + restore [e,d,c,b,a] + ret + + +;;; Implement the PRINT command in PANDA + +kuprin: call r6arg ; Parse the command + call rcarg + ret + move x,crgbts ;check it out + setzm allflg + setzm brfflg + setzm nodate + trne x,CF$PAL ;do we want it all? + setom allflg ; yes, note the fact + trne x,CF$PND ; suppress dates + setom nodate ; yes, note the fact + + trne x,CF$PAL ;if it's -ALL, + do [tyo dspc,[^P] + tyo dspc,["C]] ; clear the screen + trne x,CF$PBF ; do we want it brief? + setom brfflg + skipn t,arg6 ;check for an argument. + pjrst pwdprt ; none, print them all + came t,[sixbit /*/] + camn t,[sixbit /ALL/] ; is it special case of "ALL" ? + pjrst pwdprt ; yes, print all them wihtout INQUIR + camn t,[sixbit /*UNKNOWN/] + jrst pwprul + camn t,[sixbit /*NULL/] + jrst pwprnl + camn t,[sixbit /*NEW/] + jrst pwprnw + movem t,uname ;remember this person + move d,a ;transfer pointer + call maplsr + pjrst usrwho ;who? are You? + + +] ; End of IFN $$PAND + + +SUBTTL Login + +IFE $$PAND,[ +ulogin: setom altusw ;note that we did it this way + terpri + setzm lbrief + skipe altifx ; If 0U or friends + setom lbrief ; note we want no init file. + jrst klog0 + +;;; We enter here from the :LOGIN form. +lbfbts=16 ;bits saying brief login + +klogin: call r6arg ; Parse up the 6bit name + skipn arg6 ; Did he do :LOGIN ? + jrst [type dspc,/ADo :LOGIN +/ + ret] + call rcarg ; Decode the control arguments + ret + move x,crgbts ;check the switches + trne x,cf$lni ;did he ask for no init file? (-bf, -noinit) + setom lbrief ; note that he wants brief login + +klog0: move x,arg6 ;our argument is our XUNAME + movem x,xuname ; retry it here + movem x,uname + .suset [.ssname,,x] ;for the sake of PEEK + call pwdmap ;map in the database + call pwdlok ;does he have a password? + pjrst pwhelp ; no, let's help him out. + + save [uname] + call pwdget ;get his old entry + restore [uname] + call syschk ;check for system name + jrst [ldb x,[pi$sta pdinfo] ; check again, for HOLD + caie x,ps%hld + ret + pjrst ungot] ;Hackity hack, he's on hold, let him hack + + call diltim ;prohibited by dialup or daytime? + phaser ; yes, flush him. + move x,crgbts ;check to see if he wanted to change it + trne x,cf$lpw ;did it? + do [setzm ttyflg ; be sure he sees this + type dspc,/AEnter your old password now! +/] + + call pwask + jrst [type dspc,/AIncorrect. +/ + sosge failct ; don't let him hack passwords forever + phaser + ret] + setzm pwbuf + setzm pwbuf+1 + move x,crgbts ;get our flags + trne x,cf$lpw ;do we want to change it? + do [call pwdchg ; yes, change it! + ret] ; he rubbed out! + +;;; When we get here, we've either gotten the entry via PWDGET or +;;; a new one from PWDCHG via PWDCNS. + +log.in: move x,pdflag ;get the flags + tlze x,%pfnew ;turn off the new user bit if any + movem x,pdflag ; restore it + syscal rqdate,[val t] ;get the current date + setom t ; don't know!? + hlrm t,pddate ;right half = login date + call pwdput ; replace it + syscal login,[uname ? argi 0 ? xuname] + caia ;don't go to DDT if we didn't win! + jrst goddt + move x,calerr ;get the error returned +loglos: caie x,%erojb ;is it "CAN'T MODIFY JOB" ? + cain x,%etop ; or "NOT TOP LEVEL"? + jrst [type dspc,/AYou are hacking me. +/ + jrst goddt] ; load DDT anyway + cain x,%ebdfn ;is it "ILLEGAL FILENAME" ? + error /Attempt to log in with illegal name./ + cain x,%ensmd ;is it "MODE NOT AVAILABLE" ? + error /Attempt to log with intact inferiors./ + caie x,%eexfl ;is it "FILE ALREADY EXISTS" ? + error /Unknown error from LOGIN call./ + + move t,[000600,,UNAME] ;yes, let's hack the uname +klogn0: ldb ch,t ;gobble a char + cain ch,0 ;is it a space? + jrst [decbp6 t ; back up the byte ptr + jrst klogn0] ; and try another + came t,[000600,,UNAME] ;is it 6 chars wide? + ibp t ; no, space over the last char + movei ch,'0 ;add a zero in at the end + dpb ch,t ;deposit it + +klogn1: syscal login,[UNAME ? argi 0 ? xuname] ;try again with name0 + jrst [move x,calerr ; lost, find out why. + caie x,%eexfl ; was it because duplication? + jrst loglos ; no, go barf and return to caller + addi ch,1 ;yes, advance the digit at end of name + dpb ch,t + caig ch,'@ ;don't advance into the letters + jrst klogn1 + type dspc,/AToo many users all logged in with the same name. +/ + ret ] + + type dspc,/AAlready logged in, so logged you in as / + 6type tyoc,UNAME ;tell him who he is + terpri + jrst goddt + +] ; end of IFE $$PAND + +pwdchg: type dspc,/AI will now ask you for a password. +Give anything you like, up to 12 characters. +Case does not matter. +End it with a carriage return. +/ +pwadd5: call pwread + ret ;rubbed out or something + move x,pwbuf ;get the response + movem x,hispas ;and save it in HISPAS + move x,pwbuf+1 ;so we can compare with his next response + movem x,hispas+1 ;to avoid typo's and lossage + type dspc,/AI will now ask you to type the password in again, +to avoid the possibility of errors. +/ + call pwread ;get it again + ret ; rubbed out? + + move t,pwbuf ;get his second response + move tt,pwbuf+1 + camn t,hispas ;is it right + came tt,hispas+1 ; the same as before? + jrst [type dspc,/AThey weren't the same. We will try it again. +/ + jrst pwadd5] ; give him another chance + call pwdini ;Initialize the entry. + call pwdmak ;and add in the password +ife $$pand,[ + type dspc,/AOK, be sure to remember it! +If you have any difficulties, send mail to USER-ACCOUNTS +or call / + movei a,phone + call pwgtxt ; Print the phone # +] +.else [ type dspc,/ADone. +/] + jrst popj1 ;skip-return to denote success + +constants + + +;;; Unknown user routines. +;;; TELAPL sees how many losing unames have been tried. +;;; TELAP1 types verbose "no auto-applications" message. + +telapl: move a,failun ; See how many times loser has lost. + caige a,2 ; If only first time, just mention it. + jrst [ type dspc,/AThat name is not known. +/ + ret ] ; (Save long messages for two-time losers.) +telap1: movei a,naplmg ; Message about why no applications. + terpri + call pwgtxt ; Type it out. + terpri + ret + +;;; help routine for unknown names. + +ife $$pand,[ +pwhelp: aos failun ; Count the number of unkown unames tried. + skipn atoapl ; Are we automatically running applications? + jrst telapl ; No, so make sure he gives a good name. +pwhel0: call maplsr + movei a,lsrc + move b,uname + call lsrtns"lsrunm + jrst [type dspc,/AThat name is not known. +/ + sosge failct + phaser + jrst pwhel1] ;help him out + type dspc,/AThere is no password associated with that name. +/ + sosge failct ;don't let him hack us forever + phaser ; a loser, hack him back + +pwhel1: ask /Do you wish to apply for an account?/ + ret + pjrst acoun1 ;give him help! + +constants + +;;; Ask for various info useful to USER-ACCOUNTS + +kacoun: setzm uname ;no UNAME is known! + skipn atoapl ; If we are not doing auto-applications + jrst telap1 ; verbosely explain the situation. +acoun1: tyo dspc,[^P] ;clear the screen + tyo dspc,["C] + type dspc,/ANote: If you get into difficulties and wish to +abort this, just type a ^G (Control-G, the character that beeps) +/ + setom apltim + skipe uname ;If there is no UNAME + jrst unchk ; there can't be any valid password! + + setzm ttyflg ;turn on the TTY + move x,[ +call [type dspc,/AHere are a few questions about your desire for an account. + +A login name may be up to 6 characters, preferably letters. +There may be no spaces in this name. +Case is not preserved. It should *NOT* end in digits. +Enter your chosen login name: +/ + setzm ttyflg ;turn on the TTY + skipn uname ;if there is a uname + type tyoc,/ +Enter your chosen login name: / + ret]] + movem x,helper ;print help on this phase of the world + movem x,dsprmp + xct x ;print out the help + type tyoc,/ +(You may type "^_H" (Control-underscore H) + (or the [HELP] key if you have one) + for more help at any point in this program.) +/ + +aurd0: type tyoc,/(End your input with a Carriage Return) +Enter your chosen login name: / + +auread: move bp,[440700,,msgbuf] ;input buffer + setz count, ;no characters read yet. + call read6 ;read a 6-bit word + jrst aurd0 ; ask him for it again + cain ch,40 ;did he end with a space? + jrst [type dspc,/AThe name must not have any spaces in it! +Enter your chosen user-name: / + jrst auread] + skipn t,arg6 ;get his chosen UNAME + jrst [xct helper ; help him out + jrst auread] ; try some more + movem t,uname ;remember this name + +;;; check the UNAME for trailing digits +unchk: type dspc,/AYou have given the login name "/ + 6type tyoc,uname + type tyoc,/" +/ + move t,uname ;get the UNAME we want to check + setz tt, ;clear TT for shifting into + lshc t,-6 ;get the last 6bit char + jumpe tt,.-1 ;looping until we get it! + lsh tt,-36 ;right justify it + cail tt,'0 ;is it between 0 + caile tt,'9 ; and 9? + caia ; no, so don't complain + jrst [type dspc,/AThe name must not end in a digit! +Please try again./ + jrst aurd0] ; gobble down another attempt + + ;now that we've got the UNAME, do the work + + call pwdmap ;map in the database + call pwdini ;get a password, (or make it!) + ldb x,[pi$sta pdinfo] + caie x,ps%hld ; Is it a account held for more info + cain x,ps%new ; or a new account? + caia ; Great, let him hack it + jrst accuse ; Nope, tell him it's in use + +acounx: call pwdlok ;is he in the database? Can't let him ask + ;for somebody elses! + jrst ungot ; not there. Get info +accuse: type dspc,/AThat name is in use already. Please choose another. +/ + jrst acexit ;and exit + + +ungot: setom apltim + move bp,[440700,,msgbuf] + write bp,/Name: / + movem bp,namloc ;remember where his name starts! + call maplsr ;map in the database + movei a,lsrc ;tell LSRTNS what channel it can hack + move b,uname ;ask about this UNAME + setzm gotinq ; Set by ASKNAM if INQUIR entry exists + call lsrtns"lsrunm ;is it there? +namfoo: do [ type dspc,/AEnter your FULL name. +(end your input with a Carriage Return) +/ + move x,[type dspc,/CPlease type your full name, followed by +a carriage return. +/] + movem helper + call readln ; Read a single line + jrst qitnam ; nope, he quit on us. Don't +][ + call asknam ; ask if he's the right one + jrst qitnam] ; nope, stop this! + + setz ch, ;a null byte terminates the name + idpb ch,bp ;so we can hack the name separately + movem bp,uinfo ;UINFO gets point to start of user info + write bp,/From net site / + move t,[440700,,hstnam] + copy t,bp + write bp,/ +/ + write bp,/Purpose: / + type tyoc,/ +What do you wish to use the machine for? +(end your input with a ^C ([Control-C])) +/ + move x,[type dspc,/CPlease explain briefly what you indend to use +our machine for. +End your input with a control-C. +(type a ^C (Control-C) by holding down the control key +and typeing "C") +/] + movem x,helper + call readsn ; Read multiple lines + jrst qitnam + type dspc,/APlease give us your telephone number and (paper postal) mailing +address where you can be contacted. +(End your input with a ^C) +/ + + write bp,/Address: / + move x,[type dspc,/CEnter your U.S. MAIL adress and phone number: +/] + movem x,helper + call readsn ; Read multiple lines + jrst qitnam + write bp,/Affiliation: / + type dspc,/AWhat, if any, is your affiliation? +(End your input with a ^C) +/ + + move x,[type dspc,/CEnter your affiliation. Just a name of +an organization connected with this machine or the net, a school, or +simply "none". +(End your input with a ^C) +/ +] + + movem x,helper + call readsn ;read the frob + jrst qitnam ; quit! + + type dspc,/ANow you get to tell what password you wish. +/ + move t,uname + move b,[sixbit /ACOUNT/] ;gotta open an output file for the account + call opnout ;open an output file + typout dsko,aplmal+ml.txt ;output the text of the application + movei b,aplnam ;rename to final application file name + call rnmfn2 + call pwdchg ;get him a password + jrst .-1 ; keep at him! + + movei x,ps%apl ; Now lets set the account state + dpb x,[pi$sta pdinfo] ; to 'Applied' + + call pwdput ;and install it + + .mail aplmal ;mail in an application + .mail telmal ;and notify + +type dspc,/A +Please wait now for a few minutes; Someone may +contact you online. If not, then check back in a day or so; +try loging in. If it hasn't been granted yet, there may be mail for +you. You may read it by doing +:PRMAIL / + 6type tyoc,uname ;spell it out for him! + type tyoc,/ + +Should you desire to change your password, you may do +:HELP LOGIN for info on how to change your password, or +simply do: +":LOGIN / + 6type tyoc,uname + type tyoc,/ -CHANGE" +It will then ask you for your old password (to make sure you are you!) +and then it will ask you to give it a new password, of your +own chosing. +/ + skipn gotinq ; If he lacks an INQUIR entry, tell him + ; about INQUIR + type dspc,/A +The first time you log in, a program will be automatically +run to get certain information about you. Please answer it +as well as you can. Don't be intimidated, think of it as +your introducing yourself to us. In return, you will find +us quite friendly. +/ +acexit: setzm apltim + ret ;that's all, folks! + +qitnam: syscal delewo,[argi dsko] ;flush the mail file + jfcl + .close dsko, ;close the file too! + jrst acexit ;and exit + +.upure +uinfo: 0 ;byte pointer to user info block +namloc: 0 ;byte pointer to start of user's name! +.pure + +] ;; END IFE $$PAND, + + +SUBTTL Command Handlers + +ife $$pand,[ +;;; TCTYP +jtctyp: move t,[ftctyp,,j.file] + blt t,j.file+4 + call infcr + syscal cnsget,[argi tyic ? val x ? val x ? val x ? val x ? val ttyopt] + loss + setzm hfdupf ; Reset default terminal characteristics. + setzm bsflag + setzm sailp + move x,ttyopt ; Now check this TTY out. + tlne x,%tosai ; does this TTY know about sail characters? + setom sailp ; yes, so echo contols right + tlne x,%tohdx ; Is this TTY a loser? + setom hfdupf ; yep, note the fact! + tlne x,%tomvb ; can this TTY move backwards? + setom bsflag ; yep, notice it for half-duplex jobs that + ret ; try ^H ! + +ftctyp: sixbit /DSK/ + sixbit /TS/ + sixbit /TCTYP/ + sixbit /SYS1/ +] ;; End IFE $$PAND + +;;; LOADP +jloadp: move t,[floadp,,j.file] + jrst jwho1 +floadp: sixbit /DSK/ + sixbit /TS/ + sixbit /LOADP/ + sixbit /SYS2/ + +;;; WHO +jwho: move t,[fwho,,j.file] +jwho1: blt t,j.file+4 + call infcr + ret +fwho: sixbit /DSK/ + sixbit /TS/ + sixbit /WHO/ + sixbit /SYS1/ + +;;; HOST +j.hst: move t,[f.hst,,j.file] +j.hst1: blt t,j.file+4 + call infcr + ret +f.hst: sixbit /DSK/ + sixbit /TS/ + sixbit /HOST/ + sixbit /SYS3/ + + +;;; NAME +j.name: move t,[f.name,,j.file] + blt t,j.file+4 + call infcr + ret + +f.name: sixbit /DSK/ + sixbit /TS/ + sixbit /NAME/ + sixbit /SYS/ + +;;; LUSER +jluser: move t,[f.LUSE,,j.file] + blt t,j.file+4 + call infcr + ret + +f.luse: sixbit /DSK/ + sixbit /TS/ + sixbit /LUSER/ + sixbit /SYS1/ + +joctps: move t,[f.octp,,j.file] + blt t,j.file+4 + call infcr + ret + +f.octp: sixbit /DSK/ + sixbit /TS/ + sixbit /OCTPUS/ + sixbit /SYS2/ + +;;; DATE +jdate: move t,[f.date,,j.file] + blt t,j.file+4 + call infcr + ret + +f.date: sixbit /DSK/ + sixbit /TS/ + sixbit /DATE/ + sixbit /SYS1/ + +jtime: move t,[f.time,,j.file] + blt t,j.file+4 + call infcr + ret + +f.time: sixbit /DSK/ + sixbit /TS/ + sixbit /TIME/ + sixbit /SYS1/ + +jtimes: move t,[f.tims,,j.file] + blt t,j.file+4 + call infcr + ret + +f.tims: sixbit /DSK/ + sixbit /TS/ + sixbit /TIMES/ + sixbit /SYS1/ + +jtimoo: move t,[f.timo,,j.file] + blt t,j.file+4 + call infcr + ret + +f.timo: sixbit /DSK/ + sixbit /TS/ + sixbit /TIMOON/ + sixbit /SYS1/ + + +SUBTTL :SSTATUS + +;;; Command to print out system info + +ksstat: syscal sstatu,[val shutdn ;collect info from ITS for header + val sysdbg + val susrs + val parnxm + val time + val machin + val itsver] + loss + aos susrs ;count ourself + 6type tyoc,machin ;MC + tyo tyoc,[40] ;space + type tyoc,/ITS./ ;ITS. + 6type tyoc,itsver ;1097 +ife $$pand,type tyoc,/. PWORD./ +ifn $$pand,type tyoc,/. PANDA./ + 6type tyoc,[.fnam2] ; + type tyoc,/. +TTY / ;more stuff + 8type tyoc,consol ;type our TTY # + type tyoc,/ +/ + 10type tyoc,susrs ;type out # of users. + type tyoc,/. Lusers, Fair Share = / + eval tt,sloadu ;get the system load + movei t,10000. ;magic # to divide into to get % + idiv t,tt ;perform it + 10type tyoc,t ;and type it + type tyoc,/% +/ + skipl shutdn + call sysded ; handle system going down, as if got + ;interrupt + skipe sysdbg ;debuging? + call sysbug ; handle ITS Being debugged message + ret + +sysdwn: .dtty + jfcl + .iopush dski, ;prevent any conflict of channels + uuopsh + call sysded ;call the routine + uuopop + skipe infp ; are we in an inferior job? + jrst [.atty usrc, ;give the TTY back + jfcl + jrst .+1] + .iopop dski, ; restore the channel + jrst dismis ;dismiss the interrupt + +syshak: .dtty + jfcl + uuopsh + call sysbug ;call the routine + uuopop + jrst gobak ;return, maybe give back TTY to inferior + + + + ;interrupt routine, so save the AC's +sysded: save [X,T,TT,A,B,ch,siotct,ttyflg,iobuf,dskbp,ttyprp,prmode,pbufl,pbtsiz,remain,foobp] + syscal sstatu,[val shutdn] ;gotta make sure it's current + loss + + terpri ;make it look nice + 6type tyoc,machin ;type the machine name + + skipg shutdn ;is it going down or up? + pjrst [type tyoc,/ ITS Revived. +/ + jrst popded] ;restore our AC's + type tyoc,/ ITS Going down in / + +;; < +;; The following has the following flow structure, for leading zero suppression +;; hours ? --> print hours +;; | | +;; | (0 hours) | +;; | | +;; minutes? --> print minutes +;; | | +;; | (0 mins) | +;; | | +;; +--------->print seconds +;; | +;; | +;; V +;; + + move a,shutdn ;get the current time-to-go + idivi a,3600.*30. ;grab # of hours + skipe a ;is it that long? + jrst hprt ; yes, print the hours + exch a,b ;let's hack the remainder + idivi a,60.*30. ;convert to minutes and seconds*30. + skipe a ;are there any minutes? + jrst mprt ; yes, type them out + jrst sprt ;there must be seconds! + +hprt: 10type tyoc,a ;print it with leading 0's suppressed + tyo tyoc,[":] ;separator + exch a,b ;let's hack the remainder + idivi a,60.*30. ;convert to minutes and seconds*30. +mprt: call tprt ;print it as NN + tyo tyoc,[":] ;and the separator +sprt: exch a,b ;let's hack the rest of it + idivi a,30. ;convert to seconds + call tprt ;print it as NN + terpri ;look pretty + + move x,[dskbuf+buflen] + movem x,iobuf ;use the other buffer! + + syscal open,[cnti .uai ;access the info as to why we're going down! + argi dski + [sixbit /DSK/] + [sixbit /DOWN/] + [sixbit /MAIL/] + [sixbit /SYS/]] + caia ; Not there? Don't bother printing it then + call printf ; it's there, print it! + terpri + ;restore the AC's etc. +popded: restore [foobp,remain,pbtsiz,pbufl,prmode,ttyprp,dskbp,iobuf,ttyflg,siotct,ch,b,a,tt,t,x] + ret + +tprt: move t,a ;get copy to work with + idivi t,10. ;split into tens and units + addi t,60 ;convert to ascii decimal + tyo tyoc,t ;type it + addi tt,60 ;convert to ascii decimal + tyo tyoc,tt ;type it + ret + +sysbug: save [X,T,TT] ;interrupt routine, save the AC's + + terpri + 6type tyoc,machin + type tyoc,/ ITS being debugged. +/ + restore [TT,T,X] + ret + + +SUBTTL Logout + +ife $$PAND,[ +kquit: type dspc,/AThe proper command for logging off of this system is +:LOGOUT +/ + phaser + +klogou: move x,crgbts ;did he ask for the -BYE option? + trnn x,cf$lby + phaser ; nope, bye-bye + move x,[fbye,,j.file] + blt x,j.file+4 ;tell it what file to load from + call infcr ;run it + phaser + +fbye: sixbit /DSK/ + sixbit /TS/ ;file names for the BYE program + sixbit /BYE/ + sixbit /SYS1/ + +]; END IF# $$PAND + +ifn $$PAND,[ +klogou: +kquit: .logout 1,]; END IFN $$PAND, + + +SUBTTL Some more commands + +ulistj: type dspc,/A* CONIVR P 63 + EMACS P 24 + MAIL P 25 + LISP R 5 + FOO - 17 + MACSYM R 34 + PLANER R 45 + DIRECT P 57 + UNIVERSE-SIMULATION W 107 +/ + ret + +ulogou: phaser ;that's all, folks! + + +khelp: skipn arg6 ;find out about our argument + call r6arg + move tt,arg6 + jumpe tt,bhelp ; If no arg print what we have help on + camn tt,[sixbit /ALL/] ; Does he want help on everything? + jrst allhlp ; Yes, a moby luser, give it to him! + call ttkget ; Look up the command. + jrst khelp1 + movei a,(t) ; Save it from the hungry typers + move tt,cm$flg(t) ; Get the info on this. + tlnn tt,%cohlp ; Is this forbotten? + jrst [ type dspc,/C/ ; OK. Clear the screen first. + jrst docit ] +khelp1: type dspc,/AI know nothing of the / ; Else complain. + 6type tyoc,arg6 ; Tell him what he typed + type tyoc,/ command! +/ + ret ; Return unsuccesfully. + + +docit: type tyoc,/Help info on / ;print header + 6type tyoc,arg6 ;including the command requested + type tyoc,/: + + / + move tt,crgbts ;get the switches he gave + push sp,arg6 ;get the help string for this + trne tt,cf$hbf ;did he ask for -bf or -brief + do [call psdoc ; yes, print short documentation + ][call pldoc] ; no, print the long documentation + pop sp,nul ;restore the stack + terpri + jrst popj1 ;and return, successful + +allhlp: save [a,b,t,tt] + move a,[-cmdcnt,,cmdtab] ; AOBJN ptr to everything there's help on! +allhl1: move tt,cm$nam(a) ;Get the name of the command +IFE $$PAND,[ ;No bad commands in PANDA! + call bdcmd ;If this is a baddie command? + jrst allhl4 ; dont bother to mention it. +] +allhl3: movem tt,arg6 ; that's our argument + call docit ; document it + jfcl +allhl4: addi a,cm$len-1 + aobjn a,allhl1 ; do it for the next one + restore [tt,t,b,a] + ret ; and then ret + + +jmail: move t,[fmail,,j.file] + blt t,j.file+4 + call infcr + ret + +IFN $$PAND,[ +fmail: sixbit /DSK/ + sixbit /TS/ + sixbit /QMAIL/ ; Use regular QMAIL program. + sixbit /SYS/ +] + +IFE $$PAND,[ +fmail: sixbit /DSK/ + sixbit /TS/ + sixbit /PWMAIL/ ; Use hacked up QMAIL program. + sixbit /SYS/ +] + +uprrma: skipa a,[sixbit /RMAIL/] ; Access RMAIL file +uprmail: +kprmail: + move a,[sixbit /MAIL/] ; access MAIL file + move tt,[sixbit /PRMAIL/] + movem tt,comand + call bdcmd + jrst rtbadc + call r6arg ; Parse the argument +kprma5: skipn b,arg6 ; whose mail to read + move b,sndflt + movem b,sndflt ; remember this as our default + jumpe b,[ type dspc,/ARead whose mail? +/ + ret] + setz c, ; find it wherever it goes + call gtmail ; find it + jrst [ type dspc,/ANo mail +/ + ret] + pjrst printf ;print it + + +.upure +netabp: 0 ; Byte Pointer to NETADR entry in INQUIR +.pure +;;; Stolen from DDT + +;; OPMAIL clobbers A, takes the XUNAME to look for in B, and either 0 in C +;; or an ITS to over-ride the one specified in INQUIR. It will return +;; the HSNAME in A, the XUNAME in B, and the ITS name in C + +opmail: push p,d ;Don't clobber D + push p,c ;remember the ITS name we were given + push p,b ;save XUNAME for later + call maplsr ;map in the database + movei a,lsrc + movei d,dski + call lsrtns"lsrunm ;find this person in INQUIR + jrst [setz b, ; Remember that there was no INQUIR entry + jrst inqmal] ;and get his HSNAME from INQUIR + jumpn c,inqmal ;If we were given an explicit ITS, look only there + movei a,lsrtns"i$neta ;check out the network address field + call lsrtns"lsritm ;dig it out! + jrst inqmal + movem a,netabp ;remember where this info is + move d,a ;D gets the BP to the NET Adress + call lread6 ;read a token + jrst inqmal + caie c,"% ;Did he terminate in an % or @? + cain c,"@ + jrst [call getits ;yes, use this for the XUNAME + jrst inqmal ;somehow this is garbage! + jrst inqml0] ;OK, NOW we got the site + call mchokp ;Is this a valid ITS? + jrst [ call notits ; Tell him about forwarded mail + jrst inqmal] ; and don't fuck with the machine name +inqml0: movem a,-1(p) ;salt machine name away + +inqmal: move a,(p) ;remember our XUNAME + movei d,dski ;channel to open the directory on + move c,-1(p) ;remember our ITS + skipn c ;is it unspecified? + move c,machin ; Use current + movem c,-1(p) ;and salt this improved version away + call lsrtns"lsrhsn ;get the HSNAME + jrst [ type tyoc,/(Net or INQUIR error) +/ ; Eh??? Tell the user. + move a,(p) ;use our XUNAME as the HSNAME + jrst inqml5] + aos -3(p) ; Skip return + move a,d ;collect the HSNAME +inqml5: call unmapl ;don't need these any more, release + pop p,b ;and the XUNAME + pop p,c ;recover the ITS name + pop p,d ;remember D (unchanged) + ret + + +lread6: setzb a,t + push p,b + move b,[440600,,a] +6readl: ildb c,d + aos t + cain c,40 + jrst 6readl ; spaces are ignored. + cain c,"% ; % is a terminator + jrst mpopj1 + caie c,"@ ; @, comma are terminators + cain c,", + jrst mpopj1 + cain c,^Q ; let ^Q quote a character. + ildb c,d + caige c,40 + jrst mpopj1 ; control chars terminate even if ^Q'd + cail c,140 + subi c,40 + subi c,40 + tlne b,770000 + idpb c,b + jrst 6readl + +mpopj1: pop p,b + skipe a ;unless this is a null entry + aos (p) + popj p, + + +;; person said FOO@BAR + +getits: push p,a ;remember the FOO part + pushj p,lread6 ;get more of it + setz a, ; not there! Fail return + jumpe a,[pop p,a ? ret] ;if null, same as not there + call mchokp ;is this a known machine? + jrst gtitsx ;If not an ITS, same as not there! + move c,a ;That was the ITS name + movei a,lsrc + pop p,b ;recover our XUNAME + movem b,-1(p) ;and set the XUNAME saved on the stack + call lsrtns"lsrunm ;Find the new frobule + setz b, ; No INQUIR entry for that XUNAME + move a,c + jrst popj1 + +gtitsx: pop p,a + move a,-2(p) ;use whatever ITS was specified! + jrst notits ;Tell him the mail goes off of ITS + ret + +mchcnt==:4 ;4 ITS's +mchtab: irp machine,,[AI,ML,MC,DM] +sixbit /machine/ +termin + +;;; Expects BP to net address in NETABP, prints same with message +notits: type dspc,/A(This person's mail is forwarded to / +notit1: ildb d,netabp ;get a char + jumpe d,[ type tyoc,/) +/ ; if that's the end, that's all, so finish the line + popj p,] + tyo tyoc,d ;type the char + jrst notit1 ;and get the next + +;;; canonicalize and check the machine name. (Handles MIT-MC and MC) +;;; Takes machine in A, returns canonicalized machine in A. +;;; Stolen from DDT + +mchokp: camn b,[sixbit /DSK/] ;= machine we're on + jrst [move a,machin ? jrst popj1] + push p,b + ldb b,[143000,,a] ;get the MIT- of MIT-xx + camn b,[sixbit / MIT-/] ;Was it in that form? + jrst [ ldb a,[001400,,a] ;Get the xx part + lsh a,30 ;put it in it's place + jrst .+1] + call mchok0 ;is this a real machine? + caia +bret: aos -1(p) + pop p,b + popj p, ;no more nexts, bad! + +mchok0: movsi b,-mchcnt ;for all the machines +mchok1: camn a,mchtab(b) ;is it this one? + jrst popj1 ; yes, it's OK + aobjn b,mchok1 ;no, try next + ret + +;;; GTMAIL takes in A the FN2, B a XUNAME, an ITS name in C, or 0 meaning +;;; wherever his mail would normally be found, and opens on DSKI the mail file +;;; for that user. If it fails, it will not skip, and return a .CALL type error +;;; code in D. It will also return the HSNAME in A, the XUNAME in B, and the +;;; ITS name in C. Stolen from DDT + +gtmail: movem a,fd.fn2 ;save the fn2 of the file we're after + call opmail ;Find the mail to look at + ret + movem b,fd.fn1 + camn c,machin ;Is it from this ITS? + movsi c,'DSK ; yes, use DSK instead + movem c,fd.dev + movem a,fd.snm + camn b,xuname ;is this the same XUNAME and + came c,machin ; is this from this machine? + caia ; no, gotta tell the user + jrst gtmal9 ; yes, don't bother telling user. +gtmal5: type dspc,/A(Checking mail from / + movei b,dirnam + move d,[440700,,dskbuf] + call rfn"pfn ; generate the filename string + output tyoc,dskbuf ; and print it out + move a,fd.snm ;recover A from it's hiding place in B + move b,fd.fn1 ;recover B from it's hiding place in file block + move c,fd.dev ;recover C from it's hiding place in file block + tyo tyoc,[")] ;balance! + terpri ;new line! +gtmal9: movei b,dirnam + .call uaiopn ;open the file + caia ; no skip + jrst [ aos (p) ; found it, skip return + jrst gtmalx] ; (cause that's all!) + move d,calerr ; check out what kind of error it was + jumpe d,gtmalx ;no error, we win! + caie d,%ensfl ;Was it that the file wasn't there? + filoss dirnam ; no, complain of another kind of error +gtmalx: push p,b ;save B across umapping and flush old A + pop p,b ;restore B to it's rightful placs + ret + +.upure +sndflt: 0 ; default SENDS file to use +.pure +kprse1: skipn a,arg6 ; get whose SENDs to hack + move a,sndflt + caia +kprsen: move a,arg6 ; remember this as the default SENDS file + movem a,sndflt + syscal open,[cnti .uai ;open the sends file + argi dski + [sixbit /DSK/] + a + [sixbit /SENDS/] + cladir] + jrst [type dspc,/ANo sends +/ + ret] + pjrst printf ;print it + + +;; SEND command. +;; Note: if the SEND command is disallowed, failing sends will +;; turn into mail regardless of whether the MAIL command is allowed. + +ksend: move bp,snaptr ; Pointer to who to send to + move ct,snacnt ; Ensure it points to something plausible + skipn ct ; Complain if there's no one to send to + jrst [ type dspc,/AYou must specify who to SEND to. +/ + ret ] + caile ct,6. ; Complain if rcpt could not be a UNAME + jrst ksen11 ; Probably trying to send across network + setz a, ; Accumulate UNAME in A + move b,[440600,,a] ; Bp to UNAME +ksen10: ildb ch,bp ; Get a char from string + cain ch,", + jrst [ type dspc,/ASEND only lets you send to one person at a time. +/ + ret ] + caie ch,"% ; FOO@BAR doesn't work + cain ch,"@ +ksen11: jrst [ type dspc,/ASEND does not work across the network. +/ + ret ] + caige ch,40 ; Control chars terminate reading + soja ct,ksen20 + cail ch,140 ; SIXBITify the character + subi ch,40 + subi ch,40 + tlne b,770000 + idpb ch,b ; Deposit it into the UNAME + sojg ct,ksen10 ; Loop until end +ksen20: movem bp,snaptr ; Got it, update the BP + movem ct,snacnt ; and the count + jumpl ct,cpopj ; Huh? + syscal OPEN,[ cnti .uao ? argi dsko ? [sixbit /CLI/] ? a + [sixbit /HACTRN/]] + jrst gomail + call sndtim ; Get the time word in A + .iot dsko,[177] + typout dsko,sndtyp + .close dsko, + ret + + +gomail: move d,[440700,,tmpbuf] + idpb6 a,d ; generate asciz for the TO: field + setz e, ; and make sure it's ASCIZ + idpb e,d + .mail sndmal ; Send it as mail + type dspc,/A(Mailed) +/ + ret + + +;; table of special devices NOT to set our default to + +devtab: irp dev,,[TTY,T,MLTTY,MCTTY,DMTTY,AITTY,D,MCD,MLD,AID,DMD,XGP,TPL,GLP,DVR,COR,DIR,DIRML,DIRAI,DIRCOM,DIRSYS,DIRDSK,CLO,CLI,CLA,CLU] + sixbit /dev/ + termin +devlen==.-devtab ;# of devices + +ulistf: move tt,[sixbit /LISTF/] + movem tt,comand + call bdcmd + jrst rtbadc + skipn t,arg6 ;null command says, same as before + jrst kc.fop ; so hack without any setup + setzm fd.dev ;clear out any old ones + setzm fd.snm ;Clear out SNAME left over from :LISTF FOO; + movem t,fd.fn1 ;put in FN1 slot for KLISTF + jrst kc.fop ;and continue with hack + +;;; A non-zero name in FD.FN1 is from FOO^F or :LISTF FOO, and is tried as +;;; both a directory with the DSK device and as a device + +klistf: setzm fd.fn1 ;eliminate pre-conceived notions + setzm fd.snm ;:LISTF FOO; + move x,fi.dev + movem x,fd.dev ;and :LISTF FOO: + + move d,argptr ;pointer to the file-name + movei b,dirnam ;pointer to file name! + call rfn"rfn ;read the names +kc.fop: call dirdev ;get the dir and dev + + movem t,fx.snm ;save our new-found names in a fileblock + movem tt,fx.dev ;where we can can open and print + movei b,fdxnam ;B get's location of that fileblock + call prtopn ;open that file + jrst [skipn tt,fd.fn1 ; nothing to fill in with? + filoss (b) ; yes -- give error + move x,calerr ;what was the error? + caie x,%ensdr ; non-existant directory? + filoss (b) ; nope, give the error + skipn t,fd.snm ; was there a directory given? + move t,fi.snm ; no, get the default + save [fx.dev,fx.snm,calerr] ;save circumstances of error + movem t,fx.snm ; save our new-found names + movem tt,fx.dev + call prtopn ; open our file in the right mode + jrst [restore [calerr,fx.snm,fx.dev] + filoss (b)] ; still nothing, give error + restore [calerr,fx.snm,fx.dev] + jrst .+1] + tyo dspc,[^P] ;clear the screen + tyo dspc,["C] + + movem t,fi.snm ;we found it, make it the default + hrlzi t,-devlen ;AOBJN ptr for DEVTAB +kc.fdv: camn tt,devtab(t) ;is it a dir only device? + pjrst printf ; yes, just print out and return + aobjn t,kc.fdv ;try the next one + movem tt,fi.dev ;it's not one of them, so make it the + ;default + pjrst printf + + +;; get the dir in T and dev in TT +dirdev: skipn t,fd.snm ;was a sname given? + skipe t,fd.fn1 ; or was a FN1 given? + caia ; yes, use it + move t,fi.snm ; no, use the default + + skipn tt,fd.dev ;was a device given? + move tt,[sixbit /DSK/] ; no, use the DSK instead + ret ;return + +;; Prompt for file name with defaulting. +;;; X should be the address of default file block, or zero. + +flprmp: save [b,d] + output dspc,@filprm ;output a prompt for the frob + type dspc,/ADefault = / ;prompt for the file + move d,[440700,,DSKBUF] ;use DSKBUF, since we don't need it yet + movei b,filnam ; The default default. + skipe x ; If we were given a new default + move b,x ; use it instead. + call rfn"pfn ;convert it back again + output tyoc,dskbuf ;and type it out + type dspc,/AFILE = / + restore [d,b] + ret +.upure +filprm: 0 ;prompt for file operation +.pure + +uprint: ;Here from ^R +kprint: move tt,[sixbit /PRINT/] + movem tt,comand + call bdcmd + jrst rtbadc + move d,argptr ;pointer to the file-name + movei b,filnam ;pointer to file name! + call rfn"rfn ;read the names + + move x,fi.dev ;for sake of TTY^F ^R^F + movem x,fd.dev ;reset it to it's default + setzm x,fd.fn1 ;this should work for ML^F ^R ^F + + movei b,filnam ;point to the file we are using + call prtopn ;open it + filoss (b) ; we lost, tell him + tyo dspc,[^P] ;clear the screen first + tyo dspc,["C] + pjrst printf ;print it out + +;;; USERS command + +jusers: terpri ;make sure you start on a new line + move t,[f.usrs,,j.file] ;run the damn thing already! + blt t,j.file+4 + pjrst infcr + +f.usrs: sixbit /DSK/ ;here's home for the USERS command + sixbit /TS/ + sixbit /USERS/ + sixbit /SYS2/ + +;;;; Here goes the documentation printer etc. + +; The documentation printers take a sixbit command to document, and +; look it up and print either the short or the entire documentation. + +; print short documentation +psdoc: move tt,-1(sp) ; Get the command to document + call ttkget ; Get the command index + error /Attempt to document non-existant command/ +psdoc1: hrrz tt,cm$sdc(t) ; Get address of short doc + hlrz t,cm$sdc(t) ; Get length of short doc +psdoc2: hrli tt,440700 ;make t into a byte pointer + syscal siot,[argi tyoc ? tt ? t] ;type it out + loss + ret + +; print long documentation +pldoc: move tt,-1(sp) ; Get the command to document + call ttkget ; Get command index + error /Attempt to document non-existant command/ + push sp,t ; Remember the index + call psdoc1 ; Print out the short documentation first + pop sp,t + hrrz tt,cm$ldc(t) ; Get address of long documentation + hlrz t,cm$ldc(t) ; Get length of long documentation + pjrst psdoc2 ; Print it out + +;;; type out a list of all the commands, 5 to a line + +bhelp: type dspc,/CThese are the topics for which HELP can give more info. +Type: +:HELP +for more info on a given topic. + +/ + save [b,tt] ;Save B for use as count of commands off + move a,[-cmdcnt,,cmdtab] ;aobjn pointer to name table + move t,cmhcnt ;cmhcnt per line + movem t,hcnt ;so set hcnt +bhelp0: move tt,cm$nam(a) ;Get the name of the command +IFE $$PAND,[ + call bdcmd ;Is this an OK command? + jrst bhelp3 ; Nope. +] +bhelp2: move t,cm$flg(a) ;get the flags + tlne t,%cohlp\%conls ;maybe no need to print? + jrst bhelp3 ;just do your thing. + tyo tyoc,[^I] ;tab to next location + 6type tyoc,cm$nam(a) ;type the name + sosg hcnt ;hcnt is count of times we've typed entries + do [ terpri ;if we've typed enough on this line + move t,cmhcnt ;just go to another. + movem t,hcnt] +bhelp3: addi a,cm$len-1 + aobjn a,bhelp0 ;loop for all of them + terpri + restore [tt,b] + ret + + + +SUBTTL Interrupt handlers and Inferior hackery + +;;;; Here goes the inferior handler routines +;;;; Here go the interrupt handlers + +intspc==:100000 ;push extra debugging info +tsint: intspc,,sp + %pimpv\%piwro\%pioob\%piilo\%pidis ? 0 ? -1 ? -1 ? badint + %pipdl ? 0 ? -1 ? -1 ? pdlovr + %piioc ? 0 ? -1 ? -1 ? iocerr + 0 ? <1_tyoc>\<1_dspc> ? 0 ? 0 ? morint + %piltp ? 0 ? -1 ? -1 ? clock + 0 ? 1_tlnc ? -1 ? -1 ? telbye + 0 ? 1_tyic ? %picli ? -1 ? ttyint + 0 ? -1,,0 ? %picli ? -1 ? infint + %picli ? 0 ? %picli ? -1,,0 ? cliget + %pidbg ? 0 ? #%pimpv#%pipdl#%piioc#%piltp ? -1,,0 ? syshak + %pidwn ? 0 ? #%pimpv#%pipdl#%piioc#%piltp ? -1,,0 ? sysdwn ;Gronk + %pirlt ? 0 ? #%pimpv#%pipdl#%piioc#%piltp#%pirlt ? -1 ? timout + ;%PIRLT's don't defer themselves, so + ;hung terminals might log out. +intlng==.-tsint + +gobak: skipe infp ;If we're in an inferior + .atty usrc, ; give back the TTY + jfcl +dismis: syscal dismis,[cnti intspc ? sp] ;Go back to what you were doing. + loss + + +nlitim==5. ;Not Logged In lusers time out after five minutes. +.upure +apltim: 0 ; -1 => luser applying, don't time out +timflg: -1 ;set >= 0 if we've already warned about time +.pure + +timout: uuopsh + push p,t + syscal cnsget,[argi tyic ? val nul ? val nul ? val nul ? val TTYCOM] + loss + skipe apltim ; If luser is applying for an account + jrst timou1 ; don't hassle him. + hrrz t,ttycom ; Get com mode info. + camn t,[0,,-1] ; TTY linked to someone? + jrst timou2 ; No, see if completely timed out. +timou1: move t,[move [nlitim*60.*60.]] ; Yes, restart the countdown. + .realt t, + jfcl + pop p,t + uuopop + jrst dismis + +timou2: aose timflg ; Is this the first time? + .logout 1, ; no, time to flush. + move t,[move [2*60.*60.]] ; Else give 2 more minutes + .realt t, ; till final bye-bye. + jfcl + .dtty ; Make sure we have the TTY. + jfcl + type dspc,/A +Timeout: You have two minutes remaining in which to log in or be logged out. +This policy is necessary to avoid tying up job slots and network ports. +If you are having difficulties and need assistance, please type: + +:LUSER +and someone will assist you. +/ + pop p,t + uuopop + jrst gobak ; Relinquish TTY and dismiss. + + +cliget: .dtty + jfcl + .iopush dski, ;don't clobber anything we may be doing! + syscal open,[cnti .uii ;image mode, to get the UNAME/JNAME + argi dski + [sixbit /CLA/]] + jrst [.iopop dski, ; Restore the channel + jrst gobak] ; And return, maybe give back TTY + +;;; save the world + save [x,t,tt,a,ch,siotct,ttyflg,iobuf,dskbp,ttyprp,prmode,pbufl,pbtsiz,remain,foobp] + uuopsh + syscal cnsget,[argi tyic ? val nul ? val nul ? val nul ? val TTYCOM] + loss + move t,ttycom + tlo t,%tcoco ;turn on OCO! + syscal cnsset,[argi tyic ? [-1] ? [-1] ? [-1] ? t] + loss + + .iot dski,nuprt ;get the UNAME + .iot dski,njprt ;and the JNAME + .iot dski,savewd ;get first char, plus a few + move a,[440700,,savewd] ;BP to first char + ildb ch,a ;get the first one + cain ch,177 ;is it a rubout? + jrst nujprt ; yes, don't print message from ... etc + movem ch,chsave ;save for later re-typeout + type dspc,/AMessage from / + 6type tyoc,nuprt ;type the UNAME + tyo tyoc,[40] ;space + 6type tyoc,njprt ;JNAME + terpri + tyo tyoc,chsave ;time to type it + +;; this has the bug that short messages (< 5 chars) still get 5 chars (4 if +;; first is a rubout) typed. Tough shit. +nujprt: movei t,4 ;4 characters + movem t,siotct ;make ^S win! + syscal siot,[argi tyoc ? a ? siotct] ;to type + loss + + move x,[dskbuf+buflen] + movem x,iobuf ;use the other buffer! + call printf ;print the rest + ;restore OCO to it's former state !! + syscal cnsset,[argi tyic ? [-1] ? [-1] ? [-1] ? ttycom] + loss + ;restore world + uuopop + restore [foobp,remain,pbtsiz,pbufl,prmode,ttyprp,dskbp,iobuf,ttyflg,siotct,ch,a,tt,t,x] + + .iopop dski, ;restore the channel + terpri ;make sure don't leave it hanging + jrst gobak + + +;;; TTY interrupt handlers + +ttyint: uuopsh + save [ch] +ttypsh==.-ttyint + syscal whyint,[argi tyic ? val nul ? val ch] + jrst ttidsm ; dismissed! + cain ch,^Z ;quit? + jrst c.quit ; quit! + + cain ch,^G ;quit? + jrst g.quit ; quit with funny message! + + caie ch,^S ;is it ^S? + jrst ttidsm + syscal ttyfls,[cnti 0 ? argi tyic] ;flush the ^S, but not typeahead + loss + .reset tyoc, ; flush typeout + setzm siotct ; no more! + setzm ttyflg ; turn on the TTY while handling it + hrrz ch,-ttypsh(p) ; get where we interrupted from + skipe morflg ; are we inside a more? + caie ch,tyiiot ; waiting in a TYI? + caia ; nope + jrst [ restore [ch] ; yes + movei ch,177 ; we're gonna pretend we saw a rubout + aos -ttypsh+1(p) ; pretend the .IOT returned + jrst ttids1] ; dismis to next instruction + $echo ^S ; echo it now. Don't echo in a --MORE--, + ; since that would just get flushed anyway + cain ch,tyiiot ; were we reading? + jrst ttidsm + setom ttyflg ; prevent more cruft from starting +ttidsm: restore [ch] +ttids1: uuopop + jrst dismis ; and return to what you were doing! + +g.quit: call ttyclr ; clear output/input on TTY + type tyoc,/ (Quit) +/ + quit ; reset the world + +c.quit: call ttyclr ; clear the TTY I/O + quit + +ttyclr: .reset tyoc, ;clear the output + syscal ttyfls,[cnti 1 ? argi tyic] ;flush typein up to interrupt char + loss + setzm siotct ;clear the SIOT count! + ret + +;;; --MORE-- interrupt +morint: skipe ttyflg ; if we aren't typing anyway + jrst dismis ; just ignore it + save [ch,x] + uuopsh + push sp,siotct ;save SIOTCT seperately + syscal finish,[argi tyoc] ;wait for it to come out + jfcl ; ignore failure + type tyoc,/--MORE-- (Space yes, rubout no, ? for help)/ + setom morflg ;note we are at a more +morin1: tyi + jrst flushd + jrst [ +type dspc,/TLWhen you see --MORE-- at the bottom of your screen, +it means that there is more output to come, but the system +is waiting for you to finish reading it. When you are +ready for more output, just type a space, and it will type +out the next screenful. + +On the other hand, if you do not wish to see the output, you +may type a rubout instead. This will throw away the remaining +output. + +----------- +ZH3/ + jrst morin1] + jrst flushd ; rubbed out, flush. + setzm morflg ;turn of --MORE-- flag + cain ch,40 ;is it a space? + jrst [type dspc,/ +/ ; yes, go to top + jrst mordsm] ; to continue typeing + + caie ch,^M ;loser type a CR anyway? + movem ch,reread ; garbage char, re-read it later + + +flushd: setzm morflg ;^G or ^D -- turn off --MORE-- flag + .reset tyoc, ;throw it all away + type dspc,/ZL--FLUSHED--TL/ ;tell him about it + setom ttyflg ;no more output + setzm siotct ;flush ongoing output +mordsm: pop sp,nul ;throw away old SIOTCT + uuopop + restor [x,ch] + jrst dismis ;and end of interrupt + +;;; error interrupt handlers +badint: error /Unknown Interrupt./ +pdlovr: error /PDL Overflow./ +pdlund: error /PDL Underflow./ + +iocerr: .suset [.rbchn,,iocchn] ;find out what channel lost + syscal status,[iocchn ? val iocsts] ;get the status + loss + syscal open,[cnti .uai + argi dski + [sixbit /ERR/] + argi 3 ;means 2nd file name is status word + iocsts] + loss + movem x,erracs ;save X for analysys + move x,[1,,erracs+1] ;and use it to BLT the rest of the AC's to + blt x,erracs+17 ;safty + call printf ;print the error message + ldb t,[330500,,iocsts] ;get the error # + movei tt,1 ;set up to shift one bit into position + lsh tt,(t) ;shift it + tdnn tt,iocfpr ;Should the file name be printed? + do [ syscal rfname,[argi %jself ;yep, find out the true filename + iocchn + val fi.dev + val fi.fn1 + val fi.fn2 + val fi.snm] + loss + type dspc,/ABad file = / + move d,[440700,,msgbuf] ;use msgbuf, since we don't need it now + movei b,filnam ; + call rfn"pfn ; convert it back again + output tyoc,msgbuf] ; type that string again! + + syscal delewo,[argi dsko] ;flush any writing we may be doing + jfcl ;must not have been there or doable + + ldb t,[330500,,iocsts] ;get the error # + movei tt,1 ;set up to shift one bit into position + lsh tt,(t) ;shift it + ldb t,[330500,,iocsts] ;get the error # + movei tt,1 ;set up to shift one bit into position + lsh tt,(t) ;shift it + tdne tt,iocbad ;Is this safely ignorable? + jrst gotop + errdmp 4,[asciz /Input-Output Error/] ;AC's have been saved + +gotop: move sp,[-pdllen,,pdl] ;clean out the stack + .uclose usrc, + .suset [.sdf1,,[0]] ; Re-enable interrupts + .suset [.sdf2,,[0]] + jrst rdloop ;back to reading + + +;;; IOC errors to print file names for +; 11 - Device Full +; 14 - Directory Full +iocfpr: irp x,,[11,14] +<1_x>\termin + +;;; IOC errors to continue after +; 7 - USR Operation Channel does not have USR device open +; 10 - Channel not open +; 13 - Illegal Character after ^P on display channel + +iocbad: irp x,,[7,10,13] +<1_x>\termin + + +infint: save [x,t,tt] + uuopsh + .dtty ;get back the TTY + jfcl + syscal usrvar,[argi usrc ;get his interrupts + [sixbit /PIRQC/] + val t] + loss + trne t,%pibrk ;break? + jrst break ; handle that + setzm infp ;note we aren't in inferior anymore + trne t,%pival ;.VALUE? + jrst value ; go barf at him, I didn't say I was DDT + trnn t,<%pic.z> ;^Z ? + tlne t,%pjdcl ; or ^_D ? + jrst kjob ; kill it off. + + type dspc,/AInferior got random interrupt!/ + jrst gotop + +define pagmak a + andi a,-1 ;clear left half + lshc a,-12 ;split off page number from rest + lsh ,12-44 ;and make remainder +termin + +accum==:.bp <740,,0> +index==:.bp <17,,0> +indirc==:.bp <20,,0> +opcode==:.bp <777000,,0> + +break: move t,[-6,,[sixbit /PIRQC/ ? trz %pibrk ;turn off the interrupt + sixbit /UPC/ ? movem j.upc ;get the PC to restart at, and + ;for debugging + sixbit /SV40/ ? movem jinstr]] ;get the causing inst. + syscal usrvar,[argi usrc ? t] ;get the info + loss + + ldb t,[accum jinstr] ;pick out the accumulator + movem t,jaccum + + hrrz t,jinstr ;t <- address field + movem t,jaddr ;address field + + ldb t,[opcode jinstr] ;get the opcode + movem t,jopcod ;and save it for debuging's sake. + cain t,c.op ;is it a .oper ? + jrst kjob ; just kill it + + move t,jaccum ;check the accumulator + cain t,12 ;is it a .BREAK 12, ? + jrst brk12 ; yes + + setzm infp ;note we aren't in inferior any more + caie t,16 ;is it garbage? + jrst unbrk ;go handle unknown break + +kjob: setzm infp ;note we aren't in inferior anymore + syscal rfname,[argi usrc + val t] ;is there an inferior? + loss + skipn t + ERROR /Attempt to kill non-existant inferior./ + .uclose usrc, ;kill it + type dspc,/A:KILL +/ + .uclose usrc, ;it must have been asking to die since we + ;told it we weren't a DDT + jrst infdon + +brk12: syscal usrmem,[argi usrc ? jaddr ? val t] ;A <- cont (e.a) + jrst kjob ; lose! + jumpl t,[hlrz t,t ;if writing + caie t,400005 ; if clearing JCL + jrst [setzm jclct ;clear it and + jrst infdon] ;be done + ERROR /Inferior trying to write superior./] + ;complain + hlrz tt,t ;get operation + trne tt,200000 ;is it block mode? + error /Inferior trying to use block mode .BREAK 12,/ + cail tt,brktbl ;is it out-of-range? + jrst unbrk + xct brktb(tt) + + +unbrk: error /Inferior got a bad .BREAK interrupt./ + +brktb: jrst unbrk + jrst unbrk + jrst unbrk + jrst unbrk + jrst unbrk + jrst getjcl +brktbl==.-brktb + +getjcl: hrrz t,t ;get address again + pagmak t ;make it into a page # and loc in that page + movem t,jclpag ;save page and location in page + movem tt,jclloc ;for JCL + syscal corblk,[cnti %cbndw ;need write access + argi 0 ;no XORing, please + argi %jself ;map into ourself + argi tmpag1 ;at the highest possible location + argi usrc ;our inferior's + jclpag] ;page which is contained in A + jrst jclovf + aos jclpag ;get next page too + skipn t,jclct ;get length pointer of JCL + jrst infcnt ; no JCL, continue + addi t,4+1 ; (+1 to count ^M) + idivi t,5 ;(ptr+4)/5==length in words + add t,jclloc ;the final loc + cail t,2000 ;overflow? + do [syscal corblk,[cnti %cbndw ;need writing + argi 0 ;barf, no XOR, please + argi %jself + argi tmpag2 ;very moby + argi usrc ;our very inferior inferior + jclpag] ;and the next page + jrst jclovf] ;complain of indigestion + + + move t,jclct ;get the JCL length + addi t,4+1 ;convert to words (+1 to count ^M) + idivi t,5 ;from characters + move tt,jclloc ;get the offset for the address + add t,tt ;include it in the final total end address + hrri tt,(tt) ;and put in right half for blt + hrli tt,jclbuf ;get our source for the BLT from the JCLPTR + blt tt,-1(t) ;and perform the transfer + jrst infcnt + +infcnt: uuopop + restor [tt,t,x] + + .atty usrc, ;give it to him + jrst [.dtty ;get it back + .atty usrc, ;and try again + loss ;nope, we're screwed somehow + jrst infcn1] ;good, one with the show + + call start + +infcn1: syscal dismis,[cnti intspc + sp] + loss + +jclovf: ERROR /Inferior tried to read JCL +into pure or non-existant memory./ + +value: syscal usrvar,[argi usrc ;turn off the interrupt + [sixbit /APIRQC/] + [%PIVAL]] + loss + type dspc,/AInferior .VALUE'd / + + .uclose usrc, + jrst infdon + + +infdon: uuopop + restore [tt,t,x] + + syscal dismis,[cnti intspc + sp] + loss + +start: syscal usrvar,[argi usrc ;copy his old state + [sixbit /OPTION/] + val t] + loss + tlz a,optcmd+optbrk ;clear the OPTCMD bit (+ the OPTBRK since + ;LISP demands it!) + skipe jclct ;if there is JCL + tlo t,optcmd+optbrk ;set it again + syscal usrvar,[argi usrc ;and set it up + [sixbit /OPTION/] + t] ;write it back again + loss + + setom infp ;note we are in inferior + syscal usrvar,[argi usrc ;GO! + [sixbit /USTP/] + argi 0] + loss + + ret + + + +;;; run an inferior. Takes a job name in COMAND, and file names in +;;; INFFN1, FINFN2, and INFSNM + +infcr: call jclcop ; Set up the JCL + .status usrc,t ; look at the channel + caie t,0 ; if there is something open + .uclose usrc, ; kill it + + syscal open,[cnti .uii ; create a job + argi usrc + [sixbit /USR/] + argi 0 ; same UNAME as ourselves + COMAND] ; we look in COMAND for the UNAME + jrst [type dspc,/ACannot create inferior, maybe system full? +/ + ret] + syscal open,[cnti .uii ; open a file to load into it + argi dski + [sixbit /DSK /] + inffn1 + inffn2 + infsnm] + error /Program missing/ + + syscal load,[argi usrc ; load it + argi dski] + jrst [move x,errret ; fetch the error code + cain x,%enacr ; no core? + jrst [type dspc,/AThe system is overcrowded to the point that you cannot even log in, +so I am logging you out. +/ + phaser] +ifn $$PAND,[ cain x,%erojb ; Have we got a non-inferior? + jrst [type dspc,/AJob not inferior! +/ + ret] +] ; END IFN $$PAND, + error /Can't load job/] + syscal iot,[argi dski ;get starting address + argi t] ;in a + loss + andi t,-1 ;ignore the JRST part + + syscal close,[argi dski] ;close it + loss + + syscal usrvar,[argi usrc ;make it start there + [sixbit /UPC/] + t] ;a has address + loss + + syscal usrvar,[argi usrc ;get what bit to enable + [sixbit /INTB/] + val t] + loss + + syscal usrvar,[argi %jself ;and enable it + [sixbit /IMSK2/] + t] + loss + +TTYGO: call start + .atty usrc, ;give up the TTY and wait for return + jfcl + skipe infp ;until we aren't in inferior + .hang + .dtty + jfcl + ret + + + + +SUBTTL Initialization + +;;;; Here goes the initialization code + +ife $$pand,[ +;; Following due to EAK + +comchk: move t,ttycom ; Get our TTY com var + .suset [.runame,,uname] ; Make sure we know our UNAME for logging + tlne t,%tcrft\%tcico ; Did this loser slave another terminal + jrst ttyhak ; Yes, don't give him DDT as a reward. + movei count,100 ;if 100 TTY's are linked, we' must be + ;looping looking for TTY that isn't there + ;any more +comch0: syscal cnsget,[argi %jsnum(b) ;get the TTYCOM for given terminal + val t ? val t ? val t + val b] + loss + hrrzs b ; throw away the bits + camn b,consol ;are we back to the start? + jrst ttyhak ; yes, so must not be any winners, ask for + ;password + cain b,-1 + jrst ttyhak + syscal styget,[argi %jsnum(b) ;get a job for that TTY + val t ? val t + val c] + loss + jumple c,[sojg count,comch0 ;if it's free, try next + jrst ttyhak] ; oops, must be looping, no winners + syscal usrvar,[argi %jsnum(c) + [sixbit /UNAME/] + val c] ; find UNAME of linker + loss + movem c,linker ; remember who lunk to + hlrz c,c ; linker logged in? + caie c,-1 ; + jrst goddt4 ;winner, get him a DDT + sojg count,comch0 ; he's not responsible, try another + jrst ttyhak ;infinite loop, try again +] ;; end IFE $$PAND + +run: setom debug ;this is the debug starting address + setom noddt ;don't get DDT for any TTY's + +go: .close 1, ;if we're loaded by system, CH1 is open + move sp,[-pdllen,,pdl] ;initialize pdl + call ginit1 ;do early initialization + +ife $$pand,jrst goddt5 ; lost somehow, bad....try to get DDT +ifn $$pand,.lose +ife $$pand,[ + move t,ttycom ;check out the TTYCOM status + jumpl t,comchk ;it's in com link, don't do the default + ;stuff + skipe noddt ; special debugging crock? + jrst ttyhak ; yes, be sure to get PWORD + +;;; Ok, now we check out to see if it's a very important console. +;;; If it is, we be damned sure to get us DDT rather than risking lossage +;;; The less hair the better, I.e. what if there is a bug in a system call, +;;; Or GOD FORBID, in this program. + + eval tt,syscn + skipe b,consol ;is it machine console? + camn b,tt ; or system console? + jrst goddt5 ; Go load up a DDT + move x,ttytyp ;what type? + tlne x,%TTLCL ;is it a local TTY? + jrst goddt5 ; Go load up a DDT + +;;; Not a VIP terminal, go through regular checks. + + move x,ttytyp + skipn debug ; debugin? + trnn x,%tysty ;is it a STY? + jrst notsty + + syscal styget,[argi %jsnum(b) ? val tt] ;get info on this STY + loss + syscal open,[cnti .bii\10 ;open as foreign job + argi tlnc ;telnet channel + [sixbit /USR/] + argi %jsnum(tt) ;open the telser by job number + argi 0] ;0 JNAME means spec + loss + + syscal rfname,[argi tlnc ;is there a job open on this channel? + val t ; device + val x ; UNAME + val tt] ; JNAME + loss ; eh? + cain t,0 ;is the Device 0? + jrst goddt5 + tlz x,777700 ;clear out the TTY # part of nnTLNT + came x,[sixbit / TLNT/] ;is it really a telser? + jrst goddt5 + came tt,[sixbit /TELSER/] ;including JNAME? + jrst goddt5 ; nope + .access tlnc,[tsrloc] ; Where to get cruft from TELSER + move tt,[-1,,tsrtab] ; Transfer the first word + .iot tlnc,tt + move x,tsrtab ; Check it for validity + came x,[sixbit /TERMID/] ; Valid? + jrst ttyhak ; Funny TELSER?? + move tt,[-,,] + .iot tlnc,tt ; input the rest of the data from the TELSER + + call ginit2 ; Gotta get the local site! + + move a,lclsit ; Is this our local site? + skipn b,fhost + jrst ttyhak ; Huh? Shouldn't be possible + call netwrk"hstcmp ; If from local host, give PWORD + caia ; + jrst ttyhak ; so we can debug + + movei a,lucktb ; AOBJN ptr to LUCKTB of sites to let on + call pwsget ; Get it into our buffer, T gets AOBJN ptr +luckp: move a,fhost + move b,(t) + call netwrk"hstcmp + caia + jrst goddt5 ; Give him DDT + aobjn t,luckp ; no, try next one + jrst ttyhak ; continue, check if system console. + +notsty: call ginit2 ;perform rest of initialization + skipe noddt ;are we debugging? + jrst ttyhak ; yes, don't ever give DDT + move b,consol ; Console bit... + movei tt,1 ;one bit + setz t, + lshc t,(b) ;translate into bit for this TTY + tdnn tt,ddtty0 ; can we give him DDT for it? + tdne t,ddtty1 + jrst goddt5 ; yes, win, get him DDT +;;; now check for dialups, for sake of TELSIT + movei tt,1 ;one bit + setz t, + move x,[440700,,[asciz /DIALUP/]] + lshc t,(b) + move bp,[440700,,hstnam] + tdnn tt,dltty0 ;is this a dialup? + tdne t,dltty1 + copy x,bp ; yes, claim to be a dialup! + +];; end ife $$PAND + +ttyhak: call ginit2 ;perform rest of initialization + hlrz tt,runame ;get left half +ife $$pand,[ + caie tt,-1 ;is it logged in? + skipe debug ; and debugging? + caia ; debuggin, don't go + jrst goddt5 ; not debuging, just get him DDT. + move t,[move [nlitim*60.*60.]] ;Start countdown + .realt t, + jfcl +] +ifn $$pand,[ + call pwread ;read it + .logout 1, + move x,[sixbit /FOO/] + movem x,uname ;fake uname + call pwdmak + came t,spword + .logout 1, + setzm deathp ;note no errors + hlrz tt,runame ;check if we're logged in + cain tt,-1 ; not logged in? + .logout 1, + + call pwdmap ;map in the database + .close pwdc, ;don't need it anymore +] ; END IFN $$PAND + + ;don't let him screw himself + syscal cnsset,[argi tyic ? [-1] ? [-1] ? [-1] ? argi 0] + loss + + syscal sstatu,[val shutdn ;collect info from ITS for header + val sysdbg + val susrs + val parnxm + val time + val machin + val itsver] + loss + + aos susrs ;count ourself + + +ife $$pand,[ + tyo dspc,[^P] ;clear the screen + tyo dspc,["C] + call ksstat ;print out statistics + syscal open,[cnti .uai + argi dski + [sixbit /DSK/] + [sixbit /SYSTEM/] + [sixbit /MAIL/] + [sixbit /SYS/]] + jrst nsysm ;no system mail + call printf ;print the file + +nsysm: move x,ttytyp ;find out what kind of TTY we've got + trne x,%tysty\%tydil ;is it a network sty? or dialup? + jrst jrst rdloop ; yes, don't print local mail + +nnet: syscal open,[cnti .uai + argi dski + [sixbit /DSK/] + [sixbit /LOCAL/] + [sixbit /MAIL/] + [sixbit /SYS/]] + jrst nlocal ; no local mail + call printf +] ;; end ife $$PAND + +ifn $$pand,[ + tyo dspc,[^P] ;clear the screen + tyo dspc,["C] + type tyoc,/PANDA./ + 6type tyoc,[.fnam2] ; +] ;; end IFN $$PAND + + + +SUBTTL Read Loop + +nlocal:: +rdloop: +ifn $$PAND,[ + setzm nodate ; be sure commands don't see this preset + skipn rdxct ; some cleanup action needing to be done? + jrst rdlop1 + move a,rdxarg + move bp,rdxbp + xct rdxct ; run the cleanup handler + jfcl + setzm rdxct +rdlop1: +]; end of IFN $$PAND, + + call readin ; main read loop + jrst [cain ch,^D ; or a ^D quit? + type tyoc,/ ^D XXX? +/ + jrst rdloop] ; we've over rubbed out, or null operation + + +;; here is where we come if we successfully got a command + + setz count, ;no input any more + +;; Here is is where we come if we successfully get a command + + terpri + call kdspch ;yes, dispatch off of it. + jrst rdloop ;loop even though we failed + jrst rdloop ;We won, do it again + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; Here goes the input parser/rubout processor +;;;; +;;;; Theory of operation of the command reader. +;;;; This operates in a "Parse as you go" mode. +;;;; The format of the input lines is as follows: +;;;; +;;;; 1) The line starts out with :'s, spaces, and tabs. These are ignored. +;;;; Only :'s are echoed. +;;;; +;;;; 2) Next is the command name, which is read as a single word of sixbit. +;;;; It is stored in the location COMAND when read +;;;; +;;;; 3) The command name is terminated with [SPACE], CR, ^K or [ALTMODE] +;;;; +;;;; If terminated with [ALTMODE], COMAND is taken to be a UNAME to log in +;;;; as, and it is fed to the ULOGIN routine to watch for U or U. If +;;;; these are not given, it is an error. +;;;; +;;;; If CR or ^K is given, the command line is complete, and the successful +;;;; return is taken. (If it is over-rubbed out, the failure return is +;;;; taken.) +;;;; +;;;; If [SPACE] terminates the command name, the command is looked up. +;;;; If it doesn't exist, It goes into a BEEP loop waiting for him to rubout +;;;; the faulty command. If it does exist, the space is echoed, and the +;;;; command-name reader checks the commands flag bits to see who should +;;;; be called next. +;;;; If %COARG is present, it calls the 6bit argument reader, which is then +;;;; resposible for checking the %COCRG and %COJCL bits to decide who +;;;; to call after that. More on the 6bit argument reader (R6ARG) in a bit. +;;;; If %COARG is absent, and %COCRG is present, it calls the the control- +;;;; argument reader, which reads control-arguments. These are members of +;;;; an explicit set of possible arguments stored in the CARGHS table +;;;; The control-argument reader (RCARG) will either return successfully +;;;; with the offsets of the control-argument strings in the control +;;;; arg buffer (CARGB) +;;;; If %COCRG is absent as well, but %COJCL is present, it will call the +;;;; JCL reader. This simply reads in the characters until a ^C, ^_, or ^M +;;;; is encountered, and sets up the pointers to this string (in msgbuf) +;;;; in the reader data area +;;;; If none of %COJCL, %COCRG or %COARG is present, it +;;;; simply returns successful, since the command is one that ignores it's +;;;; arguments. +;;;; +;;;; 5) R6ARG is responsible for reading a 6bit argument, for commands such +;;;; as SEND and HELP. It does so in a manner very similar to the +;;;; command reader which calls it, but stores the result in ARGUMENT +;;;; and doesn't hack [ALTMODE]. +;;;; R6ARG checks the command's flags that it is reading for, when it +;;;; is done, if terminated with other than line terminators, and if it has +;;;; %COCRG, it calls the command reader. If not, if it has %COJCL, it +;;;; calls the JCL reader, otherwise it returns successfully. +;;;; +;;;; 6) RCARG is responsible for reading control-arguments. This is for +;;;; dual purpose of allowing the HELP or ? keys to print which arguments +;;;; are available for a given command, and to pre-parse the input line +;;;; so that individual commands don't have to do any parsing of their input +;;;; It will not accept illegal control-arguments. +;;;; It does not call further parsers, but returns successfully in all +;;;; cases except over rubout. +;;;; +;;;; 7) RJCL is the routine which reads random JCL, such as that passed to +;;;; other programs or the SEND command. This does no parsing, but +;;;; simply saves the pointer into the input buffer when it is called, and +;;;; the count before and after, and returns successfully when an line +;;;; termination character is encountered, or unsuccessfully on over-rubout. +;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; How the rubout processing works. +;;;; +;;;; The rubout processing works quite simply: +;;;; Each reader is responsible for being able to rub out within its region. +;;;; If it calls another reader after it is done, it must be a returnable +;;;; call, which can either be successful, in which case, it may return +;;;; successfully as well, or unsuccessful, in which case it should wipe out +;;;; the character which terminated it's reading, and revert to reading (or +;;;; possibly rubing out instead). +;;;; +;;;; The routine WIPECH is the routine which handles erasing the characters +;;;; from the screen. It expects the character which would appear on the +;;;; screen to be rubbed out to be in CH. If it is a printing terminal, it +;;;; will do EMACS style rubouts, where it backspace-/-backspace's each +;;;; character character, seting LFFLAG. Each routine which echo's characters +;;;; should do so with the macro ECHO, which will do the LF when needed. +;;;; + +.upure +rstate: %rsnul ; Reader State +ostate: %rsnul ; Previous reader state (no stack needed) +comand: 0 ; Command being hacked +altifx: 0 ; Infix in Altmode commands (FOO<0U) +argcnt: 0 ; Number of characters of argument +argptr: 0 ; Byte Pointer to argument +snacnt: 0 ; Number of characters of 'To:' line +snaptr: 0 ; Pointer to To: line +posloc: ; (save as COLLOC) where we entered %RSPOS +colloc: 0 ; Where on command line we entered %RSCOL +cmdloc: 0 ; Where on command line we entered %RSCMD +argloc: 0 ; Where on command line we entered %RSCOL +ps1loc: 0 ; Where on command line we entered %RSPS1 +6cnt: 0 ; Number of characters 6bit reader read +arg6: 0 ; Prefix frobs put their arg here +linbeg: 0 ; Where line begins for rubbing out. + + +sndrds: 0 ; We've redisplayed the :SEND line +.pure + +%RS==:400000,,-1 ; Typeout mask for %RS symbols + +.foo==0 +IRPW X,,[ + %RSNUL ; Empty + %RSCOL ; Initial colons and spaces + %RSCMD ; Reading 6bit command name + %RSPOS ; Reading 6bit for postfix command + %RSPS1 ; 1 Altmode of postfix command + %RSPS2 ; 2 Altmodes of postfix command + %RSALT ; Altmode at beginning of line + %RSAL2 ; Second Altmode at beginning of line + %RSARG ; Reading arguments to a command + %RSFIL ; Reading filenames for a file, hack ALT + %RSSND ; Reading text for a :SEND + %RSSNA ; Reading addressee's for a :SEND + %RSTXT ; Reading text ended with ^C + %RSBAD ; Illegal gubbish on the line + %RS6BT ; Reading a word of 6bit + ] +IRPS y,,[x] + Y==.foo +TERMIN + .foo==.foo+1 +TERMIN + +define TRANSITION state + jrst [movei x,%RS!state ? jrst newstate] +termin + + +;; STATE TRANSITION TABLE (reading forward) +;; +;; +--------+ : +--------+ 6bit +--------+ +--------+ +;; | %RSNUL |--->| %RSCOL |----->| %RSCMD |--->| %RSARG | +;; +--------+ +--------+ +--------+ +--------+ +;; | | +....................^ | | +;; | +----|------+ | +----------+ +;; V ....+ V V V +;; +--------+ +--------+ +--------+ +--------+ +;; | %RSPOS | | %RSALT |---+ | %RSFIL | | %RSSNA | +;; +--------+ +--------+ | +--------+ +--------+ +;; | +-------+ | +;; V V V +;; +--------+ +--------+ +--------+ +--------+ +;; | %RSPS1 |--->| %RSPS2 | | %RSAL2 | | %RSSND | +;; +--------+ +--------+ +--------+ +--------+ +;; +;; +--------+ +;; | %RS6BT | +;; +--------+ + +rdinit: movem bp,linbeg + setzb ct,count + setzm sndrds ; Say we haven't redisplayed :SEND buffer + setzm argcnt + setzm argloc + setzm snacnt + setzm arg6 + ret + +read6: save [a,c] + call rdinit + setz count, + move a,[440600,,arg6] + movei x,%rs6bt + movem rstate + call read0 + jrst read6x +read6w: restore [c,a] + jrst popj1 + +read6x: restore [c,a] + ret + +readln: save [a,c] + call rdinit ; read a line + movem bp,argloc + call readl0 + jrst read6x + jrst read6w + +readl0: TRANSITION ARG + +readtx: move bp,[440700,,msgbuf] +readsn: save [a,c] + call rdinit ; Read multiple lines + movem bp,argloc + movem bp,argptr + call reads0 + jrst read6x + jrst read6w + +reads0: TRANSITION TXT + +readfi: move bp,[440700,,msgbuf] ; Read a filename + call rdinit + movem bp,argloc + movem bp,argptr + TRANSITION FIL + +readin: move bp,[440700,,msgbuf] + setzm helper ; Full command read has help built in + setzm dsprmp ; No special prompting +rdrset: call rdinit + movei x,%rsnul ; Initial EMPTY state + movem x,rstate + call prompt ; Prompt +read0: skipge ch,reread ; A character to be re-read? + .iot tyic,ch ; Get a chracter + setom reread + move t,rstate ; Get the state + cain ch,^L ; Redisplay? + jrst readrd ; Do it + cain ch,177 ; Rubout? + jrst readrb ; Do it + cain ch,%TXTOP+"H ; [HELP]? + jrst readhl + + echoch ; ECHO it + + cain ch,"? ; ?? + jrst readhl ; Give help caie ch,^D + + caie ch,^C + cain ch,^M + jrst readex + + caie ch,^D + cain ch,^G + jrst [ type tyoc,/ XXX? / + jrst readfl ] + move x,rstate + cain x,%RSPOS + jrst read1 + cain ch,^H ; Backspace instead of rubout? + jrst [ type dspc,/A;Use RUBOUT or DELETE to delete characters. +;BACKSPACE is for overstriking. +/ + jrst redis ] +read1: idpb ch,bp ; Store the byte + aos ct ; Count it + caile ct,msgbfl ; Overflow? + jrst [ type dspc,/A(Line too long)/ + jrst redis ] ; Redisplay it for him to rub out + +readc: jrst @.+1(t) + RDNUL ? RDCOL ? RDCMD ? RDPOS ? RDPS1 ? RDPS2 ? RDALT ? RDAL2 ? RDARG + RDFIL ? RDSND ? RDSNA ? RDTXT ? RDBAD ? RD6BT + +readex: move t,rstate + jrst @.+1(t) + RTNUL ? RTCOL ? RTCMD ? RTPOS ? RTPS1 ? RTPS2 ? RTALT ? RTAL2 ? RTARG + RTFIL ? RTSND ? RTSNA ? RTTXT ? RTBAD ? RT6BT + +readw1: skipn comand ; Win if there's anything there + jrst readfl + +readwn: setz ch, ; ensure ends with a null + push sp,bp + idpb ch,bp + pop sp,bp + setom reread + jrst popj1 +readw0: push p,bp + setz x, + idpb x,bp + pop p,bp + jrst readwn + +RTBAD: move x,ostate ; What state went bad? + cain x,%rscmd ; Command reading? + jrst rtbadc ; Barf about unknown command + type dspc,/AI don't understand that. +/ + jrst readfl + +rtbadc: type dspc,/AI don't know the '/ + 6type tyoc,comand + type tyoc,/' command. +/ + jrst readfl + +RTNUL: +RTCOL: +readfl: setom reread + ret + +readrb: ldb ch,bp ; Get the character to be eliminated + call wipech ; Wipe it from the screen + decbp bp ; Back up the pointer + soja ct,@.+1(t) + RBNUL ? RBCOL ? RBCMD ? RBPOS ? RBPS1 ? RBPS2 ? RBALT ? RBAL2 ? RBARG + RBFIL ? RBSND ? RBSNA ? RBTXT ? RBBAD ? RB6BT + +readhl: jrst @.+1(t) + RHNUL ? RHCOL ? RHCMD ? RHPOS ? RHPS1 ? RHPS2 ? RHALT ? RBAL2 ? RHARG + RHFIL ? RHSND ? RHSNA ? RHTXT ? RHBAD ? RL6BT + +readh0: skipe helper ; Have we got a special helper? + xct helper ; Provide the help + jrst redis ; and redisplay + +readrd: move t,rstate + jrst @.+1(t) + RLNUL ? RLCOL ? RLCMD ? RLPOS ? RLPS1 ? RLPS2 ? RLALT ? RLAL2 ? RLARG + RLFIL ? RLSND ? RLSNA ? RLTXT ? RLBAD ? RL6BT + +newstate: + movem x,rstate + jrst read0 + +RDNUL: cain ch,40 + jrst read0 ; Spaces we ignore + cain ch,^M ; Return + jrst readex + cain ch,^R ; A control-R to print a file + jrst read.r ; Go do it now. + cain ch,^F + jrst read.f + movem ct,colloc + cain ch,": + TRANSITION COL + caie ch,%txtop+"H ; If he's asking for help, give it to him + cain ch,"? + jrst [call bhelp ? jrst read0] + movem ct,posloc + cain ch,33 ; Altmode? + TRANSITION ALT + caie ch,". + cain ch,"% + jrst begpos + caie ch,"! + cain ch,"/ + jrst begpos + + cail ch,"0 + caile ch,"9 + caia + jrst begpos + cail ch,"a + caile ch,"z + caia + jrst begpos + cail ch,"A + caile ch,"Z + caia + jrst begpos + jrst gobad ; Go into BAD state + +read.r: move x,[sixbit /UPRINT/] ; Prepare to read ^R-style + movem x,comand + movei x,[asciz /A(Print File)/] + movem x,filprm ; Set up prompt for printing a file + setz x ; Use the normal default. + call flprmp ; Prompt with the filename default + movem ct,argloc ; Remember where the filename begins + movem bp,argptr + TRANSITION FIL ; Start reading the filename + +rdflal: move x,[asciz /A(Print File)/] + movem x,filprm + setz x + call flprmp + move bp,[440700,,msgbuf] + call rdinit + jrst read0 + +read.f: move x,[sixbit /ULISTF/] + movem x,comand + setzm arg6 + jrst readwn + +begpc: move a,[440600,,comand] + setzm comand ; Initialize it to blanks + cail ch,140 + subi ch,40 + subi ch,40 + idpb ch,a ; and deposit + movei count,1 ; 1 character + ret + +begcmd: call begpc + TRANSITION CMD ; We're now in %RSCMD state + +begpos: call begpc + TRANSITION POS + +RBNUL: jrst rdrset ; Ignore rubouts here + +RHCOL: call bhelp + jrst redis + +RHNUL: call bhelp ; Tell what commands exist + jrst rdrset ; Flush blanks, etc, and reprompt + +RLNUL: type dspc,/C/ + jrst rdrset ; Show an empty line + +RHBAD: type dspc,/ARandom garbage on the command line, delete / + 10type tyoc,count + type tyoc,/ character(s) to correct. +/ + jrst redis + +RBBAD: sojg count,read0 ; Still bad ... + move x,ostate ; Enough rubouts to fix up + movem x,rstate ; so return to previous state + jrst read0 + +gobad: movei count,1 ; Number of bad characters + move x,rstate ; Remember what state we came from + movem x,ostate + TRANSITION BAD + +RDBAD: aoja count,read0 ; More badness + +RLCOL: +RLFIL: +RLARG: +RL6BT: +RLCMD: +RLPS2: +RLPS1: +RLALT: +RLAL2: +RLPOS: +RLBAD: jrst credis + +RDCOL: caie ch,": ; Colon? + caig ch,40 ; non-printing character? + caia + jrst begcmd + jrst read0 ; Just ignore them after 1st colon + +RBCOL: camge ct,colloc ; Anything left in buffer? + TRANSITION NUL + jrst read0 + +RDPOS: cain ch,^A ; Single-character commands + jrst readxm ; PRMAIL + cain ch,^F + jrst readxf ; LISTF + caie ch,^H + cain ch,^K + jrst readw1 + + setzm altifx ; An infix arg to $U? + cain ch,33 ; Altmode? + TRANSITION PS1 + + call rd6 ; Do the work for reading in 6bit + caia + jrst read0 +ife $$PAND,[ +rtpos1: + type dspc,/A(You must begin commands with a colon) +/ + jrst readfl + +] ; END of IFE $$PAND, +.else [ + jrst rtcmd0 +] ; End of IFN $$PAND, (.else) + +readxm: move x,comand + movem x,arg6 + move x,[sixbit /PRMAIL/] + movem x,comand + jrst readwn + +readxf: move x,comand + movem x,arg6 + move x,[sixbit /ULISTF/] + movem x,comand + jrst readwn + +RTPOS: skipn comand ; Anything there? + jrst readfl ; Nope, just return failure +ife $$PANDA,[ + jrst rtpos1 ; Yes, complain about no colon +] ; END of IFE $$PANDA, +.else [ + jrst readwn ; We got a command + ] + +RBPOS: sojge count,rbcmd0 ; If there's anything left, back up one + TRANSITION NUL ; Nothing left + +RDPS1: cain ch,33 ; Altmode? + TRANSITION PS2 ; Yes, it's two altmodes + cail ch,"0 + caile ch,"9 + jrst rdps10 + movem ch,altifx + jrst read0 +rdps10: cain ch,^A ; FOO + jrst rdps11 + caie ch,"u + cain ch,"U + caia + jrst gobad ; Lossage, go into BAD state + move x,comand + movem x,arg6 + move x,[sixbit /ULOGIN/] + movem x,comand + jrst readwn + +rdps11: move x,comand + movem x,arg6 + move x,[sixbit /UPRMAIL/] + movem x,comand + jrst readwn + +RTPS1: move x,comand ; Assume he meant to say 'U' + movem x,arg6 + move x,[sixbit /ULOGIN/] + movem x,comand + jrst readwn + +RBPS1: camge ct,ps1loc ; Have we rubbed out all of this state? + TRANSITION POS ; Yes, previous state + setzm altifx ; No more infix then + jrst read0 + +RDPS2: cail ch,"0 + caile ch,"9 + jrst rdps20 + movem ch,altifx + jrst read0 +rdps20: caie ch,^A + jrst rdalt0 ; Complain if not ^A + move x,comand + movem x,arg6 + move x,[sixbit /PRRMAI/] + movem x,comand + jrst readwn + +RBPS2: TRANSITION PS1 + +RHPOS: type dspc,/Acommand <==> :command +/ +RHPS1: type dspc,/AnameU <==> :LOGIN name +name <==> :PRMAIL name +/ +RHPS2: type dspc,/Aname <==> :PRRMAIL name +/ + +RDALT: setzm arg6 + cain ch,^A ; ^A? + jrst [move x,[sixbit /UPRMAI/] ? movem x,comand ? jrst readwn] + cain ch,33 + TRANSITION AL2 +rdalt0: type dspc,/AHuh? I don't understand that! +/ + jrst readfl + +RBALT: TRANSITION NUL + + +RDAL2: caie ch,"v + cain ch,"V ; V? + jrst rdal20 + caie ch,"u + cain ch,"U + jrst rdal21 + cain ch,^A ; ^A? + jrst [ move x,[sixbit /PRRMAI/] + movem x,comand + jrst readwn ] + cail ch,"0 ; Numeric infix? + caile ch,"9 + jrst rdalt0 ; nope, gubbish + movem ch,altifx + jrst read0 + +rdal20: move x,[sixbit /LISTJ/] + movem x,comand + jrst readwn + +rdal21: move x,[sixbit /ULOGOU/] + movem x,comand + jrst readwn + + +RTPS2: +RTALT: +RTAL2: type dspc,/AHuh? I don't understand that. +/ + jrst readfl + +RBAL2: TRANSITION ALT ; Previous state + +RHALT: +RHAL2: type dspc,/A +$U -- :LOGOUT (Prepare to disconnect from ITS.) +V -- :LISTJ (List what jobs you have. Not applicable until logged in.) +/ + jrst redis + +RD6BT: call rd6 ; Read in the 6bit + jrst readwn ; Read won + jrst read0 ; More to come + +RDCMD: call rd6 ; Read in the 6bit + jrst rtcmd0 ; Terminate it + jrst read0 ; More to come + +rd6: caie ch,^I + cain ch,40 + ret ; Ended + cail count,6 ; Is there any more room in the word? + aoja count,popj1 ; No, just count it + cail ch,140 + subi ch,40 + subi ch,40 + idpb ch,a ; Deposit the character + aoja count,popj1 + +rtcmdx: cail count,6 ; any blanks in the word? + ret ; If not, just return + move x,6blk(count) ; Else gotta clear them out + andcam x,comand + ret + +6blk: 777777,,777777 + 007777,,777777 + 000077,,777777 + 000000,,777777 + 000000,,007777 + 000000,,000077 + +RT6BT: call rt6btx ; Pad with blanks + skipn arg6 + jrst readfl + jrst readwn + +rt6btx: cail count,6 ; any blanks in the word? + ret ; If not, just return + move x,6blk(count) ; Else gotta clear them out + andcam x,arg6 + ret + + +RTCMD: call rtcmdx ; pad with blanks + skipn comand ; Anything left of the command? + jrst readfl ; No, a failure + jrst readwn ; Yes, success + +rtcmd0: movem count,6cnt ; Remember in case we rub back here + move tt,comand ; Get the command involved + call ttkget ; Get ptr to it + jrst gobad ; Undefined, it's bad + movem bp,argptr ; Save pointer to where command's args begin + setzm argcnt + move x,cm$flg(t) ; Get the flag bits + tlne x,%COFIL + transition FIL + tlnn x,%COSND + transition ARG + movem bp,snaptr ; Remember where name begins + setzm snacnt + transition SNA + +RH6BT: xct helper + jrst read0 + +RHCMD: cail ct,6 ; If we have too few characters + jrst rhcmd0 + move x,6blk(ct) ; We must mask off the unfilled part of + andcam x,comand ; the command name +rhcmd0: move tt,comand ; Get the command + call ttkget ; Get the index to it's info + jrst rhcmd1 ; No command, foo + push sp,comand + call pldoc ; print the documentation for this command + pop sp,nul + jrst read0 ; Onward + +rhcmd1: call bhelp ; Tell him what he has to choose from + jrst redis ; show what he's got + +RB6BT: sojl count,readfl ; Fail if we over-rubout + call rt6btx ; Pad arg with blanks + caige count,6 ; If we're over, we're OK + move a,6bp(count) ; Get the new byte pointer + hrri a,arg6 ; We're putting 6bit in ARG6, not COMAND + jrst read0 ; So now we're backed up + +RBCMD: sojl count,rbcmd1 ; uncount it +rbcmd0: call rtcmdx ; Pad command with blanks + caige count,6 ; If we're over, we're OK + move a,6bp(count) ; Get the new byte pointer + jrst read0 ; so now we're backed up. + +rbcmd1: TRANSITION COL + +6bp: 440600,,comand + 360600,,comand + 300600,,comand + 220600,,comand + 140600,,comand + 060600,,comand + +RTTXT: +RTSND: cain ch,^C + jrst readw0 + movei ch,^M + idpb ch,bp + movei ch,^J + idpb ch,bp + movei x,2 + addm x,ct + addm x,argcnt + jrst read0 + +RTSNA: movem bp,argptr + setzm argcnt + TRANSITION SND + +RTARG: +RTFIL: setz ch, ; Ensure that it ends with a NUL + idpb ch,bp ; For the sake of RFN + jrst readwn + +RDSNA: caie ch,40 ; Whitespace + cain ch,^I + jrst rtsna ; Go on to SND state + aos snacnt ; Count this character + jrst read0 ; Loop + +RDTXT: +RDSND: cain ch,^W + jrst rdsndw + cain ch,^U + jrst rdsndu + cain ch,^R + jrst rdsndr + cain ch,^K + jrst rlsnd0 + +RDARG: aos argcnt ; Count the argument + jrst read0 + + +snddis: move x,argptr ; The line for rediplay begins with the text + movem x,linbeg + move ct,argcnt + call sndhdr ; Print the :SEND header + setom sndrds ; say we've reformated it + pjrst redsj ; Redisplay our stuff + +rdsndw: call wipech ; Wipe the ^W from the screen + decbp bp ; Back up the pointer + sos ct ; over the ^W + skipn sndrds ; Have we reformated the SEND buffer? + call snddis + move c,argcnt ; Count of characters originally in buffer + move d,bp + call rdsnup ; Maybe move up to previous line + jrst rdsnw1 + +rdsnw0: decbp bp ; We've decided to delete it +rdsnw1: jumple c,rdsnx ; Update the screen and return if empty + ldb ch,bp ; Check out this character + cain ch,^J ; Linefeed? + call lfnlck ; Yes, see if part of a newline (CRLF) + jrst rdsnw2 ; No, just treat as control char + call rubnl ; Newline, flush it + soja c,rdsnw0 ; and keep looking for the word +rdsnw2: call alphap ; Special character? + soja c,rdsnw0 ; Yes, skip it + + decbp bp ; We've decided to delete this + sojle c,rdsnx ; Update the screen and return if empty +rdsnw3: ldb ch,bp ; Check out this character + call alphap ; Special character? + jrst rdsnx ; Yes, that delimits the word + decbp bp ; Be sure to delete this one too. + sojg c,rdsnw3 ; Part of the word, flush it + jrst rdsnx ; Start of word, update display + +rdsndu: call wipech ; Remove the ^U from the screen + decbp bp ; Back over the ^U + sos ct + skipn sndrds ; Have we reformated the SEND buffer? + call snddis + move c,argcnt ; Count of characters originally in buffer + move d,bp + ; Let's back over the first character + jumpe c,rdsnx ; if at beginning of line, will go to + ; previous line + call rdsnup ; Maybe move up a line + jrst rdsnu1 ; hack all this + +rdsnu0: decbp bp + sos c + ldb ch,bp ; Check out this character +rdsnu1: cain ch,^J ; Linefeed? + call lfnlck ; Yes, see if part of a newline (CRLF) + caia + jrst rdsnx ; Don't back over it, redisplay + jumpg c,rdsnu0 ; Update the screen and return if empty + jrst rdsnx ; Empty, update screen + +rdsnup: ldb ch,bp +rdsup1: caie ch,^J ; Is it a linefeed? + ret ; No, this isn't a line begin + call lfnlck ; Is this part of a newline (CRLF)? + ret ; No, just hack as bare ^J + decbp bp ; Move over the ^M as well + sos c + sos ct + move x,ttyopt + tlnn x,%tomvu ; Can we move up? + jrst rdsnrl ; No, just redisplay previous line + tlne x,%toovr ; no-overstrike (a way to erase) + tlnn x,%toers ; Otherwise erasible? + caia ; yes + jrst rdsnrl ; no, don't confusingly move up + type dspc,/U/ + save [x,t,a,b] + move t,bp ; copy some data temporarily + move b,c + call findnl ; Find out the beginning of this line + call rdsnxa ; Find out where on this line we are + type dspc,/H/ ; let's position ourself on this line + movei ch,10(a) + tyo dspc,ch + restore [b,a,t,x] + ret + +rdsndr: decbp bp ; Back over the ^U + sos ct + skipn sndrds ; Have we reformated the SEND buffer? + call snddis + call rdsnrl ; Redisplay the line + jrst read0 + +rdsnrl: save [x,t,b] + move b,argcnt ; Count of characters originally in buffer + move t,bp + call findnl ; Find the beginning of the line + caml b,argcnt ; Did we back up at all? + jrst rdsnrx ; Nope, don't do anything + move x,ttyopt + tlne x,%toovr ; Can't over-strike? Can erase that way! + tlne x,%TOERS ; Skip if can't erase + jrst rdsnrd ; Aha, we can do it nicely + type tyoc,/ +/ ; Nope, just start a new line + caia +rdsnrd: type dspc,/HL/ ; Display, we can clear this line +rdsnr0: caml b,argcnt ; Are we back to where we began? + jrst rdsnrx ; Yep, all done + ildb ch,t ; Pick up a character + echoch ; Echo it + aoja b,rdsnr0 ; next character + +rdsnrx: restore [b,t,x] + ret + +; In C is the count of characters in the edited argument. +; In ARGCNT is original count. It will be updated to the new count +; In BP is the Byte pointer to the remaining argument +; In D is the old byte pointer +; Update the display and go to READ0 + +rdsnx: caml c,argcnt ; Do we have anything to do? + jrst read0 ; No change, do nothing + save [t,ch,b] + move t,bp ; Copy of the BP + move b,c ; Copy of the count + call findnl ; Find the beginning of this line + call rdsnxa ; Get in A the # of character positions + ; now on the line + save [a,c] + move c,argcnt ; Now we get to find out how character + move t,argptr + call rdsnxa ; positions were rubbed out + move b,a ; B gets count + restore [c,a] ; A recovers hpos + movem c,argcnt ; We don't need the old count anymore + move x,ttyopt + tlne x,%toovr ; Can't over-strike? Can erase that way! + tlne x,%TOERS ; Skip if can't erase + jrst rdsnxd ; Aha, we can do it nicely + cail a,20. ; If we're close to left we can always + jrst rdsnx0 + tlnn x,%tomvb ; back up, even if our TTY won't backspace + jrst rdsnxl ; Otherwise, we're a loser + +rdsnx0: type dspc,/H/ ; Win, let's do it with slashes + movei x,10(a) ; Compute character to indicate our position + tyo dspc,x ; output it + + sosl b + tyo tyoc,["/] ; Output a slash, b types + sojge b,.-1 + type dspc,/H/ + movei x,10(a) + tyo dspc,x + setom lfflag + restore [b,ch,t] + move ct,argcnt + jrst read0 + +rdsnxd: restore [b,ch,t] + type dspc,/H/ + movei x,10(a) + tyo dspc,x + type dspc,/L/ +rdsnxx: move ct,argcnt + jrst read0 + +rdsnxl: restore [b,ch,t] + sojl b,rdsnxx ; When no more characters left, done + ldb ch,d ; Get first character rubbed out + tyo tyoc,ch ; Type it + decbp d ; Back up the byte pointer + jrst rdsnxl ; loop until sick of it + +;; FINDNL takes a Byte Pointer in T, a count in B, and sets them to point +;; to the last NL or the beginning of the buffer. + + +findnl: jumpe b,cpopj +fndnl0: ldb ch,t + cain ch,^J ; Looking for a linefeed + ret + decbp t ; Back up pointer + sojg b,fndnl0 ; or the beginning of the buffer + ret + +; Get the current horizontal position in A +; C has the count to end at, T has the Byte Pointer to follow. + +rdsnxa: setz a, ; A counts the character positions + caml b,c ; Already to the end? + ret +rdsxa0: ildb ch,t ; Check out a character + cain ch,^I ; TAB? + jrst rdsnxI ; Special case + caie ch,177 ; Rubout? + caige ch,40 ; Control? + aos a ; count the uparrow + aos a ; Count it + aos b +rdsxa1: came b,c ; Is this all? + jrst rdsxa0 ; Nope, keep counting + ret + +rdsnxI: addi a,7 ; Go to next tab stop + andi a,-10 ; but no further + aoja b,rdsxa1 ; Return to the loop + +alphap: caige ch,"A ; Special character? + caig ch,"9 + caia + ret + caige ch,"0 ; Special character? + ret + jrst popj1 + + +;Check to see if a LF is part of a CRLF pair. Skip if so. +lfnlck: caig c,1 ; Is this the last character? + ret ; Yes, it's not part of CRLF + push sp,x + move x,bp + decbp x + ldb x,x + cain x,^M ; A ^M to match it? + aos -1(sp) + pop sp,x + ret + +;Handle backing over a newline. +rubnl: move x,ttyopt ; Get TTY characteristics + tlnn x,%tomvu ; Can it move up? + jrst rubnl1 ; No, do something else +rubnl0: type dspc,/H/ ; Go to beginning of this line + call findnl + ret ; Return + +rubnl1: tlne x,%toovr ; Can't over-strike? Can erase that way! + tlne x,%TOERS ; Skip if can't erase + caia ; Aha, we can do it nicely + jrst rubnl0 ; Boo, can't do it + +rlsnd0: type dspc,/A/ + decbp bp ; Back over the ^K + sos ct + jrst rlsnd1 + + +RLTXT: type dspc,/C/ + setom sndrds + jrst rlsnd2 + +RLSND: type dspc,/C/ +rlsnd1: setom sndrds + call sndhdr ; Print the header +rlsnd2: move x,argptr ; Say things begin with the argument + movem x,linbeg + move ct,argcnt +RLSNA: jrst redis + +sndtyp: -11,,snddsc ; Header and message +sndltp: -10,,snddsc ; Just header + +snddsc: 440700,,[asciz /[Message from /] + tp$6bt runame + 440700,,[asciz / at MIT-/] + tp$6bt machin + 440700,,[asciz / /] + tp$6bt a + tp$ind (b)[ 440700,,[asciz /am/] + 440700,,[asciz /pm/] ] + 440700,,[asciz /] +/] + tp$ind argptr + +sndhdr: move x,rstate + caie x,%rssnd ; Is this really sending? + ret ; nope, don't print SEND header! + terpri + call sndtim + typout tyoc,sndltp + ret + +sndtim: .rtime tt, ; Get 0 ? HHMMSS + and tt,[-10000] ; Get 0 ? HHMM__ + setz t, + lshc t,14 ; Get HH ? MM____ + setz b, ; flags pm instead of am + cail t,(sixbit / 12/) ; Is it 12:00-23:59? + aos b ; yes, it's PM + caile t,(sixbit / 12/) ; Is it 24hour time? + jrst [subi t,100 ; Convert it. Subtract the 10 + ldb x,[000600,,t] ; Get the second digit + caige x,'2 ; Is it less than 2? + subi t,000070 ; Must perform a borrow type operation + cail x,'2 ; Otherwise + subi t,2 ; Can just decrement by 2 + jrst .+1] + lsh t,6 ; Get HH0 ? MM____ + iori t,(sixbit / :/) ; Get HH: ? MM____ + lshc t,-14 ; Get H ? H:MM__ + caie t,(sixbit / 0/) ; Leading zero? + lshc t,-6 ; No, include it + move a,tt ; Because TYPOUT can't hack TT + ret + +RDFIL: aos argcnt ; Count the argument + caie ch,33 + jrst read0 + setz ch, ; Let's make this an ASCIZ string + dpb ch,bp ; replacing the altmode with a NUL + + move d,bp ;pointer to the file-name + movei b,filnam ;pointer to filename block + call rfn"rfn ;read the names + + movei x,[asciz /(Print File)/] + movem x,filprm + movei x,filnam + call flprmp ; Reprompt with our new info + setz argcnt + move bp,argptr ; Re-initialize our reader to be just after + move ct,argloc ; where we began + jrst read0 ; and read in the filename. + +RBSNA: move count,6cnt ; In case we rub back into the command + sosge snacnt ; uncount this character + TRANSITION CMD ; Underflow + jrst read0 + +RBTXT: +RBSND: sosge c,argcnt ; uncount this char + transition SNA ; underflow + jumpe c,read0 ; Anything left? + call rdsup1 + movem c,argcnt ; Update the new argument count + jrst read0 + +RBFIL: +RBARG: move count,6cnt ; In case we rub back into the command + skipg argcnt ; Nothing left? + transition CMD ; underflow + sos argcnt ; uncount this char + jrst read0 + +RHARG: move tt,comand + call ttkget + error /TTKGET didn't find command, but we're in RHARG??/ + push sp,comand + call pldoc ; Give him the documentation + pop sp,nul + jrst redis ; Redisplay + + +RHFIL: cain ch,"? ; Is it a ? + jrst read1 ; ? is legal in filenames + type dspc,/AReading an ITS filename. ITS filenames have +4 components, specified as follows: + +dev: dir; fn1 fn2 + +the device name ('dev') is followed by a colon. If omitted, the most recently +referenced device is used, or DSK: (the main disks) is assumed. The directory +name is followed by a semicolon. If omitted, the most recently referenced +directory is used, or your home directory is assumed. The two filenames (fn1 +and fn2) are separated by a space. The character '>' has the special meaning +of 'greatest numerical name'. This is generally used as a second filename. +It's behaviour is difficult to predict if no files with the specified first +name have numerical second filenames. However, if there is only one file with +a given first filename, say FOO BAR, it will find that file. + +All filenames are in 'sixbit', i.e. 1-6 characters long, using 0-9, A-Z, +and the following special characters: '";:-_+=<>,.%^&$#@!*()[] +Many of those special characters must be quoted by proceeding them with a +control-Q character, however. +/ + jrst readh0 + +RHTXT: cain ch,"? ; ? is ok character of text + jrst read1 + type dspc,/C/ + jrst rhsnd0 + +RHSND: cain ch,"? ; ? is ok character of text + jrst read1 +RHSNA: type dspc,/CType ":SEND ^C". Within +the message, these characters have the following meanings: + +/ +rhsnd0: type dspc,/A + rubout deletes backwards + ^C Send message + ^D Quit + ^G Quit!! + ^L Redisplay message + ^R Redisplay line + ^U Kill current line + ^W Kill Word + [HELP] Prints documentation. This is Top-H on TV's and ^_H on non-TV's + +All other characters are self-inserting. +/ + jrst readh0 + + +pchar1: aos count ;both ways +pchar: idpb ch,bp ;save the character + aos ct ;count it + cail ct,msgbfl ; overflow? + jrst [type dspc,/AInput buffer overflow +/ + setz ch, ; simulate a quit + ret] + echoch ;echo it so he can see what t'fuck he's doin + jrst popj1 ;successful! + +uchar1: sos count ;back up local count as well +uchar: ldb ch,bp ;get the character we're rubbing out + call 1wipe ;wipe it off the screen + sos ct ;uncount it. + decbp bp ;and back it up + ret + +credsj: type dspc,/C/ +redsj: setzm lfflag + jumpe ct,cpopj + save [x,t] + move t,linbeg + move x,ct +redis0: ildb ch,t + cain ch,^M ; Is this maybe CRLF? + jrst redism + echoch +redis1: sojg x,redis0 + restore [t,x] + ret + +redism: caig x,1 ; Is there another chracter? + jrst redsm0 ; no, just a bare ^M + move ch,t + ildb ch,ch ; Is the next character ^J? + caie ch,^J + jrst redsm0 ; No, just do ^M bit + type tyoc,/ +/ ; Yes, output a newline + ibp t ; Skip the ^J then + soja x,redis1 + +redsm0: call echosl ; Echo ^M, with ^ or + jrst redis1 ; Loop + +credis: type dspc,/C/ + call credsj + jrst read0 + +redis: call redsj + jrst read0 + +r6arg: save [count,ch,a,ct,x] + skipn ct,argcnt + jrst r6arg1 + setzb count,x + setzm arg6 + move a,[440600,,arg6] +r6arg0: ildb ch,argptr ; Take away one character of the argument + sos argcnt + call rd6 ; Add it to our argument + jrst r6arg1 ; Whitespace! + sojg ct,r6arg0 ; loop + +r6arg1: restore [x,ct,a,ch,count] + ret + +rcarg: save [a,b,c,x,t,tt,bp,ct,ch] + move tt,comand + call ttkget ; in the table + error /RCARG got an unknown command./ + setzm crgbts ; No bits yet +rcarg1: skipg c,argcnt ; count of chars + jrst rcarwn ; If we didn't read anything, done + move b,argptr ; Ptr to start of it, temporary +rcare0: ildb ch,b ; Scan for leading whitespace + caie ch,^I ; whitespace? + cain ch,40 + caia + jrst rcare. ; nope, flush it. + movem b,argptr ; Whitespace, flush it + sosg c,argcnt + jrst rcarex ; If that's all, punt + jrst rcare0 ; look for more whitespace + +rcare.: move a,cm$opt(t) ; Get the options AOBJN + setz ct, ; Count how long this option is + move bp,argptr ; Ptr to start of it + move b,argptr ; Ptr to start of it +rcare1: jumpe c,rcarew + ildb ch,b ; Search for the end of it + sos c + caie ch,^I ; (whitespace marks the end) + cain ch,40 + caia + aoja ct,rcare1 ; Next character + +rcarew: movem c,argcnt ; Save our updated pointers + movem b,argptr +rcarec: call rcarck ; See if it matches this option + caia ; No match + jrst rcare2 ; Match! + aos a ; Skip the bit + aobjn a,rcarec ; and loop + + type dspc,/AUnknown option '/ +rcaree: syscal SIOT,[argi tyoc ? bp ? ct] + loss + type tyoc,/' +/ + jrst rcarex + +rcare2: setz c, ; C ==> -1 iff ambiguous + move b,a ; Remember the winning entry +rcare3: hlrz x,(a) ; Get the option length + camn x,ct ; Is it an exact match? + jrst rcare9 ; Yes, win + aos a ; Check the rest of the entries to see +rcare4: aobjp a,rcare8 ; if it's unambiguous. If so, win + call rcarck ; Does this one match too? + aoja a,rcare4 ; No match, next one + setom c ; Note that it's ambiguous + jrst rcare3 ; Check the rest and this for exact match + +rcare8: jumpe c,rcare9 ; If unambiguous, it's a win + type dspc,/AAmbiguous option '/ + jrst rcaree ; Go tell which one + +rcare9: move x,1(b) ; Get the bit + iorm x,crgbts ; Know that we have it + skiple argcnt ; Any remaining arguments? + jrst rcarg1 ; No, gobble down some more + +rcarwn: restore [ch,ct,bp,tt,t,x,c,b,a] ; The end, exit with success + jrst popj1 + +rcarex: restore [ch,ct,bp,tt,t,x,c,b,a] ; The end, exit with failure + ret + +; In CT -- Number of characters of supplied args +; In BP -- Byte pointer to supplied args +; In A -- AOBJN ptr to an [len,,address ? bit] for an option + +rcarck: save [bp,t,ct,x,c,ch] + move t,(a) ; Get an option + hlrz x,t ; Get it's length + hrli t,440700 ; Create a byte pointer +rcarc1: sojl ct,rcarcw ; End of supplied, matches! + sojl x,rcarcx ; We're longer, no match + ildb ch,t ; A character from the option + ildb c,bp ; A character from the supplied arg + cail ch,"a ; Uppercasify + caile ch,"z + caia + subi ch,40 + cail c,"a ; Uppercasify + caile c,"z + caia + subi c,40 + camn c,ch ; Are the characters the same? + jrst rcarc1 +rcarcx: restore [ch,c,x,ct,t,bp] + ret + +rcarcw: restore [ch,c,x,ct,t,bp] + jrst popj1 + +ukwarn: ife $$pand,[ + type dspc,/AThat command is not known to this program. +Maybe you should log in? Type :HELP for info. +/ +] ;; end IFE $$PAND +.else [ + type dspc,/AThat command is not known. +Type :HELP for info. +/ +] ;; end IFN $$PAND + ret + +prcmln==0 +define prcmd name,loc + sixbit /name/ ? loc +prcmln==prcmln+1 +termin + +prcmtb: prcmd PRRMAI,uprrmail + prcmd UPRMAI,uprmail +ife $$PAND, prcmd ULOGIN,ulogin + prcmd ULOGOU,ulogout + prcmd LISTJ,ulistj + prcmd ULISTF,ulistf + prcmd UPRINT,uprint + +kdspch: move tt,comand + move t,[-prcmln,,prcmtb] +kdspcl: camn tt,(t) ; Is this a prefix command? + jrst kdspc0 ; Yes, hack it + aos t + aobjn t,kdspcl ; Loop + + call ttkget ;get a pointer to the command + pjrst ukwarn ; tell him he lost, and return + + move tt,cm$flg(t) ;get it's flags + tlne tt,%COTOP ;is it a topic, rather than a command? + jrst [terpri + type tyoc,/That's a topic for HELP, not a command! +/ + ret] ;and return that we were not successful + call @cm$rtn(t) ;it's OK, go to it! + jrst popj1 ;and return our success in running it + jrst popj1 + +kdspc0: call @1(t) ; Invoke the function + jrst popj1 + jrst popj1 + +;; TTKGET takes a sixbit command in TT, and returns in T the index into CMDTAB +;; Skip returns unless the command is unknown (ie bad). + +ttkget: hrlzi t,-eqvlen ;T <- AOBJN ptr for equivilance tables +kget0: camn tt,eqvtab(t) ;is there an equivalence? + jrst [move tt,eqvtab+1(t) ;get the equiuvalent command + jrst kget2] ; and look it up + add t,[1,,1] ;skip the equivalence + aobjn t,kget0 ;try next one + +kget2: move t,[-cmdcnt,,cmdtab] ;t <- AOBJN ptr for command tables +kget3: camn tt,cm$nam(t) ;is it this entry? + jrst bdcmd ; we found it, skip if it is OK! + addi t,cm$len-1 ;Ignore the next entry. + aobjn t,kget3 ;Try the next one! + ret ;Not known, don't skip + +;; BDCMD takes in TT a sixbit command name, and skip-returns if it is OK. + +bdcmd: save [t] +IFE $$PAND,[ ;No commands are bad in PANDA! + call pwdmap ;Be sure we have the database mapped + save [a] ;Dont smash A. + movei a,nocmnd ;Let's check the table of bad commands + call pwsget ;Get the bad-commands table into TMPBUF. + move t,a ;T gets the count of bad commands. + restore [a] ;Done with A. +bdcmd1: camn tt,tmpbuf(t) ;If this is a bad command + jrst popjt ; Just return. + sojge t,bdcmd1 ;Loop for all bad commands. +];End of PWORD-only code. +popj1t: aos -1(p) ;Skip return. +popjt: restore [t] + ret + + + +;;; WIPECH takes one character in CH and wipes it off the screen. + +wipech: save [d] + movei d,1 ; Assume 1 character position + caie ch,177 ; is it a rubout + caige ch,40 ; or a control? + aos d ; then it takes two + + cain ch,33 ; is it an altmode? + sos d ; then it's an exception + + call wipe ; so let wipe do it's stuff +wipecx: restore [d] + ret + +;;; wipe away one character +1wipe: push sp,d + movei d,1 ;one position + pjrst wipe0 ;wipe it away! + +;;; WIPE takes an argument in D, which is the number of character positions to +;;; delete from the screen. + +wipe: push sp,d +wipe0: save [t,tt,b] + syscal rcpos,[argi tyoc ;get the cursor position + val a] + loss + hrrz t,a + movem t,hpos + hlrz tt,a + movem tt,vpos +wipe1: move b,ttyopt + tlne b,%toovr ;can't over-strike? Can erase that way! + tlne b,%TOERS ;skip if can't erase + jrst [move t,hpos ; get the current horizontal position + subi t,(d) ; get our desired horizontal position + skipge t ; paranoid. + setz t, ; substitute 0 for negatives + movei t,10(t) ; allow for ^P code strangeness + tyo dspc,[^P] ; move to the calculated position + tyo dspc,["H] + tyo dspc,t + tyo dspc,[^P] ; and clear the rest of the line + tyo dspc,["L] + jrst enmass] + tlnn b,%tomvb ;if this TTY can't backspace directly + jrst [push sp,bp + ldb b,bp ; we can't erase, so, we + decbp bp ; decrement our temporary bp + tyo tyoc,b ; echo deleted char (crude, but effective) + pop sp,bp + jrst gobk] ;and return + caig d, ;if it's non-positive + jrst enmass ; don't hack any more! + move b,d ;copy the counter + tyo tyoc,[^H] ;backspace + sojg b,.-1 ;Do it that many times + move b,d ;copy the counter + tyo tyoc,["/] ;wipe it out + sojg b,.-1 ;do it that many times + move b,d ;copy the counter + tyo tyoc,[^H] ;and back over it + sojg b,.-1 ;do it that many times + setom lfflag ;and note to LF when we get real char. + caia ;done with this loop +gobk: sojg d,wipe1 ;loop for each character. +enmass: setzm jlflag ;we didn't just LF + restore [b,tt,t] + pop sp,d + ret ;return to caller + + + +;; This copies our JCL to the JCL buffer, so that it is word-aligned etc. + +jclcop: move t,[440700,,jclbuf] + move bp,argptr ;get BP to start + move ct,argcnt ;Get # of characters of JCL + movem ct,jclct ; Remember how much JCL we got +jclco1: ildb ch,bp ;get character + idpb ch,t ;put the character + sojg ct,jclco1 ;try again, maybe + movei ch,^M ; End with CRLF + idpb ch,t + movei ch,^J + idpb ch,^M + setz ch, ;padd with nulls + movei ct,10 ;bunches of spaces +jclco2: idpb ch,t ;putting it in ! + sojg ct,jclco2 ;and do another + ret + +;;;; Here goes the error recovery system. + +loserr: movem x,ac.x + move x,[440700,,[asciz /Miscellaneous error/]] + movem x,errmsg + jrst errput ;and do the rest of the error stuff + +errmng: movem x,erracs ;save X for analysys + hrrz x,suuo ;grab the error message + hrli x,440700 ;make a byte pointer to it for .MAIL + movem x,errmsg ;save the error message! +errput: move tt,ac.tt ;recover the already saved AC + move x,[1,,erracs+1] ;and use it to BLT the rest of the AC's to + blt x,erracs+17 ; saftey +errmn1: move x,calerr ;collect the system error code + movem x,baderr ;and save it for posterity + move t,suuoh ;get address of error + movem t,erradr ;save address of error + + move x,errdat ;collect various data + .suset x + syscal status,[ebchn ;get the I/O status for bad channel + val ebsts] + jfcl ; Fie! + + syscal open,[cnti .uio ;image output dump file + argi dsko + [sixbit /DSK/] +ife $$PAND, [sixbit /PWORD/] +.else [sixbit /PANDA/] + [sixbit />/] + dbgdir] ;in case we don't want it to go there + quit + move t,[444400,,0] ;pointer to impure + movei tt,<</2000>*2000> ;write full pages! + syscal siot,[argi dsko ? t ? tt] ;write it out! + jfcl ; eh? + .close dsko, ;close it off + + type dspc,/AInternal Error: / + output tyoc,@errmsg + type dspc,/APlease do :BUG PWORD ^C +/ + + skipn debug + .mail bugmal ;mail the info + +pdlfix: syscal delewo,[argi dsko] ;flush the output file + jfcl ; ignore any errors, probably closed +quit=jrst pdlfix + .close dsko, + move sp,[-pdllen,,pdl] ;flush the stack out + syscal unlock,[argi %jself] ;unlock our locks! + .lose %lssys + setzm infp ;note we aren't in inferior anymore + .status usrc,t ;is there an inferior? + skipe t ;is it there? + .uclose usrc, ; kill it + setzm lfflag ;clear rubout-controling flags + setzm jlflag + setzm ttyflg + setzm siotct ;we aren't in the middle of output + setzm newflg ;clear out flag for PWDCHG + setom ttyprp ;default PRINTF to TTY output + setzm morflg ;turn of --MORE-- flag + setzm mdlflg ;we aren't hacking MUDDLE !! + setzm tyiflg ;normal mode of TYI + setzm dsprmp ;Don't do anything special for prompting +ifn $$PAND, setzm nodate + .iopdl ;reset the I/O PDL + move t,errclr ;clear various things + .suset t + skipn deathp + jrst rdloop ;and back to hacking! + .logout 1, + +.upure + +ifn $$PAND,[ +rdxarg: 0 ; Arg for cleanup handler +rdxbp: 0 ; BP to use for cleanup handler +rdxct: 0 ; Item to be XCT'd to clean up +]; end of IFN $$PAND, + +errmsg: 0 ;saved error message +errbuf: block 40 +.pure +;;; Error Clear table +errclr: -errcln,,errctb ;AOBJN ptr to stuf to reset on error +errctb: .spirqc,,[0] ;no interrupts + .sifpir,,[0] + .sdf1,,[0] ;un-defer things + .sdf2,,[0] + .smsk2,,[<1_tyic>\<1_tyoc>\<1_dspc>\<1_tlnc>] ;turn interrupts back on +errcln==.-errctb ;ERRCLN is lenght of ERRCTB + +errdat: -sstlng,,ssttab ;AOBJN ptr to lots of info +ssttab: .rbchn,,ebchn ;collect the bad channel + .rmpva,,empva ;when we get around to catching MPV's + .ruind,,euind ;get user index, for identification if we + ;get it before it is killed! + .runame,,euname ;get worthless data, usually + .rjname,,ejname + .rtty,,etty + .rpirqc,,epirqc ;interrupts? + .rifpir,,eifpir ;How do you expect me to get any work done + ;with all these interruptions? + .rcnsl,,ecnsl ;what TTY .... + .rsv40,,esv40 + .samsk2,,[<1_tyic>\<1_tyoc>\<1_dspc>\<1_tlnc>] ;turn off random ints. +sstlng==.-ssttab + + +dskerr: movem x,erracs ;save X for analysys + move x,[1,,erracs+1] ;and use it to BLT the rest of the AC's to + blt x,erracs+17 ;safty + move x,calerr ;gotta salvage the error now! PRINTF will + movem x,baderr ;clober it if we don't + syscal open,[cnti .uai ;open the ERR device + argi dski + [sixbit /ERR/] + argi 4 ;2nd file name is the error code + baderr] + .lose %lsfil + call printf ;print the error message + + move a,baderr ;get the error # + movem a,calerr ;move it back to CALERR so main error + ;handler can find it + movei tt,1 ;set up to shift one bit into position + setz t, ;T get's shifted into + lshc tt,(a) ;shift it + tdnn t,dskbd0 ;Is this safely ignorable? + tdne tt,dskbd1 + quit ; ignore it, back to work. + errdmp 4,[asciz /Couldn't open file./] ;AC's have been saved + +;;; OPEN errors to simply quit on, #'s 0-43 +; %EFLDR -- Directory full +; %EFLDV -- Device full + +dskbd0: irp x,,[%EFLDR,%EFLDV] +<1_x>\termin + +;;; OPEN errors to simply quit on, #'s 44-107 + +dskbd1: irp x,,[0] +<1_>\termin + 0 + + + +;;; failure in an open, not bug. + +opfail: push sp,calerr ;save the error code + ;we have the block containing the error + ;file + terpri + move d,[440700,,DSKBUF] ;use DSKBUF, since we don't need it yet + hrr b,suuo ;get the fileblock + call rfn"pfn ;Make it printable + output tyoc,dskbuf + type dspc,/ -- / + + syscal open,[cnti .uai ;open the ERR device + argi dski + [sixbit /ERR/] + argi 4 ;FN2 is error return from .CALL + (sp)] ;(standard call error) + loss + + call printf ;print the error message + quit ;and quit + + +SUBTTL System Utility Routines + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; +;;; Here go the system utility routines ;;; +;;; ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; find the entry, and get the group + +grplsr: movei a,lsrc ;tell LSRTNS what channel it can hack + move b,uname ;ask about this UNAME + call lsrtns"lsrunm ;is it there? + ret ; nope, fail + movem b,lsrptr ;save pointer to this entry + movei a,lsrtns"i$grp ;find his group + call lsrtns"lsritm + jrst [movei ch,40 ; nothing there, a space will do + jrst popj1] ; and consider it successful + + ildb ch,a ;check it out + cain ch,0 ;is it null? + jrst [movei ch,40 ; yes, use space instead + jrst popj1] ; and consider that a success + + upper ch ;uppercasify + jrst popj1 + +;;; map in the INQUIR database +maplsr: save [a,b] + movei a,lsrc ;A <- channel for LSRTNS + move b,[-lsrpgc,,lsrpag] ;AOBJN ptr to pages for LSRTNS + call lsrtns"lsrmap ;map in the INQUIR database + error /Failure to map in INQUIRE database!/ + restore [b,a] + ret + +unmapl: move b,[-lsrpgc,,lsrpag] ; AOBJN ptr to pages LSRTNS uses + syscal CORBLK,[ argi 0 ; DELETE! + argi %jself ; our own pages + b] ; all that LSRTNS used + loss ; huh? Won't let me give away pages?????? + .close lsrc, ; don't need it any more + ret + +;;; A routine to read a person's human name from INQUIR and ask if it's him +;;; clobbers A, B, and others. Takes a Byte Pointer to a working area in BP + +asknam: movei a,lsrtns"i$name ;find his name + call lsrtns"lsritm + jrst [type dspc,/AThere is a problem with that name's INQUIR entry. +/ + ret] + move b,bp ;Byte Pointer to our storage area + call lsrtns"lsrnam ;get his name in human-readable form + jfcl ; eh? + +asknm2: setom gotinq + type dspc,/AAre you / ;ask him + outstr tyoc,bp + decbp b ;it advances it a character + move bp,b ;and get pointer to the end + type tyoc,/? (Y or N) / ;ask + .reset tyic, ;throw away type ahead. + tyi + ret ; he quit, take it as NO + jrst asknm2 ; ask him again + jfcl + caie ch,"Y ;is it Y + cain ch,"y ; or y ? + caia ; yes, don't + jrst [type tyoc,/No. +That login name is already in use! Please choose another name and try again! +/ + ret] ; just give up + type tyoc,/Yes./ + movei ch,^M ;CRLF + idpb ch,b + movei ch,^J + idpb ch,b + move bp,b ;get our final byte pointer + jrst popj1 ;yep, that's the one! + +;;; table of devices to use .IOT on +iottab: irp dev,,[NUL,MT0] + sixbit /dev/ + termin +iotlen==.-iottab + +prtopn: save [TT,T] + move t,1(b) + + move tt,2(b) + camn t,[sixbit /..NEW./] + came tt,[sixbit /(udir)/] + caia ; Not trying to create directory + jrst [type dspc,/AIllegal file name +/ + ret] + + movsi tt,-iotlen ;AOBJN ptr to table of bad devices + movei x,.bai ;assume we must use .BAI + move t,(b) ;get the DEV of the file +prtdv1: camn t,iottab(tt) ;is it one of those damned losers? + jrst prtdv2 ; continue + aobjn tt,prtdv1 ;try next one + movei x,.uai ;WIN, we can SIOT +prtdv2: restore [T,TT] + syscal open,[argi dski ? cnt x ;open in whichever mode + (b) + 1(b) + 2(b) + 3(b)] + ret + jrst popj1 + +;;; routine to open .uao output file on DSKO. It takes the directory in B +;;; it returns the file-block pointer in B + +opnout: movem b,fo.snm ;fill in the blanks for directory + movei b,outnam ;point to file block + syscal open,[cnti .uao ;open it + argi dsko + (b) + 1(b) + 2(b) + 3(b)] + filoss (b) ; lost! + ret + +;;; fill in the FN2 and open a file. Skips if successful. +;;; takes fileblock pointer in B. Takes FN2 as argument in T + +fn2opn: movem t,2(b) + .call uaiopn + ret + jrst popj1 + +;;; similar, but for filling in the FN1 +fn1opn: movem t,1(b) + .call uaiopn + ret + jrst popj1 + +;;; rename file open on DSKO according to filename block pointed to by B +;;; then close the file +rnmfn2: movem t,2(b) +rnmcls: syscal renmwo,[argi dsko + 1(b) + 2(b)] + filoss (b) + .close dsko, + ret + + +;;; Routine to print, given an input file is already open in either .UII or +;;; .UAI on the DSKI channel (now .BAI too) COPYF entry is for copying to DSKO +;;; instead. + + +copyf: setzm ttyprp ;note output not to TTY +printf: syscal rfname,[argi dski ? val x ? val x ? val x ? val x ;ignore names + val prmode] ;but get that mode + error /RFNAME failed in PRINTF/ + move t,prmode + move tt,[440700,,dskbuf] ;byte pointer to handle .UAI files + movei x,buflen*5 ;bytes buffer will hold for .UAI files + movei a,1 ;conversion factor for .UAI to .UAO + cain t,.bai ;is it .BAI? + jrst prtbai ; yes, use what we have + cain t,.uii ;is it .UII? + do [move tt,[444400,,dskbuf] ;word at a time instead! + movei x,buflen ; buffer capacity in words instead + movei a,5 ; to convert .UII to .UAO +][ + caie t,.uai ; else, is it .UAI ? + error /PRINTF called with illegal mode/ +] +prtbai: hrr tt,iobuf + movem tt,dskbp ;this is our byte pointer + movem x,pbufl ;this is the length of our buffer + movem a,pbtsiz ;this is the # of chars per input byte + +morcop: skipe ttyflg ;if we have turnned of the TTY, + jrst [ .close dski, ; then we don't need the channel + ret] ; cause we're all done printing + move t,dskbp ;get our byte pointer + move tt,pbufl ;and our buffer size + call dvsiot ;reaad from any device + jrst [syscal close,[argi dski] + jfcl + setom ttyprp + ret] + movem t,foobp ;foo byte pointer + move t,pbufl ;lets figure out how many were moved + sub t,tt ;look MA, no random +1 or -1 's! (ITS WINS) + imul t,pbtsiz ;and be sure we have it in characters,~words + movem t,siotct ;move these out to storage so we can win on + movem t,remain ;save for later testing + caige t,buflen*5 ;if not the whole thing + call c.cadj ; adjust for TECO cretinism + + move t,[440700,,dskbuf] ;get another copy of our byte pointer + hrr t,iobuf + skipe ttyprp ;are we writing to the TTY? + do [syscal siot,[argi tyoc ;type it + t + siotct] + loss ; Eh? +][ ;ELSE + move x,remain ;get the count from remain, since SIOTCT is + syscal siot,[argi dsko ;subject to reseting at ^S int level + t ? x] + loss] + + move t,remain + cain t,buflen*5 ;zero? Are we really done? + jrst morcop ; nope, copy some more + .close dski, ;make sure it get's closed + skip ;ignore + setom ttyprp ;note that we're writing to TTY: usually + ret + +;;; read from any device on DSKI, with BP in T and count in TT +dvsiot: move x,prmode ;look at our mode. + caie x,.bai ;can we SIOT? + jrst [syscal siot,[argi dski ;yes, thank the lord + t + tt] + ret ;lost, don't skip return + jrst popj1] ;won, skip return +dvsio3: movsi x,-buflen + hrr x,iobuf ;cons up an AOBJN PTR to use + .iot dski,x ;read it in + hrr t,x ;fix up the byte pointer + hlre tt,x ;and figure up how many characters that was + imul tt,[-5] ;words -> ascii + jrst popj1 + +;;; Routine for goddamn fucking TECO that doesn't set FILLEN for end of file +;;; like it ought to. This means it writes out cretinouse ^C's at the end +;;; to pad the word! Also, the ERR device ends off with a ^L, so we flush +;;; those too! + +c.cadj: move t,foobp ;get the possibly cretinouse byte pointer + tlne t,004000 ;is it a full-word pointer? + hrli t,010700 ; yes, make it a ascii pointer + movei tt,5 ;at most 5 of the losers + setz x, ;count the beggars + norm7 t ;back up to last one +c.caj0: ldb ch,t ;get the possibly offensive character + caie ch,^L ;is it a trailing ^L ? + cain ch,^C ;is it offensive? + caia + jrst [exch x,siotct ; nope, but maybe predecessors were + subm x,siotct + ret] ; record and return + decbp t ;back up! + aos x ;boy is it offensive + sojg tt,c.caj0 ;find another? + exch x,siotct + subm x,siotct + ret ;nope that's all + +.upure +gotinq: 0 ; Set -1 if person applying for account has + ; an INQUIR entry already. +foobp: 0 ;byte pointer to the end of the buffer +remain: 0 ;# of bytes unused in buffer +fleng: 0 ;length of the file +ttyflg: 0 ;set to -1 whenever we wish to flush typeout +siotct: 0 ;count of chars left to be typed out in this + ;SIOT + +allflg: 0 ;ALL option has been specified. Used only + ;in among consenting adults. +nodate: 0 ; -1 means suppress create/modify date +brfflg: 0 ;similarly, BRFFLG is for -brief option + +reread: -1 ;if non-negative, is character to re-read + +dskbp: 0 ;the byte pointer to use for input +prmode: 0 ;contain's the mode this channel is open in. +ttyprp: -1 ;-1 means output is to TYOC, not DSKO +pbtsiz: 0 ;the # of chars per byte. This is used to + ;convert input bytes to output chars +pbufl: 0 ;size of the buffer in current bytes + +iobuf: dskbuf ;buffer to use for PRINTF + +dskbuf: block buflen + block buflen ;buffer for use by :SEND's + +.pure + +ife $$pand,[ +goddt4: movem b,linkno ; remember we were lunk to + call logit ; unusual login, log it +goddt5: move x,[jfcl] ;make it not add anything to the start adr + movem x,lodoff + jrst goddt1 ;don't type anything! + +goddt: type dspc,/A[OK] +/ ;[OK] + +goddt0: syscal ttyget,[argi tyic ? val t ? val tt ? val a] + loss + tlz a,%TSSII ;clear out the super-image bit! + syscal ttyset,[argi tyic ? t ? tt ? a] + loss +goddt1: .suset [.smask,,[0]] ;turn off all interrupts, let DDT do it when + .suset [.smsk2,,[0]] ;it is ready! + move a,[400000,,[0]] ;turn off realtime interrupts + .realt a, + jfcl + syscal open,[cnti .uii ;open the file to load in DDT from + argi lodc + [sixbit /SYS/] + [sixbit /ATSIGN/] + [sixbit /DDT/]] + error /Can't access SYS:ATSIGN DDT, can't log you in, sorry!/ + ;We've got it open, time to load up our AC's + +; close up our channels so DDT doesn't get confused (only the TTY channels +; should be open at this point, but just in case, close them all) + +irp x,,[dspc,tyic,tyoc,lsrc,pwdc,dski,dsko,usrc] + .close x, +termin + + setz t, ;clear T for offset start address + skipe lbrief ;did he specify -bf ? + movei t,1 ; yes, start at even offset instead + skipe altusw ;did he $U instead of :LOGIN ? + addi t,2 ;yes, account for that + addm t,lodoff ;so start up at our offset + hrlzi 17,lodblk ;for BLT from LODBLK to AC 0 + blt 17,17 ;move code to AC's + jrst 1 ;and execute it. + +.upure ;can't be pure, since we modify LODOFF +lodblk: jfcl + .suset ;flush our memory + .CALL ;the SETZ of the call lives in AC 6 + .logout ;probably no core. Can't do anything. + .iot 1,1 ;read start address +lodoff: addi 1,1 ;start at our special address instead + jrst (1) ;and away we go! +lcalbk: setz + sixbit /LOAD/ ;load + argi %jself ;into self + 401000,,1 ;from channel 1 +lsuset: .smemt,, +lmemt: 4000 + 0 + 0 + 0 + +.pure +] ; END IFE $$PAND + +ifn $$PAND,[ + +grpmal: 440700,,[asciz /ACCOUNTS-HELD-REFUSED/] + tp$6bt runame + 0 + 440700,,[asciz /New GROUP settings/] + -1,,[440700,,usrbfr] + +rmsmal: 440700,,[asciz /ACCOUNTS-HELD-REFUSED/] + tp$6bt runame + 0 + 0 + -7,,airtyp + +notmal: 440700,,[asciz /ACCOUNTS-NOTIFICATION/] + tp$6bt runame + 0 + 0 + -7,,airtyp +.upure +airtyp: 0 ; Type (SET/DELETE) + 440700,,[asciz /Was: /] + 440700,,usrbfr ; State before + 440700,,[asciz / +Is: /] + 440700,,usraft ; State after + 440700,,[asciz / +/] + 440700,,usrrsn ; Reason, if any +.pure +maldel: move t,[440700,,[asciz /[DELETED]/]] + move bp,[440700,,usraft] + copy t,bp + skipa t,[440700,,[asciz /I deleted the following account: +/]] +malset: move t,[440700,,[asciz /I set the following account: +/]] + movem t,airtyp + + ldb x,[pi$sta pdinfo] ; Is this something RMS want to see? + caie x,ps%hld + cain x,ps%rfs + jrst rmshak + cain x,ps%off + jrst rmshak + + .mail notmal ;send mail on it + ret + +; filter out deletions and refuse-holds for RMS +rmshak: .mail rmsmal + ret + +] ; END IFN $$PAND, + +ml.to==0 ;Byte pointer to TO: field +ml.frm==1 ;Byte pointer to FROM: field + ;or address of 6bit word +ml.snt==2 ;Byte pointer to SENT-BY field + ;or address of 6bit word +ml.sbj==3 ;Byte pointer to SUBJECT: field +ml.txt==4 ;AOBJN pointer to Byte pointer's to + ;strings to be placed in the TEXT field +;;;; MAIL forms + +sndmal: 440700,,tmpbuf + tp$6bt runame + tp$6bt runame + 0 + -1,,[ tp$ind argptr ] + +lflmal: tp$6bt PXUNAM ;XUNAME, not UNAME + 440700,,[asciz /PASSWORD-SYSTEM/] + 0 + 440700,,[asciz /Failed login/] + -3,,[440700,,[asciz /Your password was given incorrectly from /] + 440700,,hstnam ;site name or LOCAL or DIALUP + 440700,,[asciz / +/]] ;TERPRI + +bugmal: +ife $$PAND,[ + tp$ind bugnam + 440700,,[asciz /BUGGY-PWORD/] + 0 ;no SENT-BY field + 440700,,[asciz /PWORD crash file/] +]; END IFE $$PAND +ifn $$PAND,[ + tp$ind bugnam + 440700,,[asciz /BUGGY-PWORD/] + 0 ;no SENT-BY field + 440700,,[asciz /PANDA crash file/] +]; END IFN $$PAND + -4,,[ 440700,,[asciz /There is a crash file to examine. +Error message: +/] + tp$ind errmsg ;type the error message + 440700,,[asciz / +Error code: /] + tp$oct calerr] +ife $$PAND,[ + +aplmal: 440700,,[asciz /USER-ACCOUNTS-ARCHIVE/] + 440700,,[asciz /PASSWORD-SYSTEM/] + 0 + 0 + -6,,[ 440700,,[asciz /Uname: /] + tp$6bt uname + 440700,,[asciz / +/] + 440700,,msgbuf + 440700,,[asciz / +/] + tp$ind uinfo] + +telmal: 440700,,[asciz /ACCOUNTS-NOTIFICATION/] + tp$6bt uname + tp$ind namloc ;who it's from is put here + -2,,[440700,,[asciz /Application from TTY /] ? tp$oct consol] + -3,,[ 440700,,msgbuf ? 440700,,[asciz / +/] + tp$ind uinfo] +] ; END IFE $$PAND, + +mailit: push sp,uuoh ;save where we came from! + push sp,b ;need this AC + move b,fm.snm ;open an output file on the mail directory + call opnout + move t,uuo ;get the address to find these frobs in! +; skipe dm.flg ;is this on DM? +; ; DM runs a winning mailer now. +; jrst comsys ; write for losing mailer + +;;; how to mail on winning system + +comsat: type dsko,/FROM-JOB:/ +ifn $$PAND,[type dsko,/PANDA +TO:(/] +.else [type dsko,/PWORD +TO:(/] + typout dsko,ml.to(t) + +ife $$pand,[ + hrrzs t ; flush the op-code part + cain t,telmal ; Is this notification mail? + jrst [ + type dsko,/ MIT-/ + 6type dsko,machin ; tell where to send it + type dsko,/ (R-HEADER-FORCE NULL)/ ; force into RFC733 format + jrst .+1] +]; END IFE $$PAND, + + type dsko,/) +SENT-BY:/ + typout dsko,ml.frm(t) + skipn ml.snt(t) ;sent-by field? + jrst comst1 ; null, don't write it, COMSAT loses + type dsko,/ +CLAIMED-FROM:/ + skipn ml.snt(t) ;nothing there? + typout dsko,ml.frm(t) ; substitute the FROM field + skipe ml.snt(t) + typout dsko,ml.snt(t) ; something there, use it! + +comst1: skipn ml.sbj(t) ;subject field? + jrst comst2 ; null, don't write it + type dsko,/ +SUBJECT:/ + +comst2: typout dsko,ml.sbj(t) + type dsko,/ +TEXT;-1 +/ + +ife $$pand, cain t,telmal ; Is this TELMAL? +ife $$pand, call fakhed ; yes, fake a header + + typout dsko,ml.txt(t) ;type out all the text frobs + movei b,mlmnam ;rename to the mail filenames + call rnmcls + pop sp,b ;restore AC + pop sp,uuoh + jrst uuoret ;and return! + +fakhed: type dsko,/Date: / + call datime"timget ; get the time + push sp,d + move d,[440700,,dskbuf] ; get a place to copy the time + call datime"timexp ; get the time as "7 AUG 1976 0831-EST" + output dsko,dskbuf ; send it out + outstr dsko,d ; send out the -EST too! (DATIME bug?) + pop sp,d + type dsko,/ +From: / ; now for the FROM: field + move tt,ml.snt(t) + call malqck ; check for need of " quoting + jrst [ tyo dsko,[""] ; quote the insides + setom mdlflg + typout dsko,ml.snt(t) ; should muddle-quote with right char + setzm mdlflg + tyo dsko,[""] + jrst .+2] + typout dsko,ml.snt(t) ; no quoting needed, just send it + type dsko,/ +To: USER-ACCOUNTS at MIT-/ + 6type dsko,machin ; tell where + type dsko,/ +/ + ret + +malqck: push sp,ch +malqk0: hlrz ch,tt ; get the LH + andi ch,777740 ; eliminate the indirection and indexing + cain ch,tp$ind ; is it an indirect frob? + jrst [ move tt,@tt ; get what it points to + jrst malqk0] ; and start from scratch + cail ch,450000 ; is it a byte pointer? + jrst [ pop sp,ch ? ret] ; no, assume it's OK (punt!) +malqk1: ildb ch,tt + caie ch,", + cain ch,"" + jrst [ pop sp,ch ? ret] + caie ch,"< + cain ch,"> + jrst [ pop sp,ch ? ret] + cain ch,"\ + jrst [ pop sp,ch ? ret] + caie ch,^C ; end of the string? + cain ch,0 + jrst [ pop sp,ch ? jrst popj1] ; we made it, no quotes needed + jrst malqk1 + +comsys: setzm mdlflg ;hack muddle strings + type dsko,/"TO" ("/ + setom mdlflg ;hack muddle strings + typout dsko,ml.to(t) + setzm mdlflg ;don't hack muddle strings + type dsko,/") +/ + skipn ml.snt(t) ;is there a claimed-from? + jrst comsnd ; no, just hack the sender field + type dsko,/"SENDER" "/ + setom mdlflg ;hack muddle strings + typout dsko,ml.snt(t) + setzm mdlflg ;don't hack muddle strings + type dsko,/" +/ +comsnd: type dsko,/"FROM" "/ + setom mdlflg ;hack muddle strings + typout dsko,ml.frm(t) + setzm mdlflg ;don't hack muddle strings + type dsko,/" +"SCHEDULE" ("SENDING") +/ + skipn ml.sbj(t) ;is there a subject field? + jrst csytxt ; No, just go hack the text! + type dsko,/"SUBJECT" "/ + setom mdlflg ;hack muddle strings + typout dsko,ml.sbj(t) + setzm mdlflg + type dsko,/" +/ +csytxt: setzm mdlflg ;don't hack muddle strings + type dsko,/"TEXT" "/ + setom mdlflg ;hack muddle strings + typout dsko,ml.txt(t) + setzm mdlflg ;don't hack muddle strings + type dsko,/"/ + movei b,mlmnam ;rename to the mail filenames + call rnmcls + restore [b,uuoh] ;restore the world so we can go back + jrst uuoret ;and return + +crlf: skipe ttyflg ;is TTY off? + ret ; yes, don't do it! + tyo dspc,[^P] ;type a ^PA ala DDT + tyo dspc,["A] + ret + +terpri=call crlf + +;;;; GINIT does basic initialization, opening the TTY, etc. +;;;; GINIT1 is the subset of GINIT that initializes interrupts and essential +;;;; variables that are needed before the TTY is opened even. +;;;; GINIT2 opens the TTY and initializes TTYSTS and TTYST1 and TTYST2 +;;;; and the password database + +ginit: skipe startd ;has it been started already? + ret ; yes, don't bother + call ginit1 + loss ;it lost somehow + call ginit3 + ret + +ginit1: .suset [.soption,,[<%opopc\%opint\%oplok\%oplkf>,,0]] ;set up winnage. + .suset [.s40addr,,[suuo]] ;where we handle system UUO's and ints + .suset [.smask,,[ ;enable interrupts +%pidwn\%pidbg\%pimpv\%pipdl\%pirlt\%piioc\%piltp\%picli\%piwro\%pioob\%piilo\%pidis]] + .suset [.smsk2,,[<1_tyic>\<1_tyoc>\<1_dspc>\<1_tlnc>]] + .suset [.rcnsl,,consol] ;get the console number + move b,consol + syscal cnsget,[argi %jsnum(b) ;collect info on our TTY + val vsize + val hsize + val nul + val ttycom + val ttyopt + val TTYTYP] + ret ; lost, don't skip + + setzm sailp ; Clear these flags, in case they were + setzm hfdupf ; set by PURIFY$G + move x,ttyopt ;check this TTY out + tlne x,%tosai ; does this TTY know about sail characters? + setom sailp ; yes, so echo contols right + tlne x,%tohdx ;is this TTY a loser? + setom hfdupf ; yep, note the fact! + tlne x,%tomvb ;can it backspace directly? + setom bsflag ; note the fact for losers (see ECHO) + call bltspc ;Set up appropriate file specs. + jrst popj1 ;Win away... + +;;; BLTSPC - blt in the correct file specs for this machine. +;;; Returns if won. + +bltspc: syscal sstatu,[val x ? val x ? val x ? val x ? val x + val machin] ;get the machine name + loss + move x,machin ;get it in an AC + came x,[sixbit /MX/] + camn x,[sixbit /MC/] ;is it MC? + jrst [move x,[mcspec,,tsspec] ;yes, so use MC's specs + blt x,spcend-1 + ret ] + camn x,[sixbit /ML/] ;is it ML? + jrst [move x,[mlspec,,tsspec] ;yes, so use ML's specs + blt x,spcend-1 ; all of them, to the end + ret ] + camn x,[sixbit /AI/] ;is it AI? + jrst [move x,[aispec,,tsspec] ;yes, so use AI's specs + blt x,spcend-1 ; all of them, to the end + ret ] + camn x,[sixbit /MD/] ;is it MD? + jrst [move x,[mdspec,,tsspec] ;yes, so use MD's specs + blt x,spcend-1 ; all of them, to the end + ret ] + camn x,[sixbit /DB/] ;is it DB? + jrst [move x,[mdspec,,tsspec] ;yes, so use MD's specs + blt x,spcend-1 ; all of them, to the end + ret ] + camn x,[sixbit /DM/] ;DM-P? + jrst [move x,[dmspec,,tsspec] ;yes, use DM's specs + blt x,spcend-1 ; all of them to the bitter end + setom dm.flg + ret ] + .lose ; Unknown machine! + + +.upure +ginitd: 0 ; -1 means we've done GINIT2 before +.pure + +ginit2: skipe ginitd ; Have we already initialized ourself? + ret ; Yes, go no further + call ginit3 + + movei a,hstpag + movei b,hstc + call netwrk"hstmap +IFN $$PAND,[ error /Can't map host table!/ +] +.ELSE jfcl +IFE $$PAND,[ + move a,[netwrk"nw%arp] + call netwrk"ownhst + jfcl + movem a,lclsit +]; End of IFE $$PAND, + call pwdmap ; Map in the password database + setom ginitd ; note we're initialized + ret + +ginit3: syscal open,[cnti .uai + argi tyic + [sixbit /TTY/]] + loss + + .suset [.runame,,RUNAME] ;get our UNAME + + syscal ttyget,[argi tyic ? val x ? val x ? val t] + loss + skipe sailp ; if terminal can handle it + tlo t,%tssai ; we want SAIL mode available + + .suset [.rsuppro,,tt] +; caig tt,0 ;are we top level? +; ;don't use super-image just now, MRC gripes. +; tlo t,%tssii ; turn on super-image input + syscal ttyset,[argi tyic + [020202,,020202] + [030202,,020202] + t] + loss + + + ;display channel + syscal open,[cnti .uao\%TJDIS + argi dspc + [sixbit /TTY/]] + loss + ;ordinary TTY output channel + syscal open,[cnti .uao + argi tyoc + [sixbit /TTY/]] + loss + + setom startd ;note that we've run the initialization + + syscal open,[cnti .uii ;does the .TEMP.; directory exist? + argi dski + [sixbit /DSK/] + [sixbit /.FILE./] + [sixbit /(DIR)/] + [sixbit /.TEMP./]] + do [move x,[sixbit /COMMON/] ; no .TEMP. directory + movem x,cladir] ; so must be COMMON instead + .close dski, + ret + +.even=<.+1>/2*2 +loc .even + +iuname: 0 ;UNAME of person purifying +ifn $$pand,[ +spword: 707644,,721261 ;6/7/85 for new KS10 ITS machines. +] ;MX => 225747,,366135 (prev 320744,,541326) + +constants + + +purify: move sp,[-pdllen,,pdl] + call ginit ;init + setzm startd ;we haven't started, really + syscal corblk,[cnti %cbndw\%cbndr ;get a new page + argi 0 ;no superfluous XORING, please! + argi %jself + argi tmpag1 ;moby page + argi %jsnew] + .lose 1400 + move t,[<*2000>,,tmpag1*2000] + blt t,+1777 ;copy the page + syscal corblk,[cnti %cbndw\%cbndr ;move it into old location + argi 0 ;no superfluous XORING, please! + argi %jself + argi iuname/2000 ;home, sweet home + argi %jself + argi tmpag1] + .lose 1400 + syscal corblk,[cnti 0 ;delete! + argi 0 + argi %jself + argi tmpag1] + .lose 1400 + .suset [.runame,,iuname] ;remember this + move x,iuname ;remember in the impure for crash dumps + movem x,puname +ifn $$pand,[ + type dspc,/AThis is PANDA, not PWORD. +Do not install as SYS:ATSIGN HACTRN!! +/ +] + move t,[-<</2000>-.purpg>,,.purpg] + syscal corblk,[cnti %cbndr + argi 0 + argi %jself + t] + .lose 1400 + type dspc,/APurified. +/ +puree: .break 16,100000 ;return + jrst puree + + +;;; DBGHAK - Routine to read in a crash file and anylize a bit. + + +dbghak: skipn startd ;has this been started before? + move sp,[-pdllen,,pdl] ;use the main pdl for now + skipe goodf ;if we have already allocated good and bad + jrst [call goodsw ; get good context back again + jrst dbghk1] ; don't do it again! + + move t,[-4,,goodpg] ;move our own low impure for safekeeping + setz tt, ;starts in page 0 + setom goodf ;note that this set is our "GOOD" set + syscal corblk,[cnti %cbndw\%cbndr + argi 0 + argi %jself + t + argi %jself + tt] + .lose %lssys + move t,[-4,,badpag] + syscal corblk,[cnti %cbndw\%cbndr ;get pages for bad data + argi 0 + argi %jself + t + argi %jsnew] + .lose %lssys + +dbghk1: syscal corblk,[cnti %cbndw\%cbndr ;RW page for PDL + argi 0 + argi %jself + argi dpdlpg + argi %jsnew] + .lose 1400 + move sp,[-400,,dpdl] ;get debug pdl ptr + call ginit ;initialize the universe + + syscal open,[cnti .uii ;access the file + argi dski + [sixbit /DSK/] + dbgfn1 + dbgfn2 + dbgdir] + .lose %lsfil + + move t,[444400,,badloc] ;load file into our new BAD pages! + movei tt,10000 ;4 blocks of cruft + syscal siot,[argi dski ? t ? tt] ;move it in + .lose 1400 ; old CALERR is saved in BADERR + .close dski, ;close up + move t,badloc+vrsadr ;get the source filenames to compare + move tt,badloc+vrsadr+1 ;so we can see if we have the same one + camn t,[.fnam1] ;same first name? + came tt,[.fnam2] ; and second name? + jrst [type dspc,/AWrong version: +Bug file --> / ; nope! + 6type tyoc,t ;type FN1 of loser + .iot tyoc,[40] ;space + 6type tyoc,tt ;type FN2 of loser + type tyoc,/ +Current version --> / + 6type tyoc,[.fnam1] + .iot tyoc,[40] ;space + 6type tyoc,[.fnam2] + call badsw ;revert to bad context + .lose] + type dspc,/AUNAME = / + 6type tyoc,badloc+runame + skipe badloc+baderr ;if there was an .CALL error returned + do [ type dspc,/AError code = / + 8type tyoc,badloc+baderr] + + type dspc,/ALast error message was: +/ + output tyoc,@badloc+errmsg + + call badsw ;revert to bad context + .break 16,100000 ;and return to superior + +;;; routine to switch context to good (our own) pages + +goodsw: push sp,t ;save AC's, we need all the flexibility we + push sp,tt ;can get when hacking low impure + move t,[-4,,0] ;AOBJN ptr to low impure data + movei tt,goodpg ;page goodpg is our good (own) data pages + syscal corblk,[cnti %cbndw\%cbndr + argi 0 + argi %jself + t ;AOBJN ptr to low impure + argi %jself + tt] ;source of good data + .lose %lssys + pop sp,tt + pop sp,t + ret + +;;; routine to switch context to bad (from crash file) pages + +badsw: push sp,t ;save AC's, we need all the flexibility we + push sp,tt ;can get when hacking low impure + move t,[-4,,0] ;AOBJN ptr to low impure data + movei tt,badpag ;page badpag is our good (own) data pages + syscal corblk,[cnti %cbndw\%cbndr + argi 0 + argi %jself + t ;AOBJN ptr to low impure + argi %jself + tt] ;source of bad data + .lose %lssys + pop sp,tt + pop sp,t + ret + +;;; routine to print as half-words. Expects one arg on the stack. +printh: move x,-1(sp) ;get argument + hlrz x,x ;isolate left half + 8type tyoc,x ;type it + type tyoc,/,,/ ;separate it + move x,-1(sp) ;get argument + hrrz x,x ;isolate right half + 8type tyoc,x ;type it + ret + + +ifn $$pand,[ + +;;; CLOBBR - Initialize a new database. +;;; +;;; This can be hand-called from DDT to make a new database. +;;; Note: The file is written into your current SNAME + +pwflen==15. ;Length in pages of PWORD file. + +clobbr: move sp,[-pdllen,,pdl] ;Initialize pdl. + ;; First, make empty password database pages exist. + move a,[-pwflen,,pwpage] + syscal CORBLK,[ argi %cbndr+%cbndw ? argi %jself ? a ? argi %jsnew ] + .lose %lsfil + setzm pwfile + move x,[pwfile,,pwfile+1] + blt x,pwfile+<2000*pwflen>-1 + ;; Then fill in default values for the database. + setzm pwcnt ;Init user count. + setom atoapl ;Init allow applications. + setom pwordt ;Init no date override. + setom pwordt+1 + setom pwordt+2 + setom pwinit ;Init database locks + setom pwdone + setzm pwrbfp ;Init Bp. + setom pwgrdm ;Init group restrictions. + move x,[pwgrdm,,pwgrdm+1] + blt x,pwgors-1 + ;; Now create default groups. +..foo==0 +irp gr,,[USER,DAY,DIAL,TURIST,GRP.04,GRP.05,GRP.06,GRP.07,GRP.08,GRP.09,GRP.10,GRP.11,GRP.12,GRP.13,GRP.14,GRP.15] + move x,[sixbit /GR/] + movem x,pwgnam+..foo + ..foo==..foo+1 +TERMIN + .suset [.runame,,pwuhak] ;Note database user. + .suset [.rjname,,pwjhak] + ;; Now we're gonna write the database out to disk. + call bltspc ;Now set up appropriate file specs. + syscal OPEN,[cnti .uio ? argi pwdc ? pw.dev ? pw.fn1 ? pw.fn2 ] + .lose %lsfil + move t,[444400,,pwfile] + movei tt,<2000*pwflen> + syscal SIOT,[ argi pwdc ? t ? tt] + .lose %lsfil + .close pwdc, +clobr9: .logout 1, ;All done. + +];$$pand + + + +;;; Per machine specifications end up here +.upure +tsspec:: ;table specifiying way this machine likes em +spec: +pwfnam:: +pw.dev: 0 +pw.fn1: 0 +pw.fn2: 0 +pw.snm: 0 + +;;; filename block for mail files +mlmnam:: +fm.dev: 0 +fm.fn1: 0 +fm.fn2: 0 +fm.snm: 0 + +bugnam: 0 + +spcend:: +.pure + +;;;; MC and MX's specifications go here + +mcspec: offset tsspec-. ;Specs are offset and BLT'ed +pwfnam:: +pw.dev:: sixbit /DSK/ +pw.fn1: +ife $$DBUG,sixbit / BIG/ +ifn $$DBUG,sixbit / FOO/ +pw.fn2: sixbit / 0DAT/ +pw.snm: +ife $$DBUG,sixbit /SYSBIN/ +ifn $$DBUG,sixbit /CSTACY/ + +;;; filename block for mail files +mlmnam:: +fm.dev: sixbit /DSK/ +fm.fn1: sixbit /MAIL/ +fm.fn2: sixbit />/ +fm.snm: +ife $$DBUG,sixbit /.MAIL./ +ifn $$DBUG,sixbit /CSTACY/ + +bugnam: +ife $$PAND,440700,,[asciz /BUG PWORD/] +ifn $$PAND,440700,,[asciz /BUG PANDA/] + +spcend:: + offset 0 +mcspce:: ;end of MC's specs + +;;;; ML's specifications go here + +mlspec: offset tsspec-. +pwfnam: sixbit /DSK/ +ife $$DBUG,sixbit / BIG/ +ifn $$DBUG,sixbit / FOO/ + sixbit / 0DAT/ +ife $$DBUG,sixbit /SYSBIN/ +ifn $$DBUG,sixbit /CSTACY/ + +;;; filename block for mail files +mlmnam:: +fm.dev: sixbit /DSK/ +fm.fn1: sixbit /MAIL/ +fm.fn2: sixbit />/ +fm.snm: +ife $$DBUG,sixbit /.MAIL./ +ifn $$DBUG,sixbit /CSTACY/ + +bugnam: +ife $$PAND,440700,,[asciz /BUG PWORD/] +ifn $$PAND,440700,,[asciz /BUG PANDA/] + +spcend: + offset 0 +mlspce: + +;;;; AI's specifications go here +aispec: offset tsspec-. +pwfnam:: +pw.dev:: sixbit /DSK/ +pw.fn1: sixbit / BIG/ +pw.fn2: sixbit / 0DAT/ +pw.snm: +ife $$DBUG,sixbit /SYSBIN/ +ifn $$DBUG,sixbit /CSTACY/ + +;;; filename block for mail files +mlmnam:: +fm.dev: sixbit /DSK/ +fm.fn1: sixbit /MAIL/ +fm.fn2: sixbit />/ +fm.snm: +ife $$DBUG,sixbit /.MAIL./ +ifn $$DBUG,sixbit /CSTACY/ + +bugnam: +ife $$PAND,440700,,[asciz /BUG PWORD/] +ifn $$PAND,440700,,[asciz /BUG PANDA/] + +spcend:: +offset 0 +aispce:: ;end of AI's specs + +;;;; MD's specifications go here +mdspec: offset tsspec-. +pwfnam:: +pw.dev:: sixbit /DSK/ +pw.fn1: sixbit / BIG/ +pw.fn2: sixbit / 0DAT/ +pw.snm: +ife $$DBUG,sixbit /SYSBIN/ +ifn $$DBUG,sixbit /CSTACY/ + +;;; filename block for mail files +mlmnam:: +fm.dev: sixbit /DSK/ +fm.fn1: sixbit /MAIL/ +fm.fn2: sixbit />/ +fm.snm: +ife $$DBUG,sixbit /.MAIL./ +ifn $$DBUG,sixbit /CSTACY/ + +bugnam: +ife $$PAND,440700,,[asciz /BUG PWORD/] +ifn $$PAND,440700,,[asciz /BUG PANDA/] + +spcend:: +offset 0 +mdspce:: ;end of MD's specs + +;;;; ES's specifications go here +esspec: offset tsspec-. +pwfnam:: +pw.dev:: sixbit /DSK/ +pw.fn1: sixbit / BIG/ +pw.fn2: sixbit / 0DAT/ +pw.snm: +ife $$DBUG,sixbit /SYSBIN/ +ifn $$DBUG,sixbit /CSTACY/ + +;;; filename block for mail files +mlmnam:: +fm.dev: sixbit /DSK/ +fm.fn1: sixbit /MAIL/ +fm.fn2: sixbit />/ +fm.snm: +ife $$DBUG,sixbit /.MAIL./ +ifn $$DBUG,sixbit /CSTACY/ + +bugnam: +ife $$PAND,440700,,[asciz /BUG PWORD/] +ifn $$PAND,440700,,[asciz /BUG PANDA/] + +spcend:: +offset 0 +esspce:: ;end of ES's specs + + +;;; DM's specs + +dmspec: offset tsspec-. ;DM's table of specs are offset and bLT'ed +pwfnam:: sixbit /DSK/ + sixbit / 0PWRD/ + sixbit />/ +ife $$DBUG,sixbit /SYSENG/ +ifn $$DBUG,sixbit /CSTACY/ + +;;; filename block for mail files +mlmnam:: +fm.dev: sixbit /DSK/ +fm.fn1: sixbit /MAIL/ +fm.fn2: sixbit />/ +fm.snm: +ife $$DBUG,sixbit /.MAIL./ +ifn $$DBUG,sixbit /CSTACY/ + +bugnam: +ife $$PAND,440700,,[asciz /(BUG PWORD)/] +ifn $$PAND,440700,,[asciz /(BUG PANDA)/] + +spcend:: + offset 0 +dmspce:: + +;; type our prompt + +prompt: setzm ttyflg ;turn the TTY! + + tyo dspc,[^P] ;new line if we need one + tyo dspc,["A] ;just like DDT. + skipe dsprmp ;do we have an alternate prompt? + pjrst [xct dsprmp ; yes, do it + ret] ; instead +ife $$pand,tyo tyoc,[52] ;followed by "*" +ifn $$pand,tyo tyoc,[76] ;followed by ">" + ret + +echo: skipe lfflag ; are we on fresh line? + call [tyo tyoc,[^J] ; get one + setzm lfflag ; and notice we did it + ret] ; and continue + skipe hfdupf ; is it full duplex? + ret ; yes, don't echo + cain ch,^M ; CR? + jrst [ tyo tyoc,ch ; type it + tyo tyoc,[^J] ; and a LF too! + ret] + caie ch,33 ; not altmode? + cail ch,40 ; abnormal character? + cain ch,177 ; or rubout? + cain ch,^G ; ^G is echod as self + jrst [ tyo tyoc,ch ; OK, echo it normally + ret] + call echosl ; Echo it maybe in sail mode + ret ; and return + +echoch=call echo ;simple memonic + + +echosl: save [ch] ; recover the real char + skipn sailp ; do we have sail characters? + tyo tyoc,["^] ; no, circumflex will do + skipe sailp + tyo tyoc,[^K] ; yes, uparrow is the thing! + tro ch,100 ; make this into a non-control-char + tyo tyoc,ch ; and echo that + restore [ch] ; save the real character + ret + +;; routine to read from TTY following conventions WRT ?, _H, etc. +;; no-skip means ^D typed. +;; 1-skip means ? or ^_H typed. +;; 2-skips means rubout +;; 3-skips means other character + +tyiget: setzm ttyflg ;reading turns the TTY back on! + +tyi=call tyiget ;operation to get a character + skipge ch,reread ;is there anything to re-read? +tyiiot: .iot tyic,ch ; no, read the character + setom reread ;nothing to re-read any more, for sure! + + caie ch,4110 ;is it the [HELP] key? + cain ch,77 ; or ? "?" + jrst popj1 ; skip-1 return + + caile ch,36 ;is it garbage? + jrst popj23 ; non-garbage, use it! + + cain ch,0 ;is it ^@ ? + jrst tyiget ; yes, ignore it + + cain ch,^D + ret ;blow nose and return + + cain ch,^S ; is it a ^S ? + ret ; yes, return. + + cain ch,^M ;Allow a ^M to make it through! + jrst popj23 ; as a real live character + + save [x] ;borrow X from the world + move x,tyiflg ;get the flag word + + trnn x,ty.edt ;Are we hacking editing characters? + jrst nedit ; no, don't check for them! + caie ch,^W ;kill word? + cain ch,^U ; Kill line? + jrst popj3x ; yes, let them through! + cain ch,^R ;Retype line? + jrst popj3x ; yes, retype it + +nedit: cain ch,^C ;is it a ^C? Let it through! + jrst popj3x + restore [x] ; anything else IS garbage, so ignore it. + echoch ; echo the loser + tyo tyoc,[^G] ; beep + jrst tyiget ; and try again + +popj3x: restore [x] +popj23: caie ch,177 ;is it a rubout? + aos (sp) ; no, skip-3 return, ordinary garbage. + + aos (sp) ;otherwise skip-2, for rubout. + aos (sp) + ret +.upure +tyiflg: 0 ;flag word for what special chars to let thu +ty.==525252,,525252 +ty.edt==4 ;flag for allowing editing commands +.pure +;;;; Predicates for the RFN package, to skip if must be proceeded by ^Q + +rsixtp: +psixtp: cain a,54 ;comma? + jrst popj1 ; skip! + ret ;otherwise, just ordinary + +constants +versio: .fnam1 + .fnam2 + +.upure +variables +impend: ;end of impure! +.pure +corend:: ;end of core +ifg corend-lsrpag*2000, .ERR Code overlaps with INQUIR database, you will lose! +.perch ;check our allocations + +;;; Local Modes ::: +;;; Comment Begin:; ::: +;;; Comment Column:35 ::: +;;; End: ::: + +end go