//******************************************************************************
//*                                                                            *
//*    CALL-CAPCS            Call the GIVEFILE-CAPCS service directly.  This   *
//*                          a specialised form of the "TAKEFILE" utility      *
//*                          originally written by Brian Knight.               *
//*                                                                            *
//******************************************************************************
//*    I. D. Wilson          Last Modified   -   IDW   -   23/04/82            *
//******************************************************************************



// ******    N.B.   This program must be CALLSEG'ed



/***********************************************************************
*                                                                      *
*               GIVEFILE/TAKEFILE File Transfer Protocol               *
*               ----------------------------------------               *
*                                                                      *
*    The GIVEFILE and TAKEFILE commands and their corresponding        *
* services transfer files by superimposing a simple record structure   *
* on a byte stream pair.  The protocol is based on FTP-B as described  *
* in "A Network Independent File Transfer Protocol" prepared by the    *
* High Level Protocol Group.                                           *
*                                                                      *
*    The contents of the file are sent in records, each of which       *
* contains one or more sub-records.  Each sub-record is preceded by a  *
* header byte with the following format:                               *
*                                                                      *
*  Bit  10000000: If set, then this sub-record is the last in the      *
*                 current record.                                      *
*                                                                      *
*  Bit  01000000: If set, then this sub-record is a compressed sequence*
*                 (see below)                                          *
*                                                                      *
*  Bits 00111111: A binary count (0 - 63)                              *
*                                                                      *
*    If the compression bit (01000000) is zero, then the sub-record    *
* consists of the next COUNT bytes after the header.  If this bit is   *
* one, then the sub-record consists of the single byte following the   *
* header inserted COUNT times.                                         *
*                                                                      *
*    A header byte of zero is used to introduce control sequences in   *
* the data stream, so a null record must be represented as the header  *
* byte 10000000.                                                       *
*                                                                      *
*    Only two character codes are used for transferring data:          *
* IA5 with any parity, and binary.  The initial default is IA5.        *
* Binary is selected by the three-byte control sequence                *
* #X00 #X42 #X01, and IA5 by the sequence #X00 #X42 #X00. The code     *
* should not be changed between sub-records of a multi-part record.    *
*                                                                      *
*    When IA5 is selected, each record corresponds to a text line,     *
* and the first character of each record is an ANSI control character  *
* (' ', '+', '0', '-' or '1').  No other character within a record     *
* has any formatting significance.                                     *
*                                                                      *
*    When binary code is in use, the record boundaries have no         *
* significance, and the data is regarded as a stream of bytes.         *
*                                                                      *
*    The maximum record length (before compression or division into    *
* sub-records) is 252 bytes.                                           *
*                                                                      *
*    The first record sent from the command to the service is          *
* interpreted as an IA5 string (without a control character), and      *
* is used as the stream name of the 'file' to be transferred.          *
* For TRIPOS, this string is used as the argument to FINDINPUT         *
* or FINDOUTPUT.                                                       *
*                                                                      *
*    At the end of the file, the control sequence #X00 #X43 #X00       *
* should be sent, and transmission forced.                             *
*                                                                      *
*    At some time during (if an error occurs) or immediately after     *
* the transfer, the service end should send the command end a single   *
* record and force transmission.  A null record sent after the         *
* transfer indicates success; otherwise, the record should be an       *
* error message sent as an IA5 string, which the command end can       *
* display.                                                             *
*                                                                      *
***********************************************************************/


SECTION "CALL-CAPCS"


GET "LIBHDR"
GET "IOHDR"
GET "RINGHDR"
GET "BCPL.BSPLIB"


MANIFEST
    $(
    eor          = #X80  // End of record marker
    comp.flag    = #X40  // Compressed subrecord
    lenmask      = #X3F  // bytes in subrecord
    max.rec.bytes = 256  // Longest record
    $)

GLOBAL
    $(
    eof        : ug
    binary     : ug + 1
    bs.closed  : ug + 2
    $)


LET start( filename, as.name ) BE
    $(
    LET mc.name = "CAP"
    LET service.name = "BSP:GIVEFILE-CAPCS"
    LET first.line = TRUE
    LET outstr, bsp.outstr, bsp.instr = 0, 0, 0
    LET constr = output()

    eof    := FALSE
    binary := FALSE // Default code is IA5
    bs.closed := FALSE
    outstr := findoutput(as.name)
    IF outstr=0
    THEN $( writef("Can't open %s for output*n", as.name); RETURN $)
    selectoutput(outstr)

    bsp.instr := findinput( service.name )
    IF bsp.instr = 0
    THEN
      $(
      LET res2  =  result2

      endwrite() // Close local output file
      selectoutput(constr)
      writef("Can't open %s for input:  ", service.name )
      fault( res2 )
      RETURN
      $)

    bsp.outstr := result2
    selectinput(bsp.instr)
    selectoutput(bsp.outstr)

    // Away we go
    // Send the filename - special record with no cc
    wrch(eor | filename%0)
    writes(filename)
    bsp.forceout()

    // Start writing the file
    selectoutput(outstr)

    $(  // loop
    LET recbuff = VEC max.rec.bytes/bytesperword
    LET l = readrec(recbuff, max.rec.bytes)
    IF eof THEN BREAK

    TEST binary
    THEN FOR i=0 TO l-1 DO wrch(recbuff%i)
    ELSE
      $(
      LET cc    = recbuff%0

      TEST first.line
      THEN
        $( // Have to mess about to get cc right on first record
        IF cc='1' THEN wrch('*p')
        IF cc='0' THEN wrch('*n')
        IF cc='-' THEN writes("*n*n")
        // Ignore others to avoid spurious blank line
        first.line := FALSE
        $)
      ELSE SWITCHON cc
           INTO
             $(
             CASE '+': wrch('*c'); ENDCASE
             CASE ' ': wrch('*n'); ENDCASE
             CASE '0': writes("*n*n"); ENDCASE
             CASE '-': writes("*n*n*n"); ENDCASE
             CASE '1': wrch('*p'); ENDCASE
             DEFAULT:  wrch('*n')
             $)

      // Write rest of record
      FOR i = 1 TO l-1 DO wrch(recbuff%i)
      $)

    IF testflags(1)
    THEN
      $( endwrite()  // Close file being received
         selectoutput(constr); writes("****** BREAK*n")
         GOTO exit
      $)
    $) REPEAT


    // End of file
    IF (NOT binary) & (NOT first.line) THEN newline() // Terminate last record

    // Wait for message
    // Null string -> success, error message
    endwrite() // Close file being received
    selectinput(bsp.instr)
    selectoutput(constr)

    $(
    LET c       = rdch()

    TEST c=endstreamch
    THEN writes("Byte stream failure*n")
    ELSE
      $(
      LET n = c & #X3F

      IF n \= 0
      THEN writef("Error at %s - ", mc.name)

      // Read on for error message or just to give 'close request'
      // a chance.
      $( LET c = rdch()
         UNTIL c = endstreamch
         DO $( wrch(c); c := rdch() $)
      $)
      IF n \= 0 THEN newline()
      $)
    $)
exit:
    endread()  // close byte streams
    $)



AND readrec(buff, max.bytes) = VALOF
    $(
    // Reads a record into the buffer, removing any sub-records
    // and comp.flag sequences, and returns its length in bytes.
    // -1 is returned if the record is too long.
    // If the control sequence for 'end of file' is encountered,
    // then the flag eof is set.
    // If endstreamch is read, then flags eof and bs.closed are set.
    LET last.sr = FALSE
    LET pos = -1

      $( // Main loop
      LET ch = rdch()
      IF ch=endstreamch
      THEN $( eof := TRUE; bs.closed := TRUE; RESULTIS -1 $)

      TEST ch = #X00
      THEN
        $( // This is a control sequence
        LET c1, c2      = rdch(), rdch()

        SWITCHON c1
        INTO
          $(
          CASE #X42: binary := c2=#X01; ENDCASE // Code selection
          CASE #X43: IF c2=#X00 THEN eof := TRUE; BREAK // End of file
          $)

        LOOP
        $)
      ELSE
        $( // A sub record
        LET n = ch & lenmask
        last.sr := (ch & eor) \= 0

        TEST (ch & comp.flag) \= 0
        THEN
          $( // Repeat next byte n times
          ch := rdch()
          FOR i=1 TO n
          DO $(
             pos := pos + 1
             IF pos = max.bytes THEN $( eof := TRUE; RESULTIS -1 $)
             buff%pos := ch
             $)
          $)
        ELSE
          $( // Read next n bytes
          FOR i=1 TO n
          DO $(
             pos := pos + 1
             IF pos = max.bytes THEN $( eof := TRUE; RESULTIS -1 $)
             buff%pos := rdch()
             $)
          $)
        $)
      $) REPEATUNTIL last.sr

    RESULTIS pos+1
    $)



