summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Backend/SHA.hs71
-rw-r--r--Backend/SHA1.hs55
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