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
|
{- A "remote" that is just a filesystem directory.
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Remote.Directory (remote) where
import qualified Data.ByteString.Lazy.Char8 as L
import System.IO.Error
import qualified Data.Map as M
import Common.Annex
import Utility.CopyFile
import Types.Remote
import qualified Git
import UUID
import Config
import Utility.FileMode
import Remote.Helper.Special
import Remote.Helper.Encryptable
import Crypto
remote :: RemoteType Annex
remote = RemoteType {
typename = "directory",
enumerate = findSpecialRemotes "directory",
generate = gen,
setup = directorySetup
}
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
gen r u c = do
dir <- getConfig r "directory" (error "missing directory")
cst <- remoteCost r cheapRemoteCost
return $ encryptableRemote c
(storeEncrypted dir)
(retrieveEncrypted dir)
Remote {
uuid = u,
cost = cst,
name = Git.repoDescribe r,
storeKey = store dir,
retrieveKeyFile = retrieve dir,
removeKey = remove dir,
hasKey = checkPresent dir,
hasKeyCheap = True,
config = Nothing,
repo = r
}
directorySetup :: UUID -> RemoteConfig -> Annex RemoteConfig
directorySetup u c = do
-- verify configuration is sane
let dir = fromMaybe (error "Specify directory=") $
M.lookup "directory" c
liftIO $ doesDirectoryExist dir
>>! error $ "Directory does not exist: " ++ dir
c' <- encryptionSetup c
-- The directory is stored in git config, not in this remote's
-- persistant state, so it can vary between hosts.
gitConfigSpecialRemote u c' "directory" dir
return $ M.delete "directory" c'
dirKey :: FilePath -> Key -> FilePath
dirKey d k = d </> hashDirMixed k </> f </> f
where
f = keyFile k
store :: FilePath -> Key -> Annex Bool
store d k = do
g <- gitRepo
let src = gitAnnexLocation g k
let dest = dirKey d k
liftIO $ catchBool $ storeHelper dest $ copyFileExternal src dest
storeEncrypted :: FilePath -> (Cipher, Key) -> Key -> Annex Bool
storeEncrypted d (cipher, enck) k = do
g <- gitRepo
let src = gitAnnexLocation g k
let dest = dirKey d enck
liftIO $ catchBool $ storeHelper dest $ encrypt src dest
where
encrypt src dest = do
withEncryptedContent cipher (L.readFile src) $ L.writeFile dest
return True
storeHelper :: FilePath -> IO Bool -> IO Bool
storeHelper dest a = do
let dir = parentDir dest
createDirectoryIfMissing True dir
allowWrite dir
ok <- a
when ok $ do
preventWrite dest
preventWrite dir
return ok
retrieve :: FilePath -> Key -> FilePath -> Annex Bool
retrieve d k f = liftIO $ copyFileExternal (dirKey d k) f
retrieveEncrypted :: FilePath -> (Cipher, Key) -> FilePath -> Annex Bool
retrieveEncrypted d (cipher, enck) f =
liftIO $ catchBool $ do
withDecryptedContent cipher (L.readFile (dirKey d enck)) $ L.writeFile f
return True
remove :: FilePath -> Key -> Annex Bool
remove d k = liftIO $ catchBool $ do
allowWrite dir
removeFile file
removeDirectory dir
return True
where
file = dirKey d k
dir = parentDir file
checkPresent :: FilePath -> Key -> Annex (Either IOException Bool)
checkPresent d k = liftIO $ try $ doesFileExist (dirKey d k)
|
