cftp

test,cm177000,t7770.
user,plato,plato.
attach,opl=opl871.
attach,lgo=ftpbin/m=w,na.
if(.not.file(lgo,as))define,lgo=ftpbin.
compass,l,s=nostext,x.
*lgo.
exit.
~
          ident  cftp,125b,cftp
          title  cftp - cyber file transfer program.
          comment 09.06.09 cyber file transfer program.
          abs

          entry  cftp
          entry  cftpd
          entry  rfl=
          
***       cftp - cyber file transfer program
*
*         p. koning  09.06.09.
*
*         this utility uses the dtcyber exx socket access opcode
*         to run a simple file transfer protocol.  transfer is
*         provided in either direction, binary mode only.
*         full support for cyber file structure is included, so
*         files with multiple records (such as the deadstart file)
*         can be transfered.
*
*         command line
*
*         cftpd,port.
*         cftpd.
*
*         daemon mode.  this listens for incoming connections,
*         processing one at a time until stopped.  files accessed
*         are permanent files under the current username, indirect
*         access by default, direct access if requested by the client.
*         if the port argument is present, that is the decimal
*         port number used; otherwise the default (6021) is used.
*
*         cftp,op,host,lfn,rfn.
*
*         client mode.  this connects to the daemon, performs a single
*         transfer, then exits.
*
*         *op* is *get* to get a file from the remote host,
*         or *put* to send a file to the remote host.  note that
*         in either case the local file name is first, so the
*         syntax is *not* from-to or to-from, as might be more
*         intuitive.
*
*         *host* is the host name (tbd) or *z*.  if *z* is specified,
*         the host name or host address (dotted decimal notation)
*         follows the end of the argument list. *host* can also
*         be a built-in 3 character host alias name, which is the
*         *routing id* from plato.  in that case, the name is
*         translated internally to a host address and port number.
*         for all other cases, the standard port number (6021)
*         is used unless the host argument is given as *host/port*,
*         in which case *port* is a decimal port number.
*
*         *lfn* is the file name at the client end.  this is a local
*         file name.
*
*         *rfn* is the file name at the remote end.  this is a
*         permanent file name under the user name where cftpd runs.
*         by default it is an indirect access name.  if rfn/d is
*         specified, it is a direct access file.  for *get*
*         operations, the file must exist, for *put* it is created
*         if it does not exist, or replaced if it does.  in the
*         case of replacement, the existing file must be of the
*         same type (direct access or indirect access) as the new
*         file.

          base   d
          
          syscom b1

          xtext  comccmd
          xtext  comcmac
          xtext  comsrpv
          
 exx      cpop   0,016b,012b

          org    125b
          
**        socket function codes

 e.sock   equ    1           exx function code for sockets
 s.rset   equ    0           reset socket
 s.close  equ    1           shutdown (graceful close)
*         equ    2           (reserved)
 s.bind   equ    3           bind + listen
 s.acc    equ    4           accept
 s.conn   equ    5           connect
 s.read   equ    6           read data
 s.write  equ    7           write data
 s.rmul   equ    8           reset all (reset list of sockets)

 cftp     title  file transfer client main processing
          
 cftpgo   sa1    rfn         get remote file name
          bx6    x1
          sa6    ctlbuf      set in request word 0
          sa1    put         get *put* flag
          sa2    direct      get *direct access* flag
          sa3    mtu         get negotiated mtu
          bx6    x3
          lx2    -1          position flag
          bx6    x6+x1
          bx6    x6+x2
          sa6    ctlbuf+1    set flags and mtu
          sx6    2
          rj     sendctl     send request
          sx6    4
          rj     readctl     read response
          sa1    ctlbuf      get status word
          nz     x1,cerr1    if error
          sa1    put         check direction
          ng     x1,doput    if *put*
          rj     rcvfil      get the file from the server
          pl     x6,cerr2    if transfer error
          close  fet,rewind,r
          sx6    0
          sa6    ctlbuf
          sx6    4
          rj     sendctl     send final status
          pl     x6,cerr2    if error
          sx2    shut
          rj     netio       then close the socket
          message complete,3,r
          endrun

 doput    rj     sendfil     send file to server
          pl     x6,cerr2    if transfer error
          close  fet,rewind,r
          sx6    4
          rj     readctl     receive final status
          sx2    shut
          rj     netio       then close the socket
          message complete,3,r
          endrun

 cerr1    message ctlbuf+1,,r
 cerr     sx2    rsetall
          rj     netio       release the socket
          abort

 cerr2    message cerrm2,,r
          eq     cerr

 complete dis    ,* complete.*
 cerrm2   dis    ,* file transfer error.*
 cftpd    title  file transfer daemon main loop

 ftpderr  close  fet,return,r
          sx1    reset
          ex1    x1          reset the connection
 ftpdgo   sx6    0
          mx1    0
          sa6    dsock
          rj     psock       wipe planted data socket numbers
 ftpd5    sx2    accept
          ex2    x2          check for an incoming connection
          ng     x2,ftpd6    if connection received
          sx2    x2-2        check for *nodata* status
          nz     x2,derr1    if some other error
          wait   200         wait 200 ms
          eq     ftpd5
          
 ftpd6    sa1    dsock
          rj     psock       plant data socket number
          sx6    netmax
          sa6    ctlbuf
          sx6    2
          rj     sendctl     send server *hello* message
          sx6    2
          rj     readctl     read a control message
          pl     x6,ftpdgo   if error
          sa1    ctlbuf
          sa2    a1+b1
          sx6    b1          *done* bit
          bx6    x6+x1
          bx7    x1          
          sa7    rfn         save file name
          sa6    fet         set file name in fet with *done* set
          sa1    a6+b1
          sx6    x1          *first*
          sa6    a1+b1       *in* = *first*
          sa6    a6+b1       *out* = *in* so fet is empty
          bx7    x2
          sa7    put         *put* flag in sign bit
          lx7    1
          sa7    direct      direct access flag in sign bit
          sx7    x2          extract mtu
          sx2    x7-netmax
          ng     x2,ftpd1    if mtu in range
          sx7    netmax      use our mtu if smaller
 ftpd1    sa7    mtu
          sa1    put         get direction
          ng     x1,putreq   if *put*
          space  4,10
**        *get* request (daemon to client)

          sa1    direct      get file access mode
          ng     x1,getdir   if direct access
          get    fet         get working copy of the file
 ftpd2    sa1    fet
          sx6    x1
          ax6    10
          nz     x6,geterr1  if error on file access
          sa1    mtu
          mx6    0           *ok* status
          bx7    x1          transfer mtu
          sa6    ctlbuf
          sa7    a6+b1
          sx6    4
          rj     sendctl     send *ok* response
          rj     sendfil     send data file
          close  fet,return
          sx6    4
          rj     readctl     receive final status
          sx2    shut
          rj     netio       then close the socket
          sb5    -getdone    message template
          rj     donemsg     issue transfer complete message
          eq     ftpdgo      loop for next request

 getdir   attach fet,,,,r
          eq     ftpd2

 puterr1  bss    0
 puterr2  bss    0
 geterr1  sa6    ctlbuf      set error code
          sx6    4
          rj     sendctl     send error response
          message errbuf,,r
          sx2    shut
          rj     netio       issue socket shutdown
          eq     ftpdgo      loop for next request
          space  4,10
**        *put* request (client to daemon)

 putreq   sa1    direct      get file access mode
          pl     x1,ftpd3    if indirect access
          define fet         first define the file
          sa1    fet
          sx6    x1
          ax6    10
          zr     x6,ftpd3    if ok
          sx1    x6-5        see if file exists
          nz     x1,puterr1  if some other error
          attach fet,,,,w    attach existing file
          sa1    fet
          sx6    x1
          ax6    10
          nz     x6,puterr1  if error on file access
 ftpd3    sa1    mtu
          mx6    0           status is ok
          bx7    x1          reply with transfer mtu
          sa6    ctlbuf
          sa7    a6+b1
          sx6    4
          rj     sendctl     send *ok* response
          rj     rcvfil      receive data file
          pl     x6,ftpderr  if error
          sa1    direct      check mode again
          ng     x1,ftpd4    if direct access
          replace fet        replace any existing file
          sa1    fet
          sx6    x1
          ax6    10
          nz     x6,puterr2  if error on file replace
 ftpd4    close  fet,return
          sx6    0
          sa6    ctlbuf
          sx6    4
          rj     sendctl     send final status
          pl     x6,ftpderr  if error sending status
          sx2    shut
          rj     netio       then close the socket
          sb5    -putdone    message template
          rj     donemsg     issue transfer done message
          eq     ftpdgo      loop for next request

 derr1    message derrm1,,r
          sx2    rsetall
          rj     netio
          abort

 getdone  dis    ,* +++++++ sent to %%%.&&&.<<<.>>>, /////// words.*
 putdone  dis ,* +++++++ received from %%%.&&&.<<<.>>>, /////// words.*
 derrm1   dis    ,* accept error.*
          title  assemble transfer complete message
**        assemble transfer complete message
*
*         (b5) = negative of message fwa
*
*         uses   lots of regs.

 donemsg  subr
          sa1    rfn         get file name
          sb3    msgbuf
          sb2    1r+
          rj     snm         insert file name into message
          sa1    asaddr      get host address
          ax1    24
          rj     cdd
          sb2    b2-b1
          mx1    1
          ax1    b2
          bx1    x4*x1       get number zero filled
          sb5    msgbuf
          sb2    1r%
          rj     snm         insert length
          sa1    asaddr      get host address
          ax1    16
          mx2    -8
          bx1    -x2*x1
          rj     cdd
          sb2    b2-b1
          mx1    1
          ax1    b2
          bx1    x4*x1       get number zero filled
          sb5    msgbuf
          sb2    1r&
          rj     snm         insert length
          sa1    asaddr      get host address
          ax1    8
          mx2    -8
          bx1    -x2*x1
          rj     cdd
          sb2    b2-b1
          mx1    1
          ax1    b2
          bx1    x4*x1       get number zero filled
          sb5    msgbuf
          sb2    1r<
          rj     snm         insert length
          sa1    asaddr      get host address
          mx2    -8
          bx1    -x2*x1
          rj     cdd
          sb2    b2-b1
          mx1    1
          ax1    b2
          bx1    x4*x1       get number zero filled
          sb5    msgbuf
          sb2    1r>
          rj     snm         insert length
          sa1    wc          get word count
          rj     cdd
          sb2    b2-b1
          mx1    1
          ax1    b2
          bx1    x4*x1       get number zero filled
          sb5    msgbuf
          sb2    1r/
          rj     snm         insert length
          message msgbuf,,r  send transfer complete message to dayfile
          eq     donemsgx          
          title  send a file to the other cftpd
**        read local file from *fet* and send it to the other end
*
*         exit   (x6) < 0 if ok
*                (wc) = file word count
* 
*         uses   lots of registers

 sendfil  subr
          sx6    0
          sa6    wc          initialize word count
          sa1    fet
          mx6    42
          bx6    x6*x1
          sa6    sendm1+1    set file name in message
          message sendm1,1,r
          open   fet,read,r
 sendf1   read   fet         start reading
 sendf2   sa1    mtu
          readw  fet,netbuf,x1 transfer an mtu worth
          ng     x1,sendf5   if eof/eoi
          nz     x1,sendf3   if eor
          sa1    mtu
          sx7    0           flag = normal data
          eq     sendf4

 sendf3   sx7    1           flag = eor
          sx1    x1-netbuf   convert lwa+1 to word count
 sendf4   bx6    x1
          sa6    ctlbuf      set word count
          sa7    a6+b1       set flag
          sa2    wc
          ix7    x2+x6       advance word count
          sa7    a2
          sx6    x1+2        total word count = data + header
          rj     sendctl     send that
          pl     x6,sendfilx if error
          sa1    ctlbuf+1
          zr     x1,sendf2   if not eor
          eq     sendf1      start reading another record

 sendf5   sx7    b1
          ix7    x7-x1       flag = 2 for eof, 3 for eio
          sx6    0
          sa6    ctlbuf
          sa7    a6+b1
          sx6    2
          rj     sendctl     send eof/eoi control record
          pl     x6,sendfilx if error
          sa1    ctlbuf+1
          sx1    x1-2        check eof vs. eoi
          zr     x1,sendf1   if eof
          message nullm,1,r  clear line 1
          sx6    -1          ok status
          eq     sendfilx    eoi, all done

 sendm1   dis    ,* sending  xxxxxxx*
 nullm    data   0
          title  receive a file from the other cftpd
**        receive file data from the other end and write it to *fet*
*
*         entry  *fet* is open
*
*         exit   (x6) < 0 if ok
*                (wc) = file word count
*
*         uses   lots of registers

 rcvfil   subr
          sx6    0
          sa6    wc          initialize word count
          sa1    fet
          mx6    42
          bx6    x6*x1
          sx1    1r
          bx6    x6+x1
          lx6    54
          sa6    rcvm1+1    set file name in message
          message rcvm1,1,r
          open   fet,write,r
 rcvf1    sx6    2
          rj     readctl     receive the header
          pl     x6,rcvfilx  if error
          sa1    ctlbuf      get the word count
          zr     x1,rcvf2    if eof/eoi or eor without data
          sx6    netbuf
          sx7    b1
          bx7    x7*x1       low order bit of word count
          ix7    x7+x1       form wc rounded up to even
          sb3    x7
          sb4    netbuf      buffer fwa
          rj     readn       read the specified count of words
          pl     x6,rcvfe1   if error
          sa1    wc
          sa2    ctlbuf      get message word count
          ix7    x1+x2       advance word count
          sa7    a1
          sa1    ctlbuf      get original word count again
          writew fet,netbuf,x1
 rcvf2    sa1    ctlbuf+1
          zr     x1,rcvf1    if not eor/eof/eoi
          sx1    x1-2
          zr     x1,rcvf3    if eof
          pl     x1,rcvf4    if eoi
          writer fet,r
          eq     rcvf1

 rcvf3    writef fet,r
          eq     rcvf1

 rcvf4    message nullm,1,r
          sx6    -1          indicate ok
          eq     rcvfilx
          
 rcvfe1   message rcvfem,,r
          sx6    1           indicate error
          eq     rcvfilx

 rcvm1    dis    ,* receiving xxxxxxx*
 rcvfem   dis    ,* network error receiving file.*
          title  read a control message

**        read control message (2 or 4 words)
*
*         entry  (x6) = word count
*
*         exit   (x6) < 0 if ok
*
*         uses   x1, x2, x6, a6

 readctl  subr
          sb3    x6
          sb4    ctlbuf
          rj     readn       read specified word count
          ng     x6,readctlx if ok
          bx1    x6          copy error code
          rj     cdd         convert to decimal display code
          sb2    b2-b1
          mx6    1
          ax6    b2
          bx6    x4*x6       get number zero filled
          sa6    readerr+2   set in message
          message readerr,,r
          sx2    reset
          ex2    x2          reset the connection
          sx6    1
          eq     readctlx    error exit

 readerr  dis    ,* message read error xxxx*
          title  send a control message

**        send control message possibly with additional data
*
*         entry  (x6) = word count
*                (b1) = 1
*
*         exit   (x6) < 0 if ok
*
*         uses   x1, x2, x6, a6

 sendctl  subr
          sx1    x6+b1
          ax1    1
          bx6    x1
          lx6    4
          ix6    x6-x1       round up wc to even then * 15
          sa6    wbuflen
          sx6    ctlbuf
          sa6    wbuf
          sx2    write
          rj     netio
          ng     x6,sendctlx if ok
          bx1    x6          copy error code
          rj     cdd         convert to decimal display code
          sb2    b2-b1
          mx6    1
          ax6    b2
          bx6    x4*x6       get number zero filled
          sa6    senderr+2   set in message
          message senderr,,r
          sx2    reset
          ex2    x2          reset the connection
          sx6    1
          eq     sendctlx    error exit

 senderr  dis    ,* message send error xxxx*
          title  receive message of exactly n words
**        receive exactly the given word count
*
*         entry  (b3) = word count (must be even)
*                (b4) = buffer fwa
*                (rcvs) = socket number
*
*         exit   (x6) < 0 if ok
*
*         uses   x1, x2, x3, b2, b7

 readn    subr
 readn2   sx6    b4
          sx7    b3
          sa6    rbuf
          sa7    rbuflen
          sx2    read
          rj     netio       receive the data
          pl     x6,readnx   if error
          sa1    rcc         get received byte count
          sx2    15
          ix3    x1/x2       count of word pairs
          lx3    1           get count of words read
          sb2    x3
          sb3    b3-b2       calculate words left to do
          sb4    b4+b2       advance buffer pointer
          mx6    1
          zr     b3,readnx   if request satisfied
          eq     readn2      read more data
          title  plant socket number

**        plant data socket number
*
*         entry  (x1) = socket number
*
*         uses   x6, x6
          
 psock    subr
          sx6    3
          lx6    54          binary mode flag, no partial words
          bx6    x1+x6
          sa6    rcvs        plant data socket number
          sa6    ws
          sa6    ss
          sa6    rss
          sa6    socks+1
          eq     psockx
 common   title  routines and data common to client and daemon

          space  4,10
**        do a network operation, wait for it
*
*         entry  (x2) = address of socket request block.
*
*         exit   (x6) = socket request status. -1 is ok.
*
*         uses   x1, x6.
* 
*         this routine retries the socket operation so long as
*         it returns status code 2 (*eagain*), i.e., no data
*         or not ready yet, up to a limit of 1000 recalls which
*         is about 25 seconds.

 nettmo   message tmoerr,,r
          sx6    2           set no data error code to indicate timeout
 neterr   sa6    netstat     save return value
 netio    subr
          sx6    1000
          sa6    recalls     initialize count of tries
 netio1   ex6    x2          do it
          ng     x6,netiox   if ok
          sx1    x6-2        check for *eagain* status code
          nz     x1,neterr   if interesting error
          sa1    recalls
          sx6    x1-1        count down retries
          ng     x6,nettmo   if timeout
          sa6    a1
          recall             wait a bit
          eq     netio1      try again

 netstat  data   0
 recalls  data   0
 tmoerr   dis    ,* network timeout.*
          title  reprieve handler

 doexit   sx1    rsetall
          ex1    x1          reset all sockets
          reprieve rpvdata,reset,0  continue error processing
          
          space  4,10
** common decks
          
          xtext  comccdd
          xtext  comccio
          xtext  comcpfm
          xtext  comcrdw
          xtext  comcsys
          xtext  comcwtw
          xtext  comspfm
          xtext  comcsnm
          
** note - netmax must be less than dtcyber socket ring buffer
*  size divided by 7.5.
          
 netmax   equ    400         max network word count
 ciolth   equ    1001b       fet buffer size
 defport  equ    6021
          
 direct   data   0           direct access flag in sign bit
 put      data   0           operation is *put* in sign bit
 host     data   0           host address
 portnum  con    defport     port number
 lsock    data   0           listen socket (for daemon)
 sock     data   0           data socket
 lfn      data   0           local side file name
 rfn      data   0           remote side file name
 mtu      con    netmax      max chunk size (netmax, unless reduced by the other end)
 wc       data   0           count of words transfered in daemon mode
                    
 reset    vfd    42/0,6/s.rset,12/e.sock
 rss      data   0

 shut     vfd    42/0,6/s.close,12/e.sock
 ss       data   0

 accept   vfd    42/0,6/s.acc,12/e.sock
 as       data   0
 dsock    data   0           returned data socket number
 asaddr   data   0           returned remote host address

 read     vfd    42/0,6/s.read,12/e.sock
 rcvs     vfd    6/3         binary mode, full words
 rbuf     data   0
 rbuflen  data   0
 rcc      data   0

 write    vfd    42/0,6/s.write,12/e.sock
 ws       vfd    6/3         binary mode, full words
 wbuf     data   0
 wbuflen  data   0
          
 rsetall  vfd    42/0,6/s.rmul,12/e.sock
          data   0
          con    socks
          data   2

 socks    bss    2           list of sockets for *reset all*

 fet      fileb  ciobuff,ciolth,epr,fet=14

 rpvdata  rpvblk doexit

**        buffers only beyond this point, which overlay
*         the initialization code.
          
 ciobuff  bss    ciolth
 ctlbuf   bss    4           buffer for cftp control records (2 or 4 words long)
          bss    netmax      space for max length data
          bss    5           extra space for the readw/writew overrun area
 netbuf   equ    ctlbuf+2    file data starts here
 msgbuf   equ    ctlbuf+2    also used for dayfile message assembly
 errbuf   equ    ctlbuf+1    message area for *pfm* errors
          title  client initialization

          org    ciobuff     this code is overlaid by i/o buffers

 cftp     sb1    1
          sa1    actr        get arg count
          sb3    x1-4        minimum is 4
          ng     b3,err5     if not enough
          mx0    42          mask for keyword
          sa1    argr        get operation name
          sb2    x1-1        check for comma separator
          nz     b2,err9     if not comma
          bx1    x0*x1       isolate it
          sa2    =3lget
          bx6    x2-x1
          zr     x6,cftp1    if *get*
          sa2    =3lput
          bx6    x2-x1
          nz     x6,err6     if not *put*
          mx6    1           minus means put
 cftp1    sa6    put         set operation flag
          sa1    a1+b1
          bx3    x0*x1       isolate hostname
          sa2    =1lz
          bx2    x2-x3       check for *z*
          nz     x2,cftp6    if not *z*
          sb2    x1-1        see if comma separator
          zr     b2,cftp7    if comma
          sb2    x1-3        otherwise must be */*
          nz     b2,cftp7    if not slash
          sa5    a1+b1       get port number
          sb2    x5-1        check for comma separator
          nz     b2,err9     if not comma
          sb7    b1          indicate decimal conversion
          rj     dxb         convert port number
          nz     x4,err9     if error in number
          sa6    portnum     save chosen port number
          sa1    argr+2      restore argument pointer
          mx0    42          restore mask for keyword
 cftp7    mx6    1           flag for *z* host name
          sa6    host
          eq     cftp8
          
** process host name other than *z*, which means looking for
*  the name in a table of local short names.
          
 cftp6    sb2    x1-1        check for comma separator
          nz     b2,err9     if not comma
          sa2    htab        start local host table scan
 cftp2    zr     x2,err7     if end of table
          bx2    x2-x3
          zr     x2,cftp3    if matching entry
          sa2    a2+2        advance scan
          eq     cftp2

 cftp3    sa2    a2+1
          mx1    -32
          bx6    -x1*x2      isolate ip address
          sa6    host
          mx1    16
          bx6    x1*x2       isolate port number
          lx6    16          position it
          sa6    portnum
 cftp8    sa1    a1+b1       get local file name
          sb2    x1-1        check for comma separator
          nz     b2,err9     if not comma
          bx6    x0*x1
          sa6    lfn         save it
          sx7    b1
          bx7    x6+x7       set *ready* bit
          sa7    fet         set in fet
          sa1    a1+b1       get remote file name
          bx6    x0*x1
          sa6    rfn
          sb2    x1-17b
          zr     b2,cftp5    if end of command
          sb2    x1-3
          nz     b2,err9     if not */*
          sa1    a1+b1       get direct flag
          sa2    dend        must be *d* and end of command
          bx1    x1-x2
          nz     x1,err9     if not *d* or not last argument
          mx6    1
          sa6    direct      set direct access flag
 cftp5    sa1    host        check host argument
          pl     x1,cftp9    if not *z*
          sb2    ccdr        command image
          rj     usb         unpack command to *usbb*
          mx6    0
          sa6    b7+b1       make sure there is an eol
          sa1    usbb        start scan
 cftp10   sa1    a1+b1       load next char
          zr     x1,err9     error if eol
          sx2    x1-1r.
          zr     x2,cftp11   if end of command
          sx2    x1-1r)
          nz     x2,cftp10   if not end of command
 cftp11   sx7    0           clear host address assembly
          sb2    3           count of fields left - 1
          sx3    10          radix
 cftp12   sx6    0           clear number assembly
 cftp16   sa1    a1+b1       load host address character
          zr     x1,cftp13   if end of line
          sx2    x1-1r
          zr     x2,cftp12   if blank, ignore
          sx2    x1-1r.      check for number terminator
          zr     x2,cftp14   if end of field
          sx2    x1-1r0      check for digit
          ng     x2,err9     if not digit
          sx1    x1-1r9-1    check for digit
          pl     x1,err9     if not digit
          ix6    x6*x3
          ix6    x6+x2       accumulate digits
          eq     cftp16

 cftp13   nz     b2,err9     if eol before field 4
 cftp14   lx7    8           shift previous address fields
          bx7    x7+x6
          zr     x1,cftp15   if end of line
          sb2    b2-b1       count fields
          pl     b2,cftp12   if more fields to do
          eq     err9

 cftp15   sa7    host
 cftp9    reprieve rpvdata,setup,277b  catch everything except endrun
          sa2    host
          sa3    portnum
          bx6    x2
          bx7    x3
          sa6    caddr       set host address
          sa7    cport       set port number
          sx2    conn
          rj     netio       connect to the server
          pl     x6,err8     if connect failure
          sa1    cs          get resulting socket number
          rj     psock       set all other sockets
          sx6    2
          rj     readctl     get server hello message
          pl     x6,err8     error at this point is connect failure
          sa1    ctlbuf      get mtu
          ax6    x1,b1
          lx6    1           force it to be even
          sx1    x6-netmax   compare with ours
          ng     x1,cftp4    if ours is larger
          sx6    netmax      use our mtu if smaller
 cftp4    sa6    mtu         set connection mtu
          eq     cftpgo      go to mainline
          title  daemon initialization
          
 cftpd    sb1    1
          sa1    actr        get arg count
          sx1    x1
          sx6    defport     default port number
          zr     x1,cftpd1   if no arguments
          sx1    x1-1        check arg count
          nz     x1,err1     if too many arguments
          sa5    argr        get argument
          sb7    1
          rj     dxb         convert decimal number
          nz     x4,err2     if error in number string
 cftpd1   sa6    portnum     remember port number
          sa6    bport       set as listen port number
          reprieve rpvdata,setup,277b  catch everything except endrun
          sx2    bind
          rj     netio       bind and listen
          pl     x6,err4     if error
          sa1    bs          get resulting socket number
          bx6    x1
          sa6    as
          sa6    socks
          sx6    errbuf
          sa6    fet+cfpw    set error message pointer for *pfm* calls
          eq     ftpdgo      enter daemon main loop

 err1     message errm1,,r
          abort

 err2     message errm2,,r
          abort

 err3     message errm3,,r
          abort

 err4     sx2    rsetall
          rj     netio       release listen socket
          message errm4,,r
          abort

 err5     message errm5,,r
          abort

 err6     message errm6,,r
          abort

 err7     message errm7,,r
          abort

 err8     sx2    rsetall
          rj     netio       release socket
          message errm8,,r
          abort

 err9     message errm9,,r
          abort
          
 errm1    dis    ,* too many arguments.*
 errm2    dis    ,* invalid argument.*
 errm3    dis    ,* error requesting socket.*
 errm4    dis    ,* error in bind.*
 errm5    dis    ,* insufficient arguments.*
 errm6    dis    ,* invalid operation keyword.*
 errm7    dis    ,* unrecognized hostname.*
 errm8    dis    ,* error connecting to server.*
 errm9    dis    ,* argument error.*

 dend     con    1ld+17b
          
**        initialization time socket request blocks

 bind     vfd    42/0,6/s.bind,12/e.sock
 bs       data   0
          data   0           any ip address
 bport    bss    1
          data   16          backlog
          
 conn     vfd    42/0,6/s.conn,12/e.sock
 cs       data   0
 caddr    data   0
 cport    data   0
          
 host     macro  hname,i1,i2,i3,i4,p
          vfd    60/0l_hname,16/p,12/0,8/i1,8/i2,8/i3,8/i4
 host     endm

 htab     host   lcl,127,0,0,1,6021     localhost
          host   gpk,127,0,0,1,11851    pkoning, via tunnel
          host   pk2,127,0,0,1,26151    koning2, via tunnel	
          host   cyt,127,0,0,1,5831     monster, via tunnel
          host   brt,127,0,0,1,3939     boris, via tunnel
          host   faa,127,0,0,1,9641     dtfaa, via tunnel
          host   cy1,192,168,2,13,6021  monster, on its local subnet
          host   brs,192,168,2,17,6021  boris, on its local subnet
          data   0
                            
          xtext  comcdxb
          xtext  comcusb

 rfl=     end    cftp