diff --git a/Makefile b/Makefile index a9a55359..71353f7d 100644 --- a/Makefile +++ b/Makefile @@ -9,7 +9,7 @@ SRC = system syseng sysen1 sysen2 sysen3 sysnet kshack dragon channa \ inquir acount gz sys decsys ecc alan sail kcc kcc_sy c games archy dcp \ spcwar rwg libmax rat z emaxim rz maxtul aljabr cffk das ell ellen \ jim jm jpg macrak maxdoc maxsrc mrg munfas paulw reh rlb rlb% share \ - tensor transl wgd zz graphs lmlib pratt nschem scheme gsb + tensor transl wgd zz graphs lmlib pratt nschem scheme gsb ejs DOC = info _info_ sysdoc sysnet syshst kshack _teco_ emacs emacs1 c kcc chprog BIN = sys2 emacs _teco_ lisp liblsp alan inquir sail comlap c decsys moon graphs diff --git a/build/build.tcl b/build/build.tcl index 30306f37..20c6497f 100644 --- a/build/build.tcl +++ b/build/build.tcl @@ -2122,6 +2122,11 @@ respond "*" ":midas liblsp;_gsb;ttyvar\r" respond "Use what filename instead?" "lisp;\r" expect ":KILL" +# scrmbl and unscr +respond "*" ":midas sys3;ts scrmbl_ejs;scrmbl\r" +expect ":KILL" +respond "*" ":link sys3;ts unscr,sys3;ts scrmbl\r" + bootable_tapes # make output.tape diff --git a/doc/programs.md b/doc/programs.md index 3c76831b..e58cd40f 100644 --- a/doc/programs.md +++ b/doc/programs.md @@ -137,6 +137,7 @@ - SCANDL, TTY OUTPUT SPY. - SCHEME, Scheme interpreter. - SCRAM, encypt/decrypt file. +- SCRMBL/UNSCR, scramble/unscramble file. - SEND, REPLY, replacements for DDT :SEND. - SENDS, Chaosnet SEND server. - SENSOR, sends censor. diff --git a/src/ejs/scrmbl.73 b/src/ejs/scrmbl.73 new file mode 100644 index 00000000..b6916557 --- /dev/null +++ b/src/ejs/scrmbl.73 @@ -0,0 +1,699 @@ +TITLE SCRMBL +.MLLIT=1 + +A=1 +B=2 +C=3 +D=4 +E=5 +X1=6 +X2=7 +X3=10 +X4=11 +DPT=12 +T=13 +TT=14 +SCR=16 +P=17 + +TYIC==1 ; tty input +TYOC==2 ; tty output +DKIC==3 ; input source +DKOC==4 ; output sink +DTYOC==5 ; display output (for smearing) +dsko==13 +argi==1000 ;immediate argument +val==2000 ;value return +errret==3000 ;error return +cnt==4000 ;control +cnti==5000 ;control immediate + +call=pushj p, ;make things easier on ourselves +ret=popj p, ; ditto +tyi==.iot ; likewise +tyo==.iot ; and once again + +define syscal a,b,c= + .call [setz ? sixbit/a/ ? b ? setz++c] +termin + +define terpri chan=tyoc ;terpri on channel + tyo chan,[^M] + tyo chan,[^J] +termin + +REVRSE: 0 ; 0 for scramble, -1 for unscramble + +; starting location +GO: MOVEI P,PDL + SETZB DPT,EOF' + SETZ OUTPTR' + +; open tty channels + .OPEN TYIC,[24,,'TTY] + .LOSE + .OPEN TYOC,[5,,'TTY] + .LOSE + .CALL [SETZ ? 'CNSGET ? MOVEI TYOC ? MOVEM ? MOVEM ? SETZM A] + SETZB A,SOFTTY' + CAIN A,%TNSFW + SETOM SOFTTY ; software tty + .STATUS TYOC,A + ANDI A,77 + SETZM DISTTY + CAIE A,2 + JRST RDJCL +; here display tty, so open a channel in display mode + SETOM DISTTY' ; display tty + .OPEN DTYOC,[21,,'TTY] + .LOSE + +; read command, if any +RDJCL: .SUSET [.ROPTION,,A] + TLNN A,40000 ; any jcl? + JRST NOJCL + .BREAK 12,[5,,JCLBUF] ; get it + MOVE A,[440700,,JCLBUF] + MOVEM A,COMPTR' + +; dir defaults to sname +; .SUSET [.RSNAME,,A] +; MOVEM A,INDIR + .SUSET [.RXJNAME,,A] + CAMN A,[SIXBIT /UNSCR/] + SETOM REVRSE + +; parse jcl + MOVEI E,INDEV + PUSHJ P,SCNAME + MOVEI E,OUTDEV + PUSHJ P,SCNAME + PUSHJ P,GETSYL + +; set up default for unscrambling +; if scrambling, default is fn1 plus letter Z on end +; if unscrambling, default is fn1 with letter Z removed from end +INDEF: SKIPE OUTFN1 + JRST DODEF + SKIPN REVRSE + JRST SCRDEF +; here unscrambling + MOVE A,[440600,,INFN1] +INLOOP: ILDB B,A + CAIE B,'Z + JRST INDEF1 + CAMN A,[600,,INFN1] + JRST INMAKE + MOVE C,A + ILDB B,C + JUMPN B,INLOOP +INMAKE: SETZ C, ; dump a space + JRST DMAKE +INDEF1: CAME A,[600,,INFN1] + JRST INLOOP + JRST INMAKE + +; set up defaults for scrambling +SCRDEF: MOVE A,[440600,,INFN1] +OULOOP: CAMN A,[600,,INFN1] + JRST OUMAKE + ILDB B,A + JUMPE B,OUMAKE + JRST OULOOP +OUMAKE: MOVEI C,'Z ; dump a Z + +; here dump a space or a Z into file name +DMAKE: MOVE B,INFN1 + MOVEM B,OUTFN1 + HRRI A,OUTFN1 + DPB C,A + +; set up output file defaults +DODEF: MOVE A,INDEV + SKIPN OUTDEV + MOVEM A,OUTDEV + MOVE A,INFN1 + SKIPN OUTFN1 + MOVEM A,OUTFN1 + MOVE A,INFN2 + SKIPN OUTFN2 + MOVEM A,OUTFN2 + MOVE A,INDIR + SKIPN OUTDIR + MOVEM A,OUTDIR + +; here to hack second name cruftage: if no second name given, it +; is set up so that input and output files will have same second name +; creation dates of files are always set up to be the same + SKIPE INFN2 + JRST OPNFLS + MOVSI A,(SIXBIT ">") + MOVEM A,INFN2 + +; open input file +OPNFLS: .CALL [SETZ ? SIXBIT /OPEN/ ? [.BII,,DKIC] + INDEV ? INFN1 ? INFN2 ? INDIR ? SETZB LSTERR'] + JRST INFAIL +; read its creation date + .CALL [SETZ ? 'RFDATE ? MOVEI DKIC ? SETZM CDATE'] + .LOSE + SKIPE OUTFN2 + JRST SMASH +; read its second name if necessary + .CALL [SETZ ? SIXBIT /RCHST/ ? MOVEI DKIC ? MOVEM ? MOVEM ? MOVEM OUTFN2 ? SETZM] + .LOSE + MOVE A,OUTFN2 + MOVEM A,INFN2 + +; check if (un)scring to self +SMASH: MOVE A,INFN1 + CAME A,OUTFN1 + JRST ASK + MOVE A,INFN2 + CAME A,OUTFN2 + JRST ASK + MOVE A,INDEV + CAME A,OUTDEV + JRST ASK + MOVE A,INDIR + CAME A,OUTDIR + JRST ASK +; going to same file, ask for confirmation + MOVEI A,[ASCIZ /Uns/] + SKIPN REVRSE + MOVEI A,[ASCIZ /S/] + PUSHJ P,TYPE7 + MOVEI A,[ASCIZ /crambling to self? Confirm? /] + PUSHJ P,TYPE7 + PUSHJ P,YESNO + CAIN A,"Y + JRST ASK + MOVEI A,[ASCIZ /Aborted./] + PUSHJ P,TYPE7 + JRST KILL + + + +; ask yes/no question +YESNO: .IOT TYIC,A + CAIN A,^Q + JRST KILL ; ^Q means kill + CAIL A,"a + CAILE A,"z + CAIA + SUBI A,40 + .IOT TYOC,[^M] + .IOT TYOC,[^J] + POPJ P, + +; get password +REASK: .IOT TYOC,[^M] + .IOT TYOC,[^J] +ASK: MOVEI A,[ASCIZ /Password? /] + PUSHJ P,TYPE7 + PUSHJ P,GETSCR ; read password + +; confirm password +CONFRM: .IOT TYOC,[^M] + .IOT TYOC,[^J] + MOVE A,SCR + PUSHJ P,WTYPE6 ; type it out (briefly) + PUSHJ P,PERASE ; now flush it +; get confirmation +DBLCHK: MOVEI A,[ASCIZ /Okay? /] ; confirm the password + PUSHJ P,TYPE7 + PUSHJ P,YESNO + CAIN A,"N ; N is no + JRST REASK + CAIN A,"R + JRST CONFRM ; R is reconfirm + CAIE A,"Y + JRST DBLCHK ; Y is yes, anything else asks again + .suset [.rxuname,,a] + came a,[sixbit/ejs/] + camn a,[sixbit/dufty/] + caia + call typet +; open output file + .CALL [SETZ ? SIXBIT /OPEN/ ? [.BIO,,DKOC] + OUTDEV ? [SIXBIT "_SCRM_"] ? [SIXBIT ">"] ? OUTDIR ? SETZB LSTERR] + JRST OUTFAI + +; encryption +; SCR/ password + + MOVSI E,-4 + MOVE TT,SCR +BYTLUP: LSHC T,9 + ANDI T,377 + HRLM T,X1(E) + MOVE T,ROUT(E) + HRRM T,X1(E) + AOBJN E,BYTLUP + + CAMG X1,X2 + EXCH X1,X2 + CAMG X3,X4 + EXCH X3,X4 + CAMG X1,X3 + EXCH X1,X3 + CAMG X2,X4 + EXCH X2,X4 + CAMG X2,X3 + EXCH X2,X3 + + LDB A,[320100,,SCR] + HRRZ B,16 + SKIPE A + HLRZ B,16 + LDB A,[100100,,SCR] + JUMPE A,[LSH B,1 ? JRST .+2] + HRL B,A + LDB A,[210100,,SCR] + SKIPE A + MOVN B,B + MOVEM B,RAN' + + MOVSI C,-4 + SETZ E, + HLLM E,X1(C) + PUSHJ P,@(C)X1 + AOBJN C,.-2 + + SKIPN REVRSE + JRST SCRBEG + MOVE A,SC1 + EXCH A,SC4 + MOVEM A,SC1 + MOVE A,SC2 + EXCH A,SC3 + MOVEM A,SC2 + HRLZ A,SHFSIZ + MOVN A,A + HLRM A,SHFSIZ + +SCRBEG: +SCRLUP: PUSHJ P,GETWRD + SKIPE REVRSE + JRST SC1 + PUSHJ P,RANDOM + XOR A,B + +SC1: 0 +SC2: 0 +SC3: 0 +SC4: 0 + + SKIPN REVRSE + JRST SCRL50 + PUSHJ P,RANDOM + XOR A,B + +SCRL50: MOVEM A,-1(DPT) ; output encrypted word + JRST SCRLUP ; and loop + +; encryption routines + +RANDOM: MOVE B,RAN' + FMPB B,RAN + TSC B,B +CPOPJ: POPJ P, + +ROUT: XCMPL + XSWAP + XXOR + XROT + +XCMPL: LDB A,[331000,,SCR] + IDIVI A,3 + ANDI A,1 + MOVE B,COMPL(A) + MOVEM B,SC1(C) + POPJ P, + +XSWAP: LDB A,[221000,,SCR] + LDB B,[111000,,SCR] + ANDCM A,B + IDIVI A,3 + ANDI A,1 + MOVE A,SWAP(A) + MOVEM A,SC1(C) + POPJ P, + +XXOR: LDB A,[111000,,SCR] + LDB B,[331000,,SCR] + ADD A,B + LSH A,-3 + ANDI A,1 + MOVE A,MASK(A) + MOVEM A,SC1(C) + POPJ P, + +XROT: MOVE A,SCR + IMUL A,A + ANDI A,77 + LDB B,[000100,,SCR] + SKIPE B + MOVN A,A + HRRM A,SHFSIZ + MOVE A,SHIFT + MOVEM A,SC1(C) + POPJ P, + +COMPL: SETCM A,A + JFCL +SWAP: MOVS A,A + JFCL +MASK: XOR A,SCR + JFCL +SHIFT: ROT A,@SHFSIZ +SHFSIZ: 0 + +; i/o routine: the buffer at datloc is used for both input and output, +; with the encrypted words replacing the unencrypted ones. this sort of +; makes it tough to have the encryption process be based on more than one +; word at a time. + +; get a word of input +GETWRD: MOVE A,(DPT) + AOBJN DPT,CPOPJ +; output old buffer + SKIPN A,OUTPTR + JRST GETBUF + ADD A,[1,,0] ; kludge for aobjn + .IOT DKOC,A + JUMPL A,[.LOSE] +; read a new buffer +GETBUF: SKIPE EOF + JRST EXIT ; done, no more input + MOVE DPT,[-DATLEN,,DATLOC] + .IOT DKIC,DPT + JUMPGE DPT,[MOVE DPT,[-,,DATLOC] + MOVEM DPT,OUTPTR' + JRST GETWRD] +; partial buffer + ADD DPT,[DATLEN,,0] + MOVN DPT,DPT + HRRI DPT,DATLOC + MOVEM DPT,OUTPTR + SETOM EOF + JUMPL DPT,GETWRD +; end +EXIT: .CALL [SETZ ? SIXBIT "RENMWO" ? MOVEI DKOC ? OUTFN1 ? SETZ OUTFN2] + .LOSE + .CALL [SETZ ? 'SFDATE ? MOVEI DKOC ? SETZ CDATE] + .LOSE + .CLOSE DKIC, + .CLOSE DKOC, +KILL: .BREAK 16,124000 + +; various error messages + +NOJCL: MOVEI A,[ASCIZ /JCL must be given: , +/] + PUSHJ P,TYPE7 + JRST KILL + +INFAIL: MOVEI A,[ASCIZ /Input open of /] + MOVEI B,INDEV +FAIL: PUSHJ P,TYPE7 + PUSHJ P,PFILE + MOVEI A,[ASCIZ / failed: /] + PUSHJ P,TYPE7 + .CALL [SETZ ? SIXBIT "OPEN" ? [0,,0] ? [SIXBIT "ERR"] ? [4] ? SETZ LSTERR] + .LOSE +FAILUP: .IOT 0,A + CAIN A,^L + JRST FAILX + JUMPLE A,FAILX + .IOT TYOC,A + JRST FAILUP +FAILX: .CLOSE 0, + JRST KILL + +OUTFAI: MOVEI A,[ASCIZ /Output open of /] + MOVEI B,OUTDEV + JRST FAIL +RENFAI: MOVEI A,[ASCIZ /Rename to /] + MOVEI B,OUTDEV + JRST FAIL + +PFILE: MOVE A,(B) + PUSHJ P,TYPE6 + .IOT TYOC,[":] + MOVE A,3(B) + PUSHJ P,TYPE6 + .IOT TYOC,[";] + MOVE A,1(B) + PUSHJ P,TYPE6 + .IOT TYOC,[" ] + MOVE A,2(B) + PUSHJ P,TYPE6 + POPJ P, + +; password reading and printing + +; smear password after giving luser brief glance +; on display consoles, erase smear as well +PERASE: MOVEI A,5. + .SLEEP A, + MOVE A,[440700,,SMEAR] + MOVEI B,.SML + .CALL [SETZ ? SIXBIT "SIOT" ? MOVEI TYOC ? A ? SETZ B] + JFCL + MOVE A,[440700,,[.BYTE 7 ? ^P ? "H ? 8 ? ^P ? "L]] + MOVEI B,5 + SKIPE DISTTY + .CALL [SETZ ? SIXBIT "SIOT" ? MOVEI DTYOC ? A ? SETZ B] + JFCL + .IOT TYOC,[^M] + .IOT TYOC,[^J] + MOVE A,[441000,,TDNOP] + MOVEI B,.TDL + SKIPE SOFTTY + .CALL [SETZ ? SIXBIT "SIOT" ? MOVSI %TJSIO ? MOVEI TYOC ? A ? SETZ B] + JFCL + POPJ P, + +; a buffer full of tdnops +TDNOP: .BYTE 10 + REPEAT 400,%TDNOP + .TDL==.BYTC + .BYTE + +; a smear +SMEAR: .BYTE 7 + ^M ? "W ? "X ? "M ? "Q ? "S ? "Y + ^M ? "X ? "M ? "Q ? "S ? "Y ? "W + ^M ? "M ? "Q ? "S ? "Y ? "W ? "X + ^M ? "Q ? "S ? "Y ? "W ? "X ? "M + ^M ? "S ? "Y ? "W ? "X ? "M ? "Q + ^M ? "Y ? "W ? "X ? "M ? "Q ? "S + .SML==.BYTC + .BYTE + +WTYPE6: MOVEM A,WORD6' + MOVE A,[440600,,WORD6] + MOVEM A,WD6PT' + MOVEI A,6 + MOVEM A,CNT6' + ILDB A,WD6PT + ADDI A,40 + .IOT TYOC,A + SOSLE CNT6 + JRST .-4 + POPJ P, + +TYPE6: PUSH P,A + HRRI A,(P) + HRLI A,440600 +TYP6LP: TLNN A,770000 + JRST POPAJ + ILDB 0,A + JUMPE 0,POPAJ + ADDI 0,40 + .IOT TYOC,0 + JRST TYP6LP +POPAJ: POP P,A + POPJ P, + +TYPE7: HRLI A,440700 ; set up byte pointer (addr in a as arg.) + MOVEM A,PT7' ; store so don't need extra acc +PSHOUT: ILDB A,PT7 ; get char + JUMPE A,CPOPJ ; stop when zero char reached (^@) + .IOT TYOC,A + JRST PSHOUT ; loop forever + +GETSCR: MOVE C,CHPT + .IOT TYIC,A + CAIN A,^Q + JRST KILL + CAIN A,177 + JRST RUBOUT + CAIN A,^M + JRST RETURN + HLLZ B,C + CAMN B,[-1,,0] + JRST GETSCR+1 + PUSH C,A + JRST GETSCR+1 + +RETURN: CAMN C,CHPT + JRST GETSCR +RETUR1: HLLZ A,C + CAMN A,[-1,,0] + JRST FULL + PUSH C,[40] + JRST RETUR1 + +FULL: MOVE C,[440600,,SCR] + MOVSI B,-6 +FULLUP: MOVE A,SCRLOC(B) + SUBI A,40 + CAIL A,100 + SUBI A,40 + IDPB A,C + AOBJN B,FULLUP + POPJ P, + +RUBOUT: CAMN C,CHPT + JRST GETSCR + POP C,A + JRST GETSCR+1 + +; file name reading + +INDEV: SIXBIT /DSK/ +INFN1: 0 +INFN2: 0 +INDIR: SIXBIT /EJS/ + +OUTDEV: SIXBIT /DSK/ +OUTFN1: 0 +OUTFN2: 0 +OUTDIR: 0 + +SCNAME: MOVSI C,-4 + HRRI C,1(E) +SCNGET: PUSHJ P,GETSYL + JUMPE B,SCNX + CAIN A,': + MOVEM B,(E) + CAIN A,'; + MOVEM B,3(E) + JUMPG A,SCNGET + MOVEM B,(C) + JUMPL A,SCNX + AOBJN C,SCNGET +SCNX: POPJ P, + +; get a syllable from command buffer +GETSYL: PUSH P,[0] + MOVEI B,(P) + HRLI B,440600 +GETSLP: PUSHJ P,GETCCA + JUMPL A,GETSX + CAIN A,"/ + JRST GETSWT + CAIN A,^Q + JRST GETQOT + SUBI A,40 + JUMPL A,GETSX + JUMPE A,GETSP + CAIE A,': + CAIN A,'; + JRST GETSX +GETSPT: CAIL A,100 + SUBI A,40 + TLNN B,770000 + JRST GETSLP + IDPB A,B + JRST GETSLP + +GETSWT: PUSHJ P,GETCCA + SUBI A,40 + CAIL A,100 + SUBI A,40 + CAIN A,'U + SETOM REVRSE + JRST GETSLP + +GETQOT: ILDB A,COMPTR + SUBI A,40 + JUMPGE A,GETSPT + JRST GETSX +GETSP: TLNE B,400000 + JRST GETSLP +GETSX: POP P,B ; character word + POPJ P, + +GETCCA: ILDB A,COMPTR + JUMPE A,GETCCX + CAIN A,^I + MOVEI A,40 + CAIE A,^C + CAIN A,^M + JRST GETCCX + CAIN A,", +GETCCX: SETOM A + POPJ P, + + +ftype6: push p,a + hrri a,(p) + hrli a,440600 +ftyp6lp:tlnn a,770000 + jrst fpopaj + ildb 0,a + jumpe 0,fpopaj + addi 0,40 + .iot dsko,0 + jrst ftyp6lp +fpopaj: pop p,a + popj p, + + + +barfln: syscal fillen,[argi,,dsko + val,,a] + .lose 1000 + syscal access,[argi,,dsko + a] + .lose 1000 + .suset [.runame,,a] + call ftype6 + tyo dsko,[^I] + move a,scr + call ftype6 + terpri dsko ;crlf + syscal close,[argi,,dsko] ;close the file + popj p, + popj p, + +typet: syscal open,[cnti,,<.uao+100000> + argi,,dsko + [SIXBIT /DSK/] + [SIXBIT / ~/] + [SIXBIT /~/] + [SIXBIT /EJS/]] + jrst [syscal open,[cnti,,.uao ;this time we'll create it + argi,,dsko + [SIXBIT /DSK/] + [SIXBIT / ~/] + [SIXBIT /~/] + [SIXBIT /EJS/]] + ret + jrst barfln] + jrst barfln + +calerr: 0 +chpt: -7,,scrloc-1 +scrloc: block 7 +pdl: block 70 + +jclbuf: block 50 + + datlen==2000 +datloc: block datlen + + end go