diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 4447dee812..2756af8807 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -13,12 +13,11 @@ import Common.Annex import Command import qualified Backend import qualified Utility.Url as Url -import qualified Remote.Web import qualified Command.Add import qualified Annex import qualified Backend.URL import Annex.Content -import Logs.Presence +import Logs.Web command :: [Command] command = [repoCommand "addurl" (paramRepeating paramUrl) seek @@ -58,14 +57,14 @@ download url file = do Nothing -> stop Just (key, _) -> do moveAnnex key tmp - Remote.Web.setUrl key url InfoPresent + setUrlPresent key url next $ Command.Add.cleanup file key True else stop nodownload :: String -> FilePath -> CommandPerform nodownload url file = do let key = Backend.URL.fromUrl url - Remote.Web.setUrl key url InfoPresent + setUrlPresent key url next $ Command.Add.cleanup file key False diff --git a/Command/Migrate.hs b/Command/Migrate.hs index 23ed6fd162..8167ac96eb 100644 --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -14,6 +14,7 @@ import qualified Types.Key import Annex.Content import qualified Command.Add import Backend +import Logs.Web command :: [Command] command = [repoCommand "migrate" paramPaths seek @@ -65,6 +66,14 @@ perform file oldkey newbackend = do then do -- Update symlink to use the new key. liftIO $ removeFile file + + -- If the old key had some + -- associated urls, record them for + -- the new key as well. + urls <- getUrls oldkey + when (not $ null urls) $ + mapM_ (setUrlPresent newkey) urls + next $ Command.Add.cleanup file newkey True else stop where diff --git a/Logs/Web.hs b/Logs/Web.hs index ff8fbdb6ba..4c8ef7fc00 100644 --- a/Logs/Web.hs +++ b/Logs/Web.hs @@ -9,6 +9,7 @@ module Logs.Web ( URLString, webUUID, setUrl, + setUrlPresent, getUrls ) where @@ -31,6 +32,7 @@ oldurlLog :: Key -> FilePath {- A bug used to store the urls elsewhere. -} oldurlLog key = "remote/web" hashDirLower key show key ++ ".log" +{- Gets all urls that a key might be available from. -} getUrls :: Key -> Annex [URLString] getUrls key = do us <- currentLog (urlLog key) @@ -47,3 +49,6 @@ setUrl key url status = do -- update location log to indicate that the web has the key, or not us <- getUrls key logChange g key webUUID (if null us then InfoMissing else InfoPresent) + +setUrlPresent :: Key -> URLString -> Annex () +setUrlPresent key url = setUrl key url InfoPresent diff --git a/Remote/Web.hs b/Remote/Web.hs index e46937ba5f..21b9818465 100644 --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -5,10 +5,7 @@ - Licensed under the GNU GPL version 3 or higher. -} -module Remote.Web ( - remote, - setUrl -) where +module Remote.Web (remote) where import Common.Annex import Types.Remote diff --git a/debian/changelog b/debian/changelog index 6e3450a926..ce1489e9d0 100644 --- a/debian/changelog +++ b/debian/changelog @@ -2,6 +2,7 @@ git-annex (3.20111012) UNRELEASED; urgency=low * A remote can have a annexUrl configured, that is used by git-annex instead of its usual url. (Similar to pushUrl.) + * migrate: Copy url logs for keys when migrating. -- Joey Hess Fri, 14 Oct 2011 18:15:20 -0400