diff --git a/Annex.hs b/Annex.hs index 87a06615e6..f3f2a91779 100644 --- a/Annex.hs +++ b/Annex.hs @@ -58,6 +58,7 @@ import Types.UUID import Types.FileMatcher import Types.NumCopies import Types.LockPool +import Types.MetaData import qualified Utility.Matcher import qualified Data.Map as M import qualified Data.Set as S @@ -109,6 +110,7 @@ data AnnexState = AnnexState , lockpool :: LockPool , flags :: M.Map String Bool , fields :: M.Map String String + , modmeta :: [ModMeta] , cleanup :: M.Map String (Annex ()) , inodeschanged :: Maybe Bool , useragent :: Maybe String @@ -146,6 +148,7 @@ newState c r = AnnexState , lockpool = M.empty , flags = M.empty , fields = M.empty + , modmeta = [] , cleanup = M.empty , inodeschanged = Nothing , useragent = Nothing diff --git a/Annex/Branch.hs b/Annex/Branch.hs index ee3cd71e28..94c4c029c4 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -5,8 +5,6 @@ - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE CPP #-} - module Annex.Branch ( fullname, name, @@ -30,11 +28,11 @@ module Annex.Branch ( import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.Set as S import qualified Data.Map as M -import qualified Control.Exception as E import Common.Annex import Annex.BranchState import Annex.Journal +import Annex.Index import qualified Git import qualified Git.Command import qualified Git.Ref @@ -47,15 +45,12 @@ import Git.Types import Git.FilePath 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 -import Annex.Exception {- Name of the branch that is used to store git-annex's information. -} name :: Git.Ref @@ -63,11 +58,11 @@ name = Git.Ref "git-annex" {- Fully qualified name of the branch. -} fullname :: Git.Ref -fullname = Git.Ref $ "refs/heads/" ++ show name +fullname = Git.Ref $ "refs/heads/" ++ fromRef name {- Branch's name in origin. -} originname :: Git.Ref -originname = Git.Ref $ "origin/" ++ show name +originname = Git.Ref $ "origin/" ++ fromRef name {- Does origin/git-annex exist? -} hasOrigin :: Annex Bool @@ -92,8 +87,8 @@ getBranch = maybe (hasOrigin >>= go >>= use) return =<< branchsha where go True = do inRepo $ Git.Command.run - [Param "branch", Param $ show name, Param $ show originname] - fromMaybe (error $ "failed to create " ++ show name) + [Param "branch", Param $ fromRef name, Param $ fromRef originname] + fromMaybe (error $ "failed to create " ++ fromRef name) <$> branchsha go False = withIndex' True $ inRepo $ Git.Branch.commitAlways "branch created" fullname [] @@ -159,7 +154,7 @@ updateTo pairs = do then "update" else "merging " ++ unwords (map Git.Ref.describe branches) ++ - " into " ++ show name + " into " ++ fromRef name localtransitions <- parseTransitionsStrictly "local" <$> getLocal transitionsLog unless (null branches) $ do @@ -296,7 +291,7 @@ files = do branchFiles :: Annex [FilePath] branchFiles = withIndex $ inRepo $ Git.Command.pipeNullSplitZombie [ Params "ls-tree --name-only -r -z" - , Param $ show fullname + , Param $ fromRef fullname ] {- Populates the branch's index file with the current branch contents. @@ -338,32 +333,12 @@ withIndex = withIndex' False withIndex' :: Bool -> Annex a -> Annex a withIndex' bootstrapping a = do f <- fromRepo gitAnnexIndex - g <- gitRepo -#ifdef __ANDROID__ - {- This should not be necessary on Android, but there is some - - weird getEnvironment breakage. See - - https://github.com/neurocyte/ghc-android/issues/7 - - Use getEnv to get some key environment variables that - - git expects to have. -} - let keyenv = words "USER PATH GIT_EXEC_PATH HOSTNAME HOME" - let getEnvPair k = maybe Nothing (\v -> Just (k, v)) <$> getEnv k - e <- liftIO $ catMaybes <$> forM keyenv getEnvPair - let e' = ("GIT_INDEX_FILE", f):e -#else - e <- liftIO getEnvironment - let e' = addEntry "GIT_INDEX_FILE" f e -#endif - let g' = g { gitEnv = Just e' } - - r <- tryAnnex $ do - Annex.changeState $ \s -> s { Annex.repo = g' } + withIndexFile f $ do checkIndexOnce $ unlessM (liftIO $ doesFileExist f) $ do unless bootstrapping create createAnnexDirectory $ takeDirectory f unless bootstrapping $ inRepo genIndex a - Annex.changeState $ \s -> s { Annex.repo = (Annex.repo s) { gitEnv = gitEnv g} } - either E.throw return r {- Updates the branch's index to reflect the current contents of the branch. - Any changes staged in the index will be preserved. @@ -393,7 +368,7 @@ needUpdateIndex branchref = do setIndexSha :: Git.Ref -> Annex () setIndexSha ref = do f <- fromRepo gitAnnexIndexStatus - liftIO $ writeFile f $ show ref ++ "\n" + liftIO $ writeFile f $ fromRef ref ++ "\n" setAnnexFilePerm f {- Stages the journal into the index and returns an action that will @@ -467,7 +442,7 @@ ignoreRefs rs = do let s = S.unions [old, S.fromList rs] f <- fromRepo gitAnnexIgnoredRefs replaceFile f $ \tmp -> liftIO $ writeFile tmp $ - unlines $ map show $ S.elems s + unlines $ map fromRef $ S.elems s getIgnoredRefs :: Annex (S.Set Git.Ref) getIgnoredRefs = S.fromList . mapMaybe Git.Sha.extractSha . lines <$> content diff --git a/Annex/Branch/Transitions.hs b/Annex/Branch/Transitions.hs index 95d47257a3..42c61d96a6 100644 --- a/Annex/Branch/Transitions.hs +++ b/Annex/Branch/Transitions.hs @@ -41,7 +41,7 @@ dropDead f content trustmap = case getLogVariety f of in if null newlog then RemoveFile else ChangeFile $ Presence.showLog newlog - Just SingleValueLog -> PreserveFile + Just OtherLog -> PreserveFile Nothing -> PreserveFile dropDeadFromUUIDBasedLog :: TrustMap -> UUIDBased.Log String -> UUIDBased.Log String diff --git a/Annex/Content.hs b/Annex/Content.hs index 6aef77830e..bffef19f4a 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -243,10 +243,9 @@ finishGetViaTmp check key action = do moveAnnex key tmpfile logStatus key InfoPresent return True - , do - -- the tmp file is left behind, in case caller wants - -- to resume its transfer - return False + -- the tmp file is left behind, in case caller wants + -- to resume its transfer + , return False ) prepTmp :: Key -> Annex FilePath @@ -492,9 +491,11 @@ getKeysPresent = do {- In indirect mode, look for the key. In direct mode, - the inode cache file is only present when a key's content - - is present. -} + - is present, so can be used as a surrogate if the content + - is not located in the annex directory. -} present False d = doesFileExist $ contentfile d - present True d = doesFileExist $ contentfile d ++ ".cache" + present True d = doesFileExist (contentfile d ++ ".cache") + <||> present False d contentfile d = d takeFileName d {- Things to do to record changes to content when shutting down. diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs index b60ab9b1b3..7a4fba4559 100644 --- a/Annex/Content/Direct.hs +++ b/Annex/Content/Direct.hs @@ -66,7 +66,7 @@ changeAssociatedFiles key transform = do mapping <- calcRepo $ gitAnnexMapping key files <- associatedFilesRelative key let files' = transform files - when (files /= files') $ do + when (files /= files') $ modifyContent mapping $ liftIO $ viaTmp writeFileAnyEncoding mapping $ unlines files' diff --git a/Annex/Direct.hs b/Annex/Direct.hs index 340c5c4756..4a23fcc6ca 100644 --- a/Annex/Direct.hs +++ b/Annex/Direct.hs @@ -184,7 +184,7 @@ mergeDirectCleanup d oldsha newsha = do tryAnnex . maybe (araw f item) (\k -> void $ a k f) =<< catKey (getsha item) (getmode item) - moveout k f = removeDirect k f + moveout = removeDirect {- Files deleted by the merge are removed from the work tree. - Empty work tree directories are removed, per git behavior. -} @@ -286,18 +286,18 @@ setDirect wantdirect = do - this way things that show HEAD (eg shell prompts) will - hopefully show just "master". -} directBranch :: Ref -> Ref -directBranch orighead = case split "/" $ show orighead of +directBranch orighead = case split "/" $ fromRef orighead of ("refs":"heads":"annex":"direct":_) -> orighead ("refs":"heads":rest) -> Ref $ "refs/heads/annex/direct/" ++ intercalate "/" rest - _ -> Ref $ "refs/heads/" ++ show (Git.Ref.base orighead) + _ -> Ref $ "refs/heads/" ++ fromRef (Git.Ref.base orighead) {- Converts a directBranch back to the original branch. - - Any other ref is left unchanged. -} fromDirectBranch :: Ref -> Ref -fromDirectBranch directhead = case split "/" $ show directhead of +fromDirectBranch directhead = case split "/" $ fromRef directhead of ("refs":"heads":"annex":"direct":rest) -> Ref $ "refs/heads/" ++ intercalate "/" rest _ -> directhead diff --git a/Annex/FileMatcher.hs b/Annex/FileMatcher.hs index 158f3e787b..7507952803 100644 --- a/Annex/FileMatcher.hs +++ b/Annex/FileMatcher.hs @@ -43,7 +43,7 @@ checkMatcher matcher mkey afile notpresent def fileMatchInfo :: FilePath -> Annex MatchInfo fileMatchInfo file = do matchfile <- getTopFilePath <$> inRepo (toTopFilePath file) - return $ MatchingFile $ FileInfo + return $ MatchingFile FileInfo { matchFile = matchfile , relFile = file } @@ -83,6 +83,7 @@ parseToken checkpresent checkpreferreddir groupmap t , ("inbackend", limitInBackend) , ("largerthan", limitSize (>)) , ("smallerthan", limitSize (<)) + , ("metadata", limitMetaData) , ("inallgroup", limitInAllGroup groupmap) ] where diff --git a/Annex/Index.hs b/Annex/Index.hs new file mode 100644 index 0000000000..a1b2442fc2 --- /dev/null +++ b/Annex/Index.hs @@ -0,0 +1,46 @@ +{- Using other git index files + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Annex.Index ( + withIndexFile, +) where + +import qualified Control.Exception as E + +import Common.Annex +import Git.Types +import qualified Annex +import Utility.Env +import Annex.Exception + +{- Runs an action using a different git index file. -} +withIndexFile :: FilePath -> Annex a -> Annex a +withIndexFile f a = do + g <- gitRepo +#ifdef __ANDROID__ + {- This should not be necessary on Android, but there is some + - weird getEnvironment breakage. See + - https://github.com/neurocyte/ghc-android/issues/7 + - Use getEnv to get some key environment variables that + - git expects to have. -} + let keyenv = words "USER PATH GIT_EXEC_PATH HOSTNAME HOME" + let getEnvPair k = maybe Nothing (\v -> Just (k, v)) <$> getEnv k + e <- liftIO $ catMaybes <$> forM keyenv getEnvPair + let e' = ("GIT_INDEX_FILE", f):e +#else + e <- liftIO getEnvironment + let e' = addEntry "GIT_INDEX_FILE" f e +#endif + let g' = g { gitEnv = Just e' } + + r <- tryAnnex $ do + Annex.changeState $ \s -> s { Annex.repo = g' } + a + Annex.changeState $ \s -> s { Annex.repo = (Annex.repo s) { gitEnv = gitEnv g} } + either E.throw return r diff --git a/Annex/Init.hs b/Annex/Init.hs index 616bda69b5..43f24031c5 100644 --- a/Annex/Init.hs +++ b/Annex/Init.hs @@ -70,11 +70,10 @@ initialize mdescription = do ( do enableDirectMode setDirect True - , do - -- Handle case where this repo was cloned from a - -- direct mode repo. - unlessM isBare - switchHEADBack + -- Handle case where this repo was cloned from a + -- direct mode repo + , unlessM isBare + switchHEADBack ) createInodeSentinalFile u <- getUUID @@ -227,7 +226,7 @@ fixBadBare = whenM checkBadBare $ do logStatus k InfoPresent let dotgit = d ".git" liftIO $ removeDirectoryRecursive dotgit - `catchIO` (const $ renameDirectory dotgit (d "removeme")) + `catchIO` const (renameDirectory dotgit (d "removeme")) {- A repostory with the problem won't know it's a bare repository, but will - have no pre-commit hook (which is not set up in a bare repository), diff --git a/Annex/Link.hs b/Annex/Link.hs index 234e4cb2a8..26991e9118 100644 --- a/Annex/Link.hs +++ b/Annex/Link.hs @@ -94,6 +94,10 @@ hashSymlink :: LinkTarget -> Annex Sha hashSymlink linktarget = inRepo $ Git.HashObject.hashObject BlobObject $ toInternalGitPath linktarget +hashSymlink' :: Git.HashObject.HashObjectHandle -> LinkTarget -> Annex Sha +hashSymlink' h linktarget = liftIO $ Git.HashObject.hashBlob h $ + toInternalGitPath linktarget + {- Stages a symlink to the annex, using a Sha of its target. -} stageSymlink :: FilePath -> Sha -> Annex () stageSymlink file sha = diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs index 8553ee797d..aedf418f87 100644 --- a/Annex/Ssh.hs +++ b/Annex/Ssh.hs @@ -76,7 +76,7 @@ bestSocketPath abssocketfile = do -- ssh appends a 16 char extension to the socket when setting it -- up, which needs to be taken into account when checking -- that a valid socket was constructed. - sshgarbage = take (1+16) $ repeat 'X' + sshgarbage = replicate (1+16) 'X' sshConnectionCachingParams :: FilePath -> [CommandParam] sshConnectionCachingParams socketfile = diff --git a/Annex/TaggedPush.hs b/Annex/TaggedPush.hs index 039dc0e173..35fdf333c4 100644 --- a/Annex/TaggedPush.hs +++ b/Annex/TaggedPush.hs @@ -35,11 +35,11 @@ toTaggedBranch u info b = Git.Ref $ intercalate "/" $ catMaybes [ Just "refs/synced" , Just $ fromUUID u , toB64 <$> info - , Just $ show $ Git.Ref.base b + , Just $ Git.fromRef $ Git.Ref.base b ] fromTaggedBranch :: Git.Branch -> Maybe (UUID, Maybe String) -fromTaggedBranch b = case split "/" $ show b of +fromTaggedBranch b = case split "/" $ Git.fromRef b of ("refs":"synced":u:info:_base) -> Just (toUUID u, fromB64Maybe info) ("refs":"synced":u:_base) -> @@ -58,4 +58,4 @@ taggedPush u info branch remote = Git.Command.runBool , Param $ refspec branch ] where - refspec b = show b ++ ":" ++ show (toTaggedBranch u info b) + refspec b = Git.fromRef b ++ ":" ++ Git.fromRef (toTaggedBranch u info b) diff --git a/Annex/View.hs b/Annex/View.hs new file mode 100644 index 0000000000..78b4da589a --- /dev/null +++ b/Annex/View.hs @@ -0,0 +1,429 @@ +{- metadata based branch views + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Annex.View where + +import Common.Annex +import Types.View +import Types.MetaData +import qualified Git +import qualified Git.DiffTree as DiffTree +import qualified Git.Branch +import qualified Git.LsFiles +import qualified Git.Ref +import Git.UpdateIndex +import Git.Sha +import Git.HashObject +import Git.Types +import Git.FilePath +import qualified Backend +import Annex.Index +import Annex.Link +import Annex.CatFile +import Logs.MetaData +import Logs.View +import Utility.FileMode +import Types.Command +import Config +import CmdLine.Action + +import qualified Data.Set as S +import System.Path.WildMatch +import "mtl" Control.Monad.Writer + +#ifdef WITH_TDFA +import Text.Regex.TDFA +import Text.Regex.TDFA.String +#else +import Text.Regex +#endif + +{- Each visible ViewFilter in a view results in another level of + - subdirectory nesting. When a file matches multiple ways, it will appear + - in multiple subdirectories. This means there is a bit of an exponential + - blowup with a single file appearing in a crazy number of places! + - + - Capping the view size to 5 is reasonable; why wants to dig + - through 5+ levels of subdirectories to find anything? + -} +viewTooLarge :: View -> Bool +viewTooLarge view = visibleViewSize view > 5 + +visibleViewSize :: View -> Int +visibleViewSize = length . filter viewVisible . viewComponents + +data ViewChange = Unchanged | Narrowing | Widening + deriving (Ord, Eq, Show) + +{- Updates a view, adding new fields to filter on (Narrowing), + - or allowing new values in an existing field (Widening). -} +refineView :: View -> [(MetaField, String)] -> (View, ViewChange) +refineView = go Unchanged + where + go c v [] = (v, c) + go c v ((f, s):rest) = + let (v', c') = refineView' v f s + in go (max c c') v' rest + +{- Adds an additional filter to a view. This can only result in narrowing + - the view. Multivalued filters are added in non-visible form. -} +filterView :: View -> [(MetaField, String)] -> View +filterView v vs = v { viewComponents = viewComponents f' ++ viewComponents v} + where + f = fst $ refineView (v {viewComponents = []}) vs + f' = f { viewComponents = map toinvisible (viewComponents f) } + toinvisible c = c { viewVisible = False } + +refineView' :: View -> MetaField -> String -> (View, ViewChange) +refineView' view field wanted + | field `elem` (map viewField components) = + let (components', viewchanges) = runWriter $ mapM updatefield components + in (view { viewComponents = components' }, maximum viewchanges) + | otherwise = + let component = ViewComponent field viewfilter (multiValue viewfilter) + view' = view { viewComponents = component : components } + in if viewTooLarge view' + then error $ "View is too large (" ++ show (visibleViewSize view') ++ " levels of subdirectories)" + else (view', Narrowing) + where + components = viewComponents view + viewfilter + | any (`elem` wanted) "*?" = FilterGlob wanted + | otherwise = FilterValues $ S.singleton $ toMetaValue wanted + updatefield :: ViewComponent -> Writer [ViewChange] ViewComponent + updatefield v + | viewField v == field = do + let (newvf, viewchange) = combineViewFilter (viewFilter v) viewfilter + tell [viewchange] + return $ v { viewFilter = newvf } + | otherwise = return v + +{- Combine old and new ViewFilters, yielding a result that matches + - either old+new, or only new. + - + - If we have FilterValues and change to a FilterGlob, + - it's always a widening change, because the glob could match other + - values. OTOH, going the other way, it's a Narrowing change if the old + - glob matches all the new FilterValues. + - + - With two globs, the old one is discarded, and the new one is used. + - We can tell if that's a narrowing change by checking if the old + - glob matches the new glob. For example, "*" matches "foo*", + - so that's narrowing. While "f?o" does not match "f??", so that's + - widening. + -} +combineViewFilter :: ViewFilter -> ViewFilter -> (ViewFilter, ViewChange) +combineViewFilter old@(FilterValues olds) (FilterValues news) + | combined == old = (combined, Unchanged) + | otherwise = (combined, Widening) + where + combined = FilterValues (S.union olds news) +combineViewFilter (FilterValues _) newglob@(FilterGlob _) = + (newglob, Widening) +combineViewFilter (FilterGlob oldglob) new@(FilterValues s) + | all (matchGlob (compileGlob oldglob) . fromMetaValue) (S.toList s) = (new, Narrowing) + | otherwise = (new, Widening) +combineViewFilter (FilterGlob old) newglob@(FilterGlob new) + | old == new = (newglob, Unchanged) + | matchGlob (compileGlob old) new = (newglob, Narrowing) + | otherwise = (newglob, Widening) + +{- Converts a filepath used in a reference branch to the + - filename that will be used in the view. + - + - No two filepaths from the same branch should yeild the same result, + - so all directory structure needs to be included in the output file + - in some way. However, the branch's directory structure is not relevant + - in the view. + - + - So, from dir/subdir/file.foo, generate file_{dir;subdir}.foo + - + - (To avoid collisions with a filename that already contains {foo}, + - that is doubled to {{foo}}.) + -} +fileViewFromReference :: MkFileView +fileViewFromReference f = concat + [ double base + , if null dirs then "" else "_{" ++ double (intercalate ";" dirs) ++ "}" + , double $ concat extensions + ] + where + (path, basefile) = splitFileName f + dirs = filter (/= ".") $ map dropTrailingPathSeparator (splitPath path) + (base, extensions) = splitShortExtensions basefile + + double = replace "{" "{{" . replace "}" "}}" + +fileViewReuse :: MkFileView +fileViewReuse = takeFileName + +{- Generates views for a file from a branch, based on its metadata + - and the filename used in the branch. + - + - Note that a file may appear multiple times in a view, when it + - has multiple matching values for a MetaField used in the View. + - + - Of course if its MetaData does not match the View, it won't appear at + - all. + - + - Note that for efficiency, it's useful to partially + - evaluate this function with the view parameter and reuse + - the result. The globs in the view will then be compiled and memoized. + -} +fileViews :: View -> MkFileView -> FilePath -> MetaData -> [FileView] +fileViews view = + let matchers = map viewComponentMatcher (viewComponents view) + in \mkfileview file metadata -> + let matches = map (\m -> m metadata) matchers + in if any isNothing matches + then [] + else + let paths = pathProduct $ + map (map toViewPath) (visible matches) + in if null paths + then [mkfileview file] + else map ( mkfileview file) paths + where + visible = map (fromJust . snd) . + filter (viewVisible . fst) . + zip (viewComponents view) + +{- Checks if metadata matches a ViewComponent filter, and if so + - returns the value, or values that match. Self-memoizing on ViewComponent. -} +viewComponentMatcher :: ViewComponent -> (MetaData -> Maybe [MetaValue]) +viewComponentMatcher viewcomponent = \metadata -> + let s = matcher (currentMetaDataValues metafield metadata) + in if S.null s then Nothing else Just (S.toList s) + where + metafield = viewField viewcomponent + matcher = case viewFilter viewcomponent of + FilterValues s -> \values -> S.intersection s values + FilterGlob glob -> + let regex = compileGlob glob + in \values -> + S.filter (matchGlob regex . fromMetaValue) values + +compileGlob :: String -> Regex +compileGlob glob = +#ifdef WITH_TDFA + case compile (defaultCompOpt {caseSensitive = False}) defaultExecOpt regex of + Right r -> r + Left _ -> error $ "failed to compile regex: " ++ regex +#else + mkRegexWithOpts regex False True +#endif + where + regex = '^':wildToRegex glob + +matchGlob :: Regex -> String -> Bool +matchGlob regex val = +#ifdef WITH_TDFA + case execute regex val of + Right (Just _) -> True + _ -> False +#else + isJust $ matchRegex regex val +#endif + +toViewPath :: MetaValue -> FilePath +toViewPath = concatMap escapeslash . fromMetaValue + where + escapeslash c + | c == '/' = [pseudoSlash] + | c == '\\' = [pseudoBackslash] + | c == pseudoSlash = [pseudoSlash, pseudoSlash] + | c == pseudoBackslash = [pseudoBackslash, pseudoBackslash] + | otherwise = [c] + +fromViewPath :: FilePath -> MetaValue +fromViewPath = toMetaValue . deescapeslash [] + where + deescapeslash s [] = reverse s + deescapeslash s (c:cs) + | c == pseudoSlash = case cs of + (c':cs') + | c' == pseudoSlash -> deescapeslash (pseudoSlash:s) cs' + _ -> deescapeslash ('/':s) cs + | c == pseudoBackslash = case cs of + (c':cs') + | c' == pseudoBackslash -> deescapeslash (pseudoBackslash:s) cs' + _ -> deescapeslash ('/':s) cs + | otherwise = deescapeslash (c:s) cs + +pseudoSlash :: Char +pseudoSlash = '\8725' -- '∕' /= '/' + +pseudoBackslash :: Char +pseudoBackslash = '\9586' -- '╲' /= '\' + +pathProduct :: [[FilePath]] -> [FilePath] +pathProduct [] = [] +pathProduct (l:ls) = foldl combinel l ls + where + combinel xs ys = [combine x y | x <- xs, y <- ys] + +{- Extracts the metadata from a fileview, based on the view that was used + - to construct it. -} +fromView :: View -> FileView -> MetaData +fromView view f = foldr (uncurry updateMetaData) newMetaData (zip fields values) + where + visible = filter viewVisible (viewComponents view) + fields = map viewField visible + paths = splitDirectories $ dropFileName f + values = map fromViewPath paths + +{- Constructing a view that will match arbitrary metadata, and applying + - it to a file yields a set of FileViews which all contain the same + - MetaFields that were present in the input metadata + - (excluding fields that are not visible). -} +prop_view_roundtrips :: FilePath -> MetaData -> Bool -> Bool +prop_view_roundtrips f metadata visible = null f || viewTooLarge view || + all hasfields (fileViews view fileViewFromReference f metadata) + where + view = View (Git.Ref "master") $ + map (\(mf, mv) -> ViewComponent mf (FilterValues $ S.filter (not . null . fromMetaValue) mv) visible) + (fromMetaData metadata) + visiblefields = sort (map viewField $ filter viewVisible (viewComponents view)) + hasfields fv = sort (map fst (fromMetaData (fromView view fv))) == visiblefields + +{- Applies a view to the currently checked out branch, generating a new + - branch for the view. + -} +applyView :: View -> Annex Git.Branch +applyView view = applyView' fileViewFromReference view + +{- Generates a new branch for a View, which must be a more narrow + - version of the View originally used to generate the currently + - checked out branch. That is, it must match a subset of the files + - in view, not any others. + -} +narrowView :: View -> Annex Git.Branch +narrowView = applyView' fileViewReuse + +{- Go through each file in the currently checked out branch. + - If the file is not annexed, skip it, unless it's a dotfile in the top. + - Look up the metadata of annexed files, and generate any FileViews, + - and stage them. + - + - Currently only works in indirect mode. Must be run from top of + - repository. + -} +applyView' :: MkFileView -> View -> Annex Git.Branch +applyView' mkfileview view = do + top <- fromRepo Git.repoPath + (l, clean) <- inRepo $ Git.LsFiles.inRepo [top] + liftIO . nukeFile =<< fromRepo gitAnnexViewIndex + genViewBranch view $ do + uh <- inRepo Git.UpdateIndex.startUpdateIndex + hasher <- inRepo hashObjectStart + forM_ l $ \f -> + go uh hasher f =<< Backend.lookupFile f + liftIO $ do + hashObjectStop hasher + void $ stopUpdateIndex uh + void clean + where + genfileviews = fileViews view mkfileview -- enables memoization + go uh hasher f (Just (k, _)) = do + metadata <- getCurrentMetaData k + forM_ (genfileviews f metadata) $ \fv -> do + stagesymlink uh hasher fv =<< inRepo (gitAnnexLink fv k) + go uh hasher f Nothing + | "." `isPrefixOf` f = do + s <- liftIO $ getSymbolicLinkStatus f + if isSymbolicLink s + then stagesymlink uh hasher f =<< liftIO (readSymbolicLink f) + else do + sha <- liftIO $ Git.HashObject.hashFile hasher f + let blobtype = if isExecutable (fileMode s) + then ExecutableBlob + else FileBlob + liftIO . Git.UpdateIndex.streamUpdateIndex' uh + =<< inRepo (Git.UpdateIndex.stageFile sha blobtype f) + | otherwise = noop + stagesymlink uh hasher f linktarget = do + sha <- hashSymlink' hasher linktarget + liftIO . Git.UpdateIndex.streamUpdateIndex' uh + =<< inRepo (Git.UpdateIndex.stageSymlink f sha) + +{- Applies a view to the reference branch, generating a new branch + - for the View. + - + - This needs to work incrementally, to quickly update the view branch + - when the reference branch is changed. So, it works based on an + - old version of the reference branch, uses diffTree to find the + - changes, and applies those changes to the view branch. + -} +updateView :: View -> Git.Ref -> Git.Ref -> Annex Git.Branch +updateView view ref oldref = genViewBranch view $ do + (diffs, cleanup) <- inRepo $ DiffTree.diffTree oldref ref + forM_ diffs go + void $ liftIO cleanup + where + go diff + | DiffTree.dstsha diff == nullSha = error "TODO delete file" + | otherwise = error "TODO add file" + +{- Diff between currently checked out branch and staged changes, and + - update metadata to reflect the changes that are being committed to the + - view. + - + - Adding a file to a directory adds the metadata represented by + - that directory to the file, and removing a file from a directory + - removes the metadata. + - + - Note that removes must be handled before adds. This is so + - that moving a file from x/foo/ to x/bar/ adds back the metadata for x. + -} +withViewChanges :: (FileView -> Key -> CommandStart) -> (FileView -> Key -> CommandStart) -> Annex () +withViewChanges addmeta removemeta = do + makeabs <- flip fromTopFilePath <$> gitRepo + (diffs, cleanup) <- inRepo $ DiffTree.diffIndex Git.Ref.headRef + forM_ diffs handleremovals + forM_ diffs (handleadds makeabs) + void $ liftIO cleanup + where + handleremovals item + | DiffTree.srcsha item /= nullSha = + handle item removemeta + =<< catKey (DiffTree.srcsha item) (DiffTree.srcmode item) + | otherwise = noop + handleadds makeabs item + | DiffTree.dstsha item /= nullSha = + handle item addmeta + =<< ifM isDirect + ( catKey (DiffTree.dstsha item) (DiffTree.dstmode item) + -- optimisation + , isAnnexLink $ makeabs $ DiffTree.file item + ) + | otherwise = noop + handle item a = maybe noop + (void . commandAction . a (getTopFilePath $ DiffTree.file item)) + +{- Generates a branch for a view. This is done using a different index + - file. An action is run to stage the files that will be in the branch. + - Then a commit is made, to the view branch. The view branch is not + - checked out, but entering it will display the view. -} +genViewBranch :: View -> Annex () -> Annex Git.Branch +genViewBranch view a = withIndex $ do + a + let branch = branchView view + void $ inRepo $ Git.Branch.commit True (fromRef branch) branch [] + return branch + +{- Runs an action using the view index file. + - Note that the file does not necessarily exist, or can contain + - info staged for an old view. -} +withIndex :: Annex a -> Annex a +withIndex a = do + f <- fromRepo gitAnnexViewIndex + withIndexFile f a + +withCurrentView :: (View -> Annex a) -> Annex a +withCurrentView a = maybe (error "Not in a view.") a =<< currentView diff --git a/Assistant.hs b/Assistant.hs index 800a3ef786..c66a1b73b1 100644 --- a/Assistant.hs +++ b/Assistant.hs @@ -93,7 +93,8 @@ startDaemon assistant foreground startdelay cannotrun listenhost startbrowser = start (Utility.Daemon.daemonize logfd (Just pidfile) False) Nothing #else -- Windows is always foreground, and has no log file. - start id $ + liftIO $ Utility.Daemon.lockPidFile pidfile + start id $ do case startbrowser of Nothing -> Nothing Just a -> Just $ a Nothing Nothing diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs index bf316e49d6..349d4af9ca 100644 --- a/Assistant/MakeRemote.hs +++ b/Assistant/MakeRemote.hs @@ -48,9 +48,10 @@ makeRsyncRemote :: RemoteName -> String -> Annex String makeRsyncRemote name location = makeRemote name location $ const $ void $ go =<< Command.InitRemote.findExisting name where - go Nothing = setupSpecialRemote name Rsync.remote config + go Nothing = setupSpecialRemote name Rsync.remote config Nothing (Nothing, Command.InitRemote.newConfig name) - go (Just (u, c)) = setupSpecialRemote name Rsync.remote config (Just u, c) + go (Just (u, c)) = setupSpecialRemote name Rsync.remote config Nothing + (Just u, c) config = M.fromList [ ("encryption", "shared") , ("rsyncurl", location) @@ -60,44 +61,44 @@ makeRsyncRemote name location = makeRemote name location $ const $ void $ {- Inits a gcrypt special remote, and returns its name. -} makeGCryptRemote :: RemoteName -> String -> KeyId -> Annex RemoteName makeGCryptRemote remotename location keyid = - initSpecialRemote remotename GCrypt.remote $ M.fromList + initSpecialRemote remotename GCrypt.remote Nothing $ M.fromList [ ("type", "gcrypt") , ("gitrepo", location) , configureEncryption HybridEncryption , ("keyid", keyid) ] -type SpecialRemoteMaker = RemoteName -> RemoteType -> R.RemoteConfig -> Annex RemoteName +type SpecialRemoteMaker = RemoteName -> RemoteType -> Maybe CredPair -> R.RemoteConfig -> Annex RemoteName {- Inits a new special remote. The name is used as a suggestion, but - will be changed if there is already a special remote with that name. -} initSpecialRemote :: SpecialRemoteMaker -initSpecialRemote name remotetype config = go 0 +initSpecialRemote name remotetype mcreds config = go 0 where go :: Int -> Annex RemoteName go n = do let fullname = if n == 0 then name else name ++ show n r <- Command.InitRemote.findExisting fullname case r of - Nothing -> setupSpecialRemote fullname remotetype config + Nothing -> setupSpecialRemote fullname remotetype config mcreds (Nothing, Command.InitRemote.newConfig fullname) Just _ -> go (n + 1) {- Enables an existing special remote. -} enableSpecialRemote :: SpecialRemoteMaker -enableSpecialRemote name remotetype config = do +enableSpecialRemote name remotetype mcreds config = do r <- Command.InitRemote.findExisting name case r of Nothing -> error $ "Cannot find a special remote named " ++ name - Just (u, c) -> setupSpecialRemote name remotetype config (Just u, c) + Just (u, c) -> setupSpecialRemote name remotetype config mcreds (Just u, c) -setupSpecialRemote :: RemoteName -> RemoteType -> R.RemoteConfig -> (Maybe UUID, R.RemoteConfig) -> Annex RemoteName -setupSpecialRemote name remotetype config (mu, c) = do +setupSpecialRemote :: RemoteName -> RemoteType -> R.RemoteConfig -> Maybe CredPair -> (Maybe UUID, R.RemoteConfig) -> Annex RemoteName +setupSpecialRemote name remotetype config mcreds (mu, c) = do {- Currently, only 'weak' ciphers can be generated from the - assistant, because otherwise GnuPG may block once the entropy - pool is drained, and as of now there's no way to tell the user - to perform IO actions to refill the pool. -} - (c', u) <- R.setup remotetype mu $ + (c', u) <- R.setup remotetype mu mcreds $ M.insert "highRandomQuality" "false" $ M.union config c describeUUID u name configSet u c' diff --git a/Assistant/Restart.hs b/Assistant/Restart.hs index 20629cc818..0502045c2b 100644 --- a/Assistant/Restart.hs +++ b/Assistant/Restart.hs @@ -16,6 +16,7 @@ import Assistant.NamedThread import Utility.ThreadScheduler import Utility.NotificationBroadcaster import Utility.Url +import Utility.PID import qualified Git.Construct import qualified Git.Config import Config.Files @@ -25,10 +26,9 @@ import qualified Git import Control.Concurrent import System.Process (cwd) #ifndef mingw32_HOST_OS -import System.Posix (getProcessID, signalProcess, sigTERM) +import System.Posix (signalProcess, sigTERM) #else -import System.Win32.Process.Current (getCurrentProcessId) -import System.Win32.Console (generateConsoleCtrlEvent, cTRL_C_EVENT) +import Utility.WinProcess #endif {- Before the assistant can be restarted, have to remove our @@ -53,9 +53,9 @@ postRestart url = do void $ liftIO $ forkIO $ do threadDelaySeconds (Seconds 120) #ifndef mingw32_HOST_OS - signalProcess sigTERM =<< getProcessID + signalProcess sigTERM =<< getPID #else - generateConsoleCtrlEvent cTRL_C_EVENT =<< getCurrentProcessId + terminatePID =<< getPID #endif runRestart :: Assistant URLString @@ -86,10 +86,13 @@ newAssistantUrl repo = do threadDelay 100000 -- 1/10th of a second a -{- Returns once the assistant has daemonized, but possibly before it's - - listening for web connections. -} +{- Does not wait for assistant to be listening for web connections. + - + - On windows, the assistant does not daemonize, which is why the forkIO is + - done. + -} startAssistant :: FilePath -> IO () -startAssistant repo = do +startAssistant repo = void $ forkIO $ do program <- readProgramFile (_, _, _, pid) <- createProcess $ diff --git a/Assistant/Threads/Merger.hs b/Assistant/Threads/Merger.hs index 3f4fcb0cca..8c406990a7 100644 --- a/Assistant/Threads/Merger.hs +++ b/Assistant/Threads/Merger.hs @@ -80,8 +80,8 @@ onChange file mergecurrent (Just current) | equivBranches changedbranch current = do debug - [ "merging", show changedbranch - , "into", show current + [ "merging", Git.fromRef changedbranch + , "into", Git.fromRef current ] void $ liftAnnex $ Command.Sync.mergeFrom changedbranch mergecurrent _ = noop @@ -105,12 +105,12 @@ onChange file equivBranches :: Git.Ref -> Git.Ref -> Bool equivBranches x y = base x == base y where - base = takeFileName . show + base = takeFileName . Git.fromRef isAnnexBranch :: FilePath -> Bool isAnnexBranch f = n `isSuffixOf` f where - n = '/' : show Annex.Branch.name + n = '/' : Git.fromRef Annex.Branch.name fileToBranch :: FilePath -> Git.Ref fileToBranch f = Git.Ref $ "refs" base diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs index 827a171395..b94d010e3d 100644 --- a/Assistant/Threads/SanityChecker.hs +++ b/Assistant/Threads/SanityChecker.hs @@ -194,8 +194,13 @@ dailyCheck urlrenderer = do hourlyCheck :: Assistant () hourlyCheck = do +#ifndef mingw32_HOST_OS checkLogSize 0 +#else + noop +#endif +#ifndef mingw32_HOST_OS {- Rotate logs until log file size is < 1 mb. -} checkLogSize :: Int -> Assistant () checkLogSize n = do @@ -209,6 +214,7 @@ checkLogSize n = do checkLogSize $ n + 1 where filesize f = fromIntegral . fileSize <$> liftIO (getFileStatus f) +#endif oneMegabyte :: Int oneMegabyte = 1000000 @@ -237,5 +243,5 @@ checkOldUnused urlrenderer = go =<< annexExpireUnused <$> liftAnnex Annex.getGit button <- mkAlertButton True (T.pack "Configure") urlrenderer ConfigUnusedR void $ addAlert $ unusedFilesAlert [button] $ T.unpack $ renderTense Present msg #else - debug [msg] + debug [show $ renderTense Past msg] #endif diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs index de96cdf852..a36a3ee326 100644 --- a/Assistant/TransferSlots.hs +++ b/Assistant/TransferSlots.hs @@ -39,7 +39,7 @@ import qualified Control.Concurrent.MSemN as MSemN import System.Posix.Process (getProcessGroupIDOf) import System.Posix.Signals (signalProcessGroup, sigTERM, sigKILL) #else -import System.Win32.Console (generateConsoleCtrlEvent, cTRL_C_EVENT, cTRL_BREAK_EVENT) +import Utility.WinProcess #endif type TransferGenerator = Assistant (Maybe (Transfer, TransferInfo, Transferrer -> Assistant ())) @@ -256,23 +256,19 @@ cancelTransfer pause t = do signalthread tid | pause = throwTo tid PauseTransfer | otherwise = killThread tid - {- In order to stop helper processes like rsync, - - kill the whole process group of the process - - running the transfer. -} killproc pid = void $ tryIO $ do #ifndef mingw32_HOST_OS + {- In order to stop helper processes like rsync, + - kill the whole process group of the process + - running the transfer. -} g <- getProcessGroupIDOf pid let signal sig = void $ tryIO $ signalProcessGroup sig g signal sigTERM - graceperiod + threadDelay 50000 -- 0.05 second grace period signal sigKILL #else - let signal sig = void $ tryIO $ generateConsoleCtrlEvent sig pid - signal cTRL_C_EVENT - graceperiod - signal cTRL_BREAK_EVENT + terminatePID pid #endif - graceperiod = threadDelay 50000 -- 0.05 second {- Start or resume a transfer. -} startTransfer :: Transfer -> Assistant () diff --git a/Assistant/Types/NetMessager.hs b/Assistant/Types/NetMessager.hs index 0af262e9a2..41ab4b272f 100644 --- a/Assistant/Types/NetMessager.hs +++ b/Assistant/Types/NetMessager.hs @@ -32,7 +32,7 @@ data NetMessage | PairingNotification PairStage ClientID UUID -- used for git push over the network messager | Pushing ClientID PushStage - deriving (Show, Eq, Ord) + deriving (Eq, Ord, Show) {- Something used to identify the client, or clients to send the message to. -} type ClientID = Text @@ -50,7 +50,7 @@ data PushStage | SendPackOutput SequenceNum ByteString -- sent when git receive-pack exits, with its exit code | ReceivePackDone ExitCode - deriving (Show, Eq, Ord) + deriving (Eq, Ord, Show) {- A sequence number. Incremented by one per packet in a sequence, - starting with 1 for the first packet. 0 means sequence numbers are diff --git a/Assistant/WebApp/Configurators/AWS.hs b/Assistant/WebApp/Configurators/AWS.hs index ab2a32a599..bb8935b8b2 100644 --- a/Assistant/WebApp/Configurators/AWS.hs +++ b/Assistant/WebApp/Configurators/AWS.hs @@ -202,11 +202,11 @@ enableAWSRemote _ _ = error "S3 not supported by this build" #endif makeAWSRemote :: SpecialRemoteMaker -> RemoteType -> StandardGroup -> AWSCreds -> RemoteName -> RemoteConfig -> Handler () -makeAWSRemote maker remotetype defaultgroup (AWSCreds ak sk) name config = do - liftIO $ AWS.setCredsEnv (T.unpack ak, T.unpack sk) +makeAWSRemote maker remotetype defaultgroup (AWSCreds ak sk) name config = setupCloudRemote defaultgroup Nothing $ - maker hostname remotetype config + maker hostname remotetype (Just creds) config where + creds = (T.unpack ak, T.unpack sk) {- AWS services use the remote name as the basis for a host - name, so filter it to contain valid characters. -} hostname = case filter isAlphaNum name of diff --git a/Assistant/WebApp/Configurators/Local.hs b/Assistant/WebApp/Configurators/Local.hs index 1ab290b1b6..8bbdadacf1 100644 --- a/Assistant/WebApp/Configurators/Local.hs +++ b/Assistant/WebApp/Configurators/Local.hs @@ -300,7 +300,6 @@ getGenKeyForDriveR drive = withNewSecretKey $ \keyid -> getFinishAddDriveR :: RemovableDrive -> RepoKey -> Handler Html getFinishAddDriveR drive = go where - {- Set up new gcrypt special remote. -} go (RepoKey keyid) = whenGcryptInstalled $ makewith $ const $ do r <- liftAnnex $ addRemote $ makeGCryptRemote remotename dir keyid @@ -314,7 +313,7 @@ getFinishAddDriveR drive = go remotename' <- liftAnnex $ getGCryptRemoteName u dir makewith $ const $ do r <- liftAnnex $ addRemote $ - enableSpecialRemote remotename' GCrypt.remote $ M.fromList + enableSpecialRemote remotename' GCrypt.remote Nothing $ M.fromList [("gitrepo", dir)] return (u, r) {- Making a new unencrypted repo, or combining with an existing one. -} diff --git a/Assistant/WebApp/Configurators/Ssh.hs b/Assistant/WebApp/Configurators/Ssh.hs index c232cf7dd5..90a8c520fd 100644 --- a/Assistant/WebApp/Configurators/Ssh.hs +++ b/Assistant/WebApp/Configurators/Ssh.hs @@ -25,6 +25,11 @@ import qualified Remote.GCrypt as GCrypt import Annex.UUID import Logs.UUID +#ifdef mingw32_HOST_OS +import Utility.Tmp +import Utility.Rsync +#endif + import qualified Data.Text as T import qualified Data.Map as M import Network.Socket @@ -354,7 +359,7 @@ checkExistingGCrypt sshdata nope = checkGCryptRepoEncryption repourl nope nope $ enableGCrypt :: SshData -> RemoteName -> Handler Html enableGCrypt sshdata reponame = setupCloudRemote TransferGroup Nothing $ - enableSpecialRemote reponame GCrypt.remote $ M.fromList + enableSpecialRemote reponame GCrypt.remote Nothing $ M.fromList [("gitrepo", genSshUrl sshdata)] {- Combining with a gcrypt repository that may not be @@ -468,8 +473,18 @@ enableRsyncNetGCrypt sshinput reponame = notencrypted = error "Unexpectedly found a non-encrypted git repository, instead of the expected encrypted git repository." notinstalled = error "internal" -{- Prepares rsync.net ssh key, and if successful, runs an action with - - its SshData. -} +{- Prepares rsync.net ssh key and creates the directory that will be + - used on rsync.net. If successful, runs an action with its SshData. + - + - To append the ssh key to rsync.net's authorized_keys, their + - documentation recommends a dd methodd, where the line is fed + - in to ssh over stdin. + - + - On Windows, ssh password prompting happens on stdin, so cannot + - feed the key in that way. Instead, first rsync down any current + - authorized_keys file, then modifiy it, and then rsync it back up. + - This means 2 password prompts rather than one for Windows. + -} prepRsyncNet :: SshInput -> String -> (SshData -> Handler Html) -> Handler Html prepRsyncNet sshinput reponame a = do knownhost <- liftIO $ maybe (return False) knownHost (inputHostname sshinput) @@ -480,25 +495,37 @@ prepRsyncNet sshinput reponame a = do , needsPubKey = True , sshCapabilities = [RsyncCapable] } + let sshhost = genSshHost (sshHostName sshdata) (sshUserName sshdata) + let torsyncnet cmd = filter (not . null) + [ if knownhost then "" else sshOpt "StrictHostKeyChecking" "no" + , sshhost + , cmd + ] +#ifndef mingw32_HOST_OS {- I'd prefer to separate commands with && , but - - rsync.net's shell does not support that. - - - - The dd method of appending to the authorized_keys file is the - - one recommended by rsync.net documentation. I touch the file first - - to not need to use a different method to create it. - -} + - rsync.net's shell does not support that. -} let remotecommand = intercalate ";" [ "mkdir -p .ssh" , "touch .ssh/authorized_keys" , "dd of=.ssh/authorized_keys oflag=append conv=notrunc" , "mkdir -p " ++ T.unpack (sshDirectory sshdata) ] - let sshopts = filter (not . null) - [ if knownhost then "" else sshOpt "StrictHostKeyChecking" "no" - , genSshHost (sshHostName sshdata) (sshUserName sshdata) - , remotecommand - ] - sshSetup sshopts (Just $ sshPubKey keypair) $ a sshdata + sshSetup (torsyncnet remotecommand) (Just $ sshPubKey keypair) (a sshdata) +#else + liftIO $ withTmpDir "rsyncnet" $ \tmpdir -> do + createDirectory $ tmpdir ".ssh" + (oldkeys, _) <- sshTranscript (torsyncnet "cat .ssh/authorized_keys") Nothing + writeFile (tmpdir ".ssh" "authorized_keys") + (sshPubKey keypair ++ "\n" ++ oldkeys) + liftIO $ putStrLn "May need to prompt for your rsync.net password one more time..." + void $ rsync + [ Param "-r" + , File $ tmpdir ".ssh/" + , Param $ sshhost ++ ":.ssh/" + ] + let remotecommand = "mkdir -p " ++ T.unpack (sshDirectory sshdata) + sshSetup (torsyncnet remotecommand) Nothing (a sshdata) +#endif isRsyncNet :: Maybe Text -> Bool isRsyncNet Nothing = False diff --git a/Assistant/WebApp/Configurators/WebDAV.hs b/Assistant/WebApp/Configurators/WebDAV.hs index a30f75a0f8..9da2d5ccaf 100644 --- a/Assistant/WebApp/Configurators/WebDAV.hs +++ b/Assistant/WebApp/Configurators/WebDAV.hs @@ -123,10 +123,9 @@ postEnableWebDAVR _ = error "WebDAV not supported by this build" #ifdef WITH_WEBDAV makeWebDavRemote :: SpecialRemoteMaker -> RemoteName -> CredPair -> RemoteConfig -> Handler () -makeWebDavRemote maker name creds config = do - liftIO $ WebDAV.setCredsEnv creds +makeWebDavRemote maker name creds config = setupCloudRemote TransferGroup Nothing $ - maker name WebDAV.remote config + maker name WebDAV.remote (Just creds) config {- Only returns creds previously used for the same hostname. -} previouslyUsedWebDAVCreds :: String -> Annex (Maybe CredPair) diff --git a/Assistant/WebApp/Control.hs b/Assistant/WebApp/Control.hs index 02b559096e..7141cc7803 100644 --- a/Assistant/WebApp/Control.hs +++ b/Assistant/WebApp/Control.hs @@ -16,15 +16,15 @@ import Assistant.TransferSlots import Assistant.Restart import Utility.LogFile import Utility.NotificationBroadcaster +import Utility.PID import Control.Concurrent import qualified Data.Map as M import qualified Data.Text as T #ifndef mingw32_HOST_OS -import System.Posix (getProcessID, signalProcess, sigTERM) +import System.Posix (signalProcess, sigTERM) #else -import System.Win32.Process.Current (getCurrentProcessId) -import System.Win32.Console (generateConsoleCtrlEvent, cTRL_C_EVENT) +import Utility.WinProcess #endif getShutdownR :: Handler Html @@ -54,9 +54,9 @@ getShutdownConfirmedR = do void $ liftIO $ forkIO $ do threadDelay 2000000 #ifndef mingw32_HOST_OS - signalProcess sigTERM =<< getProcessID + signalProcess sigTERM =<< getPID #else - generateConsoleCtrlEvent cTRL_C_EVENT =<< getCurrentProcessId + terminatePID =<< getPID #endif redirect NotRunningR diff --git a/Assistant/WebApp/DashBoard.hs b/Assistant/WebApp/DashBoard.hs index b33919b347..718021b0e1 100644 --- a/Assistant/WebApp/DashBoard.hs +++ b/Assistant/WebApp/DashBoard.hs @@ -130,8 +130,23 @@ openFileBrowser = do #endif ifM (liftIO $ inPath cmd) ( do - void $ liftIO $ forkIO $ void $ + let run = void $ liftIO $ forkIO $ void $ boolSystem cmd params + run +#ifdef mingw32_HOST_OS + {- On windows, if the file browser is not + - already open, it comes up below the + - web browser when started. + - + - Running it a second time brings it + - to the foreground. + - + - Seems to need a delay long enough for the file + - browser to be open in order to work. Here 1 + - second. -} + liftIO $ threadDelay 1000000 + run +#endif return True , do void $ redirect $ "file://" ++ path diff --git a/Assistant/WebApp/MakeRemote.hs b/Assistant/WebApp/MakeRemote.hs index 255f0fbce1..749fbd5282 100644 --- a/Assistant/WebApp/MakeRemote.hs +++ b/Assistant/WebApp/MakeRemote.hs @@ -28,8 +28,8 @@ import Utility.Yesod - and finishes setting it up, then starts syncing with it, - and finishes by displaying the page to edit it. -} setupCloudRemote :: StandardGroup -> Maybe Cost -> Annex RemoteName -> Handler a -setupCloudRemote defaultgroup mcost maker = do - r <- liftAnnex $ addRemote maker +setupCloudRemote defaultgroup mcost name = do + r <- liftAnnex $ addRemote name liftAnnex $ do setStandardGroup (Remote.uuid r) defaultgroup maybe noop (Config.setRemoteCost (Remote.repo r)) mcost diff --git a/Assistant/XMPP.hs b/Assistant/XMPP.hs index 09b7daf4e5..e747050217 100644 --- a/Assistant/XMPP.hs +++ b/Assistant/XMPP.hs @@ -13,6 +13,7 @@ import Assistant.Common import Assistant.Types.NetMessager import Assistant.Pairing import Git.Sha (extractSha) +import Git import Network.Protocol.XMPP hiding (Node) import Data.Text (Text) @@ -152,7 +153,7 @@ pushMessage = gitAnnexMessage . encode where encode (CanPush u shas) = gitAnnexTag canPushAttr $ T.pack $ unwords $ - fromUUID u : map show shas + fromUUID u : map fromRef shas encode (PushRequest u) = gitAnnexTag pushRequestAttr $ T.pack $ fromUUID u encode (StartingPush u) = diff --git a/Backend/Hash.hs b/Backend/Hash.hs index d46ce973e0..41368a5bba 100644 --- a/Backend/Hash.hs +++ b/Backend/Hash.hs @@ -101,6 +101,7 @@ checkKeyChecksum hash key file = do case (mstat, fast) of (Just stat, False) -> do let filesize = fromIntegral $ fileSize stat + showSideAction "checksum" check <$> hashFile hash file filesize _ -> return True where diff --git a/Build/DistributionUpdate.hs b/Build/DistributionUpdate.hs index 0e7fa7304d..6965bcb681 100644 --- a/Build/DistributionUpdate.hs +++ b/Build/DistributionUpdate.hs @@ -21,11 +21,16 @@ main = do makeinfos :: Annex () makeinfos = do + void $ inRepo $ runBool + [ Param "commit" + , Param "-m" + , Param $ "publishing git-annex " ++ version + ] basedir <- liftIO getRepoDir version <- liftIO getChangelogVersion now <- liftIO getCurrentTime liftIO $ putStrLn $ "building info files for version " ++ version ++ " in " ++ basedir - fs <- liftIO $ dirContentsRecursiveSkipping (== "info") True (basedir "git-annex") + fs <- liftIO $ dirContentsRecursiveSkipping (const False) True (basedir "git-annex") forM_ fs $ \f -> do v <- lookupFile f case v of @@ -44,7 +49,7 @@ makeinfos = do void $ inRepo $ runBool [ Param "commit" , Param "-m" - , Param $ "publishing git-annex " ++ version + , Param $ "updated info files for git-annex " ++ version ] void $ inRepo $ runBool [ Param "annex" @@ -54,6 +59,19 @@ makeinfos = do [ Param "annex" , Params "sync" ] + + {- Check for out of date info files. -} + infos <- liftIO $ filter (".info" `isSuffixOf`) + <$> dirContentsRecursive (basedir "git-annex") + ds <- liftIO $ forM infos (readish <$$> readFile) + let dis = zip infos ds + let ood = filter (outofdate version) dis + unless (null ood) $ + error $ "Some info files are out of date: " ++ show (map fst ood) + where + outofdate version (_, md) = case md of + Nothing -> True + Just d -> distributionVersion d /= version getRepoDir :: IO FilePath getRepoDir = do diff --git a/Build/EvilLinker.hs b/Build/EvilLinker.hs index c8641f649c..1b57ba959b 100644 --- a/Build/EvilLinker.hs +++ b/Build/EvilLinker.hs @@ -17,6 +17,7 @@ import Control.Applicative ((<$>)) import Control.Monad import System.Directory import Data.Maybe +import Data.List import Utility.Monad import Utility.Process @@ -94,13 +95,19 @@ parseCollect2 = do path <- manyTill anyChar (try $ string ldcmd) void $ char ' ' params <- restOfLine - return $ CmdParams (path ++ ldcmd) (escapeDosPaths params) Nothing + return $ CmdParams (path ++ ldcmd) (skipHack $ escapeDosPaths params) Nothing where ldcmd = "ld.exe" versionline = do void $ string "collect2 version" restOfLine - + +{- For unknown reasons, asking the linker to link this in fails, + - with error about multiple definitions of a symbol from the library. + - This is a horrible hack. -} +skipHack :: String -> String +skipHack = replace "dist/build/git-annex/git-annex-tmp/Utility/winprocess.o" "" + {- Input contains something like - c:/program files/haskell platform/foo -LC:/Program Files/Haskell Platform/ -L... - and the *right* spaces must be escaped with \ diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs index b25082963b..3604681f96 100644 --- a/CmdLine/GitAnnex.hs +++ b/CmdLine/GitAnnex.hs @@ -26,6 +26,12 @@ import qualified Command.DropKey import qualified Command.TransferKey import qualified Command.TransferKeys import qualified Command.ReKey +import qualified Command.MetaData +import qualified Command.View +import qualified Command.VAdd +import qualified Command.VFilter +import qualified Command.VPop +import qualified Command.VCycle import qualified Command.Reinject import qualified Command.Fix import qualified Command.Init @@ -134,6 +140,12 @@ cmds = concat , Command.TransferKey.def , Command.TransferKeys.def , Command.ReKey.def + , Command.MetaData.def + , Command.View.def + , Command.VAdd.def + , Command.VFilter.def + , Command.VPop.def + , Command.VCycle.def , Command.Fix.def , Command.Fsck.def , Command.Repair.def diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs index fcf5deaf02..f9f5989ee5 100644 --- a/CmdLine/GitAnnex/Options.hs +++ b/CmdLine/GitAnnex/Options.hs @@ -54,6 +54,8 @@ gitAnnexOptions = commonOptions ++ "match files larger than a size" , Option [] ["smallerthan"] (ReqArg Limit.addSmallerThan paramSize) "match files smaller than a size" + , Option [] ["metadata"] (ReqArg Limit.addMetaData "FIELD=VALUE") + "match files with attached metadata" , Option [] ["want-get"] (NoArg Limit.Wanted.addWantGet) "match files the repository wants to get" , Option [] ["want-drop"] (NoArg Limit.Wanted.addWantDrop) diff --git a/CmdLine/GitAnnexShell/Fields.hs b/CmdLine/GitAnnexShell/Fields.hs index e71f2c2a0d..4f208773b9 100644 --- a/CmdLine/GitAnnexShell/Fields.hs +++ b/CmdLine/GitAnnexShell/Fields.hs @@ -9,6 +9,7 @@ module CmdLine.GitAnnexShell.Fields where import Common.Annex import qualified Annex +import Git.FilePath import Data.Char @@ -29,7 +30,7 @@ remoteUUID = Field "remoteuuid" $ associatedFile :: Field associatedFile = Field "associatedfile" $ \f -> -- is the file a safe relative filename? - not (isAbsolute f) && not ("../" `isPrefixOf` f) + not (absoluteGitPath f) && not ("../" `isPrefixOf` f) direct :: Field direct = Field "direct" $ \f -> f == "1" diff --git a/Command.hs b/Command.hs index 83d67bffd9..3faa4053c9 100644 --- a/Command.hs +++ b/Command.hs @@ -5,8 +5,6 @@ - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE BangPatterns #-} - module Command ( command, noRepo, diff --git a/Command/Dead.hs b/Command/Dead.hs index 13aa74bffa..f9e5c2e27b 100644 --- a/Command/Dead.hs +++ b/Command/Dead.hs @@ -7,34 +7,13 @@ module Command.Dead where -import Common.Annex import Command -import qualified Remote -import Logs.Trust -import Logs.Group - -import qualified Data.Set as S +import Types.TrustLevel +import Command.Trust (trustCommand) def :: [Command] def = [command "dead" (paramRepeating paramRemote) seek SectionSetup "hide a lost repository"] seek :: CommandSeek -seek = withWords start - -start :: [String] -> CommandStart -start ws = do - let name = unwords ws - showStart "dead" name - u <- Remote.nameToUUID name - next $ perform u - -perform :: UUID -> CommandPerform -perform uuid = do - markDead uuid - next $ return True - -markDead :: UUID -> Annex () -markDead uuid = do - trustSet uuid DeadTrusted - groupSet uuid S.empty +seek = trustCommand "dead" DeadTrusted diff --git a/Command/EnableRemote.hs b/Command/EnableRemote.hs index a00046d5a5..42ab433740 100644 --- a/Command/EnableRemote.hs +++ b/Command/EnableRemote.hs @@ -47,7 +47,7 @@ unknownNameError prefix = do perform :: RemoteType -> UUID -> R.RemoteConfig -> CommandPerform perform t u c = do - (c', u') <- R.setup t (Just u) c + (c', u') <- R.setup t (Just u) Nothing c next $ cleanup u' c' cleanup :: UUID -> R.RemoteConfig -> CommandCleanup diff --git a/Command/Fsck.hs b/Command/Fsck.hs index dfe1a9ab64..6cf444967c 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -31,12 +31,8 @@ import Config import Types.Key import Utility.HumanTime import Git.FilePath +import Utility.PID -#ifndef mingw32_HOST_OS -import System.Posix.Process (getProcessID) -#else -import System.Win32.Process.Current (getCurrentProcessId) -#endif import Data.Time.Clock.POSIX import Data.Time import System.Posix.Types (EpochTime) @@ -72,7 +68,7 @@ seek ps = do from <- getOptionField fsckFromOption Remote.byNameWithUUID i <- getIncremental withKeyOptions - (startKey i) + (\k -> startKey i k =<< getNumCopies) (withFilesInGit $ whenAnnexed $ start from i) ps @@ -84,11 +80,12 @@ getIncremental = do morei <- Annex.getFlag (optionName moreIncrementalOption) case (i, starti, morei) of (False, False, False) -> return NonIncremental - (False, True, _) -> startIncremental + (False, True, False) -> startIncremental (False ,False, True) -> ContIncremental <$> getStartTime - (True, _, _) -> + (True, False, False) -> maybe startIncremental (return . ContIncremental . Just) =<< getStartTime + _ -> error "Specify only one of --incremental, --more, or --incremental-schedule" where startIncremental = do recordStartTime @@ -149,14 +146,10 @@ performRemote key file backend numcopies remote = , checkKeyNumCopies key file numcopies ] withtmp a = do -#ifndef mingw32_HOST_OS - v <- liftIO getProcessID -#else - v <- liftIO getCurrentProcessId -#endif + pid <- liftIO getPID t <- fromRepo gitAnnexTmpDir createAnnexDirectory t - let tmp = t "fsck" ++ show v ++ "." ++ keyFile key + let tmp = t "fsck" ++ show pid ++ "." ++ keyFile key let cleanup = liftIO $ catchIO (removeFile tmp) (const noop) cleanup cleanup `after` a tmp @@ -170,18 +163,19 @@ performRemote key file backend numcopies remote = ) dummymeter _ = noop -startKey :: Incremental -> Key -> CommandStart -startKey inc key = case Backend.maybeLookupBackendName (Types.Key.keyBackendName key) of - Nothing -> stop - Just backend -> runFsck inc (key2file key) key $ performAll key backend +startKey :: Incremental -> Key -> NumCopies -> CommandStart +startKey inc key numcopies = + case Backend.maybeLookupBackendName (Types.Key.keyBackendName key) of + Nothing -> stop + Just backend -> runFsck inc (key2file key) key $ + performKey key backend numcopies -{- Note that numcopies cannot be checked in --all mode, since we do not - - have associated filenames to look up in the .gitattributes file. -} -performAll :: Key -> Backend -> Annex Bool -performAll key backend = check +performKey :: Key -> Backend -> NumCopies -> Annex Bool +performKey key backend numcopies = check [ verifyLocationLog key (key2file key) , checkKeySize key , checkBackend backend key Nothing + , checkKeyNumCopies key (key2file key) numcopies ] check :: [Annex Bool] -> Annex Bool @@ -365,7 +359,7 @@ checkBackendOr' bad backend key file postcheck = , return True ) -checkKeyNumCopies :: Key -> FilePath -> NumCopies -> Annex Bool +checkKeyNumCopies :: Key -> String -> NumCopies -> Annex Bool checkKeyNumCopies key file numcopies = do (untrustedlocations, safelocations) <- trustPartition UnTrusted =<< Remote.keyLocations key let present = NumCopies (length safelocations) @@ -415,7 +409,7 @@ badContentRemote remote key = do ++ Remote.name remote data Incremental = StartIncremental | ContIncremental (Maybe EpochTime) | NonIncremental - deriving (Eq) + deriving (Eq, Show) runFsck :: Incremental -> FilePath -> Key -> Annex Bool -> CommandStart runFsck inc file key a = ifM (needFsck inc key) @@ -471,7 +465,9 @@ getFsckTime key = do - - To guard against time stamp damange (for example, if an annex directory - is copied without -a), the fsckstate file contains a time that should - - be identical to its modification time. -} + - be identical to its modification time. + - (This is not possible to do on Windows.) + -} recordStartTime :: Annex () recordStartTime = do f <- fromRepo gitAnnexFsckState @@ -479,8 +475,12 @@ recordStartTime = do liftIO $ do nukeFile f withFile f WriteMode $ \h -> do +#ifndef mingw32_HOST_OS t <- modificationTime <$> getFileStatus f hPutStr h $ showTime $ realToFrac t +#else + noop +#endif where showTime :: POSIXTime -> String showTime = show @@ -494,10 +494,14 @@ getStartTime = do f <- fromRepo gitAnnexFsckState liftIO $ catchDefaultIO Nothing $ do timestamp <- modificationTime <$> getFileStatus f +#ifndef mingw32_HOST_OS t <- readishTime <$> readFile f return $ if Just (realToFrac timestamp) == t then Just timestamp else Nothing +#else + return $ Just timestamp +#endif where readishTime :: String -> Maybe POSIXTime readishTime s = utcTimeToPOSIXSeconds <$> diff --git a/Command/FuzzTest.hs b/Command/FuzzTest.hs index 2ed0fed62a..08103edc87 100644 --- a/Command/FuzzTest.hs +++ b/Command/FuzzTest.hs @@ -146,13 +146,6 @@ genFuzzFile = do genFuzzDir :: IO FuzzDir genFuzzDir = mkFuzzDir <$> (getStdRandom (randomR (1,16)) :: IO Int) -localFile :: FilePath -> Bool -localFile f - | isAbsolute f = False - | ".." `isInfixOf` f = False - | ".git" `isPrefixOf` f = False - | otherwise = True - data TimeStampedFuzzAction = Started UTCTime FuzzAction | Finished UTCTime Bool diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs index 79fbcf39c5..dc54023ccb 100644 --- a/Command/InitRemote.hs +++ b/Command/InitRemote.hs @@ -44,7 +44,7 @@ start (name:ws) = ifM (isJust <$> findExisting name) perform :: RemoteType -> String -> R.RemoteConfig -> CommandPerform perform t name c = do - (c', u) <- R.setup t Nothing c + (c', u) <- R.setup t Nothing Nothing c next $ cleanup u name c' cleanup :: UUID -> String -> R.RemoteConfig -> CommandCleanup diff --git a/Command/Log.hs b/Command/Log.hs index 1dd5aa51ab..84583a93a8 100644 --- a/Command/Log.hs +++ b/Command/Log.hs @@ -140,7 +140,7 @@ getLog key os = do [ Params "log -z --pretty=format:%ct --raw --abbrev=40" , Param "--remove-empty" ] ++ os ++ - [ Param $ show Annex.Branch.fullname + [ Param $ Git.fromRef Annex.Branch.fullname , Param "--" , Param logfile ] diff --git a/Command/MetaData.hs b/Command/MetaData.hs new file mode 100644 index 0000000000..6112dd0951 --- /dev/null +++ b/Command/MetaData.hs @@ -0,0 +1,68 @@ +{- git-annex command + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.MetaData where + +import Common.Annex +import qualified Annex +import Command +import Logs.MetaData +import Types.MetaData + +import qualified Data.Set as S +import Data.Time.Clock.POSIX + +def :: [Command] +def = [withOptions [setOption, tagOption, untagOption] $ + command "metadata" paramPaths seek + SectionMetaData "sets metadata of a file"] + +storeModMeta :: ModMeta -> Annex () +storeModMeta modmeta = Annex.changeState $ + \s -> s { Annex.modmeta = modmeta:Annex.modmeta s } + +setOption :: Option +setOption = Option ['s'] ["set"] (ReqArg mkmod "FIELD[+-]=VALUE") "set metadata" + where + mkmod = either error storeModMeta . parseModMeta + +tagOption :: Option +tagOption = Option ['t'] ["tag"] (ReqArg mkmod "TAG") "set a tag" + where + mkmod = storeModMeta . AddMeta tagMetaField . toMetaValue + +untagOption :: Option +untagOption = Option ['u'] ["untag"] (ReqArg mkmod "TAG") "remove a tag" + where + mkmod = storeModMeta . AddMeta tagMetaField . mkMetaValue (CurrentlySet False) + +seek :: CommandSeek +seek ps = do + modmeta <- Annex.getState Annex.modmeta + now <- liftIO getPOSIXTime + withFilesInGit (whenAnnexed $ start now modmeta) ps + +start :: POSIXTime -> [ModMeta] -> FilePath -> (Key, Backend) -> CommandStart +start now ms file (k, _) = do + showStart "metadata" file + next $ perform now ms k + +perform :: POSIXTime -> [ModMeta] -> Key -> CommandPerform +perform _ [] k = next $ cleanup k +perform now ms k = do + oldm <- getCurrentMetaData k + let m = foldl' unionMetaData newMetaData $ map (modMeta oldm) ms + addMetaData' k m now + next $ cleanup k + +cleanup :: Key -> CommandCleanup +cleanup k = do + m <- getCurrentMetaData k + showLongNote $ unlines $ concatMap showmeta $ fromMetaData $ currentMetaData m + return True + where + showmeta (f, vs) = map (\v -> fromMetaField f ++ "=" ++ fromMetaValue v) $ S.toList vs diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs index 388d065c0f..4b90b5c2e7 100644 --- a/Command/PreCommit.hs +++ b/Command/PreCommit.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010, 2013 Joey Hess + - Copyright 2010-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -13,6 +13,13 @@ import Config import qualified Command.Add import qualified Command.Fix import Annex.Direct +import Annex.View +import Logs.View +import Logs.MetaData +import Types.View +import Types.MetaData + +import qualified Data.Set as S def :: [Command] def = [command "pre-commit" paramPaths seek SectionPlumbing @@ -27,13 +34,45 @@ seek ps = ifM isDirect withFilesToBeCommitted (whenAnnexed Command.Fix.start) ps -- inject unlocked files into the annex withFilesUnlockedToBeCommitted startIndirect ps + -- committing changes to a view updates metadata + mv <- currentView + case mv of + Nothing -> noop + Just v -> withViewChanges + (addViewMetaData v) + (removeViewMetaData v) ) startIndirect :: FilePath -> CommandStart -startIndirect file = next $ do - unlessM (callCommandAction $ Command.Add.start file) $ - error $ "failed to add " ++ file ++ "; canceling commit" +startIndirect f = next $ do + unlessM (callCommandAction $ Command.Add.start f) $ + error $ "failed to add " ++ f ++ "; canceling commit" next $ return True startDirect :: [String] -> CommandStart startDirect _ = next $ next $ preCommitDirect + +addViewMetaData :: View -> FileView -> Key -> CommandStart +addViewMetaData v f k = do + showStart "metadata" f + next $ next $ changeMetaData k $ fromView v f + +removeViewMetaData :: View -> FileView -> Key -> CommandStart +removeViewMetaData v f k = do + showStart "metadata" f + next $ next $ changeMetaData k $ unsetMetaData $ fromView v f + +changeMetaData :: Key -> MetaData -> CommandCleanup +changeMetaData k metadata = do + showMetaDataChange metadata + addMetaData k metadata + return True + +showMetaDataChange :: MetaData -> Annex () +showMetaDataChange = showLongNote . unlines . concatMap showmeta . fromMetaData + where + showmeta (f, vs) = map (showmetavalue f) $ S.toList vs + showmetavalue f v = fromMetaField f ++ showset v ++ "=" ++ fromMetaValue v + showset v + | isSet v = "+" + | otherwise = "-" diff --git a/Command/Repair.hs b/Command/Repair.hs index c873176851..56925d83da 100644 --- a/Command/Repair.hs +++ b/Command/Repair.hs @@ -81,4 +81,4 @@ trackingOrSyncBranch :: Ref -> Bool trackingOrSyncBranch b = Git.Repair.isTrackingBranch b || isAnnexSyncBranch b isAnnexSyncBranch :: Ref -> Bool -isAnnexSyncBranch b = "refs/synced/" `isPrefixOf` show b +isAnnexSyncBranch b = "refs/synced/" `isPrefixOf` fromRef b diff --git a/Command/Semitrust.hs b/Command/Semitrust.hs index 26ce6961bb..edba27346a 100644 --- a/Command/Semitrust.hs +++ b/Command/Semitrust.hs @@ -7,26 +7,13 @@ module Command.Semitrust where -import Common.Annex import Command -import qualified Remote -import Logs.Trust +import Types.TrustLevel +import Command.Trust (trustCommand) def :: [Command] def = [command "semitrust" (paramRepeating paramRemote) seek SectionSetup "return repository to default trust level"] seek :: CommandSeek -seek = withWords start - -start :: [String] -> CommandStart -start ws = do - let name = unwords ws - showStart "semitrust" name - u <- Remote.nameToUUID name - next $ perform u - -perform :: UUID -> CommandPerform -perform uuid = do - trustSet uuid SemiTrusted - next $ return True +seek = trustCommand "semitrust" SemiTrusted diff --git a/Command/Sync.hs b/Command/Sync.hs index 331f5d03ff..f041b5d238 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -86,7 +86,7 @@ seek rs = do , [ mergeAnnex ] ] whenM (Annex.getFlag $ optionName contentOption) $ - whenM (seekSyncContent dataremotes) $ do + whenM (seekSyncContent dataremotes) $ -- Transferring content can take a while, -- and other changes can be pushed to the git-annex -- branch on the remotes in the meantime, so pull @@ -192,12 +192,12 @@ pushLocal (Just branch) = do updateBranch :: Git.Ref -> Git.Repo -> IO () updateBranch syncbranch g = - unlessM go $ error $ "failed to update " ++ show syncbranch + unlessM go $ error $ "failed to update " ++ Git.fromRef syncbranch where go = Git.Command.runBool [ Param "branch" , Param "-f" - , Param $ show $ Git.Ref.base syncbranch + , Param $ Git.fromRef $ Git.Ref.base syncbranch ] g pullRemote :: Remote -> Maybe Git.Ref -> CommandStart @@ -224,7 +224,7 @@ mergeRemote remote b = case b of Just _ -> and <$> (mapM merge =<< tomerge (branchlist b)) where merge = mergeFrom . remoteBranch remote - tomerge branches = filterM (changed remote) branches + tomerge = filterM (changed remote) branchlist Nothing = [] branchlist (Just branch) = [branch, syncBranch branch] @@ -283,15 +283,15 @@ pushBranch remote branch g = tryIO (directpush g) `after` syncpush g , refspec branch ] directpush = Git.Command.runQuiet $ pushparams - [show $ Git.Ref.base $ fromDirectBranch branch] + [Git.fromRef $ Git.Ref.base $ fromDirectBranch branch] pushparams branches = [ Param "push" , Param $ Remote.name remote ] ++ map Param branches refspec b = concat - [ show $ Git.Ref.base b + [ Git.fromRef $ Git.Ref.base b , ":" - , show $ Git.Ref.base $ syncBranch b + , Git.fromRef $ Git.Ref.base $ syncBranch b ] commitAnnex :: CommandStart @@ -452,7 +452,7 @@ resolveMerge' u Just target -> do unlessM (coreSymlinks <$> Annex.getGitConfig) $ addAnnexLink target f - maybe noop (flip toDirect f) + maybe noop (`toDirect` f) (fileKey (takeFileName target)) {- git-merge moves conflicting files away to files @@ -535,7 +535,7 @@ newer remote b = do -} seekSyncContent :: [Remote] -> Annex Bool seekSyncContent rs = do - mvar <- liftIO $ newEmptyMVar + mvar <- liftIO newEmptyMVar mapM_ (go mvar) =<< seekHelper LsFiles.inRepo [] liftIO $ not <$> isEmptyMVar mvar where @@ -552,7 +552,7 @@ syncFile rs f (k, _) = do putrs <- catMaybes . snd . unzip <$> (sequence =<< handleput lack) u <- getUUID - let locs' = concat [if got then [u] else [], putrs, locs] + let locs' = concat [[u | got], putrs, locs] -- Using callCommandAction rather than commandAction for drops, -- because a failure to drop does not mean the sync failed. @@ -576,7 +576,7 @@ syncFile rs f (k, _) = do | Remote.readonly r || remoteAnnexReadOnly (Types.Remote.gitconfig r) = return False | otherwise = wantSend True (Just k) (Just f) (Remote.uuid r) handleput lack = ifM (inAnnex k) - ( map put <$> (filterM wantput lack) + ( map put <$> filterM wantput lack , return [] ) put dest = do diff --git a/Command/Trust.hs b/Command/Trust.hs index 3898af347a..c0f0136994 100644 --- a/Command/Trust.hs +++ b/Command/Trust.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010 Joey Hess + - Copyright 2010, 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -10,23 +10,32 @@ module Command.Trust where import Common.Annex import Command import qualified Remote +import Types.TrustLevel import Logs.Trust +import Logs.Group + +import qualified Data.Set as S def :: [Command] def = [command "trust" (paramRepeating paramRemote) seek SectionSetup "trust a repository"] seek :: CommandSeek -seek = withWords start +seek = trustCommand "trust" Trusted -start :: [String] -> CommandStart -start ws = do - let name = unwords ws - showStart "trust" name - u <- Remote.nameToUUID name - next $ perform u - -perform :: UUID -> CommandPerform -perform uuid = do - trustSet uuid Trusted - next $ return True +trustCommand :: String -> TrustLevel -> CommandSeek +trustCommand cmd level = withWords start + where + start ws = do + let name = unwords ws + showStart cmd name + u <- Remote.nameToUUID name + next $ perform u + perform uuid = do + trustSet uuid level + when (level == DeadTrusted) $ + groupSet uuid S.empty + l <- lookupTrust uuid + when (l /= level) $ + warning $ "This remote's trust level is locally overridden to " ++ showTrustLevel l ++ " via git config." + next $ return True diff --git a/Command/Uninit.hs b/Command/Uninit.hs index 3bf6dbe005..1c8d086895 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -24,7 +24,7 @@ check :: Annex () check = do b <- current_branch when (b == Annex.Branch.name) $ error $ - "cannot uninit when the " ++ show b ++ " branch is checked out" + "cannot uninit when the " ++ Git.fromRef b ++ " branch is checked out" top <- fromRepo Git.repoPath cwd <- liftIO getCurrentDirectory whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath cwd)) $ @@ -77,7 +77,7 @@ finish = do -- avoid normal shutdown saveState False inRepo $ Git.Command.run - [Param "branch", Param "-D", Param $ show Annex.Branch.name] + [Param "branch", Param "-D", Param $ Git.fromRef Annex.Branch.name] liftIO exitSuccess {- Keys that were moved out of the annex have a hard link still in the diff --git a/Command/Untrust.hs b/Command/Untrust.hs index cde1eee930..4c1035dcd6 100644 --- a/Command/Untrust.hs +++ b/Command/Untrust.hs @@ -7,26 +7,13 @@ module Command.Untrust where -import Common.Annex import Command -import qualified Remote -import Logs.Trust +import Types.TrustLevel +import Command.Trust (trustCommand) def :: [Command] def = [command "untrust" (paramRepeating paramRemote) seek SectionSetup "do not trust a repository"] seek :: CommandSeek -seek = withWords start - -start :: [String] -> CommandStart -start ws = do - let name = unwords ws - showStart "untrust" name - u <- Remote.nameToUUID name - next $ perform u - -perform :: UUID -> CommandPerform -perform uuid = do - trustSet uuid UnTrusted - next $ return True +seek = trustCommand "untrust" UnTrusted diff --git a/Command/Unused.hs b/Command/Unused.hs index 312c26adf4..d48956920c 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -266,7 +266,7 @@ withKeysReferencedInGit a = do map (separate (== ' ')) . lines nubRefs = map (Git.Ref . snd) . nubBy (\(x, _) (y, _) -> x == y) - ourbranchend = '/' : show Annex.Branch.name + ourbranchend = '/' : Git.fromRef Annex.Branch.name ourbranches (_, b) = not (ourbranchend `isSuffixOf` b) && not ("refs/synced/" `isPrefixOf` b) addHead headRef refs = case headRef of diff --git a/Command/VAdd.hs b/Command/VAdd.hs new file mode 100644 index 0000000000..3dc1fd4cfd --- /dev/null +++ b/Command/VAdd.hs @@ -0,0 +1,36 @@ +{- git-annex command + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.VAdd where + +import Common.Annex +import Command +import Annex.View +import Command.View (paramView, parseViewParam, checkoutViewBranch) + +def :: [Command] +def = [notBareRepo $ notDirect $ + command "vadd" paramView seek SectionMetaData "add subdirs to current view"] + +seek :: CommandSeek +seek = withWords start + +start :: [String] -> CommandStart +start params = do + showStart "vadd" "" + withCurrentView $ \view -> do + let (view', change) = refineView view $ + map parseViewParam $ reverse params + case change of + Unchanged -> do + showNote "unchanged" + next $ next $ return True + Narrowing -> next $ next $ do + if visibleViewSize view' == visibleViewSize view + then error "That would not add an additional level of directory structure to the view. To filter the view, use vfilter instead of vadd." + else checkoutViewBranch view' narrowView + Widening -> error "Widening view to match more files is not currently supported." diff --git a/Command/VCycle.hs b/Command/VCycle.hs new file mode 100644 index 0000000000..b41e099a48 --- /dev/null +++ b/Command/VCycle.hs @@ -0,0 +1,41 @@ +{- git-annex command + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.VCycle where + +import Common.Annex +import Command +import Annex.View +import Types.View +import Logs.View +import Command.View (checkoutViewBranch) + +def :: [Command] +def = [notBareRepo $ notDirect $ + command "vcycle" paramNothing seek SectionUtility + "switch view to next layout"] + +seek :: CommandSeek +seek = withNothing start + +start ::CommandStart +start = go =<< currentView + where + go Nothing = error "Not in a view." + go (Just v) = do + showStart "vcycle" "" + let v' = v { viewComponents = vcycle [] (viewComponents v) } + if v == v' + then do + showNote "unchanged" + next $ next $ return True + else next $ next $ checkoutViewBranch v' narrowView + + vcycle rest (c:cs) + | multiValue (viewFilter c) = rest ++ cs ++ [c] + | otherwise = vcycle (c:rest) cs + vcycle rest c = rest ++ c diff --git a/Command/VFilter.hs b/Command/VFilter.hs new file mode 100644 index 0000000000..c16b289568 --- /dev/null +++ b/Command/VFilter.hs @@ -0,0 +1,30 @@ +{- git-annex command + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.VFilter where + +import Common.Annex +import Command +import Annex.View +import Command.View (paramView, parseViewParam, checkoutViewBranch) + +def :: [Command] +def = [notBareRepo $ notDirect $ + command "vfilter" paramView seek SectionMetaData "filter current view"] + +seek :: CommandSeek +seek = withWords start + +start :: [String] -> CommandStart +start params = do + showStart "vfilter" "" + withCurrentView $ \view -> do + let view' = filterView view $ + map parseViewParam $ reverse params + next $ next $ if visibleViewSize view' > visibleViewSize view + then error "That would add an additional level of directory structure to the view, rather than filtering it. If you want to do that, use vadd instead of vfilter." + else checkoutViewBranch view' narrowView diff --git a/Command/VPop.hs b/Command/VPop.hs new file mode 100644 index 0000000000..706a522f87 --- /dev/null +++ b/Command/VPop.hs @@ -0,0 +1,50 @@ +{- git-annex command + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.VPop where + +import Common.Annex +import Command +import qualified Git +import qualified Git.Command +import qualified Git.Ref +import Types.View +import Logs.View +import Command.View (checkoutViewBranch) + +def :: [Command] +def = [notBareRepo $ notDirect $ + command "vpop" (paramOptional paramNumber) seek SectionMetaData + "switch back to previous view"] + +seek :: CommandSeek +seek = withWords start + +start :: [String] -> CommandStart +start ps = go =<< currentView + where + go Nothing = error "Not in a view." + go (Just v) = do + showStart "vpop" (show num) + removeView v + (oldvs, vs) <- splitAt (num - 1) . filter (sameparentbranch v) + <$> recentViews + mapM_ removeView oldvs + case vs of + (oldv:_) -> next $ next $ do + showOutput + checkoutViewBranch oldv (return . branchView) + _ -> next $ next $ do + showOutput + inRepo $ Git.Command.runBool + [ Param "checkout" + , Param $ Git.fromRef $ Git.Ref.base $ + viewParentBranch v + ] + sameparentbranch a b = viewParentBranch a == viewParentBranch b + + num = fromMaybe 1 $ readish =<< headMaybe ps diff --git a/Command/View.hs b/Command/View.hs new file mode 100644 index 0000000000..17e136f7be --- /dev/null +++ b/Command/View.hs @@ -0,0 +1,90 @@ +{- git-annex command + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.View where + +import Common.Annex +import Command +import qualified Git +import qualified Git.Command +import qualified Git.Ref +import qualified Git.Branch +import Types.MetaData +import Types.View +import Annex.View +import Logs.View + +def :: [Command] +def = [notBareRepo $ notDirect $ + command "view" paramView seek SectionMetaData "enter a view branch"] + +seek :: CommandSeek +seek = withWords start + +start :: [String] -> CommandStart +start [] = error "Specify metadata to include in view" +start params = do + showStart "view" "" + view <- mkView params + go view =<< currentView + where + go view Nothing = next $ perform view + go view (Just v) + | v == view = stop + | otherwise = error "Already in a view. Use 'git annex vadd' to further refine this view." + +perform :: View -> CommandPerform +perform view = do + showSideAction "searching" + next $ checkoutViewBranch view applyView + +paramView :: String +paramView = paramPair (paramRepeating "FIELD=VALUE") (paramRepeating "TAG") + +parseViewParam :: String -> (MetaField, String) +parseViewParam s = case separate (== '=') s of + (tag, []) -> (tagMetaField, tag) + (field, wanted) -> either error (\f -> (f, wanted)) (mkMetaField field) + +mkView :: [String] -> Annex View +mkView params = do + v <- View <$> viewbranch <*> pure [] + return $ fst $ refineView v $ + map parseViewParam $ reverse params + where + viewbranch = fromMaybe (error "not on any branch!") + <$> inRepo Git.Branch.current + +checkoutViewBranch :: View -> (View -> Annex Git.Branch) -> CommandCleanup +checkoutViewBranch view mkbranch = do + oldcwd <- liftIO getCurrentDirectory + + {- Change to top of repository before creating view branch. -} + liftIO . setCurrentDirectory =<< fromRepo Git.repoPath + branch <- mkbranch view + + showOutput + ok <- inRepo $ Git.Command.runBool + [ Param "checkout" + , Param (Git.fromRef $ Git.Ref.base branch) + ] + when ok $ do + setView view + {- A git repo can easily have empty directories in it, + - and this pollutes the view, so remove them. -} + liftIO $ removeemptydirs "." + unlessM (liftIO $ doesDirectoryExist oldcwd) $ do + top <- fromRepo Git.repoPath + showLongNote (cwdmissing top) + return ok + where + removeemptydirs top = mapM_ (tryIO . removeDirectory) + =<< dirTreeRecursiveSkipping (".git" `isSuffixOf`) top + cwdmissing top = unlines + [ "This view does not include the subdirectory you are currently in." + , "Perhaps you should: cd " ++ top + ] diff --git a/Creds.hs b/Creds.hs index 3bd87a522a..0586f20703 100644 --- a/Creds.hs +++ b/Creds.hs @@ -1,29 +1,34 @@ {- Credentials storage - - - Copyright 2012 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE CPP #-} - -module Creds where +module Creds ( + module Types.Creds, + CredPairStorage(..), + setRemoteCredPair, + getRemoteCredPairFor, + getRemoteCredPair, + getEnvCredPair, + writeCacheCreds, + readCacheCreds, +) where import Common.Annex +import Types.Creds import Annex.Perms import Utility.FileMode import Crypto import Types.Remote (RemoteConfig, RemoteConfigKey) import Remote.Helper.Encryptable (remoteCipher, embedCreds) -import Utility.Env (setEnv, getEnv) +import Utility.Env (getEnv) import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.Map as M import Utility.Base64 -type Creds = String -- can be any data -type CredPair = (String, String) -- login, password - {- A CredPair can be stored in a file, or in the environment, or perhaps - in a remote's configuration. -} data CredPairStorage = CredPairStorage @@ -33,14 +38,13 @@ data CredPairStorage = CredPairStorage } {- Stores creds in a remote's configuration, if the remote allows - - that. Otherwise, caches them locally. -} -setRemoteCredPair :: RemoteConfig -> CredPairStorage -> Annex RemoteConfig -setRemoteCredPair c storage = - maybe (return c) (setRemoteCredPair' c storage) + - that. Otherwise, caches them locally. + - The creds are found in storage if not provided. -} +setRemoteCredPair :: RemoteConfig -> CredPairStorage -> Maybe CredPair -> Annex RemoteConfig +setRemoteCredPair c storage Nothing = + maybe (return c) (setRemoteCredPair c storage . Just) =<< getRemoteCredPair c storage - -setRemoteCredPair' :: RemoteConfig -> CredPairStorage -> CredPair -> Annex RemoteConfig -setRemoteCredPair' c storage creds +setRemoteCredPair c storage (Just creds) | embedCreds c = case credPairRemoteKey storage of Nothing -> localcache Just key -> storeconfig key =<< remoteCipher c @@ -105,19 +109,6 @@ getEnvCredPair storage = liftM2 (,) where (uenv, penv) = credPairEnvironment storage -{- Stores a CredPair in the environment. -} -setEnvCredPair :: CredPair -> CredPairStorage -> IO () -#ifndef mingw32_HOST_OS -setEnvCredPair (l, p) storage = do - set uenv l - set penv p - where - (uenv, penv) = credPairEnvironment storage - set var val = void $ setEnv var val True -#else -setEnvCredPair _ _ = error "setEnvCredPair TODO" -#endif - writeCacheCredPair :: CredPair -> CredPairStorage -> Annex () writeCacheCredPair credpair storage = writeCacheCreds (encodeCredPair credpair) (credPairFile storage) diff --git a/Git.hs b/Git.hs index cad4668538..55b44a9259 100644 --- a/Git.hs +++ b/Git.hs @@ -13,6 +13,7 @@ module Git ( Repo(..), Ref(..), + fromRef, Branch, Sha, Tag, diff --git a/Git/Branch.hs b/Git/Branch.hs index 405fa108f8..d182ceb395 100644 --- a/Git/Branch.hs +++ b/Git/Branch.hs @@ -28,7 +28,7 @@ current r = do case v of Nothing -> return Nothing Just branch -> - ifM (null <$> pipeReadStrict [Param "show-ref", Param $ show branch] r) + ifM (null <$> pipeReadStrict [Param "show-ref", Param $ fromRef branch] r) ( return Nothing , return v ) @@ -36,7 +36,7 @@ current r = do {- The current branch, which may not really exist yet. -} currentUnsafe :: Repo -> IO (Maybe Git.Ref) currentUnsafe r = parse . firstLine - <$> pipeReadStrict [Param "symbolic-ref", Param $ show Git.Ref.headRef] r + <$> pipeReadStrict [Param "symbolic-ref", Param $ fromRef Git.Ref.headRef] r where parse l | null l = Nothing @@ -51,7 +51,7 @@ changed origbranch newbranch repo where diffs = pipeReadStrict [ Param "log" - , Param (show origbranch ++ ".." ++ show newbranch) + , Param (fromRef origbranch ++ ".." ++ fromRef newbranch) , Params "--oneline -n1" ] repo @@ -74,7 +74,7 @@ fastForward branch (first:rest) repo = where no_ff = return False do_ff to = do - run [Param "update-ref", Param $ show branch, Param $ show to] repo + run [Param "update-ref", Param $ fromRef branch, Param $ fromRef to] repo return True findbest c [] = return $ Just c findbest c (r:rs) @@ -104,14 +104,14 @@ commit allowempty message branch parentrefs repo = do ifM (cancommit tree) ( do sha <- getSha "commit-tree" $ pipeWriteRead - (map Param $ ["commit-tree", show tree] ++ ps) + (map Param $ ["commit-tree", fromRef tree] ++ ps) (Just $ flip hPutStr message) repo update branch sha repo return $ Just sha , return Nothing ) where - ps = concatMap (\r -> ["-p", show r]) parentrefs + ps = concatMap (\r -> ["-p", fromRef r]) parentrefs cancommit tree | allowempty = return True | otherwise = case parentrefs of @@ -130,8 +130,8 @@ forcePush b = "+" ++ b update :: Branch -> Sha -> Repo -> IO () update branch sha = run [ Param "update-ref" - , Param $ show branch - , Param $ show sha + , Param $ fromRef branch + , Param $ fromRef sha ] {- Checks out a branch, creating it if necessary. -} @@ -140,7 +140,7 @@ checkout branch = run [ Param "checkout" , Param "-q" , Param "-B" - , Param $ show $ Git.Ref.base branch + , Param $ fromRef $ Git.Ref.base branch ] {- Removes a branch. -} @@ -149,5 +149,5 @@ delete branch = run [ Param "branch" , Param "-q" , Param "-D" - , Param $ show $ Git.Ref.base branch + , Param $ fromRef $ Git.Ref.base branch ] diff --git a/Git/CatFile.hs b/Git/CatFile.hs index aee6bd19f4..c8cb76d591 100644 --- a/Git/CatFile.hs +++ b/Git/CatFile.hs @@ -50,7 +50,7 @@ catFileStop (CatFileHandle p _) = CoProcess.stop p {- Reads a file from a specified branch. -} catFile :: CatFileHandle -> Branch -> FilePath -> IO L.ByteString catFile h branch file = catObject h $ Ref $ - show branch ++ ":" ++ toInternalGitPath file + fromRef branch ++ ":" ++ toInternalGitPath file {- Uses a running git cat-file read the content of an object. - Objects that do not exist will have "" returned. -} @@ -60,7 +60,7 @@ catObject h object = maybe L.empty fst3 <$> catObjectDetails h object catObjectDetails :: CatFileHandle -> Ref -> IO (Maybe (L.ByteString, Sha, ObjectType)) catObjectDetails (CatFileHandle hdl _) object = CoProcess.query hdl send receive where - query = show object + query = fromRef object send to = hPutStrLn to query receive from = do header <- hGetLine from @@ -72,8 +72,8 @@ catObjectDetails (CatFileHandle hdl _) object = CoProcess.query hdl send receive _ -> dne | otherwise -> dne _ - | header == show object ++ " missing" -> dne - | otherwise -> error $ "unknown response from git cat-file " ++ show (header, object) + | header == fromRef object ++ " missing" -> dne + | otherwise -> error $ "unknown response from git cat-file " ++ show (header, query) readcontent objtype bytes from sha = do content <- S.hGet from bytes eatchar '\n' from diff --git a/Git/Command.hs b/Git/Command.hs index 90abc7e4f3..0fa3d1b3b6 100644 --- a/Git/Command.hs +++ b/Git/Command.hs @@ -25,18 +25,10 @@ gitCommandLine :: [CommandParam] -> Repo -> [CommandParam] gitCommandLine params r@(Repo { location = l@(Local _ _ ) }) = setdir : settree ++ gitGlobalOpts r ++ params where - setdir = Param $ "--git-dir=" ++ gitpath (gitdir l) + setdir = Param $ "--git-dir=" ++ gitdir l settree = case worktree l of Nothing -> [] - Just t -> [Param $ "--work-tree=" ++ gitpath t] -#ifdef mingw32_HOST_OS - -- despite running on windows, msysgit wants a unix-formatted path - gitpath s - | isAbsolute s = "/" ++ dropDrive (toInternalGitPath s) - | otherwise = s -#else - gitpath = id -#endif + Just t -> [Param $ "--work-tree=" ++ t] gitCommandLine _ repo = assertLocal repo $ error "internal" {- Runs git in the specified repo. -} diff --git a/Git/Construct.hs b/Git/Construct.hs index 71a13f49f9..eed2b99300 100644 --- a/Git/Construct.hs +++ b/Git/Construct.hs @@ -33,6 +33,7 @@ import Common import Git.Types import Git import Git.Remote +import Git.FilePath import qualified Git.Url as Url import Utility.UserInfo @@ -57,7 +58,7 @@ fromPath dir = fromAbsPath =<< absPath dir - specified. -} fromAbsPath :: FilePath -> IO Repo fromAbsPath dir - | isAbsolute dir = ifM (doesDirectoryExist dir') ( ret dir' , hunt ) + | absoluteGitPath dir = ifM (doesDirectoryExist dir') ( ret dir' , hunt ) | otherwise = error $ "internal error, " ++ dir ++ " is not absolute" where diff --git a/Git/DiffTree.hs b/Git/DiffTree.hs index c82cf78cd0..9e4fef9d62 100644 --- a/Git/DiffTree.hs +++ b/Git/DiffTree.hs @@ -36,12 +36,12 @@ data DiffTreeItem = DiffTreeItem {- Diffs two tree Refs. -} diffTree :: Ref -> Ref -> Repo -> IO ([DiffTreeItem], IO Bool) diffTree src dst = getdiff (Param "diff-tree") - [Param (show src), Param (show dst)] + [Param (fromRef src), Param (fromRef dst)] {- Diffs two tree Refs, recursing into sub-trees -} diffTreeRecursive :: Ref -> Ref -> Repo -> IO ([DiffTreeItem], IO Bool) diffTreeRecursive src dst = getdiff (Param "diff-tree") - [Param "-r", Param (show src), Param (show dst)] + [Param "-r", Param (fromRef src), Param (fromRef dst)] {- Diffs between a tree and the index. Does nothing if there is not yet a - commit in the repository. -} @@ -61,7 +61,7 @@ diffIndex' :: Ref -> [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool) diffIndex' ref params repo = ifM (Git.Ref.headExists repo) ( getdiff (Param "diff-index") - ( params ++ [Param $ show ref] ) + ( params ++ [Param $ fromRef ref] ) repo , return ([], return True) ) diff --git a/Git/FilePath.hs b/Git/FilePath.hs index 4189244fc6..42eb0812e3 100644 --- a/Git/FilePath.hs +++ b/Git/FilePath.hs @@ -20,12 +20,15 @@ module Git.FilePath ( asTopFilePath, InternalGitPath, toInternalGitPath, - fromInternalGitPath + fromInternalGitPath, + absoluteGitPath ) where import Common import Git +import qualified System.FilePath.Posix + {- A FilePath, relative to the top of the git repository. -} newtype TopFilePath = TopFilePath { getTopFilePath :: FilePath } deriving (Show) @@ -48,8 +51,7 @@ asTopFilePath file = TopFilePath file - it internally. - - On Windows, git uses '/' to separate paths stored in the repository, - - despite Windows using '\'. Also, git on windows dislikes paths starting - - with "./" or ".\". + - despite Windows using '\'. - -} type InternalGitPath = String @@ -58,11 +60,7 @@ toInternalGitPath :: FilePath -> InternalGitPath #ifndef mingw32_HOST_OS toInternalGitPath = id #else -toInternalGitPath p = - let p' = replace "\\" "/" p - in if "./" `isPrefixOf` p' - then dropWhile (== '/') (drop 1 p') - else p' +toInternalGitPath = replace "\\" "/" #endif fromInternalGitPath :: InternalGitPath -> FilePath @@ -71,3 +69,10 @@ fromInternalGitPath = id #else fromInternalGitPath = replace "/" "\\" #endif + +{- isAbsolute on Windows does not think "/foo" or "\foo" is absolute, + - so try posix paths. + -} +absoluteGitPath :: FilePath -> Bool +absoluteGitPath p = isAbsolute p || + System.FilePath.Posix.isAbsolute (toInternalGitPath p) diff --git a/Git/Fsck.hs b/Git/Fsck.hs index 23d3a35580..e90683bc0e 100644 --- a/Git/Fsck.hs +++ b/Git/Fsck.hs @@ -74,7 +74,7 @@ isMissing s r = either (const True) (const False) <$> tryIO dump where dump = runQuiet [ Param "show" - , Param (show s) + , Param (fromRef s) ] r findShas :: Bool -> String -> [Sha] diff --git a/Git/HashObject.hs b/Git/HashObject.hs index bb9b20d96d..97e1befe67 100644 --- a/Git/HashObject.hs +++ b/Git/HashObject.hs @@ -1,6 +1,6 @@ {- git hash-object interface - - - Copyright 2011-2012 Joey Hess + - Copyright 2011-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -13,6 +13,7 @@ import Git.Sha import Git.Command import Git.Types import qualified Utility.CoProcess as CoProcess +import Utility.Tmp type HashObjectHandle = CoProcess.CoProcessHandle @@ -34,7 +35,18 @@ hashFile h file = CoProcess.query h send receive send to = hPutStrLn to file receive from = getSha "hash-object" $ hGetLine from -{- Injects some content into git, returning its Sha. -} +{- Injects a blob into git. Unfortunately, the current git-hash-object + - interface does not allow batch hashing without using temp files. -} +hashBlob :: HashObjectHandle -> String -> IO Sha +hashBlob h s = withTmpFile "hash" $ \tmp tmph -> do + hPutStr tmph s + hClose tmph + hashFile h tmp + +{- Injects some content into git, returning its Sha. + - + - Avoids using a tmp file, but runs a new hash-object command each + - time called. -} hashObject :: ObjectType -> String -> Repo -> IO Sha hashObject objtype content = hashObject' objtype (flip hPutStr content) diff --git a/Git/LsTree.hs b/Git/LsTree.hs index 956f9f5b4d..6d3ca4813e 100644 --- a/Git/LsTree.hs +++ b/Git/LsTree.hs @@ -38,13 +38,13 @@ lsTree t repo = map parseLsTree <$> pipeNullSplitZombie (lsTreeParams t) repo lsTreeParams :: Ref -> [CommandParam] -lsTreeParams t = [ Params "ls-tree --full-tree -z -r --", File $ show t ] +lsTreeParams t = [ Params "ls-tree --full-tree -z -r --", File $ fromRef t ] {- Lists specified files in a tree. -} lsTreeFiles :: Ref -> [FilePath] -> Repo -> IO [TreeItem] lsTreeFiles t fs repo = map parseLsTree <$> pipeNullSplitStrict ps repo where - ps = [Params "ls-tree --full-tree -z --", File $ show t] ++ map File fs + ps = [Params "ls-tree --full-tree -z --", File $ fromRef t] ++ map File fs {- Parses a line of ls-tree output. - (The --long format is not currently supported.) -} diff --git a/Git/Merge.hs b/Git/Merge.hs index f5791274f5..948e09e014 100644 --- a/Git/Merge.hs +++ b/Git/Merge.hs @@ -15,7 +15,7 @@ import Git.BuildVersion {- Avoids recent git's interactive merge. -} mergeNonInteractive :: Ref -> Repo -> IO Bool mergeNonInteractive branch - | older "1.7.7.6" = merge [Param $ show branch] - | otherwise = merge [Param "--no-edit", Param $ show branch] + | older "1.7.7.6" = merge [Param $ fromRef branch] + | otherwise = merge [Param "--no-edit", Param $ fromRef branch] where merge ps = runBool $ Param "merge" : ps diff --git a/Git/Objects.hs b/Git/Objects.hs index bb492f558d..516aa6d3ed 100644 --- a/Git/Objects.hs +++ b/Git/Objects.hs @@ -32,4 +32,4 @@ listLooseObjectShas r = catchDefaultIO [] $ looseObjectFile :: Repo -> Sha -> FilePath looseObjectFile r sha = objectsDir r prefix rest where - (prefix, rest) = splitAt 2 (show sha) + (prefix, rest) = splitAt 2 (fromRef sha) diff --git a/Git/Ref.hs b/Git/Ref.hs index 88717ce471..3d0c68fb0f 100644 --- a/Git/Ref.hs +++ b/Git/Ref.hs @@ -20,12 +20,12 @@ headRef = Ref "HEAD" {- Converts a fully qualified git ref into a user-visible string. -} describe :: Ref -> String -describe = show . base +describe = fromRef . base {- Often git refs are fully qualified (eg: refs/heads/master). - Converts such a fully qualified ref into a base ref (eg: master). -} base :: Ref -> Ref -base = Ref . remove "refs/heads/" . remove "refs/remotes/" . show +base = Ref . remove "refs/heads/" . remove "refs/remotes/" . fromRef where remove prefix s | prefix `isPrefixOf` s = drop (length prefix) s @@ -35,13 +35,13 @@ base = Ref . remove "refs/heads/" . remove "refs/remotes/" . show - it under the directory. -} under :: String -> Ref -> Ref under dir r = Ref $ dir ++ "/" ++ - (reverse $ takeWhile (/= '/') $ reverse $ show r) + (reverse $ takeWhile (/= '/') $ reverse $ fromRef r) {- Given a directory such as "refs/remotes/origin", and a ref such as - refs/heads/master, yields a version of that ref under the directory, - such as refs/remotes/origin/master. -} underBase :: String -> Ref -> Ref -underBase dir r = Ref $ dir ++ "/" ++ show (base r) +underBase dir r = Ref $ dir ++ "/" ++ fromRef (base r) {- A Ref that can be used to refer to a file in the repository, as staged - in the index. @@ -64,12 +64,12 @@ fileFromRef (Ref r) f = let (Ref fr) = fileRef f in Ref (r ++ fr) {- Checks if a ref exists. -} exists :: Ref -> Repo -> IO Bool exists ref = runBool - [Param "show-ref", Param "--verify", Param "-q", Param $ show ref] + [Param "show-ref", Param "--verify", Param "-q", Param $ fromRef ref] {- The file used to record a ref. (Git also stores some refs in a - packed-refs file.) -} file :: Ref -> Repo -> FilePath -file ref repo = localGitDir repo show ref +file ref repo = localGitDir repo fromRef ref {- Checks if HEAD exists. It generally will, except for in a repository - that was just created. -} @@ -84,17 +84,17 @@ sha branch repo = process <$> showref repo where showref = pipeReadStrict [Param "show-ref", Param "--hash", -- get the hash - Param $ show branch] + Param $ fromRef branch] process [] = Nothing process s = Just $ Ref $ firstLine s {- List of (shas, branches) matching a given ref or refs. -} matching :: [Ref] -> Repo -> IO [(Sha, Branch)] -matching refs repo = matching' (map show refs) repo +matching refs repo = matching' (map fromRef refs) repo {- Includes HEAD in the output, if asked for it. -} matchingWithHEAD :: [Ref] -> Repo -> IO [(Sha, Branch)] -matchingWithHEAD refs repo = matching' ("--head" : map show refs) repo +matchingWithHEAD refs repo = matching' ("--head" : map fromRef refs) repo {- List of (shas, branches) matching a given ref or refs. -} matching' :: [String] -> Repo -> IO [(Sha, Branch)] @@ -114,7 +114,7 @@ matchingUniq refs repo = nubBy uniqref <$> matching refs repo {- Gets the sha of the tree a ref uses. -} tree :: Ref -> Repo -> IO (Maybe Sha) tree ref = extractSha <$$> pipeReadStrict - [ Param "rev-parse", Param (show ref ++ ":") ] + [ Param "rev-parse", Param (fromRef ref ++ ":") ] {- Checks if a String is a legal git ref name. - diff --git a/Git/RefLog.hs b/Git/RefLog.hs index 3f41e8eaaa..98c9d66ffa 100644 --- a/Git/RefLog.hs +++ b/Git/RefLog.hs @@ -18,5 +18,5 @@ get b = mapMaybe extractSha . lines <$$> pipeReadStrict [ Param "log" , Param "-g" , Param "--format=%H" - , Param (show b) + , Param (fromRef b) ] diff --git a/Git/Repair.hs b/Git/Repair.hs index 2c0983609e..96da5ffe78 100644 --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -168,7 +168,7 @@ resetLocalBranches :: MissingObjects -> GoodCommits -> Repo -> IO ([Branch], [Br resetLocalBranches missing goodcommits r = go [] [] goodcommits =<< filter islocalbranch <$> getAllRefs r where - islocalbranch b = "refs/heads/" `isPrefixOf` show b + islocalbranch b = "refs/heads/" `isPrefixOf` fromRef b go changed deleted gcs [] = return (changed, deleted, gcs) go changed deleted gcs (b:bs) = do (mc, gcs') <- findUncorruptedCommit missing gcs b r @@ -185,12 +185,12 @@ resetLocalBranches missing goodcommits r = nukeBranchRef b r void $ runBool [ Param "branch" - , Param (show $ Ref.base b) - , Param (show c) + , Param (fromRef $ Ref.base b) + , Param (fromRef c) ] r isTrackingBranch :: Ref -> Bool -isTrackingBranch b = "refs/remotes/" `isPrefixOf` show b +isTrackingBranch b = "refs/remotes/" `isPrefixOf` fromRef b {- To deal with missing objects that cannot be recovered, removes - any branches (filtered by a predicate) that reference them @@ -231,10 +231,10 @@ explodePackedRefsFile r = do nukeFile f where makeref (sha, ref) = do - let dest = localGitDir r show ref + let dest = localGitDir r fromRef ref createDirectoryIfMissing True (parentDir dest) unlessM (doesFileExist dest) $ - writeFile dest (show sha) + writeFile dest (fromRef sha) packedRefsFile :: Repo -> FilePath packedRefsFile r = localGitDir r "packed-refs" @@ -249,7 +249,7 @@ parsePacked l = case words l of {- git-branch -d cannot be used to remove a branch that is directly - pointing to a corrupt commit. -} nukeBranchRef :: Branch -> Repo -> IO () -nukeBranchRef b r = nukeFile $ localGitDir r show b +nukeBranchRef b r = nukeFile $ localGitDir r fromRef b {- Finds the most recent commit to a branch that does not need any - of the missing objects. If the input branch is good as-is, returns it. @@ -268,7 +268,7 @@ findUncorruptedCommit missing goodcommits branch r = do [ Param "log" , Param "-z" , Param "--format=%H" - , Param (show branch) + , Param (fromRef branch) ] r let branchshas = catMaybes $ map extractSha ls reflogshas <- RefLog.get branch r @@ -297,7 +297,7 @@ verifyCommit missing goodcommits commit r [ Param "log" , Param "-z" , Param "--format=%H %T" - , Param (show commit) + , Param (fromRef commit) ] r let committrees = map parse ls if any isNothing committrees || null committrees @@ -501,9 +501,9 @@ runRepair' removablebranch fsckresult forced referencerepo g = do , "remote tracking branches that referred to missing objects." ] (resetbranches, deletedbranches, _) <- resetLocalBranches stillmissing goodcommits g - displayList (map show resetbranches) + displayList (map fromRef resetbranches) "Reset these local branches to old versions before the missing objects were committed:" - displayList (map show deletedbranches) + displayList (map fromRef deletedbranches) "Deleted these local branches, which could not be recovered due to missing objects:" deindexedfiles <- rewriteIndex g displayList deindexedfiles @@ -519,7 +519,7 @@ runRepair' removablebranch fsckresult forced referencerepo g = do Just curr -> when (any (== curr) modifiedbranches) $ do putStrLn $ unwords [ "You currently have" - , show curr + , fromRef curr , "checked out. You may have staged changes in the index that can be committed to recover the lost state of this branch!" ] putStrLn "Successfully recovered repository!" diff --git a/Git/Sha.hs b/Git/Sha.hs index ee1b6d6691..cbb66ea2d6 100644 --- a/Git/Sha.hs +++ b/Git/Sha.hs @@ -37,3 +37,7 @@ shaSize = 40 nullSha :: Ref nullSha = Ref $ replicate shaSize '0' + +{- Git's magic empty tree. -} +emptyTree :: Ref +emptyTree = Ref "4b825dc642cb6eb9a060e54bf8d69288fbee4904" diff --git a/Git/Types.hs b/Git/Types.hs index d805d8574f..8029225323 100644 --- a/Git/Types.hs +++ b/Git/Types.hs @@ -47,10 +47,10 @@ type RemoteName = String {- A git ref. Can be a sha1, or a branch or tag name. -} newtype Ref = Ref String - deriving (Eq, Ord) + deriving (Eq, Ord, Read, Show) -instance Show Ref where - show (Ref v) = v +fromRef :: Ref -> String +fromRef (Ref s) = s {- Aliases for Ref. -} type Branch = Ref diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs index 3b33ac8469..6d1ff25486 100644 --- a/Git/UpdateIndex.hs +++ b/Git/UpdateIndex.hs @@ -11,6 +11,9 @@ module Git.UpdateIndex ( Streamer, pureStreamer, streamUpdateIndex, + streamUpdateIndex', + startUpdateIndex, + stopUpdateIndex, lsTree, updateIndexLine, stageFile, @@ -25,6 +28,9 @@ import Git.Command import Git.FilePath import Git.Sha +import Control.Exception (bracket) +import System.Process (std_in) + {- Streamers are passed a callback and should feed it lines in the form - read by update-index, and generated by ls-tree. -} type Streamer = (String -> IO ()) -> IO () @@ -35,16 +41,29 @@ pureStreamer !s = \streamer -> streamer s {- Streams content into update-index from a list of Streamers. -} streamUpdateIndex :: Repo -> [Streamer] -> IO () -streamUpdateIndex repo as = pipeWrite params repo $ \h -> do +streamUpdateIndex repo as = bracket (startUpdateIndex repo) stopUpdateIndex $ + (\h -> forM_ as $ streamUpdateIndex' h) + +data UpdateIndexHandle = UpdateIndexHandle ProcessHandle Handle + +streamUpdateIndex' :: UpdateIndexHandle -> Streamer -> IO () +streamUpdateIndex' (UpdateIndexHandle _ h) a = a $ \s -> do + hPutStr h s + hPutStr h "\0" + +startUpdateIndex :: Repo -> IO UpdateIndexHandle +startUpdateIndex repo = do + (Just h, _, _, p) <- createProcess (gitCreateProcess params repo) + { std_in = CreatePipe } fileEncoding h - forM_ as (stream h) - hClose h + return $ UpdateIndexHandle p h where params = map Param ["update-index", "-z", "--index-info"] - stream h a = a (streamer h) - streamer h s = do - hPutStr h s - hPutStr h "\0" + +stopUpdateIndex :: UpdateIndexHandle -> IO Bool +stopUpdateIndex (UpdateIndexHandle p h) = do + hClose h + checkSuccessProcess p {- A streamer that adds the current tree for a ref. Useful for eg, copying - and modifying branches. -} @@ -60,7 +79,7 @@ lsTree (Ref x) repo streamer = do - a given file with a given sha. -} updateIndexLine :: Sha -> BlobType -> TopFilePath -> String updateIndexLine sha filetype file = - show filetype ++ " blob " ++ show sha ++ "\t" ++ indexPath file + show filetype ++ " blob " ++ fromRef sha ++ "\t" ++ indexPath file stageFile :: Sha -> BlobType -> FilePath -> Repo -> IO Streamer stageFile sha filetype file repo = do @@ -71,7 +90,7 @@ stageFile sha filetype file repo = do unstageFile :: FilePath -> Repo -> IO Streamer unstageFile file repo = do p <- toTopFilePath file repo - return $ pureStreamer $ "0 " ++ show nullSha ++ "\t" ++ indexPath p + return $ pureStreamer $ "0 " ++ fromRef nullSha ++ "\t" ++ indexPath p {- A streamer that adds a symlink to the index. -} stageSymlink :: FilePath -> Sha -> Repo -> IO Streamer diff --git a/Limit.hs b/Limit.hs index 6f41016330..bee92889d8 100644 --- a/Limit.hs +++ b/Limit.hs @@ -9,11 +9,6 @@ module Limit where -import Data.Time.Clock.POSIX -import qualified Data.Set as S -import qualified Data.Map as M -import System.Path.WildMatch - import Common.Annex import qualified Annex import qualified Utility.Matcher @@ -28,6 +23,8 @@ import Types.Key import Types.Group import Types.FileMatcher import Types.Limit +import Types.MetaData +import Logs.MetaData import Logs.Group import Logs.Unused import Logs.Location @@ -35,14 +32,14 @@ import Git.Types (RefDate(..)) import Utility.HumanTime import Utility.DataUnits +import Data.Time.Clock.POSIX +import qualified Data.Set as S +import qualified Data.Map as M +import System.Path.WildMatch + #ifdef WITH_TDFA import Text.Regex.TDFA import Text.Regex.TDFA.String -#else -#ifndef mingw32_HOST_OS -import System.Path.WildMatch -import Types.FileMatcher -#endif #endif {- Checks if there are user-specified limits. -} @@ -156,7 +153,7 @@ limitPresent u _ = Right $ const $ checkKey $ \key -> do limitInDir :: FilePath -> MkLimit limitInDir dir = const $ Right $ const go where - go (MatchingFile fi) = return $ any (== dir) $ splitPath $ takeDirectory $ matchFile fi + go (MatchingFile fi) = return $ elem dir $ splitPath $ takeDirectory $ matchFile fi go (MatchingKey _) = return False {- Adds a limit to skip files not believed to have the specified number @@ -267,6 +264,16 @@ limitSize vs s = case readSize dataUnits s of <$> getFileStatus (relFile fi) return $ filesize `vs` Just sz +addMetaData :: String -> Annex () +addMetaData = addLimit . limitMetaData + +limitMetaData :: MkLimit +limitMetaData s = case parseMetaData s of + Left e -> Left e + Right (f, v) -> Right $ const $ checkKey (check f v) + where + check f v k = S.member v . metaDataValues f <$> getCurrentMetaData k + addTimeLimit :: String -> Annex () addTimeLimit s = do let seconds = maybe (error "bad time-limit") durationToPOSIXTime $ diff --git a/Locations.hs b/Locations.hs index 553104d959..8189b8a076 100644 --- a/Locations.hs +++ b/Locations.hs @@ -40,6 +40,8 @@ module Locations ( gitAnnexJournalLock, gitAnnexIndex, gitAnnexIndexStatus, + gitAnnexViewIndex, + gitAnnexViewLog, gitAnnexIgnoredRefs, gitAnnexPidFile, gitAnnexDaemonStatusFile, @@ -252,6 +254,14 @@ gitAnnexIndex r = gitAnnexDir r "index" gitAnnexIndexStatus :: Git.Repo -> FilePath gitAnnexIndexStatus r = gitAnnexDir r "index.lck" +{- The index file used to generate a filtered branch view._-} +gitAnnexViewIndex :: Git.Repo -> FilePath +gitAnnexViewIndex r = gitAnnexDir r "viewindex" + +{- File containing a log of recently accessed views. -} +gitAnnexViewLog :: Git.Repo -> FilePath +gitAnnexViewLog r = gitAnnexDir r "viewlog" + {- List of refs that should not be merged into the git-annex branch. -} gitAnnexIgnoredRefs :: Git.Repo -> FilePath gitAnnexIgnoredRefs r = gitAnnexDir r "ignoredrefs" @@ -330,7 +340,7 @@ preSanitizeKeyName = concatMap escape -- other characters. By itself, it is escaped to -- doubled form. | c == ',' = ",," - | otherwise = ',' : show(ord(c)) + | otherwise = ',' : show (ord c) {- Converts a key into a filename fragment without any directory. - diff --git a/Logs.hs b/Logs.hs index 828a73dc70..21908a9cf2 100644 --- a/Logs.hs +++ b/Logs.hs @@ -1,6 +1,6 @@ {- git-annex log file names - - - Copyright 2013 Joey Hess + - Copyright 2013-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -15,7 +15,7 @@ data LogVariety = UUIDBasedLog | NewUUIDBasedLog | PresenceLog Key - | SingleValueLog + | OtherLog deriving (Show) {- Converts a path from the git-annex branch into one of the varieties @@ -24,7 +24,7 @@ getLogVariety :: FilePath -> Maybe LogVariety getLogVariety f | f `elem` topLevelUUIDBasedLogs = Just UUIDBasedLog | isRemoteStateLog f = Just NewUUIDBasedLog - | f == numcopiesLog = Just SingleValueLog + | isMetaDataLog f || f == numcopiesLog = Just OtherLog | otherwise = PresenceLog <$> firstJust (presenceLogs f) {- All the uuid-based logs stored in the top of the git-annex branch. -} @@ -119,14 +119,25 @@ remoteStateLogExt = ".log.rmt" isRemoteStateLog :: FilePath -> Bool isRemoteStateLog path = remoteStateLogExt `isSuffixOf` path +{- The filename of the metadata log for a given key. -} +metaDataLogFile :: Key -> FilePath +metaDataLogFile key = hashDirLower key keyFile key ++ metaDataLogExt + +metaDataLogExt :: String +metaDataLogExt = ".log.met" + +isMetaDataLog :: FilePath -> Bool +isMetaDataLog path = metaDataLogExt `isSuffixOf` path + prop_logs_sane :: Key -> Bool -prop_logs_sane dummykey = all id +prop_logs_sane dummykey = and [ isNothing (getLogVariety "unknown") , expect isUUIDBasedLog (getLogVariety uuidLog) , expect isPresenceLog (getLogVariety $ locationLogFile dummykey) , expect isPresenceLog (getLogVariety $ urlLogFile dummykey) , expect isNewUUIDBasedLog (getLogVariety $ remoteStateLogFile dummykey) - , expect isSingleValueLog (getLogVariety $ numcopiesLog) + , expect isOtherLog (getLogVariety $ metaDataLogFile dummykey) + , expect isOtherLog (getLogVariety $ numcopiesLog) ] where expect = maybe False @@ -136,5 +147,5 @@ prop_logs_sane dummykey = all id isNewUUIDBasedLog _ = False isPresenceLog (PresenceLog k) = k == dummykey isPresenceLog _ = False - isSingleValueLog SingleValueLog = True - isSingleValueLog _ = False + isOtherLog OtherLog = True + isOtherLog _ = False diff --git a/Logs/FsckResults.hs b/Logs/FsckResults.hs index 8e776ec215..3538bdc401 100644 --- a/Logs/FsckResults.hs +++ b/Logs/FsckResults.hs @@ -31,7 +31,7 @@ writeFsckResults u fsckresults = do store s logfile = do createDirectoryIfMissing True (parentDir logfile) liftIO $ viaTmp writeFile logfile $ serialize s - serialize = unlines . map show . S.toList + serialize = unlines . map fromRef . S.toList readFsckResults :: UUID -> Annex FsckResults readFsckResults u = do diff --git a/Logs/MetaData.hs b/Logs/MetaData.hs new file mode 100644 index 0000000000..77c1b56a50 --- /dev/null +++ b/Logs/MetaData.hs @@ -0,0 +1,137 @@ +{- git-annex general metadata storage log + - + - A line of the log will look like "timestamp field [+-]value [...]" + - + - Note that unset values are preserved. Consider this case: + - + - We have: + - + - 100 foo +x + - 200 foo -x + - + - An unmerged remote has: + - + - 150 foo +x + - + - After union merge, because the foo -x was preserved, we know that + - after the other remote redundantly set foo +x, it was unset, + - and so foo currently has no value. + - + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE CPP #-} + +module Logs.MetaData ( + getCurrentMetaData, + getMetaData, + addMetaData, + addMetaData', + currentMetaData, +) where + +import Common.Annex +import Types.MetaData +import qualified Annex.Branch +import Logs +import Logs.SingleValue + +import qualified Data.Set as S +import Data.Time.Clock.POSIX + +instance SingleValueSerializable MetaData where + serialize = Types.MetaData.serialize + deserialize = Types.MetaData.deserialize + +getMetaData :: Key -> Annex (Log MetaData) +getMetaData = readLog . metaDataLogFile + +{- Go through the log from oldest to newest, and combine it all + - into a single MetaData representing the current state. -} +getCurrentMetaData :: Key -> Annex MetaData +getCurrentMetaData = currentMetaData . collect <$$> getMetaData + where + collect = foldl' unionMetaData newMetaData . map value . S.toAscList + +{- Adds in some metadata, which can override existing values, or unset + - them, but otherwise leaves any existing metadata as-is. -} +addMetaData :: Key -> MetaData -> Annex () +addMetaData k metadata = addMetaData' k metadata =<< liftIO getPOSIXTime + +{- Reusing the same timestamp when making changes to the metadata + - of multiple keys is a nice optimisation. The same metadata lines + - will tend to be generated across the different log files, and so + - git will be able to pack the data more efficiently. -} +addMetaData' :: Key -> MetaData -> POSIXTime -> Annex () +addMetaData' k metadata now = Annex.Branch.change (metaDataLogFile k) $ + showLog . simplifyLog + . S.insert (LogEntry now metadata) + . parseLog + +{- Simplify a log, removing historical values that are no longer + - needed. + - + - This is not as simple as just making a single log line with the newest + - state of all metadata. Consider this case: + - + - We have: + - + - 100 foo +x bar +y + - 200 foo -x + - + - An unmerged remote has: + - + - 150 bar -y baz +w + - + - If what we have were simplified to "200 foo -x bar +y" then when the line + - from the remote became available, it would be older than the simplified + - line, and its change to bar would not take effect. That is wrong. + - + - Instead, simplify it to: + - + - 100 bar +y + - 200 foo -x + - + - (Note that this ends up with the same number of lines as the + - unsimplified version, so there's really no point in updating + - the log to this version. Doing so would only add data to git, + - with little benefit.) + - + - Now merging with the remote yields: + - + - 100 bar +y + - 150 bar -y baz +w + - 200 foo -x + - + - Simplifying again: + - + - 150 bar +z baz +w + - 200 foo -x + -} +simplifyLog :: Log MetaData -> Log MetaData +simplifyLog s = case sl of + (newest:rest) -> + let sl' = go [newest] (value newest) rest + in if length sl' < length sl + then S.fromList sl' + else s + _ -> s + where +#if MIN_VERSION_containers(0,5,0) + sl = S.toDescList s +#else + sl = reverse (S.toAscList s) +#endif + + go c _ [] = c + go c newer (l:ls) + | unique == newMetaData = go c newer ls + | otherwise = go (l { value = unique } : c) + (unionMetaData unique newer) ls + where + older = value l + unique = older `differenceMetaData` newer diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index e998a56b14..ebbb153ac8 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -17,6 +17,10 @@ import Types.Key import Utility.Metered import Utility.Percentage import Utility.QuickCheck +import Utility.PID +#ifdef mingw32_HOST_OS +import Utility.WinLock +#endif import Data.Time.Clock import Data.Time.Clock.POSIX @@ -24,20 +28,6 @@ import Data.Time import System.Locale import Control.Concurrent -#ifndef mingw32_HOST_OS -import System.Posix.Types (ProcessID) -#else -import System.Win32.Process (ProcessId) -import System.Win32.Process.Current (getCurrentProcessId) -import Utility.WinLock -#endif - -#ifndef mingw32_HOST_OS -type PID = ProcessID -#else -type PID = ProcessId -#endif - {- Enough information to uniquely identify a transfer, used as the filename - of the transfer information file. -} data Transfer = Transfer @@ -231,7 +221,7 @@ startTransferInfo file = TransferInfo #ifndef mingw32_HOST_OS <*> pure Nothing -- pid not stored in file, so omitted for speed #else - <*> (Just <$> getCurrentProcessId) + <*> (Just <$> getPID) #endif <*> pure Nothing -- tid ditto <*> pure Nothing -- not 0; transfer may be resuming diff --git a/Logs/Unused.hs b/Logs/Unused.hs index eff8186cf8..d26d37dca7 100644 --- a/Logs/Unused.hs +++ b/Logs/Unused.hs @@ -86,7 +86,9 @@ readUnusedLog prefix = do _ -> Nothing where (sint, rest) = separate (== ' ') line - (skey, ts) = separate (== ' ') rest + (rts, rskey) = separate (== ' ') (reverse rest) + skey = reverse rskey + ts = reverse rts readUnusedMap :: FilePath -> Annex UnusedMap readUnusedMap = log2map <$$> readUnusedLog diff --git a/Logs/View.hs b/Logs/View.hs new file mode 100644 index 0000000000..63590d5e96 --- /dev/null +++ b/Logs/View.hs @@ -0,0 +1,89 @@ +{- git-annex recent views log + - + - The most recently accessed view comes first. + - + - This file is stored locally in .git/annex/, not in the git-annex branch. + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Logs.View ( + currentView, + setView, + removeView, + recentViews, + branchView, + prop_branchView_legal, +) where + +import Common.Annex +import Types.View +import Types.MetaData +import qualified Git +import qualified Git.Branch +import qualified Git.Ref +import Git.Types +import Utility.Tmp + +import qualified Data.Set as S +import Data.Char + +setView :: View -> Annex () +setView v = do + old <- take 99 . filter (/= v) <$> recentViews + writeViews (v : old) + +writeViews :: [View] -> Annex () +writeViews l = do + f <- fromRepo gitAnnexViewLog + liftIO $ viaTmp writeFile f $ unlines $ map show l + +removeView :: View -> Annex () +removeView v = writeViews =<< filter (/= v) <$> recentViews + +recentViews :: Annex [View] +recentViews = do + f <- fromRepo gitAnnexViewLog + liftIO $ mapMaybe readish . lines <$> catchDefaultIO [] (readFile f) + +{- Gets the currently checked out view, if there is one. -} +currentView :: Annex (Maybe View) +currentView = go =<< inRepo Git.Branch.current + where + go (Just b) | branchViewPrefix `isPrefixOf` fromRef b = + headMaybe . filter (\v -> branchView v == b) <$> recentViews + go _ = return Nothing + +branchViewPrefix :: String +branchViewPrefix = "refs/heads/views" + +{- Generates a git branch name for a View. + - + - There is no guarantee that each view gets a unique branch name, + - but the branch name is used to express the view as well as possible. + -} +branchView :: View -> Git.Branch +branchView view + | null name = Git.Ref branchViewPrefix + | otherwise = Git.Ref $ branchViewPrefix ++ "/" ++ name + where + name = intercalate ";" $ map branchcomp (viewComponents view) + branchcomp c + | viewVisible c = branchcomp' c + | otherwise = "(" ++ branchcomp' c ++ ")" + branchcomp' (ViewComponent metafield viewfilter _) =concat + [ forcelegal (fromMetaField metafield) + , "=" + , branchvals viewfilter + ] + branchvals (FilterValues set) = intercalate "," $ + map (forcelegal . fromMetaValue) $ S.toList set + branchvals (FilterGlob glob) = forcelegal glob + forcelegal s + | Git.Ref.legal True s = s + | otherwise = map (\c -> if isAlphaNum c then c else '_') s + +prop_branchView_legal :: View -> Bool +prop_branchView_legal = Git.Ref.legal False . fromRef . branchView diff --git a/Makefile b/Makefile index 76a5f13d09..50d1acd9a0 100644 --- a/Makefile +++ b/Makefile @@ -252,7 +252,8 @@ hdevtools: distributionupdate: git pull - ghc --make Build/DistributionUpdate + cabal configure + ghc --make Build/DistributionUpdate -XPackageImports ./Build/DistributionUpdate .PHONY: git-annex git-union-merge git-recover-repository tags build-stamp diff --git a/Remote.hs b/Remote.hs index f2af025fb3..5fc6d1c009 100644 --- a/Remote.hs +++ b/Remote.hs @@ -189,8 +189,7 @@ prettyUUID u = concat <$> prettyListUUIDs [u] remoteFromUUID :: UUID -> Annex (Maybe Remote) remoteFromUUID u = ifM ((==) u <$> getUUID) ( return Nothing - , do - maybe tryharder (return . Just) =<< findinmap + , maybe tryharder (return . Just) =<< findinmap ) where findinmap = M.lookup u <$> remoteMap id diff --git a/Remote/Bup.hs b/Remote/Bup.hs index 62af704b2b..4e79eca421 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -15,6 +15,7 @@ import Data.ByteString.Lazy.UTF8 (fromString) import Common.Annex import Types.Remote import Types.Key +import Types.Creds import qualified Git import qualified Git.Command import qualified Git.Config @@ -82,8 +83,8 @@ gen r u c gc = do where buprepo = fromMaybe (error "missing buprepo") $ remoteAnnexBupRepo gc -bupSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID) -bupSetup mu c = do +bupSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) +bupSetup mu _ c = do u <- maybe (liftIO genUUID) return mu -- verify configuration is sane diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 3cbde7aaff..afa2296ec4 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -16,6 +16,7 @@ import Data.Int import Common.Annex import Types.Remote +import Types.Creds import qualified Git import Config.Cost import Config @@ -67,8 +68,8 @@ gen r u c gc = do where dir = fromMaybe (error "missing directory") $ remoteAnnexDirectory gc -directorySetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID) -directorySetup mu c = do +directorySetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) +directorySetup mu _ c = do u <- maybe (liftIO genUUID) return mu -- verify configuration is sane let dir = fromMaybe (error "Specify directory=") $ diff --git a/Remote/External.hs b/Remote/External.hs index 26f511551a..50a0767eab 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -73,8 +73,8 @@ gen r u c gc = do where externaltype = fromMaybe (error "missing externaltype") (remoteAnnexExternalType gc) -externalSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID) -externalSetup mu c = do +externalSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) +externalSetup mu _ c = do u <- maybe (liftIO genUUID) return mu let externaltype = fromMaybe (error "Specify externaltype=") $ M.lookup "externaltype" c @@ -92,16 +92,18 @@ externalSetup mu c = do store :: External -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool store external k _f p = sendAnnex k rollback $ \f -> - storeHelper external k f p + metered (Just p) k $ + storeHelper external k f where rollback = void $ remove external k storeEncrypted :: External -> [CommandParam] -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool storeEncrypted external gpgOpts (cipher, enck) k p = withTmp enck $ \tmp -> sendAnnex k rollback $ \src -> do - liftIO $ encrypt gpgOpts cipher (feedFile src) $ - readBytes $ L.writeFile tmp - storeHelper external enck tmp p + metered (Just p) k $ \meterupdate -> do + liftIO $ encrypt gpgOpts cipher (feedFile src) $ + readBytes $ L.writeFile tmp + storeHelper external enck tmp meterupdate where rollback = void $ remove external enck @@ -118,17 +120,19 @@ storeHelper external k f p = safely $ _ -> Nothing retrieve :: External -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool -retrieve external k _f d p = retrieveHelper external k d p +retrieve external k _f d p = metered (Just p) k $ + retrieveHelper external k d retrieveEncrypted :: External -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool -retrieveEncrypted external (cipher, enck) _ f p = withTmp enck $ \tmp -> - ifM (retrieveHelper external enck tmp p) - ( liftIO $ catchBoolIO $ do - decrypt cipher (feedFile tmp) $ - readBytes $ L.writeFile f - return True - , return False - ) +retrieveEncrypted external (cipher, enck) k f p = withTmp enck $ \tmp -> + metered (Just p) k $ \meterupdate -> + ifM (retrieveHelper external enck tmp meterupdate) + ( liftIO $ catchBoolIO $ do + decrypt cipher (feedFile tmp) $ + readBytes $ L.writeFile f + return True + , return False + ) retrieveHelper :: External -> Key -> FilePath -> MeterUpdate -> Annex Bool retrieveHelper external k d p = safely $ @@ -221,8 +225,8 @@ handleRequest' lck external req mp responsehandler send $ VALUE value handleRemoteRequest (SETCREDS setting login password) = do c <- liftIO $ atomically $ readTMVar $ externalConfig external - c' <- setRemoteCredPair' c (credstorage setting) - (login, password) + c' <- setRemoteCredPair c (credstorage setting) $ + Just (login, password) void $ liftIO $ atomically $ swapTMVar (externalConfig external) c' handleRemoteRequest (GETCREDS setting) = do c <- liftIO $ atomically $ readTMVar $ externalConfig external diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index 03747314c4..60c2df73e4 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -21,6 +21,7 @@ import Common.Annex import Types.Remote import Types.GitConfig import Types.Crypto +import Types.Creds import qualified Git import qualified Git.Command import qualified Git.Config @@ -149,8 +150,8 @@ noCrypto = error "cannot use gcrypt remote without encryption enabled" unsupportedUrl :: Annex a unsupportedUrl = error "using non-ssh remote repo url with gcrypt is not supported" -gCryptSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID) -gCryptSetup mu c = go $ M.lookup "gitrepo" c +gCryptSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) +gCryptSetup mu _ c = go $ M.lookup "gitrepo" c where remotename = fromJust (M.lookup "name" c) go Nothing = error "Specify gitrepo=" @@ -176,7 +177,7 @@ gCryptSetup mu c = go $ M.lookup "gitrepo" c void $ inRepo $ Git.Command.runBool [ Param "push" , Param remotename - , Param $ show Annex.Branch.fullname + , Param $ Git.fromRef Annex.Branch.fullname ] g <- inRepo Git.Config.reRead case Git.GCrypt.remoteRepoId g (Just remotename) of diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs index 3bb92e2f67..84557851b3 100644 --- a/Remote/Glacier.hs +++ b/Remote/Glacier.hs @@ -70,17 +70,18 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost remotetype = remote } -glacierSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID) -glacierSetup mu c = do +glacierSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) +glacierSetup mu mcreds c = do u <- maybe (liftIO genUUID) return mu - glacierSetup' u c -glacierSetup' :: UUID -> RemoteConfig -> Annex (RemoteConfig, UUID) -glacierSetup' u c = do + glacierSetup' (isJust mu) u mcreds c +glacierSetup' :: Bool -> UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) +glacierSetup' enabling u mcreds c = do c' <- encryptionSetup c let fullconfig = c' `M.union` defaults - genVault fullconfig u + unless enabling $ + genVault fullconfig u gitConfigSpecialRemote u fullconfig "glacier" "true" - c'' <- setRemoteCredPair fullconfig (AWS.creds u) + c'' <- setRemoteCredPair fullconfig (AWS.creds u) mcreds return (c'', u) where remotename = fromJust (M.lookup "name" c) @@ -245,7 +246,6 @@ archive r k = fileprefix ++ key2file k where fileprefix = M.findWithDefault "" "fileprefix" $ config r --- glacier vault create will succeed even if the vault already exists. genVault :: RemoteConfig -> UUID -> Annex () genVault c u = unlessM (runGlacier c u params) $ error "Failed creating glacier vault." diff --git a/Remote/Helper/AWS.hs b/Remote/Helper/AWS.hs index 1d80ff1b4f..0687a5ee1d 100644 --- a/Remote/Helper/AWS.hs +++ b/Remote/Helper/AWS.hs @@ -22,9 +22,6 @@ creds u = CredPairStorage , credPairRemoteKey = Just "s3creds" } -setCredsEnv :: CredPair -> IO () -setCredsEnv p = setEnvCredPair p $ creds undefined - data Service = S3 | Glacier deriving (Eq) diff --git a/Remote/Hook.hs b/Remote/Hook.hs index 1fcb2912f8..3735c228c8 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -13,6 +13,7 @@ import qualified Data.Map as M import Common.Annex import Types.Remote import Types.Key +import Types.Creds import qualified Git import Config import Config.Cost @@ -65,8 +66,8 @@ gen r u c gc = do where hooktype = fromMaybe (error "missing hooktype") $ remoteAnnexHookType gc -hookSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID) -hookSetup mu c = do +hookSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) +hookSetup mu _ c = do u <- maybe (liftIO genUUID) return mu let hooktype = fromMaybe (error "Specify hooktype=") $ M.lookup "hooktype" c diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index e27286d5a0..a905d1be31 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -18,14 +18,6 @@ module Remote.Rsync ( RsyncOpts ) where -import qualified Data.ByteString.Lazy as L -import qualified Data.Map as M -#ifndef mingw32_HOST_OS -import System.Posix.Process (getProcessID) -#else -import System.Win32.Process.Current (getCurrentProcessId) -#endif - import Common.Annex import Types.Remote import qualified Git @@ -40,8 +32,13 @@ import Crypto import Utility.Rsync import Utility.CopyFile import Utility.Metered +import Utility.PID import Annex.Perms import Logs.Transfer +import Types.Creds + +import qualified Data.ByteString.Lazy as L +import qualified Data.Map as M type RsyncUrl = String @@ -115,31 +112,31 @@ genRsyncOpts c gc transport url = RsyncOpts | otherwise = True rsyncTransport :: RemoteGitConfig -> RsyncUrl -> Annex ([CommandParam], RsyncUrl) -rsyncTransport gc rawurl - | rsyncUrlIsShell rawurl = - (\rsh -> return (rsyncShell rsh, resturl)) =<< +rsyncTransport gc url + | rsyncUrlIsShell url = + (\rsh -> return (rsyncShell rsh, url)) =<< case fromNull ["ssh"] (remoteAnnexRsyncTransport gc) of "ssh":sshopts -> do let (port, sshopts') = sshReadPort sshopts - host = takeWhile (/=':') resturl + userhost = takeWhile (/=':') url -- Connection caching (Param "ssh":) <$> sshCachingOptions - (host, port) + (userhost, port) (map Param $ loginopt ++ sshopts') "rsh":rshopts -> return $ map Param $ "rsh" : loginopt ++ rshopts rsh -> error $ "Unknown Rsync transport: " ++ unwords rsh - | otherwise = return ([], rawurl) + | otherwise = return ([], url) where - (login,resturl) = case separate (=='@') rawurl of - (h, "") -> (Nothing, h) - (l, h) -> (Just l, h) + login = case separate (=='@') url of + (_h, "") -> Nothing + (l, _) -> Just l loginopt = maybe [] (\l -> ["-l",l]) login fromNull as xs = if null xs then as else xs -rsyncSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID) -rsyncSetup mu c = do +rsyncSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) +rsyncSetup mu _ c = do u <- maybe (liftIO genUUID) return mu -- verify configuration is sane let url = fromMaybe (error "Specify rsyncurl=") $ @@ -249,14 +246,10 @@ sendParams = ifM crippledFileSystem - up trees for rsync. -} withRsyncScratchDir :: (FilePath -> Annex a) -> Annex a withRsyncScratchDir a = do -#ifndef mingw32_HOST_OS - v <- liftIO getProcessID -#else - v <- liftIO getCurrentProcessId -#endif + p <- liftIO getPID t <- fromRepo gitAnnexTmpDir createAnnexDirectory t - let tmp = t "rsynctmp" show v + let tmp = t "rsynctmp" show p nuke tmp liftIO $ createDirectoryIfMissing True tmp nuke tmp `after` a tmp diff --git a/Remote/S3.hs b/Remote/S3.hs index 081f7c1765..b217892e79 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -73,12 +73,12 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost remotetype = remote } -s3Setup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID) -s3Setup mu c = do +s3Setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) +s3Setup mu mcreds c = do u <- maybe (liftIO genUUID) return mu - s3Setup' u c -s3Setup' :: UUID -> RemoteConfig -> Annex (RemoteConfig, UUID) -s3Setup' u c = if isIA c then archiveorg else defaulthost + s3Setup' u mcreds c +s3Setup' :: UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) +s3Setup' u mcreds c = if isIA c then archiveorg else defaulthost where remotename = fromJust (M.lookup "name" c) defbucket = remotename ++ "-" ++ fromUUID u @@ -92,7 +92,7 @@ s3Setup' u c = if isIA c then archiveorg else defaulthost use fullconfig = do gitConfigSpecialRemote u fullconfig "s3" "true" - c' <- setRemoteCredPair fullconfig (AWS.creds u) + c' <- setRemoteCredPair fullconfig (AWS.creds u) mcreds return (c', u) defaulthost = do diff --git a/Remote/Tahoe.hs b/Remote/Tahoe.hs index 6b0113ac35..56a17eb624 100644 --- a/Remote/Tahoe.hs +++ b/Remote/Tahoe.hs @@ -29,6 +29,7 @@ import Control.Concurrent.STM import Common.Annex import Types.Remote +import Types.Creds import qualified Git import Config import Config.Cost @@ -85,8 +86,8 @@ gen r u c gc = do remotetype = remote } -tahoeSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID) -tahoeSetup mu c = do +tahoeSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) +tahoeSetup mu _ c = do furl <- fromMaybe (fromMaybe missingfurl $ M.lookup furlk c) <$> liftIO (getEnv "TAHOE_FURL") u <- maybe (liftIO genUUID) return mu diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index 7243e359d3..6ce83470b3 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -1,13 +1,13 @@ {- WebDAV remotes. - - - Copyright 2012 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} {-# LANGUAGE ScopedTypeVariables, CPP #-} -module Remote.WebDAV (remote, davCreds, setCredsEnv, configUrl) where +module Remote.WebDAV (remote, davCreds, configUrl) where import Network.Protocol.HTTP.DAV import qualified Data.Map as M @@ -76,8 +76,8 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost remotetype = remote } -webdavSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID) -webdavSetup mu c = do +webdavSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) +webdavSetup mu mcreds c = do u <- maybe (liftIO genUUID) return mu let url = fromMaybe (error "Specify url=") $ M.lookup "url" c @@ -85,7 +85,7 @@ webdavSetup mu c = do creds <- getCreds c' u testDav url creds gitConfigSpecialRemote u c' "webdav" "true" - c'' <- setRemoteCredPair c' (davCreds u) + c'' <- setRemoteCredPair c' (davCreds u) mcreds return (c'', u) store :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool @@ -354,6 +354,3 @@ davCreds u = CredPairStorage , credPairEnvironment = ("WEBDAV_USERNAME", "WEBDAV_PASSWORD") , credPairRemoteKey = Just "davcreds" } - -setCredsEnv :: (String, String) -> IO () -setCredsEnv creds = setEnvCredPair creds $ davCreds undefined diff --git a/Test.hs b/Test.hs index 7cbf6dbfdc..624636ed5e 100644 --- a/Test.hs +++ b/Test.hs @@ -45,6 +45,7 @@ import qualified Logs.Remote import qualified Logs.Unused import qualified Logs.Transfer import qualified Logs.Presence +import qualified Types.MetaData import qualified Remote import qualified Types.Key import qualified Types.Messages @@ -53,6 +54,8 @@ import qualified Config.Cost import qualified Crypto import qualified Annex.Init import qualified Annex.CatFile +import qualified Annex.View +import qualified Logs.View import qualified Utility.Path import qualified Utility.FileMode import qualified Build.SysConfig @@ -144,12 +147,16 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" , testProperty "prop_hashes_stable" Utility.Hash.prop_hashes_stable , testProperty "prop_schedule_roundtrips" Utility.Scheduled.prop_schedule_roundtrips , testProperty "prop_duration_roundtrips" Utility.HumanTime.prop_duration_roundtrips + , testProperty "prop_metadata_sane" Types.MetaData.prop_metadata_sane + , testProperty "prop_metadata_serialize" Types.MetaData.prop_metadata_serialize + , testProperty "prop_branchView_legal" Logs.View.prop_branchView_legal + , testProperty "prop_view_roundtrips" Annex.View.prop_view_roundtrips ] {- These tests set up the test environment, but also test some basic parts - of git-annex. They are always run before the unitTests. -} initTests :: TestEnv -> TestTree -initTests env = testGroup ("Init Tests") +initTests env = testGroup "Init Tests" [ check "init" test_init , check "add" test_add ] @@ -230,7 +237,7 @@ test_add env = inmainrepo env $ do ( do writeFile ingitfile $ content ingitfile not <$> boolSystem "git" [Param "add", File ingitfile] @? "git add failed to fail in direct mode" - boolSystem "rm" [Params "-f", File ingitfile] @? "rm failed" + nukeFile ingitfile git_annex env "sync" [] @? "sync failed" , do writeFile ingitfile $ content ingitfile @@ -258,7 +265,7 @@ test_reinject :: TestEnv -> Assertion test_reinject env = intmpclonerepoInDirect env $ do git_annex env "drop" ["--force", sha1annexedfile] @? "drop failed" writeFile tmp $ content sha1annexedfile - r <- annexeval $ Types.Backend.getKey backendSHA1 $ + r <- annexeval $ Types.Backend.getKey backendSHA1 Types.KeySource.KeySource { Types.KeySource.keyFilename = tmp, Types.KeySource.contentLocation = tmp, Types.KeySource.inodeCache = Nothing } let key = Types.Key.key2file $ fromJust r git_annex env "reinject" [tmp, sha1annexedfile] @? "reinject failed" @@ -542,7 +549,7 @@ test_fsck_basic env = intmpclonerepo env $ do git_annex env "fsck" [] @? "fsck unexpectedly failed again; previous one did not fix problem with " ++ f test_fsck_bare :: TestEnv -> Assertion -test_fsck_bare env = intmpbareclonerepo env $ do +test_fsck_bare env = intmpbareclonerepo env $ git_annex env "fsck" [] @? "fsck failed" test_fsck_localuntrusted :: TestEnv -> Assertion @@ -585,7 +592,7 @@ test_migrate' usegitattributes env = intmpclonerepoInDirect env $ do annexed_present sha1annexedfile if usegitattributes then do - writeFile ".gitattributes" $ "* annex.backend=SHA1" + writeFile ".gitattributes" "* annex.backend=SHA1" git_annex env "migrate" [sha1annexedfile] @? "migrate sha1annexedfile failed" git_annex env "migrate" [annexedfile] @@ -601,7 +608,7 @@ test_migrate' usegitattributes env = intmpclonerepoInDirect env $ do checkbackend sha1annexedfile backendSHA1 -- check that reversing a migration works - writeFile ".gitattributes" $ "* annex.backend=SHA256" + writeFile ".gitattributes" "* annex.backend=SHA256" git_annex env "migrate" [sha1annexedfile] @? "migrate sha1annexedfile failed" git_annex env "migrate" [annexedfile] @@ -712,7 +719,7 @@ test_find env = intmpclonerepo env $ do git_annex_expectoutput env "find" ["--exclude", "*"] [] test_merge :: TestEnv -> Assertion -test_merge env = intmpclonerepo env $ do +test_merge env = intmpclonerepo env $ git_annex env "merge" [] @? "merge failed" test_info :: TestEnv -> Assertion @@ -723,7 +730,7 @@ test_info env = intmpclonerepo env $ do Text.JSON.Error e -> assertFailure e test_version :: TestEnv -> Assertion -test_version env = intmpclonerepo env $ do +test_version env = intmpclonerepo env $ git_annex env "version" [] @? "version failed" test_sync :: TestEnv -> Assertion @@ -739,8 +746,8 @@ test_sync env = intmpclonerepo env $ do test_union_merge_regression :: TestEnv -> Assertion test_union_merge_regression env = {- We need 3 repos to see this bug. -} - withtmpclonerepo env False $ \r1 -> do - withtmpclonerepo env False $ \r2 -> do + withtmpclonerepo env False $ \r1 -> + withtmpclonerepo env False $ \r2 -> withtmpclonerepo env False $ \r3 -> do forM_ [r1, r2, r3] $ \r -> indir env r $ do when (r /= r1) $ @@ -766,7 +773,7 @@ test_union_merge_regression env = {- Regression test for the automatic conflict resolution bug fixed - in f4ba19f2b8a76a1676da7bb5850baa40d9c388e2. -} test_conflict_resolution_movein_bug :: TestEnv -> Assertion -test_conflict_resolution_movein_bug env = withtmpclonerepo env False $ \r1 -> do +test_conflict_resolution_movein_bug env = withtmpclonerepo env False $ \r1 -> withtmpclonerepo env False $ \r2 -> do let rname r = if r == r1 then "r1" else "r2" forM_ [r1, r2] $ \r -> indir env r $ do @@ -785,7 +792,7 @@ test_conflict_resolution_movein_bug env = withtmpclonerepo env False $ \r1 -> do ) {- Sync twice in r1 so it gets the conflict resolution - update from r2 -} - forM_ [r1, r2, r1] $ \r -> indir env r $ do + forM_ [r1, r2, r1] $ \r -> indir env r $ git_annex env "sync" ["--force"] @? "sync failed in " ++ rname r {- After the sync, it should be possible to get all - files. This includes both sides of the conflict, @@ -935,7 +942,7 @@ test_hook_remote env = intmpclonerepo env $ do test_directory_remote :: TestEnv -> Assertion test_directory_remote env = intmpclonerepo env $ do createDirectory "dir" - git_annex env "initremote" (words $ "foo type=directory encryption=none directory=dir") @? "initremote failed" + git_annex env "initremote" (words "foo type=directory encryption=none directory=dir") @? "initremote failed" git_annex env "get" [annexedfile] @? "get of file failed" annexed_present annexedfile git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to directory remote failed" @@ -951,7 +958,7 @@ test_rsync_remote :: TestEnv -> Assertion test_rsync_remote env = intmpclonerepo env $ do #ifndef mingw32_HOST_OS createDirectory "dir" - git_annex env "initremote" (words $ "foo type=rsync encryption=none rsyncurl=dir") @? "initremote failed" + git_annex env "initremote" (words "foo type=rsync encryption=none rsyncurl=dir") @? "initremote failed" git_annex env "get" [annexedfile] @? "get of file failed" annexed_present annexedfile git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to rsync remote failed" @@ -1085,7 +1092,7 @@ git_annex env command params = do Utility.Env.setEnv var val True -- catch all errors, including normally fatal errors - r <- try (run)::IO (Either SomeException ()) + r <- try run::IO (Either SomeException ()) case r of Right _ -> return True Left _ -> return False @@ -1126,7 +1133,7 @@ innewrepo :: TestEnv -> Assertion -> Assertion innewrepo env a = withgitrepo env $ \r -> indir env r a inmainrepo :: TestEnv -> Assertion -> Assertion -inmainrepo env a = indir env mainrepodir a +inmainrepo env = indir env mainrepodir intmpclonerepo :: TestEnv -> Assertion -> Assertion intmpclonerepo env a = withtmpclonerepo env False $ \r -> indir env r a @@ -1163,7 +1170,7 @@ indir env dir a = do -- any type of error and change back to cwd before -- rethrowing. r <- bracket_ (changeToTmpDir env dir) (setCurrentDirectory cwd) - (try (a)::IO (Either SomeException ())) + (try a::IO (Either SomeException ())) case r of Right () -> return () Left e -> throw e @@ -1186,7 +1193,7 @@ clonerepo env old new bare = do indir env new $ git_annex env "init" ["-q", new] @? "git annex init failed" configrepo env new - when (not bare) $ + unless bare $ indir env new $ handleforcedirect env return new @@ -1218,12 +1225,12 @@ cleanup' final dir = whenM (doesDirectoryExist dir) $ do mapM_ (void . tryIO . Utility.FileMode.allowWrite) -- This sometimes fails on Windows, due to some files -- being still opened by a subprocess. - catchIO (removeDirectoryRecursive dir) $ \e -> do + catchIO (removeDirectoryRecursive dir) $ \e -> when final $ do print e putStrLn "sleeping 10 seconds and will retry directory cleanup" Utility.ThreadScheduler.threadDelaySeconds (Utility.ThreadScheduler.Seconds 10) - whenM (doesDirectoryExist dir) $ do + whenM (doesDirectoryExist dir) $ removeDirectoryRecursive dir checklink :: FilePath -> Assertion @@ -1252,9 +1259,8 @@ checkunwritable f = unlessM (annexeval Config.isDirect) $ do -- modified despite permissions. s <- getFileStatus f let mode = fileMode s - if (mode == mode `unionFileModes` ownerWriteMode) - then assertFailure $ "able to modify annexed file's " ++ f ++ " content" - else return () + when (mode == mode `unionFileModes` ownerWriteMode) $ + assertFailure $ "able to modify annexed file's " ++ f ++ " content" checkwritable :: FilePath -> Assertion checkwritable f = do @@ -1280,7 +1286,7 @@ checklocationlog f expected = do case r of Just (k, _) -> do uuids <- annexeval $ Remote.keyLocations k - assertEqual ("bad content in location log for " ++ f ++ " key " ++ (Types.Key.key2file k) ++ " uuid " ++ show thisuuid) + assertEqual ("bad content in location log for " ++ f ++ " key " ++ Types.Key.key2file k ++ " uuid " ++ show thisuuid) expected (thisuuid `elem` uuids) _ -> assertFailure $ f ++ " failed to look up key" @@ -1326,8 +1332,7 @@ withTestEnv forcedirect = withResource prepare release release = releaseTestEnv releaseTestEnv :: TestEnv -> IO () -releaseTestEnv _env = do - cleanup' True tmpdir +releaseTestEnv _env = cleanup' True tmpdir prepareTestEnv :: Bool -> IO TestEnv prepareTestEnv forcedirect = do @@ -1404,7 +1409,7 @@ changecontent :: FilePath -> IO () changecontent f = writeFile f $ changedcontent f changedcontent :: FilePath -> String -changedcontent f = (content f) ++ " (modified)" +changedcontent f = content f ++ " (modified)" backendSHA1 :: Types.Backend backendSHA1 = backend_ "SHA1" @@ -1416,4 +1421,4 @@ backendWORM :: Types.Backend backendWORM = backend_ "WORM" backend_ :: String -> Types.Backend -backend_ name = Backend.lookupBackendName name +backend_ = Backend.lookupBackendName diff --git a/Types/Command.hs b/Types/Command.hs index ecde75cae5..0df7c82e63 100644 --- a/Types/Command.hs +++ b/Types/Command.hs @@ -66,6 +66,7 @@ data CommandSection | SectionSetup | SectionMaintenance | SectionQuery + | SectionMetaData | SectionUtility | SectionPlumbing deriving (Eq, Ord, Enum, Bounded) @@ -75,5 +76,6 @@ descSection SectionCommon = "Commonly used commands" descSection SectionSetup = "Repository setup commands" descSection SectionMaintenance = "Repository maintenance commands" descSection SectionQuery = "Query commands" +descSection SectionMetaData = "Metadata commands" descSection SectionUtility = "Utility commands" descSection SectionPlumbing = "Plumbing commands" diff --git a/Types/Creds.hs b/Types/Creds.hs new file mode 100644 index 0000000000..cb312f66de --- /dev/null +++ b/Types/Creds.hs @@ -0,0 +1,12 @@ +{- credentials + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Types.Creds where + +type Creds = String -- can be any data that contains credentials + +type CredPair = (String, String) -- login, password diff --git a/Types/MetaData.hs b/Types/MetaData.hs new file mode 100644 index 0000000000..617c122a6a --- /dev/null +++ b/Types/MetaData.hs @@ -0,0 +1,269 @@ +{- git-annex general metadata + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Types.MetaData ( + MetaData(..), + MetaField(..), + MetaValue(..), + CurrentlySet(..), + serialize, + deserialize, + MetaSerializable, + toMetaField, + mkMetaField, + tagMetaField, + fromMetaField, + toMetaValue, + mkMetaValue, + unsetMetaValue, + unsetMetaData, + fromMetaValue, + fromMetaData, + newMetaData, + updateMetaData, + unionMetaData, + differenceMetaData, + isSet, + currentMetaData, + currentMetaDataValues, + metaDataValues, + ModMeta(..), + modMeta, + parseModMeta, + parseMetaData, + prop_metadata_sane, + prop_metadata_serialize +) where + +import Common +import Utility.Base64 +import Utility.QuickCheck + +import qualified Data.Set as S +import qualified Data.Map as M +import Data.Char + +newtype MetaData = MetaData (M.Map MetaField (S.Set MetaValue)) + deriving (Show, Eq, Ord) + +{- A metadata value can be currently be set (True), or may have been + - set before and we're remembering it no longer is (False). -} +newtype CurrentlySet = CurrentlySet Bool + deriving (Read, Show, Eq, Ord, Arbitrary) + +newtype MetaField = MetaField String + deriving (Read, Show, Eq, Ord) + +data MetaValue = MetaValue CurrentlySet String + deriving (Read, Show) + +{- Metadata values compare and order the same whether currently set or not. -} +instance Eq MetaValue where + MetaValue _ a == MetaValue _ b = a == b +instance Ord MetaValue where + compare (MetaValue _ x) (MetaValue _ y) = compare x y + +{- MetaData is serialized to a format like: + - + - field1 +val1 +val2 -val3 field2 +val4 +val5 + -} +class MetaSerializable v where + serialize :: v -> String + deserialize :: String -> Maybe v + +instance MetaSerializable MetaData where + serialize (MetaData m) = unwords $ concatMap go $ M.toList m + where + go (f, vs) = serialize f : map serialize (S.toList vs) + deserialize = Just . getfield newMetaData . words + where + getfield m [] = m + getfield m (w:ws) = maybe m (getvalues m ws) (deserialize w) + getvalues m [] _ = m + getvalues m l@(w:ws) f = case deserialize w of + Just v -> getvalues (updateMetaData f v m) ws f + Nothing -> getfield m l + +instance MetaSerializable MetaField where + serialize (MetaField f) = f + deserialize = Just . MetaField + +{- Base64 problimatic values. -} +instance MetaSerializable MetaValue where + serialize (MetaValue isset v) = + serialize isset ++ + if any isSpace v || "!" `isPrefixOf` v + then '!' : toB64 v + else v + deserialize (isset:'!':v) = MetaValue + <$> deserialize [isset] + <*> fromB64Maybe v + deserialize (isset:v) = MetaValue + <$> deserialize [isset] + <*> pure v + deserialize [] = Nothing + +instance MetaSerializable CurrentlySet where + serialize (CurrentlySet True) = "+" + serialize (CurrentlySet False) = "-" + deserialize "+" = Just (CurrentlySet True) + deserialize "-" = Just (CurrentlySet False) + deserialize _ = Nothing + +{- Fields cannot be empty, contain whitespace, or start with "+-" as + - that would break the serialization. -} +toMetaField :: String -> Maybe MetaField +toMetaField f + | legalField f = Just $ MetaField f + | otherwise = Nothing + +legalField :: String -> Bool +legalField f + | null f = False + | any isSpace f = False + | any (`isPrefixOf` f) ["+", "-"] = False + | otherwise = True + +toMetaValue :: String -> MetaValue +toMetaValue = MetaValue (CurrentlySet True) + +mkMetaValue :: CurrentlySet -> String -> MetaValue +mkMetaValue = MetaValue + +unsetMetaValue :: MetaValue -> MetaValue +unsetMetaValue (MetaValue _ s) = MetaValue (CurrentlySet False) s + +{- Marks all MetaValues as no longer currently set. -} +unsetMetaData :: MetaData -> MetaData +unsetMetaData (MetaData m) = MetaData $ M.map (S.map unsetMetaValue) m + +fromMetaField :: MetaField -> String +fromMetaField (MetaField f) = f + +fromMetaValue :: MetaValue -> String +fromMetaValue (MetaValue _ f) = f + +fromMetaData :: MetaData -> [(MetaField, S.Set MetaValue)] +fromMetaData (MetaData m) = M.toList m + +newMetaData :: MetaData +newMetaData = MetaData M.empty + +{- Can be used to set a value, or to unset it, depending on whether + - the MetaValue has CurrentlySet or not. -} +updateMetaData :: MetaField -> MetaValue -> MetaData -> MetaData +updateMetaData f v (MetaData m) = MetaData $ + M.insertWith' S.union f (S.singleton v) m + +{- New metadata overrides old._-} +unionMetaData :: MetaData -> MetaData -> MetaData +unionMetaData (MetaData old) (MetaData new) = MetaData $ + M.unionWith S.union new old + +differenceMetaData :: MetaData -> MetaData -> MetaData +differenceMetaData (MetaData m) (MetaData excludem) = MetaData $ + M.differenceWith diff m excludem + where + diff sl sr = + let s = S.difference sl sr + in if S.null s then Nothing else Just s + +isSet :: MetaValue -> Bool +isSet (MetaValue (CurrentlySet isset) _) = isset + +{- Gets only currently set values -} +currentMetaDataValues :: MetaField -> MetaData -> S.Set MetaValue +currentMetaDataValues f m = S.filter isSet (metaDataValues f m) + +currentMetaData :: MetaData -> MetaData +currentMetaData (MetaData m) = removeEmptyFields $ MetaData $ + M.map (S.filter isSet) m + +removeEmptyFields :: MetaData -> MetaData +removeEmptyFields (MetaData m) = MetaData $ M.filter (not . S.null) m + +{- Gets currently set values, but also values that have been unset. -} +metaDataValues :: MetaField -> MetaData -> S.Set MetaValue +metaDataValues f (MetaData m) = fromMaybe S.empty (M.lookup f m) + +{- Ways that existing metadata can be modified -} +data ModMeta + = AddMeta MetaField MetaValue + | DelMeta MetaField MetaValue + | SetMeta MetaField MetaValue -- removes any existing values + +{- Applies a ModMeta, generating the new MetaData. + - Note that the new MetaData does not include all the + - values set in the input metadata. It only contains changed values. -} +modMeta :: MetaData -> ModMeta -> MetaData +modMeta _ (AddMeta f v) = updateMetaData f v newMetaData +modMeta _ (DelMeta f oldv) = updateMetaData f (unsetMetaValue oldv) newMetaData +modMeta m (SetMeta f v) = updateMetaData f v $ + foldr (updateMetaData f) newMetaData $ + map unsetMetaValue $ S.toList $ currentMetaDataValues f m + +{- Parses field=value, field+=value, field-=value -} +parseModMeta :: String -> Either String ModMeta +parseModMeta p = case lastMaybe f of + Just '+' -> AddMeta <$> mkMetaField f' <*> v + Just '-' -> DelMeta <$> mkMetaField f' <*> v + _ -> SetMeta <$> mkMetaField f <*> v + where + (f, sv) = separate (== '=') p + f' = beginning f + v = pure (toMetaValue sv) + +{- Parses field=value -} +parseMetaData :: String -> Either String (MetaField, MetaValue) +parseMetaData p = (,) + <$> mkMetaField f + <*> pure (toMetaValue v) + where + (f, v) = separate (== '=') p + +mkMetaField :: String -> Either String MetaField +mkMetaField f = maybe (Left $ badField f) Right (toMetaField f) + +badField :: String -> String +badField f = "Illegal metadata field name, \"" ++ f ++ "\"" + +tagMetaField :: MetaField +tagMetaField = MetaField "tag" + +{- Avoid putting too many fields in the map; extremely large maps make + - the seriaization test slow due to the sheer amount of data. + - It's unlikely that more than 100 fields of metadata will be used. -} +instance Arbitrary MetaData where + arbitrary = do + size <- arbitrarySizedBoundedIntegral `suchThat` (< 500) + MetaData . M.fromList <$> vector size + +instance Arbitrary MetaValue where + arbitrary = MetaValue <$> arbitrary <*> arbitrary + +instance Arbitrary MetaField where + arbitrary = MetaField <$> arbitrary `suchThat` legalField + +prop_metadata_sane :: MetaData -> MetaField -> MetaValue -> Bool +prop_metadata_sane m f v = and + [ S.member v $ metaDataValues f m' + , not (isSet v) || S.member v (currentMetaDataValues f m') + , differenceMetaData m' newMetaData == m' + ] + where + m' = updateMetaData f v m + +prop_metadata_serialize :: MetaField -> MetaValue -> MetaData -> Bool +prop_metadata_serialize f v m = and + [ deserialize (serialize f) == Just f + , deserialize (serialize v) == Just v + , deserialize (serialize m') == Just m' + ] + where + m' = removeEmptyFields m diff --git a/Types/Remote.hs b/Types/Remote.hs index 2a02d99aa9..2ddb68dfb8 100644 --- a/Types/Remote.hs +++ b/Types/Remote.hs @@ -24,6 +24,7 @@ import Types.Key import Types.UUID import Types.GitConfig import Types.Availability +import Types.Creds import Config.Cost import Utility.Metered import Git.Types @@ -41,7 +42,7 @@ data RemoteTypeA a = RemoteType { -- generates a remote of this type generate :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> a (Maybe (RemoteA a)), -- initializes or changes a remote - setup :: Maybe UUID -> RemoteConfig -> a (RemoteConfig, UUID) + setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> a (RemoteConfig, UUID) } instance Eq (RemoteTypeA a) where diff --git a/Types/View.hs b/Types/View.hs new file mode 100644 index 0000000000..04b002879c --- /dev/null +++ b/Types/View.hs @@ -0,0 +1,55 @@ +{- types for metadata based branch views + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Types.View where + +import Common.Annex +import Types.MetaData +import Utility.QuickCheck +import qualified Git + +import qualified Data.Set as S + +{- A view is a list of fields with filters on their allowed values, + - which are applied to files in a parent git branch. -} +data View = View + { viewParentBranch :: Git.Branch + , viewComponents :: [ViewComponent] + } + deriving (Eq, Read, Show) + +instance Arbitrary View where + arbitrary = View <$> pure (Git.Ref "master") <*> arbitrary + +data ViewComponent = ViewComponent + { viewField :: MetaField + , viewFilter :: ViewFilter + , viewVisible :: Bool + } + deriving (Eq, Read, Show) + +instance Arbitrary ViewComponent where + arbitrary = ViewComponent <$> arbitrary <*> arbitrary <*> arbitrary + +{- Only files with metadata matching the view are displayed. -} +type FileView = FilePath +type MkFileView = FilePath -> FileView + +data ViewFilter + = FilterValues (S.Set MetaValue) + | FilterGlob String + deriving (Eq, Read, Show) + +instance Arbitrary ViewFilter where + arbitrary = do + size <- arbitrarySizedBoundedIntegral `suchThat` (< 100) + FilterValues . S.fromList <$> vector size + +{- Can a ViewFilter match multiple different MetaValues? -} +multiValue :: ViewFilter -> Bool +multiValue (FilterValues s) = S.size s > 1 +multiValue (FilterGlob _) = True diff --git a/Upgrade/V2.hs b/Upgrade/V2.hs index 42419b8abd..0672de8b63 100644 --- a/Upgrade/V2.hs +++ b/Upgrade/V2.hs @@ -106,7 +106,10 @@ push = do showAction "pushing new git-annex branch to origin" showOutput inRepo $ Git.Command.run - [Param "push", Param "origin", Param $ show Annex.Branch.name] + [ Param "push" + , Param "origin" + , Param $ Git.fromRef Annex.Branch.name + ] _ -> do -- no origin exists, so just let the user -- know about the new branch diff --git a/Utility/Daemon.hs b/Utility/Daemon.hs index afba68535f..11aa576868 100644 --- a/Utility/Daemon.hs +++ b/Utility/Daemon.hs @@ -1,6 +1,6 @@ {- daemon support - - - Copyright 2012 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -10,17 +10,20 @@ module Utility.Daemon where import Common +import Utility.PID #ifndef mingw32_HOST_OS import Utility.LogFile +#else +import Utility.WinProcess +import Utility.WinLock #endif #ifndef mingw32_HOST_OS import System.Posix import Control.Concurrent.Async -#else -import System.PosixCompat.Types #endif +#ifndef mingw32_HOST_OS {- Run an action as a daemon, with all output sent to a file descriptor. - - Can write its pid to a file, to guard against multiple instances @@ -28,7 +31,6 @@ import System.PosixCompat.Types - - When successful, does not return. -} daemonize :: Fd -> Maybe FilePath -> Bool -> IO () -> IO () -#ifndef mingw32_HOST_OS daemonize logfd pidfile changedirectory a = do maybe noop checkalreadyrunning pidfile _ <- forkProcess child1 @@ -52,18 +54,18 @@ daemonize logfd pidfile changedirectory a = do wait =<< asyncWithUnmask (\unmask -> unmask a) out out = exitImmediately ExitSuccess -#else -daemonize = error "daemonize is not implemented on Windows" -- TODO #endif -{- Locks the pid file, with an exclusive, non-blocking lock. +{- Locks the pid file, with an exclusive, non-blocking lock, + - and leaves it locked on return. + - - Writes the pid to the file, fully atomically. - Fails if the pid file is already locked by another process. -} lockPidFile :: FilePath -> IO () -lockPidFile file = do - createDirectoryIfMissing True (parentDir file) +lockPidFile pidfile = do + createDirectoryIfMissing True (parentDir pidfile) #ifndef mingw32_HOST_OS - fd <- openFd file ReadWrite (Just stdFileMode) defaultFileFlags + fd <- openFd pidfile ReadWrite (Just stdFileMode) defaultFileFlags locked <- catchMaybeIO $ setLock fd (WriteLock, AbsoluteSeek, 0, 0) fd' <- openFd newfile ReadWrite (Just stdFileMode) defaultFileFlags { trunc = True } @@ -72,14 +74,21 @@ lockPidFile file = do (Nothing, _) -> alreadyRunning (_, Nothing) -> alreadyRunning _ -> do - _ <- fdWrite fd' =<< show <$> getProcessID + _ <- fdWrite fd' =<< show <$> getPID closeFd fd -#else - writeFile newfile "-1" -#endif - rename newfile file + rename newfile pidfile where - newfile = file ++ ".new" + newfile = pidfile ++ ".new" +#else + {- Not atomic on Windows, oh well. -} + unlessM (isNothing <$> checkDaemon pidfile) + alreadyRunning + pid <- getPID + writeFile pidfile (show pid) + lckfile <- winLockFile pid pidfile + writeFile lckfile "" + void $ lockExclusive lckfile +#endif alreadyRunning :: IO () alreadyRunning = error "Daemon is already running." @@ -88,7 +97,7 @@ alreadyRunning = error "Daemon is already running." - is locked by the same process that is listed in the pid file. - - If it's running, returns its pid. -} -checkDaemon :: FilePath -> IO (Maybe ProcessID) +checkDaemon :: FilePath -> IO (Maybe PID) #ifndef mingw32_HOST_OS checkDaemon pidfile = do v <- catchMaybeIO $ @@ -109,16 +118,44 @@ checkDaemon pidfile = do " (got " ++ show pid' ++ "; expected " ++ show pid ++ " )" #else -checkDaemon pidfile = maybe Nothing readish <$> catchMaybeIO (readFile pidfile) +checkDaemon pidfile = maybe (return Nothing) (check . readish) + =<< catchMaybeIO (readFile pidfile) + where + check Nothing = return Nothing + check (Just pid) = do + v <- lockShared =<< winLockFile pid pidfile + case v of + Just h -> do + dropLock h + return Nothing + Nothing -> return (Just pid) #endif {- Stops the daemon, safely. -} stopDaemon :: FilePath -> IO () -#ifndef mingw32_HOST_OS stopDaemon pidfile = go =<< checkDaemon pidfile where go Nothing = noop - go (Just pid) = signalProcess sigTERM pid + go (Just pid) = +#ifndef mingw32_HOST_OS + signalProcess sigTERM pid #else -stopDaemon = error "stopDaemon is not implemented on Windows" -- TODO + terminatePID pid +#endif + +{- Windows locks a lock file that corresponds with the pid of the process. + - This allows changing the process in the pid file and taking a new lock + - when eg, restarting the daemon. + -} +#ifdef mingw32_HOST_OS +winLockFile :: PID -> FilePath -> IO FilePath +winLockFile pid pidfile = do + cleanstale + return $ prefix ++ show pid ++ suffix + where + prefix = pidfile ++ "." + suffix = ".lck" + cleanstale = mapM_ (void . tryIO . removeFile) =<< + (filter iswinlockfile <$> dirContents (parentDir pidfile)) + iswinlockfile f = suffix `isSuffixOf` f && prefix `isPrefixOf` f #endif diff --git a/Utility/Directory.hs b/Utility/Directory.hs index c457de6e3d..f1bcfada37 100644 --- a/Utility/Directory.hs +++ b/Utility/Directory.hs @@ -1,6 +1,6 @@ {- directory manipulation - - - Copyright 2011 Joey Hess + - Copyright 2011-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -23,6 +23,7 @@ import Utility.SafeCommand import Utility.Tmp import Utility.Exception import Utility.Monad +import Utility.Applicative dirCruft :: FilePath -> Bool dirCruft "." = True @@ -73,6 +74,21 @@ dirContentsRecursiveSkipping skipdir followsubdirsymlinks topdir = go [topdir] ) _ -> skip +{- Gets the directory tree from a point, recursively and lazily, + - with leaf directories **first**, skipping any whose basenames + - match the skipdir. Does not follow symlinks. -} +dirTreeRecursiveSkipping :: (FilePath -> Bool) -> FilePath -> IO [FilePath] +dirTreeRecursiveSkipping skipdir topdir = go [] [topdir] + where + go c [] = return c + go c (dir:dirs) + | skipdir (takeFileName dir) = go c dirs + | otherwise = unsafeInterleaveIO $ do + subdirs <- go c + =<< filterM (isDirectory <$$> getSymbolicLinkStatus) + =<< catchDefaultIO [] (dirContents dir) + go (subdirs++[dir]) dirs + {- Moves one filename to another. - First tries a rename, but falls back to moving across devices if needed. -} moveFile :: FilePath -> FilePath -> IO () diff --git a/Utility/LogFile.hs b/Utility/LogFile.hs index 1c29b9ff4f..4e76116ba8 100644 --- a/Utility/LogFile.hs +++ b/Utility/LogFile.hs @@ -13,14 +13,12 @@ import Common import System.Posix.Types -openLog :: FilePath -> IO Fd #ifndef mingw32_HOST_OS +openLog :: FilePath -> IO Fd openLog logfile = do rotateLog logfile openFd logfile WriteOnly (Just stdFileMode) defaultFileFlags { append = True } -#else -openLog = error "openLog TODO" #endif rotateLog :: FilePath -> IO () @@ -49,20 +47,14 @@ listLogs logfile = filterM doesFileExist $ reverse $ maxLogs :: Int maxLogs = 9 -redirLog :: Fd -> IO () #ifndef mingw32_HOST_OS +redirLog :: Fd -> IO () redirLog logfd = do mapM_ (redir logfd) [stdOutput, stdError] closeFd logfd -#else -redirLog _ = error "redirLog TODO" -#endif redir :: Fd -> Fd -> IO () -#ifndef mingw32_HOST_OS redir newh h = do closeFd h void $ dupTo newh h -#else -redir _ _ = error "redir TODO" #endif diff --git a/Utility/PID.hs b/Utility/PID.hs new file mode 100644 index 0000000000..4867bd6de6 --- /dev/null +++ b/Utility/PID.hs @@ -0,0 +1,31 @@ +{- process ids + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Utility.PID where + +#ifndef mingw32_HOST_OS +import System.Posix.Types (ProcessID) +import System.Posix.Process (getProcessID) +#else +import System.Win32.Process (ProcessId) +import System.Win32.Process.Current (getCurrentProcessId) +#endif + +#ifndef mingw32_HOST_OS +type PID = ProcessID +#else +type PID = ProcessId +#endif + +getPID :: IO PID +#ifndef mingw32_HOST_OS +getPID = getProcessID +#else +getPID = getCurrentProcessId +#endif diff --git a/Utility/Path.hs b/Utility/Path.hs index 2bcd110d83..e22d0c3f7e 100644 --- a/Utility/Path.hs +++ b/Utility/Path.hs @@ -277,3 +277,18 @@ sanitizeFilePath = map sanitize | c == '.' = c | isSpace c || isPunctuation c || isSymbol c || isControl c || c == '/' = '_' | otherwise = c + +{- Similar to splitExtensions, but knows that some things in FilePaths + - after a dot are too long to be extensions. -} +splitShortExtensions :: FilePath -> (FilePath, [String]) +splitShortExtensions = splitShortExtensions' 5 -- enough for ".jpeg" +splitShortExtensions' :: Int -> FilePath -> (FilePath, [String]) +splitShortExtensions' maxextension = go [] + where + go c f + | len > 0 && len <= maxextension && not (null base) = + go (ext:c) base + | otherwise = (f, c) + where + (base, ext) = splitExtension f + len = length ext diff --git a/Utility/QuickCheck.hs b/Utility/QuickCheck.hs index 82af09f3dc..e2539f3d69 100644 --- a/Utility/QuickCheck.hs +++ b/Utility/QuickCheck.hs @@ -1,6 +1,6 @@ {- QuickCheck with additional instances - - - Copyright 2012 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -17,11 +17,15 @@ import Test.QuickCheck as X import Data.Time.Clock.POSIX import System.Posix.Types import qualified Data.Map as M +import qualified Data.Set as S import Control.Applicative instance (Arbitrary k, Arbitrary v, Eq k, Ord k) => Arbitrary (M.Map k v) where arbitrary = M.fromList <$> arbitrary +instance (Arbitrary v, Eq v, Ord v) => Arbitrary (S.Set v) where + arbitrary = S.fromList <$> arbitrary + {- Times before the epoch are excluded. -} instance Arbitrary POSIXTime where arbitrary = nonNegative arbitrarySizedIntegral diff --git a/Utility/WinProcess.hs b/Utility/WinProcess.hs new file mode 100644 index 0000000000..5c6d4cfce7 --- /dev/null +++ b/Utility/WinProcess.hs @@ -0,0 +1,19 @@ +{- Windows processes + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE ForeignFunctionInterface #-} + +module Utility.WinProcess where + +import Utility.PID + +import System.Win32.Process +import Foreign.C +import Control.Exception + +foreign import ccall unsafe "terminatepid" + terminatePID :: PID -> IO () diff --git a/Utility/winprocess.c b/Utility/winprocess.c new file mode 100644 index 0000000000..b6e3155739 --- /dev/null +++ b/Utility/winprocess.c @@ -0,0 +1,10 @@ +#include + +void terminatepid (DWORD pid) { + HANDLE h; + h = OpenProcess(PROCESS_TERMINATE, 0, pid); + if (h != NULL) { + TerminateProcess(h, 1); + } + CloseHandle(h); +} diff --git a/debian/changelog b/debian/changelog index e0eb14f325..d39e4fbd17 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,9 +1,50 @@ -git-annex (5.20140128) UNRELEASED; urgency=medium +git-annex (5.20140222) UNRELEASED; urgency=medium + + * Fix handling of rsync remote urls containing a username, + including rsync.net. + + -- Joey Hess Fri, 21 Feb 2014 13:03:04 -0400 + +git-annex (5.20140221) unstable; urgency=medium + + * metadata: New command that can attach metadata to files. + * --metadata can be used to limit commands to acting on files + that have particular metadata. + * Preferred content expressions can use metadata=field=value + to limit them to acting on files that have particular metadata. + * view: New command that creates and checks out a branch that provides + a structured view of selected metadata. + * vfilter, vadd, vpop, vcycle: New commands for operating within views. + * pre-commit: Update metadata when committing changes to locations + of annexed files within a view. + * Add progress display for transfers to/from external special remotes. + * unused: Fix to actually detect unused keys when in direct mode. + * fsck: When run with --all or --unused, while .gitattributes + annex.numcopies cannot be honored since it's operating on keys + instead of files, make it honor the global numcopies setting, + and the annex.numcopies git config setting. + * trust, untrust, semitrust, dead: Warn when the trust level is + overridden in .git/config. + * glacier: Do not try to run glacier value create when an existing glacier + remote is enabled. + * fsck: Refuse to do anything if more than one of --incremental, --more, + and --incremental-schedule are given, since it's not clear which option + should win. + * Windows webapp: Can set up box.com, Amazon S3, and rsync.net remotes + * Windows webapp: Can create repos on removable drives. + * Windows: Ensure HOME is set, as needed by bundled cygwin utilities. + + -- Joey Hess Fri, 21 Feb 2014 11:23:59 -0400 + +git-annex (5.20140210) unstable; urgency=medium * --in can now refer to files that were located in a repository at some past date. For example, --in="here@{yesterday}" * Fixed direct mode annexed content locking code, which is used to guard against recursive file drops. + * This is the first beta-level release of the Windows port with important + fixes (see below). + (The webapp and assistant are still alpha-level on Windows.) * sync --content: Honor annex-ignore configuration. * sync: Don't try to sync with xmpp remotes, which are only currently supported when using the assistant. @@ -13,13 +54,18 @@ git-annex (5.20140128) UNRELEASED; urgency=medium * sync --content: Reuse smart copy code from copy command, including handling and repairing out of date location tracking info. Closes: #737480 - * sync --content: Drop files from remotes that don't have them after + * sync --content: Drop files from remotes that don't want them after getting them. * sync: Fix bug in automatic merge conflict resolution code when used on a filesystem not supporting symlinks, which resulted in it losing track of the symlink bit of annexed files. * Added ways to configure rsync options to be used only when uploading or downloading from a remote. Useful to eg limit upload bandwidth. + * Fix initremote with encryption=pubkey to work with S3, glacier, webdav, + and external special remotes. + * Avoid building with DAV 0.6 which is badly broken (see #737902). + * Fix dropping of unused keys with spaces in their name. + * Fix build on platforms not supporting the webapp. * Document in man page that sshcaching uses ssh ControlMaster. Closes: #737476 * Windows: It's now safe to run multiple git-annex processes concurrently @@ -29,13 +75,11 @@ git-annex (5.20140128) UNRELEASED; urgency=medium * Windows: Fix deletion of repositories by test suite and webapp. * Windows: Test suite 100% passes again. * Windows: Fix bug in symlink calculation code. - * Fix initremote with encryption=pubkey to work with S3, glacier, webdav, - and external special remotes. + * Windows: Fix handling of absolute unix-style git repository paths. * Android: Avoid crashing when unable to set file mode for ssh config file due to Android filesystem horribleness. - * Avoid building with DAV 0.6 which is badly broken (see #737902). - -- Joey Hess Tue, 28 Jan 2014 13:57:19 -0400 + -- Joey Hess Mon, 10 Feb 2014 12:54:57 -0400 git-annex (5.20140127) unstable; urgency=medium diff --git a/debian/control b/debian/control index 966d1e0ba0..110d160cb9 100644 --- a/debian/control +++ b/debian/control @@ -13,7 +13,7 @@ Build-Depends: libghc-dataenc-dev, libghc-utf8-string-dev, libghc-hs3-dev (>= 0.5.6), - libghc-dav-dev (>= 0.3) [amd64 i386 kfreebsd-amd64 kfreebsd-i386 powerpc], + libghc-dav-dev (>= 0.6.1) [amd64 i386 kfreebsd-amd64 kfreebsd-i386 powerpc], libghc-quickcheck2-dev, libghc-monad-control-dev (>= 0.3), libghc-monadcatchio-transformers-dev, diff --git a/doc/assistant/release_notes.mdwn b/doc/assistant/release_notes.mdwn index 5c91907b12..13b7c62abf 100644 --- a/doc/assistant/release_notes.mdwn +++ b/doc/assistant/release_notes.mdwn @@ -1,3 +1,10 @@ +## version 5.20140221 + +The Windows port of the assistant and webapp is now considered to be beta +quality. There are important missing features (notably Jabber), documented +on [[todo/windows_support]], but the webapp is broadly usable on Windows +now. + ## version 5.20131221 There is now a arm [[install/linux_standalone]] build of git-annex, diff --git a/doc/bugs/Android:_Adding_Repository_on_Box.net_fails_with___34__Internal_Server_Error__34__.mdwn b/doc/bugs/Android:_Adding_Repository_on_Box.net_fails_with___34__Internal_Server_Error__34__.mdwn index dfc1cc4add..d7035432aa 100644 --- a/doc/bugs/Android:_Adding_Repository_on_Box.net_fails_with___34__Internal_Server_Error__34__.mdwn +++ b/doc/bugs/Android:_Adding_Repository_on_Box.net_fails_with___34__Internal_Server_Error__34__.mdwn @@ -15,3 +15,8 @@ Add a repository on a Box.net server to an existing repository from the webapp ( git annex 5.20140128-g32f1f68 on Android 4.1.2 (Samsung GTN8010) Build flags: Assistant Webapp S3 WebDAV Inotify XMPP DNS Feeds Quvi TDFA CryptoHash + +> Cooincidentially I noticed I'd dropped the patch that fixes that on +> Android, and have been in the process of rebuilding the Android +> autobuilder with it today. That build has finished now. [[done]] +> --[[Joey]] diff --git a/doc/bugs/Android:_Adding_Repository_on_Box.net_fails_with___34__Internal_Server_Error__34__/comment_1_91787407727f7ed833d5970d3226d0cb._comment b/doc/bugs/Android:_Adding_Repository_on_Box.net_fails_with___34__Internal_Server_Error__34__/comment_1_91787407727f7ed833d5970d3226d0cb._comment new file mode 100644 index 0000000000..45d5da95e5 --- /dev/null +++ b/doc/bugs/Android:_Adding_Repository_on_Box.net_fails_with___34__Internal_Server_Error__34__/comment_1_91787407727f7ed833d5970d3226d0cb._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkI9pq1WH6MWeExXHVQVEsniT3DdFv4AB8" + nickname="Roberto" + subject="problem still persists" + date="2014-02-10T22:55:33Z" + content=""" +I'm trying right now the latest build (5.20140210-gd99db49) but the problem persists. Am I missing something? +"""]] diff --git a/doc/bugs/Android:_Adding_Repository_on_Box.net_fails_with___34__Internal_Server_Error__34__/comment_2_f4c52fe33e9c4c107c2469fabb0c6826._comment b/doc/bugs/Android:_Adding_Repository_on_Box.net_fails_with___34__Internal_Server_Error__34__/comment_2_f4c52fe33e9c4c107c2469fabb0c6826._comment new file mode 100644 index 0000000000..d566170c9d --- /dev/null +++ b/doc/bugs/Android:_Adding_Repository_on_Box.net_fails_with___34__Internal_Server_Error__34__/comment_2_f4c52fe33e9c4c107c2469fabb0c6826._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.172" + subject="comment 2" + date="2014-02-10T23:25:42Z" + content=""" +Hmm, I've verified that the certificate library I built for android uses the right path. But for some reason that path is not showing up in the android executable. + +I think perhaps things have changed and a different library is now being used! Probably +"""]] diff --git a/doc/bugs/Android:_Adding_Repository_on_Box.net_fails_with___34__Internal_Server_Error__34__/comment_3_20c1f9399321dd85cb584b8845140b1d._comment b/doc/bugs/Android:_Adding_Repository_on_Box.net_fails_with___34__Internal_Server_Error__34__/comment_3_20c1f9399321dd85cb584b8845140b1d._comment new file mode 100644 index 0000000000..d728e35a8b --- /dev/null +++ b/doc/bugs/Android:_Adding_Repository_on_Box.net_fails_with___34__Internal_Server_Error__34__/comment_3_20c1f9399321dd85cb584b8845140b1d._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.172" + subject="finished rebuilding everything" + date="2014-02-11T17:48:07Z" + content=""" +All android builds are updated. Verified the path this time in the binary. +"""]] diff --git a/doc/bugs/Android:_Adding_Repository_on_Box.net_fails_with___34__Internal_Server_Error__34__/comment_4_d92c30061e087878a2462b5a2e495346._comment b/doc/bugs/Android:_Adding_Repository_on_Box.net_fails_with___34__Internal_Server_Error__34__/comment_4_d92c30061e087878a2462b5a2e495346._comment new file mode 100644 index 0000000000..299364913a --- /dev/null +++ b/doc/bugs/Android:_Adding_Repository_on_Box.net_fails_with___34__Internal_Server_Error__34__/comment_4_d92c30061e087878a2462b5a2e495346._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkI9pq1WH6MWeExXHVQVEsniT3DdFv4AB8" + nickname="Roberto" + subject="fix confirmed" + date="2014-02-12T12:05:42Z" + content=""" +I can confirm the problem is now fixed. + +Unfortunately a new problem has emerged with gpg that might be related to other open issues. I will try to investigate it further before opening a new ticket. + +By the way thank you very much for your great work. I'm eager to see the new metadata framework in place. It sounds extremely interesting! +"""]] diff --git a/doc/bugs/Auto_update_not_updating_to_newest_version/comment_5_ab1ee005dbd54e560ea6e3c716cc8f1b._comment b/doc/bugs/Auto_update_not_updating_to_newest_version/comment_5_ab1ee005dbd54e560ea6e3c716cc8f1b._comment new file mode 100644 index 0000000000..b05a0b1e26 --- /dev/null +++ b/doc/bugs/Auto_update_not_updating_to_newest_version/comment_5_ab1ee005dbd54e560ea6e3c716cc8f1b._comment @@ -0,0 +1,70 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawk7iPiqWr3BVPLWEDvJhSSvcOqheLEbLNo" + nickname="Dirk" + subject="Still problems" + date="2014-02-14T11:30:10Z" + content=""" +There seem to be still problems here. + +I removed all my old configurations and repositories and reinstalled the newest version from the site. After starting I get a message about an update being available. I update and end up with the same version. + +[[!format sh \"\"\" +[2014-02-14 12:22:10 CET] main: starting assistant version 5.20140209-g3a61dbe +(scanning...) [2014-02-14 12:22:10 CET] Watcher: Performing startup scan +(started...) [2014-02-14 12:22:10 CET] Upgrader: An upgrade of git-annex is available. (version 5.20140210) +--2014-02-14 12:23:24-- https://downloads.kitenet.net/git-annex/OSX/current/10.9_Mavericks/git-annex.dmg +Resolving downloads.kitenet.net... 80.68.85.49, 2001:41c8:125:49::10 +Connecting to downloads.kitenet.net|80.68.85.49|:443... connected. +HTTP request sent, awaiting response... 200 OK +Length: 29053083 (28M) [application/x-apple-diskimage] +Saving to: ‘/Users/kraft/Desktop/annex/.git/annex/tmp/SHA256E-s29053083--ee629137b511da8b874cdac78ece54b344b2b2a1763e4bf806949c9868117b13.dmg’ + + 0K .......... .......... .......... .......... .......... 0% 2.46M 11s + 50K .......... .......... .......... .......... .......... 0% 1.69M 14s + 100K .......... .......... .......... .......... .......... 0% 4.39M 11s + 150K .......... .......... .......... .......... .......... 0% 2.28M 11s + 200K .......... .......... .......... .......... .......... 0% 7.15M 10s + 250K .......... .......... .......... .......... .......... 1% 2.30M 10s + 300K .......... .......... .......... .......... .......... 1% 15.5M 9s + + 28300K .......... .......... .......... .......... .......... 99% 11.0M 0s + 28350K .......... .......... .. 100% 16.8M=2.8s + +2014-02-14 12:23:28 (9.96 MB/s) - ‘/Users/kraft/Desktop/annex/.git/annex/tmp/SHA256E-s29053083--ee629137b511da8b874cdac78ece54b344b2b2a1763e4bf806949c9868117b13.dmg’ saved [29053083/29053083] + +[2014-02-14 12:23:28 CET] main: Downloaded git-annex.. upgrade) +Checksumming Protective Master Boot Record (MBR : 0)… +Protective Master Boot Record (MBR :: verified CRC32 $BFC39E6D +Checksumming GPT Header (Primary GPT Header : 1)… + GPT Header (Primary GPT Header : 1): verified CRC32 $3488C834 +Checksumming GPT Partition Data (Primary GPT Table : 2)… +GPT Partition Data (Primary GPT Tabl: verified CRC32 $CABDFFA1 +Checksumming (Apple_Free : 3)… + (Apple_Free : 3): verified CRC32 $00000000 +Checksumming disk image (Apple_HFS : 4)… + disk image (Apple_HFS : 4): verified CRC32 $0CFF6F1A +Checksumming (Apple_Free : 5)… + (Apple_Free : 5): verified CRC32 $00000000 +Checksumming GPT Partition Data (Backup GPT Table : 6)… +GPT Partition Data (Backup GPT Table: verified CRC32 $CABDFFA1 +Checksumming GPT Header (Backup GPT Header : 7)… + GPT Header (Backup GPT Header : 7): verified CRC32 $4EC691C4 +verified CRC32 $A78EB9FA +/dev/disk4 GUID_partition_scheme +/dev/disk4s1 Apple_HFS /Applications/git-annex.upgrade.0 +\"disk4\" unmounted. +\"disk4\" ejected. +git-annex version: 5.20140209-g3a61dbe +build flags: Assistant Webapp Pairing S3 WebDAV FsEvents XMPP DNS Feeds Quvi TDFA CryptoHash +key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 WORM URL +remote types: git gcrypt S3 bup directory rsync web webdav tahoe glacier hook external +local repository version: 5 +supported repository version: 5 +upgrade supported from repository versions: 0 1 2 4 +[2014-02-14 12:23:45 CET] main: Upgrading git-annex +[2014-02-14 12:23:45 CET] main: starting assistant version 5.20140209-g3a61dbe +[2014-02-14 12:23:45 CET] UpgradeWatcher: Finished upgrading git-annex to version 5.20140209-g3a61dbe +(scanning...) [2014-02-14 12:23:45 CET] Watcher: Performing startup scan +(started...) +\"\"\"]] +"""]] diff --git a/doc/bugs/Creating_a_box.com_repository_fails/comment_3_6c3610fb95676592f17f36e4e1b09bd8._comment b/doc/bugs/Creating_a_box.com_repository_fails/comment_3_6c3610fb95676592f17f36e4e1b09bd8._comment new file mode 100644 index 0000000000..cff2e605da --- /dev/null +++ b/doc/bugs/Creating_a_box.com_repository_fails/comment_3_6c3610fb95676592f17f36e4e1b09bd8._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawk9nck8WX8-ADF3Fdh5vFo4Qrw1I_bJcR8" + nickname="Jon Ander" + subject="comment 3" + date="2014-02-11T08:01:47Z" + content=""" +I'm getting the same error in version 5.20140210 +"""]] diff --git a/doc/bugs/Creating_a_box.com_repository_fails/comment_4_c9895712e72854e4b5ff7a58e82ae374._comment b/doc/bugs/Creating_a_box.com_repository_fails/comment_4_c9895712e72854e4b5ff7a58e82ae374._comment new file mode 100644 index 0000000000..19350f3e03 --- /dev/null +++ b/doc/bugs/Creating_a_box.com_repository_fails/comment_4_c9895712e72854e4b5ff7a58e82ae374._comment @@ -0,0 +1,17 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawm78jq1Uo-ZbyOPG3diJUWVvEiM0kyAcvk" + nickname="Dorian" + subject="Same problem here" + date="2014-02-12T13:17:50Z" + content=""" +
+[2014-02-12 14:11:12 CET] main: starting assistant version 5.20140127.1
+[2014-02-12 14:11:12 CET] Cronner: You should enable consistency checking to protect your data. 
+(scanning...) [2014-02-12 14:11:12 CET] Watcher: Performing startup scan
+(started...) 
+(encryption setup) (shared cipher) (testing WebDAV server...)
+12/Feb/2014:14:11:49 +0100 [Error#yesod-core] InternalIOException : hPutBuf: illegal operation (handle is closed) @(yesod-core-1.2.3:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:471:5)
+(encryption setup) (shared cipher) (testing WebDAV server...)
+12/Feb/2014:14:13:01 +0100 [Error#yesod-core] InternalIOException : hPutBuf: illegal operation (handle is closed) @(yesod-core-1.2.3:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:471:5)
+
+"""]] diff --git a/doc/bugs/Creating_a_box.com_repository_fails/comment_5_93981afe8162f64ebb9d8c2c6a7ef91e._comment b/doc/bugs/Creating_a_box.com_repository_fails/comment_5_93981afe8162f64ebb9d8c2c6a7ef91e._comment new file mode 100644 index 0000000000..bcff92ac9b --- /dev/null +++ b/doc/bugs/Creating_a_box.com_repository_fails/comment_5_93981afe8162f64ebb9d8c2c6a7ef91e._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawk9nck8WX8-ADF3Fdh5vFo4Qrw1I_bJcR8" + nickname="Jon Ander" + subject="Not fixed" + date="2014-02-14T09:03:29Z" + content=""" +This bug has been marked as fixed but I'm still experiencing it in 5.20140210 +"""]] diff --git a/doc/bugs/Creating_a_box.com_repository_fails/comment_6_752b5725b4596721438098d38af8fb66._comment b/doc/bugs/Creating_a_box.com_repository_fails/comment_6_752b5725b4596721438098d38af8fb66._comment new file mode 100644 index 0000000000..4804e1671e --- /dev/null +++ b/doc/bugs/Creating_a_box.com_repository_fails/comment_6_752b5725b4596721438098d38af8fb66._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawk7iPiqWr3BVPLWEDvJhSSvcOqheLEbLNo" + nickname="Dirk" + subject="No working ubuntu package" + date="2014-02-16T20:50:50Z" + content=""" +The 5.20140210 package from François Marier tells me \"WebDAV not supported by this build\" when trying to add a box.com repository. So, can't really test this anymore on ubuntu. +"""]] diff --git a/doc/bugs/In_the_assistant__44___add_some_clarifications_near___34__Add_another_local_repository__34___for_the_case_of_adding_an_existing_repository.mdwn b/doc/bugs/In_the_assistant__44___add_some_clarifications_near___34__Add_another_local_repository__34___for_the_case_of_adding_an_existing_repository.mdwn new file mode 100644 index 0000000000..0e49bc3687 --- /dev/null +++ b/doc/bugs/In_the_assistant__44___add_some_clarifications_near___34__Add_another_local_repository__34___for_the_case_of_adding_an_existing_repository.mdwn @@ -0,0 +1,28 @@ +### Please describe the problem. + +The difference in consequences of `Add another local repository` in the *git-annex assistant* on an existing repository versus on a new directory are unclear. + +### What steps will reproduce the problem? + +Going to the "Add another local repository" in the *git-annex assistant* will make you confused if you want to add an existing repository. + +### What version of git-annex are you using? On what operating system? + +[[!format sh """ +$ git annex version +git-annex version: 5.20140210-gd99db49 +build flags: Assistant Webapp Pairing S3 WebDAV Inotify DBus XMPP Feeds Quvi TDFA +key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SHA256 SHA1 SHA512 SHA224 SHA384 WORM URL +remote types: git gcrypt S3 bup directory rsync web webdav tahoe glacier hook external +"""]] + +Ubuntu 13.04 + +### Please provide any additional information below. + +Ain't nobody here but us chickens. + +> Ok, I have removed the reference to "new repository" since it can be +> a new or an existing repository. The webapp already asks followup +> questions if the repository exists to make sure nothing confusing +> happens. [[done]] --[[Joey]] diff --git a/doc/bugs/Incorrect_symlink_path_in_simple_submodule_use_case/comment_2_e84b93062c82453f18308a82ee270585._comment b/doc/bugs/Incorrect_symlink_path_in_simple_submodule_use_case/comment_2_e84b93062c82453f18308a82ee270585._comment new file mode 100644 index 0000000000..29302f0c12 --- /dev/null +++ b/doc/bugs/Incorrect_symlink_path_in_simple_submodule_use_case/comment_2_e84b93062c82453f18308a82ee270585._comment @@ -0,0 +1,16 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmYwE2LrTHAgbco1mEa_y8rGVqX7exIoxc" + nickname="François" + subject="Replace the gitdir by a symbolic link" + date="2014-02-11T08:06:53Z" + content=""" +chadsgilbert proposed to replace the .git file by a symbolic link: + + + +What do you think of this possibility? Is it perennial? Can \"git annex init\" do it automatically? + +The [commit message](https://github.com/git/git/commit/69c305178) that introduces the change gives the impression that a symbolic link was a possibility. + +Thanks a lot for git annex! +"""]] diff --git a/doc/bugs/Mac_OS_git_version_still_too_old_for_.gitignore__63__.mdwn b/doc/bugs/Mac_OS_git_version_still_too_old_for_.gitignore__63__.mdwn new file mode 100644 index 0000000000..5de6d2aa57 --- /dev/null +++ b/doc/bugs/Mac_OS_git_version_still_too_old_for_.gitignore__63__.mdwn @@ -0,0 +1,28 @@ +### Please describe the problem. + +Joey, it looks like the git version wasn't updated with the latest release as is still too old to respect .gitignore files. I'm hoping that I haven't just made a silly mistake but I don't think I have... + +See http://git-annex.branchable.com/bugs/Mac_OS_git_version_too_old_to_honour_.gitignore/ for bug that was closed. + +### What steps will reproduce the problem? + +Install git-annex 5.20140209-g3a61dbe and try to use .gitignore file to exclude items from git annex. + +### What version of git-annex are you using? On what operating system? + +5.20140209-g3a61dbe on Mac OS 10.9.1. + +### Please provide any additional information below. + +[/Applications/git-annex.app/Contents/MacOS]# ./git annex version + +git-annex version: 5.20140209-g3a61dbe +build flags: Assistant Webapp Pairing S3 WebDAV FsEvents XMPP DNS Feeds Quvi TDFA CryptoHash +key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 WORM URL +remote types: git gcrypt S3 bup directory rsync web webdav tahoe glacier hook external + +[/Applications/git-annex.app/Contents/MacOS]# ./git --version + +git version 1.8.3.4 (Apple Git-47) + +> Really [[fixed|done]] now. --[[Joey]] diff --git a/doc/bugs/Mac_OS_git_version_still_too_old_for_.gitignore__63__/comment_1_1768ece63499c643c75085773b6d4c18._comment b/doc/bugs/Mac_OS_git_version_still_too_old_for_.gitignore__63__/comment_1_1768ece63499c643c75085773b6d4c18._comment new file mode 100644 index 0000000000..afa6cc8f6e --- /dev/null +++ b/doc/bugs/Mac_OS_git_version_still_too_old_for_.gitignore__63__/comment_1_1768ece63499c643c75085773b6d4c18._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.172" + subject="comment 1" + date="2014-02-20T18:59:44Z" + content=""" +I thought it got upgrades, perhaps it was downgraded again? I have prodded Kevin. +"""]] diff --git a/doc/bugs/Mac_OS_git_version_still_too_old_for_.gitignore__63__/comment_2_888fb193072cf05a34943db072eb7a3b._comment b/doc/bugs/Mac_OS_git_version_still_too_old_for_.gitignore__63__/comment_2_888fb193072cf05a34943db072eb7a3b._comment new file mode 100644 index 0000000000..1bd1e037ee --- /dev/null +++ b/doc/bugs/Mac_OS_git_version_still_too_old_for_.gitignore__63__/comment_2_888fb193072cf05a34943db072eb7a3b._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmZgZuUhZlHpd_AbbcixY0QQiutb2I7GWY" + nickname="Jimmy" + subject="comment 2" + date="2014-02-21T07:03:20Z" + content=""" +Thanks Joey and Kevin. Glad to have the bug really fixed and glad to know that I wasn't missing something obvious! +"""]] diff --git a/doc/bugs/Matching_oddity_in_SafeCommand.hs.mdwn b/doc/bugs/Matching_oddity_in_SafeCommand.hs.mdwn new file mode 100644 index 0000000000..53bba4a9b7 --- /dev/null +++ b/doc/bugs/Matching_oddity_in_SafeCommand.hs.mdwn @@ -0,0 +1,28 @@ +In SafeCommand.hs, the code to unwrap a File looks like: + +[[!format haskell """ +toCommand :: [CommandParam] -> [String] +toCommand = concatMap unwrap + where + [...] + -- Files that start with a non-alphanumeric that is not a path + -- separator are modified to avoid the command interpreting them as + -- options or other special constructs. + unwrap (File s@(h:_)) + | isAlphaNum h || h `elem` pathseps = [s] + | otherwise = ["./" ++ s] + unwrap (File s) = [s] + [...] +"""]] + +I am not sure I understand which case would be caught in the last clause "unwrap (File s)". Is that the empty file? Because all non-empty file names seem to have been caught earlier, at least in the "otherwise" if they do not match the condition. In this case, wouldn't it be an error to use an empty file name and wouldn't it be better to throw an exception instead of returning [[]]? + +I would use: + +[[!format haskell """ + unwrap (File []) = throw "Empty file name in SafeCommand.toCommand" +"""]] + +or something similar instead. + +> [[done]] diff --git a/doc/bugs/Matching_oddity_in_SafeCommand.hs/comment_1_1a51630c0791547a7e0b68eea5d81e4c._comment b/doc/bugs/Matching_oddity_in_SafeCommand.hs/comment_1_1a51630c0791547a7e0b68eea5d81e4c._comment new file mode 100644 index 0000000000..d52dfed431 --- /dev/null +++ b/doc/bugs/Matching_oddity_in_SafeCommand.hs/comment_1_1a51630c0791547a7e0b68eea5d81e4c._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.172" + subject="comment 1" + date="2014-02-12T16:27:10Z" + content=""" +You're right that line only matches empty filenames. I think that the Hurd actually does support empty filenames. It seems that the command being run would otherwise complain that it was given an empty parameter. So I do not think it's worth throwing an error here. Also, I prefer to keep toCommand a total function. +"""]] diff --git a/doc/bugs/More_build_oddities_under_OpenBSD/comment_10_09297f99f3c1c081738ca4ab32808fde._comment b/doc/bugs/More_build_oddities_under_OpenBSD/comment_10_09297f99f3c1c081738ca4ab32808fde._comment new file mode 100644 index 0000000000..e3871ea612 --- /dev/null +++ b/doc/bugs/More_build_oddities_under_OpenBSD/comment_10_09297f99f3c1c081738ca4ab32808fde._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.163" + subject="comment 10" + date="2014-02-08T18:31:23Z" + content=""" +But you said that setSocketOption failed when you were using XMPP, not when starting the webapp, so I think it's more likely to be one of the setSocketOption calls in the network library, or possibly somewhere else. +"""]] diff --git a/doc/bugs/More_build_oddities_under_OpenBSD/comment_11_1407efc78b92a3c6156154f54e4a14e2._comment b/doc/bugs/More_build_oddities_under_OpenBSD/comment_11_1407efc78b92a3c6156154f54e4a14e2._comment new file mode 100644 index 0000000000..78c430533d --- /dev/null +++ b/doc/bugs/More_build_oddities_under_OpenBSD/comment_11_1407efc78b92a3c6156154f54e4a14e2._comment @@ -0,0 +1,97 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkzwmw_zyMpZC9_J7ey--woeYPoZkAOgGw" + nickname="dxtrish" + subject="comment 11" + date="2014-02-08T19:18:17Z" + content=""" +I honestly have no idea why that move works because + + % ls -lh /usr/lib|grep -E '(gsasl|xml2|gnutls|idn)' + +returns nothing. But couldn't those symbols already be in the other libraries considering, from what I've read at least, haskell stuff are statically compiled by default? + +Anyway, you are completely right that this happened when I try to use XMPP. The reason I was looking in the wrong place to begin with was because the webapp spit out the error messsage. I have redirected my attention to the network library and the xmpp library. + +But I might have found something interesting in the network library. Keep in mind that I just learned a little today, so do correct me if I'm wrong. + +Looking at http://hackage.haskell.org/package/network-2.2.1.8/docs/src/Network-Socket.html I found: + + setSocketOption :: Socket + -> SocketOption -- Option Name + -> Int -- Option Value + -> IO () + setSocketOption (MkSocket s _ _ _ _) so v = do + with (fromIntegral v) $ \ptr_v -> do + throwErrnoIfMinus1_ \"setSocketOption\" $ + c_setsockopt s (socketOptLevel so) (packSocketOption so) ptr_v + (fromIntegral (sizeOf v)) + return () + +Everything here looks good. So I decided to take a look at SocketOption, socketOptLevel and packSocketOption. + + data SocketOption + = DummySocketOption__ + | Debug {- SO_DEBUG -} + | ReuseAddr {- SO_REUSEADDR -} + | Type {- SO_TYPE -} + | SoError {- SO_ERROR -} + | DontRoute {- SO_DONTROUTE -} + | Broadcast {- SO_BROADCAST -} + | SendBuffer {- SO_SNDBUF -} + | RecvBuffer {- SO_RCVBUF -} + | KeepAlive {- SO_KEEPALIVE -} + | OOBInline {- SO_OOBINLINE -} + | TimeToLive {- IP_TTL -} + | MaxSegment {- TCP_MAXSEG -} + | NoDelay {- TCP_NODELAY -} + | Linger {- SO_LINGER -} + | RecvLowWater {- SO_RCVLOWAT -} + | SendLowWater {- SO_SNDLOWAT -} + | RecvTimeOut {- SO_RCVTIMEO -} + | SendTimeOut {- SO_SNDTIMEO -} + + socketOptLevel :: SocketOption -> CInt + socketOptLevel so = + case so of + TimeToLive -> 0 + MaxSegment -> 6 + NoDelay -> 6 + _ -> 1 + + packSocketOption :: SocketOption -> CInt + packSocketOption so = + case so of + Debug -> 1 + ReuseAddr -> 2 + Type -> 3 + SoError -> 4 + DontRoute -> 5 + Broadcast -> 6 + SendBuffer -> 7 + RecvBuffer -> 8 + KeepAlive -> 9 + OOBInline -> 10 + TimeToLive -> 2 + MaxSegment -> 2 + NoDelay -> 1 + Linger -> 13 + RecvLowWater -> 18 + SendLowWater -> 19 + RecvTimeOut -> 20 + SendTimeOut -> 21 + +Everything looks good so I thought long and hard about this. Then, by chance, I just looked at the man page for setsockopt() and it mentioned SOL_SOCKET and I was like \"Hmm...\" + + % grep -R SOL_SOCKET /usr/include + /usr/include/openssl/e_os.h:#define ioctlsocket(a,b,c) setsockopt((a),SOL_SOCKET,(b),(c),sizeof(*(c))) + /usr/include/sys/socket.h:#define SOL_SOCKET 0xffff /* options for socket level */ + /usr/include/sys/socket.h:/* Read using getsockopt() with SOL_SOCKET, SO_PEERCRED */ + +Wat? + + #define SOL_SOCKET 0xffff + +Going back to the Haskell code above I realized that SetSocketOption will NEVER feed 0xffff as level to setsockopt() because socketOptLevel returns 1 unless optname is TimeToLive, MaxSegment or NoDelay. + +Am I way off? +"""]] diff --git a/doc/bugs/More_build_oddities_under_OpenBSD/comment_12_fdec033e37652c51fbcd74438586d285._comment b/doc/bugs/More_build_oddities_under_OpenBSD/comment_12_fdec033e37652c51fbcd74438586d285._comment new file mode 100644 index 0000000000..77c8edc68a --- /dev/null +++ b/doc/bugs/More_build_oddities_under_OpenBSD/comment_12_fdec033e37652c51fbcd74438586d285._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.163" + subject="comment 12" + date="2014-02-08T20:03:30Z" + content=""" +WRT haskell static linking, AFAIK that only affects haskell libraries. If they in turn link with C libs, the linking is still dynamic. At least this is the case on both Linux and the limited BSDs I've used it on. Have no OpenBSD experience. + +`SOL_SOCKET` is 1 on linux, so you may have the culprit. + +However.. That's a really old version of network! 2.2.1.8 is from 2010. In a more current 2.4.x version, packSocketOption uses the `SOL_SOCKET` value and not 1, so should work AFAICS. +"""]] diff --git a/doc/bugs/More_build_oddities_under_OpenBSD/comment_13_ed3716baf787ca17d227ce2e327a1959._comment b/doc/bugs/More_build_oddities_under_OpenBSD/comment_13_ed3716baf787ca17d227ce2e327a1959._comment new file mode 100644 index 0000000000..3981d32bfd --- /dev/null +++ b/doc/bugs/More_build_oddities_under_OpenBSD/comment_13_ed3716baf787ca17d227ce2e327a1959._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.163" + subject="comment 13" + date="2014-02-08T20:12:12Z" + content=""" +Does your binary end up dynamically linked to libxml2 etc? If not, it certianly seems plausible that the haskell libs statically linked with the C libs, and then at binary link time it tried to redundantly link with the libs again and failed. If this is the case, it seems it would probably be a bug in ghc. You can use `cabal build --ghc-options=-v` to get a look at how the linker is run. +"""]] diff --git a/doc/bugs/More_build_oddities_under_OpenBSD/comment_14_cf5f92e5cdfc738e7f6178c1d7a73ceb._comment b/doc/bugs/More_build_oddities_under_OpenBSD/comment_14_cf5f92e5cdfc738e7f6178c1d7a73ceb._comment new file mode 100644 index 0000000000..bb4d095a37 --- /dev/null +++ b/doc/bugs/More_build_oddities_under_OpenBSD/comment_14_cf5f92e5cdfc738e7f6178c1d7a73ceb._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkzwmw_zyMpZC9_J7ey--woeYPoZkAOgGw" + nickname="dxtrish" + subject="comment 14" + date="2014-02-08T20:29:46Z" + content=""" +Sigh.. Ofcourse it was an old version. It never occurred to me to check that. I was just Googling around and stumbled over that page. +Do you have any pointers on how I would debug this further? + +Regarding the linking; I haven't checked it any further actually. I'm planning on investigating that further once I can get this error sorted out. But my hypothesis is that it's all statically linked all the way through, like I said. That would also explain those error messages I got during linking before. +"""]] diff --git a/doc/bugs/More_build_oddities_under_OpenBSD/comment_15_ad4b7191c9b8f67def33b26a1d762a5d._comment b/doc/bugs/More_build_oddities_under_OpenBSD/comment_15_ad4b7191c9b8f67def33b26a1d762a5d._comment new file mode 100644 index 0000000000..4aeda69ebf --- /dev/null +++ b/doc/bugs/More_build_oddities_under_OpenBSD/comment_15_ad4b7191c9b8f67def33b26a1d762a5d._comment @@ -0,0 +1,26 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.163" + subject="comment 15" + date="2014-02-08T20:56:10Z" + content=""" +I think you need to find which calls to setSocketOption are failing and/or what value is causing the crash. It's a bit of a pain to get a backtrace on error (would need to build everything with profiling enabled and run git-annex with +RTS -xc options). Probably simplest to modify the setSocketOption code: + +[[!format patch \"\"\" +diff --git a/Network/Socket.hsc b/Network/Socket.hsc +index 2fe62ee..0c66432 100644 +--- a/Network/Socket.hsc ++++ b/Network/Socket.hsc +@@ -963,7 +963,7 @@ setSocketOption :: Socket + setSocketOption (MkSocket s _ _ _ _) so v = do + (level, opt) <- packSocketOption' \"setSocketOption\" so + with (fromIntegral v) $ \ptr_v -> do +- throwSocketErrorIfMinus1_ \"setSocketOption\" $ ++ throwSocketErrorIfMinus1_ (\"setSocketOption \" ++ show so ++ \" \" ++ show v) $ + c_setsockopt s level opt ptr_v + (fromIntegral (sizeOf (undefined :: CInt))) + return () +\"\"\"]] + +Which should make it print out a quite nice symbolic name of the option being used on failure, which will make it easy to find any call sites and more importantly, determine what's wrong with that option. +"""]] diff --git a/doc/bugs/More_build_oddities_under_OpenBSD/comment_16_2e765b5286d816bea00880a17a20cbfb._comment b/doc/bugs/More_build_oddities_under_OpenBSD/comment_16_2e765b5286d816bea00880a17a20cbfb._comment new file mode 100644 index 0000000000..def40653da --- /dev/null +++ b/doc/bugs/More_build_oddities_under_OpenBSD/comment_16_2e765b5286d816bea00880a17a20cbfb._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkzwmw_zyMpZC9_J7ey--woeYPoZkAOgGw" + nickname="dxtrish" + subject="comment 16" + date="2014-02-08T21:08:38Z" + content=""" +Thanks for that code snippet! I'll try it out within the next few minutes. + +Also, how would I go about rebuilding everything with profiling support? I'm doing this testing in a virtual machine so I can always start over from scratch. +"""]] diff --git a/doc/bugs/More_build_oddities_under_OpenBSD/comment_17_ded9011dcdbe4de05189a0e8d040f045._comment b/doc/bugs/More_build_oddities_under_OpenBSD/comment_17_ded9011dcdbe4de05189a0e8d040f045._comment new file mode 100644 index 0000000000..f361268419 --- /dev/null +++ b/doc/bugs/More_build_oddities_under_OpenBSD/comment_17_ded9011dcdbe4de05189a0e8d040f045._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.163" + subject="comment 17" + date="2014-02-08T21:23:02Z" + content=""" +Blow away ~/.ghc and ~/.cabal; cabal update; put `library-profiling: True` in ~/.cabal/config; and reinstall everything. + +Note that you may need to first build ghc's own bundled libraries with profiling support, if your ghc installation does not already include them. I don't know how to do that since on debian I can just `apt-get install ghc-prof`. If that's needed, ghc will tell you and refuse to build stuff with profiling. +"""]] diff --git a/doc/bugs/More_build_oddities_under_OpenBSD/comment_18_f7a85b46bf7afaaf431d6771219c66b0._comment b/doc/bugs/More_build_oddities_under_OpenBSD/comment_18_f7a85b46bf7afaaf431d6771219c66b0._comment new file mode 100644 index 0000000000..d8d73a0b77 --- /dev/null +++ b/doc/bugs/More_build_oddities_under_OpenBSD/comment_18_f7a85b46bf7afaaf431d6771219c66b0._comment @@ -0,0 +1,16 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkzwmw_zyMpZC9_J7ey--woeYPoZkAOgGw" + nickname="dxtrish" + subject="comment 18" + date="2014-02-08T23:25:29Z" + content=""" +I applied your patch and rebuilt. I even tried doing it from scratch just to get it right. + +I have three news: + +1) I got it completely working in a virtual machine + +2) On my actual (physical) openbsd machine it still isn't working, even though they're almost identical. The only difference is that the physical one also has IPv6 connectivity, while the virtual machine doesn't. Could that be it? I don't know yet, although I'm about to try it. + +3) Your patch did not help. It still didn't print out anything more useful, suggesting that it in fact isn't that function that is throwing the error. [This](http://i.imgur.com/tmBiseE.png) is what the actual error looks like and shows up after I enter the jabber account details. +"""]] diff --git a/doc/bugs/More_build_oddities_under_OpenBSD/comment_19_217be2000e423e844241d405ba9f64c8._comment b/doc/bugs/More_build_oddities_under_OpenBSD/comment_19_217be2000e423e844241d405ba9f64c8._comment new file mode 100644 index 0000000000..7ea52c150a --- /dev/null +++ b/doc/bugs/More_build_oddities_under_OpenBSD/comment_19_217be2000e423e844241d405ba9f64c8._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.172" + subject="comment 19" + date="2014-02-09T02:13:20Z" + content=""" +I'll bet you didn't rebuild all the libraries that depend on network. (Which all that static linking makes necessary...) + +IPv6 was my first guess; see http://git-annex.branchable.com/bugs/More_build_oddities_under_OpenBSD/#comment-84ee81cd162d22283fcccc1a41c8f8b3 +"""]] diff --git a/doc/bugs/More_build_oddities_under_OpenBSD/comment_20_df72e5698ba2bf2eb4fa39c5b2c5be83._comment b/doc/bugs/More_build_oddities_under_OpenBSD/comment_20_df72e5698ba2bf2eb4fa39c5b2c5be83._comment new file mode 100644 index 0000000000..29e58e1564 --- /dev/null +++ b/doc/bugs/More_build_oddities_under_OpenBSD/comment_20_df72e5698ba2bf2eb4fa39c5b2c5be83._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.172" + subject="comment 20" + date="2014-02-20T20:26:03Z" + content=""" +Any further luck on this? + +It would be nice if a page on openbsd could be added to the install page documenting what is needed to get it to build. +"""]] diff --git a/doc/bugs/More_build_oddities_under_OpenBSD/comment_6_65913a2de8bbe981beaa66c58d2429b5._comment b/doc/bugs/More_build_oddities_under_OpenBSD/comment_6_65913a2de8bbe981beaa66c58d2429b5._comment new file mode 100644 index 0000000000..ff76fb3ded --- /dev/null +++ b/doc/bugs/More_build_oddities_under_OpenBSD/comment_6_65913a2de8bbe981beaa66c58d2429b5._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkzwmw_zyMpZC9_J7ey--woeYPoZkAOgGw" + nickname="dxtrish" + subject="comment 6" + date="2014-02-08T17:23:54Z" + content=""" +Googling around I found [this](http://lpaste.net/77947) codesnippet that suggests setSocketOption is broken under OpenBSD +"""]] diff --git a/doc/bugs/More_build_oddities_under_OpenBSD/comment_7_8dd46cec230125d1410d8e6824aeddf2._comment b/doc/bugs/More_build_oddities_under_OpenBSD/comment_7_8dd46cec230125d1410d8e6824aeddf2._comment new file mode 100644 index 0000000000..72b427357a --- /dev/null +++ b/doc/bugs/More_build_oddities_under_OpenBSD/comment_7_8dd46cec230125d1410d8e6824aeddf2._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.163" + subject="comment 7" + date="2014-02-08T17:42:52Z" + content=""" +What was the ugly hack that got it to link? + +I've seen setSocketOption fail on other OS's for various portability reasons. The haskell library that is responsible for this is , and you can find several setSocketOption calls in it. I've had good luck ifdefing those out when they don't work. + +Here's a patch where I disable the IPv6Only setting on Android (amoung other unrelated porting) +"""]] diff --git a/doc/bugs/More_build_oddities_under_OpenBSD/comment_8_275d3e62cb5667a2d6ddd90db7a40bff._comment b/doc/bugs/More_build_oddities_under_OpenBSD/comment_8_275d3e62cb5667a2d6ddd90db7a40bff._comment new file mode 100644 index 0000000000..f7f7e34291 --- /dev/null +++ b/doc/bugs/More_build_oddities_under_OpenBSD/comment_8_275d3e62cb5667a2d6ddd90db7a40bff._comment @@ -0,0 +1,18 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkzwmw_zyMpZC9_J7ey--woeYPoZkAOgGw" + nickname="dxtrish" + subject="comment 8" + date="2014-02-08T18:13:33Z" + content=""" +What I did was to temporarily move away (or rename) the offending libs. What I essentially did was this: + + cabal configure + cabal build + sudo mv /usr/local/lib/lib{xml2,gnutls,gsasl,idn}.a /tmp + cabal install + sudo mv /tmp/lib{xml2,gnutls,gsasl,idn}.a /usr/local/lib + +but I've also had to patch network-info. I've contacted the maintainer of that package but I haven't received anything. I'm considering creating an actual fork with my changes but that would almost seem kind of silly as I don't know *ANY* haskell.. But I am looking at the Haskell wiki as I'm typing this so I can see what I'm looking at :). + +Won't break anything by not setting SO_REUSEADDR? I suspect you're setting it for a reason? +"""]] diff --git a/doc/bugs/More_build_oddities_under_OpenBSD/comment_9_ec6a1eb6c7b264c23ec4bbd45465d7d8._comment b/doc/bugs/More_build_oddities_under_OpenBSD/comment_9_ec6a1eb6c7b264c23ec4bbd45465d7d8._comment new file mode 100644 index 0000000000..dee77a69f8 --- /dev/null +++ b/doc/bugs/More_build_oddities_under_OpenBSD/comment_9_ec6a1eb6c7b264c23ec4bbd45465d7d8._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.163" + subject="comment 9" + date="2014-02-08T18:29:41Z" + content=""" +So you moved away libs in /usr/local to expose usable ones in /usr? + +I've had luck before sending the network-info mantainer pull requests: + +git-annex does set ReuseAddr in one place; in Utility/Webapp.hs. The only time that would have a benefit would be when using `git annex webapp --listen=address:port` and starting and restarting the webapp. Normally the webapp chooses a random free port so it shouldn't need that. +"""]] diff --git a/doc/bugs/Numcopies_not_checked_when_running_with_--all.mdwn b/doc/bugs/Numcopies_not_checked_when_running_with_--all.mdwn new file mode 100644 index 0000000000..e4a364195e --- /dev/null +++ b/doc/bugs/Numcopies_not_checked_when_running_with_--all.mdwn @@ -0,0 +1,40 @@ +### Please describe the problem. +There are a lot of differences in the behaviour of usual commands and commans using --all. +The specific problem I found was that "git annex fsck --all" will only checksum it seems and not report back numcopies failures. +Checking if objects/old versions have propagated is not possible without it or do I miss something. + +(As additional note not sure if related. It seems that git annex fsck --all is running much faster in my tests 1/3 faster. Any reason for that? Bug related?) + + +### What steps will reproduce the problem? +compare "git annex fsck" vs "git annex fsck" (no numcopies check) + +### What version of git-annex are you using? On what operating system? +git-annex version: 5.20140210-gd99db49 +Linux (Ubuntu 13.10) + +### 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. +"""]] + +> It's expected that --all (and --unused) make .gitattributes +> annex.numcopies settings be ignored, because with these options git-annex +> is operating on keys, it does not know or care what filename they're +> associated with, and so cannot look them up in .gitattributes. I have +> improved the documentation of .gitattributes files to mention this +> limitation. +> +> I also notice that fsck --all is not checking .git/config's +> annex.numcopies or the new global numcopies setting. It certianly makes +> sense for those numcopies settings to be paid attention to. +> [[fixed|done]] --[[Joey]] +> +> (--all is faster because it can quickly scan through .git/annex/objects +> to find everything, rather than looking at the symlink target of every +> file in the work tree.) diff --git a/doc/bugs/Numcopies_not_checked_when_running_with_--all/comment_1_63af5a11c3ae370433c4bf84de097414._comment b/doc/bugs/Numcopies_not_checked_when_running_with_--all/comment_1_63af5a11c3ae370433c4bf84de097414._comment new file mode 100644 index 0000000000..c0cbe3907c --- /dev/null +++ b/doc/bugs/Numcopies_not_checked_when_running_with_--all/comment_1_63af5a11c3ae370433c4bf84de097414._comment @@ -0,0 +1,9 @@ +[[!comment format=mdwn + username="stp" + ip="84.56.21.11" + subject="Some suggestions" + date="2014-02-20T21:22:21Z" + content=""" +So I think it should at least for --all look at the global numcopies setting. As this could be essential to prevent data-loss. +I agree that special working tree related numcopies don't need to be included. +"""]] diff --git a/doc/bugs/Resolve_.local_adresses_using_avahi_or_bonjour.mdwn b/doc/bugs/Resolve_.local_adresses_using_avahi_or_bonjour.mdwn index 74966415eb..3626f20245 100644 --- a/doc/bugs/Resolve_.local_adresses_using_avahi_or_bonjour.mdwn +++ b/doc/bugs/Resolve_.local_adresses_using_avahi_or_bonjour.mdwn @@ -13,4 +13,4 @@ Ubuntu ### Please provide any additional information below. - +> [[closing|done]] --[[Joey]] diff --git a/doc/bugs/__39__Internal_Server_Error__39___when_creating_repo_on_other_drive_than_C:_on_Windows.mdwn b/doc/bugs/__39__Internal_Server_Error__39___when_creating_repo_on_other_drive_than_C:_on_Windows.mdwn index 42d9ab48b2..b6f8e3ca48 100644 --- a/doc/bugs/__39__Internal_Server_Error__39___when_creating_repo_on_other_drive_than_C:_on_Windows.mdwn +++ b/doc/bugs/__39__Internal_Server_Error__39___when_creating_repo_on_other_drive_than_C:_on_Windows.mdwn @@ -31,3 +31,6 @@ Launching web browser on file://C:\Users\bbigras\AppData\Local\Temp\webapp9400.h fatal: Not a git repository: '/annex/.git' error: could not lock config file /annex/.git/config: No such file or directory """]] + +> I've fixed this! [[done]] Yay!! Get the fix from the hourly windows autobuilder. +> --[[Joey]] diff --git a/doc/bugs/assistant_eats_all_CPU/comment_18_970899faca972af6795ae0d3be1ce444._comment b/doc/bugs/assistant_eats_all_CPU/comment_18_970899faca972af6795ae0d3be1ce444._comment new file mode 100644 index 0000000000..6e9378154a --- /dev/null +++ b/doc/bugs/assistant_eats_all_CPU/comment_18_970899faca972af6795ae0d3be1ce444._comment @@ -0,0 +1,42 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawm3ayIrWKe5SqLYomXiCL-l2CDpREvA-IE" + nickname="myownlittl" + subject="Seconding this Bug." + date="2014-02-19T02:04:34Z" + content=""" +Hi Joey, I have also experienced this bug. I put my \"~/my\" folder under gitannex's management, and I've since had gitannex's assistant consume a CPU (100% of one core) when starting my computer for 1 - 12 hours (at which point I get impatient and kill annex). If stack traces would help, I can email you those. Unfortunately, my \"my\" folder includes every important document I've created, coded, or needed, in the last six years. It has just under 30,000 files, and probably isn't using gitannex the way it's intended to be used. You can see the distribution of files and file sizes in the tables below. + +If gitannex isn't designed for this sort of use case, can you recommend any free software tools that might be able to help opportunistically keep files in sync at this sort of scale, like GA? + +Thanks for your time, + +Nick + +---- + +[[!table data=\"\"\" +Size<= | Bytes | Count | +0B | 0 | 1108 | +1B | 1 | 264 | +16B | 16 | 179 | +256B | 256 | 3414 | +4K | 4096 | 12771 | +65K | 65536 | 7402 | +1M | 1048576 | 2975 | +16M | 16777216 | 703 | +256M | 268435456 | 126 | +4G | 4294967296 | 5 | +\"\"\"]] + + | Size<= | Bytes | Count | + | 0B | 0 | 1108 | + | 1B | 1 | 264 | + | 16B | 16 | 179 | + | 256B | 256 | 3414 | + | 4K | 4096 | 12771 | + | 65K | 65536 | 7402 | + | 1M | 1048576 | 2975 | + | 16M | 16777216 | 703 | + | 256M | 268435456 | 126 | + | 4G | 4294967296 | 5 | +"""]] diff --git a/doc/bugs/assistant_on_windows_adding_remote_containing_linux_paths.mdwn b/doc/bugs/assistant_on_windows_adding_remote_containing_linux_paths.mdwn index cdaabf78ee..c6b6ee4821 100644 --- a/doc/bugs/assistant_on_windows_adding_remote_containing_linux_paths.mdwn +++ b/doc/bugs/assistant_on_windows_adding_remote_containing_linux_paths.mdwn @@ -6,9 +6,18 @@ internal error, /home/michele/assistannex is not absolute ### What steps will reproduce the problem? -create a transfer repository on a usb drive (from windows) merge it with a repository on linux, try to merge it on another target windows machine +create a transfer repository on a usb drive (from windows) merge it with a +repository on linux, try to merge it on another target windows machine ### What version of git-annex are you using? On what operating system? git-annex version 5.20140128-g29aea74 +> I'm not able to follow the steps to reproduce this, but I think +> I see what the problem is. `isAbsolute` on windows does not think that +> unix-style path is absolute. Such a path can appear in a remote of a git +> repository, particularly if part of that repository was set up on a +> non-Windows system. While the remote won't be usable on Windows with a +> path like that, git-annex should not choke on the path either. +> I have fixed the code to deal with this. +> [[done]] --[[Joey]] diff --git a/doc/bugs/assistant_unable_to_auth___40__windows__41__.mdwn b/doc/bugs/assistant_unable_to_auth___40__windows__41__.mdwn index 494e4fb581..b019d51b82 100644 --- a/doc/bugs/assistant_unable_to_auth___40__windows__41__.mdwn +++ b/doc/bugs/assistant_unable_to_auth___40__windows__41__.mdwn @@ -81,3 +81,5 @@ Options: -q --quiet avoid verbose output etc """]] + +> [[fixed|done]]; both for regular remote ssh servers, and for rsync.net --[[Joey]] diff --git a/doc/bugs/assistant_using_the_incorrect_path_on_windows__63__.mdwn b/doc/bugs/assistant_using_the_incorrect_path_on_windows__63__.mdwn index 387ba74161..1ad8005224 100644 --- a/doc/bugs/assistant_using_the_incorrect_path_on_windows__63__.mdwn +++ b/doc/bugs/assistant_using_the_incorrect_path_on_windows__63__.mdwn @@ -40,3 +40,6 @@ Start creating a remote repository. ### What version of git-annex are you using? On what operating system? Windows 7, git-annex version 5.20131230-g192d991 + +> [[fixed|done]]; git-annex now ensures HOME is set when running cygwin +> commands that require it. --[[Joey]] diff --git a/doc/bugs/can__39__t_drop_unused_files_that_never_were_added.mdwn b/doc/bugs/can__39__t_drop_unused_files_that_never_were_added.mdwn new file mode 100644 index 0000000000..361f21f0e3 --- /dev/null +++ b/doc/bugs/can__39__t_drop_unused_files_that_never_were_added.mdwn @@ -0,0 +1,86 @@ +### Please describe the problem. + +When adding files to the annex and then deciding against it in an "unusual" way, git-annex gets confused and the file left behind can't be removed from the annex... + +### What steps will reproduce the problem? + +1. Add file with "git annex add" +2. Decide you don't need the file add all +3. "git rm -f newfile" +4. "git annex unused" +5. "git annex dropunused all" + +### What version of git-annex are you using? On what operating system? + +git-annex version: 5.20140210 on Debian unstable + +### 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 +$ git init +Initialized empty Git repository in /tmp/foo/.git/ +$ ls -l +total 0 +$ cp ~/download/hub-ctrl.c . +$ git add hub-ctrl.c +$ git commit +[master (root-commit) ed7eb68] A file. + 1 file changed, 412 insertions(+) + create mode 100644 hub-ctrl.c +$ cp ~/download/hub-ctrl . +$ ls -l +total 28 +-rwxr-xr-x 1 tobias tobias 14130 Feb 19 00:49 hub-ctrl +-rw-r--r-- 1 tobias tobias 9270 Feb 19 00:48 hub-ctrl.c +$ git annex init +init ok +(Recording state in git...) +$ git annex add +add hub-ctrl ok +(Recording state in git...) +$ git status +On branch master +Changes to be committed: + (use "git reset HEAD ..." to unstage) + + new file: hub-ctrl + +$ git rm hub-ctrl +error: the following file has changes staged in the index: + hub-ctrl +(use --cached to keep the file, or -f to force removal) +$ git rm -f hub-ctrl +rm 'hub-ctrl' +$ git status +On branch master +nothing to commit, working directory clean +$ git annex unused +unused . (checking for unused data...) (checking HEAD...) + Some annexed data is no longer used by any files: + NUMBER KEY + 1 SHA256E-s14130--d4e777ba2b99ed0a520fbabe7b93cf2165373b4945afe8dcb626231d9051f19d + (To see where data was previously used, try: git log --stat -S'KEY') + + To remove unwanted data: git-annex dropunused NUMBER + +ok +$ git annex dropunused all +dropunused 1 (unsafe) + Could only verify the existence of 0 out of 1 necessary copies + + Rather than dropping this file, try using: git annex move + + (Use --force to override this check, or adjust numcopies.) +failed +git-annex: dropunused: 1 failed +$ + +# End of transcript or log. +"""]] + +> It seems to me that if you run `git annex dropunused --force`, it will +> remove the file. This needing --force is a recent change; git-annex +> tries to never posibly lose data unless forced. Dropping the last +> copy of a file certianly qualifies. [[done]] --[[Joey]] diff --git a/doc/bugs/copy_unused_and_unused_not_agreeing.mdwn b/doc/bugs/copy_unused_and_unused_not_agreeing.mdwn new file mode 100644 index 0000000000..68328ac962 --- /dev/null +++ b/doc/bugs/copy_unused_and_unused_not_agreeing.mdwn @@ -0,0 +1,48 @@ +[[!format sh """ +greg@x200s:~/Documents$ git-annex unused +unused . (checking for unused data...) (checking annex/direct/master...) (checking synced/annex/direct/master...) (checking synology/master...) + Some annexed data is no longer used by any files: + NUMBER KEY + 1 SHA256E-s16367--0b00ef0154c42a0bf94e5be8d92d8af27455d59794f26c33dfc39c09178521c9.pdf + 2 SHA256E-s84--b08e1c831863bb43c02158bd5e8f3f5416c3a5203d89fa94a22149460142c273.odt + 3 SHA256E-s84--ec4caae451180a29721f2b6667eec8ec80eaa724f0727cf99d2bb21bf9218e9d.odt + ... + 88 SHA256E-s84--710d69bef61674b04974ac550d713e5928563b2a12b902b64fe451705b967452.doc + 89 SHA256E-s3830--1348d6248e35625da3e22f73d2a0017185bb5e1aa37f65bbca5dfcb3c7f53034 + 90 SHA256E-s119822--7c1b53ab6402b8835473f0b5c326f3cc300ac9372be79694942c1efa4bcdc621.pdf + 91 SHA256E-s84--63b6188696795885ff6570a76a3a74799396787f7058cbcfd4a2c40b22982420.odt + (To see where data was previously used, try: git log --stat -S'KEY') + + To remove unwanted data: git-annex dropunused NUMBER + +ok +greg@x200s:~/Documents$ git-annex copy --unused --to synology +"""]] + +Is that correct behavior? I would assume the last command would at least run through the 91 files and check my synology remote that they are there. Like this repo did: + +[[!format sh """ +$ git-annex unused +unused . (checking for unused data...) (checking master...) (checking 60justin/master...) + Some annexed data is no longer used by any files: + NUMBER KEY + 1 SHA256E-s9390266--7ed16c9423b331dbe63bb3b4278b8c94a6754a07177c53fceb3b24e9610e8054.NEF + 2 SHA256E-s10435713--49cbfe8466eada2c3787c9a7e158a7dfb9845a0aa8ef862ed2578b59c889dc4d.NEF + 3 SHA256E-s9442044--85c314e318f643237df5e3adf7559e9bf268ee28f1f92d4102161865323ddeb6.NEF + 4 SHA256E-s290672--c5822c3ef16bd62b5752b2dace81182ce00d64bd4d2d994ba93e3cb94e645708.JPG + 5 SHA256E-s293288--30f1367fc326f7b053012818863151206f9e3ddeab3c3fc5b5c1c573d120d50a.JPG + 6 SHA256E-s3672986--be960f6dc247df2496f634f7d788bd4a180fe556230e2dafc23ebc8fc1f10af3.JPG + (To see where data was previously used, try: git log --stat -S'KEY') + + To remove unwanted data: git-annex dropunused NUMBER + +ok +$ git-annex copy --unused --to synology +copy SHA256E-s9390266--7ed16c9423b331dbe63bb3b4278b8c94a6754a07177c53fceb3b24e9610e8054.NEF (checking synology...) ok +copy SHA256E-s10435713--49cbfe8466eada2c3787c9a7e158a7dfb9845a0aa8ef862ed2578b59c889dc4d.NEF (checking synology...) ok +copy SHA256E-s9442044--85c314e318f643237df5e3adf7559e9bf268ee28f1f92d4102161865323ddeb6.NEF (checking synology...) ok +copy SHA256E-s290672--c5822c3ef16bd62b5752b2dace81182ce00d64bd4d2d994ba93e3cb94e645708.JPG (checking synology...) ok +copy SHA256E-s293288--30f1367fc326f7b053012818863151206f9e3ddeab3c3fc5b5c1c573d120d50a.JPG (checking synology...) ok +copy SHA256E-s3672986--be960f6dc247df2496f634f7d788bd4a180fe556230e2dafc23ebc8fc1f10af3.JPG (checking synology...) ok +$ +"""]] diff --git a/doc/bugs/copy_unused_and_unused_not_agreeing/comment_1_a11a45868867361fcff61471ffe0ce39._comment b/doc/bugs/copy_unused_and_unused_not_agreeing/comment_1_a11a45868867361fcff61471ffe0ce39._comment new file mode 100644 index 0000000000..cedc0f7f9a --- /dev/null +++ b/doc/bugs/copy_unused_and_unused_not_agreeing/comment_1_a11a45868867361fcff61471ffe0ce39._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://grossmeier.net/" + nickname="greg" + subject="indirect vs direct" + date="2014-02-20T06:25:31Z" + content=""" +Aha! The issue is that the first repo (the one not copying unused files to synology) was in direct mode. I switched it to indirect and not only are there now a lot more files listed in unused, but copy --unused is working as expected. + +Should there be a warning in git-annex unused when in direct mode about this? I'm not exactly sure what is happening (not sure why the number of unused would go up from 91 to 296). +"""]] diff --git a/doc/bugs/copy_unused_and_unused_not_agreeing/comment_2_15559ba19393f5c061f77bc56379f8e1._comment b/doc/bugs/copy_unused_and_unused_not_agreeing/comment_2_15559ba19393f5c061f77bc56379f8e1._comment new file mode 100644 index 0000000000..a3a3c119fe --- /dev/null +++ b/doc/bugs/copy_unused_and_unused_not_agreeing/comment_2_15559ba19393f5c061f77bc56379f8e1._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.172" + subject="Could I get a "version", brethren?" + date="2014-02-20T17:58:32Z" + content=""" +I think there are two bugs here. I just reproduced and fixed a bug that would caused `git annex unused` to sometimes not notice certain unused keys when in direct mode. That's why the number you were finding in direct and indirect was different. + +That does not explain why `copy --unused` would not operate on unused files when in direct mode. A problem I have not managed to reproduce.. + +There was a recent change to the format of the .git/annex/unused.log, which temporarily broke reading it (fixed in 5.20140210). This could be some version skew problem, as while the new git-annex version can read the old log format, the old git-annex version will ignore the new log format. +"""]] diff --git a/doc/bugs/copy_unused_and_unused_not_agreeing/comment_3_9b1340e0f6a107695849c04374aaeae2._comment b/doc/bugs/copy_unused_and_unused_not_agreeing/comment_3_9b1340e0f6a107695849c04374aaeae2._comment new file mode 100644 index 0000000000..4fb2b3d391 --- /dev/null +++ b/doc/bugs/copy_unused_and_unused_not_agreeing/comment_3_9b1340e0f6a107695849c04374aaeae2._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://grossmeier.net/" + nickname="greg" + subject="comment 3" + date="2014-02-20T19:31:56Z" + content=""" +heh, I *just* dist-upgraded this morning on the box that was showing the problem from git-annex_5.20140127_amd64.deb to git-annex_5.20140210_amd64.deb. So what you say is probably right (re unused.log). + +The only other annex I have in direct mode right now is one that I also am using the standalone build with (version 5.20131224-g6ca5271 right now). It has unused content in it (in fact, it's the synology annex, where I'm moving all the unused data to). I can do testing there if needed (and since it's a standalone build, it's easy for me to switch around git-annex versions with symlinks). The only problem is that it is dog slow when running git-annex unused. :) +"""]] diff --git a/doc/bugs/copy_unused_and_unused_not_agreeing/comment_4_b88530080fd90686cfa7e336f8328dcb._comment b/doc/bugs/copy_unused_and_unused_not_agreeing/comment_4_b88530080fd90686cfa7e336f8328dcb._comment new file mode 100644 index 0000000000..9deb87d24e --- /dev/null +++ b/doc/bugs/copy_unused_and_unused_not_agreeing/comment_4_b88530080fd90686cfa7e336f8328dcb._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.172" + subject="comment 4" + date="2014-02-20T19:49:21Z" + content=""" +Well, if you had a newer git-annex than 5.20140127 temporarily in path, it would certianly explain it. I have tested --unused in direct mode and am not seeing any problems. +"""]] diff --git a/doc/bugs/fsck_giving_false_checking_information.mdwn b/doc/bugs/fsck_giving_false_checking_information.mdwn new file mode 100644 index 0000000000..b22ac1c66b --- /dev/null +++ b/doc/bugs/fsck_giving_false_checking_information.mdwn @@ -0,0 +1,29 @@ +### Please describe the problem. +When a repository has no object of a given file and git annex fsck is run it still shows "fsck file ok", which is missleading in the sense, that it gives the impression that it checked the file is alright/checksummed. + +As a result of this it seems that incremental fscks are not incremental with non checkable objects. On each run (after the first one) with "git annex fsck --incremental --more --schedule-limit 1d" all files without objects are checked even so it should wait another day till it checks again. + +Probably best to say checksum couldn't be checked on x files (only give that as quiet output, not every check) + +Another thing, which came up as a problem was, that checksum fsck would not be wanted to run as often as numcopie checks. +When the incremental fsck is used to check for bad files "git annex fsck --incremental --more --limit 1m" after a fast numcopies check "git annex fsck --incremental --more --limit 1m fast" it messes up the actual bad files check. +As both are currently using the same incremental "lock"-file they are colliding. + +### What steps will reproduce the problem? +- + +### What version of git-annex are you using? On what operating system? +git-annex version: 5.20140210-gd99db49 +Linux (Ubuntu 13.10) + +### 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. +"""]] + +> [[fixed|done]] --[[Joey]] diff --git a/doc/bugs/fsck_giving_false_checking_information/comment_1_1000603ea6b8a19eb09e6754789ad528._comment b/doc/bugs/fsck_giving_false_checking_information/comment_1_1000603ea6b8a19eb09e6754789ad528._comment new file mode 100644 index 0000000000..af198c7224 --- /dev/null +++ b/doc/bugs/fsck_giving_false_checking_information/comment_1_1000603ea6b8a19eb09e6754789ad528._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="stp" + ip="188.193.207.34" + subject="Earlier version syntax was removed" + date="2014-02-17T16:05:34Z" + content=""" +In earlier versions I noticed that when checksumming it would give back \"fsck file (checksum...) ok\" instead of \"fsck file ok\", which is at least better than not differentiating. This should definitely be improved. Perhaps even clearer than the (checksum...) notice. + +But still the incremental run not being incremental and not taking into account the schedule-limit seems strange. +"""]] diff --git a/doc/bugs/fsck_giving_false_checking_information/comment_2_3ce7c8f7098f0bf86ed409a3a095c152._comment b/doc/bugs/fsck_giving_false_checking_information/comment_2_3ce7c8f7098f0bf86ed409a3a095c152._comment new file mode 100644 index 0000000000..838471598c --- /dev/null +++ b/doc/bugs/fsck_giving_false_checking_information/comment_2_3ce7c8f7098f0bf86ed409a3a095c152._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.172" + subject="comment 2" + date="2014-02-20T20:11:36Z" + content=""" +You're only meant to use one of --incremental, or --more, or --incremental-schedule at a time. I have made fsck refuse to accept combinations of those options. + +What was happening is that, since you didn't understand the documentation (which is possibly not as clear as it could be; I have tried to improve it now), the --incremental option you passed dominated all the other options, and made it start a *new* incremental fsck each time. Which means it started from the beginning and fscked every file until you stopped it. + +I agree that it would be better if fsck --fast --incremental did not collide with fsck --incremental. There is already a bug about that: [[incremental fsck should not use sticky bit]]. + +Finally, I agree that losing the \"(checksum)\" made fsck output less informative. Although I don't think it is needed in the `git annex add` output. I have made it be shown in only the fsck output. +"""]] diff --git a/doc/bugs/fsck_giving_false_checking_information/comment_3_be4d0fec56c29cf978ef7d1715eaa516._comment b/doc/bugs/fsck_giving_false_checking_information/comment_3_be4d0fec56c29cf978ef7d1715eaa516._comment new file mode 100644 index 0000000000..27de723587 --- /dev/null +++ b/doc/bugs/fsck_giving_false_checking_information/comment_3_be4d0fec56c29cf978ef7d1715eaa516._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="stp" + ip="84.56.21.11" + subject="Great improvements" + date="2014-02-20T21:20:15Z" + content=""" +Thanks for clearing it up. It is still a bit confusing that you have to differentiate on the second run. (using --more) I probably view it as inconvenient as it make me have to remember the first and second time of running a command. I think it would be cleaner to have \"--incremental\" always skipping files and \"--incremental restart\" start from the beginning. + +Ah great yeah they are different functions and should therefore not interfere. (fsck --fast --incremental) + +Great that the checksum is back in and yeah I agree that it isn't really needed in the add command. + + +"""]] diff --git a/doc/bugs/git_annex_sync_--content_not_syncing_all_objects.mdwn b/doc/bugs/git_annex_sync_--content_not_syncing_all_objects.mdwn new file mode 100644 index 0000000000..a9426724ca --- /dev/null +++ b/doc/bugs/git_annex_sync_--content_not_syncing_all_objects.mdwn @@ -0,0 +1,31 @@ +### Please describe the problem. +When "git annex sync --content" is used only objects currently in the working tree are synced. It doesn't honor full archives, which should get all objects. +So only objects similar to "git annex find --want-get" are synced and not every available object "git annex get --all" + + +### What steps will reproduce the problem? +# mein repo: +git annex add file +git annex sync +git annex rm file +git annex sync + +# other repo: +git annex wanted here "not copies=backup:3" +git annex find --want-get # will be empty +git annex sync --content # nothing is synced even so all files should be backed up +git annex get --all # will sync the object from file + +### What version of git-annex are you using? On what operating system? +git-annex version: 5.20140210-gd99db49 +Linux (Ubuntu 13.10) + +### 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. +"""]] diff --git a/doc/bugs/git_annex_sync_--content_not_syncing_all_objects/comment_1_36deea0f1277d6888c8bb79156c56efa._comment b/doc/bugs/git_annex_sync_--content_not_syncing_all_objects/comment_1_36deea0f1277d6888c8bb79156c56efa._comment new file mode 100644 index 0000000000..e395eac0e2 --- /dev/null +++ b/doc/bugs/git_annex_sync_--content_not_syncing_all_objects/comment_1_36deea0f1277d6888c8bb79156c56efa._comment @@ -0,0 +1,16 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.172" + subject="comment 1" + date="2014-02-20T19:34:29Z" + content=""" +Yep, sync --content only looks at the work tree. + +I suppose that the assistant does a better job in this situation, since if it cannot access an archive repo, it will remember that it tried to send a file to it, and retry that transfer later -- even if in the meantime the file has gotten deleted out of the work tree (and still has content present, due to using indirect mode). I'm actually not 100% sure .. the assistant may give up on transferring a file if it's gotten removed from the work tree. It's worth considering this because I basically want sync --content to do the same syncing that the assistant does. + +Anyway, sync --content could certianly look at all keys present in the annex. This would require a separate pass, and it might then try to upload a key twice, once from work tree, and once from annex, and fail twice. + +Maybe it would be better to have this as a separate --content --all. It might also make sense to keep sync --content only looking at the work tree by default to support cases where there are multiple branches and you only want to sync one. + +I think this needs more thought. +"""]] diff --git a/doc/bugs/git_annex_sync_--content_not_syncing_all_objects/comment_2_70804d50b07630fadfc029a22173c5a0._comment b/doc/bugs/git_annex_sync_--content_not_syncing_all_objects/comment_2_70804d50b07630fadfc029a22173c5a0._comment new file mode 100644 index 0000000000..4560e10d97 --- /dev/null +++ b/doc/bugs/git_annex_sync_--content_not_syncing_all_objects/comment_2_70804d50b07630fadfc029a22173c5a0._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="stp" + ip="84.56.21.11" + subject="Some ideas for content sync" + date="2014-02-20T21:18:30Z" + content=""" +I agree that it is a tricky situation. The main issue I have is that archive preferred content expressions indicates that all versions are transferred, but when you (worst case) migrate full archives to other disks and just use git annex sync --content, you would loose all objects. + +I like the idea of --content --all as this would be consistent with other commands such as fsck for example. +Still it seems with preferred content expressions only applying to working tree data that it would still miss \"copies=backup:2\" for example and only use working tree files. Which is misleading and could lead to dataloss in my opinion. + +So the best would probably be to let preferred content for number of copies at least work on all objects, either per default or when \"git annex sync --content --all\" is used. You wouldn't run that on usual repos, but definitely on backup, archive or similar repos. + +"""]] diff --git a/doc/bugs/git_repo_fails_to_checkout.mdwn b/doc/bugs/git_repo_fails_to_checkout.mdwn new file mode 100644 index 0000000000..0c3b660189 --- /dev/null +++ b/doc/bugs/git_repo_fails_to_checkout.mdwn @@ -0,0 +1,39 @@ +### Please describe the problem. + +Attempting to clone the git repository produces + + (master) cayley:git-annex% git checkout -f HEAD + error: unable to create file doc/bugs/fatal:_unable_to_access___39__..__47__..__47__..__47__..__47__C:__92__Users__92____91__...__93____92__annex__92__.git__47__config__39__:_Invalid_argument___40__Windows__41__.mdwn (File name too long) + fatal: cannot create directory at 'doc/bugs/fatal:_unable_to_access___39__..__47__..__47__..__47__..__47__C:__92__Users__92____91__...__93____92__annex__92__.git__47__config__39__:_Invalid_argument___40__Windows__41__': File name too long + +### What steps will reproduce the problem? + +I get the above with either + + git clone https://github.com/joeyh/git-annex + +or (after this fails) retrying with + + cd git-annex + git checkout -f HEAD + +### What version of git-annex are you using? On what operating system? + +I am running git 1.9.0 from git (5f95c9f850b19b368c43ae399cc831b17a26a5ac in the git git repo) on Ubuntu 13.04. + +> More encfs brain-damange. + + One such limitation is filename length. If your underlying + filesystem limits you to N characters in a filename, then + EncFS will limit you to approximately 3*(N-2)/4. + +> It's really astounding that Ubuntu inflicts that POS on users. +> However, I can't see that as justification for limiting the +> git-annex repository to filenames shorter than `PATH_MAX` -- just +> as DOS's problems with both filename length and also `:` in filenames +> is not a good reason to mangle the repository. +> +> In either case, it's up to the user to find a way to make it work. +> In the DOS case, that involves using Cygwin's git. In the encfs case, +> it presumably means checking it out into a real filesystem. +> [[done]] --[[Joey]] diff --git a/doc/bugs/git_repo_fails_to_checkout/comment_1_d92e7e3b41382501a08f6a66c673b1fd._comment b/doc/bugs/git_repo_fails_to_checkout/comment_1_d92e7e3b41382501a08f6a66c673b1fd._comment new file mode 100644 index 0000000000..55e063f391 --- /dev/null +++ b/doc/bugs/git_repo_fails_to_checkout/comment_1_d92e7e3b41382501a08f6a66c673b1fd._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://geoffreyirving.myopenid.com/" + nickname="Geoffrey Irving" + subject="encrypted home directory" + date="2014-02-18T18:05:24Z" + content=""" +It looks like this problem is related to using an encrypted home directory. +"""]] diff --git a/doc/bugs/incremental_fsck_should_not_use_sticky_bit/comment_6_c7f1170b84f9ea4befe96cdfe3bdaa1f._comment b/doc/bugs/incremental_fsck_should_not_use_sticky_bit/comment_6_c7f1170b84f9ea4befe96cdfe3bdaa1f._comment new file mode 100644 index 0000000000..9d70c84ec4 --- /dev/null +++ b/doc/bugs/incremental_fsck_should_not_use_sticky_bit/comment_6_c7f1170b84f9ea4befe96cdfe3bdaa1f._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.172" + subject="comment 6" + date="2014-02-20T20:09:22Z" + content=""" +I also need some local fast database for metadata index storing. +"""]] diff --git a/doc/bugs/numcopies_deprecated__44___but_still_in_walkthrough.mdwn b/doc/bugs/numcopies_deprecated__44___but_still_in_walkthrough.mdwn new file mode 100644 index 0000000000..12e2672f3b --- /dev/null +++ b/doc/bugs/numcopies_deprecated__44___but_still_in_walkthrough.mdwn @@ -0,0 +1,21 @@ +### Please describe the problem. +Within the walkthrough the deprecated annex.numcopies are still used. At least it should be added that "git annex numcopies x" can be used to define it globally without the need for a .gitattribute file. And use .gitattribute only for per directory and fine grained control. +http://git-annex.branchable.com/walkthrough/backups/ + +### What steps will reproduce the problem? + + +### What version of git-annex are you using? On what operating system? + + +### 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. +"""]] + +> [[fixed|done]] --[[Joey]] diff --git a/doc/bugs/problems_with_android_and_gpg.mdwn b/doc/bugs/problems_with_android_and_gpg.mdwn new file mode 100644 index 0000000000..ac5cab7cd4 --- /dev/null +++ b/doc/bugs/problems_with_android_and_gpg.mdwn @@ -0,0 +1,73 @@ +### Please describe the problem. +When my android phone tries to decode files downloaded from a ssh remote using shared encryption, gpg errors occur. + +### What steps will reproduce the problem? +Setup is very similar to my other bug report in . +Only difference is the location of the annex on the android side. +I have put it on the /data mount which uses ext4 to avoid the /sdcard fuse mount, which does not handle symlinks. + +1) setup git annex via webapp on laptop: + +* local annex + +* remote annex via ssh with shared encryption (tried two different servers, one with and one without git-annex installed) + +* share with my devices using jabber.me account + +2) setup git annex via webapp on android: + +* local annex in /data/data/ga.androidterm/annex (ext filesystem) + +* share with my devices using jabber.me account + +* ssh remote is automatically added via XMPP + +3) add file to annex on linux, which gets uploaded to the ssh remote + +4) symlink for file is created on phone and data downloaded, but never decrypted (see logs below) + +### What version of git-annex are you using? On what operating system? +Ubunut Linux 12.04 with git-annex version: + +* 5.20140127.1 (from PPA) + +Android 4.2 (rooted) with git-annex version: + +* 5.20140211-g556cfeb (from autobuilds) + +### Please provide any additional information below. +full logs: + +* linux: + +* android: + +most interesting parts: +[[!format sh """ +# +# android: +# +gpg: can't open `/usr/local/share/gnupg/options.skel': No such file or directory +gpg: DBG: locking for `/sdcard/git-annex.home/.gnupg/secring.gpg.lock' done via O_EXCL +gpg: DBG: locking for `/sdcard/git-annex.home/.gnupg/pubring.gpg.lock' done via O_EXCL +gpg: decryption failed: bad key + +# followed by just the last line for all further attemps +gpg: decryption failed: bad key + +# gpg it self seems to be fine +root@android:/data/data/ga.androidterm # ./bin/gpg --version -v +gpg (GnuPG) 1.4.15 +Copyright (C) 2013 Free Software Foundation, Inc. +License GPLv3+: GNU GPL version 3 or later +This is free software: you are free to change and redistribute it. +There is NO WARRANTY, to the extent permitted by law. + +Home: ~/.gnupg +Supported algorithms: +Pubkey: RSA, RSA-E, RSA-S, ELG-E, DSA +Cipher: IDEA, 3DES, CAST5, BLOWFISH, AES, AES192, AES256, TWOFISH, + CAMELLIA128, CAMELLIA192, CAMELLIA256 +Hash: MD5, SHA1, RIPEMD160, SHA256, SHA384, SHA512, SHA224 +Compression: Uncompressed, ZIP, ZLIB +"""]] diff --git a/doc/bugs/problems_with_android_and_gpg/comment_1_526d8805cb1ae896e8b1920ac2aecc17._comment b/doc/bugs/problems_with_android_and_gpg/comment_1_526d8805cb1ae896e8b1920ac2aecc17._comment new file mode 100644 index 0000000000..308d7ed8d7 --- /dev/null +++ b/doc/bugs/problems_with_android_and_gpg/comment_1_526d8805cb1ae896e8b1920ac2aecc17._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://openid.stackexchange.com/user/3f8a1927-744c-4409-8425-48fb3c86672f" + nickname="kim" + subject="comment 1" + date="2014-02-14T19:16:02Z" + content=""" +I am experiencing the exaxact same issue on android 4.3 with the current git-annex version (5.20140211) +"""]] diff --git a/doc/bugs/problems_with_android_and_xmpp.mdwn b/doc/bugs/problems_with_android_and_xmpp.mdwn new file mode 100644 index 0000000000..0b05c94bb2 --- /dev/null +++ b/doc/bugs/problems_with_android_and_xmpp.mdwn @@ -0,0 +1,82 @@ +### Please describe the problem. +When trying to sync my android phone with my linux laptop using the git annex assistant and XMPP no files are transferred. + +### What steps will reproduce the problem? +1) setup git annex via webapp on laptop: + +* local annex + +* remote annex via ssh with shared encryption (tried two different servers, one with and one without git-annex installed) + +* share with my devices using jabber.me account + +2) setup git annex via webapp on android: + +* local annex in /sdcard/annex (fuse filesystem without symlink support) + +* share with my devices using jabber.me account + +* ssh remote is automatically added via XMPP + +3) add files to annex on linux, they get uploaded to the ssh remote + +4) wait forever for any files from linux to download to phone + +5) add files to annex on phone, they get uploaded to the ssh remote + +4) wait forever for any files from phone to download to linux + +### What version of git-annex are you using? On what operating system? +Ubunut Linux 12.04 with git-annex version: + +* 5.20140127.1 (from PPA) + +Android 4.2 (rooted) tried with git-annex versions: + +* 5.20140209 (from http://downloads.kitenet.net/git-annex/android/current/4.0/) + +* 5.20140211-g556cfeb (from autobuilds) + +### Please provide any additional information below. +full logs: + +(these do not show the uploads to the ssh remote, because I restarted to get clean and short logs, but the files are on the server and can be dropped and restored on the linux side manually) + +* linux: + +* android: + +most interesting parts: +[[!format sh """ +# +# linux: +# + +[2014-02-13 13:11:27 CET] XMPPClient: Pairing with dorian in progress +[2014-02-13 13:11:28 CET] XMPPSendPack: Syncing with dorian +To xmpp::dorian@jabber.me + * [new branch] git-annex -> refs/synced/4ce7576f-6f02-4657-bab5-2f4c4a564ee7/ZG9yaWFuQGphYmJlci5tZQ==/git-annex + * [new branch] annex/direct/master -> refs/synced/4ce7576f-6f02-4657-bab5-2f4c4a564ee7/ZG9yaWFuQGphYmJlci5tZQ==/annex/direct/master +[2014-02-13 13:11:29 CET] XMPPSendPack: Syncing with dorian +Everything up-to-date +[2014-02-13 13:12:21 CET] XMPPSendPack: Syncing with dorian +Everything up-to-date +[2014-02-13 13:12:21 CET] XMPPSendPack: Syncing with dorian +fatal: Could not read from remote repository. + +Please make sure you have the correct access rights +and the repository exists. + +# +# android: +# +[2014-02-13 13:16:25 CET] XMPPClient: sending: Pushing "d29" (ReceivePackOutput 2 "") +[2014-02-13 13:16:25 CET] XMPPClient: to client: d6/tigase-14134 +[2014-02-13 13:18:22 CET] XMPPClient: received: ["Unknown message"] +[2014-02-13 13:18:25 CET] XMPPReceivePack: timeout waiting for git send-pack output via XMPP +fatal: The remote end hung up unexpectedly +[2014-02-13 13:18:25 CET] XMPPReceivePack: finished running push Pushing "d29" (StartingPush (UUID "4ce7576f-6f02-4657-bab5-2f4c4a564ee7")) True +[2014-02-13 13:18:25 CET] XMPPClient: sending: Pushing "d29" (ReceivePackDone (ExitFailure 128)) +[2014-02-13 13:18:25 CET] XMPPClient: to client: d6/tigase-14134 + +"""]] diff --git a/doc/bugs/problems_with_android_and_xmpp/comment_1_dd56eb74660a606c7db54861ec745cc6._comment b/doc/bugs/problems_with_android_and_xmpp/comment_1_dd56eb74660a606c7db54861ec745cc6._comment new file mode 100644 index 0000000000..945a590217 --- /dev/null +++ b/doc/bugs/problems_with_android_and_xmpp/comment_1_dd56eb74660a606c7db54861ec745cc6._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawm78jq1Uo-ZbyOPG3diJUWVvEiM0kyAcvk" + nickname="Dorian" + subject="further information" + date="2014-02-13T13:33:49Z" + content=""" +I just tried moving the annex on the android phone to a different location, because I wasn't sure how git annex handles the /sdcard's fuse file system without symlinks... +So with the annex on the /data mount using ext I got a little further (and discovered a different problem ). + + +"""]] diff --git a/doc/bugs/rsync_transport:_username_not_respected.mdwn b/doc/bugs/rsync_transport:_username_not_respected.mdwn new file mode 100644 index 0000000000..467e676438 --- /dev/null +++ b/doc/bugs/rsync_transport:_username_not_respected.mdwn @@ -0,0 +1,43 @@ +### Please describe the problem. + +I created an encrypted rsync remote with a username (user@host). The rsync command issued by git-annex doesn't contain the username. I solved the problem using .ssh/config. + +### What steps will reproduce the problem? + + +[[!format sh """ +# Add remote like that +git-annex initremote encrsync type=rsync rsyncurl=user@xxx.rsync.net:rsync/X keyid=0xXXX +# Sync it +git-annex sync --content + + +# You'll see +$> ps ax | grep rsync +30652 pts/3 S+ 0:00 /home/ganwell/bin/git-annex.linux//lib64/ld-linux-x86-64.so.2 --library-path /home/ganwell/bin/git-annex.linux//etc/ld.so.conf.d:/home/ganwell/bin/git-annex.linux//usr/lib/x86_64-linux-gnu/gconv:/home/ganwell/bin/git-annex.linux//usr/lib/x86_64-linux-gnu/libc:/home/ganwell/bin/git-annex.linux//usr/lib:/home/ganwell/bin/git-annex.linux//usr/lib/x86_64-linux-gnu:/home/ganwell/bin/git-annex.linux//lib64:/home/ganwell/bin/git-annex.linux//lib/x86_64-linux-gnu: /home/ganwell/bin/git-annex.linux/shimmed/rsync/rsync xxx.rsync.net:rsync/X/9fa/634/'GPGHMACSHA1--X/GPGHMACSHA1--X +"""]] + + + +### What version of git-annex are you using? On what operating system? + +OS: Linux + +Ver: git-annex version: 5.20140210-g1e0a3ad + +Type: prebuilt + +### 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. +"""]] + +> Argh! How did that break? I know it used to work. +> I have fixed it, unfortunately the fix was too late for today's release, +> but it will be available in autobuilds shortly. +> [[fixed|done]] --[[Joey]] diff --git a/doc/bugs/trust_command_and_gitconfig_contradiction_causing_confusion.mdwn b/doc/bugs/trust_command_and_gitconfig_contradiction_causing_confusion.mdwn new file mode 100644 index 0000000000..d67ebe66ae --- /dev/null +++ b/doc/bugs/trust_command_and_gitconfig_contradiction_causing_confusion.mdwn @@ -0,0 +1,35 @@ +### Please describe the problem. +'trust', 'dead', etc commands completing with 'ok' but fail to acknowledge contradiction in .git/config, causing confusion. + +[[!format sh """ +greg@x200s:~/Photos$ git-annex untrust home # yes, bad remote name +untrust home ok +(Recording state in git...) +greg@x200s:~/Photos$ git-annex status # /me is old-school and forgets +greg@x200s:~/Photos$ git-annex info +repository mode: indirect +trusted repositories: 2 + c0e4106e-2631-11e2-9749-1bfa37a61069 -- rose + c69d6fcc-18d1-11e2-9487-2fe6dbf0516b -- home (photos on eeepc) + +.... + +greg@x200s:~/Photos$ git-annex dead home +dead home ok +(Recording state in git...) +greg@x200s:~/Photos$ git-annex info +repository mode: indirect +trusted repositories: 2 + c0e4106e-2631-11e2-9749-1bfa37a61069 -- rose + c69d6fcc-18d1-11e2-9487-2fe6dbf0516b -- home (photos on eeepc) +"""]] + +The home remote has "annex-trustlevel=trusted" in .git/config + + +Maybe have those commands instead say "Hey, this is different than what you said explicitly in .git/config, ya sure? (y/n)" If y, overwrite config, if n, abort. + +### What version of git-annex are you using? On what operating system? +5.20140127 on Debian + +> [[Fixed|done]], it will now warn about this situation. --[[Joey]] diff --git a/doc/design.mdwn b/doc/design.mdwn index 9a03e7554e..e4f0e5c2a9 100644 --- a/doc/design.mdwn +++ b/doc/design.mdwn @@ -1,8 +1,6 @@ git-annex's high-level design is mostly inherent in the data that it stores in git, and alongside git. See [[internals]] for details. -See [[encryption]] for design of encryption elements. +Here's the other design documents we have: -See [[roadmap]] for planning and scheduling of new stuff. - -See [[assistant]] for the design site for the git-annex [[/assistant]]. +[[!map pages="page(design/*) and !design/*/*"]] diff --git a/doc/design/assistant/telehash.mdwn b/doc/design/assistant/telehash.mdwn index ad692a4d12..b9755736f3 100644 --- a/doc/design/assistant/telehash.mdwn +++ b/doc/design/assistant/telehash.mdwn @@ -9,6 +9,8 @@ git-annex (assistant) repositories. telehash v1 (even that seems incomplete). I have pinged its author to see if he anticipates updating it. * Rapid development, situation may change in a month or 2. +* Is it secure? A security review should be done by competant people + (not Joey). See ## implementation basics diff --git a/doc/design/external_special_remote_protocol.mdwn b/doc/design/external_special_remote_protocol.mdwn index ef09148db9..6fe09ff7cc 100644 --- a/doc/design/external_special_remote_protocol.mdwn +++ b/doc/design/external_special_remote_protocol.mdwn @@ -188,7 +188,7 @@ in control. This is always the same for any given Key, so can be used for eg, creating hash directory structures to store Keys in. (git-annex replies with VALUE followed by the value.) -* `SETCONFIG Setting` +* `SETCONFIG Setting Value` Sets one of the special remote's configuration settings. Normally this is sent during INITREMOTE, which allows these settings to be stored in the git-annex branch, so will be available if the same diff --git a/doc/design/external_special_remote_protocol/comment_13_472748f03ba8dad773da7f35b70cb6e4._comment b/doc/design/external_special_remote_protocol/comment_13_472748f03ba8dad773da7f35b70cb6e4._comment new file mode 100644 index 0000000000..f222349c13 --- /dev/null +++ b/doc/design/external_special_remote_protocol/comment_13_472748f03ba8dad773da7f35b70cb6e4._comment @@ -0,0 +1,15 @@ +[[!comment format=mdwn + username="http://schnouki.net/" + nickname="Schnouki" + subject="comment 13" + date="2014-02-10T18:22:55Z" + content=""" +First things first: in the documentation, I think `SETCONFIG Setting` should be `SETCONFIG Setting Value`. + +Now a few questions: + +- why have `SETCREDS` and `GETCREDS` have both a username and a password? I'd like to use them to store a OAuth token, but because of this I also have to store a dummy value, which seems weird to me. Is it possible to just do `SETCREDS oauth_token XXXYYY123456`? +- about `PROGRESS`: my remote is sending `PROGRESS xxx` every 64kb uploaded or downloaded, but no upload/download progress is displayed by git-annex. Is this normal? Should I do it myself, or will it be done by a future version of git-annex? + +Joey, thanks a lot for all your work on git-annex :) +"""]] diff --git a/doc/design/external_special_remote_protocol/comment_14_71c3e21a72222250bab933e1c9167fbc._comment b/doc/design/external_special_remote_protocol/comment_14_71c3e21a72222250bab933e1c9167fbc._comment new file mode 100644 index 0000000000..095f225373 --- /dev/null +++ b/doc/design/external_special_remote_protocol/comment_14_71c3e21a72222250bab933e1c9167fbc._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.172" + subject="comment 14" + date="2014-02-11T01:36:51Z" + content=""" +Schnouki, fixed SETCONFIG docs. Note that this is a wiki. :) + +I agree it's a little weird for SETCREDS to have a username and a password. This is just exposing git-annex's existing credential storage which has a tuple of values rather than using, say, a multivalue map. If you only need one it's fine to put in a dummy value for the other one. + +Re PROGRESS, it seems I hooked up the progress stuff, so it was visible in the webapp, but forgot to put up a progress display at the command line. Fixed in git. + +I look forward to seeing your special remote implementation! +"""]] diff --git a/doc/design/external_special_remote_protocol/comment_15_c77386deddc64b2028d9c3a7393d4df7._comment b/doc/design/external_special_remote_protocol/comment_15_c77386deddc64b2028d9c3a7393d4df7._comment new file mode 100644 index 0000000000..d8ecdc3983 --- /dev/null +++ b/doc/design/external_special_remote_protocol/comment_15_c77386deddc64b2028d9c3a7393d4df7._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://schnouki.net/" + nickname="Schnouki" + subject="comment 15" + date="2014-02-11T13:44:10Z" + content=""" +Joey, thanks for fixing that so quickly. Indeed it works in the webapp; I'll check the CLI version as soon as possible :) + +I just released the new remote on . It's for [hubiC](https://hubic.com/), a French personal cloud storage service made by OVH that has free 25GB accounts and only charges €10/month for 10TB (VAT included). It's really experimental (hacked it over the weekend), but it seems to work for me so far. +"""]] diff --git a/doc/design/metadata.mdwn b/doc/design/metadata.mdwn new file mode 100644 index 0000000000..db0d51c5ce --- /dev/null +++ b/doc/design/metadata.mdwn @@ -0,0 +1,209 @@ +[[!toc]] + +# metadata + +Attach an arbitrary set of metadata to a key. This consists of any number +of fields. Each field has an unordered set of values. The special field +"tag" has as its values any tags that are set for the key. + +Store in git-annex branch, next to location log files. + +Storage needs to support union merging, including removing an old value +of a field, and adding a new value of a field. + +# filtered branches + +See [[tips/metadata_driven_views]] + +The reason to use specially named filtered branches is because it makes +self-documenting how the repository is currently filtered. + +TODO: Files not matching the view should be able to be included. +For example, it could make a "unsorted" directory containing files +without a tag when viewing by tag. If also viewing by author, the unsorted +directories nest. + +## operations while on filtered branch + +* If files are removed and git commit called, git-annex should remove the + relevant metadata from the files. + TODO: It's not clear that + removing a file should nuke all the metadata used to filter it into the + branch (especially if it's derived metadata like the year). + Currently, only metadata used for visible subdirs is added and removed + this way. + Also, this is not usable in direct mode because deleting the + file.. actually deletes it. +* If a file is moved into a new subdirectory while in a view branch, + a tag is added with the subdir name. This allows on the fly tagging. + **done** +* `git annex sync` should avoid pushing out the view branch, but + it should check if there are changes to the metadata pulled in, and update + the branch to reflect them. +* TODO: If `git annex add` adds a file, it gets all the metadata of the filter + branch it's added to. If it's in a relevent directory (like fosdem-2014), + it gets that metadata automatically recorded as well. + +## automatically added metadata + +TODO git annex add should automatically attach the current mtime of a file +when adding it. + +Could also automatically attach permissions. + +TODO A git hook could be run by git annex add to gather more metadata. +For example, by examining MP3 metadata. + +Also auto add metadata when adding files to view branches. See below. + +## derived metadata + +This is probably not stored anywhere. It's computed on demand by a pure +function from the other metadata. +(Should be a general mechanism for this. (It probably generalizes to +sql queries if we want to go that far.)) + +### data metadata + +TODO From the ctime, some additional +metadata is derived, at least year=yyyy and probably also month, etc. + +### directory hierarchy metadata + +TODO From the original filename used in the master branch, when +constructing a view, generate fields. For example foo/bar/baz.mp3 +would get /=foo, foo/=bar, foo/bar/=baz, and .=mp3. + +Note that dir/=subdir allows a view to use `dir/=*` and only +match one level of subdirs with the glob. So is better than dir=foo/bar +as the metadata. (Alternatively, could do special glob matching.) + +This allows using whatever directory hierarchy exists to inform the view, +without locking the view into using it. + +Complication: When refining a view, it only looks at the filenames in +the view, so it would need to map from +those filenames to derive the same metadata, unless there is persistent +storage. Luckily, the filenames used in the views currently include the +subdirs (although not quite in a parseable format, would need some small +changes). + +# other uses for metadata + +Uses are not limited to view branches. + +`git annex checkoutmeta year=2014 talk` in a subdir of master could create the +same tree of files filter would. The user can then commit that if desired. +Or, they could run additional commands like `git annex fadd` to refine the +tree of files in the subdir. + +Metadata can be used for configuring numcopies. One way would be a +numcopies=n value attached to a file. But perhaps better would be to make +the numcopies.log allow configuring numcopies based on which files have +other metadata. + +Other programs could query git-annex for the metadata of files in the work +tree, and do whatever it wants with it. + +# filenames + +The hard part of this is actually getting a useful filename to put in the +view branch, since git-annex only has a key which the user will not +want to see. + +* Could use filename metadata for the key, recorded by git-annex add (which + may not correspond to filenames being used in regular git branches like + master for the key). +* Could use the .map files to get a filename, but this is somewhat + arbitrary (.map can contain multiple filenames), and is only + currently supported in direct mode. +* Current approach: Have a reference branch (eg master) and walk it to + find filenames and + keys. Fine as long as it can be done efficiently. Also allows including + the subdirectory a file is in, potentially. cwebber points out that this + is essentially a form of tracking branch. Which implies it will need to + be updatable when the reference branch changes. Should be doable via + diff-tree. + +Note that we have to take care to avoid generating conflicting filenames. +The current approach is to embed the full directory structure inside the +filename in the view branch. + +## union merge properties + +While the storage could just list all the current values of a field on a +line with a timestamp, that's not good enough. Two disconnected +repositories can make changes to the values of a field (setting and +unsetting tags for example) and when this is union merged back together, +the changes need to be able to be replayed in order to determine which +values we end up with. + +To make that work, we log not only when a field is set to a value, +but when a value is unset as well. + +For example, here two different remotes added tags, and then later +a tag was removed: + + 1287290776.765152s tag +foo +bar + 1287290991.152124s tag +baz + 1291237510.141453s tag -bar + +# efficient metadata lookup + +Looking up metadata for view generation so far requires traversing all keys +in the git-annex branch. This is slow. A fast cache is needed. + +TODO + +# direct mode issues + +TODO (direct mode is currently not supported with view branches) + +Checking out a view branch can result in any number of copies of a file +appearing in different directories. No problem in indirect mode, but +in direct mode these are real, expensive copies. + +But, it's worth supporting direct mode! + +So, possible approaches: + +* Before checking out a view branch, calculate how much space will + be used by duplicates and refuse if not enough is free. +* Only check out one file, and omit the copies. Keep track of which + files were omitted, and make sure that when committing on the branch, + that metadata is not removed. Has the downside that files can seem + to randomly move around in the tree as their metadata changes. +* Disallow view branch checkouts that have duplicate files. + This would cripple it some, but perhaps not too badly? + +# gotchas + +* Checking out a view branch can remove the current subdir. May be worth + detecting when this happens and help the user. + **done** + +* Git has a complex set of rules for what is legal in a ref name. + View branch names will need to filter out any illegal stuff. **done** + +* Filesystems that are not case sensative (including case preserving OSX) + will cause problems if view branches try to use different cases for + 2 directories representing the value of some metadata. But, users + probably want at least case-preserving metadata values. + + Solution might be to compare metadata case-insensitively, and + pick one representation consistently, so if, for example an author + field uses mixed case, it will be used in the view branch. + + Alternatively, it could escape `A` to `_A` when such a filesystem + is detected and avoid collisions that way (double `_` to escape it). + This latter option is ugly, but so are non-posix filesystems.. and it + also solves any similar issues with case-colliding filenames. + + TODO: Check current state of this. + +* Assistant needs to know about views, so it can update metadata when + files are moved around inside them. TODO + +* What happens if git annex add or the assistant add a new file while on a + view? If the file is not also added to the master branch, it will be lost + when exiting the view. TODO diff --git a/doc/design/roadmap.mdwn b/doc/design/roadmap.mdwn index 8571188006..e6ad21fee8 100644 --- a/doc/design/roadmap.mdwn +++ b/doc/design/roadmap.mdwn @@ -9,10 +9,10 @@ Now in the * Month 3 user-driven features and polishing [[todo/direct_mode_guard]] [[assistant/upgrading]] * Month 4 [[Windows_webapp|assistant/Windows]], Linux arm, [[todo/support_for_writing_external_special_remotes]] * Month 5 user-driven features and polishing -* **Month 6 get [[assistant/Android]] and Windows out of beta** +* **Month 6 get Windows out of beta, [[metadata and views|design/metadata]]** * Month 7 user-driven features and polishing * Month 8 [[!traillink assistant/telehash]] * Month 9 [[!traillink assistant/gpgkeys]] [[!traillink assistant/sshpassword]] -* Month 10 user-driven features and polishing +* Month 10 get [[assistant/Android]] out of beta * Month 11 [[!traillink assistant/chunks]] [[!traillink assistant/deltas]] * Month 12 user-driven features and polishing diff --git a/doc/devblog/day_-4__forgetting/comment_2_e47476c80af02a2e9cf76c53fdbb8534._comment b/doc/devblog/day_-4__forgetting/comment_2_e47476c80af02a2e9cf76c53fdbb8534._comment new file mode 100644 index 0000000000..db2438f97e --- /dev/null +++ b/doc/devblog/day_-4__forgetting/comment_2_e47476c80af02a2e9cf76c53fdbb8534._comment @@ -0,0 +1,9 @@ +[[!comment format=mdwn + username="stp" + ip="188.193.207.34" + subject="Update one forgetting keys no longer present" + date="2014-02-17T23:21:49Z" + content=""" +I have some repos where due to some hiccups file versions (not in the working tree anymore) were lost and now they come up again and again when fsck is running. +So I would be happy if I could make my repos forget these not available files via \"git annex forget $key\" and perhaps even have a better solution to show all objects with numcopies=0. +"""]] diff --git a/doc/devblog/day_-4__forgetting/comment_3_b57956a8ce372d620f21ea9a497e8013._comment b/doc/devblog/day_-4__forgetting/comment_3_b57956a8ce372d620f21ea9a497e8013._comment new file mode 100644 index 0000000000..5c0bbc42b4 --- /dev/null +++ b/doc/devblog/day_-4__forgetting/comment_3_b57956a8ce372d620f21ea9a497e8013._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.172" + subject="comment 3" + date="2014-02-20T18:54:48Z" + content=""" +@stp, It seems to me if you just delete the symlinks in your git repository that point to the lost files, `git annex fsck` will shut up. +"""]] diff --git a/doc/devblog/day_-4__forgetting/comment_4_812b630df01ac35254e3c4e677554e2b._comment b/doc/devblog/day_-4__forgetting/comment_4_812b630df01ac35254e3c4e677554e2b._comment new file mode 100644 index 0000000000..187545fbc5 --- /dev/null +++ b/doc/devblog/day_-4__forgetting/comment_4_812b630df01ac35254e3c4e677554e2b._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="stp" + ip="84.56.21.11" + subject="comment 4" + date="2014-02-20T21:07:41Z" + content=""" +Yeah true if I remove symlinks from the history (as I understand your suggestion) it would work. I just wanted to suggest that it could be something useful for the git annex forget function as it already cleans out old dead repos and other things. +"""]] diff --git a/doc/devblog/day_-4__forgetting/comment_5_a9670eca2aff9ad5f04412a8d8b6df6a._comment b/doc/devblog/day_-4__forgetting/comment_5_a9670eca2aff9ad5f04412a8d8b6df6a._comment new file mode 100644 index 0000000000..d830225262 --- /dev/null +++ b/doc/devblog/day_-4__forgetting/comment_5_a9670eca2aff9ad5f04412a8d8b6df6a._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.172" + subject="comment 5" + date="2014-02-20T21:14:21Z" + content=""" +You don't need to delete them from the history, just from the branch you're running `git annex fsck` in. +"""]] diff --git a/doc/devblog/day_-4__forgetting/comment_6_4f87e2ab119f3cd81266159f02952188._comment b/doc/devblog/day_-4__forgetting/comment_6_4f87e2ab119f3cd81266159f02952188._comment new file mode 100644 index 0000000000..4ecbb1ae65 --- /dev/null +++ b/doc/devblog/day_-4__forgetting/comment_6_4f87e2ab119f3cd81266159f02952188._comment @@ -0,0 +1,9 @@ +[[!comment format=mdwn + username="stp" + ip="84.56.21.11" + subject="comment 6" + date="2014-02-20T22:19:12Z" + content=""" +As discussed on irc. +Fsck --all does check more then the working tree and therefore for fsck to not complain this would be a worthy feature to be added. (git annex forget $key) +"""]] diff --git a/doc/devblog/day_110__release_prep.mdwn b/doc/devblog/day_110__release_prep.mdwn new file mode 100644 index 0000000000..12ba78a4fd --- /dev/null +++ b/doc/devblog/day_110__release_prep.mdwn @@ -0,0 +1,25 @@ +Last night I tracked down and fixed a bug in the DAV library that has been +affecting WebDAV remotes. I've been deploying the fix for that today, +including to the android and arm autobuilders. While I finished a clean +reinstall of the android autobuilder, I ran into problems getting a clean +reinstall of the arm autobuilder (some type mismatch error building +yesod-core), so manually fixed its DAV for now. + +The WebDAV fix and other recent fixes makes me want to make a release soon, +probably Monday. + +ObWindows: Fixed git-annex to not crash when run on Windows +in a git repository that has a remote with a unix-style path +like "/foo/bar". Seems that not everything aggrees on whether such a path +is absolute; even sometimes different parts of the same library disagree! + +[[!format haskell """ +import System.FilePath.Windows + +prop_windows_is_sane :: Bool +prop_windows_is_sane = isAbsolute upath || ("C:\\STUFF" upath /= upath) + where upath = "/foo/bar" +"""]] + +Perhaps more interestingly, I've been helping dxtrish port git-annex to +OpenBSD and it seems most of the way there. diff --git a/doc/devblog/day_111__windows_beta_release.mdwn b/doc/devblog/day_111__windows_beta_release.mdwn new file mode 100644 index 0000000000..cd880dc0c5 --- /dev/null +++ b/doc/devblog/day_111__windows_beta_release.mdwn @@ -0,0 +1,6 @@ +Pushed out the new release. This is the first one where I consider the +git-annex command line beta quality on Windows. + +Did some testing of the webapp on Windows, trying out every part of the UI. +I now have eleven todo items involving the webapp listed in +[[todo/windows_support]]. Most of them don't look too bad to fix. diff --git a/doc/devblog/day_112__metadata_design.mdwn b/doc/devblog/day_112__metadata_design.mdwn new file mode 100644 index 0000000000..e75d4fc4ed --- /dev/null +++ b/doc/devblog/day_112__metadata_design.mdwn @@ -0,0 +1,18 @@ +There's a new design document for letting git-annex store arbitrary +metadata. The really neat thing about this is the user can check out only +files matching the tags or values they care about, and get an automatically +structuted file tree layout that can be dynamically filtered. It's going to +be awesome! [[design/metadata]] + +In the meantime, spent most of today working on Windows. Very good +progress, possibly motivated by wanting to get it over with so I can spend +some time this month on the above. ;) + +* webapp can make box.com and S3 remotes. This just involved fixing a hack + where the webapp set environment variables to communicate creds to + initremote. Can't change environment on Windows (or I don't know how to). +* webapp can make repos on removable drives. +* `git annex assistant --stop` works, although this is not likely to really + be useful +* The source tree now has 0 `func = error "Windows TODO"` type stubbed out + functions to trip over. diff --git a/doc/devblog/day_113__metadata_groundwork.mdwn b/doc/devblog/day_113__metadata_groundwork.mdwn new file mode 100644 index 0000000000..4859c4d33e --- /dev/null +++ b/doc/devblog/day_113__metadata_groundwork.mdwn @@ -0,0 +1,9 @@ +Built the core data types, and log for metadata storage. Making metadata +union merge well is tricky, but I have a design I'm happy with, that will +allow distributed changes to metadata. + +Finished up the day with a `git annex metadata` command to get/set metadata +for a file. + +This is all the goundwork needed to begin experimenting with generating +git branches that display different metadata-driven views of annexed files. diff --git a/doc/devblog/day_114__windows_porting.mdwn b/doc/devblog/day_114__windows_porting.mdwn new file mode 100644 index 0000000000..2f1cace1b1 --- /dev/null +++ b/doc/devblog/day_114__windows_porting.mdwn @@ -0,0 +1,8 @@ +Windows porting all day. Fixed a lot of issues with the webapp, +so quite productive. Except for the 2 hours wasted finding a way to kill a +process by PID from Haskell on Windows. + +Last night, made `git annex metadata` able to set metadata on a whole +directory or list of files if desired. And added a `--metadata field=value` +switch (and corresponding preferred content terminal) which limits +git-annex to acting on files with the specified metadata. diff --git a/doc/devblog/day_115__windows_porting.mdwn b/doc/devblog/day_115__windows_porting.mdwn new file mode 100644 index 0000000000..a9abe4ad2f --- /dev/null +++ b/doc/devblog/day_115__windows_porting.mdwn @@ -0,0 +1,17 @@ +More Windows porting.. Seem to be getting near an end of the easy stuff, +and also the webapp is getting pretty usable on Windows now, the only +really important thing lacking is XMPP support. + +Made git-annex on Windows set HOME when it's not already set. Several of +the bundled cygwin tools only look at HOME. This was made a lot harder and +uglier due to there not being any way to modify the environment of the +running process.. git-annex has to re-run itself with the fixed +environment. + +Got rsync.net working in the webapp. Although with an extra rsync.net +password prompt on Windows, which I cannot find a way to avoid. + +While testing that, I discovered that openssh 6.5p1 has broken support for +~/.ssh/config Host lines that contain upper case letters! I have filed a +bug about this and put a quick fix in git-annex, which sometimes generated +such lines. diff --git a/doc/devblog/day_116__views.mdwn b/doc/devblog/day_116__views.mdwn new file mode 100644 index 0000000000..a7aaf2c939 --- /dev/null +++ b/doc/devblog/day_116__views.mdwn @@ -0,0 +1,54 @@ +Working on building [[design/metadata]] filtered branches. + +Spent most of the day on types and pure code. Finally at the end +I wrote down two actions that I still need to implement to make +it all work: + +[[!format haskell """ +applyView' :: MkFileView -> View -> Annex Git.Branch +updateView :: View -> Git.Ref -> Git.Ref -> Annex Git.Branch +"""]] + +I know how to implement these, more or less. And in most cases +they will be pretty fast. + +The more interesting part is already done. That was the issue of how to +generate filenames in the filter branches. That depends on the `View` being +used to filter and organize the branch, but also on the original filename used +in the reference branch. Each filter branch has a reference branch (such as +"master"), and displays a filtered and metadata-driven reorganized tree +of files from its reference branch. + +[[!format haskell """ +fileViews :: View -> (FilePath -> FileView) -> FilePath -> MetaData -> Maybe [FileView] +"""]] + +So, a view that matches files tagged "haskell" or "git-annex" +and with an author of "J\*" will generate filenames like +"haskell/Joachim/interesting_theoretical_talk.ogg" and +"git-annex/Joey/mytalk.ogg". + +It can also work backwards from these +filenames to derive the MetaData that is encoded in them. + +[[!format haskell """ +fromView :: View -> FileView -> MetaData +"""]] + +So, copying a file to "haskell/Joey/mytalk.ogg" lets it know that +it's gained a "haskell" tag. I knew I was on the right track when +`fromView` turned out to be only 6 lines of code! + +The trickiest part of all this, which I spent most of yesterday thinking +about, is what to do if the master branch has files in subdirectories. It +probably does not makes sense to retain that hierarchical directory +structure in the filtered branch, because we instead have a +non-hierarchical metadata structure to express. (And there would probably +be a lot of deep directory structures containing only one file.) But +throwing away the subdirectory information entirely means that two files +with the same basename and same metadata would have colliding names. + +I eventually decided to embed the subdirectory information into the filenames +used on the filter branch. Currently that is done by converting +`dir/subdir/file.foo` to `file(dir)(subdir).foo`. We'll see how this works +out in practice.. diff --git a/doc/devblog/day_117__views_implemented.mdwn b/doc/devblog/day_117__views_implemented.mdwn new file mode 100644 index 0000000000..fa2ae28375 --- /dev/null +++ b/doc/devblog/day_117__views_implemented.mdwn @@ -0,0 +1,76 @@ +Today I built `git annex view`, and `git annex vadd` and a few related +commands. A quick demo: + +
+joey@darkstar:~/lib/talks>ls
+Chaos_Communication_Congress/  FOSDEM/       Linux_Conference_Australia/
+Debian/                        LibrePlanet/  README.md
+joey@darkstar:~/lib/talks>git annex view tag=*
+view  (searching...)
+Switched to branch 'views/_'
+ok
+joey@darkstar:~/lib/talks#_>tree -d
+.
+|-- Debian
+|-- android
+|-- bigpicture
+|-- debhelper
+|-- git
+|-- git-annex
+`-- seen
+
+7 directories
+joey@darkstar:~/lib/talks#_>git annex vadd author=*
+vadd  
+Switched to branch 'views/author=_;_'
+ok
+joey@darkstar:~/lib/talks#author=_;_>tree -d
+.
+|-- Benjamin Mako Hill
+|   `-- bigpicture
+|-- Denis Carikli
+|   `-- android
+|-- Joey Hess
+|   |-- Debian
+|   |-- bigpicture
+|   |-- debhelper
+|   |-- git
+|   `-- git-annex
+|-- Richard Hartmann
+|   |-- git
+|   `-- git-annex
+`-- Stefano Zacchiroli
+    `-- Debian
+
+15 directories
+joey@darkstar:~/lib/talks#author=_;_>git annex vpop
+vpop 1
+Switched to branch 'views/_'
+ok
+joey@darkstar:~/lib/talks#_>git annex vadd tag=git-annex
+vadd  
+Switched to branch 'views/(git-annex)'
+ok
+joey@darkstar:~/lib/talks#(git-annex)>ls
+1025_gitify_your_life_{Debian;2013;DebConf13;high}.ogv@
+git_annex___manage_files_with_git__without_checking_their_contents_into_git_{FOSDEM;2012;lightningtalks}.webm@
+mirror.linux.org.au_linux.conf.au_2013_mp4_gitannex_{Linux_Conference_Australia;2013}.mp4@
+joey@darkstar:~/lib/talks#_>git annex vpop 2
+vpop 2
+Switched to branch 'master'
+ok
+
+ +Not 100% happy with the speed -- the generation of the view branch is close +to optimal, and fast enough (unless the branch has very many matching +files). And `vadd` can be quite fast if the view has already limited the +total number of files to a smallish amount. But `view` has to look at every +file's metadata, and this can take a while in a large repository. Needs indexes. + +It also needs integration with `git annex sync`, so the view branches +update when files are added to the master branch, and moving files around +inside a view and committing them does not yet update their metadata. + +--- + +Today's work was sponsored by Daniel Atlas. diff --git a/doc/devblog/day_118__views_refined.mdwn b/doc/devblog/day_118__views_refined.mdwn new file mode 100644 index 0000000000..bfd102f18f --- /dev/null +++ b/doc/devblog/day_118__views_refined.mdwn @@ -0,0 +1,7 @@ +Still working on views. The most important addition today is that +`git annex precommit` notices when files have been moved/copied/deleted +in a view, and updates the metadata to reflect the changes. + +Also wrote some walkthrough documentation: [[tips/metadata_driven_views]]. +And, recorded a screencast demoing views, which I will upload next time +I have bandwidth. diff --git a/doc/devblog/day_119__catching_up.mdwn b/doc/devblog/day_119__catching_up.mdwn new file mode 100644 index 0000000000..c49c3e34dd --- /dev/null +++ b/doc/devblog/day_119__catching_up.mdwn @@ -0,0 +1,15 @@ +Spent the day catching up on the last week or so's traffic. Ended up +making numerous small big fixes and improvements. Message backlog stands at +44. + +Here's the [[screencast demoing views|videos/git-annex_views_demo]]! + +Added to the design today the idea of +automatically deriving metadata from the location of files in the master +branch's directory tree. Eg, `git annex view tag=* podcasts/=*` in a +repository that has a `podcasts/` directory would make a tree like +"$tag/$podcast". Seems promising. + +So much still to do with views.. I have belatedly added them to +the roadmap for this month; doing Windows and Android in the same month was +too much to expect. diff --git a/doc/devblog/day_119__catching_up/comment_1_8aa413e75cab411b0aec254f0f33ebb9._comment b/doc/devblog/day_119__catching_up/comment_1_8aa413e75cab411b0aec254f0f33ebb9._comment new file mode 100644 index 0000000000..9c1ba1e43e --- /dev/null +++ b/doc/devblog/day_119__catching_up/comment_1_8aa413e75cab411b0aec254f0f33ebb9._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawlJEI45rGczFAnuM7gRSj4C6s9AS9yPZDc" + nickname="Kevin" + subject="Neat!" + date="2014-02-20T21:59:05Z" + content=""" +When the [[metadata design|day_112__metadata_design]] stuff appeared on the blog I didn't understand what you meant by automatically creating new tree layouts. I'm really liking these views and can already imagine how useful it would be to tag my photos by person/place/time. This is awesome! Keep up the good work. +"""]] diff --git a/doc/devblog/day_119__catching_up/comment_2_db31d08690730836ce6277e797fcae1d._comment b/doc/devblog/day_119__catching_up/comment_2_db31d08690730836ce6277e797fcae1d._comment new file mode 100644 index 0000000000..532b7a4d5f --- /dev/null +++ b/doc/devblog/day_119__catching_up/comment_2_db31d08690730836ce6277e797fcae1d._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawneiQ3iR9VXOPEP34u7m_L3Qr28H1nEfE0" + nickname="Ethan" + subject="LFS" + date="2014-02-21T00:03:59Z" + content=""" +You might be interested in the Logic File System at http://www.padator.org/wiki/wiki-LFS/doku.php or http://www.padator.org/papers/ which has a similar idea with views and metadata. +"""]] diff --git a/doc/devblog/day_119__catching_up/comment_3_d44da76b18f53a5f51b46e3e15090a48._comment b/doc/devblog/day_119__catching_up/comment_3_d44da76b18f53a5f51b46e3e15090a48._comment new file mode 100644 index 0000000000..9d97aff2d4 --- /dev/null +++ b/doc/devblog/day_119__catching_up/comment_3_d44da76b18f53a5f51b46e3e15090a48._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmZgZuUhZlHpd_AbbcixY0QQiutb2I7GWY" + nickname="Jimmy" + subject="comment 3" + date="2014-02-21T07:05:34Z" + content=""" +I agree with Kevin as to the potential usefulness for photos. Particularly if there's some way of automatically extracting and using tags or other EXIF metadata. +"""]] diff --git a/doc/forum/Can_not_Drop_Unused_Files_With_Spaces/comment_1_b909ed9f474601587b2adad7ad4f674d._comment b/doc/forum/Can_not_Drop_Unused_Files_With_Spaces/comment_1_b909ed9f474601587b2adad7ad4f674d._comment new file mode 100644 index 0000000000..fa41b59a7d --- /dev/null +++ b/doc/forum/Can_not_Drop_Unused_Files_With_Spaces/comment_1_b909ed9f474601587b2adad7ad4f674d._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.163" + subject="doubt this has anything to do with spaces" + date="2014-02-08T17:44:45Z" + content=""" +If you want to drop the files from the remote, you need to also pass the --from option to dropunused. Otherwise, it defaults to dropping any of the unused files that are present in the local repository. +"""]] diff --git a/doc/forum/Can_not_Drop_Unused_Files_With_Spaces/comment_2_b2735a6e03db3f77a87a0f7d87347685._comment b/doc/forum/Can_not_Drop_Unused_Files_With_Spaces/comment_2_b2735a6e03db3f77a87a0f7d87347685._comment new file mode 100644 index 0000000000..5f5694c00f --- /dev/null +++ b/doc/forum/Can_not_Drop_Unused_Files_With_Spaces/comment_2_b2735a6e03db3f77a87a0f7d87347685._comment @@ -0,0 +1,16 @@ +[[!comment format=mdwn + username="https://me.yahoo.com/a/FHnTlSBo1eCGJRwueeKeB6.RCaPbGMPr5jxx8A--#ce0d8" + nickname="Hamza" + subject="comment 2" + date="2014-02-08T18:30:47Z" + content=""" +I tried with/without --from still does not drop the files. + + git annex dropunused --from cloud 1-3 --force + dropunused 1 (from cloud...) (gpg) ok + dropunused 2 (from cloud...) ok + dropunused 3 (from cloud...) ok + (Recording state in git...) + +still running unused shows the files as unused. +"""]] diff --git a/doc/forum/Can_not_Drop_Unused_Files_With_Spaces/comment_3_dd82a0cd698b0688ff08f0462af0275f._comment b/doc/forum/Can_not_Drop_Unused_Files_With_Spaces/comment_3_dd82a0cd698b0688ff08f0462af0275f._comment new file mode 100644 index 0000000000..86e3bd2c1c --- /dev/null +++ b/doc/forum/Can_not_Drop_Unused_Files_With_Spaces/comment_3_dd82a0cd698b0688ff08f0462af0275f._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.163" + subject="comment 3" + date="2014-02-08T19:17:46Z" + content=""" +Ok, you're right and this *does* involve spaces. Some bug in the unused log parser. +"""]] diff --git a/doc/forum/Can_not_Drop_Unused_Files_With_Spaces/comment_4_bbebb1d0dc5fbc1f6a0bb75b47bd4986._comment b/doc/forum/Can_not_Drop_Unused_Files_With_Spaces/comment_4_bbebb1d0dc5fbc1f6a0bb75b47bd4986._comment new file mode 100644 index 0000000000..6459ee8d7c --- /dev/null +++ b/doc/forum/Can_not_Drop_Unused_Files_With_Spaces/comment_4_bbebb1d0dc5fbc1f6a0bb75b47bd4986._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.163" + subject="comment 4" + date="2014-02-08T19:28:18Z" + content=""" +Fixed in git. +"""]] diff --git a/doc/forum/Can_not_Drop_Unused_Files_With_Spaces/comment_5_106c271d5174342055910bf57c0a34c5._comment b/doc/forum/Can_not_Drop_Unused_Files_With_Spaces/comment_5_106c271d5174342055910bf57c0a34c5._comment new file mode 100644 index 0000000000..4ad4d6f8b5 --- /dev/null +++ b/doc/forum/Can_not_Drop_Unused_Files_With_Spaces/comment_5_106c271d5174342055910bf57c0a34c5._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://me.yahoo.com/a/FHnTlSBo1eCGJRwueeKeB6.RCaPbGMPr5jxx8A--#ce0d8" + nickname="Hamza" + subject="comment 5" + date="2014-02-08T19:46:49Z" + content=""" +Are the files dropped on the rsync repo? Or are they gonna be dropped when fix propagates to dmg build? +"""]] diff --git a/doc/forum/Can_not_Drop_Unused_Files_With_Spaces/comment_6_3a2d3cc3e018beaf2eb44b86ce7e1a7f._comment b/doc/forum/Can_not_Drop_Unused_Files_With_Spaces/comment_6_3a2d3cc3e018beaf2eb44b86ce7e1a7f._comment new file mode 100644 index 0000000000..fbd9ed55c0 --- /dev/null +++ b/doc/forum/Can_not_Drop_Unused_Files_With_Spaces/comment_6_3a2d3cc3e018beaf2eb44b86ce7e1a7f._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.163" + subject="comment 6" + date="2014-02-08T19:49:11Z" + content=""" +You will need to upgrade git-annex to the next autobuild or an upcoming release to get the fix. +"""]] diff --git a/doc/forum/Can_not_delete_Repository.mdwn b/doc/forum/Can_not_delete_Repository.mdwn new file mode 100644 index 0000000000..549b47c3d3 --- /dev/null +++ b/doc/forum/Can_not_delete_Repository.mdwn @@ -0,0 +1,3 @@ +I have one repository that I deleted a while back. When I mark it as dead in command line it disappears from git annex info however when I run webapp it pops back webapp shows it as syncing disabled. When I try to delete it from the webapp it does not delete. I tried shutting down the daemon mark it as dead again then run git annex forget --drop-dead --force but running it makes the repo active again instead of deleting it. + +Repo in question was a S3 repo. I tried deleting it using both its name and uuid. diff --git a/doc/forum/Can_not_delete_Repository/comment_1_b1a9420974e2e50c9c86a379ad62502c._comment b/doc/forum/Can_not_delete_Repository/comment_1_b1a9420974e2e50c9c86a379ad62502c._comment new file mode 100644 index 0000000000..050127c24b --- /dev/null +++ b/doc/forum/Can_not_delete_Repository/comment_1_b1a9420974e2e50c9c86a379ad62502c._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.172" + subject="comment 1" + date="2014-02-21T17:36:03Z" + content=""" +Marking a repository as dead does not mean it is deleted. The way this is supposed to work, using the webapp is you tell it to start deleting the repository, which causes it to mark it as dead, and also, crucially, puts it into the \"unwanted\" group. This does not remove it from the list yet, but it causes all files located in the repository to be moved off it (assuming the repository can still be accessed). + +Then once the webapp detects that the repository is empty it will prompt you to continue the deletion process and truely remove it. It can take quite a while for the webapp to get around to this last step, since it's done during the expensive transfer scan, which it tries to avoid running unnecessarily. + +In any case, you can always edit .git/config and delete the remote, which should make the webapp no longer show it, as long as it's marked as dead. +"""]] diff --git a/doc/forum/Controlling_content_on_mobile_device/comment_2_dba1a1b0917332a1dee387b1183bd2cb._comment b/doc/forum/Controlling_content_on_mobile_device/comment_2_dba1a1b0917332a1dee387b1183bd2cb._comment new file mode 100644 index 0000000000..60aea0bdda --- /dev/null +++ b/doc/forum/Controlling_content_on_mobile_device/comment_2_dba1a1b0917332a1dee387b1183bd2cb._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnBJ6Dv1glxzzi4qIzGFNa6F-mfHIvv9Ck" + nickname="Jim" + subject="Metadata?" + date="2014-02-21T18:44:10Z" + content=""" +I suspect the new [metadata](http://git-annex.branchable.com/design/metadata/) support could be used to help implement this. +"""]] diff --git a/doc/forum/Problems_with_large_numbers_of_files/comment_8_0070d1fbb643380b92bd974564fb9702._comment b/doc/forum/Problems_with_large_numbers_of_files/comment_8_0070d1fbb643380b92bd974564fb9702._comment new file mode 100644 index 0000000000..8976942bf3 --- /dev/null +++ b/doc/forum/Problems_with_large_numbers_of_files/comment_8_0070d1fbb643380b92bd974564fb9702._comment @@ -0,0 +1,27 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnFjuvfPpi1kf6l54bxfFUm0Aw_Gf_IO0o" + nickname="Aaron" + subject="Too big to fsck" + date="2014-02-17T22:33:38Z" + content=""" +Hi, + +My Webapp isn't working: +$ git-annex webapp +error: refs/gcrypt/gitception+ does not point to a valid object! +error: refs/remotes/Beta/git-annex does not point to a valid object! +error: refs/remotes/Beta/master does not point to a valid object! +fatal: unable to read tree 656e7db5be172f01c0b6994d01f1a08d1273af12 + +So I tried to repair it: +$ git-annex repair +Running git fsck ... +Stack space overflow: current size 8388608 bytes. +Use `+RTS -Ksize -RTS' to increase it. + +So I tried to follow your advice here and increase the stack: +$ git-annex +RTS -K35000000 -RTS fsck +git-annex: Most RTS options are disabled. Link with -rtsopts to enable them. + +I wasn't sure what to do next, so any help would be appreciated. +"""]] diff --git a/doc/forum/alternativeto.net___34__Like__34__.mdwn b/doc/forum/alternativeto.net___34__Like__34__.mdwn new file mode 100644 index 0000000000..95e03dc21e --- /dev/null +++ b/doc/forum/alternativeto.net___34__Like__34__.mdwn @@ -0,0 +1,3 @@ +When I went to alternativeto.net I noticed that SpiderOak is a featured application. I decided to search git-annex and see how "Like"-ed it is in comparison... there were 0 "Like"-s. + +I suggest going to and "Like" git-annex. diff --git a/doc/forum/new_linux_arm_tarball_build/comment_8_6db99d998ca990494c8f2826ff1ca273._comment b/doc/forum/new_linux_arm_tarball_build/comment_8_6db99d998ca990494c8f2826ff1ca273._comment new file mode 100644 index 0000000000..9d58cb11ca --- /dev/null +++ b/doc/forum/new_linux_arm_tarball_build/comment_8_6db99d998ca990494c8f2826ff1ca273._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="https://renaud.casenave.fr/" + ip="126.10.66.235" + subject="comment 8" + date="2014-02-17T13:15:24Z" + content=""" +Hi, + +You might be happy to know git-annex works well on sailfishOS, even the webapp. +It does segfault when trying to setup a xmpp account, though. +"""]] diff --git a/doc/forum/not_finding_git-annex-shell_on_remote.mdwn b/doc/forum/not_finding_git-annex-shell_on_remote.mdwn new file mode 100644 index 0000000000..0d743bf78c --- /dev/null +++ b/doc/forum/not_finding_git-annex-shell_on_remote.mdwn @@ -0,0 +1,21 @@ +I have set up an annex on a remote machine and I am connecting via ssh. But, since it is a managed machine, I installed the git-annex binary in my own ~/bin. Well, when I try +$git annex sync + +I get: + $git annex sync +(merging origin/git-annex into git-annex...) +(Recording state in git...) +bash: git-annex-shell: command not found + + Remote origin does not have git-annex installed; setting annex-ignore +commit ok +pull origin + +merge: refs/remotes/origin/master - not something we can merge + +merge: refs/remotes/origin/synced/master - not something we can merge +failed +git-annex: sync: 1 failed + + +The git remote -v looks correct. So, how do I tell git annex on my local machine where to use $HOME/bin in PATH on the remote machine when syncing with remotes? diff --git a/doc/forum/not_finding_git-annex-shell_on_remote/comment_1_84881cad02c251a2515cec50fc22bf16._comment b/doc/forum/not_finding_git-annex-shell_on_remote/comment_1_84881cad02c251a2515cec50fc22bf16._comment new file mode 100644 index 0000000000..8441f412af --- /dev/null +++ b/doc/forum/not_finding_git-annex-shell_on_remote/comment_1_84881cad02c251a2515cec50fc22bf16._comment @@ -0,0 +1,16 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawk3HGoDpnOPob5jOjvIootmkve1-nCpRiI" + nickname="Kalle" + subject="Declare path on first line of bashrc?" + date="2014-02-15T18:36:35Z" + content=""" +If i don't misremember some systems including Debian require you to set the path on the very first line of .bashrc for it to work. Can't remember why just now. + +in other words paste the following into the very first line of `$HOME/.bashrc` + +`PATH=$PATH:$HOME/bin:$HOME/bin/git-annex.linux` + +Modify the line above if you haven't installed to `~/bin/git-annex.linux` + + +"""]] diff --git a/doc/forum/not_finding_git-annex-shell_on_remote/comment_2_f32412f8d3b84cd5cb3c4d5d6bb60f32._comment b/doc/forum/not_finding_git-annex-shell_on_remote/comment_2_f32412f8d3b84cd5cb3c4d5d6bb60f32._comment new file mode 100644 index 0000000000..7acee2035a --- /dev/null +++ b/doc/forum/not_finding_git-annex-shell_on_remote/comment_2_f32412f8d3b84cd5cb3c4d5d6bb60f32._comment @@ -0,0 +1,36 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawn3rK4VDzxyhmrIc18z7F5OuXvEbUsgUac" + nickname="Srinath" + subject="Progress, but still issues" + date="2014-02-17T04:09:23Z" + content=""" +\"I now realize that the git annex system still requires the standard \"add\" and \"commit\" process. But I'm still getting: + +$git annex sync +commit ok +pull origin +remote: Counting objects: 37, done. +remote: Compressing objects: 100% (35/35), done. +remote: Total 36 (delta 0), reused 0 (delta 0) +Unpacking objects: 100% (36/36), done. +From ssh://stampede.tacc.utexas.edu/work/02463/srinathv/cesm1_3_beta07/scripts + * [new branch] master -> origin/master + + +merge: refs/remotes/origin/synced/master - not something we can merge +failed +push origin +Counting objects: 11, done. +Delta compression using up to 4 threads. +Compressing objects: 100% (6/6), done. +Writing objects: 100% (8/8), 736 bytes | 0 bytes/s, done. +Total 8 (delta 3), reused 1 (delta 0) +To ssh://srinathv@stampede.tacc.utexas.edu/work/02463/srinathv/cesm1_3_beta07/scripts + * [new branch] git-annex -> synced/git-annex + * [new branch] master -> synced/master +ok +git-annex: sync: 1 failed + + +So the fails appear, and the suggestion of \"export PATH\" placement did not help, though appreciated. +"""]] diff --git a/doc/forum/not_finding_git-annex-shell_on_remote/comment_3_dfbf7f41dd4d17f2ce8b67daa9dcd11d._comment b/doc/forum/not_finding_git-annex-shell_on_remote/comment_3_dfbf7f41dd4d17f2ce8b67daa9dcd11d._comment new file mode 100644 index 0000000000..53419452c2 --- /dev/null +++ b/doc/forum/not_finding_git-annex-shell_on_remote/comment_3_dfbf7f41dd4d17f2ce8b67daa9dcd11d._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawn3rK4VDzxyhmrIc18z7F5OuXvEbUsgUac" + nickname="Srinath" + subject="no more issue" + date="2014-02-17T04:25:31Z" + content=""" +After doing 1 more sync, the error messages are now gone. I wonder if the refs directory needed to be synched correctly. +"""]] diff --git a/doc/forum/not_finding_git-annex-shell_on_remote/comment_4_71ae60efcacdba5e11548923b2c85b95._comment b/doc/forum/not_finding_git-annex-shell_on_remote/comment_4_71ae60efcacdba5e11548923b2c85b95._comment new file mode 100644 index 0000000000..12bf8fa75e --- /dev/null +++ b/doc/forum/not_finding_git-annex-shell_on_remote/comment_4_71ae60efcacdba5e11548923b2c85b95._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.172" + subject="comment 4" + date="2014-02-20T19:41:05Z" + content=""" +@Srinath I wonder if the machine you are running git-annex sync on is a Windows machine? I have seen that \" refs/remotes/origin/synced/master - not something we can merge\" intermittently when testing on Windows, but not other times. + +(It's not related to the original PATH configuration problem on your server.) +"""]] diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 89aef70f64..0912e0b2ac 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -503,9 +503,10 @@ subdirectories). To avoid expensive checksum calculations (and expensive transfers when fscking a remote), specify `--fast`. - To start a new incremental fsck, specify `--incremental`. Then - the next time you fsck, you can specify `--more` to skip over - files that have already been checked, and continue where it left off. + To start a new incremental fsck, use the `--incremental` option. Then + the next time you fsck, you can instead use the `--more` option + to skip over files that have already been checked, and continue + where it left off. The `--incremental-schedule` option makes a new incremental fsck be started a configurable time after the last incremental fsck was started. @@ -693,6 +694,72 @@ subdirectories). Note that this subcommand can be used to graph any git repository; it is not limited to git-annex repositories. +# METADATA COMMANDS + +* `metadata [path ...] [-s field=value -s field+=value -s field-=value ...]` + + Each file can have any number of metadata fields attached to it, + which each in turn have any number of values. This sets metadata + for the specified file or files, or if run without any values, shows + the current metadata. + + To set a field's value, removing any old value(s), use -s field=value. + + To add an additional value, use -s field+=value. + + To remove a value, use -s field-=value. + + To set a tag, use -t tag, and use -u tag to remove a tag. + + For example, to set some tags on a file and also its author: + + git annex metadata annexscreencast.ogv -t video -t screencast -s author+=Alice + +* `view [field=value ...] [tag ...]` + + Uses metadata to build a view branch of the files in the current branch, + and checks out the view branch. Only files in the current branch whose + metadata matches all the specified field values and tags will be + shown in the view. + + Multiple values for a metadata field can be specified, either by using + a glob (`field="*"`) or by listing each wanted value. The resulting view + will put files in subdirectories according to the value of their fields. + + Once within a view, you can make additional directories, and + copy or move files into them. When you commit, the metadata will + be updated to correspond to your changes. + +* `vpop [N]` + + Switches from the currently active view back to the previous view. + Or, from the first view back to original branch. + + The optional number tells how many views to pop. + +* `vfilter [field=value ...] [tag ...]` + + Filters the current view to only the files that have the + specified values and tags. + +* `vadd [field=glob ...]` + + Changes the current view, adding an additional level of directories + to categorize the files. + + For example, when the view is by author/tag, `vadd year=*` will + change it to year/author/tag. + + So will `vadd year=2014 year=2013`, but limiting the years in view + to only those two. + +* `vcycle` + + When a view involves nested subdirectories, this cycles the order. + + For example, when the view is by year/author/tag, `vcycle` will switch + it to author/tag/year. + # UTILITY COMMANDS * `migrate [path ...]` @@ -753,7 +820,8 @@ subdirectories). Fixes up symlinks that are staged as part of a commit, to ensure they point to annexed content. Also handles injecting changes to unlocked - files into the annex. + files into the annex. When in a view, updates metadata to reflect changes + made to files in the view. * `lookupkey [file ...]` @@ -792,10 +860,6 @@ subdirectories). This can be used to drop content for arbitrary keys, which do not need to have a file in the git repository pointing at them. - Example: - - git annex dropkey SHA1-s10-7da006579dd64330eb2456001fd01948430572f2 - * `transferkey` This plumbing-level command is used to request a single key be @@ -1069,6 +1133,11 @@ file contents are present at either of two repositories. The size can be specified with any commonly used units, for example, "0.5 gb" or "100 KiloBytes" +* `--metadata field=value` + + Matches only files that have a metadata field attached with the specified + value. + * `--want-get` Matches files that the preferred content settings for the repository @@ -1557,6 +1626,15 @@ for flac files: Note that setting numcopies to 0 is very unsafe. +These settings are honored by git-annex whenever it's operating on a +matching file. However, when using --all, --unused, or --key to specify +keys to operate on, git-annex is operating on keys and not files, so will +not honor the settings from .gitattributes. + +Also note that when using views, only the toplevel .gitattributes file is +preserved in the view, so other settings in other files won't have any +efffect. + # FILES These files are used by git-annex: diff --git a/doc/how_it_works.mdwn b/doc/how_it_works.mdwn index 0acf205652..69e5256e3a 100644 --- a/doc/how_it_works.mdwn +++ b/doc/how_it_works.mdwn @@ -6,13 +6,14 @@ You do not need to read this page to get started with using git-annex. The Still reading? Ok. Git's man page calls it "a stupid content tracker". With git-annex, git is instead "a stupid filename and metadata" -tracker. The contents of large files are not stored in git, only the +tracker. The contents of annexed files are not stored in git, only the names of the files and some other metadata remain there. The contents of the files are kept by git-annex in a distributed key/value store consisting of every clone of a given git repository. That's a fancy way to say that git-annex stores the actual file content somewhere under -`.git/annex/`. (See [[internals]] for details.) +`.git/annex/`. (See [[internals]] for details and note that in +[[direct_mode]] the file contents are left in the work tree.) That was the values; what about the keys? Well, a key is calculated for a given file when it's first added into git-annex. Normally this uses a hash diff --git a/doc/how_it_works/comment_2_2a8ce5859040d815e6234fc18f5f1961._comment b/doc/how_it_works/comment_2_2a8ce5859040d815e6234fc18f5f1961._comment new file mode 100644 index 0000000000..cc16f465d0 --- /dev/null +++ b/doc/how_it_works/comment_2_2a8ce5859040d815e6234fc18f5f1961._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawm4cjowB3PaZP00vEr255d1GdUBikE9Qdg" + nickname="Matthew" + subject="clarification about what is moved / stored and where" + date="2014-02-10T12:53:44Z" + content=""" +Just to support Nigel's comment; it's good to be precise and clear about what happens to the files from the start. +I've sent a similar suggestion to the mailing list. + +"""]] diff --git a/doc/install/OSX/comment_34_874ff01f27911baf6ef0f559d5d5f5a0._comment b/doc/install/OSX/comment_34_874ff01f27911baf6ef0f559d5d5f5a0._comment new file mode 100644 index 0000000000..45b62b770d --- /dev/null +++ b/doc/install/OSX/comment_34_874ff01f27911baf6ef0f559d5d5f5a0._comment @@ -0,0 +1,27 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawn3rK4VDzxyhmrIc18z7F5OuXvEbUsgUac" + nickname="Srinath" + subject="build issue with brew technique on Darwin Kernel Version 13.0.0" + date="2014-02-15T02:17:16Z" + content=""" +Following the Mac OS X brew instructions from the top of the board, I got the following error: + +[5 of 5] Compiling Yesod ( Yesod.hs, dist/build/Yesod.o ) +In-place registering yesod-1.2.5... +Installing library in /Users/srinathv/.cabal/lib/yesod-1.2.5/ghc-7.6.3 +Registering yesod-1.2.5... +Installed yesod-1.2.5 +cabal: Error: some packages failed to install: +git-annex-5.20140210 depends on libxml-sax-0.7.4 which failed to install. +libxml-sax-0.7.4 failed during the configure step. The exception was: +ExitFailure 1 +network-protocol-xmpp-0.4.5 depends on libxml-sax-0.7.4 which failed to +install. + + +Then I perused the comments and did: +$brew link libmxl2 --force +$cabal install git-annex --bindir=$HOME/bin + +with success. +"""]] diff --git a/doc/internals.mdwn b/doc/internals.mdwn index 1cf0cf5051..970e88ba02 100644 --- a/doc/internals.mdwn +++ b/doc/internals.mdwn @@ -146,6 +146,27 @@ Example: 1287290776.765152s e605dca6-446a-11e0-8b2a-002170d25c55 blah blah 1287290767.478634s 26339d22-446b-11e0-9101-002170d25c55 foo=bar +## `aaa/bbb/*.log.met` + +These log files are used to store arbitrary [[design/metadata]] about keys. +Each key can have any number of metadata fields. Each field has a set of +values. + +Lines are timestamped, and record when values are added (`field +value`), +but also when values are removed (`field -value`). Removed values +are retained in the log so that when merging an old line that sets a value +that was later unset, the value is not accidentially added back. + +For example: + + 1287290776.765152s tag +foo +bar author +joey + 1291237510.141453s tag -bar +baz + +The value can be completely arbitrary data, although it's typically +reasonably short. If the value contains any whitespace +(including \r or \r), it will be base64 encoded. Base64 encoded values +are indicated by prefixing them with "!" + ## `schedule.log` Used to record scheduled events, such as periodic fscks. diff --git a/doc/news/version_5.20131230.mdwn b/doc/news/version_5.20131230.mdwn deleted file mode 100644 index 552d7ec444..0000000000 --- a/doc/news/version_5.20131230.mdwn +++ /dev/null @@ -1,20 +0,0 @@ -git-annex 5.20131230 released with [[!toggle text="these changes"]] -[[!toggleable text=""" - * Added new external special remote interface. - * importfeed: Support youtube playlists. - * Add tasty to build-depends, so that test suite builds again. - (tasty was stuck in incoming.) - * Fix typo in test suite. - * Fix bug in Linux standalone build's shimming that broke git-annex-shell. - * Include git-receive-pack, git-upload-pack, git, and git-shell wrappers - in the Linux standalone build, and OSX app, so they will be available - when it's added to PATH. - * addurl, importfeed: Sanitize | and some other symbols and special - characters. - * Auto-upgrade v3 indirect repos to v5 with no changes. - This also fixes a problem when a direct mode repo was somehow set to v3 - rather than v4, and so the automatic direct mode upgrade to v5 was not - done. - * Android: Avoid trying to use Android's own ionice, which does not - allow specifying a command to run. Fixes transferring files to/from - android and probably a few other things."""]] \ No newline at end of file diff --git a/doc/news/version_5.20140107.mdwn b/doc/news/version_5.20140107.mdwn deleted file mode 100644 index 71a4adf939..0000000000 --- a/doc/news/version_5.20140107.mdwn +++ /dev/null @@ -1,26 +0,0 @@ -git-annex 5.20140107 released with [[!toggle text="these changes"]] -[[!toggleable text=""" - * mirror: Support --all (and --unused). - * external special remote protocol: Added GETUUID, GETWANTED, SETWANTED, - SETSTATE, GETSTATE, DEBUG. - * Windows: Fix bug in direct mode merge code that could cause files - in subdirectories to go missing. - * Windows: Avoid eating stdin when running ssh to add a authorized key, - since this is used for password prompting. - * Avoid looping if long-running git cat-file or git hash-object crashes - and keeps crashing when restarted. - * Assistant: Remove stale MERGE\_HEAD files in lockfile cleanup. - * Remotes can now be made read-only, by setting remote.<name>.annex-readonly - * wanted, schedule: Avoid printing "ok" after requested value. - * assistant: Ensure that .ssh/config and .ssh/authorized\_keys are not - group or world writable when writing to those files, as that can make - ssh refuse to use them, if it allows another user to write to them. - * addurl, importfeed: Honor annex.diskreserve as long as the size of the - url can be checked. - * add: Fix rollback when disk is completely full. - * assistant: Fixed several minor memory leaks that manifested when - adding a large number of files. - * assistant: Start a new git-annex transferkeys process - after a network connection change, so that remotes that use a persistent - network connection are restarted. - * Adjust Debian build deps to match current state of sparc, mipsel."""]] \ No newline at end of file diff --git a/doc/news/version_5.20140116.mdwn b/doc/news/version_5.20140116.mdwn deleted file mode 100644 index f107f26725..0000000000 --- a/doc/news/version_5.20140116.mdwn +++ /dev/null @@ -1,21 +0,0 @@ -git-annex 5.20140116 released with [[!toggle text="these changes"]] -[[!toggleable text=""" - * Added tahoe special remote. - * external special remote protocol: Added GETGITDIR, and GETAVAILABILITY. - * Refuse to build with git older than 1.7.1.1, which is needed for - git checkout -B - * map: Fix display of v5 direct mode repos. - * repair: Support old git versions from before git fsck --no-dangling was - implemented. - * Fix a long-standing bug that could cause the wrong index file to be used - when committing to the git-annex branch, if GIT\_INDEX\_FILE is set in the - environment. This typically resulted in git-annex branch log files being - committed to the master branch and later showing up in the work tree. - (These log files can be safely removed.) - * assistant: Detect if .git/annex/index is corrupt at startup, and - recover. - * repair: Fix bug in packed refs file exploding code that caused a .gitrefs - directory to be created instead of .git/refs - * Fix FTBFS on mipsel and sparc due to test suite not being available - on those architectures. - * Android: Avoid passing --clobber to busybox wget."""]] \ No newline at end of file diff --git a/doc/news/version_5.20140210.mdwn b/doc/news/version_5.20140210.mdwn new file mode 100644 index 0000000000..3049e9d47f --- /dev/null +++ b/doc/news/version_5.20140210.mdwn @@ -0,0 +1,42 @@ +git-annex 5.20140210 released with [[!toggle text="these changes"]] +[[!toggleable text=""" + * --in can now refer to files that were located in a repository at + some past date. For example, --in="here@{yesterday}" + * Fixed direct mode annexed content locking code, which is used to + guard against recursive file drops. + * This is the first beta-level release of the Windows port with important + fixes (see below). + (The webapp and assistant are still alpha-level on Windows.) + * sync --content: Honor annex-ignore configuration. + * sync: Don't try to sync with xmpp remotes, which are only currently + supported when using the assistant. + * sync --content: Re-pull from remotes after downloading content, + since that can take a while and other changes may be pushed in the + meantime. + * sync --content: Reuse smart copy code from copy command, including + handling and repairing out of date location tracking info. + Closes: #[737480](http://bugs.debian.org/737480) + * sync --content: Drop files from remotes that don't want them after + getting them. + * sync: Fix bug in automatic merge conflict resolution code when used + on a filesystem not supporting symlinks, which resulted in it losing + track of the symlink bit of annexed files. + * Added ways to configure rsync options to be used only when uploading + or downloading from a remote. Useful to eg limit upload bandwidth. + * Fix initremote with encryption=pubkey to work with S3, glacier, webdav, + and external special remotes. + * Avoid building with DAV 0.6 which is badly broken (see #737902). + * Fix dropping of unused keys with spaces in their name. + * Fix build on platforms not supporting the webapp. + * Document in man page that sshcaching uses ssh ControlMaster. + Closes: #[737476](http://bugs.debian.org/737476) + * Windows: It's now safe to run multiple git-annex processes concurrently + on Windows; the lock files have been sorted out. + * Windows: Avoid using unix-compat's rename, which refuses to rename + directories. + * Windows: Fix deletion of repositories by test suite and webapp. + * Windows: Test suite 100% passes again. + * Windows: Fix bug in symlink calculation code. + * Windows: Fix handling of absolute unix-style git repository paths. + * Android: Avoid crashing when unable to set file mode for ssh config file + due to Android filesystem horribleness."""]] \ No newline at end of file diff --git a/doc/news/version_5.20140210/comment_1_97065912d6a204c7387d7de5e48de420._comment b/doc/news/version_5.20140210/comment_1_97065912d6a204c7387d7de5e48de420._comment new file mode 100644 index 0000000000..fed533c602 --- /dev/null +++ b/doc/news/version_5.20140210/comment_1_97065912d6a204c7387d7de5e48de420._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="rasmus" + ip="94.34.129.197" + subject="Bug?" + date="2014-02-11T00:36:45Z" + content=""" +In this build git annex gets confused with my username of rsync backends. My username is annex@server but it keeps asking about rasmus@server (commandline and web interface). Should I open a bug report about this? Or is this a new feature that I haven't configured properly? +"""]] diff --git a/doc/news/version_5.20140210/comment_2_e589892996ca7cca3febdbf0f2cc379b._comment b/doc/news/version_5.20140210/comment_2_e589892996ca7cca3febdbf0f2cc379b._comment new file mode 100644 index 0000000000..74e5f0745a --- /dev/null +++ b/doc/news/version_5.20140210/comment_2_e589892996ca7cca3febdbf0f2cc379b._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.172" + subject="comment 2" + date="2014-02-11T00:48:35Z" + content=""" +I think you need to check your remote is configured properly before filing a bug report. But, there has been no change that is intended to lead to such a behavior. +"""]] diff --git a/doc/news/version_5.20140221.mdwn b/doc/news/version_5.20140221.mdwn new file mode 100644 index 0000000000..50f85496e1 --- /dev/null +++ b/doc/news/version_5.20140221.mdwn @@ -0,0 +1,28 @@ +git-annex 5.20140221 released with [[!toggle text="these changes"]] +[[!toggleable text=""" + * metadata: New command that can attach metadata to files. + * --metadata can be used to limit commands to acting on files + that have particular metadata. + * Preferred content expressions can use metadata=field=value + to limit them to acting on files that have particular metadata. + * view: New command that creates and checks out a branch that provides + a structured view of selected metadata. + * vfilter, vadd, vpop, vcycle: New commands for operating within views. + * pre-commit: Update metadata when committing changes to locations + of annexed files within a view. + * Add progress display for transfers to/from external special remotes. + * unused: Fix to actually detect unused keys when in direct mode. + * fsck: When run with --all or --unused, while .gitattributes + annex.numcopies cannot be honored since it's operating on keys + instead of files, make it honor the global numcopies setting, + and the annex.numcopies git config setting. + * trust, untrust, semitrust, dead: Warn when the trust level is + overridden in .git/config. + * glacier: Do not try to run glacier value create when an existing glacier + remote is enabled. + * fsck: Refuse to do anything if more than one of --incremental, --more, + and --incremental-schedule are given, since it's not clear which option + should win. + * Windows webapp: Can set up box.com, Amazon S3, and rsync.net remotes + * Windows webapp: Can create repos on removable drives. + * Windows: Ensure HOME is set, as needed by bundled cygwin utilities."""]] \ No newline at end of file diff --git a/doc/special_remotes.mdwn b/doc/special_remotes.mdwn index 02f9bd1358..e3004d2cf1 100644 --- a/doc/special_remotes.mdwn +++ b/doc/special_remotes.mdwn @@ -38,6 +38,7 @@ for using git-annex with various services: * [[IMAP|forum/special_remote_for_IMAP]] * [[Usenet|forum/nntp__47__usenet special remote]] * [chef-vault](https://github.com/3ofcoins/knife-annex/) +* [hubiC](https://github.com/Schnouki/git-annex-remote-hubic) Want to add support for something else? [[Write your own!|external]] diff --git a/doc/tips/metadata_driven_views.mdwn b/doc/tips/metadata_driven_views.mdwn new file mode 100644 index 0000000000..7b46ca974a --- /dev/null +++ b/doc/tips/metadata_driven_views.mdwn @@ -0,0 +1,121 @@ +git-annex now has support for storing +[[arbitrary metadata|design/metadata]] about annexed files. For example, this can be +used to tag files, to record the author of a file, etc. The metadata is +synced around between repositories with the other information git-annex +keeps track of. + +One nice way to use the metadata is through **views**. You can ask +git-annex to create a view of files in the currently checked out branch +that have certian metadata. Once you're in a view, you can move and copy +files to adjust their metadata further. Rather than the traditional +hierarchical directory structure, views are dynamic; you can easily +refine or reorder a view. + +Let's get started by setting some tags on files. No views yet, just some +metadata: + + # git annex metadata --tag todo work/2014/* + # git annex metadata --untag todo work/2014/done/* + # git annex metadata --tag urgent work/2014/presentation_for_tomorrow.odt + # git annex metadata --tag done work/2013/* work/2014/done/* + # git annex metadata --tag work work + # git annex metadata --tag video videos + # git annex metadata --tag work videos/operating_heavy_machinery.mov + # git annex metadata --tag done videos/old + # git annex metadata --tag new videos/lotsofcats.ogv + # git annex metadata --tag sound podcasts + # git annex metadata --tag done podcasts/old + # git annex metadata --tag new podcasts/recent + +So, you had a bunch of different kinds of files sorted into a directory +structure. But that didn't really reflect how you approach the files. +Adding some tags lets you categorize the files in different ways. + +Ok, metadata is in place, but how to use it? Time to change views! + + # git annex view tag=* + view (searching...) + + Switched to branch 'views/_' + ok + +This searched for all files with any tag, and created a new git branch +that sorts the files according to their tags. + + # tree -d + work + todo + urgent + done + new + video + sound + +Notice that a single file may appear in multiple directories +depending on its tags. For example, `lotsofcats.ogv` is in +both `new/` and `video/`. + +Ah, but you're at work now, and don't want to be distracted by cat videos. +Time to filter the view: + + # git annex vfilter tag=work + vfilter + Switched to branch 'views/(work)/_' + ok + +Now only the work files are in the view, and they're otherwise categorized +according to their other tags. So you can check the `urgent/` directory +to see what's next, and look in `todo/` for other work related files. + +Now that you're in a tag based view, you can move files around between the +directories, and when you commit your changes to git, their tags will be +updated. + + # git mv urgent/presentation_for_tomorrow_{work;2014}.odt ../done + # git commit -m "a good day's work" + metadata tag-=urgent + metadata tag+=done + +You can return to a previous view by running `git annex vpop`. If you pop +all the way out of all views, you'll be back on the regular git branch you +originally started from. You can also use `git checkout` to switch between +views and other branches. + +Beyond simple tags, you can add whatever kinds of metadata you like, and +use that metadata in more elaborate views. For example, let's add a year +field. + + # git checkout master + # git annex metadata --set year=2014 work/2014 + # git annex metadata --set year=2013 work/2013 + # git annex view year=* tag=* + +Now you're in a view with two levels of directories, first by year and then +by tag. + + # tree -d + 2014 + |-- work + |-- todo + |-- urgent + `-- done + 2013 + |-- work + `-- done + +Oh, did you want it the other way around? Easy! + + # git annex vcycle + # tree -d + work + |-- 2014 + `-- 2013 + todo + `-- 2014 + urgent + `-- 2014 + done + |-- 2014 + `-- 2013 + +This has probably only scratched the surface of what you can do with views. diff --git a/doc/tips/using_Amazon_Glacier.mdwn b/doc/tips/using_Amazon_Glacier.mdwn index 5aac7fa91e..402e50a9d6 100644 --- a/doc/tips/using_Amazon_Glacier.mdwn +++ b/doc/tips/using_Amazon_Glacier.mdwn @@ -24,7 +24,7 @@ repository use the same Glacier remote is easy: # cd /media/usb/annex # git pull laptop - # git annex initremote glacier + # git annex enableremote glacier initremote glacier (gpg) ok Now the remote can be used like any other remote. diff --git a/doc/tips/using_Amazon_Glacier/comment_1_ccee7f4f5a483a3650270b6e09ab7293._comment b/doc/tips/using_Amazon_Glacier/comment_1_ccee7f4f5a483a3650270b6e09ab7293._comment new file mode 100644 index 0000000000..9d81d6bca8 --- /dev/null +++ b/doc/tips/using_Amazon_Glacier/comment_1_ccee7f4f5a483a3650270b6e09ab7293._comment @@ -0,0 +1,36 @@ +[[!comment format=mdwn + username="http://grossmeier.net/" + nickname="greg" + subject="missing steps?" + date="2014-02-18T23:51:00Z" + content=""" +I setup a glacier remote on one machine and it successfully created the vault and is syncing files to it. + +One another machine, after git-annex sync'ing, I did: + + +[[!format sh \"\"\" +greg@x200s:~/Photos$ git-annex enableremote glacier +enableremote glacier + Set both AWS_ACCESS_KEY_ID and AWS_SECRET_ACCESS_KEY to use glacier +git-annex: Failed creating glacier vault. +\"\"\"]] + +So then I try: +[[!format sh \"\"\" +greg@x200s:~/Photos$ AWS_ACCESS_KEY_ID=HAHA AWS_SECRET_ACCESS_KEY=NOPE git-annex --debug enableremote glacier +[2014-02-18 15:43:56 PST] read: git [\"--git-dir=/home/greg/Photos/.git\",\"--work-tree=/home/greg/Photos\",\"show-ref\",\"git-annex\"] +[2014-02-18 15:43:56 PST] read: git [\"--git-dir=/home/greg/Photos/.git\",\"--work-tree=/home/greg/Photos\",\"show-ref\",\"--hash\",\"refs/heads/git-annex\"] +[2014-02-18 15:43:56 PST] read: git [\"--git-dir=/home/greg/Photos/.git\",\"--work-tree=/home/greg/Photos\",\"log\",\"refs/heads/git-annex..8108714116d08f93aa427b9ddced48cd5f2b4b72\",\"--oneline\",\"-n1\"] +[2014-02-18 15:43:56 PST] read: git [\"--git-dir=/home/greg/Photos/.git\",\"--work-tree=/home/greg/Photos\",\"log\",\"refs/heads/git-annex..742ba908f791e440a6cc85073ef505a96dd66aa4\",\"--oneline\",\"-n1\"] +[2014-02-18 15:43:56 PST] read: git [\"--git-dir=/home/greg/Photos/.git\",\"--work-tree=/home/greg/Photos\",\"log\",\"refs/heads/git-annex..071487394544a20253a70ada4ea71fcc28f9fc13\",\"--oneline\",\"-n1\"] +[2014-02-18 15:43:56 PST] read: git [\"--git-dir=/home/greg/Photos/.git\",\"--work-tree=/home/greg/Photos\",\"log\",\"refs/heads/git-annex..c8aecc22da7b84bbb82f083ce783cc699cef1c67\",\"--oneline\",\"-n1\"] +[2014-02-18 15:43:56 PST] chat: git [\"--git-dir=/home/greg/Photos/.git\",\"--work-tree=/home/greg/Photos\",\"cat-file\",\"--batch\"] +enableremote glacier [2014-02-18 15:43:56 PST] call: glacier [\"--region=us-west-2\",\"vault\",\"create\",\"glacier-7e5c0010-2634-4a5e-bc7b-6fea84b8b947\"] +git-annex: Failed creating glacier vault. +\"\"\"]] + +What am I missing? + +Also, why is it trying to *create* the valut? It's already there with content in it! +"""]] diff --git a/doc/tips/using_Amazon_Glacier/comment_2_d34e05f9244d3a4fcec87b3c360adb4e._comment b/doc/tips/using_Amazon_Glacier/comment_2_d34e05f9244d3a4fcec87b3c360adb4e._comment new file mode 100644 index 0000000000..ed482906b9 --- /dev/null +++ b/doc/tips/using_Amazon_Glacier/comment_2_d34e05f9244d3a4fcec87b3c360adb4e._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.172" + subject="comment 2" + date="2014-02-20T19:24:09Z" + content=""" +@greg, the only thing you might have missed is the need to use `glacier vault sync` to build a cache if enabling the glacier remote in another place. And that whole issue with it needing a local cache may mean few people are using glacier with more than one repository accessing the remote. + +However, this sounds like a bug. There is a comment in the source code that \"glacier vault create will succeed even if the vault already exists.\" .. perhaps it has changed since that was written. Or perhaps the command failed for some other reason, I don't know. +"""]] diff --git a/doc/tips/using_Amazon_Glacier/comment_3_4c504fd22775afe36296cf54d3e04a8e._comment b/doc/tips/using_Amazon_Glacier/comment_3_4c504fd22775afe36296cf54d3e04a8e._comment new file mode 100644 index 0000000000..a8c765bcbf --- /dev/null +++ b/doc/tips/using_Amazon_Glacier/comment_3_4c504fd22775afe36296cf54d3e04a8e._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.172" + subject="comment 3" + date="2014-02-20T19:34:48Z" + content=""" +I've changed it to avoid running glacier value create when enabling an existing glacier remote. Hopefully that fixes it. +"""]] diff --git a/doc/tips/using_Amazon_Glacier/comment_4_e6ac76b0c20285f4f96b3d0975e8ac66._comment b/doc/tips/using_Amazon_Glacier/comment_4_e6ac76b0c20285f4f96b3d0975e8ac66._comment new file mode 100644 index 0000000000..47fa6868ff --- /dev/null +++ b/doc/tips/using_Amazon_Glacier/comment_4_e6ac76b0c20285f4f96b3d0975e8ac66._comment @@ -0,0 +1,21 @@ +[[!comment format=mdwn + username="http://grossmeier.net/" + nickname="greg" + subject="comment 4" + date="2014-02-20T22:04:58Z" + content=""" +Along with stupid python problems which are now fixed (all my fault, and hopefully didn't cause more noise here than needed), the only thing that didn't go as stated was: + +[[!format sh \"\"\" +greg@x200s:~/Photos$ git-annex enableremote glacier +enableremote glacier + Set both AWS_ACCESS_KEY_ID and AWS_SECRET_ACCESS_KEY to use glacier +git-annex: Failed creating glacier vault. +greg@x200s:~/Photos$ AWS_ACCESS_KEY_ID=lolno AWS_SECRET_ACCESS_KEY=lolno git-annex enableremote glacier +enableremote glacier ok +(Recording state in git...) +greg@x200s:~/Photos$ +\"\"\"]] + +The guide says that info is sync'd. +"""]] diff --git a/doc/tips/using_Amazon_Glacier/comment_5_7788890f58f714b0cdf1462c718ea536._comment b/doc/tips/using_Amazon_Glacier/comment_5_7788890f58f714b0cdf1462c718ea536._comment new file mode 100644 index 0000000000..5e0e6c716b --- /dev/null +++ b/doc/tips/using_Amazon_Glacier/comment_5_7788890f58f714b0cdf1462c718ea536._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.172" + subject="good" + date="2014-02-21T15:20:39Z" + content=""" +If you mean the creds are not remembered, that's controlled by the embedcreds= option to initremote, and it only defaults to embedding them for gacier when using strong encryption (not encryption=shared). +"""]] diff --git a/doc/tips/using_Amazon_Glacier/comment_6_0fbe528a57552622e8128196ad80c863._comment b/doc/tips/using_Amazon_Glacier/comment_6_0fbe528a57552622e8128196ad80c863._comment new file mode 100644 index 0000000000..65128b72cd --- /dev/null +++ b/doc/tips/using_Amazon_Glacier/comment_6_0fbe528a57552622e8128196ad80c863._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://grossmeier.net/" + nickname="greg" + subject="confirmed" + date="2014-02-21T17:53:02Z" + content=""" +Yeah, I choose no encryption for this one for worst case scenario reasons (I still want photos of my kid even if I loss my gpg key and my house burns down). Now about setting up http://git.kitenet.net/?p=gpg.git;a=blob;f=README.sss;hb=HEAD ...... +"""]] diff --git a/doc/todo/Use_bitcoin-mining_ASICs_for_hashing__63__.mdwn b/doc/todo/Use_bitcoin-mining_ASICs_for_hashing__63__.mdwn new file mode 100644 index 0000000000..48c136b267 --- /dev/null +++ b/doc/todo/Use_bitcoin-mining_ASICs_for_hashing__63__.mdwn @@ -0,0 +1,18 @@ +This is just an idea, and I have no idea if it would work (that's why I'm asking): + +**Would it be possible to use ASICs made for Bitcoin mining inside git-annex to offload the hashing of files?** + +I got the idea, because I have two RaspberryPis here: + +- one runs my git-annex archive. It is really slow at hashing, so I resorted to using the WORM backend +- another one runs 2 old-ish ASIC miners. They are just barely "profitable" right now, so in a few months they will be obsolete + +Both devices to some kind of `SHA256`. I have a feeling this is either extremely easy or extremely complicated to do… :) + +> git-annex uses binaries such as `sha256sum` for hashing large files (large is +> currently hardcoded as bigger than 1MB). If you insert a binary with the same +> interface as `sha256sum` into your `$PATH`, git-annex will automatically use +> it. If you want to use ASIC hashing even for small files, you need to tweak +> `Backend/Hash.hs`. --[[HelmutGrohne]] + +>> [[done]] --[[Joey]] diff --git a/doc/todo/Use_bitcoin-mining_ASICs_for_hashing__63__/comment_1_a93805a8088402c6dc32d2b9785fcc7d._comment b/doc/todo/Use_bitcoin-mining_ASICs_for_hashing__63__/comment_1_a93805a8088402c6dc32d2b9785fcc7d._comment new file mode 100644 index 0000000000..952978834c --- /dev/null +++ b/doc/todo/Use_bitcoin-mining_ASICs_for_hashing__63__/comment_1_a93805a8088402c6dc32d2b9785fcc7d._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.172" + subject="comment 1" + date="2014-02-20T17:42:10Z" + content=""" +I feel that Helmut has the right approach to this general type of thing. + +I doubt that bitcoin ASICs feature a fast data transfer bus, because bitcoin is a pretty low-data-volume protocol. Additionally AIUI, bitcoin ASICs get their speed by hashing in parallel, which allows them to try many variations of a block at once. So they probably rely on most of the data remaining the same and only a small amount changing. So it's doubtful this would be a win. +"""]] diff --git a/doc/todo/add_metadata_to_annexed_files.mdwn b/doc/todo/add_metadata_to_annexed_files.mdwn index 0fc3e89535..3d81677cb2 100644 --- a/doc/todo/add_metadata_to_annexed_files.mdwn +++ b/doc/todo/add_metadata_to_annexed_files.mdwn @@ -1,5 +1,14 @@ -I would like to attach metadata to annexed files (objects) without cluttering the workdir with files containing this metadata. A common use case would be to add titles to my photo collection that could than end up in a generated photo album. +I would like to attach metadata to annexed files (objects) without +cluttering the workdir with files containing this metadata. A common use +case would be to add titles to my photo collection that could than end up +in a generated photo album. Depending on the implementation it might also be possible to use the metadata facility for a threaded commenting system. -The first question is whether the metadata is attached to the objects and thus shared by all paths pointing to the same data object or to paths in the worktree. I've no preference here at this point. +The first question is whether the metadata is attached to the objects and +thus shared by all paths pointing to the same data object or to paths in +the worktree. I've no preference here at this point. + +> This is [[done]]; see [[design/metadata]]. +> The metadata is attached to objects, not to files. +> --[[Joey]] diff --git a/doc/todo/openwrt_package/comment_2_2cb7dd4c0cc4413a4588b13cf7700de2._comment b/doc/todo/openwrt_package/comment_2_2cb7dd4c0cc4413a4588b13cf7700de2._comment new file mode 100644 index 0000000000..d99fa13f1d --- /dev/null +++ b/doc/todo/openwrt_package/comment_2_2cb7dd4c0cc4413a4588b13cf7700de2._comment @@ -0,0 +1,9 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkNE-H4vEcbcGndxq5daT8qUb7yIf7r1OE" + nickname="Łukasz" + subject="comment 2" + date="2014-02-11T21:05:00Z" + content=""" +if debian does not have working toolchain for mips then there is no way to port it into mips machines. +am i correct ? +"""]] diff --git a/doc/todo/openwrt_package/comment_3_5ba8a325a683ff543d81a366c873070d._comment b/doc/todo/openwrt_package/comment_3_5ba8a325a683ff543d81a366c873070d._comment new file mode 100644 index 0000000000..9c9157d18f --- /dev/null +++ b/doc/todo/openwrt_package/comment_3_5ba8a325a683ff543d81a366c873070d._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.172" + subject="comment 3" + date="2014-02-11T21:39:34Z" + content=""" +Actually, debian stable does still have ghc building for mips/mipsel. It's just newer versions that have failed to build and nobody has fixed it yet. +"""]] diff --git a/doc/todo/whislist:_allow_setting_annex-ignore_from_the_webapp.mdwn b/doc/todo/whislist:_allow_setting_annex-ignore_from_the_webapp.mdwn new file mode 100644 index 0000000000..67996281e9 --- /dev/null +++ b/doc/todo/whislist:_allow_setting_annex-ignore_from_the_webapp.mdwn @@ -0,0 +1,2 @@ +I would like to be able to set 'annex-ignore' for remote servers through the webapp. +Maybe a checkbox beneath "Syncing enabled" with something like "Also sync content" that it's checked by default? diff --git a/doc/todo/windows_support.mdwn b/doc/todo/windows_support.mdwn index ae27ac46b6..ea532dfc1c 100644 --- a/doc/todo/windows_support.mdwn +++ b/doc/todo/windows_support.mdwn @@ -3,22 +3,11 @@ now! --[[Joey]] ## status -* Does not work with Cygwin's build of git (that git does not consistently - support use of DOS style paths, which git-annex uses on Windows). - Must use Msysgit. -* rsync special remotes with a rsyncurl of a local directory are known - let r = if inr1 then r1 else r2 - buggy. (git-annex tells rsync C:foo and it thinks it means a remote host - named C...) -* Ssh connection caching does not work on Windows, so `git annex get` - has to connect twice to the remote system over ssh per file, which - is much slower than on systems supporting connection caching. -* `git annex assistant` has not been tested, is probably quite incomplete - and/or buggy. * Doesn't daemonize. Maybe use or perhaps easier, + * XMPP library not yet built. This should work to install the deps, using libs from cygwin @@ -34,3 +23,42 @@ now! --[[Joey]] Also needs gsasl, which is not in cygwin. See + +* View debug log is empty in windows -- all logs go to console. + This messes up a few parts of UI that direct user to the debug log. + Should try to get rid of the console, but only once ssh passwords + (and possibly gpg) are not prompted there anymore. + +* Local pairing seems to fail, after acking on Linux box, it stalls. + +* gcrypt is not ported to windows (and as a shell script, may need + to be rewritten) + +* Incremental fsck sets the sticky bit to record when a file is fscked, + and this is not done on windows, so fsck doesn't behave incrementally + there. + +* Deleting a git repository from inside the webapp fails "RemoveDirectory + permision denied ... file is being used by another process" + +## minor problems + +* Does not work with Cygwin's build of git (that git does not consistently + support use of DOS style paths, which git-annex uses on Windows). + Must use Msysgit. +* rsync special remotes with a rsyncurl of a local directory are known + buggy. (git-annex tells rsync C:foo and it thinks it means a remote host + named C...) +* webapp lets user choose to encrypt repo, and generate gpg key, + before checking that gcrypt is not installed +* Ssh connection caching does not work on Windows, so `git annex get` + has to connect twice to the remote system over ssh per file, which + is much slower than on systems supporting connection caching. +* glacier-cli is not easily available (probably) + +## stuff needing testing + +* test S3 and box.com setup in webapp now that they should work.. +* test that adding a repo on a removable drive works; that git is synced to + it and files can be transferred to it and back +* Does stopping in progress transfers work in the webapp? diff --git a/doc/todo/wishlist:_more_descriptive_commit_messages_in_git-annex_branch.mdwn b/doc/todo/wishlist:_more_descriptive_commit_messages_in_git-annex_branch.mdwn index 3a891fc9b2..8b6350a550 100644 --- a/doc/todo/wishlist:_more_descriptive_commit_messages_in_git-annex_branch.mdwn +++ b/doc/todo/wishlist:_more_descriptive_commit_messages_in_git-annex_branch.mdwn @@ -37,3 +37,19 @@ in my opinion, the messages should at least contain >> Closing as this is literally impossible to do without making >> git-annex worse. [[done]] --[[Joey]] + +> I'm not sure that the requested feature is that far off. There are two +> aspects, that can be solved relatively easy: +> +> * Recording the name of the remote the commit was issued on. This +> information is simply constant per remote. +> +> * While it is true that there is no 1 on 1 correspondence between commands +> and git-annex commits, it would be entirely possible to add a "message +> journal". Every command issued would start out with writing its +> invocation to the message journal. At the time the journal ends up being +> committed to the git-annex branch, the message journal is used as the +> body of the commit message and truncated. +> +> It is true that these suggestions do not address every aspect of the +> original report, but they would solve about 90%. --[[HelmutGrohne]] diff --git a/doc/todo/wishlist:_swift_backend/comment_5_1568f726f91d4589aef7ca9fcc3c957d._comment b/doc/todo/wishlist:_swift_backend/comment_5_1568f726f91d4589aef7ca9fcc3c957d._comment new file mode 100644 index 0000000000..1f0ff9f63c --- /dev/null +++ b/doc/todo/wishlist:_swift_backend/comment_5_1568f726f91d4589aef7ca9fcc3c957d._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://schnouki.net/" + nickname="Schnouki" + subject="comment 5" + date="2014-02-11T13:38:53Z" + content=""" +FYI, I just published a [special remote for hubiC](https://github.com/Schnouki/git-annex-remote-hubic) that uses the OAuth API for authentication and the SWIFT API for data transfers. Parts of it are specific for hubiC (mostly auth.py), but it should be possible to adapt it to other SWIFT providers as well. +"""]] diff --git a/doc/videos/git-annex_views_demo.mdwn b/doc/videos/git-annex_views_demo.mdwn new file mode 100644 index 0000000000..c860129fd0 --- /dev/null +++ b/doc/videos/git-annex_views_demo.mdwn @@ -0,0 +1,11 @@ +A quick screencast demoing an experimental new feature, +[[tips/metadata_driven_views]]. + + + +[video](https://downloads.kitenet.net/videos/git-annex/git-annex_views_demo.ogg) + +Credits: + +* RichiH for +* Michi for keyboard cat cameo diff --git a/doc/walkthrough/adding_files.mdwn b/doc/walkthrough/adding_files.mdwn index d1b5a04f77..b014c3ee70 100644 --- a/doc/walkthrough/adding_files.mdwn +++ b/doc/walkthrough/adding_files.mdwn @@ -7,5 +7,6 @@ # git commit -a -m added When you add a file to the annex and commit it, only a symlink to -the annexed content is committed. The content itself is stored in -git-annex's backend. +the content is committed to git. The content itself is stored in +git-annex's backend, `.git/annex/` (or in [[direct_mode]] the file +is left as-is). diff --git a/doc/walkthrough/backups.mdwn b/doc/walkthrough/backups.mdwn index 9723022b4c..b51a887949 100644 --- a/doc/walkthrough/backups.mdwn +++ b/doc/walkthrough/backups.mdwn @@ -1,15 +1,17 @@ git-annex can be configured to require more than one copy of a file exists, -as a simple backup for your data. This is controlled by the "annex.numcopies" -setting, which defaults to 1 copy. Let's change that to require 2 copies, -and send a copy of every file to a USB drive. +as a simple backup for your data. This is controlled by the +numcopies setting, which defaults to 1 copy. Let's +change that to require 2 copies, and send a copy of every file +to a USB drive. - # echo "* annex.numcopies=2" >> .gitattributes + # git annex numcopies 2 # git annex copy . --to usbdrive Now when we try to `git annex drop` a file, it will verify that it knows of 2 other repositories that have a copy before removing its content from the current repository. +The numcopies setting used above is the global default. You can also vary the number of copies needed, depending on the file name. So, if you want 3 copies of all your flac files, but only 1 copy of oggs: diff --git a/git-annex.cabal b/git-annex.cabal index a71e7df1c8..8e3f3f3883 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -1,5 +1,5 @@ Name: git-annex -Version: 5.20140129 +Version: 5.20140221 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess @@ -105,6 +105,7 @@ Executable git-annex if (os(windows)) Build-Depends: Win32, Win32-extras + C-Sources: Utility/winprocess.c else Build-Depends: unix -- Need to list these because they're generated from .hsc files. diff --git a/git-annex.hs b/git-annex.hs index 198a1f4e6e..a96dd8cbd3 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -1,13 +1,13 @@ -{- git-annex main program stub +{- git-annex main program dispatch - - - Copyright 2010-2013 Joey Hess + - Copyright 2010-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} {-# LANGUAGE CPP #-} -import System.Environment +import System.Environment (getArgs, getProgName) import System.FilePath import qualified CmdLine.GitAnnex @@ -16,19 +16,61 @@ import qualified CmdLine.GitAnnexShell import qualified Test #endif +#ifdef mingw32_HOST_OS +import Utility.UserInfo +import Utility.Env +import Config.Files +import System.Process +import System.Exit +#endif + main :: IO () -main = run =<< getProgName +main = do + ps <- getArgs + run ps =<< getProgName where - run n - | isshell n = go CmdLine.GitAnnexShell.run - | otherwise = go CmdLine.GitAnnex.run - isshell n = takeFileName n == "git-annex-shell" - go a = do - ps <- getArgs + run ps n + | isshell n = CmdLine.GitAnnexShell.run ps + | otherwise = +#ifdef mingw32_HOST_OS + winEnv gitannex ps +#else + gitannex ps +#endif + gitannex ps = #ifdef WITH_TESTSUITE case ps of ("test":ps') -> Test.main ps' - _ -> a ps + _ -> CmdLine.GitAnnex.run ps #else - a ps + CmdLine.GitAnnex.run ps +#endif + isshell n = takeFileName n == "git-annex-shell" + +#ifdef mingw32_HOST_OS +{- On Windows, if HOME is not set, probe it and set it, re-execing + - git-annex with the new environment. + - + - This is a workaround for some Cygwin commands needing HOME to be set, + - and for there being no known way to set environment variables on + - Windows, except by passing an environment in each call to a program. + - While ugly, this workaround is easier than trying to ensure HOME is set + - in all calls to the affected programs. + -} +winEnv :: ([String] -> IO ()) -> [String] -> IO () +winEnv a ps = go =<< getEnv "HOME" + where + go (Just _) = a ps + go Nothing = do + home <- myHomeDir + putStrLn $ "** Windows hack; overrideing HOME to " ++ home + e <- getEnvironment + let eoverride = + [ ("HOME", home) + , ("CYGWIN", "nodosfilewarning") + ] + cmd <- readProgramFile + (_, _, _, pid) <- createProcess (proc cmd ps) + { env = Just $ e ++ eoverride } + exitWith =<< waitForProcess pid #endif diff --git a/standalone/android/haskell-patches/SafeSemaphore_fix-build-with-new-base.patch b/standalone/android/haskell-patches/SafeSemaphore_fix-build-with-new-base.patch deleted file mode 100644 index a79ca519a5..0000000000 --- a/standalone/android/haskell-patches/SafeSemaphore_fix-build-with-new-base.patch +++ /dev/null @@ -1,36 +0,0 @@ -From 010db89634eb0f64e7961581e65da3acbb2b9f3d Mon Sep 17 00:00:00 2001 -From: foo -Date: Sat, 21 Sep 2013 22:05:41 +0000 -Subject: [PATCH] fix build with new base - ---- - src/Control/Concurrent/MSampleVar.hs | 6 +----- - 1 file changed, 1 insertion(+), 5 deletions(-) - -diff --git a/src/Control/Concurrent/MSampleVar.hs b/src/Control/Concurrent/MSampleVar.hs -index d029c64..16ad6c5 100644 ---- a/src/Control/Concurrent/MSampleVar.hs -+++ b/src/Control/Concurrent/MSampleVar.hs -@@ -30,7 +30,7 @@ module Control.Concurrent.MSampleVar - import Control.Monad(void,join) - import Control.Concurrent.MVar(MVar,newMVar,newEmptyMVar,tryTakeMVar,takeMVar,putMVar,withMVar,isEmptyMVar) - import Control.Exception(mask_) --import Data.Typeable(Typeable1(typeOf1),mkTyCon,mkTyConApp) -+import Data.Typeable(mkTyConApp) - - -- | - -- Sample variables are slightly different from a normal 'MVar': -@@ -62,10 +62,6 @@ data MSampleVar a = MSampleVar { readQueue :: MVar () - , lockedStore :: MVar (MVar a) } - deriving (Eq) - --instance Typeable1 MSampleVar where -- typeOf1 _ = mkTyConApp tc [] -- where tc = mkTyCon "MSampleVar" -- - - -- | 'newEmptySV' allocates a new MSampleVar in an empty state. No futher - -- allocation is done when using the 'MSampleVar'. --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/gnuidn_fix-build-with-new-base.patch b/standalone/android/haskell-patches/gnuidn_fix-build-with-new-base.patch deleted file mode 100644 index ff9d8f2458..0000000000 --- a/standalone/android/haskell-patches/gnuidn_fix-build-with-new-base.patch +++ /dev/null @@ -1,50 +0,0 @@ -From afdec6c9e66211a0ac8419fffe191b059d1fd00c Mon Sep 17 00:00:00 2001 -From: foo -Date: Sun, 22 Sep 2013 17:24:33 +0000 -Subject: [PATCH] fix build with new base - ---- - Data/Text/IDN/IDNA.chs | 1 + - Data/Text/IDN/Punycode.chs | 1 + - Data/Text/IDN/StringPrep.chs | 1 + - 3 files changed, 3 insertions(+) - -diff --git a/Data/Text/IDN/IDNA.chs b/Data/Text/IDN/IDNA.chs -index ed29ee4..dbb4ba5 100644 ---- a/Data/Text/IDN/IDNA.chs -+++ b/Data/Text/IDN/IDNA.chs -@@ -31,6 +31,7 @@ import Foreign - import Foreign.C - - import Data.Text.IDN.Internal -+import System.IO.Unsafe - - #include - #include -diff --git a/Data/Text/IDN/Punycode.chs b/Data/Text/IDN/Punycode.chs -index 24b5fa6..4e62555 100644 ---- a/Data/Text/IDN/Punycode.chs -+++ b/Data/Text/IDN/Punycode.chs -@@ -32,6 +32,7 @@ import Data.List (unfoldr) - import qualified Data.ByteString as B - import qualified Data.Text as T - -+import System.IO.Unsafe - import Foreign - import Foreign.C - -diff --git a/Data/Text/IDN/StringPrep.chs b/Data/Text/IDN/StringPrep.chs -index 752dc9e..5e9fd84 100644 ---- a/Data/Text/IDN/StringPrep.chs -+++ b/Data/Text/IDN/StringPrep.chs -@@ -39,6 +39,7 @@ import qualified Data.ByteString as B - import qualified Data.Text as T - import qualified Data.Text.Encoding as TE - -+import System.IO.Unsafe - import Foreign - import Foreign.C - --- -1.7.10.4 - diff --git a/standalone/android/haskell-patches/libxml-sax_text-dep.patch b/standalone/android/haskell-patches/libxml-sax_text-dep.patch new file mode 100644 index 0000000000..c9b4fdb78b --- /dev/null +++ b/standalone/android/haskell-patches/libxml-sax_text-dep.patch @@ -0,0 +1,25 @@ +From d4c861dbdee34cb2434085b9ece62c416d4cad79 Mon Sep 17 00:00:00 2001 +From: androidbuilder +Date: Sat, 8 Feb 2014 17:19:37 +0000 +Subject: [PATCH] text dependency + +--- + libxml-sax.cabal | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/libxml-sax.cabal b/libxml-sax.cabal +index 60dba81..d6883bd 100644 +--- a/libxml-sax.cabal ++++ b/libxml-sax.cabal +@@ -35,7 +35,7 @@ library + build-depends: + base >= 4.1 && < 5.0 + , bytestring >= 0.9 +- , text >= 0.7 && < 0.12 ++ , text + , xml-types >= 0.3 && < 0.4 + + exposed-modules: +-- +1.7.10.4 + diff --git a/standalone/android/haskell-patches/network-protocol-xmpp_text-dapendency.patch b/standalone/android/haskell-patches/network-protocol-xmpp_text-dapendency.patch new file mode 100644 index 0000000000..7987818372 --- /dev/null +++ b/standalone/android/haskell-patches/network-protocol-xmpp_text-dapendency.patch @@ -0,0 +1,25 @@ +From 8f124aad6d04abba5729af21ba3b50944f165d4b Mon Sep 17 00:00:00 2001 +From: androidbuilder +Date: Sat, 8 Feb 2014 17:20:41 +0000 +Subject: [PATCH] text dependency + +--- + network-protocol-xmpp.cabal | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/network-protocol-xmpp.cabal b/network-protocol-xmpp.cabal +index 2500075..d709a15 100644 +--- a/network-protocol-xmpp.cabal ++++ b/network-protocol-xmpp.cabal +@@ -36,7 +36,7 @@ library + , libxml-sax >= 0.7 && < 0.8 + , monads-tf >= 0.1 && < 0.2 + , network >= 2.2 +- , text >= 0.10 && < 0.12 ++ , text + , transformers >= 0.2 + , xml-types >= 0.3 && < 0.4 + +-- +1.7.10.4 + diff --git a/standalone/android/haskell-patches/system-filepath_cross-build.patch b/standalone/android/haskell-patches/system-filepath_cross-build.patch new file mode 100644 index 0000000000..430e8f99fa --- /dev/null +++ b/standalone/android/haskell-patches/system-filepath_cross-build.patch @@ -0,0 +1,25 @@ +From 9345a1ad95cc263f99ef124c7a386fb5aaa5405b Mon Sep 17 00:00:00 2001 +From: androidbuilder +Date: Fri, 7 Feb 2014 22:18:12 +0000 +Subject: [PATCH] fix + +--- + system-filepath.cabal | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/system-filepath.cabal b/system-filepath.cabal +index d5fbbdd..efdf9ca 100644 +--- a/system-filepath.cabal ++++ b/system-filepath.cabal +@@ -6,7 +6,7 @@ license-file: license.txt + author: John Millikin + maintainer: John Millikin + copyright: John Millikin 2010-2012 +-build-type: Custom ++build-type: Simple + cabal-version: >= 1.6 + category: System + stability: experimental +-- +1.7.10.4 + diff --git a/standalone/android/haskell-patches/x509-system_support-Android-cert-store.patch b/standalone/android/haskell-patches/x509-system_support-Android-cert-store.patch new file mode 100644 index 0000000000..b3aa407dfc --- /dev/null +++ b/standalone/android/haskell-patches/x509-system_support-Android-cert-store.patch @@ -0,0 +1,36 @@ +From 2c736615e38ee4f582af9d98d7169cf07b84d875 Mon Sep 17 00:00:00 2001 +From: Joey Hess +Date: Mon, 10 Feb 2014 23:27:32 +0000 +Subject: [PATCH] support Android cert store + +Android puts it in a different place and has only hashed files. +See https://github.com/vincenthz/hs-certificate/issues/19 +--- + System/X509/Unix.hs | 4 ++-- + 1 file changed, 2 insertions(+), 2 deletions(-) + +diff --git a/System/X509/Unix.hs b/System/X509/Unix.hs +index cbf9bbe..cab4f4a 100644 +--- a/System/X509/Unix.hs ++++ b/System/X509/Unix.hs +@@ -34,7 +34,7 @@ import qualified Control.Exception as E + import Data.Char + + defaultSystemPath :: FilePath +-defaultSystemPath = "/etc/ssl/certs/" ++defaultSystemPath = "/system/etc/security/cacerts/" + + envPathOverride :: String + envPathOverride = "SYSTEM_CERTIFICATE_PATH" +@@ -46,7 +46,7 @@ listDirectoryCerts path = (map (path ) . filter isCert <$> getDirectoryConten + && isDigit (s !! 9) + && (s !! 8) == '.' + && all isHexDigit (take 8 s) +- isCert x = (not $ isPrefixOf "." x) && (not $ isHashedFile x) ++ isCert x = (not $ isPrefixOf "." x) + + getSystemCertificateStore :: IO CertificateStore + getSystemCertificateStore = makeCertificateStore . concat <$> (getSystemPath >>= listDirectoryCerts >>= mapM readCertificates) +-- +1.7.10.4 + diff --git a/standalone/android/install-haskell-packages b/standalone/android/install-haskell-packages index 96f9299376..19e6b5c1cc 100755 --- a/standalone/android/install-haskell-packages +++ b/standalone/android/install-haskell-packages @@ -28,7 +28,6 @@ cabalinstall () { patched () { pkg=$1 ver=$2 - shift 1 if [ -z "$ver" ]; then cabal unpack $pkg else @@ -50,7 +49,7 @@ patched () { fi fi done - cabalinstall "$@" + cabalinstall rm -rf $pkg* cd .. } @@ -73,7 +72,6 @@ install_pkgs () { patched zlib patched MissingH patched bloomfilter - patched SafeSemaphore patched distributive patched comonad patched iproute @@ -87,6 +85,7 @@ install_pkgs () { patched skein patched lens patched certificate + patched x509-system patched persistent-template patched system-filepath patched wai-app-static @@ -102,12 +101,13 @@ install_pkgs () { patched yesod patched shakespeare-text patched process-conduit - patched gnuidn - patched DAV 0.5.1 + patched DAV patched yesod-static patched uuid patched dns patched gnutls + patched libxml-sax + patched network-protocol-xmpp cd .. diff --git a/standalone/no-th/haskell-patches/DAV_build-without-TH.patch b/standalone/no-th/haskell-patches/DAV_build-without-TH.patch index ac6ba2a190..d57d79a11c 100644 --- a/standalone/no-th/haskell-patches/DAV_build-without-TH.patch +++ b/standalone/no-th/haskell-patches/DAV_build-without-TH.patch @@ -1,27 +1,22 @@ -From 67e5fc4eb21fe801f7ab4c01b98c02912c5cb43f Mon Sep 17 00:00:00 2001 -From: Joey Hess -Date: Wed, 18 Dec 2013 05:44:10 +0000 +From a908cec3ae1644d72d04ccc7657433d8335665bc Mon Sep 17 00:00:00 2001 +From: dummy +Date: Sat, 8 Feb 2014 17:11:05 +0000 Subject: [PATCH] expand TH -plus manual fixups --- - DAV.cabal | 22 +--- - Network/Protocol/HTTP/DAV.hs | 96 +++++++++++++---- - Network/Protocol/HTTP/DAV/TH.hs | 232 +++++++++++++++++++++++++++++++++++++++- - 3 files changed, 307 insertions(+), 43 deletions(-) + DAV.cabal | 24 +--- + Network/Protocol/HTTP/DAV.hs | 96 ++++++++++++---- + Network/Protocol/HTTP/DAV/TH.hs | 232 ++++++++++++++++++++++++++++++++++++++- + 3 files changed, 307 insertions(+), 45 deletions(-) diff --git a/DAV.cabal b/DAV.cabal -index 1f1eb1f..ea117ff 100644 +index 3a755bb..748b0e1 100644 --- a/DAV.cabal +++ b/DAV.cabal -@@ -36,27 +36,7 @@ library - , lifted-base >= 0.1 - , monad-control - , mtl >= 2.1 -- , transformers >= 0.3 -- , transformers-base -- , xml-conduit >= 1.0 && <= 1.2 -- , xml-hamlet >= 0.4 && <= 0.5 +@@ -42,29 +42,7 @@ library + , transformers-base + , xml-conduit >= 1.0 && <= 1.2 + , xml-hamlet >= 0.4 && <= 0.5 -executable hdav - main-is: hdav.hs - ghc-options: -Wall @@ -30,24 +25,30 @@ index 1f1eb1f..ea117ff 100644 - , bytestring - , case-insensitive >= 0.4 - , containers +- , either >= 4.1 +- , errors - , http-client >= 0.2 - , http-client-tls >= 0.2 - , http-types >= 0.7 - , lens >= 3.0 - , lifted-base >= 0.1 -- , monad-control +- , monad-control >= 0.3.2 - , mtl >= 2.1 - , network >= 2.3 -- , optparse-applicative +- , optparse-applicative >= 0.5.0 +- , transformers >= 0.3 +- , transformers-base +- , xml-conduit >= 1.0 && <= 1.2 +- , xml-hamlet >= 0.4 && <= 0.5 + , text - , transformers >= 0.3 - , transformers-base - , xml-conduit >= 1.0 && <= 1.2 + + source-repository head + type: git diff --git a/Network/Protocol/HTTP/DAV.hs b/Network/Protocol/HTTP/DAV.hs -index 9d8c070..5993fca 100644 +index 94d21bc..c48618f 100644 --- a/Network/Protocol/HTTP/DAV.hs +++ b/Network/Protocol/HTTP/DAV.hs -@@ -77,7 +77,7 @@ import Network.HTTP.Types (hContentType, Method, Status, RequestHeaders, unautho +@@ -78,7 +78,7 @@ import Network.HTTP.Types (hContentType, Method, Status, RequestHeaders, unautho import qualified Text.XML as XML import Text.XML.Cursor (($/), (&/), element, node, fromDocument, checkName) @@ -56,7 +57,7 @@ index 9d8c070..5993fca 100644 import Data.CaseInsensitive (mk) -@@ -335,28 +335,84 @@ makeCollection url username password = choke $ evalDAVT url $ do +@@ -336,28 +336,84 @@ makeCollection url username password = choke $ evalDAVT url $ do propname :: XML.Document propname = XML.Document (XML.Prologue [] Nothing []) root [] where @@ -410,5 +411,5 @@ index b072116..5a01bf9 100644 + Data.Functor.<$> (_f_a2R5 __userAgent'_a2Re)) +{-# INLINE userAgent #-} -- -1.8.5.1 +1.7.10.4 diff --git a/standalone/no-th/haskell-patches/lens_no-TH.patch b/standalone/no-th/haskell-patches/lens_no-TH.patch index ffcf0027ec..81e370146e 100644 --- a/standalone/no-th/haskell-patches/lens_no-TH.patch +++ b/standalone/no-th/haskell-patches/lens_no-TH.patch @@ -1,52 +1,58 @@ -From 2b5fa1851a84f58b43e7c4224bd5695a32a80de9 Mon Sep 17 00:00:00 2001 +From b9b3cd52735f9ede1a83960968dc1f0e91e061d6 Mon Sep 17 00:00:00 2001 From: dummy -Date: Wed, 18 Dec 2013 03:27:54 +0000 +Date: Fri, 7 Feb 2014 21:49:11 +0000 Subject: [PATCH] avoid TH --- - lens.cabal | 13 +------------ - src/Control/Lens.hs | 4 ++-- - src/Control/Lens/Internal/Exception.hs | 30 ------------------------------ - src/Control/Lens/Prism.hs | 2 -- - 4 files changed, 3 insertions(+), 46 deletions(-) + lens.cabal | 14 +------------- + src/Control/Lens.hs | 6 ++---- + src/Control/Lens/Cons.hs | 2 -- + src/Control/Lens/Internal/Fold.hs | 2 -- + src/Control/Lens/Internal/Reflection.hs | 2 -- + src/Control/Lens/Prism.hs | 2 -- + src/Control/Monad/Primitive/Lens.hs | 1 - + 7 files changed, 3 insertions(+), 26 deletions(-) diff --git a/lens.cabal b/lens.cabal -index 8477892..a6ac7a5 100644 +index cee2da7..1e467c4 100644 --- a/lens.cabal +++ b/lens.cabal @@ -10,7 +10,7 @@ stability: provisional homepage: http://github.com/ekmett/lens/ bug-reports: http://github.com/ekmett/lens/issues - copyright: Copyright (C) 2012-2013 Edward A. Kmett + copyright: Copyright (C) 2012-2014 Edward A. Kmett -build-type: Custom +build-type: Simple + -- build-tools: cpphs tested-with: GHC == 7.6.3 synopsis: Lenses, Folds and Traversals - description: -@@ -173,7 +173,6 @@ library - containers >= 0.4.0 && < 0.6, - distributive >= 0.3 && < 1, - filepath >= 1.2.0.0 && < 1.4, -- generic-deriving >= 1.4 && < 1.7, - ghc-prim, - hashable >= 1.1.2.3 && < 1.3, - MonadCatchIO-transformers >= 0.3 && < 0.4, -@@ -235,14 +234,12 @@ library +@@ -216,7 +216,6 @@ library + Control.Exception.Lens + Control.Lens + Control.Lens.Action +- Control.Lens.At + Control.Lens.Combinators + Control.Lens.Cons + Control.Lens.Each +@@ -256,17 +255,14 @@ library + Control.Lens.Reified Control.Lens.Review Control.Lens.Setter - Control.Lens.Simple - Control.Lens.TH Control.Lens.Traversal Control.Lens.Tuple Control.Lens.Type Control.Lens.Wrapped - Control.Lens.Zipper Control.Lens.Zoom - Control.Monad.Error.Lens + Control.Monad.Primitive.Lens Control.Parallel.Strategies.Lens Control.Seq.Lens +- Data.Aeson.Lens Data.Array.Lens -@@ -266,12 +263,8 @@ library + Data.Bits.Lens + Data.ByteString.Lens +@@ -289,12 +285,8 @@ library Data.Typeable.Lens Data.Vector.Lens Data.Vector.Generic.Lens @@ -58,8 +64,8 @@ index 8477892..a6ac7a5 100644 - Language.Haskell.TH.Lens Numeric.Lens - if flag(safe) -@@ -370,7 +363,6 @@ test-suite doctests + other-modules: +@@ -394,7 +386,6 @@ test-suite doctests deepseq, doctest >= 0.9.1, filepath, @@ -67,7 +73,7 @@ index 8477892..a6ac7a5 100644 mtl, nats, parallel, -@@ -396,7 +388,6 @@ benchmark plated +@@ -432,7 +423,6 @@ benchmark plated comonad, criterion, deepseq, @@ -75,7 +81,7 @@ index 8477892..a6ac7a5 100644 lens, transformers -@@ -431,7 +422,6 @@ benchmark unsafe +@@ -467,7 +457,6 @@ benchmark unsafe comonads-fd, criterion, deepseq, @@ -83,7 +89,7 @@ index 8477892..a6ac7a5 100644 lens, transformers -@@ -448,6 +438,5 @@ benchmark zipper +@@ -484,6 +473,5 @@ benchmark zipper comonads-fd, criterion, deepseq, @@ -91,77 +97,87 @@ index 8477892..a6ac7a5 100644 lens, transformers diff --git a/src/Control/Lens.hs b/src/Control/Lens.hs -index f7c6548..125153e 100644 +index 7e15267..bb4d87b 100644 --- a/src/Control/Lens.hs +++ b/src/Control/Lens.hs -@@ -59,7 +59,7 @@ module Control.Lens +@@ -41,7 +41,6 @@ + ---------------------------------------------------------------------------- + module Control.Lens + ( module Control.Lens.Action +- , module Control.Lens.At + , module Control.Lens.Cons + , module Control.Lens.Each + , module Control.Lens.Empty +@@ -58,7 +57,7 @@ module Control.Lens + , module Control.Lens.Reified , module Control.Lens.Review , module Control.Lens.Setter - , module Control.Lens.Simple -#ifndef DISABLE_TEMPLATE_HASKELL +#if 0 , module Control.Lens.TH #endif , module Control.Lens.Traversal -@@ -89,7 +89,7 @@ import Control.Lens.Reified +@@ -69,7 +68,6 @@ module Control.Lens + ) where + + import Control.Lens.Action +-import Control.Lens.At + import Control.Lens.Cons + import Control.Lens.Each + import Control.Lens.Empty +@@ -86,7 +84,7 @@ import Control.Lens.Prism + import Control.Lens.Reified import Control.Lens.Review import Control.Lens.Setter - import Control.Lens.Simple -#ifndef DISABLE_TEMPLATE_HASKELL +#if 0 import Control.Lens.TH #endif import Control.Lens.Traversal -diff --git a/src/Control/Lens/Internal/Exception.hs b/src/Control/Lens/Internal/Exception.hs -index 387203e..bb1ca10 100644 ---- a/src/Control/Lens/Internal/Exception.hs -+++ b/src/Control/Lens/Internal/Exception.hs -@@ -128,18 +128,6 @@ class Handleable e (m :: * -> *) (h :: * -> *) | h -> e m where - handler_ l = handler l . const - {-# INLINE handler_ #-} +diff --git a/src/Control/Lens/Cons.hs b/src/Control/Lens/Cons.hs +index a80e9c8..7d27b80 100644 +--- a/src/Control/Lens/Cons.hs ++++ b/src/Control/Lens/Cons.hs +@@ -55,8 +55,6 @@ import Data.Vector.Unboxed (Unbox) + import qualified Data.Vector.Unboxed as Unbox + import Data.Word --instance Handleable SomeException IO Exception.Handler where -- handler = handlerIO +-{-# ANN module "HLint: ignore Eta reduce" #-} - --instance Handleable SomeException m (CatchIO.Handler m) where -- handler = handlerCatchIO -- --handlerIO :: forall a r. Getting (First a) SomeException a -> (a -> IO r) -> Exception.Handler r --handlerIO l f = reify (preview l) $ \ (_ :: Proxy s) -> Exception.Handler (\(Handling a :: Handling a s IO) -> f a) -- --handlerCatchIO :: forall m a r. Getting (First a) SomeException a -> (a -> m r) -> CatchIO.Handler m r --handlerCatchIO l f = reify (preview l) $ \ (_ :: Proxy s) -> CatchIO.Handler (\(Handling a :: Handling a s m) -> f a) + -- $setup + -- >>> :set -XNoOverloadedStrings + -- >>> import Control.Lens +diff --git a/src/Control/Lens/Internal/Fold.hs b/src/Control/Lens/Internal/Fold.hs +index 00e4b66..03c9cd2 100644 +--- a/src/Control/Lens/Internal/Fold.hs ++++ b/src/Control/Lens/Internal/Fold.hs +@@ -37,8 +37,6 @@ import Data.Maybe + import Data.Semigroup hiding (Min, getMin, Max, getMax) + import Data.Reflection + +-{-# ANN module "HLint: ignore Avoid lambda" #-} - ------------------------------------------------------------------------------ - -- Helpers + -- Folding ------------------------------------------------------------------------------ -@@ -159,21 +147,3 @@ supply = unsafePerformIO $ newIORef 0 - -- | This permits the construction of an \"impossible\" 'Control.Exception.Handler' that matches only if some function does. - newtype Handling a s (m :: * -> *) = Handling a +diff --git a/src/Control/Lens/Internal/Reflection.hs b/src/Control/Lens/Internal/Reflection.hs +index bf09f2c..c9e112f 100644 +--- a/src/Control/Lens/Internal/Reflection.hs ++++ b/src/Control/Lens/Internal/Reflection.hs +@@ -64,8 +64,6 @@ import Data.Word + import Data.Typeable + import Data.Reflection ---- the m parameter exists simply to break the Typeable1 pattern, so we can provide this without overlap. ---- here we simply generate a fresh TypeRep so we'll fail to compare as equal to any other TypeRep. --instance Typeable (Handling a s m) where -- typeOf _ = unsafePerformIO $ do -- i <- atomicModifyIORef supply $ \a -> let a' = a + 1 in a' `seq` (a', a) -- return $ mkTyConApp (mkTyCon3 "lens" "Control.Lens.Internal.Exception" ("Handling" ++ show i)) [] -- {-# INLINE typeOf #-} +-{-# ANN module "HLint: ignore Avoid lambda" #-} - ---- The @Handling@ wrapper is uninteresting, and should never be thrown, so you won't get much benefit here. --instance Show (Handling a s m) where -- showsPrec d _ = showParen (d > 10) $ showString "Handling ..." -- {-# INLINE showsPrec #-} -- --instance Reifies s (SomeException -> Maybe a) => Exception (Handling a s m) where -- toException _ = SomeException HandlingException -- {-# INLINE toException #-} -- fromException = fmap Handling . reflect (Proxy :: Proxy s) -- {-# INLINE fromException #-} + class Typeable s => B s where + reflectByte :: proxy s -> IntPtr + diff --git a/src/Control/Lens/Prism.hs b/src/Control/Lens/Prism.hs -index 45b5cfe..88c7ff9 100644 +index 9e0bec7..0cf6737 100644 --- a/src/Control/Lens/Prism.hs +++ b/src/Control/Lens/Prism.hs -@@ -53,8 +53,6 @@ import Unsafe.Coerce +@@ -59,8 +59,6 @@ import Unsafe.Coerce import Data.Profunctor.Unsafe #endif @@ -170,6 +186,18 @@ index 45b5cfe..88c7ff9 100644 -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens +diff --git a/src/Control/Monad/Primitive/Lens.hs b/src/Control/Monad/Primitive/Lens.hs +index ee942c6..2f37134 100644 +--- a/src/Control/Monad/Primitive/Lens.hs ++++ b/src/Control/Monad/Primitive/Lens.hs +@@ -20,7 +20,6 @@ import Control.Lens + import Control.Monad.Primitive (PrimMonad(..)) + import GHC.Prim (State#) + +-{-# ANN module "HLint: ignore Unused LANGUAGE pragma" #-} + + prim :: (PrimMonad m) => Iso' (m a) (State# (PrimState m) -> (# State# (PrimState m), a #)) + prim = iso internal primitive -- -1.8.5.1 +1.7.10.4 diff --git a/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch b/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch index d5596395a1..adf0679ead 100644 --- a/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch +++ b/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch @@ -1,17 +1,17 @@ -From 08cc43788c16fb91f63bc0bd520eeccdcdab477a Mon Sep 17 00:00:00 2001 +From 5f30a68faaa379ac3fe9f0b016dd1a20969d548f Mon Sep 17 00:00:00 2001 From: dummy -Date: Tue, 17 Dec 2013 17:15:33 +0000 +Date: Fri, 7 Feb 2014 23:04:06 +0000 Subject: [PATCH] remove and expand TH --- - Yesod/Core.hs | 30 +++--- - Yesod/Core/Class/Yesod.hs | 249 +++++++++++++++++++++++++++++++-------------- - Yesod/Core/Dispatch.hs | 27 ++--- - Yesod/Core/Handler.hs | 25 ++--- - Yesod/Core/Internal/Run.hs | 4 +- - Yesod/Core/Internal/TH.hs | 111 -------------------- - Yesod/Core/Widget.hs | 32 +----- - 7 files changed, 209 insertions(+), 269 deletions(-) + Yesod/Core.hs | 30 +++--- + Yesod/Core/Class/Yesod.hs | 248 ++++++++++++++++++++++++++++++-------------- + Yesod/Core/Dispatch.hs | 37 ++----- + Yesod/Core/Handler.hs | 25 ++--- + Yesod/Core/Internal/Run.hs | 4 +- + Yesod/Core/Internal/TH.hs | 111 -------------------- + Yesod/Core/Widget.hs | 32 +----- + 7 files changed, 209 insertions(+), 278 deletions(-) diff --git a/Yesod/Core.hs b/Yesod/Core.hs index 12e59d5..2817a69 100644 @@ -67,7 +67,7 @@ index 12e59d5..2817a69 100644 , renderCssUrl ) where diff --git a/Yesod/Core/Class/Yesod.hs b/Yesod/Core/Class/Yesod.hs -index a64d6eb..5dffbfa 100644 +index 140600b..6c718e2 100644 --- a/Yesod/Core/Class/Yesod.hs +++ b/Yesod/Core/Class/Yesod.hs @@ -5,11 +5,15 @@ @@ -127,7 +127,7 @@ index a64d6eb..5dffbfa 100644 -- | Override the rendering function for a particular URL. One use case for -- this is to offload static hosting to a different domain name to avoid -@@ -370,45 +383,103 @@ widgetToPageContent w = do +@@ -374,45 +387,103 @@ widgetToPageContent w = do -- modernizr should be at the end of the http://www.modernizr.com/docs/#installing -- the asynchronous loader means your page doesn't have to wait for all the js to load let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc @@ -270,7 +270,7 @@ index a64d6eb..5dffbfa 100644 return $ PageContent title headAll $ case jsLoader master of -@@ -438,10 +509,13 @@ defaultErrorHandler NotFound = selectRep $ do +@@ -442,10 +513,13 @@ defaultErrorHandler NotFound = selectRep $ do r <- waiRequest let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r setTitle "Not Found" @@ -288,7 +288,7 @@ index a64d6eb..5dffbfa 100644 provideRep $ return $ object ["message" .= ("Not Found" :: Text)] -- For API requests. -@@ -451,10 +525,11 @@ defaultErrorHandler NotFound = selectRep $ do +@@ -455,10 +529,11 @@ defaultErrorHandler NotFound = selectRep $ do defaultErrorHandler NotAuthenticated = selectRep $ do provideRep $ defaultLayout $ do setTitle "Not logged in" @@ -304,7 +304,7 @@ index a64d6eb..5dffbfa 100644 provideRep $ do -- 401 *MUST* include a WWW-Authenticate header -@@ -476,10 +551,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do +@@ -480,10 +555,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do defaultErrorHandler (PermissionDenied msg) = selectRep $ do provideRep $ defaultLayout $ do setTitle "Permission Denied" @@ -322,7 +322,7 @@ index a64d6eb..5dffbfa 100644 provideRep $ return $ object $ [ "message" .= ("Permission Denied. " <> msg) -@@ -488,30 +566,43 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do +@@ -492,30 +570,42 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do defaultErrorHandler (InvalidArgs ia) = selectRep $ do provideRep $ defaultLayout $ do setTitle "Invalid Arguments" @@ -377,15 +377,19 @@ index a64d6eb..5dffbfa 100644 + id + ((Text.Blaze.Internal.preEscapedText . T.pack) + " not supported

") } -+ - provideRep $ return $ object ["message" .= ("Bad method" :: Text), "method" .= m] + provideRep $ return $ object ["message" .= ("Bad method" :: Text), "method" .= TE.decodeUtf8With TEE.lenientDecode m] asyncHelper :: (url -> [x] -> Text) diff --git a/Yesod/Core/Dispatch.hs b/Yesod/Core/Dispatch.hs -index df822e2..5583495 100644 +index e6f489d..3ff37c1 100644 --- a/Yesod/Core/Dispatch.hs +++ b/Yesod/Core/Dispatch.hs -@@ -6,18 +6,18 @@ +@@ -1,4 +1,3 @@ +-{-# LANGUAGE TemplateHaskell #-} + {-# LANGUAGE OverloadedStrings #-} + {-# LANGUAGE TypeFamilies #-} + {-# LANGUAGE FlexibleInstances #-} +@@ -6,18 +5,18 @@ {-# LANGUAGE CPP #-} module Yesod.Core.Dispatch ( -- * Quasi-quoted routing @@ -414,7 +418,7 @@ index df822e2..5583495 100644 , PathMultiPiece (..) , Texts -- * Convert to WAI -@@ -124,13 +124,6 @@ toWaiApp site = do +@@ -128,13 +127,6 @@ toWaiAppLogger logger site = do , yreSite = site , yreSessionBackend = sb } @@ -428,8 +432,31 @@ index df822e2..5583495 100644 middleware <- mkDefaultMiddlewares logger return $ middleware $ toWaiAppYre yre +@@ -163,13 +155,7 @@ warp port site = do + ] + -} + , Network.Wai.Handler.Warp.settingsOnException = const $ \e -> +- messageLoggerSource +- site +- logger +- $(qLocation >>= liftLoc) +- "yesod-core" +- LevelError +- (toLogStr $ "Exception from Warp: " ++ show e) ++ error (show e) + } + + -- | A default set of middlewares. +@@ -194,7 +180,6 @@ mkDefaultMiddlewares logger = do + -- | Deprecated synonym for 'warp'. + warpDebug :: YesodDispatch site => Int -> site -> IO () + warpDebug = warp +-{-# DEPRECATED warpDebug "Please use warp instead" #-} + + -- | Runs your application using default middlewares (i.e., via 'toWaiApp'). It + -- reads port information from the PORT environment variable, as used by tools diff --git a/Yesod/Core/Handler.hs b/Yesod/Core/Handler.hs -index 3581dbc..908256e 100644 +index 7c561c5..847d475 100644 --- a/Yesod/Core/Handler.hs +++ b/Yesod/Core/Handler.hs @@ -164,7 +164,7 @@ import Data.Text.Encoding (decodeUtf8With, encodeUtf8) @@ -449,7 +476,7 @@ index 3581dbc..908256e 100644 get :: MonadHandler m => m GHState get = liftHandlerT $ HandlerT $ I.readIORef . handlerState -@@ -743,19 +744,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url) +@@ -748,19 +749,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url) -> m a redirectToPost url = do urlText <- toTextUrl url @@ -479,10 +506,10 @@ index 3581dbc..908256e 100644 -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'. hamletToRepHtml :: MonadHandler m => HtmlUrl (Route (HandlerSite m)) -> m Html diff --git a/Yesod/Core/Internal/Run.hs b/Yesod/Core/Internal/Run.hs -index 25f51f1..d04d2cd 100644 +index 10871a2..6ed631e 100644 --- a/Yesod/Core/Internal/Run.hs +++ b/Yesod/Core/Internal/Run.hs -@@ -15,7 +15,7 @@ import Control.Exception.Lifted (catch) +@@ -16,7 +16,7 @@ import Control.Exception.Lifted (catch) import Control.Monad.IO.Class (MonadIO) import Control.Monad.IO.Class (liftIO) import Control.Monad.Logger (LogLevel (LevelError), LogSource, @@ -491,7 +518,7 @@ index 25f51f1..d04d2cd 100644 import Control.Monad.Trans.Resource (runResourceT, withInternalState, runInternalState, createInternalState, closeInternalState) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 -@@ -128,8 +128,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) +@@ -131,8 +131,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> ErrorResponse -> YesodApp safeEh log' er req = do @@ -680,5 +707,5 @@ index a972efa..156cd45 100644 ihamletToRepHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message) => HtmlUrlI18n message (Route (HandlerSite m)) -- -1.8.5.1 +1.7.10.4 diff --git a/standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch b/standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch index 0a82434ea3..18cae3a34f 100644 --- a/standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch +++ b/standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch @@ -1,19 +1,19 @@ -From fbd8f048c239e34625e438a24213534f6f68c3e8 Mon Sep 17 00:00:00 2001 +From 9f62992414f900fcafa00a838925e24c4365c50f Mon Sep 17 00:00:00 2001 From: dummy -Date: Tue, 17 Dec 2013 18:34:25 +0000 -Subject: [PATCH] spliced TH +Date: Fri, 7 Feb 2014 23:11:31 +0000 +Subject: [PATCH] splice TH --- - Yesod/Form/Fields.hs | 771 ++++++++++++++++++++++++++++++++++++------------ - Yesod/Form/Functions.hs | 239 ++++++++++++--- - Yesod/Form/Jquery.hs | 129 ++++++-- - Yesod/Form/MassInput.hs | 233 ++++++++++++--- - Yesod/Form/Nic.hs | 65 +++- - yesod-form.cabal | 1 + + Yesod/Form/Fields.hs | 771 +++++++++++++++++++++++++++++++++++------------ + Yesod/Form/Functions.hs | 239 ++++++++++++--- + Yesod/Form/Jquery.hs | 129 ++++++-- + Yesod/Form/MassInput.hs | 233 +++++++++++--- + Yesod/Form/Nic.hs | 65 +++- + yesod-form.cabal | 1 + 6 files changed, 1127 insertions(+), 311 deletions(-) diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs -index b2a47c6..016c98b 100644 +index 97d0034..016c98b 100644 --- a/Yesod/Form/Fields.hs +++ b/Yesod/Form/Fields.hs @@ -1,4 +1,3 @@ @@ -74,7 +74,7 @@ index b2a47c6..016c98b 100644 - , fieldView = \theId name attrs val isReq -> toWidget [hamlet| -$newline never -- +- -|] + , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_arOn + -> do { id @@ -103,7 +103,7 @@ index b2a47c6..016c98b 100644 - , fieldView = \theId name attrs val isReq -> toWidget [hamlet| -$newline never -- +- -|] + , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_arOz + -> do { id @@ -1789,7 +1789,7 @@ index 2862678..04ddaba 100644 } where diff --git a/yesod-form.cabal b/yesod-form.cabal -index 9e0c710..a39f71f 100644 +index 1f6e0e1..4667861 100644 --- a/yesod-form.cabal +++ b/yesod-form.cabal @@ -19,6 +19,7 @@ library @@ -1798,8 +1798,8 @@ index 9e0c710..a39f71f 100644 , shakespeare-css >= 1.0 && < 1.1 + , shakespeare , shakespeare-js >= 1.0.2 && < 1.3 - , persistent >= 1.2 && < 1.3 + , persistent >= 1.2 && < 1.4 , template-haskell -- -1.8.5.1 +1.7.10.4 diff --git a/standalone/no-th/haskell-patches/yesod_hack-TH.patch b/standalone/no-th/haskell-patches/yesod_hack-TH.patch index eedc7df158..4ee8aa5bb2 100644 --- a/standalone/no-th/haskell-patches/yesod_hack-TH.patch +++ b/standalone/no-th/haskell-patches/yesod_hack-TH.patch @@ -1,12 +1,13 @@ -From e3d1ead4f02c2c45e64a1ccad5b461cc6fdabbd2 Mon Sep 17 00:00:00 2001 +From 69398345ff1e63bcc6a23fce18e42390328b78d2 Mon Sep 17 00:00:00 2001 From: dummy Date: Tue, 17 Dec 2013 18:48:56 +0000 Subject: [PATCH] hack for TH --- - Yesod.hs | 19 ++++++++++++-- - Yesod/Default/Util.hs | 69 ++------------------------------------------------- - 2 files changed, 19 insertions(+), 69 deletions(-) + Yesod.hs | 19 ++++++++++++-- + Yesod/Default/Main.hs | 23 ----------------- + Yesod/Default/Util.hs | 69 ++----------------------------------------------- + 3 files changed, 19 insertions(+), 92 deletions(-) diff --git a/Yesod.hs b/Yesod.hs index b367144..fbe309c 100644 @@ -39,6 +40,49 @@ index b367144..fbe309c 100644 +delete = undefined +insert = undefined + +diff --git a/Yesod/Default/Main.hs b/Yesod/Default/Main.hs +index 0780539..2c73800 100644 +--- a/Yesod/Default/Main.hs ++++ b/Yesod/Default/Main.hs +@@ -1,10 +1,8 @@ + {-# LANGUAGE CPP #-} + {-# LANGUAGE DeriveDataTypeable #-} + {-# LANGUAGE OverloadedStrings #-} +-{-# LANGUAGE TemplateHaskell #-} + module Yesod.Default.Main + ( defaultMain +- , defaultMainLog + , defaultRunner + , defaultDevelApp + , LogFunc +@@ -54,27 +52,6 @@ defaultMain load getApp = do + + type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO () + +--- | Same as @defaultMain@, but gets a logging function back as well as an +--- @Application@ to install Warp exception handlers. +--- +--- Since 1.2.5 +-defaultMainLog :: (Show env, Read env) +- => IO (AppConfig env extra) +- -> (AppConfig env extra -> IO (Application, LogFunc)) +- -> IO () +-defaultMainLog load getApp = do +- config <- load +- (app, logFunc) <- getApp config +- runSettings defaultSettings +- { settingsPort = appPort config +- , settingsHost = appHost config +- , settingsOnException = const $ \e -> logFunc +- $(qLocation >>= liftLoc) +- "yesod" +- LevelError +- (toLogStr $ "Exception from Warp: " ++ show e) +- } app +- + -- | Run your application continously, listening for SIGINT and exiting + -- when received + -- diff --git a/Yesod/Default/Util.hs b/Yesod/Default/Util.hs index a10358e..0547424 100644 --- a/Yesod/Default/Util.hs @@ -136,5 +180,5 @@ index a10358e..0547424 100644 - else return $ Just ex - else return Nothing -- -1.8.5.1 +1.7.10.4 diff --git a/templates/configurators/newrepository.hamlet b/templates/configurators/newrepository.hamlet index 2c2202d0e5..5c5066a26d 100644 --- a/templates/configurators/newrepository.hamlet +++ b/templates/configurators/newrepository.hamlet @@ -7,6 +7,6 @@ Make a repository on a Removable Drive

- Where do you want to put this new repository? + Repository location:

^{form} diff --git a/templates/configurators/newrepository/combine.hamlet b/templates/configurators/newrepository/combine.hamlet index 7cdec85080..e26f05f4e6 100644 --- a/templates/configurators/newrepository/combine.hamlet +++ b/templates/configurators/newrepository/combine.hamlet @@ -2,7 +2,7 @@

Combine repositories?

- You have created a new repository at #{newrepo}. + The repository at #{newrepo} is set up.
Do you want to combine it with your existing repository at #{mainrepo}?