From 09071f86007113e12c90c55cf54f7dde2b049dd3 Mon Sep 17 00:00:00 2001 From: Eric Swenson Date: Fri, 25 Nov 2016 13:16:11 -0800 Subject: [PATCH] Added support for NAME, FINGER, and its aliases. Also added support for the remote FINGER service. Note that this commit includes the INQUIR database INQUIR;LSR1 >. This is needed for various programs that use the LSRTNS library. --- Makefile | 3 +- README.md | 1 + bin/inquir/lsr1.empty | Bin 0 -> 5420 bytes build/build.tcl | 24 +- doc/_info_/name.order | 140 ++ src/sysen2/name.558 | 3857 ++++++++++++++++++++++++++++++++++++++++ src/sysen2/tvkbd.rooms | 64 + 7 files changed, 4087 insertions(+), 2 deletions(-) create mode 100644 bin/inquir/lsr1.empty create mode 100644 doc/_info_/name.order create mode 100755 src/sysen2/name.558 create mode 100644 src/sysen2/tvkbd.rooms diff --git a/Makefile b/Makefile index fca7bfb9..afbb01ba 100644 --- a/Makefile +++ b/Makefile @@ -2,7 +2,8 @@ EMULATOR ?= simh SRC = system syseng sysen1 sysen2 sysnet kshack dragon channa midas _teco_ emacs rms klh syshst sra mrc ksc DOC = info _info_ sysdoc kshack _teco_ emacs emacs1 -MINSYS = _ sys sys2 sys3 device emacs _teco_ sysbin +MINSYS = _ sys sys2 sys3 device emacs _teco_ sysbin inquir + RAM = bin/boot/ram.262 NSALV = bin/boot/salv.rp06 DSKDMP = bin/boot/dskdmp.rp06 diff --git a/README.md b/README.md index 4f6dc2f6..568b1538 100644 --- a/README.md +++ b/README.md @@ -85,6 +85,7 @@ from scratch. - SUPDUP, Supdup client - FTPS, FTP Server - FTPU, FTP Client + - NAME, Shows logged in users and locations, aka FINGER 6. A brand new host table is built from the host table source and installed into SYSBIN; HOSTS3 > using H3MAKE. diff --git a/bin/inquir/lsr1.empty b/bin/inquir/lsr1.empty new file mode 100644 index 0000000000000000000000000000000000000000..9242ce7e0479254ab750c4b36430a217546e61cf GIT binary patch literal 5420 zcmeHL-D(q25T0NPDOgN3rAQD?ttGp-UAAdcgIL&Q6YawOq%o07Zd^**U6bsVCjPuZ zE_{GKlb0eQzJo|^ybzV+%*nQRqj)Qvft@q^%{S-FeCO_b-+o)PSaYeQ+&);(7XU3! zZs8(;!VJTlaIHI(LdyZ1=9dAYJot_a&}e#rFEX5eh6VeAXA|~CB!uf-&El7|-x~dt zDYARd&~q|eVV$rZMLWGBdXXS(K-k=R2CkPCbpaCP)ii>fNxwhG=i0k#*c}XfU5m>E z683&-WDLTiMVeP|MRS5%LTJuid4LgN&sUWU`*3SN!vF>9(s^K6);eWWL z%jqknvdQ@m2uK;YE4*}40jYpgKq?>=kP1izqyka_sen{KDj*e*3P=T{0)JCr25&f5 zRC>JAm^F;UF*{Drzz;f1@w=|eDwt8>q2o3j_NX0nTddu5t&Z3;Nm-ioAxS4uoSZ;K zK`z7ZaoeWF4m_qaMO7h*hhPG}3%2{C@N6)?&wMKM4#Dvcx=x$bw~g9Xb<+?AifVc` z7Mh+*zTq)EZU!mmy1j38bZGQPX`(SZ3McS~-mGDmz)?CHy-4Dta1y7<7%bQF;c0)2 r??)EyNEFj@1kCEYMy+~pbE{U{-KoO-985Cm#PkmFYlxX=aE0?\r" +respond "*" ":copy inquir;lsr1 empty,inquir;lsr1 >\r" + +respond "*" ":copy sysbin;name bin,sys;ts name\r" +respond "*" "name\033j" +respond "*" "\033l sys;ts name\r" +respond "*" "debug/" +respond "-1" "0\r\033g" + +respond "*" ":link sys1;ts when,sys;ts name\r" +respond "*" ":link sys1;ts whoare,sys;ts name\r" +respond "*" ":link sys1;ts whois,sys;ts name\r" +respond "*" ":link sys1;ts supnam,sys;ts name\r" +respond "*" ":link sys1;ts finger,sys;ts name\r" +respond "*" ":link sys;ts f,sys;ts name\r" +respond "*" ":link sys2;ts n,sys;ts name\r" +respond "*" ":link device;tcp syn117,sys;ts name\r" + respond "*" ":link kshack;good ram,.;ram ram\r" respond "*" ":link kshack;ddt bin,.;@ ddt\r" respond "*" $emulator_escape diff --git a/doc/_info_/name.order b/doc/_info_/name.order new file mode 100644 index 00000000..f4bfe1e7 --- /dev/null +++ b/doc/_info_/name.order @@ -0,0 +1,140 @@ +10/77 +The NAME program. + +NAME is a program whose major function is to provide +more information about users than other available programs +such as WHO, PEEK etc. which deal only with logged in +users and bascially only give the UNAME, JNAME and tty no. +of a user. NAME however gives the persons full name in +addition to his UNAME, and the tty no. is further augmented +by giving the physical location of the terminal. + +The NAME program accepts as a command line a specification +concerning what users it should return information on. +The most common use of the program is to obtain a listing +of everyone logged in. This is easily accomplished by +typing NAME or :NAME at DDT. The next simplest form +of a command line is to list several user names and/or +tty no. (Tnm) separated by commas. In this case NAME will +give information on only those users given in the command +line. Thus, ":NAME foo,bar,t23" +causes NAME to return information of users foo and bar and +then tty no. 23. Two "user names" are special when used +here; they are "*" and "*NET" which cause NAME to generate +info on all logged in users and all users logged in through +the ARPA network respectively. Thus "NAME " is equivilant +to ":NAME *". + +Partial matching: + NAME normally returns all full matches to a given name; +however, it can also return "partial" matches by ending the +name with a dash or three periods; thus, + :NAME SMI-,DO... +would find all users whose names begin with "SMI" or "DO" and will +catch SMITH and DOE for example. + +Exact matching, weird names: + Names can be quoted and an exact match forced by enclosing +the name within double-quotes. In particular no partial matching +is done; thus one may safely say + :NAME "Foo-" +and not worry about NAME's trying to find everyone whose name starts +with FOO. This is also a reasonable way of passing strange things +on to other sites, as in "Foo/sw @file"@SAIL. + +The format of a basic NAME listing of a logged in user is: + {.}T +Here is name the user logged in under. His actual +name is looked up in a file of authorized users and given +in the field. is the name of the user's +current job; i.e. the job in his tree which currently has +the tty. is the length of time elapsed since anything +was last typed at the user's terminal. A "." will optionally +follow the idle time iff there are no jobs in the user's tree +which are running. Next the terminal no. for the user is +listed followed by a description of its location. For network +terminals the site from which the user is coming is listed +as the tty description. For local STYs either the UNAME and +JNAME of the controlling procedure is given or a description +of the "daemon" which has it open. + +There are switches controlling the information listed: + /A - Abbreviate, will inhibit NAME from printing the full name of a user + (useful when using the program to see if someone you already + know is logged in) +/J - Job number, will include the job no. of the user's HACTRN + just before the jobname field. +/W - WHOIS, prints lengthy information about all users specified. +/T - Time or When, prints last logout time of users specified. + +For logged out users the following information is displayed: + Not logged in. +If either ; plan or com: plan exists +then has the value "Plan:" followed by the first page +of that file. If the file doesn't exist then has the +value "No plan." This feature is useful for specifying your +intended whereabouts if you intend to be gone for a few days. + +NAME also has the capability to ask other sites for name-style +information. It passes as a command line to the other side just +the portion of its commnand line which pertains to the foriegn +host and prints the output from the other side. The format of +the command line to request information from another site is +"foo,bar,...,@site1,user1,user2,...,@site2..." which would print +information on foo,bar, etc. locally and then request +information from site1 on user1,user2 etc. and then from site2 +and so on. Three "site names" have special meaning, *, *LISPM, +and *ITS which specify all sites which support NAME servers, all +LISP machines, and all ITS sites respectively. Thus ":NAME +@*ITS" will give a name listing for each of AI, ML, and DM. +Note that the command line applicable to a specified host is +passed directly to it to interpret; that host may not interpret +the command line in quite the same way as set forth in this +memo. Since the ITS sites all use the same program there is no +difficulty when using all the allowed features. SAIL does not +allow the "user names" * or *ARPA, nor does it recognize any jcl +switches. + +;;;;;;;; SU-AI "FINGER" DOCUMENTATION - FINGER.LES[UP,DOC] ;;;;;;;;; + +13 Oct 1975 FINGER by Les Earnest + +The system command "FING" shows data on all jobs, in order by +programmer initials. The "IDLE" column shows the time, in minutes, +since the given job was last in the RUN queue. If the job is +currently in the STOP queue, a "." follows. + +The command "FING " shows data only on the specified people. +For example, "FING JMC,DAVE,HERSK" requests information on programmer JMC +and anyone whose first or last name begins with "DAVE" or "HERSK". +String matching uses the following precedence: + 1) exact match on programmer initials, + 2) exact match on friendly or last names, + 3) match on leading characters of friendly or last names. +If a given string matches more than one person at a given level, it +reports "ambiguous" and lists their names. + +For people who are not logged in, it tells when they last logged out +and shows their plan file, if any. + + FILE LISTS +Arguments in the FINGER command are separated by commas and/or spaces. +An argument of the form "@" causes that file to be read. +Files can include references to other files, ad nauseum. In files, +everything to the right of a semicolon on a given line is ignored, +so that comments can be put there. + +The default file extension is "DIS" and the default PPN is "[P,DOC]". +Thus if you say "FING @H", it will first look for a file in you area +called "H". If that doesn't exist, it will next try "H.DIS" in your +area and, if necessary, "H.DIS[P,DOC]", the latter being the list of +hand-eye people which is kept in [P,DOC] along with other group lists +(see SAIL Telephone Directory). + + SWITCHES +The argument list may also contain switches of the form "-PLAN" or +"-LOGOUT", which suppress the output of plan files and times of +last logout, respectively. These may be abbreviated to as little +as "-p" and "-l". Thus, if you give the command "FING @VB @M-L" +you will get information only on people in the Volleyball and Music +Groups who are logged in. diff --git a/src/sysen2/name.558 b/src/sysen2/name.558 new file mode 100755 index 00000000..7e811f94 --- /dev/null +++ b/src/sysen2/name.558 @@ -0,0 +1,3857 @@ +;-*-MIDAS-*- +.symtab 7123.,7321. +TITLE NAME PROGRAM + +f=0 ;flags +a=1 +b=2 +c=3 +d=4 +e=5 +t=6 +tt=7 + +l=10 +u1=11 ; UUO ac +u2=12 ; UUO ac +u3=13 ; UUO ac +u=14 ;user index into sys core +i=15 ;random index into sys core +x=16 +p=17 ;pdl ptr + + +dkic==1 + +ntsicp==2 ;icp channel, server side. +ntsi==3 ;net in, server side. +ntso==4 ;net out ch no., same as tyoc. + +tyoc==4 ;terminal ouput channel +tyic==5 ;tty input (solely to interrupt on) +%tyob==1_tyoc ;interrupt mask bits. +%tyib==1_tyic + +ls1c==6 ;channel for keeping LSR1 open so we can map in pages. + +plic==7 ;ch no. for reading plans. +nticp==10 ;user side icp channel +ntic==12 ;user side net in. +ntoc==13 ;user side net out. + +usrich==11 ;usr job input channel + +ubpfj==10 ;mode bit for USR open to prevent reowning + +icpsoc==117 ;socket to connect to for icp. + +ifndef maxkbd,maxkbd==100 ;maximum # of keyboards +mapmsk==574377776000 ;$t; in ddt types out 10-11 interface map entry + +ifndef maxtty,maxtty==100. ;max # tty's we can handle. +ifndef nontty,nontty==120. ;plus this many non-tty entries (i.e. Lisp machines) + +define type str + typz [asciz/str/] +termin + +DEFINE SYSCAL A,B + .CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))] +TERMIN +CIMM==1000,,0 +CRET==2000,,0 +CERR==3000,,0 +CTL== 4000,,0 +CTLI==5000,,0 + +DEFINE PUSHAE AC,LIST +IRP LOC,,[LIST] +PUSH AC,LOC +TERMIN +TERMIN + +DEFINE POPAE AC,LIST +IRP LOC,,[LIST] +POP AC,LOC +TERMIN +TERMIN + +DEFINE ASCSTR STR +.LENGTH STR +440700,,[ASCIZ STR]!TERMIN + +DEFINE MDBPT AC,FOO +ADD AC,[70000,,0] ;increase p +CAIG AC,0 ;skip, + SUB AC,[430000,,1] ;unless went off edge, in which case reset. +TERMIN + +;random byte pointers + +$opcod==331100 ;op code in instruction +$acfld==270400 ;accumulator field +$xfld==220400 ;idx field + +$ercod==220600 ;error code for .status + +$rchost==001100 ;host no. taken from .rchst + + +;flag bits in LH of F +%svrmod==400000 ;program is server. +%chasrv==200000 ;program is a chaosnet server to boot +%chausr==100000 ;talking to a chaosnet host +%netusr==20000 ;include all users from network in listing +%astflg==10000 ;all logged in users should be printed. +%astlsp==4000 ;all users on included lisp machines should be printed. +%nottv==400 ;set if this tty is not a tv +%uname==100 ;while uname is being read +%nignr==40 ;tmp flag used in jcl parsing +%rqmod==20 ;handling request for info from network +%supd==10 ;supdup trying to find out its terminal ID +%rcrs==4 ;set if we've printed "[uname jname]" for this user +%tcpsrv==2 ;program is a tcp server to boot + +%DM==4 ;set when on MIT-DMS (only during startup) + +;flag bits in RH +%getus==400000 ;set when local site appears in JCL +%getnt==200000 ;set when foreign site appears in JCL +%nojcl==100000 ;set when no JCL to be read +%astf1== 40000 ;flag seeing if any name found in JCL. + ;Prevents %astflg from being set by default. +%quot== 20000 ;flag saying name being matched should be exact. +%alllm==10000 ;include ALL lisp machines, not just those for this ITS. + +%jobnof== 4000 ;include job no. in listing +%abbrev== 2000 ;omit full name field on listing +%whois== 1000 ;all info available on specified users. +%nelsp== 400 ;show associated lispms +%ctlq== 200 ;used by ^Q quoting hack. +%qtmod== 100 ;used in parsing JCL item within quotes. +%getsw== 40 ;set when switches appear in JCL. +%when== 20 ;only interested in login/logout times. +%usetcp== 10 ;should use tcp when opening a connection + +;the memory map for this crock + +; Pages Area +; 0 - purpgb impure variables +; purpgb - purpge the program (pure) +; ttpage the TTLOC data file (2 pages) +; ls2org - ? the LSR data (pure), followed by the HOSTS1 data (pure) +; hiporg - hiporg+itspgs-1 absolute its pages + + ;note, 300000 is not enough to get all user variables on mc +itspgs==400000/2000 ;# its pages +hiporg==200 ;page # of origin of high ITS pages + +;; Definitions for purifying and relocating variables into +;; impure low core. BVAR and EVAR should bracket each group of +;; variables, which by definition are impure. +;; PURPGB specifies page # beginning pure code; PURPGE is the +;; first page after pure code and is determined at end of assembly. + +purpgb==4 ;start pure code on 4th page. +%%pbeg==2000*purpgb + +define bvar +ife %%vpar,.err BVAR inside BVAR! +%%vpar==0 +%%vsav==. +loc %%vend +termin + +define evar +ifn %%vpar,.err EVAR without BVAR! +%%vpar==1 +%%vend==. +ifle %%pbeg-%%vend,.err Impure overflow! +loc %%vsav +termin + +%%vpar==1 ;initialize B/EVAR macros. +%%vend==100 ;start impure here. +%%vsav==%%pbeg ;start pure here. +;;;;;;;;;;;;;;;;;;;;;;;;;;; + +loc 41 + pushj p,uuoh +loc 42 + -lintblk,,tsint +loc %%vsav + +BVAR +pat: patch": block 100 +EVAR + +popaj1: aos -1(p) +popaj: pop p,a +apopj: popj p, + +crlf: asciz / +/ +BVAR +ownhst: 0 ; # of our own site + 0 ; it can have two numbers on two networks (rather a kludge this) +hstcur: 0 ; # of host currently hacking (JCHIT checks this) +hstic: 0 ; # of "sticky" host at any given time +option: 0 ;holds job's .OPTION variable +tcmxh: 0 ;line length of our tty. +lxunm: 0 ; holds user's xuname (good for debugging) +lxjnm: 0 ; xjname. Note also DMPUNM/JNM. +nlstty: 0 ;number of last sty-type tty (plus one). +nl11ty: 0 ;number of last tv tty (plus one). +beglen: 0 ;# of chars taken up by all but the "console location" field +done: 0 ;byte pointer to point in jcl to continue from, or zero +usetcp: 0 +usencp: 0 +debug: -1 ;non-zero means don't dump self out + ;(so as not to clobber old version) +sysid: 0 ;holds current ITS version syms are good for + +EVAR ; Following stuff is pure. +dmpunm: 0 ; holds XUNAME of user who dumped this pure image +dmpjnm: 0 ; xjname thereof. + +define syms list + irps foo,,[list] + squoze 0,foo +foo: 0 +termin +0 +termin + +;constant syms (not addrs) +cnstb: syms [nct:nfstty:nsttys:nf11ty:n11tys:lublk:] + + ;400000(u) +usrxtb: syms [uname:xuname:usysnm:jname:ttytbl:tt11p:utmptr:suppro:] + + ;400000(i) ;FOO! Some of these shouldn't be indexed by anything +ixtb: syms [ttysts:stysts:ttytyp:ttitm:time:shutdn:sysdbg:] + +evaler: move d,@(p) ;get addr to be iored into what eval gives + aos (p) ;increment to get next arg + move c,@(p) ;get addr of sym table +evalup: move b,(c) ;get squoze for sym + jumpe b,popj1 ;thru + .eval b, ;get addr for it + tdza b,b ;undefined make it all zero + ior b,d ;otherwise ior addr into it + movem b,1(c) ;store in right place + addi c,2 ;increment index + jrst evalup ;back for all +popj1: aos (p) + popj p, + +;Request various of NETWRK's routines. +$$HST3==1 ; Use HOSTS3 now. +$$ARPA==1 ;Hack the ARPAnet +$$TCP==1 +$$CHAOS==1 ;Hack the CHAOSnet +$$ALLNET==1 ;Lookup routines will handle any host +$$SYMLOOK==1 +$$HOSTNM==1 +$$HSTSIX==1 +$$HSTMAP==1 +$$OWNHST==1 +$$CONNECT==1 +$$ICP==1 +$$SERVE==1 +$$ANALYZ==1 + +.INSRT SYSTEM;CHSDEF +.INSRT SYSENG;NETWRK + +putchr: .iot tyoc,t + popj p, + +;get routines for searching INQUIR;LSR1 > +$$HSNM==1 +.insrt syseng;lsrtns + +;Network-number info +;NW%CHS==:7 ;Chaos net +;NW%ARP==:12 ;Arpa net +;NW%DLN==:26 ;Dial net (not supported by these routines) +;NW$BYT==:331000 ;Byte pointer to network number + +init: tlne f,%svrmod+%supd ;server shouldn't print anything + jrst init1 + movei a,[asciz /Initializing-- +/] + skipn debug ;different msgs depending on whether dumping + movei a,[asciz /New sys, must initialize-- +Take paws off keys and wait +/] + iot tyoc,(a) + ;first, unpurify so that won't get PURPG errors in various places. +init1: move a,[,,purpgb] + move b,[%cbndr+%cbndw+%cbprv] ;new bits. + pushj p,corcpy ;bleah. go copy core by hand since %CBCPY loses. + setz a, + move b,[-itspgs,,hiporg] ;AOBJN args to CORBLK must be writable! + syscal corblk,[ + [200000,,0] + [-1] + b + [400000] + a] + jsr error + pushj p,evaler + 400000(u) + usrxtb + pushj p,evaler + 400000(i) + ixtb + pushj p,evaler + 0 + cnstb + + move a,nfstty ;want # of last sty + add a,nsttys + movem a,nlstty ;store it (note symbol not an its one) + move a,nf11ty ;ditto for pdp11 tv's + add a,n11tys + movem a,nl11ty ;store (note symbol not an its one) + move a,nct + caile a,maxtty + jsr error + pushj p,gttys + .rsysi a, ;get sys. version of these syms + movem a,sysid + move a,lxunm + movem a,dmpunm ; save dumper's uname + move a,lxjnm + movem a,dmpjnm ; and jname, in pure core yet. + tlne f,%svrmod+%supd ;server? + popj p, ;yes, don't dump, don't print anything. + move a,[-,,purpgb] +; purify code. + syscal corblk,[cimm %cbndr ;make read-only + cimm -1 ? a ;into self, as specified by AOBJN + cimm -1] ;from self. + jsr error + +; Now we must flush the TTLOC data and substitute a fresh all-zero page +; in case the database is missing at time of initialization. +; Due to the ITS core allocator lossage that doesn't guarentee fresh pages +; when there's a page already there, we must delete the page first. + + syscal corblk,[cimm 0 ? cimm %jself ? cimm ttpage] + jsr error + syscal corblk,[cimm %cbndr\%cbndw ? cimm %jself ? cimm ttpage + cimm %jsnew] + jsr error + + syscal corblk,[cimm 0 ? cimm %jself ? cimm ttpage+1] + jsr error + syscal corblk,[cimm %cbndr\%cbndw ? cimm %jself ? cimm ttpage+1 + cimm %jsnew] + jsr error + + skipe debug ;debugging? + jrst initdn ;yes, don't dump + .suset [.roption,,a] + tlnn a,optddt ;don't valret unless there is a ddt! + jrst initdn + .value [asciz / :pdump sys;dsk:ts name +p/] + +initdn: iot tyoc,[asciz /Init done +/] + popj p, + + ;simulate existence of %CBCPY. +corcpy: syscal corblk,[cimm %cbndr+%cbndw ? cimm -1 ? cimm usrpag ? cimm %jsnew] + jsr error + hrlz c,a + lsh c,10. ;get addr in LH + hrri c,usrfil + blt c,usrfil+1777 ;copy page by hand. + hrrz c,a + syscal corblk,[B ? cimm -1 ? C ;replace page with copied page. + cimm -1 ? cimm usrpag] + jsr error + syscal corblk,[cimm 0 ? cimm -1 ? cimm usrpag] ;flush scratch page. + jsr error + aobjn a,corcpy ;repeat as necessary. + popj p, + + +BVAR +errcod: 0 +error: 0 ; JSR here when fatal error happens. + skipe debug + .value + tlne f,%svrmod + jsr exit ;if server, just die for now. Perhaps later report it. + + ; We're going to dump. Save some info. + movem a,asave ; save ac (don't smash pdl) + .suset [.rbchn,,bchn] + hrlz a,bchn + add a,[.rios,,ios] + .suset a + move a,asave + .value [asciz : Urk! AAAAAAIIIIIEEEEeeeeeeeeee...  +:SL SYS;TS NAME +:PDUMP CRASH;NAME > +:BUG NAME A NAME crash was just dumped to CRASH;NAME > !! +: Sorry about that. If you have any idea why this crash +happened or how to reproduce it, please do another :bug name +and tell us... +] + jsr exit ;if continued, die outright. + +asave: 0 ; temp +bchn: 0 +ios: 0 + + + +exit: 0 + tlne f,%tcpsrv + jrst exit1 + tlne f,%chasrv + syscal force,[cimm ntso] + jrst exit2 + syscal pktiot,[cimm ntso ? cimm [%coeof_28.]] ;send eof + jrst exit2 +exit1: syscal finish,[cimm ntso] ;and wait for all data to get through + skipa ;dont need to close if other side did +exit2: .close tyoc, ;in case it was translated, close it before .value. + skipe debug + .value + .logout ;logout will close network connections if any. + .break 16,344000 +EVAR + +go: setz f, ;initialize flags + move p,pdl ;initialize pdl + .suset [.roption,,a] + tlo a,optint + .suset [.soption,,a] + movem a,option ;save + move a,[-3,,[.smask,,[%piioc+%pimpv+%pipdl] + .rxjname,,lxjnm + .rxuname,,lxunm]] + .suset a + move b,lxjnm + camn b,[sixbit /WHEN/] + tro f,%when + came b,[sixbit /WHOARE/] + camn b,[sixbit /WHOIS/] + tro f,%whois + camn b,[sixbit /SUPNAM/] + tlo f,%supd +go1a: syscal sstatu,[repeat 5,[ ? cret a ] ? cret a] + jsr error + came a,mname ;same sys as initialized before? + setzm sysid ;no, then assure we will init + movem a,mname + camn a,[sixbit/DM/] + tlo f,%dm ;we're on DM. (In the Twilight Zone...) + move a,[netwrk"nw%chs] ;Get Chaosnet address of own site + pushj p,netwrk"ownhst + seto a, + movem a,ownhst + move a,[netwrk"nw%arp] ;Get Arpanet address of own site + pushj p,netwrk"ownhst + seto a, + movem a,ownhst+1 + skipge ownhst ;Make sure if any network address, ownhst is one + movem a,ownhst ;It must also be the one preferred by HSTLOOK, which is Chaos currently. + .suset [.runame,,a] + hlros a + aojn a,goa + .suset [.rjname,,a] + came a,[sixbit /rfc117/] + camn a,[sixbit /netrfc/] + jrst server + camn a,[sixbit /tcp/] + jrst tcpsrv + camn a,[sixbit /chaos/] ;chaosnet NAME + jrst chasrv + jrst goa ;jname is not NETRFC or RFC117 so is normal NAME + +tcpsrv: tlo f,%tcpsrv ;we happen to be a TCP server +server: tlo f,%svrmod ;we are in server mode. + trz f,%when\%whois ;turn off other modes set by random xjname + tlz f,%supd + tlne f,%dm ;if on dm, then dedemonize us. + syscal stdmst,[['rfc105] ? [-1]] + jfcl + movei a,ntsicp ;1st channel of three (icp, in, out). + movei b,icpsoc ;socket # to listen on. + move c,[.uai,,.uao] ;input mode,,output mode + pushj p,[tlne f,%tcpsrv + jrst tcplsn + jrst netwrk"arpsrv] ;listen for and accept a connection. + jsr error + +;set up 'terminal' parameters for server +servr2: tlo f,%nottv + movei a,1000 ;linel for server + movem a,tcmxh + jrst goc + +chasrv: tlo f,%svrmod\%chasrv ;we are in server mode. + trz f,%when\%whois ;turn off other modes set by random xjname + tlz f,%supd + movei a,ntsi ;input channel + movei b,0 ;any host + movei c,[asciz /NAME/] ;contact name + movei d,5 ;window size + pushj p,netwrk"chalsn + jsr error + jrst servr2 + +goa: tlne f,%supd + jrst goc + tlz f,%svrmod ;we are not server. + .open tyoc,[.uao,,'tty] ;char unit out, disp. mode + jsr error + syscal ttyget,[cimm tyoc ? cret a ? cret b ? cret c] + jrst [ movei a,100000 ;"TTY:" isn't a terminal? It must have been translated. + movem a,tcmxh ;That's OK. + tlo f,%nottv + jrst goc] + .open tyic,[.uai,,'tty] ;Don't try to open tty input unless it's really a tty. + jsr error + tlz c,%tsmor ;do more processing + tlo b,030000 ;make ^G,^S interrupt. + syscal ttyset,[cimm tyoc + a ? b ? c] + jsr error + syscal cnsget,[cimm tyoc ? cret b ? cret tcmxh + CRET A ? CRET A ? CRET A] + jsr error + .suset [.simsk2,,[%tyib+%tyob]] ;enable tty interrupts + tlO f,%nottv ;assume not a tv + trnE a,%tp11t + tlZ f,%nottv ;IF ON A TV, CLEAR FLAG. +goc: .rsysi a, ;get version number of i.t.s. + came a,sysid ;skip if same as the one syms were int'ld with + pushj p,init ;else must re-initialize + syscal open,[%climm,,plic ? [sixbit /DSK/] ? [sixbit /TTLOC/] + [sixbit /DATA/] ? [sixbit /SYSBIN/]] + jrst gocx ; Punt, we've got a page there already + syscal corblk,[%climm,,%cbndr\%cbndw ? %climm,,%jself ? %climm,,ttpage + %climm,,plic ? %climm,,0] + jrst gocx ; Punt, we've got a page there already + syscal corblk,[ %climm,,%cbndr\%cbndw ? %climm,,%jself + %climm,,ttpage+1 ? %climm,,plic ? %climm,,1] + jfcl ; Punt, we've got a page there already +gocx: .close plic, + pushj p,ls2map ; map data in and anything else necessary + +;drops through + +;drops in. + move a,[hjtab,,hjtab+1] + setzm hjtab + blt a,hjtab+nnhsts-1 ;clear out table of hosts to hack. + trz f,%getus+%getnt ;clear both flags for local & net + tlne f,%supd + jrst supd0 + +;get our JCL from superior, or from net connection (if net server). + tlne f,%chasrv ;chaosnet server? + jrst jclcha + tlnn f,%svrmod + jrst jclgt4 + move a,[440700,,jclbuf] ;Get it from net connection. + movsi c,-jclbln ; length of JCL buffer in chars +jclgt2: .iot ntsi,b + idpb b,a + caie b,^M ;read till get a ^M from foreign site + aobjn c,jclgt2 ;or until count out. +jclgt3: hrrzm c,jclcnt ;store cnt + jrst jclgt8 + +;get our JCL from the chaosnet RFC. +jclcha: ldb c,[netwrk"pktbuf+$cpknb] ;get byte count + move d,[441000,,netwrk"pktbuf+%cpkdt] +jclch1: sojle c,jclgt3 ;nothing but contact name, store zero count + ildb b,d ;get character + caie b,40 ;until space + jrst jclch1 + caile c,jclbln ;maximum length of jcl + movei c,jclbln ;just truncate i guess + movem c,jclcnt + move a,[440700,,jclbuf] +jclch2: ildb b,d + idpb b,a + sojg c,jclch2 + jrst jclgt8 + +jclgt4: move a,option ;Get JCL from superior. + tlnn a,optcmd + jrst jclgt6 + .break 12,[..RJCL,,jclbuf] + setz c, + move b,[440700,,jclbuf] +jclgt5: addi c,1 + ildb a,b + jumpn a,jclgt5 ;count chars in JCL (assume ASCIZ - really need some + subi c,1 + movem c,jclcnt ;way of asking superior for count!) +jclgt8: pushj p,jcla ;chomp JCL to find what hosts to hack. + skipe hjtab + jrst ljcl ;if found at least one, go do them. + trne f,%getnt ;if only unknown hosts seen + jsr exit + trnn f,%getsw ;found none. skip if found switches, however. +jclgt6: tro f,%nojcl ;else there was no JCL to speak of. + tro f,%getus ;No JCL or just switches => do all users, like "*". + move a,ownhst + movem a,hjtab + jrst ljcl + +;get necessary information to grok own teletype +;for a SUPNAM job run as an inferior by a SUPDUP user program. +supd0: movei a,usrpag + movem a,ffpag + lsh a,10. + movem a,ffloc + pushj p,usrini + .suset [.rcnsl,,i] + move x,usrloc + movei u,0 ;don't try to record user info + pushj p,gotone ;gobble info about our own tty + jfcl + movei a,u%unam(x) ;get address that UNAME goes in + hrli a,.runame ;must have the UNAME to prevent TTCHK from + .suset a ;clearing + caml i,nfstty ;determine type of tty + caml i,nlstty + caia + jrst supd3 ;do sty hair + caml i,nf11ty + caml i,nl11ty + jrst supd1 ;vanilla + syscal tvwher,[cimm 400000(i) ? cret a] ;tv + jsr error + cail a,0 + cail a,maxkbd + jsr error + movei b,(i) ;get TTY # in B + push p,a + pushj p,ttchk ;get Byte Pointer to TTLOC info if any + caia ; No TTLOC info + jrst [ pop p,a + jrst supd2] ; It's there, use it + pop p,a + move a,kbddoc(a) +supd2: move f,['TERMID] + .break 16,105 + +supd1: movei b,(i) ;get TTY # in B + pushj p,ttchk ;get Byte Pointer to TTLOC info if any + move a,ttydoc(i) + jrst supd2 ; It's there, use it + +supd3: move e,[440700,,supdid] ;byte pointer for hstout to store cruft + movei i,39. ;# characters + movem i,tcmxh + setzm beglen + pushj p,hstout ;hope this guy's typeout gets intercepted + setz x, + idpb x,e + move a,[440700,,supdid] + jrst supd2 + +;If the local host is among the hosts to be processed, +;extract all JCL entries which apply to it, then process them all. +ljcl: trne f,%getnt ;were any foreign sites specified? + trne f,%getus ;If foreign sites spec'd and local not spec'd, + caia + jrst fjcl ;don't do local site at all. + move b,ownhst + movem b,hstcur ;set self up as current host. + trne f,%getnt ;will we be doing any foreign sites later? + jrst [ typi "[ + pushj p,netwrk"hstsrc + .lose + typz (a) ;yes, so type out name in regular fashion. + typi "] + typz crlf + jrst .+1] + pushj p,usrini ; initialize usr-info blocks. + trne f,%nojcl + jrst lclall ;if no JCL, do speedy "*". + pushj p,jclbeg ;set up for munching in + + ; routine gobbles all items and stores in tables + trz f,%astf1 ;clear flag to see if we should *. + setzm nspecs ;clear index for ptr storage +ljcl10: pushj p,jchitm ;get a JCL item for specified host. (us) + jrst ljcl20 ;EOF, all done with name collection + skipn a,itsw ;switch spec? + jrst ljcl15 ;no, skip switch search + + ;handle switches. + cail a,"a + caile a,"z + caia + subi a,40 ;make uppercase + movsi c,-njcsws +ljcl12: hlrz b,jcswtb(c) + cain a,(b) ;char matches switch in table? + jrst [ hrrz b,jcswtb(c) + tro f,(b) ;set flag in RH + jrst ljcl10] + aobjn c,ljcl12 + jrst ljcl10 ;ignore unknown switches + +jcswtb: "A,,%abbrev ;don't print full name + "J,,%jobno ;include job no. + "W,,%whois ;print complete info about user. + "T,,%when ;ugly switch choice, oh well. + "L,,%nelsp ;/L look on associated Lisp machines too + +commen ~ +There is now way this flag can be set in the manner intended. +:f /i@dm passes it on to DM, and :f @dm/i throws it away (I think) +If somebody can make it work, then they should probably rename it +to "N,,%usencp and fix the various places that use it. -dcp 2/6/83 + "I,,%usetcp ;try to use old NCP on arpanet +end commen ~ +njcsws==.-jcswtb + + ;handle names. +ljcl15: skipn b,itcnt ;ignore null names. + jrst ljcl10 + tro f,%astf1 ;indicate a name was given. + movei a,itcnt + ustrn a,[ascstr [,]] ;name of "," comes from a null name, as in :NAME ,@MC + caia + ustrn a,[ascstr [*]] ;* special -- like /m alone + jrst [ tlo f,%astflg ? tro f,%nelsp ? jrst ljcl10] + ustrn a,[ascstr [*NET]] ;special name? + jrst [ tlo f,%netusr ? jrst ljcl10] ;set flag, don't store. + ; By the looks of this this never worked -- Gumby +; ustrn a,[ascstr [*LISPM]] ;special name? +; jrst [ tro f,%alllm ? jrst ljcl10] ;set flag, don't store. + pushj p,namsto ;store name in various places + jrst ljcl10 ;back for another name + +ljcl20: skipe a,nsktty + jrst [ imul a,[-1,,0] + hrri a,sektty + movem a,whotty + jrst .+1] + skipe a,nskunm + jrst [ imul a,[-1,,0] + hrri a,sekunm + movem a,who + jrst .+1] + skipe a,nskfnm + jrst [ imul a,[-1,,0] + hrri a,sekfnm + movem a,whofnm + jrst .+1] + trnn f,%astf1 ;if name-found flag not set, +lclall: tlo f,%astflg ;turn on "*" action... + movei b,49. + trne f,%abbrev + movei b,25. + trne f,%jobnof + addi b,3 + movem b,beglen ;Compute truncation point. + move x,usrloc ;Initial index into table of users to print. + setzm tlusers ;Zero users to print so far. + trne f,%nelsp ;Ask lisp machines for status, as appropriate. + pushj p,lmfing + tdne f,[%astflg+%netusr+%astlsp,,] + pushj p,star ;If "*", gobble data on all logged in users. + skipn whofnm + skipe who + pushj p,whofnd ;Now find all users specified by uname or full name. + skipe b,whotty + pushj p,whoft ;Find all terminals specified by number. + pushj p,putout ;Output all the users in the tables. + trnn f,%getnt ;if there was no foreign site spec, + jsr exit ;die peacefully. + +;else drop thru to net hacking routines. + +;Having processed the local host if appropriate, +;we now loop over all the foreign hosts to be processes +;and for each one, extract the JCL data for it and send to server there. +fjcl: movsi c,-nnhsts +fjcl51: skipn a,hjtab(c) ;get a site + jrst fjcl54 ; Null, ignore and get another. + setzm hjtab(c) ;aha, found one. clear from table. + came a,ownhst ;ignore if self + camn a,ownhst+1 + jrst fjcl54 + movem p,savpdl ; Found valid site. Save stuff in case IOC rcvd. + movem c,savc + movei b,fjcl53 ; and set up return loc for IOC. + movem b,neterr + jrst fjcl55 ; and go hack site! + +fjcl53: move p,savpdl ; Return here from net stuff if hit an IOC. + move c,savc ; restore accs. +fjcl54: aobjn c,fjcl51 ; normal return comes here. + jsr exit ;die, none left to hack. + +fjcl55: movem a,hstcur ;store # as current host. + typz crlf ;split off from previous output. + typi "[ + push p,b + move b,a + pushj p,netwrk"hstsrc + jrst [ move a,hstcur + pushj p,typehn + jrst fjcl56 ] + typz (a) ;type official name of site. +fjcl56: pop p,b + typi "] + typz crlf + + ;attempt to setup appropriate stuff for contact name or line to server + +;;; I guess these "Resting In Pieces"s will not be going off anymore... +;;; Also, they will need to be changed when those IMP slots are reused. +;;; -- CSTACY 10 December 1983 +; I learned the hard way that CStacy had left this timebomb in here 5 years +; later. -Alan 1988 +; move a,hstcur +; came a,[1200400006] ;AI, R.I.P. +; camn a,[1200200006] ;DMS, R.I.P. +; jrst [ type [Requiescat in pace.] +; typz crlf +; type [May we please have a moment of silence ...] +; typz crlf ;most network programs do readline +; syscal finish,[cimm tyoc] ;force it out before sleep +; jfcl +; movei a,30.*5. ;5 second homage +; .sleep a, +; type [ Thank you.] +; typz crlf +; jrst fjcl] ;go do rest of sites + move a,hstcur + move t,[440700,,connam] + movem t,cnnptr ;initialize pointer to contact name + setzm cnncnt ;and byte count +; ldb t,[330600,,a] ;get network number + netwrk"getnet t,a ; Get network number + came t,[netwrk"nw%chs] + jrst fjcl49 ;arpanet or something + movei t,[asciz /NAME /] + pushj p,cnnstr + tloa f,%chausr +fjcl49: tlz f,%chausr ;assume not chaosnet + trne f,%whois ;special addition.. if WHOIS, make sure that + pushj p,[movei t,[asciz \/W \] ;switch gets sent! + jrst cnnstr] + trne f,%when + pushj p,[movei t,[asciz \/T \] ;ditto for WHEN-style. + jrst cnnstr] + trz f,%astf1 ;clear flg for "*" + pushj p,jclbeg ;initialize + caia +fjcl59: move p,pdl ;restore PDL if necessary (IOC err return) +fjcl60: pushj p,jchitm ;get item + jrst fjcl70 ;no more + skipe itsw + jrst [ movei tt,"/ ;switch? + pushj p,cnnbyt + move tt,itsw + pushj p,cnnbyt + movei tt,40 + pushj p,cnnbyt + jrst fjcl60] + skipn c,itcnt + jrst fjcl60 ;if null name, means "@" was given. ignore for now + troe f,%astf1 ;indicate some name was given. + pushj p,[movei tt,", ;if flag already set, separate name with comma + jrst cnnbyt] + move b,itptr + skipe itquot + pushj p,[movei tt,"" ;if quoted, give first quotemark. + jrst cnnbyt] + addm c,cnncnt +fjcl63: ildb a,b + idpb a,cnnptr + sojg c,fjcl63 + skipe itquot + pushj p,[movei tt,"" ;if quoted, give second quotemark. + jrst cnnbyt] + skipe itpmat + pushj p,[movei tt,"- ;if wants partial match, give trailing dash. + jrst cnnbyt] + jrst fjcl60 + + ;done with names if any... +fjcl70: pushj p,hicp ;try to perform ICP. + jrst fjcl ;failed. routine prints message, here just go back. + tlne f,%chausr + jrst fjcl72 + movei t,[.byte 7 ? ^M ? ^J] ;for the arpanet, output everything now + pushj p,cnnstr + move t,[440700,,connam] + move tt,cnncnt + syscal siot,[cimm ntoc ? t ? tt] + jsr error + syscal force,[cimm ntoc] ;make sure output gets sent + jsr error +fjcl72: pushj p,netin ;go copy net input to TTY + jrst fjcl ;when done, go back for more sites. + + ;initialize for a pass through JCL +jclbeg: push p,a + move a,ownhst ; initial "sticky site" is local. + movem a,hstic + move d,jclcnt ;count of chars in JCL buffer + move e,[440700,,jclbuf] ;ptr to jcl buffer + pop p,a + popj p, + +BVAR +itcnt: 0 ;cnt of chars in name of item +itptr: 0 ;ptr to name of item +itbrk: 0 ;char which broke scan +ithst: 0 ;either site # of item, or bp to 36-bit site #'s, terminated by zero. +itmhst: 0 ;non-zero for multiple-hosts flag +itsw: 0 ;if non-z, item was switch, holds switch char. +itquot: 0 ;if non-z, item was given inside quote-marks, wants exact match. +itpmat: 0 ;if non-z, item wants to be partially matched. +itbarf: 0 ;if non-z, complain if unknown host enountered. +EVAR + + ; JCITM - get an item. returns in itcnt, itptr, ithst, itbrk. + ; D has char cnt of string, E ptr to. + ;itsw has switch char if a switch, else zero. + +jcitm: pushj p,spfl ;flush spaces + jumpe d,apopj ;EOF? + pushae p,[a,b,c] + movem e,itptr ;save ptr +jcitm0: move c,e + ildb a,c ;check 1st char + setzm itsw + cain a,"/ + jrst [ sojle d,jcitm9 ;switch. munch it. + ildb a,c + movem a,itsw ;store switch char + move e,c ;update ptr + soja d,jcitm8] ;and return successfully + pushj p,jcwd ;get a word. returns brk char in A, cnt in itcnt + movem b,itcnt ;store cnt of word found + setzm itquot + setzm itpmat + trne f,%qtmod ;was it within quotemarks? + jrst [ setom itquot ;set flag if so. + setzm itpmat ;and don't allow partial match. + ibp itptr ;and point to char after ". + jrst jcitm3] + + ; Check for need to do partial matching + jumple b,jcitm3 ; obviously none if nothing collected. + pushae p,[a,e] + mdbpt e, ;decrement ptr to get last char in wd. + ldb a,e + cain a,"- ; is it "partial-match" terminator? + jrst [ setom itpmat ; if so, set flag for it. + sos itcnt ; and take dash off end. + jrst jcitm2] + cain a,". ; check for "..."; possible? + caige b,4 ; if so, make sure have enough. + jrst jcitm2 ; nope to either +repeat 2,[mdbpt e, + ldb a,e + caie a,". ; check first + jrst jcitm2 +] + subi b,3 + setom itpmat ; won, say partial matching. + movem b,itcnt ; store proper count (minus "...") +jcitm2: popae p,[e,a] + +jcitm3: caie a,"% ; either "%" or + cain a,"@ ; "@" indicates a site. + jrst jcitm5 ;broken by site specification! go parse it. + pushj p,jcitm7 ;broken by / => back up over it. + jumpe b,[jumpl a,jcitm9 ;else if nothing in word, it might be EOF, + caie a,", ;else ignore it unless terminated by a comma + jrst jcitm0 + aos itcnt ;in which case return "," as the name + jrst .+1] + movem a,itbrk ;save brk char +jcitm4: move b,hstic ;no host spec, so + movem b,ithst ;assign sticky one. + setzm itmhst + skipge b + setom itmhst ;BP's are negative => multiple hosts + jrst jcitm8 ;jump to switch-checker return. + + ;parse host spec that follows. +jcitm5: move c,e ;save ptr + pushj p,jcwd ;get next word. + movem a,itbrk ;save brkchar whatever it is. + jumpe b,jcitm4 ;if no host spec, assign sticky. + movei a,b ;insert addr of host "string" descriptor + ustrn a,[ascstr [*ITS]] ;skip if strings not equal + caia + ustrn a,[ascstr [ITS]] + jrst [ pushj p,itsnms + jrst jcitm6] + ustrn a,[ascstr [*LISPM]] + jrst [ movei a,hslm + jrst jcitm6] + ustrn a,[ascstr [LISPM]] + jrst [ movei a,hslm + jrst jcitm6] + ustrn a,[ascstr [*MIT]] + jrst [ movei a,hsmit + jrst jcitm6] + ustrn a,[ascstr [*CHAOS]] + jrst [ movei a,hschs + jrst jcitm6] + ustrn a,[ascstr [*VMS]] + jrst [ movei a,hsvms + jrst jcitm6] + ustrn a,[ascstr [*APIARY]] + jrst [ movei a,hsapes + jrst jcitm6] + ustrn a,[ascstr [*ROBOTS]] + jrst [ movei a,hsbots + jrst jcitm6] + ustrn a,[ascstr [*TWENEX]] + jrst [ movei a,hstnx + jrst jcitm6] + ustrn a,[ascstr [TWENEX]] + jrst [ movei a,hstnx + jrst jcitm6] + ustrn a,[ascstr [*]] + jrst [ movei a,hsall + jrst jcitm6] + pushj p,hanlyz ;analyze name, return host # in A + movei a,0 ;if error, use patently false site. + caia +jcitm6: hrli a,444400 ; 36-bit bytes + movem a,ithst ;store as host for this item + setzm itmhst + skipge a ;Skip if network number + setom itmhst ;BP's are negative, say multiple hosts + skipn itcnt ;if no name for item, + movem a,hstic ;set as new sticky site. + move a,itbrk + pushj p,jcitm7 ;if broken by /, back up over it. +jcitm8: aos -3(p) ;skip on return... +jcitm9: popae p,[c,b,a] + popj p, + +jcitm7: caie a,"/ ;if breaking char was JCL switch, + popj p, + mdbpt e, ;then back pointer up. + addi d,1 + popj p, + + + ; JCHITM - like JCITM, but returns only those items with host as + ;specified in HSTCUR. +jchitm: push p,a +jchit2: setzm itbarf ;Do not complain about unknown hosts + pushj p,jcitm ;get an item + jrst popaj ;no more + skipe itsw + jrst popaj1 + move a,ithst + skipn itmhst ;Skip if not a single host + jrst [ came a,hstcur + jrst jchit2 ;wrong site, get another item. + jrst popaj1] ;aha, found one! + push p,b +jchit5: ildb b,a + jumpe b,[pop p,b + jrst jchit2] ;jump if end of string + pushj p,hstlook ;convert what's in b to host number. + camn b,ownhst+1 ;this mostly all works the wrong way + move b,ownhst ;take the host that hstcur will prefer + came b,hstcur + jrst jchit5 + pop p,b + jrst popaj1 ;match... + +;Convert host name in B to host number in B. +;Host name can be a 1-word asciz string, or address of asciz string. +;Does not print anything if host is unknown. + +hstlook: + push p,a + push p,e ;hstlook clobbers E + push p,b + movei a,(p) ;B may contain host name in asciz, + tlnn b,-1 ;or if lh is 0, it is address of asciz string. + move a,b + pushj p,netwrk"hstlook ;convert to host number. + setz a, + move b,a ;return that in B. + sub p,[1,,1] + pop p,e + pop p,a + popj p, + +;auxiliary routines for JCITM. + + ; spfl - flush spaces from JCL string +spfl: push p,a + push p,b + jrst spfl3 +spfl2: move b,e + ildb a,e + cain a,40 +spfl3: sojge d,spfl2 + jumpl d,spfl4 + addi d,1 + move e,b +spfl4: pop p,b + pop p,a + popj p, + + ; jcwd - updates D, E, 1 past break char, leaves brkchar in A, cnt in B + ; item beginning with quote gets scanned up to next quote, and next char + ; is the "break" char. +jcwd: setz b, ;clear cnt + trz f,%ctlq+%qtmod + sojl d,[seto a, ? popj p,] ;before checking 1st char, make sure it's there + ildb a,e ;get 1st char to check for quoting. + caie a,"" + jrst jcwd2 ;if not quotemark, go into loop. + tro f,%qtmod ;if a quotemark, set mode! +jcwd1: sojl d,[seto a, ? popj p,] ;if EOF, brkchar is -1 + ildb a,e +jcwd2: trze f,%ctlq ;if single-char quoting, + aoja b,jcwd1 ;don't check for anything. + trne f,%qtmod ;are we in string quote mode? + jrst [ caie a,"" ;yes, is this char terminator of string? + aoja b,jcwd1 ;no, keep going. + sojl d,[seto a, ? popj p,] ;yes, is terminator. stop if EOF + ildb a,e ;get next char as brkchar. + popj p,] + cain a,^Q ;if quote char, + tro f,%ctlq ;set flag. + caie a,", ;if standard item breaker, + caig a,40 ;or a space or ctl char, + popj p, ;break. + caie a,"/ ;other break chars... + cain a,"@ + popj p, + cain a,"% + popj p, + aoja b,jcwd1 + + ; JCLA - analyze JCL to accumulate all site #'s we will have to + ;scan specifically for. + +jcla: pushae p,[a,b,c,d,e] + move a,[hjtab,,hjtab+1] + setzm hjtab + blt a,hjtab+nnhsts-1 ; clear host-has-JCL indicator table + trz f,%getus+%getnt + pushj p,jclbeg ;set up JCITM. +jcla10: setom itbarf ;complain about unknown hosts + pushj p,jcitm ;get an item + jrst jcla50 ;EOF, no more items. + skipe itsw + jrst [ tro f,%getsw ? jrst jcla10] + move c,ithst + move a,c + skipn itmhst ;Skip if only one + jrst jcla16 +jcla15: ildb b,c + jumpe b,jcla10 ;no more hosts, stop + pushj p,hstlook + move a,b +jcla16: came a,ownhst + camn a,ownhst+1 + troa f,%getus + tro f,%getnt + movsi b,-nnhsts +jcla20: skipn hjtab(b) + jrst [ movem a,hjtab(b) + skipe itmhst + jrst jcla15 + jrst jcla10] + camn a,hjtab(b) ;compare hst # with those already listed + jrst [ skipe itmhst + jrst jcla15 + jrst jcla10] + aobjn b,jcla20 + jsr error + +jcla50: popae p,[e,d,c,b,a] + popj p, + + + + ;stores item name in appropriate locations in appropriate forms. +namsto: pushae p,[a,b,c] + move c,nspecs + cail c,maxspc +; jsr error + jrst namst9 ; ignore until get error macro/uuo + lsh c,1 + move a,itcnt + move b,itptr + skipn itquot ;if was quoted, + skipn itpmat ;or if partial match not requested, + tlo a,400000 ;set sign bit as flag in cnt word. + movem a,namtab(c) + movem b,namtab+1(c) + hrrzs a + caile a,6 + jrst namst6 ;too long to be uname or Tnn. + movei a,itcnt + pushj p,ncvt6 ;convert string into 6bit + push p,a ; save 6bit + skipe itquot ;if name was quoted, never convert to TTY #. + jrst namst3 + tlc a,(sixbit /T0 /) + tdne a,[777000,,-1] ;test for Tn + jrst namst3 ;nope, uname. + tlnn a,77 ; see if anything in 2nd digit pos. + jrst [ lsh a,-30 ; no, just get single digit. + jrst namst2] + tlc a,'0 + tlne a,70 ; make sure char in 3rd pos is digit. + jrst namst3 ; nope + lshc a,-30 + lsh b,3 + lshc a,3 +namst2: aos b,nsktty + caile b,maxent + jsr error + movem a,sektty-1(b) ;say type is TTY. + pop p,a + jrst namst8 + +namst3: pop p,a + aos b,nskunm + caile b,maxent + jsr error + movem a,sekunm-1(b) + skipe itpmat ; was partial match requested? + hrros pmatnm-1(b) ; Set LH to -1 if so. + +namst6: movei a,namtab(c) + aos b,nskfnm + caile b,maxent + jsr error + movem a,sekfnm-1(b) + skipe itpmat ; partial match requested? + hllos pmatnm-1(b) ; set RH to -1 if so. +namst8: aos nspecs +namst9: popae p,[c,b,a] + popj p, + +BVAR +ifndef maxspc,maxspc==30 +nspecs: 0 ;# of specs stored in namtab +namtab: block maxspc*2 + +ifndef maxent,maxent==30 ;max # entries for any one type +nsktty: 0 ;cnt of ttys to look for +sektty: block maxent ;holds # of tty +nskunm: 0 ;unames +sekunm: block maxent ;holds 6bit of uname +nskfnm: 0 ;full names +sekfnm: block maxent ;holds ptr to namtab descriptor + +pmatnm: block maxent ; LH has uname switch, RH has full name switch for corresponding + ; entries in SEKUNM and SEKFNM. If switch is -1, partial + ; matches should be found. Otherwise, only exact matches. +EVAR + +ncvt6: pushae p,[b,c,d,e] + move c,(a) + move d,1(a) + setz a, + move e,[440600,,a] + jrst ncvt63 +ncvt62: ildb b,d + cail b,"a + caile b,"z + caia + subi b,40 + subi b,40 + idpb b,e +ncvt63: sojge c,ncvt62 + popae p,[e,d,c,b] + popj p, + +;Get data from Lisp machines. We use a Chaosnet simple-transaction with contact +;name FINGER. The first line of the response is the user ID, the second is +;the console location, the third is the idle time (as a string). + +;Look through the host table to find all the Lisp machines, +;or all Lisp machines associated with the machine we are on. +;Contact them eight at a time using all 16 I/O channels. +lmfing: pushae p,[a,b,c,d,e,t,tt] + .iopush ntsi, + .iopush tyoc, + .iopush tyic, + .iopush ls1c, + .suset [.rmsk2,,tt] + push p,tt + movei c,177777 ;Enable all I/O interrupts + movem c,lmintb + .suset [.smsk2,,c] + setz c, ;C has index into LMADRS. +ife 1,[ ;now we have reagan this works differently... + trne f,%alllm + jrst [ movei b,hslm ;Find the table of all lisp machines, or + jrst lmfin2] + ] + setz a, ;find the table of lisp machines +lmfin1: hllz b,hs10lm(a) ;associated with this machine. + jumpe b,lmfinx + came b,mname + aoja a,lmfin1 + hrrz b,hs10lm(a) ;B gets address of that table. +lmfin2: move a,b ;Each word of table is an ASCIZ string. Get address. + skipn (a) + jrst lmfin3 + move a,(a) + hrli a,440700 + push p,b + push p,c + pushj p,netwrk"hstlook ;Look it up as a host name. + setz a, + pop p,c + pop p,b + skipn a ;If we found one, + aoja b,lmfin2 + movem a,lmadrs(c) ;store it in LMADRS. + addi c,1 + caile c,nontty ;Complain if LMADRS gets full. + jsr error + aoja b,lmfin2 + +lmfin3: setzm nextlm + .rdtime t, ;Get starting time. Use at most 30 seconds for whole thing. + addi t,30.*30. + movem t,chstim' ;Time to stop + ;Now start 8 RFC's + movei a,16 +lmstr4: pushj p,lmrfc ;Ask eight lisp machines, to start with. + subi a,2 + jumpge a,lmstr4 + ;Collect results +lmstr6: movei a,16 ;Scan all the channels +lmstr7: .suset [.sdf2,,[0]] ;Enable for state-change interrupts + setzm lmintf ;Flag set if chsin1 didn't get latest poop + pushj p,chsin1 ;chsin1 processes any replies, + ;and when one lispm replies, + ;it reuses the channels to ask another one. + subi a,2 + jumpge a,lmstr7 + movsi a,-8 ;See if any channels still active + skipge chsidx(a) + aobjn a,.-1 + jumpge a,lmstr9 + .rdtime t, ;Yes, timed-out anyway? + caml t,chstim + jrst lmstr9 + movei t,30. ;No, delay momentarily and try again + skipn lmintf +lmintw: .sleep t, + jrst lmstr6 + +lmstr9: movsi a,-20 ;Close channels and return +lmstr8: .call [ setz ? sixbit/close/ ? setzi (a) ] + jfcl + aobjn a,lmstr8 +lmfinx: setzm lmintb + .suset [.saifpir,,[177777]] + .suset [.sdf2,,[0]] + pop p,tt + .suset [.smsk2,,tt] + .iopop ls1c, + .iopop tyic, + .iopop tyoc, + .iopop ntsi, + popae p,[tt,t,e,d,c,b,a] + popj p, + +;Enter an RFC to next Lisp machine on channel in A. +;Uses AC's a,b,t,tt +lmrfc: move t,a ;mark channel free + lsh t,-1 + setom chsidx(t) + move tt,nextlm ;Find next machine + caige tt,nontty + skipn b,lmadrs(tt) + popj p, + aos nextlm + movem tt,chsidx(t) + .rdtime tt, + movem tt,chsstm(t) + dpb b,[$cpkda+lmpkt] ;send RFC to this guy + movei tt,%corfc + dpb tt,[$cpkop+lmpkt] + movei tt,.length/FINGER/ + dpb tt,[$cpknb+lmpkt] + move tt,[.byte 8 ? "F ? "I ? "N ? "G] + movem tt,%cpkdt+lmpkt + move tt,[.byte 8 ? "E ? "R] + movem tt,%cpkdt+1+lmpkt + .call [ setz ? 'CHAOSO ? movei (a) ? setzi 1(a) ] + jrst [ setom chsidx(t) ? popj p, ] ;probably device full + .call [ setz ? 'PKTIOT ? movei 1(a) ? setzi lmpkt ] + jsr error + popj p, ;pick up answer later + +;Call here to check status of channel-pair in a +chsin1: ;set c to index into lisp-machine tables + move tt,a + lsh tt,-1 + skipge c,chsidx(tt) + popj p, ;channel not in use + .call [ setz ? 'WHYINT ? movei (a) ? movem b ? movem b ? setzm b ] + jsr error + hlrzs b ;number of input packets + jumpe b,chsin9 ;none yet + .call [ setz ? 'PKTIOT ? movei (a) ? setzi lmpkt ] ;Get the packet + jsr error + ldb tt,[$cpkop+lmpkt] + caie tt,%coans + jrst lmrfc ;Some lossage, ignore this machine + ;First line is UNAME in ascii + move b,[440800,,%cpkdt+lmpkt] + movei d,0 + move tt,[440600,,d] +chsin2: ildb t,b + cain t,215 + jrst chsin3 + caige t,140 + subi t,40 + tlne tt,770000 + idpb t,tt + jrst chsin2 + +chsin3: jumpe d,lmrfc ;Ignore if no one logged in there + movem d,lmunam(c) + ;Second line is console location in ascii + move e,lmdoc(c) + movei d,10*5-1 ;max characters +chsin4: ildb t,b + cain t,215 + jrst chsin5 + idpb t,e + sojg d,chsin4 + ildb t,b + caie t,215 + jrst .-2 +chsin5: ;Third line is idle time as a string + movei e,lmidle(c) + hrli e,440700 + movei d,4 +chsin6: ildb t,b + cain t,215 + jrst chsin7 + idpb t,e + sojg d,chsin6 +chsin7: jrst lmrfc ;find another guy + +chsin9: .rdtime t, + sub t,chsstm(tt) + caige t,4*30. + popj p, + jrst lmrfc ;timed out, give up on this guy + +;This routine adds lisp machine whose index is in i to user tables +lmadd: move t,lmunam(i) + movem t,u%unam(x) + movem t,u%xunm(x) + move a,lmadrs(i) + pushj p,netwrk"hstsix + jsr error + movem a,u%jnam(x) + movei t,maxtty(i) + movsm t,u%tty(x) ;fake tty# + movei tt,%ulgin + iorm tt,u%flgs(x) ;indicate this entry is logged in. + pushj p,addus4 ;make this entry real + popj p, + +;This is the basic unit of processing for local users. +;We have a large set of parallel tables, all indexed by rh(x). +;Each new user recorded gets an entry in those tables, and TLUSERS is incremented. +;Eventually, all the users in the tables are printed out. + +;Record user in rh(u) with tty in rh(i) in table slot in rh(x). +;It is the caller's responsibility to increment x and tlusers. +gotone: hrrz a,i ;get tty # + setzm u%svrj(x) ;will be zero if not net user + setzm u%tty(x) ;also make sure of this + caml a,nfstty ;is it a psuedo? + caml a,nlstty + jrst gotdat ;no, we have all info in u + + ;hack psuedo-tty... + sub a,nfstty ;tis a sty...find sty # + exch i,a ;use i for sty index temporarily + push p,u + move u,@stysts ;get sty info (i.e. who has this sty open) + exch a,i ;restore i + move b,@uname ;get uname and + movem b,u%aux1(x) + move a,@jname ;jname of controlling procedure. + movem a,u%aux2(x) + movem u,u%svrj(x) + push p,i + movei i,-1 ;if job isn't a server, i will have -1. + jumpe u,[setzm u%aux1(x) ;if no job at all, reset vars + setzm u%aux2(x) + setzm u%svrj(x) + aoja i,gotsvx] ;and indicate non-server. + skipl @suppro ;to be a server, must be top-level + jrst gotsvx + came a,['stelnt] ;and jname must be stelnt, netrfc, telser, or rfc + camn a,['netrfc] ; (eventually check here for jname of CHAOS + jrst gotsv1 ; and do right things etc) + hlrz b,a + caie b,'rfc + camn a,['telser] + jrst gotsv1 + jrst gotsvx + + ;hack network server - simply make i not be -1 +gotsv1: movei i,1 ;rh(u%tty) = 1 => network server +gotsvx: hrrm i,u%tty(x) ;i has 0 for no sty, -1 for non-net sty, 1 for net-sty + pop p,i ;restore i (tty #) + pop p,u ;restore u + +gotdat: hrlm i,u%tty(x) ;record info in tables + move a,@utmptr + move a,400000(a) + hrrm a,u%jtm(x) + skipa a,u ;find idx no of top level job +gotda1: move u,b + skipl b,@suppro + jrst gotda1 ;loop till find -1, which means job is top level + hrlm u,u%jtm(x) + move b,@uname ;get UNAME and XUNAME from top level job. + movem b,u%unam(x) + move b,@xuname + movem b,u%xunm(x) + + move u,a ;restore stored idx no + move a,@jname + movem a,u%jnam(x) + movei a,%ulgin + iorm a,u%flgs(x) ;indicate this entry is logged in. + popj p, + +;Put all users now logged in in the tables to be listed. +;This is done by looping over all terminal numbers. +;Also handle request for all users coming in over the net. +;The flags %astflg and %netusr are used to distinguish these two cases. +star: pushae p,[a,b,c,d,e,i] + hrlz i,nct ;length of its tty tables (# of ttys) + movn i,i ;as aobjn. + +star1: move u,@ttysts ;get status wd for this tty + tlnn u,%tscns ;being used as a console? + jrst star2 ;no, disregard + hrrz u,u ;flush lh + cain u,-1 ;check for no user(just in case) + jrst star2 ;hmm, nope. + jumpe u,star2 ;don't mention system job. + pushj p,gotone ;got a user! record him. + tlne f,%astflg ;user wants all logged in users if set + jrst star4 + tlne f,%netusr ;if user wants all people logged in thru net... + skipn u%svrj(x) + jrst star2 +star4: pushj p,addus4 ;Officially add this user to the table. +star2: aobjn i,star1 ;tty not being used, keep looking + tlnn f,%astflg\%astlsp ;If we want all users, show all lisp machine users. + jrst star3 + ;add any Lisp machines + movei i,nontty-1 +star5: skipe lmunam(i) + pushj p,lmadd + sojge i,star5 +star3: popae p,[i,e,d,c,b,a] + popj p, + +;look through the user file for all users whose +; (1) uname matches JCL unames +; (2) Full name matches JCL fullnames. +; if in WHEN, make entry even if not found in user file. + +whofnd: pushae p,[a,b,c,d,e] + skipn e,who ;get AOBJN for uname matching. + jrst whof50 ;no unames to find, do fullnames. +whof10: move b,(e) + pushj p,useek1 ;look for uname in INQUIR data base. + jumpn b,whof17 + movei b,1 + syscal open,[[.uai,,dkic] ? ['dsk,,] + [sixbit /.file./] ; See if directory exists + [sixbit /(dir)/] + (e)] + seto b, + .close dkic, +whof17: move a,(e) ;Add user. B is positive if user has dir or has inquir entry. + pushj p,addusr + aobjn e,whof10 + +whof50: skipn e,whofnm + jrst whof95 ;no fullname requests? return. +whof54: move a,(e) ;get slot entry - ptr to descriptor + move b,1(a) ;get b.p. to next fullname + hrrz d,(a) ;and # characters in it. + move c,strfre ;copy to strstg, so we can make it asciz and word aligned. +whof55: ildb a,b + cail a,"a ;also convert it all to upper case, as lsrlnm requires. + caile a,"z + caia + subi a,40 + idpb a,c + sojg d,whof55 + setz a, ;not only make it asciz, but pad with 0's at least to + repeat 5,idpb a,c ;a word boundary. + movei a,ls1c ;look this last name up in LSR1 + move b,strfre + pushj p,[ skipl @(e) + jrst lsrtns"lsrlnp ;either as a prefix + jrst lsrtns"lsrlnm] ;or for an exact match + jrst whof57 +whof56: push p,b ;and b gets aobjn -> range of LASTNAME table words. + hrrz b,(b) ;for each one, get the file address of corresponding entry, + movei a,ls1c + pushj p,lsrtns"lsrget ;get the entry in core, + jsr error + hrli b,440700 ;extract the uname from the entry, convert to 6bit in a. + aos b + move c,[440600,,a] + setz a, +whof58: ildb d,b + jumpe d,whof59 + subi d,40 + tlne c,770000 + idpb d,c + jrst whof58 + +whof59: movei b,1 + pushj p,addusr ;and add the user to usrtab. +whof60: pop p,b + aobjn b,whof56 +whof57: aobjn e,whof54 ;check each last name specified in the jcl. +whof95: popae p,[e,d,c,b,a] + popj p, + +;Add the user whose uname is in A (as sixbit) to the table. +;If the user is logged in, all ttys he is on are added. +;Otherwise, an entry is added for him with no tty. +;An entry with a tty is redundant only if that tty is already mentioned. +;An entry with no tty is redundant if that uname is already mentioned. +;B is >0 if the user has an inquir entry or a file directory. +;If B is negative, the user should not be added if not logged in, unless this is :WHEN. +addusr: hrlz i,nct ;length of its tty tables (# of ttys) + movn i,i ;as aobjn. + push p,tluser +addus1: move u,@ttysts ;get status wd for this tty + tlnn u,%tscns ;being used as a console? + jrst addus2 ;no, disregard + hrrz u,u ;flush lh + cain u,-1 ;Detect case of idle tty. + jrst addus2 + came a,@xuname ;See if this tty's uname or xuname matches desired one. + camn a,@uname + caia + jrst addus2 + pushj p,ttyexs ;Found a tty with the desired user. If not mentioned already, + caia + pushj p,addus3 ;make an entry for this tty. +addus2: aobjn i,addus1 + ;Also try adding from Lisp machines + movei i,nontty-1 +addul1: camn a,lmunam(i) + pushj p,addul2 + sojge i,addul1 + pop p,c + camn c,tluser ;If no tty has this user, + pushj p,unmexs ;and there's no entry of any sort for him, + popj p, + trnn f,%when ;and either he is a known user or this is :WHEN, + jumpl b,cpopj + movem a,u%unam(x) ;add him as not logged in. + movem a,u%xunm(x) + setom u%tty(x) ;indicate not logged in. + movem b,u%fdir(x) ;Remember whether he has a directory. + jrst addus4 + +addul2: addi i,maxtty + pushj p,ttyexs + jrst [ subi i,maxtty ? popj p, ] + subi i,maxtty + push p,a + pushj p,lmadd + pop p,a + popj p, + +addus3: pushae p,[a,b,c,d,e] + pushj p,gotone + popae p,[e,d,c,b,a] +addus4: aos tluser ;Bump free pointer to tables; maybe get more core. + addi x,ul + caml x,usrend + pushj p,usrinc + popj p, + +;TTYEXS - skip if there is no entry in the table yet for the tty in rh(I). + +ttyexs: push p,x + push p,a + movn x,tluser + jumpe x,ttyex5 ;if nothing in tables yet, skip. + hrlzs x + add x,usrloc +ttyex2: hlrz a,u%tty(x) + cain a,(i) + jrst popaxj ;Found the tty. Don't skip. + addi x,ul-1 + aobjn x,ttyex2 +ttyex5: aos -2(p) ;didn't find, skip on return. +popaxj: pop p,a + pop p,x + popj p, + +; UNMEXS - takes uname in A, skips if not entered in USRTAB table. +;Doesn't skip if uname matches either a uname or xuname entry. + +unmexs: push p,x + movn x,tluser + jumpe x,unmex5 ;if nothing in tables yet, skip. + hrlzs x + add x,usrloc +unmex2: came a,u%unam(x) + camn a,u%xunm(x) + jrst [pop p,x ? popj p,] ;found him, return without skipping. + addi x,ul-1 + aobjn x,unmex2 +unmex5: pop p,x + aos (p) ;didn't find, skip on return. + popj p, + + +;Given in B an aobjn -> a table of tty numbers, +;make sure there is an entry in the table of users for each of those ttys. +whoft: move i,(b) + pushj p,whoft0 + aobjn b,whoft + popj p, + +;Make an entry in the table for the tty whose number is in I, +;whether the tty is in use or not. If not, give user as "Nobody". +;We check to see that the tty is not already in the table. +whoft0: move c,usrloc + jrst whoft3 + +whoft1: hlrz d,u%tty(c) + camn d,i ;Check each entry we have. + popj p, ;If we have one for this tty already, + addi c,ul ;don't make another one. +whoft3: camge c,x ;No entry for this tty yet => make one. + jrst whoft1 + move u,@ttysts ;get status wd for this tty + tlnn u,%tscns ;being used as a console? + jrst whoft4 ;no, say "Nobody". + hrrz u,u ;flush lh + caie u,-1 ;Detect case of idle tty. + jrst addus3 ;Otherwise, make entry saying who is on the tty. +whoft4: hrlzm i,u%tty(x) + move d,['nobody] ;supply "nobody" as the user. + movem d,u%unam(x) + movem d,u%xunm(x) + setzm u%jnam(x) + jrst addus4 + +;Print out all the users added to the table by STAR, WHOFND, WHOFT, etc. +putout: pushae p,[d,e] +putou9: movn x,tluser + hrlzs x + add x,usrloc +putou2: setz i, ;sys variables cretinously indexed by I... + skipge @sysdbg ;see if sys being debugged... + jrst [ iot tyoc,[asciz /SYSTEM BEING DEBUGGED +/] + jrst .+1] + move d,@shutdn ;get system var saying if and when sys is scheduled to die. + jumpe d,putou3 ;not scheduled to go down. + sub d,@time + idivi d,30. ;it is; d gets # seconds till then. + .rlpdt a, ;get # seconds from start of year to now. + add a,d ;get # seconds from start of year till sys goes down. + idivi a,24.*60.*60. ;remainder is # seconds since midnight. + move d,b ;d has time for system to go down. + iot tyoc,[asciz /ITS GOING DOWN AT /] + pushj p,tmhms ;print time system will go down. + typz crlf + .open dkic,[.bai,,'sys + sixbit /down/ + sixbit /mail/] + jrst putou4 +putou5: move d,[-10,,dwnml] + .iot dkic,d + setzm (d) ;ensure asciz string + movei a,dwnml + iot tyoc,(a) + jumpge d,putou5 +putou4: typz crlf +putou3: jumpl x,ptohed ;possibility of no users... + trne f,%whois+%when + jrst [ iot tyoc,[asciz /Not found. +/] + jrst finish] + iot tyoc,[asciz /No users +/] + jrst finish + +ptohed: tlne f,%astflg+%netusr + skipn tlusers ;For * and *NET we want a header, + jrst ptohd2 ;provided there's at least one user. + movei a,[asciz /-User- --Full name-- /] + trnn f,%abbrev ;omit full name for abbreviated listing + jrst ptohd1 + movei a,[asciz /-User-/] +ptohd1: iot tyoc,(a) + trne f,%jobnof ;make room for job number if we are printing it. + iot tyoc,[asciz /Job/] + iot tyoc,[asciz / Jobnam Idle TTY -Console location- +/] +ptohd2:: + +;print out next line, about the next user. +ptolup: skipl a,u%tty(x) ;see if this entry is logged in. + jrst ptolu1 + camn x,usrloc ;If not logged in, but previous entry was logged in, + jrst ptolu1 + skipge a,u%tty-ul(x) + jrst ptolu1 + tlne f,%astflg+%netusr ;and we had a * or *NET, then separate that from the rest + typz crlf ;of the stuff (which begins now) with a blank line. +ptolu1: pushj p,unmout ;print info about user (eg his name) + push p,b ;also, entry for user left in B. + skipge u%tty(x) + jrst ptocn7 + .iot tyoc,[40] ;Here for a logged in user. one space + pushj p,jnmout ;just job name for now + pushj p,ttyout ;info about tty + setz a, + jrst ptocn6 + +;Here for a not-logged-in user. +ptocn7: pushj p,lgotim ;try to find his last logout time (ptr left in A) +;*** Note, the code here inside the literal causes a bug when doing :when moon +;*** if moon5 has an inquir entry but no directory and no logout times entry. +;*** Not clear to me how to fix this. + jumpe a,[skiple u%fdir(x) ; if no logout time, see if has fdir + jumpe b,ptol50 ; if has fdir and no LSR entry, avoid + move a,[440700,,[asciz / Not logged in./]] + jrst .+2] ; this message. Skip over "last l.." + type [ Last logout ] + pushj p,otypc + + pushae p,[c,d] + + move a,u%xunm(x) + setz c, + movei d,plic + pushj p,lsrtns"lsrhsn ;look up the HSNAME + jrst [popae p,[d,c] ; Punt + jrst ptol5x] + move a,d + popae p,[d,c] + syscal open,[[.uai,,plic] ? ['dsk,,] + u%xunm(x) ? [sixbit /plan/] ? a] + caia + jrst [ movei a,1 + jrst ptocn6] ; found plan file! +ptol5x: setz a, + skiple u%fdir(x) ; If entry-less and has file dir, + jumpe b,ptol50 ; don't barf about plan file. + type [ No plan.] +ptol50: +ptocn6: pop p,b + trnn f,%whois ; Is this a whois? + jrst ptol75 ; nope, skip detailed info. + jumpn b,[pushj p,lsrout ; Output LSR stuff if user has inquir entry + jrst ptol75] + skipg u%fdir(x) ; no inquir entry, has file dir? + jrst ptol75 ; sigh, nope. + syscal open,[[.uai,,dkic] ? ['dsk,,] + [sixbit /-read-/] ? [sixbit /-this-/] ? u%xunm(x)] + jrst [ syscal open,[[.uai,,dkic] ? ['dsk,,] + [sixbit /!read!/] ? [sixbit /!this!/] ? u%xunm(x)] + jrst ptol75 + jrst .+1] + type [ + Note: +] + pushj p,typdki ; type out file + +ptol75: jumpe a,ptocn9 ; jump if no plan. + .iopush plic, ; transfer channel to DKIC + .iopop dkic, + type [ Plan: +] + pushj p,typdki ; type it out + +ptocn9: typz crlf ; new line +ptocnt: addi x,ul-1 ;bump index + aobjn x,ptolup + + ;now we are finished printing out all the users +finish: popae p,[e,d] + popj p, + + ; Type out one page of stuff from DKIC channel, + ; indenting as per INDENL. + ; Makes sure CRLF was last thing output. +typdki: push p,a + push p,b +typdk1: tdca b,b +typdk2: seto b, + .iot dkic,a +typdk3: jumpl a,typdk5 + caie a,^C + cain a,^L + jrst typdk5 + jumpe b,[caie a,^M + typz indenl + jrst .+1] + .iot tyoc,a + caie a,^M + jrst typdk2 + .iot dkic,a ; CR seen, needs checkout. + caie a,^J + jrst [ tlne f,%svrmod ; Bare CR + .iot tyoc,[^@] ; needs NULL for telnet ptcl + jrst typdk3] + .iot tyoc,a + jrst typdk1 + +typdk5: caie b, ; make sure CRLF is last thing. + typz crlf + .close dkic, + pop p,b + pop p,a + popj p, + + +indenl: asciz / / ; Spaces to indent for whois lines. + + ;Hack the printout of random LSR stuff about this user. +lsrout: push p,b ; shouldn't clobber acs. + pushj p,lsrfnd ;find pointers to all LSR info about this entry + typz crlf + + ; First line + skipn lsr+LSRTNS"I$nick ;nickname exists? + skipe lsr+LSRTNS"I$neta ; or net addr? + jrst lsro1 + skipn lsr+lsrtns"i$proj ; or project? + skipe lsr+lsrtns"i$supr ; or supervisor? + jrst lsro1 + jrst lsro2 ; bah, try second line. + + ; Type "(nickname) [netaddr] hacking for " +lsro1: typz indenl ; indentation for lsr stuff + skipe lsr+LSRTNS"I$nick ; nickname? + jrst [ TYPE [(] + 7TYP 1,lsr+LSRTNS"I$NICK + TYPE [)] + jrst .+1] + skipe lsr+lsrtns"i$neta ; Net addr? + jrst [ skipe lsr+lsrtns"i$nick + .iot tyoc,[40] + .iot tyoc,["[] + 7typ 1,lsr+lsrtns"i$neta + .iot tyoc,["]] + jrst .+1] + SKIPN LSR+LSRTNS"I$PROJ ; Either proj or superv? + skipe lsr+lsrtns"i$supr + jrst [skipn lsr+lsrtns"i$nick + skipe lsr+lsrtns"i$neta + type [ ] ; space if anything preceding. + type [Hacking ] + skipe lsr+lsrtns"i$proj + 7TYP 1,LSR+LSRTNS"I$PROJ + SKIPN LSR+LSRTNS"I$SUPR + jrst .+1 + skipe lsr+lsrtns"i$proj ; if no proj, "Hacking for ..." + type [ ] + type [for ] + 7TYP 1,LSR+LSRTNS"I$SUPR + jrst .+1] + typz crlf + + ; Second line: "; ; ; Home Phone " +lsro2: SKIPN LSR+LSRTNS"I$BRTH ; Anything that can go on line? + SKIPE LSR+LSRTNS"I$MITA + JRST lsro21 + SKIPN LSR+LSRTNS"I$MITT + SKIPE LSR+LSRTNS"I$HOMT + JRST lsro21 + jrst lsro3 ; Nothing to go on line. +lsro21: typz indenl ;THERE IS ONE; START A LINE FOR THEM. + SETZ B, + SKIPE LSR+LSRTNS"I$BRTH + JRST [ type [Birthday ] + 7TYP 1,LSR+LSRTNS"I$BRTH + aoja b,.+1] + SKIPE LSR+LSRTNS"I$MITA ;IF THERE'S AN MIT ADDRESS, + JRST [ caie b, + type [; ] + 7TYP 1,LSR+LSRTNS"I$MITA ;PRINT IT. + aoja b,.+1] + SKIPE LSR+LSRTNS"I$MITT ;IS THERE AN MIT TEL #? + JRST [ skipe b + SKIPN LSR+LSRTNS"I$MITA + caia + type [; ] ;SPECIAL CASE: BIRTHDAY AND MIT TEL BUT NO MIT ADR. + skipe b + type [ ] + 7TYP 1,LSR+LSRTNS"I$MITT + aoja b,.+1] + SKIPE LSR+LSRTNS"I$HOMT + JRST [ SKIPE B + type [; ] + type [Home Phone ] + 7TYP 1,LSR+LSRTNS"I$HOMT + jrst .+1] + typz crlf + + ; Third line: "" +lsro3: SKIPE LSR+LSRTNS"I$HOMA + JRST [ typz indenl + 7TYP 4,LSR+LSRTNS"I$HOMA + typz crlf + jrst .+1] + ; Fourth line(s): "" + SKIPE LSR+LSRTNS"I$REM + JRST [ typz crlf + typz indenl + 7TYP 5,LSR+LSRTNS"I$REM ;handle remarks as ASCIZ. + typz crlf + jrst .+1] + pop p,b + popj p, + + ;initialize user-info blocks. LS2MAP must have been called!! +usrini: push p,ffloc + pop p,usrloc ;initialize USRLOC and drop thru. + + ; called when index into usr-info area is .GE. C(USREND). +usrinc: pushae p,[a,b] + syscal corblk,[cimm %cbndr+%cbndw + cimm -1 ? ffpag ? cimm %jsnew] ;get fresh new page + jsr error + aos a,ffpag ;increment + lsh a,10. + movem a,ffloc + sub a,usrloc ;find # wds in usr-info area now + idivi a,ul ;find # blocks possible. + imuli a,ul ;find limiting address in terms of block boundaries + add a,usrloc ;make absolute + movem a,usrend ;and store. + popae p,[b,a] + popj p, + +;Connect to the host whose number is in HSTCUR. Skip if successful. +;If fail, don't skip, but print an error message. +hicp: pushae p,[a,b,c,d,e] + tlne f,%chausr + jrst hicpc + movei a,nticp + move b,hstcur + movei c,icpsoc + move d,[.uai,,.uao] + pushj p,[tro f,%usetcp ;see comment about /i switch + trnn f,%usetcp + jrst netwrk"arpicp ;" + movei a,ntic + jrst tcpicp] +hicp1: pushj p,netwrk"analyz ;Always skips + aos -5(p) + popae p,[e,d,c,b,a] + popj p, + +hicpc: movei tt,0 ;make sure asciz + idpb tt,cnnptr + movei a,ntic + move b,hstcur + movei c,connam + movei d,5 + push p,[hicp1] + jrst netwrk"chacon + +netin: pushae p,[a,c] + setz c, ;clear cnt of chars on line +netin1: .iot ntic,a ;read a name listing and print it + JUMPE A,NETIN1 ;IGNORE NULLS. + camn a,[-1,,3] ;eof character + jrst netin9 ;done... + tlne f,%chausr + jrst [ caie a,215 ;convert newline to crlf + jrst .+1 + seto c, + .iot tyoc,[^M] + movei a,^J + jrst .+1] + andi a,177 ;For chaosnet, map 211 into tab (and so forth) + cain a,^I ;handle tabs in count + jrst [ addi c,10 + andi c,777770 + jrst netin2] + cain a,^M + seto c, ;CR, clear cnt (-1 because AOS'd later) + ;; The following added by CBF 22Jul84 to handle Unix style newlines + cain a,^J ; An LF? Perhaps this is a losing Unix newline char? + jrst [ caig c,0 ; are we in a column > 0? + jrst .+1 ; No, we're not + .iot tyoc,[^M] ; Yes, we are, force a CR + setz c, ; clear column cnt + jrst .+1] + caie a,^J ;lf doesn't increment count + aos c + + ;; this should check to see if the tty has %tosai! + caige a,40 ;is it control character? + cain a,^M ;but not CR + skipa ;then it'll print like ^A + aos c ;so worry about it + +netin2: trnn f,%whois + camg c,tcmxh ; If not doing WHOIS, don't print beyond linel, + ; truncate instead. (On 10/8/88 I changed the + ; CAMGE that used to be here to a CAMG because if + ; you have 79 available columns it is OK to print + ; in column 79. Perhaps this will uncover some + ; other fencepost error that this has been hiding. + ; If you find that error, don't just put the CAMGE + ; back, fix that other error! -Alan) + .iot tyoc,a + jrst netin1 ;get another char + +netin9: .close ntic, ;close net chans when done + .close ntoc, + popae p,[c,a] + popj p, + +cnnbyt: idpb tt,cnnptr + aos cnncnt + popj p, + +cnnstr: hrli t,440700 +cnnst1: ildb tt,t + jumpe tt,cpopj + pushj p,cnnbyt + jrst cnnst1 + +;output the uname and full name of the user in x. +;return in b a pointer to his lsr1 entry in core (or 0 if none). + +unmout: move a,u%unam(x) ;get uname + pushj p,wtype6 ;type out the sixbit + pushj p,useek ;look for this uname in dir, return group designation + ;char in A, entry in B, b.p. in C to fullname. D is relation char. + trne f,%abbrev ;no name if abbreviated + popj p, + .iot tyoc,[40] + push p,b ;save table entry + jumpn b,unmou5 ; normal printout if entry found. + skipge b,u%fdir(x) ; no entry, has file directory? + jrst unmou5 ; Nope. + jumpe b,[syscal open,[[.bai,,dkic] ? ['dsk,,] + [sixbit /.file./] ; see if has file dir + [sixbit /(dir)/] + u%xunm(x)] + skipa b,[-1] ; nope, switch set neg + movei b,1 ; yep, set pos. + movem b,u%fdir(x) + jumpl b,unmou5 ; now can make definite jump + jrst .+1] ; has file dir! continue + move c,[440700,,[asciz /--> File Directory Only! /]] + movei b,25. + jrst unmou7 ; skip over group-char print +unmou5: caig a,40 ;space or control characters + movei a,"- ;print as "-" + ;; suppress printing of "A" on AI unless it's AX + push p,b + move b,mname + sub b,[sixbit/AI/] + jumpn b,unmou6 + caie a,"A + jrst unmou6 + caie d,"X + movei a,40 +unmou6: pop p,b + .iot tyoc,a + caie d,0 + caie d,"X + movei d,40 + .iot tyoc,d ;print relation if it is X. + .iot tyoc,[40] + movei b,22. +unmou7: setz d, + pushj p,typcnt ;type out info about user + pop p,b ;return. + popj p, + +;look for uname indexed by X and return byte pointer in C to fullname string. +;A will have the "group designation char" if there is one. +;B gets the core address of the entry, which will be valid only until the next useek. +;If the user has no entry, B gets 0. +;D gets "relation" character. +useek: move b,u%xunm(x) ;b gets xuname, or ______ for non-logged-in users. + hlre c,b + aosn c + seto b, +useek1: movei a,ls1c ;a gets channel LSR1 is open on. + pushj p,lsrtns"lsrunm ;search LSR1 for the uname. + jrst usearl ;not found => return standard stuff. + movei a,lsrtns"i$name + pushj p,lsrtns"lsritm ;get pointer to full name item. + jrst usearl ;every entry ought to have one. + push p,b + move b,strfre ;permute into lastname last order, + move c,b ;copying into strstg. + pushj p,lsrtns"lsrnam + jsr error + move b,(p) + movei a,lsrtns"i$grp ;now get the "Group" item, + pushj p,lsrtns"lsritm + setz a, + ildb a,a ;and extract its 1st character. +;The below can't (?) happen. +; cain a,^M +; setz a, ;for a null entry return 0. + push p,a + movei a,lsrtns"i$rel ;relation in D. + pushj p,lsrtns"lsritm + setz a, + ildb a,a + move d,a + pop p,a + pop p,b + popj p, + +;here if user has no entry or entry has no fullname. +usearl: setzb a,b + move c,[440700,,[asciz / ???/]] + popj p, + +typcon: .iot tyoc,a +typcnt: sojl b,[popj p,] ;this routine takes pointer in c,limit in b. + ildb a,c ;get char + cail a,40 ;control chr is delimiter + jrst typcon +padlup: .iot tyoc,[40] ;output blanks up to limit + sojl b,[popj p,] + jrst padlup + +otypc: push p,b +otypc1: ildb b,a + caige b,40 + jrst [pop p,b ? popj p,] + .iot tyoc,b + jrst otypc1 + +jnmout: trnn f,%jobnof + jrst jnmou1 + hlrz a,u%jtm(x) + idiv a,lublk + pushj p,octtyp + .iot tyoc,[40] +jnmou1: move a,u%jnam(x) + jrst wtype6 ;type out 6bit name of job + +;print out all info about tty - how long idle, what tty number, and where it is. +ttyout: .iot tyoc,[40] + hlrz i,u%tty(x) ;see if lisp machine + caige i,maxtty + jrst ttyoun + subi i,maxtty ;lm tables index + movei c,lmidle(i) ;yes, idle time is in ascii + hrli c,440700 ;count chars, wants to fit in 4-column field + movei a,4 +ttyol1: ildb b,c + skipe b + soja a,ttyol1 + jumpe a,ttyol3 +ttyol2: .iot tyoc,[40] ;put leading spaces + sojg a,ttyol2 +ttyol3: movei a,lmidle(i) + pushj p,typ7ta + movei a,5 +ttyol4: .iot tyoc,[40] + sojg a,ttyol4 + hlrz b,u%tty(x) + move a,lmdoc-maxtty(b) ;Console location + jrst type7u + +ttyoun: setz i, ;get current time in 30'ths + move a,@time + hlrz i,u%tty(x) + sub a,@ttitm ;- time of last input on this tty. + idivi a,30.*60. ;get time in minutes tty has been idle. + jumpe a,[iot tyoc,[asciz / /] + jrst ttyou1] ;it's been a very short time + caige a,60. + jrst [ .iot tyoc,[40] + .iot tyoc,[40] + pushj p,dectyp ;< 1 hr - say how many minutes + jrst ttyou1] + idivi a,60. + cail a,10. + jrst [ iot tyoc,[asciz /*:**/] + jrst ttyou1] ;a very long time. + addi a,"0 + .iot tyoc,a + .iot tyoc,[":] + idivi b,10. + addi b,"0 + addi c,"0 + .iot tyoc,b + .iot tyoc,c +ttyou1: hrrz a,u%jtm(x) + jumpn a,[.iot tyoc,[40] + jrst ttyou2] + .iot tyoc,[".] +ttyou2: hlrz b,u%tty(x) ;get tty number. + .iot tyoc,["T] + ldb a,[030300,,b] + addi a,"0 + .iot tyoc,a ;and print it as "T" followed by 2 digits. + ldb a,[000300,,b] + addi a,"0 + .iot tyoc,a + .iot tyoc,[40] + +ttyprt: move i,tcmxh ;keep track of where we are on the line + sub i,beglen ;I <- # of characters left on line + tlz f,%rcrs ;This isn't recursive yet! + +ttypr0: caml b,nfstty ;a sty? + caml b,nlstty + caia ;no! skip. + jrst hstout ;yes! assumption is net caller. + caml b,nf11ty ;a pdp11 tv? + caml b,nl11ty + jrst nrmtty ;nope, 'normal' tty. + jrst tv + + + +;here if its a tv + +tv: push p,b ;save the TTY number + pushj p,ttchk ;Is the TTYLOC info? + caia ; No, check the TVKBD info + jrst [ push p,a ;Save the byte pointer for a bit + ildb b,a ;get a char + cain b,33 ;magic escape? If so, recover TTY no and + jrst [ pop p,b ? pop p,b ? jrst type7u] ;type rest + pop p,a ;Otherwise just use the whole string + pop p,b ;Recover the TTY number + jrst type7u] ;Type it + pop p,b ;recover the TTY number + syscal tvwher,[cimm 400000(b) ? cret a] ;have tty no, get kbd no. + jsr error + cain a,377 + jrst [ type [ Not connected] + popj p, ] + cail a,0 + cail a,maxkbd + jrst [type [?? TV-11 garbaged!] + popj p,] + push p,a ;save for later + tlne f,%nottv ;are we on a tv? + jrst tv1 ;no, skip lengthy tv info + pushj p,octhak + ior a,['kbd00] + lsh a,6 + pushj p,wtype6 + subi i,6 ;account for 6 characters typed +tv1: pop p,b ;kbd again + move a,kbddoc(b) + pushj p,type7v ;output appropriate stuff + popj p, + +;;; This looks in the SYSBIN;TTLOC DATA file (which was mapped in at the +;;; start) and if there is an entry for that user on that terminal, it +;;; uses the entry instead of the entry from SYSENG;TTYTYP (FILE) +;;; (which was gobbled at initialization time). +;;; The format of the TTLOC DATA file is: +;;; For each TTY, there is a block of 21 words, the first word is +;;; the UNAME of the person on the line, and the rest is an ASCIZ string. +;;; If the UNAME doesn't correspond to who's on the line now, +;;; the entry is cleared and ignored. + +;;; B is the TTY number + +ttchk: push p,b ;save the real B for later + imuli b,ttsize ;get offset in TTLOC table + addi b,ttloc ;make absolute + move a,u%unam(x) ;get the UNAME that's on this TTY + skipe 1(b) ;if there's no data in the entry + came a,(b) ; Or there's a new person there + jrst ttchk0 ; Clear out the entry + movei a,1(b) ;yes, return ptr to the ASCIZ string + hrli a,440700 ;make it a Byte Pointer + pop p,b ;restore the real TTY # + aos (p) ;skip return + popj p, + +;; note: The UNAME may be inconsistant if this is a recursive TTYPRT +ttchk0: tlnn f,%rcrs ;Unless this is an recursive TTYPRT + setzm (b) ; clear out the entry + pop p,b ;Nope, get back the real B + popj p, + + +;here for ordinary vegetable patch tty + +nrmtty: pushj p,ttchk ;check the TTLOC database for interesting info + jrst nrmtt0 + push p,a ;remember our TTYLOC + ildb a,a ;Look at the first character + cain a,33 ;for a magic escape + jrst nrmttx ; in which case, do as he says + syscal TTYVAR,[ %climm,,%jsnum(b) ? %climm,,'TYP ? %clout,,a] + jsr error + trne a,%tydil\%tyrlm ;Is this a dialup or ROLM? + tlne f,%rcrs ; and not the recursive printing for a STY? + caia + jrst [ trnn a,%tyrlm + skipa a,[[asciz /Dialup: /]] + movei a,[asciz /ROLM: /] ;Tell about it + pushj p,type7v + jrst .+1] + pop p,a ;recall our TTYLOC + jrst type7u ;type it out + +nrmttx: pop p,a ;recover the byte pointer + ibp a ;and throw away the first character [the escape] + jrst type7u ;type out the rest of the TTYLOC + +nrmtt0: move a,ttydoc(b) ;No TTYLOC info, use the default + jrst type7u +constants + +hstout: hlrz b,u%tty(x) ;Get the TTY number + pushj p,ttchk ;check for TTLOC info + seto a, ; remember that there wasn't any + hrrz b,u%tty(x) ;See if network tty + cain b,-1 ;check for non-net sty + came a,[-1] ; With no TTLOC info + caia + jrst styout ;harumph...go hack it + push p,a ;remember our info for later + syscal open,[ [ubpfj+.bii,,usrich] + [sixbit/usr/] + u%aux1(x) + u%aux2(x) ] ;open up the server + jrst hstou0 ;gone + syscal usrmem,[%climm,,usrich ? %climm,,100 ? %clout,,a] + jrst hstou0 + came a,['TERMID] ;Does server have info for us? + jrst hstou0 ;apparently not + movei a,101 + move b,[-ltlinf,,telinf] ;get cruft +hstou2: syscal usrmem,[%climm,,usrich ? a ? %clout,,(b)] + jrst hstou0 ;Branch off if job goes away or something + aos a + aobjn b,hstou2 + +;; 3 cases: (1) We have a console ID from TTLOC. +;; Print the canonicalized host-name which we were given, a +;; colon, and the console ID. If it's a TIP, print the port #. +;; (2) We have a console ID from TELSER. Print it. +;; (3) We have no console ID, print Net site and the host name. +;; In this case we print the port number for TIP's + + move a,(p) ;get the TTYLOC info + camn a,[-1] ;if there's no TTYLOC info + skipe termid ; and if TELSER doesn't know where this TTY is + caia + jrst hstou3 ; Then we go print the host full name + camn a,[-1] ;No TTYLOC info? + jrst hstoyz ; Don't MPV looking at its first char! + ildb b,a ;check the first character + cain b,33 ;magic escape? + jrst [ pop p,b ; yes, discard saved byte pointer + pushj p,type7u ; and use the incremented one, discarding escape + jrst hstou5] ; on with the shoe. +hstoyz: pushj p,prthsc ;Print abbreviated host name and optional TIP port number + move a,hstat ;Examine host type. + cain a,ts%min ;If this is a MINITS host. + jrst hstoy0 ;don't print ": " since we didn't print host + movei a,[asciz/: /] + pushj p,type7v +hstoy0: pop p,a ;recover our special info + camn a,[-1] ;unless there's none + movei a,termid ; in which case we hack the TELSER info + pushj p,type7v ;Type terminal name + jrst hstou4 + +;Print host name and TIP number + +;This entry used when putting host name before a colon. Try to abbreviate it. +;Specifically, change MIT-x to x, LISP-MACHINE-x to LMx, SU-AI to SAIL. +;We also check for MINITS consoles, and use the sixbit name for them. +;We could change PLASMA to nothing at all (not even colon) but I don't really +;think that's so great (Moon). + +prthsc: push p,b + move b,hstat ;Examine host type. + cain b,ts%min ;If this is a MINITS host. + jrst [ ;6typ hstsix ;Print out its sixbit name. + pop p,b + jrst prths1 ] +prthc0: move a,[440700,,hstnam] ;Scan name supplied by TELNET server. + irpc ch,,[MIT-] + ildb b,a + caie b,"ch + jrst prthc2 + termin + push p,a ;Remember where short "host name" began. + ildb b,a + jumpe b,prthc1 + caie b,". + jrst .-3 + mdbpt a, ;Godamn domain names! + setz b, ;Dike out the domain part! + idpb b,a +prthc1: pop p,a ;Recover the "host name". + pop p,b + pushj p,type7u ;MIT- host, just show part after MIT- + jrst prths1 ;and before the .ARPA. + +prthc2: move b,hstnam + camn b,[ascii/SU-AI/] + jrst [ movei a,[asciz/SAIL/] + pop p,b + jrst prths0 ] + push p,c + push p,d + move a,[440700,,hstnam] + move b,[440700,,[asciz/LISPM-/]] +prthc3: ildb c,b + jumpe c,[typi "L + typi "M + subi i,2 + pop p,d + pop p,c + pop p,b + pushj p,type7u + jrst prths1 ] + ildb d,a + camn c,d + jrst prthc3 + jrst domstp ;strip .ARPA and .EDU + +prthst: push p,b + push p,c + push p,d + ;; Strip .ARPA, .EDU, etc from host name +domstp: move b,[440700,,hstnam] + push p,b ;save it too +domlop: ildb c,b +domlo1: jumpe c,domeos ;null? Oh well. + caie c,". ;starts domain? + jrst domlop ;nope; keep looking + movem b,(p) ;save this byte ptr + ildb c,b ;get domain name + cain c,"A ;.ARPA or .AI.MIT.EDU ? + jrst domaxx + cain c,"E ;.EDU? + jrst domedu + cain c,"L ;.LCS.EDU ? + jrst domlcs + cain c,"M ;.MIT.EDU? + jrst dommit + jrst domlo1 + +domaxx: ildb c,b ;Check for "i.mit.edu" or "rpa" + cain c,"I + jrst domitx + caie c,"R + jrst domlo1 + ildb c,b + caie c,"P + jrst domlo1 + ildb c,b + caie c,"A + jrst domlo1 + jrst dommsk ;was ".arpa"; mask domain + +domlcs: ildb c,b ;check for "cs.mit.edu" + caie c,"C + jrst domlo1 + ildb c,b + caie c,"S + jrst domlo1 +domitx: ildb c,b ;check for ".mit.edu" + caie c,". + jrst domlo1 + ildb c,b + caie c,"M + jrst domlo1 +dommit: ildb c,b ;check for "it.edu" + caie c,"I + jrst domlo1 + ildb c,b + caie c,"T + jrst domlo1 + ildb c,b + caie c,". + jrst domlo1 + ildb c,b + caie c,"E + jrst domlo1 +domedu: ildb c,b ;check for "du" + caie c,"D + jrst domlo1 + ildb c,b + caie c,"U + jrst domlo1 +dommsk: setz a, + dpb a,(p) ;mask out from "." on. + +domeos: pop p,a ;restore stack ptr + pop p,d + pop p,c + pop p,b + movei a,hstnam +prths0: pushj p,type7v ;type host name gotten out of server +prths1: skipn a,tipnum + popj p, ;Not a TIP + subi i,2 ;Port number is at least a # and a digit + cail a,10 ;Subtract additional 1 for each of up to 3 octal digits + subi i,1 + cail a,100 + subi i,1 + jumple i,cpopj ;And exit if no room on line + typi "# ;port # prefix + jrst octtyo + +;Print net site mumble mumble +hstou3: pop p,a ;Flush special TTLOC info + movei a,[asciz /Net site /] + cail i,36 ;If not much room left, don't say "Net Site". + pushj p,type7v + pushj p,prthst +hstou4: +; ldb a,[nw$byt,,fhost] + netwrk"getnet a,fhost ;For Public Relations, if was via Chaos net, + camn a,[netwrk"nw%chs] ; say so + caig i,8 ; but only if there is room on the line + jrst hstou5 + move a,hstat ;since we're not printing MINITS hosts any more + cain a,ts%min ;and people understand chaosnet now + jrst hstou5 ;flush this message too. + movei a,[asciz/ (Chaos)/] + pushj p,type7v +hstou5: .close usrich, + ;caig i,7 ;have room for job no.? + popj p, ;no, don't print anything + ;move a,[440700,,[asciz /, job /]] + ;pushj p,type7t + ;hrrz a,u%svrj(x) + ;idiv a,lublk + ;jrst octtyo + +styprt: tlne f,%supd ;Don't include the sty stuff in SUPDUP's info + popj p, + tlnn f,%rcrs ;Note that any more will be recursive + jrst [ move a,u%unam(x) ; first time...remember our UNAME for later + movem a,ttyunm + jrst stypr0] + move a,u%aux1(x) ;get uname of controlling process + camn a,ttyunm ;Is this the same UNAME as the last one + tlon f,%rcrs ; and this is recursive + caia ; no. + popj p, ; yes. Don't print recursive frobs +stypr0: tlo f,%rcrs + typi "[ + sos i ;count the [ + move a,u%aux1(x) ;Check the controler's UNAME + came a,u%aux2(x) ;If UNAME=JNAME, probably CRTSTY demon + camn a,ttyunm ;Is the uname the same as for the controllee? + jrst stypr5 ; Yes, don't print it + ldb a,[360600,,a] ;check the first char of the name + cain a,16 ;is it "."? Maybe .FOO, a CRTSTY for FOO? + jrst [ ldb a,[003600,,u%aux1(x)] ;Try it without the . + lsh a,6 + camn a,ttyunm ; Does it match? + jrst stypr5 ; yes, don't print the UNAME now either + jrst .+1] ; no match, so print the frob + move a,u%aux1(x) + movem a,ttyunm ;Don't type this one again + pushj p,atype6 ;out it go + typi 40 + sos i ;count the space +stypr5: move a,u%aux2(x) ;get JNAME of controlling process + pushj p,atype6 + movei a,[asciz /] /] + jrst type7v ; This is the first level + +;Here if couldn't get info from server job, treat as non-network STY +hstou0: .close usrich, + pop p,a ;balance the stack, we're punting this info +;This is a non-network sty +styout: move a,u%aux2(x) ;check for daemon + camn a,['hactrn] ;only if it is a hactrn + jrst styou1 +styou2: skipn u%aux1(x) ;make sure something there. + jrst [ type [ STY not in use] + popj p,] ;not really there... + + syscal OPEN,[ %clbit,,.uii\10 ? %climm,,usrich ? [sixbit /USR/] + u%aux1(x) ? u%aux2(x)] + jrst styou4 + push p,c + move a,[-4,,[ sixbit /CNSL/ ? movem b + sixbit /UNAME/ ? movem c]] + syscal USRVAR,[%climm,,usrich ? a] + jrst styou6 + jumpl b,styou6 ;If sty owner doesn't have a TTY, just tell who + push p,c ;remember our new UNAME + push p,b ;remember owner's TTY number + pushj p,styprt ;print the caller info + push p,i ;remember where we are on the line + move i,-1(p) ;GOTONE takes TTY # in I + setz u, ;don't bother looking up his name etc. + hrlm i,u%tty(x) ;remember our new TTY number + pushj p,gotone ;Clobber our entry with sty owner's info + jfcl + pop p,i ;recover where we are on the line + pop p,b + pop p,u%unam(x) ;salt away our new UNAME + pop p,c + jrst ttypr0 ;and print the owner's TTYLOC + +styou6: .close usrich, + pop p,c + jrst styou4 ; if so, just do the U=xxx J=xxx hack + +styou5: pop p,i ;recover where we are on the line + pop p,b +styou4: typi "U + typi "= + move a,u%aux1(x) ;get uname of controlling proc + pushj p,wtype6 ;out it go + typi 40 ;with a spacer + typi "J + typi "= + move a,u%aux2(x) ;and then the jname + pushj p,wtype6 + popj p, + +styou1: tlne f,%supd + jrst styou2 + push p,x ;check if daemon is listed in LSR1 + addi x,u%aux1-u%xunm + pushj p,useek + pop p,x + jumpe b,styou2 ;if not found, it is no demon. + jumple i,cpopj ;if no more room, type nothing +styou3: ildb a,c + caige a,40 + popj p, + typi (a) + sojg i,styou3 + popj p, + +;2 position octal or decimal print of number in a. Leading zero replaced with space. +octtyp: idivi a,10 + caia +dectyp: idivi a,10. + addi a,"0 + cain a,"0 + movei a,40 + typi (a) + addi b,"0 + typi (b) + popj p, + +;Type 3 digits of octal, without zero suppression. +octt3: idivi a,10 + hrlm b,(p) + pushj p,octt2 + jrst octt1 + +;Type 2 digits of octal, without zero suppression. +octt2: idivi a,10 + typi "0(a) + typi "0(b) + popj p, + +;Type as many digits as needed to print number in a in octal. +octtyo: idivi a,10 + hrlm b,(p) + skipe a + pushj p,octtyo +octt1: hlrz b,(p) + typi "0(b) + popj p, + +;Type as many digits as needed to print number in a in decimal. +dectyo: idivi a,10. + hrlm b,(p) + skipe a + pushj p,dectyo +dect1: hlrz b,(p) + typi "0(b) + popj p, + +; Type HOSTS3 format host number in A in decimal octet format. +typehn: push p,a + push p,b + ldb a,[400400,,-1(p)] + jumpe a,typhn1 + pushj p,dectyo + typi ": +typhn1: ldb a,[301000,,-1(p)] + pushj p,dectyo + typi ". + ldb a,[201000,,-1(p)] + pushj p,dectyo + typi ". + ldb a,[101000,,-1(p)] + pushj p,dectyo + typi ". + ldb a,[001000,,-1(p)] + pushj p,dectyo + pop p,b + pop p,a + popj p, + +;print asciz string <- b.p. in a, printing no more than -beglen chars. +type7v: hrli a,440700 + jrst type7u + +typ7ta: hrli a,440700 +type7t: move i,tcmxh + sub i,beglen +type7u: push p,b + jumple i,type7x ;in case ever get called after end of line +type7l: ildb b,a + jumpe b,type7x + typi (b) + ;; allow extra character for control-chars (should this check %TOSAI?) + cail b,40 + cain b,177 ;but check for rubout + sos i + sojg i,type7l +type7x: pop p,b + popj p, + +;Map in the inquir data base (INQUIR;LSR1 >) and the host names data base (SYSBIN;HOSTS2 >). + +LS2MAP: PUSH P,A + PUSH P,B + MOVEI A,LS1C ;we keep LSR1 open on this channel. + MOVE B,[USRPAG-177,,USRPAG] ;this block of pages is available for use. + PUSHJ P,LSRTNS"LSRMAP ;map in the index tables & allocate space for 2 data pgs + JSR ERROR + HRRZ A,B + MOVEI B,DKIC + PUSHJ P,NETWRK"HSTMAP ;Map in the HOSTS2 file. + JSR ERROR + MOVEM A,FFPAG ;save # of first page free after HOSTS1 data. + CAILE A,200-1 ;if outrageous figure, + JSR ERROR ;die. later perhaps shout for help. + LSH A,10. + MOVEM A,FFLOC ;store addr of first free core (where USRTAB will start). + POP P,B + POP P,A + POPJ P, + +BVAR +FFPAG: 0 ; # of page first free after HOSTS2 and USRTAB. used for growing USRTAB. +FFLOC: 0 ; corresponding addr. +EVAR + +; LSRFND - given in B the addr of the LSR1 entry of a luser, +; snarfs into the table LSR the byte-pointers to the various items, +; so that LSR+n contains the pointer to item n. +NITMS==20. ;This is the length of LSR and the number of items we can know. + +LSRFND: PUSH P,A + PUSH P,B + PUSH P,C + PUSH P,D + HRLI B,440700 ;TURN ADDR INTO B.P. + AOS B + MOVE C,[LSR,,LSR+1] + SETZM LSR ;CLEAR ALL ENTRIES OF LSR TABLE. + BLT C,LSR+NITMS-1 + MOVSI C,-NITMS +LSRFN1: MOVE A,B + IBP A ;IF NEXT CHAR IS IN A WORD + HRRZ D,(A) ;WHOSE LOW BIT IS SET, WE HAVE RUN OUT OF ITEMS IN + CAIN D,-1 ;THIS ENTRY, SO GIVE UP LEAVING REST OF LSR ZEROED. + JRST LSRFN9 + LDB A,A ;LOOK AT 1ST CHAR OF NEXT ITEM. + SKIPE A ;IF IT'S NOT ^@, ITEM ISN'T NULL, + MOVEM B,LSR(C) ;SO REMEMBER IT IN THE LSR TABLE. + ILDB A,B + JUMPN A,.-1 ;NOW SKIP THE ITEM. + AOBJN C,LSRFN1 ;DO THIS FOR EACH ITEM PRESENT, UP TO LIMIT WE CAN HANDLE. +LSRFN9: POP P,D + POP P,C + POP P,B + POP P,A + POPJ P, + +BVAR +LSR: BLOCK NITMS +EVAR + + ; Read CHANNA;LOGOUT TIMES file into core, if not on DM, + ;and find last logout time for user in u%xunm(X). + ; (leaves byte ptr in A, 0 if not found) +BVAR +lgonm1: 0 ;these hold ASCII of name to look for. +lgonm2: 0 +EVAR + +lgotim: skipn a,lgotry ;should we? + popj p, ;if 0, don't try, return zero. + skipn lgoptr ;if not in core yet, + jrst [ pushj p,lgoget ;get the file. + jrst [ setz a, ;if failed to get it, + setzm lgotry ;return 0 and don't try again. + popj p,] + jrst .+1] + push p,b ;protect against ULSEEK. + push p,c + move b,[440600,,u%xunm(x)] + move c,[440700,,lgonm1] + setzm lgonm1 + setzm lgonm2 +lgotm2: ildb a,b ; get 6bit + addi a,40 + idpb a,c + tlne b,770000 ;last char hacked? + jrst lgotm2 + + move c,lgoptr ;get aobjn + move a,lgonm1 +lgotm5: camn a,(c) ;first 5 chars equal? + jrst [ move b,1(c) ;get next wd for 6th char + and b,[774000,,0] ;mask out 1st char + came b,lgonm2 ;matches 6th char of uname? + jrst .+1 ;nope + jrst lgotm7] ;aha, finally found it! + addi c,4 ;add 5 to index each pass (25. chars/entry) + aobjn c,lgotm5 + setz a, ;didn't find at all. + jrst popcbj + +lgotm7: movei a,1(c) ;must form bp to char after uname. + hrli a,350700 ; (pts to 2nd char) +popcbj: pop p,c + pop p,b + popj p, + +lgoget: syscal open,[[.bii,,dkic] ? ['dsk,,] + ['logout] ? [sixbit /times/] ? ['channa]] + popj p, ;fail. + push p,a + syscal fillen,[cimm dkic ? cret a] + jsr error + movem a,lgolen + addi a,1777 + trz a,1777 + addm a,ffloc + lsh a,-10. + movns a + hrlzs a + hrr a,ffpag + syscal corblk,[ movei %cbprv ; read-only + movei -1 ? a ? cimm dkic] + jsr error + .close dkic, + push p,b + move a,lgolen + idivi a,5. ;calculate # entries (25. chars = 5 wds per entry) + ;ignore any remainder. +; jumpn b,[tlne f,%svrmod ;jump if lossage (file not right length) +; jrst popbaj ;if server, don't complain. +; .value [asciz /:mail bug-name,bug-dragon LOGOUT TIMES has garbage!p/] +; jrst popbaj] + movns a + hrlzs a + move b,ffpag + lsh b,10. + hrr a,b + movem a,lgoptr ;set up ptr to file + pop p,b + pop p,a + aos (p) ;won. + popj p, + +wtype6: push p,a ;type 6 columns of sixbit + push p,b + movem a,t6 + move b,[440600,,t6] +wtyp6a: ildb a,b + typi 40(a) + tlne b,770000 + jrst wtyp6a + pop p,b + pop p,a + popj p, + +atype6: push p,a ;save the universe frob bashage + push p,b + move b,a ;get the word where we can LSHC it +atyp6a: setz a, ;clear out gubbish + lshc a,6 ;get the first char + typi 40(a) ;type it as ascii + sos i ;keep count of the characters we type + jumpn b,atyp6a ;if there's more, type it + pop p,b + pop p,a + popj p, + +type6: hrli a,440600 ;byte pointer to 6bit chars + movem a,t6 ;pointer like for type7 +shvout: ildb a,t6 ;get char + cain a,'% ;'%' is delimiter + popj p, ;return when thru + addi a,40 ;convert 6bit to ascii + .iot tyoc,a + jrst shvout + +octhak: movei b,0 + lshc a,-3 ;uses b reg also + lsh a,3 ;effect of lsh's is to separate the octal digits by 3 + lshc a,3. ;and align them on right + popj p, + +tmhms: movei c,0 + jrst tmp3 + +tmpt: movei c,0 + jumpe d,cpopj + camge d,tmt1(c) + aoja c,.-1 +tmp3: idiv d,tmt1(c) + addi d,"0 + .iot tyoc,d + move d,e + trnn c,1 + aoja c,tmp3 + cail c,5 + popj p, + .iot tyoc,[":] + aoja c,tmp3 + +tmt1: 36000. + 3600. + 600. + 60. + 10. + 1 + +gttys: syscal open,[[.bai,,dkic] ? ['dsk,,] + ['ttytyp] ? [sixbit />/] ? ['syseng]] + jsr error + syscal fillen,[cimm dkic ? cret a] + jsr error + addi a,1 ;so that can be sure of zero word. + movei a,1777(a) + lsh a,-10. ;get # pages needed for file. + movns a + hrlzs a + hrri a,usrpag ;set up page AOBJN + movem a,tyfpgs ;save so can free pages later. + syscal corblk,[cimm %cbndr+%cbndw+%cbcpy + cimm -1 ? A ? cimm dkic] ;slurp up. + jsr error + .close dkic, + move a,[440700,,usrfil] +gttys0: ildb b,a +gttys1: caie b,0 + cain b,^C ;at eof? + jsr error ;yes! no entry in ttytyp for this machine! + caie b,"; ;maybe we've found an entry. + jrst gttys0 + ildb b,a + caie b,"; ;an entry has three semicolons, a space, and a machine name. + jrst gttys1 + ildb b,a + caie b,"; + jrst gttys1 + ildb b,a + caie b,40 + jrst gttys1 + move d,mname ;found the semi's and space; now see if machine name is ours. +gttys2: ildb b,a + caie b,40 + cain b,^M + jrst gttys3 + andi b,77 + xori b,40 + rot d,6 + xori d,(b) + trnn d,77 + jrst gttys2 + ldb b,a + jrst gttys1 + +gttys3: jumpn d,gttys1 + ;found entry for our site! + ;now find the individual strings in the ttytyp file entry, + ;copy them as asciz strings into TTYFIL, and put b.p.'s + ;to them in the ttydoc table. + setzm ttydoc + move c,[ttydoc,,ttydoc+1] + blt c,ttydoc+maxtty-1 ;clear out TTYDOC table. + move c,[-maxtty,,ttydoc] + move d,[440700,,ttyfil] +gttys4: ildb b,a + caie b,0 ;eof => no more strings. + cain b,^C + jrst gttys5 + caie b,"; + jrst gttys4 ;find next documentation string. + ildb b,a + cain b,"; ;2 semi's in a row => start of next entry + jrst gttys5 ;meaning end of this one. + caie b,"T ;comment doesn't start with "Tnm " => ignore it. + jrst gttys4 + ildb b,a + cail b,"0 + caile b,"9 + jrst gttys4 + ildb b,a ;don't bother testing the 3rd char for digithood, + ildb b,a + caie b,40 ;but check 4th for blankness. + jrst gttys4 + movem d,(c) ;remember the byte pointer to the string. +gttys7: ildb b,a ;copy into TTYFIL. + cain b,^M + setz b, ;make ASCIZ when done. + idpb b,d + jumpn b,gttys7 + jrst gttys8 + +gttys6: ildb b,a ;find the end of this string, + caie b,^M + jrst gttys6 +gttys8: aobjn c,gttys4 + jsr error ;too many tty's in ttytyp?!? + +gttys5: movei a,1(d) ;check terminating address + cail a,usrfil ;to make sure nothing will be clobbered. + jsr error ;ugh, TTY data too large! Must allocate more in assembly. + move a,tyfpgs + syscal corblk,[ cimm 0 ? cimm -1 ? A ? cimm -1] ;free up pages. + jsr error + popj p, + +define dismis (addr) +.call [setz ? 'dismis ? ctli (setz) +ifse [addr][][ setz p] +ifsn [addr][][ p + ifn <@>&, setzi addr + .else setz addr + ] +] +termin + +BVAR + +tsint: setz p ;our pdl ptr. 4.9 bit means save .jpc, .suuoh, lspcl + + ;special block for lmfing + 0 +lmintb: 0 + -1 ? -1 + lmintr + + ;simple typein interrupt + 0 ? %tyib + -1 ? -1 + inttyi + + ;tty output interrupt for **MORE**. + 0 ? %tyob + -1 ? -1 + inttyo + + ;for IOC errors, particularly on net. + %piioc ? 0 + -1 ? -1 ;defer wds. defer everything in the world. + intioc ;pc to start this group at + + ; For nasty conditions + %pipdl+%pimpv ? 0 ; PDL OV and MPV + -1 ? -1 + intftl ; fatal interrupt +lintblk=.-tsint + +neterr: 0 ;loc to return to if IOC error occurs on net. +savpdl: 0 ; place to save P +savc: 0 ; place to save C (see MAIN50) +jpcsav: 0 ; save JPC if fatal interrupt. +EVAR + +;Interrupt when anything happens on Chaosnet channels +lmintr: setom lmintf + push p,tt + movei tt,177777 ;Defer any further interrupts + iorm tt,-5(p) ;(This is the saved DF2 word) + hrrz tt,-4(p) ;PC interrupted out of + cain tt,lmintw + aos -4(p) ;Unsleep + pop p,tt + dismis + +intftl: .suset [.rjpc,,jpcsav] ; save loc for debugging. + jsr error + +intioc: tlne f,%svrmod + jsr error + push p,a + .suset [.rbchn,,a] + cain a,nticp ;must be net channel. + jrst intio3 + caie a,ntic + cain a,ntoc + jrst intio3 + jsr error +intio3: pushae p,[t,tt] + pushj p,netwrk"analyz ;print out error msg + jsr error + popae p,[tt,t,a] + skipn neterr + jsr error + dismis @neterr ;return to net err location. (indirect!) + +inttyi: push p,a + movei a,tyic + .ityic a, + jrst intyi3 ;no int. char, ignore. + caie a,^G + cain a,^S + jrst [syscal ttyfls,[cimm tyic ? ctli 1] ; Flush input up to int char + .lose %lssys + .reset tyoc, ; and halt output + jsr exit] ; and quit. +intyi3: pop p,a + dismis ;else ignore it. + +inttyo: pushae p,[a,u1,u2] + syscal whyint,[cimm tyoc ? cret a ? cret u1] + jsr error + cain a,%wytyo + skipl u1 + jrst intyo4 ;ignore int if not a **MORE** int. + type [--MORE--] + syscal finish,[cimm tyoc ? cerr errcod] + jfcl + syscal iot,[cimm tyic ? cret a ? ctli %tiact+%tipek+%tiint] + jsr error + cain a,40 ;space to continue? + jrst intyo3 + type [Flushed] + jsr exit ;nope, kill it without resetting buffer. + +intyo3: syscal iot,[cimm tyic ? cret a ? ctli %tiact+%tiint] ;aha, space. flush it. + jsr error + .iot tyoc,[^M] + .iot tyoc,[^J] ;go to top of screen easily +intyo4: popae p,[u2,u1,a] + dismis + +uuoh: ldb u1,[$opcode,,40] + caie u1,0 + caile u1,nuuo + jsr error + jrst @uuotab-1(u1) + + +define uuodef name,handlr +if1 [ +ifndef nuuo,nuuo==0 +nuuo==nuuo+1 +name!nuuo_27. +] + handlr +termin + +uuotab: + uuodef iot=,u.iot + uuodef netblk=,u.ntb + uuodef typi=,u.typi + uuodef typc=,u.typc + uuodef typz=,u.typz + uuodef 7typ=,u.7typ + uuodef ustrn=,u.ustr + uuodef 6typ=,u.6typ + +;6TYP option,E - typeout sixbit in E +;If option is 0, hack truncation using line length in I +;If option is 1, don't hack truncation + +u.6typ: move u1,40 + ldb u3,[270400,,u1] ;Get option. + hrrz u1,u1 ;Get address of sixbit string. + hrli u1,440600 ;Make into sixbit Bp. +6typ1: ildb u2,u1 ;Get a character. + jumpe u2,cpopj ;If zero, all done. + addi u2,40 ;ASCIIfy. + cain u3,0 + jrst [ jumple i,6typ2 ;Truncate if no more room. + soja i,.+1 ] + .iot tyoc,u2 ;Type it out. + tlne u1,770000 ;If end of word, all done. + jrst 6typ1 ;Else keep going. +6typ2: popj p, + +;Type Immediate. +u.typi: hrrz u1,40 + tlne f,%chasrv + pushj p,lmccnv ;convert character to lispm character set + tlnn f,%supd + .iot tyoc,u1 + tlne f,%supd + idpb u1,e + popj p, + +;Compare two strings with uppercase force and skip if not equal +u.ustr: pushae p,[a,b] + move u3,40 + ldb u1,[$acfld,,u3] + move u1,(u1) ;get pointer to one string + move u2,(u1) ;get cnt + came u2,(u3) ;compare counts + jrst ustr9 ;fail instantly if counts unequal. + jumpe u2,ustr8 ;win instantly if both zero + move u1,1(u1) ;and byte ptrs + move u3,1(u3) ;and for other string +ustr2: ildb a,u1 + ildb b,u3 + caie a,(b) + jrst [ cail a,"a + caile a,"z + caia + subi a,40 + cail b,"a + caile b,"z + caia + subi b,40 + caie a,(b) + jrst ustr9 ;unequal even with uppercase. + jrst .+1] ;equal, saved. + sojg u2,ustr2 + jrst ustr8 +ustr9: aos -2(p) ;match failed, skip on return. +ustr8: popae p,[b,a] + popj p, + + +u.iot: ldb u1,[$acfld,,40] ;block mode output + movem u1,pch + hrrz u1,40 + hrli u1,440700 ;set up byte pointer (addr in a as arg.) + movem u1,t7 ;store so don't need extra acc + push p,[.] ;loop if lmccnv finds ^J +u.i1: ildb u1,t7 ;get char + jumpe u1,pop1j ;stop when zero char reached (^@) + cain u1,^C + jrst pop1j + tlne f,%chasrv + pushj p,lmccnv + syscal iot,[pch ? u1] + jsr error + jrst u.i1 + +;Wait for net channel to change state +u.ntb: movei u1,20.*30. + movem u1,timout' ;set up max time to wait + move u1,@40 + ldb u2,[$acfld,,40] + syscal netblk,[u2 ? u1 ? timout ? cret u2] + jrst ntb3 + hrrz u1,40 + move u1,1(u1) ;pick up second work of arg +ntb1: camn u2,(u1) ;is current state on list? + jrst ntb2 + aobjn u1,ntb1 + caia +ntb2: aos (p) +ntb3: popj p, + +;Type out asciz string at E +u.typz: move u2,40 + hrli u2,440700 + push p,[.] ; loop if lmccnv finds ^J + jrst u.tyz3 + +u.tyz2: tlne f,%chasrv + pushj p,lmccnv + tlnn f,%supd + .iot tyoc,u1 + tlne f,%supd + idpb u1,e +u.tyz3: ildb u1,u2 + jumpn u1,u.tyz2 +pop1j: pop p,(p) + popj p, + +;Type out string at E terminated by ctl char +u.typc: move u2,40 + hrli u2,440700 + jrst u.tyc3 + +u.tyc2: tlne f,%chasrv + pushj p,lmccnv ; can't get ^J + tlnn f,%supd + .iot tyoc,u1 + tlne f,%supd + idpb u1,e +u.tyc3: ildb u1,u2 + cail u1,40 + jrst u.tyc2 + popj p, + +lmccnv: cain u1,^J + jrst pop1j + caie u1,^M + cain u1,^I + tro u1,200 + popj p, + +; 7TYP ,[] OUTPUTS AN ASCIZ STRING TO TTY. +; IS AS FOLLOWS: +; 0 => STRAIGHT ASCIZ. +; 1 => TERMINATE BEFORE A CR (PRINT ONLY 1 LINE). +; 2 => PRINT ONLY 1 WORD. +; 3 => PRINT ONLY 1 WORD. +; 4 => REPLACE EVERY CRLF BY A SEMICOLON-SPACE. +; 5 => ONE TAB IN FRONT OF EVERY LINE BUT THE FIRST. +; DON'T OUTPUT TRAILING CRLF. + +U.7TYP: PUSH P,A + MOVE A,40 + TRNN A,-1 + JRST POPAJ + PUSH P,B + PUSH P,C + LDB C,[270400,,A] + MOVE A,(A) +7TYP1: ILDB B,A + JUMPE B,PPCBAJ + + CAIN B,^M + JRST @7DABLE(C) +7TYP4: CAIN B,^C + JRST 7TYP1 +7TYPIT: .IOT tyoc,B + TLNN A,760000 + CAIE C,2 + JRST 7TYP1 +PPCBAJ: POP P,C +POPBAJ: POP P,B + POP P,A +CPOPJ: POPJ P, + +7DABLE: 7TYPIT ;DISPATCH TABLE BASED ON AC FIELD - WHAT TO DO FOR CR? + PPCBAJ + 7TYPIT + 7TYPIT + 7TYP6 + 7TYP5 + +7TYP6: .IOT tyoc,[";] + .IOT tyoc,[40] + ILDB B,A ;PASS THE LF. + JRST 7TYP1 + +7TYP5: ILDB B,A + CAIE B,^J + CAIN B,^M + JRST 7TYP5 + JUMPE B,PPCBAJ + tlne f,%chasrv + jrst [.iot tyoc,[215] + jrst .+3] + .IOT tyoc,[^M] + .IOT tyoc,[^J] + pushae p,[a,b] + skipa b,[440700,,indenl] +7typ54: .iot tyoc,a + ildb a,b + jumpn a,7typ54 + popae p,[b,a] + JRST 7TYP4 + + + +nnhsts==100 ;Number of hosts we can accept in our JCL. + +BVAR + +hjtab: block nnhsts +EVAR +define tvkbd num,name/ + loc kbddoc+num +ifse [name], 440700,,[asciz /???/] +ifsn [name], 440700,,[asciz /name/] +termin + +ttydoc: block maxtty + +kbddoc: + +.insrt sysen2;tvkbd rooms + +loc kbddoc+maxkbd + +;Given A -> ? , +;we look the string up as a host name. +;If found, we return the host number in A and skip. +;Otherwise we clobber A and don't skip. + +HANLYZ: PUSHAE P,[B,C,D,E,T,TT] + MOVE D,(A) + MOVE B,1(A) + MOVE C,[440700,,HANLST] + JUMPE D,HANLY1 +HANLY0: ILDB T,B + IDPB T,C + SOJG D,HANLY0 +HANLY1: IDPB D,C + MOVEI A,HANLST + PUSHJ P,NETWRK"HSTLOOK + JRST [ SKIPN ITBARF + JRST HANLY9 + TYPZ CRLF + TYPI "[ + TYPZ (A) + TYPZ [ASCIZ " is an unknown host]"] + TYPZ CRLF + TYPZ CRLF + JRST HANLY9 ] + AOS -6(P) +HANLY9: POPAE P,[TT,T,E,D,C,B] + POPJ P, + +;;; tcp support routines + +tcplsn: syscal tcpopn,[movei 1(a) ? movei 2(a) + b ? [-1] ;local, foreign + [-1]] + popj p, ;failure return + movei b,3.*30. ;3 seconds for a listen (expect immediate + syscal netblk,[movei 1(a) ? movei %nslsn ? b ? movem c ? movem b] + popj p, ;another failure + tlz c,-1 + caie c,%nsrfc ;maybe still in rfc + jrst tcpls2 ;nope + movei b,30.*30. ;30 seconds for a full connection + syscal netblk,[movei 1(a) ? movei %nsrfc ? b ? movem c ? movem b] + popj p, ;another failure +tcpls2: jumple b,cpopj + tlz c,-1 + caie c,%nsopn ;open, or + cain c,%nsinp ;open with input + jrst popj1 ;success + cain c,%nscli ;also closed with input + jrst popj1 + popj p, + +tcpicp: pushj p,netwrk"tcpcon + popj p, + jrst popj1 + + +; Routine to get table of known ITS machines from the system. +itsnms: push p,b + move t,[-,,hsits] ; Ask for 1 more than we have room for. + move tt,[sixbit /ITSNMS/] + .getsys t, + jfcl + skipl t + .lose ; Wow! We're rolling in ITS machines! + setzi a, +itsnm1: skipn tt,hsits(a) + jrst itsnmx + move b,a + lsh b,1 + add b,[440700,,itsnmz] + hrrzm b,hsits(a) +itsnm2: setzi t,0 + lshc t,6 + movei t,"A-'A(t) + idpb t,b + jumpn tt,itsnm2 + idpb tt,b + aoja a,itsnm1 + +itsnmx: movei a,hsits + pop p,b + popj p, + +; Having these hosts wired into the NAME program like this is a loss. +; There should be a database somewhere that this can be read from. + +; The tables are in reverse order; the machines listed first are going +; to be displayed last. Maybe this is a bug. Also, there should be +; a way to make it list the idle lisp machines too (some switch to check +; to avoid the null-uname check..) + +BVAR + +hsits: irps x,,[AI,MX,MC] + sixbit /x/ + termin +repeat 9, 0 +mxitss==:.-hsits + 0 + +itsnmz: block 2*mxitss ; ASCIZ strings for above + +EVAR + +;Match name of ITS system to list of names of lisp machines +;that should be considered automatically with that ITS system. +hs10lm: sixbit /mc/+hslmmc + 0 + + ;Lisp machines associated with MC. +hslmmc: irps x,,sinatra bing avatar merlin lm20 lm19 mit-pi lm9 lm16 lm12 starling gstaad sancho + [asciz/x/] + termin + 0 + + ; List of all Lisp machines. +; Now reagan has the all-lispm finger server, *lispm = Reagan +hslm: [asciz /reagan/] + 0 +commen ~ + irps x,,lm15 lm27 sinatra bing mit-merlin lm22 mit-pi jimi janis buddy moon morrison elvis lennon + [asciz /x/] + termin + irps x,,ap1 ap2 ap3 ap4 ap5 ap6 ap7 ap8 ap9 ap10 + [asciz /x/] + termin + irps x,,rb1 rb2 rb3 rb4 + [asciz /x/] + termin + irps x,,mickey minnie boo-boo yogi mit-cherry mit-flame mit-live-oak + [asciz /x/] + termin + irps x,,tweety-pie mit-panda mit-koala mit-polar mit-grizzly + [asciz /x/] + termin + irps x,,starling gstaad lm12 lm9 lm16 + [asciz /x/] + termin + irps x,,cadr-test lm1 lm2 lm3 lm4 lm5 lm6 lm7 lm8 lm11 lm18 lm19 lm20 lm21 lm23 lm24 lm25 lm26 lm28 lm29 lm30 lm31 lm32 + [asciz /x/] + termin + irps x,,lm13 lm14 lm17 + [asciz /x/] + termin +end reaganomics flame +~ + ;List of NE43 VMS sites (*VMS). +hsvms: irps x,,pig corwin oberon vulcan golem + [asciz /x/] + termin + 0 + + ;MIT Twenex sites +hstnx: irps x,,xx oz speech ee + [asciz /x/] + termin + 0 + + ;List of Apiary machines. +hsapes: irps x,,ap1 ap2 ap3 ap4 ap5 ap6 ap7 ap8 ap9 ap10 + [asciz /x/] + termin + 0 + + ;List of Robotics machines. +hsbots: irps x,,vulcan golem lm5 lm25 rb1 rb2 rb3 rb4 + [asciz /x/] + termin + 0 + + ; List of a few MIT sites known to have NAME/FINGER servers. +hsmit: irps x,,mc oz xx multics mit-vx corwin oberon vulcan pig eecs speech htvax htjr math dspg syl cipg + [asciz /x/] + termin + 0 + + +hschs: irps x,mc oz xx scrc-tenex mit-vx corwin oberon marie vulcan pig eecs speech htvax htjr dspg syl cipg + [asciz /x/] + termin + irps x,,scrc-yukon scrc-riverside pointer bassett beagle retriever spaniel terrier + [asciz /x/] + termin + 0 + + ; List of SCRC hosts that have NAME/FINGER servers +hsscrc: irps x,,scrc-tenex scrc-afghan scrc-assabet scrc-basset scrc-beagle scrc-blackstone scrc-borzoi scrc-boxer scrc-bulldog scrc-charles scrc-collie scrc-connecticut scrc-dachshund scrc-dalmatian scrc-euphrates scrc-housatonic scrc-husky scrc-menotomy scrc-merrimack scrc-muddy scrc-mystic scrc-neponset scrc-pointer scrc-retriever scrc-samoyed scrc-schnauzer scrc-setter scrc-shepherd scrc-spaniel scrc-susquehanna scrc-terrier + [asciz /x/] + termin + 0 + + ; List of all sites known to have NAME/FINGER servers + ; Tries to have the most interresting hosts first + ; because they are contacted in the order listed here. +hsall: irps x,,mc oz xx vx multics ee + [asciz /x/] + termin + irps x,,sri-nic su-score sail su-sierra sumex su-isl s1-a cmua cmub cmuc cmud + [asciz /x/] + termin + irps x,,cit-20 lbl-unix ll-11 ll-asg ll-xn office-1 rand-ai rutgers sci-ics sdac-unix usc-eclb-ipi usc-isib usc-isid usc-isif utah-20 wharton-10 harv-10 + [asciz /x/] + termin + 0 + + + +BVAR + +ttyunm: 0 ;UNAME of person on this TTY, before any recursive TTYPRT's + ;For sake of not printing UNAME's of UNAME-JNAME pairs +;variables set according to jcl received by "name". +who: 0 ;nonzero => it is aobjn to a block of unames for particular + ;users. only those users are described. if a user is not + ;logged in, his uname and full name are printed anyway. +whotty: 0 ;nonzero => it is a aobjn ptr to the numbers of the ttys + ;which the user has requested a description of. +whofnm: 0 ;similar, for fnam table +mname: 0 ;sixbit name of running machine + 0 ;needed by kills2 + + +versio: .fnam2 ;version # of program. +pdl: -60,,. + block 60 ;push down list +jclcnt: 0 ;cnt of chars in jcl buffer +jclbln==150. ;max # chars allowed in JCL buffer +jclbuf: block +1 ;we tell ddt to store jcl line here. +jclx: ascii / +/ ;ddt will stop when it finds a nonzero word. + ; parser will stop when it finds ^M. + +hanlst: block 10 ;temp. storage for asciz string to give to hstlook. + +cnnptr: 0 ;byte pointer to line being built up to send +cnncnt: 0 ;byte count of " +connam: block 20 ;string itself + +seknam: block 6 ;name to look up. chr per word +dwnml: block 10 ;read sys:down mail into this block if nec. + 0 ;fence for type7 +supdid: block 8 ;buffer for sending terminal ID to SUPDUP + 0 +pch: 0 ;temp storage for iot +t7: 0 ;holds b.p. in type7 +t6: 0 ;holds b.p. in type6 +tyfpgs: 0 ;holds page AOBJN for freeing core used in TTYTYP munching. +lgoptr: 0 ;byte ptr to logout times file +lgolen: 0 ; length of file in core +lgotry: -1 ; if 0, don't hack LOGOUT TIMES. + +strstl==20 ;fullnames copied to here when we permute them. +strfre: 440700,,strstg +strstg: block strstl ;storage used for consing up permuted fullnames. + +usrloc: 0 ;holds location of usr tables. +usrend: 0 ;address beyond which no integral usr block exists. +tluser: 0 ;total # of users about which info is stored. + +;The following is copied from location 101 in a TELSER +telinf:: +termid: block 8 ;if non-zero, an asciz terminal name +hstnam: block 8 ;if non-zero, the name of the host in asciz +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 +hstat: 0 ;Type of host (TAC, MINITS, USER, SERVER.) +TS%SRV==0 ;Server host. +TS%USR==1 ;User host only. +TS%TIP==2 ;Unknown hosts are treated like TIPs. +TS%MIN==3 ;MINITS terminal concentrator. + ;end of stuff looked at by NAME. +ltlinf==.-telinf + +;Table of Lisp machines. +lmadrs: block nontty ;Chaos net address, 0 if table entry not used +lmunam: block nontty ;Sixbit uname +lmidle: block nontty ;Ascii idle-time +lmdoc: repeat nontty, 440700,,lmdcfl+<.rpcnt*10> ;Address of console-location documentation +lmdcfl: block 10*nontty ;Console-location documentation stored here +nextlm: 0 ;Index of next machine to be connected to +lmintf: 0 ;Interrupt-occurred flag +chsidx: repeat 10,-1 ;-1 not in use, else index in lmadrs of guy connected to +chsstm: block 10 ;time transaction started +.vector lmpkt(%cpmxw) + + ; User-info block, one per each user reported. Blocks stored + ;dynamically in core above LSR file. +u%unam==0 ; UNAME of toplevel job in TTY's tree. +u%xunm==1 ; XUNAME of same. +u%jnam==3 ; JNAME of job with TTY. + +u%tty== 4 ; -1 user not logged in, + ; else LH = TTY #, rh=0 no sty, -1 non-net sty, 1 net sty +u%svrj==5 ; Job # of server associated with STY, if any. +u%jtm== 6 ; JTMU variable for job with TTY. (ascii of idle time for nontty tty) +u%aux1==7 ; If STY and belongs to non-network job, this is UNAME of that job. +u%aux2==10 ; and this is the JNAME. +u%flgs==11 ; Random flags associated with this entry. + %ulgin==1 ;indicates logged in. +u%fdir==12 ; tristate switch - file directory exists for XUNAME? + ; -1 => No, +1 => Yes. + ; > +1 => This xuname has an inquir entry, may or may not have a dir. + ; (the way things are done, it will never matter). + ; 0 => don't know (only allowed for users with tty's, + ; with whom it usually won't matter). +ul==13 ; length of a user-info block. + + variables +EVAR + +ttyfil: block 300 ;holds strings for TTY documentation. Should be last + ;thing before USRFIL, but still in pure core. + constants +ttsize=21 +purpge==<.+1777>/2000 +ttpage==<.+1777>/2000 +ttloc==ttpage*2000 ;Location of TTY location data +loc ttloc ;be sure to allocate a page there +0 + +usrpag==ttpage+2 +usrfil==usrpag*2000 +ls2org==usrfil +end go diff --git a/src/sysen2/tvkbd.rooms b/src/sysen2/tvkbd.rooms new file mode 100644 index 00000000..612202d7 --- /dev/null +++ b/src/sysen2/tvkbd.rooms @@ -0,0 +1,64 @@ +TVKBD 0,333 Robotics Group +TVKBD 1,810 Andreae, Connor, White, Wieckert x7836 +TVKBD 2,921 AI Music Hacker's Hangout x1728 +TVKBD 3,812 +TVKBD 4,813 Hewitt x5873 +TVKBD 5,816 Winston x6218 +TVKBD 6,811 Marx, Schunck, Zinnikas x5875 +TVKBD 7, +TVKBD 10,333 Robotics Group +TVKBD 11, +TVKBD 12, +TVKBD 13,819 Davis x5879 +TVKBD 14,820 +TVKBD 15, +TVKBD 16, +TVKBD 17,822 Ullman x5033 +TVKBD 20, +TVKBD 21,824 Hildreth, Katz, Levin x6032 +TVKBD 22,825 Hamscher, Hanson, Shirley x5848 +TVKBD 23,826 Fredkin x5904 +TVKBD 24,815 Horn x5863 +TVKBD 25, +TVKBD 26, +TVKBD 27, +TVKBD 30,926 Moon, Sealy, Stacy x6765 +TVKBD 31,902 Vision Lab x6769 +TVKBD 32,910 +TVKBD 33,342 Rich x7877 +TVKBD 34,913 Greenblatt x6765 +TVKBD 35,914 Stallman x2076 +TVKBD 36,912 +TVKBD 37,907 CADR-1's room x6765 +TVKBD 40,906 +TVKBD 41,356 Sussman x5874, Shrobe x5899 +TVKBD 42,348 Cherry, Forbus, McAllester, Roylance x7884 +TVKBD 43,350 Minsky x5864 +TVKBD 44,345a Ohanian x7845 +TVKBD 45,354 VLSI Hilton x7807 +TVKBD 46,346 Everyone Else (Tightly Packed) x7885 +TVKBD 47, +TVKBD 50, +TVKBD 51, +TVKBD 52, +TVKBD 53, +TVKBD 54, +TVKBD 55, +TVKBD 56, +TVKBD 57, +TVKBD 60, +TVKBD 61, +TVKBD 62, +TVKBD 63, +TVKBD 64, +TVKBD 65, +TVKBD 66, +TVKBD 67, +TVKBD 70, +TVKBD 71, +TVKBD 72, +TVKBD 73, +TVKBD 74, +TVKBD 75, +TVKBD 76, +TVKBD 77,