mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

fix error throwing

Browse source
This commit is contained in:
Joey Hess 2011-03-15 11:50:40 -04:00
parent 7b0c6177ff
commit 83a9bb624b
2 changed files with 8 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Command/Add.hs
View file

@ -58,7 +58,7 @@ cleanup file key = do
-- 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
liftIO $ touch file (TimeSpec mtime 0) False
Annex.queue "add" [Param "--"] file
return True

12
Touch.hsc
View file

@ -50,15 +50,17 @@ nowTime = TimeSpec 0 #const UTIME_NOW
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
{- Changes the access and/or modification times of an existing file.
Can follow symlinks, or not. Throws IO error on failure. -}
touchBoth :: FilePath -> TimeSpec -> TimeSpec -> Bool -> IO ()
touchBoth file atime mtime follow =
allocaArray 2 $ \ptr ->
withCString file $ \f -> do
pokeArray ptr [atime, mtime]
r <- c_utimensat at_fdcwd f ptr flags
return (r == 0)
if (r /= 0)
then throwErrno "touchBoth"
else return ()
where
at_fdcwd = #const AT_FDCWD
at_symlink_nofollow = #const AT_SYMLINK_NOFOLLOW
@ -67,5 +69,5 @@ touchBoth file atime mtime follow =
then 0
else at_symlink_nofollow
touch :: FilePath -> TimeSpec -> Bool -> IO Bool
touch :: FilePath -> TimeSpec -> Bool -> IO ()
touch file mtime follow = touchBoth file omitTime mtime follow