-- File: AddressTranslationImpl.mesa - last edit:
-- AOF                 26-Apr-85 13:30:18
-- BGY                 29-Jul-85 14:03:58
-- BJD                  9-Oct-84 17:28:00
-- HGM                  7-Sep-85 14:26:12
-- Copyright (C) 1984, 1985 by Xerox Corporation. All rights reserved. 

DIRECTORY
  AddressCache USING [AddNSName, GetSize, LookupNSName],
  AddressTranslation USING [ErrorRecord, Reason],
  Auth USING [CallProblem, IdentityHandle],
  AuthSpecial USING [MakeNullCHConversation],
  CH USING [ConversationHandle, FreeConversationHandle, 
    LookupDistinguishedName, MakeConversationHandle, Name, ReturnCode],
  CHCommonLookups USING [LookupAddress, LookupNameProperty],
  CHPIDs USING [associatedWorkstation],
  Courier USING [LocalSystemElement],
  ExtendedString USING [StringToNumber],
  Format USING [DecimalFormat, Number, StringProc],
  Heap USING [systemZone],
  NSName USING [Error, FreeName, MakeName, maxFullNameLength, 
    Name, NameFieldsFromString, NameTooSmall],
  NSString USING [String, StringFromMesaString],
  Profile USING [GetDefaultOrganization, GetID, Qualify],
  Runtime USING [IsBound],
  String USING [AppendChar, AppendString, AppendSubString, 
    EqualStrings, SubString, SubStringDescriptor],
  System USING [broadcastHostNumber, HostNumber, NetworkAddress, 
    NetworkNumber, nullHostNumber, nullNetworkNumber, 
    nullSocketNumber, SocketNumber];

AddressTranslationImpl: PROGRAM

  IMPORTS
    AddressCache, AuthSpecial, CH, CHCommonLookups, 
    Courier, ExtendedString, Format, Heap,
    NSName, NSString, Profile, Runtime, String
  EXPORTS AddressTranslation =
  
  BEGIN
  
  --Local constants, types and variables
  NetworkAddress: TYPE = System.NetworkAddress;
  
  bound: BOOLEAN = Runtime.IsBound[LOOPHOLE[AddressCache.GetSize]];
  
  Error: PUBLIC ERROR [errorRecord: AddressTranslation.ErrorRecord] = CODE;
  
  
  <<
  This module implements the address translation interface.  It translates
  strings to internal records.

  A fully specified address string is of the form 
  <netNumber>.<hostNumber>.<socketNumber> or 
  <netNumber>#<hostNumber>#<socketNumber>
  
  hostNumber must always be specified. It can have one of several forms:
    1) A sequence of characters in ['0 .. '7] optionally followed by a 'B.
    2) A sequence of characters in ['0..'9] optionally followed by 'D.
       The string may also have '- characters imbedded impying product format.
    3) A sequence of characters in ['0..'9] or in ['A..'F] optionally followed
       by 'H.  Hex specifications may have a leading zero to reduce ambiguity.
    4) A Clearinghouse distinguished name containing at least one character not
       in the set {in['0..'9], in['A..'F]}.  The Clearinghouse name may include
       blanks, the characters '-, '*, '@, ':, or numerals as well as upper and
       lower case letters.
  
       The string is broken into its local, domain, and organization (org)
       components by looking for either ': or '@ characters.  Both separators
       are not allowed in the same string.  Clients are advised to only use
       ': as separator characters.  If the string does not contain a
       domain and/or org field, values for those fields will be supplied from
       a Tajo interface, see the documentation for exact details.
  
       The resulting Clearinghouse name is looked up in the CH.  The name must
       denote (or be an alias for) one of a specific set of CH objects for the 
       lookup to succeed.
       Refer to the release documentation for the currently supported set of 
       allowed CH objects.
  
    5) The special string "ME" is equivalent to specifing the Processor 
       ID of the host that AddressTranslation is called on.
  
    6) The special string "*" is equivalent to specifing the broadcast
       Processor ID.
  
  Both netNumber and socketNumber can be defaulted.
  
  The translation routine will translate any string that is well formed and
  unambiguous.
  Examples: 74B#25200000016#2      Lassen:OSBU North      25200000016 
            60.Lassen	      ME
            *                      74.*.           #Lassen:Bayhill:Xerox#2B
            #25200000016#2
  
  Ambiguous (because pair could mean net#host or host#socket):
            74#2
  >>

  

  BigNumber: TYPE = MACHINE DEPENDENT RECORD [
    SELECT OVERLAID * FROM
    null => [a, b, c, d: WORD],
    net => [an, bn: WORD, net: System.NetworkNumber],
    host => [ah: WORD, host: System.HostNumber],
    socket => [as, bs, cs: WORD, socket: System.SocketNumber],
    ENDCASE];
  nullBigNumber: BigNumber = [null[0, 0, 0, 0]];

  --PROCS

  PrintCHReturnCode: PUBLIC PROC[
    rc: CH.ReturnCode, proc: Format.StringProc, data: LONG POINTER ¬ NIL] =
    BEGIN
    SELECT rc.code FROM
      done => proc ["[done, "L, data];
      notAllowed => proc ["[notAllowed, "L, data];
      rejectedTooBusy => proc ["[rejectedTooBusy, "L, data];
      allDown => proc ["[allDown, "L, data];
      LOOPHOLE [4] => proc ["[operationRejectedUseCourier, "L, data];
      badProtocol => proc ["[badProtocol, "L, data];
      illegalPropertyID => proc ["[illegalPropertyID, "L, data];
      illegalOrgName => proc ["[illegalOrgName, "L, data];
      illegalDomainName => proc ["[illegalDomainName, "L, data];
      illegalLocalName => proc ["[illegalLocalName, "L, data];
      noSuchOrg => proc ["[noSuchOrg, "L, data];
      noSuchDomain => proc ["[noSuchDomain, "L, data];
      noSuchLocal => proc ["[noSuchLocal, "L, data];
      propertyIDNotFound => proc ["[propertyIDNotFound, "L, data];
      wrongPropertyType => proc ["[wrongPropertyType, "L, data];
      noChange => proc ["[noChange, "L, data];
      outOfDate => proc ["[outOfDate, "L, data];
      overflowOfName => proc ["[overflowOfName, "L, data];
      overflowOfDataBase => proc ["[overflowOfDataBase, "L, data];
      LOOPHOLE [50] => proc ["[wrongServer, "L, data];
      LOOPHOLE [60] => proc ["[identifierRejected, "L, data];
      LOOPHOLE [61] => proc ["[verifierInvalid, "L, data];
      LOOPHOLE [62] => proc ["[verifierExpired, "L, data];
      LOOPHOLE [63] => proc ["[verifierReused, "L, data];
      LOOPHOLE [64] => proc ["[credentialsExpired, "L, data];
      credentialsTooWeak => proc ["[credentialsTooWeak, "L, data];
      wasUpNowDown => proc ["[wasUpNowDown, "L, data];
      ENDCASE => {proc ["[???("L, data];
        Format.Number [proc, rc.code, Format.DecimalFormat];
	proc ["), "L, data];
	};
    SELECT rc.which FROM
      first => proc ["first]"L, data];
      second => proc ["second]"L, data];
      ENDCASE => {proc ["???("L, data];
        Format.Number [proc, rc.which, Format.DecimalFormat, data];
	proc [")]"L, data];
	};
    END; -- of PrintCHReturnCode

  PrintError: PUBLIC PROCEDURE [
    error: AddressTranslation.ErrorRecord, proc: Format.StringProc, 
    clientData: LONG POINTER ¬ NIL] = {
    WITH e: error SELECT FROM
      scanError => {
        proc["Scan error at position "L, clientData];
	Format.Number [proc, e.position, [], clientData];
	proc["."L, clientData];
	};
      badSyntax => {
        proc["Bad syntax in "L, clientData];
	proc[SELECT e.field FROM
	  net => "net"L,
	  host => "host"L,
	  socket => "socket"L,
	  ENDCASE => "string"L, clientData];
	proc["."L, clientData];
	};
      chLookupProblem => {
        proc["Clearinghouse lookup problem: "L];
	PrintCHReturnCode[e.rc, proc, clientData];
	proc["."L, clientData];
	};
      otherCHProblem => {
        proc["AddressTranslation problem: "L, clientData];
	proc[SELECT e.reason FROM
	  noUsefulProperties => "no useful properties"L,
	  ambiguousSeparators => "ambiguous separators"L,
	  tooManySeparators => "too many separators"L,
	  authentication => "authentication"L,
	  invalidName => "invalid name"L,
	  invalidPassword => "invalid password"L,
	  couldntDetermineAddress => "couldn't determine address"L,
	  spare1 => "spare1"L,
	  spare2 => "spare2"L,
	  spare3 => "spare3"L,
	  ENDCASE => "unknown"L, clientData];
	proc["."L, clientData];
        };
      ENDCASE;
    };
    
  StringToNetworkNumber: PUBLIC PROC[s: LONG STRING]
    RETURNS [nN: System.NetworkNumber] =
    BEGIN
    net: String.SubStringDescriptor;
    type: FieldType ¬ default;
    nN ¬ System.nullNetworkNumber;  --set default
    IF s = NIL THEN GOTO nope;
    net ¬ [s, 0, s.length];
    type ¬ GetType[@net];
    SELECT type FROM
      default => nN ¬ DefaultNet[];
      broadcast => nN ¬ LOOPHOLE[LAST[LONG CARDINAL]];
      octal, decimal, hex => Convert[@nN, SIZE[System.NetworkNumber], @net, type];
      ENDCASE => GOTO nope;
    EXITS nope => NULL;
    END;  --StringToNetworkNumber

  StringToHostNumber: PUBLIC PROC[s: LONG STRING]
    RETURNS [hN: System.HostNumber] = {
    host: String.SubStringDescriptor;
    type: FieldType ¬ default;
    hN ¬ System.nullHostNumber;  --set default
    IF s = NIL THEN GOTO nope;
    host ¬ [s, 0, s.length];
    type ¬ GetType[@host];
    SELECT type FROM
      default => hN ¬ DefaultHost[];
      broadcast => hN ¬ System.broadcastHostNumber;
      octal, decimal, hex => Convert[@hN, SIZE[System.HostNumber], @host, type];
      ENDCASE => GOTO nope;
    EXITS nope => NULL;
    };  --StringToHostNumber
    
  defaultHost: System.HostNumber ¬ System.nullHostNumber;
  defaultNet: System.NetworkNumber ¬ System.nullNetworkNumber;
  
  DefaultHost: PROC RETURNS [dH: System.HostNumber] = {
    IF defaultHost = System.nullHostNumber THEN
      defaultHost ¬ Courier.LocalSystemElement[].host;
    RETURN[defaultHost];
    };

  DefaultNet: PROC RETURNS [dN: System.NetworkNumber] = {
    IF defaultNet = System.nullNetworkNumber THEN
      defaultNet ¬ Courier.LocalSystemElement[].net;
    RETURN[defaultNet];
    };

  <<
  If the user doesn't specify a socket then addr.socket is defaulted to
  System.nullSocketNumber

  If the string requires CH lookup, the first property searched for will
  be defaultCHPID.  If defaultCHPID is set to the default "all", or the lookup
  using the default did not succeed, then all allowable properties will 
  be checked.  The property that the lookup succeeded on is returned as
  usedCHPID (unknown value if chUsed is False).

  If the string requires CH lookup, then distingName will be passed to the
  CH interfaces used, allowing the user to determine the exact distinguished
  name stored in the CH.  See the release documentation for further 
  information.
  >> 

  FieldType: TYPE = {default, broadcast, octal, decimal, hex, clearinghouse};
  
  GetType: PROC[ss: String.SubString] RETURNS [type: FieldType ¬ default] = {
    end: CARDINAL ¬ ss.offset+ss.length;
    FOR i: CARDINAL IN [ss.offset..end) DO
      SELECT ss.base[i] FROM
        IN['0..'7] => type ¬ MAX[type, octal];
        '8, '9 => type ¬ MAX[type, decimal];
        'A, 'C, 'E, 'F => type ¬ MAX[type, hex];
        'B, 'b => SELECT TRUE FROM
          (type > octal) => LOOP;
          (i = end - 1) => type ¬ octal;
          ENDCASE => type ¬ hex;
        'D, 'd => SELECT TRUE FROM
          (type > decimal) => LOOP;
          (i = end - 1) => type ¬ decimal;
          ENDCASE => type ¬ MAX[type, hex];
        'H, 'h => SELECT TRUE FROM
          (type > hex) => LOOP;
          (i = end - 1) => type ¬ hex;
          ENDCASE => {type ¬ clearinghouse; EXIT};
        '- => type ¬ SELECT type FROM
	  default, hex => clearinghouse, octal => decimal, ENDCASE => type;
        '* => type ¬ MAX[type, broadcast];
        ENDCASE => {type ¬ clearinghouse; EXIT};
      ENDLOOP;
    IF (type = broadcast AND ss.length # 1) OR 
      (type = hex AND ~(ss.base[ss.offset] IN ['0..'9])) THEN 
      type ¬ clearinghouse;
    };
  
  StringToNetworkAddress: PUBLIC PROC[
    s: LONG STRING, id: Auth.IdentityHandle ¬ NIL, distingName: NSName.Name ¬ NIL]
    RETURNS [addr: NetworkAddress, chUsed: BOOLEAN ¬ FALSE] = {
    netPart, hostPart, socketPart: String.SubStringDescriptor;
    netType, hostType, socketType: FieldType ¬ default;
    i, firstDot, secondDot, second, third: CARDINAL ¬ 0;
    netPart ¬ hostPart ¬ socketPart ¬ [s, 0, 0];
    IF s = NIL THEN Error[[scanError[0]]];
    BEGIN
    FOR i IN [0..s.length) DO  -- find net part
      IF s[i] = '. OR s[i] = '# THEN {firstDot ¬ i; EXIT};
      REPEAT FINISHED => GOTO onlyHost;
      ENDLOOP;
    netPart ¬ [s, 0, firstDot];
    netType ¬ GetType[@netPart];
    second ¬ firstDot + 1;
    FOR i DECREASING IN (firstDot..s.length) DO  -- find socket part
      IF s[i] = '. OR s[i] = '# THEN {secondDot ¬ i; EXIT};
      REPEAT FINISHED => { -- only two parts
        socketPart ¬ [s, second, s.length - second];
        socketType ¬ GetType[@socketPart];
        SELECT netType FROM
          clearinghouse => {
            IF socketType = clearinghouse THEN GOTO onlyHost;
            hostPart ¬ netPart; hostType ¬ netType; netType ¬ default;
            GOTO done};
          ENDCASE => {
            IF socketType # clearinghouse THEN Error[[badSyntax[host]]];
            hostPart ¬ socketPart; hostType ¬ socketType; socketType ¬ default;
            GOTO done}};
      ENDLOOP;
    third ¬ secondDot + 1;
    socketPart ¬ [s, third, s.length - third];
    socketType ¬ GetType[@socketPart];
    hostPart ¬ [s, second, secondDot - second];
    hostType ¬ GetType[@hostPart];
    IF netType = clearinghouse AND socketType = clearinghouse AND
      hostType = clearinghouse THEN GOTO onlyHost;
    IF netType = clearinghouse THEN Error[[badSyntax[net]]];
    IF socketType = clearinghouse THEN Error[[badSyntax[socket]]];
    EXITS onlyHost => {
      netType ¬ socketType ¬ default; 
      hostPart ¬ [s, 0, s.length];
      hostType ¬ GetType[@hostPart]};
      done => NULL;
    END;
    [addr, chUsed] ¬ GetAddress[
      @netPart, @hostPart, @socketPart, netType, hostType, socketType,
      id, distingName];
    };  --StringToNetworkAddress

  GetAddress: PROC[
    net, host, socket: String.SubString, netType, hostType, socketType: FieldType,
    id: Auth.IdentityHandle ¬ NIL, distingName: NSName.Name ¬ NIL]  
    RETURNS[na: NetworkAddress, chUsed: BOOLEAN ¬ FALSE] = {
    overWrite: BOOLEAN ¬ hostType # clearinghouse;
    SELECT hostType FROM
      default => na.host ¬ DefaultHost[];
      broadcast => na.host ¬ System.broadcastHostNumber;
      octal, decimal, hex => Convert[
        @na.host, SIZE[System.HostNumber], host, hostType];
      ENDCASE => {
        s: LONG STRING ¬ Heap.systemZone.NEW[StringBody[host.length]];
	String.AppendSubString[s, host];
        [na, chUsed] ¬ NameToNetworkAddress[s, id, distingName!
	  UNWIND => Heap.systemZone.FREE[@s]];
	Heap.systemZone.FREE[@s];
	};
    SELECT netType FROM
      default => IF overWrite THEN na.net ¬ DefaultNet[];
      broadcast => na.net ¬ LOOPHOLE[LAST[LONG CARDINAL]];
      octal, decimal, hex => Convert[
        @na.net, SIZE[System.NetworkNumber], net, netType];
      ENDCASE => ERROR Error[[badSyntax[net]]];
    SELECT socketType FROM
      default => IF overWrite THEN na.socket ¬ System.nullSocketNumber;
      broadcast => na.socket ¬ LOOPHOLE[LAST[CARDINAL]];
      octal, decimal, hex => Convert[
        @na.socket, SIZE[System.SocketNumber], socket, socketType];
      ENDCASE => ERROR Error[[badSyntax[socket]]];
      };
  
  Convert: PROC [
    f: LONG POINTER, size: CARDINAL, ss: String.SubString, type: FieldType] = {
    s: LONG STRING ¬ [40];
    long: LONG STRING ¬ NIL;
    base: CARDINAL ¬ SELECT type FROM octal => 8, decimal => 10, ENDCASE => 16;
    IF ss.length > 40 THEN 
      long ¬ s ¬ Heap.systemZone.NEW[StringBody[ss.length]];
    BEGIN ENABLE UNWIND => IF long # NIL THEN Heap.systemZone.FREE[@long];
    s.length ¬ 0;
    FOR i: CARDINAL IN [ss.offset..ss.offset + ss.length) DO
      IF ss.base[i] # '- THEN String.AppendChar[s, ss.base[i]];
      ENDLOOP;
    SELECT s[s.length - 1] FROM
      IN ['0..'9] => NULL;
      IN ['A..'F] => IF base # 16 THEN s.length ¬ s.length - 1;
      ENDCASE => s.length ¬ s.length - 1;
    ExtendedString.StringToNumber[f, size, base, s];
    IF long # NIL THEN Heap.systemZone.FREE[@long];
    END;
    };
  
  NameToNetworkAddress: PROC[
    s: LONG STRING, identity: Auth.IdentityHandle ¬ NIL, distingName: NSName.Name]
    RETURNS [na: NetworkAddress, chUsed: BOOLEAN ¬ FALSE] =
    BEGIN
    qualified: LONG STRING = [NSName.maxFullNameLength];
    target: NSName.Name ¬ NIL;
    z: UNCOUNTED ZONE = Heap.systemZone;
    conversation: CH.ConversationHandle ¬ [NIL, NIL];
    cacheSize: CARDINAL ¬ 0;
    hit: BOOLEAN ¬ FALSE;

    --special case - see if the name is "ME" 
    IF String.EqualStrings[s, "ME"L] THEN {
        na ¬ Courier.LocalSystemElement[];
        na.socket ¬ System.nullSocketNumber;
	RETURN};

    BEGIN
    ENABLE
      UNWIND =>
	BEGIN
        IF target # NIL THEN {NSName.FreeName[z, target]; target ¬ NIL};
	IF conversation.conversation # NIL THEN
	  CH.FreeConversationHandle [@conversation, z];
	END;

    <<
    Try to get address of s from the CH, using first the default
    property type, <defaultCHPID>, then any CHPID that we know about
    >>

    ok: BOOLEAN ¬ TRUE;
    done: CH.ReturnCode ¬ [done, first];
    reason: AddressTranslation.Reason ¬ couldntDetermineAddress;  -- default
    auth: Auth.CallProblem;

    chUsed ¬ TRUE;  -- set the return variables
    
    Profile.Qualify[s, qualified, clearinghouse];
    BEGIN -- Profile.Qualify doesn't do anything if you feed it A:B
    separators: CARDINAL ¬ 0;
    GetDefaultOrganization: PROCEDURE [s: LONG STRING] =
      BEGIN
      String.AppendChar[qualified, ':];
      String.AppendString[qualified, s];
      END;
    FOR i: CARDINAL IN [0..qualified.length) DO
      SELECT qualified[i] FROM
        ': => {IF (separators ¬ separators + 1) = 2 THEN EXIT};
	ENDCASE;
      REPEAT FINISHED => Profile.GetDefaultOrganization[GetDefaultOrganization];
      ENDLOOP;
    END;
    
    target ¬ NSName.MakeName[z];
    NSName.NameFieldsFromString[
      z: z, destination: target, s: NSString.StringFromMesaString[qualified] !
        NSName.Error => {reason ¬  tooManySeparators; CONTINUE};
	NSName.NameTooSmall => {reason ¬ tooManySeparators; CONTINUE}];
    IF reason # couldntDetermineAddress THEN  -- NSName.Error was signaled
      ERROR Error[[otherCHProblem[reason]]]; -- UNWIND will free allocated storage
    
    IF bound THEN cacheSize ¬ AddressCache.GetSize[];
    IF cacheSize > 0 THEN {
      [na, hit] ¬ AddressCache.LookupNSName[target];
      IF hit THEN {chUsed ¬ FALSE; RETURN};
      };
    
    BEGIN -- All this crap just to read the CH. Argh!!!!!
    GetIdentity: PROCEDURE [id: Auth.IdentityHandle] =
      {[conversation, ok, auth] ¬ CH.MakeConversationHandle [id, z]};
    IF identity = NIL THEN Profile.GetID[strong, GetIdentity]
    ELSE [conversation, ok, auth] ¬ CH.MakeConversationHandle [identity, z];
    IF ~ok THEN SELECT auth FROM
      strongKeyDoesNotExist, badKey => {
        -- Try back door if not logged in. (May not work)
	-- Humm. strongKeyDoesNotExist works if password is NIL (Dicentra case)
	-- but Tajo uses an empty string, and that seems to generate badKey
        conversation ¬ AuthSpecial.MakeNullCHConversation[z];
        ok ¬ TRUE; };
      ENDCASE;
    IF ~ok THEN ERROR Error[[otherCHProblem[SELECT auth FROM
      badKey => invalidPassword,
      strongKeyDoesNotExist, simpleKeyDoesNotExist => invalidName,
      ENDCASE => authentication]]];
    END;

    IF distingName # NIL THEN
      done ¬ CH.LookupDistinguishedName [conversation, target, distingName];
    IF done.code = done THEN
      [done, na] ¬ CHCommonLookups.LookupAddress[conversation, target];
    
    IF done.code # done AND done.code # allDown AND done.code # noSuchLocal THEN
      BEGIN
      workstationName: NSName.Name ¬ NIL;
      -- try to lookup the associated workstation
      [done, workstationName, ] ¬ CHCommonLookups.LookupNameProperty[ 
	conversation, target, CHPIDs.associatedWorkstation, z];
      IF done.code = done THEN [done, na, ] ¬ CHCommonLookups.LookupAddress[
        conversation, workstationName];
      IF workstationName # NIL THEN NSName.FreeName[z, workstationName];
      workstationName ¬ NIL;
      END;

    -- free up storage
    IF cacheSize > 0 AND ~hit AND done.code = done THEN
      AddressCache.AddNSName[target, na];
    IF target # NIL THEN {NSName.FreeName[z, target]; target ¬ NIL};
    IF conversation.conversation # NIL THEN CH.FreeConversationHandle[
      @conversation, z];
    
    IF done.code = propertyIDNotFound THEN
      RETURN WITH ERROR Error[[otherCHProblem[couldntDetermineAddress]]];
    IF done.code # done THEN RETURN WITH ERROR Error[[chLookupProblem[done]]];
    END;
    END;  --NameToNetworkAddress

  END.