Merge branch 'master' into s3-aws

Conflicts:
	Utility/Url.hs
	debian/changelog
	git-annex.cabal
This commit is contained in:
Joey Hess 2014-09-18 14:36:20 -04:00
commit f7847ae98d
282 changed files with 6524 additions and 1207 deletions

View file

@ -51,6 +51,7 @@ import qualified Remote.Helper.Ssh as Ssh
import qualified Remote.GCrypt
import Config.Files
import Creds
import Annex.CatFile
import Control.Concurrent
import Control.Concurrent.MSampleVar
@ -338,8 +339,8 @@ dropKey r key
commitOnCleanup r $ onLocal r $ do
ensureInitialized
whenM (Annex.Content.inAnnex key) $ do
Annex.Content.lockContent key $
Annex.Content.removeAnnex key
Annex.Content.lockContent key
Annex.Content.removeAnnex
logStatus key InfoMissing
Annex.Content.saveState True
return True
@ -354,15 +355,27 @@ copyFromRemote' r key file dest
| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) (return False) $ do
params <- Ssh.rsyncParams r Download
u <- getUUID
hardlink <- annexHardLink <$> Annex.getGitConfig
-- run copy from perspective of remote
onLocal r $ do
ensureInitialized
v <- Annex.Content.prepSendAnnex key
case v of
Nothing -> return False
Just (object, checksuccess) ->
runTransfer (Transfer Download u key) file noRetry
(rsyncOrCopyFile params object dest)
Just (object, checksuccess) -> do
let copier = rsyncOrCopyFile params object dest
#ifndef mingw32_HOST_OS
let linker = createLink object dest >> return True
go <- ifM (pure hardlink <&&> not <$> isDirect)
( return $ \m -> liftIO (catchBoolIO linker)
<||> copier m
, return copier
)
#else
let go = copier
#endif
runTransfer (Transfer Download u key)
file noRetry go
<&&> checksuccess
| Git.repoIsSsh (repo r) = feedprogressback $ \feeder -> do
direct <- isDirect
@ -500,6 +513,8 @@ repairRemote r a = return $ do
{- Runs an action from the perspective of a local remote.
-
- The AnnexState is cached for speed and to avoid resource leaks.
- However, catFileStop is called to avoid git-cat-file processes hanging
- around on removable media.
-
- The repository's git-annex branch is not updated, as an optimisation.
- No caller of onLocal can query data from the branch and be ensured
@ -520,7 +535,8 @@ onLocal r a = do
cache st = Annex.changeState $ \s -> s
{ Annex.remoteannexstate = M.insert (uuid r) st (Annex.remoteannexstate s) }
go st a' = do
(ret, st') <- liftIO $ Annex.run st a'
(ret, st') <- liftIO $ Annex.run st $
catFileStop `after` a'
cache st'
return ret
@ -539,7 +555,7 @@ rsyncOrCopyFile rsyncparams src dest p =
docopy = liftIO $ bracket
(forkIO $ watchfilesize zeroBytesProcessed)
(void . tryIO . killThread)
(const $ copyFileExternal src dest)
(const $ copyFileExternal CopyTimeStamps src dest)
watchfilesize oldsz = do
threadDelay 500000 -- 0.5 seconds
v <- catchMaybeIO $

View file

@ -16,10 +16,9 @@ import Types.Remote
import Types.CleanupActions
import qualified Annex
import Annex.LockFile
import Utility.LockFile
#ifndef mingw32_HOST_OS
import Annex.Perms
#else
import Utility.WinLock
#endif
{- Modifies a remote's access functions to first run the
@ -84,19 +83,12 @@ runHooks r starthook stophook a = do
unlockFile lck
#ifndef mingw32_HOST_OS
mode <- annexFileMode
fd <- liftIO $ noUmask mode $
openFd lck ReadWrite (Just mode) defaultFileFlags
v <- liftIO $ tryIO $
setLock fd (WriteLock, AbsoluteSeek, 0, 0)
case v of
Left _ -> noop
Right _ -> run stophook
liftIO $ closeFd fd
v <- liftIO $ noUmask mode $ tryLockExclusive (Just mode) lck
#else
v <- liftIO $ lockExclusive lck
#endif
case v of
Nothing -> noop
Just lockhandle -> do
run stophook
liftIO $ dropLock lockhandle
#endif

View file

@ -92,7 +92,7 @@ gen r u c gc = do
genRsyncOpts :: RemoteConfig -> RemoteGitConfig -> [CommandParam] -> RsyncUrl -> RsyncOpts
genRsyncOpts c gc transport url = RsyncOpts
{ rsyncUrl = url
, rsyncOptions = opts []
, rsyncOptions = transport ++ opts []
, rsyncUploadOptions = transport ++ opts (remoteAnnexRsyncUploadOptions gc)
, rsyncDownloadOptions = transport ++ opts (remoteAnnexRsyncDownloadOptions gc)
, rsyncShellEscape = M.lookup "shellescape" c /= Just "no"

View file

@ -183,7 +183,7 @@ testDav url (Just (u, p)) = do
test $ liftIO $ evalDAVT url $ do
prepDAV user pass
makeParentDirs
inLocation tmpDir $ void mkCol
void $ mkColRecursive tmpDir
inLocation (tmpLocation "git-annex-test") $ do
putContentM (Nothing, L.empty)
delContentM