github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-04-26 20:27:13 +00:00
Code Issues Releases Wiki Activity
Files
bf6d2a9ad28deb74b26e0955c56f324f8fcd2002
PDP-10.its/src/sysen1/pword.2662

10446 lines
288 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
; -*- 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 <filename block>
;;; 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=<calerr>
.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-<ln-<ln/5>*5>>*7>+1>_14>>,,<buf+<ln/5>>> 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 <jrst label>
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 <CHANNEL>,[ASCIZ /STRING/]
uuodef outstr,istrt ;OUTSTR <CHANNEL>,[<bp [<string>]]
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 ;<AC> 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 <previous contents of loclst>
;; ;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 ; -<length>
movns a ; <length>
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 -<size>
jumpge t,pwspte ; empty, just zero it
hlre x,pwsptr ; Get -<room>
sub x,t ; get -<room left>
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 -<room>
hlre tt,c ; Get -<length>
movns tt ; <length>
add x,tt ; Get -<remaining room>
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 <name> <optional arguments>
(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 <file>
prints a file. Files are in the format <device>:<directory>;<name1> <name2>
where each field is six characters or less.
Device defaults to DSK:, <directory> 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 <varname>
You will be asked if you wish to set it. If so, you will be
prompted for additional information.
Do "VAR <cr>" 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 <creator> [-BRIEF]
All the accounts created by <creator> 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 <user> <cargs> <CR> prints info on a single user.
PRINT * <cargs> or :PRINT<CR> 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<CR>
-nodate Don't list the creator and modifier (and dates)
What is printed for a user without the -ALL option is as follows
<UNAME> <group> <state> <pw> <FLAGS> TU <human-style-name> <login date>
Creator: <uname> <date; Last modification: <uname> <date>
The T column is his INQUIR group, the U column is his INQUIR affiliation.
<group> is one of the 16 different user groups listed by the GROUP command.
<state> is one of the following: [NEW] [APL] [OK] [RFS] [HLD] [OFF] [SYS]
<pw> 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 <user> <message>^C sends <message> to <user> immediately
if he is logged in. If he is not logged in or is not receiving
messages, it will be mailed. The <message> 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 <name>@<site>,<name>@<site>,....
<name> is the user you want to find out about, or everyone at that site
if you omit it. "@<site>" 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 <user>
<altmode>H?
/
command prmail,,kprmai,(%coarg),,,/Read a user's mail.
/,/:PRMAIL <user>
prints a users mail file.
/
command prsend,,kprsen,(%coarg),,,/Print a user's SENDS file.
/,/:PRSEND <user>
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 <directory name>
prints a file. <directory name> 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 <msgbfl+4>/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)
<setz>+<errret>+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 <uname> [<options>]"
/
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<cr>.
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 <UNAME> 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 <UNAME> 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 <uname>"
/
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,?,<CR>,^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
<CR> -- 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<CR> ?
jrst [type dspc,/ADo :LOGIN <NAME>
/
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] ;<our version #>
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<CR>^F
movem x,fd.dev ;reset it to it's default
setzm x,fd.fn1 ;this should work for ML^F ^R<CR> ^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 <topic>
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 <a+1>,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,<tmpag1_12>(tt) ;and put in right half for blt
hrli tt,jclbuf ;get our source for the BLT from the JCLPTR
blt tt,<tmpag1_12>-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 <JOB> 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,[-<tsrcnt-1>,,<tsrtab+1>]
.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] ;<our version #>
] ;; 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 <n>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 ; <alt>^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 ; <alt><alt>^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 /]
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 <username> <cr> <message> ^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,<<<impend+1777>/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 <description of the problem> ^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_<x-44>>\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 <lsuset-lodblk> ;flush our memory
.CALL <lcalbk-lodblk> ;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-lodblk>
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,/ /
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,/ </ ; end of name
setom mdlflg
typout dsko,[tp$6bt uname] ; tell the UNAME involved
setzm mdlflg
type dsko,/ at /
6type dsko,machin ; tell where
type dsko,/>
To: USER-ACCOUNTS at /
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 /KA/] ;is it KA?
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,[<<iuname/2000>*2000>,,tmpag1*2000]
blt t,<tmpag1*2000>+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,[-<<<corend+1777>/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
Reference in New Issue View Git Blame Copy Permalink