diff options
| -rw-r--r-- | Annex/ReplaceFile.hs | 3 | ||||
| -rw-r--r-- | Backend/URL.hs | 26 | ||||
| -rw-r--r-- | Command/Add.hs | 4 | ||||
| -rw-r--r-- | Command/AddUrl.hs | 16 | ||||
| -rw-r--r-- | Utility/FileSystemEncoding.hs | 20 | ||||
| -rw-r--r-- | Utility/Path.hs | 19 | ||||
| -rw-r--r-- | Utility/Tmp.hs | 17 | ||||
| -rw-r--r-- | debian/changelog | 2 |
8 files changed, 82 insertions, 25 deletions
diff --git a/Annex/ReplaceFile.hs b/Annex/ReplaceFile.hs index 93f807978..dd93b471c 100644 --- a/Annex/ReplaceFile.hs +++ b/Annex/ReplaceFile.hs @@ -31,8 +31,7 @@ replaceFile file a = do liftIO $ catchIO (rename tmpfile file) (fallback tmpfile) where setup tmpdir = do - (tmpfile, h) <- openTempFileWithDefaultPermissions tmpdir $ - takeFileName file + (tmpfile, h) <- openTempFileWithDefaultPermissions tmpdir "tmp" hClose h return tmpfile fallback tmpfile _ = do diff --git a/Backend/URL.hs b/Backend/URL.hs index 9e1652970..ace578a24 100644 --- a/Backend/URL.hs +++ b/Backend/URL.hs @@ -27,16 +27,18 @@ backend = Backend , canUpgradeKey = Nothing } -fromUrl :: String -> Maybe Integer -> Key -fromUrl url size = stubKey - { keyName = key - , keyBackendName = "URL" - , keySize = size +{- 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. -} +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) + return $ stubKey + { keyName = key + , keyBackendName = "URL" + , keySize = size } - where - {- when it's not too long, use the url as the key name - - 256 is the absolute filename max, but use a shorter - - length because this is not the entire key filename. -} - key - | length url < 128 = url - | otherwise = take 128 url ++ "-" ++ md5s (Str url) diff --git a/Command/Add.hs b/Command/Add.hs index b4141d06f..245ca2bd6 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -31,6 +31,7 @@ import Config import Utility.InodeCache import Annex.FileMatcher import Annex.ReplaceFile +import Utility.Tmp def :: [Command] def = [notBareRepo $ command "add" paramPaths seek SectionCommon @@ -105,7 +106,8 @@ lockDown file = ifM (crippledFileSystem) unlessM (isDirect) $ liftIO $ void $ tryIO $ preventWrite file liftIO $ catchMaybeIO $ do - (tmpfile, h) <- openTempFile tmp (takeFileName file) + (tmpfile, h) <- openTempFile tmp $ + relatedTemplate $ takeFileName file hClose h nukeFile tmpfile withhardlink tmpfile `catchIO` const nohardlink diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 5c8c224f2..5591bc7ee 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -54,7 +54,8 @@ start relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI s bad = fromMaybe (error $ "bad url " ++ s) $ parseURI $ escapeURIString isUnescapedInURI s go url = do - let file = fromMaybe (url2file url pathdepth) optfile + pathmax <- liftIO $ fileNameLengthLimit "." + let file = fromMaybe (url2file url pathdepth pathmax) optfile showStart "addurl" file next $ perform relaxed s file @@ -122,7 +123,7 @@ download url file = do liftIO $ snd <$> Url.exists url headers , return Nothing ) - return $ Backend.URL.fromUrl url size + Backend.URL.fromUrl url size runtransfer dummykey tmp = Transfer.download webUUID dummykey (Just file) Transfer.forwardRetry $ const $ do liftIO $ createDirectoryIfMissing True (parentDir tmp) @@ -151,15 +152,15 @@ nodownload relaxed url file = do else liftIO $ Url.exists url headers if exists then do - let key = Backend.URL.fromUrl url size + key <- Backend.URL.fromUrl url size cleanup url file key Nothing else do warning $ "unable to access url: " ++ url return False -url2file :: URI -> Maybe Int -> FilePath -url2file url pathdepth = case pathdepth of - Nothing -> filesize $ escape fullurl +url2file :: URI -> Maybe Int -> Int -> FilePath +url2file url pathdepth pathmax = case pathdepth of + Nothing -> truncateFilePath pathmax $ escape fullurl Just depth | depth >= length urlbits -> frombits id | depth > 0 -> frombits $ drop depth @@ -168,7 +169,6 @@ url2file url pathdepth = case pathdepth of where fullurl = uriRegName auth ++ uriPath url ++ uriQuery url frombits a = intercalate "/" $ a urlbits - urlbits = map (filesize . escape) $ filter (not . null) $ split "/" fullurl + urlbits = map (truncateFilePath pathmax . escape) $ filter (not . null) $ split "/" fullurl auth = fromMaybe (error $ "bad url " ++ show url) $ uriAuthority url - filesize = take 255 escape = replace "/" "_" . replace "?" "_" diff --git a/Utility/FileSystemEncoding.hs b/Utility/FileSystemEncoding.hs index 98f2f7755..ac105e73d 100644 --- a/Utility/FileSystemEncoding.hs +++ b/Utility/FileSystemEncoding.hs @@ -1,6 +1,6 @@ {- GHC File system encoding handling. - - - Copyright 2012 Joey Hess <joey@kitenet.net> + - Copyright 2012-2013 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} @@ -10,7 +10,8 @@ module Utility.FileSystemEncoding ( withFilePath, md5FilePath, decodeW8, - encodeW8 + encodeW8, + truncateFilePath, ) where import qualified GHC.Foreign as GHC @@ -75,3 +76,18 @@ encodeW8 w8 = unsafePerformIO $ do - represent the FilePath on disk. -} decodeW8 :: FilePath -> [Word8] decodeW8 = s2w8 . _encodeFilePath + +{- Truncates a FilePath to the given number of bytes (or less), + - as represented on disk. + - + - Avoids returning an invalid part of a unicode byte sequence, at the + - cost of efficiency when running on a large FilePath. + -} +truncateFilePath :: Int -> FilePath -> FilePath +truncateFilePath n = go . reverse + where + go f = + let bytes = decodeW8 f + in if length bytes <= n + then reverse f + else go (drop 1 f) diff --git a/Utility/Path.hs b/Utility/Path.hs index 216b2401d..0a9931c46 100644 --- a/Utility/Path.hs +++ b/Utility/Path.hs @@ -21,6 +21,7 @@ import Data.Char import qualified System.FilePath.Posix as Posix #else import qualified "MissingH" System.Path as MissingH +import System.Posix.Files #endif import Utility.Monad @@ -217,3 +218,21 @@ toCygPath p | hasTrailingPathSeparator p = Posix.addTrailingPathSeparator s | otherwise = s #endif + +{- Maximum size to use for a file in a specified directory. + - + - Many systems have a 255 byte limit to the name of a file, + - so that's taken as the max if the system has a larger limit, or has no + - limit. + -} +fileNameLengthLimit :: FilePath -> IO Int +#ifdef __WINDOWS__ +fileNameLengthLimit _ = return 255 +#else +fileNameLengthLimit dir = do + l <- fromIntegral <$> getPathVar dir FileNameLimit + if l <= 0 + then return 255 + else return $ minimum [l, 255] + where +#endif diff --git a/Utility/Tmp.hs b/Utility/Tmp.hs index f03e4c0dc..186cd121a 100644 --- a/Utility/Tmp.hs +++ b/Utility/Tmp.hs @@ -14,6 +14,7 @@ import Control.Monad.IfElse import Utility.Exception import System.FilePath +import Utility.FileSystemEncoding type Template = String @@ -69,3 +70,19 @@ withTmpDirIn tmpdir template = bracket create remove let dir = t ++ "." ++ show n either (const $ makenewdir t $ n + 1) (const $ return dir) =<< tryIO (createDirectory dir) + +{- It's not safe to use a FilePath of an existing file as the template + - for openTempFile, because if the FilePath is really long, the tmpfile + - will be longer, and may exceed the maximum filename length. + - + - This generates a template that is never too long. + - (Well, it allocates 20 characters for use in making a unique temp file, + - anyway, which is enough for the current implementation and any + - likely implementation.) + -} +relatedTemplate :: FilePath -> FilePath +relatedTemplate f + | len > 20 = truncateFilePath (len - 20) f + | otherwise = f + where + len = length f diff --git a/debian/changelog b/debian/changelog index 94143d0fc..499f09a10 100644 --- a/debian/changelog +++ b/debian/changelog @@ -29,6 +29,8 @@ git-annex (4.20130724) UNRELEASED; urgency=low can be clicked on the open a new webapp when the assistant is already running. * Improve test suite on Windows; now tests git annex sync. + * Fix a few bugs involving filenames that are at or near the filesystem's + maximum filename length limit. -- Joey Hess <joeyh@debian.org> Tue, 23 Jul 2013 12:39:48 -0400 |