(* Copyright 1996-2003 John D. Polstra.
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 * 1. Redistributions of source code must retain the above copyright
 *    notice, this list of conditions and the following disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in the
 *    documentation and/or other materials provided with the distribution.
 * 3. All advertising materials mentioning features or use of this software
 *    must display the following acknowledgment:
 *      This product includes software developed by John D. Polstra.
 * 4. The name of the author may not be used to endorse or promote products
 *    derived from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
 * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
 * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
 * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
 * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
 * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 * $Id: TreeComp.m3,v 1.76 2003/03/04 19:26:17 jdp Exp $ *)

MODULE TreeComp;

IMPORT
  ClientClass, CVProto, CVTree, ErrMsg, FileAttr, FileID, FileInfo,
  FileInfoMerger, FileRd, FileStatus, GlobTree, GzipRd, GzipWr, IO,
  LinkTbl, Logger, OSError, PathComp, Pathname, Rd, Reaper, StreamRd,
  StreamWr, SupFileRec, SupFileRecSeq, SupMisc, Text, Thread, Time,
  TokScan, Wr;

EXCEPTION Error(TEXT);

REVEAL
  T = Public BRANDED OBJECT
    proto: CVProto.T;
    wireRd: StreamRd.T;		(* Raw reader. *)
    rd: StreamRd.T;		(* Currently active reader. *)
    wireWr: StreamWr.T;		(* Raw writer. *)
    wr: StreamWr.T;		(* Currently active writer. *)
    collections: SupFileRecSeq.T;
    clientClass: ClientClass.T;
    compLevel: [0..9];
    reaper: Reaper.T;
    logger: Logger.T;
  OVERRIDES
    apply := Apply;
    init := Init;
  END;

PROCEDURE Apply(self: T): REFANY =
  VAR
    ts: TokScan.T;
    collection, release: TEXT;
    initialBytesIn, initialBytesOut: LONGREAL;
  BEGIN
    TRY
      TRY
	FOR i := 0 TO self.collections.size()-1 DO
	  WITH sfr = self.collections.get(i) DO
	    IF NOT SupFileRec.Option.Skip IN sfr.options THEN
	      ts := self.proto.getCmd(self.rd);
	      ts.getFolded("COLL");
	      collection := ts.getToken("collection");
	      release := ts.getToken("release");
              SupFileRec.Check(sfr, collection, release);
              initialBytesIn := StreamRd.ByteCount(self.rd);
              initialBytesOut := StreamWr.ByteCount(self.wr); 
              TRY
                CompCollection(self, sfr);
              FINALLY
                LOCK sfr DO
                  sfr.bytesIn := sfr.bytesIn +
                    StreamRd.ByteCount(self.rd) - initialBytesIn;
                  sfr.bytesOut := sfr.bytesOut +
		    StreamWr.ByteCount(self.wr) - initialBytesOut;
                END;
	      END;
	    END;
	  END;
	END;
	ts := self.proto.getCmd(self.rd);
	ts.getLiteral(".");
	self.proto.putCmd(self.wr, ".");
	Wr.Flush(self.wr);
      FINALLY
	IF self.reaper # NIL THEN
	  Reaper.Dying(self.reaper);
	END;
      END;
    EXCEPT
    | CVTree.Error(msg) =>
      RETURN msg;
    | Error(msg) =>
      RETURN msg;
    | Rd.EndOfFile =>
      RETURN "Premature EOF from client";
    | Rd.Failure(list) =>
      RETURN "Network read failure: " & ErrMsg.StrError(list);
    | Thread.Alerted =>
      RETURN "Interrupted";
    | TokScan.Error(msg) =>
      RETURN "TreeComp protocol error: " & msg;
    | Wr.Failure(list) =>
      RETURN "Network write failure: " & ErrMsg.StrError(list);
    END;
    RETURN NIL;
  END Apply;

PROCEDURE CompCollection(self: T; sfr: SupFileRec.T)
  RAISES {CVTree.Error, Error, Rd.EndOfFile, Rd.Failure, Thread.Alerted,
	  TokScan.Error, Wr.Failure} =
  VAR
    compress: BOOLEAN;
    merger: Merger;
  BEGIN
    sfr.scanTime := Time.Now();

    self.proto.putCmd(self.wr, "COLL",
      sfr.collection,
      sfr.release,
      TokScan.EncodeTime(sfr.scanTime));
    Wr.Flush(self.wr);

    compress := SupFileRec.Option.Compress IN sfr.options;

    IF compress THEN
      TRY
	self.rd := NEW(GzipRd.T).init(self.wireRd, closeChild := FALSE);
      EXCEPT OSError.E(list) =>
	RAISE Error("Cannot create Gzip reader: " & ErrMsg.StrError(list));
      END;
    END;
    TRY
      IF compress THEN
	TRY
	  self.wr := NEW(GzipWr.T).init(self.wireWr, level := self.compLevel,
	    closeChild := FALSE);
	EXCEPT OSError.E(list) =>
	  RAISE Error("Cannot create Gzip writer: " & ErrMsg.StrError(list));
	END;
      END;
      TRY
	merger := NEW(Merger).init(self, sfr);
	TRY
	  IF SupFileRec.Option.CheckoutMode IN sfr.options THEN
	    CompCheckoutMode(self, sfr, merger);
	  ELSE
	    CompCVSMode(self, sfr, merger);
	  END;
	FINALLY
	  merger.close();
	END;

	self.proto.putCmd(self.wr, ".");
	Wr.Flush(self.wr);

	IF compress THEN
	  Wr.Close(self.wr);
	  IF NOT Rd.EOF(self.rd) THEN
	    RAISE TokScan.Error(
	      "Expected EOF from compressed stream, didn't get it");
	  END;
	  Rd.Close(self.rd);
	END;
      FINALLY
	IF compress THEN
	  GzipWr.Cleanup(self.wr);
	  self.wr := self.wireWr;
	END;
      END;
    FINALLY
      IF compress THEN
	GzipRd.Cleanup(self.rd);
	self.rd := self.wireRd;
      END;
    END;
  END CompCollection;

PROCEDURE CompCVSMode(self: T; sfr: SupFileRec.T; merger: Merger)
  RAISES {Error, Rd.EndOfFile, Rd.Failure, Thread.Alerted,
	  TokScan.Error, Wr.Failure} =
  CONST myName = "CompCVSMode: ";
  VAR
    linkTbl: LinkTbl.T := NIL;
    clientFile, serverFile: FileInfo.T;
  BEGIN
    Trace(self, myName, " ", sfr.collection);
    IF self.proto.v.hasHardLinks THEN
      linkTbl := NEW(LinkTbl.Default).init();
    END;

    WHILE GetNext(merger, clientFile, serverFile) DO
      IF clientFile = NIL THEN  (* Add file on client. *)
	IF NOT SupFileRec.Option.DoDeletesOnly IN sfr.options THEN
	  CASE serverFile.type OF
	  | FileInfo.Type.DirDown =>  (* Create directory. *)
              Trace(self, myName, " Create directory ", serverFile.name);
	      self.proto.putCmd(self.wr, "I", serverFile.name);
	  | FileInfo.Type.DirUp =>  (* Set directory attributes. *)
              Trace(self, myName, " Set directory attributes ",
                serverFile.name);
	      self.proto.putCmd(self.wr, "J",
		serverFile.name,
		EncodeAttr(self, sfr, serverFile.attr));
	  | FileInfo.Type.Live, FileInfo.Type.Dead =>
	      (* Create the file if it doesn't already exist with the proper
		 attributes. *)
	      VAR
		cmd := "T";
		sendAttr := serverFile.attr;
	      BEGIN
                Trace(self, myName, " Create file with proper attributes ",
                  serverFile.name);
		IF serverFile.type = FileInfo.Type.Dead THEN cmd := "t" END;
		(* If it is an RCS file, and we are using "loose"
		   equality for RCS files, then the sizes may
		   disagree because of harmless differences in
		   white space. *)
		IF SupMisc.IsRCS(serverFile.name)
		AND NOT SupFileRec.Option.NoRCS IN sfr.options
		AND NOT SupFileRec.Option.StrictCheckRCS IN sfr.options
		AND self.proto.v.hasLooseRCSCheck THEN
		  sendAttr := FileAttr.MaskOut(sendAttr,
		    FileAttr.AttrTypes{ FileAttr.AttrType.Size });
		END;
		IF NOT HardLink(self, linkTbl, serverFile) THEN
		  self.proto.putCmd(self.wr, cmd,
		    serverFile.name,
		    EncodeAttr(self, sfr, sendAttr));
		END;
	      END;
	  END;
	END;
      ELSIF serverFile = NIL THEN  (* Delete file on client. *)
	CASE clientFile.type OF
	| FileInfo.Type.DirDown =>  (* Remove listfile entry for directory. *)
            Trace(self, myName, " Remove listfile entry for directory ",
              clientFile.name);
	    self.proto.putCmd(self.wr, "i", clientFile.name);
	| FileInfo.Type.DirUp =>  (* Remove directory. *)
            Trace(self, myName, " Remove directory ", clientFile.name);
	    self.proto.putCmd(self.wr, "j", clientFile.name);
	| FileInfo.Type.Live, FileInfo.Type.Dead =>  (* Delete file. *)
            Trace(self, myName, " Delete file ", clientFile.name);
	    self.proto.putCmd(self.wr, "D", clientFile.name);
	END;
      ELSE  (* File exists on both the server and the client. *)
	IF NOT SupFileRec.Option.DoDeletesOnly IN sfr.options THEN
	  CASE serverFile.type OF
	  | FileInfo.Type.DirDown =>
	      IF clientFile.type # FileInfo.Type.DirDown THEN
		<* ASSERT clientFile.type # FileInfo.Type.DirUp *>
		ReplaceFileWithDirectory(self,
		  clientFile := clientFile,
		  serverDir := serverFile);
	      END;
	      (* Otherwise, do nothing at this point.  The work will be done
		 when we reach the DirUp. *)
	  | FileInfo.Type.DirUp =>
	      <* ASSERT clientFile.type = FileInfo.Type.DirUp *>
	      IF NOT FileAttr.Equal(clientFile.attr,
		FileAttr.Umask(serverFile.attr, sfr.umask))
	      THEN
		(* Set directory attributes. *)
               Trace(self, myName, " Set directory attributes ",
                 serverFile.name);
		self.proto.putCmd(self.wr, "J",
		  serverFile.name,
		  EncodeAttr(self, sfr, serverFile.attr));
	      END;
	  | FileInfo.Type.Live, FileInfo.Type.Dead =>
	      IF clientFile.type = FileInfo.Type.DirDown THEN
		ReplaceDirectoryWithFile(self, merger,
		  clientDir := clientFile,
		  serverFile := serverFile);
	      ELSE
		<* ASSERT clientFile.type # FileInfo.Type.DirUp *>
		IF NOT HardLink(self, linkTbl, serverFile) THEN
		  IF NOT FileAttr.Equal(clientFile.attr,
		    FileAttr.Umask(serverFile.attr, sfr.umask))
		  OR clientFile.type # serverFile.type
                  OR SupFileRec.Option.DetailAllRCSFiles IN sfr.options AND
                     SupMisc.IsRCS(serverFile.name) THEN
		    (* FIXME - check for BogusModTime? *)
                    IF self.clientClass.collectionIsPartiallyHidden(
		      sfr.collection)
		    THEN
                      Trace(self, myName, 
                        " Update partially hidden file (fix) ",
                        serverFile.name);
                    ELSE
                      Trace(self, myName, " Update file (fix) ",
                        serverFile.name);
                    END;
                    self.proto.putCmd(self.wr, "U", serverFile.name);
		  END;
		END;
	      END;
	  END;
	END;
      END;
      Wr.Flush(self.wr);
    END;
  END CompCVSMode;

PROCEDURE ReplaceDirectoryWithFile(self: T;
				   merger: Merger;
				   clientDir: FileInfo.T;
				   serverFile: FileInfo.T)
  RAISES {Error, Rd.EndOfFile, Rd.Failure, Thread.Alerted,
	  TokScan.Error, Wr.Failure} =
  CONST myName = "ReplaceDirectoryWithFile: ";
  VAR
    cf, sf: FileInfo.T;
    depth: CARDINAL;
  BEGIN
    Trace(self, myName, " ", clientDir.name, " ", serverFile.name);
    (* Remove the entire directory tree on the client. *)
    (* FIXME - Make the client remove empty Attic directories automatically. *)
    cf := clientDir;
    sf := NIL;
    depth := 0;
    REPEAT
      (* We should get only client files from the merger until we have
	 consumed the entire directory tree. *)
      <* ASSERT sf = NIL *>
      CASE cf.type OF
      | FileInfo.Type.DirDown =>  (* Remove listfile entry. *)
          Trace(self, myName, " Remove listfile entry ", cf.name);
	  self.proto.putCmd(self.wr, "i", cf.name);
	  INC(depth);
      | FileInfo.Type.DirUp =>  (* Remove directory. *)
          Trace(self, myName, " Remove directory ", cf.name);
	  self.proto.putCmd(self.wr, "j", cf.name);
	  DEC(depth);
      | FileInfo.Type.Live, FileInfo.Type.Dead =>  (* Delete file. *)
          Trace(self, myName, " Delete file ", cf.name);
	  self.proto.putCmd(self.wr, "D", cf.name);
      END;
    UNTIL depth = 0 OR NOT GetNext(merger, cf, sf);

    IF depth # 0 THEN
      RAISE Error("Unmatched DirDown from client");
    END;

    (* Add the file. *)
    Trace(self, myName, " Update file ", serverFile.name);
    self.proto.putCmd(self.wr, "U", serverFile.name);
  END ReplaceDirectoryWithFile;

PROCEDURE ReplaceFileWithDirectory(self: T;
				   clientFile: FileInfo.T;
				   serverDir: FileInfo.T)
  RAISES {Thread.Alerted, Wr.Failure} =
  CONST myName = "ReplaceFileWithDirectory: ";
  BEGIN
    Trace(self, myName, " ", clientFile.name, " ", serverDir.name);
    (* Delete the file, then create the directory. *)
    self.proto.putCmd(self.wr, "D", clientFile.name);
    self.proto.putCmd(self.wr, "I", serverDir.name);
  END ReplaceFileWithDirectory;

PROCEDURE CompCheckoutMode(self: T;
                           sfr: SupFileRec.T;
			   merger: Merger)
  RAISES {Rd.EndOfFile, Rd.Failure, Thread.Alerted, TokScan.Error,
          Wr.Failure} =
  CONST myName = "CompCheckoutMode: ";
  VAR
    clientFile, serverFile: FileInfo.T;
  BEGIN
    Trace(self, myName, sfr.collection);
    <* ASSERT self.clientClass.inAllowedCollections(sfr.collection) *>
    <* ASSERT NOT
       self.clientClass.collectionIsPartiallyHidden(sfr.collection) *>
    WHILE GetNext(merger, clientFile, serverFile) DO
      IF clientFile = NIL THEN  (* Add file on client. *)
	IF NOT FileInfo.IsDir(serverFile) THEN
          Trace(self, myName, " Update file (add) ", serverFile.name);
	  self.proto.putCmd(self.wr, "U", serverFile.name);
	END;
      ELSIF serverFile = NIL THEN  (* Delete file on client. *)
	IF NOT FileInfo.IsDir(clientFile) THEN
          Trace(self, myName, " Delete file ", clientFile.name);
	  self.proto.putCmd(self.wr, "D", clientFile.name);
	END;
      ELSE  (* File exists on both the server and the client. *)
	(* Note, the client records the exact attributes of the
           server's RCS file in checkout mode, unmodified by the
           client's umask.  So we need not do anything with the umask
           on this end. *)
	IF NOT FileInfo.IsDir(serverFile)
	AND NOT FileAttr.Equal(clientFile.attr, serverFile.attr)
	THEN
	  (* FIXME - check for BogusModTime? *)
          Trace(self, myName, " Update file (fix)");
	  self.proto.putCmd(self.wr, "U", serverFile.name);
	END;
      END;
      Wr.Flush(self.wr);
    END;
  END CompCheckoutMode;

PROCEDURE HardLink(self: T;
		   linkTbl: LinkTbl.T;
                   fi: FileInfo.T): BOOLEAN
  RAISES {Thread.Alerted, Wr.Failure} =
(* If there is a known hard link to the given file, emits a link command
   and returns "TRUE".  Otherwise, returns "FALSE". *)
  VAR
    linkTo: Pathname.T;
    cmd: TEXT;
  BEGIN
    IF linkTbl # NIL AND NOT FileInfo.IsDir(fi)
    AND FileAttr.AttrType.LinkCount IN FileAttr.GetMask(fi.attr)
    AND FileAttr.GetLinkCount(fi.attr) > 1 THEN
      WITH id = FileID.FromAttr(fi.attr) DO
	IF id # NIL THEN
	  IF linkTbl.get(id, linkTo) THEN
	    IF fi.type = FileInfo.Type.Live THEN cmd := "H" ELSE cmd := "h" END;
	    self.proto.putCmd(self.wr, cmd, fi.name, linkTo);
	    RETURN TRUE;
	  END;
	  EVAL linkTbl.put(id, fi.name);
	END;
      END;
    END;
    RETURN FALSE;
  END HardLink;

PROCEDURE DecodeAttr(<*UNUSED*> self: T; t: TEXT): FileAttr.T
  RAISES {TokScan.Error} =
  BEGIN
    LOOP
      TRY
	RETURN FileAttr.Decode(t);
      EXCEPT FileAttr.UnknownGroup, FileAttr.UnknownOwner =>
	(* Ignore unknown attributes from the client. *)
      END;
    END;
  END DecodeAttr;

PROCEDURE EncodeAttr(self: T;
                      sfr: SupFileRec.T;
		      attr: FileAttr.T): TEXT =
  BEGIN
    IF self.proto.v.hasFileAttrs THEN
      RETURN FileAttr.Encode(attr,
	support := self.proto.v.attrSupport,
	ignore := sfr.attrIgnore);
    ELSE
      RETURN TokScan.EncodeTime(FileAttr.GetModTime(attr));
    END;
  END EncodeAttr;

PROCEDURE GetNext(m: Merger;
                  VAR clientFile, serverFile: FileInfo.T): BOOLEAN
  RAISES {Rd.EndOfFile, Rd.Failure, Thread.Alerted, TokScan.Error} =
(* This is a wrapper around "Merger.next()", to correct its "RAISES"
   clause.  This procedure should raise the union of the exceptions
   raised by "GetFromClient" and "GetFromServer". *)
  <* FATAL ANY *>
  BEGIN
    RETURN m.next(clientFile, serverFile);
  END GetNext;

PROCEDURE Init(self: T;
               proto: CVProto.T;
	       rd: StreamRd.T;
	       wr: StreamWr.T;
               collections: SupFileRecSeq.T;
               clientClass: ClientClass.T;
	       compLevel: [-1..9] := -1;
	       reaper: Reaper.T := NIL;
	       logger: Logger.T := NIL): T =
  BEGIN
    self.proto := proto;
    self.wireRd := rd;
    self.rd := rd;  (* Start out uncompressed. *)
    self.wireWr := wr;
    self.wr := wr;  (* Start out uncompressed. *)
    self.collections := collections;
    self.clientClass := clientClass;
    IF compLevel = -1 THEN compLevel := SupMisc.DefaultCompression END;
    self.compLevel := compLevel;
    self.reaper := reaper;
    self.logger := logger;
    RETURN self;
  END Init;

(*****************************************************************************)

TYPE
  Merger = FileInfoMerger.T OBJECT
    treeComp: T;
    rd: Rd.T;
    sfr: SupFileRec.T;
    iter: CVTree.Iterator;
    serverPruning: BOOLEAN;
    clientDecomp: PathComp.Decompressor;
  METHODS
    init(self: T; sfr: SupFileRec.T): Merger
      RAISES {CVTree.Error, Thread.Alerted} := MergerInit;
    close()
      RAISES {CVTree.Error, Thread.Alerted} := MergerClose;
  OVERRIDES
    getA := GetFromClient;
    getB := GetFromServer;
  END;

PROCEDURE MergerInit(m: Merger;
                     self: T;
		     sfr: SupFileRec.T): Merger
  RAISES {CVTree.Error, Thread.Alerted} =
  BEGIN
    m.treeComp := self;
    m.rd := self.rd;
    m.sfr := sfr;
    m.iter := NIL;
    IF sfr.serverScanFile # NIL THEN  (* Use the scan file. *)
      TRY
	m.iter := NEW(FSIter).init(sfr.serverScanFile);
      EXCEPT CVTree.Error => (* Ignore. *) END;
    END;
    IF m.iter = NIL THEN  (* Do a full tree walk. *)
      m.iter := CVTree.Iterate(
	root := sfr.serverPrefix,
	follow := GlobTree.Not(sfr.symlink));
    END;
    m.serverPruning := FALSE;
    m.clientDecomp := NEW(PathComp.Decompressor).init();
    RETURN m;
  END MergerInit;

PROCEDURE MergerClose(m: Merger)
  RAISES {CVTree.Error, Thread.Alerted} =
  BEGIN
    m.iter.close();
  END MergerClose;

PROCEDURE GetFromClient(m: Merger): FileInfo.T
  RAISES {Rd.EndOfFile, Rd.Failure, Thread.Alerted, TokScan.Error} =
(* If you add any exceptions, add them to "GetNext" also. *)
  VAR
    ts: TokScan.T;
    cmd: TEXT;
    name: TEXT;
    attr: FileAttr.T;
    cmdCh: CHAR;
    type: FileInfo.Type;
  BEGIN
    LOOP
      ts := m.treeComp.proto.getCmd(m.rd);
      cmdCh := ts.getChar("command");
      cmd := Text.FromChar(cmdCh);
      CASE cmdCh OF
      | '.' =>
	  EXIT;
      | 'D' =>  (* Down into directory. *)
	  name := ts.getToken("directory name");
	  ts.getEnd("end of \"" & cmd & "\" command");
	  WITH path = m.clientDecomp.put(PathComp.Type.DirDown, name) DO
	    IF m.treeComp.proto.v.dirsAreExplicit
	    AND NOT SupFileRec.Option.CheckoutMode IN m.sfr.options THEN
	      RETURN NEW(FileInfo.T,
		name := path,
		attr := NIL,
		type := FileInfo.Type.DirDown);
	    END;
	  END;
      | 'F', 'f' =>  (* Live file, dead file. *)
	  IF cmdCh = 'F' THEN
	    type := FileInfo.Type.Live;
	  ELSE 
	    type := FileInfo.Type.Dead;
	  END;
	  name := ts.getToken("file name");
	  IF m.treeComp.proto.v.hasFileAttrs THEN
	    attr := DecodeAttr(m.treeComp, ts.getToken("attributes"));
	  ELSE
	    attr := NEW(FileAttr.T).init(FileAttr.FileType.File,
	      modTime := ts.getTime("modTime"));
	  END;
	  ts.getEnd("end of \"" & cmd & "\" command");
	  WITH path = m.clientDecomp.put(PathComp.Type.File, name) DO
	    RETURN NEW(FileInfo.T,
	      name := path,
	      attr := attr,
	      type := type);
	  END;
      | 'U' =>  (* Up out of directory. *)
	  IF m.treeComp.proto.v.dirsAreExplicit THEN
	    attr := DecodeAttr(m.treeComp, ts.getToken("attributes"));
	  END;
	  ts.getEnd("end of \"" & cmd & "\" command");
	  WITH path = m.clientDecomp.put(PathComp.Type.DirUp, NIL) DO
	    IF m.treeComp.proto.v.dirsAreExplicit
	    AND NOT SupFileRec.Option.CheckoutMode IN m.sfr.options THEN
	      RETURN NEW(FileInfo.T,
		name := path,
		attr := attr,
		type := FileInfo.Type.DirUp);
	    END;
	  END;
      ELSE
	RAISE TokScan.Error("Invalid command \"" & cmd & "\"");
      END;
    END;
    RETURN NIL;
  END GetFromClient;

PROCEDURE GetFromServer(m: Merger): FileInfo.T
  RAISES {Thread.Alerted} =
(* If you add any exceptions, add them to "GetNext" also. *)
  VAR
    type: CVTree.FileType;
    path: Pathname.T;
    attr: FileAttr.T;
    listIt: BOOLEAN;
  BEGIN
    LOOP
      TRY
	IF NOT m.iter.next(type, path, attr) THEN EXIT END;
	CASE type OF
	| CVTree.FileType.DirDown =>
	    IF m.sfr.dirFilter.test(path) THEN
	      IF m.treeComp.proto.v.dirsAreExplicit
	      AND NOT SupFileRec.Option.CheckoutMode IN m.sfr.options THEN
		RETURN NEW(FileInfo.T,
		  name := path,
		  attr := attr,
		  type := FileInfo.Type.DirDown);
	      END;
	    ELSE
	      m.iter.prune();
	      m.serverPruning := TRUE;
	    END;
	| CVTree.FileType.File =>
	    IF SupFileRec.Option.CheckoutMode IN m.sfr.options THEN
	      (* List RCS files only. *)
	      listIt := attr.fileType = FileAttr.FileType.File
		AND SupMisc.IsRCS(path);
	    ELSE
	      (* List everything that is supported by the protocol.  Ignore
		 the unsupported file types. *)
	      listIt := FileAttr.AttrType.FileType IN
		m.treeComp.proto.v.attrSupport[attr.fileType];
	    END;
	    IF listIt AND m.sfr.fileFilter.test(path) THEN
	      RETURN NEW(FileInfo.T,
		name := path,
		attr := attr,
		type := FileInfo.Type.Live);
	    END;
	| CVTree.FileType.AtticFile =>
	    IF attr.fileType = FileAttr.FileType.File
	    AND SupMisc.IsRCS(path) THEN
	      IF m.sfr.fileFilter.test(path) THEN
		RETURN NEW(FileInfo.T,
		  name := path,
		  attr := attr,
		  type := FileInfo.Type.Dead);
	      END;
	    ELSE  (* Non-RCS file in the Attic?! *)
	      WITH fullPath = SupMisc.CatPath(m.sfr.serverPrefix,
		SupMisc.AtticName(path))
	      DO
		Warning(m.treeComp,
		  "Non-RCS file \"" & fullPath & "\" in Attic");
	      END;
	    END;
	| CVTree.FileType.DirUp =>
	    IF NOT m.serverPruning THEN
	      IF m.treeComp.proto.v.dirsAreExplicit
	      AND NOT SupFileRec.Option.CheckoutMode IN m.sfr.options THEN
		RETURN NEW(FileInfo.T,
		  name := path,
		  attr := attr,
		  type := FileInfo.Type.DirUp);
	      END;
	    ELSE
	      m.serverPruning := FALSE;
	    END;
	END;
      EXCEPT CVTree.Error(msg) =>
	Warning(m.treeComp, msg);
      END;
    END;
    RETURN NIL;
  END GetFromServer;

(*****************************************************************************)

TYPE
  FSIter = CVTree.Iterator OBJECT
    path: Pathname.T;
    fsrd: FileStatus.Reader;
    pruning := FALSE;
  METHODS
    init(path: Pathname.T): FSIter
      RAISES {CVTree.Error, Thread.Alerted} := FSIterInit;
  OVERRIDES
    next := FSIterNext;
    prune := FSIterPrune;
    close := FSIterClose;
  END;

PROCEDURE FSIterClose(self: FSIter)
  RAISES {CVTree.Error, Thread.Alerted} =
  BEGIN
    TRY
      self.fsrd.close();
    EXCEPT Rd.Failure(l) =>
      RAISE CVTree.Error("Read failure on \"" & self.path & "\": "
	& ErrMsg.StrError(l));
    END;
  END FSIterClose;

PROCEDURE FSIterInit(self: FSIter; path: Pathname.T): FSIter
  RAISES {CVTree.Error, Thread.Alerted} =
  VAR
    rd: Rd.T;
  BEGIN
    TRY
      self.path := path;
      rd := FileRd.Open(self.path);
      self.fsrd := NIL;
      TRY
	TRY
	  self.fsrd := FileStatus.FromRd(rd);
	  IF self.fsrd.version() < 5 THEN  (* Too old. *)
	    self.fsrd.close();
	    RAISE CVTree.Error("Scan file \"" & self.path
	      & "\" format is too old");
	  END;
	  RETURN self;
	EXCEPT
	| FileStatus.Error(msg) =>
	    RAISE CVTree.Error("Error in \"" & self.path & "\": " & msg);
	| Rd.Failure(l) =>
	    RAISE CVTree.Error("Read failure on \"" & self.path & "\": "
	      & ErrMsg.StrError(l));
	END;
      FINALLY
	IF self.fsrd = NIL THEN
	  TRY Rd.Close(rd) EXCEPT ELSE END;
	END;
      END;
    EXCEPT
    | OSError.E(l) =>
	RAISE CVTree.Error("Cannot open \"" & self.path & "\": "
	  & ErrMsg.StrError(l));
    END;
  END FSIterInit;

PROCEDURE FSIterNext(self: FSIter;
                     VAR type: CVTree.FileType;
                     VAR name: Pathname.T;
		     VAR attr: FileAttr.T): BOOLEAN
  RAISES {CVTree.Error, Thread.Alerted} =
  VAR
    fs: FileStatus.T;
  BEGIN
    TRY
      IF self.pruning THEN
	self.pruning := FALSE;
	fs := self.fsrd.prune();
      ELSE
	fs := self.fsrd.get();
      END;

      name := fs.name;
      attr := fs.clientAttr;
      CASE fs.type OF
      | FileStatus.Type.DirDown =>
	  type := CVTree.FileType.DirDown;
      | FileStatus.Type.DirUp =>
	  type := CVTree.FileType.DirUp;
      | FileStatus.Type.FileLive =>
	  type := CVTree.FileType.File;
      | FileStatus.Type.FileDead =>
	  type := CVTree.FileType.AtticFile;
      | FileStatus.Type.CheckoutLive, FileStatus.Type.CheckoutDead =>
	  RAISE CVTree.Error("Invalid checkout-mode scan file \""
	    & self.path & "\"");
      END;
      RETURN TRUE;
    EXCEPT
    | FileStatus.Error(msg) =>
	RAISE CVTree.Error("Error in \"" & self.path & "\": "
	  & msg);
    | Rd.EndOfFile =>
	RETURN FALSE;
    | Rd.Failure(l) =>
	RAISE CVTree.Error("Read error on \"" & self.path & "\": "
	  & ErrMsg.StrError(l));
    END;
  END FSIterNext;

PROCEDURE FSIterPrune(self: FSIter) =
  BEGIN
    self.pruning := TRUE;
  END FSIterPrune;

(*****************************************************************************)

PROCEDURE Warning(self: T; msg: TEXT) =
(* Logs a warning message. *)
  BEGIN
    IF self.logger # NIL THEN
      Logger.Put(self.logger, Logger.Priority.Warning, msg);
    END;
  END Warning;

PROCEDURE Trace(self: T; m1, m2, m3, m4, m5, m6, m7, m8: TEXT := NIL;
                level := 1) =
(* Logs a trace message. *)
  BEGIN
    IF traceLevel >= level THEN
      VAR 
        msg := "";
      BEGIN
        IF m1 # NIL THEN msg := msg & m1 END;
        IF m2 # NIL THEN msg := msg & m2 END;
        IF m3 # NIL THEN msg := msg & m3 END;
        IF m4 # NIL THEN msg := msg & m4 END;
        IF m5 # NIL THEN msg := msg & m5 END;
        IF m6 # NIL THEN msg := msg & m6 END;
        IF m7 # NIL THEN msg := msg & m7 END;
        IF m8 # NIL THEN msg := msg & m8 END;
        IF self.logger # NIL THEN
          Logger.Debug(self.logger, msg);
        ELSE
          IO.Put("logger = NIL: " & msg & "\n");
        END;
      END;
    END;
  END Trace;

BEGIN
END TreeComp.