From 1f2856de633fd8674c47e59d5ad123171c831529 Mon Sep 17 00:00:00 2001 From: Eric Swenson Date: Sat, 6 Oct 2018 13:29:23 -0700 Subject: [PATCH] Added inquir; inqexm and inqrep. Created links for ts inqchk and ts inqpat. Resolves #1260. --- build/lisp.tcl | 7 + src/inquir/inqexm.101 | 1113 +++++++++++++++++++++++++++++++++++++++++ src/inquir/inqrep.32 | 529 ++++++++++++++++++++ 3 files changed, 1649 insertions(+) create mode 100755 src/inquir/inqexm.101 create mode 100755 src/inquir/inqrep.32 diff --git a/build/lisp.tcl b/build/lisp.tcl index d1bcd60b..03a90223 100644 --- a/build/lisp.tcl +++ b/build/lisp.tcl @@ -196,6 +196,13 @@ respond "_" "inquir;inquir\r" respond "_" "\032" type ":kill\r" +respond "*" ":midas inquir;ts inqexm_inqexm\r" +expect ":KILL" +respond "*" ":midas inquir;ts inqrep_inqrep\r" +expect ":KILL" +respond "*" ":link inquir;ts inqchk,ts inquir\r" +respond "*" ":link inquir;ts inqpat,inqupd bin\r" + respond "*" "complr\013" respond "_" "liblsp;_libdoc;dbg ejs2\r" respond "_" "liblsp;_libdoc;comrd kmp1\r" diff --git a/src/inquir/inqexm.101 b/src/inquir/inqexm.101 new file mode 100755 index 00000000..80e3e2a1 --- /dev/null +++ b/src/inquir/inqexm.101 @@ -0,0 +1,1113 @@ +;-*- MODE: MIDAS -*- + +TITLE INQEXM - Examine Inquire Database + ;CStacy 6/8/83 + +;;; This program is used to examine the LSR1 database in various ways. +;;; For a list of commands, run it and type HELP. + +;;;; Things to do: +;;;; Quoted strings for the syllable reader. +;;;; Inferiors - WHOIS, LOOKUP, INQUIR. +;;;; Command to toggle UNAME/Full printouts. +;;;; INQREP. +;;;; Fancier search criteria ala KMP's food transfer protocol. +;;;; Print list of users from a file of UNAMES. +;;;; HAS-ACCOUNT-P predicate. + +;;; Registers. + +X=0 ;Super temporary register. +A=1 ;General registers. +B=2 +C=3 +D=4 +E=5 +BP=6 ;Byte pointer. +CHAR=7 ;Character. +COUNT=10 ;Accumulator. +T=12 ;Temporary registers. +TT=13 +OC==14 ;Default output channel. +U1==T ;4 UUO Registers. +U2==TT +U3==15 +U4==16 +P=17 ;Stack pointer. + +;;; I/O Channels + +DSKI==1 ;Disk Input. +DSKO==2 ;Disk Output. +TTYO=15 ;TTY typeout. +TTYI=16 ;TTY typein. + +;;; Date and time routines. + +DATIME"$$IN==1 ;Conversion from ASCII date-time to standard form. +DATIME"$$ABS==1 ;Conversion from disk format dates to absolute days. +.INSRT SYSENG;DATIME > + +;;; LSR1 database routines. + +$$OVLY==0 ;Map entire LSR1 file at once. +$$HSNM==1 ;Get HSNAME routines also. + ;All other routines defaultly selected. +.INSRT SYSENG;LSRTNS > + +;;; Filename parsing routines. + +RFN"$$RFN==1 +.INSRT SYSENG;RFN > + + +;;; Macros and output routines. + +$$OUT==1 +.INSRT KSC;MACROS > +.INSRT KSC;OUT > + +;;; Get symbol table lookup routines from network package. + +$$ARPA==1 ;Must specify a network.. +$$SYMLOOK==1 +.INSRT SYSENG;NETWRK > + + +SUBTTL More Macros + +DEFINE DECBP C ;Decrement byte pointer. + ADD C,[70000,,] ;Back up the byte pointer. + SKIPGE C ;Did we cross a word boundary? + SUB C,[430000,,1] ; then fix it. +TERMIN + + +DEFINE UPPER CHR ;uppercase ascii character + CAIL CHR,141 ;lower "a" + CAILE CHR,172 ;lower "z" + CAIA ;if got here, it's not lower a-z, skip + SUBI CHR,40 ;convert case +TERMIN + +;;; Macro for tokenization calls. +;;; Fails or puts token in TOKEN +;;; Note: BPTR not used in this implementation. + +DEFINE GTOKEN BPTR,FAILER,TYPE + SKIPN MORJCL + JRST FAILER + CALL RD2TKN + JRST FAILER +IFSE TYPE,REST, CALL TOKNZR +IFSE TYPE,ASC, CALL TOKNIZ +IFSE TYPE,SIX, CALL RDSIX + JRST FAILER +TERMIN + + + +SUBTTL Error Handler and Returns + +POPJ1: AOS (P) ;Skip +CPOPJ: RET ;Return + +SYSLOS:: +AUTPSY: 0 ;Fatal error JSR here. + .LOSE %LSFIL ;Print error message. + ;If the luser continues us, log out. +DEATH: SKIPE DEBUG ;Jump to your fate! + .VALUE [ASCIZ /:Dying... /] + .LOGOUT 1, ;Suicide! + + +;;; Fatal bugs are reported with this: + +DEFINE BUG (LIST) + JRST [ MOVEI OC,TTYO + OUT!LIST + POP P,OC + JSR AUTPSY ] +TERMIN + + +;;; Non fatal errors are reported with these: + +DEFINE ERRRET (LIST) + JRST [ PUSH P,OC + MOVEI OC,TTYO + OUT!LIST + POP P,OC + RET ] +TERMIN + +DEFINE BARF GO,(LIST) + JRST [ PUSH P,OC + MOVEI OC,TTYO + OUT!LIST + POP P,OC + JRST GO ] +TERMIN + + + + +SUBTTL Interrupt handler. + +TMPLOC 42,{-TSINTL,,TSINT} ;New style interrupts. +INTACS==T_6+5 ;Temp/OUT registers preserved. + +TSINT: INTACS,,P + 0 ? 1_TTYI ? 0 ? <1_TTYO>\<1_TTYI> ? CHRINT + 0 ? 1_TTYO ? 0 ? 0 ? MORINT +TSINTL==:.-TSINT + +;;; Interrupt dismissal + +INTRET: SYSCAL DISMIS,[%CLBIT,,INTACS ? P] + JSR SYSLOS + +;;; Console interrupts. + +CHRINT: MOVEI T,TTYI ;Interrupt character. + .ITYIC T, + JRST INTRET + CAIN T,^S + JRST [.RESET TTYO, + SYSCAL TTYFLS,[ %CLBIT,,1 ? %CLIMM,,TTYI] + .LOSE %LSSYS + JRST FLSIT] + CAIN T,^G + JRST [.RESET TTYO, + SYSCAL TTYFLS,[ %CLBIT,,1 ? %CLIMM,,TTYI] + .LOSE %LSSYS + OUT(TTYO,("(Quit)")) + JRST FLSIT1] + JRST INTRET ;Ignore other control characters. +MORINT: OUT(TTYO,("--More--")) ;MORE break. + SYSCAL IOT,[%CLBIT,,%TIPEK ? %CLIMM,,TTYI ? %CLOUT,,T] + .LOSE %LSFIL + CAIE T,40 + CAIN T,177 + .IOT TTYI,T + CAIE T,40 + JRST FLSIT + OUT(TTYO,("A")) + JRST INTRET +FLSIT: OUT(TTYO,("Flushed")) + ;Flushing a command means +FLSIT1: MOVEI T,TOPLEV ;and returning to toplevel. + MOVEM T,-5(P) + JRST INTRET + + + +SUBTTL Command Tables + +DEFINE CMD NAME,ROUTIN,&SHORT,LONG +TMPLOC HLPTAB+.-CMDTAB,{[ASCIZ LONG],,[ASCIZ SHORT]} + ROUTIN,,[ASCIZ \NAME\ ] +TERMIN +IF1 HLPTAB==0 + +;;; Table of top level commands. +;;; If the short doc starts with an underscore, the command is not listed +;;; in KHELP. Long documentation is still avilable though. + +CMDTAB: + CMD QUIT,DEATH,"Quit this program.","" + + CMD HELP,KHELP,"List the available commands.","HELP [CR] Lists the commands available. +HELP [CR] Explains the command in greater detail." + + CMD ?,KHELP,"_Same as HELP.","To get help, type: HELP [CR]" + + CMD BADGROUPS,KBADGR,"List users will illegal Group designations.","This command will list the UNAME and GROUP of all people in the database +whose group letter is not one of the officially approved designators." + + CMD CASE,KCASE,"Examine or toggle case sensitivity in string searches.","By default, substring search commands like COUNT and SEARCH ignore the +alphabetic case of the search strings. With the CASE command, you may +change this setting, and can make case be significant when searching. +CASE [CR] Tells you what the current setting is, and offers to change it." + + CMD COUNT,KCOUNT,"Count database entries.","COUNT [CR] Counts up all the entries in the database. +COUNT [CR] Does a search and counts up all the +matching entries." + + CMD FILE,KFILE,"Sends next command's output to a file.","FILE [CR] Changes which file to send the output to." + + CMD GROUP,KGROUP,"Tell what group a person is in.","GROUP Looks up the user and prints an English explanation of his group designation." + + CMD GOODGROUP,KGOOGR,"List the approved Group item designation letters.","" + + CMD ITEMS,KITEMS,"List the names of the database items.","" + + CMD NEWUFD,KNUFD,"Create a new User File Directory.","NEWUFD [CR] Creates the named file directory." + + CMD SEARCH,KSEARC,"Substring search through items in the database entries.","SEARCH [CR] Searches through the file and prints +the UNAMEs of the matching entries. The ITEMS command will tell you +the names of the database items." + + +CMDTBL==.-CMDTAB +HLPTBL==CMDTBL +IF1 EXPUNGE HLPTAB +HLPTAB: BLOCK CMDTBL + + +NITMS==0 +DEFINE ITEM NAME,NUM,DESC/ +IFNB [DESC] TMPLOC ITDTAB+.-ITMTAB, [ASCIZ\DESC\] + NUM,,[ASCIZ\NAME\] +NITMS==NITMS+1 +TERMIN +IF1 ITDTAB==0 + +;;; Table of Inquire items by [item-number,,name] +;;; ITDIAB is a table of corrosponding asciz [description] strings. + +ITMTAB: ITEM UNAME,LSRTNS"I$UNAM,User name + ITEM AUTH,LSRTNS"I$AUTH,Authorization + ITEM NAME,LSRTNS"I$NAME,Name + ITEM NICK,LSRTNS"I$NICK,Nick name + ITEM GROUP,LSRTNS"I$GRP,Group + ITEM RELATION,LSRTNS"I$REL,Relation + ITEM MITADR,LSRTNS"I$MITA,MIT address + ITEM MITTEL,LSRTNS"I$MITT,MIT phone + ITEM HOMADR,LSRTNS"I$HOMA,Home address + ITEM HOMTEL,LSRTNS"I$HOMT,Home phone + ITEM NETBOX,LSRTNS"I$NETA,Network mailbox + ITEM BIRTHDAY,LSRTNS"I$BRTH,Birthday + ITEM PROJECT,LSRTNS"I$PROJ,Project + ITEM SUPERVISOR,LSRTNS"I$SUPR,Supervisor + ITEM REMARKS,LSRTNS"I$REM,Remarks + ITEM FILEDIR,LSRTNS"I$DIR,File directory + ITEM LOCAL,LSRTNS"I$LOCL,Local items + ITEM MACHINES,LSRTNS"I$MACH,Machines known on + ITEM ALTER,LSRTNS"I$ALTR,Last Alteration timestamp + +ITMTBL==.-ITMTAB +IF1 EXPUNGE ITDTAB +ITDTAB: BLOCK ITMTBL + + +DEFINE GRPLTR LETTER,&DESC + [ASCIZ DESC],,LETTER +TERMIN + +GRPTAB: GRPLTR "A,"Artificial Intelligence Lab" + GRPLTR "C,"Project MAC" + GRPLTR "D,"Dynamic Modelling" + GRPLTR "E,"EECS" + GRPLTR "L,"LOGO Lab" + GRPLTR "H,"ACTOR" + GRPLTR "K,"Kollaborating Researcher" + GRPLTR "M,"Mathlab" + GRPLTR "O,"Other (program, etc.)" + GRPLTR "N,"Non-Consortium Macsyma" + GRPLTR "P,"Knowledge Bases/AutoProg" + GRPLTR "S,"MIT student/staff/faculty" + GRPLTR "T,"Tourist" + GRPLTR "U,"Macsyma Consortium Subscriber" + GRPLTR "X,"MIT-XX LCS" + GRPLTR "Z,"Clinical Decision Making" + GRPLTR "+,"MIT System Maintainer" + GRPLTR "$,"Foreign System Maintainer" + GRPLTR "@,"Alias entry" +; GRPLTR "~,"Dave Plummer" +; GRPLTR "*,"RMS" +; GRPLTR "`,"Alan Bawden" + +GRPTBL==.-GRPTAB + + + +SUBTTL Main Program + +GO: MOVE P,[-PDLLEN,,PDL] ;Init the stack. + SYSCAL OPEN,[%CLBIT,,<.UAO\%TJDIS> ? %CLIMM,,TTYO ? [SIXBIT /TTY/]] + .LOSE %LSFIL + SYSCAL OPEN,[%CLBIT,,.UAI ? %CLIMM,,TTYI ? [SIXBIT /TTY/]] + .LOSE %LSFIL + SYSCAL CNSGET,[%CLIMM,,TTYO ? %CLOUT,,X ? %CLOUT,,TCMXH] + .LOSE %LSFIL + SYSCAL TTYSET,[%CLIMM,,TTYI ? [222222,,222222] ? [230222,,220222]] + .LOSE %LSFIL + .SUSET [.ROPTION,,A] ;Read job option bits. + TLO A,%OPINT\%OPOPC ;Turn on winning-PC and new interrupts. + .SUSET [.SOPTION,,A] ;Set option bits. + .SUSET [.SMSK2,,[<1_TTYI>\<1_TTYO>]] ;Enable TTY interrupts. + .SUSET [.RHSNAM,,A] ;Read home sname. + MOVEM A,SNAME ;Use as output file default. +MAPLSR: MOVEI A,DSKI ;Try to map in Inquire database. + MOVE B,[-LSRPGS,,LSRPAG] + CALL LSRTNS"LSRMAP + BUG (,("AUnable to map Inquire database."),CRLF) + .CLOSE DSKI, + MOVEI A,LSRPGS + HLRZ B,B + HRLI B,-1 + ADD A,B ;Subtract Reserved-Used pages. + MOVEM A,TOTAL ;Remember total length of file mapped. + MOVE A,LSR1+LSRTNS"HDRDTA ;Get address in file of Data area. + ADDI A,LSR1 ;Compute core address. + MOVEM A,DATA ;Remember where first entry is. + OUT(TTYO,OPEN(UC$IOT)) + OUT(,CH(TTYO)) ;Open typeout display as default device. + MOVE A,LSR1+LSRTNS"HDRDAT + MOVE B,LSR1+LSRTNS"HDRTIM + OUT(,CRLF,CRLF,("INQUIR Database Examiner "),6F(VERSHN),(".")) + OUT(,("AThis LSR1 database created "),6W(A),(" "),6W(B),("."),CRLF) + + +SUBTTL Top Level Loop + +;;; Commands: +;;; o Are passed MORJCL, BP, COUNT, and parse their own args. +;;; o May smash any ACs. +;;; o Come here on ^S or ^G or Moreflush. +;;; o Skip on success. (Command failure does not mean +;;; anything special though.) +;;; o Output from commands should go to standard-output. +;;; Error messages go to TTYO (one reason for macros). + + +TOPLEV: MOVE P,[-PDLLEN,,PDL] ;Re-initialize the stack pointer. + MOVE A,KFILEF + JUMPL A,TOPLE1 ;Normally, dont mess with output. + JUMPE A,[ OUT(,CH(TTYO)) + OUT(DSKO,CLS) + OUT(,("A"),LBRK,("Output to TTY."),RBRK) + SETOM KFILEF ;Set output-status to normal. + JRST TOPLE1 ] + SETZM KFILEF ;Now doing command to disk output. +TOPLE1: CALL CMREAD ;Read a command line. + JRST TOPLEV + MOVE BP,[440700,,CMDBUF] + CALL RD2TKN + NOP + MOVE A,BP + ILDB CHAR,BP ;If the first character is a semicolon + CAIN CHAR,73 ; Ignore it, it's a comment. + JRST TOPLEV + MOVE BP,A + CALL TOKNIZ ;Gobble an ascii token into TOKEN. + NOP +TOPLE2: MOVEI A,TOKEN + MOVE E,[-CMDTBL,,CMDTAB] ;Check normal command table. + CALL NETWRK"SYMLOOK + JRST UNKCMD + CAMN B,[-1] ;Number? + JRST [ MOVEI A,KNUM ; Yes - look up that entry number. + JRST CMDIS1 ] +CMDISP: HLRZ A,(B) ;Get address of routine. +CMDIS1: CALL (A) ;Call the command. + NOP ;Failure return not handled specially. + JRST TOPLEV ;Loop. + +UNKCMD: OUT(TTYO,("AI don't know the word "),C(42),TZ(TOKEN),C(42),(".")) + JRST TOPLEV + + +;;; FILE command. + +KFILE: CALL RD2TKN ;Bp to filename arg in command line. + JRST KFILE1 ; If no filename, use current default. + MOVE D,BP + MOVEI B,DEVNAM ;Else parse filename into here. + CALL RFN"RFN +KFILE1: OUT(TTYO,("ASend output to "),6F(DEVNAM),(":"),6F(SNAME),(";")) + OUT(TTYO,6F(FN1),(" "),6F(FN2),(" ,OK?")) + CALL YORNP + ERRRET (TTYO,("AAborted, use FILE command to change defaults.")) + SYSCAL OPEN,[%CLBIT,,%TJDIS+.UAO ? %CLIMM,,DSKO + DEVNAM ? FN1 ? FN2 ? SNAME] + ERRRET (TTYO,("AUnable to open file.")) + OUT(DSKO,OPEN(UC$IOT)) + OUT(,CH(DSKO)) ;Open disk output as default. + MOVEI T,1 + MOVEM T,KFILEF ;Say we just set disk output. + OUT(TTYO,("A"),LBRK,("Output to disk."),RBRK) + JRST POPJ1 + + + + +SUBTTL Loop through database. + +;;; This routine maps the function pointed to by FUN over every +;;; entry in the database. LOOP normally skip-returns, non-skip +;;; means there was an error. LOOP smashes random ACs. +;;; We return the core address of the entry found in LSTADR. +;;; +;;; The user's function must not smash any ACs. +;;; The core address of the entry is available in A. +;;; COUNT is maintained. User skip-return means keep going, +;;; non-skip ends the loop. There is no call-return convention for +;;; the user function to indicate success or failure to LOOP's caller. +;;; +;;; If we call GOTO instead of LOOP, we stop at the entry +;;; whose number is in E. + +;;;; (What this should do someday is take two functions: +;;;; a predicate and an consequence...) + +GOTO: PUSHAE P,[A,B,C,D,E] + MOVEI A,POPJ1 ;Do nothing function. + MOVEM A,FUN + JRST LOOP1 ;Now loop until target. + +LOOP: PUSHAE P,[A,B,C,D,E] + MOVE E,[-1] ;Normally we count up to infinity. +LOOP1: MOVE A,DATA + SETZ B, ;B is the offset to the next one. + SETZ COUNT, +LOOP2: AOS COUNT ;Keep count of entries. + MOVE C,(A) ;Get entry header. + HRRZ D,C ;RH has check value. + CAIE D,-1 ;Check for valid header. + JRST [ OUT(,("AEntry number "),D(COUNT),(" at "),O(A),(" has bad header: "),H(C),(" ."),CRLF) + JRST LOOP9 ] + HLRZ B,C ;Get entry length. + CAMN COUNT,E ;Are we at the target entry? + JRST [ JUMPN B,LOOP8 ; Yes. Return address of target + SOS COUNT ; Or complain if past eof. + JRST LOOP9 ] +LOOP3: JUMPE B,LOOP7 ;A zero length entry terminates the file. + CALL @FUN ;Call the user's function. + JRST LOOP8 ; See if user wants to return now. + ADD A,B ;Add offset to find next entry. + JRST LOOP2 ;Go fetch another entry. + +LOOP7: SOS COUNT ;Here for EOF success. +LOOP8: AOS -5(P) ;Success exit. +LOOP9: MOVEM A,LSTADR ;Say where last entry was found. + POPAE P,[E,D,C,B,A] + RET + + + +SUBTTL Simple Commands + +;;; KHELP - Give the user some help + +KHELP: GTOKEN BP,KHEL1,ASC ;Get subtopic, else list commands. + MOVEI A,TOKEN + MOVE E,[-CMDTBL,,CMDTAB] + CALL NETWRK"SYMLOOK ;Look up the field name. + ERRRET (TTYO,CRLF,("I dont know about "),TZ(TOKEN)) + CAMN B,[-1] ;See if he wants to know about KNUM. + JRST [ MOVE A,T ; Yes - get database entry number in A. + OUT(,CRLF,("Print the UNAME of the LSR1 entry at "),D(A),(".")) + JRST KHEL9 ] + SUBI B,CMDTAB + ADDI B,HLPTAB + HLRZ BP,(B) ;Address of long documentation string. + SKIPN (BP) + ERRRET (TTYO,("ANo detailed information for that command.")) + HRLI BP,440700 ;Make it into a Bp. + OUT(,CRLF,TPZ(BP),CRLF) + JRST KHEL9 +KHEL1: OUT(,CRLF,("Command keywords may be abbreviated, they need only be unique."),CRLF) + MOVSI A,-CMDTBL +KHEL2: HRR BP,HLPTAB(A) ;Examine next short help string. + HRLI BP,440700 ;Make Bp to string. + ILDB CHAR,BP ;Check first char. + CAIN CHAR,137 ;If it starts with an underscore + JRST KHEL3 ; do not list it. + HRLI BP,440700 ;Else list it (restore Bp to start). + HRRZ B,CMDTAB(A) ;And next command name. + HRLI B,440700 + OUT(,TPZ(B),TAB,TPZ(BP),CRLF) +KHEL3: AOBJN A,KHEL2 ;List them all. + OUT(,("Or type the number (with decimal point) of an entry to find.")) + OUT(,CRLF,("Type HELP for info on a particular command.")) + OUT(,CRLF,("More features are planned. Mail to CSTACY for bug reports, etc.")) +KHEL9: OUT(,CRLF,CRLF) + JRST POPJ1 + + + +;;; KNUM - Find an entry by number. +;;; This command is not called directly by the user. +;;; We expect a database entry number in T. + +KNUM: MOVE E,T + SKIPN E + ERRRET (TTYO,("AWe count entries from one, not zero.")) + CALL GOTO + ERRRET (TTYO,("AThere are only "),D(COUNT),(" entries in the database.")) + MOVEI A,LSRTNS"I$UNAM + MOVE B,LSTADR + CALL LSRTNS"LSRITM + BUG (,("AThe entry at "),O(LSTADR),(" lacks a UNAME.")) + OUT(,("AEntry number "),D(COUNT),(" at "),O(LSTADR),(" belongs to "),TPZ(A),(".")) + JRST POPJ1 + + + +;;; KCASE - Change case sensitivity settings. + +KCASE: MOVE A,[SIXBIT /OFF/] ;Zero means OFF. + SKIPE ALPCAS ;If it is -1 + MOVE A,[SIXBIT /ON/] ; say it is on. + OUT(TTYO,("ACase sensitivity is currently "),6F(A),(".")) + OUT(TTYO,CRLF,("Change it?")) + MOVE A,ALPCAS + CALL YORNP ;Want to change it? + CAIA + SETCA A, + MOVEM A,ALPCAS + JRST POPJ1 + + + + +SUBTTL KNUDIR - Make a new UFD + +KNUFD: GTOKEN BP,KNUFDN,SIX + OUT(TTYO,("AAre you sure you want to create a "),6F(A),("; directory?")) + CALL YORNP + ERRRET (TTYO,("AAborted.")) + SYSCAL OPEN,[%CLBIT,,.UAI ? %CLIMM,,DSKO + [SIXBIT /DSK/] + [SIXBIT /..NEW./] + [SIXBIT /(UDIR)/] + A + %CLERR,,B] + JRST [ CAIN B,%ENSFL ;FILE NOT FOUND error means success. + JRST KNUFD1 + OUT(TTYO,("AError: Directory not created.")) + JRST KNUFD9 ] + OUT(TTYO,("ADirectory already exists.")) + SYSCAL DELEWO,[%CLIMM,DSKO] + NOP + JRST KNUFD9 +KNUFD1: OUT(TTYO,CRLF,6F(A),("; created.")) + AOS (P) +KNUFD9: .CLOSE DSKO, + RET + +KNUFDN: ERRRET (TTYO,("ADirectory name not specified.")) + + + +SUBTTL KCOUNT - Counts up the entries + +;;; This is a command to count up the entries in a database. + +KCOUNT: SKIPN MORJCL + JRST [ MOVEI A,POPJ1 ;#'(LAMBDA (&REST IGNORE))) + JRST KCOUN1 ] + GTOKEN BP,KSERMA,ASC ;Get Item name. + MOVEI A,TOKEN + MOVE E,[-ITMTBL,,ITMTAB] + CALL NETWRK"SYMLOOK ;Look up the field name. + ERRRET (TTYO,("A"),TZ(TOKEN),(" is not a known field.")) + CAMN B,[-1] ;Avoid confusing user with number radix. + ERRRET (TTYO,("AUse item names, not numbers. Try the ITEMS command for help.")) + HLRZ A,(B) ;A gets Inquire search item number. + MOVEM A,SEARIN ;Save it. + GTOKEN BP,KSERMA,REST ;Get search string. + MOVE T,B ;Get pointer into ITMTAB. + SUBI T,ITMTAB ;Convert to index for ITDTAB. + MOVE C,ITDTAB(T) ;C gets Bp to item description. + OUT(TTYO,("ASearching "),TZ$(C),(" items for "),C(42),TZ(TOKEN),C(42),(".")) + MOVEI A,KSEFN ;Use pickier function. +KCOUN1: MOVEM A,FUN + SETZM HITCNT ;Count the hits. + SETZM SEAPRT ;But dont print them. + CALL LOOP ;Go count up the entries. + ERRRET (TTYO,("AThere was a problem - maybe the database is munged?")) + SKIPN HITCNT + JRST KCOUN6 + OUT(TTYO,("A"),D(HITCNT),(" entries found."),CRLF) + JRST KCOUN9 +KCOUN6: MOVE A,LSTADR ;Get address of last entry found. + SUB A,DATA ;Compute number of data words. + MOVE B,LSR1+LSRTNS"HDRUNM ;Compute number of data pages + ADDI B,LSR1 ;(which is number of UNM entries). + MOVE B,(B) + OUT(TTYO,("ATotal of "),D(COUNT),(" entries in "),D(B),(" data pages "),LPAR,D(A),(" words"),RPAR,("."),CRLF) + OUT(TTYO,("LSR1 database consumes "),D(TOTAL),(" disk pages."),CRLF) +KCOUN9: JRST POPJ1 + + + +SUBTTL For searching the database + +;;; KITEMS command. +;;; This lists the names of all the database fields which can +;;; be used in search commands. + +KITEMS: MOVSI D,-NITMS ;Get AOBJN pointer to item names. + OUT(TTYO,CRLF,("FieldH"),C(24.),("NumberH"),C(32.),("Description")) +KITEM1: HRRZ A,ITMTAB(D) ;Get address of item name. + HLRZ B,ITMTAB(D) ;Get item number. + HRRZ C,ITDTAB(D) ;Get address of item description. + OUT(TTYO,CRLF,TZ$(A),("H"),C(24.),LPAR,D(B),RPAR,("H"),C(32.),TZ$(C)) + AOBJN D,KITEM1 + JRST POPJ1 + + +;;; SEARCH , +;;; Prints out the unames of all users who are found. + +KSEARC: GTOKEN BP,KSERMA,ASC ;Get item name. + MOVEI A,TOKEN + MOVE E,[-ITMTBL,,ITMTAB] + CALL NETWRK"SYMLOOK ;Look up the field name. + ERRRET (TTYO,("A"),TZ(TOKEN),(" is not a known field.")) + CAMN B,[-1] ;Avoid confusing user with number radix. + ERRRET (TTYO,("AUse item names, not numbers. Try the ITEMS command for help.")) +KSEAR1: HLRZ A,(B) ;A gets Inquire search item number. + MOVEM A,SEARIN ;Save it. + GTOKEN,KSERMA,REST ;Get search string. + MOVE T,B ;Get pointer into ITMTAB. + SUBI T,ITMTAB ;Convert to index for ITDTAB. + MOVE C,ITDTAB(T) ;C gets Bp to item description. +KSEAR2: OUT(TTYO,("ASearching "),TZ$(C),(" items for "),C(42),TZ(TOKEN),C(42),(".")) + MOVEI X,KSEFN + MOVEM X,FUN + SETZM HITCNT + SETOM SEAPRT + CALL LOOP ;Map KSEFN over the database. + NOP + JRST POPJ1 + +;;; Here for missing args to search command. + +KSERMA: ERRRET (TTYO,("AI don't see what to search for."),CRLF) + +;;; Search predicate function, to be called from LOOP context. + +KSEFN: PUSHAE P,[A,B] ;Clobber no ACs. + MOVE B,-1(P) ;Get core address of this entry. + MOVE A,SEARIN ;Get item number we want. + CALL LSRTNS"LSRITM ;A gets Bp to the item. + JRST KSEFN9 ; (Unless item is null...) + MOVE BP,[440700,,TOKEN] ;Get Bp to ASCIZ target. + MOVE B,A ;Get Bp to ASCIZ item. + CALL SFND ;See if the item contains the string. + JRST KSEFN9 + AOS HITCNT ;Hit! Count hits... + SKIPN SEAPRT ;Are we printing? + JRST KSEFN9 ; no. + MOVEI A,LSRTNS"I$UNAME ;Else Print out the uname. + MOVE B,-1(P) ;Get core address of this entry. + CALL LSRTNS"LSRITM ;A get Bp to the UNAME. + JRST KSEFN9 + OUT(,CRLF,TPZ(A)) +KSEFN9: POPAE P,[B,A] + JRST POPJ1 ;Never signal failure. + + + + +;;; GOODGROUP command - prints the legal Group item letters. + +KGOOGR: MOVSI A,-GRPTBL +KGOOG1: OUT(,CRLF) + HRLZI BP,440700 ;Get Bp to description. + HLR BP,GRPTAB(A) + HRRZ CHAR,GRPTAB(A) ;Get ASCII group letter. + SYSCAL IOT,[OC ? CHAR] ;B(acharbyte) not implemented in OUT. + JSR AUTPSY + OUT(,TAB,TPZ(BP)) + AOBJN A,KGOOG1 ;Loop for all groups. + OUT(,CRLF) + JRST POPJ1 + +;;; GROUP command - tells what kind of user someone is. + +KGROUP: GTOKEN,KGROUN,SIX + MOVE B,A ;Get sixbit uname. + MOVE C,A ;Save UNAME. + MOVEI A,0 ;LSR1 is in core. + CALL LSRTNS"LSRUNM + ERRRET (TTYO,("AUser not found.")) + MOVEI A,LSRTNS"I$NAME + CALL LSRTNS"LSRITM ;Try to get his name. + JRST [ MOVE A,[440700,,[ASCIZ "(Unknown)"]] + JRST .+1 ] + MOVE D,A ;Save Bp to NAME. + MOVEI A,LSRTNS"I$GRP + CALL LSRTNS"LSRITM ;Get Bp to group letter. + JRST [ MOVE A,[440700,,[ASCIZ ""]] + JRST .+1 ] + ILDB CHAR,A ;Get group letter. + MOVSI A,-GRPTBL +KGROU1: HRRZ B,GRPTAB(A) ;Get char from Groups table. + CAMN CHAR,B ;Is this his group? + JRST [ HRLZI BP,440700 ; Yes - get Bp to description. + HLR BP,GRPTAB(A) + JRST KGROU2 ] + AOBJN A,KGROU1 ;No, try again. + MOVE BP,[440700,,[ASCIZ "(unrecognized Group)"]] +KGROU2: MOVE B,[440700,,TOKEN] ;Bp to a string buffer. + MOVE A,D ;Bp to personal name. + CALL LSRTNS"LSRNAM ;Permute it down B. + NOP + MOVE B,[440700,,TOKEN] ;Bp to nice name. + OUT(,6F(C),(","),TAB,TPZ(B),(", is listed in the "),TPZ(BP),(" group.")) + JRST POPJ1 + +KGROUN: ERRRET (TTYO,("AYou did not specify a UNAME to look up.")) + + +;;; BADGROUP command - searches for people with bad Group items. +;;; Maybe someday make this take optional arg instead of built in list. + +KBADGR: MOVEI A,SIGFN ;Illegal Group Function. + MOVEM A,FUN + CALL LOOP + NOP + JRST POPJ1 + +;;; Illegal Group Item Predicate. To be called from LOOP context. + +SIGFN: PUSHAE P,[A,B,C] ;Clobber no ACs. + MOVE B,-2(P) ;Core address of this entry. + MOVEI A,LSRTNS"I$GRP ;We want the group. + CALL LSRTNS"LSRITM ;A gets Bp to the GROUP item. + JRST [ MOVE C,A + JRST SIGFN7 ] ; "No group is a bad group" + MOVE C,A + ILDB CHAR,A ;CHAR gets his group letter. + MOVE B,[440700,,OKGRPS] ;Bp to the good group letters. +SIGFN1: ILDB T,B ;Get a good letter. + JUMPE T,SIGFN7 + CAMN CHAR,T ;A good group? + JRST SIGFN9 ; Yes - dont print it. + JRST SIGFN1 +SIGFN7: MOVEI A,LSRTNS"I$UNAME ;Else Print out the uname. + MOVE B,-2(P) ;Get core address of this entry. + CALL LSRTNS"LSRITM ;A get Bp to the UNAME. + JRST KSEFN9 ; No UNAME, sigh... + OUT(,CRLF,TPZ(A),TAB,TPZ(C)) +SIGFN9: POPAE P,[C,B,A] + JRST POPJ1 ;Never signal failure. + + + + +SUBTTL Keyboard Input + +;;; Read an ASCIZ string from the TTY into the command buffer. +;;; This can be called anywhere for reading in an asciz string. +;;; Note that the ^S and ^G interrupt chars flush us to TOPLEV. +;;; Update count in COUNT and skip-return unless no characters read. +;;; +;;; This stuff probably doesnt work very well on glass TTYs. +;;; Too bad. + +CMREAD: OUT(TTYO,("A"),RABR) ;Prompt the user. + MOVE BP,[440700,,CMDBUF] ;Bp to command string buffer. + SETZ COUNT, +CMREA1: .IOT TTYI,CHAR ;Get a character. + CAIN CHAR,177 ;RUBOUT rubs out a character. + JRST RUBOUT + CAIN CHAR,^H + JRST [ OUT(TTYO,("SALUse the RUBOUT or DELETE key to delete characters.RF")) + JRST CMREA1 ] + CAIN CHAR,^D ;^D rubs out a line. + JRST RUBALL + CAIN CHAR,^U ;^U rubs out a line. + JRST RUBALL + CAIN CHAR,^L ;^L clears and redisplays. + JRST REDISP + CAIN CHAR,^R ;^R redisplays. + JRST REDIS1 + CAIE CHAR,^C ;^C and ^M finish input. + CAIN CHAR,^M + JRST [ MOVEI CHAR,0 + IDPB CHAR,BP ;Tie off ASCIZ string. + SKIPE COUNT ;If we read something + AOS (P) ; Skip + RET ] ; Return. + CAIGE CHAR,40 ;No random ctl chars allowed! + JRST [ OUT(TTYO,("")) + JRST REDIS1 ] + AOS COUNT ;Keep count of chars read. + CAILE COUNT,CMBUFL*5. ;Avoid overflowing the buffer. + JRST [ OUT(TTYO,("ASLine too long!R")) + JRST REDISP ] ; Chance to rubout some cruft. + IDPB CHAR,BP ;Stuff it. + JRST CMREA1 ;Get another. + +RUBOUT: SKIPN COUNT ;Dont allow rubout of nothing. + JRST [ OUT(TTYO,("")) + JRST CMREA1 ] + OUT(TTYO,("X")) ;Rubout. + DECBP BP + SOS COUNT ;Back up. + JRST CMREA1 ;Get another character. + +RUBALL: OUT(TTYO,("H"),C(8.),("L")) + JRST CMREAD ;Flush entire line. + +REDISP: OUT(TTYO,("C")) +REDIS1: MOVE A,COUNT ;Count word + HRLZI B,440700 ;followed by + HRRI B,CMDBUF ;Byte pointer. + OUT(TTYO,("H"),C(8.),("L"),RABR,TS(A)) + JRST CMREA1 + + + +SUBTTL Parsing + +;;; Routine for RFN. Skip if we should terminate a filename. + +RSIXTP: CAIN A,54 ;Comma is the only non-control + JRST POPJ1 ;character which ends filenames. + RET + +;;; Read an ascii token from BP into the TOKEN buffer. +;;; Set MORJCL if there are more characters. +;;; SKip return. + +TOKNZR: SETOM REST ;Come here for Rest tokenization. + CAIA +TOKNIZ: SETZM REST ;Come here for normal tokenization. + PUSHAE P,[B] + SETZM MORJCL ;Assume only one token. + MOVE B,[440700,,TOKEN] ;Bp to result +TOKNI1: ILDB CHAR,BP ;Get char + JUMPE CHAR,TOKNI4 ;A NUL ends JCL. + SKIPE REST + JRST TOKNI2 + CAIE CHAR,40 ;A SPACE + CAIN CHAR,54 ; or a COMMA. + JRST TOKNI3 ; end a token. +TOKNI2: IDPB CHAR,B ;Collect token characters. + SOJLE COUNT,TOKNI4 ;Dont go past end of typein! + JRST TOKNI1 +TOKNI3: SETOM MORJCL ;Say we did not read NUL. +TOKNI4: MOVEI CHAR,0 + IDPB CHAR,B ;Tie off asciz string. + POPAE P,[B] + JRST POPJ1 ;All done. + + + +;;; Read to next token. +;;; This advances BP to read the next non delimiter. +;;; Skip returns unless no more characters. + +RD2TKN: ILDB CHAR,BP ;Get a character. + SKIPE CHAR ;If end of string + CAIN CHAR,^M ; or CR + RET ; non-skip. + CAIN CHAR,40 + JRST RD2TKN + CAIN CHAR,"," + JRST RD2TKN + DECBP BP ;Not delimiter - back up. + JRST POPJ1 ;Skip return with BP pointing at it. + + +;;; Read a sixbit word from BP, and return it in A. +;;; BP is updated. Skips unless we deposited no characters. +;;; +;;; BP should be pointing at first character of a new syllable - +;;; delimiters will end the input. There is no check to see if +;;; the syllable will fit in a sixbit word. We just fill one word. + +RDSIX: SETZ T, ;Count characters in T. + SETZ A, ;Result goes into A. + MOVE TT,[440600,,A] ;Bp to the sixbit result. +RDSI1: ILDB CHAR,BP ;Get a character. + JUMPE CHAR,RDSI9 + CAIN CHAR,40 ;Space ends word. + JRST RDSI2 + CAIN CHAR,^M ;CR ends word. + JRST RDSI2 + CAIN CHAR,"," ;Comma ends word. + JRST RDSI2 + CAIL CHAR,140 ;Sixbitify. + SUBI CHAR,40 + SUBI CHAR,40 + IDPB CHAR,TT ;Deposit into result. + AOS T ;Keep count. + CAIE T,6 ;If room for more, + JRST RDSI1 ; gobble again. +RDSI2: JUMPE T,CPOPJ +RDSI9: JRST POPJ1 + + + +SUBTTL Utility Routines + +;;; Map the LOGOUT TIMES database into core. +;;; Skip return if successful. + +MAPTIM: SYSCAL OPEN,[%CLBIT,,.BAI ? %CLIMM,,DSKI ? [SIXBIT /DSK/] + [SIXBIT /LOGOUT/] ? [SIXBIT/TIMES/] ? [SIXBIT /CHANNA/]] + ERRRET (TTYO,("ACannot open LOGOUT TIMES database.")) + SYSCAL FILLEN,[%CLIMM,,DSKI ? %CLOUT,,A] + JSR SYSLOS + CAIL A,TIMMAX + BUG (,("ANot enough pages reserved for LOGOUT TIMES.")) + MOVEM A,TIMLEN + ADDI A,1777 + LSH A,-10. + MOVNS A + HRLZS A + HRRI A,TIMPAG + SYSCAL CORBLK,[%CLIMM,,%CBRED ? %CLIMM,,%JSELF ? A ? %CLIMM,,DSKI] + JSR SYSLOS + .CLOSE DSKI, + JRST POPJ1 + + +;;; (Y-OR-N-P) Skips on True. + +YORNP: OUT(TTYO,(" (Y or N) ")) + .IOT TTYI,CHAR + CAIN CHAR,40 + JRST YORNY + CAIN CHAR,177 + JRST YORNN + UPPER CHAR + CAIN CHAR,131 + JRST YORNY + CAIN CHAR,116 + JRST YORNN + OUT(TTYO,("X")) + JRST YORNP +YORNY: AOS (P) +YORNN: RET + + +;;; SFND - String Find +;;; String Find an ASCIZ string inside another. +;;; Takes a substring from BP and a string to search from B. +;;; Skip returns if BP is in B. +;;; Clobbers no ACs. (Someday return the index, but not needed yet.) + +SFND: PUSHAE P,[A,B,C,D,E,BP] + MOVE E,ALPCAS ;Alphabetic case flag. +SFND1: ILDB CHAR,BP ;Get character to look for. + JUMPE CHAR,SFND9 ;Null string matches nothing. + JUMPE E,[UPPER CHAR + JRST .+1] +SFND2: ILDB C,B ;Get character. + JUMPE C,SFND9 ;Lose if we get to the end of the string. + JUMPE E,[UPPER C + JRST .+1] + CAME CHAR,C ;We are looking for start of BP in B. + JRST SFND2 ; Keep looking for a starting point. + MOVEM B,D ;Remember starting point. +SFND3: ILDB CHAR,BP ;Get another character pair. + JUMPE CHAR,SFND8 ;If BP runs out before B, we have won. + JUMPE E,[UPPER CHAR + JRST .+1] + ILDB C,B + JUMPE C,SFND9 ;If B runs out before BP, no match. + JUMPE E,[UPPER C + JRST .+1] + CAME CHAR,C ;If the match is incomplete + JRST [ MOVE B,D ; Try to find a new starting point. + MOVE BP,(P) ; Re-establsh target Bp for another try. + JRST SFND1 ] + JRST SFND3 ;See if the entire string matches. +SFND8: AOS -6(P) +SFND9: POPAE P,[BP,E,D,C,B,A] + RET + + + + + +SUBTTL Storage Definitions. + +CONSTANTS +VARIABLES + +PDLLEN==64. ;Stack length. +PDL: BLOCK PDLLEN ;The stack. + +VERSHN: .FNAM2 ;Program version in sixbit. + +JUNK: 0 ;Data sink. + +DEBUG: 0 ;-1 Iff debugging INQEXM. + +TCMXH: 0 ;Console horizontal size. + +CMBUFL==<100./5> +CMDBUF: BLOCK CMBUFL+1 ;Command string buffer. + +TOKENL==<20./5> +TOKEN: BLOCK TOKENL ;Command token. + +REST: 0 ;Controls type of tokenization. + ;-1 Iff should ignore delimiters. + +MORJCL: 0 ;-1 Iff NUL unseen in command tokenization. + +FUN: 0 ;Pointer to user function. + +LSTADR: 0 ;Core address of the last found in KCOUNT. + +DATA: 0 ;Address of first LSR1 data entry. + +TOTAL: 0 ;Number of LSR1 pages read in. + +TIMLEN: 0 ;# Words read of LOGOUT TIMES. + +;;; Output redirection state - used in main command loop. +KFILEF: -1 ;1 Iff we just did a FILE command. + ;-1 Iff normal. + ;0 Iff should reset after command. + +;;; A Filename block. + +DEVNAM: SIXBIT /DSK/ ;Start out with reasonable defaults. +FN1: SIXBIT /_EXM_/ +FN2: SIXBIT />/ +SNAME: 0 + +ALPCAS: 0 ;-1 Iff alphabetic case should be + ;significant in substring search tests. + +SEARIN: 0 ;Item number for KSEFN substring search. + +HITCNT: 0 ;Hits in discriminating COUNT. + +SEAPRT: 0 ;-1 Iff Searches should print out hits. + +;;; List of OK Group designation items. +OKGRPS: ASCIZ /ACDELHKMONPSTUXZ+$@/ + +QNUDIR: 0 + +PAT:PATCH:: BLOCK 100 + 0 + +CONSTANTS +VARIABLES + + +;;; Now come the pages we map in from database. + +LASTPG==<.+1777>/2000 ;Start mapping databases here. + +LSRPAG==LASTPG ;Starting page of Inquire database. +LSRPGS==220. ;Number of pages reserved for LSR1. +LSR1=LSRPAG*2000 ;Address of database header. + +TIMPAG==LSRPAG+LSRPGS ;Starting page of last-logout database. +TIMPGS==40. ;Number of pages for LOGOUT TIMES. +TIMMAX==TIMPGS*2000 ;Number of words maximum for LOGOUT TIMES. + + + +END GO + + +;;; Local Modes: +;;; Mode:MIDAS +;;; compile command: :midas 1 M +;;; End: diff --git a/src/inquir/inqrep.32 b/src/inquir/inqrep.32 new file mode 100755 index 00000000..1e1e9989 --- /dev/null +++ b/src/inquir/inqrep.32 @@ -0,0 +1,529 @@ +;-*- Mode:MIDAS -*- + +title Reap the INQUIR data base. + +;;; This program is used to reap the Inquire data base. +;;; Each group has its own grace period. --- 12/9/81 by CStacy. + +;; Default groups: +;; TOURISTS: T,S,K +;; GUESTS: N,$,E +;; Regular users not included above: A,C,D,L,H,M,P,U,X,Z,+,@,O + + +;To use INQREP, run it and type G (for Generate) at it. +;It will write a preliminary list as INQUIR;REAP GEN. +;Then run INQREP again and type F (for Filter) at it. +;This will filter out some names and write INQUIR;REAP FILTRD. +;Copy that file to INQUIR;REAP GEN on some other machine. +;Run INQREP there and type F at it. +;This will filter out more names and write INQUIR;REAP FILTRD on that machine. +;Keep copying REAP FILTRD to REAP GEN on another machine and doing INQREP F +;there until a filter has been done on each machine. +;Then read in INQUIR;REAP FILTRD, examine the names, remove any that really +;ought to be preserved (setting their authorizations to other than * so that +;they will not be offered for reaping again. +;Then write it out as INQUIR;REAP DELETE, run INQREP and type D (for Delete) at it +;to delete all the names remaining on the list. + + +subttl Basic Definitions + +x=0 +a=1 +b=2 +c=3 +d=4 +e=5 +g=6 +h=7 +i=10 +j=11 +bp=12 +t=13 +tt=14 +p=17 + +lsrch==1 ;Inquire mapping channel. +dski==2 ;Disk input channel. +dsko==3 ;Disk output channel. + +ttyi==5 ;TTY typein channel. +ttyo==6 ;TTY typeout channel. + +lpdl==100 + +define syscal op,args + .call [setz ? sixbit/op/ ? args ((setz))] +termin + +argi==1000 +val==2000 +errret==3000 +cnt==4000 +cnti==5000 + +call=pushj p, +ret=popj p, +save==push p, +rest==pop p, + +define type ch,&string + movei t,<.length string> + move tt,[440700,,[ascii string]] + syscal siot,[argi,,ch ? tt ? t] + .lose %lsfil +termin + +define terpri ch + .iot ch,[^M] + .iot ch,[^J] +termin + +define upasc chr + cail chr,140 + subi chr,40 +termin + +datime"$$in==1 ;Routine to turn ascii date-time into standard form. +datime"$$abs==1 ;Routines to convert disk format dates to absolute days. +datime"$$out==1 +.insrt syseng;datime + +lsrtns"$$ovly==0 ;Map entire LSR file into core at once. +lsrtns"$$ulnm==0 ;Don't assemble some things we don't need. +lsrtns"$$ulnp==0 +lsrtns"$$unam==0 +.insrt syseng;lsrtns + + + +go: move p,[-lpdl,,pdl] ;Init the stack. + syscal open,[cnti,,.uao+%tjdis ;Dpy TTY output. + argi,,ttyo ? [sixbit /TTY/]] + .lose %lsfil + syscal open,[cnti,,.uai ;TTY input. + argi,,ttyi ? [sixbit /TTY/]] + .lose %lsfil + type ttyo,/A(G)enerate, (F)ilter, or (D)elete ?/ + .iot ttyi,d ;Ask what she wants. + upasc d + cain d,"G ;Gonna do a Generate? + jrst gen + cain d,"F ;Gonna do a Filter? + jrst filter + cain d,"D ;Gonna do a Delete? + jrst delete + type ttyo,/AI dont know how to do that to an Inquire database!/ + .logout 1, ;maybe discourage total losers. + + + +subttl Generate + +;; The Generate operation writes a list of all users who we should consider +;; for reaping into INQUIR;REAP GEN. This is the file to be Filtered. + +gen: type ttyo,/AShall I reap tourists?/ + .iot ttyi,d + upasc d + cain d,"Y + setom reaptf + type ttyo,/AShall I reap people in group {N,E,$}?/ + .iot ttyi,d + upasc d + cain d,"Y + setom reapnf + type ttyo,/AShall I reap lab people also?/ + .iot ttyi,d + upasc d + cain d,"Y + setom reaplf + + syscal open,[cnti,,.uao ? argi,,dsko + [sixbit /DSK/] ;Open the output file. + [sixbit /REAP/] + [sixbit /GEN/] + [sixbit /INQUIR/]] + .lose %lsfil + + movei a,lsrch ;Try to map in LSR1 on this channel. + move b,[-lsrpgs,,lsrpag] ;Place to put data. + call lsrtns"lsrmap + .value [asciz /:FOO! Unable to map in Inquire database./] + movei b,lsrpag*2000 + add b,lsrtns"hdrdta+lsrpag*2000 + +;; See if we are are going to even consider reaping the next Inquire entry. + +genlup: movei a,lsrtns"i$grp ;Item number of into A. + call lsrtns"lsritm ;Try to get this entry's group. + jrst randm ;No group = tourist. + ildb g,a ;Group letter into G. + jrst randm +reapT: move a,reaptf + skipe a, ;If we are reaping tourists + jrst [ move bp,[440700,,grpa] ;use group A. + call tryg + jumpn cnsidr,randm + jrst reapN ] +reapN: move a,reapnf + skipe a, ;If we are reaping other guests + jrst [ move bp,[440700,,grpb] ;use group B. + call tryg + jumpn cnsidr,randm + jrst reapL ] +reapL: move a,reaplf + skipe a, ;If we are reaping lab people + jrst randm1 ;consider any remaining group. +randm: movei a,lsrtns"i$auth + call lsrtns"lsritm ;Get the Auth for this entry. + jrst randm1 ;Consider null authorizations, (if they exist!) + ildb a,a +cnsaut: caie a,"* ;If Auth is not "*", dont consider. + jrst gennxt +randm1: movei a,lsrtns"i$uname ;Ok, consider him. Output his uname to the file. + aos kcnsid ;Keep count just for laughs. + call lsrtns"lsritm + jrst gennxt + call itmsix ;Get it as sixbit in A. G still has group. + call wrlin +gennxt: hlrz a,(b) ;Advance to next LSR entry. + add b,a + hlrz a,(b) + jumpn a,genlup ;next entry is zero-length => we've reached the end. +done: .close dsko, + skipe debug ;Dont :KILL if we are not debugging. + jrst [ type ttyo,/AAll Done./ + .logout 1,] + .value [asciz /:Done./] + + +;See if an entry is part of the set under consideration. +tryg: setzm cnsidr ;Flag saying we should consider this entry. + ildb c,bp ;Get a letter from the group-set. + jumpe c,cpopj ;If no more letters, return. + came g,c ;Maybe this entry should be considered. + jrst tryg ;On the other hand, maybe not. + setom cnsidr ;Then again,... + ret + +;Read the asciz string off the b.p. in A and return as sixbit in A. +itmsix: setz h, + move d,[440600,,h] +itmsi1: ildb c,a ;Get the uname of this entry as sixbit in A. + jumpe c,itmsi2 + cail c,140 + subi c,40 + tlnn d,770000 ;Don't gobble more than six characters. + jrst itmsi1 + subi c,40 + idpb c,d + jrst itmsi1 + +itmsi2: move a,h + ret + + + +subttl Filter + +;; The Filter operation reads in INQUIR;REAP GEN and writes INQUIR;REAP FILTRD. +;; Each name in the input file is written in the output file unless +;; that name has logged in on this machine within the grace period specified +;; for his group, or has a directory on this machine. + +filter: call timmap + syscal rqdate,[val,,now] + .lose %lssys + syscal open,[cnti,,.uai ? argi,,dski + [sixbit /DSK/] + [sixbit /REAP/] + [sixbit /GEN/] + [sixbit /INQUIR/]] + .lose %lsfil + syscal open,[cnti,,.uao ? argi,,dsko + [sixbit /DSK/] + [sixbit /REAP/] + [sixbit /FILTRD/] + [sixbit /INQUIR/]] + .lose %lsfil + +fillup: call rdlin ;Read in the next uname in A and group in G. + jrst done + syscal open,[cnti,,.bii ? argi,,lsrch + [sixbit /DSK/] ? [sixbit /.FILE./] ? [sixbit /(DIR)/] ? a] + caia + jrst fillup ;Filter out anyone who has a directory. + push p,a + call timsrc ;Look up his last logout time. + jrst filwrt ;No logout time remembered => certainly flush him. + move b,a + move a,now ;Found it => how many days ago was it? + call datime"timsub ;Subtract last logout time from current time. + idivi a,24.*60.*60. ;Convert seconds to days. + call getgra ;Get the correct grace period. + camg a,grace ;If it is recent enough, don't flush him. + jrst filnx1 +filwrt: pop p,a ;If he is old enough, write him into the output file + call wrlin ;Just the same way he was read from it. + jrst fillup + +filnx1: pop p,a + jrst fillup + +;; Set GRACE to the value appropriate for this person, based on +;; on his Inquire group (in G). + +getgra: move bp,[440700,,grpa] ;See if this group letter is in group A. +getgr1: ildb c,bp + jumpe c,getgr2 + came g,c ;Match? + jrst getgr1 + move t,grac.a + jrst gotgra +getgr2: move bp,[440700,,grpb] ;See if this group letter is in group B. +getgr3: ildb c,bp + skipn c, + jrst [ move t,grac.0 ;If not in A or B, use default value. + jrst gotgra] + came g,c ;Match? + jrst getgr1 + move t,grac.a +gotgra: movem t,grace + ret + + +subttl Delete + +;; The Delete operation reads INQUIR;REAP DELETE and deletes everyone on it. + +delete: syscal open,[argi,,dski + [sixbit /DSK/] + [sixbit /REAP/] + [sixbit /DELETE/] + [sixbit /INQUIR/]] + .lose %lsfil + syscal open,[cnti,,.uao ? argi,,dsko + [sixbit /DSK/] + [sixbit /_INQREP/] + [sixbit /OUTPUT/] + [sixbit/.MAIL./]] + .lose %lsfil + call rdlin + jrst done + push p,a + type dsko,/From-Job:INQREP +From:RX"INQREP +To:(UPDATE-INQUIR ML) +To:(UPDATE-INQUIR DM) +To:(UPDATE-INQUIR MC) +Text;-1 +/ + jrst dellu1 +dellup: call rdlin ;Read next user name into A. + jrst deldon + push p,a +dellu1: type dsko,/BEGIN: +SUNAME: / + pop p,a + call sixout + type dsko,/ +UNAME: +ALTER: INQREP / + .rdate a, + call sixout + .iot dsko,["-] + .rtime a, + call sixout + type dsko,/ +END: +/ + jrst dellup + +deldon: syscal renmwo,[argi,,dsko ? [sixbit/MAIL/] ? [sixbit />/]] + .lose %lsfil + .close dsko, + jrst done + + +;Read a line from dski in the form uname(group), and return the +;uname in sixbit in A and the group as a character in G. +rdlin: setz h, + move g,[440600,,h] +rdlin1: .iot dski,c + andi c,-1 + cain c,^C + ret + cain c,^I + jrst rdlin2 + cail c,140 + subi c,40 + tlnn g,770000 ;Don't gobble more than six characters. + jrst rdlin1 + subi c,40 + idpb c,g + jrst rdlin1 + +rdlin2: move a,h + .iot dski,g ;Skip the paren. + .iot dski,g ;Return the group char in g, + cain g,") ;but if we got a closeparen it means the group is null. + tdza g,g + .iot dski,c ;Otherwise, skip the closeparen. + .iot dski,c ;In any case, skip the CRLF. + .iot dski,c + aos (p) + ret + +;wrlin writes the uname in A and the group in G to the output file. +wrlin: push p,b + call sixout + .iot dsko,[^I] ;After his name, put his group in parentheses. + .iot dsko,["(] + skipe g + .iot dsko,g + .iot dsko,[")] + .iot dsko,[^M] ;and then a CRLF, and go hack the next user. + .iot dsko,[^J] + pop p,b + ret + +;Output the sixbit word in A. Clobbers B. +sixout: setz b, + rotc a,6 + addi b,40 + .iot dsko,b + jumpn a,sixout +cpopj: ret + +;Output the asciz string which A points at. Clobbers B. +ascout: hrli a,440700 +ascou1: ildb b,a + jumpe b,cpopj + .iot dsko,b + jrst ascou1 + +;Type the asciz string which A points at. Clobbers B. +asctyp: hrli a,440700 +ascty1: ildb b,a + jumpe b,cpopj + .iot ttyo,b + jrst ascty1 + + +;Map the LOGOUT TIMES file into core. +timmap: syscal open,[[.bai,,lsrch] ? ['DSK,,] ? ['LOGOUT] ? [sixbit/TIMES/] ? ['CHANNA]] + .lose %lsfil + syscal fillen,[%climm,,lsrch ? %clout,,a] + .lose %lsfil + cail a,timmax + .value [asciz /:LOGOUT TIMES file too long to fit! +:kill /] + movem a,timlen + addi a,1777 + lsh a,-10. + movns a + hrlzs a + hrri a,timpag + syscal corblk,[%climm,,%cbred ? %climm,,%jself ? a ? %climm,,lsrch] + .lose %lssys + .close lsrch, + movei a,timdat + movem a,lstltm ;The first time we search logout times, start at beginning. + ret + +;Given a uname in A in sixbit, return in A the last logout time of that uname. +;Skips if the last logout time is known. +timsrc: move c,[440700,,d] + move d,[ascii / /] + move e,[ascii/ /] +timsr1: setz b, ;First, convert uname to ascii in D and E. + rotc a,6 + addi b,40 + idpb b,c + jumpn a,timsr1 + move a,lstltm + move b,timlen ;Now search through the logout times file + addi b,timdat ;for that uname. +timsr2: camn a,b ;Return non-skipping if we have exhausted the file. + ret + move c,1(a) + and c,[.byte 7 ? 177] + camn d,(a) + came e,c + jrst timsr3 ;This entry in file doesn't match => step. + movem a,lstltm + move d,[350700,,1] ;We found this uname => decode ascii date-time. + add d,a + aos (p) + jrst datime"asctwd + +timsr3: move i,(a) ;Mismatch. Have we found a logout times entry + tlc i,400000 ;greater (in ascii order) than what we are looking for. + move j,d + tlc j,400000 + camle j,i + jrst timsr4 ;No, 1st word searched for is less than 1st word found. + came j,i + jrst timsr5 ;Yes, 1st word searched for is greater + move i,c + move j,e ;1st words equal, so compare 2nd words. + tlc i,400000 + tlc j,400000 + camg j,i + jrst timsr5 +timsr4: addi a,5 ;We haven't reached the desired entry yet => keep looking. + jrst timsr2 + +timsr5: movem a,lstltm ;Found an entry for a greater uname => we know there is none + ret ;for the one we are seardskig for. + + + +subttl Data + +kcnsid: 0 ;When Generating, number of entries found. + +cnsidr: 0 ;Consider-reaping-this-entry-flag. + +grace: 200. ;Flush someone after this many days of non-use. + +grpa: asciz /TSK/ ;Tourists, Students, and Kollaborators +grac.a: 200. ;get reaped after seven months. +grpb: asciz /NE$/ ;Nonconsortium, EE, and Network people +grac.b: 728. ;get reaped after two years. + +grac.0: 728. ;Lab people get reaped after two years. + +reaptf: 0 ;reaping grp.a people flag +reapnf: 0 ;reaping grp.b people flag +reaplf: 0 ;reapding lab people flag + +timlen: 0 ;length of LOGOUT TIMES file, in words. +now: 0 ;Current time and date in disk format. +lstltm: 0 ;Where to start seardskig the logout times file. + ;We use the fact that both it and the LSR file are sorted. +timbfr: block 8 + +debug: -1 + +pdl: block lpdl +patch: pat: + block 40 +patche: -1 + +variables +constants + + .=<.+1777>/2000*2000 +timdat: timpag==./2000 ;LOGOUT TIMES file mapped in here. +timmax==40.*2000 + + block timmax ;should be enough space. + +lsrpag==./2000 ;INQUIR data base mapped in here. +lsrpgs==200. + +ifg lsrpag+lsrpgs-400,.err address space overflow! + end go