summaryrefslogtreecommitdiff
path: root/Upgrade/V1.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-03-16 01:23:20 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-03-16 01:23:20 -0400
commite227c210ec817eca6b4409cb4cc893f791d51c00 (patch)
tree3e46ece96f39697614843c976308cf43c7605d0b /Upgrade/V1.hs
parentf1e010f42e373bd0658c3b9c6ab67cd84715ad60 (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.hs155
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