1{- git-annex v1 -> v2 upgrade support 2 - 3 - Copyright 2011 Joey Hess <id@joeyh.name> 4 - 5 - Licensed under the GNU AGPL version 3 or higher. 6 -} 7 8module Upgrade.V1 where 9 10import System.Posix.Types 11import Data.Char 12import Data.Default 13import Data.ByteString.Builder 14import qualified Data.ByteString as S 15import qualified Data.ByteString.Lazy as L 16import qualified System.FilePath.ByteString as P 17 18import Annex.Common 19import Annex.Content 20import Annex.Link 21import Annex.Perms 22import Types.Key 23import Logs.Presence 24import qualified Annex.Queue 25import qualified Git 26import qualified Git.LsFiles as LsFiles 27import Backend 28import Utility.FileMode 29import Utility.Tmp 30import qualified Upgrade.V2 31 32-- v2 adds hashing of filenames of content and location log files. 33-- Key information is encoded in filenames differently, so 34-- both content and location log files move around, and symlinks 35-- to content need to be changed. 36-- 37-- When upgrading a v1 key to v2, file size metadata ought to be 38-- added to the key (unless it is a WORM key, which encoded 39-- mtime:size in v1). This can only be done when the file content 40-- is present. Since upgrades need to happen consistently, 41-- (so that two repos get changed the same way by the upgrade, and 42-- will merge), that metadata cannot be added on upgrade. 43-- 44-- Note that file size metadata 45-- will only be used for detecting situations where git-annex 46-- would run out of disk space, so if some keys don't have it, 47-- the impact is minor. At least initially. It could be used in the 48-- future by smart auto-repo balancing code, etc. 49-- 50-- Anyway, since v2 plans ahead for other metadata being included 51-- in keys, there should probably be a way to update a key. 52-- Something similar to the migrate subcommand could be used, 53-- and users could then run that at their leisure. 54 55upgrade :: Annex Bool 56upgrade = do 57 showAction "v1 to v2" 58 59 ifM (fromRepo Git.repoIsLocalBare) 60 ( moveContent 61 , do 62 moveContent 63 updateSymlinks 64 moveLocationLogs 65 66 Annex.Queue.flush 67 ) 68 69 Upgrade.V2.upgrade 70 71moveContent :: Annex () 72moveContent = do 73 showAction "moving content" 74 files <- getKeyFilesPresent1 75 forM_ files move 76 where 77 move f = do 78 let f' = toRawFilePath f 79 let k = fileKey1 (fromRawFilePath (P.takeFileName f')) 80 let d = parentDir f' 81 liftIO $ allowWrite d 82 liftIO $ allowWrite f' 83 _ <- moveAnnex k (AssociatedFile Nothing) f' 84 liftIO $ removeDirectory (fromRawFilePath d) 85 86updateSymlinks :: Annex () 87updateSymlinks = do 88 showAction "updating symlinks" 89 top <- fromRepo Git.repoPath 90 (files, cleanup) <- inRepo $ LsFiles.inRepo [] [top] 91 forM_ files (fixlink . fromRawFilePath) 92 void $ liftIO cleanup 93 where 94 fixlink f = do 95 r <- lookupKey1 f 96 case r of 97 Nothing -> noop 98 Just (k, _) -> do 99 link <- fromRawFilePath 100 <$> calcRepo (gitAnnexLink (toRawFilePath f) k) 101 liftIO $ removeFile f 102 liftIO $ createSymbolicLink link f 103 Annex.Queue.addCommand [] "add" [Param "--"] [f] 104 105moveLocationLogs :: Annex () 106moveLocationLogs = do 107 showAction "moving location logs" 108 logkeys <- oldlocationlogs 109 forM_ logkeys move 110 where 111 oldlocationlogs = do 112 dir <- fromRepo Upgrade.V2.gitStateDir 113 ifM (liftIO $ doesDirectoryExist dir) 114 ( mapMaybe oldlog2key 115 <$> liftIO (getDirectoryContents dir) 116 , return [] 117 ) 118 move (l, k) = do 119 dest <- fromRepo (logFile2 k) 120 dir <- fromRepo Upgrade.V2.gitStateDir 121 let f = dir </> l 122 createWorkTreeDirectory (parentDir (toRawFilePath dest)) 123 -- could just git mv, but this way deals with 124 -- log files that are not checked into git, 125 -- as well as merging with already upgraded 126 -- logs that have been pulled from elsewhere 127 old <- liftIO $ readLog1 f 128 new <- liftIO $ readLog1 dest 129 liftIO $ writeLog1 dest (old++new) 130 Annex.Queue.addCommand [] "add" [Param "--"] [dest] 131 Annex.Queue.addCommand [] "add" [Param "--"] [f] 132 Annex.Queue.addCommand [] "rm" [Param "--quiet", Param "-f", Param "--"] [f] 133 134oldlog2key :: FilePath -> Maybe (FilePath, Key) 135oldlog2key l 136 | drop len l == ".log" && sane = Just (l, k) 137 | otherwise = Nothing 138 where 139 len = length l - 4 140 k = readKey1 (take len l) 141 sane = (not . S.null $ fromKey keyName k) && (not . S.null $ formatKeyVariety $ fromKey keyVariety k) 142 143-- WORM backend keys: "WORM:mtime:size:filename" 144-- all the rest: "backend:key" 145-- 146-- If the file looks like "WORM:XXX-...", then it was created by mixing 147-- v2 and v1; that infelicity is worked around by treating the value 148-- as the v2 key that it is. 149readKey1 :: String -> Key 150readKey1 v 151 | mixup = fromJust $ deserializeKey $ intercalate ":" $ Prelude.tail bits 152 | otherwise = mkKey $ \d -> d 153 { keyName = encodeBS n 154 , keyVariety = parseKeyVariety (encodeBS b) 155 , keySize = s 156 , keyMtime = t 157 } 158 where 159 bits = splitc ':' v 160 b = Prelude.head bits 161 n = intercalate ":" $ drop (if wormy then 3 else 1) bits 162 t = if wormy 163 then Just (Prelude.read (bits !! 1) :: EpochTime) 164 else Nothing 165 s = if wormy 166 then Just (Prelude.read (bits !! 2) :: Integer) 167 else Nothing 168 wormy = Prelude.head bits == "WORM" 169 mixup = wormy && isUpper (Prelude.head $ bits !! 1) 170 171showKey1 :: Key -> String 172showKey1 k = intercalate ":" $ filter (not . null) 173 [b, showifhere t, showifhere s, decodeBS n] 174 where 175 showifhere Nothing = "" 176 showifhere (Just x) = show x 177 b = decodeBS $ formatKeyVariety v 178 n = fromKey keyName k 179 v = fromKey keyVariety k 180 s = fromKey keySize k 181 t = fromKey keyMtime k 182 183keyFile1 :: Key -> FilePath 184keyFile1 key = replace "/" "%" $ replace "%" "&s" $ replace "&" "&a" $ showKey1 key 185 186fileKey1 :: FilePath -> Key 187fileKey1 file = readKey1 $ 188 replace "&a" "&" $ replace "&s" "%" $ replace "%" "/" file 189 190writeLog1 :: FilePath -> [LogLine] -> IO () 191writeLog1 file ls = viaTmp L.writeFile file (toLazyByteString $ buildLog ls) 192 193readLog1 :: FilePath -> IO [LogLine] 194readLog1 file = catchDefaultIO [] $ 195 parseLog . encodeBL <$> readFileStrict file 196 197lookupKey1 :: FilePath -> Annex (Maybe (Key, Backend)) 198lookupKey1 file = do 199 tl <- liftIO $ tryIO getsymlink 200 case tl of 201 Left _ -> return Nothing 202 Right l -> makekey l 203 where 204 getsymlink = takeFileName <$> readSymbolicLink file 205 makekey l = maybeLookupBackendVariety (fromKey keyVariety k) >>= \case 206 Nothing -> do 207 unless (null kname || null bname || 208 not (isLinkToAnnex (toRawFilePath l))) $ 209 warning skip 210 return Nothing 211 Just backend -> return $ Just (k, backend) 212 where 213 k = fileKey1 l 214 bname = decodeBS (formatKeyVariety (fromKey keyVariety k)) 215 kname = decodeBS (fromKey keyName k) 216 skip = "skipping " ++ file ++ 217 " (unknown backend " ++ bname ++ ")" 218 219getKeyFilesPresent1 :: Annex [FilePath] 220getKeyFilesPresent1 = getKeyFilesPresent1' . fromRawFilePath 221 =<< fromRepo gitAnnexObjectDir 222getKeyFilesPresent1' :: FilePath -> Annex [FilePath] 223getKeyFilesPresent1' dir = 224 ifM (liftIO $ doesDirectoryExist dir) 225 ( do 226 dirs <- liftIO $ getDirectoryContents dir 227 let files = map (\d -> dir ++ "/" ++ d ++ "/" ++ takeFileName d) dirs 228 liftIO $ filterM present files 229 , return [] 230 ) 231 where 232 present f = do 233 result <- tryIO $ getFileStatus f 234 case result of 235 Right s -> return $ isRegularFile s 236 Left _ -> return False 237 238logFile1 :: Git.Repo -> Key -> String 239logFile1 repo key = Upgrade.V2.gitStateDir repo ++ keyFile1 key ++ ".log" 240 241logFile2 :: Key -> Git.Repo -> String 242logFile2 = logFile' (hashDirLower def) 243 244logFile' :: (Key -> RawFilePath) -> Key -> Git.Repo -> String 245logFile' hasher key repo = 246 gitStateDir repo ++ fromRawFilePath (hasher key) ++ fromRawFilePath (keyFile key) ++ ".log" 247 248stateDir :: FilePath 249stateDir = addTrailingPathSeparator ".git-annex" 250 251gitStateDir :: Git.Repo -> FilePath 252gitStateDir repo = addTrailingPathSeparator $ 253 fromRawFilePath (Git.repoPath repo) </> stateDir 254