// FtpServProtFile.bcpl - FTP server commands // Copyright Xerox Corporation 1979, 1980, 1981, 1982 // Last modified May 8, 1982 8:41 PM by Boggs get "FtpProt.decl" external [ // outgoing procedures ServRetrieve; ServStore ServDelete; ServDirectory; ServRename // incoming procedures GetCommand; FTPM; ServProtocolError FreePList; ScanPList; GeneratePList // incoming statics CtxRunning ] //----------------------------------------------------------------------------------------- let ServRetrieve() be //----------------------------------------------------------------------------------------- //if FtpCtx.Retrieve returns false then // it will never again be called //if FtpCtx.Retrieve returns true then // FtpCtx.RetrieveFile MAY OR MAY NOT be called // but FtpCtx.RetrieveCleanup will ALWAYS be called [ let remotePL = ScanPList(); if remotePL eq 0 return let localPL = 0 [ localPL = (CtxRunning>>FtpCtx.Retrieve)(remotePL, localPL) if localPL eq 0 break FTPM(markHereIsPList) GeneratePList(localPL) let ok = false switchon GetCommand()<>FtpCtx.RetrieveFile)(localPL, remotePL) then [ FTPM(markYes, 0, "Transfer complete") ok = true ] break ] default: ServProtocolError() //falls through case markNo: case 0: break ] repeat (CtxRunning>>FtpCtx.RetrieveCleanup)(localPL, ok, remotePL) ] repeat FreePList(remotePL) ] //----------------------------------------------------------------------------------------- and ServStore(new) be //----------------------------------------------------------------------------------------- // This handles both the old and new store commands. [ let remotePL = ScanPList(); if remotePL eq 0 return let localPL = (CtxRunning>>FtpCtx.Store)(remotePL) if localPL ne 0 then [ test new //if new, then localPL is really a pList ifso [ FTPM(markHereIsPList) GeneratePList(localPL) ] ifnot FTPM(markYes, 0, "File open, ready for data") let ok = true switchon GetCommand()<>FtpCtx.StoreFile)(remotePL, localPL) switchon GetCommand()<>FtpCtx.StoreCleanup)(remotePL, ok, localPL) ] FreePList(remotePL) ] //----------------------------------------------------------------------------------------- and ServDelete() be //----------------------------------------------------------------------------------------- // If FtpCtx.Delete returns false then // it will never again be called // If FtpCtx.Delete returns true then // FtpCtx.DeleteFile MAY OR MAY NOT be called [ let remotePL = ScanPList(); if remotePL eq 0 return let localPL = 0 [ localPL = (CtxRunning>>FtpCtx.Delete)(remotePL, localPL) if localPL eq 0 break FTPM(markHereIsPList) GeneratePList(localPL) switchon GetCommand()<>FtpCtx.DeleteFile)(localPL, remotePL) then FTPM(markYes, 0, "File Deleted") break ] default: ServProtocolError() //falls through case markNo: case 0: break ] repeat ] repeat FreePList(remotePL) ] //----------------------------------------------------------------------------------------- and ServDirectory(new) be //----------------------------------------------------------------------------------------- // If FtpCtx.Directory ever returns false then // it will never be called again [ let remotePL = ScanPList(); if remotePL eq 0 return let localPL = 0 let firstTime = true [ localPL = (CtxRunning>>FtpCtx.Directory)(remotePL, localPL) if localPL eq 0 break if firstTime % not new then FTPM(markHereIsPList) GeneratePList(localPL) firstTime = false ] repeat FreePList(remotePL) ] //----------------------------------------------------------------------------------------- and ServRename() be //----------------------------------------------------------------------------------------- [ let oldPL = ScanPList(); if oldPL eq 0 return let newPL = ScanPList(); if newPL ne 0 then if (CtxRunning>>FtpCtx.Rename)(oldPL, newPL) then FTPM(markYes, 0, "Renamed ok") FreePList(newPL) FreePList(oldPL) ]