{$DOUBLE}
Program GetLnk;
 {$nomain}

{ 
  Description: Locate active link to given node, or create one.  
         File: [AMIRTR]GETLNK.PAS
       Author: Jim Bostwick 
    Last Edit: 9-APR-1990 23:51:20 
      History:
         13-OCT-1989 -JMB - Pass whole message as param
         3-AUG-1989 - JMB - Add $DOUBLE compiler switch

BUGS: The logical name translation is somewhat brain-damaged. As it is now,
	either use no logical names for remote nodes, or always use them. 
	If a link is first opened using a logical (e.g., RTR$foo), subsequent
	attempts to open a link to the real node will fail. If, however, you 
	use node 'foo' (or it's equivalent real node name) consistently, you
	will have no trouble. 

 	If translation of node name on each message (ugh!) is to be avoided,
	a list of equivalents really needs to be kept here. The right thing
	is to have a linked list of node-name/link number pairs, which is 
	searched rather than the link table. That way, any number of logical
	names can point to one real-node/router-task pair. 

}
 {$Nolist}
 {[a+,b+,l-,k+,r+] Pasmat }
 %INCLUDE 'AMIRTR.PKG';
 %INCLUDE 'pas$ext:rlon.ext';
 %INCLUDE 'pas$ext:catr56.ext';
 %INCLUDE 'signal.ext';
 %INCLUDE 'debug.ext';
 %INCLUDE 'dbghdr.ext';

 {$List }
 {*CALL*}


  PROCEDURE GetLnk(VAR Out_Msg: Message_rec;
                   VAR L: Integer);
    EXTERNAL;

{*USER*

 Procedure searches the link table for an entry matching the given node
name. If not found, search for an unused table entry, and attempt to open
a link using that entry. 
 Return table index in L, or 0 if both table full and no match found. 

 NOTE: In a later version, throw out least recently used link to make room
        if necessary. This version just returns 0. 

 When opening a link, attempt translation of logical "RTR$node". If it
    does NOT translate, use destination task of "AMIRTR". If it DOES 
    translate, parse return string of form node::task for real node name
    and task. Open link to these, but place original node name in the
    link record. This 'indirection' is useful for debug on a single node, 
    and may have other uses as well. [ aside from the obvious use of 
    confusing the hell out of appication programmers :^) ]

In sum, the two logicals for message redirection are:
        MSG$node (used by MSINIT in user task) 
                = <to_node>::<via_router>
                to_node is destination node - will be placed in msg header
                via_router is router task on LOCAL node to handle traffic
       RTR$node  (used here in the router task)
                = <real_node>::<remote_router>
                real_node is node name handling traffic for <node> - may be
                        same.
                remote_router is router task at REMOTE node to handle traffic
Together, these allow various combinations of special routers and re-directed
    traffic. In particular, the following:

    *  LOCAL is local node, ROUTER is normal router task REMOTE is remote node.
    1. To use an alternate router on local node:
                MSG$node = node::ALTRTR 
        (traffic for 'node' is handled by local router 'ALTRTR')
    2. To use an alternate remote router:
                RTR$node = node:ALTRTR
        ( traffic for 'node' is handled by router 'ALTRTR' on 'node')
    3. To re-direct traffic destined for node 'FUBAR' to node 'BLECH'
                MSG$FUBAR = BLECH::ROUTER  (task level)
                        - or - 
                RTR$FUBAR = BLECH::ROUTER  (router level)
       Note: if a remote node is redirected to the local node, task level
                redirection will send message to router, who will use 
                VSDA (NOT DECNET) to forward it to the destination. 
                However, if router-level redirection is used, the router
                WILL attempt a DECNET link back to the local node. 
                A Router task can NOT talk to itself! Therefore, alternate
                router task MUST be installed on local node, and used in 
                the router level redirection. 
 }

{*WIZARD*

 }



  PROCEDURE GetLnk;

    VAR
      I: Integer;
      logical, equivalent: str20;
      debug_str: str80;
      dsw: Integer;
      pos, siz: Integer;
      nodenam: ch6;
      rtrnam, rtrnod: ch6;


    BEGIN
      I := 1; { I is loop counter }
      L := 0; { L is the link we're looking for }
      Spad(nodenam, chr(0), ' ');
      Sassign(nodenam, Out_Msg.Dest_node);
      IF Debugging AND ((Debug_level > 1) OR (ps_open IN Debug_flags)) THEN
        BEGIN
        Sassign(debug_str, 'GETLNK - looking for <');
        Sconcat(debug_str, nodenam);
        Sconcat(debug_str, '>.');
        Debug(debug_str);
        dbghdr(Out_Msg)
        END;
      WHILE (I <= Max_Links) AND (L = 0) DO
        BEGIN
        IF Link[I].Active 
	    THEN IF Sequal(nodenam, Link[I].Node) 
		THEN L := I;
        I := I + 1
        END; { While }

      IF (L = 0) THEN	{ No active link, try for new one }
        BEGIN { Search for empty table entry }
        I := 1;
        WHILE ((I <= Max_Links) AND (Link[I].Active)) DO I := I + 1;
        IF (I <= Max_Links) THEN L := I;
        IF (L <> 0) THEN { attempt to create link in entry L }
          BEGIN
          Sassign(logical, 'RTR$'); { check for logical node }
          Sconcat(logical, nodenam);
          STrunc(logical);
          SClear(equivalent);
          RLON(logical, equivalent, siz);
          dsw := $dsw;
          IF dsw = 1 THEN
            BEGIN { translation succeeded }
            pos := Ssearch(equivalent, '::', 1);
	    sassign(debug_str,'Translation of ');
	    sconcat(debug_str,logical);
	    sconcat(debug_str,' is ');
	    sconcat(debug_str,equivalent);
	    debug(debug_str);
            IF pos <> 0 THEN
              BEGIN
              SSubstr(Out_Msg.Dest_node, equivalent, 1, pos - 1);
              IF pos < 7 THEN
                FOR I := pos TO 6 DO Out_Msg.Dest_node[I] := ' ';
              SSubstr(rtrnam, equivalent, pos + 2,
                      slen(equivalent) - (pos + 1))
              END;
	    sassign(debug_str,'OUt_msg.dest_node = ');
	    sconcat(debug_str,out_msg.dest_node);
	    sconcat(debug_str,' and rtrnam = ');
	    sconcat(debug_str, rtrnam);
	    debug(debug_str)
            END;
          IF (dsw <> 1) OR (pos = 0) THEN
            BEGIN { translation failed - use defaults }
            Sassign(Out_Msg.Dest_node, nodenam);
            rtrnam := 'AMIRTR'
            END;
          CATR56(rtrnam, Out_Msg.router);
          NTCONB(Out_Msg.Dest_node, chr(0), rtrnam, reqb, I); { build connect
            block }
          IF (I <> 1) THEN
            BEGIN
            Signal(Sig_NTCONB, I, Null_IOSB, 'GETLNK (stat)');
            L := 0
            END
          ELSE
            BEGIN
            WITH Link[L] DO
              BEGIN
              SClear(read_dat);
              NTCON(Lun, Aux_EFN, 'Connect         ', reqb, read_dat, IOSB);
              IF (($dsw <> 1) OR (IOSB.int[1] <> 1)) THEN
                BEGIN
                Signal(Sig_NTCON, Lun, IOSB, 'GETLNK (lun)');
                L := 0
                END
              ELSE
                BEGIN { post initial read on new link }
                NTREC(Lun, Net_EFN, loophole(address, ref(Msg)),
                      Size(Message_rec), Read_IOSB);
                IF (($dsw <> 1) OR (IOSB.int[1] <> 1)) THEN
                  BEGIN
                  Signal(Sig_NTRECF, L, Read_IOSB, 'GETLNK (link)');
                  L := 0
                  END
                ELSE
                  BEGIN { finish link initialization, signal success }
                  Active := TRUE;
                  Node := nodenam; { the one he originally asked for }
                  Link_Flags := [link_active];
                  WITH Stats DO
                    BEGIN
                    Last_activity := 0;
                    Connects := Connects + 1

{--* Here beginneth the PTH memorial procedure ending... *--}

                    END { with stats }
                  END { else finish init }
                END { post initial read }
              END { with link[l] }
            END { else }
          END { L <> 0 }
        END { If L = 0 }
    END; { GetLnk }
