blob: c074ab48a2d4028f0c7f8921aad4304f401340e0 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
{- git-annex SHA abstract backend
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Backend.SHA (backends) where
import Control.Monad.State
import Data.String.Utils
import System.Cmd.Utils
import System.IO
import System.Directory
import Data.Maybe
import qualified Backend.File
import BackendTypes
import Messages
import qualified Annex
import Locations
import Content
import Types
import Utility
import qualified SysConfig
type SHASize = Int
backends :: [Backend Annex]
-- order is slightly significant; want sha1 first ,and more general
-- sizes earlier
backends = catMaybes $ map genBackend [1, 256, 512, 224, 384]
genBackend :: SHASize -> Maybe (Backend Annex)
genBackend size
| supported size = Just b
| otherwise = Nothing
where
b = Backend.File.backend
{ name = shaName size
, getKey = keyValue size
, fsckKey = Backend.File.checkKey $ checkKeyChecksum size
}
supported 1 = SysConfig.sha1sum
supported 256 = SysConfig.sha256sum
supported 224 = SysConfig.sha224sum
supported 384 = SysConfig.sha384sum
supported 512 = SysConfig.sha512sum
supported _ = False
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
|
