Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/t20src/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