blob: 14b4b9dae5082c0216e8038e7809c7f735ad9eff (
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
115
116
117
118
119
120
121
122
123
124
125
126
127
|
{- git-annex pseudo-backend
-
- This backend does not really do any independant data storage,
- it relies on the file contents in .git/annex/ in this repo,
- and other accessible repos.
-
- This is an abstract backend; getKey has to be implemented to complete
- it.
-}
module Backend.File (backend) where
import Control.Monad.State
import System.IO
import System.Cmd
import System.Cmd.Utils
import Control.Exception
import List
import Maybe
import TypeInternals
import LocationLog
import Locations
import qualified Remotes
import qualified GitRepo as Git
import Utility
import Core
import qualified Annex
import UUID
import qualified Backend
backend = Backend {
name = mustProvide,
getKey = mustProvide,
storeFileKey = dummyStore,
retrieveKeyFile = copyKeyFile,
removeKey = checkRemoveKey,
hasKey = checkKeyFile
}
mustProvide = error "must provide this field"
{- Storing a key is a no-op. -}
dummyStore :: FilePath -> Key -> Annex (Bool)
dummyStore file key = return True
{- Just check if the .git/annex/ file for the key exists. -}
checkKeyFile :: Key -> Annex Bool
checkKeyFile k = inAnnex k
{- Try to find a copy of the file in one of the remotes,
- and copy it over to this one. -}
copyKeyFile :: Key -> FilePath -> Annex (Bool)
copyKeyFile key file = do
remotes <- Remotes.keyPossibilities key
if (null remotes)
then do
showNote "not available"
showLocations key
return False
else trycopy remotes remotes
where
trycopy full [] = do
showNote "not available"
showTriedRemotes full
showLocations key
return False
trycopy full (r:rs) = do
copied <- Remotes.copyFromRemote r key file
if (copied)
then return True
else trycopy full rs
{- Checks remotes to verify that enough copies of a key exist to allow
- for a key to be safely removed (with no data loss), and fails with an
- error if not. -}
checkRemoveKey :: Key -> Annex (Bool)
checkRemoveKey key = do
force <- Annex.flagIsSet "force"
if (force)
then return True
else do
g <- Annex.gitRepo
remotes <- Remotes.keyPossibilities key
let numcopies = read $ Git.configGet g config "1"
if (numcopies > length remotes)
then notEnoughCopies numcopies (length remotes) []
else findcopies numcopies 0 remotes []
where
config = "annex.numcopies"
findcopies need have [] bad =
if (have >= need)
then return True
else notEnoughCopies need have bad
findcopies need have (r:rs) bad = do
haskey <- Remotes.inAnnex r key
case (haskey) of
Right True -> findcopies need (have+1) rs bad
Right False -> findcopies need have rs bad
Left _ -> findcopies need have rs (r:bad)
notEnoughCopies need have bad = do
unsafe
showLongNote $
"Could only verify the existence of " ++
(show have) ++ " out of " ++ (show need) ++
" necessary copies"
if (not $ null bad) then showTriedRemotes bad else return ()
showLocations key
hint
return False
unsafe = showNote "unsafe"
hint = showLongNote $ "(Use --force to override this check, or adjust annex.numcopies.)"
showLocations :: Key -> Annex ()
showLocations key = do
g <- Annex.gitRepo
u <- getUUID g
uuids <- liftIO $ keyLocations g key
let uuidsf = filter (\v -> v /= u) uuids
ppuuids <- prettyPrintUUIDs uuidsf
if (null uuidsf)
then showLongNote $ "No other repository is known to contain the file."
else showLongNote $ "Try making some of these repositories available:\n" ++ ppuuids
showTriedRemotes remotes =
showLongNote $ "I was unable to access these remotes: " ++
(Remotes.list remotes)
|
