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
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
{- git-annex v1 -> v2 upgrade support
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Upgrade.V1 where
import System.IO.Error (try)
import System.Directory
import Control.Monad.State (liftIO)
import Control.Monad (filterM, forM_, unless)
import System.Posix.Files
import System.FilePath
import Data.String.Utils
import Key
import System.Posix.Types
import Content
import Types
import Locations
import qualified Annex
import Backend
import Messages
import Version
upgrade :: Annex Bool
upgrade = do
showSideAction "Upgrading object directory layout v1 to v2..."
error "upgradeFrom1 TODO FIXME"
-- v2 adds hashing of filenames of content and location log files.
--
-- Key information is encoded in filenames differently.
--
-- When upgrading a v1 key to v2, file size metadata needs to be
-- added to the key (unless it is a WORM key, which encoded
-- mtime:size in v1). This can only be done when the file content
-- is present.
--
-- So there are two approaches -- either upgrade
-- everything, leaving out file size information for files not
-- present in the current repo; or upgrade peicemeil, only
-- upgrading keys whose content is present.
--
-- The latter approach would mean that, until every clone of an
-- annex is upgraded, git annex would refuse to operate on annexed
-- files that had not yet been committed. Unless it were taught to
-- work with both v1 and v2 keys in the same repo.
--
-- Another problem with the latter approach might involve content
-- being moved between repos while the conversion is still
-- incomplete. If repo A has already upgraded, and B has not, and B
-- has K, moving K from B -> A would result in it lurking
-- unconverted on A. Unless A upgraded it in passing. But that's
-- getting really complex, and would mean a constant trickle of
-- upgrade commits, which users would find annoying.
--
-- So, the former option it is! Note that file size metadata
-- will only be used for detecting situations where git-annex
-- would run out of disk space, so if some keys don't have it,
-- the impact is small. At least initially. It could be used in the
-- future by smart auto-repo balancing code, etc.
--
-- Anyway, since v2 plans ahead for other metadata being included
-- in keys, there should probably be a way to update a key.
-- Something similar to the migrate subcommand could be used,
-- and users could then run that at their leisure. Or, this upgrade
-- could to that key update for all keys that have been converted
-- and have content in the repo.
-- do the reorganisation of the log files
-- do the reorganisation of the key files
g <- Annex.gitRepo
let olddir = gitAnnexDir g
keys <- getKeysPresent1
forM_ keys $ \k -> moveAnnex k $ olddir </> keyFile1 k
-- update the symlinks to the key files
Annex.queueRun
setVersion
return True
keyFile1 :: Key -> FilePath
keyFile1 key = replace "/" "%" $ replace "%" "&s" $ replace "&" "&a" $ show key
fileKey1 :: FilePath -> Key
fileKey1 file = readKey1 $
replace "&a" "&" $ replace "&s" "%" $ replace "%" "/" file
readKey1 :: String -> Key
readKey1 v = Key { keyName = n , keyBackendName = b, keySize = s, keyMtime = t }
where
bits = split ":" v
b = head bits
n = join ":" $ drop (if wormy then 3 else 1) bits
t = if wormy
then Just (read (bits !! 1) :: EpochTime)
else Nothing
s = if wormy
then Just (read (bits !! 2) :: Integer)
else Nothing
wormy = b == "WORM"
lookupFile1 :: FilePath -> Annex (Maybe (Key, Backend Annex))
lookupFile1 file = do
bs <- Annex.getState Annex.supportedBackends
tl <- liftIO $ try getsymlink
case tl of
Left _ -> return Nothing
Right l -> makekey bs l
where
getsymlink = do
l <- readSymbolicLink file
return $ takeFileName l
makekey bs l = do
case maybeLookupBackendName bs bname of
Nothing -> do
unless (null kname || null bname ||
not (isLinkToAnnex l)) $
warning skip
return Nothing
Just backend -> return $ Just (k, backend)
where
k = fileKey1 l
bname = keyBackendName k
kname = keyName k
skip = "skipping " ++ file ++
" (unknown backend " ++ bname ++ ")"
getKeysPresent1 :: Annex [Key]
getKeysPresent1 = do
g <- Annex.gitRepo
getKeysPresent1' $ gitAnnexObjectDir g
getKeysPresent1' :: FilePath -> Annex [Key]
getKeysPresent1' dir = do
exists <- liftIO $ doesDirectoryExist dir
if (not exists)
then return []
else do
contents <- liftIO $ getDirectoryContents dir
files <- liftIO $ filterM present contents
return $ map fileKey1 files
where
present d = do
result <- try $
getFileStatus $ dir ++ "/" ++ d ++ "/" ++ takeFileName d
case result of
Right s -> return $ isRegularFile s
Left _ -> return False
|
