Google
 

Trailing-Edge - PDP-10 Archives - BB-P363B-SM_1985 - t20/nmlt20/nmunet.b36
There are 2 other files named nmunet.b36 in the archive. Click here to see a list.
! UPD ID= 195, SNARK:<6.1.NML>NMUNET.B36.9,  10-Dec-84 14:57:45 by HALPIN
! Get MONSYM Library file out of default directory, not BLI:
!
! UPD ID= 125, SNARK:<6.1.NML>NMUNET.B36.8,  10-Oct-84 12:42:43 by HALPIN
! Once again, fix NMU$NETWORK_VALIDATE.  Moved some code to the TOPS10
! Feature test in NMU$NETWORK_VALIDATE that is not needed for TOPS20.
! Fixed the TOPS20 test for null USERID and ACCOUNT fields.
!
! UPD ID= 100, SLICE:<6.1.NML>NMUNET.B36.7,  18-Sep-84 15:27:38 by GUNN
!
! Add call to require NETT20.B36 for TOPS20 to allow compilation
! under BLISS V3.0 and beyond.
!
!WORK:<GUNN.NML>NMUNET.B36.5 21-Aug-84 10:03:47, Edit by GUNN
!
! Change to accomodate new LIBRARY conventions. MONSYM.L36 and JLNKG.L36
! are now explicity declared here rather than in NMULIB.
!
! UPD ID= 59, SNARK:<6.1.NML>NMUNET.B36.6,  14-Jun-84 15:07:15 by HALPIN
! Don't try to validate the ACCOUNT string if we didn't receive one
! across the net.
!
! UPD ID= 58, SNARK:<6.1.NML>NMUNET.B36.5,  14-Jun-84 10:24:17 by HALPIN
! Removed extra 'return 0' expression, which I put in, in UPD 50.
!
! UPD ID= 50, SNARK:<6.1.NML>NMUNET.B36.4,   6-Jun-84 11:26:19 by HALPIN
! More fixes to NMU$NETWORK_VALIDATE.  Reinstoresd code to move accounting
! info from the connect block to the local cahracter arrays, which are used
! as JSYS arguments.  Also fixed the bit tests for OPERATOR and WHEEL
! privs.
!
! UPD ID= 47, SNARK:<6.1.NML>NMUNET.B36.3,  29-May-84 17:30:20 by GLINDELL
! Reinstore code in NMU$NETWORK_VALIDATE to check for length 1 and zero
!  contents of user name (under $TOPS20)
!
! UPD ID= 30, SNARK:<6.1.NML>NMUNET.B36.2,  24-May-84 16:14:08 by GLINDELL
! DSKT:NMUNET.B36[10,6026,NML703] 22-Feb-84 15:05:21, Edit by DAVENPORT
!
! Conditionalize the TOPS20 code in NMU$NETWORK_VALIDATE.
!
!PH4:<HALPIN>NMUNET.B36.2 20-Feb-84 16:25:48, Edit by HALPIN
!
! Ident 12.
! Change TIME_OUT value from 30 to 60 seconds on SOURCE link
! Connects.  This is to accommodate dumping of DN200 RJE stations.
!
!PH4:<HALPIN>NMUNET.B36.26 16-Feb-84 09:22:53, Edit by HALPIN
!
! Ident 11.
! Use the ACESS% JSYS to verify passwords on Remote Listner
! connections.  This changed needed because GTDIR% returns
! encrypted (?) passwords.
!
!PH4:<HALPIN>NMUNET.B36.3  1-Feb-84 13:28:10, Edit by HALPIN
!
! Ident 10.
! Zero the contents of the DIRBLK vector every time we enter
! NMU$NETWORK_VALIDATE.  Old info on the stack causes $$GTDIR
! to stomp on other parts of memory.
!
! PH4:<MCINTEE>NMUNET.B36.3,  2-Jun-83 08:30:12, Edit by MCINTEE
!
! Ident 09.
! Change reference to debug flag NETWORK_DESCRIPTOR to PRIVATE_SERVER_LINK
! and PRIVATE_HOST_LINK.
!
!NET:<PECKHAM.DEVELOPMENT>NMUNET.B36.12 25-Jun-82 20:26:12, Edit by PECKHAM
!
! Ident 08.
! In NMU$NETWORK_VALIDATE, check the connect accounting data
! as if the user were logging in.  Reject if no match.
! If a match, indicate if he has OPERATOR or WHEEL privledges.
!
!NET:<BRANDT.DEVELOPMENT>NMUNET.B36.1 23-Jun-82 11:26:03, Edit by BRANDT
!
!  Ident 07.
!    Change text of timeout error message.
!
!NET:<BRANDT.DEVELOPMENT>NMUNET.B36.1 28-May-82 11:26:03, Edit by BRANDT
!
!  Ident 06.
!    Change NMU$NETWORK_OPEN so timeout on connect works.
!    Allow for MEMORY_GET to fail in NETWORK_OPEN.
!    Make error detail field of $RESPONSE message null rather than 0.
!    Add debugging code in NETWORK_READ to indicate timeout.
!
!NET:<PECKHAM.DEVELOPMENT>NMUNET.B36.3 23-Mar-82 08:26:03, Edit by PECKHAM
!
! Ident 05.
! Make response pointers optional in NMU$NETWORK_OPEN.
!
!NET:<DECNET20-V3P1.NMU>NMUNET.B36 4-Dec-81 11:25:03, Edit by THIGPEN
!
! Change call to NMU$SCHED_WAIT in NMU$NETWORK_OPEN to include a timeout value
!    LOOK FOR "***" to see where code needs a fail path due to this change!
!
! 15-Nov-81 2:28:36, Edit by GROSSMAN
!
! Change the routine NETWORK_EVENT so that it can determine which NSP channel
! caused the interrupt in the first place. This only applies to Tops-10.
!
!NET:<DECNET20-V3P1.NMU>NMUNET.B36.11  2-Nov-81 11:16:03, Edit by WEBBER
!
!    Add a -2 return from NETWORK_OPEN, which means "permanent error; do
!    not retry".  (This return is compatible with older versions of calling
!    routines.)
!
!NET:<DECNET20-V3P1.NMU>NMUNET.B36.10 23-Oct-81 15:27:47, Edit by WEBBER
!
!    Fix last mod to pass -1 as a parameter to match the %J.  This gets
!    the "last error" ERSTR string.
!
!NET:<DECNET20-V3P1.NMU>NMUNET.B36.5 19-Oct-81 14:25:50, Edit by WEBBER
!
!    Add ERSTR string to response when OPENF for a link fails.
!
!NET:<DECNET20-V3P1.NMU>NMUNET.B36.3 19-Oct-81 14:04:47, Edit by WEBBER
!
!    Add "failure type" map to map disconnect codes into NM link failure
!    error detail.
!
!NET:<DECNET20-V3P1.NMU>NMUNET.B36.4 16-Oct-81 15:25:00, Edit by WEBBER
!
!    Change interface to NMU$NETWORK_OPEN to include an error response buffer.
!
!NET:<DECNET20-V3P1.NMU>NMUNET.B36.3 17-Mar-81 14:15:19, Edit by JENNESS
!    Add debug code for TRANSITIONS and TRACE.
!NET:<DECNET20-V3P1.BASELEVEL-2.SOURCES>NMUNET.B36.3 11-Mar-81 10:58:41, Edit by JENNESS
!    Return failure from _OPEN when OPEN_FOR_CONNECTION fails.
!NET:<DECNET20-V3P1.NMU>NMUNET.BLI.8  3-Feb-81 10:10:54, Edit by JENNESS
!    Change to conform to _SIZE and _LENGTH naming conventions.
!    Return $true/$false from NMU$NETWORK_VALIDATE instead of 0/not 0.
module NMUNET (					! Task to task network communications
		ident = 'X00.12'
		) =
begin
!
! COPYRIGHT (C) 1980, 1981
! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS  01754
!
! THIS SOFTWARE IS FURNISHED  UNDER A LICENSE FOR USE ONLY ON A SINGLE
! COMPUTER  SYSTEM AND  MAY BE  COPIED ONLY WITH  THE INCLUSION OF THE
! ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE, OR ANY OTHER COPIES  THEREOF
! MAY NOT BE PROVIDED OR  OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON
! EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO THESE LICENSE
! TERMS.  TITLE TO AND  OWNERSHIP OF THE  SOFTWARE  SHALL AT ALL TIMES
! REMAIN IN DEC.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
! AND SHOULD  NOT BE CONSTRUED  AS A COMMITMENT  BY DIGITAL  EQUIPMENT
! CORPORATION.
!
! DEC ASSUMES  NO  RESPONSIBILITY  FOR  THE USE OR  RELIABILITY OF ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
!

!++
! Facility: LSG DECnet Network Management
!
! Abstract: This module provides a "generic" interface to DECnet
!	    task to task communications.
!
!	    As perceived by  the user of  these interfaces, there  are
!	    two types of link ends: TARGET and SOURCE.  A TARGET  task
!	    (sometimes known as  a SERVER) waits  for another task  to
!	    issue a connect to it.  A SOURCE task issues a connect  to
!	    the task it  wishes to communicate  with.  Thus the  major
!	    difference  between  the  ends  of  a  link  is  the  link
!	    connection operation.
!
! Environment: TOPS10/TOPS20 user mode, MCB RSX task level
!
! Author: Steven M. Jenness, Creation date: 12-Sep-80
!
!--

!<BLF/SYNONYM $FIELD=FIELD>
!<BLF/SYNONYM %unquote =>
!<BLF/PAGE>
!
! Include files
!

library 'NMULIB';			! Get all required definitions

library 'MONSYM';			! Monitor symbols

library 'JLNKG';			! JSYS linkage definitions

!
! Global routines
!

forward routine
    NMU$NETWORK_UTILITIES;			! Define global entry points

!
! Local routines
!

forward routine
    NETWORK_EVENT : NETWORK_INTERRUPT_LINKAGE novalue,	! Network interrupt handler
    %if $TOPS10
    %then
         PARSE_PPN,			! Parse PPN from network connect
         PARSE_PASSWORD,                ! Parse password from connect
    %else %if $TOPS20
          %then
               LOCAL_NODE_NUMBER : novalue, ! Get EXECUTOR node number
               LOCAL_NODE_NAME : novalue, ! Get EXECUTOR node name
               BUILD_LINK_INFO_BLOCK : novalue,
          %fi
    %fi
    IQ_SCAN;                            ! Scanning routine for info queue

!
! Constants
!

bind
    FAIL_TYPE = uplit

!	Failure code			Reject/object code
!	------------			------------------

	(	5,			!	0
		4,			!	1
		2,			!	2
	       11,			!	3
		7,			!	4
		1,			!	5
		9,			!	6
	       12,			!	7
	       15,			!	8
	       14,			!	9
    rep 22 of (15),			!   10-31
		4,			!      32
		9,			!      33
		8,			!      34
	       15,			!      35
		8,			!      36
	       15,			!      37
	       10,			!      38
		3,			!      39
	       15,			!      40
	       15,			!      41
	       15,			!      42
		8): vector;		!      43

bind
    RETRY_CODE = uplit

!	Return code			Reject/object code
!	-----------			------------------

	(	-2,			!	0
		-1,			!	1
		-2,			!	2
		-2,			!	3
		-2,			!	4
		-2,			!	5
		-1,			!	6
		-2,			!	7
		-1,			!	8
		-2,			!	9
    rep 22 of (-2),			!   10-31
		-1,			!      32
		-1,			!      33
		-2,			!      34
		-2,			!      35
		-2,			!      36
		-2,			!      37
		-1,			!      38
		-2,			!      39
		-2,			!      40
		-2,			!      41
		-2,			!      42
		-2): vector;		!      43

!
! Own variables
!

own
    LOCAL_NODE : block [ch$allocation (9, 8)],	! Local node id
    NEXT_LINK_ID,			! Link identification sequence
    INFO_QUEUE : Q_HEADER;		! Queue of all link info blocks

!
! Structures
!

    $field
    LINK_INFO_FIELDS =
	set
	LINK_QUEUE = [$sub_block (Q_ENTRY_SIZE)], ! Queue of all links
	LINK_EVENT = [$sub_block (EVENT_BLOCK_SIZE)], ! Link event
	LINK_ID = [$integer],		! Link identifier
	LINK_TYPE = [$integer],		! Link type (source, target)
	LINK_STATUS = [$sub_block (LINK_STATUS_BLOCK_SIZE)],
	LINK_SYSTEM_SPECIFIC_FIELDS
	tes;

literal
    LINK_INFO_BLOCK_SIZE = $field_set_size,
    LINK_INFO_BLOCK_ALLOCATION = $field_set_units;

macro
    LINK_INFO_BLOCK =
 block [LINK_INFO_BLOCK_SIZE] field (LINK_INFO_FIELDS) %;

!
! Definitions needed for debugging
!
external
    %debug_data_base;

    %module_name ('NMUNET');

!
! External routines
!

external routine
    NMU$QUEUE_MANAGER,			! Queue management routines
    NMU$MEMORY_MANAGER,			! Memory management routines
    NMU$SCHED_MANAGER,			! Scheduler interface
    NMU$TEXT_MANAGER;			! Text processing facility
%global_routine ('NMU$NETWORK_INITIALIZE') : novalue =

!++
! Functional description:
!
!	This routine initializes the network system interface.
!
! Formal parameters: none
!
! Routine value: none
! Side effects:
!
!	The local node id is retrieved for NMU$NETWORK_LOCAL.
!
!--

    begin

    local
	NODE_ID;
!
! Make the local node id and save it.
!
    NODE_ID = ch$ptr (LOCAL_NODE,, 8);
    LOCAL_NODE_NUMBER (NODE_ID);
    LOCAL_NODE_NAME (NODE_ID);
!
! Reset queue of all link info blocks.
!
    NMU$QUEUE_RESET (INFO_QUEUE);

    %debug (NETWORK_TRANSITIONS, (TRACE_INFO ('Network interface reset')));

    end;					! End of NMU$NETWORK_INITIALIZE
%global_routine ('NMU$NETWORK_OPEN', TYPE, CONN_BLK : ref CONNECT_BLOCK,
		    RESPONSE_PTR, RESPONSE_LEN, RESPONSE_CODE) =

!++
! Functional description:
!
!	This routine opens a logical link.  It blocks the running
!	task until a successful connect is made or the link connection
!	is aborted for some explicit reason.
!
!	TARGET_LINK:	When this routine returns it will have filled
!			in the connect block fields: OPTIONAL_DATA,
!			USER, ACCOUNT and PASSWORD.  The link must
!			still be accepted or rejected.
!
!	SOURCE_LINK:	When this routine returns it will have filled
!			in the connect block fields: OPTIONAL_DATA,
!			REJECT_REASON.
!
! Formal parameters:
!
!	.TYPE	   	Link type to open (SOURCE_LINK, TARGET_LINK).
!	.CONN_BLK  	Address of a link connect block.
!	.RESPONSE_PTR	Character pointer to an area in which an error
!			response message may be built.
!			if 0, no response is built.
!	.RESPONSE_LEN	Address of a value containing the maximum length
!			of the response message.  On return, if an error
!			message has been built this value will contain
!			the length of the message.
!	.RESPONSE_CODE	NICE error code to put into the response message;
!			usually LCF or MCF.
!
! Routine value:
!
!	gtr 0	Link id to be used in all future link references.
!	lss 0	DECnet link failure indication.
!
! Side effects: none
!
!--

    begin

    local
	LINK_INFO : ref LINK_INFO_BLOCK,
	TIME_OUT,
	CONNECTED;

    %debug (NETWORK_TRANSITIONS, 
	(begin
	    if .TYPE eql SOURCE_LINK
	    then TRACE_INFO ('Opening source link')
	    else TRACE_INFO ('Opening target link');

	    if .TYPE eql SOURCE_LINK
	    then
		begin
		local PTR, NUMBER, LENGTH;
		PTR = .CONN_BLK [CB_HOST];
		NUMBER = GETW (PTR);
		LENGTH = GETB (PTR);
		if .LENGTH gtr 0
		then TRACE_INFO (' to node (%D) %#A', .NUMBER, .LENGTH, .PTR)
		else TRACE_INFO (' to node (%D)', .NUMBER);
		end;

	    TRACE_INFO (' object type: %D', .CONN_BLK [CB_OBJECT]);

	    if .CONN_BLK [CB_TASK_LENGTH] gtr 0
	    then TRACE_INFO (' task: %#A',
				.CONN_BLK [CB_TASK_LENGTH],
				.CONN_BLK [CB_TASK]);

	    if .CONN_BLK [CB_DESCRIPTOR_LENGTH] gtr 0
	    then TRACE_INFO (' descriptor: %#A',
			     .CONN_BLK [CB_DESCRIPTOR_LENGTH],
			     .CONN_BLK [CB_DESCRIPTOR])
	    else
		begin
		external routine USER_NAME;
	 	if .TYPE eql SOURCE_LINK 
		then

	  	     %debug ((PRIVATE_HOST_LINK and NETWORK_TRANSITIONS),
			     (TRACE_INFO (' debugging descriptor: %@', USER_NAME)))
	        else
               	     %debug ((PRIVATE_SERVER_LINK and NETWORK_TRANSITIONS),
			     (TRACE_INFO (' debugging descriptor: %@', USER_NAME)));
		end;

	    if .TYPE eql SOURCE_LINK
	    then
		begin

		if .CONN_BLK [CB_USERID_LENGTH] gtr 0
		then TRACE_INFO (' userid: %#A',
				 .CONN_BLK [CB_USERID_LENGTH],
				 .CONN_BLK [CB_USERID]);

		if .CONN_BLK [CB_ACCOUNT_LENGTH] gtr 0
		then TRACE_INFO (' account: %#A',
				 .CONN_BLK [CB_ACCOUNT_LENGTH],
				 .CONN_BLK [CB_ACCOUNT]);

		if .CONN_BLK [CB_PASSWORD_LENGTH] gtr 0
		then TRACE_INFO (' password: %#A',
				 .CONN_BLK [CB_PASSWORD_LENGTH],
				 .CONN_BLK [CB_PASSWORD]);

		if .CONN_BLK [CB_DATA_LENGTH] gtr 0
		then TRACE_INFO (' optional data: %#B',
				 .CONN_BLK [CB_DATA_LENGTH],
				 .CONN_BLK [CB_DATA]);
		end;
	 end));	

    if (LINK_INFO = NMU$MEMORY_GET (LINK_INFO_BLOCK_ALLOCATION)) eql 0
    then
	begin
	if .RESPONSE_PTR neq 0
	then
	    .RESPONSE_LEN = $RESPONSE (.RESPONSE_PTR, NICE$_REE);
	return -2			! Fail if we can't get memory
	end;

    LINK_INFO [LINK_ID] = (NEXT_LINK_ID = .NEXT_LINK_ID + 1);

    %debug (NETWORK_TRANSITIONS,
	    (TRACE_INFO (' link id assigned: %O', .LINK_INFO [LINK_ID])));

    NMU$SCHED_EVENT (LINK_INFO [LINK_EVENT], $true);
    LINK_INFO [LINK_TYPE] = .TYPE;

    BUILD_LINK_INFO_BLOCK (.CONN_BLK, .LINK_INFO);

    NMU$QUEUE_INSERT (INFO_QUEUE, LINK_INFO [LINK_QUEUE]);

    if not OPEN_FOR_CONNECTION (.LINK_INFO) then
    begin
	%debug (NETWORK_TRANSITIONS,
		(TRACE_INFO ('Link %O open failed', .LINK_INFO [LINK_ID])));

	if .RESPONSE_PTR neq 0
	then
	    .RESPONSE_LEN = $RESPONSE (.RESPONSE_PTR, NICE$_LCF, ,
			' %J', -1 );

	NMU$QUEUE_EXTRACT (INFO_QUEUE, .LINK_INFO);
	NMU$MEMORY_RELEASE (.LINK_INFO, LINK_INFO_BLOCK_ALLOCATION);
	return -2
	end;

    %if $tops10
    %then
	NMU$SCHED_EVENT (LINK_INFO [LINK_EVENT], $true);
    %fi

    if .TYPE eql SOURCE_LINK		! If source link
    then TIME_OUT = 60			!  wait 60 seconds for connect.
    else TIME_OUT = 0;			! If target link, wait forever.

    READ_LINK_STATUS (.LINK_INFO);
    if CONNECT_WAIT (.LINK_INFO)
    then
	CONNECTED = NMU$SCHED_WAIT (LINK_INFO [LINK_EVENT] , .TIME_OUT);

    if not .CONNECTED
    then
	begin
	if .RESPONSE_PTR neq 0
	then
	    .RESPONSE_LEN = $RESPONSE (.RESPONSE_PTR, NICE$_LCF, 10,
			' Terminated after %D second timeout', .TIME_OUT);
        NMU$NETWORK_ABORT (.LINK_INFO [LINK_ID], $SC$ERR_UAB, 0, 0);
	return -2			! Don't retry
	end;

    READ_LINK_STATUS (.LINK_INFO);

    if LINK_OPEN (.LINK_INFO)
    then
	begin
	READ_HOST_ID (.CONN_BLK, .LINK_INFO);
	READ_OPTIONAL_DATA (.CONN_BLK, .LINK_INFO);

	%debug (NETWORK_TRANSITIONS,
		(begin
		    TRACE_INFO ('Link %O connected', .LINK_INFO [LINK_ID]);
		    begin
		    local PTR, NUMBER, LENGTH;
		    PTR = .CONN_BLK [CB_HOST];
		    NUMBER = GETW (PTR);
		    LENGTH = GETB (PTR);
		    if .LENGTH gtr 0
		    then TRACE_INFO (' to node (%D) %#A', .NUMBER, .LENGTH, .PTR)
		    else TRACE_INFO (' to node (%D)', .NUMBER);
		    end;

		    if .CONN_BLK [CB_DATA_LENGTH] gtr 0
		    then TRACE_INFO (' optional data: %#B',
				 .CONN_BLK [CB_DATA_LENGTH],
				 .CONN_BLK [CB_DATA]);

		    end));


	if .LINK_INFO [LINK_TYPE] eql TARGET_LINK
	then
	    begin
	    READ_USER_NAME (.CONN_BLK, .LINK_INFO);
	    READ_PASSWORD_STRING (.CONN_BLK, .LINK_INFO);
	    READ_ACCOUNT_STRING (.CONN_BLK, .LINK_INFO);
	    READ_OBJECT_TYPE (.CONN_BLK, .LINK_INFO);
	    READ_DESCRIPTOR (.CONN_BLK, .LINK_INFO);
	    %debug (NETWORK_TRANSITIONS,
		    (begin
	    	     TRACE_INFO (' object type: %D', .CONN_BLK [CB_OBJECT]);

	    	     if .CONN_BLK [CB_USERID_LENGTH] gtr 0
	    	     then TRACE_INFO (' userid: %#A',
				 .CONN_BLK [CB_USERID_LENGTH],
				 .CONN_BLK [CB_USERID]);

	    	     if .CONN_BLK [CB_ACCOUNT_LENGTH] gtr 0
	    	     then TRACE_INFO (' account: %#A',
				 .CONN_BLK [CB_ACCOUNT_LENGTH],
				 .CONN_BLK [CB_ACCOUNT]);

	    	     if .CONN_BLK [CB_PASSWORD_LENGTH] gtr 0
	    	     then TRACE_INFO (' password: %#A',
				 .CONN_BLK [CB_PASSWORD_LENGTH],
				 .CONN_BLK [CB_PASSWORD]);


	    	     TRACE_INFO (' object type: %D', .CONN_BLK [CB_OBJECT]);

	    	     if .CONN_BLK [CB_DESCRIPTOR_LENGTH] gtr 0
	    	     then TRACE_INFO (' descriptor: %#A',
			     .CONN_BLK [CB_DESCRIPTOR_LENGTH],
			     .CONN_BLK [CB_DESCRIPTOR]);

		     end));

	    end;

	.LINK_INFO [LINK_ID]
	end
    else
	begin
	READ_REJECT_CODE (.CONN_BLK, .LINK_INFO);

	if .RESPONSE_PTR neq 0
	then
	    .RESPONSE_LEN = $RESPONSE (.RESPONSE_PTR, NICE$_LCF,
			.FAIL_TYPE[.CONN_BLK[CB_REJECT_CODE]] );

	%debug (NETWORK_TRANSITIONS,
		(begin
		 TRACE_INFO ('Link %O connect failed', .LINK_INFO [LINK_ID]);
		 TRACE_INFO (' reject code: %D', .CONN_BLK [CB_REJECT_CODE]);
		 end));

	if .LINK_INFO [LINK_TYPE] eql SOURCE_LINK
	then
	    begin
	    READ_OPTIONAL_DATA (.CONN_BLK, .LINK_INFO);
	    %debug (NETWORK_TRANSITIONS,
		    (if .CONN_BLK [CB_DATA_LENGTH] gtr 0
		     then TRACE_INFO (' optional data: %#B',
				 .CONN_BLK [CB_DATA_LENGTH],
				 .CONN_BLK [CB_DATA])));

	    end;

	CLOSE_LINK (.LINK_INFO, 0, 0);
	NMU$QUEUE_EXTRACT (INFO_QUEUE, .LINK_INFO);
	NMU$MEMORY_RELEASE (.LINK_INFO, LINK_INFO_BLOCK_ALLOCATION);
	.RETRY_CODE[.CONN_BLK[CB_REJECT_CODE]]
	end

    end;					! End of NMU$NETWORK_OPEN
%global_routine ('NMU$NETWORK_ACCEPT', LINK_IDENTIFIER, DATA_LENGTH, DATA_PTR) =

!++
! Functional description:
!
!	This routine accepts the connection to a TARGET link
!	end.  The link was initially opened by a call to the
!	NMU$NETWORK_TARGET routine.
!
! Formal parameters: none
!
!	.LINK_IDENTIFIER    Link id for the target link end.
!	.DATA_LENGTH	    Length of optional accept data
!	.DATA_PTR	    Pointer to optional accept data
!
! Routine value:
!
!	$true	Accept done
!	$false	Invalid link id
!
! Side effects: none
!
!--

    begin

    local
	LINK_INFO : ref LINK_INFO_BLOCK;

    if (LINK_INFO = NMU$QUEUE_SCAN (INFO_QUEUE, .LINK_IDENTIFIER, IQ_SCAN)) neq 0
    then
	begin
	%debug (NETWORK_TRANSITIONS,
		(begin
		 TRACE_INFO ('Link %O connect accepted', .LINK_IDENTIFIER);
		 TRACE_INFO (' optional data: %#B', .DATA_LENGTH, .DATA_PTR);
		 end));

	ACCEPT_NETWORK_CONNECT (.LINK_INFO, .DATA_LENGTH, .DATA_PTR);
	$true
	end
    else
	begin
	%debug (NETWORK_TRANSITIONS,
		(TRACE_INFO ('Invalid link identifier %O', .LINK_IDENTIFIER)));
	$false
	end
    end;					! End of NMU$NETWORK_ACCEPT
%global_routine ('NMU$NETWORK_REJECT', LINK_IDENTIFIER, REASON, DATA_LENGTH, DATA_PTR) =

!++
! Functional description:
!
!	This routine rejects the connection to a TARGET link
!	end.  The link was initially opened by a call to the
!	NMU$NETWORK_TARGET routine.
!
!	Note that if this routine fails ($false return value)
!	the NMU$NETWORK_CLOSE still needs to be called to clean
!	up the link.
!
! Formal parameters: none
!
!	.LINK_IDENTIFIER    Link id for the target link end.
!	.REASON		    Reason code for rejection
!	.DATA_LENGTH	    Length of optional reject data
!	.DATA_PTR	    Pointer to optional reject data
!
! Routine value:
!
!	$true	Reject done
!	$false	Invalid link id
!
! Side effects: none
!
!--

    begin

    local
	LINK_INFO : ref LINK_INFO_BLOCK;

    if (LINK_INFO = NMU$QUEUE_SCAN (INFO_QUEUE, .LINK_IDENTIFIER, IQ_SCAN)) neq 0
    then
	begin
	%debug (NETWORK_TRANSITIONS,
		(begin
		 TRACE_INFO ('Link %O connect rejected', .LINK_IDENTIFIER);
		 TRACE_INFO (' reason code: %D', .REASON);
		 TRACE_INFO (' optional data: %#B', .DATA_LENGTH, .DATA_PTR);
		 end));

	REJECT_NETWORK_CONNECT (.LINK_INFO, .REASON, .DATA_LENGTH, .DATA_PTR);
	$true
	end
    else
	begin
	%debug (NETWORK_TRANSITIONS,
		(TRACE_INFO ('Invalid link identifier %O', .LINK_IDENTIFIER)));
	$false
	end
    end;					! End of NMU$NETWORK_REJECT
%global_routine ('NMU$NETWORK_READ', LINK_IDENTIFIER, BUFFER_LENGTH, BUFFER_PTR) =

!++
! Functional description:
!
!	This routine reads data from the specified logical link into
!	the supplied buffer.  This calls blocks until either data is
!	available or the link is disconnected.
!
! Formal parameters:
!
!	.LINK_IDENTIFIER Link identifier.
!	.BUFFER_LENGTH	Number of 8 bit bytes available in buffer.
!	.BUFFER_PTR	Pointer to buffer to read data into.
!
! Routine value:
!
!	Number of bytes read in (0 = link error)
!
! Side effects: none
!
!--

    begin

    local
	LINK_INFO : ref LINK_INFO_BLOCK,
	LENGTH;

    if (LINK_INFO = NMU$QUEUE_SCAN (INFO_QUEUE, .LINK_IDENTIFIER, IQ_SCAN)) neq 0
    then
	begin
	LENGTH = READ_MESSAGE (.LINK_INFO, .BUFFER_LENGTH, .BUFFER_PTR);
	%debug (NETWORK_TRACE,
		(if .LENGTH geq 0
		 then
		     begin
		     local COUNT, PTR, OUTCNT;

    		     TRACE_INFO ('Read data on link %O, %D bytes read',
				 .LINK_IDENTIFIER, .LENGTH);

		     PTR = .BUFFER_PTR;
		     COUNT = .LENGTH;

		     while .COUNT gtr 0 do
			 begin
			 OUTCNT = min (.COUNT, 8);
			 TRACE_INFO (' %#B', .OUTCNT, .PTR);
			 PTR = ch$plus (.PTR, 8);
			 COUNT = .COUNT - 8;
			 end;
		     end
		 else
    		     TRACE_INFO ('Read data on link %O, timed out',
				 .LINK_IDENTIFIER)));
	.LENGTH
	end
    else
	begin
	%debug ((NETWORK_TRANSITIONS or NETWORK_TRACE),
		(TRACE_INFO ('Invalid link identifier %O', .LINK_IDENTIFIER)));
	0
	end
    end;					! End of NMU$NETWORK_READ
%global_routine ('NMU$NETWORK_WRITE', LINK_IDENTIFIER, EOM_FLAG, BUFFER_LENGTH, BUFFER_PTR) =

!++
! Functional description:
!
!	This routine writes data to the specified logical link from
!	the supplied buffer.
!
! Formal parameters:
!
!	.LINK_IDENTIFIER Link identifier.
!	.EOM_FLAG	Flag to indicate end of message.
!	.BUFFER_LENGTH	Number of 8 bit bytes of data in buffer.
!	.BUFFER_PTR	Pointer to buffer to write data from.
!
! Routine value:
!
!	$true	Write succeeded
!	$false	Write failed, link disconnected.
!
! Side effects: none
!
!--

    begin

    local
	LINK_INFO : ref LINK_INFO_BLOCK,
	RESULT;

    if (LINK_INFO = NMU$QUEUE_SCAN (INFO_QUEUE, .LINK_IDENTIFIER, IQ_SCAN)) eql 0
    then
	begin
	%debug ((NETWORK_TRANSITIONS or NETWORK_TRACE),
		(TRACE_INFO ('Invalid link identifier %O', .LINK_IDENTIFIER)));
	$false
	end
    else
	if not LINK_CONNECTED (.LINK_INFO)
	then
	    begin
	    %debug ((NETWORK_TRANSITIONS or NETWORK_TRACE),
		(TRACE_INFO ('Link %O not connected', .LINK_IDENTIFIER)));
	    $false
	    end
	else
	    begin

	    %debug (NETWORK_TRACE,
		(begin
		 local COUNT, PTR, OUTCNT;

		 if .EOM_FLAG
		 then TRACE_INFO ('Write message on link %O, %D bytes',
				   .LINK_IDENTIFIER, .BUFFER_LENGTH)
		 else TRACE_INFO ('Write string on link %O, %D bytes',
				   .LINK_IDENTIFIER, .BUFFER_LENGTH);

		 PTR = .BUFFER_PTR;
		 COUNT = .BUFFER_LENGTH;

		 while .COUNT gtr 0 do
			begin
			OUTCNT = min (.COUNT, 8);
			TRACE_INFO (' %#B', .OUTCNT, .PTR);
			PTR = ch$plus (.PTR, 8);
			COUNT = .COUNT - 8;
			end;

		 end));

	    RESULT = (if .EOM_FLAG
	    then WRITE_MESSAGE (.LINK_INFO, .BUFFER_LENGTH, .BUFFER_PTR)
	    else WRITE_STRING (.LINK_INFO, .BUFFER_LENGTH, .BUFFER_PTR));

	    %debug ((NETWORK_TRANSITIONS or NETWORK_TRACE),
		(if not .RESULT
		 then
		    TRACE_INFO ('Write failed on link %O', .LINK_IDENTIFIER)));

	    .RESULT
	    end

    end;					! End of NMU$NETWORK_WRITE
%global_routine ('NMU$NETWORK_ABORT', LINK_IDENTIFIER, REASON, DATA_LENGTH, DATA_PTR) =

!++
! Functional description:
!
!
! Formal parameters:
!
!	.LINK_IDENTIFIER    Identifier of link to abort
!	.REASON		    Reason code to aborting link
!	.DATA_LENGTH	    Length of optional abort data
!	.DATA_PTR	    Pointer to optional abort data
!
! Routine value:
!
!	$true	Link aborted
!	$false	Invalid link id
!
! Side effects: none
!
!--

    begin

    local
	LINK_INFO : ref LINK_INFO_BLOCK;

    if (LINK_INFO = NMU$QUEUE_SCAN (INFO_QUEUE, .LINK_IDENTIFIER, IQ_SCAN)) neq 0
    then
	begin
	%debug (NETWORK_TRANSITIONS,
		(begin
		 TRACE_INFO ('Link %O aborted', .LINK_IDENTIFIER);
		 TRACE_INFO (' reason code: %D', .REASON);
		 TRACE_INFO (' optional data: %#B', .DATA_LENGTH, .DATA_PTR);
		 end));

	ABORT_LINK (.LINK_INFO, .REASON, .DATA_LENGTH, .DATA_PTR);
	NMU$QUEUE_EXTRACT (INFO_QUEUE, .LINK_INFO);
	NMU$MEMORY_RELEASE (.LINK_INFO, LINK_INFO_BLOCK_ALLOCATION);
	$true
	end
    else
	begin
	%debug ((NETWORK_TRANSITIONS or NETWORK_TRACE),
		(TRACE_INFO ('Invalid link identifier %O', .LINK_IDENTIFIER)));
	$false
	end

    end;					! End of NMU$NETWORK_ABORT
%global_routine ('NMU$NETWORK_CLOSE', LINK_IDENTIFIER, DATA_LENGTH, DATA_PTR) =

!++
! Functional description:
!
!
! Formal parameters:
!
!	.LINK_IDENTIFIER    Identifier of link to close
!	.DATA_LENGTH	    Length of optional close data
!	.DATA_PTR	    Pointer to optional close data
!
! Routine value:
!
!	$true	Link closed
!	$false	Invalid link id
!
! Side effects: none
!
!--

    begin

    local
	LINK_INFO : ref LINK_INFO_BLOCK;

    if (LINK_INFO = NMU$QUEUE_SCAN (INFO_QUEUE, .LINK_IDENTIFIER, IQ_SCAN)) neq 0
    then
	begin
	%debug (NETWORK_TRANSITIONS,
		(begin
		 TRACE_INFO ('Link %O closed', .LINK_IDENTIFIER);
		 TRACE_INFO (' optional data: %#B', .DATA_LENGTH, .DATA_PTR);
		 end));


	CLOSE_LINK (.LINK_INFO, .DATA_LENGTH, .DATA_PTR);
	NMU$QUEUE_EXTRACT (INFO_QUEUE, .LINK_INFO);
	NMU$MEMORY_RELEASE (.LINK_INFO, LINK_INFO_BLOCK_ALLOCATION);
	$true
	end
    else
	begin
	%debug ((NETWORK_TRANSITIONS or NETWORK_TRACE),
		(TRACE_INFO ('Invalid link identifier %O', .LINK_IDENTIFIER)));
	$false
	end

    end;					! End of NMU$NETWORK_CLOSE
%global_routine ('NMU$NETWORK_STATUS', LINK_IDENTIFIER, STS_BLK) =

!++
! Functional description:
!
!	This routine supplies the status of a logical link.
!
! Formal parameters:
!
!	.LINK_IDENTIFIER   Link identifier.
!	.STS_BLK	   Address of status block.
!
! Routine value: none
! Side effects: none
!
!--

    begin

    local
	LINK_INFO : ref LINK_INFO_BLOCK;

    if (LINK_INFO = NMU$QUEUE_SCAN (INFO_QUEUE, .LINK_IDENTIFIER, IQ_SCAN)) neq 0
    then
	begin
	READ_LINK_STATUS (.LINK_INFO);
	$true
	end
    else $false

    end;					! End of NMU$NETWORK_STATUS
global routine %unquote NMU$NETWORK_VALIDATE (CBLK) =

!++
! Functional description:
!
!
! Formal parameters:
!
!	.CBLK  	Address of a link connect block.
!
! Routine value:
!
!	-2 - JSYS error
!	-1 - No such user
!	 0 - Unprivledged user
!	 1 - WHEEL privledges
!	 2 - OPERATOR privledges
!
! Side effects: none
!
!--

    begin

    map
	CBLK : ref CONNECT_BLOCK;

    %if $TOPS20
    %then

    begin

    literal AC_PSW = %O'040000000000';

    local
	USERID : block [ch$allocation (16 + 1)],
	PASSWORD : block [ch$allocation (8 + 1)],
	ACCOUNT : block [ch$allocation (16 + 1)],
	DIRBLK : vector [$CDDAC + 1],
	DIRECTORY_NUMBER,
	DIRPSW : block [ch$allocation (8 + 1)],
	ACCBLK : vector [$ACJOB+1];

    DECLARE_JSYS (RCUSR, RCDIR, GTDIR, ACCES, VACCT, STCMP);

    macro
	jsys$ptr (ADDR) = ch$ptr (ADDR) %;

    bind
	USER_NUMBER = DIRECTORY_NUMBER;

    if (.CBLK [CB_USERID_LENGTH] eql 1 ) and
       (ch$rchar (.CBLK [CB_USERID]) eql 0)
    then return 0;

    incr I from 0 to $CDDAC
    do
	DIRBLK[.I] = 0;

    ch$wchar (0, ch$move (.CBLK [CB_USERID_LENGTH], .CBLK [CB_USERID], ch$ptr (USERID)));
    %(validate that this is a valid user name)%
    ch$wchar (0, ch$move (.CBLK [CB_ACCOUNT_LENGTH], .CBLK [CB_ACCOUNT], ch$ptr (ACCOUNT)));
    ch$wchar (0, ch$move (.CBLK [CB_PASSWORD_LENGTH], .CBLK [CB_PASSWORD], ch$ptr (PASSWORD)));

    if not $$RCUSR (RC_EMO, jsys$ptr (USERID), 0;,, USER_NUMBER)
    then return -2;

    if .USER_NUMBER eql 0 then return -2;

    if not $$RCDIR (RC_EMO, .USER_NUMBER, 0;,, DIRECTORY_NUMBER)
    then return -2;

    if .DIRECTORY_NUMBER eql 0 then return -2;

    DIRBLK [$CDLEN] = $CDDAC + 1;

    if not $$GTDIR (.DIRECTORY_NUMBER, DIRBLK, jsys$ptr (DIRPSW))
    then return -2;

    ACCBLK [$ACDIR] = .DIRECTORY_NUMBER;
    ACCBLK [$ACPSW] = jsys$ptr (PASSWORD);
    ACCBLK [$ACJOB] = -1;

    if not $$ACCES ( (AC_PSW + 3), ACCBLK)
    then return -1;

    if not (.CBLK [CB_ACCOUNT_LENGTH] eql 1 ) and
       (ch$rchar (.CBLK [CB_ACCOUNT]) eql 0)
    then 
	 if not $$VACCT (.DIRECTORY_NUMBER, jsys$ptr (ACCOUNT))
         then return -1;

    if (.DIRBLK [$CDPRV] and SC_OPR) neq 0
    then return 2;

    if (.DIRBLK [$CDPRV] and SC_WHL) neq 0
    then return 1;

    end;

    %fi
    %if $TOPS10
    %then

    begin

    builtin
	UUO;

    register
	T1;

    literal
	UGACC$ = %o'24',		! Access control function
	UGOUP$ = %o'25',		! Obtain user's profile
	$UGACT = 1,			! Account string argument
	$UGPPN = 2,			! PPN argument
	$UGPSW = 3,			! Password argument
	$ACPRV = 2,			! Privilege word from UGOUP$
	$ACPRO = 7,			! Profile word from UGOUP$
	AC$POK = %o'020000000000',	! POKE privilege bit
	AC$OPR = %o'000000070000';	! Operator privilege byte

    local
	PPN,
	PASSWORD,
	QUEUE_BLOCK: vector [11],
	USER_PROFILE: vector [20];

    macro
	DEFAULT_USERID = '' %,
	DEFAULT_ACCOUNT = '' %,
	DEFAULT_PASSWORD = '' %;

    !
    ! Default any missing parts
    !

    if .CBLK [CB_USERID_LENGTH] eql 0
    then
	begin
	    CBLK [CB_USERID] = ch$ptr (uplit (%asciz DEFAULT_USERID));
	    CBLK [CB_USERID_LENGTH] = ch$diff (ch$find_ch (17, .CBLK [CB_USERID], 0), .CBLK [CB_USERID]);
	end;

    if .CBLK [CB_ACCOUNT_LENGTH] eql 0
    then
	begin
	    CBLK [CB_ACCOUNT] = ch$ptr (uplit (%asciz DEFAULT_ACCOUNT));
	    CBLK [CB_ACCOUNT_LENGTH] = ch$diff (ch$find_ch (17, .CBLK [CB_ACCOUNT], 0), .CBLK [CB_ACCOUNT]);
	end;

    if .CBLK [CB_PASSWORD_LENGTH] eql 0
    then
	begin
	    CBLK [CB_PASSWORD] = ch$ptr (uplit (%asciz DEFAULT_PASSWORD));
	    CBLK [CB_PASSWORD_LENGTH] = ch$diff (ch$find_ch (17, .CBLK [CB_PASSWORD], 0), .CBLK [CB_PASSWORD]);
	end;

    !
    ! Grant unprivileged access if no user-id
    !

    if .CBLK [CB_USERID_LENGTH] eql 0
    then
	return 0;

    if not PARSE_PPN (PPN, .CBLK[CB_USERID])
    then
	return -1;

    PASSWORD = PARSE_PASSWORD (.CBLK[CB_PASSWORD]);

    !
    ! Set up to validate user supplied account information
    !

    QUEUE_BLOCK [$QUFNC] = QF$RSP + $QUMAE;
    QUEUE_BLOCK [$QUNOD] = 0;
    QUEUE_BLOCK [$QURSP] = 20^18 + USER_PROFILE;
    QUEUE_BLOCK [$QUARG] = QA$IMM + 1^18 + $QBAFN;
    QUEUE_BLOCK [$QUARV] = UGACC$;
    QUEUE_BLOCK [$QUARG+2] = QA$IMM + 1^18 + $UGPPN;
    QUEUE_BLOCK [$QUARV+2] = .PPN;
    QUEUE_BLOCK [$QUARG+4] = QA$IMM + 1^18 + $UGPSW;
    QUEUE_BLOCK [$QUARV+4] = .PASSWORD;
!   QUEUE_BLOCK [$QUARG+6] = ((.CBLK[CB_ACCOUNT_LENGTH]/5)+1)^18 + $UGACT;
!   QUEUE_BLOCK [$QUARV+6] = .CBLK [CB_ACCOUNT];

    T1 = 9^18 + QUEUE_BLOCK;

    !
    ! Validate the PPN, account, and password
    !

    if not uuo (1, QUEUE$ (T1))
    then
	return -1;

    !
    ! Set up to obtain user's profile
    !

    QUEUE_BLOCK [$QUARV] = UGOUP$;

    T1 = 9^18 + QUEUE_BLOCK;

    !
    ! Obtain user's profile
    !

    if not uuo (1, QUEUE$ (T1))
    then
	return -1;

    !
    ! First check for system operator privileges
    !

    if .POINTR ((USER_PROFILE [$ACPRO+1]), AC$OPR) eql $OBSOP
    then
	return 2;

    !
    ! Also check for user with POKE privileges
    !

    if .POINTR ((USER_PROFILE [$ACPRV+1]), AC$POK)
    then
	return 1;

    end;

    %fi

    return 0

    end;					! End of NMU$NETWORK_VALIDATE
%if $TOPS10
%then
%routine ('PARSE_PPN', PPN, PTR) =

!++
!
! Functional description:
!
!	This routine parses a PPN from a string.
!
! Formal parameters:
!
!	PPN	- Address of location to store PPN.
!	PTR	- Byte pointer to string to be parsed.
!
! Routine value:
!
!	$true	- PPN parsed correctly
!	$false	- Error encountered
!
!--

begin

    local
	CHAR,
	PROJ,
	PROG,
	PPN_DELIMETER;

    PROJ = 0;
    PROG = 0;
    PPN_DELIMETER = 0;

    if ch$rchar (.PTR) eql %c'['
    then
	begin
	    PTR = ch$plus (.PTR, 1);
	    PPN_DELIMETER = %c']';
	end;

    while (CHAR = ch$rchar_a (PTR)) neq 0
    do
	begin
	    if (.CHAR lss %c'0') or (.CHAR gtr %c'7')
	    then
		exitloop;
	    PROJ = .PROJ*8 + .CHAR - %c'0';
	    if .PROJ gtr %o'777777'
	    then
		return $false;
	end;

    if .CHAR neq %c','
    then
	return $false;

    while (CHAR = ch$rchar_a (PTR)) neq 0
    do
	begin
	    if (.CHAR lss %c'0') or (.CHAR gtr %c'7')
	    then
		exitloop;
	    PROG = .PROG*8 + .CHAR - %c'0';
	    if .PROG gtr %o'777777'
	    then
		return $false;
	end;

    if .CHAR neq .PPN_DELIMETER
    then
	return $false;

    if (.PROJ eql 0) or (.PROG eql 0)
    then
	return $false;

    .PPN = .PROJ^18 + .PROG;

    $true

end;				! of PARSE_PPN
%routine ('PARSE_PASSWORD', PTR) =

!++
!
! Functional description:
!
!	This routine parses a SIXBIT password from a string.
!
! Formal parameters:
!
!	PTR	- Byte pointer to string to be parsed.
!
! Routine value:
!
!	SIXBIT password
!
!--

begin

    local
	CHAR,
	PASSWORD;

    PASSWORD = 0;

    while (CHAR = ch$rchar_a (PTR)) neq 0
    do
	begin
	    if (.CHAR geq %c'a') and (.CHAR leq %c'z')
	    then
		CHAR = .CHAR - (%c'a' - %c'A');
	    PASSWORD = .PASSWORD ^ 6 + ((.CHAR - %c' ') and %o'77');
	end;

    .PASSWORD

end;				! of PARSE_PASSWORD
%fi
%global_routine ('NMU$NETWORK_LOCAL') =

!++
! Functional description:
!
!	This routine returns a pointer to the local node
!	name string.
!
! Formal parameters: none
!
! Routine value:
!
!	Byte pointer to node name string.
!
! Side effects: none
!
!--

    begin
    ch$ptr (LOCAL_NODE,, 8)
    end;					! End of NMU$NETWORK_LOCAL
%routine ('NETWORK_EVENT') NETWORK_INTERRUPT_ROUTINE novalue =

!++
! Functional description:
!
!	This routine is called whenever there is a network link
!	event.  The event block associated with the link is flagged to
!	indicate to any watching task that a link event has occured.
!
! Formal parameters:
!
!	.LINK_INFO	Address of link info block
!
! Routine value: none
! Side effects: none
!
!--

    begin
	%if $TOPS10 %then
	local LINK_INFO : ref LINK_INFO_BLOCK;

	if ..CHANNEL_STATUS eql 0 then return;

	LINK_INFO = SEARCH_NETLNK (..CHANNEL_STATUS and %o'777777');

	if .LINK_INFO eql 0 then return;

	%fi

	NMU$SCHED_FLAG (LINK_INFO [LINK_EVENT]);
	PROCESS_WAKE;
	NETWORK_INTERRUPT_CLEAR (.LINK_INFO);
    end;					! End of NETWORK_EVENT
%routine ('IQ_SCAN', LINK_INFO : ref LINK_INFO_BLOCK, LINK_IDENTIFIER) =

!++
! Functional description:
!
!	This routine is called when scanning the INFO_QUEUE by
!	NMU$QUEUE_SCAN to find the entry associated with a
!	particular link identifier.
!
! Formal parameters:
!
!	.LINK_INFO	  address of current entry on the info queue.
!	.LINK_IDENTIFIER  identifier of link to find data base for.
!
! Routine value:
!
!	Address of link info block if matched (0 otherwise).
!
! Side effects: none
!
!--

    begin
	if .LINK_INFO [LINK_ID] eql .LINK_IDENTIFIER
	then .LINK_INFO
	else 0
    end;					! End of IQ_SCAN
!
! System specific network service routines
!

switches
    list (require);

%if $TOPS20
%then require 'NETT20';
%fi

end						! End of module NMUNET

eludom
! Local Modes:
! Mode:BLISS
! Auto Save Mode:0
! Comment Column:40
! Comment Rounding:+1
! End: