Better sanitization of problem characters when generating URL and WORM keys.

FAT has a lot of characters it does not allow in filenames, like ? and *
It's probably the worst offender, but other filesystems also have
limitiations.

In 2011, I made keyFile escape : to handle FAT, but missed the other
characters. It also turns out that when I did that, I was also living
dangerously; any existing keys that contained a : had their object
location change. Oops.

So, adding new characters to escape to keyFile is out. Well, it would be
possible to make keyFile behave differently on a per-filesystem basis, but
this would be a real nightmare to get right. Consider that a rsync special
remote uses keyFile to determine the filenames to use, and we don't know
the underlying filesystem on the rsync server..

Instead, I have gone for a solution that is backwards compatable and
simple. Its only downside is that already generated URL and WORM keys
might not be able to be stored on FAT or some other filesystem that
dislikes a character used in the key. (In this case, the user can just
migrate the problem keys to a checksumming backend. If this became a big
problem, fsck could be made to detect these and suggest a migration.)

Going forward, new keys that are created will escape all characters that
are likely to cause problems. And if some filesystem comes along that's
even worse than FAT (seems unlikely, but here it is 2013, and people are
still using FAT!), additional characters can be added to the set that are
escaped without difficulty.

(Also, made WORM limit the part of the filename that is embedded in the key,
to deal with filesystem filename length limits. This could have already
been a problem, but is more likely now, since the escaping of the filename
can make it longer.)

This commit was sponsored by Ian Downes

3 files changed, 38 insertions, 18 deletions

diff --git a/Backend/URL.hs b/Backend/URL.hs
index ace578a24..a8161c98d 100644
--- a/Backend/URL.hs
+++ b/Backend/URL.hs
@@ -10,11 +10,10 @@ module Backend.URL (
 	fromUrl
 ) where
 
-import Data.Hash.MD5
-
 import Common.Annex
 import Types.Backend
 import Types.Key
+import Backend.Utilities
 
 backends :: [Backend]
 backends = [backend]
@@ -27,18 +26,12 @@ backend = Backend
 	, canUpgradeKey = Nothing
 	}
 
-{- When it's not too long, use the full url as the key name.
- - If the url is too long, it's truncated at half the filename length
- - limit, and the md5 of the url is prepended to ensure a unique key. -}
+{- Every unique url has a corresponding key. -}
 fromUrl :: String -> Maybe Integer -> Annex Key
 fromUrl url size = do
-	limit <- liftIO . fileNameLengthLimit =<< fromRepo gitAnnexDir
-	let truncurl = truncateFilePath (limit `div` 2) url
-	let key = if url == truncurl
-		then url
-		else truncurl ++ "-" ++ md5s (Str url)
+	n <- genKeyName url
 	return $ stubKey
-		{ keyName = key
+		{ keyName = n
 		, keyBackendName = "URL"
 		, keySize = size
-	}
+		}
diff --git a/Backend/Utilities.hs b/Backend/Utilities.hs
new file mode 100644
index 000000000..24dbfd6d9
--- /dev/null
+++ b/Backend/Utilities.hs
@@ -0,0 +1,25 @@
+{- git-annex backend utilities
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Backend.Utilities where
+
+import Data.Hash.MD5
+
+import Common.Annex
+
+{- Generates a keyName from an input string. Takes care of sanitizing it.
+ - If it's not too long, the full string is used as the keyName.
+ - Otherwise, it's truncated at half the filename length limit, and its
+ - md5 is prepended to ensure a unique key. -}
+genKeyName :: String -> Annex String
+genKeyName s = do
+	limit <- liftIO . fileNameLengthLimit =<< fromRepo gitAnnexDir
+	let s' = preSanitizeKeyName s
+	let truncs = truncateFilePath (limit `div` 2) s'
+	return $ if s' == truncs
+		then s'
+		else truncs ++ "-" ++ md5s (Str s)
diff --git a/Backend/WORM.hs b/Backend/WORM.hs
index 3471eedc1..60db42f56 100644
--- a/Backend/WORM.hs
+++ b/Backend/WORM.hs
@@ -11,6 +11,7 @@ import Common.Annex
 import Types.Backend
 import Types.Key
 import Types.KeySource
+import Backend.Utilities
 
 backends :: [Backend]
 backends = [backend]
@@ -33,9 +34,10 @@ backend = Backend
 keyValue :: KeySource -> Annex (Maybe Key)
 keyValue source = do
 	stat <- liftIO $ getFileStatus $ contentLocation source
-	return $ Just Key {
-		keyName = takeFileName $ keyFilename source,
-		keyBackendName = name backend,
-		keySize = Just $ fromIntegral $ fileSize stat,
-		keyMtime = Just $ modificationTime stat
-	}
+	n <- genKeyName $ keyFilename source
+	return $ Just Key
+		{ keyName = n
+		, keyBackendName = name backend
+		, keySize = Just $ fromIntegral $ fileSize stat
+		, keyMtime = Just $ modificationTime stat
+		}