// IFSDirParse.bcpl -- Parse IFS filenames
// Copyright Xerox Corporation 1979, 1981, 1982

// Last modified May 11, 1982  2:04 PM by Taft

get "Ifs.decl"
get "IfsFiles.decl"
get "IfsDirs.decl"
get "IfsRs.decl"

external
[
// Outgoing procedures
CreateFD; DestroyFD; ParseFD; UpdateFD
IFSParseVersion; IFSAppendVersion; SetDRLength

// Incoming procedures -- rest of IFS
IFSError; CreateStringStream; CopyString; FreePointer; PutTemplate
MakeKPMTemplate

// Incoming procedures -- operating system
DefaultArgs; SysAllocateZero
Puts; Wns; Wss; Closes

// Incoming statics
primaryIFS; CtxRunning
]

//---------------------------------------------------------------------------
let CreateFD(name, lc, lvErrorCode, fs, dirName; numargs na) = valof
//---------------------------------------------------------------------------
// Parses the supplied "name" (a BCPL string) and returns an FD
// structure suitable for lookup purposes in file system fs, or zero
// if the name is malformed.  "lc" is the lookup control parameter.
// "dirName" is the default directory name, and overrides the one in
// the userInfo if supplied.
// If an error is encountered and lvErrorCode is supplied, an
// error code is stored in @lvErrorCode; zero is stored upon success.
// The returned structure is allocated from sysZone.
[
let userInfo = CtxRunning>>RSCtx.userInfo
DefaultArgs(lv na, -2, lv na, primaryIFS,
 (userInfo>>UserInfo.defaultDir ne 0? userInfo>>UserInfo.defaultDir,
 userInfo>>UserInfo.connName))
if dirName eq 0 then dirName = ""

// Blunder check on string lengths
if name>>STRING.length gr maxPathNameChars %
 dirName>>STRING.length gr maxPathNameChars then
   [ @lvErrorCode = ecNameTooLong; resultis 0 ]

// Generate the full filename
let fullName = vec 127
let ss = CreateStringStream(fullName, 255)
test name>>STRING.char↑1 eq $<
   ifso Wss(ss, name)
   ifnot
      [
      // If the default directory is in the form ">xxx" then prefix the
      // connect name; otherwise use it as it stands.
      let pref = dirName>>STRING.length ne 0 & dirName>>STRING.char↑1 eq $>?
       userInfo>>UserInfo.connName, ""
      PutTemplate(ss, "<$S$S>$S", pref, dirName, name)
      ]
Closes(ss)

// build the FD and DR structures.
// the DR must be long enough to accomodate appending a version.
let length = fullName>>STRING.length
if length gr maxPathNameChars then
   [ @lvErrorCode = ecNameTooLong; resultis 0 ]
let fd = SysAllocateZero(lenFD)
fd>>FD.fs = fs
fd>>FD.lc = lc
let dr = SysAllocateZero(lenDRHeader + (length+9) rshift 1)
CopyString(lv dr>>DR.pathName, fullName)
dr>>DR.type = drTypeNormal
fd>>FD.dr = dr

// attempt to parse the name.
@lvErrorCode = ParseFD(fd)
if @lvErrorCode ne 0 then fd = DestroyFD(fd)
resultis fd
]

//---------------------------------------------------------------------------
and DestroyFD(fd) = valof
//---------------------------------------------------------------------------
// Deallocates the supplied FD and returns zero to permit one to say
// "foo = DestroyFD(foo)"
[
FreePointer(lv fd>>FD.dr, lv fd>>FD.template, lv fd>>FD.pathStk, lv fd)
resultis 0
]

//---------------------------------------------------------------------------
and ParseFD(fd) = valof
//---------------------------------------------------------------------------
// Parses the name string in the fd's DR and sets up the auxiliary
// lookup information in the FD.  Returns zero if successful and
// an error code if unsuccessful.
[
// reject illegal combinations of lookup control parameters
let lc = fd>>FD.lc
let vc = lc<<LC.vc
if lc<<LC.create & lc<<LC.multiple %
 not lc<<LC.multiple & vc eq lcVAll %
 not lc<<LC.create & vc eq lcVNext then
   IFSError(ecIllegalLookupControl)

// scan the name string and set up the pointers in the FD
let code = ScanFD(fd)
if code gr 0 resultis code  //error
if code ls 0 then unless fd>>FD.lc.multiple resultis ecIllegalStar
fd>>FD.iFirstStar = -code  //record index of first "*"

// parse the version number if there is one
let dr = fd>>FD.dr
let length = dr>>DR.pathName.length
test fd>>FD.lenBodyString gr 0 & fd>>FD.lenBodyString ls length
   ifso switchon IFSParseVersion(lv dr>>DR.pathName,
    fd>>FD.lenBodyString+1, length, lv fd>>FD.version) into
      [
      case 0:  // successfully parsed version
         [ vc = lcVExplicit; endcase ]
      case 1:  // non-digit encountered
         [
         if fd>>FD.lenBodyString eq length-1 then
            [  // test for special cases of !H, !N, !L, !*
            let nvc = selecton dr>>DR.pathName.char↑length into
               [
               case $H: case $h: lcVHighest
               case $N: case $n: lcVNext
               case $L: case $l: lcVLowest
               case $**: lcVAll
               default: 0
               ]
            if nvc ne 0 then [ vc = nvc; endcase ]
            ]
         // not one of the special cases, treat as no version case
         fd>>FD.lenBodyString = length+1
         endcase
         ]
      case 2:  // illegal version number, error
         resultis ecIllegalVersion
      ]
   ifnot fd>>FD.lenBodyString = length+1  // where to append version
fd>>FD.lc.vc = vc

// ParseFD (cont'd)

// special case: no "*" and no version in string and lcVAll default?
if vc eq lcVAll & fd>>FD.iFirstStar eq 0 then
   fd>>FD.iFirstStar = length+2  // where "*" will be eventually

// remaining processing depends on whether name contains "*"s
test fd>>FD.iFirstStar eq 0
   ifso
      [  // no "*"s, compute and append version for actual lookup
      unless vc eq lcVExplicit do
         fd>>FD.version = (vc eq lcVLowest? 0, #177777)
      IFSAppendVersion(fd)
      ]
   ifnot
      [  // "*"s, generate KPM template and truncate name in DR
      unless vc eq lcVExplicit do
         [  // append "!*"
         let i = fd>>FD.lenBodyString
         dr>>DR.pathName.char↑i = $!
         dr>>DR.pathName.char↑(i+1) = $**
         dr>>DR.pathName.length = i+1
         ]
      fd>>FD.template = MakeKPMTemplate(lv dr>>DR.pathName)
      dr>>DR.pathName.length = fd>>FD.iFirstStar-1
      fd>>FD.lenBodyString = dr>>DR.pathName.length
      ]
resultis (dr>>DR.pathName.length gr maxPathNameChars? ecNameTooLong, 0)
]

//---------------------------------------------------------------------------
and UpdateFD(fd) be
//---------------------------------------------------------------------------
// Re-parses the FD's pathname and resets the lenDirString,
// lenBodyString, and version fields in the FD.  This should be
// done only after the FD's pathname is replaced by a real
// filename.
[
if ScanFD(fd) ne 0 % fd>>FD.lenBodyString eq 0 then
   IFSError(ecIllegalExistingName, lv fd>>FD.dr>>DR.pathName)
IFSParseVersion(lv fd>>FD.dr>>DR.pathName, fd>>FD.lenBodyString+1,
 fd>>FD.dr>>DR.pathName.length, lv fd>>FD.version)
]

//---------------------------------------------------------------------------
and ScanFD(fd) = valof
//---------------------------------------------------------------------------
// Scans the fd.dr.pathName string and sets the lenDirString, lenSubDirString,
// and lenBodyString fields in the fd.  lenBodyString is set
// to zero if no "!" is encountered.  no attempt is made
// to parse the version.  Returns one of:
//   zero - normal
//   positive - error code
//   negative - negative of the index of the first "*"
[
let dr = fd>>FD.dr
fd>>FD.lenDirString, fd>>FD.lenBodyString = 0, 0
let iFirstStar = 0  // no "*" seen yet
for i = 1 to dr>>DR.pathName.length do
   [
   let char = dr>>DR.pathName.char↑i
   switchon char into
      [
      case $>:
         [
         if fd>>FD.lenDirString eq 0 then fd>>FD.lenDirString = i
         fd>>FD.lenSubDirString = i
         endcase
         ]
      case $!:
         [ fd>>FD.lenBodyString = i; endcase ]
      case $**:
         [ if iFirstStar eq 0 then iFirstStar = i; endcase ]
      default:
         [ if char le #40 % char ge #177 resultis ecIllegalChar ]
      ]
   ]
if fd>>FD.lenDirString eq 0 & iFirstStar eq 0 %
 dr>>DR.pathName.char↑1 ne $< & iFirstStar ne 1 then
   resultis ecNameMalformed  // "<" or ">" missing
resultis -iFirstStar  // zero if no "*"
]

//---------------------------------------------------------------------------
and IFSParseVersion(string, firstChar, lastChar, lvVersion) = valof
//---------------------------------------------------------------------------
// Attempts to parse the substring described by the arguments
// as a version number.  Stores the version in @lvVersion if
// successful.  A code is returned describing the outcome:
//   0 successful
//   1 non-digit encountered
//   2 illegal version number (zero or overflowed 16 bits)
[
let code,version = 0,0
for i = firstChar to lastChar do
   [
   let digit = string>>STRING.char↑i-$0
   if digit ls 0 % digit gr 9 resultis 1  // non-digit encountered
   if version ugr 6553 % (version eq 6553 & digit gr 5) then
      code = 2  // overflowed, but keep scanning to find non-digits
   version = 10*version+digit
   ]
if version eq 0 then code = 2
@lvVersion = version
resultis code
]

//---------------------------------------------------------------------------
and IFSAppendVersion(fd) be
//---------------------------------------------------------------------------
// Appends the version number to the pathname string in the
// FD structure fd.  Assumes that the lenBodyString
// word contains the index of the character to be overwritten
// by the "!".  Updates directory entry length and string length.
[
let dr = fd>>FD.dr
let ss = CreateStringStream(lv dr>>DR.pathName, 999,
 fd>>FD.lenBodyString)
Puts(ss, $!)
Wns(ss, fd>>FD.version, 0, 10)  // unsigned decimal
Closes(ss)
SetDRLength(dr)
]

//---------------------------------------------------------------------------
and SetDRLength(dr) be
//---------------------------------------------------------------------------
// Sets the DR's length based on its type and the pathname's length
[
dr>>DR.length = lenDRHeader+1 + dr>>DR.pathName.length rshift 1 +
 (dr>>DR.type eq drTypeDIF? lenDIFRec, 0)
]