symlink touching fun

When adding files to the annex, the symlinks pointing at the annexed
content are made to have the same mtime as the original file. While git
does not preserve that information, this allows a tool like metastore to be
used with annexed files.

.gitignore

@@ -11,3 +11,4 @@ doc/.ikiwiki
 html
 *.tix
 .hpc
+Touch.hs

Command/Add.hs

@@ -18,6 +18,7 @@ import Types
 import Content
 import Messages
 import Utility
+import Touch
 
 command :: [Command]
 command = [Command "add" paramPath seek "add files to annex"]
@@ -53,5 +54,11 @@ cleanup file key = do
 
 	link <- calcGitLink file key
 	liftIO $ createSymbolicLink link file
+
+	-- touch the symlink to have the same mtime as the file it points to
+	s <- liftIO $ getFileStatus file
+	let mtime = modificationTime s
+	_ <- liftIO $ touch file (TimeSpec mtime 0) False
+
 	Annex.queue "add" [Param "--"] file
 	return True

Command/Find.hs

@@ -12,7 +12,6 @@ import Control.Monad.State (liftIO)
 
 import Command
 import Content
-import Messages
 
 command :: [Command]
 command = [Command "find" (paramOptional $ paramRepeating paramPath) seek

Command/PreCommit.hs

@@ -14,7 +14,6 @@ import qualified Annex
 import qualified GitRepo as Git
 import qualified Command.Add
 import qualified Command.Fix
-import Messages
 import Utility
 
 command :: [Command]

Makefile

@@ -11,7 +11,10 @@ SysConfig.hs: configure.hs TestConfig.hs
 	$(GHCMAKE) configure
 	./configure
 
-$(bins): SysConfig.hs
+Touch.hs: Touch.hsc
+	hsc2hs $<
+
+$(bins): SysConfig.hs Touch.hs
 	$(GHCMAKE) $@
 
 git-annex.1: doc/git-annex.mdwn
@@ -57,7 +60,7 @@ docs: $(mans)
 		--exclude='news/.*'
 
 clean:
-	rm -rf build $(bins) $(mans) test configure SysConfig.hs *.tix .hpc
+	rm -rf build $(bins) $(mans) test configure Touch.hs SysConfig.hs *.tix .hpc
 	rm -rf doc/.ikiwiki html
 	find . \( -name \*.o -or -name \*.hi \) -exec rm {} \;
 

Touch.hsc

@@ -0,0 +1,70 @@
+{- More control over touching a file.
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module Touch (
+	TimeSpec(..),
+	now,
+	omit,
+	touchBoth,
+	touch
+) where
+
+import Foreign
+import Foreign.C
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+
+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)
+
+data TimeSpec = TimeSpec CTime CLong
+
+instance Storable TimeSpec where
+	alignment _ = #{alignment struct timespec}
+	sizeOf _ = #{size struct timespec}
+	peek ptr = do
+		sec <- #{peek struct timespec, tv_sec} ptr
+		nsec <- #{peek struct timespec, tv_nsec} ptr
+		return $ TimeSpec sec nsec
+	poke ptr (TimeSpec sec nsec) = do
+		#{poke struct timespec, tv_sec} ptr sec
+		#{poke struct timespec, tv_nsec} ptr nsec
+
+{- special timespecs -}
+omit :: TimeSpec
+omit = TimeSpec 0 #const UTIME_OMIT
+now :: TimeSpec
+now = TimeSpec 0 #const UTIME_NOW
+
+{- While its interface is beastly, utimensat is in recent
+   POSIX standards, unlike futimes. -}
+foreign import ccall "utimensat" 
+	c_utimensat :: CInt -> CString -> Ptr TimeSpec -> CInt -> IO CInt
+
+{- Changes the access and/or modification times of a file.
+   Can follow symlinks, or not. -}
+touchBoth :: FilePath -> TimeSpec -> TimeSpec -> Bool -> IO Bool
+touchBoth file atime mtime follow = 
+	allocaArray 2 $ \ptr ->
+	withCString file $ \f -> do
+		pokeArray ptr [atime, mtime]
+		r <- c_utimensat at_fdcwd f ptr flags
+		putStrLn $ "ret " ++ (show r)
+		return (r == 0)
+	where
+		at_fdcwd = #const AT_FDCWD
+		at_symlink_nofollow = #const AT_SYMLINK_NOFOLLOW
+
+		flags = if follow
+			then 0
+			else at_symlink_nofollow 
+
+touch :: FilePath -> TimeSpec -> Bool -> IO Bool
+touch file mtime follow = touchBoth file omit mtime follow

debian/changelog

@@ -1,6 +1,10 @@
 git-annex (0.24) UNRELEASED; urgency=low
 
   * Add Suggests on graphviz. Closes: #618039
+  * When adding files to the annex, the symlinks pointing at the annexed
+    content are made to have the same mtime as the original file.
+    While git does not preserve that information, this allows a tool
+    like metastore to be used with annexed files.
 
  -- Joey Hess <joeyh@debian.org>  Sun, 13 Mar 2011 14:25:17 -0400
 

doc/bugs/softlink_atime.mdwn

@@ -21,3 +21,17 @@ Optionally, editing the meta-data should change the times in all annexes.
 >>> unlikely to do it better.
 
 >>>> OK, thanks for the clarification. Would it be acceptable for you to put the timestamps into the metastore with vanilla git? If such an option existed, everyone would be able to benefit and not just me. -- RichiH
+
+>>>>> I've now committed to git changes to make git-annex add make
+>>>>> symlinks that reflect the original file's mtime. (It's not possible
+>>>>> to set the ctime of a symlink; nor would you want to as messing with
+>>>>> ctimes can break backup software ... and atime doesn't much matter.)
+>>>>> 
+>>>>> So all you have to do is make the pre-commit hook call
+>>>>> [metastore](http://david.hardeman.nu/software.php). The hook
+>>>>> would look like this: ---[[Joey]] [[!tag done]]
+
+	#!/bin/sh
+	git annex pre-commit .
+	metastore --save
+	git add .metadata