fix error throwing

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

View file

@ -58,7 +58,7 @@ cleanup file key = do
-- touch the symlink to have the same mtime as the file it points to -- touch the symlink to have the same mtime as the file it points to
s <- liftIO $ getFileStatus file s <- liftIO $ getFileStatus file
let mtime = modificationTime s let mtime = modificationTime s
_ <- liftIO $ touch file (TimeSpec mtime 0) False liftIO $ touch file (TimeSpec mtime 0) False
Annex.queue "add" [Param "--"] file Annex.queue "add" [Param "--"] file
return True return True

View file

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