Added GIT_ANNEX_VECTOR_CLOCK environment variable

Can be used to override the default timestamps used in log files in the
git-annex branch. This is a dangerous environment variable; use with
caution.

Note that this only affects writing to the logs on the git-annex branch.
It is not used for metadata in git commits (other env vars can be set for
that).

There are many other places where timestamps are still used, that don't
get committed to git, but do touch disk. Including regular timestamps
of files, and timestamps embedded in some files in .git/annex/, including
the last fsck timestamp and timestamps in transfer log files.

A good way to find such things in git-annex is to get for getPOSIXTime and
getCurrentTime, although some of the results are of course false positives
that never hit disk (unless git-annex gets swapped out..)

So this commit does NOT necessarily make git-annex comply with some HIPPA
privacy regulations; it's up to the user to determine if they can use it in
a way compliant with such regulations.

Benchmarking: It takes 0.00114 milliseconds to call getEnv
"GIT_ANNEX_VECTOR_CLOCK" when that env var is not set. So, 100 thousand log
files can be written with an added overhead of only 0.114 seconds. That
should be by far swamped by the actual overhead of writing the log files
and making the commit containing them.

This commit was supported by the NSF-funded DataLad project.

3 files changed, 23 insertions, 23 deletions

diff --git a/Command/Expire.hs b/Command/Expire.hs
index 8dd0e962e..551742304 100644
--- a/Command/Expire.hs
+++ b/Command/Expire.hs
@@ -13,6 +13,7 @@ import Logs.UUID
 import Logs.MapLog
 import Logs.Trust
 import Annex.UUID
+import Annex.VectorClock
 import qualified Remote
 import Utility.HumanTime
 
@@ -70,15 +71,15 @@ start (Expire expire) noact actlog descs u =
   where
 	lastact = changed <$> M.lookup u actlog
 	whenactive = case lastact of
-		Just (Date t) -> do
-			d <- liftIO $ durationSince $ posixSecondsToUTCTime t
+		Just (VectorClock c) -> do
+			d <- liftIO $ durationSince $ posixSecondsToUTCTime c
 			return $ "last active: " ++ fromDuration d ++ " ago"
 		_  -> return "no activity"
 	desc = fromUUID u ++ " " ++ fromMaybe "" (M.lookup u descs)
 	notexpired ent = case ent of
 		Unknown -> False
-		Date t -> case lookupexpire of
-			Just (Just expiretime) -> t >= expiretime
+		VectorClock c -> case lookupexpire of
+			Just (Just expiretime) -> c >= expiretime
 			_ -> True
 	lookupexpire = headMaybe $ catMaybes $
 		map (`M.lookup` expire) [Just u, Nothing]
diff --git a/Command/Forget.hs b/Command/Forget.hs
index 583eee7ca..d172cc693 100644
--- a/Command/Forget.hs
+++ b/Command/Forget.hs
@@ -11,8 +11,7 @@ import Command
 import qualified Annex.Branch as Branch
 import Logs.Transitions
 import qualified Annex
-
-import Data.Time.Clock.POSIX
+import Annex.VectorClock
 
 cmd :: Command
 cmd = command "forget" SectionMaintenance 
@@ -36,10 +35,10 @@ seek = commandAction . start
 start :: ForgetOptions -> CommandStart
 start o = do
 	showStart "forget" "git-annex"
-	now <- liftIO getPOSIXTime
-	let basets = addTransition now ForgetGitHistory noTransitions
+	c <- liftIO currentVectorClock
+	let basets = addTransition c ForgetGitHistory noTransitions
 	let ts = if dropDead o
-		then addTransition now ForgetDeadRemotes basets
+		then addTransition c ForgetDeadRemotes basets
 		else basets
 	next $ perform ts =<< Annex.getState Annex.force
 
diff --git a/Command/MetaData.hs b/Command/MetaData.hs
index 617b291a1..d10fc9921 100644
--- a/Command/MetaData.hs
+++ b/Command/MetaData.hs
@@ -9,6 +9,7 @@ module Command.MetaData where
 
 import Command
 import Annex.MetaData
+import Annex.VectorClock
 import Logs.MetaData
 import Annex.WorkTree
 import Messages.JSON (JSONActionItem(..))
@@ -18,7 +19,6 @@ import qualified Data.Set as S
 import qualified Data.Map as M
 import qualified Data.Text as T
 import qualified Data.ByteString.Lazy.UTF8 as BU
-import Data.Time.Clock.POSIX
 import Data.Aeson
 import Control.Concurrent
 
@@ -68,28 +68,28 @@ optParser desc = MetaDataOptions
 seek :: MetaDataOptions -> CommandSeek
 seek o = case batchOption o of
 	NoBatch -> do
-		now <- liftIO getPOSIXTime
+		c <- liftIO currentVectorClock
 		let seeker = case getSet o of
 			Get _ -> withFilesInGit
 			GetAll -> withFilesInGit
 			Set _ -> withFilesInGitNonRecursive
 				"Not recursively setting metadata. Use --force to do that."
 		withKeyOptions (keyOptions o) False
-			(startKeys now o)
-			(seeker $ whenAnnexed $ start now o)
+			(startKeys c o)
+			(seeker $ whenAnnexed $ start c o)
 			(forFiles o)
 	Batch -> withMessageState $ \s -> case outputType s of
 		JSONOutput _ -> batchInput parseJSONInput $
 			commandAction . startBatch
 		_ -> giveup "--batch is currently only supported in --json mode"
 
-start :: POSIXTime -> MetaDataOptions -> FilePath -> Key -> CommandStart
-start now o file k = startKeys now o k (mkActionItem afile)
+start :: VectorClock -> MetaDataOptions -> FilePath -> Key -> CommandStart
+start c o file k = startKeys c o k (mkActionItem afile)
   where
 	afile = AssociatedFile (Just file)
 
-startKeys :: POSIXTime -> MetaDataOptions -> Key -> ActionItem -> CommandStart
-startKeys now o k ai = case getSet o of
+startKeys :: VectorClock -> MetaDataOptions -> Key -> ActionItem -> CommandStart
+startKeys c o k ai = case getSet o of
 	Get f -> do
 		l <- S.toList . currentMetaDataValues f <$> getCurrentMetaData k
 		liftIO $ forM_ l $
@@ -97,14 +97,14 @@ startKeys now o k ai = case getSet o of
 		stop
 	_ -> do
 		showStart' "metadata" k ai
-		next $ perform now o k
+		next $ perform c o k
 
-perform :: POSIXTime -> MetaDataOptions -> Key -> CommandPerform
-perform now o k = case getSet o of
+perform :: VectorClock -> MetaDataOptions -> Key -> CommandPerform
+perform c o k = case getSet o of
 	Set ms -> do
 		oldm <- getCurrentMetaData k
 		let m = combineMetaData $ map (modMeta oldm) ms
-		addMetaData' k m now
+		addMetaData' k m c
 		next $ cleanup k
 	_ -> next $ cleanup k
 
@@ -169,7 +169,7 @@ startBatch (i, (MetaData m)) = case i of
 			, keyOptions = Nothing
 			, batchOption = NoBatch
 			}
-		now <- liftIO getPOSIXTime
+		t <- liftIO currentVectorClock
 		-- It would be bad if two batch mode changes used exactly
 		-- the same timestamp, since the order of adds and removals
 		-- of the same metadata value would then be indeterminate.
@@ -178,7 +178,7 @@ startBatch (i, (MetaData m)) = case i of
 		-- probably less expensive than cleaner methods,
 		-- such as taking from a list of increasing timestamps.
 		liftIO $ threadDelay 1
-		next $ perform now o k
+		next $ perform t o k
 	mkModMeta (f, s)
 		| S.null s = DelMeta f Nothing
 		| otherwise = SetMeta f s