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: TreeList.m3.html,v 1.3 2010-04-29 17:17:58 wagner Exp $
MODULE TreeList;
IMPORT
Attic, CVProto, ErrMsg, FileAttr, FileAttrSeq, FileRd, FileStatus,
GzipWr, Logger, OSError, OSErrorPosix, Pathname, Rd, Reaper,
StreamWr, SupFileRec, SupFileRecSeq, SupMisc, Text, Thread, TokScan,
Uerror, Wr;
EXCEPTION Error(TEXT);
REVEAL
T = Public BRANDED OBJECT
proto: CVProto.T;
wireWr: StreamWr.T; (* Raw writer. *)
wr: StreamWr.T; (* Currently active writer. *)
collections: SupFileRecSeq.T;
compLevel: [0..9];
reaper: Reaper.T;
stats: Stats;
trace: Logger.T;
OVERRIDES
apply := Apply;
init := Init;
END;
PROCEDURE Apply(self: T): REFANY =
BEGIN
TRY
TRY
IF self.stats # NIL THEN
self.stats.start();
END;
FOR i := 0 TO self.collections.size()-1 DO
ListCollection(self, self.collections.get(i));
END;
Trace(self, "");
self.proto.putCmd(self.wr, ".");
Wr.Flush(self.wr);
FINALLY
IF self.reaper # NIL THEN
Reaper.Dying(self.reaper);
END;
IF self.stats # NIL THEN
self.stats.finish();
END;
END;
RETURN NEW(SupMisc.ThreadStatus,
status := SupMisc.ExitCode.Success, message := NIL);
EXCEPT
| Error(msg) =>
RETURN NEW(SupMisc.ThreadStatus,
status := SupMisc.ExitCode.Failure,
message := "TreeList failed: " & msg);
| Thread.Alerted =>
RETURN NEW(SupMisc.ThreadStatus,
status := SupMisc.ExitCode.Failure,
message := "TreeList failed: Interrupted");
| Wr.Failure(list) =>
RETURN NEW(SupMisc.ThreadStatus,
status := SupMisc.ExitCode.TransientFailure,
message := "TreeList failed: Network write failure: "
& ErrMsg.StrError(list));
END;
END Apply;
PROCEDURE Init(self: T;
proto: CVProto.T;
wr: StreamWr.T;
collections: SupFileRecSeq.T;
compLevel: [-1..9] := -1;
reaper: Reaper.T := NIL;
stats: Stats := NIL;
trace: Logger.T := NIL): T =
BEGIN
self.proto := proto;
self.wireWr := wr;
self.wr := wr;
self.collections := collections;
IF compLevel = -1 THEN compLevel := SupMisc.DefaultCompression END;
self.compLevel := compLevel;
self.reaper := reaper;
self.stats := stats;
self.trace := trace;
RETURN self;
END Init;
PROCEDURE ListCollection(self: T;
sfr: SupFileRec.T)
RAISES {Error, Thread.Alerted, Wr.Failure} =
BEGIN
IF NOT SupFileRec.Option.Skip IN sfr.options THEN
self.proto.putCmd(self.wr, "COLL", sfr.collection, sfr.release);
Wr.Flush(self.wr);
IF SupFileRec.Option.Compress IN sfr.options 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
PutCollectionList(self, sfr);
self.proto.putCmd(self.wr, ".");
Wr.Flush(self.wr);
IF SupFileRec.Option.Compress IN sfr.options THEN
Wr.Close(self.wr);
END;
FINALLY
IF SupFileRec.Option.Compress IN sfr.options THEN
GzipWr.Cleanup(self.wr);
self.wr := self.wireWr;
END;
END;
END;
END ListCollection;
***************************************************************************
Listing a collection.
***************************************************************************
PROCEDURE PutCollectionList(self: T;
sfr: SupFileRec.T)
RAISES {Error, Thread.Alerted, Wr.Failure} =
VAR
sfPath := SupMisc.CatPath(
SupMisc.ResolvePath(sfr.clientBase, sfr.clientCollDir),
SupMisc.CatPath(sfr.collection, SupMisc.StatusFileName(sfr)));
sfReader: FileStatus.Reader;
fs: FileStatus.T;
attr: FileAttr.T;
sendCmd: TEXT;
sendName: Pathname.T;
sendAttr: FileAttr.T;
needToFlush: BOOLEAN;
path, origPath: Pathname.T;
attrStack := NEW(FileAttrSeq.T).init(30); (* Per directory level. *)
depth: CARDINAL := 0;
pruneDepth: CARDINAL := LAST(CARDINAL);
protoOffset, wireOffset: LONGREAL;
BEGIN
TRY
TRY
sfReader := FileStatus.FromRd(FileRd.Open(sfPath));
EXCEPT OSError.E => (* Just use an empty source. *)
sfReader := FileStatus.FromNull();
END;
TRY
depth := 0;
pruneDepth := LAST(CARDINAL);
IF self.stats # NIL THEN
LOCK self.stats DO
protoOffset := StreamWr.ByteCount(self.wr) - self.stats.bytesOut;
wireOffset :=
StreamWr.ByteCount(self.wireWr) - self.stats.wireBytesOut;
END;
END;
LOOP
TRY fs := sfReader.get() EXCEPT Rd.EndOfFile => EXIT END;
sendCmd := NIL;
sendName := NIL;
sendAttr := NIL;
needToFlush := FALSE;
CASE fs.type OF
| FileStatus.Type.DirDown =>
INC(depth);
IF depth < pruneDepth THEN (* Not currently pruning. *)
IF sfr.dirFilter.test(fs.name) THEN
path := SupMisc.CatPath(sfr.clientPrefix, fs.name);
TRY
(* We don't send the directory attributes on the way
down the tree. When descending, existence is all
that matters. Nevertheless, on the way down is
the time to check the attributes, in case the
directory doesn't exist. *)
IF SupFileRec.Option.TrustStatusFile IN sfr.options THEN
attr := NEW(FileAttr.T).init(FileAttr.FileType.Directory);
ELSE
attr := FileAttr.FromPathname(path, follow := FALSE);
END;
IF attr.fileType = FileAttr.FileType.SymLink THEN
(* It is recorded as a directory, but it is
really a symlink. Check for the case in
which it is a symlink pointing to a
directory. In that case, follow
the link. Older versions of the client
followed such links, and we don't want to
replace the symlink with a new copy of
the entire subtree. That might fill up
the wrong filesystem. *)
TRY
WITH fa = FileAttr.FromPathname(path, follow := TRUE) DO
IF fa.fileType = FileAttr.FileType.Directory THEN
attr := fa; (* Follow link to the directory. *)
IF NOT SupFileRec.Option.CheckoutMode IN sfr.options
THEN
Warn(self, "\"" & fs.name & "\" should be a"
& " directory, but is a symlink to a directory"
& " -- check your prefix setting");
END;
END;
END;
EXCEPT OSError.E => (* Link to nowhere. *) END;
END;
IF attr.fileType = FileAttr.FileType.Directory THEN
(* It really is a directory. *)
attrStack.addhi(attr); (* Save attributes for later. *)
IF depth <= 3 THEN Trace(self, fs.name) END;
sendCmd := "D";
sendName := fs.name;
ELSE (* It is not really a directory. *)
pruneDepth := depth; (* Start pruning. *)
(* Report it as something bogus so that it will be
replaced. *)
sendCmd := "F";
sendName := fs.name;
sendAttr := FileAttr.Bogus;
END;
EXCEPT OSError.E =>
(* The directory doesn't exist. Prune everything
below it. *)
pruneDepth := depth;
END;
ELSE (* Start pruning. *)
pruneDepth := depth;
END;
END;
| FileStatus.Type.DirUp =>
IF depth < pruneDepth THEN (* Not currently pruning. *)
needToFlush := TRUE; (* FIXME - Be smarter. *)
sendCmd := "U";
IF SupFileRec.Option.TrustStatusFile IN sfr.options THEN
EVAL attrStack.remhi();
attr := fs.clientAttr;
ELSE
attr := attrStack.remhi();
END;
IF self.proto.v.dirsAreExplicit THEN
IF FileAttr.Equal(attr, fs.clientAttr) THEN
sendAttr := attr;
ELSE (* Force the attributes to be updated. *)
sendAttr := FileAttr.Bogus;
END;
END;
IF self.stats # NIL THEN (* Update the statistics. *)
LOCK self.stats DO
self.stats.bytesOut :=
StreamWr.ByteCount(self.wr) - protoOffset;
self.stats.wireBytesOut :=
StreamWr.ByteCount(self.wireWr) - wireOffset;
END;
self.stats.update();
END;
ELSIF depth = pruneDepth THEN (* Finished pruning. *)
pruneDepth := LAST(CARDINAL);
END;
DEC(depth);
| FileStatus.Type.CheckoutLive =>
IF depth < pruneDepth THEN (* Not currently pruning. *)
IF SupFileRec.Option.CheckoutMode IN sfr.options
AND sfr.fileFilter.test(fs.name) THEN
path := SupMisc.CatPath(sfr.clientPrefix,
SupMisc.CheckoutName(fs.name));
TRY
sendCmd := "F";
sendName := fs.name;
IF SupFileRec.Option.TrustStatusFile IN sfr.options THEN
attr := fs.clientAttr;
ELSE
attr := FileAttr.FromPathname(path, follow := FALSE);
END;
IF FileAttr.Equal(attr, fs.clientAttr)
AND FileAttr.Equal(attr,
FileAttr.ForCheckout(fs.serverAttr, sfr.umask))
AND Text.Equal(sfr.checkoutTag, fs.tag)
AND Text.Equal(sfr.checkoutDate, fs.date) THEN
(* The file corresponds to the information we have
recorded about it, and its mode is correct for
the requested umask setting. *)
sendAttr := fs.serverAttr;
ELSE
(* Either the file has been touched, or we are
asking for a different revision than the one
we recorded information about, or its mode
isn't right (because it was last updated
using a version of CVSup that wasn't so
strict about modes). *)
sendAttr := FileAttr.Bogus;
END;
(* If the protocol supports preserving
checkout-mode file permissions but we don't
have any recorded information about the file,
it means that this is the user's first update
since upgrading to a CVSup version that
preserves checkout-mode permissions. For that
case, we report bogus attributes to force
the system to make sure the permissions are
correct. *)
IF self.proto.v.clientSendsUmask AND NOT
FileAttr.AttrType.Mode IN FileAttr.GetMask(fs.clientAttr)
THEN
sendAttr := FileAttr.Bogus;
END;
EXCEPT OSError.E =>
(* According to the checkouts file we should have this
file, but we don't. Maybe the user deleted the file,
or maybe the checkouts file is wrong. List the file
with bogus attributes to cause the server to get
things back in sync again. *)
sendAttr := FileAttr.Bogus;
END;
END;
END;
| FileStatus.Type.CheckoutDead =>
IF depth < pruneDepth THEN (* Not currently pruning. *)
IF SupFileRec.Option.CheckoutMode IN sfr.options
AND sfr.fileFilter.test(fs.name) THEN
path := SupMisc.CatPath(sfr.clientPrefix,
SupMisc.CheckoutName(fs.name));
TRY
IF SupFileRec.Option.TrustStatusFile IN sfr.options THEN
OSErrorPosix.Raise0(Uerror.ENOENT);
ELSE
attr := FileAttr.FromPathname(path, follow := FALSE);
(* The file exists. Make sure it is really a file,
and not a directory. If it is a directory it
doesn't correspond to this checkouts file record,
so it should be ignored. *)
IF attr.fileType = FileAttr.FileType.Directory THEN
OSErrorPosix.Raise0(Uerror.ENOENT);
END;
END;
(* We shouldn't have this file, but we do. Report it to
the server, which will either send a deletion request,
or (if the file has come alive) send the correct
version. *)
sendCmd := "F";
sendName := fs.name;
sendAttr := FileAttr.Bogus;
EXCEPT OSError.E =>
(* It is correct that we don't have this file. List
it, so that the server can determine whether it
has come alive. *)
sendCmd := "f";
sendName := fs.name;
IF Text.Equal(sfr.checkoutTag, fs.tag)
AND Text.Equal(sfr.checkoutDate, fs.date) THEN
sendAttr := fs.serverAttr;
ELSE
sendAttr := FileAttr.Bogus;
END;
END;
END;
END;
| FileStatus.Type.FileLive, FileStatus.Type.FileDead =>
IF depth < pruneDepth THEN (* Not currently pruning. *)
IF NOT SupFileRec.Option.CheckoutMode IN sfr.options THEN
path := SupMisc.CatPath(sfr.clientPrefix, fs.name);
origPath := path;
TRY
IF SupFileRec.Option.TrustStatusFile IN sfr.options THEN
attr := fs.clientAttr;
IF fs.type = FileStatus.Type.FileDead THEN
path := SupMisc.AtticName(path);
END;
ELSE
attr := Attic.FileAttrFromPathname(path, follow := FALSE);
END;
IF FileAttr.AttrType.FileType IN
self.proto.v.attrSupport[attr.fileType] THEN
(* Both the client and the server can handle this file
type, so list it to the server. *)
IF path = origPath THEN (* Live. *)
IF sfr.fileFilter.test(fs.name) THEN
sendCmd := "F";
END;
ELSE (* Dead. *)
IF sfr.fileFilter.test(SupMisc.AtticName(fs.name)) THEN
sendCmd := "f";
END;
END;
END;
IF sendCmd # NIL THEN (* We are listing this file. *)
sendName := fs.name;
IF FileAttr.Equal(attr, fs.clientAttr) THEN
(* The recorded info corresponds to the actual file.
We send the attributes from the file itself, since
they may contain more information than what we
recorded. *)
sendAttr := attr;
(* 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(fs.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;
ELSE
(* The file's attributes disagree with what we set them
to the last time we updated the file. Perhaps the
user has edited the file in the meantime. We return
a set of attributes with an impossible modTime
rather than the actual one. This forces a full
comparison to be done on the file.
We used to return the actual modtime, and that works
virtually all the time. But if by chance the user
edited the file at the precise same time that it
was modified on the server, then we would have
missed updating it. The current technique avoids
any possibility of that, at very little cost. *)
sendAttr := FileAttr.Bogus;
END;
END;
EXCEPT OSError.E =>
(* According to the checkouts file we should have this
file, but we don't. Maybe the user deleted the file,
or maybe the checkouts file is wrong. List the file
with bogus attributes to cause the server to get
things back in sync again. *)
sendCmd := "F";
sendName := fs.name;
sendAttr := FileAttr.Bogus;
END;
END;
END;
END;
IF sendCmd # NIL THEN (* List the file to the server. *)
IF Thread.TestAlert() THEN
RAISE Thread.Alerted;
END;
self.proto.putCmd(self.wr, sendCmd, more := TRUE);
IF sendName # NIL THEN
self.proto.putCmd(self.wr, NIL, SupMisc.PathLast(sendName),
more := TRUE);
END;
IF sendAttr # NIL THEN (* Send the attributes too. *)
IF self.proto.v.hasFileAttrs THEN
IF NOT self.proto.v.clientSendsUmask AND sfr.umask # 0 THEN
(* We are talking to an old server which doesn't
know how to consider the client's umask when
comparing file modes, and we are using a umask
that is not a no-op. Therefore we must not send
the file modes. If we did, the server might note
a modes mismatch but be unable to correct it --
i.e., the file would be fruitlessly "updated" every
time. *)
sendAttr := FileAttr.MaskOut(sendAttr,
FileAttr.AttrTypes{ FileAttr.AttrType.Mode });
END;
self.proto.putCmd(self.wr, NIL,
FileAttr.Encode(sendAttr,
support := self.proto.v.attrSupport,
ignore := sfr.attrIgnore),
more := TRUE);
ELSE
self.proto.putCmd(self.wr, NIL,
TokScan.EncodeTime(FileAttr.GetModTime(sendAttr)),
more := TRUE);
END;
END;
self.proto.putCmd(self.wr, NIL);
IF needToFlush THEN Wr.Flush(self.wr) END;
END;
END;
<* ASSERT depth = 0 *>
FINALLY
sfReader.close();
END;
EXCEPT
| FileStatus.Error(msg) =>
RAISE Error("Error in \"" & sfPath & "\": " & msg
& ". Delete it and try again.");
| Rd.Failure(list) =>
RAISE Error("Read failure from \"" & sfPath & "\": "
& ErrMsg.StrError(list));
END;
END PutCollectionList;
***************************************************************************
REVEAL
Stats = StatsPublic BRANDED OBJECT
OVERRIDES
init := StatsInit;
start := StatsDoNothing;
update := StatsDoNothing;
finish := StatsDoNothing;
END;
PROCEDURE StatsInit(self: Stats): Stats =
BEGIN
RETURN self;
END StatsInit;
PROCEDURE StatsDoNothing(<*UNUSED*> self: Stats) =
BEGIN
END StatsDoNothing;
***************************************************************************
PROCEDURE Warn(self: T; msg: TEXT) =
BEGIN
IF self.trace # NIL THEN
Logger.Put(self.trace, Logger.Priority.Warning, msg);
END;
END Warn;
PROCEDURE Trace(self: T; msg: TEXT) =
BEGIN
IF self.trace # NIL THEN
Logger.Put(self.trace, Logger.Priority.Info, msg);
END;
END Trace;
BEGIN
END TreeList.