diff options
| -rw-r--r-- | Annex.hs | 3 | ||||
| -rw-r--r-- | Build/NullSoftInstaller.hs | 13 | ||||
| -rw-r--r-- | CHANGELOG | 3 | ||||
| -rw-r--r-- | CmdLine/Action.hs | 38 | ||||
| -rw-r--r-- | Command/Get.hs | 4 | ||||
| -rw-r--r-- | Command/Mirror.hs | 2 | ||||
| -rw-r--r-- | Command/Move.hs | 2 | ||||
| -rw-r--r-- | Command/Sync.hs | 2 | ||||
| -rw-r--r-- | doc/bugs/get_-J___34__fails__34___to_get_files_with_the_same_key.mdwn | 4 | ||||
| -rw-r--r-- | doc/bugs/get_-J___34__fails__34___to_get_files_with_the_same_key/comment_6_5f2ed95bcad2e3d1c4260d1fb0440052._comment | 19 | ||||
| -rw-r--r-- | doc/devblog/day_476__third_time_lucky.mdwn | 29 | ||||
| -rw-r--r-- | stack.yaml | 2 | ||||
| -rwxr-xr-x | standalone/windows/build-simple.sh | 26 | ||||
| -rwxr-xr-x | standalone/windows/build.sh | 59 |
14 files changed, 130 insertions, 76 deletions
@@ -138,6 +138,7 @@ data AnnexState = AnnexState , existinghooks :: M.Map Git.Hook.Hook Bool , desktopnotify :: DesktopNotify , workers :: [Either AnnexState (Async AnnexState)] + , activekeys :: TVar (M.Map Key ThreadId) , activeremotes :: MVar (M.Map (Types.Remote.RemoteA Annex) Integer) , keysdbhandle :: Maybe Keys.DbHandle , cachedcurrentbranch :: Maybe Git.Branch @@ -147,6 +148,7 @@ data AnnexState = AnnexState newState :: GitConfig -> Git.Repo -> IO AnnexState newState c r = do emptyactiveremotes <- newMVar M.empty + emptyactivekeys <- newTVarIO M.empty o <- newMessageState sc <- newTMVarIO False return $ AnnexState @@ -192,6 +194,7 @@ newState c r = do , existinghooks = M.empty , desktopnotify = mempty , workers = [] + , activekeys = emptyactivekeys , activeremotes = emptyactiveremotes , keysdbhandle = Nothing , cachedcurrentbranch = Nothing diff --git a/Build/NullSoftInstaller.hs b/Build/NullSoftInstaller.hs index 7ce470bc9..acbdd83fd 100644 --- a/Build/NullSoftInstaller.hs +++ b/Build/NullSoftInstaller.hs @@ -1,17 +1,16 @@ {- Generates a NullSoft installer program for git-annex on Windows.
-
- - This uses the Haskell nsis package (cabal install nsis)
- - to generate a .nsi file, which is then used to produce
- - git-annex-installer.exe
+ - This uses the Haskell nsis package to generate a .nsi file,
+ - which is then used to produce git-annex-installer.exe
-
- The installer includes git-annex, and utilities it uses, with the
- exception of git and some utilities that are bundled with git.
- The user needs to install git separately, and the installer checks
- for that.
-
- - To build the installer, git-annex should already be built by cabal,
- - and the necessary utility programs (rsync and wget) already installed
- - in PATH from msys32.
+ - To build the installer, git-annex should already be built using
+ - stack and the necessary utility programs (rsync and wget) already
+ - installed in PATH from msys32.
-
- Copyright 2013-2015 Joey Hess <id@joeyh.name>
-
@@ -41,7 +40,7 @@ import Build.BundledPrograms main = do
withTmpDir "nsis-build" $ \tmpdir -> do
let gitannex = tmpdir </> gitannexprogram
- mustSucceed "ln" [File "dist/build/git-annex/git-annex.exe", File gitannex]
+ mustSucceed "stack" [Param "--local-bin-path", File ".", Param "install"]
let license = tmpdir </> licensefile
mustSucceed "sh" [Param "-c", Param $ "zcat standalone/licences.gz > '" ++ license ++ "'"]
webappscript <- vbsLauncher tmpdir "git-annex-webapp" "git annex webapp"
@@ -11,6 +11,9 @@ git-annex (6.20171004) UNRELEASED; urgency=medium where interrupting an add could result in the file being moved into the annex, with no symlink yet created. * Avoid repeated checking that files passed on the command line exist. + * get -J/move -J/copy -J/mirror -J/sync -J: Avoid "transfer already in + progress" errors when two files use the same key. + * stack.yaml: Update to lts-9.9. -- Joey Hess <id@joeyh.name> Sat, 07 Oct 2017 14:11:00 -0400 diff --git a/CmdLine/Action.hs b/CmdLine/Action.hs index 75c9e9471..b8d0e3a40 100644 --- a/CmdLine/Action.hs +++ b/CmdLine/Action.hs @@ -1,6 +1,6 @@ {- git-annex command-line actions - - - Copyright 2010-2015 Joey Hess <id@joeyh.name> + - Copyright 2010-2017 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -18,9 +18,12 @@ import Messages.Concurrent import Types.Messages import Remote.List +import Control.Concurrent import Control.Concurrent.Async +import Control.Concurrent.STM import Control.Exception (throwIO) import Data.Either +import qualified Data.Map.Strict as M #ifdef WITH_CONCURRENTOUTPUT import qualified System.Console.Regions as Regions @@ -177,3 +180,36 @@ allowConcurrentOutput a = go =<< Annex.getState Annex.concurrency #else allowConcurrentOutput = id #endif + +{- Ensures that only one thread processes a key at a time. + - Other threads will block until it's done. -} +onlyActionOn :: Key -> CommandStart -> CommandStart +onlyActionOn k a = onlyActionOn' k run + where + run = do + -- Run whole action, not just start stage, so other threads + -- block until it's done. + r <- callCommandAction' a + case r of + Nothing -> return Nothing + Just r' -> return $ Just $ return $ Just $ return r' + +onlyActionOn' :: Key -> Annex a -> Annex a +onlyActionOn' k a = go =<< Annex.getState Annex.concurrency + where + go NonConcurrent = a + go (Concurrent _) = do + tv <- Annex.getState Annex.activekeys + bracket (setup tv) id (const a) + setup tv = liftIO $ do + mytid <- myThreadId + atomically $ do + m <- readTVar tv + case M.lookup k m of + Just tid + | tid /= mytid -> retry + | otherwise -> return (return ()) + Nothing -> do + writeTVar tv $! M.insert k mytid m + return $ liftIO $ atomically $ + modifyTVar tv $ M.delete k diff --git a/Command/Get.hs b/Command/Get.hs index 5cb0245d9..a412b2cb3 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -62,8 +62,8 @@ startKeys from key ai = checkFailedTransferDirection ai Download $ start' (return True) from key (AssociatedFile Nothing) ai start' :: Annex Bool -> Maybe Remote -> Key -> AssociatedFile -> ActionItem -> CommandStart -start' expensivecheck from key afile ai = stopUnless (not <$> inAnnex key) $ - stopUnless expensivecheck $ +start' expensivecheck from key afile ai = onlyActionOn key $ + stopUnless (not <$> inAnnex key) $ stopUnless expensivecheck $ case from of Nothing -> go $ perform key afile Just src -> diff --git a/Command/Mirror.hs b/Command/Mirror.hs index a8f4307a2..941e397a4 100644 --- a/Command/Mirror.hs +++ b/Command/Mirror.hs @@ -53,7 +53,7 @@ start o file k = startKey o afile k (mkActionItem afile) afile = AssociatedFile (Just file) startKey :: MirrorOptions -> AssociatedFile -> Key -> ActionItem -> CommandStart -startKey o afile key ai = case fromToOptions o of +startKey o afile key ai = onlyActionOn key $ case fromToOptions o of ToRemote r -> checkFailedTransferDirection ai Upload $ ifM (inAnnex key) ( Command.Move.toStart False afile key ai =<< getParsed r , do diff --git a/Command/Move.hs b/Command/Move.hs index b9e0b6548..04e6aa384 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -74,7 +74,7 @@ startKey :: MoveOptions -> Bool -> Key -> ActionItem -> CommandStart startKey o move = start' o move (AssociatedFile Nothing) start' :: MoveOptions -> Bool -> AssociatedFile -> Key -> ActionItem -> CommandStart -start' o move afile key ai = +start' o move afile key ai = onlyActionOn key $ case fromToOptions o of Right (FromRemote src) -> checkFailedTransferDirection ai Download $ diff --git a/Command/Sync.hs b/Command/Sync.hs index 1bd8e623c..b2d0bd275 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -609,7 +609,7 @@ seekSyncContent o rs = do - Returns True if any file transfers were made. -} syncFile :: Either (Maybe (Bloom Key)) (Key -> Annex ()) -> [Remote] -> AssociatedFile -> Key -> Annex Bool -syncFile ebloom rs af k = do +syncFile ebloom rs af k = onlyActionOn' k $ do locs <- Remote.keyLocations k let (have, lack) = partition (\r -> Remote.uuid r `elem` locs) rs diff --git a/doc/bugs/get_-J___34__fails__34___to_get_files_with_the_same_key.mdwn b/doc/bugs/get_-J___34__fails__34___to_get_files_with_the_same_key.mdwn index fade3b331..7008eb62d 100644 --- a/doc/bugs/get_-J___34__fails__34___to_get_files_with_the_same_key.mdwn +++ b/doc/bugs/get_-J___34__fails__34___to_get_files_with_the_same_key.mdwn @@ -46,3 +46,7 @@ so at the end we get a run of git-annex which exits with error 1... and in json I wondered if annex should first analyze passed paths to get actual keys to be fetched? [[!meta author=yoh]] + +> [[fixed|done]]; also fixed for several other commands, but the final +> fix needed each command that could have the problem to be modified, so +> there could possibly be some I missed.. --[[Joey]] diff --git a/doc/bugs/get_-J___34__fails__34___to_get_files_with_the_same_key/comment_6_5f2ed95bcad2e3d1c4260d1fb0440052._comment b/doc/bugs/get_-J___34__fails__34___to_get_files_with_the_same_key/comment_6_5f2ed95bcad2e3d1c4260d1fb0440052._comment new file mode 100644 index 000000000..32f2d4dec --- /dev/null +++ b/doc/bugs/get_-J___34__fails__34___to_get_files_with_the_same_key/comment_6_5f2ed95bcad2e3d1c4260d1fb0440052._comment @@ -0,0 +1,19 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 6""" + date="2017-10-17T17:21:27Z" + content=""" +Another way to approach the problem would be, when the transfer of +the same key is already in progress by another thread of the same process, +wait for that thread to complete before running the requested transfer +action. + +The assistant has a TransferMap of all transfers the process is running. +That would need to be moved from the DaemonStatus to Annex state. + +To wait on the thread that's doing the transfer, would need to store +a MVar or something in the TransferInfo; the ThreadId can't be waited on +by itself. + +This seems much less intrusive, and just as fast as my initial approach. +"""]] diff --git a/doc/devblog/day_476__third_time_lucky.mdwn b/doc/devblog/day_476__third_time_lucky.mdwn new file mode 100644 index 000000000..1a07b1b03 --- /dev/null +++ b/doc/devblog/day_476__third_time_lucky.mdwn @@ -0,0 +1,29 @@ +There's been a lot of little bug fixes and improvements going on +in the ... oops ... almost a month since I last updated the devblog. +Including a release of git-annex on the 3rd, and another release +that's almost ready to go now. Just have not had the energy to blog about +it all. + +Anyway, today I spent way too long fixing a minor wart. When multiple +annexed files have the same content, transferring them with concurrency +enabled could make it complain that "transfer already in progress". +Which is better than transferring the same content twice, but it did make +there seem to be a failure. + +I implemented two and a half different fixes for that. The first half a fix +was too intrusive and I couldn't get it to work. Then came a fix that +avoided the problem pretty cleanly, except it actually led to worse +behavior, because it would sometimes transfer the same content twice, and +needed non-obvious tweaks here and there to prevent that. Finally, around +an hour ago, having actually given up unhappily for the day, I realized a +much better way to fix it, that was minimally intrusive and works +perfectly. + +So it goes.. I'd say "concurrency is hard", but it's more that big complex +code bases can make things that seem simple not really that simple. +Yesterday I had a much easier time fixing a related problem with `git annex +add -J`, which was really a lot hairier (involving a race condition and +a lack of atomicity), but didn't cut across the code base in the same broad +way. + +Today's work was supported by the NSF-funded DataLad project. diff --git a/stack.yaml b/stack.yaml index e8f36f43d..d84c4682e 100644 --- a/stack.yaml +++ b/stack.yaml @@ -23,4 +23,4 @@ extra-deps: - yesod-default-1.2.0 explicit-setup-deps: git-annex: true -resolver: lts-8.13 +resolver: lts-9.9 diff --git a/standalone/windows/build-simple.sh b/standalone/windows/build-simple.sh index 65be71271..381f5635f 100755 --- a/standalone/windows/build-simple.sh +++ b/standalone/windows/build-simple.sh @@ -11,28 +11,20 @@ PATH="/c/Program Files/Git/cmd:/c/Program Files/NSIS:$PATH" withcyg () { PATH="$PATH:/c/cygwin/bin" "$@" } + +# Prefer programs from cygwin. withcygpreferred () { PATH="/c/cygwin/bin:$PATH" "$@" } -# Install haskell dependencies. -# cabal install is not run in cygwin, because we don't want configure scripts -# for haskell libraries to link them with the cygwin library. -if ! cabal install --only-dependencies; then - cabal update || true - cabal install --only-dependencies -fi +# Deps are not built with cygwin environment, because we don't want +# configure scripts for haskell libraries to link them with the cygwin +# libraries. +stack setup +stack build --dependencies-only # Build git-annex -if [ ! -e "dist/setup-config" ]; then - withcyg cabal configure -fi -if ! withcyg cabal build; then - ghc --make Build/EvilLinker -fno-warn-tabs - withcyg Build/EvilLinker -fi +withcyg stack build # Build the installer -cabal install nsis -ghc --make Build/NullSoftInstaller.hs -fno-warn-tabs -PATH="$PATH:/cygdrive/c/Program Files/NSIS" Build/NullSoftInstaller.exe +withcygpreferred stack runghc --package nsis Build/NullSoftInstaller.hs diff --git a/standalone/windows/build.sh b/standalone/windows/build.sh index 2aa382cdc..f4407ab31 100755 --- a/standalone/windows/build.sh +++ b/standalone/windows/build.sh @@ -19,6 +19,11 @@ withcyg () { PATH="$PATH:/c/cygwin/bin" "$@" } +# Prefer programs from cygwin. +withcygpreferred () { + PATH="/c/cygwin/bin:$PATH" "$@" +} + # This tells git-annex where to upgrade itself from. UPGRADE_LOCATION=http://downloads.kitenet.net/git-annex/windows/current/git-annex-installer.exe export UPGRADE_LOCATION @@ -28,49 +33,18 @@ export UPGRADE_LOCATION #FORCE_GIT_VERSION=1.9.5 #export FORCE_GIT_VERSION -# Uncomment to get rid of cabal installed libraries. -#cabal list --installed -#rm -rf /c/Users/jenkins/AppData/Roaming/cabal /c/Users/jenkins/AppData/Roaming/ghc - # Don't allow build artifact from a past successful build to be extracted # if we fail. rm -f git-annex-installer.exe -# Install haskell dependencies. -# cabal install is not run in cygwin, because we don't want configure scripts -# for haskell libraries to link them with the cygwin library. -cabal update || true - -# workaround strange cabal install bug for xss-sanitize -if [ ! -d xss-sanitize ]; then - git clone https://github.com/yesodweb/haskell-xss-sanitize xss-sanitize - (cd xss-sanitize && cabal install) -fi - -cabal install --only-dependencies \ - --constraint='persistent-sqlite ==2.2' \ - --constraint='cryptonite ==0.7' \ - --constraint='mwc-random ==0.13.3.2' \ - --force-reinstalls \ - || true - -# Detect when the last build was an incremental build and failed, -# and try a full build. Done this way because this shell seems a bit -# broken. -if [ -e last-incremental-failed ]; then - cabal clean || true - # windows breakage.. - rm -rf dist dist.old || mv -v dist dist.old -fi -touch last-incremental-failed - +# Deps are not built with cygwin environment, because we don't want +# configure scripts for haskell libraries to link them with the cygwin +# libraries. +stack setup +stack build --dependencies-only + # Build git-annex -withcyg cabal configure -if ! withcyg cabal build; then - rm -f Build/EvilLinker.exe - ghc --make Build/EvilLinker -fno-warn-tabs - Build/EvilLinker -fi +withcyg stack build # Get extra programs to bundle with git-annex. # These are msys2 programs, from https://msys2.github.io/. @@ -96,15 +70,10 @@ getextra rsync.exe 85cb7a4d16d274fcf8069b39042965ad26abd6aa getextra wget.exe 044380729200d5762965b10123a4f134806b01cf # Build the installer -cabal install nsis -ghc -fforce-recomp --make Build/NullSoftInstaller.hs -fno-warn-tabs -PATH=".:/c/cygwin/bin:$PATH" Build/NullSoftInstaller.exe - -rm -f last-incremental-failed +withcygpreferred stack runghc --package nsis Build/NullSoftInstaller.hs rm -f dist/build-version -ghc --make Build/BuildVersion.hs -Build/BuildVersion > dist/build-version +stack runghc Build/BuildVersion.hs > dist/build-version # Test git-annex # The test is run in c:/WINDOWS/Temp, because running it in the autobuilder |