fromkey, registerurl: Improve handling of urls that happen to also be parsable as strange keys.

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

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 = '-'
 

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,