{- git-annex "SHA1" backend - - Copyright 2010 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} module Backend.SHA1 (backend) where import Control.Monad.State import Data.String.Utils import System.Cmd.Utils import System.IO import System.Directory import qualified Backend.File import TypeInternals import Messages import qualified Annex import Locations import Core backend :: Backend backend = Backend.File.backend { name = "SHA1", getKey = keyValue, fsckKey = Backend.File.checkKey checkKeySHA1 } sha1 :: FilePath -> Annex String sha1 file = do showNote "checksum..." liftIO $ pOpen ReadFromPipe "sha1sum" [file] $ \h -> do line <- hGetLine h let bits = split " " line if (null bits) then error "sha1sum parse error" else return $ bits !! 0 -- A key is a sha1 of its contents. keyValue :: FilePath -> Annex (Maybe Key) keyValue file = do s <- sha1 file return $ Just $ Key ((name backend), s) -- A key's sha1 is checked during fsck. checkKeySHA1 :: Key -> Annex Bool checkKeySHA1 key = do g <- Annex.gitRepo let file = annexLocation g key present <- liftIO $ doesFileExist file if (not present) then return True else do s <- sha1 file if (s == keyName key) then return True else do dest <- moveBad key showNote $ "bad file content (moved to "++dest++")" return False