MODULE SupMisc;

IMPORT
  FileAttr, Fmt, FS, Glob, GlobTree, IP, OSError, OSErrorPosix,
  Pathname, Process, Random, Rd, RdClass, RegEx, SupFileRec, Text,
  TextArraySort, TextSeq, Thread, TokScan, Uerror;
IMPORT TCP;

TYPE
  AtomicCounter = MUTEX OBJECT
    count: CARDINAL := 0;
  END;

CONST
  TempStemPrefix = "#cvs.cvsup-";

VAR
  TempStem: TEXT := NIL;
  tempCount := NEW(AtomicCounter);
  RCSSuffixLength := Text.Length(RCSSuffix);

  portMu := NEW(MUTEX);  (* Monitors "portRandom" and "nextPort". *)
  portRandom: Random.T := NIL;
  nextPort: IP.Port := IP.NullPort;

PROCEDURE AtticName(name: Pathname.T): Pathname.T =
  VAR
    fileName := PathLast(name);
    dirName := PathPrefix(name);
  BEGIN
    IF Text.Equal(PathLast(dirName), CVSAttic) THEN  (* Already in Attic. *)
      RETURN name;
    ELSE
      RETURN CatPath(CatPath(dirName, CVSAttic), fileName);
    END;
  END AtticName;

PROCEDURE CatPath(p1, p2: Pathname.T): Pathname.T =
  VAR
    nSlash: [0..2];
  BEGIN
    IF Text.Empty(p1) THEN RETURN p2 END;
    IF Text.Empty(p2) THEN RETURN p1 END;
    nSlash := 0;
    IF Text.GetChar(p1, Text.Length(p1)-1) = SlashChar THEN INC(nSlash) END;
    IF Text.GetChar(p2, 0) = SlashChar THEN INC(nSlash) END;
    CASE nSlash OF
    | 0 => RETURN Cat3(p1, SlashText, p2);
    | 1 => RETURN p1 & p2;
    | 2 => RETURN p1 & Text.Sub(p2, 1);
    END;
  END CatPath;

PROCEDURE CheckoutName(name: Pathname.T): Pathname.T =
  BEGIN
    (* FIXME - If the name is too short, i.e., not an RCS name, this
       gets a runtime error.  Is that OK? *)
    RETURN Text.Sub(name, 0, Text.Length(name) - RCSSuffixLength);
  END CheckoutName;

PROCEDURE CommonLength(a, b: TEXT): CARDINAL =
  BEGIN
    WITH len = MIN(Text.Length(a), Text.Length(b)) DO
      FOR i := 0 TO len-1 DO
	IF Text.GetChar(a, i) # Text.GetChar(b, i) THEN RETURN i END;
      END;
      RETURN len;
    END;
  END CommonLength;

PROCEDURE ExpandFilenames(prefix: Pathname.T;
                          names: TextSeq.T): TextSeq.T =
  VAR
    oldSize := names.size();
    newNames: TextSeq.T;
    arr: REF ARRAY OF TEXT;
    cur, prev: TEXT;
    curLen, prevLen: CARDINAL;
  BEGIN
    (* Copy the names sequence, expanding wildcards as we go. *)
    newNames := NEW(TextSeq.T).init(2 * oldSize);
    FOR i := 0 TO oldSize-1 DO
      cur := names.get(i);
      IF Text.FindChar(cur, '*') # -1
      OR Text.FindChar(cur, '?') # -1
      OR Text.FindChar(cur, '[') # -1
      OR Text.FindChar(cur, '{') # -1 THEN
	(* FIXME - Expand wildcards. *)
      ELSE
	TRY
	  IF FS.Status(CatPath(prefix, cur)).type = FS.DirectoryFileType THEN
	    newNames.addhi(cur);
	  ELSE
	    (* FIXME - Handle regular files. *)
	  END;
	EXCEPT OSError.E => (* Ignore non-existent files. *) END;
      END;
    END;

    (* Copy the expanded list of names into an array, and sort it. *)
    arr := NEW(REF ARRAY OF TEXT, newNames.size());
    FOR i := FIRST(arr^) TO LAST(arr^) DO
      arr[i] := newNames.get(i);
    END;
    TextArraySort.Sort(arr^, PathCompare);

    (* Copy the sorted array into a new sequence, eliminating overlaps. *)
    newNames := NEW(TextSeq.T).init(NUMBER(arr^));
    prev := NIL;
    FOR i := FIRST(arr^) TO LAST(arr^) DO
      cur := arr[i];
      curLen := Text.Length(cur);
      IF prev = NIL OR CommonLength(prev, cur) < prevLen
      OR curLen > prevLen AND Text.GetChar(cur, prevLen) # SlashChar
      THEN  (* No overlap. *)
	newNames.addhi(cur);
	prev := cur;
	prevLen := curLen;
      END;
    END;

    RETURN newNames;
  END ExpandFilenames;

PROCEDURE FindFile(base: Pathname.T;
                   searchPath: TEXT;
		   file: Pathname.T): Pathname.T =
  <* FATAL TokScan.Error *>
  VAR
    ts := TokScan.New(searchPath, SET OF CHAR{':'});
    dir: Pathname.T;
    path: Pathname.T;
  BEGIN
    WHILE ts.next(dir) DO
      path := ResolvePath(base, ResolvePath(dir, file));
      TRY
	EVAL FileAttr.FromPathname(path, follow := TRUE);
	RETURN path;
      EXCEPT OSError.E => (* Keep going. *) END;
    END;
    RETURN NIL;
  END FindFile;

PROCEDURE FilterPathList(searchPath: TEXT;
                         cl: TextPredicateClosure): TEXT =
  <* FATAL TokScan.Error *>
  VAR
    dir: TEXT;
    ts := TokScan.New(searchPath, SET OF CHAR{':'});
    res: TEXT := NIL;
  BEGIN
    WHILE ts.next(dir) DO
      IF cl.matches(dir) THEN
        IF res = NIL THEN
          res := dir;
        ELSE
          res := res & ":" & dir;
        END;
      END;
    END;
    IF res = NIL THEN
      res := "";
    END;
    RETURN res;
  END FilterPathList;

PROCEDURE GetCmdLine(rd: Rd.T): TEXT
  RAISES {Rd.EndOfFile, Rd.Failure, Thread.Alerted} =
  VAR
    txt := "";
    j, n: INTEGER;
  BEGIN
    RdClass.Lock (rd);
    TRY
      LOOP (* INV: txt contains the partial result *)
        IF rd.cur = rd.hi THEN
	  <* ASSERT NOT rd.closed *>
          IF rd.seek (rd.cur, FALSE) = RdClass.SeekResult.Eof THEN
            RAISE Rd.EndOfFile;
          END;
        END;
        (* rd is ready *)
        n := rd.hi - rd.lo + rd.st;
        j := rd.cur - rd.lo + rd.st;
        WHILE (j # n) AND rd.buff[j] # '\n' DO INC(j) END;
        VAR rd_cur := rd.cur - rd.lo + rd.st;
            len := j - rd_cur;
         BEGIN
          IF len >= 1 AND j # n  AND rd.buff[j-1] = '\r' THEN
            (* segment ends in \r\n *)
            txt := txt & Text.FromChars (SUBARRAY (rd.buff^, rd_cur, len-1));
            INC (rd.cur, len+1);
            RETURN txt;
          ELSIF j # n THEN
            (* segment ends in \n *)
            txt := txt & Text.FromChars (SUBARRAY (rd.buff^, rd_cur, len));
            INC (rd.cur, len+1);
            IF NOT Text.Empty(txt) AND
                 Text.GetChar(txt, Text.Length(txt)-1) = '\r' THEN
              txt := Text.Sub(txt, 0, Text.Length(txt)-1)
            END;
            RETURN txt;
          ELSE
            (* segment does not contain line break *)
            txt := txt & Text.FromChars (SUBARRAY (rd.buff^, rd_cur, len));
            INC (rd.cur, len);
          END;
        END;
      END; (* LOOP *)
    FINALLY
      RdClass.Unlock (rd);
    END;
  END GetCmdLine;

PROCEDURE IsBlankLine(t: TEXT): BOOLEAN =
  BEGIN
    FOR i := 0 TO Text.Length(t)-1 DO
      IF NOT Text.GetChar(t, i) IN SET OF CHAR{' ', '\t', '\r', '\n'} THEN
	RETURN FALSE;
      END;
    END;
    RETURN TRUE;
  END IsBlankLine;

PROCEDURE IsDirectory(name: Pathname.T): BOOLEAN =
  BEGIN
    TRY
      RETURN FS.Status(name).type = FS.DirectoryFileType;
    EXCEPT OSError.E =>
      RETURN FALSE;
    END;
  END IsDirectory;

PROCEDURE IsRCS(p: Pathname.T): BOOLEAN =
  BEGIN
    WITH suffixPos = Text.Length(p) - RCSSuffixLength DO
      IF suffixPos <= 0 THEN
	RETURN FALSE;
      END;
      FOR i := 0 TO RCSSuffixLength-1 DO
	IF Text.GetChar(p, suffixPos+i) # Text.GetChar(RCSSuffix, i) THEN
	  RETURN FALSE;
	END;
      END;
      RETURN TRUE;
    END;
  END IsRCS;

PROCEDURE LiveName(name: Pathname.T): Pathname.T =
  VAR
    fileName := PathLast(name);
    dirName := PathPrefix(name);
  BEGIN
    IF Text.Equal(PathLast(dirName), CVSAttic) THEN
      RETURN CatPath(PathPrefix(dirName), fileName);
    ELSE  (* Already live. *)
      RETURN name;
    END;
  END LiveName;

PROCEDURE MakeDirectories(path: Pathname.T; umask := -1)
  RAISES {OSError.E} =
  VAR
    head := PathPrefix(path);
    tail: TextSeq.T := NIL;
    attr := NEW(FileAttr.T).init(FileAttr.FileType.Directory);
  BEGIN
    attr := FileAttr.MergeDefault(attr);
    attr := FileAttr.Umask(attr, umask);
    (* Successively remove trailing directories until we find a path
       that exists. *)
    WHILE NOT Text.Empty(head) DO
      TRY
	EVAL FS.Status(head);
	EXIT;
      EXCEPT OSError.E(list) =>
	IF OSErrorPosix.AtomToErrno(list.head) = Uerror.ENOENT THEN
	  IF tail = NIL THEN tail := NEW(TextSeq.T).init(30) END;
	  WITH last = PathLast(head) DO
	    (* Without the tests for "Pathname.Current" and empty, we
	       would get a "file exists" error down below when we
	       tried to create the same directory twice. *)
	    IF NOT Text.Equal(last, Pathname.Current)
	    AND NOT Text.Empty(last) THEN
	      tail.addlo(last);
	    END;
	  END;
	  head := PathPrefix(head);
	ELSE
	  RAISE OSError.E(list);
	END;
      END;
    END;

    (* Make the needed directories and set their attributes. *)
    IF tail # NIL THEN
      WHILE tail.size() > 0 DO
	head := CatPath(head, tail.remlo());
	FileAttr.MakeNode(attr, head);
	EVAL FileAttr.Install(attr, head);
      END;
    END;
  END MakeDirectories;

PROCEDURE NewConnector(addr: IP.Address;
                       loPort, hiPort: IP.Port): TCP.Connector
  RAISES {IP.Error} =
  VAR
    ep: IP.Endpoint;
    firstPort: IP.Port;
  BEGIN
    ep.addr := addr;

    IF hiPort = IP.NullPort THEN
      hiPort := loPort;
    ELSIF loPort = IP.NullPort THEN
      loPort := hiPort;
    ELSIF loPort > hiPort THEN
      VAR t := loPort;
      BEGIN loPort := hiPort;  hiPort := t END;
    END;
    IF loPort = hiPort THEN
      ep.port := loPort;
      RETURN TCP.NewConnector(ep);
    END;

    LOCK portMu DO
      IF NOT (loPort <= nextPort AND nextPort <= hiPort) THEN
	IF portRandom = NIL THEN  (* First call by this process. *)
	  portRandom := NEW(Random.Default).init();
	END;
	nextPort := portRandom.integer(loPort, hiPort);
      END;
      firstPort := nextPort;
      LOOP
	ep.port := nextPort;
	IF nextPort >= hiPort THEN nextPort := loPort ELSE INC(nextPort) END;
	TRY
	  RETURN TCP.NewConnector(ep);
	EXCEPT IP.Error(list) =>
	  IF list.head # IP.PortBusy OR nextPort = firstPort THEN
	    RAISE IP.Error(list);
	  END;
	END;
      END;
    END;
  END NewConnector;

PROCEDURE ParseHost(t: TEXT; VAR (*OUT*) res: IP.Address): BOOLEAN
  RAISES {IP.Error} =
  BEGIN
    TRY
      res := ParseIPAddress(t);
      RETURN TRUE;
    EXCEPT BadAddress =>
      RETURN IP.GetHostByName(t, res);
    END;
  END ParseHost;

PROCEDURE ParseIPAddress(t: TEXT; netOK := FALSE): IP.Address
  RAISES {BadAddress} =
  CONST
    Digits = SET OF CHAR{'0'..'9'};
  VAR
    addr: IP.Address;
    octet: CARDINAL;
    len := Text.Length(t);
    pos := 0;
  BEGIN
    FOR i := FIRST(addr.a) TO LAST(addr.a) DO
      IF pos = len THEN  (* Default the trailing octets to 0. *)
	IF NOT netOK THEN RAISE BadAddress END;
	octet := 0;
      ELSE
	IF i # FIRST(addr.a) THEN  (* Get the '.' *)
	  IF Text.GetChar(t, pos) # '.' THEN RAISE BadAddress END;
	  INC(pos);
	  IF pos = len THEN RAISE BadAddress END;
	END;
	IF NOT Text.GetChar(t, pos) IN Digits THEN RAISE BadAddress END;
	octet := 0;
	REPEAT
	  octet := 10*octet + ORD(Text.GetChar(t, pos)) - ORD('0');
	  INC(pos);
	UNTIL pos = len OR NOT Text.GetChar(t, pos) IN Digits;
	IF octet < 0 OR octet > 255 THEN RAISE BadAddress END;
      END;
      addr.a[i] := octet;
    END;
    IF pos # len THEN RAISE BadAddress END;
    RETURN addr;
  END ParseIPAddress;

PROCEDURE PathLast(p: Pathname.T): Pathname.T =
  BEGIN
    WITH pos = Text.FindCharR(p, SlashChar) DO
      IF pos = -1 THEN
	RETURN p;
      ELSE
	RETURN Text.Sub(p, pos+1);
      END;
    END;
  END PathLast;

PROCEDURE PathPrefix(p: Pathname.T): Pathname.T =
  BEGIN
    WITH pos = Text.FindCharR(p, SlashChar) DO
      IF pos = -1 THEN
	RETURN "";
      ELSIF pos = 0 THEN
	RETURN SlashText;
      ELSE
	RETURN Text.Sub(p, 0, pos);
      END;
    END;
  END PathPrefix;

PROCEDURE PatternMatch(pattern: TEXT;
                       options := Glob.MatchOptions{}): GlobTree.T
                       RAISES {RegEx.Error} =
  BEGIN
    IF Text.Length(pattern) > 0 AND Text.GetChar(pattern, 0) = '+' THEN
      (* Remove the '+' and interpret it as a regular expression. *)
      pattern := Text.Sub(pattern, 1);
      (* Add anchors at the beginning and end, if needed. *)
      IF Text.Length(pattern) = 0 OR Text.GetChar(pattern, 0) # '^' THEN
        pattern := "^" & pattern;
      END;
      <* ASSERT Text.Length(pattern) > 0 *>
      IF Text.GetChar(pattern, Text.Length(pattern) - 1) # '$' THEN
        pattern := pattern & "$";
      END;
      IF Text.Equal(pattern, "^.*$") THEN
        RETURN GlobTree.True;
      END;
      RETURN GlobTree.RegExMatch(pattern);
    ELSE  (* Treat it as a shell pattern. *)
      IF Text.Equal(pattern, "*") THEN
        RETURN GlobTree.True;
      END;
      RETURN GlobTree.Match(pattern, options);
    END;
  END PatternMatch;

PROCEDURE RCSName(name: Pathname.T): Pathname.T =
  BEGIN
    RETURN name & RCSSuffix;
  END RCSName;

PROCEDURE ResolvePath(p1, p2: Pathname.T): Pathname.T =
  BEGIN
    IF Pathname.Absolute(p2) THEN
      RETURN p2;
    ELSE
      RETURN CatPath(p1, p2);
    END;
  END ResolvePath;

PROCEDURE StatusFileName(sfr: SupFileRec.T): Pathname.T =
  BEGIN
    RETURN "checkouts" & StatusFileSuffix(sfr);
  END StatusFileName;

PROCEDURE StatusFileSuffix(sfr: SupFileRec.T): TEXT =
  VAR
    suffix, tag: TEXT;
  BEGIN
    IF sfr.listSuffix # NIL THEN
      suffix := "." & sfr.listSuffix;
    ELSIF SupFileRec.Option.UseRelSuffix IN sfr.options THEN
      suffix := "";
      IF sfr.release # NIL THEN
	suffix := suffix & "." & sfr.release;
      END;
      IF SupFileRec.Option.CheckoutMode IN sfr.options THEN
	tag := sfr.checkoutTag;
	IF tag = NIL THEN tag := "." END;
	suffix := suffix & ":" & tag;
      END;
    ELSE
      suffix := "";
    END;
    RETURN suffix;
  END StatusFileSuffix;

PROCEDURE TempName(p: Pathname.T): Pathname.T =
  VAR
    count: CARDINAL;
  BEGIN
    LOCK tempCount DO
      IF TempStem = NIL THEN  (* First call. *)
	(* We do this here, rather than in the module initialization
	  code, because our process ID may have changed due to forking
	  in "daemon". *)
	TempStem := TempStemPrefix & Fmt.Int(Process.GetMyID());
      END;
      count := tempCount.count;
      INC(tempCount.count);
    END;

    WITH lastSlash = Text.FindCharR(p, SlashChar),
    name = TempStem & "." & Fmt.Int(count) DO
      IF lastSlash = -1 THEN
	RETURN name;
      ELSE
	RETURN Text.Sub(p, 0, lastSlash+1) & name;
      END;
    END;
  END TempName;

BEGIN
END SupMisc.