diff --git a/Annex/Branch.hs b/Annex/Branch.hs --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -34,7 +34,6 @@ import Data.Function import Data.Char import Control.Concurrent (threadDelay) -import System.IO.Unsafe (unsafeInterleaveIO) import Annex.Common import Annex.BranchState @@ -335,23 +334,16 @@ commitIndex' jl committedref racemessage basemessage retrynum' [committedref] {- Lists all files on the branch. including ones in the journal - - that have not been committed yet. There may be duplicates in the list. - - Streams lazily. -} + - that have not been committed yet. There may be duplicates in the list. -} files :: Annex [FilePath] files = do update - withIndex $ do - g <- gitRepo - withJournalHandle (go g) - where - go g jh = readDirectory jh >>= \case - Nothing -> branchFiles' g - Just file - | dirCruft file -> go g jh - | otherwise -> do - let branchfile = fileJournal file - rest <- unsafeInterleaveIO (go g jh) - return (branchfile:rest) + -- ++ forces the content of the first list to be buffered in memory, + -- so use getJournalledFilesStale which should be much smaller most + -- of the time. branchFiles will stream as the list is consumed. + (++) + <$> getJournalledFilesStale + <*> branchFiles {- Files in the branch, not including any from journalled changes, - and without updating the branch. -} diff --git a/Annex/Journal.hs b/Annex/Journal.hs --- a/Annex/Journal.hs +++ b/Annex/Journal.hs @@ -55,6 +55,16 @@ getJournalFileStale file = inRepo $ \g -> catchMaybeIO $ readFileStrict $ journalFile file g +{- List of existing journal files, but without locking, may miss new ones + - just being added, or may have false positives if the journal is staged + - as it is run. -} +getJournalledFilesStale :: Annex [FilePath] +getJournalledFilesStale = do + g <- gitRepo + fs <- liftIO $ catchDefaultIO [] $ + getDirectoryContents $ gitAnnexJournalDir g + return $ filter (`notElem` [".", ".."]) $ map fileJournal fs + withJournalHandle :: (DirectoryHandle -> IO a) -> Annex a withJournalHandle a = do d <- fromRepo gitAnnexJournalDir diff --git a/Annex/Transfer.hs b/Annex/Transfer.hs --- a/Annex/Transfer.hs +++ b/Annex/Transfer.hs @@ -199,7 +199,8 @@ {- Retries a transfer when it fails, as long as the failed transfer managed - to send some data. -} forwardRetry :: RetryDecider -forwardRetry = pure $ \old new -> pure $ bytesComplete old < bytesComplete new +forwardRetry = pure $ \old new -> pure $ + fromMaybe 0 (bytesComplete old) < fromMaybe 0 (bytesComplete new) {- Retries a number of times with growing delays in between when enabled - by git configuration. -} diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,22 @@ +git-annex (6.20180509) upstream; urgency=medium + + * The old git-annex Android app is now deprecated in favor of running + git-annex in termux. + * runshell: Use proot when running on Android, to work around + Android 8's ill-advised seccomp filtering of system calls, + including ones crucial for reliable thread locking. + (This will only work with termux's version of proot.) + * Fix bug in last release that crashes when using + --all or running git-annex in a bare repository. May have also + affected git-annex unused and git-annex info. + * Fix bug in last release that prevented the webapp opening on + non-Linux systems. + * Support building with hinotify-0.3.10. + * Display error message when http download fails. + * Avoid forward retry when 0 bytes were received. + + -- Joey Hess Wed, 09 May 2018 16:20:26 -0400 + git-annex (6.20180427) upstream; urgency=medium * move: Now takes numcopies configuration, and required content diff --git a/Utility/Android.hs b/Utility/Android.hs --- a/Utility/Android.hs +++ b/Utility/Android.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + {- Android stuff - - Copyright 2018 Joey Hess @@ -14,4 +16,9 @@ -- Note that this relies on termux's uname having been built with "Android" -- as the os name. Often on Android, uname will report "Linux". osAndroid :: IO Bool -osAndroid = ("Android" `isPrefixOf` ) <$> readProcess "uname" ["-o"] +#ifdef linux_HOST_OS +osAndroid = catchDefaultIO False $ + ("Android" `isPrefixOf` ) <$> readProcess "uname" ["-o"] +#else +osAndroid = return False +#endif diff --git a/Utility/DirWatcher/INotify.hs b/Utility/DirWatcher/INotify.hs --- a/Utility/DirWatcher/INotify.hs +++ b/Utility/DirWatcher/INotify.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + {- higher-level inotify interface - - Copyright 2012 Joey Hess @@ -10,6 +12,9 @@ import Common hiding (isDirectory) import Utility.ThreadLock import Utility.DirWatcher.Types +#if MIN_VERSION_hinotify(0,3,10) +import Utility.FileSystemEncoding +#endif import System.INotify import qualified System.Posix.Files as Files @@ -55,7 +60,7 @@ lock <- newLock let handler event = withLock lock (void $ go event) flip catchNonAsync failedwatch $ do - void (addWatch i watchevents dir handler) + void (addWatch i watchevents (toInternalFilePath dir) handler) `catchIO` failedaddwatch withLock lock $ mapM_ scan =<< filter (not . dirCruft) <$> @@ -93,7 +98,7 @@ | otherwise -> noop - go (Created { isDirectory = isd, filePath = f }) + go (Created { isDirectory = isd, filePath = fi }) | isd = recurse $ indir f | otherwise = do ms <- getstatus f @@ -106,28 +111,39 @@ when (hashook addHook) $ runhook addHook f ms _ -> noop + where + f = fromInternalFilePath fi + -- Closing a file is assumed to mean it's done being written, -- so a new add event is sent. - go (Closed { isDirectory = False, maybeFilePath = Just f }) = - checkfiletype Files.isRegularFile addHook f + go (Closed { isDirectory = False, maybeFilePath = Just fi }) = + checkfiletype Files.isRegularFile addHook $ + fromInternalFilePath fi + -- When a file or directory is moved in, scan it to add new -- stuff. - go (MovedIn { filePath = f }) = scan f - go (MovedOut { isDirectory = isd, filePath = f }) + go (MovedIn { filePath = fi }) = scan $ fromInternalFilePath fi + go (MovedOut { isDirectory = isd, filePath = fi }) | isd = runhook delDirHook f Nothing | otherwise = runhook delHook f Nothing + where + f = fromInternalFilePath fi + -- Verify that the deleted item really doesn't exist, -- since there can be spurious deletion events for items -- in a directory that has been moved out, but is still -- being watched. - go (Deleted { isDirectory = isd, filePath = f }) + go (Deleted { isDirectory = isd, filePath = fi }) | isd = guarded $ runhook delDirHook f Nothing | otherwise = guarded $ runhook delHook f Nothing where guarded = unlessM (filetype (const True) f) - go (Modified { isDirectory = isd, maybeFilePath = Just f }) + f = fromInternalFilePath fi + + go (Modified { isDirectory = isd, maybeFilePath = Just fi }) | isd = noop - | otherwise = runhook modifyHook f Nothing + | otherwise = runhook modifyHook (fromInternalFilePath fi) Nothing + go _ = noop hashook h = isJust $ h hooks @@ -185,3 +201,15 @@ Nothing -> return Nothing Just s -> return $ parsesysctl s parsesysctl s = readish =<< lastMaybe (words s) + +#if MIN_VERSION_hinotify(0,3,10) +toInternalFilePath :: FilePath -> RawFilePath +toInternalFilePath = toRawFilePath +fromInternalFilePath :: RawFilePath -> FilePath +fromInternalFilePath = fromRawFilePath +#else +toInternalFilePath :: FilePath -> FilePath +toInternalFilePath = id +fromInternalFilePath :: FilePath -> FilePath +fromInternalFilePath = id +#endif diff --git a/Utility/FileSystemEncoding.hs b/Utility/FileSystemEncoding.hs --- a/Utility/FileSystemEncoding.hs +++ b/Utility/FileSystemEncoding.hs @@ -12,6 +12,9 @@ useFileSystemEncoding, fileEncoding, withFilePath, + RawFilePath, + fromRawFilePath, + toRawFilePath, decodeBS, encodeBS, decodeW8, @@ -32,6 +35,7 @@ import System.IO.Unsafe import Data.Word import Data.List +import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L #ifdef mingw32_HOST_OS import qualified Data.ByteString.Lazy.UTF8 as L8 @@ -119,6 +123,22 @@ #else encodeBS = L8.fromString #endif + +{- Recent versions of the unix package have this alias; defined here + - for backwards compatibility. -} +type RawFilePath = S.ByteString + +{- Note that the RawFilePath is assumed to never contain NUL, + - since filename's don't. This should only be used with actual + - RawFilePaths not arbitrary ByteString that may contain NUL. -} +fromRawFilePath :: RawFilePath -> FilePath +fromRawFilePath = encodeW8 . S.unpack + +{- Note that the FilePath is assumed to never contain NUL, + - since filename's don't. This should only be used with actual FilePaths + - not arbitrary String that may contain NUL. -} +toRawFilePath :: FilePath -> RawFilePath +toRawFilePath = S.pack . decodeW8 {- Converts a [Word8] to a FilePath, encoding using the filesystem encoding. - diff --git a/Utility/Url.hs b/Utility/Url.hs --- a/Utility/Url.hs +++ b/Utility/Url.hs @@ -250,9 +250,13 @@ - By default, conduit is used for the download, except for file: urls, - which are copied. If the url scheme is not supported by conduit, falls - back to using curl. + - + - Displays error message on stderr when download failed. -} download :: MeterUpdate -> URLString -> FilePath -> UrlOptions -> IO Bool -download meterupdate url file uo = go `catchNonAsync` (const $ return False) +download meterupdate url file uo = + catchJust matchHttpException go showhttpexception + `catchNonAsync` showerr where go = case parseURIRelaxed url of Just u -> case (urlDownloader uo, parseUrlConduit (show u)) of @@ -277,7 +281,7 @@ resp <- http req (httpManager uo) if responseStatus resp == ok200 then store zeroBytesProcessed WriteMode resp - else return False + else showrespfailure resp Just sz -> resumeconduit req sz alreadydownloaded sz s h = s == requestedRangeNotSatisfiable416 @@ -302,8 +306,33 @@ then store (BytesProcessed sz) AppendMode resp else if responseStatus resp == ok200 then store zeroBytesProcessed WriteMode resp - else return False + else showrespfailure resp + showrespfailure resp = liftIO $ do + hPutStrLn stderr $ B8.toString $ + statusMessage $ responseStatus resp + hFlush stderr + return False + showhttpexception he = do +#if MIN_VERSION_http_client(0,5,0) + let msg = case he of + HttpExceptionRequest _ (StatusCodeException _ msgb) -> + B8.toString msgb + HttpExceptionRequest _ other -> show other + _ -> show he +#else + let msg = case he of + StatusCodeException status _ _ -> statusMessage status + _ -> show he +#endif + hPutStrLn stderr $ "download failed: " ++ msg + hFlush stderr + return False + showerr e = do + hPutStrLn stderr (show e) + hFlush stderr + return False + store initialp mode resp = do sinkResponseFile meterupdate initialp file mode resp return True @@ -441,6 +470,13 @@ | otherwise = Nothing matchStatusCodeHeadersException _ _ = Nothing #endif + +{- Use with eg: + - + - > catchJust matchHttpException + -} +matchHttpException :: HttpException -> Maybe HttpException +matchHttpException = Just #if MIN_VERSION_http_client(0,5,0) matchHttpExceptionContent :: (HttpExceptionContent -> Bool) -> HttpException -> Maybe HttpException diff --git a/git-annex.cabal b/git-annex.cabal --- a/git-annex.cabal +++ b/git-annex.cabal @@ -1,5 +1,5 @@ Name: git-annex -Version: 6.20180427 +Version: 6.20180509 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess