// IfsFtpStore.bcpl -- IFS Ftp Store command
// Copyright Xerox Corporation 1979, 1980, 1981, 1982, 1983
// Last modified September 23, 1983  6:09 PM by Taft

get "Ifs.decl"
get "IfsDirs.decl"
get "IfsFiles.decl"
get "IfsFtpProt.decl"

external
[
// outgoing procedures
FtpSStore; FtpSStoreFile; FtpSStoreCleanup; FtpSSetProps

// incoming procedures from other Ftp files
FtpSMakeSFIL; FtpSSendMark
FtpSCheckAccess; FtpSFillPLFromLD
NetToDisk; FreePList

// incoming procedures from IFS Dirs
IFSOpenFile; DeleteFileFromFD; GetBufferForFD
StreamsFD; DestroyFD
CloseIFSStream; CloseIFSFile; TransferLeaderPage

// incoming procedures - miscellaneous
SysFree; MoveBlock; IFSPrintError; CopyString; FreePointer; ExtractSubstring

// incoming statics
CtxRunning
]

//---------------------------------------------------------------------------
let FtpSStore(remotePL) = valof
//---------------------------------------------------------------------------
[
unless FtpSCheckAccess(remotePL) resultis false

switchon remotePL>>PL.TYPE into
   [
   case Unspecified:
      resultis FtpSSendMark(markNo, ecTypeRequired)
   case Text:
      if remotePL>>PL.EOLC eq CRLF then
         resultis FtpSSendMark(markNo, ecCRLFConversion)
      endcase
   case Binary:
      if remotePL>>PL.BYTE eq 0 then
         resultis FtpSSendMark(markNo, ecByteRequired)
      endcase
   ]

FtpSMakeSFIL(remotePL)
let ec = nil
CtxRunning>>FtpCtx.diskStream = IFSOpenFile(remotePL>>PL.SFIL, lv ec,
 modeWrite, 0, 0, 0, remotePL>>PL.DIRE)
if CtxRunning>>FtpCtx.diskStream eq 0 then resultis FtpSSendMark(markNo, ec)

// obtain properties for the actual file that was created
CtxRunning>>FtpCtx.fd = StreamsFD(CtxRunning>>FtpCtx.diskStream)
let localPL = FtpSFillPLFromLD(remotePL)  // can't fail, file is locked

// now copy user's properties that we will put in file once it gets stored.
// Note that we don't set these properties now, because the user still has
// a chance to abandon the store and we don't want to modify the file yet.
localPL>>PL.TYPE = remotePL>>PL.TYPE
localPL>>PL.BYTE = remotePL>>PL.BYTE
if remotePL>>PL.CDAT.h ne 0 then
   MoveBlock(lv localPL>>PL.CDAT, lv remotePL>>PL.CDAT, 2)
MoveBlock(lv localPL>>PL.SIZE, lv remotePL>>PL.SIZE, 2)  // this is a lie --
   // size will be determined by the number of bytes the user actually sends.
if remotePL>>PL.AUTH ne 0 then
   [
   FreePointer(lv localPL>>PL.AUTH)
   localPL>>PL.AUTH = ExtractSubstring(remotePL>>PL.AUTH)
   ]
localPL>>PL.CSUM = remotePL>>PL.CSUM

resultis localPL
]

//---------------------------------------------------------------------------
and FtpSStoreFile(remotePL, localPL) = valof
//---------------------------------------------------------------------------
[
// Set any file properties that are supplied in remotePL.
// The file is locked, so there is no need to lock the directory for this.
let fd = StreamsFD(CtxRunning>>FtpCtx.diskStream)
let ild = GetBufferForFD(fd)
TransferLeaderPage(fd, ild)
FtpSSetProps(ild, remotePL)
TransferLeaderPage(fd, ild, true)
SysFree(ild)

// Transfer the file.
let ec = NetToDisk(CtxRunning>>FtpCtx.diskStream,
 CtxRunning>>FtpCtx.bspStream, lv remotePL>>PL.SIZE)
if ec eq 0 resultis true
resultis FtpSSendMark(markNo, ecNotStored, IFSPrintError, ec)
]

//---------------------------------------------------------------------------
and FtpSStoreCleanup(remotePL, ok, localPL) be
//---------------------------------------------------------------------------
[
CtxRunning>>FtpCtx.fd = 0
FreePList(localPL)
// destroy stream unconditionally, but close file only if transfer went ok
let fd = CloseIFSStream(CtxRunning>>FtpCtx.diskStream, not ok)
unless ok do
   // The file is damaged, and we must destroy it if we can
   if DeleteFileFromFD(fd, false, true) ne 0 then CloseIFSFile(fd)
DestroyFD(fd)
]

//---------------------------------------------------------------------------
and FtpSSetProps(ild, remotePL) be
//---------------------------------------------------------------------------
// Copies file properties from remotePL into leader page supplied by caller,
// who is expected to rewrite it afterward.  (Called by Store and Rename.)
[
if remotePL>>PL.TYPE ne 0 then ild>>ILD.type = remotePL>>PL.TYPE
if remotePL>>PL.BYTE ne 0 then ild>>ILD.byteSize = remotePL>>PL.BYTE
if remotePL>>PL.CDAT.h ne 0 then
   MoveBlock(lv ild>>ILD.created, lv remotePL>>PL.CDAT, 2)
if remotePL>>PL.AUTH ne 0 & remotePL>>PL.AUTH>>String.length le maxDirNameChars then
   CopyString(lv ild>>ILD.author, remotePL>>PL.AUTH)
if ild>>ILD.checksum ne 0 then ild>>ILD.checksum = remotePL>>PL.CSUM
]