diff options
author | 2011-03-16 01:23:20 -0400 | |
---|---|---|
committer | 2011-03-16 01:23:20 -0400 | |
commit | e227c210ec817eca6b4409cb4cc893f791d51c00 (patch) | |
tree | 3e46ece96f39697614843c976308cf43c7605d0b /Upgrade/V1.hs | |
parent | f1e010f42e373bd0658c3b9c6ab67cd84715ad60 (diff) |
upgrade groundwork
pulled in old versions of functions for working with keys
Wrote a parser from old key filenames to new keys.
Diffstat (limited to 'Upgrade/V1.hs')
-rw-r--r-- | Upgrade/V1.hs | 155 |
1 files changed, 155 insertions, 0 deletions
diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs new file mode 100644 index 000000000..dd51206b3 --- /dev/null +++ b/Upgrade/V1.hs @@ -0,0 +1,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 |