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ÿ)
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)
$)
$)