Trailing-Edge
-
PDP-10 Archives
-
bb-h138f-bm
-
7-sources/diudef.b36
There are 4 other files named diudef.b36 in the archive. Click here to see a list.
%TITLE 'DIU Default Processing'
MODULE DIUDEF(IDENT = '254',
LANGUAGE(BLISS36),
ENTRY(DEF$INIT, ! Initialize defaults list
DEF$REQUEST, ! Set up request defaults
DEF$FIND, ! Find default block for node
DEF$CREATE ! Create new default block
)) =
BEGIN
! COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1986.
! 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: DIU (Data Interchange Utility for TOPS-20)
!
! ABSTRACT: This module sets defaults in a request block prior to
! queueing it for execution.
!
! ENVIRONMENT: TOPS-20 V6.1 (User mode) RMS V3
! BLISS-36 V4 XPORT
!
! AUTHOR: Rick Fricchione CREATED: 10-Feb-1985
%SBTTL 'Revision History'
! HISTORY:
!
! 254 Remove extra trace messages that I'm tired of seeing.
! Gregory A. Scott 2-Jul-86
!
! 252 Remove library of CONDIT.
! Sandy Clemens 1-Jul-86
!
! 233 DEF$BUFFER wasn't making the filespecs ASCIZ properly (shows up on
! embedded access control in particular). It also never used its third
! argument (request block); it only has two arguments now.
! Gregory A. Scott 16-Jun-86
!
! 216 Clean up DEF$TAGS a little bit, size the filespec buffers by using the
! difference between p_src and p_dst pointers and the start of the
! buffers.
! Gregory A. Scott 4-Jun-86
!
! 172 Remove LIBRARY of TOPS20.
! Gregory A. Scott 20-May-86
!
! 165 DIU$ABORT was external routine but was never referenced.
! Gregory A. Scott 16-May-86
!
! 150 /DESCR defaults on output if there isn't an output /DESCR and there is
! an input /DESCR in DEF$REQUEST.
! Gregory A. Scott 9-May-86
!
! 147 Don't output an extra CRLF in DEF$PROMPT after the % Access information
! for node "X" message.
! Gregory A. Scott 8-May-86
!
! 143 Rewrite DEF$REQUEST to handle all request defaulting into reqblk,
! including calling DEF$BUFFER and new routine DEF$RSWITCH. Add some
! comments here and there.
! Gregory A. Scott 6-May-86
!
! 142 DEF$BUFFER now returns the length to the caller properly. DEF$REQUEST
! defaulted the LOG file to a bad place, causing things to get trashed.
! Gregory A. Scott 5-May-86
!
! 140 Save connected directory string (without the device) so that log files
! can be properly defaulted in DIUC20's /LOG switch. Routine DEF$ACCESS
! needed major work.
! Gregory A. Scott 4-May-86
!
! 137 Remove references to DEF$G_MAXTIME, DEF$G_STATUS_DELTA,
! DEF$G_REQUEUE_INTERVAL, DIU$H_TRIES which aren't implemented. Have
! DEF$INIT get the initial LOG filespec placed in the root default.
! DEF$CREATE should be maintaining the linked list, rather than having
! each caller do it, and it should default the log file from the
! def_root entry.
! Gregory A. Scott 2-May-86
!
! 131 Remove extern of diudbg which wasn't referenced and is no longer used.
! Gregory A. Scott 28-Mar-86
!
! 121 Bug in DEF$ACCESS caused nulls to be included at the end of each
! filespec. This screwed up the counts which later screwed up the log
! files since they were outputting based on ASCIZ strings. PS: Those who
! put comments after the code are not appreciated by those who put
! comments before the code.
! Gregory A. Scott 19-Apr-86
!
! 52 Make sure that the access string has a leading double-quote even
! if the USERNAME is not specified in routine DEF$ACCESS.
! Sandy Clemens 12-Nov-85
!
! 46 Clean up SET DEFAULTS code.
! Sandy Clemens 4-Nov-85
!
! 40 Put the REQUIRE/LIBRARY of 'TOPS20' into a TOPS-20 only
! conditional.
! Sandy Clemens 7-Oct-85
!
! 024 Put in OPTION=TRUNCATE to prevent XPORT errors
!
! 012 Remove STR_STRING macro call, someone removed it from DIU.R36
!
! 001 Andy Nourse
! Fix defaulting
!
! V01-000 RDF0001 Rick Fricchione 10-Feb-1985
! Original version. Change defautls structure to look like
! VAX DIU, write DEF$ routines and entry points.
!--
%SBTTL 'Forward Routine'
FORWARD ROUTINE
DEF$INIT : NOVALUE, ! Init defaults init
DEF$REQUEST : NOVALUE, ! Fill in defaults for a request
DEF$RSWITCH : NOVALUE, ! Fill in request switches
DEF$ACCESS : NOVALUE, ! Fill in access control defaults
DEF$BUFFER, ! Default entire filespec buffer
DEF$FIND, ! Find default block for node
DEF$PROMPT : NOVALUE, ! Prompt for access
DEF$CREATE, ! Create new defaults node
DEF$TAGS : NOVALUE; ! Process access tags
%SBTTL 'Libraries'
LIBRARY 'BLI:XPORT'; ! What else is there?
LIBRARY 'DIU'; ! DIU data structures
LIBRARY 'FAO'; ! FAO formatting
LIBRARY 'RMSINT'; ! RMS V3 macros
LIBRARY 'DIUCOMMAND'; ! DIUC20 literals
%SBTTL 'Externals'
EXTERNAL ROUTINE
S$USERNAME, ! Return username/directory name
S$CDIR, ! Return connected directory number
MOVEAZ, ! Move ASCIZ strings
ASKD; ! Ask for default user/pass/acct
EXTERNAL
sflags : BITVECTOR[36], ! What parts of source have we seen?
dflags : BITVECTOR[36], ! What parts of dest have we seen?
rflags : BITVECTOR[36], ! What once_per_request switches seen?
src_node, ! Last source node in ASCIZ
dst_node, ! Destination node in ASCIZ
p_src, ! Pointer to end of source filespec blk
p_dst, ! Pointer to end of dest filespec block
tty : $XPO_IOB(), ! Terminal i/o block
reqblk : $DIU_BLOCK; ! The main request block
%SBTTL 'Storage'
GLOBAL
def_dir : VECTOR[CH$ALLOCATION(80)], ! Each char can be ^Ved
def_root : $DEF_DECL, ! Head of defaults chain
defaults : REF $DEF_DECL INITIAL (def_root); ! Pointer to def chain
OWN
acc_tags_seen: BITVECTOR[3];
LITERAL
acc_user_seen=0,
acc_pass_seen=1,
acc_acct_seen=2;
OWN
buf_user : VECTOR[CH$ALLOCATION(40)],
buf_pass : VECTOR[CH$ALLOCATION(40)],
buf_acct : VECTOR[CH$ALLOCATION(40)],
acc_user : $STR_DESCRIPTOR(CLASS=BOUNDED,
STRING=(40,CH$PTR(buf_user))),
acc_pass : $STR_DESCRIPTOR(CLASS=BOUNDED,
STRING=(40,CH$PTR(buf_pass))),
acc_acct : $STR_DESCRIPTOR(CLASS=BOUNDED,
STRING=(40,CH$PTR(buf_acct)));
%SBTTL 'Routine DEF$INIT'
GLOBAL ROUTINE DEF$INIT : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! One time init call used to set up defaults list. All other creation
! of default blocks is done via DEF$CREATE.
!--
%IF %SWITCHES(TOPS20)
%THEN
LOCAL connected_dir : $STR_DESCRIPTOR(),
cd_start,
cd_end,
cd_len;
%FI
!$TRACE('DEF$INIT');
! Get the default log file inserted into the default root
%IF %SWITCHES(TOPS20)
%THEN ! TOPS-20
! Get the connected directory string.
$STR_DESC_INIT(DESC=connected_dir, CLASS=DYNAMIC);
S$USERNAME(S$CDIR(),connected_dir);
! Extract the directory for later defaulting in DIUC20.
cd_start = CH$FIND_CH(.connected_dir[STR$H_LENGTH], ! Find the start
.connected_dir[STR$A_POINTER],
%C'<');
IF NOT CH$FAIL(.cd_start) ! Just in case
THEN BEGIN cd_end = CH$FIND_CH(.connected_dir[STR$H_LENGTH], ! Find end
.connected_dir[STR$A_POINTER],
%C'>');
IF NOT CH$FAIL(.cd_end) ! Defensive programming
THEN BEGIN
cd_start = CH$PLUS(.cd_start,1); ! Look past the open bracket
CH$MOVE(CH$DIFF(.cd_end,.cd_start), ! Move what was inbetween
.cd_start,
CH$PTR(def_dir));
END;
END;
! Construct a string of my favorite log file and put that into the default area
! for the log file in def_root.
$STR_DESC_INIT(DESC=def_root[DEF$D_LOG], CLASS=DYNAMIC,
STRING=$STR_CONCAT(connected_dir,'DIU.LOG.0'));
$XPO_FREE_MEM(STRING=connected_dir);
%ELSE ! TOPS-10
! Code here should default the log file better, like include STR:[P,P]
$STR_DESC_INIT(DESC=def_root[DEF$D_LOG],
CLASS=DYNAMIC,
STRING='DIU.LOG');
%FI ! End of TOPS-20/TOPS-10 conditional
! Initialize the default defaults.
$STR_DESC_INIT(DESC=def_root[DEF$D_NODE], STRING='*'); ! Node *
$STR_DESC_INIT(DESC=def_root[DEF$D_USER], CLASS=DYNAMIC); ! No user
$STR_DESC_INIT(DESC=def_root[DEF$D_PASSWORD],CLASS=DYNAMIC); ! No pass
$STR_DESC_INIT(DESC=def_root[DEF$D_ACCOUNT], CLASS=DYNAMIC); ! No acct
def_root[DEF$B_DEFER] = DIU$K_QUEUE; ! /QUEUE:YES
def_root[DEF$B_NOTIFY] = NOTIFY_TERMINAL; ! /NOTIFY:TERMINAL
def_root[DEF$A_NXT] = 0; ! No more here yet..
END; ! DEF$INIT
%SBTTL 'Routine DEF$REQUEST'
GLOBAL ROUTINE DEF$REQUEST : NOVALUE =
BEGIN
!
! FUNCTIONAL DESCRIPTION:
!
! This routine fills in the request block based on what was missing from
! the request. It calls a routine to reformat the filespec buffers and
! set their length. It defaults the log file and notification switches.
! It defaults the output description file if there was an input
! description file and there is no output description file.
!
! IMPLICIT INPUTS:
!
! reqblk: the request block we are working on
! sflags, dflags, rflags: flags for switches typed to command parser
!
! IMPLICIT OUTPUTS:
!
! reqblk: filled in
!--
LOCAL n_ptr, ! Pointer to node spec to use
n_desc : $STR_DESCRIPTOR(); ! Descr of node spec string
!$TRACE('DEF$REQUEST');
! Extract access control information for source files.
reqblk[DIU$H_SOURCE_FILESPEC] = ! Default source access control info
DEF$BUFFER(CH$DIFF(.p_src, CH$PTR(reqblk[DIU$T_SOURCE_FILESPEC])),
CH$PTR(reqblk[DIU$T_SOURCE_FILESPEC]));
! Extract access control information for destination files.
reqblk[DIU$H_DESTINATION_FILESPEC] = ! Default dest access control info
DEF$BUFFER(CH$DIFF(.p_dst, CH$PTR(reqblk[DIU$T_DESTINATION_FILESPEC])),
CH$PTR(reqblk[DIU$T_DESTINATION_FILESPEC]));
! Next we want to find a default block to default the request switches from.
! If the destination is remote, use that node's entry for the defaults. If the
! destination is local, use the last source file's defaults.
n_ptr = 0; ! Zero this local variable
IF .dflags[F_NODE] ! If the dest was remote,
THEN BEGIN ! then use that default entry
$STR_DESC_INIT(DESC=n_desc, CLASS=FIXED,
STRING=(ASCIZ_LEN(CH$PTR(dst_node)),
CH$PTR(dst_node)));
n_ptr = DEF$FIND(n_desc);
END;
IF .n_ptr EQL 0 AND .sflags[F_NODE] ! If no dest default and source remote,
THEN BEGIN ! then use last src node default entry
$STR_DESC_INIT(DESC=n_desc, CLASS=FIXED,
STRING=(ASCIZ_LEN(CH$PTR(src_node)),
CH$PTR(src_node)));
n_ptr = DEF$FIND(n_desc);
END;
IF .n_ptr EQL 0 ! If local to local request,
THEN n_ptr = def_root; ! then use def_root defaults
! n_ptr points to the default block to use. Default the request info.
DEF$RSWITCH(.n_ptr);
! Default the destination /DESCRIPTION switch here
IF .reqblk[DIU$H_SOURCE_DESCRIPTION] NEQ 0
AND .reqblk[DIU$H_DESTINATION_DESCRIPTION] EQL 0
THEN BEGIN
reqblk[DIU$H_DESTINATION_DESCRIPTION] = .reqblk[DIU$H_SOURCE_DESCRIPTION];
MOVEAZ(%REF(CH$PTR(reqblk[DIU$T_SOURCE_DESCRIPTION])),
%REF(CH$PTR(reqblk[DIU$T_DESTINATION_DESCRIPTION])));
END;
END; ! DEF$REQUEST
%SBTTL 'Routine DEF$RSWITCH'
ROUTINE DEF$RSWITCH (def : REF $DEF_DECL) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION
!
! This routine fills in the request switches for reqblk based on the
! passed address of a default block
!
! FORMAL PARAMETERS:
!
! def_block: passed address of a def block to apply defaults from
!
! IMPLICIT INPUTS:
!
! rflags: request flags
! reqblk: request block
!
! IMPLICIT OUTPUTS:
!
! reqblk: filled in as appropriate
!--
LOCAL l_desc: $STR_DESCRIPTOR(CLASS=BOUNDED,
STRING=(DIU$K_NORMAL_FILE_SIZE,
CH$PTR(reqblk[DIU$T_LOG_FILESPEC])));
!$TRACE_FAO('DEF$RSWITCH called with node !AS',def[DEF$D_NODE]);
! NOTIFY switch defaulting
IF NOT .rflags[R_NOTIFY] ! Was there a /NOTIFY typed?
THEN reqblk[DIU$Z_NOTIFY] = .def[DEF$B_NOTIFY]; ! No, default it
! LOG FILE defaulting happens here.
IF NOT .rflags[R_LOG_FILE] ! Was there a /LOG_FILE typed?
THEN BEGIN ! No, default it
$STR_COPY(STRING=def[DEF$D_LOG], TARGET=l_desc); ! Copy log string
reqblk[DIU$H_LOG_FILESPEC] = .l_desc[STR$H_LENGTH]; ! Set its length
END;
END; ! DEF$RSWITCH
%SBTTL 'Routine DEF$BUFFER'
ROUTINE DEF$BUFFER (p_buf_len, p_buffer) : =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Take a filespec buffer, scan it, and process the defaults which
! should be applied based upon the nodes found in the buffer.
!
! FORMAL PARAMETERS:
!
! p_buf_len: Length of the buffer to process.
! p_buffer: Byte pointer to the buffer.
!--
BIND buf_len = .p_buf_len,
buffer = .p_buffer;
LOCAL nodebuffer: VECTOR[CH$ALLOCATION(Diu$k_Nodesize)],
node : $STR_DESCRIPTOR(CLASS=BOUNDED,
STRING=(DIU$K_NODESIZE,CH$PTR(nodebuffer))),
bufferdesc : $STR_DESCRIPTOR(CLASS=BOUNDED, STRING=(buf_len,buffer)),
new : $STR_DESCRIPTOR(CLASS=DYNAMIC_BOUNDED, STRING=(0,0));
!$TRACE('DEF$BUFFER');
acc_tags_seen = 0; ! No access tags seen yet
$XPO_GET_MEM(DESC=new, CHARACTERS=NAM$K_MAXRSS);
IF buf_len EQL 0 ! Are there any filespecs?
THEN RETURN(0); ! No, return length zero
DEF$TAGS(bufferdesc, new); ! Process global tags for u/p/a
! Process each filespec in the list, defaulting the access information
DO BEGIN
! Get the length of the filespec, and point at it.
STR_EXCLUDE(bufferdesc, .bufferdesc[STR$H_LENGTH]);
bufferdesc[STR$H_LENGTH] = CH$RCHAR_A(bufferdesc[STR$A_POINTER]);
IF .bufferdesc[STR$H_LENGTH] EQL 0 ! If the filespec length is zero
THEN EXITLOOP; ! Then this is the end of the buffer
BEGIN
! Make descr to filespec, and a dynamic one for updated filespec
LOCAL indesc : $STR_DESCRIPTOR(STRING=(.bufferdesc[STR$H_LENGTH],
.bufferdesc[STR$A_POINTER])),
outdesc : $STR_DESCRIPTOR(CLASS= DYNAMIC, STRING = (0,0)),
tagdesc : $STR_DESCRIPTOR(CLASS= DYNAMIC, STRING = (0,0));
! Skip over the filespec and parse local tags
STR_EXCLUDE(bufferdesc, .bufferdesc[STR$H_LENGTH]);
DEF$TAGS(bufferdesc, tagdesc);
DEF$ACCESS(indesc, outdesc, node);
! Put in new length of filespec
CH$WCHAR(.outdesc[STR$H_LENGTH],
CH$PLUS(.new[STR$A_POINTER], .new[STR$H_LENGTH]));
new[STR$H_LENGTH]=.new[STR$H_LENGTH] + 1;
! The filespec and tags are now appended to new_buffer
$STR_APPEND(STRING = outdesc, TARGET = new); ! Append filespec
$STR_APPEND(STRING = tagdesc, TARGET = new); ! Append tags
$XPO_FREE_MEM(STRING = outdesc); ! Free the memory
$XPO_FREE_MEM(STRING = tagdesc); ! used in those strings
END; ! End of non-zero length buffer
END WHILE 1; ! End of DO BEGIN
! Back to the start of the buffer to copy everything back
CH$FILL(0,DIU$K_FILESPEC_MAXIMUM_LENGTH, ! Zero passed buffer
CH$PTR(buffer));
$STR_DESC_INIT(DESC = bufferdesc, ! String descr to it
CLASS = BOUNDED,
STRING = (DIU$K_FILESPEC_MAXIMUM_LENGTH,buffer));
$STR_COPY(STRING = Str_String_Plus_Prefix(new), ! Copy new buffer back there
TARGET = bufferdesc);
! Free the memory we acquired and return
$XPO_FREE_MEM(STRING = new); ! Return bounded descr storage
RETURN(.bufferdesc[STR$H_LENGTH]) ! Return the new length
END; ! DEF$BUFFER
%SBTTL 'Routine DEF$ACCESS'
ROUTINE DEF$ACCESS (p_file_desc : REF $STR_DESCRIPTOR(),
p_out_desc : REF $STR_DESCRIPTOR(),
p_ret_node : REF $STR_DESCRIPTOR() ) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Put default access in a filespec, returns the filespec with embedded
! access info and remote node (if any) associated with the filespec.
!
! FORMAL PARAMETERS:
!
! p_file_desc : Addr of descriptor for filespec
! p_out_desc : Addr of descriptor to put filespec with access info
! p_ret_node : Addr of descriptor to put node name
!
! IMPLICIT INPUTS AND OUTPUTS:
!
! acc_user\
! acc_pass > Userid, Password & Account, use if specified,
! acc_acct/ fill in from defaults if not
!
! SIDE EFFECTS:
!
! a default block may be created for the node in question.
!--
BIND
file_desc = .p_file_desc: $STR_DESCRIPTOR(),
out_desc = .p_out_desc: $STR_DESCRIPTOR(),
ret_node = .p_ret_node: $STR_DESCRIPTOR();
LOCAL
def : REF $DEF_DECL,
restd : VECTOR[CH$ALLOCATION(NAM$K_MAXRSS)],
rest : $STR_DESCRIPTOR(CLASS=BOUNDED,
STRING=(NAM$K_MAXRSS,CH$PTR(restd))),
noded : VECTOR[CH$ALLOCATION(6)],
node : $STR_DESCRIPTOR(CLASS=BOUNDED, STRING=(6,CH$PTR(noded)));
!$TRACE('DEF$ACCESS');
! Find the node name (if any) and put it into the ret_node descriptor
IF NOT($STR_SCAN(STRING=file_desc, FIND='::'))
THEN BEGIN ! File is Local
$STR_DESC_INIT(DESC=ret_node, STRING=(0,0)); ! Return null node name
$STR_COPY(STRING=file_desc, ! Copy all to output
TARGET=out_desc, OPTION=TRUNCATE); ! Truncate if too long
RETURN;
END;
! Filespec is remote, see if it has an access string, and if so just return it
! as is.
IF $STR_SCAN(STRING=file_desc, FIND='"::')
THEN BEGIN ! Filespec has access in it now
$STR_SCAN(STRING=file_desc, ! Find the node name
TARGET=node, STOP='"');
$STR_COPY(STRING=node, ! Return node name
TARGET=ret_node, OPTION=TRUNCATE);
$STR_COPY(STRING=file_desc, ! Return the source string as is
TARGET=out_desc, OPTION=TRUNCATE);
RETURN;
END;
! Filespec is remote without embedded access information. Get the node name
! extracted and pass it back to the caller. Get the rest of filespec set up.
$STR_SCAN(STRING=file_desc, ! Get the node name copied locally
TARGET=node, STOP=':');
$STR_COPY(STRING=node, ! Return node name to caller
TARGET=ret_node, OPTION=TRUNCATE);
$STR_COPY(TARGET = rest, ! get the dev:[dir]file.typ.gen part
STRING = ((.file_desc[STR$H_LENGTH]-(2+.node[STR$H_LENGTH])),
(CH$PLUS(.file_desc[STR$A_POINTER],
(2+.node[STR$H_LENGTH])))));
! See if there is a default for this node. If not, create one and copy the
! root defaults there.
IF (def = DEF$FIND(node)) EQL 0 ! Is there a node like this around?
THEN BEGIN ! Nope, create a node entry for him
def = DEF$CREATE(node);
END;
! Copy defaults into default storage places
IF .acc_tags_seen[acc_user_seen]
THEN $STR_COPY(STRING=acc_user, TARGET=def[DEF$D_USER]);
IF .acc_tags_seen[acc_pass_seen]
THEN $STR_COPY(STRING=acc_pass, TARGET=def[DEF$D_PASSWORD]);
IF .acc_tags_seen[acc_acct_seen]
THEN $STR_COPY(STRING=acc_acct, TARGET=def[DEF$D_ACCOUNT]);
! Prompt for the strings we need to fill in.
DEF$PROMPT(node,.def);
! Now that we have the user/password/account stuff set up in a default block,
! and everything is all filled in so very nice, we want to append the access
! information on to the nodename.
$STR_COPY(TARGET=out_desc, OPTION=TRUNCATE,
STRING=$STR_CONCAT(node,
'"',
def[DEF$D_USER],
' ',
def[DEF$D_PASSWORD],
' ',
def[DEF$D_ACCOUNT],
'"::',
rest));
END; ! DEF$ACCESS
%SBTTL 'Routine DEF$FIND'
GLOBAL ROUTINE DEF$FIND (nodedesc : REF $STR_DESCRIPTOR() )=
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Find default block for node
!
! FORMAL PARAMETERS:
!
! Address of descriptor for node
!
! IMPLICIT INPUTS:
!
! DEFAULTS : default block chain
!
! ROUTINE VALUE:
!
! Address of desired default block, or 0
!
!--
LOCAL
def : REF $DEF_DECL;
!$TRACE('DEF$FIND');
def = .defaults; ! Point at the root.
! Look at all the current nodes, and try and find the one that
! matches.
WHILE .def NEQ 0 ! Until we hit the end of the line
DO IF $STR_EQL(STRING1=$STR_FORMAT(.nodedesc,UP_CASE), ! Does it match?
STRING2=def[DEF$D_NODE])
THEN RETURN .def ! Found it, return the address
ELSE def = .def[DEF$A_NXT]; ! Point to next one, exit if done
RETURN FALSE; ! Failure if we get here
END; ! DEF$FIND
%SBTTL 'Routine DEF$PROMPT'
ROUTINE DEF$PROMPT (node : REF $STR_DESCRIPTOR(),
def : REF $DEF_DECL) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Prompt for access information as needed
!
! FORMAL PARAMETERS:
!
! node : Addr of descriptor for nodeid
! def : Address of default block
!--
LITERAL sup_echo = 1;
LOCAL do_user : INITIAL(0),
do_pass : INITIAL(0),
do_acct : INITIAL(0);
!$TRACE('DEF$PROMPT');
! See if we need to prompt for anything. This is so if the string passed is
! a single "*".
do_user = $STR_EQL(STRING1=def[DEF$D_USER], STRING2=PROMPT_STRING);
do_pass = $STR_EQL(STRING1=def[DEF$D_PASSWORD], STRING2=PROMPT_STRING);
do_acct = $STR_EQL(STRING1=def[DEF$D_ACCOUNT], STRING2=PROMPT_STRING);
! If anything requires prompting, then tell them we want something
IF (.do_user OR .do_pass OR .do_acct)
THEN $XPO_PUT_MSG(STRING=$STR_CONCAT('Access information for node "',
.node,
%CHAR(%C'"')),
SEVERITY=SUCCESS);
IF .do_user ! Get a username?
THEN BEGIN ! Yes
ASKD(PP('User: '), acc_user, 0);
$STR_COPY(STRING = acc_user, TARGET = def[DEF$D_USER]);
END;
IF .do_acct ! Need to get a account?
THEN BEGIN ! Yes
ASKD(PP('Account: '), acc_acct, 0);
$STR_COPY(STRING = acc_acct, TARGET = def[DEF$D_ACCOUNT]);
END;
IF .do_pass ! Need to get a password?
THEN BEGIN ! Yes
ASKD(PP('Password: '), acc_pass, SUP_ECHO);
$STR_COPY(STRING = acc_pass, TARGET = def[DEF$D_PASSWORD]);
END;
END; ! DEF$PROMPT
%SBTTL 'Routine DEF$CREATE'
GLOBAL ROUTINE DEF$CREATE (node : REF $STR_DESCRIPTOR() ) : =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Create a node default block, link it into the list of them.
!
! FORMAL PARAMETERS:
!
! node : Addr of descriptor for nodeid
!
! ROUTINE VALUE:
!
! Address of default block
!--
LOCAL def : REF $DEF_DECL;
!$TRACE('DEF$CREATE');
! Get memory, link the def block into the list.
$XPO_GET_MEM(UNITS=DEF$K_BLN, RESULT=def, FILL=0);
def[DEF$A_NXT] = .defaults; ! Point next as old head
defaults = .def; ! Point head at us
! Initialize the node name
$STR_DESC_INIT(DESC=def[DEF$D_NODE], ! Insert node name
CLASS=DYNAMIC,
STRING=$STR_FORMAT(.node,UP_CASE));
! Following call requires the STR_FORMAT to avoid trashing the string later...
! Apparently this forces it to make a new copy of the string or something.
$STR_DESC_INIT(DESC=def[DEF$D_LOG], ! Insert def log file
CLASS=DYNAMIC,
STRING=$STR_FORMAT(def_root[DEF$D_LOG],UP_CASE));
! Default the username, password, and account from def_root
$STR_DESC_INIT(DESC = def[DEF$D_USER], ! Copy the username
CLASS = DYNAMIC,
STRING = $STR_FORMAT(def_root[DEF$D_USER], UP_CASE));
$STR_DESC_INIT(DESC = def[DEF$D_PASSWORD], ! Copy the password
CLASS = DYNAMIC,
STRING = $STR_FORMAT(def_root[DEF$D_PASSWORD], UP_CASE));
$STR_DESC_INIT(DESC = def[DEF$D_ACCOUNT], ! Copy the account
CLASS = DYNAMIC,
STRING = $STR_FORMAT(def_root[DEF$D_ACCOUNT], UP_CASE));
! Default the switches
def[DEF$B_NOTIFY] = .def_root[DEF$B_NOTIFY]; ! default the notify switch
def[DEF$B_DEFER] = .def_root[DEF$B_DEFER]; ! default the queue switch
! Send address back to caller
RETURN .def;
END; ! DEF$CREATE
%SBTTL 'Routine DEF$TAGS'
ROUTINE DEF$TAGS (p_oldbuff : REF $STR_DESCRIPTOR(CLASS=BOUNDED),
p_newbuff : REF $STR_DESCRIPTOR(CLASS=BOUNDED)) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine grubs through a filespec string (with DIU tag information
! including tags for userid, password, and account) and returns a
! filespec string without these tags. The access information is put into
! acc_user, acc_pass, and acc_acct for later perusal.
!
! FORMAL PARAMETERS:
!
! p_oldbuff : virgin buffer from DIUC20
! p_newbuff : buffer with access tags combed out
!
! IMPLICIT OUTPUTS:
!
! acc_user: set up with the user (if any)
! acc_pass: set up with the password (if any)
! acc_acct: set up with the account (if any)
! acc_tags_seen: bits lit if user/pass/acct tags seen.
!--
BIND oldbuff = .p_oldbuff : $STR_DESCRIPTOR(CLASS=BOUNDED),
newbuff = .p_newbuff : $STR_DESCRIPTOR(CLASS=BOUNDED);
LOCAL tag_ptr, ! Pointer to tag
tag_len, ! Length of current tag
tag; ! Value of current tag
DO BEGIN
tag_ptr = .oldbuff[STR$A_POINTER]; ! Point to the start of the tags
tag = CH$RCHAR_A(tag_ptr); ! Get the tag id
!$TRACE_FAO('DEF$TAGS found tag !3OL',.tag);
SELECT .tag OF
SET
[$ETG]:
BEGIN
oldbuff[STR$H_LENGTH] = 1; ! Just the ETG please
$STR_APPEND(STRING=oldbuff, TARGET=newbuff);
END;
[DIU$K_DIU_USER]:
BEGIN
STR_EXCLUDE(oldbuff, 2); ! Skip tag type & count
tag_len = CH$RCHAR_A(tag_ptr);
IF .tag_len NEQ 0
THEN BEGIN
oldbuff[STR$H_LENGTH] = .tag_len;
$STR_COPY(STRING=oldbuff, TARGET=acc_user);
END;
acc_tags_seen[acc_user_seen] = 1;
END;
[DIU$K_DIU_PASSWORD]:
BEGIN
STR_EXCLUDE(oldbuff, 2); ! Skip tag type & count
tag_len = CH$RCHAR_A(tag_ptr);
IF .tag_len NEQ 0
THEN BEGIN
oldbuff[STR$H_LENGTH] = .tag_len;
$STR_COPY(STRING=oldbuff, TARGET=acc_pass);
END;
acc_tags_seen[acc_pass_seen] = 1;
END;
[DIU$K_DIU_ACCOUNT]:
BEGIN
STR_EXCLUDE(oldbuff, 2); ! Skip tag type & count
tag_len = CH$RCHAR_A(tag_ptr);
IF .tag_len NEQ 0
THEN BEGIN
oldbuff[STR$H_LENGTH] = .tag_len;
$STR_COPY(STRING=oldbuff, TARGET=acc_acct);
END;
acc_tags_seen[acc_acct_seen] = 1;
END;
[OTHERWISE]:
BEGIN ! Not user/pass/acct: just copy it
oldbuff[STR$H_LENGTH] = CH$RCHAR_A(tag_ptr)+ 2 ; !Include Tag & count
$STR_APPEND(STRING=oldbuff, TARGET=newbuff);
END;
TES; ! End of tag application code
STR_EXCLUDE(oldbuff, .oldbuff[STR$H_LENGTH]); ! Pass over what we processed
END UNTIL (.tag EQL $ETG) ! Until no more tags for this file
END; ! DEF$TAGS
END
ELUDOM ! End of Module DIUDEF