// Ftp.bcpl -- the main program, such as it is
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified October 2, 1982  1:07 AM by Boggs

get "AltoFileSys.d"
get "FtpProt.decl"
get "AltoDefs.d"

external
[
// outgoing procedures
AfterJunta; FunnyAllocate

// incoming procedures
InitFtp; BeforeJuntaInit
InitFtpServer; InitFtpUser; InitFtpTelnet
CallContextList; Block; SetTimer; TimerHasExpired
Closes; FlushKeyboard
MoveBlock; StartIO; Min; Idle
AddToZone

TFSClose; Free; DefaultArgs

// incoming statics
ctxQ; sysZone; cliStream; logStream
UserName; UserPassword; defaultPL
lvIdle; lvUserFinishProc

ramFlag; tfsFlag; telnetFlag; serverFlag; userFlag
ftpDisk; initCode; savedAllocate
lvSwatContextProc; savedSwatContextProc
]

static [ savedIdle; savedUserFinishProc ]

structure String [ length byte; char^1,1 byte ]

//---------------------------------------------------------------------------
structure Zone:  // ******* Implementation dependent *****
//---------------------------------------------------------------------------
[
Allocate word
Free word
OutOfSpaceRtn word
MalFormedRtn word
anchor:
   [
   length word
   pSbNext word
   pSbPrevious word
   ]
rover word
minAdr word
maxAdr word
]

//---------------------------------------------------------------------------
let FTP(blv, upe, cfa) be BeforeJuntaInit(blv, upe, cfa)
//---------------------------------------------------------------------------

//---------------------------------------------------------------------------
and AfterJunta() be
//---------------------------------------------------------------------------
[
savedUserFinishProc = @lvUserFinishProc
@lvUserFinishProc = FtpFinishProc
savedIdle = @lvIdle; @lvIdle = Block; Idle = Block

InitFtp()
AddToZone(sysZone, InitFtp, sysZone-InitFtp)

if serverFlag then InitFtpServer()
if userFlag then InitFtpUser()
if telnetFlag then InitFtpTelnet()
Free(sysZone, initCode)

sysZone!0 = savedAllocate  //**
CallContextList(ctxQ!0) repeat  //forever
]

//---------------------------------------------------------------------------
and FtpFinishProc() be
//---------------------------------------------------------------------------
// This is the last user finish procedure.
[
if UserPassword>>String.length eq 0 then
   [
   if defaultPL ne 0 & defaultPL>>PL.UNAM ne 0 then
      MoveBlock(UserName, defaultPL>>PL.UNAM,
       Min(defaultPL>>PL.UNAM>>String.length/2+1, UserName!-1))
   if defaultPL ne 0 & defaultPL>>PL.UPSW ne 0 then
      MoveBlock(UserPassword, defaultPL>>PL.UPSW,
       Min(defaultPL>>PL.UPSW>>String.length/2+1, UserPassword!-1))
   ]

@displayListHead = 0
let timer = 0; SetTimer(lv timer, 10)
if logStream ne 0 then Closes(logStream)
if cliStream ne 0 then Closes(cliStream)

if tfsFlag then
   [
   TFSClose(ftpDisk)
   @lvSwatContextProc = savedSwatContextProc
   ]

if ramFlag then
   [
   (table [ 61010b; 1401b ])(177776b, 22b)  //SetBLV(177776b)
   StartIO(100000b)  //silent boot
   ]

until TimerHasExpired(lv timer) loop
@lvIdle = savedIdle
FlushKeyboard()
@lvUserFinishProc = savedUserFinishProc  //rumble rumble
]

//---------------------------------------------------------------------------
and FunnyAllocate(zone, length, returnOnFail, even; numargs na) = valof
//---------------------------------------------------------------------------
//******* Implementation dependent  *********
[
DefaultArgs(lv na, -2, false, false)
zone>>Zone.rover = zone>>Zone.anchor.pSbNext
resultis savedAllocate(zone, length, returnOnFail, even)
]