// IfsServReceive.bcpl -- Pup Server File Transfer routines // Copyright Xerox Corporation 1979, 1982 // Last modified October 28, 1982 10:17 AM by Taft get "PupEFTP.decl" get "IfsServEFTP.decl" get "IfsDirs.decl" get "Streams.d" external [ // outgoing procedures PupServReceive // incoming procedures OpenEFTPSoc; CloseEFTPSoc; ReceiveEFTPPacket; DeclarePupSoc; ReleasePBI IFSOpenFile; IFSDeleteFile; IFSRenameFile; IFSDeleteOldVersions Closes; KsBufferAddress; LnPageSize CurrentPos; PositionPtr; CleanupDiskStream; SetDirty SetTimer; TimerHasExpired; Min; ByteBlt ] //---------------------------------------------------------------------------- let PupServReceive(ftp) = valof //---------------------------------------------------------------------------- [ let soc = vec lenEFTPSoc OpenEFTPSoc(soc, ftp>>FTP.lclPort, ftp>>FTP.frnPort) DeclarePupSoc(soc) let pcnt = nil let stream = IFSOpenFile(ftp>>FTP.tempName, 0, modeWrite, charItem) if stream ne 0 then [ let buffer = KsBufferAddress(stream) let pageBytes = 2 lshift LnPageSize(stream) let bptr = 0 let pbi = 0 // wait for first packet of transfer let timer = nil; SetTimer(lv timer, 6000) // 1 minute [ (ftp>>FTP.proc1)(soc) pcnt = ReceiveEFTPPacket(soc, ftp>>FTP.timeOut1, lv pbi) ] repeatuntil pbi ne 0 % TimerHasExpired(lv timer) // PupServReceive (cont'd) // pbi ne 0 means a data packet was received. This happens only if pcnt ge 0. // Note that pcnt eq 0 can mean either of two things: pbi eq 0 means end-of-file, // while pbi ne 0 means a zero-length data packet was received. if pbi ne 0 then [ [ // repeat let pptr = 0 while pptr ls pcnt do [ let c = Min(pcnt-pptr, pageBytes-bptr) ByteBlt(buffer, bptr, lv pbi>>PBI.pup.bytes, pptr, c) bptr = bptr+c pptr = pptr+c PositionPtr(stream, bptr) SetDirty(stream, true) if bptr eq pageBytes then [ bptr = 0; CleanupDiskStream(stream) ] // write page and advance ] ReleasePBI(pbi) pbi = 0 pcnt = ReceiveEFTPPacket(soc, ftp>>FTP.timeOut2, lv pbi) repeatwhile pcnt eq EFTPNotFirstSynch ] repeatwhile pbi ne 0 if pcnt eq 0 then unless (ftp>>FTP.proc2)(stream) do pcnt = -1 ] Closes(stream) test pcnt eq 0 ifso [ // make new version of real file and then delete old versions unless IFSRenameFile(ftp>>FTP.tempName, ftp>>FTP.realName) do pcnt = -1 IFSDeleteOldVersions(ftp>>FTP.realName) ] ifnot IFSDeleteFile(ftp>>FTP.tempName) ] CloseEFTPSoc(soc) DeclarePupSoc(0) resultis pcnt eq 0 & stream ne 0 ]