diff options
| -rw-r--r-- | Backend/SHA.hs | 71 | ||||
| -rw-r--r-- | Backend/SHA1.hs | 55 |
2 files changed, 74 insertions, 52 deletions
diff --git a/Backend/SHA.hs b/Backend/SHA.hs new file mode 100644 index 000000000..d779e8055 --- /dev/null +++ b/Backend/SHA.hs @@ -0,0 +1,71 @@ +{- git-annex SHA abstract backend + - + - Copyright 2011 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Backend.SHA (genBackend) where + +import Control.Monad.State +import Data.String.Utils +import System.Cmd.Utils +import System.IO +import System.Directory + +import qualified Backend.File +import BackendTypes +import Messages +import qualified Annex +import Locations +import Content +import Types +import Utility + +type SHASize = Int + +-- Constructor for Backends using a given SHASize. +genBackend :: SHASize -> Backend Annex +genBackend size = Backend.File.backend + { name = shaName size + , getKey = keyValue size + , fsckKey = Backend.File.checkKey $ checkKeyChecksum size + } + +shaName :: SHASize -> String +shaName size = "SHA" ++ show size + +shaN :: SHASize -> FilePath -> Annex String +shaN size file = do + showNote "checksum..." + liftIO $ pOpen ReadFromPipe command (toCommand [File file]) $ \h -> do + line <- hGetLine h + let bits = split " " line + if null bits + then error $ command ++ " parse error" + else return $ head bits + where + command = "sha" ++ (show size) ++ "sum" + +-- A key is a checksum of its contents. +keyValue :: SHASize -> FilePath -> Annex (Maybe Key) +keyValue size file = do + s <- shaN size file + return $ Just $ Key (shaName size, s) + +-- A key's checksum is checked during fsck. +checkKeyChecksum :: SHASize -> Key -> Annex Bool +checkKeyChecksum size key = do + g <- Annex.gitRepo + let file = gitAnnexLocation g key + present <- liftIO $ doesFileExist file + if not present + then return True + else do + s <- shaN size file + if s == keyName key + then return True + else do + dest <- moveBad key + warning $ "Bad file content; moved to " ++ filePathToString dest + return False diff --git a/Backend/SHA1.hs b/Backend/SHA1.hs index 22bc493b7..76d2af69e 100644 --- a/Backend/SHA1.hs +++ b/Backend/SHA1.hs @@ -1,63 +1,14 @@ {- git-annex "SHA1" backend - - - Copyright 2010 Joey Hess <joey@kitenet.net> + - Copyright 2011 Joey Hess <joey@kitenet.net> - - 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 BackendTypes -import Messages -import qualified Annex -import Locations -import Content import Types -import Utility +import Backend.SHA backend :: Backend Annex -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" (toCommand [File file]) $ \h -> do - line <- hGetLine h - let bits = split " " line - if null bits - then error "sha1sum parse error" - else return $ head bits - --- 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 = gitAnnexLocation 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 - warning $ "Bad file content; moved to " ++ filePathToString dest - return False +backend = genBackend 1 |