// FtpRunInit.bcpl - initialization procedures for run file versions of Ftp
// Copyright Xerox Corporation 1979, 1980, 1981
// Last modified October 2, 1982  12:27 AM by Boggs

get "AltoFileSys.d"
get "BcplFiles.d"
get "Streams.d"
get "SysDefs.d"

external
[
// outgoing procedures
BeforeJuntaInit; Overlay
InitSysFont; InitComCm; InitLog

// incoming procedures
Junta; AfterJunta; Ws
CallSwat; MoveBlock; Allocate; Free
OpenFile; Resets; Closes; Gets; Puts
ReadBlock; FileLength; PositionPage; JumpToFa
PutTemplate; WRITEUDT; CliGetString

// outgoing statics
hostName; logStream; overlayStream; tfsUnit

// incoming statics
fpSysFont; fpComCm; sysZone; sysFont; OsVersion; lvAbortFlag
cli; cliStream; otherPupQ; userDsp

protectedServer; overwriteServer; killServer
debugFlag; tfsFlag; ramFlag
userFlag; serverFlag; telnetFlag
logFlag; errorFlag; cliFlag
]

static
[
hostName; logStream; overlayStream; tfsUnit = 0
ftpCFA; currentSegNum = 0
]

//-----------------------------------------------------------------------------------------
let BeforeJuntaInit(blv, upe, cfa) be
//-----------------------------------------------------------------------------------------
[
@lvAbortFlag = @lvAbortFlag +1
if OsVersion ls 17 then
   [
   Ws("*NYour OS is too old.  Ftp requires OS 17 or greater")
   finish
   ]

// overlay cfa
compileif lCFA gr 9 then [ foo = nil ]
ftpCFA = table [ 0; 0; 0; 0; 0; 0; 0; 0; 0 ]
MoveBlock(ftpCFA, cfa, lCFA)

// global switches
let userMentioned, serverMentioned = false, false
while upe!0 ne 0 do
   [
   let length = upe>>UPE.length
   if upe>>UPE.type eq globalSwitches then
      [
      let notFlag = false
      for i = 1 to length-1 do
         [
         switchon upe!i into
            [
            case $-:
               [ notFlag = not notFlag; loop ]
            case $A: case $a:
               [ logFlag = 1; endcase ]  //append
            case $C: case $c:
               [ telnetFlag = not notFlag; endcase ]
            case $D: case $d:
               [ debugFlag = not notFlag; endcase ]
            case $E: case $e:
               [ errorFlag = not notFlag; endcase ]
            case $K: case $k:
               [ killServer = not notFlag; endcase ]
            case $L: case $l:
               [ logFlag = not notFlag; endcase ]  //overwrite
            case $O: case $o:
               [ overwriteServer = not notFlag; endcase ]
            case $P: case $p:
               [ protectedServer = not notFlag; endcase ]
            case $R: case $r:
               [ ramFlag = not notFlag; endcase ]
            case $S: case $s:
               [
               serverFlag = not notFlag
               serverMentioned = true
               endcase
               ]
            case $T: case $t:
               [
               tfsFlag = not notFlag
               while i ne length-1 do
                  [
                  let digit = upe!(i+1)-$0
                  if digit ls 0 % digit gr 7 break
                  tfsUnit = tfsUnit lshift 3 + digit
                  i = i+1
                  ]
               endcase
               ]
            case $U: case $u:
               [
               userFlag = not notFlag
               userMentioned = true
               endcase
               ]
            ]
         notFlag = false
         ]
      ]
   upe = upe + length
   ]

if tfsFlag then
   if userFlag & serverFlag then
      test serverMentioned
         ifso userFlag = false
         ifnot serverFlag = false

Junta(levDisplay, AfterJunta)
]

//-----------------------------------------------------------------------------------------
and InitSysFont() be
//-----------------------------------------------------------------------------------------
[
let font = OpenFile("sysfont.al", ksTypeReadOnly, wordItem,
 0, fpSysFont, 0, sysZone)
if font eq 0 then CallSwat("Can't open sysfont.al")
let lenFont = (FileLength(font)+1) rshift 1
sysFont = Allocate(sysZone, lenFont)
Resets(font); ReadBlock(font, sysFont, lenFont); Closes(font)
sysFont = sysFont +2
]

//-----------------------------------------------------------------------------------------
and InitComCm() be
//-----------------------------------------------------------------------------------------
[
cliStream = OpenFile("Com.cm", ksTypeReadOnly, charItem, 0, fpComCm, 0, sysZone)
if cliStream eq 0 then CallSwat("Can't open Com.cm")
Free(sysZone, CliGetString(false))  //subsystem name
hostName = CliGetString(false)  //host name handled as a special case
cli = CliGetString(false)  //are there any more tokens?
test cli ne 0
   ifso cliFlag = true
   ifnot [ Closes(cliStream); cliStream = 0 ]
]

//-----------------------------------------------------------------------------------------
and InitLog() be
//-----------------------------------------------------------------------------------------
// open a typescript file on DP0
[
if cliFlag then unless logFlag do logFlag = true
if logFlag then
   [ // if logFlag eq -1 then overwrite; if logFlag eq 1 then append
   logStream = OpenFile("Ftp.log", ksTypeWriteOnly, charItem)
   test logStream eq 0
      ifso logFlag = false
      ifnot
         [
         if logFlag eq 1 then FileLength(logStream)  //position to end
         PutTemplate(logStream, "FTP log started $P*N*N", WRITEUDT, 0)
         ]
   ]
]

//---------------------------------------------------------------------------
and Overlay(segNum) = valof
//---------------------------------------------------------------------------
[
if overlayStream eq 0 then
   [
   overlayStream = OpenFile(0, ksTypeReadOnly, wordItem, 0, ftpCFA)
   JumpToFa(overlayStream, lv ftpCFA>>CFA.fa)
   ]

let codeArea = nil
   [
   if segNum ls currentSegNum then CallSwat("Overlays out of order")
   let header = vec 15
   PositionPage(overlayStream, ftpCFA>>CFA.fa.pageNumber)
   currentSegNum = currentSegNum +1
   ReadBlock(overlayStream, header, 16)
   if currentSegNum eq segNum then
      [
      //read in the segment
      codeArea = Allocate(sysZone, header>>BBHeader.codeLength)
      ReadBlock(overlayStream, codeArea, header>>BBHeader.codeLength)

      //fixup static pointers
      for i = 1 to Gets(overlayStream) do
         [
         let addr = Gets(overlayStream)
         @addr = codeArea+Gets(overlayStream)
         ]
      ]

   ftpCFA>>CFA.fa.pageNumber = ftpCFA>>CFA.fa.pageNumber +
    (header>>BBHeader.fileLength + 255) rshift 8
   ] repeatuntil currentSegNum eq segNum

resultis codeArea
]