! prep options ! n - nsi ! r - ring ! k - kent ! x - transport service interface ! if k is not set, ercc format is assumed #if ~(n!r!x) ! (k&n) #report invalid prep options #abort 1 #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 include "deimosperm" conststring (15) vsn = "FTP(nsi)..1h " begin externalstring (255) fnspec cli string 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 (127) s) record (parmf) par owninteger total param = 0, this param = 0, split 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 ! ! ! strings and things ! constrecord (*) name null==0 #if k ownstring (15) us="CUR051" ownstring (16) bpass="...." #else ownstring (15) us="ERCM09" ownstring (16) bpass="XXXX" #fi ownstring (33) fname="" ownstring (63) cli, add, cli2 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(*) ! 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 P_SER=BUFFER MANAGER; P_REPLY=OWN ID P_FN=RELEASE BUFFER PON(P) END ! ! ASK FOR BUFFER ! ROUTINE ASK FOR BUFFER P_SER=BUFFER MANAGER; P_REPLY=OWN ID 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 lev3 == p_mes_lev3 printstring(" Gate:") cycle i = 0, 1, mes_len-header len write(lev3_data(i), 3); newline if i&15=15 repeat newline end ! ! TO GATE ! routine to gate(integer fn) p_ser=gate ser; p_reply=own id 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 (63) s) printstring("Fault : "); printstring(s) 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 node = 0; term = 15 if add -> ("N").ns start if ns -> ns.("T").ts start node = stoi(ns); term = stoi(ts) -> ok finish printstring("Address:"); printstring(add); printstring(" not understood ") stop finish ok: #fi if cc=5 thenstart printstring("I give up!") newline tidyup finishelsestart printstring("Connecting to ") if add # "" then printstring(add) else printstring("emas") newline #if ~x p_port=1; p_facility=16 p_flag=x'48'; p_node=node p_term=term; to gate(open call) state=connecting #else state=connecting ask for buffer #fi cc=cc+1 finish end ! ! ! signal dot ! routine signal dot printsymbol('.') csent=csent-1024; ksent=ksent+1 if (ksent//50)*50=ksent then newline else printsymbol(k'100000') end ! ! *** Handle Buffer ! 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 #if k routine getchar(integername c) !------------------------------- integer i; !wanted to avoid compiler bug 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 (63) 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 direction = 1 then sfta(25) = x'80' and sfta(26) = 2 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 cycle x = 1, 1, 4 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(2) this param = 0 split pt = 3 end ! ! get param(into a record) ! routine get param(record (parmf) name par, bytearrayname a) integer i, j, k, n par = 0 return if this param = total param; ! no more this param = this param+1 par_type = a(split pt) n = 2; k = a(split pt+1) if k&x'30'=x'30' start ; ! string param par_s = string(addr(a(split pt+2))) n = length(par_s)+2 else if k&x'20'=x'20' start ; ! integer param par_int = (a(split pt+2)<<8)!a(split pt+3) n = 4 finish finish split pt = split pt+n 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 routine send disc(integer type) !-------------------------------- p_s1=type p_mes==null to gate(disconnect) end ! ! ***** Handle Gate ! routine handle gate integer type record (lev3f) name lev3 #if ~x switch f(input recd: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 p_s1=1 to gate(enable input) 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 to gate(enable input) 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 start fails = 1 fault("Rneg received!") dump mes(p_mes) if split pt = 0 then set param count(p_mes_lev3_data) cycle get param(par, p_mes_lev3_data) exit if par_type = 0; ! no more if par_type = x'71' then fault(par_s) repeat split pt = 0 -> 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 params(p_mes, "FTPD") set ts params(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 fault("Invalid Data In") end: printstring("value = "); write(type, 1); write(lev3_data(2),1) newline 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!") return ! f(call aborted): 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 ! !************************************************************************* ! cli = cli string; ! pick up parameters ! format: in file/out file,address unless cli -> cli.(",").add then add = "" if cli -> cli.("/").cli2 and cli = "" then direction = 1 printstring(vsn) i=mapvirt(buffer manager,4,3) i=mapvirt(buffer manager,5,4) i=mapvirt(buffer manager,6,5) prompt("Remote file name?") readstring(fname) #if k unless fname -> us.(".").fname then us = "CUR051" if us # "CUR051" start #else unless fname -> us.(".").fname then us = "ERCM09" 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='a' or int='A' thenstart 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 int=0 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