Trailing-Edge
-
PDP-10 Archives
-
T10_DECMAIL_MS_V11_FT1_860414
-
10,7/mail/mx/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
%IF %SWITCHES(TOPS20) %THEN
library 'MONSYM'; ! Monitor symbols
library 'JLNKG'; ! 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
%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 = 6000 ! 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 (-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);
.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: