From cbbdbe357f7e5ed1fd0a842d2c22b6befddfa55a Mon Sep 17 00:00:00 2001 From: Eric Swenson Date: Tue, 20 Dec 2016 15:32:20 -0800 Subject: [PATCH] Added XHOST. Resolves #320 Source from MC: ALAN; XHOST 36. --- README.md | 1 + build/build.tcl | 4 + doc/info/xhost.5 | 87 +++++++ src/sysen3/xhost.36 | 565 ++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 657 insertions(+) create mode 100755 doc/info/xhost.5 create mode 100755 src/sysen3/xhost.36 diff --git a/README.md b/README.md index d813dc5f..2bb508ee 100644 --- a/README.md +++ b/README.md @@ -223,6 +223,7 @@ A list of [known ITS machines](doc/machines.md). - TYPE8, type 8-bit file. - UNTALK, split-screen comm-link program. - UPTIME, Chaosnet uptime server. + - XHOST, tool for replacing host nicnames with real hostnames. - WHAT, humorous quips to various "what" questions. - WHO%, list index/uname/jname/%time in sorted list. - X, Y, Z, remember DDT command and re-execute it. diff --git a/build/build.tcl b/build/build.tcl index 2d4460e7..b51f5b7e 100644 --- a/build/build.tcl +++ b/build/build.tcl @@ -1072,6 +1072,10 @@ expect ":KILL" respond "*" ":midas sys;ts fed_sysen2;fed\r" expect ":KILL" +# XHOST +respond "*" ":midas sys2;ts xhost_sysen3;xhost\r" +expect ":KILL" + # ndskdmp tape respond "*" ":link kshack;good ram,.;ram ram\r" respond "*" ":link kshack;ddt bin,.;@ ddt\r" diff --git a/doc/info/xhost.5 b/doc/info/xhost.5 new file mode 100755 index 00000000..dbd02138 --- /dev/null +++ b/doc/info/xhost.5 @@ -0,0 +1,87 @@ +-*- Text -*- + +File: XHOST Node: Top Up: (DIR) + +After 31 March 1987 the NIC will no longer allow alternate host names +(nicknames) to appear in the Official Host Table or domain name servers. +Unfortunately there are many mailing list files around that contain entries +using these soon-to-be-obsolete hostnames. XHOST is a tool for assisting +in the conversion of such mailing list files to use only "approved" host +names. + +XHOST has two parts. There is an :XHOST program that reads a mailing list +file and writes an "XHOST" file in which all nicknames have been flagged, +and an XHOST Emacs library that contains an Emacs command for performing a +query-replace-style scan of an XHOST file. + +:XHOST takes the name of a mailing list file as an argument, and writes a +file whose second name is XHOST. For example: + + :XHOST GUBBLE PEOPLE + +will read the file GUBBLE PEOPLE from your working directory and write a +file there named GUBBLE XHOST. + +The format of an XHOST file is fairly simple. Each nickname that :XHOST +thinks it has found will be immediately followed by rubout ("¢, ASCII +code 177). Following the rubout is the hostname that XHOST recommends as a +replacement. + +The replacement will start with an atsign ("@") if the original hostname +did not. This will turn an entry like "(RPG SU-AI)" into the preferred form +"(RPG @SAIL.STANFORD.EDU)", which will result in better host name error +reporting from the mailer. + +:XHOST does -not- really understand the format of mailing list files. It +understands how to parse comments, but it does not understand the parenthesis +structure. Thus occasionally it will offer to turn a user name into a +hostname. For example it might offer: + + HENRYÀHENRY.ECE.CMU.EDU + +Watching out for things like this will keep you on your toes. (XHOST has a +table of known absurd replacements such as "DanG" => "NYU-DANGER.ARPA". +The maintainer will accept nominations for additions.) + +Loading the XHOST Emacs library defines a single Emacs command: +M-X Canonicalize Hosts. This command scans through an XHOST file searching +for the hostnames flagged by :XHOST. For each one that it finds, you can +accept or decline the proposed replacement. M-X Canonicalize Hosts behaves +very much like M-X Query Replace. The complete list of commands it accepts +are: + + Space - Replace old host name with new. + Rubout - Leave old host name as it is. + N - Nothing. Leave both host names in buffer. + U - Undo last change. + C-L - Redisplay. + C-R - Enter recursive ^R mode. + Q - Quits. + ? - Self documentation. + +As an additional feature, if M-X Canonicalize Hosts does not find any +flagged names in the currently selected buffer, it assumes that you +probably need to run :XHOST first. It offers to write out the current +buffer if necessary, and then sends a command to DDT to run :XHOST over +that file and then return to Emacs. When :XHOST is complete, the XHOST +file is read back into the current buffer and M-X Canonicalize Hosts starts +its normal scan. + +Thus the easiest way to update the mailing list file GUBBLE PEOPLE is to + + 1. read GUBBLE PEOPLE into an Emacs buffer + 2. do M-X Load Library$XHOST if you haven't already in this Emacs + 3. do M-X Canonicalize Hosts + 4. answer "Y" when it offers to run :XHOST, + 5. get a cup of tea while :XHOST runs, it's not instantaneous + 6. decide what to do about each host one-by-one as M-X Canonicalize + Hosts shows them to you + 7. write the resulting file back out over the old GUBBLE PEOPLE. + +There will still be a GUBBLE XHOST file sitting around when you are +finished. If you are 100% certain that what you just did was correct, then +you can just delete it. If you decide that you screwed up, you can always +recover by reading in GUBBLE XHOST, and running M-X Canonicalize Hosts +again. + +Bugs, suggestions, etc. to Alan@AI. diff --git a/src/sysen3/xhost.36 b/src/sysen3/xhost.36 new file mode 100755 index 00000000..7fb7f840 --- /dev/null +++ b/src/sysen3/xhost.36 @@ -0,0 +1,565 @@ +; -*- Midas -*- + +title XHOST - Prepare to canonicalize all host names in a file. + +a=:1 +b=:2 +c=:3 +d=:4 +e=:5 +t=:6 +tt=:7 +x=:10 +y=:11 +z=:12 + +p=:17 + +ch==:0,,-1 +chttyi==:1 +chttyo==:2 +chdski==:3 +chdsko==:4 + +%fr==:0,,525252 +%freof==:400000 +%frlcl==:200000 +%fl==:1,,525252 + +call=:pushj p, +return=:popj p, +save==:push p, +rest==:pop p, +flose=:.lose %lsfil +slose=:.lose %lssys +pause=:.break 16,100000 +quit=:.logout 1, +tyi=:.iot chttyi, +tyo=:.iot chttyo, + +define bltdup org,len + move tt,[,,+1] + blt tt,+-1 +termin + +define syscall name,args + .call [setz ? .1stwd sixbit /name/ ? args(400000)] +termin + +popj1: aos (p) +cpopj: return + +format"$$pcode==:1 +format"$$errs==:0 +.insrt dsk:syseng;format > + +outstr: syscall siot,[movei chttyo ? a ? b] + slose + return + +define format &string&,args + call [ + call $format +.zzz.==-1 +irp arg,,[args] + save arg +.zzz.==.irpcnt +termin + hrroi a,[ascii string] + movei b,.length string + movni c,.zzz.+1 + jrst format"format] +termin + +$forma: save a + save b + save c + save [.+2] + jrst @-4(p) + rest c + rest b + rest a + rest (p) + return + +; Table of hostname translations: +; Host named by left half should always appear with name in right half. +; If right half is 0, then host is ignored. +tran: + [asciz "Symbolics"],,[asciz "Symbolics"] + [asciz "Berkeley.EDU"],,[asciz "Berkeley.EDU"] + ; Nobody sends mail to RICE-KRISPIES.AI.MIT.EDU: + [asciz "Rice"],,[asciz "Rice.EDU"] +ltran==:.-tran + +; UNAME table: +; Certain common tokens that frequently occur in mailing lists that aren't +; really host names go here. +; Keep this list sorted! +unames: +irps name,,[ + cent CMB COLE dae DanG EB FILE Frank + Gregor HAL HES HIC KWH Lauren lee LIN + LSP MAH MAP Moon MRC NULL OLE RAY + RK RMS RON Tim TK TY + ] + sixbit /name/ +termin +nunames==:.-unames +lgunames==:36.-.lz nunames-1, +repeat <1_lgunames>-nunames, setz-1 + +netwrk"$$hstmap==:1 +netwrk"$$hostnm==:1 +netwrk"$$symlook==:1 +netwrk"$$look==:1 +netwrk"$$hst3==:1 +.insrt dsk:syseng;netwrk > + +.vector tran1(ltran) + +; CALL LKINIT: Initialize hostname database +; Clobbers A and B +lkinit: movei a,ffpage + movei b,chdski + call netwrk"hstmap + .lose + setzm tran1+0 + bltdup tran1,ltran + movsi b,-ltran +lkini1: hlrz a,tran(b) + hrli a,440700 + call look + skipa + movem a,tran1(b) + aobjn b,lkini1 + return + +; CALL LOOK: Canonicalize hostname +; skips if hostname found +; A (a/v): bp -> asciz /hostname/ +look: move y,a + move z,[440600,,x] + setzi x, + jrst lookgo + +looklp: tlnn z,770000 + jrst lookhs + trzn t,100 + trca t,40 + tro t,40 + idpb t,z +lookgo: ildb t,y + jumpn t,looklp + movei t,unames +zzz==1_lgunames +repeat lgunames,[ +zzz==zzz_-1 + caml x,zzz(t) + movei t,zzz(t) +] ;end repeat + camn x,(t) + return +lookhs: save b + save e + call netwrk"hsttbp ; E: aobjn to NAMES table + call netwrk"syml1 ; non-interactive search + jrst looklz ; lost + camn b,[-1] + jrst looklz ; numbers lose too + hlrz a,netwrk"nmlsit(b) + add a,netwrk"hstadr ; A: SITE table entry + hlrz a,netwrk"stlnam(a) + add a,netwrk"hstadr + hrli a,440700 ; A: bp -> asciz /official name/ + movsi t,-ltran + came a,tran1(t) + aobjn t,.-1 + jumpge t,lookwn + hrr a,tran(t) + trne a,-1 +lookwn: aos -2(p) +looklz: rest e + rest b + return + +; The only characters in hostnames are letters, digits, "." and "-". +; Hostnames never begin or end with "." or "-". +; (There is also a bug in NETWRK where hostnames beginning with a digit are not +; found.) +foo: call netwrk"hsttbp ; E: aobjn to NAMES table +foolp: hrrz a,netwrk"nmrnam(e) + add a,netwrk"hstadr + hrli a,440700 + move b,a ; A, B: bp -> hostname + setzi d, ; D: accumulate length +foolpc: ildb t,a + jumpe t,foonxt + aoja d,foolpc + +foonxt: syscall siot,[movei chdsko ? b ? d] + slose + .iot chdsko,[^M] + .iot chdsko,[^J] + aobjn e,foolp ; OK, so we know they are one word long... + return + +rfn"$$rfn==:1 +rfn"$$switch==:1 +.insrt dsk:syseng;rfn > + +rsixtp: cain a,"/ + aos (p) + return + +switch: format "Illegal switch: ~C",a + quit + +.vector buffer(lbuffer==:10000) +.scalar inbp ; bp for INCH +.scalar incnt ; # chars available to INCH +.scalar outbp ; bp to output still in buffer +.scalar outcnt ; # chars of output still in buffer + +; CALL INCH: Read a character +; A (val): Next character +; B (val): Class of character +inch0: setzb a,b .see qeof + trne %freof + return + call fill +inch: sosge incnt + jrst inch0 + ildb a,inbp + move b,class(a) + return + +; CALL IOINIT: Initialize I/O +ioinit: setzm outcnt + move t,[-lbuffer,,buffer] + jrst fill1 + +fill: syscall siot,[movei chdsko ? outbp ? outcnt] ; zeros OUTCNT + slose + move t,buffer+lbuffer-1 + movem t,buffer+0 + move t,[1-lbuffer,,buffer+1] +fill1: .iot chdski,t + jumpl t,eof + movei t,5* ; Don't give out last word yet +fill2: movem t,incnt + move t,[440700,,buffer] + movem t,inbp + movem t,outbp + return + +eof: tro %freof + .close chdski, + movei t,-buffer(t) + jumpe t,fill2 + move tt,buffer-1(t) + imuli t,5 + xor tt,[.byte 7 ? 0 ? ^C ? ^C ? ^C ? ^C] + trne tt,177_1 + jrst fill2 + trne tt,177_8 + soja t,fill2 + subi t,3 + tdne tt,[177_15.] + aoja t,fill2 + tlne tt,(177_22.) + jrst fill2 + soja t,fill2 + +.vector pdl(lpdl==:100.) +.scalar option +.vector filnam(4) + +usrvar: sixbit /OPTION/ ? tlo %opint\%opopc + sixbit /MASK/ ? move [%pipdl] + sixbit /OPTION/ ? movem option + sixbit /SNAME/ ? movem filnam+3 +lusrvar==:.-usrvar + +nojcl: format "Use JCL" + quit + +go: move p,[-lpdl,,pdl-1] + setzi 0, ; clear flags + .open chttyi,[.uai,,'tty ? setz ? setz] + slose + .open chttyo,[.uao\%tjdis,,'tty ? setz ? setz] + slose + move tt,[-lusrvar,,usrvar] + syscall usrvar,[movei %jself ? tt] + slose + call lkinit + move a,option + tlnn a,%opcmd + jrst nojcl +.vector jcl(ljcl==:100.) + setzm jcl + bltdup jcl,ljcl-1 + movsi t,(.byte 7 ? ^C ? ^C) + movem t,jcl+ljcl-1 + .break 12,[..rjcl,,jcl] + movsi t,(sixbit /DSK/) + movem t,filnam+0 + move t,[sixbit /NAMES/] + movem t,filnam+1 + movsi t,(sixbit />/) + movem t,filnam+2 + movei b,filnam + move d,[440700,,jcl] + call rfn"rfn + syscall open,[movsi .bai ? movei chdski ? filnam+0 + filnam+1 ? filnam+2 ? filnam+3] + flose + syscall open,[movsi .uao ? movei chdsko ? filnam+0 + filnam+1 ? [sixbit /XHOST/] ? filnam+3] + flose + call ioinit + setom breakc + jrst begin + +nsemic: aos outcnt + call inch ; parse comment + caie a,^M + jumpn b,nsemic + jumpe b,ndone +normal: aos outcnt +norml1: call inch + jrst @ntable(b) + +ntable: offset -. +qeof:: ndone ; must be 0 +qbreak:: nbreak +qquote:: nquote +qsemic:: nsemic +qslash:: nslash +qbrack:: nbrack +qother:: normal +qhyphe:: normal +qalnum:: ;; letters and digits from here on up +qalpha:: normal +qnumer:: normal + offset 0 + +; slash +nslash: movei t,normal +eatone: aos outcnt + call inch + jumpn b,(t) + jrst ndone + +; doublequote +nquot0: jsp t,eatone +nquote: aos outcnt + call inch + cain b,qslash + jrst nquot0 + caie a,42 + jumpn b,nquote + jumpn b,nbreak + jrst ndone + +; filename +nbrac0: jsp t,eatone +nbrack: aos outcnt + call inch + cain b,qslash + jrst nbrac0 + caie a,135 + jumpn b,nbrack + jumpn b,nbreak + jrst ndone + +ndone: syscall siot,[movei chdsko ? outbp ? outcnt] + slose + quit + +.vector token(ltoken==:20.) +.scalar breakc + +; break character +nbreak: aos outcnt + movem a,breakc +begin: call inch + caie b,qalpha + jrst @ntable(b) + move c,[440700,,token] + movni d,5*ltoken +acum: aojge d,aexito + idpb a,c + call inch + jrst @atable(b) + +atable: offset -. +qeof:: abreak ; must be 0 +qbreak:: abreak +qquote:: abreak +qsemic:: abreak +qslash:: aexit +qbrack:: aexit +qother:: aexit +qhyphe:: ahyphe +qalnum:: ;; letters and digits from here on up +qalpha:: acum +qnumer:: acum + offset 0 + +ahyphe: aojge d,aexito + idpb a,c + call inch + cail b,qalnum + jrst acum + jrst aexit + +abrekf: rest a +aexit: addi d,<5*ltoken> +aexit0: skipn outcnt + jrst aexit1 + addm d,outcnt + jrst @ntable(b) + +aexito: movei d,<5*ltoken>-1 + jrst aexit0 + +aexit1: move c,[440700,,token] + syscall siot,[movei chdsko ? c ? d] + slose +aexit2: setoi c, + adjbp c,inbp + movem c,outbp + jrst @ntable(b) + +abreak: setzi t, + idpb t,c + save a + move a,[440700,,token] + call look + jrst abrekf + call lclchk + move x,[440700,,token] + move y,a + call sequal + cain t,(tt) + jrst abrekf + jumpn t,abrekt + trne %frlcl + caie tt,". + jrst abrekt + jrst abrekf + +abrekt: syscall siot,[movei chdsko ? outbp ? outcnt] + slose + move t,[440700,,token] + addi d,<5*ltoken> + syscall siot,[movei chdsko ? t ? d] + slose + .iot chdsko,[177] + movei t,"@ + came t,breakc + .iot chdsko,["@] + move c,a + setzi d, +abrekl: ildb t,c + jumpe t,abrekx + cain t,". + trnn %frlcl + aoja d,abrekl +abrekx: syscall siot,[movei chdsko ? a ? d] + slose + rest a + jrst aexit2 + +; CALL LCLCHK: Check if hostname is local +; A (a/v): b.p. -> asciz /hostname/ +; Sets %FRLCL if hostname ends in ".AI.MIT.EDU" or ".LCS.MIT.EDU". +; Clears it otherwise. +lclchk: trz %frlcl + move x,a +lclck1: ildb t,x + caie t,". + jumpn t,lclck1 + jumpe t,cpopj + ildb t,x + caie t,"A + cain t,"a + jrst lclcka + caie t,"L + cain t,"l + jrst lclckl + return + +lclckl: skipa y,[440700,,[asciz "CS.MIT.EDU"]] +lclcka: move y,[440700,,[asciz "I.MIT.EDU"]] + call sequal + cain t,(tt) + tro %frlcl + return + +; CALL SEQUAL: Compare strings for equality +; X (a/v): b.p. -> asciz /string1/ (updated) +; Y (a/v): b.p. -> asciz /string2/ (updated) +; T (val): last character read from string1 +; TT (val): last character read from string2 +; If C(T) = C(TT), then the strings were equal. (In which case C(T) = 0.) +; Slightly faster if string2 is upper case. +sequal: ildb t,x + ildb tt,y + cain t,(tt) + jumpn t,sequal + caie t,"a-"A(tt) + jrst sequl1 + cail t,"a + caile t,"z + return + jrst sequal + +sequl1: caie tt,"a-"A(t) + return + cail tt,"a + caile tt,"z + return + jrst sequal + +class: repeat 200, qother + +loc class+"A + repeat 26., qalpha + +loc class+"a + repeat 26., qalpha + +loc class+"0 + repeat 10., qnumer + +irp ch,,[11,12,14,15,40,50,51,100,133,42,73,55,56,57,21]type,,[qbreak,qbreak,qbreak,qbreak,qbreak,qbreak,qbreak,qbreak,qbrack,qquote,qsemic,qhyphe,qhyphe,qslash,qslash] +loc class+ch + type +termin + +loc class+200 + +tsint: +loc 42 + -ltsint,,tsint +loc tsint + 400000,,p +ltsint==:.-tsint + +dismis: setz ? sixbit /DISMIS/ ? movsi 400000 ? setz p + +cnstnts: +constants +variables + +patch:: +pat: block 100. +epatch: -1 ; Make memory exist, end of patch area + +ffaddr: +ffpage==:_-12 + +end go