%conststring (13) vsn = "ftps....4c " #datestring #timestring !******************************** !* emas-2900 fep ftp server * !* file: ftp4s/ftp4y * !* * !******************************** #options ! prep versions are:- ! ! k = kent (no uflag) ! e = ERCC ! r = ring ! n = nsi ! x = Transport Service ! m = Full Monitoring ! c = Clock monitoring (needs a real time clock) ! i = new imp compiler ! t = tracing - keeps a cyclic trace of actions on each descriptor ! #if ~(k!e) ! ~(r!n!x) ! (r&n) ! (k&e) ! (k&n) #report incompatible prep options #abort #fi #if i %control x'4001' #else %control 1 #fi #if i %include "b_deimosspecs" #else %include "deimosperm" #fi %begin #if ~x ! k %externalstring (255) %fnspec itos(%integer n,j) #fi %recordformat am1f(%integer rxs, rxd, txs, txd) %ownrecord (am1f) %name l == 1; ! supplied by am1 handler #if n %recordformat lev3f(%byteinteger fn, sufl, st, ss, %c (%byte sn, dn, dt, ds, lfl, luflag, %bytearray aa(0:241) %or %byte sfl, suflag, %c (%byteintegerarray a(0:241) %or %c %integer x1, x2, x3, x4, users, state, cpu, pkts, sbr, byt, ftpo, ftpi))) #fi #if r #if k %recordformat lev3f(%integer st,ds,rc,tc, %c (%byteintegerarray a(0:241) %or %c %integer x1, x2, x3, x4, users, state, cpu, pkts, sbr, byt, ftpo, ftpi)) #else %recordformat lev3f(%integer st,ds,rc,tc,uflag, %c (%byteintegerarray a(0:241) %or %c %integer x1, x2, x3, x4, users, state, cpu, pkts, sbr, byt, ftpo, ftpi)) #fi #fi #if x %recordformat lev3f(%bytearray reserved(0:7), %bytearray a(0:241)) #fi #if r #if e %recordformat ssmessagef(%integer sou,prt,c,prt r,ds,st,sn, %c %byteintegerarray a(0:237)); !$e #else %recordformat ssmessagef(%integer sou,prt,c,prt r,ds, %c %byteintegerarray a(0:239)) #fi #fi #if ~b %recordformat mef(%record (mef) %name link, %c %byteinteger len, type, (%record (lev3f)lev3 %or %c %bytearray params(0:231) %or %string (231) str)) %recordformat m2900f(%record (mef) %name l, %byteinteger len, type, %c %integer stream, sub ident, %c (%integer p2a, p2b, p3a, p3b,p4a, p4b, p5a, p5b, p6a, p6b %or%c %bytearray b(0:19))) %recordformat maf(%record (mef)%name l, %byteinteger mlen, %c mtype, (%byte len, type, %c (%bytearray m(0:242) %or %c %integer ref, in ident, out ident, %string (63) address) %or %c %bytearray a(0:240))) #else %recordformat mef(%integer buff no, %c %byteinteger len, type, (%record (lev3f)lev3 %or %c %bytearray params(0:231) %or %string (231) str)) %recordformat m2900f(%integer buff no, %byteinteger len, type, %c %integer stream, sub ident, %c (%integer p2a, p2b, p3a, p3b,p4a, p4b, p5a, p5b, p6a, p6b %or%c %bytearray b(0:19))) %recordformat maf(%integer buff no, %byteinteger mlen, %c mtype, (%byte len, type, %c (%bytearray m(0:242) %or %c %integer ref, in ident, out ident, %string (63) address) %or %c %bytearray a(0:240))) #fi #if ~x %recordformat pe(%byteinteger ser, reply, %c fn, gate port, %record (mef) %name mes, (%byte c1, s1 %or %c %integer c)) #else #if ~b %recordformat pe(%byteinteger ser, reply, %c (%integer a, b, (%integer c %or %byte c1, c2) %or %byte fn, a2, %c (%record(mef)%name mes, %byte gate port, task port %or %c %string (3) facility))) #else %recordformat pe(%byteinteger ser, reply, %c (%integer a, b, (%integer c %or %byte c1, c2) %or %byte fn, a2, %c (%integer buff no, %byte gate port, task port %or %c %string (3) facility))) #fi #fi %recordformat qf(%record (mef) %name e) #if t %constinteger maxtrace = 31; !keep to power of 2 minus 1 %recordformat tracef(%byte ostate, type) ! types of trace entry %constinteger tconnect = 1 %constinteger taccept =2 %constinteger tdisconnect = 3 %constinteger treset = 4 %constinteger tsendconnect = 5 %constinteger maxnettype = 5 %constinteger tallocate = 6 %constinteger tconn = 7; !needs two values for the two streams %constinteger tsusp = 9; !needs two values for the two streams %constinteger tabort = 11; !needs two values for the two streams %constinteger tenable = 13; !needs two values for the two streams %constinteger tdisc = 15; !needs two values for the two streams %constinteger trefuse = 17 %constinteger tacc = 18 %constinteger tclear = 19 %constinteger tdeallocate = 20 %constinteger maxtype = 20 %ownstring (12) %array tmessage(1:maxtype) = "connect","accept", "disconnect", "reset", "sendconnect", "allocate", "i connect", "o connect", "i suspend", "o suspend", "i abort", "o abort", "i enable", "o enable", "i disconnect", "o disconnect", "refused", "accepted", "clear", "deallocate" #fi !******************************************************** !* formats of tables, ie stream descriptors, tcps etc * !******************************************************** #if ~b %recordformat con desf(%record (mef) %name hold, %c #else %recordformat con desf(%integer hold, %c #fi %integer index, stream, permit, node, term, first, istate, %c o state, port, mode, kill, direction, in, n, icount, ref, outlen, %c cpos, count, nc, secadd, %c #if k max data len, #fi #if t %integer tracep, %record (tracef) %array trace(0:maxtrace), #fi #if ~b %record (mef) %name holdi, %record (qf) inp q) #else %integer holdi, %record (qf) inp q) #fi !************************************************************ !* upper level (itp&ftp) handler messages to gate !************************************************************ #if ~x %constinteger enable facility = 1; ! enable the facility ! %constinteger disable facility = 2; ! the reverse %constinteger call reply = 3; ! reply to a 'call connect' %constinteger enable input = 4; ! allow a block to be read %constinteger put output = 5; ! send a block of output %constinteger close call = 6; ! terminate a call %constinteger abort call = 7; ! abort the call %constinteger open call = 8; ! open up a call %constinteger open message = 9; ! send a message !********************************************************** !* messages from gate to upper level protocols !********************************************************** %constinteger incoming call = 2 %constinteger input recd = 3; ! block arrived from node %constinteger output transmitted = 4; ! prepared to accept more %constinteger call closed = 5; ! either end has closed down %constinteger call aborted = 6; ! other end has aborted %constinteger open call a = 7 %constinteger open call b = 8; ! reply from remote %constinteger message r = 9; ! message rec'd %constinteger message reply = 10; ! message reply from gate #else #if k %include "tsbsp_tscodes" #else %include "b_ygatecalls" #fi #fi !************************************************************** !* buffer manager calls (from and to) * !************************************************************** ! %constinteger buffer here = 0 !********** to buffer manager *********** %constinteger request buffer = 0 %constinteger release buffer = 1 !************************************************************** !* calls to 2900 link handler * !************************************************************** %constinteger send data = 0 %constinteger low level control = 1 %constinteger here i am = 2 %constinteger return control = 3 !************************************************************** !* replies from 2900 link handler * !**************************************************************** %constinteger interf addr = 0 %constinteger do input = 1 %constinteger do output = 2 %constinteger message = 3 %constinteger mainframe up = 4 %constinteger mainframe down = 5 !**************************************************************** !********** various service numbers ************* #if ~x ! k %constinteger gate ser = 16 #else %constinteger gate ser = 24 #fi %constinteger buffer manager = 17 %constinteger link handler = 18 %constinteger t3 ser = 21 %constinteger comm bit = k'1' %constinteger accept char = k'002' %constinteger acfy = k'010'; ! peter calls it rxfy %constinteger xopl = k'020'; ! x operable - latched ! %constinteger xop = k'040'; ! x operable %constinteger ready = k'200' #if ~k %constinteger ts accept = 17 #fi !********************* FTP Transfer Control Commands ************* %constinteger ss = x'40'; ! Start of Data %constinteger cs = x'42'; ! Code Select %constinteger es = x'43'; ! End of Data %constinteger qr = x'46'; ! Quit %constinteger er = x'47'; ! End Acknowledge !******************* FTP Initialisation and Termination *************** %constinteger p stop = X'00'; ! Request Termination (from p) %constinteger q Stopack = X'05'; ! Acknowledge Termination (from q) !*********************************************************** !* 2900 states * !*********************************************************** %own %integer host state = 0; ! holds 2900 state %constinteger down = 0 %constinteger up = 1 !****************** comms control states ******************** %constinteger unused = 0 %constinteger disconnecting = 1 %constinteger connecting = 2 %constinteger suspending = 4; ! end of section or file %constinteger aborting = 5 %constinteger enabling = 7 %constinteger enabled = 8 !* s t a t e s %constinteger not alloc = -1 %constinteger idle = 0 %constinteger trying = 1; ! awaiting network reply %constinteger timing = 2; ! connection refused, waiting for clock %constinteger aborted = 3; ! 2900 has gone down %constinteger Emas Dwn = 4; ! emas went down, waiting for net %constinteger wait ts = 5; ! fix Xgate YB problems %constinteger connect 1 = 6; ! lev3 connected, waiting for ! 2900 connect&enable %constinteger connected = 7; ! in file %constinteger enabld = 8; ! 2900 has started file %constinteger Conn Lost = 9; ! Disc before accept received on in call %constinteger closing = 10; ! close has been sent to network !****************************************** !* reasons for waiting for a buffer * !****************************************** %constinteger low level ip transfer = 22 %constinteger low level op transfer = 23 %constinteger get op block = 24 %constinteger send abort = 25; ! ask emas to abort stream %constinteger do input connect = 27 %constinteger connecting reply = 29; ! keep this odd (see from buffer manager) %constinteger connecting reply 2 = 30 %constinteger connecting reply failed = 31 %constinteger connecting reply 2 failed = 32 #if x %constinteger get connect buffer = 33 #if k %constinteger send push = 34; !send zero len data with push #fi #fi !************************************************************** #if t %routinespec puttrace #fi %routinespec do enable facility(%string (11) address) %routinespec to gate(%integer fn, %record (mef) %name mes, %c %integer flag) #if ~b %routinespec to 2900(%integer fn, %record (m2900f) %name m2900) #else %routinespec to 2900(%integer fn, buff no) #fi %routinespec get buffer(%integer reason) %routinespec free buffer(%record (mef) %name mes) %routinespec who and state %routinespec tell %routinespec from gate %routinespec from 2900 %routinespec do connect %record (con desf) %mapspec get free des %routinespec flush file %routinespec from buffer manager(%record (pe) %name p2) %integerfnspec allocate stream(%record (con desf) %name d) %routinespec tidy buffers %routinespec retrieve(%record (con desf) %name d) %routinespec do repm(%integer flag) %routinespec clear all streams %routinespec read from am1 %routinespec write to am1 %routinespec read message from am1 %routinespec write message to am1 %routinespec mon mes(%record (mef) %name mes) !****************************************************** %record (pe) p %owninteger con sub id reply = 1; ! picks up from actual mess %ownrecord (con desf) %name d %ownrecord (con desf) %name d4, d5 #if t %constinteger con lim = 13; ! number of active terminals (see fixed top) #else %constinteger con lim = 25; ! number of active terminals (see fixed top) #fi %ownrecord (con desf) %array con desa(0:con lim) %ownrecord (qf) %name free des; ! pts to list of free con desa %record (qf) %name q frig #if x %ownstring (73) %array adda(0:conlim) #fi #if ~x %constinteger max ports = 50 %ownbyteintegerarray porta(0:max ports) ! cross index from port to tcp #fi %constinteger fixed = 350; ! 1st available stream %constinteger fixed top = 399; ! number of 2900 streams in eam5 ! was 281 ! #if b %recordformat hold bufff(%record (hold bufff) %name link, %integer buff no) %record (holdbufff) %array hba(0:100) %record (holdbufff) %name free hold #fi !* * * * * * * * * * * * * * * * * * %ownrecord (qf) %name buffer pool; ! =k'142472' %owninteger no of buff = 0, bh = 0 %owninteger max buff = 4 %owninteger mon = 0; ! monitoring flag (set to 'O') #if ~k %owninteger data len = 120; ! cut down length for pss #fi %owninteger spec mon = 0, special flag = 0 %owninteger out pos = 0 %owninteger ftpi = 0; ! no of ftp packets %owninteger ftpo = 0 #if r %constinteger initial permit = 2 #if k %constinteger header len = 0, header m len = 0 #else %constinteger header len = 2, header m len = 2 #fi #else #if x #if k %constinteger initial permit = 1 #else %constinteger initial permit = 2 #fi %constinteger header len = 0 #else %constinteger initial permit = 1; ! = 2 for ring %constinteger header len = 6, header m len = 10 #fi #fi %ownstring(1) snil = "" %ownstring (63) called, calling %ownstring (73) qual; ! nb: Emas address moved through it %ownstring (1) disqual #if k %ownstring (5) window = "W=1/1" #else %ownstring (5) window = "" #fi ! l o g g i n g o n %integer i %conststring (7) %array ostates(-1:closing) = "not all", "Idle", "asking", "timing", "abortng", "EmasDwn", "Wait Ts", "chcking", "conning", "going", "ConLost", "close" #if ~x %ownstring (15) ad1, ad2, ad3 #fi #if c %routinespec mark(%integer type) %constintegername clock st == k'12540'; ! in seg 0 %constintegername clock cnt == k'12544' %constinteger clock start = k'31'; ! 100khz, up, multiple, no ints %owninteger tpt %ownbytearray typen(0:511) %ownintegerarray timer(0:511) #fi !********************************************** !* initialisation * !********************************************** #if i use tt(t3 ser) #else change out zero = t3 ser #fi %cycle i = con lim, -1, 2 con desa(i)_index = i; con desa(i)_o state = not alloc qfrig == con desa(i) qfrig_e == free des free des == qfrig %repeat con desa(1)_index = 1 condesa(0)_stream = 6 con desa(1)_stream = 7 #if b %cycle i = 100, -1, 2 hba(i-1)_link == hba(i) %repeat free hold == hba(1) #fi printstring(vsn) #if e printstring(" ERCC") #else printstring(" kent") #fi #if r printstring(" ring ") #else #if x #if b printstring(" (Big)") #fi printstring(" ts") #else printstring(" nsi") #fi #if b printstring(" big ") #fi #fi printstring(datestring) newline map hwr(0); ! map am1 to segment 0 #if ~b i = map virt(buffer manager, 5, 4); ! map buff man stack to seg 4 i = map virt(buffer manager, 6, 5) #fi d == con desa(0) d4 == d d5 == con desa(1) p_c = 6; ! param for 'here i am' #if ~b to 2900(here i am, null) #else to 2900(here i am, 0) #fi p_c = 7 #if ~b to 2900(here i am, null) #else to 2900(here i am, 0) #fi #if ~x to gate(enable facility, null, 16) #else do enable facility("FTP") do enable facility("MAIL") #if ~k do enable facility("X"); ! NB: very special for GEAC #fi #fi #if c clock st = clock start #fi alarm(500); ! set clock for 10 secs !********************************************** !* main loop * !********************************************** %cycle p_ser = 0; poff(p) %if int # 0 %start %if 'M' <= int <= 'P' %start mon = int-'O' printstring("ok ") %finish #if c %if int = 'T' %start select output(1) i = tpt %cycle write(typen(i), 2); write(timer(i), 4) write(timer(i)-timer(i-1), 4); newline i = (i+1)&511 %exit %if i = tpt %repeat select output(0) mark(99) %finish #fi %if '1' <= int <= '7' %start window = "W=2/2" charno(window,3) = int; charno(window,5) = int %finish %if int = '?' %start printstring("Buff ="); write(bh, 1) printstring(", Pool ="); write(no of buff, 1); newline %cycle i = 2, 1, con lim d == con desa(i) %if d_o state # not alloc %start printstring("ftp:") who and state newline %if out pos > 30 printstring("p ="); write(d_port, 1) printstring(", oc ="); write(d_nc, 1) printstring(", ist ="); write(d_istate, 1) printstring(", ic ="); write(d_icount, 1) printstring(", om ="); write(d_mode, 1) printstring(", if ="); write(d_first, 1) printstring(", op ="); write(d_permit, 1) newline %finish %repeat newline %finish %if int = 'C' %start; ! close output select output(1); ! select it #if t %for i=2, 1, conlim %cycle d == con desa(i) puttrace %repeat #fi close output printstring("done ") %finish %if int = 'S' %then max buff = 4-max buff int = 0 %finish %if p_reply = link handler %start from 2900 %finish %else %if p_reply = gate ser %start from gate %finish %else %if p_reply = buffer manager %start from buffer manager(p) %finish %else %if p_reply = 0 %start; ! clock tick %cycle i = con lim, -1, 0 d == con desa(i) %if d_o state = timing %start d_count = d_count-1 %if d_count <= 0 %then d_o state = idle %and do connect %finish %repeat alarm(100); ! 2 secs %finish %repeat !************************************************* !* routines to do the work * !************************************************* #if t %routine trace(%integer type) !---------------------------- d_trace(d_tracep)_type = type d_trace(d_tracep)_ostate = d_ostate d_tracep = (d_tracep + 1) & maxtrace %end %routine puttrace !---------------- %integer t, p, first %record (tracef) %name tr first = 1 p = d_tracep %cycle tr == d_trace(p) %if tr_type # 0 %start %if first # 0 %start who and state; !only output if there's something there newline first = 0 %finish t = tr_type %if t <= maxnettype %then printstring("network ") %elsec printstring("emas ") printstring(tmessage(t)) spaces(13-length(tmessage(t))) %if tr_ostate <= closing %start printstring("state:") printstring(ostates(tr_ostate)) %finish newline %finish p = (p+1) & maxtrace %repeatuntil p = d_tracep %end #fi #if k %routine stoi(%integername ans, %string (*) %name s) !----------------------------------- %integer n, i, c n = 0 %if length(s)=0 %thenreturn %for i = 1, 1, length(s) %cycle c = charno(s, i) %if '0'<=c<='9' %start n = n*10+c-'0' %finishelseexit %repeat ans = n %end %routine decode quality(%string (*) %name s, %integername maxdatalenin, maxdatalenout) !------------------------------------------------------------------------------- %string (31) x,y maxdatalenin=0 maxdatalenout=0 %if s->x.("P=").y %start; ! y begins with .../..., %if y->x.("/").y %start stoi(maxdatalenout, x) stoi(maxdatalenin, y) %finish %finish %end #fi %routine crunch(%integer n) %integer i who and state; newline %cycle i = 1, 1, 10 printstring("**** ftps failed"); write(n, 1); printstring(" - dump it *** ") %repeat *=k'104001'; ! emt wait %end #if c %routine mark(%integer type) typen(tpt) = type timer(tpt) = clock cnt tpt = (tpt+1)&511 %end #fi #if b %routine bpush(%record (qf) %name q, %integer buff no) %record (hold bufff) %name bf bf == free hold free hold == bf_link bf_buff no = buff no push(q, bf) %end %integerfn bpop(%record (qf) %name q) %record (hold bufff) %name bf %integer x bf == pop(q) x = bf_buff no bf_link == free hold free hold == bf %result = x %end %record (mef) %map map(%integer buff no) ! buff no is already in r0 - where its wanted %result == null %if buff no = 0 *mov_#10,1; ! desired vm seg no *2 ie 5*2 *iot %result == record(k'120000'); ! allow 3 code segs for now %end %routine free buff no(%integer buff no) ! not mapped, so send it straight back %record (pe) p %return %if buff no = 0; ! rest of code is very loose on this p_ser = buffer manager; p_reply = id p_fn = release buffer p_buff no = buff no pon(p) bh = bh-1 %end #fi %routine do enable facility(%string (11) address) %record (mef) %name mes p_ser = buffer manager; p_reply = id p_fn = request buffer ponoff(p) p_ser = gate ser; p_reply = own id p_fn = enable facility; p_a2 = 1 #if ~b mes == p_mes #else mes == map(p_buff no) #fi string(addr(mes_params)) = address pon(p) %end %routine to gate(%integer fn, %record (mef) %name mes, %c %integer flag) %if mon < 0 %start select output(1); printstring("To gate:"); write(fn, 1) printstring(" on task port "); write(d_index, 1) printstring(", Gate Port"); write(d_port, 1) printstring(", Flag"); write(flag, 1); newline select output(0) %finish %if fn = put output %start; ! queue these as necessary %if mon = -1 %or spec mon # 0 %start spec mon = 0 select output(1) printstring("io "); mon mes(mes) %finish ftpo = ftpo+1 %if addr(mes)&k'140000'=k'140000' %or addr(mes)&k'77'#0 %then crunch(1) %finish p_ser = gate ser; p_reply = own id #if ~x p_fn = fn; p_gate port = d_port; p_mes == mes; p_s1 = flag #else p_fn = fn; p_gate port = d_port; p_task port = d_index p_a2 = flag %if mes == null %start #if ~b p_mes == null #else p_buff no = 0 #fi %else #if ~b p_mes == mes #else p_buff no = mes_buffno crunch(99) %unless k'4000' <= p_buff no <= k'7777' #fi bh = bh-1 %finish #fi pon(p) %end #if ~b %routine to 2900(%integer fn, %record (m2900f) %name m2900) #else %routine to 2900(%integer fn, buff no) #fi p_ser = link handler; p_reply = own id p_fn = fn #if ~b p_mes == m2900 %unless m2900 == null %start bh = bh-1 %if m2900_stream < 5 %or m2900_stream > fixed top %then crunch(11) %if m2900_stream > 10 %and m2900_stream < fixed %then crunch(12) %finish #else p_buff no = buff no bh = bh-1 %unless buff no = 0 #fi pon(p) %end %routine get buffer(%integer reason) %record (pe) p #if b %record (holdbufff) %name hb #fi !******************************************************* !* hold a pool, so can call buffer here immedialtely* !* otherwise hold the activity until it arrives* !******************************************************* #if ~x %if reason = get op block %c %then p_c1 = 0 %else p_c1 = 1 #else %if reason = get op block %or reason = get connect buffer %c %then p_c1 = 0 %else p_c1 = 1 #fi ! ****** watch the above line ******** (big or small buffer) #if ~x p_s1 = reason; p_gate port = d_index %if buffer pool == null %or p_c1 # 0 %start; ! have to ask for it #else p_c2 = reason; p_a2 = d_index %if buffer pool == null %or p_c1 # 0 %start; ! have to ask for it #fi p_ser = buffer manager; p_reply = own id p_fn = request buffer pon(p) %else #if ~b p_mes == buffer pool; buffer pool == p_mes_link p_mes_link == null #else hb == buffer pool buffer pool == hb_link p_buff no = hb_buff no hb_link == free hold free hold == hb #fi bh = bh-1; ! from buff adds one back on no of buff = noof buff-1; from buffer manager(p) %finish %end %routine free buffer(%record (mef) %name mes) %record (pe) p #if b %record (holdbufff) %name hb #fi %if addr(mes)&k'140000'=k'140000' %or addr(mes)&k'77'#0 %then crunch(2) %if mes_type # 0 %or no of buff >= max buff %start p_ser = buffer manager; p_reply = own id !! queue it if it is a long buffer p_fn = release buffer #if ~b p_mes == mes #else p_buff no = mes_buff no #fi bh = bh-1 pon(p) %else !! long buffer, so queue it #if ~b mes_link == buffer pool; buffer pool == mes #else hb == free hold; free hold == hb_link hb_buff no = mes_buff no hb_link == buffer pool buffer pool == hb #fi no of buff = no of buff+1 %finish %end !! %routine tell %string (*) %name s write(d_index, 2); space %if d_direction = 0 %start printstring("ftp-Q ") #if x s == adda(d_index) printstring(s) #fi %else printstring("ftp-P ") #if x s == string(addr(adda(d_index))+1) printstring(s) #fi %finish #if ~x write(d_term, 1) #else #fi space out pos = length(s) %end %routine who and state tell printsymbol('(') printstring(ostates(d_o state)) printstring(") ") %end #if k & x %routinespec pack(%record(mef) %name mes, %string (*) %name s) %routine reject connect(%integer reason, %string (12) explan, %c %record (mef) %name mes) %unless mes==null %start mes_len=0 pack(mes, snil) pack(mes, explan) %finish p_a2=reason p_task port=0 p_fn=disconnect p_mes == mes p_ser = gate ser; p_reply = own id pon(p) %end #else %routine plant fail(%integer type, %record (mef) %name mes) #if ~x #if n %record (lev3f) %name ssmessage ssmessage == mes_lev3 ssmessage_aa(0) = 1; ssmessage_aa(1) = type mes_len = header m len + 2 #else %record (SSMESSAGEF) %name ssmessage ssmessage == mes_lev3 ssmessage_a(0) = 1; ssmessage_a(1) = type mes_len = header m len+2-1; !$e #fi #else disqual = to string(type) #fi %end #fi #if ~x %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 #fi #if x %routine fault(%integer n, state) printstring("Ftp:Fault:"); write(n, 1) who and state %unless d == null printstring(" Expected state:"); printstring(o states(state)) newline %end %string (127) %fn unpack(%record (mef) %name mes, %integer no) %integer i, l %unless mes == null %or mes_len<=0 %or no<=0 %start l = 0 %while no>1 %cycle l=l+mes_params(l)+1 no = no-1 %repeat %result = string(addr(mes_params(l))) %finish %else %result = "" %end %routine pack(%record(mef) %name mes, %string (*) %name s) string(addr(mes_params(mes_len))) = s mes_len = mes_len+length(s)+1 %end #fi ! r o u t i n e f r o m g a t e %routine from gate %record (mef) %name mes #if n!x %record (lev3f) %name ssmessage #else %record (ssmessagef) %name ssmessage #fi %recordformat p3f(%byteinteger ser,reply,fn,port,a,b,c,d) %record (p3f) %name p3 %integer fn, flag, strm, i, trm, fac, d1, d2, buff no %integer node, state #if ~x %switch fns(incoming call:control data) #else #if k %switch fns(connect:datagram) %integer max data len in, max data len out #else %switch fns(connect:control data) #fi #fi #if x %routine discres printstring(", reason ="); write(p_a2, 1) #if k newline #else write(d1, 1); write(d2, 1); newline #fi %end #fi #if b %if p_buff no = 0 %then mes == null %else %start mes == map(p_buff no); bh = bh+1 buff no = p_buff no %finish #else mes == p_mes %unless mes == null %then bh = bh+1 #fi fn = p_fn #if ~x strm = p_gate port d == con desa(porta(strm)) #else strm = p_task port d == con desa(strm) #fi state = d_o state #if m %if mon < 0 %start select output(1) printstring("From Gate, fn="); write(fn, 1) printstring(", G Port ="); write(p_gate port, 1) printstring(", T Port ="); write(p_task port, 1) printstring(", Flag ="); write(p_a2, 1) newline select output(0) %finish #fi ->fns(fn) #if ~x fns(incoming call): #else fns(Connect): strm = p_gate port; ! remember gate port no #fi flag = 0; ! reject if all else fails #if x disqual = "" #fi #if c mark(30) #fi %if host state = down %start #if k & x reject connect(tserr down, "System down", p_mes) %return #else #if ~x plant fail('d', p_mes) #else flag = x'fd' #fi -> reply #fi %finish #if ~x ssmessage == mes_lev3 #if e #if r node = ssmessage_sn; trm = ssmessage_st; ! nsi mod %if node=0 %then trm = p_c1; ! source is on ring #else; ! nsi node = p_mes_lev3_sn; trm = p_mes_lev3_st #fi #else node = 0; trm = p_c1; #fi #fi d == get free des %if d == null %start #if k reject connect(tserr busy, "System full", p_mes) %return #else flag = x'fe' -> reply #fi %finish #if n d_permit = p_c1; ! remember the for/rev buff lim (nsi mod) #fi #if n i = p_mes_lev3_luflag; ! pickup 'f' number d_secadd = i&x'7f'; ! nb: in the network, x'80' is not present #else #if ~x d_secadd = ssmessage_ds>>8; ! Fn portion of address is here #fi #fi #if t trace(tconnect) #fi !! construct a message to the 2900 ******* i = allocate stream(d); ! both streams d_direction = 0; ! 0 = incoming, 1 = outgoing #if ~x d_node = node; d_term = trm #else #if ~b d_holdi == mes; ! retain the message #else d_holdi = buff no; buff no = 0 #fi #fi d_o state = connect 1; ! wait for confirmation d_nc = 0 #if m #fi #if ~x d_port = p_gate port; ! remember gate port no porta(p_gate port) = d_index; ! backward mapping #else d_port = strm; ! remember gate port no #fi get buffer(do input connect) %return; ! Asking the 2900, so wait #if ~k reply: #if x ! no descriptor, so reply now p_ser = gate ser; p_reply = own id p_mes == null p_fn = Disconnect; p_a2 = flag pon(p) free buffer(mes) #else do repm(flag) #fi %return #fi #if ~x fns(input recd): #else fns(Input Here): #fi ftpi = ftpi+1 #if c mark(1) #fi %if state = not alloc %start; ! X-over (tighten up check ????) free buffer(mes) printstring("Ftps: Invalid Buffer from Gate, stream =") write(d_index, 1); newline %finish #if ~b %if d_inp q_e == null %and d_holdi == null %start #else %if d_inp q_e == null %and d_holdi = 0 %start #fi !! stream is waiting for a network buffer get buffer(low level ip transfer) %if state = enabld d_in = 0; ! into buffer pointer, and kick 2900 ! if the stream is able to go %finish %if mon = -1 %start select output(1) printstring("In "); mon mes(mes) select output(0) %finish #if ~b push(d_inp q, mes); ! q buffer anyway #else bpush(d_inp q, mes_buff no); ! q buffer anyway #fi d_nc = d_nc+1; ! count it %return #if ~x fns(output transmitted): #if c mark(10) #fi i = d_permit d_permit = d_permit+1 #else fns(Enable Output): #if c mark(10) #fi i = d_permit d_permit = d_permit+p_a2 #fi %if i = 0 %and state = enabld %then %c get buffer(get op block) %return #if ~x fns(call closed): fns(call aborted): ! all is lost #else fns(Disconnect): %unless mes == null %start #if ~k d1 = mes_lev3_reserved(2); d2 = mes_lev3_reserved(3) #fi free buffer(mes) %finish %if strm = 0 %start; ! disconnect before Accept ! %cycle i = 2, 1, con lim d == con desa(i) %if p_gate port = d_port %start who and state printstring("Disc before acc ") d_o state = Conn Lost; %return %finish %repeat printstring("Disc on unknown strm ="); write(strm, 1) discres; newline %return %finish #fi #if t trace(tdisconnect) #fi %if state = closing %start %if mon < 0 %start tell; printstring("close ack ") %finish to 2900(low level control, d_hold) #if ~b d_o state = idle; d_hold == null #else d_o state = idle; d_hold = 0 #fi %else #if x ! hold disconnect params for spoolr #if ~k d_term = d2<<8!d1; ! effectively swabbed for spoolr %if p_a2 # 139 %then d_term = 0; ! if not 'call closed' - no info #else d_term = 0 #fi %if state = trying %or state = wait ts %start %if state = wait ts %then to gate(Disconnect, null, 1) d_nc = d_nc+1; d_port = flag; ! remember reason d_o state = timing; ! try again soon d_count = 22; ! after 45 secs %if mon = -1 %start tell; printstring("ConRej"); discres %finish %return %finish #fi #if k %if mon # 0 %or p_a2 > 1 %start; !monitoring or an abort #else %if mon # 0 %or d1 > 1 %start #fi who and state printstring("network abort") #if x discres #else newline #fi %finish %if state = not alloc %then %return; ! very nasty *************** %if d_o state >= connected %start get buffer(send abort); ! get emas to abort stream #if ~x to gate(abort call, null, 0); ! reply to gate to clear port #else #if k to gate(Disconnect, null, 1); ! reply to gate to clear port #else to gate(Disconnect, null, 255); ! reply to gate to clear port #fi #fi %finish %if state = Emas Dwn %then retrieve(d) %else %start %if state = aborted %start %if d_nc = 99 %then d_nc = 97 %else retrieve(d) ! when its trying, and a deall comes in, must wait for ! LAST of disconnect & get buff(con repl %finish %else d_o state = idle %finish %finish %return #if ~x fns(open call a): ! allocated port no d == con desa(p_gate port) !! p_gate port < 0 (ie failed!) #if n d_port = p_s1; ! note: nsi difference (and 2 lines below) #else p3 == p d_port = p3_a #fi %if d_port = 0 %then p_s1 = 125 %else %start porta(d_port) = p_gate port %return %finish !* d_port = 0 => no gate ports, so treat as a open call b !* with error flag = 125 fns(open call b): ! reply from remote device flag = p_s1; ! success/fail flag #else fns(Accept Call): #fi #if t trace(taccept) #fi %if d_o state # trying %and d_o state # aborted %and %c d_o state # Emas Dwn %start acc fai: fault(3, trying) %return %finish %if d_index < 2 %then -> acc fai; ! not assigned #if x #if k qual = unpack(mes, 2) decode quality(qual, max data len out, max data len in) d_max data len = max data len out #fi free buffer(mes) %unless mes == null d_port = p_Gate Port #fi %if state = aborted %or state = Emas Dwn %start !! connection established ! #if ~x %if flag#0 %then retrieve(d) %else %start to gate(abort call, null, 0) %finish #else #if k to gate(Disconnect, null, tserr crash) #else to gate(Disconnect, null, 1) #fi #fi %return %finish #if ~x %if flag # 0 %start d_nc = d_nc+1; d_port = flag; ! remember reason d_o state = timing %else #fi d_permit = initial permit; ! nsi change #if k get buffer(connecting reply); !get buffer to trply to spoolr get buffer(connecting reply 2);!and for the other stream d_o state = connected #else d_o state = wait ts; ! must wait for YB accept (Xgate problems) #fi d_nc = 0 d_count = 0 #if ~x %finish #fi %return #if ~x fns(message r): ! incoming login or enquiry fns(message reply): ! reply to sendmessage #else fns(reset): #if t trace(treset) #fi free buffer(mes) %unless mes == null %if mon # 0 %start tell; printstring("Reset ! ") %finish %if state = closing %then to gate(reset, null, 0) %and %return chop connection: #if k to gate(Disconnect, null, tserr reset) #else to gate(Disconnect, null, 1) #fi %unless state = wait ts %start %if d_o state # aborted %and d_o state # Emas dwn %start d_o state = idle get buffer(send abort); ! and tell 2900 call gone %finish %else d_o state = trying %finish %return #if k fns(expedited data): #else fns(Expedited): #fi tell; printstring("Expedited ! ") -> chop connection #if ~k fns(control data): %if state = wait ts %start d_o state = connected get buffer(connecting reply); ! tell EMAS to go get buffer(connecting reply 2); ! and second stream %if mon < 0 %start who and state; printstring("TS Conn. ") %finish %finish to gate(Enable input, null, 1) free buffer(mes) %return #fi fns(*): #fi crunch(3) %end !! r o u t i n e from 2900 !! all messages from the 2900 come to this routine %routine from 2900 %record (m2900f) %name m2900 %record (m2900f) %name m2900b %integer stream, sub ident, state, mode, am1c, type, nsta, buff no %integer p2a, p2b, ioflag %switch link fns(interf addr:mainframe down) %switch com state(disconnecting:enabled) %switch com state b(disconnecting:enabled) #if ~b m2900 == p_mes; m2900b == m2900 #else buff no = p_buff no m2900 == map(buff no); m2900b == m2900 #fi %if p_fn = message %start stream = m2900_stream; ! get first stream no %finish %else stream = p_c %if stream < fixed %or stream > fixed top %then d == null %else %c d == con desa((stream-fixed+4)>>1) -> link fns(p_fn) link fns(interf addr): ! interface addr from eam5 #if ~b l == record(addr(p_mes)&k'17777'); ! force to seg 0 #else l == record(p_buff no&k'17777'); ! force it to seg 0 #fi %return link fns(do output): ! -> 11/34 %if stream = 7 %then read message from am1 %else %c read from am1 %return link fns(do input): ! -> 2900 %if stream = 6 %then write message to am1 %else %c write to am1 %return link fns(mainframe down): link fns(mainframe up): host state = down clear all streams %return link fns(message): bh = bh+1 sub ident = m2900_sub ident state = m2900b_b(1); mode = m2900b_b(0)&x'f0' ! mode = 0 - seq, 1 - circ, 2 - seq cont ! = x'10' - iso, x'20' - ebc, x'30' - bin ! = x'40' - normal FTP (data phase) ! = x'50' - default emas to emas FTP (data) ! = x'60' - Negitiation Phase FTP p2a = m2900_p2a; p2b = m2900_p2b m2900_p2a = 0; m2900_p2b = 0 %if sub ident # 0 %start; ! low level !****************************************** !* l o w l e v e l control message !****************************************** ioflag = stream&1; ! ioflag = 1 => 2900 o/p %if mon < 0 %start select output(1) printstring("from 2900 "); who and state %unless d == null write(stream, 2) write(sub ident, 2); write(state, 2); write(mode, 2) newline select output(0) %finish %if stream <= 7 %start %if stream = 6 %then d ==d4 %else d == d5 ->com state b(state) %finish %if d == null %or d_o state = not alloc %or d_o state = Emas Dwn %start printstring("ftps: stream?"); write(stream, 1); fault(1, Idle) -> control reply %finish -> com state(state) com state(enabling): #if t trace(tenable+ioflag) #fi #if c mark(21) #fi -> control reply %if d_o state = idle fault(9, Connected) %unless connected<=d_o state 0 %start #if ~b %if d_hold == null %start #else %if d_hold = 0 %start #fi get buffer(get op block) %else type = low level op transfer #if ~b do trans and reply: to 2900(low level control, m2900) #else do trans and reply: to 2900(Low level control, m2900_buff no) #fi get buffer(type) %return %finish %finish %else %if mode = x'40' %then nsta = 10; ! normal Ftp data %if mode = x'50' %then nsta = 5; ! Default Emas-Emas %if mode = x'60' %then nsta = 0; ! Neg phase %if d_icount = 0 %start d_istate = nsta; ! accept new state %if mon = -1 %then newline %else %if mon = -1 %then printstring(" (nsc) ") %finish d_first = x'ff' #if ~b %unless d_holdi == null %and d_inp q_e == null %c #else %unless d_holdi = 0 %and d_inp q_e == null %c #fi %then type = low level ip transfer %and -> do trans and reply %finish -> control reply com state(connecting): #if t trace(tconn+ioflag) #fi #if c mark(20) #fi con sub id reply = m2900_sub ident; ! retain for reply %if ioflag # 0 %start; ! output d_nc = 0 %if d_direction # 0 %start %if mon < 0 %then tell %and printstring("out conn ") %if d_o state = Idle %then do connect %else %c Fault(2, Idle) %finish %else -> control reply %else; ! input d_icount = 0; ! always allow state change after conn %if d_o state = connect 1 %start p_gate port = d_port; ! for repm #if n do repm(d_permit); !ok - nsi mod #else do repm(1); ! ok #fi d_o state = connected d_permit = initial permit -> control reply %finish %if d_o state = Conn Lost %start get buffer(send abort) d_o state = idle -> control reply %finish %finish #if ~b free buffer(m2900); ! reply is made up when actually connected #else free buff no(buff no); ! reply is made up later #fi %return com state(disconnecting): #if t trace(tdisc+ioflag) #fi #if c mark(22) #fi %if aborted # d_o state # idle %and ioflag # 0 %start ! this must only be done on one stream !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! fault(4, connected) %if d_o state # connected d_o state = closing #if ~b %unless d_hold == null %then free buffer(d_hold) ! note: It can easily do one more ! 'request' for o/p than needed d_hold == m2900 #else %unless d_hold = 0 %then free buff no(d_hold) ! more than one can be 'requested' d_hold = m2900_buff no #fi %if mon < 0 %then tell %and printstring("Disconnecting call ") #if ~x to gate(abort call, null, 0); ! issue to gate #else to gate(Disconnect, null, 0) #fi %return; ! hold reply till later %finish -> control reply com state(aborting): #if t trace(tabort+ioflag) #fi %if mon < 0 %start tell; printstring("aborting ") %finish ->suspd com state(suspending): #if t trace(tsusp+ioflag) #fi flush file %if ioflag # 0 suspd: fault(5, enabld) %unless d_o state=idle %or d_ostate=enabld %or %c d_o state = connected d_o state = connected %if d_o state # idle %and ioflag = 0 ! susp on output does not stop input d_kill = state %unless d_kill = aborting; !remember type of call ! stop transfers unless its idle anyway control reply: #if ~b to 2900(low level control, m2900) #else to 2900(Low level control, buff no) #fi %return !! *********************************************** !! the following are all stream 6 & 7 manipulations !! ************************************************ com state b(enabling): d_o state = enabling d_mode = p2b; ! Buffer size %if stream = 7 %start host state = up printstring("Ftp: Up ") %finish -> control reply com state b(connecting): d_o state = connected d_n = 0; d_nc = 0; d_count = 0; d_mode = 0; d_cpos = 0 #if k printstring("ftp: logon stream"); write(stream, 1) printstring(" connected ") string(addr(m2900_p3a)) = "BSP"; ! flag tsbsp fep to spoolr #else string(addr(m2900_p3a)) = "X25"; ! flag x25 fep to spoolr #fi %if stream = 6 %then -> clear out com stateb(disconnecting): %if stream = 7 %then printstring("Ftp: Down ") com stateb(suspending): com stateb(aborting): d_o state = idle host state = down clear out: tidy buffers clear all streams -> control reply %finish !! high level control message d == d5 #if ~b free buffer(m2900) #else free buff no(buff no) #fi get buffer(get op block) %if d_nc = d_count; ! dont do twice d_nc = p2b; ! update pointer %end #if x %routine do connect fault(6, idle) %if d_o state # idle d_o state = trying get buffer(get connect buffer) %end %routine do actual connect(%record (mef) %name mes) #if k %integer i #fi #if t trace(tsendconnect) #fi qual = adda(d_index) called = string(addr(qual)+1) #if k %for i=1, 1, length(called) %cycle; !convert first . to / (temporary) %if charno(called, i) = '.' %then charno(called, i) = '/' %and %exit %repeat #fi calling = string(addr(qual)+length(called)+2) %if mon # 0 %and d_nc = 0 %start printstring("Connect to:"); printstring(called) printstring(", from:"); printstring(calling) newline %finish mes_len = 0 pack(mes, called) pack(mes, calling) pack(mes, window) pack(mes, snil); ! used to be EMAS - ftp but fast select prob. with Aus d_port = 0; ! ensure it goes out on port 0 #if k to Gate(Connect, mes, 0) #else to Gate(Connect, mes, 2) #fi %end #else %routine do connect #if n %recordformat p3f(%byteinteger ser, reply, %c fn, port, (%byteinteger facility, flag %or %c %record (mef) %name mes), %byteinteger node, term) #else %recordformat p3f(%byteinteger ser, reply, %c fn, port, (%byteinteger node, flag %or %c %record (mef) %name mes), %byteinteger term, facility) #fi %record (p3f) p3 ! note on se of 'flag' ! flag < 128 - standard NSI use - not used on ring ! flag > 128 - 128+F number - put in 'user flags' used as ! address extension for psse p3_ser = gate ser; p3_reply = own id #if ~x p3_fn = open call; p3_port = d_index p3_term = d_term p3_facility = 16 p3_node = d_node; !overwritten by k&r option below #fi #if r #if e %if d_secadd # 0 %then p3_flag = x'80'!d_secadd #else p3_facility=255; !16 bit facility number p3_flag=d_secadd; p3_node=16; !big facility no. #fi #else p3_flag = x'80'!d_secadd #fi d_o state = trying pon(p3) %end #fi %record (con des f) %map get free des qfrig == free des %if qfrig == null %start printstring("ftps: out of descriptors! **** ") %result == null %finish free des == qfrig_e qfrig_e == null %result == qfrig %end %routine flush file %integer len %record (mef) %name mes ! This pushes out the last block when 2900 sends suspend #if ~b mes == d_hold %unless mes == null %start d_hold == null #else %unless d_hold = 0 %start mes == map(d_hold) d_hold = 0 #fi %if d_o state # enabld %then free buffer(mes) %and %return ! transfer has been aborted while transfer was in progress len = d_n %if d_mode=x'50' %and d_n = d_cpos+1 %then len = len-1 ! 1 dummy length byte present #if k %if len < 0 %then len = 0 #else %if len <= 0 %then free buffer(mes) %else %start #fi #if n mes_lev3_suflag = 1 #else #if e&(~x) mes_lev3_uflag = x'0100' #fi #fi mes_len = len+header len; d_n = 0 d_permit = d_permit-1; ! for mode changing #if k to gate(put output, mes, 1); !push it %else get buffer(send push) #else to gate(put output, mes, 0) %finish #fi %finish %end %routine kick 2900 message(%record (maf) %name log) !! this routine sends 'log' to the 2900 by inserting !! it in the input q for stream 4, and kicking it if !! necessary d == d4 #if ~b %if d_hold == null %and d_inp q_e == null %then %c #else %if (d_hold = 0 %and d_inp q_e == null) %or d_cpos>5 %then %c #fi get buffer(do output) #if ~b push(d_inp q, log) #else bpush(d_inp q, log_buff no) #fi d_cpos = d_cpos+1 %end !! r o u t i n e from buffer manager !! all requests for buffers come back through here %routine from buffer manager(%record (pe) %name p2) %integer reason, type, strm %record (m2900f) %name m2900 %record (maf) %name log #if k %integer max data len in, max data len out #fi %integer lc1, lc2, buff no %record (mef) %name mes, mex %string (3) td #if ~b mes == p2_mes #else buff no = p2_buff no mes == map(buff no) #fi bh = bh+1 #if ~x reason = p2_s1; ! get reason for calling strm = p2_gate port #else reason = p2_c2; ! get reason for calling strm = p2_a2 #fi d == con desa(strm); ! and map to descriptor %if mon < 0 %start select output(1) printstring("from bm: reason, index") write(reason, 2); write(strm, 2); newline select output(0) %finish %if reason = get op block %start #if c mark(2) #fi #if ~b free buffer(d_hold) %unless d_hold == null; ! safety check d_hold == mes; d_n = 0 #else free buff no(d_hold) %unless d_hold = 0; ! safety check d_hold = buff no; d_n = 0 #fi get buffer(low level op transfer) %return %finish #if x ! Connect from Network, going to Spoolr ! The incoming buffer is used to hold the 'qual of service' ! the only required part of params (in a SHORT buffer) ! The incoming call buffer (LONG) is used to pass the params ! to Spoolr. ! #fi %if reason = do input connect %start #if c mark(31) #fi #if x Fault(7, Connect 1) %if d_o state # connect 1 #if ~b mex == d_holdi #else mex == map(d_holdi) #fi called = unpack(mex, 1) calling = unpack(mex, 2) %if charno(calling, 2) = '.' %then %c calling -> td.(".").calling qual = unpack(mex, 3) #if k decode quality(qual, max data len out, max data len in) d_max data len = max data len out #fi #if ~b log == mex; d_holdi == mes; ! swap the buffers #else log == mex; d_holdi = buff no; ! swap the buffers over #fi log_type = 4; ! new type for packed strings #else log == p2_mes log_type = 1 #fi log_in ident = swab(d_stream) log_out ident = swab(d_stream+1) log_ref = 0 #if ~x log_address = "N" log_address = log_address.itos(d_node, -1) log_address = log_address."T" log_address = log_address.itos(d_term, -1) %if d_secadd # 0 %start log_address = log_address.".F" log_address = log_address.itos(d_secadd, -1) %finish #else adda(d_index) = calling lc1 = length(called); lc2 = length(calling) %if lc1+lc2 > 256-12-3 %start printstring("In Len? ") printstring(calling); newline length(calling) = 0 %finish string(addr(log_address)+1) = called string(addr(log_address)+lc1+2) = calling length(log_address) = lc1+lc2+2 #fi %if mon # 0 %start write(d_index, 2) printstring(" Incoming call from:"); printstring(calling) printstring(" To "); printstring(called) newline %finish log_len = 5+2+1+length(log_address) kick 2900 message(log) #if b mes == map(buff no); ! map back to it #fi mes_str = qual; ! save qualifiers for reply to connect %return %finish #if x %if reason = get connect buffer %start do actual connect(mes) %return %finish #if k %if reason = send push %start p_mes_len = 0; !null data d_permit = d_permit - 1 to gate(put output, p_mes, 1); !pushed %return %finish #fi #fi !! message to 2900 reason !! note: streams 6&7 also use this mechanism m2900 == mes m2900_stream = d_stream m2900_sub ident = 10; m2900_p2a = 0; m2900_p2b = 0 type = low level control #if c mark(3) #fi %if reason = low level op transfer %and d_stream > 7 %then %c m2900_stream = m2900_stream+1 %if reason = send abort %start m2900_sub ident = 0 m2900_p3a = 0 m2900_p3b = 1 type = send data %finish %if connecting reply <= reason <= connecting reply 2 failed %start m2900_sub ident = con sub id reply %if reason >= connecting reply failed %then %c m2900_p2b = x'0a00'; ! = swab(10) %if reason&1 = 0 %then m2900_stream = m2900_stream+1 %if reason = connecting reply 2 failed %start %if d_nc # 99 %then retrieve(d) %else d_nc = 96 %finish %finish %if mon < 0 %start select output(1) printstring("to 2900, str, subid, p2b:") write(m2900_stream, 1); write(m2900_sub ident, 1) write(m2900_p2b, 1); newline select output(0) %finish #if ~b to 2900(type, m2900) #else to 2900(type, m2900_buff no) #fi %end %integerfn allocate stream(%record (con desf) %name d) !! nb: allocates two streams, one odd and the other even !! now totally dependant on d_index %integer i i = fixed-4+d_index<<1; ! index=2 -> fixed p_c = i; ! claim the stream #if ~b to 2900(here i am, null) #else to 2900(here i am, 0) #fi p_c = i+1 #if ~b to 2900(here i am, null) #else to 2900(here i am, 0) #fi d_stream = i %result = i %end %routine tidy buffers #if ~b free buffer(pop(d_inp q)) %while %not d_inp q_e == null free buffer(d_hold) %unless d_hold == null d_hold == null free buffer(d_holdi) %unless d_holdi == null d_holdi == null #else free buff no(bpop(d_inp q)) %while %not d_inp q_e == null free buff no(d_hold) %unless d_hold = 0 d_hold = 0 free buff no(d_holdi) %unless d_holdi = 0 d_holdi = 0 #fi %end %routine retrieve(%record (con desf) %name d) !! sever link between 2900 and descriptor and !! free the descriptor %if d_index < 2 %start fault(10, Not alloc); %return %finish tidy buffers d_o state = not alloc; d_term = -1 d_port = 0; d_node = 0; ! in X25, node is disconnect reason qfrig == d qfrig_e == free des free des == qfrig %end %routine do repm(%integer flag) !! sends a 'call reply' to gate, nb: assumes p_gate port = port number #if x %record (mef) %name mes %integer fn #fi p_ser = gate ser; p_reply = own id #if ~x p_fn = call reply; p_s1 = flag #else %if flag = 0 %then fn = Disconnect %else fn = Accept Call p_fn = fn; p_a2 = 0 p_task port = d_index #if ~b mes == d_holdi; d_holdi == null #else crunch(97) %if d_holdi = 0 mes == map(d_holdi); d_holdi = 0 #fi #if k qual = window; !window size of 1 #else qual = mes_str %if qual -> called.("P=256/256").calling %then %c qual = called."P=128/128".calling #fi mes_len = 0 pack(mes, snil) pack(mes, qual) pack(mes, snil) #if ~b p_mes == mes #else p_buff no = mes_buff no #fi #if m %if mon < 0 %start select output(1) printstring("Call reply:"); %if flag = 0 %then printstring %c ("Failed") %else printstring("Ok") write(p_task port, 1); write(p_gate port, 1); newline select output(0) %finish bh = bh-1 #fi #fi pon(p) %end %routine clear all streams !! used when emas goes down %integer i %switch sts(not alloc:closing) %cycle i = 2, 1, con lim d == con desa(i) #if t %if d_ostate # not alloc %then trace(tclear) #fi %if mon < 0 %and d_o state # not alloc %start who and state; printstring("Down ") %finish ->sts(d_o state) sts(connect 1): p_gate port = d_port #if k reject connect(tserr down, "System down", d_holdi) d_holdi == null #else do repm(0); ! reply 'reject' to connect #fi sts(idle): sts(Conn Lost): sts(timing): retrieve(d) %continue sts(connected): sts(enabld): sts(Wait Ts): #if ~x to gate(abort call, null, 0) #else to gate(Disconnect, null, 1) #fi sts(trying): sts(Closing): sts(aborted): d_o state = Emas Dwn %continue sts(Emas Dwn): ! must wait for network sts(not alloc): %repeat host state = down %end %routine read from am1 %record (am1f) %name l2 %integer max ad, adr, adr2 %record (mef) %name mes %record (lev3f) %name lev3 #if i %label cyc, parity, commbt, xopdwn, exit2, y1, y3 %constinteger r0=0,r1=1,r2=2,r3=3, xopl = k'20', acfy = k'10' #fi %integer n, cpos, t, max2 #if c mark(11) #fi %if d == null %then mes == null %else %c #if ~b mes == d_hold #else mes == map(d_hold) #fi %if mes == null %start printstring("ftp: seq1! ") t = 0!128; -> skip2 %finish lev3 == mes_lev3 !! (cater for partial block rec'd) %if d_n # 0 %start n = d_n; cpos = d_cpos %else n = 0 n = n+1 %if d_mode = x'50'; ! default mode cpos = 0 %finish %if mon = -1 %start select output(1) printstring("read from, n cpos:"); write(n, 1); write(cpos, 1) newline; select output(0) %finish !! next section is in assembler in a file 'ercc14.ftpassm' ! acfy =10 ! xopl =20 l2 == l adr2 = addr(lev3_a(0)); !$e lev3_a(0) #if k max ad = adr2+d_max data len #else max ad = adr2+data len #fi max2 = max ad rep cycle: adr = adr2+n; ! lev3_a(n) %if d_mode = x'50' %then max ad = adr2+n+63 %if max ad > max2 %then max ad = max2; ! mode 50 really ! #if i *mov_adr,r1 *mov_l2,r3 cyc: *mov_@r3,r2; ! r2 = status *bit_#k'220',r2; ! ready or xopl set? *beq_cyc; ! no, so wait *bit_#xopl,r2; ! was it xop? *bne_xopdwn; ! it was set, so get out *mov_2(r3),r0; ! pick up char *bit_#acfy,@r3; ! did it fail to read? *beq_y1; ! no, so carry on *mov_2(r3),r0; ! read it again *bit_#acfy,@r3; ! failed again? *bne_parity; ! hard failure, so get out y1: *asr_r2; ! get comm bit (9th bit) *bcs_commbt; ! set, so exit *movb_r0,(r1)+; ! store char in array y3: *cmp_r1,maxad; ! at end of array? *bhis_exit2; ! yes, so get out *bis_#2,(r3); ! accept the last char *br_cyc; ! go for the next one exit2: *mov_r1,adr -> exit parity: *mov_r1,adr t = 3; -> skip commbt: *mov_r1,adr t = 2!128; -> skip xopdwn: *mov_r1,adr t = 64 #else *=k'016401';*=k'10'; ! mov 10(r4),r1 ! r1 == nss_a(n) *=k'016403';*=k'4'; ! mov 4(r4),r3 ! l2 = -4(r5) *=k'011302' ; ! cycle: mov (r3),r2 ! stat=r2 *=k'032702';*=k'000220'; ! bit #200+xopl,r2 *=k'001774' ; ! beq cycle ! nothing set, so wait *=k'032702';*=k'000020'; ! bit #xopl,r2 ! xopl set? *=k'001034' ; ! bne xopdwn ! yes, so fail it ! *=k'016300';*=k'000002'; ! mov 2(r3),r0 ! sym=r0 *=k'032713';*=k'000010'; ! bit #acfy,@r3 ! failed to read? *=k'001405' ; ! beq y1 ! no, so carry on *=k'016300';*=k'000002'; ! mov 2(r3),r0 ! read it again *=k'032713';*=k'000010'; ! bit #acfy,@r3 ! failed again? *=k'001014' ; ! bne parity ! yes, so fails ! y1: *=k'006202' ; ! asr r2 ! get comm bit *=k'103415' ; ! bcs commbt ! comm bit seen *=k'110021' ; ! movb r0,(r1)+ ! nss_a(n) = sym! n=n+1 *=k'020164';*=k'6'; ! y3: cmp r1,6(r4) ! end of cuurent record *=k'103003' ; ! bhis exit ! yes, so exit *=k'052713';*=k'000002'; ! bis #2,(r3) ! accept char *=k'000746' ; ! br cycle ! ! exit: ! etc *=k'010164';*=k'10'; ! mov r1,10(r4) ! restore 'adr' -> exit ! parity: s1: *=k'010164';*=k'10'; ! mov r1,10(r4) l1: ->parity ! commbt: s2: *=k'010164';*=k'10'; ! mov r1,10(r4) l3: ->comm bit ! xopdwn: xopdwn: t = 64; -> skip; ! send unsuccessfull parity: t = 3; -> skip comm bit: t = 2!128 #fi skip: n = adr-adr2; ! recomput n %if d_mode=x'50' %start lev3_a(cpos) = (n-cpos-1)!128 d_cpos = n; ! start new record here d_n = n+1; ! leave one byte for length of next %finish %else d_n = n skip2: p_c1 = t; ! long block+accept last #if ~b to 2900(return control, null) #else to 2900(return control, 0) #fi %return exit: n = adr-adr2; ! recompute n #if m %if mon = -1 %start select output(1); printstring("in data: n, cpos:") write(n, 1); write(cpos, 1); newline select output(0) %finish #fi %if d_mode = x'50' %start lev3_a(cpos) = (n-cpos-1)!128 %finish #if k %if n < d_max data len-5 %start #else %if n < data len-5 %start #fi cpos = n; n = n+1 %if d_mode = x'50' l_rxs = l_rxs!accept char; ! accept the last char -> rep cycle %finish p_c1 = 0!128; ! done+accept last #if ~b d_hold == null to 2900(return control, null) #else d_hold = 0 to 2900(return control, 0) #fi d_n = 0 #if n lev3_suflag = 1; ! allways binary mode - nsi mod #else #if e&(~x) lev3_uflag = x'0100' #fi #fi mes_len = n+header len; !$e %if d_o state # enabld %start; ! transfer has been aborted free buffer(mes); ! get rid of the buffer %else #if c mark(12) #fi to gate(put output, mes, 0) d_nc = d_nc+1 d_permit = d_permit-1 %if d_permit > 0 %then get buffer(get op block) #if c mark(13) #fi %finish %end %routine write to am1 %record (mef) %name mes %record (lev3f) %name lev3 %integer n, end, gate reply, am1 reply, stat, sym %switch data state(0:13) #if c mark(4) #fi am1 reply = 0; ! "normal" reply %while d_o state = enabld %cycle #if ~b mes == d_holdi %if mes == null %then mes == pop(d_inp q) #else %if d_holdi # 0 %then mes == map(d_holdi) %else mes == map(bpop(d_inp q)) #fi %if mes == null %then %exit !! terminate with "normal" (shouldnt happen) lev3 == mes_lev3 end = mes_len-header len; !$e gate reply = enable input; ! allow next to gate n = d_in; ! start of block - d_in = 0 %cycle %cycle stat = l_rxs %if stat&xopl#0 %start am1 reply = 64 #if ~b d_holdi == mes; ! retain for retry #else d_holdi = mes_buff no; ! retain for retry #fi d_in = n; ! and the pointer -> am1 rep %finish %if stat&ready # 0 %start !! l i m i t sent am1 reply = 2; ! long block d_in = n #if ~b d_holdi == mes; ! retain for later #else d_holdi = mes_buff no; !retain for later #fi -> am1 rep %finish %if l_txs&ready # 0 %then %exit %repeat skip: %if n >= end %start !! send go ahead #if ~x gate rep: #if c mark(5) #fi to gate(gate reply, null, 0); ! enable input or close call #else gate rep: to gate(Gate reply, null, 1); ! one buffer ack #fi free buffer(mes) #if ~b d_holdi == null; d_in = 0 #else d_holdi = 0; d_in = 0 #fi %if d_inp q_e == null %then ->am1 rep %exit %finish sym = lev3_a(n); n = n+1 %if mon = -1 %start; ! int = 'N' select output(1) printstring("di:"); write(d_istate, 1) write(n, 1) write(d_icount, 1); write(sym, 3) space %and printsymbol(sym) %if sym > 32 newline; select output(0) %finish ->data state(d_istate) data state(0): ! beginning of record (neg phase) d_icount = sym&63 %if sym&128 # 0 %then d_istate = 2; ! ie 3 - get 1stchar d_istate = d_istate+1 %if d_icount = 0 %start %if d_istate = 3 %then -> kick d_istate = 0 %finish -> send it data state(1): ! 1st char of sub/record (neg phase) data state(3): ! 1st char of last record/sub record d_first = sym %if d_first = x'ff' d_istate = d_istate+1 -> ds4 %if d_istate = 4 data state(2): ! chars in block (neg phase) d_icount = d_icount-1 %if d_icount = 0 %start d_istate = 0 %finish %if d_icount < 0 %start printstring("ftps: phase error ") -> had it; ! temp expedient %finish -> send it data state(4): ! chars in block (last block) ds4: d_icount = d_icount-1 %if d_icount = 0 %start kick: d_o state = connected; ! no more i/p until a new enable %if mon < 0 %start select output(1); tell; printstring("kick ") select output(0) %finish d_istate = 0 am1 reply = 4; ! kick 2900 l_txd = sym; ! pass to 2900 %if n >= end %then ->gate rep; ! block fin, reply to gate d_in = n #if ~b d_holdi == mes; ! retain the block & pointer #else d_holdi = mes_buff no; ! retain block and pointer into it #fi -> am1 rep; ! tell the 2900 %finish -> send it ! * * * Now the states for the Defaut Emas-Emas data transfer data state(5): ! record/sub record count (default phase) %if sym = 128 %start; ! horrible frig for dec-10 (0 len) sym = nl; ! implant a nl -> send it; ! expect a record headernext %finish d_icount = sym&63 %if d_icount = 0 %start; ! transfer command d_istate = 7 %finish %else d_istate = d_istate+1 -> skip; ! record count is not part of the data data state(6): ! subsequent data chars (default phase) d_icount = d_icount-1 %if d_icount = 0 %then d_istate = 5 -> send it data state(7): ! 1st char of transfer comm (default phase) %if sym = es %or sym = qr %or sym = er %then %c d_istate = d_istate+2 %and -> send it %if sym # ss %and sym # cs %start; ! illegal - halt for now printstring("ftps:illegal tcc =") write(sym, 1); newline had it: printstring("ptr ="); write(n, 1); printstring(" block = ") mon mes(mes) -> kick %finish d_istate = d_istate+1; ! rubbish - so junk the last byte -> skip data state(8): ! skip mode of transfer command d_istate = 5 -> skip data state(9): ! end of transfer (default phase) -> kick; ! nb: state -> 0 as expect disconnect next ! * * * Now the states for the non-default, full Ftp Data transfer * * * data state(10): ! 1st char - length of record/sub/tcc %if sym = 0 %start; ! TCC d_istate = 12; ! get the next 2 chars f tcc d_icount = 2; ! mainly to stop an 'enabling' changing state -> send it; ! send the first thru %finish d_icount = sym&63; ! pickup record length %if d_icount # 0 %start; ! zero-length record is valid %if sym&64 # 0 %start; ! compression d_icount = 1; ! only one to go %finish d_istate = d_istate+1; ! go to 'into block' state %finish -> send it data state(11): ! inside record/sub record d_icount = d_icount-1; ! count it down %if d_icount = 0 %then d_istate = 10; ! eor, to length next %if d_icount < 0 %then printstring("FTPS:Non-default Phase error ") %and -> kick ! on error, give up by kicking 2900 -> send it data state(12): ! 2nd byte of tcc d_istate = d_istate+1; ! pickup 3rd byte d_icount = 1 -> send it data state(13): ! 3rd and last byte of tcc d_icount = 0 -> kick; ! tell 2900 send it: l_txd = sym %repeat %repeat am1 rep: p_c1 = am1 reply #if ~b to 2900(return control, null) #else to 2900(return control, 0) #fi #if c mark(6) #fi %end !! r e a d m e s s a g e f r o m a m 1 %routine read message from am1 %record (maf) %name m %integer n, sym, t, stat, x, get another block, buff no %integer type, strm %record (con desf) %name dx %switch swd(not alloc:closing) %switch hlm(1:5) get another block = 0; ! another block coming flag d == d5; ! messages on stream 7 #if ~b m == d_hold #else buff no = d_hold; m == map(buff no) #fi %if m == null %start printstring("ftp: seq2! ") stat = l_rxs t = 0!128; -> reply %finish !! (cater for partial block rec'd) n = d_n %if n = 0 %then d_cpos = 0 %cycle %cycle stat = l_rxs %exit %if stat&(ready!xopl) # 0 %repeat %if stat&xopl # 0 %start; ! xop gone down t = 64; ! send unsuccessfull printstring("ftps: xop d ") -> skip %finish sym = l_rxd; ! read the char %if l_rxs&acfy # 0 %start; ! failed to read sym = l_rxd; ! read it again %if l_rxs&acfy # 0 %start; ! hard failure - parity t = 3 printstring("ftps: parity ") -> skip %finish %finish %if stat&comm bit # 0 %start t = 2!128 skip: d_n = n reply: p_c1 = t; ! long block+accept last #if ~b to 2900(return control, null) #else to 2900(return control, 0) #fi d == d5; ! ensure we are mapped on get buffer(get op block) %if get another block # 0 ! get a buffer NOW if requested earlier %return %finish %if d_count = d_mode %then d_count = -1 %if d_count = d_nc %then -> badm d_count = d_count+1 m_a(n) = sym; n = n+1 %if n = 1 %start; ! Got the total length d_cpos = m_a(0)+1; ! max = 256 - length is like string %unless 5 < d_cpos <= 256-18 %start badm: printstring("***ftps: message fails -") write(d_cpos, 1); write(d_count, 1); write(d_mode, 1) write(d_nc, 1); write(type, 1) printstring(" all ftp messages lost ") -> reply %finish %else %if n = d_cpos %then -> exit3; ! Got the whole message %finish l_rxs = l_rxs!accept char; ! accept the last char %repeat exit3: #if ~b d_hold == null #else d_hold = 0 #fi t = 0!128; ! normal+accept last type = m_type; ! max = 256 %unless 1 <= type <= 4 %then ->badm %if d_count # d_nc %start; ! Another message waiting get another block = 1; ! get another when finished this %finish strm = swab(m_in ident) n = (strm-fixed+4)>>1 d == con desa(n) %if mon < 0 %start printstring("HLM"); write(d_index, 1) write(type, 1); write(m_a(0), 1); write(m_ref, 1) newline %finish -> hlm(type) hlm(2): ! Allocate stream - reply #if c mark(34) #fi fault(11, Connect 1) %and -> free it %if d_index < 2; ! null ! fault(8, connect 1) %and -> free it %if d_o state < connect 1 %and d_o state # idle %if m_ref = 0 %start #if t trace(trefuse) #fi %if mon < 0 %then %c tell %and printstring("refused ") p_gate port = d_port; do repm(0) retrieve(d) %else #if t trace(tacc) #fi d_ref = m_ref; ! remember spoolers ref no %finish free it: #if ~b free buffer(m); -> reply #else free buff no(buff no); -> reply #fi hlm(4): ! new packed string number #if k !check for spoolr reusing its reference numbers %for n = 2, 1, con lim %cycle d == con desa(n) %if d_o state # not alloc %start %if d_ref = m_ref %start printstring("ftps: Spoolr reusing reference no. (line no)") newline who and state newline %if d_ostate = idle %start retrieve(d); !so it can be re-used %else d_ref = 0; !don't want to see it again %finish %finish %finish %repeat #fi ! set d_direction = 1 %if an outgoing connection to be made ?? %if length(m_address) > 73 %or charno(m_address, 1)>63 %start ! overall length, or length of 1st packed ! string inside %if mon # 0 %then printstring("Length Too Long ") -> failed %finish -> failed %if special flag # 0 d == get free des %if d == null %start; ! failed hlm(1): ! allocate new (output) pair failed: ! flag it m_in ident = 0 m_out ident = 0 %else #if t trace(tallocate) #fi i = allocate stream(d); ! get both streams d_o state = idle #if ~x %if m_address -> ("N").ad1 %and ad1 -> ad1.("T").ad2 %start %if ad2 -> ad2.(".F").ad3 %then d_secadd = stoi(ad3) %c %else d_secadd = 0 d_node = stoi(ad1); d_term = stoi(ad2) %if mon # 0 %start printstring("ftps:address N"); write(d_node, 1) printstring(" T"); write(d_term, 1) %if d_secadd # 0 %start printstring(" F"); write(d_secadd, 1) %finish newline %finish %else printstring("ftps:address ? "); printstring(m_address) newline %finish #else adda(d_index) = m_address #fi m_in ident = swab(d_stream) m_out ident = swab(d_stream+1) d_direction = 1 d_ref = m_ref %finish -> move it hlm(3): ! spoolr requests deallocation #if t trace(tdeallocate) #fi %if n < 2 %or n > conlim %start printstring("ftps:Spoolr deallocate on an illegal strm, =") write(strm, 1); write(n, 1); newline -> move it; ! ignore %finish %if mon < 0 %start who and state printstring(" deallocated ") %finish m_in ident = d_term; ! pass in disconnect reason -> swd(d_o state) swd(not alloc): ! shouldn't get here any longer printstring("FTP:Deall on idle? ") ->move it; ! reply, but ignore it (already gone) !! swd(Conn Lost): swd(idle): ! ok, so do it retrieve(d) -> move it swd(wait ts): to gate(Disconnect, null, 39); ! then fall thru swd(timing): ! its trying to connect swd(trying): ! Call outstanding d_nc = 0; ! ensure sub-state flag is clear ! retrieve the descriptor AFTER the connect reply sent %if d_o state = trying %or d_o state = wait ts %start d_o state = aborted d_nc = 99 ! set 'flag' in _nc, so that connecting reply 2 ! does not retrieve the descriptor %finish %else d_o state = idle dx == d; ! remember who it is kick 2900 message(m); ! sequence changed for benefit of new buff man d == dx; ! and restore it get buffer(connecting reply failed) get buffer(connecting reply 2 failed) -> reply swd(Emas Dwn): swd(aborted): crunch(6) swd(connect 1): p_gate port = d_port do repm(0) retrieve(d); ! and get the descriptor back -> move it swd(connected): swd(enabld): swd(closing): ! send failed ( x over ) who and state; printstring(" Deallocate error 6 ") m_out ident = 999 move it: dx == d kick 2900 message(m) d == dx; ! rescue d -> reply %end !! w r i t e m e s s a g e t o a m 1 %routine write message to am1 %record (maf) %name m %integer n, max, am1 reply, stat d == d4; ! messages on stream 4 am1 reply = 4; ! "condition y" %cycle #if c mark(32) #fi #if ~b m == d_hold %if m == null %then m == pop(d_inp q) %and d_cpos = d_cpos-1 d_hold == m; ! put it in here for retry #else m == map(d_hold) %if m == null %then m == map(bpop(d_inp q)) %and d_cpos = d_cpos-1 d_hold = m_buff no; ! put it ere for retry #fi %if m == null %then %exit !! terminate with "normal" (shouldnt happen) n = d_n; ! start of block - d_n = 0 %cycle %cycle stat = l_rxs %if stat&xopl#0 %start am1 reply = 64; d_kill = n; ->am1 rep %finish %if stat&ready # 0 %start !! l i m i t sent am1 reply = 2; ! long block d_n = n; d_count = max -> am1 rep %finish %if l_txs&ready # 0 %then %exit %repeat %if n > m_a(0) %start free buffer(m) #if ~b d_hold == null; d_n = 0; d_kill = 0 #else d_hold = 0; d_n = 0; d_kill = 0 #fi %if d_inp q_e == null %then ->am1 rep %exit %finish l_txd = m_a(n); n=n+1 %repeat %repeat am1 rep: p_c1 = am1 reply #if ~b to 2900(return control, null) #else to 2900(Return control, 0) #fi #if c mark(33) #fi %end %routine mon mes(%record (mef) %name mes) %integer i, j, k, n %record (lev3f) %name lev3 k = mes_len; lev3 == mes_lev3 write(k, 1); printstring(": ") j = 0 %cycle i = 0, 1, k-1 write(lev3_a(i), 1) j = j+1; %if j = 20 %then j = 0 %and newline %repeat newline; select output(0) %end %endofprogram