// IfsCopyDiskRare.bcpl
// Copyright Xerox Corporation 1980, 1981, 1982
// Last modified September 25, 1983  2:53 PM by Taft

get "Streams.d"
get "Ifs.decl"
get "IfsRS.decl"
get "IfsDirs.decl"
get "IfsFiles.decl"
get "IfsCopyDisk.decl"

external
[
// outgoing procedures
CDVersion; CDLogin; CDSendErrors; CDCloseFile
CDSendDiskParams; CDHereAreDiskParams

// incoming procedures
PutString; PutIfsEc; PutBlock
CloseIFSStream; CloseIFSFile; LookupFD; DeleteFileFromFD; GetBufferForFD
DestroyFD; StreamsFD; TransferLeaderPage
IFSOpenFile; ReadBlock; WriteBlock; Closes
Login; Connect; ActiveJobs; CreateStringStream
PrintIFSVersion; WritePackedDT; PutTemplate
SysAllocate; SysFree; FreePointer; MoveBlock

// incoming statics
maxJobs; CtxRunning
]

//----------------------------------------------------------------------------
let CDVersion(cb) be
//----------------------------------------------------------------------------
[
let activeJobs = ActiveJobs()
PutString(version, cdVersion, "$P; $D user$S out of $D",
 PrintIFSVersion, "CopyDisk server", activeJobs, (activeJobs eq 1? "", "s"), maxJobs)
]

//----------------------------------------------------------------------------
and CDLogin(cb) be
//----------------------------------------------------------------------------
[
let uNam = lv cb>>CB.string.string
let uPsw = uNam + uNam>>String.length rshift 1 +1
let cNam = uPsw + uPsw>>String.length rshift 1 +1
let cPsw = cNam + cNam>>String.length rshift 1 +1

let ec = Login(uNam, uPsw, CtxRunning>>RSCtx.userInfo)
if ec eq 0 then
   ec = Connect(cNam, cPsw, CtxRunning>>RSCtx.userInfo)

test ec eq 0
   ifso PutIfsEc(yes, ecLogConn)
   ifnot PutIfsEc(no, ec)
]

//----------------------------------------------------------------------------
and CDSendErrors(cb) be
//----------------------------------------------------------------------------
[
test CtxRunning>>CDCtx.errorCode ne 0
   ifso
      PutIfsEc(no, CtxRunning>>CDCtx.errorCode)
   ifnot
      [
      let cb = vec lenErrors
      cb>>CB.errors.diskType = 0
      PutBlock(cb, hereAreErrors, lenErrors)
      ]
]

//----------------------------------------------------------------------------
and CDHereAreDiskParams(cb) be
//----------------------------------------------------------------------------
[
FreePointer(lv CtxRunning>>CDCtx.diskParams)
CtxRunning>>CDCtx.diskParams = SysAllocate(cb>>CB.length)
MoveBlock(CtxRunning>>CDCtx.diskParams, cb, cb>>CB.length)
]

//----------------------------------------------------------------------------
and CDSendDiskParams(cb) be
//----------------------------------------------------------------------------
[
CDCloseFile()
CtxRunning>>CDCtx.errorCode = 0
let ec, read = nil, cb>>CB.type eq sendDiskParamsR
let stream = IFSOpenFile(lv cb>>CB.string.string, lv ec,
 (read? modeRead, modeReadWrite), wordItem, (read? 0, lcCreate+lcVNext))
if stream eq 0 then [ PutIfsEc(no, ec); return ]
test read
   ifso  // reading
      [
      manifest maxLenDiskParams = 20  // guard; currently 6
      let cb = vec maxLenDiskParams
      ReadBlock(stream, cb, maxLenDiskParams)
      test cb>>CB.type eq hereAreDiskParams &
       cb>>CB.length le maxLenDiskParams
         ifso
            [
            let fd = StreamsFD(stream)
            let ild = GetBufferForFD(fd)
            TransferLeaderPage(fd, ild)  // read
            let c = lv ild>>ILD.flags
            let ss = CreateStringStream(lv c>>CB.string, 255)
            PutTemplate(ss, "$S created $P by $S", lv ild>>ILD.pathName,
             WritePackedDT, lv ild>>ILD.created, lv ild>>ILD.author)
            Closes(ss)
            SysFree(ild)
            PutBlock(c, comment, lenString+ss>>String.length/2 +1)
            PutBlock(cb, hereAreDiskParams, cb>>CB.length)
            ]
         ifnot
            [
            PutIfsEc(no, ecBadFormat)
            Closes(stream)
            stream = 0
            ]
      ]
   ifnot  // writing
      [
      CtxRunning>>CDCtx.delete = StreamsFD(stream)>>FD.oldPageNumber eq -1
      let dp = vec lenDiskParams
      dp>>CB.diskParams.diskType = 0
      PutBlock(dp, hereAreDiskParams, lenDiskParams)
      ]
CtxRunning>>CDCtx.diskStream = stream
]

//----------------------------------------------------------------------------
and CDCloseFile() be
//----------------------------------------------------------------------------
// Releases diskParams, Closes the disk stream, and may delete the file.
[
FreePointer(lv CtxRunning>>CDCtx.diskParams)
if CtxRunning>>CDCtx.diskStream eq 0 return
let delete = CtxRunning>>CDCtx.delete ne 0
// leave file locked if we are about to delete it.
let fd = CloseIFSStream(CtxRunning>>CDCtx.diskStream, delete)
if delete then
   if DeleteFileFromFD(fd, false, true) ne 0 then CloseIFSFile(fd)
DestroyFD(fd)
CtxRunning>>CDCtx.diskStream = 0
]