diff --git a/Annex/ExternalAddonProcess.hs b/Annex/ExternalAddonProcess.hs --- a/Annex/ExternalAddonProcess.hs +++ b/Annex/ExternalAddonProcess.hs @@ -55,14 +55,20 @@ started cmd errrelayer pall@(Just hin, Just hout, Just herr, ph) = do stderrelay <- async $ errrelayer herr let shutdown forcestop = do - cancel stderrelay + -- Close the process's stdin, to let it know there + -- are no more requests, so it will exit. + hClose hout + -- Close the procces's stdout as we're not going to + -- process any more output from it. + hClose hin if forcestop then cleanupProcess pall - else flip onException (cleanupProcess pall) $ do - hClose herr - hClose hin - hClose hout - void $ waitForProcess ph + else void (waitForProcess ph) + `onException` cleanupProcess pall + -- This thread will exit after consuming any + -- remaining stderr from the process. + () <- wait stderrelay + hClose herr return $ ExternalAddonProcess { externalSend = hin , externalReceive = hout diff --git a/Annex/FileMatcher.hs b/Annex/FileMatcher.hs --- a/Annex/FileMatcher.hs +++ b/Annex/FileMatcher.hs @@ -25,6 +25,7 @@ AddUnlockedMatcher, addUnlockedMatcher, checkAddUnlockedMatcher, + LimitBy(..), module Types.FileMatcher ) where diff --git a/Annex/Hook.hs b/Annex/Hook.hs --- a/Annex/Hook.hs +++ b/Annex/Hook.hs @@ -18,16 +18,6 @@ import qualified Data.Map as M --- Remove all hooks. -unHook :: Annex () -unHook = do - hookUnWrite preCommitHook - hookUnWrite postReceiveHook - hookUnWrite postCheckoutHook - hookUnWrite postMergeHook - hookUnWrite preCommitAnnexHook - hookUnWrite postUpdateAnnexHook - preCommitHook :: Git.Hook preCommitHook = Git.Hook "pre-commit" (mkHookScript "git annex pre-commit .") [] diff --git a/Annex/Init.hs b/Annex/Init.hs --- a/Annex/Init.hs +++ b/Annex/Init.hs @@ -145,7 +145,11 @@ uninitialize :: Annex () uninitialize = do - unHook + -- Remove hooks that are written when initializing. + hookUnWrite preCommitHook + hookUnWrite postReceiveHook + hookUnWrite postCheckoutHook + hookUnWrite postMergeHook deconfigureSmudgeFilter removeRepoUUID removeVersion diff --git a/Annex/Locations.hs b/Annex/Locations.hs --- a/Annex/Locations.hs +++ b/Annex/Locations.hs @@ -47,6 +47,8 @@ gitAnnexFsckResultsLog, gitAnnexSmudgeLog, gitAnnexSmudgeLock, + gitAnnexMoveLog, + gitAnnexMoveLock, gitAnnexExportDir, gitAnnexExportDbDir, gitAnnexExportLock, @@ -76,7 +78,7 @@ gitAnnexPidFile, gitAnnexPidLockFile, gitAnnexDaemonStatusFile, - gitAnnexLogFile, + gitAnnexDaemonLogFile, gitAnnexFuzzTestLogFile, gitAnnexHtmlShim, gitAnnexUrlFile, @@ -377,6 +379,14 @@ gitAnnexSmudgeLock :: Git.Repo -> FilePath gitAnnexSmudgeLock r = fromRawFilePath $ gitAnnexDir r P. "smudge.lck" +{- .git/annex/move.log is used to log moves that are in progress, + - to better support resuming an interrupted move. -} +gitAnnexMoveLog :: Git.Repo -> FilePath +gitAnnexMoveLog r = fromRawFilePath $ gitAnnexDir r P. "move.log" + +gitAnnexMoveLock :: Git.Repo -> FilePath +gitAnnexMoveLock r = fromRawFilePath $ gitAnnexDir r P. "move.lck" + {- .git/annex/export/ is used to store information about - exports to special remotes. -} gitAnnexExportDir :: Git.Repo -> FilePath @@ -513,8 +523,8 @@ gitAnnexDir r P. "daemon.status" {- Log file for daemon mode. -} -gitAnnexLogFile :: Git.Repo -> FilePath -gitAnnexLogFile r = fromRawFilePath $ gitAnnexDir r P. "daemon.log" +gitAnnexDaemonLogFile :: Git.Repo -> FilePath +gitAnnexDaemonLogFile r = fromRawFilePath $ gitAnnexDir r P. "daemon.log" {- Log file for fuzz test. -} gitAnnexFuzzTestLogFile :: Git.Repo -> FilePath diff --git a/Annex/View.hs b/Annex/View.hs --- a/Annex/View.hs +++ b/Annex/View.hs @@ -235,27 +235,34 @@ pseudoBackslash :: String pseudoBackslash = "\56546\56469\56498" +-- And this is '﹕' similarly. +pseudoColon :: String +pseudoColon = "\56559\56505\56469" + toViewPath :: MetaValue -> FilePath -toViewPath = escapeslash [] . decodeBS . fromMetaValue +toViewPath = escapepseudo [] . decodeBS . fromMetaValue where - escapeslash s ('/':cs) = escapeslash (pseudoSlash:s) cs - escapeslash s ('\\':cs) = escapeslash (pseudoBackslash:s) cs - escapeslash s ('%':cs) = escapeslash ("%%":s) cs - escapeslash s (c1:c2:c3:cs) - | [c1,c2,c3] == pseudoSlash = escapeslash ("%":pseudoSlash:s) cs - | [c1,c2,c3] == pseudoBackslash = escapeslash ("%":pseudoBackslash:s) cs - | otherwise = escapeslash ([c1]:s) (c2:c3:cs) - escapeslash s cs = concat (reverse (cs:s)) + escapepseudo s ('/':cs) = escapepseudo (pseudoSlash:s) cs + escapepseudo s ('\\':cs) = escapepseudo (pseudoBackslash:s) cs + escapepseudo s (':':cs) = escapepseudo (pseudoColon:s) cs + escapepseudo s ('%':cs) = escapepseudo ("%%":s) cs + escapepseudo s (c1:c2:c3:cs) + | [c1,c2,c3] == pseudoSlash = escapepseudo ("%":pseudoSlash:s) cs + | [c1,c2,c3] == pseudoBackslash = escapepseudo ("%":pseudoBackslash:s) cs + | [c1,c2,c3] == pseudoColon = escapepseudo ("%":pseudoColon:s) cs + | otherwise = escapepseudo ([c1]:s) (c2:c3:cs) + escapepseudo s cs = concat (reverse (cs:s)) fromViewPath :: FilePath -> MetaValue -fromViewPath = toMetaValue . encodeBS . deescapeslash [] +fromViewPath = toMetaValue . encodeBS . deescapepseudo [] where - deescapeslash s ('%':escapedc:cs) = deescapeslash ([escapedc]:s) cs - deescapeslash s (c1:c2:c3:cs) - | [c1,c2,c3] == pseudoSlash = deescapeslash ("/":s) cs - | [c1,c2,c3] == pseudoBackslash = deescapeslash ("\\":s) cs - | otherwise = deescapeslash ([c1]:s) (c2:c3:cs) - deescapeslash s cs = concat (reverse (cs:s)) + deescapepseudo s ('%':escapedc:cs) = deescapepseudo ([escapedc]:s) cs + deescapepseudo s (c1:c2:c3:cs) + | [c1,c2,c3] == pseudoSlash = deescapepseudo ("/":s) cs + | [c1,c2,c3] == pseudoBackslash = deescapepseudo ("\\":s) cs + | [c1,c2,c3] == pseudoColon = deescapepseudo (":":s) cs + | otherwise = deescapepseudo ([c1]:s) (c2:c3:cs) + deescapepseudo s cs = concat (reverse (cs:s)) prop_viewPath_roundtrips :: MetaValue -> Bool prop_viewPath_roundtrips v = fromViewPath (toViewPath v) == v @@ -353,7 +360,7 @@ topf <- inRepo (toTopFilePath f) go uh topf sha (toTreeItemType mode) =<< lookupKey f liftIO $ void clean - genViewBranch view + genViewBranch view where genviewedfiles = viewedFiles view mkviewedfile -- enables memoization diff --git a/Assistant.hs b/Assistant.hs --- a/Assistant.hs +++ b/Assistant.hs @@ -74,7 +74,7 @@ Annex.changeState $ \s -> s { Annex.daemon = True } enableInteractiveBranchAccess pidfile <- fromRepo gitAnnexPidFile - logfile <- fromRepo gitAnnexLogFile + logfile <- fromRepo gitAnnexDaemonLogFile liftIO $ debugM desc $ "logging to " ++ logfile createAnnexDirectory (parentDir pidfile) #ifndef mingw32_HOST_OS @@ -127,7 +127,7 @@ start daemonize webappwaiter = withThreadState $ \st -> do checkCanWatch dstatus <- startDaemonStatus - logfile <- fromRepo gitAnnexLogFile + logfile <- fromRepo gitAnnexDaemonLogFile liftIO $ debugM desc $ "logging to " ++ logfile liftIO $ daemonize $ flip runAssistant (go webappwaiter) diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs --- a/Assistant/Threads/SanityChecker.hs +++ b/Assistant/Threads/SanityChecker.hs @@ -221,7 +221,7 @@ -} checkLogSize :: Int -> Assistant () checkLogSize n = do - f <- liftAnnex $ fromRepo gitAnnexLogFile + f <- liftAnnex $ fromRepo gitAnnexDaemonLogFile logs <- liftIO $ listLogs f totalsize <- liftIO $ sum <$> mapM getFileSize logs when (totalsize > 2 * oneMegabyte) $ do diff --git a/Assistant/WebApp/Control.hs b/Assistant/WebApp/Control.hs --- a/Assistant/WebApp/Control.hs +++ b/Assistant/WebApp/Control.hs @@ -72,7 +72,7 @@ getLogR :: Handler Html getLogR = page "Logs" Nothing $ do - logfile <- liftAnnex $ fromRepo gitAnnexLogFile + logfile <- liftAnnex $ fromRepo gitAnnexDaemonLogFile logs <- liftIO $ listLogs logfile logcontent <- liftIO $ concat <$> mapM readFile logs $(widgetFile "control/log") diff --git a/Build/BundledPrograms.hs b/Build/BundledPrograms.hs --- a/Build/BundledPrograms.hs +++ b/Build/BundledPrograms.hs @@ -87,3 +87,17 @@ ifset True s = Just s ifset False _ = Nothing #endif + +magicDLLs :: [FilePath] +#ifdef mingw32_HOST_OS +magicDLLs = ["libmagic-1.dll", "libgnurx-0.dll"] +#else +magicDLLs = [] +#endif + +magicShare :: [FilePath] +#ifdef mingw32_HOST_OS +magicShare = ["magic.mgc"] +#else +magicShare = [] +#endif diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,36 @@ +git-annex (8.20201103) upstream; urgency=medium + + * move: Improve resuming a move that was interrupted after the object + was transferred, in cases where numcopies checks prevented the resumed + move from dropping the object from the source repository. + * When a special remote has chunking enabled, but no chunk sizes are + recorded (or the recorded ones are not found), speculatively try + chunks using the configured chunk size. + * Fixed some problems that prevented this command from working: + git submodule foreach git annex init + * Improve shutdown process for external special remotes and external + backends. Make sure to relay any remaining stderr from the process, + and potentially avoid the process getting a SIGPIPE if it writes to + stderr too late. + * Fix a bug that prevented linux standalone bundle from working on a fresh + install. + * Windows build changed to one done by the datalad-extensions project + using Github actions. + * Windows build now includes libmagic, so mimetype and mimeencoding + will work. + Thanks to John Thorvald Wodder II and Yaroslav Halchenko for their work + on this. + * view: Avoid using ':' from metadata when generating a view, because + it's a special character on Windows ("c:") + * Fix a memory leak introduced in the last release. + * add, import: Fix a reversion in 7.20191009 that broke handling + of --largerthan and --smallerthan. + * view: Fix a reversion in 8.20200522 that broke entering or changing views. + * Fix build on Windows with network-3. + * testremote: Display exceptions when tests fail, to aid debugging. + + -- Joey Hess Tue, 03 Nov 2020 11:40:56 -0400 + git-annex (8.20201007) upstream; urgency=medium * --json output now includes a new field "input" which is the input @@ -454,7 +487,7 @@ git-annex (7.20200202.7) upstream; urgency=medium - * add: --force-annex/--force-git options make it easier to override + * add: --force-large/--force-small options make it easier to override annex.largefiles configuration (and potentially safer as it avoids bugs like the smudge bug fixed in the last release). * reinject --known: Fix bug that prevented it from working in a bare repo. diff --git a/COPYRIGHT b/COPYRIGHT --- a/COPYRIGHT +++ b/COPYRIGHT @@ -18,6 +18,16 @@ Copyright: © 2020 Joey Hess License: GPL-3+ +Files: Command/Sync.hs +Copyright: © Joachim Breitner + © 2011-2020 Joey Hess +License: AGPL-3+ + +Files: Command/List.hs +Copyright: © 2013 Joey Hess + © 2013 Antoine Beaupré +License: AGPL-3+ + Files: Remote/Ddar.hs Copyright: © 2011-2020 Joey Hess © 2014 Robie Basak diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs --- a/CmdLine/GitAnnex/Options.hs +++ b/CmdLine/GitAnnex/Options.hs @@ -223,7 +223,7 @@ annexedMatchingOptions :: [GlobalOption] annexedMatchingOptions = concat [ keyMatchingOptions' - , fileMatchingOptions' + , fileMatchingOptions' Limit.LimitAnnexFiles , combiningOptions , timeLimitOption ] @@ -315,11 +315,11 @@ ] -- Options to match files which may not yet be annexed. -fileMatchingOptions :: [GlobalOption] -fileMatchingOptions = fileMatchingOptions' ++ combiningOptions ++ timeLimitOption +fileMatchingOptions :: Limit.LimitBy -> [GlobalOption] +fileMatchingOptions lb = fileMatchingOptions' lb ++ combiningOptions ++ timeLimitOption -fileMatchingOptions' :: [GlobalOption] -fileMatchingOptions' = +fileMatchingOptions' :: Limit.LimitBy -> [GlobalOption] +fileMatchingOptions' lb = [ globalSetter Limit.addExclude $ strOption ( long "exclude" <> short 'x' <> metavar paramGlob <> help "skip files matching the glob pattern" @@ -330,12 +330,12 @@ <> help "limit to files matching the glob pattern" <> hidden ) - , globalSetter Limit.addLargerThan $ strOption + , globalSetter (Limit.addLargerThan lb) $ strOption ( long "largerthan" <> metavar paramSize <> help "match files larger than a size" <> hidden ) - , globalSetter Limit.addSmallerThan $ strOption + , globalSetter (Limit.addSmallerThan lb) $ strOption ( long "smallerthan" <> metavar paramSize <> help "match files smaller than a size" <> hidden diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs --- a/CmdLine/Seek.hs +++ b/CmdLine/Seek.hs @@ -48,6 +48,7 @@ import Control.Concurrent.Async import System.Posix.Types +import Data.IORef data AnnexedFileSeeker = AnnexedFileSeeker { startAction :: SeekInput -> RawFilePath -> Key -> CommandStart @@ -416,18 +417,24 @@ seekHelper :: (a -> RawFilePath) -> WarnUnmatchWhen -> ([LsFiles.Options] -> [RawFilePath] -> Git.Repo -> IO ([a], IO Bool)) -> WorkTreeItems -> Annex ([(SeekInput, a)], IO Bool) seekHelper c ww a (WorkTreeItems l) = do os <- seekOptions ww - inRepo $ \g -> combinelists <$> forM (segmentXargsOrdered l) - (runSegmentPaths' mk c (\fs -> a os fs g) . map toRawFilePath) + v <- liftIO $ newIORef [] + r <- inRepo $ \g -> concat . concat <$> forM (segmentXargsOrdered l) + (runSegmentPaths' mk c (\fs -> go v os fs g) . map toRawFilePath) + return (r, cleanupall v) where mk (Just i) f = (SeekInput [fromRawFilePath i], f) -- This is not accurate, but it only happens when there are a -- great many input WorkTreeItems. mk Nothing f = (SeekInput [fromRawFilePath (c f)], f) - combinelists v = - let r = concat $ concat $ map fst v - cleanup = and <$> sequence (map snd v) - in (r, cleanup) + go v os fs g = do + (ls, cleanup) <- a os fs g + liftIO $ modifyIORef' v (cleanup:) + return ls + + cleanupall v = do + cleanups <- readIORef v + and <$> sequence cleanups seekHelper _ _ _ NoWorkTreeItems = return ([], pure True) data WarnUnmatchWhen = WarnUnmatchLsFiles | WarnUnmatchWorkTreeItems diff --git a/Command/Add.hs b/Command/Add.hs --- a/Command/Add.hs +++ b/Command/Add.hs @@ -29,9 +29,16 @@ cmd :: Command cmd = notBareRepo $ - withGlobalOptions [jobsOption, jsonOptions, jsonProgressOption, fileMatchingOptions] $ + withGlobalOptions opts $ command "add" SectionCommon "add files to annex" paramPaths (seek <$$> optParser) + where + opts = + [ jobsOption + , jsonOptions + , jsonProgressOption + , fileMatchingOptions LimitDiskFiles + ] data AddOptions = AddOptions { addThese :: CmdParams diff --git a/Command/Import.hs b/Command/Import.hs --- a/Command/Import.hs +++ b/Command/Import.hs @@ -39,11 +39,21 @@ cmd :: Command cmd = notBareRepo $ - withGlobalOptions [jobsOption, jsonOptions, jsonProgressOption, fileMatchingOptions] $ + withGlobalOptions opts $ command "import" SectionCommon "add a tree of files to the repository" (paramPaths ++ "|BRANCH[:SUBDIR]") (seek <$$> optParser) + where + opts = + [ jobsOption + , jsonOptions + , jsonProgressOption + -- These options are only used when importing from a + -- directory, not from a special remote. So it's ok + -- to use LimitDiskFiles. + , fileMatchingOptions LimitDiskFiles + ] data ImportOptions = LocalImportOptions diff --git a/Command/Move.hs b/Command/Move.hs --- a/Command/Move.hs +++ b/Command/Move.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010-2018 Joey Hess + - Copyright 2010-2020 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -16,9 +16,12 @@ import Annex.Transfer import Logs.Presence import Logs.Trust +import Logs.File import Annex.NumCopies import System.Log.Logger (debugM) +import qualified Data.ByteString.Char8 as B8 +import qualified Data.ByteString.Lazy as L cmd :: Command cmd = withGlobalOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMatchingOptions] $ @@ -130,34 +133,36 @@ return $ dest `elem` remotes toPerform :: Remote -> RemoveWhen -> Key -> AssociatedFile -> Bool -> Either String Bool -> CommandPerform -toPerform dest removewhen key afile fastcheck isthere = +toPerform dest removewhen key afile fastcheck isthere = do + srcuuid <- getUUID case isthere of Left err -> do showNote err stop - Right False -> do + Right False -> logMove srcuuid destuuid False key $ \deststartedwithcopy -> do showAction $ "to " ++ Remote.name dest ok <- notifyTransfer Upload afile $ upload (Remote.uuid dest) key afile stdRetry $ Remote.action . Remote.storeKey dest key afile if ok - then finish False $ + then finish deststartedwithcopy $ Remote.logStatus dest key InfoPresent else do when fastcheck $ warning "This could have failed because --fast is enabled." stop - Right True -> finish True $ - unlessM (expectedPresent dest key) $ - Remote.logStatus dest key InfoPresent + Right True -> logMove srcuuid destuuid False key $ \deststartedwithcopy -> + finish deststartedwithcopy $ + unlessM (expectedPresent dest key) $ + Remote.logStatus dest key InfoPresent where + destuuid = Remote.uuid dest finish deststartedwithcopy setpresentremote = case removewhen of RemoveNever -> do setpresentremote next $ return True RemoveSafe -> lockContentForRemoval key lockfailed $ \contentlock -> do srcuuid <- getUUID - let destuuid = Remote.uuid dest willDropMakeItWorse srcuuid destuuid deststartedwithcopy key afile >>= \case DropAllowed -> drophere setpresentremote contentlock "moved" DropCheckNumCopies -> do @@ -211,19 +216,21 @@ fromPerform :: Remote -> RemoveWhen -> Key -> AssociatedFile -> CommandPerform fromPerform src removewhen key afile = do showAction $ "from " ++ Remote.name src - ifM (inAnnex key) - ( dispatch removewhen True True - , dispatch removewhen False =<< go - ) + present <- inAnnex key + destuuid <- getUUID + logMove srcuuid destuuid present key $ \deststartedwithcopy -> + if present + then dispatch removewhen deststartedwithcopy True + else dispatch removewhen deststartedwithcopy =<< get where - go = notifyTransfer Download afile $ + get = notifyTransfer Download afile $ download (Remote.uuid src) key afile stdRetry $ \p -> getViaTmp (Remote.retrievalSecurityPolicy src) (RemoteVerify src) key $ \t -> Remote.verifiedAction $ Remote.retrieveKeyFile src key afile t p + dispatch _ _ False = stop -- failed dispatch RemoveNever _ True = next $ return True -- copy complete dispatch RemoveSafe deststartedwithcopy True = lockContentShared key $ \_lck -> do - let srcuuid = Remote.uuid src destuuid <- getUUID willDropMakeItWorse srcuuid destuuid deststartedwithcopy key afile >>= \case DropAllowed -> dropremote "moved" @@ -233,7 +240,11 @@ verifyEnoughCopiesToDrop "" key Nothing numcopies [Remote.uuid src] verified tocheck (dropremote . showproof) faileddropremote DropWorse -> faileddropremote + + srcuuid = Remote.uuid src + showproof proof = "proof: " ++ show proof + dropremote reason = do liftIO $ debugM "move" $ unwords [ "Dropping from remote" @@ -242,6 +253,7 @@ ] ok <- Remote.action (Remote.removeKey src key) next $ Command.Drop.cleanupRemote key src ok + faileddropremote = do showLongNote "(Use --force to override this check, or adjust numcopies.)" showLongNote $ "Content not dropped from " ++ Remote.name src ++ "." @@ -287,8 +299,8 @@ - This function checks all that. It needs to know if the destination - repository already had a copy of the file before the move began. -} -willDropMakeItWorse :: UUID -> UUID -> Bool -> Key -> AssociatedFile -> Annex DropCheck -willDropMakeItWorse srcuuid destuuid deststartedwithcopy key afile = +willDropMakeItWorse :: UUID -> UUID -> DestStartedWithCopy -> Key -> AssociatedFile -> Annex DropCheck +willDropMakeItWorse srcuuid destuuid (DestStartedWithCopy deststartedwithcopy) key afile = ifM (Command.Drop.checkRequiredContent srcuuid key afile) ( if deststartedwithcopy then unlessforced DropCheckNumCopies @@ -309,3 +321,53 @@ return (desttrust > UnTrusted || desttrust >= srctrust) data DropCheck = DropWorse | DropAllowed | DropCheckNumCopies + +newtype DestStartedWithCopy = DestStartedWithCopy Bool + +{- Runs an action that performs a move, and logs the move, allowing an + - interrupted move to be restarted later. + - + - This deals with the situation where dest did not start with a copy, + - but the move downloaded it, and was then interrupted before dropping + - it from the source. Re-running the move would see dest has a + - copy, and so could refuse to allow the drop. By providing the logged + - DestStartedWithCopy, this avoids that annoyance. + -} +logMove :: UUID -> UUID -> Bool -> Key -> (DestStartedWithCopy -> Annex a) -> Annex a +logMove srcuuid destuuid deststartedwithcopy key a = bracket setup cleanup go + where + logline = L.fromStrict $ B8.unwords + [ fromUUID srcuuid + , fromUUID destuuid + , serializeKey' key + ] + + setup = do + logf <- fromRepo gitAnnexMoveLog + -- Only log when there was no copy. + unless deststartedwithcopy $ + appendLogFile logf gitAnnexMoveLock logline + return logf + + cleanup logf = do + -- This buffers the log file content in memory. + -- The log file length is limited to the number of + -- concurrent jobs, times the number of times a move + -- (of different files) has been interrupted. + -- That could grow without bounds given enough time, + -- so the log is also truncated to the most recent + -- 100 items. + modifyLogFile logf gitAnnexMoveLock + (filter (/= logline) . reverse . take 100 . reverse) + + go logf + -- Only need to check log when there is a copy. + | deststartedwithcopy = do + wasnocopy <- checkLogFile logf gitAnnexMoveLock + (== logline) + if wasnocopy + then go' False + else go' deststartedwithcopy + | otherwise = go' deststartedwithcopy + + go' = a . DestStartedWithCopy diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs --- a/Command/TestRemote.hs +++ b/Command/TestRemote.hs @@ -235,15 +235,15 @@ test :: RunAnnex -> Annex (Maybe Remote) -> Annex Key -> [TestTree] test runannex mkr mkk = [ check "removeKey when not present" $ \r k -> - whenwritable r $ isRight <$> tryNonAsync (remove r k) + whenwritable r $ runBool (remove r k) , check ("present " ++ show False) $ \r k -> whenwritable r $ present r k False , check "storeKey" $ \r k -> - whenwritable r $ isRight <$> tryNonAsync (store r k) + whenwritable r $ runBool (store r k) , check ("present " ++ show True) $ \r k -> whenwritable r $ present r k True , check "storeKey when already present" $ \r k -> - whenwritable r $ isRight <$> tryNonAsync (store r k) + whenwritable r $ runBool (store r k) , check ("present " ++ show True) $ \r k -> present r k True , check "retrieveKeyFile" $ \r k -> do lockContentForRemoval k noop removeAnnex @@ -273,7 +273,7 @@ get r k , check "fsck downloaded object" fsck , check "removeKey when present" $ \r k -> - whenwritable r $ isRight <$> tryNonAsync (remove r k) + whenwritable r $ runBool (remove r k) , check ("present " ++ show False) $ \r k -> whenwritable r $ present r k False ] @@ -306,31 +306,31 @@ [ check "check present export when not present" $ \ea k1 _k2 -> not <$> checkpresentexport ea k1 , check "remove export when not present" $ \ea k1 _k2 -> - isRight <$> tryNonAsync (removeexport ea k1) + runBool (removeexport ea k1) , check "store export" $ \ea k1 _k2 -> - isRight <$> tryNonAsync (storeexport ea k1) + runBool (storeexport ea k1) , check "check present export after store" $ \ea k1 _k2 -> checkpresentexport ea k1 , check "store export when already present" $ \ea k1 _k2 -> - isRight <$> tryNonAsync (storeexport ea k1) + runBool (storeexport ea k1) , check "retrieve export" $ \ea k1 _k2 -> retrieveexport ea k1 , check "store new content to export" $ \ea _k1 k2 -> - isRight <$> tryNonAsync (storeexport ea k2) + runBool (storeexport ea k2) , check "check present export after store of new content" $ \ea _k1 k2 -> checkpresentexport ea k2 , check "retrieve export new content" $ \ea _k1 k2 -> retrieveexport ea k2 , check "remove export" $ \ea _k1 k2 -> - isRight <$> tryNonAsync (removeexport ea k2) + runBool (removeexport ea k2) , check "check present export after remove" $ \ea _k1 k2 -> not <$> checkpresentexport ea k2 , check "retrieve export fails after removal" $ \ea _k1 k2 -> not <$> retrieveexport ea k2 , check "remove export directory" $ \ea _k1 _k2 -> - isRight <$> tryNonAsync (removeexportdirectory ea) + runBool (removeexportdirectory ea) , check "remove export directory that is already removed" $ \ea _k1 _k2 -> - isRight <$> tryNonAsync (removeexportdirectory ea) + runBool (removeexportdirectory ea) -- renames are not tested because remotes do not need to support them ] where @@ -448,3 +448,9 @@ unlessM ((Remote.uuid r `elem`) <$> loggedLocations k) $ giveup $ f ++ " is not stored in the remote being tested, cannot test it" return k + +runBool :: Monad m => m () -> m Bool +runBool a = do + a + return True + diff --git a/Command/Upgrade.hs b/Command/Upgrade.hs --- a/Command/Upgrade.hs +++ b/Command/Upgrade.hs @@ -38,12 +38,13 @@ seek o = commandAction (start o) start :: UpgradeOptions -> CommandStart -start (UpgradeOptions { autoOnly = True }) = do +start (UpgradeOptions { autoOnly = True }) = starting "upgrade" (ActionItemOther Nothing) (SeekInput []) $ do - getVersion >>= maybe noop checkUpgrade - next $ return True -start _ = starting "upgrade" (ActionItemOther Nothing) (SeekInput []) $ do - whenM (isNothing <$> getVersion) $ do - initialize Nothing Nothing - r <- upgrade False latestVersion - next $ return r + getVersion >>= maybe noop checkUpgrade + next $ return True +start _ = + starting "upgrade" (ActionItemOther Nothing) (SeekInput []) $ do + whenM (isNothing <$> getVersion) $ do + initialize Nothing Nothing + r <- upgrade False latestVersion + next $ return r diff --git a/Git/Construct.hs b/Git/Construct.hs --- a/Git/Construct.hs +++ b/Git/Construct.hs @@ -21,6 +21,7 @@ repoAbsPath, checkForRepo, newFrom, + adjustGitDirFile, ) where #ifndef mingw32_HOST_OS @@ -73,7 +74,7 @@ , ret (takeDirectory canondir) ) | otherwise = ifM (doesDirectoryExist dir) - ( gitDirFile dir >>= maybe (ret dir) (pure . newFrom) + ( checkGitDirFile dir >>= maybe (ret dir) (pure . newFrom) -- git falls back to dir.git when dir doesn't -- exist, as long as dir didn't end with a -- path separator @@ -198,7 +199,7 @@ checkForRepo :: FilePath -> IO (Maybe RepoLocation) checkForRepo dir = check isRepo $ - check (gitDirFile dir) $ + check (checkGitDirFile dir) $ check isBareRepo $ return Nothing where @@ -219,23 +220,35 @@ <&&> doesDirectoryExist (dir "objects") gitSignature file = doesFileExist $ dir file +-- Check for a .git file. +checkGitDirFile :: FilePath -> IO (Maybe RepoLocation) +checkGitDirFile dir = adjustGitDirFile' $ Local + { gitdir = toRawFilePath (dir ".git") + , worktree = Just (toRawFilePath dir) + } + -- git-submodule, git-worktree, and --separate-git-dir -- make .git be a file pointing to the real git directory. -- Detect that, and return a RepoLocation with gitdir pointing -- to the real git directory. -gitDirFile :: FilePath -> IO (Maybe RepoLocation) -gitDirFile dir = do - c <- firstLine <$> - catchDefaultIO "" (readFile $ dir ".git") - return $ if gitdirprefix `isPrefixOf` c - then Just $ Local - { gitdir = toRawFilePath $ absPathFrom dir $ - drop (length gitdirprefix) c - , worktree = Just (toRawFilePath dir) - } - else Nothing +adjustGitDirFile :: RepoLocation -> IO RepoLocation +adjustGitDirFile loc = fromMaybe loc <$> adjustGitDirFile' loc + +adjustGitDirFile' :: RepoLocation -> IO (Maybe RepoLocation) +adjustGitDirFile' loc = do + let gd = fromRawFilePath (gitdir loc) + c <- firstLine <$> catchDefaultIO "" (readFile gd) + if gitdirprefix `isPrefixOf` c + then do + top <- takeDirectory <$> absPath gd + return $ Just $ loc + { gitdir = toRawFilePath $ absPathFrom top $ + drop (length gitdirprefix) c + } + else return Nothing where gitdirprefix = "gitdir: " + newFrom :: RepoLocation -> Repo newFrom l = Repo diff --git a/Git/CurrentRepo.hs b/Git/CurrentRepo.hs --- a/Git/CurrentRepo.hs +++ b/Git/CurrentRepo.hs @@ -67,15 +67,14 @@ configure (Just d) _ = do absd <- absPath d curr <- getCurrentDirectory - r <- Git.Config.read $ newFrom $ - Local - { gitdir = toRawFilePath absd - , worktree = Just (toRawFilePath curr) - } + loc <- adjustGitDirFile $ Local + { gitdir = toRawFilePath absd + , worktree = Just (toRawFilePath curr) + } + r <- Git.Config.read $ newFrom loc return $ if Git.Config.isBare r then r { location = (location r) { worktree = Nothing } } else r - configure Nothing Nothing = giveup "Not in a git repository." addworktree w r = changelocation r $ Local diff --git a/Limit.hs b/Limit.hs --- a/Limit.hs +++ b/Limit.hs @@ -441,11 +441,11 @@ } {- Adds a limit to skip files that are too large or too small -} -addLargerThan :: String -> Annex () -addLargerThan = addLimit . limitSize LimitAnnexFiles (>) +addLargerThan :: LimitBy -> String -> Annex () +addLargerThan lb = addLimit . limitSize lb (>) -addSmallerThan :: String -> Annex () -addSmallerThan = addLimit . limitSize LimitAnnexFiles (<) +addSmallerThan :: LimitBy -> String -> Annex () +addSmallerThan lb = addLimit . limitSize lb (<) limitSize :: LimitBy -> (Maybe Integer -> Maybe Integer -> Bool) -> MkLimit Annex limitSize lb vs s = case readSize dataUnits s of diff --git a/Logs/File.hs b/Logs/File.hs --- a/Logs/File.hs +++ b/Logs/File.hs @@ -1,12 +1,21 @@ {- git-annex log files - - - Copyright 2018 Joey Hess + - Copyright 2018-2020 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} -module Logs.File (writeLogFile, withLogHandle, appendLogFile, streamLogFile) where +{-# LANGUAGE BangPatterns #-} +module Logs.File ( + writeLogFile, + withLogHandle, + appendLogFile, + modifyLogFile, + streamLogFile, + checkLogFile, +) where + import Annex.Common import Annex.Perms import Annex.LockFile @@ -14,6 +23,9 @@ import qualified Git import Utility.Tmp +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Lazy.Char8 as L8 + -- | Writes content to a file, replacing the file atomically, and -- making the new file have whatever permissions the git repository is -- configured to use. Creates the parent directory when necessary. @@ -39,10 +51,62 @@ -- | Appends a line to a log file, first locking it to prevent -- concurrent writers. -appendLogFile :: FilePath -> (Git.Repo -> FilePath) -> String -> Annex () +appendLogFile :: FilePath -> (Git.Repo -> FilePath) -> L.ByteString -> Annex () appendLogFile f lck c = createDirWhenNeeded f $ withExclusiveLock lck $ do - liftIO $ withFile f AppendMode $ \h -> hPutStrLn h c + liftIO $ withFile f AppendMode $ \h -> L8.hPutStrLn h c setAnnexFilePerm f + +-- | Modifies a log file. +-- +-- If the function does not make any changes, avoids rewriting the file +-- for speed, but that does mean the whole file content has to be buffered +-- in memory. +-- +-- The file is locked to prevent concurrent writers, and it is written +-- atomically. +modifyLogFile :: FilePath -> (Git.Repo -> FilePath) -> ([L.ByteString] -> [L.ByteString]) -> Annex () +modifyLogFile f lck modf = withExclusiveLock lck $ do + ls <- liftIO $ fromMaybe [] + <$> tryWhenExists (L8.lines <$> L.readFile f) + let ls' = modf ls + when (ls' /= ls) $ + createDirWhenNeeded f $ + viaTmp writelog f (L8.unlines ls') + where + writelog f' b = do + liftIO $ L.writeFile f' b + setAnnexFilePerm f' + +-- | Checks the content of a log file to see if any line matches. +-- +-- This can safely be used while appendLogFile or any atomic +-- action is concurrently modifying the file. It does not lock the file, +-- for speed, but instead relies on the fact that a log file usually +-- ends in a newline. +checkLogFile :: FilePath -> (Git.Repo -> FilePath) -> (L.ByteString -> Bool) -> Annex Bool +checkLogFile f lck matchf = withExclusiveLock lck $ bracket setup cleanup go + where + setup = liftIO $ tryWhenExists $ openFile f ReadMode + cleanup Nothing = noop + cleanup (Just h) = liftIO $ hClose h + go Nothing = return False + go (Just h) = do + !r <- liftIO (any matchf . fullLines <$> L.hGetContents h) + return r + +-- | Gets only the lines that end in a newline. If the last part of a file +-- does not, it's assumed to be a new line being logged that is incomplete, +-- and is omitted. +-- +-- Unlike lines, this does not collapse repeated newlines etc. +fullLines :: L.ByteString -> [L.ByteString] +fullLines = go [] + where + go c b = case L8.elemIndex '\n' b of + Nothing -> reverse c + Just n -> + let (l, b') = L.splitAt n b + in go (l:c) (L.drop 1 b') -- | Streams lines from a log file, and then empties the file at the end. -- diff --git a/Logs/Smudge.hs b/Logs/Smudge.hs --- a/Logs/Smudge.hs +++ b/Logs/Smudge.hs @@ -13,11 +13,13 @@ import Git.FilePath import Logs.File +import qualified Data.ByteString.Lazy as L + -- | Log a smudged file. smudgeLog :: Key -> TopFilePath -> Annex () smudgeLog k f = do logf <- fromRepo gitAnnexSmudgeLog - appendLogFile logf gitAnnexSmudgeLock $ fromRawFilePath $ + appendLogFile logf gitAnnexSmudgeLock $ L.fromStrict $ serializeKey' k <> " " <> getTopFilePath f -- | Streams all smudged files, and then empties the log at the end. diff --git a/Remote/Directory.hs b/Remote/Directory.hs --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -195,8 +195,7 @@ - down. -} finalizeStoreGeneric :: FilePath -> FilePath -> FilePath -> IO () finalizeStoreGeneric d tmp dest = do - void $ tryIO $ allowWrite dest -- may already exist - void $ tryIO $ removeDirectoryRecursive dest -- or not exist + removeDirGeneric d dest createDirectoryUnder d (parentDir dest) renameDirectory tmp dest -- may fail on some filesystems diff --git a/Remote/GitLFS.hs b/Remote/GitLFS.hs --- a/Remote/GitLFS.hs +++ b/Remote/GitLFS.hs @@ -295,11 +295,11 @@ let endpoint' = addbasicauth (Git.credentialBasicAuth cred) endpoint let testreq' = LFS.startTransferRequest endpoint' transfernothing flip catchNonAsync (const (returnendpoint endpoint')) $ do - resp' <- makeSmallAPIRequest testreq' - inRepo $ if needauth (responseStatus resp') - then Git.rejectUrlCredential cred - else Git.approveUrlCredential cred - returnendpoint endpoint' + resp' <- makeSmallAPIRequest testreq' + inRepo $ if needauth (responseStatus resp') + then Git.rejectUrlCredential cred + else Git.approveUrlCredential cred + returnendpoint endpoint' else returnendpoint endpoint where transfernothing = LFS.TransferRequest diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs --- a/Remote/Helper/Chunked.hs +++ b/Remote/Helper/Chunked.hs @@ -120,6 +120,10 @@ -> Annex () storeChunks u chunkconfig encryptor k f p storer checker = case chunkconfig of + -- Only stable keys are safe to store chunked, + -- because an unstable key can have multiple different + -- objects, and mixing up chunks from them would be + -- possible without this check. (UnpaddedChunks chunksize) -> ifM (isStableKey k) ( do h <- liftIO $ openBinaryFile f ReadMode @@ -206,7 +210,7 @@ -} removeChunks :: Remover -> UUID -> ChunkConfig -> EncKey -> Key -> Annex () removeChunks remover u chunkconfig encryptor k = do - ls <- chunkKeys u chunkconfig k + ls <- map chunkKeyList <$> chunkKeys u chunkconfig k mapM_ (remover . encryptor) (concat ls) let chunksizes = catMaybes $ map (fromKey keyChunkSize <=< headMaybe) ls forM_ chunksizes $ chunksRemoved u k . FixedSizeChunks . fromIntegral @@ -242,10 +246,11 @@ -- looking in the git-annex branch for chunk counts -- that are likely not there. getunchunked `catchNonAsync` - (\e -> go (Just e) =<< chunkKeysOnly u basek) + (\e -> go (Just e) =<< chunkKeysOnly u chunkconfig basek) | otherwise = go Nothing =<< chunkKeys u chunkconfig basek where - go pe ls = do + go pe cks = do + let ls = map chunkKeyList cks currsize <- liftIO $ catchMaybeIO $ getFileSize dest let ls' = maybe ls (setupResume ls) currsize if any null ls' @@ -350,22 +355,27 @@ -- looking in the git-annex branch for chunk counts -- that are likely not there. v <- check basek + let getchunkkeys = chunkKeysOnly u chunkconfig basek case v of Right True -> return True - Left e -> checklists (Just e) =<< chunkKeysOnly u basek - _ -> checklists Nothing =<< chunkKeysOnly u basek + Left e -> checklists (Just e) =<< getchunkkeys + _ -> checklists Nothing =<< getchunkkeys | otherwise = checklists Nothing =<< chunkKeys u chunkconfig basek where checklists Nothing [] = return False checklists (Just deferrederror) [] = throwM deferrederror - checklists d (l:ls) + checklists d (ck:cks) | not (null l) = do v <- checkchunks l case v of - Left e -> checklists (Just e) ls - Right True -> return True - Right False -> checklists Nothing ls - | otherwise = checklists d ls + Left e -> checklists (Just e) cks + Right True -> do + ensureChunksAreLogged u basek ck + return True + Right False -> checklists Nothing cks + | otherwise = checklists d cks + where + l = chunkKeyList ck checkchunks :: [Key] -> Annex (Either SomeException Bool) checkchunks [] = return (Right True) @@ -378,6 +388,14 @@ check = tryNonAsync . checker . encryptor +data ChunkKeys + = ChunkKeys [Key] + | SpeculativeChunkKeys (ChunkMethod, ChunkCount) [Key] + +chunkKeyList :: ChunkKeys -> [Key] +chunkKeyList (ChunkKeys l) = l +chunkKeyList (SpeculativeChunkKeys _ l) = l + {- A key can be stored in a remote unchunked, or as a list of chunked keys. - This can be the case whether or not the remote is currently configured - to use chunking. @@ -388,18 +406,52 @@ - This finds all possible lists of keys that might be on the remote that - can be combined to get back the requested key, in order from most to - least likely to exist. + - + - Speculatively tries chunks using the ChunkConfig last of all + - (when that's not the same as the recorded chunks). This can help + - recover from data loss, where the chunk log didn't make it out, + - though only as long as the ChunkConfig is unchanged. -} -chunkKeys :: UUID -> ChunkConfig -> Key -> Annex [[Key]] -chunkKeys u chunkconfig k = do - l <- chunkKeysOnly u k - return $ if noChunks chunkconfig - then [k] : l - else l ++ [[k]] +chunkKeys :: UUID -> ChunkConfig -> Key -> Annex [ChunkKeys] +chunkKeys = chunkKeys' False -chunkKeysOnly :: UUID -> Key -> Annex [[Key]] -chunkKeysOnly u k = map (toChunkList k) <$> getCurrentChunks u k +{- Same as chunkKeys, but excluding the unchunked key. -} +chunkKeysOnly :: UUID -> ChunkConfig -> Key -> Annex [ChunkKeys] +chunkKeysOnly = chunkKeys' True +chunkKeys' :: Bool -> UUID -> ChunkConfig -> Key -> Annex [ChunkKeys] +chunkKeys' onlychunks u chunkconfig k = do + recorded <- getCurrentChunks u k + let recordedl = map (ChunkKeys . toChunkList k) recorded + return $ addspeculative recorded $ if onlychunks + then recordedl + else if noChunks chunkconfig + then ChunkKeys [k] : recordedl + else recordedl ++ [ChunkKeys [k]] + where + addspeculative recorded l = case chunkconfig of + NoChunks -> l + UnpaddedChunks chunksz -> case fromKey keySize k of + Nothing -> l + Just keysz -> + let (d, m) = keysz `divMod` fromIntegral chunksz + chunkcount = d + if m == 0 then 0 else 1 + v = (FixedSizeChunks chunksz, chunkcount) + in if v `elem` recorded + then l + else l ++ [SpeculativeChunkKeys v (toChunkList k v)] + LegacyChunks _ -> l + toChunkList :: Key -> (ChunkMethod, ChunkCount) -> [Key] toChunkList k (FixedSizeChunks chunksize, chunkcount) = takeChunkKeyStream chunkcount $ chunkKeyStream k chunksize toChunkList _ (UnknownChunks _, _) = [] + +{- When chunkKeys provided a speculative chunk list, and that has been + - verified to be present, use this to log it in the chunk log. This way, + - a later change to the chunk size of the remote won't prevent accessing + - the chunks. -} +ensureChunksAreLogged :: UUID -> Key -> ChunkKeys -> Annex () +ensureChunksAreLogged u k (SpeculativeChunkKeys (chunkmethod, chunkcount) _) = + chunksStored u k chunkmethod chunkcount +ensureChunksAreLogged _ _ (ChunkKeys _) = return () diff --git a/Test.hs b/Test.hs --- a/Test.hs +++ b/Test.hs @@ -298,6 +298,8 @@ , testCase "export_import_subdir" test_export_import_subdir , testCase "shared clone" test_shared_clone , testCase "log" test_log + , testCase "view" test_view + , testCase "magic" test_magic , testCase "import" test_import , testCase "reinject" test_reinject , testCase "unannex (no copy)" test_unannex_nocopy @@ -445,6 +447,36 @@ test_log :: Assertion test_log = intmpclonerepo $ do git_annex "log" [annexedfile] @? "log failed" + +test_view :: Assertion +test_view = intmpclonerepo $ do + git_annex "metadata" ["-s", "test=test1", annexedfile] @? "metadata failed" + git_annex "metadata" ["-s", "test=test2", sha1annexedfile] @? "metadata failed" + git_annex "view" ["test=test1"] @? "entering view failed" + checkexists annexedfile + checkdoesnotexist sha1annexedfile + +test_magic :: Assertion +test_magic = intmpclonerepo $ do +#ifdef WITH_MAGICMIME + boolSystem "git" + [ Param "config" + , Param "annex.largefiles" + , Param "mimeencoding=binary" + ] @? "git config annex.largefiles failed" + writeFile "binary" "\127" + writeFile "text" "test\n" + git_annex "add" ["binary", "text"] + @? "git-annex add failed with mimeencoding in largefiles" + git_annex "sync" [] + @? "git-annex sync failed" + (isJust <$> annexeval (Annex.CatFile.catKeyFile (encodeBS "binary"))) + @? "binary file not added to annex despite mimeencoding config" + (isNothing <$> annexeval (Annex.CatFile.catKeyFile (encodeBS "text"))) + @? "non-binary file got added to annex despite mimeencoding config" +#else + return () +#endif test_import :: Assertion test_import = intmpclonerepo $ Utility.Tmp.Dir.withTmpDir "importtest" $ \importdir -> do diff --git a/Utility/Path.hs b/Utility/Path.hs --- a/Utility/Path.hs +++ b/Utility/Path.hs @@ -235,15 +235,11 @@ - than it would be to run the action separately with each path. In - the case of git file list commands, that assumption tends to hold. -} -runSegmentPaths :: (a -> RawFilePath) -> ([RawFilePath] -> IO ([a], v)) -> [RawFilePath] -> IO ([[a]], v) -runSegmentPaths c a paths = do - (l, cleanup) <- a paths - return (segmentPaths c paths l, cleanup) +runSegmentPaths :: (a -> RawFilePath) -> ([RawFilePath] -> IO [a]) -> [RawFilePath] -> IO [[a]] +runSegmentPaths c a paths = segmentPaths c paths <$> a paths -runSegmentPaths' :: (Maybe RawFilePath -> a -> r) -> (a -> RawFilePath) -> ([RawFilePath] -> IO ([a], v)) -> [RawFilePath] -> IO ([[r]], v) -runSegmentPaths' si c a paths = do - (l, cleanup) <- a paths - return (segmentPaths' si c paths l, cleanup) +runSegmentPaths' :: (Maybe RawFilePath -> a -> r) -> (a -> RawFilePath) -> ([RawFilePath] -> IO [a]) -> [RawFilePath] -> IO [[r]] +runSegmentPaths' si c a paths = segmentPaths' si c paths <$> a paths {- Converts paths in the home directory to use ~/ -} relHome :: FilePath -> IO String diff --git a/Utility/WebApp.hs b/Utility/WebApp.hs --- a/Utility/WebApp.hs +++ b/Utility/WebApp.hs @@ -85,15 +85,16 @@ -} getSocket :: Maybe HostName -> IO Socket getSocket h = do -#if defined(__ANDROID__) || defined (mingw32_HOST_OS) - -- getAddrInfo currently segfaults on Android. +#if defined (mingw32_HOST_OS) -- The HostName is ignored by this code. + -- getAddrInfo didn't used to work on windows; current status + -- unknown. when (isJust h) $ error "getSocket with HostName not supported on this OS" - addr <- inet_addr "127.0.0.1" + let addr = tupleToHostAddress (127,0,0,1) sock <- socket AF_INET Stream defaultProtocol preparesocket sock - bind sock (SockAddrInet aNY_PORT addr) + bind sock (SockAddrInet defaultPort addr) use sock where #else diff --git a/doc/git-annex-add.mdwn b/doc/git-annex-add.mdwn --- a/doc/git-annex-add.mdwn +++ b/doc/git-annex-add.mdwn @@ -50,8 +50,7 @@ * `--force-small` Treat all files as small files, ignoring annex.largefiles and annex.dotfiles - configuration, and add to git, also ignoring annex.addsmallfiles - configuration. + and annex.addsmallfiles configuration, and add to git. * `--backend` 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: 8.20201007 +Version: 8.20201103 Cabal-Version: >= 1.10 License: AGPL-3 Maintainer: Joey Hess @@ -377,7 +377,7 @@ DAV (>= 1.0) CC-Options: -Wall GHC-Options: -Wall -fno-warn-tabs -Wincomplete-uni-patterns - Default-Language: Haskell98 + Default-Language: Haskell2010 Default-Extensions: PackageImports, LambdaCase Other-Extensions: TemplateHaskell -- Some things don't work with the non-threaded RTS. @@ -595,9 +595,8 @@ CPP-Options: -DWITH_TORRENTPARSER if flag(MagicMime) - if (! os(windows)) - Build-Depends: magic - CPP-Options: -DWITH_MAGICMIME + Build-Depends: magic + CPP-Options: -DWITH_MAGICMIME if flag(Benchmark) Build-Depends: criterion