Merge branch 'master' into s3-aws
Conflicts: Utility/Url.hs debian/changelog git-annex.cabal
This commit is contained in:
commit
f7847ae98d
282 changed files with 6524 additions and 1207 deletions
|
@ -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 $
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue