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