// FtpPListProt.bcpl - Property list protocol routines for FTP
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified May 13, 1982  1:16 PM by Boggs

get "Pup.decl"
get "FtpProt.decl"

external
[
// outgoing procedures
InitPList; FreePList; ScanPList; GeneratePList

// incoming procedures
GenProp; ScanProp; FreeProp; InitProp; FTPM
Puts; PutTemplate; Gets; Wss; Zero; Allocate; Free
EnumerateKeywordTable; LookupKeyword

// incoming statics
CtxRunning; pListKT; sysZone
]

manifest
[
maxPropItemChars = 127
maxPropItemWords = maxPropItemChars rshift 1 +1
]

//---------------------------------------------------------------------------
let InitPList(defPList; numargs na) = valof
//---------------------------------------------------------------------------
// Returns a pl, initialized to be a copy of defPList, if supplied.
[
let pl = Allocate(sysZone, lenPL); Zero(pl, lenPL)
if na gr 0 & defPList ne 0 then
   [
   let v = vec 1; v!0 = pl; v!1 = defPList
   EnumerateKeywordTable(pListKT, InitProp, v)
   ]
resultis pl
]

//---------------------------------------------------------------------------
and FreePList(pl) = valof
//---------------------------------------------------------------------------
// Destroys a property list.  Returns zero.
[
if pl ne 0 then
   [
   EnumerateKeywordTable(pListKT, FreeProp, pl)
   Free(sysZone, pl)
   ]
resultis 0
]

//---------------------------------------------------------------------------
and GeneratePList(pl) be
//---------------------------------------------------------------------------
// Translates pl to network format and sends it.
[
Puts(CtxRunning>>FtpCtx.dbls, $()  //PList open parenthesis
EnumerateKeywordTable(pListKT, GenProp, pl)
Puts(CtxRunning>>FtpCtx.dbls, $))  //PList close parenthesis
]

//---------------------------------------------------------------------------
and ScanPList(lvEc; numargs na) = valof
//---------------------------------------------------------------------------
// Expects to find a plist as the next thing in FtpCtx.bspStream.
// Scans the property list into pl, returning true if all goes well.
// Returns false if the list had bad syntax, having already
//  generated "[No]<code>string", but -> NO <- trailing [EOC]
[
if na eq 0 then lvEc = lv na; @lvEc = 0
let char = IgnoreBlanks(true)
if char eq -1 resultis false  //stream failed or mark
if char ne $( then
   [
   FTPM(markNo, 10b, "Malformed property list: ( expected")
   @lvEc = true
   resultis false
   ]
let pl = InitPList()
let name = Allocate(sysZone, maxPropItemWords)
let value = Allocate(sysZone, maxPropItemWords)
let ok = valof
   [
   switchon IgnoreBlanks(true) into
      [
      case $): resultis true
      case $(: break
      default: FTPM(markNo, 10b, "Malformed property list: ) expected") //fall
      case -1: resultis false
      ] repeat
   unless GetPListItem(name, $*S) resultis false
   unless GetPListItem(value, $)) resultis false
   let prop = LookupKeyword(pListKT, name)
   if prop eq 0 then
      [
      FTPM(markComment, 0, " Unrecognized property: $S", false, name)
      loop
      ]
   let v = vec 1; v!0 = pl; v!1 = value
   test ScanProp(prop, nil, name, v)
      ifso loop  //on to next property
      ifnot resultis false  //ScanProp calls FTPM on error
   ] repeat
Free(sysZone, name)
Free(sysZone, value)
test ok
   ifso resultis pl
   ifnot [ @lvEc = true; resultis FreePList(pl) ]
]

//---------------------------------------------------------------------------
and IgnoreBlanks(echo) = valof
//---------------------------------------------------------------------------
// Ignores leading spaces, returning the first non-space character read
[
let char = Gets(CtxRunning>>FtpCtx.bspStream)
if echo then Puts(CtxRunning>>FtpCtx.dls, char)
if char eq $*S loop
resultis char
] repeat

//---------------------------------------------------------------------------
and GetPListItem(lvDest, termChar) = valof
//---------------------------------------------------------------------------
// Reads FtpCtx.bspStream assembling a string at lvDest.
// Unquotes characters. Returns true if all is well.
// Terminates when it reads termChar.
[
lvDest>>String.length = 0
let quotePending = false
let char = IgnoreBlanks(false)
   [
   if char eq -1 then
      [
      Wss(CtxRunning>>FtpCtx.dls, "Unexpected Mark or End of BSP stream")
      resultis false
      ]
   Puts(CtxRunning>>FtpCtx.dls, char)
   if char eq termChar & not quotePending resultis true
   if char ne QuoteChar % quotePending then
      [
      if lvDest>>String.length eq maxPropItemChars then
         [
         FTPM(markNo, 10b, "Property item exceeds $UD chars", false,
          maxPropItemChars)
         resultis false
         ]
      lvDest>>String.length = lvDest>>String.length + 1
      lvDest>>String.char↑(lvDest>>String.length) = char
      ]
   quotePending = char eq QuoteChar & not quotePending
   char = Gets(CtxRunning>>FtpCtx.bspStream)
   ] repeat
]