blob: a1124dfe2e7a9166073465807bc982ca29b5fcf1 (
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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
|
{- git-annex SHA backend
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Backend.SHA (backends) where
import Common.Annex
import qualified Annex
import Annex.Content
import Types.Backend
import Types.Key
import qualified Build.SysConfig as SysConfig
type SHASize = Int
-- order is slightly significant; want SHA256 first, and more general
-- sizes earlier
sizes :: [Int]
sizes = [256, 1, 512, 224, 384]
backends :: [Backend]
backends = catMaybes $ map genBackend sizes ++ map genBackendE sizes
genBackend :: SHASize -> Maybe Backend
genBackend size
| isNothing (shaCommand size) = Nothing
| otherwise = Just b
where
b = Backend
{ name = shaName size
, getKey = keyValue size
, fsckKey = checkKeyChecksum size
}
genBackendE :: SHASize -> Maybe Backend
genBackendE size =
case genBackend size of
Nothing -> Nothing
Just b -> Just $ b
{ name = shaNameE size
, getKey = keyValueE size
}
shaCommand :: SHASize -> Maybe String
shaCommand 1 = SysConfig.sha1
shaCommand 256 = SysConfig.sha256
shaCommand 224 = SysConfig.sha224
shaCommand 384 = SysConfig.sha384
shaCommand 512 = SysConfig.sha512
shaCommand _ = Nothing
shaName :: SHASize -> String
shaName size = "SHA" ++ show size
shaNameE :: SHASize -> String
shaNameE size = shaName size ++ "E"
shaN :: SHASize -> FilePath -> Annex String
shaN size file = do
showAction "checksum"
liftIO $ pOpen ReadFromPipe command (toCommand [File file]) $ \h -> do
sha <- fst . separate (== ' ') <$> hGetLine h
if null sha
then error $ command ++ " parse error"
else return sha
where
command = fromJust $ shaCommand size
{- A key is a checksum of its contents. -}
keyValue :: SHASize -> FilePath -> Annex (Maybe Key)
keyValue size file = do
s <- shaN size file
stat <- liftIO $ getFileStatus file
return $ Just $ stubKey
{ keyName = s
, keyBackendName = shaName size
, keySize = Just $ fromIntegral $ fileSize stat
}
{- Extension preserving keys. -}
keyValueE :: SHASize -> FilePath -> Annex (Maybe Key)
keyValueE size file = keyValue size file >>= maybe (return Nothing) addE
where
addE k = return $ Just $ k
{ keyName = keyName k ++ extension
, keyBackendName = shaNameE size
}
naiveextension = takeExtension file
extension
-- long or newline containing extensions are
-- probably not really an extension
| length naiveextension > 6 ||
'\n' `elem` naiveextension = ""
| otherwise = naiveextension
{- A key's checksum is checked during fsck. -}
checkKeyChecksum :: SHASize -> Key -> Annex Bool
checkKeyChecksum size key = do
fast <- Annex.getState Annex.fast
file <- inRepo $ gitAnnexLocation key
present <- liftIO $ doesFileExist file
if not present || fast
then return True
else check =<< shaN size file
where
check s
| s == dropExtension (keyName key) = return True
| otherwise = do
dest <- moveBad key
warning $ "Bad file content; moved to " ++ dest
return False
|
