! User interface module for (Moose) INet process, GDMR, Jan. 1988 !%option "-Low-NonStandard-NoCheck-NoTrace-NoDiag" %option "-Low-NonStandard-NoCheck" %constinteger TCP max = 32 %constinteger UDP max = 8 %constinteger requests = 32 %constinteger outbound size = 10240 %constinteger outbound priority = 6 %include "INet:Formats.Inc" %include "INet:Utility.Inc" %include "INet:INet.Inc" %constinteger infinity = 16_7FFFFFFF %externalrecord(queue fm)%spec TCP outbound queue %externalrecord(queue fm)%spec UDP outbound queue %externalrecord(queue fm)%spec ICMP outbound queue %externalrecord(semaphore fm)%spec dispatch semaphore %externalrecord(TCB table fm)%namespec TCB table %externalrecord(UDP table fm)%namespec UDP table %externalroutinespec FS insert(%string(31) what, %integer value) %systemintegerfnspec global heap get(%integer amount) %systemroutinespec phex2(%integer x) %systemroutinespec phex(%integer x) %routine copy data(%integer bytes, %bytename from, to) %label L *subq.l #1, D0 L: *move.b (A0)+, (A1)+ *dbra D0, L %end ! All TCP and UDP operations take place via the following data structure. ! Depending on the state field the user requests may or may not be valid. ! The outbound queue holds user requests when the particular interface is ! blocked for flow control purposes. The pending queue holds requests which ! require a response from the protocol module (claim, open). The inbound queue ! holds user read requests for which there is no peer-data as yet, while the ! pending in queue holds peer-data for which there is no user-read request ! (there will, of course, only ever be one of these queues active at any ! particular time....). In attempt to prevent misuse of TCP/UDP units, ! each interface is tagged with a user-supplied key which must match before ! the requested operation is allowed. %recordformat interface fm(%integer state, key, %record(INet user request fm)%name outbound, %record(INet user request fm)%name pending, %record(INet user request fm)%name inbound, %record(INet user request fm)%name pending in) ! NB: idle state assumed = 0 %constinteger idle state = 0; ! Default, not in use %constinteger enabled state = 1; ! Turned on, but free %constinteger allocated state = 2; ! Claimed, not yet open %constinteger open state = 3; ! Open, unblocked %constinteger blocked state = 4; ! Open, blocked %constinteger write code = 1; ! Pending inbound data %constinteger close code = 2; ! Pending inbound close from peer ! Because there is an autonomous process waiting for user requests, we have ! to interlock access to the interface data structures. For simplicity ! we use one common semaphore for both TCP and UDP. We attempt to minimise ! the time this semaphore is held. %ownrecord(semaphore fm) interface semaphore = 0 ! Pending inbound data/close packets from the peer for which there is no ! user-read requests are queued. For convenience, the user-request format ! is employed. Rather than return them to the heap, we keep a free list ! for speed. %ownrecord(queue fm) free requests = 0 ! Common interface procedures. These are used by both the TCP and UDP ! code, as the functionality is common. ! Send a buffer to the user. If there is no pending read request, queue it. %predicate send(%record(interface fm)%name i, %record(buffer fm)%name b) %record(INet user request fm)%name r, n !! printstring("Send: "); phex(addr(i)) !! space; phex(addr(b)); write(b_data bytes, 1); newline semaphore wait(interface semaphore) %if i_state < open state %start ! This particular interface is not in data-transfer mode, so ! drop the packet. signal semaphore(interface semaphore) release buffer(b) %false %finish %if i_inbound == nil %start ! No user-read waiting, we'll have to queue r == dequeue(free requests) r == record(global heap get(size of(r))) %if r == nil; ! None free ! Fill relevant fields and queue it. r_INet buffer == b r_code = write code r_next == nil %if i_pending in == nil %start ! Empty i_pending in == r %else ! Not empty, so chain down n == i_pending in n == n_next %while n_next ## nil n_next == r %finish signal semaphore(interface semaphore) %else ! There's a user-read request waiting. Unlink it and copy in our data. r == i_inbound i_inbound == r_next signal semaphore(interface semaphore) %if b_data bytes <= 0 %start ! No data? Oh, well.... r_bytes = 0 %else copy data(b_data bytes, b_data start, r_buffer) r_bytes = b_data bytes %finish r_peer = b_IP header_source r_interface = b_interface r_status = 0 ! Now enqueue our buffer on its next queue, if required, and ! send the user's request on its way %if b_next queue == nil %start ! No later activity required, so free it. release buffer(b) %else ! Later activity, enqueue it as specified. enqueue buffer(b, b_next queue) %finish send message(r, r_system part_reply, nil) %c %if r_system part_reply ## nil %finish %true %end ! Peer close request has arrived. Enqueue it for the user. %routine send close(%record(interface fm)%name i) %record(INet user request fm)%name r, n !! printstring("Send close: "); phex(addr(i)); newline semaphore wait(interface semaphore) %if i_state < open state %start ! Not in data-transfer mode, so forget it. signal semaphore(interface semaphore) %return %finish %if i_inbound == nil %start ! Nothing waiting, we'll have to queue. r == dequeue(free requests) r == record(global heap get(size of(r))) %if r == nil; ! None free r_code = close code r_INet buffer == nil r_next == nil %if i_pending in == nil %start ! Empty i_pending in == r %else ! Not empty, chain down list. n == i_pending in n == n_next %while n_next ## nil n_next == r %finish signal semaphore(interface semaphore) %else ! There's a request waiting. Unlink it and send back a close. r == i_inbound i_inbound == r_next signal semaphore(interface semaphore) r_status = closing error r_bytes = -99 ! Now send the user's request on its way send message(r, r_system part_reply, nil) %c %if r_system part_reply ## nil %finish %end ! Response to an open/define request. As a side effect we mark the interface ! open for data transfer. %recordformat connect fm(%integer ra, rp, lp) %routine send open response(%record(interface fm)%name i, %integer error, ra, rp, lp) %record(INet user request fm)%name r %record(connect fm)%name c !! printstring("Send open response: "); phex(addr(i)) !! space; write(error, 0); write(ra, 1); write(rp, 1) !! write(lp, 1); newline semaphore wait(interface semaphore) %if i_state = idle state %start ! Wasn't opening?? Forget it. signal semaphore(interface semaphore) %return %finish ! Unlink user's request and turn on the interface. r == i_pending; i_pending == nil i_state = open state %if i_state # blocked state signal semaphore(interface semaphore) %return %if r == nil; ! No request?? r_status = error; ! As supplied by protocol module c == record(addr(r_buffer)) !! printstring("Connect buffer at "); phex(addr(c)); newline %if c ## nil %start c_ra = ra; c_rp = rp c_lp = lp r_bytes = 12 %finish send message(r, r_system part_reply, nil) %c %if r_system part_reply ## nil %end ! Response to a port-claim request. Send back the port in the user's buffer. %routine send claim response(%record(interface fm)%name i, %integer error, allocated) %record(INet user request fm)%name r !! printstring("Send claim response: "); phex(addr(i)) !! space; write(error, 0); write(allocated, 1); newline semaphore wait(interface semaphore) %if i_state = idle state %start ! Not allocated?? Ignore it. signal semaphore(interface semaphore) %return %finish ! Unlink the user's request. r == i_pending; i_pending == nil signal semaphore(interface semaphore) !! printstring("Request at "); phex(addr(r)); newline %return %if r == nil; ! No request?? r_status = error; ! As supplied by procotol module !! printstring("Buffer at "); phex(addr(r_buffer)); newline %if r_buffer ## nil %start ! Buffer provided, return the allocated port integer(addr(r_buffer)) = allocated r_bytes = 4 %finish send message(r, r_system part_reply, nil) %c %if r_system part_reply ## nil %end ! Turn on the specified interface, allowing it to be allocated. %routine enable(%record(interface fm)%name i) !! printstring("Enable "); phex(addr(i)); newline semaphore wait(interface semaphore) %if i_state = idle state %start i = 0 i_state = enabled state %finish ! Else ignore duplicate enable. signal semaphore(interface semaphore) %end ! Turn off specified interface. Purge its queues, and drop/return any ! pending requests. Later user-requests will be bounced. %routine disable(%record(interface fm)%name i, %integer error) %record(INet user request fm)%name r %record(buffer fm)%name b !! printstring("Disable "); phex(addr(i)) !! space; write(error, 0); newline error = reset error %if error = 0 semaphore wait(interface semaphore) ! Pending user-write requests. %while i_outbound ## nil %cycle r == i_outbound i_outbound == r_next r_status = error send message(r, r_system part_reply, nil) %c %if r_system part_reply ## nil %repeat ! Open/claim requests %while i_pending ## nil %cycle r == i_pending i_pending == r_next r_status = error send message(r, r_system part_reply, nil) %c %if r_system part_reply ## nil %repeat ! User-read requests %while i_inbound ## nil %cycle r == i_inbound i_inbound == r_next r_status = error send message(r, r_system part_reply, nil) %c %if r_system part_reply ## nil %repeat ! Peer-write requests. %while i_pending in ## nil %cycle r == i_pending in i_pending in == r_next b == r_INet buffer release buffer(b) %if b ## nil enqueue(r, free requests) %repeat ! Free the interface (implicitly mark idle). i = 0 signal semaphore(interface semaphore) %end ! Flow control -- mark interface as blocked. %routine block(%record(interface fm)%name i) !! printstring("Block "); phex(addr(i)); newline semaphore wait(interface semaphore) i_state = blocked state %if i_state >= open state; ! Only if open/blocked signal semaphore(interface semaphore) %end ! Flow control -- mark interface as unblocked. If there are any user-requests ! queued, we deal with them (all) now. %routine unblock(%record(interface fm)%name i) %record(INet user request fm)%name r %record(buffer fm)%name b !! printstring("Unblock "); phex(addr(i)); newline semaphore wait(interface semaphore) i_state = open state %if i_state > open state; ! Only if blocked ! Deal with any pending user-write requests %while i_outbound ## nil %cycle ! Dequeue next. r == i_outbound i_outbound == r_next %if r_code & request type = TCP request %start ! It's a TCP request. Copy the data (if any). b == claim buffer b_code = r_code b_TCB == TCB table_TCB(r_unit) b_TCB_slot = r_unit; !? b_data start == b_data(64) %if r_bytes <= 0 %start b_data bytes = 0 %else copy data(r_bytes, r_buffer, b_data start) b_data bytes = r_bytes %finish ! Send it on its way, then drop through to return ! the user's request. enqueue buffer(b, TCP outbound queue) r_status = 0 ! %else %if r_code & request type = UDP request %else ! Something unknown waiting, bounce it. r_status = bugcheck error %finish send message(r, r_system part_reply, nil) %c %if r_system part_reply ## nil %repeat signal semaphore(interface semaphore) %end ! Pending input dumper. This is only applicable to UDP, but has been ! abstracted here as a general facility for convenience. What it does ! is throw away everything on the pending in queue. Semaphore assumed ! already claimed. %routine purge pending in(%record(interface fm)%name i) %record(INet user request fm)%name r %record(buffer fm)%name b %while i_pending in ## nil %cycle r == i_pending in i_pending in == r_next b == r_INet buffer release buffer(b) %if b ## nil enqueue(r, free requests) %repeat %end ! User timeout handler -- scan the inbound queue counting down the timeout ! field. If any go non-positive send the request back to the user with an ! appropriate error message. NB: semaphore claimed in the envelope routine. %routine user timeouts(%record(interface fm)%name i) %record(INet user request fm)%name r, p, x r == i_inbound; p == nil %while r ## nil %cycle r_timeout = r_timeout - 1 %if r_timeout <= 0 %start %if p == nil %then i_inbound == r_next {first in list} %c %else p_next == r_next x == r; r == r_next x_status = user timeout error send message(x, x_system part_reply, nil) %c %if x_system part_reply ## nil %else p == r; r == r_next %finish %repeat %end ! TCP interface. Mostly these just validate the interface unit number, then ! call the TCP/UDP-common code above. %ownrecord(interface fm)%array TCP interface(1 : TCP max) = 0(*) %externalpredicate TCP send to user(%record(buffer fm)%name b) %false %unless 0 < b_TCB_slot <= TCP max %false %unless send(TCP interface(b_TCB_slot), b) %true %end %externalroutine TCP send close(%integer unit) send close(TCP interface(unit)) %if 0 <= unit <= TCP max %end %externalroutine TCP open response(%integer unit, error, ra, rp, lp) send open response(TCP interface(unit), error, ra, rp, lp) %if 0 <= unit <= TCP max %end %externalroutine TCP claim response(%integer unit, error, allocated) send claim response(TCP interface(unit), error, allocated) %if 0 <= unit <= TCP max %end %externalroutine TCP enable(%integer unit) enable(TCP interface(unit)) %if 0 <= unit <= TCP max %end %externalroutine TCP disable(%integer unit, error) disable(TCP interface(unit), error) %if 0 <= unit <= TCP max %end %externalroutine TCP block(%integer unit) block(TCP interface(unit)) %if 0 <= unit <= TCP max %end %externalroutine TCP unblock(%integer unit) unblock(TCP interface(unit)) %if 0 <= unit <= TCP max %end ! This next should never fail, provided the rest of the code in this ! module is working correctly. It's in to provide compatibility with the ! VMS version. %externalpredicate TCP interpret user request(%record(buffer fm)%name b) %true %if TCP abort request <= b_code <= TCP close request printstring("INet: Dud TCP user request code "); phex2(b_code); newline %false %end ! The following procedure is called by the autonomous user-request handler ! to decide what to do with the request it has just received. If the ! request has been completed immediately it returns %true, else returns ! %false to indicate that the request remains pending. !! %conststring(23)%array TCP request name(TCP first request: TCP last request) = !! "TCP allocate unit", !! "TCP abort", !! "TCP claim", !! "TCP claim priv", !! "TCP open", !! "TCP send", !! "TCP close", !! "TCP receive" %predicate TCP interpret(%record(INet user request fm)%name r) %record(INet user request fm)%name n %record(interface fm)%name i %record(buffer fm)%name b %integer x ! Was the user's request sensible? %unless TCP first request <= r_code <= TCP last request %start !! printstring("TCP interpret: dud op "); phex2(r_code); newline r_status = dud op error %true %finish !! printstring("TCP interpret: ") !! printstring(TCP request name(r_code)); newline ! Does the user want to allocate a TCP unit? If so, scan the tables ! looking for any that are turned on but not otherwise in use (only ! enabled state). Allocate the first one found and copy in the ! user-supplied key -- this will later be used to try to prevent ! bogus use of someone else's unit. %if r_code = TCP allocate unit request %start semaphore wait(interface semaphore) %for x = 1, 1, TCP max %cycle i == TCP interface(x) %if i_state = enabled state %start ! Got one. Mark it allocated and return the unit number ! in the user's request. i_state = allocated state i_key = r_key signal semaphore(interface semaphore) r_status = 0 r_unit = x %true %finish %repeat ! None free, bounce the request. signal semaphore(interface semaphore) r_status = none free error %true %finish ! For everything but an allocate request the user is required to ! quote a valid unit number. Unfortunately we can't check that the ! user really does have access to that particular unit; the best we can ! do is to compare the quoted key fields and assume that a match is not ! due to luck or forgery..... From now on the unit must be at least ! in the allocated state. %unless 0 < r_unit <= TCP max %start r_status = dud op error %true %finish i == TCP interface(r_unit) semaphore wait(interface semaphore) %if i_state < allocated state %start signal semaphore(interface semaphore) r_status = dud op error %true %finish %unless r_key = i_key %start ! Mismatch, bounce it. signal semaphore(interface semaphore) r_status = dud op error %true %finish ! The next range of requests are valid whenever the unit is allocated. %if TCP abort request <= r_code <= TCP open request %start ! All except the abort request expect a response from the ! protocol module. As we're only geared up for one such ! request at a time we bounce any such while we're still ! processing a previous one... %if r_code # TCP abort request %start %if i_pending == nil %start ! Nothing being processed, so pend our request. r_next == nil i_pending == r %else ! Something already being processed signal semaphore(interface semaphore) r_status = dud op error %true %finish %finish signal semaphore(interface semaphore) ! OK so far. Claim a buffer, copy in any data, and then ! send it on to the main dispatcher for processing. b == claim buffer b_code = r_code b_privilege = 1; ! Always! b_TCB == TCB table_TCB(r_unit) b_TCB_slot = r_unit; !? b_data start == b_data(64) %if r_code # TCP open request %or r_bytes <= 0 %start ! No data. b_data bytes = 0 %else ! Copy it copy data(r_bytes, r_buffer, b_data start) b_data bytes = r_bytes %finish enqueue buffer(b, TCP outbound queue) signal semaphore(dispatch semaphore) ! An abort request is completed immediately, while anything ! else is held pending the protocol module's response. %if r_code = TCP abort request %start r_status = 0 %true %else %false %finish %finish ! Sending and receiving is subject to the interface being opened. ! Sending of data is subject to flow control: if the interface ! is blocked the request must be queued. %if r_code = TCP send request %or r_code = TCP close request %start %if i_state = open state %start ! Open, not blocked, so send it on. signal semaphore(interface semaphore) b == claim buffer b_code = r_code b_TCB == TCB table_TCB(r_unit) b_TCB_slot = r_unit; !? b_data start == b_data(64) %if r_bytes <= 0 %start b_data bytes = 0 %else copy data(r_bytes, r_buffer, b_data start) b_data bytes = r_bytes %finish enqueue buffer(b, TCP outbound queue) signal semaphore(dispatch semaphore) r_status = 0 %true %else %if i_state = blocked state ! Open, blocked, so enqueue it. r_next == nil %if i_outbound == nil %start i_outbound == r %else n == i_outbound n == n_next %while n_next ## nil n_next == r %finish signal semaphore(interface semaphore) %false %else ! Not open, so bounce it. signal semaphore(interface semaphore) r_status = dud op error %true %finish %finish ! Only thing left is receive request. The unit must be at least open. !! printstring("Must be receive request"); newline %if i_state < open state %start signal semaphore(interface semaphore) r_status = dud op error %true %finish ! There are two cases to consider: either there is data pending from ! our peer (on the pending in queue) in which case we can complete ! the request immediately, or there is nothing pending in which case ! we will have to wait. %if i_pending in == nil %start !! printstring("Nothing pending, wait"); newline ! Nothing immediately available, so we'll have to wait. ! Put ourselves on the tail of the inbound queue. r_timeout = infinity %if r_timeout <= 0 r_next == nil %if i_inbound == nil %start i_inbound == r %else n == i_inbound n == n_next %while n_next ## nil n_next == r %finish signal semaphore(interface semaphore) %false %else !! printstring("Something pending"); newline ! There's something immediately available. Unlink it and copy its ! data into our buffer. n == i_pending in; i_pending in == n_next signal semaphore(interface semaphore) b == n_INet buffer %if n_code = write code %start ! Data from our peer. Copy it %if b_data bytes > 0 %and r_buffer ## nil %start copy data(b_data bytes, b_data start, r_buffer) r_bytes = b_data bytes %else ! No data or no buffer?? r_bytes = 0 %finish r_status = 0 %else %if n_code = close code r_status = closing error r_bytes = -98 %else ! Something bogus r_status = bugcheck error r_bytes = -97 %finish ! The INet buffer, if there is one, may now need to be ! enqueued on another queue. %if b ## nil %start %if b_next queue == nil %start ! Nothing more for this one, free it. release buffer(b) %else ! This one has further to go. Enqueue it and notify the ! dispatcher that something has happened. enqueue buffer(b, b_next queue) signal semaphore(dispatch semaphore) %finish %finish ! Finally, release the queue record enqueue(n, free requests) %true %finish %end ! UDP interface. These are similar to the TCP versions, in that in ! most cases they merely validate their arguments before calling the ! common procedures above. There is, as yet, no block/unblock. %ownrecord(interface fm)%array UDP interface(1 : UDP max) = 0(*) %externalroutine UDP send to user(%record(buffer fm)%name b) %if 0 < b_UDP entry_slot <= UDP max %c %and send(UDP interface(b_UDP entry_slot), b) %start; %finish %end %externalroutine UDP open response(%integer unit, error, ra, rp, lp) !! printstring("UDP open response: "); write(unit, 0); space !! write(error, 0); write(ra, 1); write(rp, 1); write(lp, 1); newline send open response(UDP interface(unit), error, ra, rp, lp) %if 0 <= unit <= UDP max %end %externalroutine UDP claim response(%integer unit, error, allocated) !! printstring("UDP claim response: "); write(unit, 0); space !! write(error, 0); write(allocated, 1); newline send claim response(UDP interface(unit), error, allocated) %if 0 <= unit <= UDP max %end %externalroutine UDP enable(%integer unit) !! printstring("UDP enable "); write(unit, 0); newline enable(UDP interface(unit)) %if 0 <= unit <= UDP max %end %externalroutine UDP disable(%integer unit, error) !! printstring("UDP disable "); write(unit, 0); space !! write(error, 0); newline disable(UDP interface(unit), error) %if 0 <= unit <= UDP max %end ! Once again this should never fail, provided the rest of the code in this ! module is working correctly. It's in to provide compatibility with the ! VMS version. %externalpredicate UDP interpret user request(%record(buffer fm)%name b) %true %if UDP forget context request <= b_code <= UDP data request printstring("INet: Dud UDP user request code "); phex2(b_code); newline %false %end ! The following is very similar to the TCP version above. Unfortunately ! there are sufficient variations that a common version is not feasible. ! Note that we are set up to cope with flow control even though the ! protocol module doesn't enforce any -- it seems sennsible just to leave ! it in for later, though..... %predicate UDP interpret(%record(INet user request fm)%name r) %record(INet user request fm)%name n %record(interface fm)%name i %record(buffer fm)%name b %integer x !! printstring("UDP interpret: "); phex2(r_code); newline ! Was the user's request sensible? %unless UDP first request <= r_code & 16_FF <= UDP last request %start r_status = dud op error %true %finish ! Does the user want to allocate a UDP unit? If so, scan the tables ! looking for any that are turned on but not otherwise in use (only ! enabled state). Allocate the first one found and copy in the ! user-supplied key -- this will later be used to try to prevent ! bogus use of someone else's unit. %if r_code = UDP allocate unit request %start !! printstring("Allocate"); newline semaphore wait(interface semaphore) %for x = 1, 1, UDP max %cycle i == UDP interface(x) %if i_state = enabled state %start ! Got one. Mark it allocated and return the unit number ! in the user's request. i_state = allocated state i_key = r_key signal semaphore(interface semaphore) r_status = 0 r_unit = x !! printstring("Allocated "); write(x, 0); newline %true %finish %repeat ! None free, bounce the request. signal semaphore(interface semaphore) r_status = none free error %true %finish ! For everything but an allocate request the user is required to ! quote a valid unit number. Unfortunately we can't check that the ! user really does have access to that particular unit; the best we can ! do is to compare the quoted key fields and assume that a match is not ! due to luck or forgery..... From now on the unit must be at least ! in the allocated state. %unless 0 < r_unit <= UDP max %start r_status = dud op error %true %finish i == UDP interface(r_unit) semaphore wait(interface semaphore) %if i_state < allocated state %start signal semaphore(interface semaphore) r_status = dud op error %true %finish %unless r_key = i_key %start ! Mismatch, bounce it. signal semaphore(interface semaphore) r_status = dud op error %true %finish ! All requests allow a purge. This is to allow datagram clients to ! guarantee that server responses don't come from old client requests. %if r_code & UDP purge input flag # 0 %start purge pending in(i) r_code = r_code & (\ UDP purge input flag) !! printstring("Input purged, code now "); phex2(r_code); newline %finish ! The next range of requests are valid whenever the unit is allocated. ! Query context is somewhat dubious for an undefined unit, but we'll ! let it through for now.... %if UDP forget context request <= r_code <= UDP query context request %start ! All except the abort request expect a response from the ! protocol module. As we're only geared up for one such ! request at a time we bounce any such while we're still ! processing a previous one... !! printstring("Forget..query"); newline %if r_code # UDP forget context request %start !! printstring("Not forget"); newline %if i_pending == nil %start ! Nothing being processed, so pend our request. r_next == nil i_pending == r %else ! Something already being processed signal semaphore(interface semaphore) r_status = dud op error %true %finish %finish signal semaphore(interface semaphore) ! OK so far. Claim a buffer, copy in any data, and then ! send it on to the main dispatcher for processing. !! printstring("Buffer at "); phex(addr(b)); newline b == claim buffer b_code = r_code b_privilege = 1; ! Always! b_UDP entry == UDP table_UDP(r_unit) b_UDP entry_slot = r_unit; !? b_data start == b_data(64) %if r_code # UDP define context request %or r_bytes <= 0 %start ! No data. !! printstring("No data"); newline b_data bytes = 0 %else ! Copy it !! printstring("Copy "); write(r_bytes, 0); newline copy data(r_bytes, r_buffer, b_data start) b_data bytes = r_bytes %finish enqueue buffer(b, UDP outbound queue) signal semaphore(dispatch semaphore) !! printstring("Enqueued"); newline ! A forget request is completed immediately, while anything ! else is held pending the protocol module's response. %if r_code = UDP forget context request %start r_status = 0 %true %else %false %finish %finish ! Sending and receiving is subject to the interface being opened. ! Sending of data is subject to flow control: if the interface ! is blocked the request must be queued. %if r_code = UDP data request %start !! printstring("UDP data: "); write(r_bytes, 0); newline %if i_state = open state %start ! Open, not blocked, so send it on. signal semaphore(interface semaphore) b == claim buffer b_code = r_code b_UDP entry == UDP table_UDP (r_unit) b_UDP entry_slot = r_unit; !? b_data start == b_data(64) %if r_bytes <= 0 %start b_data bytes = 0 %else copy data(r_bytes, r_buffer, b_data start) b_data bytes = r_bytes %finish enqueue buffer(b, UDP outbound queue) signal semaphore(dispatch semaphore) r_status = 0 %true %else %if i_state = blocked state ! Open, blocked, so enqueue it. r_next == nil %if i_outbound == nil %start i_outbound == r %else n == i_outbound n == n_next %while n_next ## nil n_next == r %finish signal semaphore(interface semaphore) %false %else ! Not open, so bounce it. signal semaphore(interface semaphore) r_status = dud op error %true %finish %finish ! Only thing left is receive request. The unit must be at least open. %if i_state < open state %start signal semaphore(interface semaphore) r_status = dud op error %true %finish !! printstring("UDP receive"); newline ! There are two cases to consider: either there is data pending from ! our peer (on the pending in queue) in which case we can complete ! the request immediately, or there is nothing pending in which case ! we will have to wait. %if i_pending in == nil %start ! Nothing immediately available, so we'll have to wait. ! Put ourselves on the tail of the inbound queue. r_next == nil r_timeout = infinity %if r_timeout <= 0 %if i_inbound == nil %start i_inbound == r %else n == i_inbound n == n_next %while n_next ## nil n_next == r %finish signal semaphore(interface semaphore) %false %else ! There's something immediately available. Unlink it and copy its ! data into our buffer. Note that there's no possibility that the ! INet buffer pointer will be nil, as we can only get here via ! "send" and not "send close". n == i_pending in; i_pending in == n_next signal semaphore(interface semaphore) b == n_INet buffer ! Data from our peer. Copy it %if b_data bytes > 0 %and r_buffer ## nil %start copy data(b_data bytes, b_data start, r_buffer) r_bytes = b_data bytes %else ! No data or no buffer?? r_bytes = 0 %finish r_peer = b_IP header_source r_interface = b_interface r_status = 0 ! UDP buffers never have any further to go, so we just free it ! up then return a reply indicator to our caller. release buffer(b) ! Finally, release the queue record enqueue(n, free requests) %true %finish %end ! ICMP has no inbound interface. ! Outbound process. Receives user TCP/UDP requests and calls the appropriate ! processing procedure. If these expect to send an immediate reply they return ! %true, else %false to indicate no reply as yet. ICMP requests are handled ! immediately and always receive an immediate reply. %ownrecord(semaphore fm) outbound semaphore = 0 %ownrecord(mailbox fm) outbound mailbox = 0 %routine outbound process %record(buffer fm)%name b %record(INet user request fm)%name r open input(2, ":N"); select input(2) open output(2, ":T"); select output(2) %cycle r == receive message(outbound mailbox) !! printstring("Outbound: "); phex(r_code); newline %if r_code & request type = TCP request %start send message(r, r_system part_reply, nil) %c %if TCP interpret(r) %and r_system part_reply ## nil %else %if r_code & request type = UDP request send message(r, r_system part_reply, nil) %c %if UDP interpret(r) %and r_system part_reply ## nil %else %if r_code & request type = ICMP request ! ICMP handled in-line. The buffer format is somewhat ! non-standard w.r.t. TCP/UDP. !! printstring("ICMP"); newline b == claim buffer !! printstring("Buffer at "); phex(addr(b)); newline b_data start == b_data(64); b_data bytes = 8 integer(addr(b_data start) ) = r_code integer(addr(b_data start) + 4) = integer(addr(r_buffer)) !! printstring("Enqueue on ICMP queue at ") !! phex(addr(ICMP outbound queue)); newline enqueue buffer(b, ICMP outbound queue) !! printstring("Signal dispatch semaphore at ") !! phex(addr(dispatch semaphore)); newline signal semaphore(dispatch semaphore) !! printstring("Done, responding"); newline r_status = 0 send message(r, r_system part_reply, nil) %c %if r_system part_reply ## nil %else ! Dud code r_status = dud op error send message(r, r_system part_reply, nil) %c %if r_system part_reply ## nil %finish %repeat %end ! User timeout handler. Loop round the interface control blocks, ! calling the per-interface routine. %externalroutine interface user timeouts %integer i semaphore wait(interface semaphore) user timeouts(TCP interface(i)) %for i = 1, 1, TCP max user timeouts(UDP interface(i)) %for i = 1, 1, UDP max signal semaphore(interface semaphore) %end ! Initialisation. For compatibility we return the number of TCP and ! UDP interfaces configured in, though these are static compile-time ! parameters. We set up the semaphore/mailbox for user-requests and ! initialise the pending request buffer pool before starting the ! user-request process and returning. %externalroutine start user interfaces(%integername max TCP, max UDP) %record(process fm)%name p %record(INet user request fm)%name r %integer i %label do outbound process setup semaphore(outbound semaphore) setup mailbox(outbound mailbox, outbound semaphore) FS insert(INet mailbox name, addr(outbound mailbox)) setup semaphore(interface semaphore) signal semaphore(interface semaphore) setup queue(free requests) %for i = 1, 1, requests %cycle r == record(global heap get(size of(r))) enqueue(r, free requests) %repeat p == create process(outbound size, addr(do outbound process), outbound priority, nil) max TCP = TCP max max UDP = UDP max %return do outbound process: outbound process %end %end %of %file