! prep options ! n - nsi ! r - ring ! k - kent ! x - transport service interface ! g - more general ftp ! a - Version for Psse Accounts (sends straight to a process with same filename ! b - new buffer manager (not permanently mapped on ! if k is not set, ercc format is assumed #options #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..5c " %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 #if ~b %recordformat lev3f(%bytearray dummy(0:7), %c (%byteintegerarray data(0:241) %or %string (200) dst) %orc %byteintegerarray params(0:250) ) #else %recordformat lev3f((%bytearray params(0:250) %or %c %bytearray dummy(0:5), %c (%byteintegerarray data(0:241) %or %string (200) dst))) #fi #fi #if ~b %recordformat mef(%record(mef)%name link,%byteinteger len,type, %c %record(lev3f) lev3) #else %recordformat mef(%integer buff no, len, %byte owner, type, %c %record (lev3f) lev3) #fi #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 #if ~b %recordformat pef(%byteinteger ser,reply,fn,s1, %c (%record (mef) %name mes, %byteinteger gate port, task port) %orc %string (3) facility) #else %recordformat pef(%byteinteger ser,reply,fn,s1, %c (%integer buff no, %byteinteger gate port, task port) %orc %string (3) facility) #fi #fi #if a %owninteger ptr, cell, no of cells, cellsize = 0 #fi %ownrecord(pef) p %ownrecord (mef) %name mes %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,tim,tim2 %owninteger direction = 0 %owninteger fails = 0, quiet = 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 "b_ygatecalls" #fi ! ! service numbers ! #if x %constinteger gate ser = 24 #else %constinteger gate ser=16 #fi %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(16) bpass="...." #else #if ~a %ownstring(16) bpass="XXXX" #else %ownstring(5) bpass="KDF9" #fi #fi #if ~a %ownstring (63) us = "" #else %ownstring(63) us = "ERUA11" #fi %ownstring(33) fname="" %ownstring (63) cli, add, cli2, qual, call frig %owninteger unix frig = 0; ! test, changes param 3 to 1 (line orientated) %owninteger fac ad = 0 %ownbyteintegerarray sfta(0:200) = %c 18, 4, 7, 0, 34, 1, 0, 2, 34, 0, 1, 1, 34, 0, 3, 3, 34, 0, x'80', 0(*) ! %ownbyteintegerarray ss0(0:5) = 0, 64, 0, 0, x'42', x'c0' ! nb: ss(0) + code select 'always zero' + iso ! ! 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' ! %ownbytearray stop m(0:6) = 6, stop, 1, x'0f', 34, x'20', 0 %owninteger binary = 0 %owninteger geac = 0 %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 %on 9 %start; ! disc full etc. selectoutput(0) printstring("Disc/directory is full! ") -> abo %finish ! !************************************************************************ ! ! ***** 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 P_SER=BUFFER MANAGER; P_REPLY=id P_FN=REQUEST BUFFER #if x P_GATE PORT=0; !long buffer #else P_LEN=0 #fi PON(P) %END #if b %record (mef) %map map(%integer buff no) ! New compiler - so must get 0 *mov_1,0 *mov_#8,1; ! desired vm seg no *2 ie 4*2 *iot %result == record(k'100000') %end #fi %routine time it %integer x, c %if ksent = 0 %then %return printstring("In"); write((tim2-tim)//60, 2) printstring(" secs =") x = (tim2-tim)//6; ! 1/10 of a sec c = ksent %while c > 64 %cycle; c=c//2; x=x//2;%repeat x = (c*512)//x write(x*20, 2); printstring(" bytes/sec ") %end ! ! dump mes ! %routine dump mes(%record (mef) %name mes) %integer i, x %record (lev3f) %name lev3 lev3 == mes_lev3 printstring(" Gate:") x = mes_len-header len write(x, 1); printstring("> ") %if x<1 %then x = 1 %cycle i = 0, 1, x-1 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(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 tim2 = time dump chars time it %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 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 printstring(add) #fi newline #if x state=connecting ask for buffer #fi cc=cc+1 %finish %end ! ! ! signal dot ! %routine signal dot csent=csent-1024; ksent=ksent+1 %if quiet = 0 %start printsymbol('.') #if k %if (ksent//50)*50=ksent %then newline %else printsymbol(k'100000') #else %if (ksent//50)*50=ksent %then newline %else terminate #fi %finish %end ! ! *** Handle Buffer ! #if x %routine set ts param(%record (mef) %name b, %string (63) s) !pack ts parameter string into the buffer %integer l l=mes_len string(addr(mes_lev3_params(l)))=s mes_len=l+length(s)+1 %end #fi #if x %routine print hex(%integer n) %ownbytearray hd(0:15) = '0', '1', '2', '3', '4', '5','6','7', '8','9','A','B','C','D','E','F' space printsymbol(hd(n>>4&15)) printsymbol(hd(n&15)) %end #fi #if k %routine getchar(%integername c) !------------------------------- %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) p1, p2, tadd %string(3) d %string(5) calling %integer i,j,more,type,k,n,x,pos %record (lev3f) %name lev3 %switch sw(0:connecting) %on 9 %start; ! eot i = i-1; more = 0 -> do eof %finish %if fails # 0 %then free buffer %and %return lev3==mes_lev3 %if state<1 %or state>connecting %then fault("Illeg buf state") %andreturn ->sw(state) ! sw(0): %return ! sw(send sft): %if geac = 1 %then sfta(18) = 1 {record => eol} add string(x'42', us, sfta) %if direction = 0 %and fname -> (".").p1 %start; ! device type add string(x'50', p1, sfta) sfta(13) = x'40'; sfta(14) = 1 %else add string(x'40', fname, sfta) %finish add string(x'44', bpass, sfta) #if e %if direction = 1 %then sfta(25) = x'80' %and sfta(26) = 2 #else %if direction = 1 %start sfta(13) = x'80'; sfta(14) = 2 %else x = sfta(0)+1; ! add file size (integer param) sfta(x) = x'60'; ! file size sfta(x+1) = x'22'; ! type:integer, "=" sfta(x+2) = 0; ! high order sfta(x+3) = 20; ! try 20kb for now sfta(0) = x+3 sfta(2) = sfta(2)+1; ! extra param now (now two) %finish #fi %if unix frig # 0 %then sfta(18) = 1; ! change param 3 to '1' printstring("Sending SFT ") lev3_dst=string(addr(sfta(0))) mes_len = sfta(0)+1+header len 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 to gate(put output) %return ! ! sw(send ss): ! send ss(0) printstring("Sending ss(0) ") tim = time lev3_data(i) = ss0(i) %for i = 0, 1, 5 mes_len = 6+header len state = send data -> send common send short: lev3_data(0) = 0 lev3_data(1) = type; lev3_data(2) = 0 mes_len = 3+header len send common: #if ~x p_port = port #else p_s1=0 #fi 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 ~a %if j=eot %and binary = 0 %then i = i-1 %and more=0 %andexit #fi #fi #if a ptr = ptr + 1 ;%if ptr = cellsize %then ptr = 0 %and cell = cell + 1 %if cell = 0 %start %if ptr = 1 %start Printstring("Not a formatted file ") %and more=0 %and %exit %unless j = 2 %elseif ptr = 2 Printstring("Not a formatted file ") %and more=0 %and %exit %unless j = 0 %elseif ptr = 3 no of cells = j %elseif ptr = 4 no of cells = no of cells + j << 8 %finish %else %if cell = no of cells %start lev3_data(k) = j ;k = k + 1 more = 0 %exit %finish %finish #fi lev3_data(k)=j; k = k+1 csent=csent+1 %if csent=1024 %start signal dot %finish %repeat do eof: 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 mes_len=k+header len %if k=1 %and more=0 %then ->swses to gate(put output) %if more=0 %thenstart state=send es %finish %return ! swses: sw(send es): tim2 = time printstring("Sending es ") state = wait er type = es -> send short ! sw(send stop): state = stop sent lev3_dst = string(addr(stop m(0))) lev3_data(0) = lev3_data(0)!128; ! len byte of lev3_dst p_s1 = 0 mes_len = 7+header len to gate(put output) %return #if x sw(connecting): mes_len=0; !set up transport service parameters tadd = add %if qual = "" %then Qual = "W=2/2" set ts param(mes, add) ! set ts param(mes, call frig) calling = "FTP" set ts param(mes, calling) set ts param(mes, qual) set ts param(mes, "Deimos ftp") port=0; !value not known yet p_s1 = 0 %if mon < 0 %start printstring("Con: To Gate:"); write(mes_len, 1); printsymbol('>') %cycle i = 0, 1, mes_len write(mes_lev3_params(i), 3); newline %if i&15=15 %repeat newline %finish 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 >= 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 %result = byte(a); ! check the length again %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) %owninteger n = 0, binflag = 0, eor %integer max, l, k, i %record (lev3f) %name lev3 lev3 == mes_lev3 max = mes_len-header len k = 0 select output(1) %cycle %if n = 0 %start n = lev3_data(k); k = k+1 %if mon#0 %then printstring("re") %and write(n, 1) %and newline %if n = 0 %start; ! transfer command select output(0) %result = lev3_data(k); ! send back type %finish %exit %if k >= max eor = n&128; ! remember the top bit n = n&63; ! reduce to simple length %if n=0 %then newline %and %continue %finish %if mon<0 %then write(n, 1) %and write(lev3_data(k), 1) %and write(k, 1) %c %and newline l = lev3_data(k); k= k+1; n= n-1 %if binflag = 0 %start %if l < 10 %start select output(0) binflag = 1; printstring("Binary ") select output(1) %finish %else binflag = 2 %finish %if binflag = 1 %or l # 13 %then printsymbol(l) %if n = 0 %and eor # 0 %and unix frig # 0 %then newline csent = csent+1 %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 #if ~b p_mes == null #else p_buff no = 0 #fi to gate(disconnect) %end #fi %integerfn do interpret message(%record (mef) %name mes) %bytearrayname a %integer x a == 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_type = x'0f' %start; ! state of trf %if par_int = x'2000' %then printstring("State = ok ") %else %start printstring("Trf fails "); write(par_int, 1) newline %finish %else %if par_s # "" %start printstring("param?"); printstring(par_s); newline %finish %finish %finish %repeat %finish split pt = 0 %if last ind = 0 %then free buffer %and %result = 1 ! there was more coming split pt = 0; !dummy code (compiler bug) %result = 0; ! no more coming %end ! ! ***** Handle Gate ! %routine handle gate %integer type, x, d1, d2 %record (lev3f) %name lev3 %bytearrayname a #if ~x %switch f(input here:message reply) #else %switch f(connect:datagram reply) %routine reason out printstring(", Reason ="); write(p_s1, 2) print hex(d1); print hex(d2); newline %end #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 #if k p_s1=1 to gate(enable input) #fi state=send sft ask for buffer %finishelse fault("Illeg accept") %unless mes==null %then free buffer %return #fi ! f(input here): lev3 == mes_lev3 type = lev3_data(1) #if x p_s1=1; !number of enables #if b p_buff no = 0 #fi #fi %if mon < 0 %then printstring("from ") %and dump mes(mes) to gate(enable input) #if b p_buff no = mes_buff no #fi %if state = await data %start type = do input(mes) %if type = es %start tim2 = time 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 printstring("Rneg received! ") dump mes(mes) %if mon > 0 %if do interpret message(mes) # 0 %then %return -> 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 mes_len = 3+header len lev3_data(0) = 130; lev3_data(2) = 0 to gate(put output) printstring("Go sent ") tim = time %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: state = stop sent lev3_dst = string(addr(stop m(0))) lev3_data(0) = lev3_data(0)!128; ! len byte of lev3_dst p_s1 = 0 mes_len = 7+header len to gate(put output) %return send type: lev3_data(0)=0 lev3_data(1) = type; lev3_data(2) = 0 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 %and new pt = 0 %start fault("Not Stopack") -> end %finish %if do interpret message(mes) # 0 %then %return; ! more coming state = closing #if x #if k mes_len=0; !send null data with push - acts as close req p_s1=1 to gate(put output) free buffer p_mes == null p_s1 = 0 #else free buffer #if ~b p_mes == null #else p_buff no = 0 #fi to gate(Disconnect) #fi #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(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(reset): %unless mes == null %start %if mon # 0 %start printstring("Disc:") %cycle i = 0, 1, mes_len write(mes_lev3_params(i), 3); newline %if i&15=15 %repeat newline %finish d1 = mes_lev3_params(2); d2 = mes_lev3_params(3) free buffer %finish printstring("Reset recd") reason out; newline send disc(99) state = aborting %return f(disconnect): %unless mes == null %start %if mon # 0 %start printstring("Disc:") %cycle i = 0, 1, mes_len write(mes_lev3_params(i), 3); newline %if i&15=15 %repeat newline %finish d1 = mes_lev3_params(2); d2 = mes_lev3_params(3) free buffer %finish %if state=connecting %start; !connect failed printstring("Connect fails"); reason out clock=1 %return %finish %if state=closing %start #fi newline %if fails = 0 %then %c printstring("End of file...") %else %c printstring("Attempt aborted, ") dump chars time it tidyup %return %finish ! %if state # aborting %start printstring("Call aborted by other end") #if x reason out #else newline #fi fails = 1 #if x send disc(1) #else to gate(abort call) #fi %finish tidyup %return ! f(*): printstring("Illegal fn from gate"); write(p_fn,1); newline %return %end ! !************************************************************************* ! ! ***** Main program starts here ! !************************************************************************* ! #if k cli = cli string; ! pick up parameters #else cli = cli param; ! pick up parameters #fi ! format: in file/out file,address #if a fname = cli; ! uses same name for both purposes %if fname -> fname.("(").cli %then i = 1; ! delete file directory number %if fname="NAMFIL" %then cellsize = 32 %else cellsize = 128 #else #if k %unless cli -> cli.(",").add %then add = "" #else %unless cli -> cli.("%C").callfrig %then call frig = "FTP" %if cli -> cli.("#U").add %start; ! HORRIBLE - Test for Vax etc (TEST ONLY) unix frig = 1; cli = cli.add; ! pickup rest %finish %unless cli -> cli.("=").qual %then qual = "" %unless cli -> cli.(":").add %then add = "" #fi %if cli -> cli.("/").cli2 %and cli = "" %then direction = 1 #fi printstring(vsn) #if r printstring("Ring ") #fi #if n printstring("NSI ") #fi #if x printstring("TSI ") #fi printstring(datestring); newline #if ~b i=mapvirt(buffer manager,5,4) i=mapvirt(buffer manager,6,5) #fi %if add -> add.("/B").fname %then binary = 1; ! set binary mode %if add -> add.("/G").fname %then geac = 1; ! special for geac #if ~a %if add = "" %start; ! nb: change to default !! prompt("Full Address?"); readstring(add) %finish %else add = add.".FTP" %if charno(add, 1) = 'L' %and add -> fname.("L").add %start %if length(add) = 1 %then add = fname."00001500000".add %else %c add = fname."0000150000".add %finish repr: prompt("Remote User Name?") readstring(us) %if us = "" %then -> repr #if k %unless us -> us.(".").fname %then us = "" %if us = "" %start us = "CUR051" %else #else %if charno(us, 1) = '"' %and charno(us,length(us)) = '"' %start charno(us, 1) = length(us)-2; us = string(addr(us)+1) ->get file name %finish %unless us -> us.(".").fname %start get file name: prompt("Remote File Name?") readstring(fname) %finish %if us = "*" %start us = "ERCM09" %else #fi prompt("Background Pass?") readstring(bpass) %finish #else ! account code add = "15000001"; ! point at EMAS #fi select input(1) #if k neot=-1; !for handling 'real' eof #fi alarm(50) clock=0; cc=0 do connect; ! send a connect %cycle p_ser=0; poff(p) %if 'M' <= int <= 'P' %then mon = int-'O' %and int = 0 %if p_reply = 0 %start; ! clock %if int='L' %then give up = 30000 %if int = 'Q' %then quiet = quiet!!1 %if int='A' %thenstart abo: %if clock > 0 %then %stop; ! remove 'S' when this works !! %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 int=0 %unless int = 'S' %if clock=-1 %thenstop alarm(50) %if clock=5 %then clock=0 %and do connect %if clock > 0 %then clock = clock+1 %finishelseif p_reply =buffer manager %thenstart #if ~b mes == p_mes #else mes == map(p_buff no) mes_owner = own id #fi handle buffer %finishelseif p_reply=gate ser %thenstart #if ~b mes == p_mes #else mes == map(p_buff no) mes_owner = own id %unless p_buff no = 0 #fi handle gate %finish %repeat %endofprogram