// 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("<System>IFS.syms")
let mark = UserRetrieve(pList, Retrieve)
FreePList(pList)
if mark<<Mark.mark eq markNo test (mark<<Mark.subCode eq 2 %
mark<<Mark.subCode eq 20b % mark<<Mark.subCode eq 21b)
ifso UserName!0, UserPassword!0 = 0, 0
ifnot break
ok = mark eq 0? 1, mark<<Mark.mark eq markEndOfCommand
]
UserClose(ok eq 1)
unless ok eq -1 loop
// SpyCtx (cont'd)
// display table
dt = Allocate(sysZone, lenDT); Zero(dt, lenDT)
for line = 1 to maxLines do
[
dt>>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)
]