// VMemSpy.bcpl // Copyright Xerox Corporation 1980, 1981 // Last modified September 28, 1982 10:23 PM by Boggs get "SysDefs.d" get "BcplFiles.d" get "AltoDefs.d" get "VMemSpy.decl" get "Pup0.decl" get "Pup1.decl" get "PupRtp.decl" get "PupBsp.decl" get "FtpProt.decl" external [ // incoming procedures Spy; Wss; SysErr CreateKeyboardStream; PutTemplate CreateDisplayStream; ShowDisplayStream EraseBits; CharWidth; SetLmarg GetPartner; CreateBSPStream; BSPReadBlock OpenLevel1Socket; CloseLevel1Socket OpenRTPSocket; CloseRTPSocket UserOpen; UserClose; UserRetrieve InitPList; FreePList Gets; Puts; Closes; Resets CallSwat; Zero; MoveBlock; Noop; Idle InitializeZone; AddToZone; Allocate; Free MyFrame; Enqueue; Junta; MultEq; DoubleIncrement TimerHasExpired; SetTimer ExtractSubstring; CopyString InitializeContext; CallContextList; Block InitPupLevel1; InitFtpUtil; InitFtpPList InitBcplRuntime; LoadRam // outgoing statics dt; nt; port; show; noshow sysZone; dsp // incoming statics keys; sysFont RamImage; CtxRunning UserName; UserPassword; lvUserFinishProc ] static [ dt; nt; show; noshow; port savedUFP; lineWords; sysZone; dsp ] manifest stackLimit = 335b structure BBFD: // BB File Descriptor [ name word blank word 3 ] manifest lenBBFD = size BBFD/16 //---------------------------------------------------------------------------- let VMemSpy() be //---------------------------------------------------------------------------- [ let juntaLevel = LoadRam(RamImage) eq 0? levBasic, levBcpl if juntaLevel eq levBasic then InitBcplRuntime() Junta(juntaLevel, AfterJunta) ] //---------------------------------------------------------------------------- and AfterJunta() be //---------------------------------------------------------------------------- [ CreateKeyboardStream() Idle = Block for i = 0 to 7 do cursorBitMap!i = 177400b for i = 8 to 15 do cursorBitMap!i = 377b savedUFP = @lvUserFinishProc; @lvUserFinishProc = SpyFinish let freeBegin = @stackLimit @stackLimit = MyFrame() -200 sysZone = InitializeZone(freeBegin, 77777b, SysErr, 0) AddToZone(sysZone, freeBegin+77777b, @stackLimit-freeBegin-77777b) lineWords = lDCB+10+38*2*((sysFont!-2+1) rshift 1) dsp = CreateDisplayStream(6, Allocate(sysZone, 3*lineWords), 3*lineWords) ShowDisplayStream(dsp, DSalone) Wss(dsp, "VMemSpy of 29 Sept 82") port = Allocate(sysZone, lenPort) nt = Allocate(sysZone, maxOvs); Zero(nt, maxOvs) let ctxQ = Allocate(sysZone, 2); ctxQ!0 = 0 InitPupLevel1(sysZone, ctxQ, 10) InitFtpUtil() InitFtpPList() Enqueue(ctxQ, InitializeContext(Allocate(sysZone, 500), 500, SpyCtx, lenExtraCtx)) CallContextList(ctxQ!0) repeat //forever ] //---------------------------------------------------------------------------- and SpyFinish() be //---------------------------------------------------------------------------- [ manifest kbInterruptBit = 1 lshift 12 @activeInterrupts = @activeInterrupts & not kbInterruptBit @displayInterrupt = @displayInterrupt & not kbInterruptBit @displayListHead = 0 for i = 0 to 30000 loop @lvUserFinishProc = savedUFP ] //---------------------------------------------------------------------------- and Wss(stream, string) be //---------------------------------------------------------------------------- for i = 1 to string>>String.length do Puts(stream, string>>String.char^i) //---------------------------------------------------------------------------- and SysErr(p1, errNo, p2, p3, p4, p5; numargs na) be //---------------------------------------------------------------------------- [ let t = p1; p1 = errNo; errNo = t (table [ 77403b; 1401b ])("Sys.Errors", lv p1) ] //---------------------------------------------------------------------------- and SpyCtx() be // a context //---------------------------------------------------------------------------- [ let host = GetString("*NIFS name: ", true); if host eq 0 loop unless GetPartner(host, dsp, port, 0, socketFTP) loop Free(sysZone, host) // oepn a BSP connection to the Ftp server Zero(CtxRunning+3, lenExtraCtx) let soc = vec lenBSPSoc CtxRunning>>FtpCtx.bspSoc = soc CtxRunning>>FtpCtx.dspStream = dsp OpenLevel1Socket(soc, 0, port) OpenRTPSocket(soc, 0, modeInitAndReturn) let timer = nil; SetTimer(lv timer, 6000) // 1 minute Block() repeatuntil soc>>RTPSoc.state ne stateRFCOut % (kbdAd!1 & 2) eq 0 % TimerHasExpired(lv timer) unless soc>>RTPSoc.state eq stateOpen do [ PutTemplate(dsp, "*NConnection attempt $S", TimerHasExpired(lv timer)? "timed out", "aborted") CloseRTPSocket(soc, 0) CloseLevel1Socket(soc) loop ] CtxRunning>>FtpCtx.bspStream = CreateBSPStream(soc) CtxRunning>>FtpCtx.lst = lv Noop - offset ST.puts/16 CtxRunning>>FtpCtx.dls = lv Noop - offset ST.puts/16 CtxRunning>>FtpCtx.dbls = CtxRunning>>FtpCtx.bspStream unless UserOpen(Noop) loop // retrieve the symbol table let ok = 0 //0 => in progress; 1 => unretryable; -1 => done until ok do [ if UserName>>String.length eq 0 % UserPassword>>String.length eq 0 then [ let unam = GetString("*NLogin user: ", true); unless unam break CopyString(UserName, unam); Free(sysZone, unam) let upsw = GetString("password: ", false); unless upsw break CopyString(UserPassword, upsw); Free(sysZone, upsw) ] let pList = InitPList() pList>>PL.UNAM = ExtractSubstring(UserName) pList>>PL.UPSW = ExtractSubstring(UserPassword) pList>>PL.SFIL = ExtractSubstring("IFS.syms") let mark = UserRetrieve(pList, Retrieve) FreePList(pList) if mark<>DT^line.bitMap = Allocate(sysZone, lineWords) dt>>DT^line.ds = CreateDisplayStream(1, dt>>DT^line.bitMap, lineWords) ShowDisplayStream(dt>>DT^line.ds) ] // VM stats display let showBitMap = Allocate(sysZone, 4*lineWords) show = CreateDisplayStream(4, showBitMap, 4*lineWords) SetLmarg(show, 120) let noshowBitMap = Allocate(sysZone, 4*lineWords) noshow = CreateDisplayStream(4, noshowBitMap, 4*lineWords) SetLmarg(noshow, 120) Spy() // Spy on server // destroy all display streams except dsp ShowDisplayStream(dsp, DSalone) for i = 0 to 30000 loop //give display task time to notice for line = 1 to maxLines do [ Free(sysZone, dt>>DT^line.bitMap) Closes(dt>>DT^line.ds) ] Free(sysZone, dt) Closes(show); Free(sysZone, showBitMap) Closes(noshow); Free(sysZone, noshowBitMap) for i = 0 to maxOvs-1 do if nt!i ne 0 then Free(sysZone, nt!i) Zero(nt, maxOvs) ] repeat //---------------------------------------------------------------------------- and Retrieve(pl) = RetrieveFile //---------------------------------------------------------------------------- //---------------------------------------------------------------------------- and RetrieveFile(pl) = valof //---------------------------------------------------------------------------- // Note that this procedure counts on the fact that the name string area // preceeds the BB file descriptor area in a Syms file. [ PutTemplate(dsp, "*NRetrieving $S...", pl>>PL.SFIL) let bspStream = CtxRunning>>FtpCtx.bspStream let pos = vec 1; Zero(pos, 2) // sym file header let sh = vec lSYmsHeader DoubleIncrement(pos, BSPReadBlock(bspStream, sh, 0, lSYmsHeader*2)) if (sh>>SYmsHeader.version & 177400b) ne 1000b resultis false // names let namePos = vec 1; namePos!0 = 0; namePos!1 = sh>>SYmsHeader.namesAddr*2 until MultEq(pos, namePos) do [ Gets(bspStream); DoubleIncrement(pos) ] let lenNameArea = Gets(bspStream) lshift 8 + Gets(bspStream) let nameArea = Allocate(sysZone, lenNameArea) for i = 1 to lenNameArea-1 do nameArea!i = Gets(bspStream) lshift 8 + Gets(bspStream) DoubleIncrement(pos, lenNameArea) DoubleIncrement(pos, lenNameArea) // BB file descriptors let bbPos = vec 1; bbPos!0 = 0; bbPos!1 = sh>>SYmsHeader.binFilesAddr*2 until MultEq(pos, bbPos) do [ Gets(bspStream); DoubleIncrement(pos) ] let numBBFD = Gets(bspStream) lshift 8 + Gets(bspStream) for numOvs = 0 to numBBFD-1 do [ if numOvs gr maxOvs then CallSwat("Increase maxOvs") let bbfd = vec lenBBFD DoubleIncrement(pos, BSPReadBlock(bspStream, bbfd, 0, lenBBFD*2)) let name = nameArea + bbfd>>BBFD.name nt!numOvs = ExtractSubstring(name, 1, name>>String.length-3) ] Free(sysZone, nameArea) until Gets(bspStream) eq -1 loop Wss(dsp, "Done!") resultis true ] //---------------------------------------------------------------------------- and GetString(prompt, echo) = valof //---------------------------------------------------------------------------- [ Wss(dsp, prompt) let string = vec 128 let count = 0 [ let char = Gets(keys) switchon char into [ case $*S: case $*N: case $*033: [ if count ne 0 then [ Puts(dsp, $*S); break ] endcase ] case $*001: case $*010: [ if count ne 0 then [ if echo then EraseBits(dsp, -CharWidth(dsp, string>>String.char^count)) count = count -1 ] endcase ] case $*177: [ Wss(dsp, " XXX") count = 0 break ] default: [ if count ls (UserName!-1) lshift 1 -1 then [ count = count +1 string>>String.char^count = char if echo then Puts(dsp, char) ] endcase ] ] ] repeat if count eq 0 resultis false string>>String.length = count resultis ExtractSubstring(string) ]