diff options
| -rw-r--r-- | Backend/SHA.hs | 13 | ||||
| -rw-r--r-- | Logs/Transfer.hs | 33 | ||||
| -rw-r--r-- | debian/changelog | 2 | ||||
| -rw-r--r-- | doc/bugs/commitBuffer:_invalid_argument___40__invalid_character__41__.mdwn | 3 |
4 files changed, 39 insertions, 12 deletions
diff --git a/Backend/SHA.hs b/Backend/SHA.hs index 497e7d7e2..bfb94df99 100644 --- a/Backend/SHA.hs +++ b/Backend/SHA.hs @@ -16,6 +16,7 @@ import Types.KeySource import qualified Build.SysConfig as SysConfig import Data.Digest.Pure.SHA import qualified Data.ByteString.Lazy as L +import System.Process type SHASize = Int @@ -55,7 +56,7 @@ shaN shasize file filesize = do case shaCommand shasize filesize of Left sha -> liftIO $ sha <$> L.readFile file Right command -> liftIO $ parse command . lines <$> - readProcess command (toCommand [File file]) + readsha command (toCommand [File file]) where parse command [] = bad command parse command (l:_) @@ -64,6 +65,16 @@ shaN shasize file filesize = do where sha = fst $ separate (== ' ') l bad command = error $ command ++ " parse error" + {- sha commands output the filename, so need to set fileEncoding -} + readsha command args = + withHandle StdoutHandle createProcessSuccess p $ \h -> do + fileEncoding h + output <- hGetContentsStrict h + hClose h + return output + where + p = (proc command args) + { std_out = CreatePipe } shaCommand :: SHASize -> Integer -> Either (L.ByteString -> String) String shaCommand shasize filesize diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index 5c16e758e..a58944a83 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -97,28 +97,27 @@ runTransfer t file a = do <*> pure Nothing <*> pure file <*> pure False - let content = writeTransferInfo info - ok <- bracketIO (prep tfile mode content) (cleanup tfile) a - unless ok $ failed content + ok <- bracketIO (prep tfile mode info) (cleanup tfile) a + unless ok $ failed info return ok where - prep tfile mode content = do + prep tfile mode info = do fd <- openFd (transferLockFile tfile) ReadWrite (Just mode) defaultFileFlags { trunc = True } locked <- catchMaybeIO $ setLock fd (WriteLock, AbsoluteSeek, 0, 0) when (locked == Nothing) $ error $ "transfer already in progress" - writeFile tfile content + writeTransferInfoFile info tfile return fd cleanup tfile fd = do void $ tryIO $ removeFile tfile void $ tryIO $ removeFile $ transferLockFile tfile closeFd fd - failed content = do + failed info = do failedtfile <- fromRepo $ failedTransferFile t createAnnexDirectory $ takeDirectory failedtfile - liftIO $ writeFile failedtfile content + liftIO $ writeTransferInfoFile info failedtfile {- If a transfer is still running, returns its TransferInfo. -} checkTransfer :: Transfer -> Annex (Maybe TransferInfo) @@ -136,9 +135,8 @@ checkTransfer t = do case locked of Nothing -> return Nothing Just (pid, _) -> liftIO $ - flip catchDefaultIO Nothing $ do - readTransferInfo (Just pid) - <$> readFile tfile + flip catchDefaultIO Nothing $ + readTransferInfoFile (Just pid) tfile {- Gets all currently running transfers. -} getTransfers :: Annex [(Transfer, TransferInfo)] @@ -159,7 +157,7 @@ getFailedTransfers u = catMaybes <$> (liftIO . getpairs =<< concat <$> findfiles where getpairs = mapM $ \f -> do let mt = parseTransferFile f - mi <- readTransferInfo Nothing <$> readFile f + mi <- readTransferInfoFile Nothing f return $ case (mt, mi) of (Just t, Just i) -> Just (t, i) _ -> Nothing @@ -196,6 +194,13 @@ parseTransferFile file where bits = splitDirectories file +writeTransferInfoFile :: TransferInfo -> FilePath -> IO () +writeTransferInfoFile info tfile = do + h <- openFile tfile WriteMode + fileEncoding h + hPutStr h $ writeTransferInfo info + hClose h + writeTransferInfo :: TransferInfo -> String writeTransferInfo info = unlines -- transferPid is not included; instead obtained by looking at @@ -205,6 +210,12 @@ writeTransferInfo info = unlines , fromMaybe "" $ associatedFile info -- comes last; arbitrary content ] +readTransferInfoFile :: (Maybe ProcessID) -> FilePath -> IO (Maybe TransferInfo) +readTransferInfoFile mpid tfile = do + h <- openFile tfile ReadMode + fileEncoding h + hClose h `after` (readTransferInfo mpid <$> hGetContentsStrict h) + readTransferInfo :: (Maybe ProcessID) -> String -> Maybe TransferInfo readTransferInfo mpid s = case bits of diff --git a/debian/changelog b/debian/changelog index b949534e9..cc567e581 100644 --- a/debian/changelog +++ b/debian/changelog @@ -20,6 +20,8 @@ git-annex (3.20120826) UNRELEASED; urgency=low * Support repositories created with --separate-git-dir. Closes: #684405 * reinject: When the provided file doesn't match, leave it where it is, rather than moving to .git/annex/bad/ + * Avoid crashing on encoding errors in filenames when writing transfer info + files and reading from checksum commands. -- Joey Hess <joeyh@debian.org> Mon, 27 Aug 2012 13:27:39 -0400 diff --git a/doc/bugs/commitBuffer:_invalid_argument___40__invalid_character__41__.mdwn b/doc/bugs/commitBuffer:_invalid_argument___40__invalid_character__41__.mdwn index ab5a2e9ee..027d22431 100644 --- a/doc/bugs/commitBuffer:_invalid_argument___40__invalid_character__41__.mdwn +++ b/doc/bugs/commitBuffer:_invalid_argument___40__invalid_character__41__.mdwn @@ -223,3 +223,6 @@ http://git-annex.branchable.com/todo/support-non-utf8-locales/ failed (Recording state in git...) git-annex: copy: 1 failed + +> [[Fixed|done]]. Sorry this took so long, I was at a very busy point when +> you filed this and am only just getting caught up. --[[Joey]] |