// FtpUserInit.bcpl
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified October 11, 1982  1:03 AM by Boggs

get "FtpProt.decl"
get "AltoDefs.d"
get "Streams.d"

external
[
// outgoing procedure
InitFtpUser; LoadKT

// incoming procedures
InitFtpCli; InitFtpKbd; FtpCli; FtpKbd; FtpUserFinishProc
Allocate; Free; Zero; Enqueue
InitPList; ExtractSubstring
InitializeContext; InsertKeyword; CreateDisplayStream
LsPuts; DlsPuts; DblsPuts; CreateKeyStream; UserKey; LogPuts

// outgoing statics
userDspLen; userDsp; userKeys; userSoc; userCtx; userUFP; defaultPL

// incoming statics
debugFlag; tfsFlag; cliFlag; logFlag; stackSize; ctxQ
lvUserFinishProc; UserName; UserPassword
sysZone; sysFont; fontHeight; lBSPSoc
]

static [ userDspLen; userDsp; userKeys; userSoc; userCtx; userUFP; defaultPL ]

structure String [ length byte; char^1,1 byte ]

//-----------------------------------------------------------------------------------------
let InitFtpUser() be
//-----------------------------------------------------------------------------------------
[
let len = userDspLen; let bitMap = Allocate(sysZone, userDspLen, lv len)
if bitMap eq 0 then bitMap = Allocate(sysZone, len)
let ds = CreateDisplayStream((userDsp>>DS.fdcb>>DCB.height*2)/fontHeight,
 bitMap, len, sysFont)
let dcb = @displayListHead; while dcb ne 0 do
   [
   if dcb>>DCB.next eq userDsp>>DS.fdcb then
      [
      ds>>DS.ldcb>>DCB.next = userDsp>>DS.ldcb>>DCB.next
      dcb>>DCB.next = ds>>DS.fdcb
      Free(sysZone, userDsp); userDsp = ds
      break
      ]
   dcb = dcb>>DCB.next
   ]

userKeys = CreateKeyStream(UserKey, userDsp)
userDspLen = userDsp; userDsp = lv LogPuts - offset ST.puts/16

userSoc = Allocate(sysZone, lBSPSoc)
userCtx = Allocate(sysZone, stackSize); Zero(userCtx, stackSize)
userCtx = InitializeContext(userCtx, stackSize, (cliFlag? FtpCli, FtpKbd), lenExtraCtx)
userCtx>>FtpCtx.bspSoc = userSoc
userCtx>>FtpCtx.lst = lv LsPuts - offset ST.puts/16
userCtx>>FtpCtx.dls = lv DlsPuts - offset ST.puts/16
userCtx>>FtpCtx.dbls = lv DblsPuts - offset ST.puts/16
userCtx>>FtpCtx.dspStream = userDsp
let bufferLength = tfsFlag? 1024, 6*256
userCtx>>FtpCtx.buffer = Allocate(sysZone, bufferLength)
userCtx>>FtpCtx.bufferLength = bufferLength
userCtx>>FtpCtx.debugFlag = debugFlag
Enqueue(ctxQ, userCtx)

// User default property list
defaultPL = InitPList()
if UserName>>String.length ne 0 then
   defaultPL>>PL.UNAM = ExtractSubstring(UserName)
if UserPassword>>String.length ne 0 then
   defaultPL>>PL.UPSW = ExtractSubstring(UserPassword)

userUFP = @lvUserFinishProc
@lvUserFinishProc = FtpUserFinishProc

test cliFlag
   ifso InitFtpCli()
   ifnot InitFtpKbd()
]

//-----------------------------------------------------------------------------------------
and LoadKT(kt, string, arg1, arg2; numargs na) be
//-----------------------------------------------------------------------------------------
[
let kte = InsertKeyword(kt, string)
for i = 0 to na-3 do kte!i = (lv arg1)!i
]