From 511cf77b6dce10f965a0c4cf81da371a7133cc72 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 28 Aug 2013 13:19:02 -0400 Subject: [PATCH 01/73] add transition log --- Logs/Transitions.hs | 94 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 94 insertions(+) create mode 100644 Logs/Transitions.hs diff --git a/Logs/Transitions.hs b/Logs/Transitions.hs new file mode 100644 index 0000000000..e548a2f232 --- /dev/null +++ b/Logs/Transitions.hs @@ -0,0 +1,94 @@ +{- git-annex transitions log + - + - This is used to record transitions that have been performed on the + - git-annex branch, and when the transition was first started. + - + - We can quickly detect when the local branch has already had an transition + - done that is listed in the remote branch by checking that the local + - branch contains the same transition, with the same or newer start time. + - + - When a remote branch that has had an transition performed on it + - becomes available for merging into the local git-annex branch, + - the transition is first performed on the local branch. + - + - When merging a remote branch into the local git-annex branch, + - all transitions that have been performed on the local branch must also + - have been performed on the remote branch already. (Or it would be + - possible to perform the transitions on a fixup branch and merge it, + - but that would be expensive.) + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Logs.Transitions where + +import Data.Time.Clock.POSIX +import Data.Time +import System.Locale +import qualified Data.Set as S + +import Common.Annex + +transitionsLog :: FilePath +transitionsLog = "transitions.log" + +data Transition + = ForgetGitHistory + | ForgetDeadRemotes + deriving (Show, Ord, Eq, Read) + +data TransitionLine = TransitionLine + { transitionStarted :: POSIXTime + , transition :: Transition + } deriving (Show, Ord, Eq) + +type Transitions = S.Set TransitionLine + +addTransition :: POSIXTime -> Transition -> Transitions -> Transitions +addTransition ts t = S.insert $ TransitionLine ts t + +showTransitions :: Transitions -> String +showTransitions = unlines . map showTransitionLine . S.elems + +{- If the log contains new transitions we don't support, returns Nothing. -} +parseTransitions :: String -> Maybe Transitions +parseTransitions = check . map parseTransitionLine . lines + where + check l + | all isJust l = Just $ S.fromList $ catMaybes l + | otherwise = Nothing + +showTransitionLine :: TransitionLine -> String +showTransitionLine (TransitionLine ts t) = unwords [show t, show ts] + +parseTransitionLine :: String -> Maybe TransitionLine +parseTransitionLine s = TransitionLine <$> pdate ds <*> readish ts + where + ws = words s + ts = Prelude.head ws + ds = unwords $ Prelude.tail ws + pdate = parseTime defaultTimeLocale "%s%Qs" >=*> utcTimeToPOSIXSeconds + +{- Compares two sets of transitions, and returns a list of any transitions + - from the second set that have not yet been perfomed in the first, + - and a list of any transitions from the first set that have not yet been + - performed in the second. -} +diffTransitions :: Transitions -> Transitions -> ([Transition], [Transition]) +diffTransitions a b = (b `diff` a, a `diff` b) + where + diff x y = map transition $ S.elems $ S.difference x y + +sameTransitions :: Transitions -> Transitions -> Bool +sameTransitions a b = let (x, y) = diffTransitions a b in null x && null y + +{- Typically ran with Annex.Branch.change, but we can't import Annex.Branch + - here since it depends on this module. -} +recordTransition :: (FilePath -> (String -> String) -> Annex ()) -> Transition -> Annex () +recordTransition changer o = do + t <- liftIO getPOSIXTime + changer transitionsLog $ + showTransitions . addTransition t o . fromMaybe badlog . parseTransitions + where + badlog = error $ "unknown transitions exist in " ++ transitionsLog From fcd5c167efbaf409e64e8e56114584f094101fb5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 28 Aug 2013 15:57:42 -0400 Subject: [PATCH 02/73] untested transition detection on merging, and transition running code --- Annex/Branch.hs | 112 ++++++++++++++++++++++++++++++++++++++++---- Locations.hs | 5 ++ Logs/Transitions.hs | 30 +++++++----- doc/git-annex.mdwn | 18 +++++++ 4 files changed, 142 insertions(+), 23 deletions(-) diff --git a/Annex/Branch.hs b/Annex/Branch.hs index bc3736a9a6..fa4b0265de 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -1,6 +1,6 @@ {- management of the git-annex branch - - - Copyright 2011-2012 Joey Hess + - Copyright 2011-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -22,9 +22,12 @@ module Annex.Branch ( commit, files, withIndex, + performTransitions, ) where import qualified Data.ByteString.Lazy.Char8 as L +import qualified Data.Set as S +import qualified Data.Map as M import Common.Annex import Annex.BranchState @@ -32,6 +35,7 @@ import Annex.Journal import qualified Git import qualified Git.Command import qualified Git.Ref +import qualified Git.Sha import qualified Git.Branch import qualified Git.UnionMerge import qualified Git.UpdateIndex @@ -42,6 +46,8 @@ import Annex.CatFile import Annex.Perms import qualified Annex import Utility.Env +import Logs.Transitions +import Annex.ReplaceFile {- Name of the branch that is used to store git-annex's information. -} name :: Git.Ref @@ -110,6 +116,9 @@ forceUpdate = updateTo =<< siblingBranches - later get staged, and might overwrite changes made during the merge. - This is only done if some of the Refs do need to be merged. - + - Also handles performing any Transitions that have not yet been + - performed, in either the local branch, or the Refs. + - - Returns True if any refs were merged in, False otherwise. -} updateTo :: [(Git.Ref, Git.Branch)] -> Annex Bool @@ -117,7 +126,8 @@ updateTo pairs = do -- ensure branch exists, and get its current ref branchref <- getBranch dirty <- journalDirty - (refs, branches) <- unzip <$> filterM isnewer pairs + ignoredrefs <- getIgnoredRefs + (refs, branches) <- unzip <$> filterM (isnewer ignoredrefs) pairs if null refs {- Even when no refs need to be merged, the index - may still be updated if the branch has gotten ahead @@ -132,7 +142,9 @@ updateTo pairs = do else lockJournal $ go branchref dirty refs branches return $ not $ null refs where - isnewer (r, _) = inRepo $ Git.Branch.changed fullname r + isnewer ignoredrefs (r, _) + | S.member r ignoredrefs = return False + | otherwise = inRepo $ Git.Branch.changed fullname r go branchref dirty refs branches = withIndex $ do cleanjournal <- if dirty then stageJournal else return noop let merge_desc = if null branches @@ -140,16 +152,23 @@ updateTo pairs = do else "merging " ++ unwords (map Git.Ref.describe branches) ++ " into " ++ show name + localtransitions <- parseTransitionsStrictly "local" + <$> getStale transitionsLog unless (null branches) $ do showSideAction merge_desc mergeIndex refs - ff <- if dirty - then return False - else inRepo $ Git.Branch.fastForward fullname refs - if ff - then updateIndex branchref - else commitBranch branchref merge_desc - (nub $ fullname:refs) + let commitrefs = nub $ fullname:refs + transitioned <- handleTransitions localtransitions commitrefs + case transitioned of + Nothing -> do + ff <- if dirty + then return False + else inRepo $ Git.Branch.fastForward fullname refs + if ff + then updateIndex branchref + else commitBranch branchref merge_desc commitrefs + Just (branchref', commitrefs') -> + commitBranch branchref' merge_desc commitrefs' liftIO cleanjournal {- Gets the content of a file, which may be in the journal, or in the index @@ -361,3 +380,76 @@ stageJournal = withIndex $ do sha <- hashFile h path streamer $ Git.UpdateIndex.updateIndexLine sha FileBlob (asTopFilePath $ fileJournal file) + +{- This is run after the refs have been merged into the index, + - but before the result is committed to the branch. + - Which is why it's passed the contents of the local branches's + - transition log before that merge took place. + - + - When the refs contain transitions that have not yet been done locally, + - the transitions are performed on the index, and a new branch + - is created from the result, and returned. + - + - When there are transitions recorded locally that have not been done + - to the remote refs, the transitions are performed in the index, + - and the existing branch is returned. In this case, the untransitioned + - remote refs cannot be merged into the branch (since transitions + - throw away history), so none of them are included in the returned + - list of refs, and they are added to the list of refs to ignore, + - to avoid re-merging content from them again. + -} +handleTransitions :: Transitions -> [Git.Ref] -> Annex (Maybe (Git.Branch, [Git.Ref])) +handleTransitions localts refs = do + m <- M.fromList <$> mapM getreftransition refs + let remotets = M.elems m + if all (localts ==) remotets + then return Nothing + else do + let allts = combineTransitions (localts:remotets) + let (transitionedrefs, untransitionedrefs) = + partition (\r -> M.lookup r m == Just allts) refs + transitionedbranch <- performTransitions allts (localts /= allts) + ignoreRefs untransitionedrefs + return $ Just (transitionedbranch, transitionedrefs) + where + getreftransition ref = do + ts <- parseTransitionsStrictly "remote" . L.unpack + <$> catFile ref transitionsLog + return (ref, ts) + +ignoreRefs :: [Git.Ref] -> Annex () +ignoreRefs rs = do + old <- getIgnoredRefs + let s = S.unions [old, S.fromList rs] + f <- fromRepo gitAnnexIgnoredRefs + replaceFile f $ \tmp -> liftIO $ writeFile tmp $ + unlines $ map show $ S.elems s + +getIgnoredRefs :: Annex (S.Set Git.Ref) +getIgnoredRefs = S.fromList . mapMaybe Git.Sha.extractSha . lines <$> content + where + content = do + f <- fromRepo gitAnnexIgnoredRefs + liftIO $ catchDefaultIO "" $ readFile f + +{- Performs the specified transitions on the contents of the index file, + - commits it to the branch, or creates a new branch, and returns + - the branch's ref. -} +performTransitions :: Transitions -> Bool -> Annex Git.Ref +performTransitions ts neednewbranch = withIndex $ do + when (inTransitions ForgetDeadRemotes ts) $ + error "TODO ForgetDeadRemotes transition" + if neednewbranch + then do + committedref <- inRepo $ Git.Branch.commit message fullname [] + setIndexSha committedref + return committedref + else do + ref <- getBranch + commitBranch ref message [fullname] + getBranch + where + message + | neednewbranch = "new branch for transition " ++ tdesc + | otherwise = "continuing transition " ++ tdesc + tdesc = show $ map describeTransition $ transitionList ts diff --git a/Locations.hs b/Locations.hs index 1cbbb9886a..7762afb641 100644 --- a/Locations.hs +++ b/Locations.hs @@ -35,6 +35,7 @@ module Locations ( gitAnnexJournalLock, gitAnnexIndex, gitAnnexIndexLock, + gitAnnexIgnoredRefs, gitAnnexPidFile, gitAnnexDaemonStatusFile, gitAnnexLogFile, @@ -225,6 +226,10 @@ gitAnnexIndex r = gitAnnexDir r "index" gitAnnexIndexLock :: Git.Repo -> FilePath gitAnnexIndexLock r = gitAnnexDir r "index.lck" +{- List of refs that should not be merged into the git-annex branch. -} +gitAnnexIgnoredRefs :: Git.Repo -> FilePath +gitAnnexIgnoredRefs r = gitAnnexDir r "ignoredrefs" + {- Pid file for daemon mode. -} gitAnnexPidFile :: Git.Repo -> FilePath gitAnnexPidFile r = gitAnnexDir r "daemon.pid" diff --git a/Logs/Transitions.hs b/Logs/Transitions.hs index e548a2f232..41f4b26353 100644 --- a/Logs/Transitions.hs +++ b/Logs/Transitions.hs @@ -46,6 +46,10 @@ data TransitionLine = TransitionLine type Transitions = S.Set TransitionLine +describeTransition :: Transition -> String +describeTransition ForgetGitHistory = "forget git history" +describeTransition ForgetDeadRemotes = "forget dead remotes" + addTransition :: POSIXTime -> Transition -> Transitions -> Transitions addTransition ts t = S.insert $ TransitionLine ts t @@ -60,6 +64,11 @@ parseTransitions = check . map parseTransitionLine . lines | all isJust l = Just $ S.fromList $ catMaybes l | otherwise = Nothing +parseTransitionsStrictly :: String -> String -> Transitions +parseTransitionsStrictly source = fromMaybe badsource . parseTransitions + where + badsource = error $ "unknown transitions listed in " ++ source ++ "; upgrade git-annex!" + showTransitionLine :: TransitionLine -> String showTransitionLine (TransitionLine ts t) = unwords [show t, show ts] @@ -71,17 +80,14 @@ parseTransitionLine s = TransitionLine <$> pdate ds <*> readish ts ds = unwords $ Prelude.tail ws pdate = parseTime defaultTimeLocale "%s%Qs" >=*> utcTimeToPOSIXSeconds -{- Compares two sets of transitions, and returns a list of any transitions - - from the second set that have not yet been perfomed in the first, - - and a list of any transitions from the first set that have not yet been - - performed in the second. -} -diffTransitions :: Transitions -> Transitions -> ([Transition], [Transition]) -diffTransitions a b = (b `diff` a, a `diff` b) - where - diff x y = map transition $ S.elems $ S.difference x y +combineTransitions :: [Transitions] -> Transitions +combineTransitions = S.unions -sameTransitions :: Transitions -> Transitions -> Bool -sameTransitions a b = let (x, y) = diffTransitions a b in null x && null y +inTransitions :: Transition -> Transitions -> Bool +inTransitions t = not . S.null . S.filter (\l -> transition l == t) + +transitionList :: Transitions -> [Transition] +transitionList = map transition . S.elems {- Typically ran with Annex.Branch.change, but we can't import Annex.Branch - here since it depends on this module. -} @@ -89,6 +95,4 @@ recordTransition :: (FilePath -> (String -> String) -> Annex ()) -> Transition - recordTransition changer o = do t <- liftIO getPOSIXTime changer transitionsLog $ - showTransitions . addTransition t o . fromMaybe badlog . parseTransitions - where - badlog = error $ "unknown transitions exist in " ++ transitionsLog + showTransitions . addTransition t o . parseTransitionsStrictly "local" diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 7cac9087d1..72e376d649 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -479,6 +479,24 @@ subdirectories). Upgrades the repository to current layout. +* forget + + Causes the git-annex branch to be rewritten, throwing away historical + data about past locations of files, files that are no longer present on + any remote, etc. The resulting branch will use less space, but for + example `git annex log` will not be able to show where files used to + be located. + + To also prune references to remotes that have been marked as dead, + specify --forget-dead. + + When this rewritten branch is merged into other clones of + the repository, git-annex will automatically perform the same rewriting + to their local git-annex branch. So the forgetfulness will automatically + propigate out from its starting point until all repositories running + git-annex have forgotten their old history. (You may need to force + git to push the branch to any git repositories not running git-annex. + # QUERY COMMANDS * version From 4a915cd3cdf5757637c9c8d0b43e1c208524ddb9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 28 Aug 2013 16:38:03 -0400 Subject: [PATCH 03/73] add forget command Works, more or less. --dead is not implemented, and so far a new branch is made, but keys no longer present anywhere are not scrubbed. git annex sync fails to push the synced/git-annex branch after a forget, because it's not a fast-forward of the existing synced branch. Could be fixed by making git-annex sync use assistant-style sync branches. --- Annex/Branch.hs | 1 + Command/Forget.hs | 41 +++++++++++++++++++++++++++++++++++++++++ GitAnnex.hs | 2 ++ Logs/Transitions.hs | 10 ++++++---- doc/git-annex.mdwn | 2 +- 5 files changed, 51 insertions(+), 5 deletions(-) create mode 100644 Command/Forget.hs diff --git a/Annex/Branch.hs b/Annex/Branch.hs index fa4b0265de..5af6b6be97 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -402,6 +402,7 @@ handleTransitions :: Transitions -> [Git.Ref] -> Annex (Maybe (Git.Branch, [Git. handleTransitions localts refs = do m <- M.fromList <$> mapM getreftransition refs let remotets = M.elems m + liftIO $ print ("transitions", localts, remotets) if all (localts ==) remotets then return Nothing else do diff --git a/Command/Forget.hs b/Command/Forget.hs new file mode 100644 index 0000000000..e405a99181 --- /dev/null +++ b/Command/Forget.hs @@ -0,0 +1,41 @@ +{- git-annex command + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.Forget where + +import Common.Annex +import Command +import qualified Annex.Branch as Branch +import Logs.Transitions +import qualified Annex + +import Data.Time.Clock.POSIX + +def :: [Command] +def = [command "forget" paramNothing seek + SectionMaintenance "prune git-annex branch history"] + +seek :: [CommandSeek] +seek = [withNothing start] + +start :: CommandStart +start = do + showStart "forget" "git-annex" + next $ perform =<< Annex.getState Annex.force + +perform :: Bool -> CommandPerform +perform True = do + now <- liftIO getPOSIXTime + let ts = addTransition now ForgetGitHistory noTransitions + recordTransitions Branch.change ts + -- get branch committed before contining with the transition + Branch.update + void $ Branch.performTransitions ts True + next $ return True +perform False = do + showLongNote "To forget git-annex branch history, you must specify --force. This deletes metadata!" + stop diff --git a/GitAnnex.hs b/GitAnnex.hs index 05565e643b..1212edf9fe 100644 --- a/GitAnnex.hs +++ b/GitAnnex.hs @@ -67,6 +67,7 @@ import qualified Command.Map import qualified Command.Direct import qualified Command.Indirect import qualified Command.Upgrade +import qualified Command.Forget import qualified Command.Version import qualified Command.Help #ifdef WITH_ASSISTANT @@ -139,6 +140,7 @@ cmds = concat , Command.Direct.def , Command.Indirect.def , Command.Upgrade.def + , Command.Forget.def , Command.Version.def , Command.Help.def #ifdef WITH_ASSISTANT diff --git a/Logs/Transitions.hs b/Logs/Transitions.hs index 41f4b26353..d4b7d5eb35 100644 --- a/Logs/Transitions.hs +++ b/Logs/Transitions.hs @@ -50,6 +50,9 @@ describeTransition :: Transition -> String describeTransition ForgetGitHistory = "forget git history" describeTransition ForgetDeadRemotes = "forget dead remotes" +noTransitions :: Transitions +noTransitions = S.empty + addTransition :: POSIXTime -> Transition -> Transitions -> Transitions addTransition ts t = S.insert $ TransitionLine ts t @@ -91,8 +94,7 @@ transitionList = map transition . S.elems {- Typically ran with Annex.Branch.change, but we can't import Annex.Branch - here since it depends on this module. -} -recordTransition :: (FilePath -> (String -> String) -> Annex ()) -> Transition -> Annex () -recordTransition changer o = do - t <- liftIO getPOSIXTime +recordTransitions :: (FilePath -> (String -> String) -> Annex ()) -> Transitions -> Annex () +recordTransitions changer t = do changer transitionsLog $ - showTransitions . addTransition t o . parseTransitionsStrictly "local" + showTransitions . S.union t . parseTransitionsStrictly "local" diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 72e376d649..5fb0ce5a4d 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -488,7 +488,7 @@ subdirectories). be located. To also prune references to remotes that have been marked as dead, - specify --forget-dead. + specify --dead. When this rewritten branch is merged into other clones of the repository, git-annex will automatically perform the same rewriting From d9bc4bd2764812525cc518e399c23d476cae3820 Mon Sep 17 00:00:00 2001 From: Gastlag Date: Wed, 28 Aug 2013 21:49:56 +0000 Subject: [PATCH 04/73] Added a comment: Gittorrent --- ...ment_1_f4c110ef35ebf4fd89f06edf2c4f0c48._comment | 13 +++++++++++++ 1 file changed, 13 insertions(+) create mode 100644 doc/todo/Bittorrent-like_features/comment_1_f4c110ef35ebf4fd89f06edf2c4f0c48._comment diff --git a/doc/todo/Bittorrent-like_features/comment_1_f4c110ef35ebf4fd89f06edf2c4f0c48._comment b/doc/todo/Bittorrent-like_features/comment_1_f4c110ef35ebf4fd89f06edf2c4f0c48._comment new file mode 100644 index 0000000000..eba291af97 --- /dev/null +++ b/doc/todo/Bittorrent-like_features/comment_1_f4c110ef35ebf4fd89f06edf2c4f0c48._comment @@ -0,0 +1,13 @@ +[[!comment format=mdwn + username="Gastlag" + ip="109.190.97.30" + subject="Gittorrent" + date="2013-08-28T21:49:56Z" + content=""" +May this could interest you : few years ago somes tried to mix Git and Bittorrent. + +http://www.advogato.org/article/994.html +http://utsl.gen.nz/gittorrent/rfc.html +http://code.google.com/p/gittorrent/ +https://git.wiki.kernel.org/index.php/SoC2010Application#Did_your_organization_participate_in_past_GSoCs.3F_If_so.2C_please_summarize_your_involvement_and_the_successes_and_challenges_of_your_participation +"""]] From 10eb376a4c65463455b11c6e1fae53c6c7ee5f61 Mon Sep 17 00:00:00 2001 From: "https://www.google.com/accounts/o8/id?id=AItOawknruiCHUcOh2mmpkh7OFJ4iNfAOOamRVs" Date: Thu, 29 Aug 2013 06:38:46 +0000 Subject: [PATCH 05/73] Added a comment --- ..._155e0c4d3aa41eebfe27533ab70a91d3._comment | 68 +++++++++++++++++++ 1 file changed, 68 insertions(+) create mode 100644 doc/bugs/Windows_and_Linux_in_direct_mode_confuses_git/comment_1_155e0c4d3aa41eebfe27533ab70a91d3._comment diff --git a/doc/bugs/Windows_and_Linux_in_direct_mode_confuses_git/comment_1_155e0c4d3aa41eebfe27533ab70a91d3._comment b/doc/bugs/Windows_and_Linux_in_direct_mode_confuses_git/comment_1_155e0c4d3aa41eebfe27533ab70a91d3._comment new file mode 100644 index 0000000000..1a443fb197 --- /dev/null +++ b/doc/bugs/Windows_and_Linux_in_direct_mode_confuses_git/comment_1_155e0c4d3aa41eebfe27533ab70a91d3._comment @@ -0,0 +1,68 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawknruiCHUcOh2mmpkh7OFJ4iNfAOOamRVs" + nickname="Renaud" + subject="comment 1" + date="2013-08-29T06:38:44Z" + content=""" +I wonder if it isn't related to the fact that even if I do `git annex drop` on windows, the file is still marked as modified in git. +What is in repository is the path to the file's data using unix style folder separator but what is in my working directory is a file containing the path using windows style folder separator. + +I paste a transcript to describe what I mean: + +[[!format sh \"\"\" +$ mkdir tmp + +$ cd tmp + +$ git init +Initialized empty Git repository in c:/Users/raz/tmp/tmp/.git/ + +$ git annex init test +init test + Detected a crippled filesystem. + + Enabling direct mode. + + Detected a filesystem without fifo support. + + Disabling ssh connection caching. +ok +(Recording state in git...) + +$ echo test > test + +$ git annex add +add test (checksum...) ok +(Recording state in git...) + +$ git annex sync +commit +ok +git-annex: no branch is checked out + +$ git annex drop --force +drop test ok +(Recording state in git...) + +$ git status +# On branch master +# Changes not staged for commit: +# (use \"git add ...\" to update what will be committed) +# (use \"git checkout -- ...\" to discard changes in working directory) +# +# modified: test +# +no changes added to commit (use \"git add\" and/or \"git commit -a\") + +$ git diff +diff --git a/test b/test +index a9dd439..62343b2 120000 +--- a/test ++++ b/test +@@ -1 +1 @@ +-.git/annex/objects/w8/pv/SHA256E-s5--f2ca1bb6c7e907d06dafe4687e579fce76b37e4e93 +\ No newline at end of file ++.git\annex\objects\w8\pv\SHA256E-s5--f2ca1bb6c7e907d06dafe4687e579fce76b37e4e93 +\ No newline at end of file +\"\"\"]] +"""]] From 406c1766595ebce89149b23297c986861109b27a Mon Sep 17 00:00:00 2001 From: "http://nicolas-schodet.myopenid.com/" Date: Thu, 29 Aug 2013 07:16:31 +0000 Subject: [PATCH 06/73] --- ...denied__44___after_direct_mode_switch.mdwn | 77 +++++++++++++++++++ 1 file changed, 77 insertions(+) create mode 100644 doc/bugs/rename:_permission_denied__44___after_direct_mode_switch.mdwn diff --git a/doc/bugs/rename:_permission_denied__44___after_direct_mode_switch.mdwn b/doc/bugs/rename:_permission_denied__44___after_direct_mode_switch.mdwn new file mode 100644 index 0000000000..16f243e9a2 --- /dev/null +++ b/doc/bugs/rename:_permission_denied__44___after_direct_mode_switch.mdwn @@ -0,0 +1,77 @@ +### Please describe the problem. + +On Mac OS X, I tried to switch a repository to direct mode, but there was a +problem in the middle of the switch (permission denied) and the switch +aborted, leaving the repository in a half switched state. + +I tried different manipulations, one of which was a checkout (oops), switch +back to indirect, then direct again, and now I have the repository in direct +mode except one file which caused the permission denied error. + +### What steps will reproduce the problem? + +Do not know exactly why this file is special. I still have the repository, and +each time I try to get this file, it fails with the same error message. + +### What version of git-annex are you using? On what operating system? + +On Umba, git-annex version: 4.20130723, on Mac OS X 10.6.8. + +### Please provide any additional information below. + +Umba is the Mac OS X, camaar and riva are Debian machines. + +[[!format sh """ +Umba$ git annex version +git-annex version: 4.20130723 +build flags: Assistant Webapp Pairing Testsuite S3 WebDAV FsEvents XMPP DNS +Umba$ + +Umba$ git annex get --from riva --not --in here +get 2013-07-31/2013-07-31_180411.jpg (from riva...) +Password: +SHA256-s2819887--987f9811d7b5c7a287a74b7adbb852be4d18eeda61c3507f4e08c534d2356f4c + 2819887 100% 943.08kB/s 0:00:02 (xfer#1, to-check=0/1) + +sent 42 bytes received 2820397 bytes 433913.69 bytes/sec +total size is 2819887 speedup is 1.00 +failed +git-annex: get: 1 failed +Umba$ find . -name SHA256-s2819887-\* +./.git/annex/objects/wq/3j/SHA256-s2819887--987f9811d7b5c7a287a74b7adbb852be4d18eeda61c3507f4e08c534d2356f4c +./.git/annex/objects/wq/3j/SHA256-s2819887--987f9811d7b5c7a287a74b7adbb852be4d18eeda61c3507f4e08c534d2356f4c/SHA256-s2819887--987f9811d7b5c7a287a74b7adbb852be4d18eeda61c3507f4e08c534d2356f4c.cache +./.git/annex/objects/wq/3j/SHA256-s2819887--987f9811d7b5c7a287a74b7adbb852be4d18eeda61c3507f4e08c534d2356f4c/SHA256-s2819887--987f9811d7b5c7a287a74b7adbb852be4d18eeda61c3507f4e08c534d2356f4c.map +./.git/annex/transfer/failed/download/13fd5d5a-ed97-11e2-9178-574d3b1c0618/SHA256-s2819887--987f9811d7b5c7a287a74b7adbb852be4d18eeda61c3507f4e08c534d2356f4c +./.git/annex/transfer/failed/download/95443f2e-ed96-11e2-9d3f-8ffa5b1aae7a/SHA256-s2819887--987f9811d7b5c7a287a74b7adbb852be4d18eeda61c3507f4e08c534d2356f4c +Umba$ git annex fsck +fsck 2013-07-31/2013-07-31_180411.jpg ok +(Recording state in git...) +Umba$ git annex drop 2013-07-31/2013-07-31_180411.jpg +Umba$ git annex get --from riva --not --in here +get 2013-07-31/2013-07-31_180411.jpg (from riva...) +Password: +SHA256-s2819887--987f9811d7b5c7a287a74b7adbb852be4d18eeda61c3507f4e08c534d2356f4c + 2819887 100% 949.58kB/s 0:00:02 (xfer#1, to-check=0/1) + +sent 42 bytes received 2820397 bytes 512807.09 bytes/sec +total size is 2819887 speedup is 1.00 +failed +git-annex: get: 1 failed +Umba$ + +camaar% git annex copy --to umba --not --in umba +copy 2013-07-31/2013-07-31_180411.jpg (checking umba...) (to umba...) +SHA256-s2819887--987f9811d7b5c7a287a74b7adbb852be4d18eeda61c3507f4e08c534d2356f4c + 2819887 100% 4.19MB/s 0:00:00 (xfer#1, to-check=0/1) +git-annex: //Users/nicolas/Pictures/Petites Boutes/.git/annex/tmp/2013-07-31_18041141700.jpg: rename: permission denied (Operation not permitted) +git-annex-shell: recvkey: 1 failed + +sent 2820393 bytes received 42 bytes 1128174.00 bytes/sec +total size is 2819887 speedup is 1.00 +rsync error: syntax or usage error (code 1) at main.c(1070) [sender=3.0.9] + + rsync failed -- run git annex again to resume file transfer +failed +git-annex: copy: 1 failed +camaar% +"""]] From 8aea7deecc4acb232a35c0c8589334dc2fc101d8 Mon Sep 17 00:00:00 2001 From: "https://me.yahoo.com/a/2grhJvAC049fJnvALDXek.6MRZMTlg--#eec89" Date: Thu, 29 Aug 2013 07:23:13 +0000 Subject: [PATCH 07/73] Added a comment --- .../comment_1_0cf7a12bfa2957260f4b2f79b0cadf2f._comment | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 doc/forum/Pruning_out_unwanted_Git_objects/comment_1_0cf7a12bfa2957260f4b2f79b0cadf2f._comment diff --git a/doc/forum/Pruning_out_unwanted_Git_objects/comment_1_0cf7a12bfa2957260f4b2f79b0cadf2f._comment b/doc/forum/Pruning_out_unwanted_Git_objects/comment_1_0cf7a12bfa2957260f4b2f79b0cadf2f._comment new file mode 100644 index 0000000000..fbf538afa5 --- /dev/null +++ b/doc/forum/Pruning_out_unwanted_Git_objects/comment_1_0cf7a12bfa2957260f4b2f79b0cadf2f._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://me.yahoo.com/a/2grhJvAC049fJnvALDXek.6MRZMTlg--#eec89" + nickname="John" + subject="comment 1" + date="2013-08-29T07:23:13Z" + content=""" +Maybe one way to solve this that would be general is to have some kind of `prune-history` command, which keeps only the HEAD and drops everything else. Because there are some repositories that I want to manage with `git-annex` for many reasons, but I don't care about keep history around at all. +"""]] From a569cad4c94e237d382c8badd383fba55af5fdce Mon Sep 17 00:00:00 2001 From: "https://www.google.com/accounts/o8/id?id=AItOawnRai_qFYPVvEgC6i1nlM1bh-C__jbhqS0" Date: Thu, 29 Aug 2013 12:45:11 +0000 Subject: [PATCH 08/73] Added a comment: Looks great --- ...ent_2_3192f614c929b8060d4fbde56a7adec1._comment | 14 ++++++++++++++ 1 file changed, 14 insertions(+) create mode 100644 doc/forum/Running_assistant_steps_manually/comment_2_3192f614c929b8060d4fbde56a7adec1._comment diff --git a/doc/forum/Running_assistant_steps_manually/comment_2_3192f614c929b8060d4fbde56a7adec1._comment b/doc/forum/Running_assistant_steps_manually/comment_2_3192f614c929b8060d4fbde56a7adec1._comment new file mode 100644 index 0000000000..b6c10ee880 --- /dev/null +++ b/doc/forum/Running_assistant_steps_manually/comment_2_3192f614c929b8060d4fbde56a7adec1._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnRai_qFYPVvEgC6i1nlM1bh-C__jbhqS0" + nickname="Matthew" + subject="Looks great" + date="2013-08-29T12:45:10Z" + content=""" +This looks great as I have: + + * A preference for multiple small repositories. + * Old versions for `git-annex` due to being on Ubuntu LTS for my server. + * A Samsung Galaxy Nexus which somehow seems too slow to run the assistant. + +So these steps combined with some locking and maybe `inotify` seem perfect +"""]] From c181efe43786cc913385c931cf2ef8c34588dc36 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 29 Aug 2013 13:31:29 -0400 Subject: [PATCH 09/73] use --force in taggedPush This should make the assistant force update its tagged push branch after a transition like git annex forget. --- Annex/TaggedPush.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Annex/TaggedPush.hs b/Annex/TaggedPush.hs index 44a1a0eb0e..2a5f823fd3 100644 --- a/Annex/TaggedPush.hs +++ b/Annex/TaggedPush.hs @@ -49,6 +49,10 @@ fromTaggedBranch b = case split "/" $ show b of taggedPush :: UUID -> Maybe String -> Git.Ref -> Remote -> Git.Repo -> IO Bool taggedPush u info branch remote = Git.Command.runBool [ Param "push" + -- This is safe because we "own" the tagged branch we're pushing; + -- it has no other writers. Ensures it is pushed even if it has + -- been rewritten by a transition. + , Param "--force" , Param $ Remote.name remote , Param $ refspec Annex.Branch.name , Param $ refspec branch From 0886ee0e9cf781036cb72b7dc0ab81d19df94828 Mon Sep 17 00:00:00 2001 From: "http://sunny256.sunbase.org/" Date: Thu, 29 Aug 2013 18:05:39 +0000 Subject: [PATCH 10/73] Added a comment: Missing from the downloads.kitenet.net annex --- ...omment_1_937cbaccf235d6d9118aacd49058bb4f._comment | 11 +++++++++++ 1 file changed, 11 insertions(+) create mode 100644 doc/news/version_4.20130827/comment_1_937cbaccf235d6d9118aacd49058bb4f._comment diff --git a/doc/news/version_4.20130827/comment_1_937cbaccf235d6d9118aacd49058bb4f._comment b/doc/news/version_4.20130827/comment_1_937cbaccf235d6d9118aacd49058bb4f._comment new file mode 100644 index 0000000000..293938867e --- /dev/null +++ b/doc/news/version_4.20130827/comment_1_937cbaccf235d6d9118aacd49058bb4f._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="http://sunny256.sunbase.org/" + nickname="sunny256" + subject="Missing from the downloads.kitenet.net annex" + date="2013-08-29T18:05:38Z" + content=""" +Great release, thanks a lot. It's missing from the annex at downloads.kitenet.net, though. + +Cheers,
+Øyvind (sunny256) +"""]] From 6a737ca6af904529c7f03b53000c0ec11f2c7c6f Mon Sep 17 00:00:00 2001 From: "http://joeyh.name/" Date: Thu, 29 Aug 2013 18:15:08 +0000 Subject: [PATCH 11/73] Added a comment --- ...comment_2_3405f3cd699860ee239cf23ade19e92c._comment | 10 ++++++++++ 1 file changed, 10 insertions(+) create mode 100644 doc/bugs/git-annex_quit_unexpectedly___40__macosx__41__/comment_2_3405f3cd699860ee239cf23ade19e92c._comment diff --git a/doc/bugs/git-annex_quit_unexpectedly___40__macosx__41__/comment_2_3405f3cd699860ee239cf23ade19e92c._comment b/doc/bugs/git-annex_quit_unexpectedly___40__macosx__41__/comment_2_3405f3cd699860ee239cf23ade19e92c._comment new file mode 100644 index 0000000000..18b2b7a52c --- /dev/null +++ b/doc/bugs/git-annex_quit_unexpectedly___40__macosx__41__/comment_2_3405f3cd699860ee239cf23ade19e92c._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="4.153.8.7" + subject="comment 2" + date="2013-08-29T18:15:08Z" + content=""" +I now have a test case that shows that this can happen reliably on OSX if you enter the wrong XMPP password repeatedly. It might also happen if you just enter the wrong password once, with a server like google's, since the assistant will try falling back to different servers. John is aware of this haskell-gnutls problem. + +John also found, and we hope fixed (but it's hard to tell) a bug in haskell-gnutls that caused a crash maybe 1 time in 10 under some conditions on OSX, when the right password was entered. +"""]] From 86a9aaf6c1141dcb30eb9833f9fecd5fe97cf5e9 Mon Sep 17 00:00:00 2001 From: "http://joeyh.name/" Date: Thu, 29 Aug 2013 18:26:00 +0000 Subject: [PATCH 12/73] Added a comment --- ..._faa5cf0645728b4ade850a691fa472db._comment | 25 +++++++++++++++++++ 1 file changed, 25 insertions(+) create mode 100644 doc/news/version_4.20130827/comment_2_faa5cf0645728b4ade850a691fa472db._comment diff --git a/doc/news/version_4.20130827/comment_2_faa5cf0645728b4ade850a691fa472db._comment b/doc/news/version_4.20130827/comment_2_faa5cf0645728b4ade850a691fa472db._comment new file mode 100644 index 0000000000..0002e8607b --- /dev/null +++ b/doc/news/version_4.20130827/comment_2_faa5cf0645728b4ade850a691fa472db._comment @@ -0,0 +1,25 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="4.153.8.7" + subject="comment 2" + date="2013-08-29T18:26:00Z" + content=""" +It seems to be there on downloads.kitenet.net. When I run `git log` in there I see commit 82de1ed1a354e389bc71a15af1a3e67b5bd56f23 which added the release to the annex, and all the files seem to be present. For example, git-annex-standalone-amd64.tar.gz is pointing at the key `SHA256E-s20143752--388c33138185fb2eb5fdb00bf2155a9168e5a76501216887ea1ffa7ada06b776.tar.gz`, which is right. + +
+joey@wren:~>wget http://downloads.kitenet.net/git-annex/linux/current/git-annex-standalone-amd64.tar.gz
+--2013-08-29 14:25:00--  http://downloads.kitenet.net/git-annex/linux/current/git-annex-standalone-amd64.tar.gz
+Resolving downloads.kitenet.net (downloads.kitenet.net)... 2001:41c8:125:49::10, 80.68.85.49
+Connecting to downloads.kitenet.net (downloads.kitenet.net)|2001:41c8:125:49::10|:80... connected.
+HTTP request sent, awaiting response... 200 OK
+Length: 20143752 (19M) [application/x-gzip]
+Saving to: ‘git-annex-standalone-amd64.tar.gz’
+
+100%[======================================>] 20,143,752  48.9MB/s   in 0.4s   
+
+2013-08-29 14:25:01 (48.9 MB/s) - ‘git-annex-standalone-amd64.tar.gz’ saved [20143752/20143752]
+
+joey@wren:~>sha256sum git-annex-standalone-amd64.tar.gz 
+388c33138185fb2eb5fdb00bf2155a9168e5a76501216887ea1ffa7ada06b776  git-annex-standalone-amd64.tar.gz
+
+"""]] From 6cdac3a003b6850fd96a60d94320d084d8651096 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 29 Aug 2013 14:15:32 -0400 Subject: [PATCH 13/73] sync, assistant: Force push of the git-annex branch. Necessary to ensure it gets pushed to remotes after being rewritten by forget. See inline rationalles for why I think this is safe! --- Annex/TaggedPush.hs | 10 +++++----- Command/Sync.hs | 42 +++++++++++++++++++++++++++++------------- Git/Branch.hs | 4 ++++ debian/changelog | 10 ++++++++++ 4 files changed, 48 insertions(+), 18 deletions(-) diff --git a/Annex/TaggedPush.hs b/Annex/TaggedPush.hs index 2a5f823fd3..039dc0e173 100644 --- a/Annex/TaggedPush.hs +++ b/Annex/TaggedPush.hs @@ -13,6 +13,7 @@ import qualified Annex.Branch import qualified Git import qualified Git.Ref import qualified Git.Command +import qualified Git.Branch import Utility.Base64 {- Converts a git branch into a branch that is tagged with a UUID, typically @@ -49,12 +50,11 @@ fromTaggedBranch b = case split "/" $ show b of taggedPush :: UUID -> Maybe String -> Git.Ref -> Remote -> Git.Repo -> IO Bool taggedPush u info branch remote = Git.Command.runBool [ Param "push" - -- This is safe because we "own" the tagged branch we're pushing; - -- it has no other writers. Ensures it is pushed even if it has - -- been rewritten by a transition. - , Param "--force" , Param $ Remote.name remote - , Param $ refspec Annex.Branch.name + {- Using forcePush here is safe because we "own" the tagged branch + - we're pushing; it has no other writers. Ensures it is pushed + - even if it has been rewritten by a transition. -} + , Param $ Git.Branch.forcePush $ refspec Annex.Branch.name , Param $ refspec branch ] where diff --git a/Command/Sync.hs b/Command/Sync.hs index 551c2fa694..567e3146bb 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -167,29 +167,45 @@ pushRemote remote branch = go =<< needpush showOutput inRepo $ pushBranch remote branch -{- If the remote is a bare git repository, it's best to push the branch - - directly to it. On the other hand, if it's not bare, pushing to the - - checked out branch will fail, and this is why we use the syncBranch. +{- Pushes a regular branch like master to a remote. Also pushes the git-annex + - branch. + - + - If the remote is a bare git repository, it's best to push the regular + - branch directly to it, so that cloning/pulling will get it. + - On the other hand, if it's not bare, pushing to the checked out branch + - will fail, and this is why we push to its syncBranch. - - Git offers no way to tell if a remote is bare or not, so both methods - are tried. - - The direct push is likely to spew an ugly error message, so stderr is - - elided. Since progress is output to stderr too, the sync push is done - - first, and actually sends the data. Then the direct push is tried, - - with stderr discarded, to update the branch ref on the remote. + - elided. Since git progress display goes to stderr too, the sync push + - is done first, and actually sends the data. Then the direct push is + - tried, with stderr discarded, to update the branch ref on the remote. + - + - The sync push forces the update of the remote synced/git-annex branch. + - This is necessary if a transition has rewritten the git-annex branch. + - Normally any changes to the git-annex branch get pulled and merged before + - this push, so this forcing is unlikely to overwrite new data pushed + - in from another repository that is also syncing. + - + - But overwriting of data on synced/git-annex can happen, in a race. + - The only difference caused by using a forced push in that case is that + - the last repository to push wins the race, rather than the first to push. -} pushBranch :: Remote -> Git.Ref -> Git.Repo -> IO Bool -pushBranch remote branch g = tryIO directpush `after` syncpush +pushBranch remote branch g = tryIO (directpush g) `after` syncpush g where - syncpush = Git.Command.runBool (pushparams (refspec branch)) g - directpush = Git.Command.runQuiet (pushparams (show $ Git.Ref.base branch)) g - pushparams b = + syncpush = Git.Command.runBool $ pushparams + [ Git.Branch.forcePush $ refspec Annex.Branch.name + , refspec branch + ] + directpush = Git.Command.runQuiet $ pushparams + [show $ Git.Ref.base branch] + pushparams branches = [ Param "push" , Param $ Remote.name remote - , Param $ refspec Annex.Branch.name - , Param b - ] + ] ++ map Param branches refspec b = concat [ show $ Git.Ref.base b , ":" diff --git a/Git/Branch.hs b/Git/Branch.hs index d4a6840165..fed53d767e 100644 --- a/Git/Branch.hs +++ b/Git/Branch.hs @@ -101,3 +101,7 @@ commit message branch parentrefs repo = do return sha where ps = concatMap (\r -> ["-p", show r]) parentrefs + +{- A leading + makes git-push force pushing a branch. -} +forcePush :: String -> String +forcePush b = "+" ++ b diff --git a/debian/changelog b/debian/changelog index 68ba98b8bb..cb6fbee5a9 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,13 @@ +git-annex (4.20130828) UNRELEASED; urgency=low + + * forget: New command, causes git-annex branch history to be forgotten + in a way that will spread to other clones of the repository. + (As long as they're running this version or newer of git-annex.) + * sync, assistant: Force push of the git-annex branch. Necessary + to ensure it gets pushed to remotes after being rewritten by forget. + + -- Joey Hess Tue, 27 Aug 2013 11:03:00 -0400 + git-annex (4.20130827) unstable; urgency=low * Youtube support! (And 53 other video hosts). When quvi is installed, From 6147652cc6342f5d8d39cb3aba3a50d35d352ed0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 29 Aug 2013 16:41:59 -0400 Subject: [PATCH 14/73] wording --- Annex/Branch.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 5af6b6be97..13e1f11eb8 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -175,7 +175,7 @@ updateTo pairs = do - (and committed to the branch). - - Updates the branch if necessary, to ensure the most up-to-date available - - content is available. + - content is returned. - - Returns an empty string if the file doesn't exist yet. -} get :: FilePath -> Annex String From 62beaa1a86773ce5fa3f9bc60d447c129ecb15b5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 29 Aug 2013 18:51:22 -0400 Subject: [PATCH 15/73] refactor git-annex branch log filename code into central location Having one module that knows about all the filenames used on the branch allows working back from an arbitrary filename to enough information about it to implement dropping dead remotes and doing other log file compacting as part of a forget transition. --- Command/Log.hs | 4 +- Logs.hs | 110 +++++++++++++++++++++++++++++++++++++++ Logs/Group.hs | 5 +- Logs/Location.hs | 21 ++------ Logs/PreferredContent.hs | 5 +- Logs/Remote.hs | 5 +- Logs/Trust.hs | 5 +- Logs/UUID.hs | 5 +- Logs/Web.hs | 36 ++----------- Test.hs | 2 + Upgrade/V2.hs | 6 +-- Utility/Misc.hs | 6 +++ 12 files changed, 136 insertions(+), 74 deletions(-) create mode 100644 Logs.hs diff --git a/Command/Log.hs b/Command/Log.hs index 2d4819f7ff..f3a5becb8a 100644 --- a/Command/Log.hs +++ b/Command/Log.hs @@ -17,7 +17,7 @@ import Data.Char import Common.Annex import Command -import qualified Logs.Location +import Logs import qualified Logs.Presence import Annex.CatFile import qualified Annex.Branch @@ -135,7 +135,7 @@ getLog :: Key -> [CommandParam] -> Annex [String] getLog key os = do top <- fromRepo Git.repoPath p <- liftIO $ relPathCwdToFile top - let logfile = p Logs.Location.logFile key + let logfile = p locationLogFile key inRepo $ pipeNullSplitZombie $ [ Params "log -z --pretty=format:%ct --raw --abbrev=40" , Param "--remove-empty" diff --git a/Logs.hs b/Logs.hs new file mode 100644 index 0000000000..6339efa135 --- /dev/null +++ b/Logs.hs @@ -0,0 +1,110 @@ +{- git-annex log file names + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Logs where + +import Common.Annex +import Types.Key + +data LogVariety = UUIDBasedLog | PresenceLog Key + deriving (Show) + +{- Converts a path from the git-annex branch into one of the varieties + - of logs used by git-annex, if it's a known path. -} +getLogVariety :: FilePath -> Maybe LogVariety +getLogVariety f + | f `elem` uuidBasedLogs = Just UUIDBasedLog + | otherwise = PresenceLog <$> firstJust (presenceLogs f) + +{- All the uuid-based logs stored in the git-annex branch. -} +uuidBasedLogs :: [FilePath] +uuidBasedLogs = + [ uuidLog + , remoteLog + , trustLog + , groupLog + , preferredContentLog + ] + +{- All the ways to get a key from a presence log file -} +presenceLogs :: FilePath -> [Maybe Key] +presenceLogs f = + [ urlLogFileKey f + , locationLogFileKey f + ] + +uuidLog :: FilePath +uuidLog = "uuid.log" + +remoteLog :: FilePath +remoteLog = "remote.log" + +trustLog :: FilePath +trustLog = "trust.log" + +groupLog :: FilePath +groupLog = "group.log" + +preferredContentLog :: FilePath +preferredContentLog = "preferred-content.log" + +{- The pathname of the location log file for a given key. -} +locationLogFile :: Key -> String +locationLogFile key = hashDirLower key ++ keyFile key ++ ".log" + +{- Converts a pathname into a key if it's a location log. -} +locationLogFileKey :: FilePath -> Maybe Key +locationLogFileKey path + | ["remote", "web"] `isPrefixOf` splitDirectories dir = Nothing + | ext == ".log" = fileKey base + | otherwise = Nothing + where + (dir, file) = splitFileName path + (base, ext) = splitAt (length file - 4) file + +{- The filename of the url log for a given key. -} +urlLogFile :: Key -> FilePath +urlLogFile key = hashDirLower key keyFile key ++ urlLogExt + +{- Old versions stored the urls elsewhere. -} +oldurlLogs :: Key -> [FilePath] +oldurlLogs key = + [ "remote/web" hashDirLower key key2file key ++ ".log" + , "remote/web" hashDirLower key keyFile key ++ ".log" + ] + +urlLogExt :: String +urlLogExt = ".log.web" + +{- Converts a url log file into a key. + - (Does not work on oldurlLogs.) -} +urlLogFileKey :: FilePath -> Maybe Key +urlLogFileKey path + | ext == urlLogExt = fileKey base + | otherwise = Nothing + where + file = takeFileName path + (base, ext) = splitAt (length file - extlen) file + extlen = length urlLogExt + +{- Does not work on oldurllogs. -} +isUrlLog :: FilePath -> Bool +isUrlLog file = urlLogExt `isSuffixOf` file + +prop_logs_sane :: Key -> Bool +prop_logs_sane dummykey = all id + [ isNothing (getLogVariety "unknown") + , expect isUUIDBasedLog (getLogVariety uuidLog) + , expect isPresenceLog (getLogVariety $ locationLogFile dummykey) + , expect isPresenceLog (getLogVariety $ urlLogFile dummykey) + ] + where + expect = maybe False + isUUIDBasedLog UUIDBasedLog = True + isUUIDBasedLog _ = False + isPresenceLog (PresenceLog k) = k == dummykey + isPresenceLog _ = False diff --git a/Logs/Group.hs b/Logs/Group.hs index ee3b75b860..3f88b627d3 100644 --- a/Logs/Group.hs +++ b/Logs/Group.hs @@ -21,16 +21,13 @@ import qualified Data.Set as S import Data.Time.Clock.POSIX import Common.Annex +import Logs import qualified Annex.Branch import qualified Annex import Logs.UUIDBased import Types.Group import Types.StandardGroups -{- Filename of group.log. -} -groupLog :: FilePath -groupLog = "group.log" - {- Returns the groups of a given repo UUID. -} lookupGroups :: UUID -> Annex (S.Set Group) lookupGroups u = (fromMaybe S.empty . M.lookup u) . groupsByUUID <$> groupMap diff --git a/Logs/Location.hs b/Logs/Location.hs index 0f57b66634..1289af3216 100644 --- a/Logs/Location.hs +++ b/Logs/Location.hs @@ -20,12 +20,11 @@ module Logs.Location ( loggedLocations, loggedKeys, loggedKeysFor, - logFile, - logFileKey ) where import Common.Annex import qualified Annex.Branch +import Logs import Logs.Presence import Annex.UUID @@ -37,19 +36,19 @@ logStatus key status = do {- Log a change in the presence of a key's value in a repository. -} logChange :: Key -> UUID -> LogStatus -> Annex () -logChange key (UUID u) s = addLog (logFile key) =<< logNow s u +logChange key (UUID u) s = addLog (locationLogFile key) =<< logNow s u logChange _ NoUUID _ = noop {- Returns a list of repository UUIDs that, according to the log, have - the value of a key. -} loggedLocations :: Key -> Annex [UUID] -loggedLocations key = map toUUID <$> (currentLog . logFile) key +loggedLocations key = map toUUID <$> (currentLog . locationLogFile) key {- Finds all keys that have location log information. - (There may be duplicate keys in the list.) -} loggedKeys :: Annex [Key] -loggedKeys = mapMaybe (logFileKey . takeFileName) <$> Annex.Branch.files +loggedKeys = mapMaybe locationLogFileKey <$> Annex.Branch.files {- Finds all keys that have location log information indicating - they are present for the specified repository. -} @@ -62,15 +61,3 @@ loggedKeysFor u = filterM isthere =<< loggedKeys us <- loggedLocations k let !there = u `elem` us return there - -{- The filename of the log file for a given key. -} -logFile :: Key -> String -logFile key = hashDirLower key ++ keyFile key ++ ".log" - -{- Converts a log filename into a key. -} -logFileKey :: FilePath -> Maybe Key -logFileKey file - | ext == ".log" = fileKey base - | otherwise = Nothing - where - (base, ext) = splitAt (length file - 4) file diff --git a/Logs/PreferredContent.hs b/Logs/PreferredContent.hs index 8005fc0d30..947a31875f 100644 --- a/Logs/PreferredContent.hs +++ b/Logs/PreferredContent.hs @@ -24,6 +24,7 @@ import Data.Time.Clock.POSIX import Common.Annex import qualified Annex.Branch import qualified Annex +import Logs import Logs.UUIDBased import Limit import qualified Utility.Matcher @@ -35,10 +36,6 @@ import Logs.Group import Logs.Remote import Types.StandardGroups -{- Filename of preferred-content.log. -} -preferredContentLog :: FilePath -preferredContentLog = "preferred-content.log" - {- Changes the preferred content configuration of a remote. -} preferredContentSet :: UUID -> String -> Annex () preferredContentSet uuid@(UUID _) val = do diff --git a/Logs/Remote.hs b/Logs/Remote.hs index 89792b0545..48ee9eb60b 100644 --- a/Logs/Remote.hs +++ b/Logs/Remote.hs @@ -25,12 +25,9 @@ import Data.Char import Common.Annex import qualified Annex.Branch import Types.Remote +import Logs import Logs.UUIDBased -{- Filename of remote.log. -} -remoteLog :: FilePath -remoteLog = "remote.log" - {- Adds or updates a remote's config in the log. -} configSet :: UUID -> RemoteConfig -> Annex () configSet u c = do diff --git a/Logs/Trust.hs b/Logs/Trust.hs index eb6e42ad7e..6c6b33f70e 100644 --- a/Logs/Trust.hs +++ b/Logs/Trust.hs @@ -27,14 +27,11 @@ import Common.Annex import Types.TrustLevel import qualified Annex.Branch import qualified Annex +import Logs import Logs.UUIDBased import Remote.List import qualified Types.Remote -{- Filename of trust.log. -} -trustLog :: FilePath -trustLog = "trust.log" - {- Returns a list of UUIDs that the trustLog indicates have the - specified trust level. - Note that the list can be incomplete for SemiTrusted, since that's diff --git a/Logs/UUID.hs b/Logs/UUID.hs index 2f24a388e4..ef1074e78b 100644 --- a/Logs/UUID.hs +++ b/Logs/UUID.hs @@ -28,13 +28,10 @@ import Types.UUID import Common.Annex import qualified Annex import qualified Annex.Branch +import Logs import Logs.UUIDBased import qualified Annex.UUID -{- Filename of uuid.log. -} -uuidLog :: FilePath -uuidLog = "uuid.log" - {- Records a description for a uuid in the log. -} describeUUID :: UUID -> String -> Annex () describeUUID uuid desc = do diff --git a/Logs/Web.hs b/Logs/Web.hs index 47ab61943d..0239f23350 100644 --- a/Logs/Web.hs +++ b/Logs/Web.hs @@ -11,8 +11,6 @@ module Logs.Web ( getUrls, setUrlPresent, setUrlMissing, - urlLog, - urlLogKey, knownUrls, Downloader(..), getDownloader, @@ -22,9 +20,9 @@ module Logs.Web ( import qualified Data.ByteString.Lazy.Char8 as L import Common.Annex +import Logs import Logs.Presence import Logs.Location -import Types.Key import qualified Annex.Branch import Annex.CatFile import qualified Git @@ -36,35 +34,9 @@ type URLString = String webUUID :: UUID webUUID = UUID "00000000-0000-0000-0000-000000000001" -urlLogExt :: String -urlLogExt = ".log.web" - -urlLog :: Key -> FilePath -urlLog key = hashDirLower key keyFile key ++ urlLogExt - -{- Converts a url log file into a key. - - (Does not work on oldurlLogs.) -} -urlLogKey :: FilePath -> Maybe Key -urlLogKey file - | ext == urlLogExt = fileKey base - | otherwise = Nothing - where - (base, ext) = splitAt (length file - extlen) file - extlen = length urlLogExt - -isUrlLog :: FilePath -> Bool -isUrlLog file = urlLogExt `isSuffixOf` file - -{- Used to store the urls elsewhere. -} -oldurlLogs :: Key -> [FilePath] -oldurlLogs key = - [ "remote/web" hashDirLower key key2file key ++ ".log" - , "remote/web" hashDirLower key keyFile key ++ ".log" - ] - {- Gets all urls that a key might be available from. -} getUrls :: Key -> Annex [URLString] -getUrls key = go $ urlLog key : oldurlLogs key +getUrls key = go $ urlLogFile key : oldurlLogs key where go [] = return [] go (l:ls) = do @@ -77,13 +49,13 @@ setUrlPresent :: Key -> URLString -> Annex () setUrlPresent key url = do us <- getUrls key unless (url `elem` us) $ do - addLog (urlLog key) =<< logNow InfoPresent url + addLog (urlLogFile key) =<< logNow InfoPresent url -- update location log to indicate that the web has the key logChange key webUUID InfoPresent setUrlMissing :: Key -> URLString -> Annex () setUrlMissing key url = do - addLog (urlLog key) =<< logNow InfoMissing url + addLog (urlLogFile key) =<< logNow InfoMissing url whenM (null <$> getUrls key) $ logChange key webUUID InfoMissing diff --git a/Test.hs b/Test.hs index 3eb330c226..ec70c4ecbd 100644 --- a/Test.hs +++ b/Test.hs @@ -33,6 +33,7 @@ import qualified Types.KeySource import qualified Types.Backend import qualified Types.TrustLevel import qualified Types +import qualified Logs import qualified Logs.UUIDBased import qualified Logs.Trust import qualified Logs.Remote @@ -115,6 +116,7 @@ quickcheck = , check "prop_idempotent_key_encode" Types.Key.prop_idempotent_key_encode , check "prop_idempotent_shellEscape" Utility.SafeCommand.prop_idempotent_shellEscape , check "prop_idempotent_shellEscape_multiword" Utility.SafeCommand.prop_idempotent_shellEscape_multiword + , check "prop_logs_sane" Logs.prop_logs_sane , check "prop_idempotent_configEscape" Logs.Remote.prop_idempotent_configEscape , check "prop_parse_show_Config" Logs.Remote.prop_parse_show_Config , check "prop_parentDir_basics" Utility.Path.prop_parentDir_basics diff --git a/Upgrade/V2.hs b/Upgrade/V2.hs index b5de6c8c04..42419b8abd 100644 --- a/Upgrade/V2.hs +++ b/Upgrade/V2.hs @@ -12,9 +12,9 @@ import qualified Git import qualified Git.Command import qualified Git.Ref import qualified Annex.Branch -import Logs.Location import Annex.Content import Utility.Tmp +import Logs olddir :: Git.Repo -> FilePath olddir g @@ -47,7 +47,7 @@ upgrade = do e <- liftIO $ doesDirectoryExist old when e $ do - mapM_ (\(k, f) -> inject f $ logFile k) =<< locationLogs + mapM_ (\(k, f) -> inject f $ locationLogFile k) =<< locationLogs mapM_ (\f -> inject f f) =<< logFiles old saveState False @@ -73,7 +73,7 @@ locationLogs = do where tryDirContents d = catchDefaultIO [] $ dirContents d islogfile f = maybe Nothing (\k -> Just (k, f)) $ - logFileKey $ takeFileName f + locationLogFileKey f inject :: FilePath -> FilePath -> Annex () inject source dest = do diff --git a/Utility/Misc.hs b/Utility/Misc.hs index 804a9e4872..48ce4c9294 100644 --- a/Utility/Misc.hs +++ b/Utility/Misc.hs @@ -91,6 +91,12 @@ massReplace vs = go [] vs go (replacement:acc) vs (drop (length val) s) | otherwise = go acc rest s +{- First item in the list that is not Nothing. -} +firstJust :: Eq a => [Maybe a] -> Maybe a +firstJust ms = case dropWhile (== Nothing) ms of + [] -> Nothing + (md:_) -> md + {- Given two orderings, returns the second if the first is EQ and returns - the first otherwise. - From 323c9f68cab07301555a1029565fe859af5582aa Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 29 Aug 2013 19:21:44 -0400 Subject: [PATCH 16/73] blog for the day --- doc/devblog/day_-3__.mdwn | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) create mode 100644 doc/devblog/day_-3__.mdwn diff --git a/doc/devblog/day_-3__.mdwn b/doc/devblog/day_-3__.mdwn new file mode 100644 index 0000000000..fa1473e06e --- /dev/null +++ b/doc/devblog/day_-3__.mdwn @@ -0,0 +1,29 @@ +John Millikin came through and fixed that haskell-gnutls segfault +on OSX that I developed a reproducible test case for the other day. +It's a bit hard to test, since the bug doesn't always happen, but the +fix is already deployed for Mountain Lion autobuilder. + +However, I then found another way to make haskell-gnutls segfault, more +reliably on OSX, and even sometimes on Linux. Just entering the wrong XMPP +password in the assistant can trigger this crash. Hopefully John will work +his magic again. + +--- + +Meanwhile, I fixed the sync-after-forget problem. Now sync always forces +its push of the git-annex branch (as does the assistant). I considered but +rejected having sync do the kind of uuid-tagged branch push that the +assistant sometimes falls back to if it's failing to do a normal sync. It's +ugly, but worse, it wouldn't work in the workflow where multiple clients +are syncing to a central bare repository, because they'd not pull down the +hidden uuid-tagged branches, and without the assistant running on the +repository, nothing would ever merge their data into the git-annex branch. +Forcing the push of synced/git-annex was easy, once I satisfied myself +that it was always ok to do so. + +Also factored out a module that knows about all the different log files +stored on the git-annex branch, which is all the support infrastructure +that will be needed to make `git annex forget --drop-dead` work. Since this +is basically a routing module, perhaps I'll get around to making it use +a nice bidirectional routing library like +[Zwaluw](http://hackage.haskell.org/package/Zwaluw) one day. From 2f57d74534333d9fc51126499a0f31b1248d1deb Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 29 Aug 2013 20:28:45 -0400 Subject: [PATCH 17/73] remove print --- Annex/Branch.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 13e1f11eb8..334b60634f 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -402,7 +402,6 @@ handleTransitions :: Transitions -> [Git.Ref] -> Annex (Maybe (Git.Branch, [Git. handleTransitions localts refs = do m <- M.fromList <$> mapM getreftransition refs let remotets = M.elems m - liftIO $ print ("transitions", localts, remotets) if all (localts ==) remotets then return Nothing else do From e555dc7833103c03042e24fac2957e721acb5634 Mon Sep 17 00:00:00 2001 From: "https://me.yahoo.com/a/2grhJvAC049fJnvALDXek.6MRZMTlg--#eec89" Date: Fri, 30 Aug 2013 04:19:59 +0000 Subject: [PATCH 18/73] Added a comment --- .../comment_6_b509006e1590480a104627369bc910f2._comment | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 doc/bugs/Problem_when_dropping_unused_files/comment_6_b509006e1590480a104627369bc910f2._comment diff --git a/doc/bugs/Problem_when_dropping_unused_files/comment_6_b509006e1590480a104627369bc910f2._comment b/doc/bugs/Problem_when_dropping_unused_files/comment_6_b509006e1590480a104627369bc910f2._comment new file mode 100644 index 0000000000..60f2165e29 --- /dev/null +++ b/doc/bugs/Problem_when_dropping_unused_files/comment_6_b509006e1590480a104627369bc910f2._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://me.yahoo.com/a/2grhJvAC049fJnvALDXek.6MRZMTlg--#eec89" + nickname="John" + subject="comment 6" + date="2013-08-30T04:19:57Z" + content=""" +Just saw it happen again today, in a repository that passed \"fsck -A\" multiple times just yesterday. What is going on? +"""]] From f1756cd073066700c96965e3b9de54f83b6baaab Mon Sep 17 00:00:00 2001 From: "https://me.yahoo.com/a/2grhJvAC049fJnvALDXek.6MRZMTlg--#eec89" Date: Fri, 30 Aug 2013 04:20:28 +0000 Subject: [PATCH 19/73] Added a comment --- .../comment_7_a8a19650916aff09da206342a5041baf._comment | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 doc/bugs/Problem_when_dropping_unused_files/comment_7_a8a19650916aff09da206342a5041baf._comment diff --git a/doc/bugs/Problem_when_dropping_unused_files/comment_7_a8a19650916aff09da206342a5041baf._comment b/doc/bugs/Problem_when_dropping_unused_files/comment_7_a8a19650916aff09da206342a5041baf._comment new file mode 100644 index 0000000000..a0adf2b651 --- /dev/null +++ b/doc/bugs/Problem_when_dropping_unused_files/comment_7_a8a19650916aff09da206342a5041baf._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://me.yahoo.com/a/2grhJvAC049fJnvALDXek.6MRZMTlg--#eec89" + nickname="John" + subject="comment 7" + date="2013-08-30T04:20:28Z" + content=""" +Just saw it happen again today, in a repository that passed \"fsck -A\" multiple times just yesterday. What is going on? +"""]] From 31f5c94bb610cd34f707b10d5514f76f0cd838f4 Mon Sep 17 00:00:00 2001 From: "https://me.yahoo.com/a/2grhJvAC049fJnvALDXek.6MRZMTlg--#eec89" Date: Fri, 30 Aug 2013 04:21:43 +0000 Subject: [PATCH 20/73] removed --- .../comment_7_a8a19650916aff09da206342a5041baf._comment | 8 -------- 1 file changed, 8 deletions(-) delete mode 100644 doc/bugs/Problem_when_dropping_unused_files/comment_7_a8a19650916aff09da206342a5041baf._comment diff --git a/doc/bugs/Problem_when_dropping_unused_files/comment_7_a8a19650916aff09da206342a5041baf._comment b/doc/bugs/Problem_when_dropping_unused_files/comment_7_a8a19650916aff09da206342a5041baf._comment deleted file mode 100644 index a0adf2b651..0000000000 --- a/doc/bugs/Problem_when_dropping_unused_files/comment_7_a8a19650916aff09da206342a5041baf._comment +++ /dev/null @@ -1,8 +0,0 @@ -[[!comment format=mdwn - username="https://me.yahoo.com/a/2grhJvAC049fJnvALDXek.6MRZMTlg--#eec89" - nickname="John" - subject="comment 7" - date="2013-08-30T04:20:28Z" - content=""" -Just saw it happen again today, in a repository that passed \"fsck -A\" multiple times just yesterday. What is going on? -"""]] From 9e4aa30f6f59a7d932dce089020188c0525b800f Mon Sep 17 00:00:00 2001 From: "https://me.yahoo.com/a/2grhJvAC049fJnvALDXek.6MRZMTlg--#eec89" Date: Fri, 30 Aug 2013 04:25:48 +0000 Subject: [PATCH 21/73] Added a comment --- ...ent_7_fe261c074211ccb94bbcb32cfd8ee654._comment | 14 ++++++++++++++ 1 file changed, 14 insertions(+) create mode 100644 doc/bugs/Problem_when_dropping_unused_files/comment_7_fe261c074211ccb94bbcb32cfd8ee654._comment diff --git a/doc/bugs/Problem_when_dropping_unused_files/comment_7_fe261c074211ccb94bbcb32cfd8ee654._comment b/doc/bugs/Problem_when_dropping_unused_files/comment_7_fe261c074211ccb94bbcb32cfd8ee654._comment new file mode 100644 index 0000000000..6f3e42f5c5 --- /dev/null +++ b/doc/bugs/Problem_when_dropping_unused_files/comment_7_fe261c074211ccb94bbcb32cfd8ee654._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="https://me.yahoo.com/a/2grhJvAC049fJnvALDXek.6MRZMTlg--#eec89" + nickname="John" + subject="comment 7" + date="2013-08-30T04:25:45Z" + content=""" +I tried your suggestion of cloning the repository and moving `.git/config` and `.git/annex`, and got this: + + fsck Astronomy/12_ATM_2.jpg error: invalid object 100644 06f8fe222f052100101e5c2e77640f2ec3efff98 for '002/0a6/SHA256E-s427690--03aeabcde841b66168b72de80098d74e047f3ffc832d4bbefa1f2f70ee6c92f8.jpg.log' + fatal: git-write-tree: error building trees + git-annex: failed to read sha from git write-tree + +What else can I try? Note that I can't even find this `.log` anywhere under my `.git` directory for this repository. +"""]] From c4581ef2b0472e8ec1a7ef6d5aa5aa5fc861c8c5 Mon Sep 17 00:00:00 2001 From: "https://me.yahoo.com/a/2grhJvAC049fJnvALDXek.6MRZMTlg--#eec89" Date: Fri, 30 Aug 2013 04:30:15 +0000 Subject: [PATCH 22/73] Added a comment --- .../comment_8_bc8e4dc7e0d6577ba5fcc98f56627b1f._comment | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 doc/bugs/Problem_when_dropping_unused_files/comment_8_bc8e4dc7e0d6577ba5fcc98f56627b1f._comment diff --git a/doc/bugs/Problem_when_dropping_unused_files/comment_8_bc8e4dc7e0d6577ba5fcc98f56627b1f._comment b/doc/bugs/Problem_when_dropping_unused_files/comment_8_bc8e4dc7e0d6577ba5fcc98f56627b1f._comment new file mode 100644 index 0000000000..0b82af2f1d --- /dev/null +++ b/doc/bugs/Problem_when_dropping_unused_files/comment_8_bc8e4dc7e0d6577ba5fcc98f56627b1f._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://me.yahoo.com/a/2grhJvAC049fJnvALDXek.6MRZMTlg--#eec89" + nickname="John" + subject="comment 8" + date="2013-08-30T04:30:14Z" + content=""" +The only thing that worked was nuking `.git/annex/index` and letting `git-annex sync` rebuild it. +"""]] From 8cdee9a040a31ccceb0e3e9c90d8fbdb568dba86 Mon Sep 17 00:00:00 2001 From: "https://me.yahoo.com/a/2grhJvAC049fJnvALDXek.6MRZMTlg--#eec89" Date: Fri, 30 Aug 2013 05:59:28 +0000 Subject: [PATCH 23/73] Added a comment --- ...comment_9_e53148a9efa061a825f668a9492182f7._comment | 10 ++++++++++ 1 file changed, 10 insertions(+) create mode 100644 doc/bugs/Large_unannex_operations_result_in_stale_symlinks_and_data_loss/comment_9_e53148a9efa061a825f668a9492182f7._comment diff --git a/doc/bugs/Large_unannex_operations_result_in_stale_symlinks_and_data_loss/comment_9_e53148a9efa061a825f668a9492182f7._comment b/doc/bugs/Large_unannex_operations_result_in_stale_symlinks_and_data_loss/comment_9_e53148a9efa061a825f668a9492182f7._comment new file mode 100644 index 0000000000..74aaa1e56b --- /dev/null +++ b/doc/bugs/Large_unannex_operations_result_in_stale_symlinks_and_data_loss/comment_9_e53148a9efa061a825f668a9492182f7._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="https://me.yahoo.com/a/2grhJvAC049fJnvALDXek.6MRZMTlg--#eec89" + nickname="John" + subject="comment 9" + date="2013-08-30T05:59:28Z" + content=""" +I'll chime in and say that the non-fast behavior being the default seems wrong, and making hard-link invisibly seems wrong. What Joey proposed -- copying a file if there are multiple hard-links -- seems like the right solution. + +Just recently I tried to unannex a large repository and was bitten by now-dangling symlinks to files that I couldn't locate anymore. The fact is that the current unannex operation is too dangerous to be useful. +"""]] From 9564895f0de1750035c7ae32e7ec8604ab6bb430 Mon Sep 17 00:00:00 2001 From: "https://me.yahoo.com/a/2grhJvAC049fJnvALDXek.6MRZMTlg--#eec89" Date: Fri, 30 Aug 2013 05:59:40 +0000 Subject: [PATCH 24/73] Added a comment --- ...omment_10_20429a1a7be9a6b0b22c02081586adbc._comment | 10 ++++++++++ 1 file changed, 10 insertions(+) create mode 100644 doc/bugs/Large_unannex_operations_result_in_stale_symlinks_and_data_loss/comment_10_20429a1a7be9a6b0b22c02081586adbc._comment diff --git a/doc/bugs/Large_unannex_operations_result_in_stale_symlinks_and_data_loss/comment_10_20429a1a7be9a6b0b22c02081586adbc._comment b/doc/bugs/Large_unannex_operations_result_in_stale_symlinks_and_data_loss/comment_10_20429a1a7be9a6b0b22c02081586adbc._comment new file mode 100644 index 0000000000..1b89002091 --- /dev/null +++ b/doc/bugs/Large_unannex_operations_result_in_stale_symlinks_and_data_loss/comment_10_20429a1a7be9a6b0b22c02081586adbc._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="https://me.yahoo.com/a/2grhJvAC049fJnvALDXek.6MRZMTlg--#eec89" + nickname="John" + subject="comment 10" + date="2013-08-30T05:59:39Z" + content=""" +I'll chime in and say that the non-fast behavior being the default seems wrong, and making hard-link invisibly seems wrong. What Joey proposed -- copying a file if there are multiple hard-links -- seems like the right solution. + +Just recently I tried to unannex a large repository and was bitten by now-dangling symlinks to files that I couldn't locate anymore. The fact is that the current unannex operation is too dangerous to be useful. +"""]] From 5a890bf57d0f5448d8a7df41d46f40debeab8daa Mon Sep 17 00:00:00 2001 From: "https://me.yahoo.com/a/2grhJvAC049fJnvALDXek.6MRZMTlg--#eec89" Date: Fri, 30 Aug 2013 05:59:57 +0000 Subject: [PATCH 25/73] removed --- ...omment_10_20429a1a7be9a6b0b22c02081586adbc._comment | 10 ---------- 1 file changed, 10 deletions(-) delete mode 100644 doc/bugs/Large_unannex_operations_result_in_stale_symlinks_and_data_loss/comment_10_20429a1a7be9a6b0b22c02081586adbc._comment diff --git a/doc/bugs/Large_unannex_operations_result_in_stale_symlinks_and_data_loss/comment_10_20429a1a7be9a6b0b22c02081586adbc._comment b/doc/bugs/Large_unannex_operations_result_in_stale_symlinks_and_data_loss/comment_10_20429a1a7be9a6b0b22c02081586adbc._comment deleted file mode 100644 index 1b89002091..0000000000 --- a/doc/bugs/Large_unannex_operations_result_in_stale_symlinks_and_data_loss/comment_10_20429a1a7be9a6b0b22c02081586adbc._comment +++ /dev/null @@ -1,10 +0,0 @@ -[[!comment format=mdwn - username="https://me.yahoo.com/a/2grhJvAC049fJnvALDXek.6MRZMTlg--#eec89" - nickname="John" - subject="comment 10" - date="2013-08-30T05:59:39Z" - content=""" -I'll chime in and say that the non-fast behavior being the default seems wrong, and making hard-link invisibly seems wrong. What Joey proposed -- copying a file if there are multiple hard-links -- seems like the right solution. - -Just recently I tried to unannex a large repository and was bitten by now-dangling symlinks to files that I couldn't locate anymore. The fact is that the current unannex operation is too dangerous to be useful. -"""]] From 9a550733d2e2add4bee240449fd69fa992fb588d Mon Sep 17 00:00:00 2001 From: "https://me.yahoo.com/a/2grhJvAC049fJnvALDXek.6MRZMTlg--#eec89" Date: Fri, 30 Aug 2013 06:06:16 +0000 Subject: [PATCH 26/73] Added a comment --- ...comment_4_c3625409652bff5f2165260803269a8a._comment | 10 ++++++++++ 1 file changed, 10 insertions(+) create mode 100644 doc/forum/Annex_contents_just_disappeared__63__/comment_4_c3625409652bff5f2165260803269a8a._comment diff --git a/doc/forum/Annex_contents_just_disappeared__63__/comment_4_c3625409652bff5f2165260803269a8a._comment b/doc/forum/Annex_contents_just_disappeared__63__/comment_4_c3625409652bff5f2165260803269a8a._comment new file mode 100644 index 0000000000..236f8cfdef --- /dev/null +++ b/doc/forum/Annex_contents_just_disappeared__63__/comment_4_c3625409652bff5f2165260803269a8a._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="https://me.yahoo.com/a/2grhJvAC049fJnvALDXek.6MRZMTlg--#eec89" + nickname="John" + subject="comment 4" + date="2013-08-30T06:06:16Z" + content=""" +Just to confirm, this wasn't a git-annex problem at all, but just a misstep during migration as you suggested. + +I think what I'm going to do now is to just wipe the slate clean and start over again, by using `unannex -fast` on all the files, wiping `.git`, and then adding everything back in using my new default backend of SHA512E. The bigger pain is doing the same thing on all the servers where I have this data (to avoid having to upload it again), but in such a way that I'm not replicating file history. I think I should be able to just clone, `mv $OLDREPO/.git/annex/objects objects`, `git annex add objects`, `git rm -r --cached objects`, and then everything should be good without even needing a new commit on the remote machine, just a git-annex sync. +"""]] From 9a0f79cc5166adfcba090077519ae6e4005153d5 Mon Sep 17 00:00:00 2001 From: "https://me.yahoo.com/a/2grhJvAC049fJnvALDXek.6MRZMTlg--#eec89" Date: Fri, 30 Aug 2013 06:09:29 +0000 Subject: [PATCH 27/73] Added a comment --- .../comment_2_73698913837bfd5a58cf15721211e43e._comment | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 doc/tips/yet_another_simple_disk_usage_like_utility/comment_2_73698913837bfd5a58cf15721211e43e._comment diff --git a/doc/tips/yet_another_simple_disk_usage_like_utility/comment_2_73698913837bfd5a58cf15721211e43e._comment b/doc/tips/yet_another_simple_disk_usage_like_utility/comment_2_73698913837bfd5a58cf15721211e43e._comment new file mode 100644 index 0000000000..fe4b3d0d21 --- /dev/null +++ b/doc/tips/yet_another_simple_disk_usage_like_utility/comment_2_73698913837bfd5a58cf15721211e43e._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://me.yahoo.com/a/2grhJvAC049fJnvALDXek.6MRZMTlg--#eec89" + nickname="John" + subject="comment 2" + date="2013-08-30T06:09:29Z" + content=""" +You may want to try my `sizes` tool on Hackage. Just pass `-A` and it will be aware of the annex and report sizes as if no files were annexed. The only downside is that it reports file usage for replicated content multiple times, as if you'd copied the data out of the annex rather than hardlinked all duplicate copies (although, this may be exactly the behavior some people want). +"""]] From db9a7f0384616a4e091e117b7cbb42007284c689 Mon Sep 17 00:00:00 2001 From: "https://me.yahoo.com/a/2grhJvAC049fJnvALDXek.6MRZMTlg--#eec89" Date: Fri, 30 Aug 2013 06:18:42 +0000 Subject: [PATCH 28/73] Added a comment --- .../comment_2_7472943c02cfe2808b0d566e06caa1a5._comment | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 doc/forum/Pruning_out_unwanted_Git_objects/comment_2_7472943c02cfe2808b0d566e06caa1a5._comment diff --git a/doc/forum/Pruning_out_unwanted_Git_objects/comment_2_7472943c02cfe2808b0d566e06caa1a5._comment b/doc/forum/Pruning_out_unwanted_Git_objects/comment_2_7472943c02cfe2808b0d566e06caa1a5._comment new file mode 100644 index 0000000000..0c26463514 --- /dev/null +++ b/doc/forum/Pruning_out_unwanted_Git_objects/comment_2_7472943c02cfe2808b0d566e06caa1a5._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://me.yahoo.com/a/2grhJvAC049fJnvALDXek.6MRZMTlg--#eec89" + nickname="John" + subject="comment 2" + date="2013-08-30T06:18:42Z" + content=""" +This was answered quite thoroughly in:http://git-annex.branchable.com/forum/safely_dropping_git-annex_history/ +"""]] From 32ff7e2313d63b820d89fd3f2d00779638d8bf6a Mon Sep 17 00:00:00 2001 From: "https://me.yahoo.com/a/2grhJvAC049fJnvALDXek.6MRZMTlg--#eec89" Date: Fri, 30 Aug 2013 06:20:58 +0000 Subject: [PATCH 29/73] Added a comment --- ...ent_9_e9a22aa2ebcde5f6595b49dba9375761._comment | 14 ++++++++++++++ 1 file changed, 14 insertions(+) create mode 100644 doc/bugs/Problem_when_dropping_unused_files/comment_9_e9a22aa2ebcde5f6595b49dba9375761._comment diff --git a/doc/bugs/Problem_when_dropping_unused_files/comment_9_e9a22aa2ebcde5f6595b49dba9375761._comment b/doc/bugs/Problem_when_dropping_unused_files/comment_9_e9a22aa2ebcde5f6595b49dba9375761._comment new file mode 100644 index 0000000000..b75b3f61bb --- /dev/null +++ b/doc/bugs/Problem_when_dropping_unused_files/comment_9_e9a22aa2ebcde5f6595b49dba9375761._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="https://me.yahoo.com/a/2grhJvAC049fJnvALDXek.6MRZMTlg--#eec89" + nickname="John" + subject="comment 9" + date="2013-08-30T06:20:58Z" + content=""" +And yet again it happens: + + error: invalid object 100644 3edb1d4a44ffba1ea1491693ae7d9faa82aad717 for '000/4ce/SHA256E-s175006724--a0edc4f880223028b3fa3a27b142c8e027ddf66db973b8272ca845a4a9e01d3e.mp4.log' fatal: git-write-tree: error building trees + +This was in a repository that was working perfectly well until I tried to `git-annex get`. The weird thing is that I don't even have any `SHA256E` files anymore. + +I think that after my recent migration, none of my repositories can be trusted. This is just happening too often (more than 10 times in the last week, across many repositories on many machines). I will just rebuild them all. But I do wish git-annex was more resilient about this. +"""]] From 7dc58d423a800dbc0439f0cd1019a3af75c25474 Mon Sep 17 00:00:00 2001 From: "https://www.google.com/accounts/o8/id?id=AItOawkgH7oNEqNbh3g-N1-UHXuqleXaRYDgj1U" Date: Fri, 30 Aug 2013 06:33:39 +0000 Subject: [PATCH 30/73] --- ...ry:___34__internal_server_error__34__.mdwn | 22 +++++++++++++++++++ 1 file changed, 22 insertions(+) create mode 100644 doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__.mdwn diff --git a/doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__.mdwn b/doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__.mdwn new file mode 100644 index 0000000000..251c6aa08b --- /dev/null +++ b/doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__.mdwn @@ -0,0 +1,22 @@ +### Please describe the problem. +When I try to add a box.com cloud repository with the encryption option selected, I get an error that says "internal server error". + +### What steps will reproduce the problem? +Anytime I try to set up a cloud repository with box.com (and presumably others, since this seems to be a problem with gpg (see log)) that is encrypted, I get this error. + + +### What version of git-annex are you using? On what operating system? +The operating system is Mac OS X 10.8.4, and the version of git-annex is 4.20130801-gc88bbc4. + + +### Please provide any additional information below. + +[[!format sh """ +# If you can, paste a complete transcript of the problem occurring here. +# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log + +(encryption setup) gpg: /Users/adamliter/.gnupg/gpg.conf:233: invalid auto-key-locate list +30/Aug/2013:02:27:11 -0400 [Error#yesod-core] user error (gpg ["--quiet","--trust-model","always","--gen-random","--armor","1","512"] exited 2) @(yesod-core-1.1.8.3:Yesod.Internal.Core ./Yesod/Internal/Core.hs:550:5) + +# End of transcript or log. +"""]] From 03d3a299bcfcc1967e2de00959dfac9df7cea200 Mon Sep 17 00:00:00 2001 From: "https://www.google.com/accounts/o8/id?id=AItOawnWvnTWY6LrcPB4BzYEBn5mRTpNhg5EtEg" Date: Fri, 30 Aug 2013 10:55:39 +0000 Subject: [PATCH 31/73] --- ...nc__47__ssh_backend_to_other_backend__63__.mdwn | 14 ++++++++++++++ 1 file changed, 14 insertions(+) create mode 100644 doc/forum/How_to_copy__47__duplicate_all_data_from_rsync__47__ssh_backend_to_other_backend__63__.mdwn diff --git a/doc/forum/How_to_copy__47__duplicate_all_data_from_rsync__47__ssh_backend_to_other_backend__63__.mdwn b/doc/forum/How_to_copy__47__duplicate_all_data_from_rsync__47__ssh_backend_to_other_backend__63__.mdwn new file mode 100644 index 0000000000..b660cb6a06 --- /dev/null +++ b/doc/forum/How_to_copy__47__duplicate_all_data_from_rsync__47__ssh_backend_to_other_backend__63__.mdwn @@ -0,0 +1,14 @@ +Hello, + +I want to be safe and have two copies of my files on two different backend. Currently I only have a SSH backend, that stores all my data. I have full(root) access to that machine/backend. On my laptop I have only a few bytes of data, because all is moved/copied to that SSH backend. Now, I want to duplicate the data on the SSH backend to a Google Drive account (or any other). How could I do that (without downloading all data from the SSH backend)??? Encryption is not a must. + +I looked into the annex/objects folder on the SSH backend, but there are 3 char length directories compared to what I see on a test Google Drive backend, where only 2 char length directory names are. +Example SSH backend: +[git-annex root]/annex/objects/c10/90a/SHA256E-s445227--14c3f85d6dd3464f116f6a5bbd411012781d36794549d136b18d1914c4158820.jpg/SHA256E-s445227--14c3f85d6dd3464f116f6a5bbd411012781d36794549d136b18d1914c4158820.jpg +Example Google Drive: +[Google Drive root]/annex/W7/xQ/SHA256E-s913904--29f9800b0dd34d4200c4e9ee152b79c3556a9a473848720be7cf83d20eff65a4.JPG + +Is there a way to convert these directory names and do a simpe copy??? + +Thank you, +Bence From e4ea1c5e8f0cfe835ca11cd5253750e66cd181e0 Mon Sep 17 00:00:00 2001 From: guilhem Date: Fri, 30 Aug 2013 11:39:52 +0000 Subject: [PATCH 32/73] Added a comment --- ...comment_1_9be1b577fa4d5fe9754845073fdf5d32._comment | 10 ++++++++++ 1 file changed, 10 insertions(+) create mode 100644 doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__/comment_1_9be1b577fa4d5fe9754845073fdf5d32._comment diff --git a/doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__/comment_1_9be1b577fa4d5fe9754845073fdf5d32._comment b/doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__/comment_1_9be1b577fa4d5fe9754845073fdf5d32._comment new file mode 100644 index 0000000000..ec0234c2d1 --- /dev/null +++ b/doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__/comment_1_9be1b577fa4d5fe9754845073fdf5d32._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="guilhem" + ip="129.16.20.209" + subject="comment 1" + date="2013-08-30T11:39:51Z" + content=""" +gpg complains about an invalid parameter for the `auto-key-locate` option, which is not passed by git-annex but found in your gpg.conf. + +What is on line 233 of `/Users/adamliter/.gnupg/gpg.conf`? +"""]] From ee5c377507bf55140200f44f3781e23bd2b55052 Mon Sep 17 00:00:00 2001 From: "http://sunny256.sunbase.org/" Date: Fri, 30 Aug 2013 11:43:44 +0000 Subject: [PATCH 33/73] Added a comment --- ..._ad156d6199b525884114ff823d265bf7._comment | 39 +++++++++++++++++++ 1 file changed, 39 insertions(+) create mode 100644 doc/news/version_4.20130827/comment_3_ad156d6199b525884114ff823d265bf7._comment diff --git a/doc/news/version_4.20130827/comment_3_ad156d6199b525884114ff823d265bf7._comment b/doc/news/version_4.20130827/comment_3_ad156d6199b525884114ff823d265bf7._comment new file mode 100644 index 0000000000..538395f90c --- /dev/null +++ b/doc/news/version_4.20130827/comment_3_ad156d6199b525884114ff823d265bf7._comment @@ -0,0 +1,39 @@ +[[!comment format=mdwn + username="http://sunny256.sunbase.org/" + nickname="sunny256" + subject="comment 3" + date="2013-08-30T11:43:44Z" + content=""" +Hm, commit 82de1ed1a3 doesn't exist here after git-annex sync. This is the output from another computer, running Linux Mint 15: + + $ ga sync + commit + ok + pull linode + ok + pull kitenet + WARNING: gnome-keyring:: couldn't connect to: /run/user/sunny/keyring-WSsS6N/pkcs11: No such file or directory + ok + push linode + Everything up-to-date + ok + push kitenet + WARNING: gnome-keyring:: couldn't connect to: /run/user/sunny/keyring-WSsS6N/pkcs11: No such file or directory + WARNING: gnome-keyring:: couldn't connect to: /run/user/sunny/keyring-WSsS6N/pkcs11: No such file or directory + error: Cannot access URL http://downloads.kitenet.net/.git/, return code 22 + fatal: git-http-push failed + failed + git-annex: sync: 1 failed + $ git log -1 + commit e4d2f03d9b37b2fac9508bf755ff7619bf46590c (HEAD, linode/synced/master, linode/master, linode/HEAD, kitenet/synced/master, kitenet/master, synced/master, master) + Author: Joey Hess + Date: 3 weeks ago + + update + 2013-08-30 13:36:37 sunny@passp:~/src/other/annex/downloads.kitenet.net/git-annex (master u=) + $ git log 82de1ed1a354e389bc71a15af1a3e67b5bd56f23 + fatal: bad object 82de1ed1a354e389bc71a15af1a3e67b5bd56f23 + +There's some warnings from gnome-keyring and a failed push (sorry about that, happens automatically), but the fetch from kitenet seems to succeed. + +"""]] From a5b87259ba45af07293908b34a3a6317e5f80725 Mon Sep 17 00:00:00 2001 From: "http://sunny256.sunbase.org/" Date: Fri, 30 Aug 2013 11:49:20 +0000 Subject: [PATCH 34/73] Added a comment --- .../comment_4_877061eb24d9d9543cc9cd229906bd64._comment | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 doc/news/version_4.20130827/comment_4_877061eb24d9d9543cc9cd229906bd64._comment diff --git a/doc/news/version_4.20130827/comment_4_877061eb24d9d9543cc9cd229906bd64._comment b/doc/news/version_4.20130827/comment_4_877061eb24d9d9543cc9cd229906bd64._comment new file mode 100644 index 0000000000..5828a36c71 --- /dev/null +++ b/doc/news/version_4.20130827/comment_4_877061eb24d9d9543cc9cd229906bd64._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://sunny256.sunbase.org/" + nickname="sunny256" + subject="comment 4" + date="2013-08-30T11:49:20Z" + content=""" +And some additional info, I'm using `http://downloads.kitenet.net/.git/` as the address to your annex. Maybe this repo is missing a `git update-server-info` in the `post-update` hook or something. +"""]] From a869432f5bf3ccc0925f66af83bca60848c83d3f Mon Sep 17 00:00:00 2001 From: "https://www.google.com/accounts/o8/id?id=AItOawnWvnTWY6LrcPB4BzYEBn5mRTpNhg5EtEg" Date: Fri, 30 Aug 2013 15:31:27 +0000 Subject: [PATCH 35/73] --- ...rom_rsync__47__ssh_backend_to_other_backend__63__.mdwn | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/doc/forum/How_to_copy__47__duplicate_all_data_from_rsync__47__ssh_backend_to_other_backend__63__.mdwn b/doc/forum/How_to_copy__47__duplicate_all_data_from_rsync__47__ssh_backend_to_other_backend__63__.mdwn index b660cb6a06..0e72582d32 100644 --- a/doc/forum/How_to_copy__47__duplicate_all_data_from_rsync__47__ssh_backend_to_other_backend__63__.mdwn +++ b/doc/forum/How_to_copy__47__duplicate_all_data_from_rsync__47__ssh_backend_to_other_backend__63__.mdwn @@ -3,10 +3,10 @@ Hello, I want to be safe and have two copies of my files on two different backend. Currently I only have a SSH backend, that stores all my data. I have full(root) access to that machine/backend. On my laptop I have only a few bytes of data, because all is moved/copied to that SSH backend. Now, I want to duplicate the data on the SSH backend to a Google Drive account (or any other). How could I do that (without downloading all data from the SSH backend)??? Encryption is not a must. I looked into the annex/objects folder on the SSH backend, but there are 3 char length directories compared to what I see on a test Google Drive backend, where only 2 char length directory names are. -Example SSH backend: -[git-annex root]/annex/objects/c10/90a/SHA256E-s445227--14c3f85d6dd3464f116f6a5bbd411012781d36794549d136b18d1914c4158820.jpg/SHA256E-s445227--14c3f85d6dd3464f116f6a5bbd411012781d36794549d136b18d1914c4158820.jpg -Example Google Drive: -[Google Drive root]/annex/W7/xQ/SHA256E-s913904--29f9800b0dd34d4200c4e9ee152b79c3556a9a473848720be7cf83d20eff65a4.JPG + +Example SSH backend: [git-annex root]/annex/objects/c10/90a/SHA256E-s445227--14c3f85d6dd3464f116f6a5bbd411012781d36794549d136b18d1914c4158820.jpg/SHA256E-s445227--14c3f85d6dd3464f116f6a5bbd411012781d36794549d136b18d1914c4158820.jpg + +Example Google Drive: [Google Drive root]/annex/W7/xQ/SHA256E-s913904--29f9800b0dd34d4200c4e9ee152b79c3556a9a473848720be7cf83d20eff65a4.JPG Is there a way to convert these directory names and do a simpe copy??? From 0f240c301f6b1f7f548053472222394765d93475 Mon Sep 17 00:00:00 2001 From: "https://www.google.com/accounts/o8/id?id=AItOawkgH7oNEqNbh3g-N1-UHXuqleXaRYDgj1U" Date: Fri, 30 Aug 2013 15:39:16 +0000 Subject: [PATCH 36/73] Added a comment --- .../comment_2_0da0d68b646f2b38be6ecf7c0fe13743._comment | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__/comment_2_0da0d68b646f2b38be6ecf7c0fe13743._comment diff --git a/doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__/comment_2_0da0d68b646f2b38be6ecf7c0fe13743._comment b/doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__/comment_2_0da0d68b646f2b38be6ecf7c0fe13743._comment new file mode 100644 index 0000000000..c8a1db2288 --- /dev/null +++ b/doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__/comment_2_0da0d68b646f2b38be6ecf7c0fe13743._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkgH7oNEqNbh3g-N1-UHXuqleXaRYDgj1U" + nickname="Adam" + subject="comment 2" + date="2013-08-30T15:39:16Z" + content=""" +\"auto-key-locate cert pka ldap hkp://keys.gnupg.net\" is on line 233 +"""]] From fa7c7f25535d42edc5d3cfee6b2a4c81e7829367 Mon Sep 17 00:00:00 2001 From: guilhem Date: Fri, 30 Aug 2013 16:09:58 +0000 Subject: [PATCH 37/73] Added a comment --- ...t_3_09c56f5574931f2ebe903069f0731160._comment | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) create mode 100644 doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__/comment_3_09c56f5574931f2ebe903069f0731160._comment diff --git a/doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__/comment_3_09c56f5574931f2ebe903069f0731160._comment b/doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__/comment_3_09c56f5574931f2ebe903069f0731160._comment new file mode 100644 index 0000000000..3cfa9a8291 --- /dev/null +++ b/doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__/comment_3_09c56f5574931f2ebe903069f0731160._comment @@ -0,0 +1,16 @@ +[[!comment format=mdwn + username="guilhem" + ip="129.16.20.209" + subject="comment 3" + date="2013-08-30T16:09:58Z" + content=""" +Hmm, it looks like a perfectly valid list. Interesting. +But regardless, gpg doesn't seem to like that line; what gpg version +are you using? Also, does it work directly on the command-line +(`gpg -a --gen-random 1 1`)? + +Have you tried to setup the remote without that line in the gpg.conf? Of +course it wouldn't solve the core of the issue, but it's irrelevant for +random data generation anyway (the same goes for `--trust-model`); +perhaps this very command should be run with `--no-options`. +"""]] From 4b3a219ba8bb4ef0d6c0e3bd1702637710f5b210 Mon Sep 17 00:00:00 2001 From: "https://www.google.com/accounts/o8/id?id=AItOawkgH7oNEqNbh3g-N1-UHXuqleXaRYDgj1U" Date: Fri, 30 Aug 2013 21:39:26 +0000 Subject: [PATCH 38/73] Added a comment --- ...mment_4_0c127396e682ca6ced43aec7deeb0335._comment | 12 ++++++++++++ 1 file changed, 12 insertions(+) create mode 100644 doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__/comment_4_0c127396e682ca6ced43aec7deeb0335._comment diff --git a/doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__/comment_4_0c127396e682ca6ced43aec7deeb0335._comment b/doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__/comment_4_0c127396e682ca6ced43aec7deeb0335._comment new file mode 100644 index 0000000000..6d2bb451a8 --- /dev/null +++ b/doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__/comment_4_0c127396e682ca6ced43aec7deeb0335._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkgH7oNEqNbh3g-N1-UHXuqleXaRYDgj1U" + nickname="Adam" + subject="comment 4" + date="2013-08-30T21:39:26Z" + content=""" +`gpg -a --gen-random 1 1` on the command line seems to work. At least, when I just ran it it returned `Xg==`. I'm not super familiar with running gpg on the command line, so I'm not sure if that is the desired result when running that. + +The version of gpg is GnuPG/MacGPG2 version 2.0.20. + +I just tried deleting that line from the config file, and now it worked. Would I be able to replace the line after setting up the repository, or is that going to create problems? I'm not entirely sure what that line does, and I'm a little wary about messing with it in case it breaks the functionality of any of the other things that I use gpg for, like email encryption. +"""]] From 4b1fcb2b8105b51fd62d9202caac4a6be3f4e045 Mon Sep 17 00:00:00 2001 From: guilhem Date: Fri, 30 Aug 2013 22:51:56 +0000 Subject: [PATCH 39/73] Added a comment --- ...ment_5_6bc3eadefde4750eec67a55de6651b2d._comment | 13 +++++++++++++ 1 file changed, 13 insertions(+) create mode 100644 doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__/comment_5_6bc3eadefde4750eec67a55de6651b2d._comment diff --git a/doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__/comment_5_6bc3eadefde4750eec67a55de6651b2d._comment b/doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__/comment_5_6bc3eadefde4750eec67a55de6651b2d._comment new file mode 100644 index 0000000000..998d670553 --- /dev/null +++ b/doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__/comment_5_6bc3eadefde4750eec67a55de6651b2d._comment @@ -0,0 +1,13 @@ +[[!comment format=mdwn + username="guilhem" + ip="129.16.20.209" + subject="comment 5" + date="2013-08-30T22:51:56Z" + content=""" +OK (you just generated 1 byte of base64-encoded random data). +No, I'm afraid git-annex will croak for each operation using gpg on your remote (which includes get, push, fsck, ...). + +This lines specifies how gpg automatically retrieves public keys when you get a signed message for instance. If you don't want to mix configurations, it is easy to create a git-annex-specific GnuPG home directory, but it requires you to point the `GNUPGHOME` to this alternative directory before starting git-annex. + +That said, other MacOSX users have encountered the same problem, and it was [[reported_to_be_solved_recently|/bugs/internal_server_error_when_choosing_encrypted_rsync_repo_option/]]. +"""]] From ec54b3635ecc7de669a6e43231508fcf1faca6cc Mon Sep 17 00:00:00 2001 From: "http://pnijjar.livejournal.com/" Date: Sat, 31 Aug 2013 00:05:17 +0000 Subject: [PATCH 40/73] Added a comment --- .../comment_1_6caa7e67461a6ea5de8155ae9cf75fab._comment | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 doc/devblog/moving_blogs/comment_1_6caa7e67461a6ea5de8155ae9cf75fab._comment diff --git a/doc/devblog/moving_blogs/comment_1_6caa7e67461a6ea5de8155ae9cf75fab._comment b/doc/devblog/moving_blogs/comment_1_6caa7e67461a6ea5de8155ae9cf75fab._comment new file mode 100644 index 0000000000..46df4a7f68 --- /dev/null +++ b/doc/devblog/moving_blogs/comment_1_6caa7e67461a6ea5de8155ae9cf75fab._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://pnijjar.livejournal.com/" + ip="99.236.22.229" + subject="comment 1" + date="2013-08-31T00:05:16Z" + content=""" +Do we need to update our RSS feeds? I appear to be getting your devblog posts in my old feed, but I do not know whether that will continue working. +"""]] From 8b25aa3b9c0ad294f230e9a1aa2fa41d62137cb8 Mon Sep 17 00:00:00 2001 From: "https://www.google.com/accounts/o8/id?id=AItOawmkBwMWvNKZZCge_YqobCSILPMeK6xbFw8" Date: Sat, 31 Aug 2013 10:03:04 +0000 Subject: [PATCH 41/73] Added a comment --- ...comment_2_e3e2048fc2397b87a2f29c9fe49394cb._comment | 10 ++++++++++ 1 file changed, 10 insertions(+) create mode 100644 doc/devblog/moving_blogs/comment_2_e3e2048fc2397b87a2f29c9fe49394cb._comment diff --git a/doc/devblog/moving_blogs/comment_2_e3e2048fc2397b87a2f29c9fe49394cb._comment b/doc/devblog/moving_blogs/comment_2_e3e2048fc2397b87a2f29c9fe49394cb._comment new file mode 100644 index 0000000000..19b5ae1c6f --- /dev/null +++ b/doc/devblog/moving_blogs/comment_2_e3e2048fc2397b87a2f29c9fe49394cb._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmkBwMWvNKZZCge_YqobCSILPMeK6xbFw8" + nickname="develop" + subject="comment 2" + date="2013-08-31T10:03:04Z" + content=""" +The old RSS feed will continue working. + +So sit back, relax, and enjoy the show. +"""]] From 8744de02b27c3d9e7b3d8c769e19c48544b0cfcc Mon Sep 17 00:00:00 2001 From: hcb Date: Sat, 31 Aug 2013 14:00:52 +0000 Subject: [PATCH 42/73] --- doc/bugs/missing_msys-1.0.dll.mdwn | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) create mode 100644 doc/bugs/missing_msys-1.0.dll.mdwn diff --git a/doc/bugs/missing_msys-1.0.dll.mdwn b/doc/bugs/missing_msys-1.0.dll.mdwn new file mode 100644 index 0000000000..2f37da5cb2 --- /dev/null +++ b/doc/bugs/missing_msys-1.0.dll.mdwn @@ -0,0 +1,28 @@ +### Please describe the problem. +Can not execute xargs.exe. It fails with missing msys-1.0.dll + +### What steps will reproduce the problem? +Execute xargs.exe directly +Noticed when running: git-annex.exe sync + +### What version of git-annex are you using? On what operating system? +Windows 7 + +git-annex-installer.exe 2013-08-27 03:37 + +git-annex version: 4.20130827-g4f18612 +build flags: Pairing Testsuite S3 WebDAV DNS +local repository version: 4 +default repository version: 3 +supported repository versions: 3 4 +upgrade supported from repository versions: 2 + +### Please provide any additional information below. + +[[!format sh """ +# If you can, paste a complete transcript of the problem occurring here. +# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log + + +# End of transcript or log. +"""]] From cdffa748a260c0f8ea5beb4b57ef7e1595041fd6 Mon Sep 17 00:00:00 2001 From: hcb Date: Sat, 31 Aug 2013 14:07:56 +0000 Subject: [PATCH 43/73] removed --- doc/bugs/missing_msys-1.0.dll.mdwn | 28 ---------------------------- 1 file changed, 28 deletions(-) delete mode 100644 doc/bugs/missing_msys-1.0.dll.mdwn diff --git a/doc/bugs/missing_msys-1.0.dll.mdwn b/doc/bugs/missing_msys-1.0.dll.mdwn deleted file mode 100644 index 2f37da5cb2..0000000000 --- a/doc/bugs/missing_msys-1.0.dll.mdwn +++ /dev/null @@ -1,28 +0,0 @@ -### Please describe the problem. -Can not execute xargs.exe. It fails with missing msys-1.0.dll - -### What steps will reproduce the problem? -Execute xargs.exe directly -Noticed when running: git-annex.exe sync - -### What version of git-annex are you using? On what operating system? -Windows 7 - -git-annex-installer.exe 2013-08-27 03:37 - -git-annex version: 4.20130827-g4f18612 -build flags: Pairing Testsuite S3 WebDAV DNS -local repository version: 4 -default repository version: 3 -supported repository versions: 3 4 -upgrade supported from repository versions: 2 - -### Please provide any additional information below. - -[[!format sh """ -# If you can, paste a complete transcript of the problem occurring here. -# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log - - -# End of transcript or log. -"""]] From fa92bb6851b94867d0e230d1bd5f516a48f6b788 Mon Sep 17 00:00:00 2001 From: "https://www.google.com/accounts/o8/id?id=AItOawlYsjf5dcZnzs0b9EPxnjVddx1rnrpZASs" Date: Sat, 31 Aug 2013 15:48:40 +0000 Subject: [PATCH 44/73] Added a comment: Any news? --- .../comment_6_94144c0cbdbccc72c13e12daf7657a29._comment | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9/comment_6_94144c0cbdbccc72c13e12daf7657a29._comment diff --git a/doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9/comment_6_94144c0cbdbccc72c13e12daf7657a29._comment b/doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9/comment_6_94144c0cbdbccc72c13e12daf7657a29._comment new file mode 100644 index 0000000000..fbb519bdd2 --- /dev/null +++ b/doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9/comment_6_94144c0cbdbccc72c13e12daf7657a29._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawlYsjf5dcZnzs0b9EPxnjVddx1rnrpZASs" + nickname="Duarte" + subject="Any news?" + date="2013-08-31T15:48:39Z" + content=""" +Has anyone made any progress on this? Just wondering... +"""]] From eda14db5f35380fbe2627d04921f8ef0b2e4efc2 Mon Sep 17 00:00:00 2001 From: "https://www.google.com/accounts/o8/id?id=AItOawmTNrhkVQ26GBLaLD5-zNuEiR8syTj4mI8" Date: Sat, 31 Aug 2013 18:20:58 +0000 Subject: [PATCH 45/73] Added a comment --- ...ment_10_2ed5aa8c632048b13e01d358883fa383._comment | 12 ++++++++++++ 1 file changed, 12 insertions(+) create mode 100644 doc/tips/finding_duplicate_files/comment_10_2ed5aa8c632048b13e01d358883fa383._comment diff --git a/doc/tips/finding_duplicate_files/comment_10_2ed5aa8c632048b13e01d358883fa383._comment b/doc/tips/finding_duplicate_files/comment_10_2ed5aa8c632048b13e01d358883fa383._comment new file mode 100644 index 0000000000..77a308b90f --- /dev/null +++ b/doc/tips/finding_duplicate_files/comment_10_2ed5aa8c632048b13e01d358883fa383._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmTNrhkVQ26GBLaLD5-zNuEiR8syTj4mI8" + nickname="Juan" + subject="comment 10" + date="2013-08-31T18:20:58Z" + content=""" +I'm already spreading the word. Handling scientific papers, data, simulations and code has been quite a challenge during my academic career. While code was solved long ago, the three first items remained a huge problem. +I'm sure many of my colleagues will be happy to use it. +Is there any hashtag or twitter account? I've seen that you collected some of my tweets, but I don't know how you did it. Did you search for git-annex? +Best, + Juan +"""]] From 0831e18372861af8c83852a13e24ef91ba251335 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 31 Aug 2013 17:38:33 -0400 Subject: [PATCH 46/73] forget --drop-dead: Completely removes mentions of repositories that have been marked as dead from the git-annex branch. Wrote nice pure transition calculator, and ugly code to stage its results into the git-annex branch. Also had to split up several Log modules that Annex.Branch needed to use, but that themselves used Annex.Branch. The transition calculator is limited to looking at and changing one file at a time. While this made the implementation relatively easy, it precludes transitions that do stuff like deleting old url log files for keys that are being removed because they are no longer present anywhere. --- Annex/Branch.hs | 91 +++++++++++++++++++++++++++++-------- Annex/Branch/Transitions.hs | 53 +++++++++++++++++++++ Command/Forget.hs | 31 +++++++++---- Logs/Presence.hs | 83 ++------------------------------- Logs/Presence/Pure.hs | 84 ++++++++++++++++++++++++++++++++++ Logs/Transitions.hs | 13 ------ Logs/Trust.hs | 28 ++---------- Logs/Trust/Pure.hs | 36 +++++++++++++++ debian/changelog | 2 + doc/git-annex.mdwn | 13 +++--- 10 files changed, 279 insertions(+), 155 deletions(-) create mode 100644 Annex/Branch/Transitions.hs create mode 100644 Logs/Presence/Pure.hs create mode 100644 Logs/Trust/Pure.hs diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 334b60634f..9ee281de9b 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -46,8 +46,12 @@ import Annex.CatFile import Annex.Perms import qualified Annex import Utility.Env +import Logs import Logs.Transitions +import Logs.Trust.Pure import Annex.ReplaceFile +import qualified Annex.Queue +import Annex.Branch.Transitions {- Name of the branch that is used to store git-annex's information. -} name :: Git.Ref @@ -194,7 +198,10 @@ get' :: FilePath -> Annex String get' file = go =<< getJournalFile file where go (Just journalcontent) = return journalcontent - go Nothing = withIndex $ L.unpack <$> catFile fullname file + go Nothing = getRaw file + +getRaw :: FilePath -> Annex String +getRaw file = withIndex $ L.unpack <$> catFile fullname file {- Applies a function to modifiy the content of a file. - @@ -272,13 +279,17 @@ commitBranch' branchref message parents = do files :: Annex [FilePath] files = do update - withIndex $ do - bfiles <- inRepo $ Git.Command.pipeNullSplitZombie - [ Params "ls-tree --name-only -r -z" - , Param $ show fullname - ] - jfiles <- getJournalledFiles - return $ jfiles ++ bfiles + (++) + <$> branchFiles + <*> getJournalledFiles + +{- Files in the branch, not including any from journalled changes, + - and without updating the branch. -} +branchFiles :: Annex [FilePath] +branchFiles = withIndex $ inRepo $ Git.Command.pipeNullSplitZombie + [ Params "ls-tree --name-only -r -z" + , Param $ show fullname + ] {- Populates the branch's index file with the current branch contents. - @@ -436,20 +447,60 @@ getIgnoredRefs = S.fromList . mapMaybe Git.Sha.extractSha . lines <$> content - commits it to the branch, or creates a new branch, and returns - the branch's ref. -} performTransitions :: Transitions -> Bool -> Annex Git.Ref -performTransitions ts neednewbranch = withIndex $ do - when (inTransitions ForgetDeadRemotes ts) $ - error "TODO ForgetDeadRemotes transition" - if neednewbranch - then do - committedref <- inRepo $ Git.Branch.commit message fullname [] - setIndexSha committedref - return committedref - else do - ref <- getBranch - commitBranch ref message [fullname] - getBranch +performTransitions ts neednewbranch = do + -- For simplicity & speed, we're going to use the Annex.Queue to + -- update the git-annex branch, while it usually holds changes + -- for the head branch. Flush any such changes. + Annex.Queue.flush + withIndex $ do + run $ mapMaybe getTransitionCalculator $ transitionList ts + Annex.Queue.flush + if neednewbranch + then do + committedref <- inRepo $ Git.Branch.commit message fullname [] + setIndexSha committedref + return committedref + else do + ref <- getBranch + commitBranch ref message [fullname] + getBranch where message | neednewbranch = "new branch for transition " ++ tdesc | otherwise = "continuing transition " ++ tdesc tdesc = show $ map describeTransition $ transitionList ts + + {- The changes to make to the branch are calculated and applied to + - the branch directly, rather than going through the journal, + - which would be innefficient. (And the journal is not designed + - to hold changes to every file in the branch at once.) + - + - When a file in the branch is changed by transition code, + - that value is remembered and fed into the code for subsequent + - transitions. + -} + run [] = noop + run changers = do + trustmap <- calcTrustMap <$> getRaw trustLog + fs <- branchFiles + hasher <- inRepo hashObjectStart + forM_ fs $ \f -> do + content <- getRaw f + apply changers hasher f content trustmap + liftIO $ hashObjectStop hasher + apply [] _ _ _ _ = return () + apply (changer:rest) hasher file content trustmap = + case changer file content trustmap of + RemoveFile -> do + Annex.Queue.addUpdateIndex + =<< inRepo (Git.UpdateIndex.unstageFile file) + -- File is deleted; can't run any other + -- transitions on it. + return () + ChangeFile content' -> do + sha <- inRepo $ hashObject BlobObject content' + Annex.Queue.addUpdateIndex $ Git.UpdateIndex.pureStreamer $ + Git.UpdateIndex.updateIndexLine sha FileBlob (asTopFilePath file) + apply rest hasher file content' trustmap + PreserveFile -> + apply rest hasher file content trustmap diff --git a/Annex/Branch/Transitions.hs b/Annex/Branch/Transitions.hs new file mode 100644 index 0000000000..90002de624 --- /dev/null +++ b/Annex/Branch/Transitions.hs @@ -0,0 +1,53 @@ +{- git-annex branch transitions + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Annex.Branch.Transitions ( + FileTransition(..), + getTransitionCalculator +) where + +import Logs +import Logs.Transitions +import Logs.UUIDBased as UUIDBased +import Logs.Presence.Pure as Presence +import Types.TrustLevel +import Types.UUID + +import qualified Data.Map as M + +data FileTransition + = ChangeFile String + | RemoveFile + | PreserveFile + +type TransitionCalculator = FilePath -> String -> TrustMap -> FileTransition + +getTransitionCalculator :: Transition -> Maybe TransitionCalculator +getTransitionCalculator ForgetGitHistory = Nothing +getTransitionCalculator ForgetDeadRemotes = Just dropDead + +dropDead :: FilePath -> String -> TrustMap -> FileTransition +dropDead f content trustmap = case getLogVariety f of + Just UUIDBasedLog -> ChangeFile $ + UUIDBased.showLog id $ dropDeadFromUUIDBasedLog trustmap $ UUIDBased.parseLog Just content + Just (PresenceLog _) -> + let newlog = Presence.compactLog $ dropDeadFromPresenceLog trustmap $ Presence.parseLog content + in if null newlog + then RemoveFile + else ChangeFile $ Presence.showLog newlog + Nothing -> PreserveFile + +dropDeadFromUUIDBasedLog :: TrustMap -> UUIDBased.Log String -> UUIDBased.Log String +dropDeadFromUUIDBasedLog trustmap = M.filterWithKey $ notDead trustmap . const + +{- Presence logs can contain UUIDs or other values. Any line that matches + - a dead uuid is dropped; any other values are passed through. -} +dropDeadFromPresenceLog :: TrustMap -> [Presence.LogLine] -> [Presence.LogLine] +dropDeadFromPresenceLog trustmap = filter $ notDead trustmap (toUUID . Presence.info) + +notDead :: TrustMap -> (v -> UUID) -> v -> Bool +notDead trustmap a v = M.findWithDefault SemiTrusted (a v) trustmap /= DeadTrusted diff --git a/Command/Forget.hs b/Command/Forget.hs index e405a99181..d216ae3ca4 100644 --- a/Command/Forget.hs +++ b/Command/Forget.hs @@ -12,30 +12,41 @@ import Command import qualified Annex.Branch as Branch import Logs.Transitions import qualified Annex +import qualified Option import Data.Time.Clock.POSIX def :: [Command] -def = [command "forget" paramNothing seek +def = [withOptions forgetOptions $ command "forget" paramNothing seek SectionMaintenance "prune git-annex branch history"] +forgetOptions :: [Option] +forgetOptions = [dropDeadOption] + +dropDeadOption :: Option +dropDeadOption = Option.flag [] "drop-dead" "drop references to dead repositories" + seek :: [CommandSeek] -seek = [withNothing start] +seek = [withFlag dropDeadOption $ \dropdead -> + withNothing $ start dropdead] -start :: CommandStart -start = do +start :: Bool -> CommandStart +start dropdead = do showStart "forget" "git-annex" - next $ perform =<< Annex.getState Annex.force - -perform :: Bool -> CommandPerform -perform True = do now <- liftIO getPOSIXTime - let ts = addTransition now ForgetGitHistory noTransitions + let basets = addTransition now ForgetGitHistory noTransitions + let ts = if dropdead + then addTransition now ForgetDeadRemotes basets + else basets + next $ perform ts =<< Annex.getState Annex.force + +perform :: Transitions -> Bool -> CommandPerform +perform ts True = do recordTransitions Branch.change ts -- get branch committed before contining with the transition Branch.update void $ Branch.performTransitions ts True next $ return True -perform False = do +perform _ False = do showLongNote "To forget git-annex branch history, you must specify --force. This deletes metadata!" stop diff --git a/Logs/Presence.hs b/Logs/Presence.hs index ec5cec209a..516d59618f 100644 --- a/Logs/Presence.hs +++ b/Logs/Presence.hs @@ -12,36 +12,18 @@ -} module Logs.Presence ( - LogStatus(..), - LogLine(LogLine), + module X, addLog, readLog, - getLog, - parseLog, - showLog, logNow, - compactLog, - currentLog, - prop_parse_show_log, + currentLog ) where import Data.Time.Clock.POSIX -import Data.Time -import System.Locale -import qualified Data.Map as M +import Logs.Presence.Pure as X import Common.Annex import qualified Annex.Branch -import Utility.QuickCheck - -data LogLine = LogLine { - date :: POSIXTime, - status :: LogStatus, - info :: String -} deriving (Eq, Show) - -data LogStatus = InfoPresent | InfoMissing - deriving (Eq, Show, Bounded, Enum) addLog :: FilePath -> LogLine -> Annex () addLog file line = Annex.Branch.change file $ \s -> @@ -52,29 +34,6 @@ addLog file line = Annex.Branch.change file $ \s -> readLog :: FilePath -> Annex [LogLine] readLog = parseLog <$$> Annex.Branch.get -{- Parses a log file. Unparseable lines are ignored. -} -parseLog :: String -> [LogLine] -parseLog = mapMaybe parseline . lines - where - parseline l = LogLine - <$> (utcTimeToPOSIXSeconds <$> parseTime defaultTimeLocale "%s%Qs" d) - <*> parsestatus s - <*> pure rest - where - (d, pastd) = separate (== ' ') l - (s, rest) = separate (== ' ') pastd - parsestatus "1" = Just InfoPresent - parsestatus "0" = Just InfoMissing - parsestatus _ = Nothing - -{- Generates a log file. -} -showLog :: [LogLine] -> String -showLog = unlines . map genline - where - genline (LogLine d s i) = unwords [show d, genstatus s, i] - genstatus InfoPresent = "1" - genstatus InfoMissing = "0" - {- Generates a new LogLine with the current date. -} logNow :: LogStatus -> String -> Annex LogLine logNow s i = do @@ -84,39 +43,3 @@ logNow s i = do {- Reads a log and returns only the info that is still in effect. -} currentLog :: FilePath -> Annex [String] currentLog file = map info . filterPresent <$> readLog file - -{- Given a log, returns only the info that is are still in effect. -} -getLog :: String -> [String] -getLog = map info . filterPresent . parseLog - -{- Returns the info from LogLines that are in effect. -} -filterPresent :: [LogLine] -> [LogLine] -filterPresent = filter (\l -> InfoPresent == status l) . compactLog - -{- Compacts a set of logs, returning a subset that contains the current - - status. -} -compactLog :: [LogLine] -> [LogLine] -compactLog = M.elems . foldr mapLog M.empty - -type LogMap = M.Map String LogLine - -{- Inserts a log into a map of logs, if the log has better (ie, newer) - - information than the other logs in the map -} -mapLog :: LogLine -> LogMap -> LogMap -mapLog l m - | better = M.insert i l m - | otherwise = m - where - better = maybe True newer $ M.lookup i m - newer l' = date l' <= date l - i = info l - -instance Arbitrary LogLine where - arbitrary = LogLine - <$> arbitrary - <*> elements [minBound..maxBound] - <*> arbitrary `suchThat` ('\n' `notElem`) - -prop_parse_show_log :: [LogLine] -> Bool -prop_parse_show_log l = parseLog (showLog l) == l - diff --git a/Logs/Presence/Pure.hs b/Logs/Presence/Pure.hs new file mode 100644 index 0000000000..ffeb78b26d --- /dev/null +++ b/Logs/Presence/Pure.hs @@ -0,0 +1,84 @@ +{- git-annex presence log, pure operations + - + - Copyright 2010-2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Logs.Presence.Pure where + +import Data.Time.Clock.POSIX +import Data.Time +import System.Locale +import qualified Data.Map as M + +import Common.Annex +import Utility.QuickCheck + +data LogLine = LogLine { + date :: POSIXTime, + status :: LogStatus, + info :: String +} deriving (Eq, Show) + +data LogStatus = InfoPresent | InfoMissing + deriving (Eq, Show, Bounded, Enum) + +{- Parses a log file. Unparseable lines are ignored. -} +parseLog :: String -> [LogLine] +parseLog = mapMaybe parseline . lines + where + parseline l = LogLine + <$> (utcTimeToPOSIXSeconds <$> parseTime defaultTimeLocale "%s%Qs" d) + <*> parsestatus s + <*> pure rest + where + (d, pastd) = separate (== ' ') l + (s, rest) = separate (== ' ') pastd + parsestatus "1" = Just InfoPresent + parsestatus "0" = Just InfoMissing + parsestatus _ = Nothing + +{- Generates a log file. -} +showLog :: [LogLine] -> String +showLog = unlines . map genline + where + genline (LogLine d s i) = unwords [show d, genstatus s, i] + genstatus InfoPresent = "1" + genstatus InfoMissing = "0" + +{- Given a log, returns only the info that is are still in effect. -} +getLog :: String -> [String] +getLog = map info . filterPresent . parseLog + +{- Returns the info from LogLines that are in effect. -} +filterPresent :: [LogLine] -> [LogLine] +filterPresent = filter (\l -> InfoPresent == status l) . compactLog + +{- Compacts a set of logs, returning a subset that contains the current + - status. -} +compactLog :: [LogLine] -> [LogLine] +compactLog = M.elems . foldr mapLog M.empty + +type LogMap = M.Map String LogLine + +{- Inserts a log into a map of logs, if the log has better (ie, newer) + - information than the other logs in the map -} +mapLog :: LogLine -> LogMap -> LogMap +mapLog l m + | better = M.insert i l m + | otherwise = m + where + better = maybe True newer $ M.lookup i m + newer l' = date l' <= date l + i = info l + +instance Arbitrary LogLine where + arbitrary = LogLine + <$> arbitrary + <*> elements [minBound..maxBound] + <*> arbitrary `suchThat` ('\n' `notElem`) + +prop_parse_show_log :: [LogLine] -> Bool +prop_parse_show_log l = parseLog (showLog l) == l + diff --git a/Logs/Transitions.hs b/Logs/Transitions.hs index d4b7d5eb35..783ce5090a 100644 --- a/Logs/Transitions.hs +++ b/Logs/Transitions.hs @@ -7,16 +7,6 @@ - done that is listed in the remote branch by checking that the local - branch contains the same transition, with the same or newer start time. - - - When a remote branch that has had an transition performed on it - - becomes available for merging into the local git-annex branch, - - the transition is first performed on the local branch. - - - - When merging a remote branch into the local git-annex branch, - - all transitions that have been performed on the local branch must also - - have been performed on the remote branch already. (Or it would be - - possible to perform the transitions on a fixup branch and merge it, - - but that would be expensive.) - - - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. @@ -86,9 +76,6 @@ parseTransitionLine s = TransitionLine <$> pdate ds <*> readish ts combineTransitions :: [Transitions] -> Transitions combineTransitions = S.unions -inTransitions :: Transition -> Transitions -> Bool -inTransitions t = not . S.null . S.filter (\l -> transition l == t) - transitionList :: Transitions -> [Transition] transitionList = map transition . S.elems diff --git a/Logs/Trust.hs b/Logs/Trust.hs index 6c6b33f70e..c6f0ad3abd 100644 --- a/Logs/Trust.hs +++ b/Logs/Trust.hs @@ -6,6 +6,7 @@ -} module Logs.Trust ( + module X, trustLog, TrustLevel(..), trustGet, @@ -16,8 +17,6 @@ module Logs.Trust ( lookupTrust, trustMapLoad, trustMapRaw, - - prop_parse_show_TrustLog, ) where import qualified Data.Map as M @@ -31,6 +30,7 @@ import Logs import Logs.UUIDBased import Remote.List import qualified Types.Remote +import Logs.Trust.Pure as X {- Returns a list of UUIDs that the trustLog indicates have the - specified trust level. @@ -94,26 +94,4 @@ trustMapLoad = do {- Does not include forcetrust or git config values, just those from the - log file. -} trustMapRaw :: Annex TrustMap -trustMapRaw = simpleMap . parseLog (Just . parseTrustLog) - <$> Annex.Branch.get trustLog - -{- The trust.log used to only list trusted repos, without a field for the - - trust status, which is why this defaults to Trusted. -} -parseTrustLog :: String -> TrustLevel -parseTrustLog s = maybe Trusted parse $ headMaybe $ words s - where - parse "1" = Trusted - parse "0" = UnTrusted - parse "X" = DeadTrusted - parse _ = SemiTrusted - -showTrustLog :: TrustLevel -> String -showTrustLog Trusted = "1" -showTrustLog UnTrusted = "0" -showTrustLog DeadTrusted = "X" -showTrustLog SemiTrusted = "?" - -prop_parse_show_TrustLog :: Bool -prop_parse_show_TrustLog = all check [minBound .. maxBound] - where - check l = parseTrustLog (showTrustLog l) == l +trustMapRaw = calcTrustMap <$> Annex.Branch.get trustLog diff --git a/Logs/Trust/Pure.hs b/Logs/Trust/Pure.hs new file mode 100644 index 0000000000..11cfbe0563 --- /dev/null +++ b/Logs/Trust/Pure.hs @@ -0,0 +1,36 @@ +{- git-annex trust log, pure operations + - + - Copyright 2010-2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Logs.Trust.Pure where + +import Common.Annex +import Types.TrustLevel +import Logs.UUIDBased + +calcTrustMap :: String -> TrustMap +calcTrustMap = simpleMap . parseLog (Just . parseTrustLog) + +{- The trust.log used to only list trusted repos, without a field for the + - trust status, which is why this defaults to Trusted. -} +parseTrustLog :: String -> TrustLevel +parseTrustLog s = maybe Trusted parse $ headMaybe $ words s + where + parse "1" = Trusted + parse "0" = UnTrusted + parse "X" = DeadTrusted + parse _ = SemiTrusted + +showTrustLog :: TrustLevel -> String +showTrustLog Trusted = "1" +showTrustLog UnTrusted = "0" +showTrustLog DeadTrusted = "X" +showTrustLog SemiTrusted = "?" + +prop_parse_show_TrustLog :: Bool +prop_parse_show_TrustLog = all check [minBound .. maxBound] + where + check l = parseTrustLog (showTrustLog l) == l diff --git a/debian/changelog b/debian/changelog index cb6fbee5a9..a28c9f1877 100644 --- a/debian/changelog +++ b/debian/changelog @@ -3,6 +3,8 @@ git-annex (4.20130828) UNRELEASED; urgency=low * forget: New command, causes git-annex branch history to be forgotten in a way that will spread to other clones of the repository. (As long as they're running this version or newer of git-annex.) + * forget --drop-dead: Completely removes mentions of repositories that + have been marked as dead from the git-annex branch. * sync, assistant: Force push of the git-annex branch. Necessary to ensure it gets pushed to remotes after being rewritten by forget. diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 5fb0ce5a4d..269588addf 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -482,17 +482,16 @@ subdirectories). * forget Causes the git-annex branch to be rewritten, throwing away historical - data about past locations of files, files that are no longer present on - any remote, etc. The resulting branch will use less space, but for - example `git annex log` will not be able to show where files used to - be located. + data about past locations of files. The resulting branch will use less + space, but `git annex log` will not be able to show where + files used to be located. - To also prune references to remotes that have been marked as dead, - specify --dead. + To also prune references to repositories that have been marked as dead, + specify --drop-dead. When this rewritten branch is merged into other clones of the repository, git-annex will automatically perform the same rewriting - to their local git-annex branch. So the forgetfulness will automatically + to their local git-annex branches. So the forgetfulness will automatically propigate out from its starting point until all repositories running git-annex have forgotten their old history. (You may need to force git to push the branch to any git repositories not running git-annex. From c79809754d8351d9396ba39329dfa64bcca97329 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 31 Aug 2013 17:55:07 -0400 Subject: [PATCH 47/73] blog for the day --- doc/devblog/day_-1__drop_dead.mdwn | 5 +++++ 1 file changed, 5 insertions(+) create mode 100644 doc/devblog/day_-1__drop_dead.mdwn diff --git a/doc/devblog/day_-1__drop_dead.mdwn b/doc/devblog/day_-1__drop_dead.mdwn new file mode 100644 index 0000000000..97f7cf1d28 --- /dev/null +++ b/doc/devblog/day_-1__drop_dead.mdwn @@ -0,0 +1,5 @@ +Implemented `git annex forget --drop-dead`, which is finally a way to +remove all references to old repositories that you've marked as dead. + +I've still not merged in the `forget` branch, because I developed this +while slightly ill, and have not tested it very well yet. From cd1f42c042a543b3147908bcb8c9dbc8ebb48226 Mon Sep 17 00:00:00 2001 From: "https://www.google.com/accounts/o8/id?id=AItOawkgedYqmQb4dJU7UdVuRLwsQE-KlKVrFto" Date: Sun, 1 Sep 2013 00:25:27 +0000 Subject: [PATCH 48/73] Added a comment --- .../comment_3_ddc9cbae1a721400a9acf2153e18f4f0._comment | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 doc/bugs/git-annex_broken_on_Android_4.3/comment_3_ddc9cbae1a721400a9acf2153e18f4f0._comment diff --git a/doc/bugs/git-annex_broken_on_Android_4.3/comment_3_ddc9cbae1a721400a9acf2153e18f4f0._comment b/doc/bugs/git-annex_broken_on_Android_4.3/comment_3_ddc9cbae1a721400a9acf2153e18f4f0._comment new file mode 100644 index 0000000000..14eed81c96 --- /dev/null +++ b/doc/bugs/git-annex_broken_on_Android_4.3/comment_3_ddc9cbae1a721400a9acf2153e18f4f0._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkgedYqmQb4dJU7UdVuRLwsQE-KlKVrFto" + nickname="Chungy" + subject="comment 3" + date="2013-09-01T00:25:15Z" + content=""" +Just confirming the bug on my Verizon Galaxy S 3 with CyanogenMod 10.2 (Android 4.3), it's not Nexus-specific. +"""]] From c2915ac2a33a6f0e1356f6825d58c5fbebea67df Mon Sep 17 00:00:00 2001 From: hcb Date: Sun, 1 Sep 2013 09:20:25 +0000 Subject: [PATCH 49/73] --- doc/forum/Help_Windows_walkthrough.mdwn | 177 ++++++++++++++++++++++++ 1 file changed, 177 insertions(+) create mode 100644 doc/forum/Help_Windows_walkthrough.mdwn diff --git a/doc/forum/Help_Windows_walkthrough.mdwn b/doc/forum/Help_Windows_walkthrough.mdwn new file mode 100644 index 0000000000..dbe61b556b --- /dev/null +++ b/doc/forum/Help_Windows_walkthrough.mdwn @@ -0,0 +1,177 @@ +Hello, + +i am trying to run the walkthrough on Windows 7. When i try to get the contents of a file, i only get a some git annex text string and not the real file. Both repositories are on the same ntfs filesystem. + +C:\tmp>git annex version +git-annex version: 4.20130827-g4f18612 +build flags: Pairing Testsuite S3 WebDAV DNS +local repository version: 4 +default repository version: 3 +supported repository versions: 3 4 +upgrade supported from repository versions: 2 + +C:\tmp\server>git --version +git version 1.8.3.msysgit.0 + + +# walkthrough.bat + + doskey /history > commands.log + mkdir laptop + cd laptop + git init + git annex init laptop + cd .. + + git clone laptop server + cd server + git annex init server + git remote add laptop c:\tmp\laptop + + cd ..\laptop + git remote add server c:\tmp\server + copy ..\1.pdf . + git annex add 1.pdf + git commit -m add + dir + + cd ..\server + dir + git fetch laptop + git merge laptop/master + git annex get 1.pdf + dir + type 1.pdf + + +# walkthrough.log + + C:\tmp>walkthrough.bat + + C:\tmp>doskey /history 1>commands.log + + C:\tmp>mkdir laptop + + C:\tmp>cd laptop + + C:\tmp\laptop>git init + Initialized empty Git repository in C:/tmp/laptop/.git/ + + C:\tmp\laptop>git annex init laptop + init laptop + Detected a crippled filesystem. + + Enabling direct mode. + + Detected a filesystem without fifo support. + + Disabling ssh connection caching. + ok + (Recording state in git...) + + C:\tmp\laptop>cd .. + + C:\tmp>git clone laptop server + Cloning into 'server'... + done. + warning: remote HEAD refers to nonexistent ref, unable to checkout. + + + C:\tmp>cd server + + C:\tmp\server>git annex init server + init server + Detected a crippled filesystem. + + Enabling direct mode. + + Detected a filesystem without fifo support. + + Disabling ssh connection caching. + ok + (Recording state in git...) + + C:\tmp\server>git remote add laptop c:\tmp\laptop + + C:\tmp\server>cd ..\laptop + + C:\tmp\laptop>git remote add server c:\tmp\server + + C:\tmp\laptop>copy ..\1.pdf . + 1 file(s) copied. + + C:\tmp\laptop>git annex add 1.pdf + add 1.pdf (checksum...) ok + (Recording state in git...) + + C:\tmp\laptop>git commit -m add + [master (root-commit) 7ad1514] add + 1 file changed, 1 insertion(+) + create mode 120000 1.pdf + + C:\tmp\laptop>dir + Volume in drive C has no label. + Volume Serial Number is x + + Directory of C:\tmp\laptop + + 09/01/2013 11:03 AM . + 09/01/2013 11:03 AM .. + 08/30/2013 12:43 PM 37,500 1.pdf + 1 File(s) 37,500 bytes + 2 Dir(s) 7,698,817,024 bytes free + + C:\tmp\laptop>cd ..\server + + C:\tmp\server>dir + Volume in drive C has no label. + Volume Serial Number is x + + Directory of C:\tmp\server + + 09/01/2013 11:03 AM . + 09/01/2013 11:03 AM .. + 0 File(s) 0 bytes + 2 Dir(s) 7,698,817,024 bytes free + + C:\tmp\server>git fetch laptop + remote: Counting objects: 9, done. + remote: Compressing objects: 100% (6/6), done. + remote: Total 8 (delta 1), reused 0 (delta 0) + Unpacking objects: 100% (8/8), done. + From c:\tmp\laptop + * [new branch] git-annex -> laptop/git-annex + * [new branch] master -> laptop/master + + C:\tmp\server>git merge laptop/master + + C:\tmp\server>git annex get 1.pdf + get 1.pdf (merging laptop/git-annex origin/git-annex into git-annex...) + (Recording state in git...) + (from laptop...) + 1.pdf + 37500 100% 4.51MB/s 0:00:00 (xfer#1, to-check=0/1) + + sent 37573 bytes received 31 bytes 75208.00 bytes/sec + total size is 37500 speedup is 1.00 + ok + (Recording state in git...) + + C:\tmp\server>dir + Volume in drive C has no label. + Volume Serial Number is x + + Directory of C:\tmp\server + + 09/01/2013 11:03 AM . + 09/01/2013 11:03 AM .. + 09/01/2013 11:03 AM 194 1.pdf + 1 File(s) 194 bytes + 2 Dir(s) 7,698,767,872 bytes free + + C:\tmp\server>type 1.pdf + .git/annex/objects/kM/0q/SHA256E-s37500--32d8190c7e189d45f48245a100e4cc981ea1bbc + 02ac8bfa6188db73e41ce06f3.pdf/SHA256E-s37500--32d8190c7e189d45f48245a100e4cc981e + a1bbc02ac8bfa6188db73e41ce06f3.pdfC:\tmp\server> + C:\tmp\server> + From 6f0b67efe53fbf72b705d334722a5075de41c9a0 Mon Sep 17 00:00:00 2001 From: "Sandra.Devil" Date: Sun, 1 Sep 2013 09:38:32 +0000 Subject: [PATCH 50/73] Added a comment: New laptop --- .../comment_1_f3cc7a25af4c59fda3924c737a789419._comment | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 doc/devblog/day_-4__forgetting/comment_1_f3cc7a25af4c59fda3924c737a789419._comment diff --git a/doc/devblog/day_-4__forgetting/comment_1_f3cc7a25af4c59fda3924c737a789419._comment b/doc/devblog/day_-4__forgetting/comment_1_f3cc7a25af4c59fda3924c737a789419._comment new file mode 100644 index 0000000000..4c926c1afd --- /dev/null +++ b/doc/devblog/day_-4__forgetting/comment_1_f3cc7a25af4c59fda3924c737a789419._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="Sandra.Devil" + ip="77.172.73.184" + subject="New laptop" + date="2013-09-01T09:38:32Z" + content=""" +What is the new laptop you are going to use? Specs please :) +"""]] From df5f84b08a6a58fc86db51c101a166daa6c293e6 Mon Sep 17 00:00:00 2001 From: arand Date: Sun, 1 Sep 2013 18:06:52 +0000 Subject: [PATCH 51/73] Added a comment --- ..._f040e31b763fc9a7aa092442b4d6b8e8._comment | 20 +++++++++++++++++++ 1 file changed, 20 insertions(+) create mode 100644 doc/forum/howto_update_feed/comment_4_f040e31b763fc9a7aa092442b4d6b8e8._comment diff --git a/doc/forum/howto_update_feed/comment_4_f040e31b763fc9a7aa092442b4d6b8e8._comment b/doc/forum/howto_update_feed/comment_4_f040e31b763fc9a7aa092442b4d6b8e8._comment new file mode 100644 index 0000000000..f7a35d1b65 --- /dev/null +++ b/doc/forum/howto_update_feed/comment_4_f040e31b763fc9a7aa092442b4d6b8e8._comment @@ -0,0 +1,20 @@ +[[!comment format=mdwn + username="arand" + ip="130.243.226.21" + subject="comment 4" + date="2013-09-01T18:06:51Z" + content=""" +Yet another solution, keeping it all in one script + + #!/bin/sh + + while IFS= read line + do + test -n \"${line%%#*}\" && echo git annex importfeed --relaxed \"$line\" + done < Date: Sun, 1 Sep 2013 20:02:59 +0000 Subject: [PATCH 52/73] Added a comment --- .../comment_4_593235735e32238094121b1f79355bbd._comment | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 doc/bugs/git-annex_broken_on_Android_4.3/comment_4_593235735e32238094121b1f79355bbd._comment diff --git a/doc/bugs/git-annex_broken_on_Android_4.3/comment_4_593235735e32238094121b1f79355bbd._comment b/doc/bugs/git-annex_broken_on_Android_4.3/comment_4_593235735e32238094121b1f79355bbd._comment new file mode 100644 index 0000000000..ab721064a1 --- /dev/null +++ b/doc/bugs/git-annex_broken_on_Android_4.3/comment_4_593235735e32238094121b1f79355bbd._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawntVnR-Z5ghYInvsElbDeADPSuCsF18iTY" + nickname="Thomas" + subject="comment 4" + date="2013-09-01T20:02:59Z" + content=""" +Yet another confirmation of the bug on a Samsung Galaxy Note running 4.3 via Cyanogenmod as well. +"""]] From 6ca664fa9d2a386436aaa1b815553f699005bb55 Mon Sep 17 00:00:00 2001 From: "https://www.google.com/accounts/o8/id?id=AItOawk9nck8WX8-ADF3Fdh5vFo4Qrw1I_bJcR8" Date: Mon, 2 Sep 2013 10:41:52 +0000 Subject: [PATCH 53/73] --- ...sn__39__t_been_working_for_a_few_days.mdwn | 72 +++++++++++++++++++ 1 file changed, 72 insertions(+) create mode 100644 doc/forum/Box.com_hasn__39__t_been_working_for_a_few_days.mdwn diff --git a/doc/forum/Box.com_hasn__39__t_been_working_for_a_few_days.mdwn b/doc/forum/Box.com_hasn__39__t_been_working_for_a_few_days.mdwn new file mode 100644 index 0000000000..77b0928916 --- /dev/null +++ b/doc/forum/Box.com_hasn__39__t_been_working_for_a_few_days.mdwn @@ -0,0 +1,72 @@ +I've been experiencing problems with Box.com for a few days now and I don't know what's causing them. Is anyone else experiencing anything similar? + +I paste the log. + + [2013-09-02 12:27:26 CEST] TransferWatcher: transfer finishing: Transfer {transferDirection = Upload, transferUUID = UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9", transferKey = Key {keyName = "c9e1d5421e78924c21e3d68e84f80a8d1f64f9488020107ca0eeee0c4f10e763.py", keyBackendName = "SHA256E", keySize = Just 1891, keyMtime = Nothing}} + [2013-09-02 12:27:26 CEST] TransferScanner: queued Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/kgp/kant.xml Nothing : expensive scan found missing object + [2013-09-02 12:27:26 CEST] Transferrer: Transferring: Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/argecho.py Nothing + [2013-09-02 12:27:26 CEST] TransferWatcher: transfer starting: Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/argecho.py Nothing + [2013-09-02 12:27:26 CEST] TransferWatcher: transfer starting: Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/argecho.py Nothing + + + 100% 0.0 B/s 0s[2013-09-02 12:27:26 CEST] TransferWatcher: transfer starting: Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/argecho.py Just 437 + ResponseTimeout + ResponseTimeout + + + [2013-09-02 12:27:44 CEST] TransferWatcher: transfer finishing: Transfer {transferDirection = Upload, transferUUID = UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9", transferKey = Key {keyName = "dd3cc45d91430c6f7d68eb807f4ac1561cd0297b11a2de77b5fe66017d125798.py", keyBackendName = "SHA256E", keySize = Just 437, keyMtime = Nothing}} + [2013-09-02 12:27:44 CEST] TransferScanner: queued Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/kgp/kgp.dtd Nothing : expensive scan found missing object + [2013-09-02 12:27:44 CEST] Transferrer: Transferring: Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/autosize.py Nothing + [2013-09-02 12:27:44 CEST] TransferWatcher: transfer starting: Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/autosize.py Nothing + [2013-09-02 12:27:44 CEST] TransferWatcher: transfer starting: Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/autosize.py Nothing + + + 100% 0.0 B/s 0s[2013-09-02 12:27:44 CEST] TransferWatcher: transfer starting: Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/autosize.py Just 2861 + ResponseTimeout + ResponseTimeout + + + [2013-09-02 12:28:02 CEST] TransferWatcher: transfer finishing: Transfer {transferDirection = Upload, transferUUID = UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9", transferKey = Key {keyName = "d6b7940ac68768a8e37e72f248e2d94f19fb0d47062084d9baf0ec08cebbf692.py", keyBackendName = "SHA256E", keySize = Just 2861, keyMtime = Nothing}} + [2013-09-02 12:28:02 CEST] TransferScanner: queued Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/kgp/kgp.py Nothing : expensive scan found missing object + [2013-09-02 12:28:02 CEST] Transferrer: Transferring: Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/builddialectexamples.py Nothing + [2013-09-02 12:28:03 CEST] TransferWatcher: transfer starting: Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/builddialectexamples.py Nothing + [2013-09-02 12:28:03 CEST] TransferWatcher: transfer starting: Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/builddialectexamples.py Nothing + + + 100% 0.0 B/s 0s[2013-09-02 12:28:03 CEST] TransferWatcher: transfer starting: Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/builddialectexamples.py Just 1090 + ResponseTimeout + ResponseTimeout + + + [2013-09-02 12:28:21 CEST] TransferWatcher: transfer finishing: Transfer {transferDirection = Upload, transferUUID = UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9", transferKey = Key {keyName = "f1492b80d05b96cc7cf2904d461c99d430fa86a4eb1d99f1b155c9147ff4420f.py", keyBackendName = "SHA256E", keySize = Just 1090, keyMtime = Nothing}} + [2013-09-02 12:28:21 CEST] TransferScanner: queued Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/kgp/russiansample.xml Nothing : expensive scan found missing object + [2013-09-02 12:28:21 CEST] Transferrer: Transferring: Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/colorize.py Nothing + [2013-09-02 12:28:21 CEST] TransferWatcher: transfer starting: Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/colorize.py Nothing + [2013-09-02 12:28:21 CEST] TransferWatcher: transfer starting: Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/colorize.py Nothing + + + 100% 0.0 B/s 0s[2013-09-02 12:28:21 CEST] TransferWatcher: transfer starting: Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/colorize.py Just 4864 + ResponseTimeout + ResponseTimeout + + + [2013-09-02 12:28:40 CEST] TransferWatcher: transfer finishing: Transfer {transferDirection = Upload, transferUUID = UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9", transferKey = Key {keyName = "b577eaf8b6ddbf9fef866c455cae248aec3b22e3f2e91aa2b75ece90f1801689.py", keyBackendName = "SHA256E", keySize = Just 4864, keyMtime = Nothing}} + [2013-09-02 12:28:40 CEST] TransferScanner: queued Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/kgp/stderr.py Nothing : expensive scan found missing object + [2013-09-02 12:28:40 CEST] Transferrer: Transferring: Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/dialect.py Nothing + [2013-09-02 12:28:40 CEST] TransferWatcher: transfer starting: Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/dialect.py Nothing + [2013-09-02 12:28:40 CEST] TransferWatcher: transfer starting: Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/dialect.py Nothing + + + 100% 0.0 B/s 0s[2013-09-02 12:28:40 CEST] TransferWatcher: transfer starting: Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/dialect.py Just 4449 + ResponseTimeout + ResponseTimeout + + + [2013-09-02 12:28:58 CEST] TransferWatcher: transfer finishing: Transfer {transferDirection = Upload, transferUUID = UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9", transferKey = Key {keyName = "c5e5d9b1bee2710c7ed05270a363d3e93270b0fb6779c4c8d59ace06c11db684.py", keyBackendName = "SHA256E", keySize = Just 4449, keyMtime = Nothing}} + [2013-09-02 12:28:58 CEST] TransferScanner: queued Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/kgp/stdout.py Nothing : expensive scan found missing object + [2013-09-02 12:28:58 CEST] Transferrer: Transferring: Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/fibonacci.py Nothing + [2013-09-02 12:28:58 CEST] TransferWatcher: transfer starting: Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/fibonacci.py Nothing + [2013-09-02 12:28:58 CEST] TransferWatcher: transfer starting: Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/fibonacci.py Nothing + + + 100% 0.0 B/s 0s[2013-09-02 12:28:58 CEST] TransferWatcher: transfer starting: Upload UUID "72111b4c-28fe-42fd-a77b-e4cb9240a1c9" Documentos/diveintopython-5.4/py/fibonacci.py Just 532 From 307537a9a44011de53c9bfb33c10840500f86bc4 Mon Sep 17 00:00:00 2001 From: "http://sunny256.sunbase.org/" Date: Mon, 2 Sep 2013 11:47:00 +0000 Subject: [PATCH 54/73] Added a comment: It works here --- .../comment_1_6ca872c241399b9129cf9a18f42ebd43._comment | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 doc/forum/Box.com_hasn__39__t_been_working_for_a_few_days/comment_1_6ca872c241399b9129cf9a18f42ebd43._comment diff --git a/doc/forum/Box.com_hasn__39__t_been_working_for_a_few_days/comment_1_6ca872c241399b9129cf9a18f42ebd43._comment b/doc/forum/Box.com_hasn__39__t_been_working_for_a_few_days/comment_1_6ca872c241399b9129cf9a18f42ebd43._comment new file mode 100644 index 0000000000..2c7d98b49d --- /dev/null +++ b/doc/forum/Box.com_hasn__39__t_been_working_for_a_few_days/comment_1_6ca872c241399b9129cf9a18f42ebd43._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://sunny256.sunbase.org/" + nickname="sunny256" + subject="It works here" + date="2013-09-02T11:47:00Z" + content=""" +I set up a box.com remote a couple of months ago or so just for testing. Haven't used it that much, but I tested it now to see if it still works. No errors or problems. I have pasted the output from a session where I copied a file to box.com, dropped it locally, then got it back from box.com here: . The computer I ran the test on is using the newest git-annex binary (v4.20130827), Ubuntu 10.04.4 LTS. Pretty old distro, but it still works. +"""]] From a6b93284eba266a525dbaf3daf4f44e8a5742e61 Mon Sep 17 00:00:00 2001 From: "http://edheil.wordpress.com/" Date: Tue, 3 Sep 2013 14:38:51 +0000 Subject: [PATCH 55/73] Added a comment --- .../comment_5_f806fd5930e90920db24456297465bae._comment | 9 +++++++++ 1 file changed, 9 insertions(+) create mode 100644 doc/bugs/git-annex_broken_on_Android_4.3/comment_5_f806fd5930e90920db24456297465bae._comment diff --git a/doc/bugs/git-annex_broken_on_Android_4.3/comment_5_f806fd5930e90920db24456297465bae._comment b/doc/bugs/git-annex_broken_on_Android_4.3/comment_5_f806fd5930e90920db24456297465bae._comment new file mode 100644 index 0000000000..cfb75bdd89 --- /dev/null +++ b/doc/bugs/git-annex_broken_on_Android_4.3/comment_5_f806fd5930e90920db24456297465bae._comment @@ -0,0 +1,9 @@ +[[!comment format=mdwn + username="http://edheil.wordpress.com/" + ip="173.162.44.162" + subject="comment 5" + date="2013-09-03T14:38:51Z" + content=""" +If there's anything we can do to help debug this, please let us know. Have just started using git-annex on android recently & would love to have it on all my devices. + +"""]] From f536438ccce36bef6368e519ad7d25d9a9382cf3 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 3 Sep 2013 13:15:47 -0400 Subject: [PATCH 56/73] add core.sharedrepository setting --- .../setup_a_public_repository_on_a_web_site.mdwn | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/doc/tips/setup_a_public_repository_on_a_web_site.mdwn b/doc/tips/setup_a_public_repository_on_a_web_site.mdwn index 39b2912188..8251cabf6f 100644 --- a/doc/tips/setup_a_public_repository_on_a_web_site.mdwn +++ b/doc/tips/setup_a_public_repository_on_a_web_site.mdwn @@ -9,18 +9,20 @@ Here's how I set it up. --[[Joey]] 1. Set up a web site. I used Apache, and configured it to follow symlinks. `Options FollowSymLinks` 2. Put some files on the website. Make sure it works. -4. `git init; git annex init` -3. We want users to be able to clone the git repository over http, because +3. `git init; git annex init` +4. `git config core.sharedrepository world` (Makes sure files + are always added with permissions that allow everyone to read them.) +5. We want users to be able to clone the git repository over http, because git-annex can download files from it over http as well. For this to work, `git update-server-info` needs to get run after commits. The git `post-update` hook will take care of this, you just need to enable the hook. `chmod +x .git/hooks/post-update` -5. `git annex add; git commit -m added` -6. Make sure users can still download files from the site directly. -7. Instruct advanced users to clone a http url that ends with the "/.git/" +6. `git annex add; git commit -m added` +7. Make sure users can still download files from the site directly. +8. Instruct advanced users to clone a http url that ends with the "/.git/" directory. For example, for downloads.kitenet.net, the clone url is `https://downloads.kitenet.net/.git/` -8. Set up a git `post-receive` hook to update the repository's working tree +9. Set up a git `post-receive` hook to update the repository's working tree when changes are pushed to it. See below for details. When users clone over http, and run git-annex, it will From 67fda9e669440ebe51ba5bac82cd017057a719a7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 3 Sep 2013 13:35:49 -0400 Subject: [PATCH 57/73] Honor core.sharedrepository when receiving and adding files in direct mode. --- Annex/Content.hs | 13 +++++++++++++ debian/changelog | 2 ++ doc/bugs/400_mode_leakage.mdwn | 8 ++++++++ 3 files changed, 23 insertions(+) diff --git a/Annex/Content.hs b/Annex/Content.hs index 01ad6f96fd..25ee4c7db6 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -279,6 +279,7 @@ moveAnnex key src = withObjectLoc key storeobject storedirect then do updateInodeCache key src replaceFile f $ liftIO . moveFile src + chmodContent f forM_ fs $ addContentWhenNotPresent key f else ifM (goodContent key f) @@ -500,6 +501,18 @@ freezeContent file = unlessM crippledFileSystem $ removeModes writeModes . addModes [ownerReadMode] +{- Adjusts read mode of annexed file per core.sharedRepository setting. -} +chmodContent :: FilePath -> Annex () +chmodContent file = unlessM crippledFileSystem $ + liftIO . go =<< fromRepo getSharedRepository + where + go GroupShared = modifyFileMode file $ + addModes [ownerReadMode, groupReadMode] + go AllShared = modifyFileMode file $ + addModes readModes + go _ = modifyFileMode file $ + addModes [ownerReadMode] + {- Allows writing to an annexed file that freezeContent was called on - before. -} thawContent :: FilePath -> Annex () diff --git a/debian/changelog b/debian/changelog index 68ba98b8bb..98bfd9445e 100644 --- a/debian/changelog +++ b/debian/changelog @@ -25,6 +25,8 @@ git-annex (4.20130827) unstable; urgency=low * Debian: Run the builtin test suite as an autopkgtest. * Debian: Recommend ssh-askpass, which ssh will use when the assistant is run w/o a tty. Closes: #719832 + * Honor core.sharedrepository when receiving and adding files in direct + mode. -- Joey Hess Tue, 27 Aug 2013 11:03:00 -0400 diff --git a/doc/bugs/400_mode_leakage.mdwn b/doc/bugs/400_mode_leakage.mdwn index e0228a18a5..63f0fb11d2 100644 --- a/doc/bugs/400_mode_leakage.mdwn +++ b/doc/bugs/400_mode_leakage.mdwn @@ -15,3 +15,11 @@ files transit through a special remote, using modes to limit access to individual files is not wise.) --[[Joey]] + +> Revisiting this, git-annex already honors core.sharedrepository settings, +> so I just needed to set it to `world` to allow everyone to read. +> +> There was a code path in direct mode where that didn't work; fixed that. +> +> [[done]] +> --[[Joey]] From b26262f24e86535e75b0ed02fab399dfece6a7e8 Mon Sep 17 00:00:00 2001 From: "http://joeyh.name/" Date: Tue, 3 Sep 2013 17:59:03 +0000 Subject: [PATCH 58/73] Added a comment --- ...mment_1_5fc22393a1b28235eabb2871ad83d0a7._comment | 12 ++++++++++++ 1 file changed, 12 insertions(+) create mode 100644 doc/forum/Help_Windows_walkthrough/comment_1_5fc22393a1b28235eabb2871ad83d0a7._comment diff --git a/doc/forum/Help_Windows_walkthrough/comment_1_5fc22393a1b28235eabb2871ad83d0a7._comment b/doc/forum/Help_Windows_walkthrough/comment_1_5fc22393a1b28235eabb2871ad83d0a7._comment new file mode 100644 index 0000000000..95623a6454 --- /dev/null +++ b/doc/forum/Help_Windows_walkthrough/comment_1_5fc22393a1b28235eabb2871ad83d0a7._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="4.153.8.7" + subject="comment 1" + date="2013-09-03T17:59:03Z" + content=""" +The walkthrough assumes a system that uses indirect mode by default, so it won't work quite right on Windows, which is forced to use direct mode. + +Running `git annex fsck` in the server repository will fix up this situation, but the right thing on Windows is to use `git annex sync` rather than the manual `git fetch + git merge` the walkthrough shows. + +Guess I'll make the walkthrough use sync, although it may make it harder for people to understand what's going on internally. +"""]] From 4e6cf16117e496df67de442cadd6de6f4a87a41b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 3 Sep 2013 13:59:08 -0400 Subject: [PATCH 59/73] adjust walkthrough to also work on Windows (not fully tested on windows) --- doc/walkthrough/getting_file_content.mdwn | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/walkthrough/getting_file_content.mdwn b/doc/walkthrough/getting_file_content.mdwn index f41e17770a..f92704ff39 100644 --- a/doc/walkthrough/getting_file_content.mdwn +++ b/doc/walkthrough/getting_file_content.mdwn @@ -6,7 +6,7 @@ We can use this to copy everything in the laptop's annex to the USB drive. # cd /media/usb/annex - # git fetch laptop; git merge laptop/master + # git annex sync laptop # git annex get . get my_cool_big_file (from laptop...) ok get iso/debian.iso (from laptop...) ok From dcce96eec318ee4a659a9d767aaf0399513fd718 Mon Sep 17 00:00:00 2001 From: "http://joeyh.name/" Date: Tue, 3 Sep 2013 18:07:34 +0000 Subject: [PATCH 60/73] Added a comment: sorry for delay.. --- ...comment_5_8991648dda991768e3a58477a4c3c923._comment | 10 ++++++++++ 1 file changed, 10 insertions(+) create mode 100644 doc/news/version_4.20130827/comment_5_8991648dda991768e3a58477a4c3c923._comment diff --git a/doc/news/version_4.20130827/comment_5_8991648dda991768e3a58477a4c3c923._comment b/doc/news/version_4.20130827/comment_5_8991648dda991768e3a58477a4c3c923._comment new file mode 100644 index 0000000000..55fa6d10a6 --- /dev/null +++ b/doc/news/version_4.20130827/comment_5_8991648dda991768e3a58477a4c3c923._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="4.153.8.7" + subject="sorry for delay.." + date="2013-09-03T18:07:34Z" + content=""" +That's weird.. I have a post-update hook that runs git-update-server-info, but I reproduced the problem, and manually running that fixed it. + +Guess I will need to keep an eye on this at the next release to see if it was a one-off problem.. +"""]] From d1bacccff44124d8e491f866e923b5065436e798 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 3 Sep 2013 14:32:26 -0400 Subject: [PATCH 61/73] importfeed: Also ignore transient problems with downloading content from feeds. --- Command/ImportFeed.hs | 2 ++ debian/changelog | 11 +++++++++-- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs index 816865e8c6..662daacf33 100644 --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -52,6 +52,8 @@ perform relaxed cache url = do Just l | not (null l) -> do ok <- all id <$> mapM (downloadEnclosure relaxed cache) l + unless ok $ + feedProblem url "problem downloading item" next $ cleanup url ok _ -> do feedProblem url "bad feed content" diff --git a/debian/changelog b/debian/changelog index 98bfd9445e..59fdeff36f 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,12 @@ +git-annex (4.20130828) UNRELEASED; urgency=low + + * importfeed: Also ignore transient problems with downloading content + from feeds. + * Honor core.sharedrepository when receiving and adding files in direct + mode. + + -- Joey Hess Tue, 03 Sep 2013 14:31:45 -0400 + git-annex (4.20130827) unstable; urgency=low * Youtube support! (And 53 other video hosts). When quvi is installed, @@ -25,8 +34,6 @@ git-annex (4.20130827) unstable; urgency=low * Debian: Run the builtin test suite as an autopkgtest. * Debian: Recommend ssh-askpass, which ssh will use when the assistant is run w/o a tty. Closes: #719832 - * Honor core.sharedrepository when receiving and adding files in direct - mode. -- Joey Hess Tue, 27 Aug 2013 11:03:00 -0400 From b51dffa46d7901a152856609b3b12a943a3601df Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 3 Sep 2013 14:39:07 -0400 Subject: [PATCH 62/73] fix error propigating when unable to download feed item --- Command/ImportFeed.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs index 662daacf33..e455ebb63d 100644 --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -54,7 +54,7 @@ perform relaxed cache url = do <$> mapM (downloadEnclosure relaxed cache) l unless ok $ feedProblem url "problem downloading item" - next $ cleanup url ok + next $ cleanup url True _ -> do feedProblem url "bad feed content" next $ return True From 4079f9cfe890369ee7b6b72308645bd2cb02c238 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 3 Sep 2013 16:31:32 -0400 Subject: [PATCH 63/73] avoid double commit during transition The second commit had some bad refs which resulted in the race detection code running. But that commit was unnecessary anyway, it only was there to merge in the other refs. --- Annex/Branch.hs | 57 +++++++++++++++++++++-------------------------- Command/Forget.hs | 2 +- 2 files changed, 26 insertions(+), 33 deletions(-) diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 9ee281de9b..b8c9d02e48 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -162,17 +162,13 @@ updateTo pairs = do showSideAction merge_desc mergeIndex refs let commitrefs = nub $ fullname:refs - transitioned <- handleTransitions localtransitions commitrefs - case transitioned of - Nothing -> do - ff <- if dirty - then return False - else inRepo $ Git.Branch.fastForward fullname refs - if ff - then updateIndex branchref - else commitBranch branchref merge_desc commitrefs - Just (branchref', commitrefs') -> - commitBranch branchref' merge_desc commitrefs' + unlessM (handleTransitions localtransitions commitrefs) $ do + ff <- if dirty + then return False + else inRepo $ Git.Branch.fastForward fullname refs + if ff + then updateIndex branchref + else commitBranch branchref merge_desc commitrefs liftIO cleanjournal {- Gets the content of a file, which may be in the journal, or in the index @@ -251,7 +247,8 @@ commitBranch' branchref message parents = do committedref <- inRepo $ Git.Branch.commit message fullname parents setIndexSha committedref parentrefs <- commitparents <$> catObject committedref - when (racedetected branchref parentrefs) $ + when (racedetected branchref parentrefs) $ do + liftIO $ print ("race detected", branchref, parentrefs, "committing", (branchref, parents)) fixrace committedref parentrefs where -- look for "parent ref" lines and return the refs @@ -394,34 +391,33 @@ stageJournal = withIndex $ do {- This is run after the refs have been merged into the index, - but before the result is committed to the branch. - - Which is why it's passed the contents of the local branches's - - transition log before that merge took place. + - (Which is why it's passed the contents of the local branches's + - transition log before that merge took place.) - - When the refs contain transitions that have not yet been done locally, - the transitions are performed on the index, and a new branch - - is created from the result, and returned. + - is created from the result. - - When there are transitions recorded locally that have not been done - to the remote refs, the transitions are performed in the index, - - and the existing branch is returned. In this case, the untransitioned + - and committed to the existing branch. In this case, the untransitioned - remote refs cannot be merged into the branch (since transitions - - throw away history), so none of them are included in the returned - - list of refs, and they are added to the list of refs to ignore, + - throw away history), so they are added to the list of refs to ignore, - to avoid re-merging content from them again. -} -handleTransitions :: Transitions -> [Git.Ref] -> Annex (Maybe (Git.Branch, [Git.Ref])) +handleTransitions :: Transitions -> [Git.Ref] -> Annex Bool handleTransitions localts refs = do m <- M.fromList <$> mapM getreftransition refs let remotets = M.elems m if all (localts ==) remotets - then return Nothing + then return False else do let allts = combineTransitions (localts:remotets) let (transitionedrefs, untransitionedrefs) = partition (\r -> M.lookup r m == Just allts) refs - transitionedbranch <- performTransitions allts (localts /= allts) + performTransitions allts (localts /= allts) transitionedrefs ignoreRefs untransitionedrefs - return $ Just (transitionedbranch, transitionedrefs) + return True where getreftransition ref = do ts <- parseTransitionsStrictly "remote" . L.unpack @@ -444,10 +440,9 @@ getIgnoredRefs = S.fromList . mapMaybe Git.Sha.extractSha . lines <$> content liftIO $ catchDefaultIO "" $ readFile f {- Performs the specified transitions on the contents of the index file, - - commits it to the branch, or creates a new branch, and returns - - the branch's ref. -} -performTransitions :: Transitions -> Bool -> Annex Git.Ref -performTransitions ts neednewbranch = do + - commits it to the branch, or creates a new branch. -} +performTransitions :: Transitions -> Bool -> [Ref] -> Annex () +performTransitions ts neednewlocalbranch transitionedrefs = do -- For simplicity & speed, we're going to use the Annex.Queue to -- update the git-annex branch, while it usually holds changes -- for the head branch. Flush any such changes. @@ -455,18 +450,16 @@ performTransitions ts neednewbranch = do withIndex $ do run $ mapMaybe getTransitionCalculator $ transitionList ts Annex.Queue.flush - if neednewbranch + if neednewlocalbranch then do - committedref <- inRepo $ Git.Branch.commit message fullname [] + committedref <- inRepo $ Git.Branch.commit message fullname transitionedrefs setIndexSha committedref - return committedref else do ref <- getBranch - commitBranch ref message [fullname] - getBranch + commitBranch ref message (nub $ fullname:transitionedrefs) where message - | neednewbranch = "new branch for transition " ++ tdesc + | neednewlocalbranch && null transitionedrefs = "new branch for transition " ++ tdesc | otherwise = "continuing transition " ++ tdesc tdesc = show $ map describeTransition $ transitionList ts diff --git a/Command/Forget.hs b/Command/Forget.hs index d216ae3ca4..74bd68ad1d 100644 --- a/Command/Forget.hs +++ b/Command/Forget.hs @@ -45,7 +45,7 @@ perform ts True = do recordTransitions Branch.change ts -- get branch committed before contining with the transition Branch.update - void $ Branch.performTransitions ts True + void $ Branch.performTransitions ts True [] next $ return True perform _ False = do showLongNote "To forget git-annex branch history, you must specify --force. This deletes metadata!" From 34d505ed4056bb5adbf5abb0a45305b6af7c1347 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 3 Sep 2013 16:53:31 -0400 Subject: [PATCH 64/73] blog for the day --- doc/devblog/day_-1__inauspicious_beginning.mdwn | 11 +++++++++++ 1 file changed, 11 insertions(+) create mode 100644 doc/devblog/day_-1__inauspicious_beginning.mdwn diff --git a/doc/devblog/day_-1__inauspicious_beginning.mdwn b/doc/devblog/day_-1__inauspicious_beginning.mdwn new file mode 100644 index 0000000000..b14f763bbe --- /dev/null +++ b/doc/devblog/day_-1__inauspicious_beginning.mdwn @@ -0,0 +1,11 @@ +I try hard to keep this devblog about git-annex development and not me. +However, it is a shame that what I wanted to be the beginning of my first +real month of work funded by the new campaign has been marred by my home's +internet connection being taken out by a lightning strike, and by illness. +Nearly back on my feet after that, and waiting for my new laptop to +finally get here. + +Today's work: Finished up the `git annex forget` feature and merged it in. +Fixed the bug that was causing the commit race detection code to +incorrectly fire on the commit made by the transition code. Few other bits +and pieces. From e13d7c3cea1959616b13439261ae3a96a4d8fb37 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 3 Sep 2013 16:59:33 -0400 Subject: [PATCH 65/73] fix number --- ...spicious_beginning.mdwn => day_1__inauspicious_beginning.mdwn} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename doc/devblog/{day_-1__inauspicious_beginning.mdwn => day_1__inauspicious_beginning.mdwn} (100%) diff --git a/doc/devblog/day_-1__inauspicious_beginning.mdwn b/doc/devblog/day_1__inauspicious_beginning.mdwn similarity index 100% rename from doc/devblog/day_-1__inauspicious_beginning.mdwn rename to doc/devblog/day_1__inauspicious_beginning.mdwn From 1b75cade1bc1d057a9652560a9fa21091f9476c7 Mon Sep 17 00:00:00 2001 From: "http://a-or-b.myopenid.com/" Date: Wed, 4 Sep 2013 01:36:47 +0000 Subject: [PATCH 66/73] Added a comment --- ..._1_ce06ba4f65f322362b23797f6190c7c3._comment | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) create mode 100644 doc/bugs/version_doesn__39__t_show___34__Feeds__34___but_podcasting_feature_working/comment_1_ce06ba4f65f322362b23797f6190c7c3._comment diff --git a/doc/bugs/version_doesn__39__t_show___34__Feeds__34___but_podcasting_feature_working/comment_1_ce06ba4f65f322362b23797f6190c7c3._comment b/doc/bugs/version_doesn__39__t_show___34__Feeds__34___but_podcasting_feature_working/comment_1_ce06ba4f65f322362b23797f6190c7c3._comment new file mode 100644 index 0000000000..8b156f8228 --- /dev/null +++ b/doc/bugs/version_doesn__39__t_show___34__Feeds__34___but_podcasting_feature_working/comment_1_ce06ba4f65f322362b23797f6190c7c3._comment @@ -0,0 +1,17 @@ +[[!comment format=mdwn + username="http://a-or-b.myopenid.com/" + ip="203.45.2.230" + subject="comment 1" + date="2013-09-04T01:36:46Z" + content=""" +This still is not fixed. :-( + + $ git annex version + git-annex version: 4.20130827 + build flags: Assistant Webapp Pairing Testsuite S3 WebDAV FsEvents XMPP DNS + + +...but the ```importfeed``` functionality works. + +I know this isn't a particularly high priority bug... +"""]] From 480ecb379c6b16fc2c792118881dcb4aec5fc032 Mon Sep 17 00:00:00 2001 From: RaspberryPie Date: Wed, 4 Sep 2013 03:58:37 +0000 Subject: [PATCH 67/73] Added a comment: git-annex assistant for the Raspberry Pi --- ...omment_18_1efa0c7a963ec452fc6336fbe4964f6e._comment | 10 ++++++++++ 1 file changed, 10 insertions(+) create mode 100644 doc/install/cabal/comment_18_1efa0c7a963ec452fc6336fbe4964f6e._comment diff --git a/doc/install/cabal/comment_18_1efa0c7a963ec452fc6336fbe4964f6e._comment b/doc/install/cabal/comment_18_1efa0c7a963ec452fc6336fbe4964f6e._comment new file mode 100644 index 0000000000..e3a523e228 --- /dev/null +++ b/doc/install/cabal/comment_18_1efa0c7a963ec452fc6336fbe4964f6e._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="RaspberryPie" + ip="96.47.226.20" + subject="git-annex assistant for the Raspberry Pi" + date="2013-09-04T03:58:37Z" + content=""" +It took a while and a few tries, but I finally built the git-annex binary including the assistant on a Raspberry Pi. The build comes without the flags webapp, webdav, and dbus as these rely on a Template Haskell compiler that hasn't been ported to Arm architecture yet. + +I put the binary up on Github in case anyone's interested: +"""]] From 1aae962ac5fffbda78de03efa9bf8c9c8ec543bd Mon Sep 17 00:00:00 2001 From: "http://joeyh.name/" Date: Wed, 4 Sep 2013 06:36:16 +0000 Subject: [PATCH 68/73] Added a comment --- .../comment_3_6a1e7a83d94394454fc085f6d2728cd7._comment | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 doc/forum/Pruning_out_unwanted_Git_objects/comment_3_6a1e7a83d94394454fc085f6d2728cd7._comment diff --git a/doc/forum/Pruning_out_unwanted_Git_objects/comment_3_6a1e7a83d94394454fc085f6d2728cd7._comment b/doc/forum/Pruning_out_unwanted_Git_objects/comment_3_6a1e7a83d94394454fc085f6d2728cd7._comment new file mode 100644 index 0000000000..90951961f3 --- /dev/null +++ b/doc/forum/Pruning_out_unwanted_Git_objects/comment_3_6a1e7a83d94394454fc085f6d2728cd7._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="2001:4830:1600:187::2" + subject="comment 3" + date="2013-09-04T06:36:15Z" + content=""" +`git annex forget` automates this now. Needs a version of git-annex supporting it installed on *all* the computers you use the repo on. +"""]] From 2bec72419166aeea097ea88a32f813aa8d719434 Mon Sep 17 00:00:00 2001 From: "http://joeyh.name/" Date: Wed, 4 Sep 2013 06:38:01 +0000 Subject: [PATCH 69/73] Added a comment --- .../comment_12_47794a2abf29bf4ea2763ff89d872ab4._comment | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 doc/forum/safely_dropping_git-annex_history/comment_12_47794a2abf29bf4ea2763ff89d872ab4._comment diff --git a/doc/forum/safely_dropping_git-annex_history/comment_12_47794a2abf29bf4ea2763ff89d872ab4._comment b/doc/forum/safely_dropping_git-annex_history/comment_12_47794a2abf29bf4ea2763ff89d872ab4._comment new file mode 100644 index 0000000000..5c09316041 --- /dev/null +++ b/doc/forum/safely_dropping_git-annex_history/comment_12_47794a2abf29bf4ea2763ff89d872ab4._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="2001:4830:1600:187::2" + subject="comment 12" + date="2013-09-04T06:38:00Z" + content=""" +`git annex forget` automates this now, without needing to force-push or have a flag day. Needs a version of git-annex supporting it installed on *all* the computers you use the repo on. Repos notice they need to forget when git annex is run in them, and do, automatically. +"""]] From 45c23e2fc40cbfa35b5e85d5d228420c04bbed26 Mon Sep 17 00:00:00 2001 From: "http://joeyh.name/" Date: Wed, 4 Sep 2013 06:43:26 +0000 Subject: [PATCH 70/73] Added a comment --- ...mment_2_33c429ffa7e9e2ed9c5fac760ee8e82c._comment | 12 ++++++++++++ 1 file changed, 12 insertions(+) create mode 100644 doc/forum/How_to_delete_a_remote__63__/comment_2_33c429ffa7e9e2ed9c5fac760ee8e82c._comment diff --git a/doc/forum/How_to_delete_a_remote__63__/comment_2_33c429ffa7e9e2ed9c5fac760ee8e82c._comment b/doc/forum/How_to_delete_a_remote__63__/comment_2_33c429ffa7e9e2ed9c5fac760ee8e82c._comment new file mode 100644 index 0000000000..2866710c8b --- /dev/null +++ b/doc/forum/How_to_delete_a_remote__63__/comment_2_33c429ffa7e9e2ed9c5fac760ee8e82c._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="2001:4830:1600:187::2" + subject="comment 2" + date="2013-09-04T06:43:26Z" + content=""" +Recently git-annex has gotten the ability to do this: `git annex forget --drop-dead` + +That prunes all history relating to all dead remotes. You need to be running a git-annex that supports this on all computers you use the repos on, or the pruned history will get merged back in. + +I don't recommend doing this just because you want to \"clean history\". Think of it as something you can do at some point in the future if the .git/objects somehow gets too large or too slow. Put off deleting data until tomorrow if you don't absolutely need to do it today. +"""]] From d88d4953f8e942fc18ac4ccdb912d8bd0fa53078 Mon Sep 17 00:00:00 2001 From: "http://joeyh.name/" Date: Wed, 4 Sep 2013 06:44:43 +0000 Subject: [PATCH 71/73] Added a comment --- ...comment_4_477e3c213c5a5d4a33afd42a5b94c718._comment | 10 ++++++++++ 1 file changed, 10 insertions(+) create mode 100644 doc/forum/Truly_purging_dead_repositories/comment_4_477e3c213c5a5d4a33afd42a5b94c718._comment diff --git a/doc/forum/Truly_purging_dead_repositories/comment_4_477e3c213c5a5d4a33afd42a5b94c718._comment b/doc/forum/Truly_purging_dead_repositories/comment_4_477e3c213c5a5d4a33afd42a5b94c718._comment new file mode 100644 index 0000000000..3f39803b24 --- /dev/null +++ b/doc/forum/Truly_purging_dead_repositories/comment_4_477e3c213c5a5d4a33afd42a5b94c718._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="2001:4830:1600:187::2" + subject="comment 4" + date="2013-09-04T06:44:42Z" + content=""" +Status no longer shows dead repositories. + +See also, answer here: +"""]] From d2da95f372089edabd196f5c0211cc50dcc0793b Mon Sep 17 00:00:00 2001 From: konubinix Date: Wed, 4 Sep 2013 07:40:23 +0000 Subject: [PATCH 72/73] Added a comment: Dropping dead repositories --- ...ent_3_e9c5508092ca2983f458b16bf1e07082._comment | 14 ++++++++++++++ 1 file changed, 14 insertions(+) create mode 100644 doc/forum/How_to_delete_a_remote__63__/comment_3_e9c5508092ca2983f458b16bf1e07082._comment diff --git a/doc/forum/How_to_delete_a_remote__63__/comment_3_e9c5508092ca2983f458b16bf1e07082._comment b/doc/forum/How_to_delete_a_remote__63__/comment_3_e9c5508092ca2983f458b16bf1e07082._comment new file mode 100644 index 0000000000..337ef2efe1 --- /dev/null +++ b/doc/forum/How_to_delete_a_remote__63__/comment_3_e9c5508092ca2983f458b16bf1e07082._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="konubinix" + ip="82.243.233.186" + subject="Dropping dead repositories" + date="2013-09-04T07:40:22Z" + content=""" +Actually, it may be a good idea to remove repositories made for tests purposes. + +I now have 2 dead repositories that are USB_test1 and USB_test2 that I created before knowing I could reuse the annex uuid. + +They are now there and it is difficult to remove them. + +For that special case, the --drop-dead feature is very welcome. +"""]] From 3f2bb8b028b8221940e59591ae806baa67090696 Mon Sep 17 00:00:00 2001 From: rjc Date: Wed, 4 Sep 2013 21:42:52 +0000 Subject: [PATCH 73/73] Added a comment: laptop --- ...comment_1_cc4dea43caf3126c6f814b589b701d70._comment | 10 ++++++++++ 1 file changed, 10 insertions(+) create mode 100644 doc/devblog/day_1__inauspicious_beginning/comment_1_cc4dea43caf3126c6f814b589b701d70._comment diff --git a/doc/devblog/day_1__inauspicious_beginning/comment_1_cc4dea43caf3126c6f814b589b701d70._comment b/doc/devblog/day_1__inauspicious_beginning/comment_1_cc4dea43caf3126c6f814b589b701d70._comment new file mode 100644 index 0000000000..03e3fec6d6 --- /dev/null +++ b/doc/devblog/day_1__inauspicious_beginning/comment_1_cc4dea43caf3126c6f814b589b701d70._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="rjc" + ip="86.22.66.200" + subject="laptop" + date="2013-09-04T21:42:52Z" + content=""" +Are you retiring your Dell mini? + +What kind of laptop are you getting? +"""]]