;-*- 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