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.

1 files changed, 70 insertions, 0 deletions

diff --git a/Touch.hsc b/Touch.hsc
new file mode 100644
index 000000000..ad36761c4
--- /dev/null
+++ b/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