! prep options
! n - nsi
! r - ring
! k - kent
! x - transport service interface
! e - Edinburgh format ftp
! g - more general ftp
! if k is not set, ercc format is assumed
#if ~(n!r!x) ! ~(e!g) ! (n&r) ! (n&x) ! (r&x) ! (e&g)
#report must specify one of (n,r,x) and one of (e,g)
#abort
#fi
#if r
#report Preparing ring version
#fi
#if n
#report Preparing NSI version
#fi
#if x
#report Preparing transport service interface version
#fi
!
!
! *** ftpd1s
!
! *** Ftp package to send deimos files
!
! *** Stream 1 is the file to be sent. It prompts for
! the remote file name.
!
! *** INT A will cause the file to abort.
!
! Sequence of messages
!
! sft ->
! <- rpos/rneg
! Go ->
! ss(0) ->
! Data ->
! .... ->
! Es ->
! <- Er(0)
! Stop ->
! <- Stopack
!
control 1
#if k
include "deimosperm"
#else
include "b_deimosspecs"
#fi
conststring (9) vsn = "FTP..1l "
begin
#if k
externalstring (255) fnspec cli string
#else
externalstring (255) fnspec cli param
#fi
#datestring
#timestring
recordformat qf(record (qf)name q); !not used
#if n
recordformat lev3f(byteinteger fn,sufl,st,ss, (byteinteger flag,uflag, c
(byteintegerarray data(0:237) or string (200) dst) or c
(byteinteger sn,dn,dt,ds,mflg,ufl,string (200) s)))
#fi
#if r
#if ~k
recordformat lev3f(integer st,ds,rc,tc,uflag, c
(byteintegerarray data(0:241) or c
string (200) dst))
#else
recordformat lev3f(integer st,ds,rc,tc, c
(byteintegerarray data(0:241) or c
string (200) dst))
#fi
#fi
#if x
recordformat lev3f(string (7) dummy, c
(byteintegerarray data(0:241) or string (200) dst) orc
byteintegerarray params(0:250) )
#fi
recordformat mef(record (mef)name link,byteinteger len,type, c
record (lev3f) lev3)
#if n
recordformat pef(byteinteger ser,reply,fn,port, c
(record (mef)name mes, byteinteger len,s1 or c
byteinteger facility,flag,node,term))
#fi
#if r
recordformat pef(byteinteger ser,reply,fn,port, c
(record (mef)name mes, byteinteger len,s1 or c
byteinteger node, flag, term, facility))
#fi
#if x
recordformat pef(byteinteger ser,reply,fn,s1, c
(record (mef) name mes, byteinteger gate port, task port) orc
string (3) facility)
#fi
ownrecord (pef) p
ownrecord (lev3f) name lev3
recordformat parmf(integer type, int, string (255) s)
record (parmf) par
owninteger total param = 0, this param = 0, split pt = 0, curr len, last ind
owninteger new pt = 0
owninteger port,ksent,csent,state,clock,i,cc
owninteger direction = 0
owninteger fails = 0
#if k
!globals to handle 'real' eof - even for binary files.
owninteger neot,holdc; !number of real eot chars to be sent
#fi
!
! constants
!
constinteger eot=4
!
#if ~x
! gate to task functions
!
constinteger incomming call=2
constinteger input here=3
constinteger output txd=4
constinteger call closed=5
constinteger call aborted=6
constinteger open reply a=7
constinteger open reply b=8
constinteger open message=9
!
! task to gate functions
!
constinteger enable facility=1
constinteger disable facility=2
constinteger call reply=3
constinteger enable input=4
constinteger put output=5
constinteger close call=6
constinteger abort call=7
constinteger open call=8
constinteger message reply=10
#else
include "tsbsp_tscodes"
#fi
!
! service numbers
!
constinteger gate ser=16
constinteger buffer manager=17
!
constinteger request buffer=0
constinteger release buffer=1
!
! general variables
!
owninteger give up = 5
!
! strings and things
!
constrecord (*) name null==0
#if k
ownstring (63) us="CUR051"
ownstring (16) bpass="...."
#else
ownstring (63) us="ERCM09"
ownstring (16) bpass="XXXX"
#fi
ownstring (33) fname=""
ownstring (63) cli, add, cli2
owninteger fac ad = 0
#if e
ownbyteintegerarray sfta(0:200) = c
26, 4, 7, 0, 34, 1, 0, 2, 34, 0, 8, 9, 50, 9,
'E', 'M', 'A', 'S', '-', 'E', 'M', 'A', 'S',
1, 34, 0, 1, 0(*)
#else
ownbyteintegerarray sfta(0:200) = c
22, 4, 8, 0, 34, 1, 1, 2, 34, 0, 1,
1, 34, 0, 1, 3, 34, 0, x'80',
x'60', 34, x'03', x'e7', 0(*)
#fi
!
ownbyteintegerarray ss0(0:3) = 3, 0, 64, 0
!
! states
!
constinteger send sft=1
constinteger send ss=2
constinteger send data=3
constinteger await data=4
constinteger send es = 5
constinteger wait er = 6
constinteger send stop = 7
constinteger stop sent = 8
constinteger closing=9
constinteger aborting=10
constinteger wait rep b=11
constinteger connecting = 12
!
! ftp command values
!
constinteger stop = 0, go = 1, rpos = 2, rneg = 3, sft = 4, stopack = 5
constinteger ss = x'40', es = x'43', rr = x'44', qr = x'46', er = x'47'
!
owninteger mon = 0
#if n
constinteger header len = 6; ! nsi
#fi
#if r
#if ~k
constinteger header len = 2; ! ring
#else
constinteger header len = 0
#fi
#fi
#if x
constinteger header len = 0
#fi
!
!************************************************************************
!
! ***** Routines start here
!
!************************************************************************
!
! string to integer
!
integer fn stoi(string (*)name s)
integer x,y,sum
sum = 0
result = 0 if s = ""
cycle x = 1, 1, length(s)
sum = sum*10+(charno(s, x)-'0')
repeat
result = sum
end
!
! RELEASE BLOCK
!
ROUTINE FREE BUFFER
#if k
P_SER=BUFFER MANAGER; P_REPLY=OWN ID
#else
P_SER=BUFFER MANAGER; P_REPLY=id
#fi
P_FN=RELEASE BUFFER
PON(P)
END
!
! ASK FOR BUFFER
!
ROUTINE ASK FOR BUFFER
#if k
P_SER=BUFFER MANAGER; P_REPLY=OWN ID
#else
P_SER=BUFFER MANAGER; P_REPLY=id
#fi
P_FN=REQUEST BUFFER
#if x
P_GATE PORT=0; !long buffer
#else
P_LEN=0
#fi
PON(P)
END
!
! dump mes
!
routine dump mes(record (mef) name mes)
integer i, x
record (lev3f) name lev3
lev3 == p_mes_lev3
printstring(" Gate:")
x = mes_len-header len
write(x, 1); printstring("> ")
if x<1 then x = 1
cycle i = 0, 1, x
write(lev3_data(i), 3); newline if i&15=15
repeat
newline
end
!
! TO GATE
!
routine to gate(integer fn)
#if k
p_ser=gate ser; p_reply=own id
#else
p_ser=gate ser; p_reply=id
#fi
if mon < 0 and fn = put output start
printstring("To")
dump mes(p_mes)
finish
#if x
p_task port = 1
p_gate port = port
#fi
p_fn=fn; pon(p)
end
!
! dump chars
!
routine dump chars
printstring("Chars")
if direction = 0 then printstring(" sent=") else c
printstring(" rec'd=")
write(ksent,0); printstring("K+")
write(csent,0); newline
end
!
! dump status
!
routine dump status
conststring (20)array ss(0:12)= c
"Not used !!", "send sft", "send ss", "send data", "await data",
"send es", "wait er", "send stop", "stop sent", "closing", "aborting",
"wait rep b", "connecting"
printstring("State :"); write(state,0)
if state>0 and state<=12 then space and printstring(ss(state))
newline
dump chars
end
!
! *** add string
!
! add the string s, into the array a, in ftp parameter format
!
routine add string(integer param, string (*) name s, bytearrayname a)
integer i, x
x = a(0)+1
a(x) = param
a(x+1) = x'32'; ! string param, op = EQ
string(addr(a(x+2))) = s; ! add in string
a(0) = x+2+length(s)
end
!
! read string
!
routine read string(string (*) name s)
integer i
s = ""
cycle
readsymbol(i)
exit if i=nl
s=s.tostring(i)
repeat
end
!
! fault
!
routine fault(string (255) s)
integer i, n
printstring("Fault : ")
n=9
cycle i = 1, 1, length(s)
printsymbol(charno(s, i))
n=n+1
newline and n = 1 if n = 72
repeat
newline
dump status
end
!
! tidy and quit
!
routine tidyup
clock=-1
end
!
! connect
!
routine do connect
#if ~x
integer node, term
string (15) ns, ts, fs
#if k
node = 0; term = 15
#else
node = 0; term = 9; !fe1
#fi
if add -> ts.("N").ns start
if ns -> ns.("T").ts start
if ts -> ts.(".F").fs start
fac ad = stoi(fs)
finish else fac ad = 0
node = stoi(ns); term = stoi(ts)
-> ok
finish
printstring("Address:"); printstring(add); printstring(" not understood
")
stop
finish
ok:
#fi
if cc=give up or int = 'S' thenstart
printstring("I give up!")
newline
tidyup
finishelsestart
printstring("Connecting to ")
#if k
if add # "" then printstring(add) else printstring("emas")
#else
if add # "" then printstring(add) else printstring("2972 - fe1")
#fi
newline
#if n
p_port = 1; p_facility = 16
p_flag = x'48'
p_node = node
p_term = term; to gate(open call)
state = connecting
#fi
#if r
#if k
!use kent 16 bit facility number
p_port = 1; p_facility = 255
p_flag = fac ad; p_node = 16; !2 bytes of facility code
#else
p_port = 1; p_facility = 16
if fac ad # 0 then p_flag = x'80'!fac ad else p_flag = 0
p_node = node
#fi
p_term = term; to gate(open call)
state = connecting
#fi
#if x
state=connecting
ask for buffer
#fi
cc=cc+1
finish
end
!
!
! signal dot
!
routine signal dot
printsymbol('.')
csent=csent-1024; ksent=ksent+1
#if k
if (ksent//50)*50=ksent then newline else printsymbol(k'100000')
#else
if (ksent//50)*50=ksent then newline else terminate
#fi
end
!
! *** Handle Buffer
!
#if x
routine set ts param(record (mef) b, string (33) s)
!pack ts parameter string into the buffer
integer l
l=p_mes_len
string(addr(p_mes_lev3_params(l)))=s
p_mes_len=l+length(s)+1
end
#fi
#if k
routine getchar(integername c)
!-------------------------------
integer i
i=0
on event 9 start
neot=-1
c=-1; return
finish
if neot>0 then neot=neot-1 and c=eot and return
if neot=0 then neot=-1 and c=holdc and return
readsymbol(c)
if c=eot start ; !find how many eots, set neot to that minus 1
while c=eot cycle
neot=neot+1
readsymbol(c)
repeat
holdc=c
c=eot
finish
end
#fi
routine handle buffer
string (255) jcl
integer i,j,more,type,k,n,x,pos
record (lev3f) name lev3
switch sw(0:connecting)
if fails # 0 then free buffer and return
lev3==p_mes_lev3
if state<1 or state>connecting then fault("Illeg buf state") andreturn
->sw(state)
!
sw(0):
return
!
sw(send sft):
add string(x'42', us, sfta)
add string(x'40', fname, sfta)
add string(x'44', bpass, sfta)
#if e
if direction = 1 then sfta(25) = x'80' and sfta(26) = 2
#else
if direction = 1 then sfta(13) = x'80' and sfta(14) = 2
#fi
jcl = string(addr(sfta(0)))
printstring("Sending SFT
")
lev3_dst=jcl
length(lev3_dst) = length(lev3_dst)!128; ! add in end-of-record marker
#if ~x
p_port=port
#if n
lev3_uflag = 5
#else
#if ~k
lev3_uflag = x'0100'
#fi
#fi
#else
p_s1=0
#fi
p_mes_len=length(jcl)+1+header len
to gate(put output)
return
!
!
sw(send ss): ! send ss(0)
printstring("Sending ss(0)
")
type = ss
state = send data
send short:
if type = stop then lev3_data(0) = 130 else lev3_data(0) = 0
lev3_data(1) = type; lev3_data(2) = 0
#if ~x
p_port = port
#else
p_s1=0
#fi
p_mes_len = 3+header len
to gate(put output)
return
!
sw(send data): more=1; !send block of data
k = 0
#if k
cycle x = 1, 1, 4
#else
cycle x = 1, 1, 2; !temp frig for John
#fi
pos = k; k = k+1
if x = 4 then n = 41 else n = 63
cycle i=1,1,n
#if k
getchar(j)
if j<0 then i=i-1 and more=0 and exit
#else
readsymbol(j)
if j=eot then i = i-1 and more=0 andexit
#fi
lev3_data(k)=j; k = k+1
csent=csent+1
if csent=1024 start
signal dot
finish
repeat
lev3_data(pos)=i!128; ! + record marker
exit if more = 0
repeat
#if ~x
p_port=port
#if ~k
lev3_uflag=5
#fi
#else
p_s1=0
#fi
p_mes_len=k+header len
if k=1 and more=0 then free buffer else to gate(put output)
if more=0 thenstart
state=send es
finish
return
!
sw(send es):
printstring("Sending es
")
state = wait er
type = es
-> send short
!
sw(send stop):
state = stop sent
type = stop
-> send short
#if x
sw(connecting):
p_mes_len=0; !set up transport service parameters
if add="" then add="EMAS"
set ts param(p_mes, add.".FTP")
set ts param(p_mes, "FTPD")
set ts param(p_mes, "")
set ts param(p_mes, "Deimos ftp")
port=0; !value not known yet
to gate(connect)
return
#fi
sw(*):
fault("Illegal buffer state"); return
end
!
! set up global param counts (needed for split blocks)
!
routine set param count(bytearrayname a)
total param = a(1)
this param = 0
split pt = 2
end
!
!
integerfn byte(bytearrayname a)
if split pt >= p_mes_len - header len then result = -1; !no more here
if curr len = 0 start ; !eor
curr len = a(split pt)&63
last ind = a(split pt)&128
split pt = split pt + 1
finish
curr len = curr len - 1
split pt = split pt + 1
result = a(split pt - 1)
end
!
! get param(into a record)
!
routine get param(record (parmf) name par, bytearrayname a)
integer i, j, k, n, x
integerfn byte
split pt = split pt + 1
result = a(split pt - 1)
end
par = 0; par_type = -1
return if this param = total param; ! no more
this param = this param+1
par_type = byte
n = 2; k = byte
if k&x'30'=x'30' start ; ! string param
par_s = ""
j = byte; !get the length
cycle i=1, 1, j
x = byte
exit if x < 0; !no more in this packet
par_s = par_s.to string(x)
repeat
else
if k&x'20'=x'20' start ; ! integer param
par_int = byte<<8!byte
finish
finish
end
!
! ****** do input - read input and put in file
!
integer fn do input(record (mef) name mes)
integer max, n, k, i
record (lev3f) name lev3
lev3 == p_mes_lev3
max = p_mes_len-header len
k = 0
select output(1)
cycle
n = lev3_data(k)
if n = 0 start ; ! transfer command
select output(0)
result = lev3_data(k+1); ! send back type
finish
n = n&63; ! reduce to simple length
lev3_data(k) = n
printstring(string(addr(lev3_data(k))))
k = k+n+1
csent = csent+n
exit if k>=max
repeat
select output(0)
if csent >= 1024 start
signal dot
finish
result = 0
end
#if x
routine send disc(integer type)
!--------------------------------
p_s1=type
p_mes==null
to gate(disconnect)
end
#fi
!
! ***** Handle Gate
!
routine handle gate
integer type, x
record (lev3f) name lev3
bytearrayname a
#if ~x
switch f(input here:message reply)
#else
switch f(connect:datagram reply)
#fi
->f(p_fn)
!
#if ~x
f(open reply a): if state=connecting thenstart
#if n
port=p_s1
#else
port = p_node
#fi
state=wait rep b
finishelse fault("Illeg open rep a")
return
!
f(open reply b): if p_s1#0 start
printstring("Connect fails,reason=")
write(p_s1,0); newline
clock=1
finishelsestart
if state=wait rep b thenstart
printstring("Connected....")
newline
state=send sft
ask for buffer
finishelse fault("Illeg open reply b")
finish
return
#else
f(accept call):
if state=connecting start
port=p_gate port
printstring("Connected..."); newline
state=send sft
ask for buffer
finishelse fault("Illeg accept")
unless p_mes==null then free buffer
return
#fi
!
f(input here):
lev3 == p_mes_lev3
type = lev3_data(1)
#if x
p_s1=1; !number of enables
#fi
if mon < 0 then printstring("from ") and dump mes(p_mes)
to gate(enable input)
if p_mes_len=0 start ; !null data transfer (probably a push)
-> free
finish ;
if state = await data start
type = do input(p_mes)
if type = es start
printstring("Eof seen
")
state = send stop
ask for buffer
type = er
-> send type
finish
-> free
finish
if state = send sft start ; ! should be rpos/rneg
if type = rneg or new pt # 0 start
fails = 1
fault("Rneg received!")
dump mes(p_mes) if mon # 0
a == p_mes_lev3_data
if curr len = 0 start
curr len = a(0)&63
last ind = a(0)&128
split pt = 1
finish
cycle
x = byte(a); exit if x<0; ! at end
sfta(newpt) = x; newpt = newpt+1
repeat
if curr len = 0 and last ind # 0 start
set param count(sfta)
cycle
get param(par, sfta)
exit if par_type = -1; ! no more
if par_type = x'71' start
printstring("message:"); printstring(par_s); newline
else
if par_s # "" start
printstring("param?"); printstring(par_s); newline
finish
finish
repeat
finish
split pt = 0
if last ind = 0 then -> free; ! more coming
split pt = 0; !dummy code (compiler bug)
-> send stop; ! may be second packet !!
finish
if type = rpos start
lev3_data(1) = go
if direction = 0 then state = send ss else state = await data
#if x
p_s1=0
#fi
to gate(put output)
printstring("Go sent
")
return
finish
fault("invalid reply to sft")
! ????
-> end
finish
if state = wait er or type = qr start
! should be er(0)
if type = qr start
fault("Quit rec'd")
lev3_data(0) = 0; lev3_data(1) = es
#if x
p_s1=0
#fi
to gate(put output); return
else
if type = er start
if lev3_data(2) = 0 start
printstring("er(0) - recd
")
else
printstring("er("); write(lev3_data(2), 1)
printstring(") - recd
")
finish
finish
send stop:
type = stop
state = stop sent
send type:
if type = stop then lev3_data(0)=130 else lev3_data(0)=0
lev3_data(1) = type; lev3_data(2) = 0
p_mes_len = 3+header len
#if ~x
p_port = port
#else
p_s1=0
#fi
to gate(put output)
return
finish
finish
if state = stop sent start
if type # stopack start
fault("Not Stopack")
-> end
finish
state = closing
#if x
p_mes_len=0
set ts param(p_mes, "FTPD")
set ts param(p_mes, "end of transfer")
p_s1=0; !ok flag
to gate(disconnect); !close the connection
#else
free buffer
to gate(abort call)
#fi
return
finish
if state = aborting then -> free
fault("Invalid Data In")
end: printstring("value = "); write(type, 1); write(lev3_data(2),1)
newline
dump mes(p_mes)
int = 'A'; !abort the call now
free: free buffer
return
!
#if x
f(enable output):
#else
f(output txd):
#fi
if state=send data or state = send ss or state = send es c
then ask for buffer
#if ~x
if state=closing thenstart
p_port=port
to gate(close call)
finish
#fi
return
!
#if ~x
f(call closed):
fault("Unexpected call closed!")
to gate(close call)
tidyup
return
!
f(call aborted):
if state = aborting start
printstring("Abort acknowledged"); newline
tidy up
return
finish
if state=closing start
#else
f(disconnect):
unless p_mes==null then free buffer
if state=connecting start ; !connect failed
printstring("Connect fails, reason="); write(p_s1,2); newline
clock=1
return
finish
if state=closing start
if p_s1#1 then send disc(1); !disc ack
#fi
newline
if fails = 0 then c
printstring("End of file...") else c
printstring("Attempt aborted, ")
dump chars
tidyup
return
finish
!
printstring("Call aborted by other end")
newline
fails = 1
#if x
send disc(1)
#else
to gate(abort call)
#fi
tidyup
return
!
f(*):
printstring("Illegal fn from gate"); write(p_fn,1); newline
return
end
!
!*************************************************************************
!
! ***** Main program starts here
!
!*************************************************************************
!
on 9 start ; ! disc full etc.
selectoutput(0)
printstring("Disc/directory is full!
")
-> abo
finish
#if k
cli = cli string; ! pick up parameters
#else
cli = cli param; ! pick up parameters
#fi
! format: in file/out file,address
#if k
unless cli -> cli.(",").add then add = ""
#else
unless cli -> cli.(":").add then add = ""
#fi
if cli -> cli.("/").cli2 and cli = "" then direction = 1
printstring(vsn)
#if r
printstring("Ring ")
#fi
#if n
printstring("NSI ")
#fi
#if x
printstring("TSI ")
#fi
#if e
printstring("Emas ")
#else
printstring("Gen ")
#fi
printstring(datestring); newline
i=mapvirt(buffer manager,4,3)
i=mapvirt(buffer manager,5,4)
i=mapvirt(buffer manager,6,5)
#if g
prompt("Remote user?")
readstring(us)
#fi
prompt("Remote file?")
readstring(fname)
#if k
-> skip if us # "CUR051"
#else
-> skip if us # "ERCM09"
#fi
#if k
unless fname -> us.(".").fname then us = "CUR051"
if us # "CUR051" start
skip:
#else
unless fname -> us.(",").fname start
unless fname -> us.(".").fname then us = "ERCM09"
finish
skip:
if us # "ERCM09" start
#fi
prompt("Background Pass?")
readstring(bpass)
finish
select input(1)
#if k
neot=-1; !for handling 'real' eof
#fi
alarm(250)
clock=0; cc=0
do connect; ! send a connect
cycle
p_ser=0; poff(p)
if int='L' then give up = 30000 and int = 0
if int='a' or int='A' thenstart
abo:
if state< closing start
#if x
send disc(42)
#else
p_port = port
to gate(abort call)
#fi
state=aborting
printstring("Aborting call"); newline
finishelsestart
printstring("Cannot abort :")
dump status
finish
finishelseif int='?' then dump status
if int = 'O' then mon = 0
if int = 'M' then mon = -1
if int = 'P' then mon = 1
int=0 unless int = 'S'
if p_reply=0 thenstart ; !clock
if clock=-1 thenstop
alarm(250)
if clock=2 then clock=0 and do connect
if clock=1 then clock=2
finishelseif p_reply=buffer manager thenstart
handle buffer
finishelseif p_reply=gate ser thenstart
handle gate
finish
repeat
endofprogram