migrate: Copy url logs for keys when migrating.

5 files changed, 19 insertions, 8 deletions

diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs
index 4447dee81..2756af880 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 23ed6fd16..8167ac96e 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 ff8fbdb6b..4c8ef7fc0 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 e46937ba5..21b981846 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 6e3450a92..ce1489e9d 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 <joeyh@debian.org>  Fri, 14 Oct 2011 18:15:20 -0400