blob: a0d814aa08301d035109466cab8759447ec6146e (
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
|
{- git-annex "WORM" backend -- Write Once, Read Many
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Backend.WORM (backends) where
import Control.Monad.State
import System.FilePath
import System.Posix.Files
import System.Posix.Types
import System.Directory
import Data.String.Utils
import qualified Backend.File
import BackendTypes
import Locations
import qualified Annex
import Content
import Messages
import Types
backends :: [Backend Annex]
backends = [backend]
backend :: Backend Annex
backend = Backend.File.backend {
name = "WORM",
getKey = keyValue,
fsckKey = Backend.File.checkKey checkKeySize
}
-- The key is formed from the file size, modification time, and the
-- basename of the filename.
--
-- That allows multiple files with the same names to have different keys,
-- while also allowing a file to be moved around while retaining the
-- same key.
keyValue :: FilePath -> Annex (Maybe Key)
keyValue file = do
stat <- liftIO $ getFileStatus file
return $ Just $ Key (name backend, key stat)
where
key stat = uniqueid stat ++ sep ++ base
uniqueid stat = show (modificationTime stat) ++ sep ++
show (fileSize stat)
base = takeFileName file
sep = ":"
{- Extracts the file size from a key. -}
keySize :: Key -> FileOffset
keySize key = read $ section !! 1
where
section = split ":" (keyName key)
{- The size of the data for a key is checked against the size encoded in
- the key. Note that the modification time is not checked. -}
checkKeySize :: Key -> Annex Bool
checkKeySize key = do
g <- Annex.gitRepo
let file = gitAnnexLocation g key
present <- liftIO $ doesFileExist file
if not present
then return True
else do
s <- liftIO $ getFileStatus file
if fileSize s == keySize key
then return True
else do
dest <- moveBad key
warning $ "Bad file size; moved to " ++ dest
return False
|
