summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Annex.hs3
-rw-r--r--Build/NullSoftInstaller.hs13
-rw-r--r--CHANGELOG3
-rw-r--r--CmdLine/Action.hs38
-rw-r--r--Command/Get.hs4
-rw-r--r--Command/Mirror.hs2
-rw-r--r--Command/Move.hs2
-rw-r--r--Command/Sync.hs2
-rw-r--r--doc/bugs/get_-J___34__fails__34___to_get_files_with_the_same_key.mdwn4
-rw-r--r--doc/bugs/get_-J___34__fails__34___to_get_files_with_the_same_key/comment_6_5f2ed95bcad2e3d1c4260d1fb0440052._comment19
-rw-r--r--doc/devblog/day_476__third_time_lucky.mdwn29
-rw-r--r--stack.yaml2
-rwxr-xr-xstandalone/windows/build-simple.sh26
-rwxr-xr-xstandalone/windows/build.sh59
14 files changed, 130 insertions, 76 deletions
diff --git a/Annex.hs b/Annex.hs
index add568a1b..32a303239 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -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"
diff --git a/CHANGELOG b/CHANGELOG
index f6c1c8daa..1d9a71188 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -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