section "Cms-start"
get "libhdr"
get "etherhdr"
get "ftphdr"

//
LET START() BE $(
   let vv = getvec(130 +    // memory
                   81  +    // cv
                   282 +    // buffer 1
                   282 +    // buffer 2
                     5      // password
                  )

   LET RES,X,Y=0,0,0
   LET GETREP=0
   let rti = rootnode!rtn.info
   etsk := rti!rtninfo.ether

   v := vv
   If v=0 DO
   $( writes("*nNot enough store.*n")
      stop(5)
   $)

   if rti=0 | etsk=0 do
   $( err("*NLoad ether handler please.*n")
      stop(7)
   $)

   v1 := v + 282
   memory := v1 + 282
   cv := memory + 131
   password := cv + 81

   BLKSIZE:=127
   HANKY:=FALSE
   ENDING:=FALSE
   GOODEND:=FALSE
   if rdargs("PUT/S,PRINT/S,VMID/A,FN/A,FT/A,CHECK/S,BINARY/S,FILE,*
              *DISK/K,PASS/K", cv, 80)=0 DO
   $( err("*Nerror in arguments*N")
      stop(10)
   $)

   dir := cv!0 -> 2, 1
   if cv!1 do dir := 3     // print option
   binary := cv!6     // BINARY TRANSFERS NOT YET SUPPORTED
   vmid := cv!2
   fn := cv!3
   ft := cv!4
   check := cv!5

   if cv!7=0 do cv!7 := dir=1 -> "**", ":T.FTP-DEF"  // probably stops!
   test dir=1 DO stream := findoutput(cv!7)
              OR stream := findinput(cv!7)

   if stream=0 do
   $( err("*NError in finding file*n")
      stop(20)
   $)

   test cv!8=0 do disk := "191"
               or disk := cv!8
   test cv!9=0 do concatenate("R",vmid,password)
               or password := cv!9

   CHECKSUM:=0
   hp := sendpkt(-1, etsk, act.findfreeport, ?, ?, ?)
   IF hp=0 DO
   $( err("*NNo ports available*N")
      stop(71)
   $)

   main()
$)

.
section "Cms1"

get "libhdr"
get "etherhdr"
get "ftphdr"

let main() be
$(
   let res = 0
   let x, y = 0, 0
   CLOSE(2)
   RES:=OPEN(V,DIR,VMID,FN,FT,DISK,PASSWORD)
   UNLESS RES=0 DO $( err("ERROR %N IN OPENING CMS FILE*N",RES)
                      closestream()
                      stop(res)
                  $)
   TEST DIR=1 THEN $(X
   $(A
    RES:=GETIT(V,2000)
   IF CHECK THEN $(
    FOR I=0 TO 21 DO $(
        NEWLINE()
        FOR J=0 TO 9 DO WRITEF(" %X2",GETBYTE(V,I*10+J))
    $)
   $)
    if testflags(1) do res := 1   // will cause break
    UNLESS RES=0 DO BREAK
   P1:=DATAOFFSET+2 ; LEN:=0 ; LEN2:=0
   $(
      LEN2:=(GETBYTE(V,P1)<<8)+GETBYTE(V,P1+1)

      IF CHECK THEN WRITEF(" LENGTH IN SUBFIELD WAS %N*N",LEN2)
      IF LEN2=#XFFFF BREAK
      SUMCHECK(V,P1+2,LEN2)
      UNLESS BINARY DO ASCII(V+V+P1+2,LEN2)
      WBLOCK(V,P1+2,LEN2)
      P1:=P1+LEN2+2
      IF CHECK THEN WRITEF("POINTER WAS %N*N",P1)
   $) REPEAT
   $)A REPEAT
   //
   X:=RES=2->1,2
   RES:=CLOSE(X)
   RETCODE:=RES
   IF CHECK THEN WRITEF("CLOSING WITH %N REPLY WAS %N*N",X,RES)
   closestream()
   RETCODE:=RES
   freevec(v)
   UNLESS res=0 DO writes("*nTransfer failed.*n")
   stop(res)
   $)X ELSE $(X
   $(B
   LEN:=0;LEN2:=0;P1:=DATAOFFSET+1
   PUTBYTE(V,P1,#XFF); PUTBYTE(V,P1+1,#XFF)
   $(
      IF ENDING&(\HANKY) GOTO ENDPUT
      RESTORE(V)
      IF ENDING BREAK
      RES:=RBLOCK(V,P1+2,@LEN2)
       IF CHECK THEN WRITEF(" RBLCOCK LEN2 = %N , RES=%X4*N",LEN2,RES)
      UNLESS RES=0 DO $(  ENDING:=TRUE;GOODEND:=RES=#X8000;BREAK
                      $)
      LEN:=LEN+LEN2
      UNLESS BINARY DO EBCDIC(V+V+P1+2,LEN2)
      SUMCHECK(V,P1+2,LEN2)
      PUTBYTE(V,P1,LEN2>>8)
      PUTBYTE(V,P1+1,LEN2)
      P1:=P1+LEN2+2
      if p1>bufmax then $( remember(v); break $)
//      IF (P1+60)>BUFMAX THEN BREAK
   $) REPEAT
   PUTBYTE(V,P1,#XFF);PUTBYTE(V,P1+1,#XFF)
   IF CHECK THEN $(
      WRITEF(" PUT LENGTH WAS %N*N",P1-DATAOFFSET+1)
      FOR I =0 TO (P1-DATAOFFSET+1)/10 DO $(
           NEWLINE()
         FOR J=0 TO 9 DO WRITEF(" %X2",GETBYTE(V,DATAOFFSET+I*10+J))
      $)
      NEWLINE()
   $)
   LEN:=P1-DATAOFFSET+1
   IF LEN=2 LOOP   //DONT BOTHER TO SEND DUMMYS
   RES:=PUT(V,LEN)
   if testflags(1) do res := 1   // causes break
   UNLESS RES=0 BREAK
   $)B REPEAT
ENDPUT:
   IF CHECK THEN WRITEF(" REASON FOR ENDING WAS %X4*N",RES)
   X:=GOODEND->1,2
   GOODEND:=FALSE
   RES:=CLOSE(X)
   IF CHECK THEN WRITEF("CLOSING WITH %N REPLY WAS %N*N",X,RES)
   closestream()
   RETCODE:=RES
   ENDING:=FALSE
   freevec(v)
   UNLESS retcode=0 DO writes("*nTransfer failed.*n")
   stop(retcode)
   $)X
$)
//
//
.
section "Cms2"

get "libhdr"
get "etherhdr"
get "ftphdr"

let REMEMBER(V) BE $(
   HANKY:=TRUE
   P1:=P1-LEN2-2
   IF CHECK THEN WRITEF("LEN2 IN REMEBER WAS %N*N",LEN2)
   FOR I=0 TO  LEN2-1 DO PUTBYTE(MEMORY,I+2,GETBYTE(V,P1+2+I))
   PUTBYTE(MEMORY,0,LEN2>>8)
   PUTBYTE(MEMORY,1,LEN2)
$)
//
AND RESTORE(V) BE $(
   UNLESS HANKY RETURN
   HANKY:=FALSE
   LEN2:=(GETBYTE(MEMORY,0)<<8)+GETBYTE(MEMORY,1)
   IF CHECK THEN WRITEF("LEN2 IN RESTORE WAS %N*N",LEN2)
   FOR I=0 TO LEN2-1 DO
      PUTBYTE(V,I+2+P1,GETBYTE(MEMORY,I+2))
   PUTBYTE(V,P1,GETBYTE(MEMORY,0))
   PUTBYTE(V,P1+1,GETBYTE(MEMORY,1))
   P1:=P1+LEN2+2
$)
//
AND ms(v,n,s) be $(
   for i = 1 to n do putbyte(s,i,getbyte(v,i-1))
   PUTBYTE(S,0,N)
$)
//
AND ASCII(V,N) BE $(
   for i = 0 to n-1 do 0%(v+i) := asciit(0%(v+i))
$)
AND EBCDIC(V,N) BE $(
   for i = 0 to n-1 do 0%(v+i) := ebcdict(0%(v+i))
$)
and asciit(c) = c=21 -> #XA,
  c!table
   /* EBCDIC 00-07 */  #000, #001, #002, #003,    0, #011,    0, #177,
   /* EBCDIC 08-0F */     0,    0,    0, #013, #014, #015, #016, #017,
   /* EBCDIC 10-17 */  #020, #021, #022, #023,    0,    0, #010,    0,
   /* EBCDIC 18-1F */  #030, #031,    0,    0, #034, #035, #036, #037,
   /* EBCDIC 20-27 */     0,    0,    0,    0,    0, #012, #027, #033,
   /* EBCDIC 28-2F */     0,    0,    0,    0,    0, #005, #006, #007,
   /* EBCDIC 30-37 */     0,    0, #026,    0,    0,    0,    0, #004,
   /* EBCDIC 38-3F */     0,    0,    0,    0, #024, #025,    0, #032,
   /* EBCDIC 40-47 */  #040,    0,    0,    0,    0,    0,    0,    0,
   /* EBCDIC 48-4F */     0,    0,    0, #056, #074, #050, #053, #174,
   /* EBCDIC 50-57 */  #046,    0,    0,    0,    0,    0,    0,    0,
   /* EBCDIC 58-5F */     0,    0, #041, #044, #052, #051, #073, #176,
   /* EBCDIC 60-67 */  #055, #057,    0,    0,    0,    0,    0,    0,
   /* EBCDIC 68-6F */     0,    0,    0, #054, #045, #137, #076, #077,
   /* EBCDIC 70-77 */     0, #136,    0,    0,    0,    0,    0,    0,
   /* EBCDIC 78-7F */     0, #140, #072, #043, #100, #047, #075, #042,
   /* EBCDIC 80-87 */     0, #141, #142, #143, #144, #145, #146, #147,
   /* EBCDIC 88-8F */  #150, #151,    0, #173,    0,    0,    0,    0,
   /* EBCDIC 90-97 */     0, #152, #153, #154, #155, #156, #157, #160,
   /* EBCDIC 98-9F */  #161, #162,    0, #175,    0,    0,    0,    0,
   /* EBCDIC A0-A7 */     0,    0, #163, #164, #165, #166, #167, #170,
   /* EBCDIC A8-AF */  #171, #172,    0,    0,    0, #133,    0,    0,
   /* EBCDIC B0-B7 */     0,    0,    0,    0,    0,    0,    0,    0,
   /* EBCDIC B8-BF */     0,    0,    0,    0,    0, #135,    0,    0,
   /* EBCDIC C0-C7 */     0, #101, #102, #103, #104, #105, #106, #107,
   /* EBCDIC C8-CF */  #110, #111,    0,    0,    0,    0,    0,    0,
   /* EBCDIC D0-D7 */     0, #112, #113, #114, #115, #116, #117, #120,
   /* EBCDIC D8-DF */  #121, #122,    0,    0,    0,    0,    0,    0,
   /* EBCDIC E0-E7 */  #134,    0, #123, #124, #125, #126, #127, #130,
   /* EBCDIC E8-EF */  #131, #132,    0,    0,    0,    0,    0,    0,
   /* EBCDIC F0-F7 */  #060, #061, #062, #063, #064, #065, #066, #067,
   /* EBCDIC F8-FF */  #070, #071,    0,    0,    0,    0,    0, #134

 AND ebcdict(ch) = 	// translate ch from ASCII to EBCDIC
             ch!TABLE #X00,#X01,#X02,#X03,#X37,#X2D,#X2E,#X2F,
                      #X16,#X05,#X15,#X0B,#X0C,#X0D,#X0E,#X0F,
                      #X10,#X11,#X12,#X13,#X3C,#X3D,#X32,#X26,
                      #X18,#X19,#X3F,#X27,#X1C,#X1D,#X1E,#X1F,
                      #X40,#X5A,#X7F,#X7B,#X5B,#X6C,#X50,#X7D,
                      #X4D,#X5D,#X5C,#X4E,#X6B,#X60,#X4B,#X61,
                      #XF0,#XF1,#XF2,#XF3,#XF4,#XF5,#XF6,#XF7,
                      #XF8,#XF9,#X7A,#X5E,#X4C,#X7E,#X6E,#X6F,
                      #X7C,#XC1,#XC2,#XC3,#XC4,#XC5,#XC6,#XC7,
                      #XC8,#XC9,#XD1,#XD2,#XD3,#XD4,#XD5,#XD6,
                      #XD7,#XD8,#XD9,#XE2,#XE3,#XE4,#XE5,#XE6,
                      #XE7,#XE8,#XE9,#XAD,#XE0,#XBD,#X71,#X6D,
                      #X79,#X81,#X82,#X83,#X84,#X85,#X86,#X87,
                      #X88,#X89,#X91,#X92,#X93,#X94,#X95,#X96,
                      #X97,#X98,#X99,#XA2,#XA3,#XA4,#XA5,#XA6,
                      #XA7,#XA8,#XA9,#X8B,#X4F,#X9B,#X5F,#X07,
                      #X00,#X01,#X02,#X03,#X37,#X2D,#X2E,#X2F,
                      #X16,#X05,#X25,#X0B,#X0C,#X0D,#X0E,#X0F,
                      #X10,#X11,#X12,#X13,#X3C,#X3D,#X32,#X26,
                      #X18,#X19,#X3F,#X27,#X1C,#X1D,#X1E,#X1F,
                      #X40,#X5A,#X7F,#X7B,#X5B,#X6C,#X50,#X7D,
                      #X4D,#X5D,#X5C,#X4E,#X6B,#X60,#X4B,#X61,
                      #XF0,#XF1,#XF2,#XF3,#XF4,#XF5,#XF6,#XF7,
                      #XF8,#XF9,#X7A,#X5E,#X4C,#X7E,#X6E,#X6F,
                      #X7C,#XC1,#XC2,#XC3,#XC4,#XC5,#XC6,#XC7,
                      #XC8,#XC9,#XD1,#XD2,#XD3,#XD4,#XD5,#XD6,
                      #XD7,#XD8,#XD9,#XE2,#XE3,#XE4,#XE5,#XE6,
                      #XE7,#XE8,#XE9,#XAD,#XE0,#XBD,#X71,#X6D,
                      #X79,#X81,#X82,#X83,#X84,#X85,#X86,#X87,
                      #X88,#X89,#X91,#X92,#X93,#X94,#X95,#X96,
                      #X97,#X98,#X99,#XA2,#XA3,#XA4,#XA5,#XA6,
                      #XA7,#XA8,#XA9,#X8B,#X4F,#X9B,#X5F,#X07

.
section "Cms3"

get "libhdr"
get "etherhdr"
get "ftphdr"

let WBLOCK(V,P,N) = VALOF $(
   let a = output()
   selectoutput(stream)
   for i = 1 to n do wrch(v%(p+i-1))
   unless binary do newline()
   selectoutput(a)
   resultis 0
$)
AND RBLOCK(V,P,N) = VALOF $(
   let a = input()
   let c = endstreamch
   let b = blksize
   let i = 0

   selectinput(stream)
   !n := 0

   $( c := rdch()
      if c=endstreamch | c='*N' break
      v%(p+i) := c
      b := b-1
      !n := !n + 1
      i := i + 1
   $) REPEATUNTIL c='*P'  // we want to keep layout

   selectinput(a)
   if c=endstreamch resultis #X8000
   resultis 0
$)


and err(s) be
$( writef(s)
   freevec(v)
$)

.
section "Cms4"

get "libhdr"
get "etherhdr"
get "ftphdr"

let OPEN(V,DIR,VMID,FN,FT,DISK,PASSWORD) = VALOF $(
   LET RES=0
   UNLESS (DIR=1) | (DIR=2) | (DIR=3)  RESULTIS -1
   UNLESS (GETBYTE(VMID,0)<=8) RESULTIS -2
   UNLESS (GETBYTE(FN,0)<=8) RESULTIS -3
   UNLESS (GETBYTE(FT,0)<=8) RESULTIS -4
   UNLESS (GETBYTE(DISK,0)<=4) RESULTIS -7
   UNLESS (GETBYTE(PASSWORD,0)<=8) RESULTIS -8
   FOR I=0 TO 60 DO PUTBYTE(V,I,' ')  // BLANK ALL FIELDS
   MOVES(V,2,VMID)
   MOVES(V,10,FN)
   MOVES(V,18,FT)
   MOVES(V,35,DISK)
   MOVES(V,39,PASSWORD)
    PUTBYTE(V,DATAOFFSET+31,0)
    PUTBYTE(V,DATAOFFSET+32,0)
   PUTBYTE(V,DATAOFFSET+0,#X01)
   PUTBYTE(V,DATAOFFSET+1,DIR)
   RES:=ETHER(V,V1,47)
   RESULTIS RES
$)
//
AND GETIT(V,N) = VALOF  $(
  LET RES=0
   PUTBYTE(V1,0+DATAOFFSET,#X02)
   if check do writes("*NIn GETIT before calling ETHER")
   RES:=ETHER(V1,V,1)
   if check do writes("*nafter ETHER")
   RESULTIS RES
$)
//
AND PUT(V,N) = VALOF  $(
   LET RES=0
   PUTBYTE(V,0+DATAOFFSET,#X03)
   RES:=ETHER(V,V1,N+3)
$)
//

.
section "Cms5"

get "libhdr"
get "etherhdr"
get "ftphdr"

let SUMCHECK(V,P,N) BE FOR I=1 TO N DO CHECKSUM:=checksum+getbYTE(V,P+I-1)
//
AND CLOSE(X)   = VALOF $(
   LET RES=0
   PUTBYTE(V,DATAOFFSET+0,#X04)
   PUTBYTE(V,DATAOFFSET+1,X)
   PUTBYTE(V,DATAOFFSET+2,CHECKSUM>>8)
   PUTBYTE(V,DATAOFFSET+3,CHECKSUM&#XFF)
   RES:=ETHER(V,V1,4)
   RESULTIS RES
$)
//
AND SHUTDOWN() = VALOF $(
   LET RES=0
   PUTBYTE(V,DATAOFFSET,#X05)
   RES:=ETHER(V,V1,1)
   RESULTIS RES
$)
//
//
AND MOVES(V,N,S) BE FOR I=1 TO GETBYTE(S,0) DO PUTBYTE(V,DATAOFFSET+N+I-1,
                                               GETBYTE(S,I))
//
AND ETHER(A,B,N) = VALOF $(
   LET RES=0
   let hd.rxb = vec 11
   let hd.txb = vec 11

   n := (n | 1) + 1
   if check do writef("*n in ether, a=%x4,b=%x4,n=%n", a, b, n)
   for i = 0 to 11 do hd.rxb!i, hd.txb!i := 0,  0
   PUTBYTE(hd.txb,e.dest,#X02)
   PUTBYTE(hd.txb,e.source,1)
   PUTBYTE(hd.txb,e.len1,N>>8)
   PUTBYTE(hd.txb,e.len2,N)
   hd.txb%e.port2 := hd.txb%e.port2 | (hp >> 8)
   hd.txb%e.port3 := hp
   hd.rxb%e.port1 := hp>>4
   hd.rxb%e.port2 := hp<<4
   UNLESS sendpkt(-1,etsk,act.write,?,?,hd.txb,A,?,?)=0 RESULTIS -14
   if check do writes("*nETHER wrote OK")
   UNLESS sendpkt(-1,etsk,act.read,?,?,hd.rxb,B,?,?)=0 RESULTIS -15
   if check do writes("*nETHER read OK")
   IF GETBYTE(A,DATAOFFSET) \= GETBYTE(B,DATAOFFSET) RESULTIS -10
   RESULTIS GETBYTE(B,DATAOFFSET+1)
$)
//

and concatenate(s1,s2,sr) be
$( sr%0 := s1%0 + s2%0
   for i = 1 to s1%0 do sr%i := s1%i
   for i = s1%0 + 1 to s1%0 + s2%0 do sr%i := s2%(i - s1%0)
$)


and closestream() be
$( sendpkt(-1, etsk, act.releaseport, ?, ?, hp)
   test dir=1 do
   $( let a = output()
      selectoutput(stream)
      endwrite()
      selectoutput(a)
   $)
   or
   $( let a = input()
      selectinput(stream)
      endread()
      selectinput(a)
   $)
$)