migrate: Copy url logs for keys when migrating.

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
 

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

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

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

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