Trailing-Edge
-
PDP-10 Archives
-
BB-JR93K-BB_1990
-
10,7/decmai/mx/mxnnet.b36
There are 22 other files named mxnnet.b36 in the archive. Click here to see a list.
module NMUNET ( ! Task to task network communications
ident = 'X00.12'
) =
begin
! COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1985, 1989.
! ALL RIGHTS RESERVED.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND 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. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
! SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
!++
! 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 'MXNLIB'; ! Get all required definitions
%IF %SWITCHES(TOPS20) %THEN
library 'MONSYM'; ! Monitor symbols
library 'MXJLNK'; ! JSYS linkage definitions
%FI
library 'MXLIB'; ! MX 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
ntimo, !Decnet timeout in minutes...
%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 );
%if $tops20
%then
READ_LINK_STATUS (.LINK_INFO);
READ_REJECT_CODE (.CONN_BLK, .LINK_INFO);
NMU$NETWORK_ABORT (.LINK_INFO [LINK_ID], $SC$ERR_UAB, 0, 0);
%fi
%if $tops10
%then
NMU$QUEUE_EXTRACT (INFO_QUEUE, .LINK_INFO);
NMU$MEMORY_RELEASE (.LINK_INFO, LINK_INFO_BLOCK_ALLOCATION);
%fi
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 = .ntimo ! wait for connect.
else TIME_OUT = 0; ! If target link, wait forever.
CONNECTED = $true; !Assume we're connected
READ_LINK_STATUS (.LINK_INFO);
if CONNECT_WAIT (.LINK_INFO) !If we're waiting, do so.
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 (-2 = link error) (-1 = timeout...)
!
! 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);
$TRACE('Read_Message Length is %D',.length);
.LENGTH
end
else
begin
%debug ((NETWORK_TRANSITIONS or NETWORK_TRACE),
(TRACE_INFO ('Invalid link identifier %O', .LINK_IDENTIFIER)));
-2
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: