summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Annex/Content.hs13
-rw-r--r--Annex/Ingest.hs32
-rw-r--r--Annex/MetaData.hs2
-rw-r--r--Assistant/Threads/Committer.hs30
-rw-r--r--Command/Add.hs6
-rw-r--r--Command/Migrate.hs9
-rw-r--r--Command/ReKey.hs80
-rw-r--r--Command/Smudge.hs6
-rw-r--r--Database/Keys.hs2
-rw-r--r--Test.hs7
-rw-r--r--debian/changelog1
-rw-r--r--doc/devblog/day_354-355__beating_on_the_test_suite.mdwn8
-rw-r--r--doc/todo/smudge.mdwn16
13 files changed, 142 insertions, 70 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs
index 9e8da49e9..fd0a2742c 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -30,6 +30,8 @@ module Annex.Content (
LinkAnnexResult(..),
unlinkAnnex,
checkedCopyFile,
+ linkOrCopy,
+ linkOrCopy',
sendAnnex,
prepSendAnnex,
removeAnnex,
@@ -582,11 +584,14 @@ linkAnnex fromto key src (Just srcic) dest = do
{- Hard links or copies src to dest. Only uses a hard link when annex.thin
- is enabled and when src is not already hardlinked to elsewhere.
- - Checks disk reserve before copying, and will fail if not enough space,
- - or if the dest file already exists. -}
+ - Checks disk reserve before copying against the size of the key,
+ - and will fail if not enough space, or if the dest file already exists. -}
linkOrCopy :: Key -> FilePath -> FilePath -> Annex Bool
-linkOrCopy key src dest = catchBoolIO $
- ifM (annexThin <$> Annex.getGitConfig)
+linkOrCopy = linkOrCopy' (annexThin <$> Annex.getGitConfig)
+
+linkOrCopy' :: Annex Bool -> Key -> FilePath -> FilePath -> Annex Bool
+linkOrCopy' canhardlink key src dest = catchBoolIO $
+ ifM canhardlink
( hardlink
, copy =<< getstat
)
diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs
index 73f8a39ca..70ea105bb 100644
--- a/Annex/Ingest.hs
+++ b/Annex/Ingest.hs
@@ -9,6 +9,7 @@
module Annex.Ingest (
LockedDown(..),
+ LockDownConfig(..),
lockDown,
ingest,
finishIngestDirect,
@@ -48,11 +49,17 @@ import Utility.Touch
import Control.Exception (IOException)
data LockedDown = LockedDown
- { lockingFile :: Bool
+ { lockDownConfig :: LockDownConfig
, keySource :: KeySource
}
deriving (Show)
+data LockDownConfig = LockDownConfig
+ { lockingFile :: Bool -- ^ write bit removed during lock down
+ , hardlinkFileTmp :: Bool -- ^ hard link to temp directory
+ }
+ deriving (Show)
+
{- The file that's being ingested is locked down before a key is generated,
- to prevent it from being modified in between. This lock down is not
- perfect at best (and pretty weak at worst). For example, it does not
@@ -64,24 +71,21 @@ data LockedDown = LockedDown
- against some changes, like deletion or overwrite of the file, and
- allows lsof checks to be done more efficiently when adding a lot of files.
-
- - If lockingfile is True, the file is going to be added in locked mode.
- - So, its write bit is removed as part of the lock down.
- -
- Lockdown can fail if a file gets deleted, and Nothing will be returned.
-}
-lockDown :: Bool -> FilePath -> Annex (Maybe LockedDown)
-lockDown lockingfile file = either
+lockDown :: LockDownConfig -> FilePath -> Annex (Maybe LockedDown)
+lockDown cfg file = either
(\e -> warning (show e) >> return Nothing)
(return . Just)
- =<< lockDown' lockingfile file
+ =<< lockDown' cfg file
-lockDown' :: Bool -> FilePath -> Annex (Either IOException LockedDown)
-lockDown' lockingfile file = ifM crippledFileSystem
+lockDown' :: LockDownConfig -> FilePath -> Annex (Either IOException LockedDown)
+lockDown' cfg file = ifM (pure (not (hardlinkFileTmp cfg)) <||> crippledFileSystem)
( withTSDelta $ liftIO . tryIO . nohardlink
, tryIO $ do
tmp <- fromRepo gitAnnexTmpMiscDir
createAnnexDirectory tmp
- when lockingfile $
+ when (lockingFile cfg) $
freezeContent file
withTSDelta $ \delta -> liftIO $ do
(tmpfile, h) <- openTempFile tmp $
@@ -93,7 +97,7 @@ lockDown' lockingfile file = ifM crippledFileSystem
where
nohardlink delta = do
cache <- genInodeCache file delta
- return $ LockedDown lockingfile $ KeySource
+ return $ LockedDown cfg $ KeySource
{ keyFilename = file
, contentLocation = file
, inodeCache = cache
@@ -101,7 +105,7 @@ lockDown' lockingfile file = ifM crippledFileSystem
withhardlink delta tmpfile = do
createLink file tmpfile
cache <- genInodeCache tmpfile delta
- return $ LockedDown lockingfile $ KeySource
+ return $ LockedDown cfg $ KeySource
{ keyFilename = file
, contentLocation = tmpfile
, inodeCache = cache
@@ -115,7 +119,7 @@ lockDown' lockingfile file = ifM crippledFileSystem
-}
ingest :: Maybe LockedDown -> Annex (Maybe Key, Maybe InodeCache)
ingest Nothing = return (Nothing, Nothing)
-ingest (Just (LockedDown lockingfile source)) = withTSDelta $ \delta -> do
+ingest (Just (LockedDown cfg source)) = withTSDelta $ \delta -> do
backend <- chooseBackend $ keyFilename source
k <- genKey source backend
let src = contentLocation source
@@ -127,7 +131,7 @@ ingest (Just (LockedDown lockingfile source)) = withTSDelta $ \delta -> do
_ -> failure "changed while it was being added"
where
go (Just (key, _)) mcache (Just s)
- | lockingfile = golocked key mcache s
+ | lockingFile cfg = golocked key mcache s
| otherwise = ifM isDirect
( godirect key mcache s
, gounlocked key mcache s
diff --git a/Annex/MetaData.hs b/Annex/MetaData.hs
index 0751bbb49..88415ffde 100644
--- a/Annex/MetaData.hs
+++ b/Annex/MetaData.hs
@@ -30,7 +30,7 @@ import Data.Time.Clock.POSIX
- When the file has been modified, the metadata is copied over
- from the old key to the new key. Note that it looks at the old key as
- committed to HEAD -- the new key may or may not have already been staged
- - in th annex.
+ - in the index.
-
- Also, can generate new metadata, if configured to do so.
-}
diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs
index 34303f52a..be4a0a255 100644
--- a/Assistant/Threads/Committer.hs
+++ b/Assistant/Threads/Committer.hs
@@ -268,11 +268,15 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
direct <- liftAnnex isDirect
unlocked <- liftAnnex versionSupportsUnlockedPointers
let lockingfiles = not (unlocked || direct)
+ let lockdownconfig = LockDownConfig
+ { lockingFile = lockingfiles
+ , hardlinkFileTmp = True
+ }
(pending', cleanup) <- if unlocked || direct
then return (pending, noop)
else findnew pending
(postponed, toadd) <- partitionEithers
- <$> safeToAdd lockingfiles havelsof delayadd pending' inprocess
+ <$> safeToAdd lockdownconfig havelsof delayadd pending' inprocess
cleanup
unless (null postponed) $
@@ -283,7 +287,7 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
catMaybes <$>
if not lockingfiles
then addunlocked direct toadd
- else forM toadd (add lockingfiles)
+ else forM toadd (add lockdownconfig)
if DirWatcher.eventsCoalesce || null added || unlocked || direct
then return $ added ++ otherchanges
else do
@@ -310,15 +314,15 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
| c = return otherchanges
| otherwise = a
- add :: Bool -> Change -> Assistant (Maybe Change)
- add lockingfile change@(InProcessAddChange { lockedDown = ld }) =
+ add :: LockDownConfig -> Change -> Assistant (Maybe Change)
+ add lockdownconfig change@(InProcessAddChange { lockedDown = ld }) =
catchDefaultIO Nothing <~> doadd
where
ks = keySource ld
doadd = sanitycheck ks $ do
(mkey, mcache) <- liftAnnex $ do
showStart "add" $ keyFilename ks
- ingest $ Just $ LockedDown lockingfile ks
+ ingest $ Just $ LockedDown lockdownconfig ks
maybe (failedingest change) (done change mcache $ keyFilename ks) mkey
add _ _ = return Nothing
@@ -332,15 +336,19 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
ct <- liftAnnex compareInodeCachesWith
m <- liftAnnex $ removedKeysMap isdirect ct cs
delta <- liftAnnex getTSDelta
+ let cfg = LockDownConfig
+ { lockingFile = False
+ , hardlinkFileTmp = True
+ }
if M.null m
- then forM toadd (add False)
+ then forM toadd (add cfg)
else forM toadd $ \c -> do
mcache <- liftIO $ genInodeCache (changeFile c) delta
case mcache of
- Nothing -> add False c
+ Nothing -> add cfg c
Just cache ->
case M.lookup (inodeCacheToKey ct cache) m of
- Nothing -> add False c
+ Nothing -> add cfg c
Just k -> fastadd isdirect c k
fastadd :: Bool -> Change -> Key -> Assistant (Maybe Change)
@@ -416,12 +424,12 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
-
- Check by running lsof on the repository.
-}
-safeToAdd :: Bool -> Bool -> Maybe Seconds -> [Change] -> [Change] -> Assistant [Either Change Change]
+safeToAdd :: LockDownConfig -> Bool -> Maybe Seconds -> [Change] -> [Change] -> Assistant [Either Change Change]
safeToAdd _ _ _ [] [] = return []
-safeToAdd lockingfiles havelsof delayadd pending inprocess = do
+safeToAdd lockdownconfig havelsof delayadd pending inprocess = do
maybe noop (liftIO . threadDelaySeconds) delayadd
liftAnnex $ do
- lockeddown <- forM pending $ lockDown lockingfiles . changeFile
+ lockeddown <- forM pending $ lockDown lockdownconfig . changeFile
let inprocess' = inprocess ++ mapMaybe mkinprocess (zip pending lockeddown)
openfiles <- if havelsof
then S.fromList . map fst3 . filter openwrite <$>
diff --git a/Command/Add.hs b/Command/Add.hs
index 8a7db0a91..b88dc52f7 100644
--- a/Command/Add.hs
+++ b/Command/Add.hs
@@ -115,7 +115,11 @@ start file = ifAnnexed file addpresent add
perform :: FilePath -> CommandPerform
perform file = do
lockingfile <- not <$> isDirect
- lockDown lockingfile file >>= ingest >>= go
+ let cfg = LockDownConfig
+ { lockingFile = lockingfile
+ , hardlinkFileTmp = True
+ }
+ lockDown cfg file >>= ingest >>= go
where
go (Just key, cache) = next $ cleanup file key cache True
go (Nothing, _) = stop
diff --git a/Command/Migrate.hs b/Command/Migrate.hs
index b8d2eea87..87e4772d1 100644
--- a/Command/Migrate.hs
+++ b/Command/Migrate.hs
@@ -17,6 +17,7 @@ import Annex.Content
import qualified Command.ReKey
import qualified Command.Fsck
import qualified Annex
+import Logs.MetaData
cmd :: Command
cmd = notDirect $ withGlobalOptions annexedMatchingOptions $
@@ -73,8 +74,12 @@ perform file oldkey oldbackend newbackend = go =<< genkey
| knowngoodcontent = finish newkey
| otherwise = stopUnless checkcontent $ finish newkey
checkcontent = Command.Fsck.checkBackend oldbackend oldkey Command.Fsck.KeyLocked $ Just file
- finish newkey = stopUnless (Command.ReKey.linkKey oldkey newkey) $
- next $ Command.ReKey.cleanup file oldkey newkey
+ finish newkey = ifM (Command.ReKey.linkKey file oldkey newkey)
+ ( do
+ copyMetaData oldkey newkey
+ next $ Command.ReKey.cleanup file oldkey newkey
+ , error "failed"
+ )
genkey = case maybe Nothing (\fm -> fm oldkey newbackend (Just file)) (fastMigrate oldbackend) of
Just newkey -> return $ Just (newkey, True)
Nothing -> do
diff --git a/Command/ReKey.hs b/Command/ReKey.hs
index 9fb8515c0..468d0dfe6 100644
--- a/Command/ReKey.hs
+++ b/Command/ReKey.hs
@@ -1,6 +1,6 @@
{- git-annex command
-
- - Copyright 2012 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2016 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -13,10 +13,16 @@ import qualified Annex
import Types.Key
import Annex.Content
import Annex.Ingest
+import Annex.Link
+import Annex.Perms
+import Annex.ReplaceFile
import Logs.Web
import Logs.Location
-import Utility.CopyFile
+import Git.FilePath
import qualified Remote
+import qualified Database.Keys
+import Annex.InodeSentinal
+import Utility.InodeCache
cmd :: Command
cmd = notDirect $
@@ -40,24 +46,50 @@ start (file, keyname) = ifAnnexed file go stop
perform :: FilePath -> Key -> Key -> CommandPerform
perform file oldkey newkey = do
- present <- inAnnex oldkey
- _ <- if present
- then linkKey oldkey newkey
- else do
- unlessM (Annex.getState Annex.force) $
- error $ file ++ " is not available (use --force to override)"
- return True
+ ifM (inAnnex oldkey)
+ ( unlessM (linkKey file oldkey newkey) $
+ error "failed"
+ , unlessM (Annex.getState Annex.force) $
+ error $ file ++ " is not available (use --force to override)"
+ )
next $ cleanup file oldkey newkey
{- Make a hard link to the old key content (when supported),
- to avoid wasting disk space. -}
-linkKey :: Key -> Key -> Annex Bool
-linkKey oldkey newkey = getViaTmp' DefaultVerify newkey $ \tmp -> unVerified $ do
- src <- calcRepo $ gitAnnexLocation oldkey
- liftIO $ ifM (doesFileExist tmp)
- ( return True
- , createLinkOrCopy src tmp
- )
+linkKey :: FilePath -> Key -> Key -> Annex Bool
+linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file)
+ {- If the object file is already hardlinked to elsewhere, a hard
+ - link won't be made by getViaTmp', but a copy instead.
+ - This avoids hard linking to content linked to an
+ - unlocked file, which would leave the new key unlocked
+ - and vulnerable to corruption. -}
+ ( getViaTmp' DefaultVerify newkey $ \tmp -> unVerified $ do
+ oldobj <- calcRepo (gitAnnexLocation oldkey)
+ linkOrCopy' (return True) newkey oldobj tmp
+ , do
+ ic <- withTSDelta (liftIO . genInodeCache file)
+ {- The file being rekeyed is itself an unlocked file, so if
+ - it's linked to the old key, that link must be broken. -}
+ oldobj <- calcRepo (gitAnnexLocation oldkey)
+ v <- tryNonAsync $ modifyContent oldobj $ do
+ replaceFile oldobj $ \tmp ->
+ unlessM (checkedCopyFile oldkey file tmp) $
+ error "can't lock old key"
+ freezeContent oldobj
+ oldic <- withTSDelta (liftIO . genInodeCache oldobj)
+ whenM (isUnmodified oldkey oldobj) $
+ Database.Keys.addInodeCaches oldkey (catMaybes [oldic])
+ case v of
+ Left e -> do
+ warning (show e)
+ return False
+ Right () -> do
+ r <- linkToAnnex newkey file ic
+ return $ case r of
+ LinkAnnexFailed -> False
+ LinkAnnexOk -> True
+ LinkAnnexNoop -> True
+ )
cleanup :: FilePath -> Key -> Key -> CommandCleanup
cleanup file oldkey newkey = do
@@ -68,8 +100,18 @@ cleanup file oldkey newkey = do
r <- Remote.claimingUrl url
setUrlPresent (Remote.uuid r) newkey url
- -- Update symlink to use the new key.
- liftIO $ removeFile file
- addLink file newkey Nothing
+ ifM (isJust <$> isAnnexLink file)
+ ( do
+ -- Update symlink to use the new key.
+ liftIO $ removeFile file
+ addLink file newkey Nothing
+ , do
+ liftIO $ whenM (isJust <$> isPointerFile file) $
+ writeFile file (formatPointer newkey)
+ stagePointerFile file =<< hashPointerFile newkey
+ Database.Keys.removeAssociatedFile oldkey
+ =<< inRepo (toTopFilePath file)
+ )
+
logStatus newkey InfoPresent
return True
diff --git a/Command/Smudge.hs b/Command/Smudge.hs
index 8b7d848d2..1ca3de2c3 100644
--- a/Command/Smudge.hs
+++ b/Command/Smudge.hs
@@ -72,7 +72,7 @@ clean file = do
then liftIO $ B.hPut stdout b
else ifM (shouldAnnex file)
( liftIO . emitPointer
- =<< go =<< ingest =<< lockDown False file
+ =<< go =<< ingest =<< lockDown cfg file
, liftIO $ B.hPut stdout b
)
stop
@@ -81,6 +81,10 @@ clean file = do
logStatus k InfoPresent
return k
go _ = error "could not add file to the annex"
+ cfg = LockDownConfig
+ { lockingFile = False
+ , hardlinkFileTmp = False
+ }
shouldAnnex :: FilePath -> Annex Bool
shouldAnnex file = do
diff --git a/Database/Keys.hs b/Database/Keys.hs
index 38d9742df..4c4c65850 100644
--- a/Database/Keys.hs
+++ b/Database/Keys.hs
@@ -173,7 +173,7 @@ addAssociatedFile' k f = queueDb $ do
-- If the same file was associated with a different key before,
-- remove that.
delete $ from $ \r -> do
- where_ (r ^. AssociatedFile ==. val (getTopFilePath f) &&. r ^. AssociatedKey ==. val sk)
+ where_ (r ^. AssociatedFile ==. val (getTopFilePath f) &&. not_ (r ^. AssociatedKey ==. val sk))
void $ insertUnique $ Associated sk (getTopFilePath f)
where
sk = toSKey k
diff --git a/Test.hs b/Test.hs
index 9f7c7e328..3f0abb5c7 100644
--- a/Test.hs
+++ b/Test.hs
@@ -854,16 +854,9 @@ test_unused = intmpclonerepoInDirect $ do
writeFile f "unlockedcontent2"
checkunused [] "with unlocked file after modification"
not <$> boolSystem "git" [Param "diff", Param "--quiet", File f] @? "git diff did not show changes to unlocked file"
- ver2key <- getKey backendSHA256E "unlockedfile"
-- still nothing unused because one version is in the index
-- and the other is in the work tree
checkunused [] "with unlocked file after git diff"
- writeFile f "unlockedcontent3"
- -- original version is still in index; version 2 is unused
- -- now, and version 3 is in work tree
- checkunused [ver2key] "with unlocked file after second modification"
- not <$> boolSystem "git" [Param "diff", Param "--quiet", File f] @? "git diff did not show changes to unlocked file"
- checkunused [ver2key] "with unlocked file after second git diff"
where
checkunused expectedkeys desc = do
git_annex "unused" [] @? "unused failed"
diff --git a/debian/changelog b/debian/changelog
index e5d968d9b..af7bd0753 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -43,6 +43,7 @@ git-annex (6.20151219) UNRELEASED; urgency=medium
* unused: Bug fix when a new file was added to the annex, and then
removed (but not git rmed). git still has the add staged in this case,
so the content should not be unused and was wrongly treated as such.
+ * migrate: Copy over metadata to new key.
-- Joey Hess <id@joeyh.name> Sat, 19 Dec 2015 13:31:17 -0400
diff --git a/doc/devblog/day_354-355__beating_on_the_test_suite.mdwn b/doc/devblog/day_354-355__beating_on_the_test_suite.mdwn
new file mode 100644
index 000000000..2eacb2acb
--- /dev/null
+++ b/doc/devblog/day_354-355__beating_on_the_test_suite.mdwn
@@ -0,0 +1,8 @@
+Been working hard on the last several test suite failures for v6 unlocked
+files. Now I've solved almost all of them, which is a big improvement to
+my confidence in its (almost) correctness.
+
+Frustratingly, the test suite is still not green after all this work.
+There's some kind of intermittent failure related to the sqlite database.
+Only seems to happen when the test suite is running, and the error
+message is simply "Error" which is making it hard to track down..
diff --git a/doc/todo/smudge.mdwn b/doc/todo/smudge.mdwn
index 36561ca7f..8bea3dac9 100644
--- a/doc/todo/smudge.mdwn
+++ b/doc/todo/smudge.mdwn
@@ -2,9 +2,7 @@ git-annex should use smudge/clean filters.
### implementation todo list
-* Test suite has a currently disabled pass that tests v6 unlocked files.
- That pass has many failures.
-* Intermittent test suite failures, with:
+* Intermittent sqlite related test suite failures, with:
Exception: failed to commit changes to sqlite database: Just SQLite3 returned ErrorIO while attempting to perform step.
sqlite worker thread crashed: SQLite3 returned ErrorError while attempting to perform step.
* Reconcile staged changes into the associated files database, whenever
@@ -21,20 +19,20 @@ git-annex should use smudge/clean filters.
(And should avoid unlocking an object with a hard link if it's hard
linked to a shared clone, but that's already accomplished because it
avoids unlocking an object if it's hard linked at all)
-* Crippled filesystem should cause all files to be transparently unlocked.
- Note that this presents problems when dealing with merge conflicts and
- when pushing changes committed in such a repo. Ideally, should avoid
- committing implicit unlocks, or should prevent such commits leaking out
- in pushes.
* Dropping a smudged file causes git status (and git annex status)
to show it as modified, because the timestamp has changed.
Getting a smudged file can also cause this.
Upgrading a direct mode repo also leaves files in this state.
User can use `git add` to clear it up, but better to avoid this,
by updating stat info in the index.
- (May need to use libgit2 to do this, cannot find
+ (May need to use libgit2 to do this efficiently, cannot find
any plumbing except git-update-index, which is very inneficient for
smudged files.)
+* Crippled filesystem should cause all files to be transparently unlocked.
+ Note that this presents problems when dealing with merge conflicts and
+ when pushing changes committed in such a repo. Ideally, should avoid
+ committing implicit unlocks, or should prevent such commits leaking out
+ in pushes.
* Optimisation: See if the database schema can be improved to speed things
up. Are there enough indexes? getAssociatedKey in particular does a
reverse lookup and might benefit from an index.