// 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 ]