-- Grapevine:  program to check database for export controls

-- DBExport.mesa

-- Andrew Birrell  11-Feb-82  9:41:35

DIRECTORY
Ascii		USING[ CR ],
BodyDefs	USING[ maxRNameLength, RName ],
IODefs		USING[ WriteChar, WriteString ],
LaurelExecDefs	USING[ MakeMenuCommandCallable ],
NameInfoDefs	USING[ Close, Enumerate, Expand, ExpandInfo, GetMembers,
		       MemberInfo ],
Runtime		USING[ IsBound ],
Storage		USING[ Free, Node, String ],
String		USING[ AppendChar, AppendString ];

DBExport: PROGRAM
IMPORTS IODefs, LaurelExecDefs, NameInfoDefs, Runtime, Storage, String =

BEGIN

OPEN IODefs, BodyDefs, NameInfoDefs;

LowerCase: PROC[c: CHARACTER] RETURNS[ CHARACTER ] = INLINE
  { RETURN[ IF c IN ['A..'Z] THEN 'a + (c-'A) ELSE c] };

EndsWith: PROC[a, b: STRING] RETURNS[ BOOLEAN ] = INLINE
  BEGIN
  j: CARDINAL _ a.length;
  -- Assumes b is all lower case --
  IF a.length < b.length THEN RETURN[FALSE];
  FOR i: CARDINAL DECREASING IN [0..b.length)
  DO j _ j-1;
     IF LowerCase[a[j]] # LowerCase[b[i]] THEN RETURN[FALSE];
  ENDLOOP;
  RETURN[TRUE]
  END;

targets: DESCRIPTOR FOR ARRAY OF STRING _ DESCRIPTOR[NIL,0];

GetTargets: PROC =
  BEGIN
  info: NameInfoDefs.MemberInfo =
    NameInfoDefs.GetMembers["OtherRegistries^.internet"L];
  WITH info SELECT FROM
    allDown =>
      WriteString["Can't get OtherRegistries^.internet - all down"L];
    notFound, individual =>
      WriteString["Can't get OtherRegistries^.internet - not a group"L];
    group =>
      BEGIN
      count: CARDINAL _ 0;
      GetCount: PROC[entry: RName] RETURNS[done: BOOLEAN] =
        { count _ count+1; done _ FALSE };
      GetReg: PROC[entry: RName] RETURNS[done: BOOLEAN] =
        BEGIN
        FOR i: CARDINAL DECREASING IN [0..entry.length)
        DO IF entry[i] = '.
           THEN BEGIN
                targets[count] _ Storage.String[entry.length-i];
                FOR j: CARDINAL IN [i..entry.length)
                DO String.AppendChar[targets[count], entry[j]] ENDLOOP;
                count _ count+1;
                WriteString[SELECT count FROM
                              1 => """"L,
                              LENGTH[targets] => " and """L,
                            ENDCASE => ", """L];
                WriteString[targets[count-1]];
                WriteChar['"];
                EXIT
                END;
        ENDLOOP;
        done _ FALSE;
        END;
      WriteString["Looking for members and forwardees in: "L];
      NameInfoDefs.Enumerate[members,GetCount];
      targets _ DESCRIPTOR[Storage.Node[count*SIZE[STRING]],count];
      count _ 0;
      NameInfoDefs.Enumerate[members,GetReg];
      NameInfoDefs.Close[members];
      END;
  ENDCASE => ERROR;
  END;

FreeTargets: PROC =
  BEGIN
  tBase: POINTER _ BASE[targets];
  FOR i: CARDINAL IN [0..LENGTH[targets])
  DO Storage.Free[@targets[i]] ENDLOOP;
  Storage.Free[@tBase];
  END;

lookType: { group, individual };

Look: PROC[entry: RName] RETURNS[done: BOOLEAN] =
   BEGIN
   first: BOOLEAN _ TRUE;
   Check: PROC[n: RName] RETURNS[done: BOOLEAN] =
      BEGIN
      FOR i: CARDINAL IN [0..LENGTH[targets])
      DO IF EndsWith[n, targets[i]]
         THEN BEGIN
              IF first
              THEN BEGIN
                   WriteChar[Ascii.CR]; WriteChar[Ascii.CR];
                   WriteString[entry];
                   WriteString[IF lookType = group
                               THEN " contains "
                               ELSE " is forwarded to "];
                   first _ FALSE;
                   END
              ELSE WriteString[", "];
              WriteString[n];
              EXIT
              END;
      ENDLOOP;
      done _ FALSE;
      END;
   memberInfo: NameInfoDefs.ExpandInfo = NameInfoDefs.Expand[entry];
   WITH memberInfo SELECT FROM
     group =>
       BEGIN ENABLE UNWIND => NameInfoDefs.Close[members];
       NameInfoDefs.Enumerate[members, Check];
       NameInfoDefs.Close[members];
       done _ FALSE
       END;
     allDown => { done _ TRUE; WriteString["all R-Servers down!"L] };
     individual => { done _ FALSE; NameInfoDefs.Close[sites] };
     notFound => done _ FALSE;
   ENDCASE => ERROR;
   END;


LookEnum: PROC[enumName: RName,
               work: PROC[RName]RETURNS[done: BOOLEAN] ] =
   -- argument is "groups.reg", "individuals.reg", or "dead.reg" --
   BEGIN
   memberInfo: NameInfoDefs.MemberInfo;
   memberInfo _ NameInfoDefs.GetMembers[enumName];
   WITH memberInfo SELECT FROM
     group => BEGIN ENABLE UNWIND => NameInfoDefs.Close[members];
       NameInfoDefs.Enumerate[members, work];
       NameInfoDefs.Close[members];
       END;
     allDown =>
       { WriteString[enumName]; WriteString[": all R-Servers down!"L] };
     notFound =>
       { WriteString[enumName]; WriteString[": not found!"L] };
   ENDCASE => ERROR;
   END;

LookAtRegistry: PROC[regGroup: RName] RETURNS[done: BOOLEAN] =
   BEGIN
   wanted: RName = [maxRNameLength];
   FOR i: CARDINAL DECREASING IN [0..regGroup.length)
   DO regGroup.length _ regGroup.length-1;
      IF regGroup[i] = '. THEN EXIT;
   ENDLOOP;
   String.AppendString[wanted, "Groups."L];
   String.AppendString[wanted, regGroup];
   -- Don't look inside target registries --
   FOR i: CARDINAL IN [0..LENGTH[targets])
   DO IF EndsWith[wanted, targets[i]] THEN RETURN[FALSE]; ENDLOOP;
   WriteChar[Ascii.CR]; WriteChar[Ascii.CR];
   WriteString["Registry "L]; WriteString[regGroup];
   lookType _ group; LookEnum[wanted, Look];
   wanted.length _ 0;
   String.AppendString[wanted, "Individuals."L];
   String.AppendString[wanted, regGroup];
   lookType _ individual; LookEnum[wanted, Look];
   done _ FALSE;
   END;

LookAtAll: PROC =
   { LookEnum["Groups.gv"L, LookAtRegistry] };


IF Runtime.IsBound[LaurelExecDefs.MakeMenuCommandCallable]
THEN BEGIN
     LaurelExecDefs.MakeMenuCommandCallable[user];
     LaurelExecDefs.MakeMenuCommandCallable[newMail];
     LaurelExecDefs.MakeMenuCommandCallable[mailFile];
     LaurelExecDefs.MakeMenuCommandCallable[display];
     LaurelExecDefs.MakeMenuCommandCallable[delete];
     LaurelExecDefs.MakeMenuCommandCallable[undelete];
     LaurelExecDefs.MakeMenuCommandCallable[moveTo];
     LaurelExecDefs.MakeMenuCommandCallable[copy];
     END;

GetTargets[];
IF LENGTH[targets] # 0 THEN LookAtAll[];
IF BASE[targets] # NIL THEN FreeTargets[];

END.