// IfsServSend.bcpl -- Pup Server File Transfer routines // Copyright Xerox Corporation 1979, 1982, 1983 // Last modified January 22, 1983 10:49 AM by Taft get "PupEFTP.decl" get "IfsServEFTP.decl" get "IfsDirs.decl" get "Streams.d" external [ // outgoing procedures PupServSend // incoming procedures OpenEFTPSoc; CloseEFTPSoc; SendEFTPBlock; SendEFTPEnd; DeclarePupSoc IFSOpenFile; Closes; KsBufferAddress; LnPageSize CurrentPos; PositionPtr; CleanupDiskStream Min ] //---------------------------------------------------------------------------- let PupServSend(ftp, bytesToSkip; numargs na) = valof //---------------------------------------------------------------------------- [ let soc = vec lenEFTPSoc OpenEFTPSoc(soc, ftp>>FTP.lclPort, ftp>>FTP.frnPort) DeclarePupSoc(soc) // If timeout1 is small, crank down the initial retransmission timeout soc>>EFTPSoc.currentTimeout = Min(soc>>EFTPSoc.currentTimeout, ftp>>FTP.timeOut1/10) // Permit "*" in filename (lcMultiple) for benefit of HandleBootFileRequest. let bcnt, timeout = nil, nil let stream = IFSOpenFile(ftp>>FTP.realName, 0, 0, 0, lcVHighest+lcMultiple) if stream ne 0 then [ let buffer = KsBufferAddress(stream) let pageBytes = 2 lshift LnPageSize(stream) let ptr = na gr 1? bytesToSkip, 0 [ // repeat PositionPtr(stream, ptr+512, false) // will stop at eof bcnt = CurrentPos(stream)-ptr if bcnt le 0 break bcnt = SendEFTPBlock(soc, buffer+ptr rshift 1, bcnt, (soc>>EFTPSoc.SeqNum eq 0? ftp>>FTP.timeOut1, ftp>>FTP.timeOut2)) if bcnt ls 512 break ptr = ptr+512 if ptr eq pageBytes then [ ptr = 0; CleanupDiskStream(stream) ] // advance to next page ] repeat if bcnt ge 0 then bcnt = SendEFTPEnd(soc, ftp>>FTP.timeOut2)? 0, EFTPTimeout Closes(stream) ] CloseEFTPSoc(soc) DeclarePupSoc(0) resultis stream ne 0 & bcnt eq 0 ]