From f5060c9334cc0c96f11ee085b74d290c2b1d00db Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Sat, 30 May 2015 02:08:49 -0400
Subject: fromkey, registerurl: Improve handling of urls that happen to also be
 parsable as strange keys.

---
 Command/FromKey.hs | 18 +++++++++++++-----
 Types/Key.hs       |  5 +++++
 debian/changelog   |  7 +++++++
 3 files changed, 25 insertions(+), 5 deletions(-)

diff --git a/Command/FromKey.hs b/Command/FromKey.hs
index 584d913fc..51389b770 100644
--- a/Command/FromKey.hs
+++ b/Command/FromKey.hs
@@ -54,12 +54,20 @@ massAdd = go True =<< map (separate (== ' ')) . lines <$> liftIO getContents
 		go status' rest
 	go _ _ = error "Expected pairs of key and file on stdin, but got something else."
 
+-- From user input to a Key.
+-- User can input either a serialized key, or an url.
+--
+-- In some cases, an input can be parsed as both a key and as an uri.
+-- For example, "WORM--a:a" parses as an uri. To disambiguate, check
+-- the uri scheme, to see if it looks like the prefix of a key. This relies
+-- on key backend names never containing a ':'.
 mkKey :: String -> Key
-mkKey s = case file2key s of
-	Just k -> k
-	Nothing -> case parseURI s of
-		Just _u -> Backend.URL.fromUrl s Nothing
-		Nothing -> error $ "bad key " ++ s
+mkKey s = case parseURI s of
+	Just u | not (isKeyPrefix (uriScheme u)) ->
+		Backend.URL.fromUrl s Nothing
+	_ -> case file2key s of
+		Just k -> k
+		Nothing -> error $ "bad key/url " ++ s
 
 perform :: Key -> FilePath -> CommandPerform
 perform key file = do
diff --git a/Types/Key.hs b/Types/Key.hs
index 037437303..553fd8f3d 100644
--- a/Types/Key.hs
+++ b/Types/Key.hs
@@ -16,6 +16,7 @@ module Types.Key (
 	nonChunkKey,
 	chunkKeyOffset,
 	isChunkKey,
+	isKeyPrefix,
 
 	prop_idempotent_key_encode,
 	prop_idempotent_key_decode
@@ -66,6 +67,10 @@ chunkKeyOffset k = (*)
 isChunkKey :: Key -> Bool
 isChunkKey k = isJust (keyChunkSize k) && isJust (keyChunkNum k)
 
+-- Checks if a string looks like at least the start of a key.
+isKeyPrefix :: String -> Bool
+isKeyPrefix s = [fieldSep, fieldSep] `isInfixOf` s
+
 fieldSep :: Char
 fieldSep = '-'
 
diff --git a/debian/changelog b/debian/changelog
index 8fdf5ef7e..42a8d29df 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,10 @@
+git-annex (5.20150529) UNRELEASED; urgency=medium
+
+  * fromkey, registerurl: Improve handling of urls that happen to also
+    be parsable as strange keys.
+
+ -- Joey Hess <id@joeyh.name>  Sat, 30 May 2015 02:07:18 -0400
+
 git-annex (5.20150528) unstable; urgency=medium
 
   * fromkey, registerurl: Allow urls to be specified instead of keys,
-- 
cgit v1.2.3