diff --git a/.gitattributes b/.gitattributes deleted file mode 100644 index 5d425843f2..0000000000 --- a/.gitattributes +++ /dev/null @@ -1 +0,0 @@ -debian/changelog merge=dpkg-mergechangelogs diff --git a/.gitignore b/.gitignore deleted file mode 100644 index 2210878472..0000000000 --- a/.gitignore +++ /dev/null @@ -1,31 +0,0 @@ -tags -Setup -*.hi -*.o -tmp -test -build-stamp -Build/SysConfig.hs -Build/InstallDesktopFile -Build/EvilSplicer -Build/Standalone -Build/OSXMkLibs -git-annex -git-annex.1 -git-annex-shell.1 -git-union-merge -git-union-merge.1 -git-recover-repository -git-recover-repository.1 -doc/.ikiwiki -html -*.tix -.hpc -dist -# Sandboxed builds -cabal-dev -# Project-local emacs configuration -.dir-locals.el -# OSX related -.DS_Store -.virthualenv diff --git a/Annex.hs b/Annex.hs index ae56ec5ad7..583cb0e023 100644 --- a/Annex.hs +++ b/Annex.hs @@ -5,14 +5,13 @@ - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE GeneralizedNewtypeDeriving, PackageImports #-} module Annex ( Annex, AnnexState(..), PreferredContentMap, new, - newState, run, eval, getState, @@ -41,6 +40,7 @@ import Control.Concurrent import Common import qualified Git import qualified Git.Config +import Annex.Direct.Fixup import Git.CatFile import Git.CheckAttr import Git.CheckIgnore @@ -111,10 +111,10 @@ data AnnexState = AnnexState , useragent :: Maybe String } -newState :: Git.Repo -> AnnexState -newState gitrepo = AnnexState - { repo = gitrepo - , gitconfig = extractGitConfig gitrepo +newState :: GitConfig -> Git.Repo -> AnnexState +newState c r = AnnexState + { repo = r + , gitconfig = c , backends = [] , remotes = [] , output = defaultMessageState @@ -148,7 +148,10 @@ newState gitrepo = AnnexState {- Makes an Annex state object for the specified git repo. - Ensures the config is read, if it was not already. -} new :: Git.Repo -> IO AnnexState -new = newState <$$> Git.Config.read +new r = do + r' <- Git.Config.read r + let c = extractGitConfig r' + newState c <$> if annexDirect c then fixupDirect r' else return r' {- Performs an action in the Annex monad from a starting state, - returning a new state. -} diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 8192804a6b..9838af25f3 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -29,6 +29,7 @@ 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 @@ -53,6 +54,7 @@ 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 @@ -345,15 +347,15 @@ withIndex' bootstrapping a = do #endif let g' = g { gitEnv = Just $ ("GIT_INDEX_FILE", f):e } - Annex.changeState $ \s -> s { Annex.repo = g' } - checkIndexOnce $ unlessM (liftIO $ doesFileExist f) $ do - unless bootstrapping create - liftIO $ createDirectoryIfMissing True $ takeDirectory f - unless bootstrapping $ inRepo genIndex - r <- a + r <- tryAnnex $ do + Annex.changeState $ \s -> s { Annex.repo = g' } + 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} } - - return r + 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. @@ -384,7 +386,7 @@ setIndexSha :: Git.Ref -> Annex () setIndexSha ref = do f <- fromRepo gitAnnexIndexStatus liftIO $ writeFile f $ show ref ++ "\n" - setAnnexPerm f + setAnnexFilePerm f {- Stages the journal into the index and returns an action that will - clean up the staged journal files, which should only be run once diff --git a/Annex/CatFile.hs b/Annex/CatFile.hs index 407b4ddae3..812d032c6a 100644 --- a/Annex/CatFile.hs +++ b/Annex/CatFile.hs @@ -27,6 +27,7 @@ import qualified Annex import Git.Types import Git.FilePath import Git.FileMode +import qualified Git.Ref catFile :: Git.Branch -> FilePath -> Annex L.ByteString catFile branch file = do @@ -108,9 +109,6 @@ catKeyChecked needhead ref@(Ref r) = map snd . filter (\p -> fst p == file) {- From a file in the repository back to the key. - - - - Prefixing the file with ./ makes this work even if in a subdirectory - - of a repo. - - Ideally, this should reflect the key that's staged in the index, - not the key that's committed to HEAD. Unfortunately, git cat-file @@ -134,8 +132,8 @@ catKeyChecked needhead ref@(Ref r) = catKeyFile :: FilePath -> Annex (Maybe Key) catKeyFile f = ifM (Annex.getState Annex.daemon) ( catKeyFileHEAD f - , catKeyChecked True (Ref $ ":./" ++ f) + , catKeyChecked True $ Git.Ref.fileRef f ) catKeyFileHEAD :: FilePath -> Annex (Maybe Key) -catKeyFileHEAD f = catKeyChecked False (Ref $ "HEAD:./" ++ f) +catKeyFileHEAD f = catKeyChecked False $ Git.Ref.fileFromRef Git.Ref.headRef f diff --git a/Annex/Content.hs b/Annex/Content.hs index 66ca7be18b..62f1b1ccbe 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -29,8 +29,8 @@ module Annex.Content ( preseedTmp, freezeContent, thawContent, - cleanObjectLoc, dirKeys, + withObjectLoc, ) where import System.IO.Unsafe (unsafeInterleaveIO) @@ -54,9 +54,7 @@ import Annex.Perms import Annex.Link import Annex.Content.Direct import Annex.ReplaceFile -#ifndef mingw32_HOST_OS import Annex.Exception -#endif {- Checks if a given key's content is currently present. -} inAnnex :: Key -> Annex Bool @@ -255,11 +253,9 @@ moveAnnex key src = withObjectLoc key storeobject storedirect where storeobject dest = ifM (liftIO $ doesFileExist dest) ( alreadyhave - , do - createContentDir dest + , modifyContent dest $ do liftIO $ moveFile src dest freezeContent dest - freezeContentDir dest ) storeindirect = storeobject =<< calcRepo (gitAnnexLocation key) @@ -273,7 +269,6 @@ moveAnnex key src = withObjectLoc key storeobject storedirect storedirect = storedirect' storeindirect storedirect' fallback [] = fallback storedirect' fallback (f:fs) = do - thawContentDir =<< calcRepo (gitAnnexLocation key) thawContent src v <- isAnnexLink f if Just key == v @@ -349,11 +344,11 @@ withObjectLoc key indirect direct = ifM isDirect where goindirect = indirect =<< calcRepo (gitAnnexLocation key) -cleanObjectLoc :: Key -> Annex () -cleanObjectLoc key = do +cleanObjectLoc :: Key -> Annex () -> Annex () +cleanObjectLoc key cleaner = do file <- calcRepo $ gitAnnexLocation key - unlessM crippledFileSystem $ - void $ liftIO $ catchMaybeIO $ allowWrite $ parentDir file + void $ tryAnnexIO $ thawContentDir file + cleaner liftIO $ removeparents file (3 :: Int) where removeparents _ 0 = noop @@ -369,13 +364,10 @@ cleanObjectLoc key = do removeAnnex :: Key -> Annex () removeAnnex key = withObjectLoc key remove removedirect where - remove file = do - thawContentDir file + remove file = cleanObjectLoc key $ do liftIO $ nukeFile file removeInodeCache key - cleanObjectLoc key removedirect fs = do - thawContentDir =<< calcRepo (gitAnnexLocation key) cache <- recordedInodeCache key removeInodeCache key mapM_ (resetfile cache) fs @@ -389,12 +381,10 @@ removeAnnex key = withObjectLoc key remove removedirect {- Moves a key's file out of .git/annex/objects/ -} fromAnnex :: Key -> FilePath -> Annex () -fromAnnex key dest = do +fromAnnex key dest = cleanObjectLoc key $ do file <- calcRepo $ gitAnnexLocation key - thawContentDir file thawContent file liftIO $ moveFile file dest - cleanObjectLoc key {- Moves a key out of .git/annex/objects/ into .git/annex/bad, and - returns the file it was moved to. -} @@ -404,9 +394,8 @@ moveBad key = do bad <- fromRepo gitAnnexBadDir let dest = bad takeFileName src createAnnexDirectory (parentDir dest) - thawContentDir src - liftIO $ moveFile src dest - cleanObjectLoc key + cleanObjectLoc key $ + liftIO $ moveFile src dest logStatus key InfoMissing return dest diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs index b0b8621e91..a5d71288b2 100644 --- a/Annex/Content/Direct.hs +++ b/Annex/Content/Direct.hs @@ -10,6 +10,7 @@ module Annex.Content.Direct ( associatedFilesRelative, removeAssociatedFile, removeAssociatedFileUnchecked, + removeAssociatedFiles, addAssociatedFile, goodContent, recordedInodeCache, @@ -64,8 +65,8 @@ changeAssociatedFiles key transform = do files <- associatedFilesRelative key let files' = transform files when (files /= files') $ do - createContentDir mapping - liftIO $ viaTmp write mapping $ unlines files' + modifyContent mapping $ + liftIO $ viaTmp write mapping $ unlines files' top <- fromRepo Git.repoPath return $ map (top ) files' where @@ -75,6 +76,13 @@ changeAssociatedFiles key transform = do hPutStr h content hClose h +{- Removes the list of associated files. -} +removeAssociatedFiles :: Key -> Annex () +removeAssociatedFiles key = do + mapping <- calcRepo $ gitAnnexMapping key + modifyContent mapping $ + liftIO $ nukeFile mapping + {- Removes an associated file. Returns new associatedFiles value. - Checks if this was the last copy of the object, and updates location - log. -} @@ -142,16 +150,16 @@ addInodeCache key cache = do {- Writes inode cache for a key. -} writeInodeCache :: Key -> [InodeCache] -> Annex () -writeInodeCache key caches = withInodeCacheFile key $ \f -> do - createContentDir f - liftIO $ writeFile f $ - unlines $ map showInodeCache caches +writeInodeCache key caches = withInodeCacheFile key $ \f -> + modifyContent f $ + liftIO $ writeFile f $ + unlines $ map showInodeCache caches {- Removes an inode cache. -} removeInodeCache :: Key -> Annex () -removeInodeCache key = withInodeCacheFile key $ \f -> do - createContentDir f -- also thaws directory - liftIO $ nukeFile f +removeInodeCache key = withInodeCacheFile key $ \f -> + modifyContent f $ + liftIO $ nukeFile f withInodeCacheFile :: Key -> (FilePath -> Annex a) -> Annex a withInodeCacheFile key a = a =<< calcRepo (gitAnnexInodeCache key) diff --git a/Annex/Direct.hs b/Annex/Direct.hs index ea2b577b9d..3fa5f93622 100644 --- a/Annex/Direct.hs +++ b/Annex/Direct.hs @@ -8,13 +8,18 @@ module Annex.Direct where import Common.Annex +import qualified Annex import qualified Git import qualified Git.LsFiles import qualified Git.Merge import qualified Git.DiffTree as DiffTree +import qualified Git.Config +import qualified Git.Ref +import qualified Git.Branch import Git.Sha import Git.FilePath import Git.Types +import Config import Annex.CatFile import qualified Annex.Queue import Logs.Location @@ -133,28 +138,33 @@ mergeDirect d branch g = do - and the commit sha passed in, along with the old sha of the tree - before the merge. Uses git diff-tree to find files that changed between - the two shas, and applies those changes to the work tree. + - + - There are really only two types of changes: An old item can be deleted, + - or a new item added. Two passes are made, first deleting and then + - adding. This is to handle cases where eg, a file is deleted and a + - directory is added. The diff-tree output may list these in the opposite + - order, but we cannot really add the directory until the file with the + - same name is remvoed. -} mergeDirectCleanup :: FilePath -> Git.Ref -> Git.Ref -> Annex () mergeDirectCleanup d oldsha newsha = do (items, cleanup) <- inRepo $ DiffTree.diffTreeRecursive oldsha newsha makeabs <- flip fromTopFilePath <$> gitRepo - forM_ items (updated makeabs) + let fsitems = zip (map (makeabs . DiffTree.file) items) items + forM_ fsitems $ + go DiffTree.srcsha DiffTree.srcmode moveout moveout_raw + forM_ fsitems $ + go DiffTree.dstsha DiffTree.dstmode movein movein_raw void $ liftIO cleanup liftIO $ removeDirectoryRecursive d where - updated makeabs item = do - let f = makeabs (DiffTree.file item) - void $ tryAnnex $ - go f DiffTree.srcsha DiffTree.srcmode moveout moveout_raw - void $ tryAnnex $ - go f DiffTree.dstsha DiffTree.dstmode movein movein_raw - where - go f getsha getmode a araw - | getsha item == nullSha = noop - | otherwise = maybe (araw f) (\k -> void $ a k f) - =<< catKey (getsha item) (getmode item) + go getsha getmode a araw (f, item) + | getsha item == nullSha = noop + | otherwise = void $ + tryAnnex . maybe (araw f) (\k -> void $ a k f) + =<< catKey (getsha item) (getmode item) - moveout = removeDirect + moveout k f = removeDirect k f {- Files deleted by the merge are removed from the work tree. - Empty work tree directories are removed, per git behavior. -} @@ -200,11 +210,11 @@ toDirectGen k f = do where fromindirect loc = do {- Move content from annex to direct file. -} - thawContentDir loc updateInodeCache k loc void $ addAssociatedFile k f - thawContent loc - replaceFile f $ liftIO . moveFile loc + modifyContent loc $ do + thawContent loc + replaceFile f $ liftIO . moveFile loc fromdirect loc = do replaceFile f $ liftIO . void . copyFileExternal loc @@ -231,3 +241,66 @@ changedDirect oldk f = do locs <- removeAssociatedFile oldk f whenM (pure (null locs) <&&> not <$> inAnnex oldk) $ logStatus oldk InfoMissing + +{- Enable/disable direct mode. -} +setDirect :: Bool -> Annex () +setDirect wantdirect = do + if wantdirect + then do + switchHEAD + setbare + else do + setbare + switchHEADBack + setConfig (annexConfig "direct") val + Annex.changeGitConfig $ \c -> c { annexDirect = wantdirect } + where + val = Git.Config.boolConfig wantdirect + setbare = setConfig (ConfigKey Git.Config.coreBare) val + +{- Since direct mode sets core.bare=true, incoming pushes could change + - the currently checked out branch. To avoid this problem, HEAD + - is changed to a internal ref that nothing is going to push to. + - + - For refs/heads/master, use refs/heads/annex/direct/master; + - this way things that show HEAD (eg shell prompts) will + - hopefully show just "master". -} +directBranch :: Ref -> Ref +directBranch orighead = case split "/" $ show 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) + +{- Converts a directBranch back to the original branch. + - + - Any other ref is left unchanged. + -} +fromDirectBranch :: Ref -> Ref +fromDirectBranch directhead = case split "/" $ show directhead of + ("refs":"heads":"annex":"direct":rest) -> + Ref $ "refs/heads/" ++ intercalate "/" rest + _ -> directhead + +switchHEAD :: Annex () +switchHEAD = maybe noop switch =<< inRepo Git.Branch.currentUnsafe + where + switch orighead = do + let newhead = directBranch orighead + maybe noop (inRepo . Git.Branch.update newhead) + =<< inRepo (Git.Ref.sha orighead) + inRepo $ Git.Branch.checkout newhead + +switchHEADBack :: Annex () +switchHEADBack = maybe noop switch =<< inRepo Git.Branch.currentUnsafe + where + switch currhead = do + let orighead = fromDirectBranch currhead + v <- inRepo $ Git.Ref.sha currhead + case v of + Just headsha + | orighead /= currhead -> do + inRepo $ Git.Branch.update orighead headsha + inRepo $ Git.Branch.checkout orighead + inRepo $ Git.Branch.delete currhead + _ -> inRepo $ Git.Branch.checkout orighead diff --git a/Annex/Direct/Fixup.hs b/Annex/Direct/Fixup.hs new file mode 100644 index 0000000000..13485242ae --- /dev/null +++ b/Annex/Direct/Fixup.hs @@ -0,0 +1,31 @@ +{- git-annex direct mode guard fixup + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Annex.Direct.Fixup where + +import Git.Types +import Git.Config +import qualified Git.Construct as Construct +import Utility.Path +import Utility.SafeCommand + +{- Direct mode repos have core.bare=true, but are not really bare. + - Fix up the Repo to be a non-bare repo, and arrange for git commands + - run by git-annex to be passed parameters that override this setting. -} +fixupDirect :: Repo -> IO Repo +fixupDirect r@(Repo { location = l@(Local { gitdir = d, worktree = Nothing }) }) = do + let r' = r + { location = l { worktree = Just (parentDir d) } + , gitGlobalOpts = gitGlobalOpts r ++ + [ Param "-c" + , Param $ coreBare ++ "=" ++ boolConfig False + ] + } + -- Recalc now that the worktree is correct. + rs' <- Construct.fromRemotes r' + return $ r' { remotes = rs' } +fixupDirect r = return r diff --git a/Annex/Exception.hs b/Annex/Exception.hs index aaa6811a53..91347583e4 100644 --- a/Annex/Exception.hs +++ b/Annex/Exception.hs @@ -10,6 +10,8 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE PackageImports #-} + module Annex.Exception ( bracketIO, tryAnnex, diff --git a/Annex/Hook.hs b/Annex/Hook.hs new file mode 100644 index 0000000000..7301a09584 --- /dev/null +++ b/Annex/Hook.hs @@ -0,0 +1,42 @@ +{- git-annex git hooks + - + - Note that it's important that the scripts not change, otherwise + - removing old hooks using an old version of the script would fail. + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Annex.Hook where + +import Common.Annex +import qualified Git.Hook as Git +import Utility.Shell +import Config + +preCommitHook :: Git.Hook +preCommitHook = Git.Hook "pre-commit" (mkHookScript "git annex pre-commit .") + +mkHookScript :: String -> String +mkHookScript s = unlines + [ shebang_local + , "# automatically configured by git-annex" + , s + ] + +hookWrite :: Git.Hook -> Annex () +hookWrite h = + -- cannot have git hooks in a crippled filesystem (no execute bit) + unlessM crippledFileSystem $ + unlessM (inRepo $ Git.hookWrite h) $ + hookWarning h "already exists, not configuring" + +hookUnWrite :: Git.Hook -> Annex () +hookUnWrite h = unlessM (inRepo $ Git.hookUnWrite h) $ + hookWarning h "contents modified; not deleting. Edit it to remove call to git annex." + +hookWarning :: Git.Hook -> String -> Annex () +hookWarning h msg = do + r <- gitRepo + warning $ Git.hookName h ++ " hook (" ++ Git.hookFile h r ++ ") " ++ msg diff --git a/Annex/Path.hs b/Annex/Path.hs new file mode 100644 index 0000000000..a8c4907b23 --- /dev/null +++ b/Annex/Path.hs @@ -0,0 +1,34 @@ +{- git-annex program path + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Annex.Path where + +import Common +import Config.Files +import System.Environment + +{- A fully qualified path to the currently running git-annex program. + - + - getExecutablePath is available since ghc 7.4.2. On OSs it supports + - well, it returns the complete path to the program. But, on other OSs, + - it might return just the basename. + -} +programPath :: IO (Maybe FilePath) +programPath = do +#if MIN_VERSION_base(4,6,0) + exe <- getExecutablePath + p <- if isAbsolute exe + then return exe + else readProgramFile +#else + p <- readProgramFile +#endif + -- In case readProgramFile returned just the command name, + -- fall back to finding it in PATH. + searchPath p diff --git a/Annex/Perms.hs b/Annex/Perms.hs index f5925b741a..e3a2fa65a2 100644 --- a/Annex/Perms.hs +++ b/Annex/Perms.hs @@ -6,19 +6,22 @@ -} module Annex.Perms ( - setAnnexPerm, + setAnnexFilePerm, + setAnnexDirPerm, annexFileMode, createAnnexDirectory, noUmask, createContentDir, freezeContentDir, thawContentDir, + modifyContent, ) where import Common.Annex import Utility.FileMode import Git.SharedRepository import qualified Annex +import Annex.Exception import Config import System.Posix.Types @@ -31,17 +34,27 @@ withShared a = maybe startup a =<< Annex.getState Annex.shared Annex.changeState $ \s -> s { Annex.shared = Just shared } a shared +setAnnexFilePerm :: FilePath -> Annex () +setAnnexFilePerm = setAnnexPerm False + +setAnnexDirPerm :: FilePath -> Annex () +setAnnexDirPerm = setAnnexPerm True + {- Sets appropriate file mode for a file or directory in the annex, - other than the content files and content directory. Normally, - use the default mode, but with core.sharedRepository set, - allow the group to write, etc. -} -setAnnexPerm :: FilePath -> Annex () -setAnnexPerm file = unlessM crippledFileSystem $ +setAnnexPerm :: Bool -> FilePath -> Annex () +setAnnexPerm isdir file = unlessM crippledFileSystem $ withShared $ liftIO . go where - go GroupShared = groupWriteRead file + go GroupShared = modifyFileMode file $ addModes $ + groupSharedModes ++ + if isdir then [ ownerExecuteMode, groupExecuteMode ] else [] go AllShared = modifyFileMode file $ addModes $ - [ ownerWriteMode, groupWriteMode ] ++ readModes + readModes ++ + [ ownerWriteMode, groupWriteMode ] ++ + if isdir then executeModes else [] go _ = noop {- Gets the appropriate mode to use for creating a file in the annex @@ -52,10 +65,7 @@ annexFileMode = withShared $ return . go go GroupShared = sharedmode go AllShared = combineModes (sharedmode:readModes) go _ = stdFileMode - sharedmode = combineModes - [ ownerWriteMode, groupWriteMode - , ownerReadMode, groupReadMode - ] + sharedmode = combineModes groupSharedModes {- Creates a directory inside the gitAnnexDir, including any parent - directories. Makes directories with appropriate permissions. -} @@ -72,7 +82,7 @@ createAnnexDirectory dir = traverse dir [] =<< top where done = forM_ below $ \p -> do liftIO $ createDirectoryIfMissing True p - setAnnexPerm p + setAnnexDirPerm p {- Blocks writing to the directory an annexed file is in, to prevent the - file accidentially being deleted. However, if core.sharedRepository @@ -103,3 +113,13 @@ createContentDir dest = do liftIO $ allowWrite dir where dir = parentDir dest + +{- Creates the content directory for a file if it doesn't already exist, + - or thaws it if it does, then runs an action to modify the file, and + - finally, freezes the content directory. -} +modifyContent :: FilePath -> Annex a -> Annex a +modifyContent f a = do + createContentDir f -- also thaws it + v <- tryAnnex a + freezeContentDir f + either throwAnnex return v diff --git a/Annex/Version.hs b/Annex/Version.hs index 05b3f02273..2b4a49fd2d 100644 --- a/Annex/Version.hs +++ b/Annex/Version.hs @@ -19,18 +19,21 @@ defaultVersion :: Version defaultVersion = "3" directModeVersion :: Version -directModeVersion = "4" +directModeVersion = "5" supportedVersions :: [Version] supportedVersions = [defaultVersion, directModeVersion] upgradableVersions :: [Version] #ifndef mingw32_HOST_OS -upgradableVersions = ["0", "1", "2"] +upgradableVersions = ["0", "1", "2", "4"] #else -upgradableVersions = ["2"] +upgradableVersions = ["2", "4"] #endif +autoUpgradeableVersions :: [Version] +autoUpgradeableVersions = ["4"] + versionField :: ConfigKey versionField = annexConfig "version" @@ -42,12 +45,3 @@ setVersion = setConfig versionField removeVersion :: Annex () removeVersion = unsetConfig versionField - -checkVersion :: Version -> Annex () -checkVersion v - | v `elem` supportedVersions = noop - | v `elem` upgradableVersions = err "Upgrade this repository: git-annex upgrade" - | otherwise = err "Upgrade git-annex." - where - err msg = error $ "Repository version " ++ v ++ - " is not supported. " ++ msg diff --git a/Assistant.hs b/Assistant.hs index 781089e060..d4786f99ad 100644 --- a/Assistant.hs +++ b/Assistant.hs @@ -28,6 +28,8 @@ import Assistant.Threads.ProblemFixer import Assistant.Threads.MountWatcher #endif import Assistant.Threads.NetWatcher +import Assistant.Threads.Upgrader +import Assistant.Threads.UpgradeWatcher import Assistant.Threads.TransferScanner import Assistant.Threads.TransferPoller import Assistant.Threads.ConfigMonitor @@ -50,6 +52,7 @@ import qualified Utility.Daemon import Utility.LogFile import Utility.ThreadScheduler import Utility.HumanTime +import Annex.Perms import qualified Build.SysConfig as SysConfig import System.Log.Logger @@ -63,11 +66,13 @@ stopDaemon = liftIO . Utility.Daemon.stopDaemon =<< fromRepo gitAnnexPidFile - - startbrowser is passed the url and html shim file, as well as the original - stdout and stderr descriptors. -} -startDaemon :: Bool -> Bool -> Maybe Duration -> Maybe HostName -> Maybe (Maybe Handle -> Maybe Handle -> String -> FilePath -> IO ()) -> Annex () -startDaemon assistant foreground startdelay listenhost startbrowser = do +startDaemon :: Bool -> Bool -> Maybe Duration -> Maybe String -> Maybe HostName -> Maybe (Maybe Handle -> Maybe Handle -> String -> FilePath -> IO ()) -> Annex () +startDaemon assistant foreground startdelay cannotrun listenhost startbrowser = do Annex.changeState $ \s -> s { Annex.daemon = True } pidfile <- fromRepo gitAnnexPidFile logfile <- fromRepo gitAnnexLogFile +#ifndef mingw32_HOST_OS + createAnnexDirectory (parentDir logfile) logfd <- liftIO $ openLog logfile if foreground then do @@ -86,6 +91,13 @@ startDaemon assistant foreground startdelay listenhost startbrowser = do Just a -> Just $ a origout origerr else start (Utility.Daemon.daemonize logfd (Just pidfile) False) Nothing +#else + -- Windows is always foreground, and has no log file. + start id $ + case startbrowser of + Nothing -> Nothing + Just a -> Just $ a Nothing Nothing +#endif where desc | assistant = "assistant" @@ -99,7 +111,6 @@ startDaemon assistant foreground startdelay listenhost startbrowser = do flip runAssistant (go webappwaiter) =<< newAssistantData st dstatus - #ifdef WITH_WEBAPP go webappwaiter = do d <- getAssistant id @@ -108,44 +119,53 @@ startDaemon assistant foreground startdelay listenhost startbrowser = do #endif notice ["starting", desc, "version", SysConfig.packageversion] urlrenderer <- liftIO newUrlRenderer - mapM_ (startthread urlrenderer) - [ watch $ commitThread #ifdef WITH_WEBAPP - , assist $ webAppThread d urlrenderer False listenhost Nothing webappwaiter + let webappthread = [ assist $ webAppThread d urlrenderer False cannotrun listenhost Nothing webappwaiter ] +#else + let webappthread = [] +#endif + let threads = if isJust cannotrun + then webappthread + else webappthread ++ + [ watch $ commitThread +#ifdef WITH_WEBAPP #ifdef WITH_PAIRING - , assist $ pairListenerThread urlrenderer + , assist $ pairListenerThread urlrenderer #endif #ifdef WITH_XMPP - , assist $ xmppClientThread urlrenderer - , assist $ xmppSendPackThread urlrenderer - , assist $ xmppReceivePackThread urlrenderer + , assist $ xmppClientThread urlrenderer + , assist $ xmppSendPackThread urlrenderer + , assist $ xmppReceivePackThread urlrenderer #endif #endif - , assist $ pushThread - , assist $ pushRetryThread - , assist $ mergeThread - , assist $ transferWatcherThread - , assist $ transferPollerThread - , assist $ transfererThread - , assist $ daemonStatusThread - , assist $ sanityCheckerDailyThread - , assist $ sanityCheckerHourlyThread - , assist $ problemFixerThread urlrenderer + , assist $ pushThread + , assist $ pushRetryThread + , assist $ mergeThread + , assist $ transferWatcherThread + , assist $ transferPollerThread + , assist $ transfererThread + , assist $ daemonStatusThread + , assist $ sanityCheckerDailyThread + , assist $ sanityCheckerHourlyThread + , assist $ problemFixerThread urlrenderer #ifdef WITH_CLIBS - , assist $ mountWatcherThread urlrenderer + , assist $ mountWatcherThread urlrenderer #endif - , assist $ netWatcherThread - , assist $ netWatcherFallbackThread - , assist $ transferScannerThread urlrenderer - , assist $ cronnerThread urlrenderer - , assist $ configMonitorThread - , assist $ glacierThread - , watch $ watchThread - -- must come last so that all threads that wait - -- on it have already started waiting - , watch $ sanityCheckerStartupThread startdelay - ] + , assist $ netWatcherThread + , assist $ upgraderThread urlrenderer + , assist $ upgradeWatcherThread urlrenderer + , assist $ netWatcherFallbackThread + , assist $ transferScannerThread urlrenderer + , assist $ cronnerThread urlrenderer + , assist $ configMonitorThread + , assist $ glacierThread + , watch $ watchThread + -- must come last so that all threads that wait + -- on it have already started waiting + , watch $ sanityCheckerStartupThread startdelay + ] + mapM_ (startthread urlrenderer) threads liftIO waitForTermination watch a = (True, a) diff --git a/Assistant/Alert.hs b/Assistant/Alert.hs index b10a724ed9..c767d429d9 100644 --- a/Assistant/Alert.hs +++ b/Assistant/Alert.hs @@ -15,6 +15,7 @@ import Assistant.Alert.Utility import qualified Remote import Utility.Tense import Logs.Transfer +import Types.Distribution import Data.String import qualified Data.Text as T @@ -42,6 +43,7 @@ mkAlertButton autoclose label urlrenderer route = do { buttonLabel = label , buttonUrl = url , buttonAction = if autoclose then Just close else Nothing + , buttonPrimary = True } #endif @@ -61,7 +63,7 @@ baseActivityAlert = Alert , alertIcon = Just ActivityIcon , alertCombiner = Nothing , alertName = Nothing - , alertButton = Nothing + , alertButtons = [] } warningAlert :: String -> String -> Alert @@ -77,11 +79,11 @@ warningAlert name msg = Alert , alertIcon = Just ErrorIcon , alertCombiner = Just $ dataCombiner $ \_old new -> new , alertName = Just $ WarningAlert name - , alertButton = Nothing + , alertButtons = [] } -errorAlert :: String -> AlertButton -> Alert -errorAlert msg button = Alert +errorAlert :: String -> [AlertButton] -> Alert +errorAlert msg buttons = Alert { alertClass = Error , alertHeader = Nothing , alertMessageRender = renderData @@ -93,7 +95,7 @@ errorAlert msg button = Alert , alertIcon = Just ErrorIcon , alertCombiner = Nothing , alertName = Nothing - , alertButton = Just button + , alertButtons = buttons } activityAlert :: Maybe TenseText -> [TenseChunk] -> Alert @@ -160,7 +162,7 @@ sanityCheckFixAlert msg = Alert , alertIcon = Just ErrorIcon , alertName = Just SanityCheckFixAlert , alertCombiner = Just $ dataCombiner (++) - , alertButton = Nothing + , alertButtons = [] } where render alert = tenseWords $ alerthead : alertData alert ++ [alertfoot] @@ -172,7 +174,7 @@ fsckingAlert button mr = baseActivityAlert { alertData = case mr of Nothing -> [ UnTensed $ T.pack $ "Consistency check in progress" ] Just r -> [ UnTensed $ T.pack $ "Consistency check of " ++ Remote.name r ++ " in progress"] - , alertButton = Just button + , alertButtons = [button] } showFscking :: UrlRenderer -> Maybe Remote -> IO (Either E.SomeException a) -> Assistant a @@ -192,7 +194,7 @@ notFsckedNudge urlrenderer mr = do button <- mkAlertButton True (T.pack "Configure") urlrenderer ConfigFsckR void $ addAlert (notFsckedAlert mr button) #else -notFsckedNudge _ = noop +notFsckedNudge _ _ = noop #endif notFsckedAlert :: Maybe Remote -> AlertButton -> Alert @@ -204,7 +206,7 @@ notFsckedAlert mr button = Alert ] , alertIcon = Just InfoIcon , alertPriority = High - , alertButton = Just button + , alertButtons = [button] , alertClosable = True , alertClass = Message , alertMessageRender = renderData @@ -215,7 +217,50 @@ notFsckedAlert mr button = Alert , alertData = [] } -brokenRepositoryAlert :: AlertButton -> Alert +baseUpgradeAlert :: [AlertButton] -> TenseText -> Alert +baseUpgradeAlert buttons message = Alert + { alertHeader = Just message + , alertIcon = Just UpgradeIcon + , alertPriority = High + , alertButtons = buttons + , alertClosable = True + , alertClass = Message + , alertMessageRender = renderData + , alertCounter = 0 + , alertBlockDisplay = True + , alertName = Just UpgradeAlert + , alertCombiner = Just $ fullCombiner $ \new _old -> new + , alertData = [] + } + +canUpgradeAlert :: AlertPriority -> GitAnnexVersion -> AlertButton -> Alert +canUpgradeAlert priority version button = + (baseUpgradeAlert [button] $ fromString msg) + { alertPriority = priority + , alertData = [fromString $ " (version " ++ version ++ ")"] + } + where + msg = if priority >= High + then "An important upgrade of git-annex is available!" + else "An upgrade of git-annex is available." + +upgradeReadyAlert :: AlertButton -> Alert +upgradeReadyAlert button = baseUpgradeAlert [button] $ + fromString "A new version of git-annex has been installed." + +upgradingAlert :: Alert +upgradingAlert = activityAlert Nothing [ fromString "Upgrading git-annex" ] + +upgradeFinishedAlert :: Maybe AlertButton -> GitAnnexVersion -> Alert +upgradeFinishedAlert button version = + baseUpgradeAlert (maybe [] (:[]) button) $ fromString $ + "Finished upgrading git-annex to version " ++ version + +upgradeFailedAlert :: String -> Alert +upgradeFailedAlert msg = (errorAlert msg []) + { alertHeader = Just $ fromString "Upgrade failed." } + +brokenRepositoryAlert :: [AlertButton] -> Alert brokenRepositoryAlert = errorAlert "Serious problems have been detected with your repository. This needs your immediate attention!" repairingAlert :: String -> Alert @@ -228,7 +273,7 @@ pairingAlert :: AlertButton -> Alert pairingAlert button = baseActivityAlert { alertData = [ UnTensed "Pairing in progress" ] , alertPriority = High - , alertButton = Just button + , alertButtons = [button] } pairRequestReceivedAlert :: String -> AlertButton -> Alert @@ -244,7 +289,7 @@ pairRequestReceivedAlert who button = Alert , alertIcon = Just InfoIcon , alertName = Just $ PairAlert who , alertCombiner = Just $ dataCombiner $ \_old new -> new - , alertButton = Just button + , alertButtons = [button] } pairRequestAcknowledgedAlert :: String -> Maybe AlertButton -> Alert @@ -253,7 +298,7 @@ pairRequestAcknowledgedAlert who button = baseActivityAlert , alertPriority = High , alertName = Just $ PairAlert who , alertCombiner = Just $ dataCombiner $ \_old new -> new - , alertButton = button + , alertButtons = maybe [] (:[]) button } xmppNeededAlert :: AlertButton -> Alert @@ -261,7 +306,7 @@ xmppNeededAlert button = Alert { alertHeader = Just "Share with friends, and keep your devices in sync across the cloud." , alertIcon = Just TheCloud , alertPriority = High - , alertButton = Just button + , alertButtons = [button] , alertClosable = True , alertClass = Message , alertMessageRender = renderData @@ -280,7 +325,7 @@ cloudRepoNeededAlert friendname button = Alert ] , alertIcon = Just ErrorIcon , alertPriority = High - , alertButton = Just button + , alertButtons = [button] , alertClosable = True , alertClass = Message , alertMessageRender = renderData @@ -298,7 +343,7 @@ remoteRemovalAlert desc button = Alert "\" has been emptied, and can now be removed." , alertIcon = Just InfoIcon , alertPriority = High - , alertButton = Just button + , alertButtons = [button] , alertClosable = True , alertClass = Message , alertMessageRender = renderData diff --git a/Assistant/Alert/Utility.hs b/Assistant/Alert/Utility.hs index af52a4235d..db2ea19250 100644 --- a/Assistant/Alert/Utility.hs +++ b/Assistant/Alert/Utility.hs @@ -87,7 +87,7 @@ makeAlertFiller success alert { alertClass = if c == Activity then c' else c , alertPriority = Filler , alertClosable = True - , alertButton = Nothing + , alertButtons = [] , alertIcon = Just $ if success then SuccessIcon else ErrorIcon } where diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs index 32a3fd6f52..bf316e49d6 100644 --- a/Assistant/MakeRemote.hs +++ b/Assistant/MakeRemote.hs @@ -20,6 +20,7 @@ import qualified Command.InitRemote import Logs.UUID import Logs.Remote import Git.Remote +import Git.Types (RemoteName) import Creds import Assistant.Gpg import Utility.Gpg (KeyId) diff --git a/Assistant/NamedThread.hs b/Assistant/NamedThread.hs index 2440c45bf5..e1b3983f76 100644 --- a/Assistant/NamedThread.hs +++ b/Assistant/NamedThread.hs @@ -82,7 +82,7 @@ startNamedThread urlrenderer (NamedThread afterstartupsanitycheck name a) = do (RestartThreadR name) runAssistant d $ void $ addAlert $ (warningAlert (fromThreadName name) msg) - { alertButton = Just button } + { alertButtons = [button] } #endif namedThreadId :: NamedThread -> Assistant (Maybe ThreadId) diff --git a/Assistant/Pairing.hs b/Assistant/Pairing.hs index 4736c4396c..bb1384a151 100644 --- a/Assistant/Pairing.hs +++ b/Assistant/Pairing.hs @@ -28,7 +28,7 @@ data PairStage | PairAck {- "I saw your PairAck; you can stop sending them." -} | PairDone - deriving (Eq, Read, Show, Ord) + deriving (Eq, Read, Show, Ord, Enum) newtype PairMsg = PairMsg (Verifiable (PairStage, PairData, SomeAddr)) deriving (Eq, Read, Show) diff --git a/Assistant/Repair.hs b/Assistant/Repair.hs index 1f54451251..1369d31986 100644 --- a/Assistant/Repair.hs +++ b/Assistant/Repair.hs @@ -46,7 +46,7 @@ repairWhenNecessary urlrenderer u mrmt fsckresults unless ok $ do button <- mkAlertButton True (T.pack "Click Here") urlrenderer $ RepairRepositoryR u - void $ addAlert $ brokenRepositoryAlert button + void $ addAlert $ brokenRepositoryAlert [button] #endif return ok | otherwise = return False diff --git a/Assistant/Restart.hs b/Assistant/Restart.hs new file mode 100644 index 0000000000..65d913712f --- /dev/null +++ b/Assistant/Restart.hs @@ -0,0 +1,86 @@ +{- git-annex assistant restarting + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module Assistant.Restart where + +import Assistant.Common +import Assistant.Threads.Watcher +import Assistant.DaemonStatus +import Assistant.NamedThread +import Utility.ThreadScheduler +import Utility.NotificationBroadcaster +import Utility.Url +import qualified Git.Construct +import qualified Git.Config +import Config.Files +import qualified Annex +import qualified Git + +import Control.Concurrent +import System.Posix (getProcessID, signalProcess, sigTERM) +import System.Process (cwd) + +{- Before the assistant can be restarted, have to remove our + - gitAnnexUrlFile and our gitAnnexPidFile. Pausing the watcher is also + - a good idea, to avoid fighting when two assistants are running in the + - same repo. + -} +prepRestart :: Assistant () +prepRestart = do + liftIO . maybe noop (`throwTo` PauseWatcher) =<< namedThreadId watchThread + liftIO . nukeFile =<< liftAnnex (fromRepo gitAnnexUrlFile) + liftIO . nukeFile =<< liftAnnex (fromRepo gitAnnexPidFile) + +{- To finish a restart, send a global redirect to the new url + - to any web browsers that are displaying the webapp. + - + - Wait for browser to update before terminating this process. -} +postRestart :: URLString -> Assistant () +postRestart url = do + modifyDaemonStatus_ $ \status -> status { globalRedirUrl = Just url } + liftIO . sendNotification . globalRedirNotifier =<< getDaemonStatus + void $ liftIO $ forkIO $ do + threadDelaySeconds (Seconds 120) + signalProcess sigTERM =<< getProcessID + +runRestart :: Assistant URLString +runRestart = liftIO . newAssistantUrl + =<< liftAnnex (Git.repoLocation <$> Annex.gitRepo) + +{- Starts up the assistant in the repository, and waits for it to create + - a gitAnnexUrlFile. Waits for the assistant to be up and listening for + - connections by testing the url. -} +newAssistantUrl :: FilePath -> IO URLString +newAssistantUrl repo = do + startAssistant repo + geturl + where + geturl = do + r <- Git.Config.read =<< Git.Construct.fromPath repo + waiturl $ gitAnnexUrlFile r + waiturl urlfile = do + v <- tryIO $ readFile urlfile + case v of + Left _ -> delayed $ waiturl urlfile + Right url -> ifM (listening url) + ( return url + , delayed $ waiturl urlfile + ) + listening url = catchBoolIO $ fst <$> exists url [] Nothing + delayed a = do + threadDelay 100000 -- 1/10th of a second + a + +{- Returns once the assistant has daemonized, but possibly before it's + - listening for web connections. -} +startAssistant :: FilePath -> IO () +startAssistant repo = do + program <- readProgramFile + (_, _, _, pid) <- + createProcess $ + (proc program ["assistant"]) { cwd = Just repo } + void $ checkSuccessProcess pid diff --git a/Assistant/Ssh.hs b/Assistant/Ssh.hs index f316aa5008..1dc982ba63 100644 --- a/Assistant/Ssh.hs +++ b/Assistant/Ssh.hs @@ -12,6 +12,7 @@ import Utility.Tmp import Utility.UserInfo import Utility.Shell import Utility.Rsync +import Utility.FileMode import Git.Remote import Data.Text (Text) @@ -233,12 +234,8 @@ setupSshKeyPair sshkeypair sshdata = do sshdir <- sshDir createDirectoryIfMissing True $ parentDir $ sshdir sshprivkeyfile - unlessM (doesFileExist $ sshdir sshprivkeyfile) $ do - h <- fdToHandle =<< - createFile (sshdir sshprivkeyfile) - (unionFileModes ownerWriteMode ownerReadMode) - hPutStr h (sshPrivKey sshkeypair) - hClose h + unlessM (doesFileExist $ sshdir sshprivkeyfile) $ + writeFileProtected (sshdir sshprivkeyfile) (sshPrivKey sshkeypair) unlessM (doesFileExist $ sshdir sshpubkeyfile) $ writeFile (sshdir sshpubkeyfile) (sshPubKey sshkeypair) diff --git a/Assistant/Threads/NetWatcher.hs b/Assistant/Threads/NetWatcher.hs index 0d8442c696..a7124fa01c 100644 --- a/Assistant/Threads/NetWatcher.hs +++ b/Assistant/Threads/NetWatcher.hs @@ -15,6 +15,7 @@ import Assistant.Sync import Utility.ThreadScheduler import qualified Types.Remote as Remote import Assistant.DaemonStatus +import Utility.NotificationBroadcaster #if WITH_DBUS import Utility.DBus @@ -127,7 +128,9 @@ listenWicdConnections client callback = #endif handleConnection :: Assistant () -handleConnection = reconnectRemotes True =<< networkRemotes +handleConnection = do + liftIO . sendNotification . networkConnectedNotifier =<< getDaemonStatus + reconnectRemotes True =<< networkRemotes {- Network remotes to sync with. -} networkRemotes :: Assistant [Remote] diff --git a/Assistant/Threads/PairListener.hs b/Assistant/Threads/PairListener.hs index 482b0923ca..cd95ab5a43 100644 --- a/Assistant/Threads/PairListener.hs +++ b/Assistant/Threads/PairListener.hs @@ -16,6 +16,7 @@ import Assistant.WebApp.Types import Assistant.Alert import Assistant.DaemonStatus import Utility.ThreadScheduler +import Utility.Format import Git import Network.Multicast @@ -42,20 +43,32 @@ pairListenerThread urlrenderer = namedThread "PairListener" $ do (pip, verified) <- verificationCheck m =<< (pairingInProgress <$> getDaemonStatus) let wrongstage = maybe False (\p -> pairMsgStage m <= inProgressPairStage p) pip - case (wrongstage, sane, pairMsgStage m) of - -- ignore our own messages, and - -- out of order messages - (True, _, _) -> go reqs cache sock - (_, False, _) -> go reqs cache sock - (_, _, PairReq) -> if m `elem` reqs + let fromus = maybe False (\p -> remoteSshPubKey (pairMsgData m) == remoteSshPubKey (inProgressPairData p)) pip + case (wrongstage, fromus, sane, pairMsgStage m) of + (_, True, _, _) -> do + debug ["ignoring message that looped back"] + go reqs cache sock + (_, _, False, _) -> go reqs cache sock + -- PairReq starts a pairing process, so a + -- new one is always heeded, even if + -- some other pairing is in process. + (_, _, _, PairReq) -> if m `elem` reqs then go reqs (invalidateCache m cache) sock else do pairReqReceived verified urlrenderer m go (m:take 10 reqs) (invalidateCache m cache) sock - (_, _, PairAck) -> do + (True, _, _, _) -> do + debug + ["ignoring out of order message" + , show (pairMsgStage m) + , "expected" + , show (succ . inProgressPairStage <$> pip) + ] + go reqs cache sock + (_, _, _, PairAck) -> do cache' <- pairAckReceived verified pip m cache go reqs cache' sock - (_, _, PairDone) -> do + (_,_ , _, PairDone) -> do pairDoneReceived verified pip m go reqs cache sock @@ -75,11 +88,10 @@ pairListenerThread urlrenderer = namedThread "PairListener" $ do verified = verifiedPairMsg m pip sameuuid = pairUUID (inProgressPairData pip) == pairUUID (pairMsgData m) - {- Various sanity checks on the content of the message. -} - checkSane msg + checkSane msg {- Control characters could be used in a - console poisoning attack. -} - | any isControl msg || any (`elem` "\r\n") msg = do + | any isControl (filter (/= '\n') (decode_c msg)) = do liftAnnex $ warning "illegal control characters in pairing message; ignoring" return False diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs index b03298510a..6946e8b3a9 100644 --- a/Assistant/Threads/SanityChecker.hs +++ b/Assistant/Threads/SanityChecker.hs @@ -25,8 +25,10 @@ import Utility.Batch import Utility.NotificationBroadcaster import Config import Utility.HumanTime +import Git.Repair import Data.Time.Clock.POSIX +import qualified Data.Set as S {- This thread runs once at startup, and most other threads wait for it - to finish. (However, the webapp thread does not, to prevent the UI @@ -36,6 +38,21 @@ sanityCheckerStartupThread startupdelay = namedThreadUnchecked "SanityCheckerSta {- Stale git locks can prevent commits from happening, etc. -} void $ repairStaleGitLocks =<< liftAnnex gitRepo + {- A corrupt index file can prevent the assistant from working at + - all, so detect and repair. -} + ifM (not <$> liftAnnex (inRepo (checkIndex S.empty))) + ( do + notice ["corrupt index file found at startup; removing and restaging"] + liftAnnex $ inRepo nukeIndex + {- Normally the startup scan avoids re-staging files, + - but with the index deleted, everything needs to be + - restaged. -} + modifyDaemonStatus_ $ \s -> s { forceRestage = True } + , whenM (liftAnnex $ inRepo missingIndex) $ do + debug ["no index file; restaging"] + modifyDaemonStatus_ $ \s -> s { forceRestage = True } + ) + {- If there's a startup delay, it's done here. -} liftIO $ maybe noop (threadDelaySeconds . Seconds . fromIntegral . durationSeconds) startupdelay diff --git a/Assistant/Threads/TransferWatcher.hs b/Assistant/Threads/TransferWatcher.hs index fc09373e79..cd72828650 100644 --- a/Assistant/Threads/TransferWatcher.hs +++ b/Assistant/Threads/TransferWatcher.hs @@ -16,6 +16,7 @@ import Utility.DirWatcher.Types import qualified Remote import Control.Concurrent +import qualified Data.Map as M {- This thread watches for changes to the gitAnnexTransferDir, - and updates the DaemonStatus's map of ongoing transfers. -} @@ -89,6 +90,11 @@ onDel file = case parseTransferFile file of debug [ "transfer finishing:", show t] minfo <- removeTransfer t + -- Run transfer hook. + m <- transferHook <$> getDaemonStatus + maybe noop (\hook -> void $ liftIO $ forkIO $ hook t) + (M.lookup (transferKey t) m) + finished <- asIO2 finishedTransfer void $ liftIO $ forkIO $ do {- XXX race workaround delay. The location diff --git a/Assistant/Threads/UpgradeWatcher.hs b/Assistant/Threads/UpgradeWatcher.hs new file mode 100644 index 0000000000..80f2040a07 --- /dev/null +++ b/Assistant/Threads/UpgradeWatcher.hs @@ -0,0 +1,109 @@ +{- git-annex assistant thread to detect when git-annex is upgraded + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Assistant.Threads.UpgradeWatcher ( + upgradeWatcherThread +) where + +import Assistant.Common +import Assistant.Upgrade +import Utility.DirWatcher +import Utility.DirWatcher.Types +import Utility.ThreadScheduler +import Assistant.Types.UrlRenderer +import Assistant.Alert +import Assistant.DaemonStatus +#ifdef WITH_WEBAPP +import Assistant.WebApp.Types +import qualified Build.SysConfig +#endif + +import Control.Concurrent.MVar +import qualified Data.Text as T + +data WatcherState = InStartupScan | Started | Upgrading + deriving (Eq) + +upgradeWatcherThread :: UrlRenderer -> NamedThread +upgradeWatcherThread urlrenderer = namedThread "UpgradeWatcher" $ do + whenM (liftIO checkSuccessfulUpgrade) $ + showSuccessfulUpgrade urlrenderer + go =<< liftIO upgradeFlagFile + where + go Nothing = debug [ "cannot determine program path" ] + go (Just flagfile) = do + mvar <- liftIO $ newMVar InStartupScan + changed <- Just <$> asIO2 (changedFile urlrenderer mvar flagfile) + let hooks = mkWatchHooks + { addHook = changed + , delHook = changed + , addSymlinkHook = changed + , modifyHook = changed + , delDirHook = changed + } + let dir = parentDir flagfile + let depth = length (splitPath dir) + 1 + let nosubdirs f = length (splitPath f) == depth + void $ liftIO $ watchDir dir nosubdirs hooks (startup mvar) + -- Ignore bogus events generated during the startup scan. + startup mvar scanner = do + r <- scanner + void $ swapMVar mvar Started + return r + +changedFile :: UrlRenderer -> MVar WatcherState -> FilePath -> FilePath -> Maybe FileStatus -> Assistant () +changedFile urlrenderer mvar flagfile file _status + | flagfile /= file = noop + | otherwise = do + state <- liftIO $ readMVar mvar + when (state == Started) $ do + setstate Upgrading + ifM (liftIO upgradeSanityCheck) + ( handleUpgrade urlrenderer + , do + debug ["new version failed sanity check; not using"] + setstate Started + ) + where + setstate = void . liftIO . swapMVar mvar + +handleUpgrade :: UrlRenderer -> Assistant () +handleUpgrade urlrenderer = do + -- Wait 2 minutes for any final upgrade changes to settle. + -- (For example, other associated files may be being put into + -- place.) Not needed when using a distribution bundle, because + -- in that case git-annex handles the upgrade in a non-racy way. + liftIO $ unlessM usingDistribution $ + threadDelaySeconds (Seconds 120) + ifM autoUpgradeEnabled + ( do + debug ["starting automatic upgrade"] + unattendedUpgrade +#ifdef WITH_WEBAPP + , do + button <- mkAlertButton True (T.pack "Finish Upgrade") urlrenderer ConfigFinishUpgradeR + void $ addAlert $ upgradeReadyAlert button +#else + , noop +#endif + ) + +showSuccessfulUpgrade :: UrlRenderer -> Assistant () +showSuccessfulUpgrade urlrenderer = do +#ifdef WITH_WEBAPP + button <- ifM autoUpgradeEnabled + ( pure Nothing + , Just <$> mkAlertButton True + (T.pack "Enable Automatic Upgrades") + urlrenderer ConfigEnableAutomaticUpgradeR + ) + void $ addAlert $ upgradeFinishedAlert button Build.SysConfig.packageversion +#else + noop +#endif diff --git a/Assistant/Threads/Upgrader.hs b/Assistant/Threads/Upgrader.hs new file mode 100644 index 0000000000..f0c47e8441 --- /dev/null +++ b/Assistant/Threads/Upgrader.hs @@ -0,0 +1,101 @@ +{- git-annex assistant thread to detect when upgrade is available + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Assistant.Threads.Upgrader ( + upgraderThread +) where + +import Assistant.Common +import Assistant.Upgrade + +import Assistant.Types.UrlRenderer +import Assistant.DaemonStatus +import Assistant.Alert +import Utility.NotificationBroadcaster +import Utility.Tmp +import qualified Annex +import qualified Build.SysConfig +import qualified Utility.Url as Url +import qualified Annex.Url as Url +import qualified Git.Version +import Types.Distribution +#ifdef WITH_WEBAPP +import Assistant.WebApp.Types +#endif + +import Data.Time.Clock +import qualified Data.Text as T + +upgraderThread :: UrlRenderer -> NamedThread +upgraderThread urlrenderer = namedThread "Upgrader" $ + when (isJust Build.SysConfig.upgradelocation) $ do + {- Check for upgrade on startup, unless it was just + - upgraded. -} + unlessM (liftIO checkSuccessfulUpgrade) $ + checkUpgrade urlrenderer + h <- liftIO . newNotificationHandle False . networkConnectedNotifier =<< getDaemonStatus + go h =<< liftIO getCurrentTime + where + {- Wait for a network connection event. Then see if it's been + - half a day since the last upgrade check. If so, proceed with + - check. -} + go h lastchecked = do + liftIO $ waitNotification h + autoupgrade <- liftAnnex $ annexAutoUpgrade <$> Annex.getGitConfig + if autoupgrade == NoAutoUpgrade + then go h lastchecked + else do + now <- liftIO getCurrentTime + if diffUTCTime now lastchecked > halfday + then do + checkUpgrade urlrenderer + go h =<< liftIO getCurrentTime + else go h lastchecked + halfday = 12 * 60 * 60 + +checkUpgrade :: UrlRenderer -> Assistant () +checkUpgrade urlrenderer = do + debug [ "Checking if an upgrade is available." ] + go =<< getDistributionInfo + where + go Nothing = debug [ "Failed to check if upgrade is available." ] + go (Just d) = do + let installed = Git.Version.normalize Build.SysConfig.packageversion + let avail = Git.Version.normalize $ distributionVersion d + let old = Git.Version.normalize <$> distributionUrgentUpgrade d + if Just installed <= old + then canUpgrade High urlrenderer d + else if installed < avail + then canUpgrade Low urlrenderer d + else debug [ "No new version found." ] + +canUpgrade :: AlertPriority -> UrlRenderer -> GitAnnexDistribution -> Assistant () +canUpgrade urgency urlrenderer d = ifM autoUpgradeEnabled + ( startDistributionDownload d + , do +#ifdef WITH_WEBAPP + button <- mkAlertButton True (T.pack "Upgrade") urlrenderer (ConfigStartUpgradeR d) + void $ addAlert (canUpgradeAlert urgency (distributionVersion d) button) +#else + noop +#endif + ) + +getDistributionInfo :: Assistant (Maybe GitAnnexDistribution) +getDistributionInfo = do + ua <- liftAnnex Url.getUserAgent + liftIO $ withTmpFile "git-annex.tmp" $ \tmpfile h -> do + hClose h + ifM (Url.downloadQuiet distributionInfoUrl [] [] tmpfile ua) + ( readish <$> readFileStrict tmpfile + , return Nothing + ) + +distributionInfoUrl :: String +distributionInfoUrl = fromJust Build.SysConfig.upgradelocation ++ ".info" diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index 3eedbe145d..6a56eadbbd 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -200,6 +200,9 @@ onAdd matcher file filestatus add matcher file | otherwise = noChange +shouldRestage :: DaemonStatus -> Bool +shouldRestage ds = scanComplete ds || forceRestage ds + {- In direct mode, add events are received for both new files, and - modified existing files. -} @@ -214,7 +217,7 @@ onAddDirect symlinkssupported matcher file fs = do - really modified, but it might have - just been deleted and been put back, - so it symlink is restaged to make sure. -} - ( ifM (scanComplete <$> getDaemonStatus) + ( ifM (shouldRestage <$> getDaemonStatus) ( do link <- liftAnnex $ inRepo $ gitAnnexLink file key addLink file link (Just key) @@ -286,7 +289,7 @@ onAddSymlink' linktarget mk isdirect file filestatus = go mk - links too.) -} ensurestaged (Just link) daemonstatus - | scanComplete daemonstatus = addLink file link mk + | shouldRestage daemonstatus = addLink file link mk | otherwise = case filestatus of Just s | not (afterLastDaemonRun (statusChangeTime s) daemonstatus) -> noChange diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs index a5f4f42011..2ad61168e1 100644 --- a/Assistant/Threads/WebApp.hs +++ b/Assistant/Threads/WebApp.hs @@ -30,6 +30,7 @@ import Assistant.WebApp.Configurators.Preferences import Assistant.WebApp.Configurators.Edit import Assistant.WebApp.Configurators.Delete import Assistant.WebApp.Configurators.Fsck +import Assistant.WebApp.Configurators.Upgrade import Assistant.WebApp.Documentation import Assistant.WebApp.Control import Assistant.WebApp.OtherRepos @@ -52,11 +53,12 @@ webAppThread :: AssistantData -> UrlRenderer -> Bool + -> Maybe String -> Maybe HostName -> Maybe (IO Url) -> Maybe (Url -> FilePath -> IO ()) -> NamedThread -webAppThread assistantdata urlrenderer noannex listenhost postfirstrun onstartup = thread $ liftIO $ do +webAppThread assistantdata urlrenderer noannex cannotrun listenhost postfirstrun onstartup = thread $ liftIO $ do #ifdef __ANDROID__ when (isJust listenhost) $ -- See Utility.WebApp @@ -68,6 +70,7 @@ webAppThread assistantdata urlrenderer noannex listenhost postfirstrun onstartup <*> getreldir <*> pure staticRoutes <*> pure postfirstrun + <*> pure cannotrun <*> pure noannex <*> pure listenhost setUrlRenderer urlrenderer $ yesodRender webapp (pack "") diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs index 36d557c3d7..cb66e845a1 100644 --- a/Assistant/TransferSlots.hs +++ b/Assistant/TransferSlots.hs @@ -5,6 +5,8 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE CPP #-} + module Assistant.TransferSlots where import Assistant.Common @@ -32,8 +34,10 @@ import qualified Data.Map as M import qualified Control.Exception as E import Control.Concurrent import qualified Control.Concurrent.MSemN as MSemN -import System.Posix.Signals (signalProcessGroup, sigTERM, sigKILL) +#ifndef mingw32_HOST_OS import System.Posix.Process (getProcessGroupIDOf) +import System.Posix.Signals (signalProcessGroup, sigTERM, sigKILL) +#endif type TransferGenerator = Assistant (Maybe (Transfer, TransferInfo, Transferrer -> Assistant ())) @@ -247,13 +251,18 @@ 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 void $ tryIO $ signalProcessGroup sigTERM g threadDelay 50000 -- 0.05 second grace period void $ tryIO $ signalProcessGroup sigKILL g +#else + error "TODO: cancelTransfer not implemented on Windows" +#endif {- Start or resume a transfer. -} startTransfer :: Transfer -> Assistant () diff --git a/Assistant/TransferrerPool.hs b/Assistant/TransferrerPool.hs index d9104f74dd..bb4648731a 100644 --- a/Assistant/TransferrerPool.hs +++ b/Assistant/TransferrerPool.hs @@ -5,12 +5,17 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE CPP #-} + module Assistant.TransferrerPool where import Assistant.Common import Assistant.Types.TransferrerPool import Logs.Transfer + +#ifndef mingw32_HOST_OS import qualified Command.TransferKeys as T +#endif import Control.Concurrent.STM import System.Process (create_group) @@ -38,13 +43,18 @@ withTransferrer program pool a = do - finish. -} performTransfer :: Transferrer -> Transfer -> AssociatedFile -> IO Bool performTransfer transferrer t f = catchBoolIO $ do +#ifndef mingw32_HOST_OS T.sendRequest t f (transferrerWrite transferrer) T.readResponse (transferrerRead transferrer) +#else + error "TODO performTransfer not implemented on Windows" +#endif {- Starts a new git-annex transferkeys process, setting up a pipe - that will be used to communicate with it. -} mkTransferrer :: FilePath -> IO Transferrer mkTransferrer program = do +#ifndef mingw32_HOST_OS (myread, twrite) <- createPipe (tread, mywrite) <- createPipe mapM_ (\fd -> setFdOption fd CloseOnExec True) [myread, mywrite] @@ -68,6 +78,9 @@ mkTransferrer program = do , transferrerWrite = mywriteh , transferrerHandle = pid } +#else + error "TODO mkTransferrer not implemented on Windows" +#endif {- Checks if a Transferrer is still running. If not, makes a new one. -} checkTransferrer :: FilePath -> Transferrer -> IO Transferrer diff --git a/Assistant/Types/Alert.hs b/Assistant/Types/Alert.hs index 2e52ca7efe..e6fbe86d39 100644 --- a/Assistant/Types/Alert.hs +++ b/Assistant/Types/Alert.hs @@ -31,6 +31,7 @@ data AlertName | CloudRepoNeededAlert | SyncAlert | NotFsckedAlert + | UpgradeAlert deriving (Eq) {- The first alert is the new alert, the second is an old alert. @@ -49,10 +50,10 @@ data Alert = Alert , alertIcon :: Maybe AlertIcon , alertCombiner :: Maybe AlertCombiner , alertName :: Maybe AlertName - , alertButton :: Maybe AlertButton + , alertButtons :: [AlertButton] } -data AlertIcon = ActivityIcon | SyncIcon | SuccessIcon | ErrorIcon | InfoIcon | TheCloud +data AlertIcon = ActivityIcon | SyncIcon | SuccessIcon | ErrorIcon | InfoIcon | UpgradeIcon | TheCloud type AlertMap = M.Map AlertId Alert @@ -73,4 +74,5 @@ data AlertButton = AlertButton { buttonLabel :: Text , buttonUrl :: Text , buttonAction :: Maybe (AlertId -> IO ()) + , buttonPrimary :: Bool } diff --git a/Assistant/Types/DaemonStatus.hs b/Assistant/Types/DaemonStatus.hs index a1a0d64dc0..a618c700d7 100644 --- a/Assistant/Types/DaemonStatus.hs +++ b/Assistant/Types/DaemonStatus.hs @@ -14,6 +14,7 @@ import Logs.Transfer import Assistant.Types.ThreadName import Assistant.Types.NetMessager import Assistant.Types.Alert +import Utility.Url import Control.Concurrent.STM import Control.Concurrent.MVar @@ -28,6 +29,8 @@ data DaemonStatus = DaemonStatus { startedThreads :: M.Map ThreadName (Async (), IO ()) -- False when the daemon is performing its startup scan , scanComplete :: Bool + -- True when all files should be restaged. + , forceRestage :: Bool -- Time when a previous process of the daemon was running ok , lastRunning :: Maybe POSIXTime -- True when the daily sanity checker is running @@ -53,18 +56,25 @@ data DaemonStatus = DaemonStatus , desynced :: S.Set UUID -- Pairing request that is in progress. , pairingInProgress :: Maybe PairingInProgress - -- Broadcasts notifications about all changes to the DaemonStatus + -- Broadcasts notifications about all changes to the DaemonStatus. , changeNotifier :: NotificationBroadcaster -- Broadcasts notifications when queued or current transfers change. , transferNotifier :: NotificationBroadcaster - -- Broadcasts notifications when there's a change to the alerts + -- Broadcasts notifications when there's a change to the alerts. , alertNotifier :: NotificationBroadcaster - -- Broadcasts notifications when the syncRemotes change + -- Broadcasts notifications when the syncRemotes change. , syncRemotesNotifier :: NotificationBroadcaster - -- Broadcasts notifications when the scheduleLog changes + -- Broadcasts notifications when the scheduleLog changes. , scheduleLogNotifier :: NotificationBroadcaster -- Broadcasts a notification once the startup sanity check has run. , startupSanityCheckNotifier :: NotificationBroadcaster + -- Broadcasts notifications when the network is connected. + , networkConnectedNotifier :: NotificationBroadcaster + -- Broadcasts notifications when a global redirect is needed. + , globalRedirNotifier :: NotificationBroadcaster + , globalRedirUrl :: Maybe URLString + -- Actions to run after a Key is transferred. + , transferHook :: M.Map Key (Transfer -> IO ()) -- When the XMPP client is connected, this will contain the XMPP -- address. , xmppClientID :: Maybe ClientID @@ -81,6 +91,7 @@ newDaemonStatus :: IO DaemonStatus newDaemonStatus = DaemonStatus <$> pure M.empty <*> pure False + <*> pure False <*> pure Nothing <*> pure False <*> pure Nothing @@ -100,5 +111,9 @@ newDaemonStatus = DaemonStatus <*> newNotificationBroadcaster <*> newNotificationBroadcaster <*> newNotificationBroadcaster + <*> newNotificationBroadcaster + <*> newNotificationBroadcaster + <*> pure Nothing + <*> pure M.empty <*> pure Nothing <*> pure M.empty diff --git a/Assistant/Upgrade.hs b/Assistant/Upgrade.hs new file mode 100644 index 0000000000..fd71897cad --- /dev/null +++ b/Assistant/Upgrade.hs @@ -0,0 +1,316 @@ +{- git-annex assistant upgrading + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Assistant.Upgrade where + +import Assistant.Common +import Assistant.Restart +import qualified Annex +import Assistant.Alert +import Assistant.DaemonStatus +import Utility.Env +import Types.Distribution +import Logs.Transfer +import Logs.Web +import Logs.Presence +import Logs.Location +import Annex.Content +import qualified Backend +import qualified Types.Backend +import qualified Types.Key +import Assistant.TransferQueue +import Assistant.TransferSlots +import Remote (remoteFromUUID) +import Annex.Path +import Config.Files +import Utility.ThreadScheduler +import Utility.Tmp +import Utility.UserInfo +import qualified Utility.Lsof as Lsof + +import qualified Data.Map as M +import Data.Tuple.Utils + +{- Upgrade without interaction in the webapp. -} +unattendedUpgrade :: Assistant () +unattendedUpgrade = do + prepUpgrade + url <- runRestart + postUpgrade url + +prepUpgrade :: Assistant () +prepUpgrade = do + void $ addAlert upgradingAlert + void $ liftIO $ setEnv upgradedEnv "1" True + prepRestart + +postUpgrade :: URLString -> Assistant () +postUpgrade = postRestart + +autoUpgradeEnabled :: Assistant Bool +autoUpgradeEnabled = liftAnnex $ (==) AutoUpgrade . annexAutoUpgrade <$> Annex.getGitConfig + +checkSuccessfulUpgrade :: IO Bool +checkSuccessfulUpgrade = isJust <$> getEnv upgradedEnv + +upgradedEnv :: String +upgradedEnv = "GIT_ANNEX_UPGRADED" + +{- Start downloading the distribution key from the web. + - Install a hook that will be run once the download is complete, + - and finishes the upgrade. + - + - Creates the destination directory where the upgrade will be installed + - early, in order to check if another upgrade has happened (or is + - happending). On failure, the directory is removed. + -} +startDistributionDownload :: GitAnnexDistribution -> Assistant () +startDistributionDownload d = go =<< liftIO . newVersionLocation d =<< liftIO oldVersionLocation + where + go Nothing = debug ["Skipping redundant upgrade"] + go (Just dest) = do + liftAnnex $ setUrlPresent k u + hook <- asIO1 $ distributionDownloadComplete d dest cleanup + modifyDaemonStatus_ $ \s -> s + { transferHook = M.insert k hook (transferHook s) } + maybe noop (queueTransfer "upgrade" Next (Just f) t) + =<< liftAnnex (remoteFromUUID webUUID) + startTransfer t + k = distributionKey d + u = distributionUrl d + f = takeFileName u ++ " (for upgrade)" + t = Transfer + { transferDirection = Download + , transferUUID = webUUID + , transferKey = k + } + cleanup = liftAnnex $ do + removeAnnex k + setUrlMissing k u + logStatus k InfoMissing + +{- Called once the download is done. + - Passed an action that can be used to clean up the downloaded file. + - + - Fsck the key to verify the download. + -} +distributionDownloadComplete :: GitAnnexDistribution -> FilePath -> Assistant () -> Transfer -> Assistant () +distributionDownloadComplete d dest cleanup t + | transferDirection t == Download = do + debug ["finished downloading git-annex distribution"] + maybe (failedupgrade "bad download") go + =<< liftAnnex (withObjectLoc k fsckit (getM fsckit)) + | otherwise = cleanup + where + k = distributionKey d + fsckit f = case Backend.maybeLookupBackendName (Types.Key.keyBackendName k) of + Nothing -> return $ Just f + Just b -> case Types.Backend.fsckKey b of + Nothing -> return $ Just f + Just a -> ifM (a k f) + ( return $ Just f + , return Nothing + ) + go f = do + ua <- asIO $ upgradeToDistribution dest cleanup f + fa <- asIO1 failedupgrade + liftIO $ ua `catchNonAsync` (fa . show) + failedupgrade msg = do + void $ addAlert $ upgradeFailedAlert msg + cleanup + liftIO $ void $ tryIO $ removeDirectoryRecursive dest + +{- The upgrade method varies by OS. + - + - In general, find where the distribution was installed before, + - and unpack the new distribution next to it (in a versioned directory). + - Then update the programFile to point to the new version. + -} +upgradeToDistribution :: FilePath -> Assistant () -> FilePath -> Assistant () +upgradeToDistribution newdir cleanup distributionfile = do + liftIO $ createDirectoryIfMissing True newdir + (program, deleteold) <- unpack + changeprogram program + cleanup + prepUpgrade + url <- runRestart + {- At this point, the new assistant is fully running, so + - it's safe to delete the old version. -} + liftIO $ void $ tryIO deleteold + postUpgrade url + where + changeprogram program = liftIO $ do + unlessM (boolSystem program [Param "version"]) $ + error "New git-annex program failed to run! Not using." + pf <- programFile + liftIO $ writeFile pf program + +#ifdef darwin_HOST_OS + {- OS X uses a dmg, so mount it, and copy the contents into place. -} + unpack = liftIO $ do + olddir <- oldVersionLocation + withTmpDirIn (parentDir newdir) "git-annex.upgrade" $ \tmpdir -> do + void $ boolSystem "hdiutil" + [ Param "attach", File distributionfile + , Param "-mountpoint", File tmpdir + ] + void $ boolSystem "cp" + [ Param "-R" + , File $ tmpdir installBase "Contents" + , File $ newdir + ] + void $ boolSystem "hdiutil" + [ Param "eject" + , File tmpdir + ] + sanitycheck newdir + let deleteold = do + deleteFromManifest $ olddir "Contents" "MacOS" + makeorigsymlink olddir + return (newdir "Contents" "MacOS" "git-annex", deleteold) +#else + {- Linux uses a tarball (so could other POSIX systems), so + - untar it (into a temp directory) and move the directory + - into place. -} + unpack = liftIO $ do + olddir <- oldVersionLocation + withTmpDirIn (parentDir newdir) "git-annex.upgrade" $ \tmpdir -> do + let tarball = tmpdir "tar" + -- Cannot rely on filename extension, and this also + -- avoids problems if tar doesn't support transparent + -- decompression. + void $ boolSystem "sh" + [ Param "-c" + , Param $ "zcat < " ++ shellEscape distributionfile ++ + " > " ++ shellEscape tarball + ] + tarok <- boolSystem "tar" + [ Param "xf" + , Param tarball + , Param "--directory", File tmpdir + ] + unless tarok $ + error $ "failed to untar " ++ distributionfile + sanitycheck $ tmpdir installBase + installby rename newdir (tmpdir installBase) + let deleteold = do + deleteFromManifest olddir + makeorigsymlink olddir + return (newdir "git-annex", deleteold) + installby a dstdir srcdir = + mapM_ (\x -> a x (dstdir takeFileName x)) + =<< dirContents srcdir +#endif + sanitycheck dir = + unlessM (doesDirectoryExist dir) $ + error $ "did not find " ++ dir ++ " in " ++ distributionfile + makeorigsymlink olddir = do + let origdir = parentDir olddir installBase + nukeFile origdir + createSymbolicLink newdir origdir + +{- Finds where the old version was installed. -} +oldVersionLocation :: IO FilePath +oldVersionLocation = do +#ifdef darwin_HOST_OS + pdir <- parentDir <$> readProgramFile + let dirs = splitDirectories pdir + {- It will probably be deep inside a git-annex.app directory. -} + let olddir = case findIndex ("git-annex.app" `isPrefixOf`) dirs of + Nothing -> pdir + Just i -> joinPath (take (i + 1) dirs) +#else + olddir <- parentDir <$> readProgramFile +#endif + when (null olddir) $ + error $ "Cannot find old distribution bundle; not upgrading." + return olddir + +{- Finds a place to install the new version. + - Generally, put it in the parent directory of where the old version was + - installed, and use a version number in the directory name. + - If unable to write to there, instead put it in the home directory. + - + - The directory is created. If it already exists, returns Nothing. + -} +newVersionLocation :: GitAnnexDistribution -> FilePath -> IO (Maybe FilePath) +newVersionLocation d olddir = + trymkdir newloc $ do + home <- myHomeDir + trymkdir (home s) $ + return Nothing + where + s = installBase ++ "." ++ distributionVersion d + topdir = parentDir olddir + newloc = topdir s + trymkdir dir fallback = + (createDirectory dir >> return (Just dir)) + `catchIO` const fallback + +installBase :: String +installBase = "git-annex." ++ +#ifdef linux_HOST_OS + "linux" +#else +#ifdef darwin_HOST_OS + "app" +#else + "dir" +#endif +#endif + +deleteFromManifest :: FilePath -> IO () +deleteFromManifest dir = do + fs <- map (dir ) . lines <$> catchDefaultIO "" (readFile manifest) + mapM_ nukeFile fs + nukeFile manifest + removeEmptyRecursive dir + where + manifest = dir "git-annex.MANIFEST" + +removeEmptyRecursive :: FilePath -> IO () +removeEmptyRecursive dir = do + print ("remove", dir) + mapM_ removeEmptyRecursive =<< dirContents dir + void $ tryIO $ removeDirectory dir + +{- This is a file that the UpgradeWatcher can watch for modifications to + - detect when git-annex has been upgraded. + -} +upgradeFlagFile :: IO (Maybe FilePath) +upgradeFlagFile = ifM usingDistribution + ( Just <$> programFile + , programPath + ) + +{- Sanity check to see if an upgrade is complete and the program is ready + - to be run. -} +upgradeSanityCheck :: IO Bool +upgradeSanityCheck = ifM usingDistribution + ( doesFileExist =<< programFile + , do + -- Ensure that the program is present, and has no writers, + -- and can be run. This should handle distribution + -- upgrades, manual upgrades, etc. + v <- programPath + case v of + Nothing -> return False + Just program -> do + untilM (doesFileExist program <&&> nowriter program) $ + threadDelaySeconds (Seconds 60) + boolSystem program [Param "version"] + ) + where + nowriter f = null + . filter (`elem` [Lsof.OpenReadWrite, Lsof.OpenWriteOnly]) + . map snd3 + <$> Lsof.query [f] + +usingDistribution :: IO Bool +usingDistribution = isJust <$> getEnv "GIT_ANNEX_STANDLONE_ENV" diff --git a/Assistant/WebApp/Common.hs b/Assistant/WebApp/Common.hs index 3bd164569f..f7a49601f0 100644 --- a/Assistant/WebApp/Common.hs +++ b/Assistant/WebApp/Common.hs @@ -12,6 +12,7 @@ import Assistant.WebApp as X import Assistant.WebApp.Page as X import Assistant.WebApp.Form as X import Assistant.WebApp.Types as X +import Assistant.WebApp.RepoId as X import Utility.Yesod as X hiding (textField, passwordField, insertBy, replace, joinPath, deleteBy, delete, insert, Key, Option) import Data.Text as X (Text) diff --git a/Assistant/WebApp/Configurators/AWS.hs b/Assistant/WebApp/Configurators/AWS.hs index 29f7907768..ab2a32a599 100644 --- a/Assistant/WebApp/Configurators/AWS.hs +++ b/Assistant/WebApp/Configurators/AWS.hs @@ -23,7 +23,7 @@ import Types.Remote (RemoteConfig) import Types.StandardGroups import Creds import Assistant.Gpg -import Git.Remote +import Git.Types (RemoteName) import qualified Data.Text as T import qualified Data.Map as M diff --git a/Assistant/WebApp/Configurators/Edit.hs b/Assistant/WebApp/Configurators/Edit.hs index fc3b8ab0cd..6e7cbef5b3 100644 --- a/Assistant/WebApp/Configurators/Edit.hs +++ b/Assistant/WebApp/Configurators/Edit.hs @@ -37,6 +37,9 @@ import Git.Remote import Remote.Helper.Encryptable (extractCipher) import Types.Crypto import Utility.Gpg +import Annex.UUID +import Assistant.Ssh +import Config import qualified Data.Text as T import qualified Data.Map as M @@ -157,27 +160,30 @@ editRepositoryAForm ishere def = RepoConfig Nothing -> aopt hiddenField "" Nothing Just d -> aopt textField "Associated directory" (Just $ Just d) -getEditRepositoryR :: UUID -> Handler Html +getEditRepositoryR :: RepoId -> Handler Html getEditRepositoryR = postEditRepositoryR -postEditRepositoryR :: UUID -> Handler Html +postEditRepositoryR :: RepoId -> Handler Html postEditRepositoryR = editForm False getEditNewRepositoryR :: UUID -> Handler Html getEditNewRepositoryR = postEditNewRepositoryR postEditNewRepositoryR :: UUID -> Handler Html -postEditNewRepositoryR = editForm True +postEditNewRepositoryR = editForm True . RepoUUID getEditNewCloudRepositoryR :: UUID -> Handler Html getEditNewCloudRepositoryR = postEditNewCloudRepositoryR postEditNewCloudRepositoryR :: UUID -> Handler Html -postEditNewCloudRepositoryR uuid = xmppNeeded >> editForm True uuid +postEditNewCloudRepositoryR uuid = xmppNeeded >> editForm True (RepoUUID uuid) -editForm :: Bool -> UUID -> Handler Html -editForm new uuid = page "Edit repository" (Just Configuration) $ do +editForm :: Bool -> RepoId -> Handler Html +editForm new (RepoUUID uuid) = page "Edit repository" (Just Configuration) $ do mremote <- liftAnnex $ Remote.remoteFromUUID uuid + when (mremote == Nothing) $ + whenM ((/=) uuid <$> liftAnnex getUUID) $ + error "unknown remote" curr <- liftAnnex $ getRepoConfig uuid mremote liftAnnex $ checkAssociatedDirectory curr mremote ((result, form), enctype) <- liftH $ @@ -192,7 +198,13 @@ editForm new uuid = page "Edit repository" (Just Configuration) $ do config <- liftAnnex $ M.lookup uuid <$> readRemoteLog let repoInfo = getRepoInfo mremote config let repoEncryption = getRepoEncryption mremote config - $(widgetFile "configurators/editrepository") + $(widgetFile "configurators/edit/repository") +editForm new r@(RepoName _) = page "Edit repository" (Just Configuration) $ do + mr <- liftAnnex (repoIdRemote r) + let repoInfo = getRepoInfo mr Nothing + g <- liftAnnex gitRepo + let sshrepo = maybe False (remoteLocationIsSshUrl . flip parseRemoteLocation g . Git.repoLocation . Remote.repo) mr + $(widgetFile "configurators/edit/nonannexremote") {- Makes any directory associated with the repository. -} checkAssociatedDirectory :: RepoConfig -> Maybe Remote -> Annex () @@ -241,3 +253,17 @@ encrypted using gpg key: ^{gpgKeyDisplay k (M.lookup k knownkeys)} |] getRepoEncryption _ _ = return () -- local repo + +getUpgradeRepositoryR :: RepoId -> Handler () +getUpgradeRepositoryR (RepoUUID _) = redirect DashboardR +getUpgradeRepositoryR r = go =<< liftAnnex (repoIdRemote r) + where + go Nothing = redirect DashboardR + go (Just rmt) = do + liftIO fixSshKeyPair + liftAnnex $ setConfig + (remoteConfig (Remote.repo rmt) "ignore") + (Git.Config.boolConfig False) + liftAssistant $ syncRemote rmt + liftAnnex $ void Remote.remoteListRefresh + redirect DashboardR diff --git a/Assistant/WebApp/Configurators/Local.hs b/Assistant/WebApp/Configurators/Local.hs index 8528d22a01..56e1876bb4 100644 --- a/Assistant/WebApp/Configurators/Local.hs +++ b/Assistant/WebApp/Configurators/Local.hs @@ -10,10 +10,10 @@ module Assistant.WebApp.Configurators.Local where import Assistant.WebApp.Common -import Assistant.WebApp.OtherRepos import Assistant.WebApp.Gpg import Assistant.WebApp.MakeRemote import Assistant.Sync +import Assistant.Restart import Init import qualified Git import qualified Git.Construct @@ -24,12 +24,13 @@ import Config.Files import Utility.FreeDesktop #ifdef WITH_CLIBS import Utility.Mounts -#endif import Utility.DiskFree +#endif import Utility.DataUnits import Utility.Network import Remote (prettyUUID) import Annex.UUID +import Annex.Direct import Types.StandardGroups import Logs.PreferredContent import Logs.UUID @@ -167,7 +168,7 @@ getAndroidCameraRepositoryR = where addignore = do liftIO $ unlessM (doesFileExist ".gitignore") $ - writeFile ".gitignore" ".thumbnails/*" + writeFile ".gitignore" ".thumbnails" void $ inRepo $ Git.Command.runBool [Param "add", File ".gitignore"] @@ -199,7 +200,7 @@ getCombineRepositoryR :: FilePath -> UUID -> Handler Html getCombineRepositoryR newrepopath newrepouuid = do r <- combineRepos newrepopath remotename liftAssistant $ syncRemote r - redirect $ EditRepositoryR newrepouuid + redirect $ EditRepositoryR $ RepoUUID newrepouuid where remotename = takeFileName newrepopath diff --git a/Assistant/WebApp/Configurators/Pairing.hs b/Assistant/WebApp/Configurators/Pairing.hs index d9fc068637..788b5f637d 100644 --- a/Assistant/WebApp/Configurators/Pairing.hs +++ b/Assistant/WebApp/Configurators/Pairing.hs @@ -249,6 +249,7 @@ startLocalPairing stage oncancel alert muuid displaysecret secret = do tid <- liftIO myThreadId let selfdestruct = AlertButton { buttonLabel = "Cancel" + , buttonPrimary = True , buttonUrl = urlrender DashboardR , buttonAction = Just $ const $ do oncancel diff --git a/Assistant/WebApp/Configurators/Preferences.hs b/Assistant/WebApp/Configurators/Preferences.hs index d90a69f204..385f187113 100644 --- a/Assistant/WebApp/Configurators/Preferences.hs +++ b/Assistant/WebApp/Configurators/Preferences.hs @@ -19,6 +19,8 @@ import Config import Config.Files import Utility.DataUnits import Git.Config +import Types.Distribution +import qualified Build.SysConfig import qualified Data.Text as T @@ -26,6 +28,7 @@ data PrefsForm = PrefsForm { diskReserve :: Text , numCopies :: Int , autoStart :: Bool + , autoUpgrade :: AutoUpgrade , debugEnabled :: Bool } @@ -37,6 +40,8 @@ prefsAForm def = PrefsForm "Number of copies" (Just $ numCopies def) <*> areq (checkBoxField `withNote` autostartnote) "Auto start" (Just $ autoStart def) + <*> areq (selectFieldList autoUpgradeChoices) + autoUpgradeLabel (Just $ autoUpgrade def) <*> areq (checkBoxField `withNote` debugnote) "Enable debug logging" (Just $ debugEnabled def) where @@ -45,6 +50,16 @@ prefsAForm def = PrefsForm debugnote = [whamlet|View Log|] autostartnote = [whamlet|Start the git-annex assistant at boot or on login.|] + autoUpgradeChoices :: [(Text, AutoUpgrade)] + autoUpgradeChoices = + [ ("ask me", AskUpgrade) + , ("enabled", AutoUpgrade) + , ("disabled", NoAutoUpgrade) + ] + autoUpgradeLabel + | isJust Build.SysConfig.upgradelocation = "Auto upgrade" + | otherwise = "Auto restart on upgrade" + positiveIntField = check isPositive intField where isPositive i @@ -68,12 +83,14 @@ getPrefs = PrefsForm <$> (T.pack . roughSize storageUnits False . annexDiskReserve <$> Annex.getGitConfig) <*> (annexNumCopies <$> Annex.getGitConfig) <*> inAutoStartFile + <*> (annexAutoUpgrade <$> Annex.getGitConfig) <*> (annexDebug <$> Annex.getGitConfig) storePrefs :: PrefsForm -> Annex () storePrefs p = do setConfig (annexConfig "diskreserve") (T.unpack $ diskReserve p) setConfig (annexConfig "numcopies") (show $ numCopies p) + setConfig (annexConfig "autoupgrade") (fromAutoUpgrade $ autoUpgrade p) unlessM ((==) <$> pure (autoStart p) <*> inAutoStartFile) $ do here <- fromRepo Git.repoPath liftIO $ if autoStart p diff --git a/Assistant/WebApp/Configurators/Ssh.hs b/Assistant/WebApp/Configurators/Ssh.hs index 057472a34b..708f094e99 100644 --- a/Assistant/WebApp/Configurators/Ssh.hs +++ b/Assistant/WebApp/Configurators/Ssh.hs @@ -20,7 +20,7 @@ import Types.StandardGroups import Utility.UserInfo import Utility.Gpg import Types.Remote (RemoteConfig) -import Git.Remote +import Git.Types (RemoteName) import qualified Remote.GCrypt as GCrypt import Annex.UUID import Logs.UUID diff --git a/Assistant/WebApp/Configurators/Upgrade.hs b/Assistant/WebApp/Configurators/Upgrade.hs new file mode 100644 index 0000000000..77d9c062d8 --- /dev/null +++ b/Assistant/WebApp/Configurators/Upgrade.hs @@ -0,0 +1,48 @@ +{- git-annex assistant webapp upgrade UI + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +{-# LANGUAGE CPP, QuasiQuotes, TemplateHaskell, OverloadedStrings #-} + +module Assistant.WebApp.Configurators.Upgrade where + +import Assistant.WebApp.Common +import Types.Distribution +import Assistant.Upgrade +import Assistant.Restart +import Config + +{- On Android, just point the user at the apk file to download. + - Installation will be handled by selecting the downloaded file. + - + - Otherwise, start the upgrade process, which will run fully + - noninteractively. + - -} +getConfigStartUpgradeR :: GitAnnexDistribution -> Handler Html +getConfigStartUpgradeR d = do +#ifdef ANDROID_SPLICES + let url = distributionUrl d + page "Upgrade" (Just Configuration) $ + $(widgetFile "configurators/upgrade/android") +#else + liftAssistant $ startDistributionDownload d + redirect DashboardR +#endif + +{- Finish upgrade by starting the new assistant in the same repository this + - one is running in, and redirecting to it. -} +getConfigFinishUpgradeR :: Handler Html +getConfigFinishUpgradeR = do + liftAssistant prepUpgrade + url <- liftAssistant runRestart + liftAssistant $ postUpgrade url + redirect url + +getConfigEnableAutomaticUpgradeR :: Handler Html +getConfigEnableAutomaticUpgradeR = do + liftAnnex $ setConfig (annexConfig "autoupgrade") + (fromAutoUpgrade AutoUpgrade) + redirect DashboardR diff --git a/Assistant/WebApp/Configurators/WebDAV.hs b/Assistant/WebApp/Configurators/WebDAV.hs index c42b8dbbc5..df44e2e10e 100644 --- a/Assistant/WebApp/Configurators/WebDAV.hs +++ b/Assistant/WebApp/Configurators/WebDAV.hs @@ -18,7 +18,7 @@ import qualified Remote import Types.Remote (RemoteConfig) import Types.StandardGroups import Logs.Remote -import Git.Remote +import Git.Types (RemoteName) import qualified Data.Map as M #endif diff --git a/Assistant/WebApp/Configurators/XMPP.hs b/Assistant/WebApp/Configurators/XMPP.hs index 18f900dc6e..d0ded0b228 100644 --- a/Assistant/WebApp/Configurators/XMPP.hs +++ b/Assistant/WebApp/Configurators/XMPP.hs @@ -43,6 +43,7 @@ xmppNeeded = whenM (isNothing <$> liftAnnex getXMPPCreds) $ do { buttonLabel = "Configure a Jabber account" , buttonUrl = urlrender XMPPConfigR , buttonAction = Just close + , buttonPrimary = True } #else xmppNeeded = return () diff --git a/Assistant/WebApp/Control.hs b/Assistant/WebApp/Control.hs index b7684531ad..a9fcca22e2 100644 --- a/Assistant/WebApp/Control.hs +++ b/Assistant/WebApp/Control.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp control - - - Copyright 2012 Joey Hess + - Copyright 2012, 2013 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -10,15 +10,17 @@ module Assistant.WebApp.Control where import Assistant.WebApp.Common -import Config.Files -import Utility.LogFile import Assistant.DaemonStatus import Assistant.Alert import Assistant.TransferSlots +import Assistant.Restart +import Utility.LogFile +import Utility.NotificationBroadcaster import Control.Concurrent import System.Posix (getProcessID, signalProcess, sigTERM) import qualified Data.Map as M +import qualified Data.Text as T getShutdownR :: Handler Html getShutdownR = page "Shutdown" Nothing $ @@ -36,26 +38,32 @@ getShutdownConfirmedR = do - the transfer processes). -} ts <- M.keys . currentTransfers <$> getDaemonStatus mapM_ pauseTransfer ts - page "Shutdown" Nothing $ do - {- Wait 2 seconds before shutting down, to give the web - - page time to load in the browser. -} - void $ liftIO $ forkIO $ do - threadDelay 2000000 - signalProcess sigTERM =<< getProcessID - $(widgetFile "control/shutdownconfirmed") - -{- Quite a hack, and doesn't redirect the browser window. -} -getRestartR :: Handler Html -getRestartR = page "Restarting" Nothing $ do + webapp <- getYesod + let url = T.unpack $ yesodRender webapp (T.pack "") NotRunningR [] + {- Signal any other web browsers. -} + liftAssistant $ do + modifyDaemonStatus_ $ \status -> status { globalRedirUrl = Just url } + liftIO . sendNotification . globalRedirNotifier =<< getDaemonStatus + {- Wait 2 seconds before shutting down, to give the web + - page time to load in the browser. -} void $ liftIO $ forkIO $ do threadDelay 2000000 - program <- readProgramFile - unlessM (boolSystem "sh" [Param "-c", Param $ restartcommand program]) $ - error "restart failed" - $(widgetFile "control/restarting") - where - restartcommand program = program ++ " assistant --stop; exec " ++ - program ++ " webapp" + signalProcess sigTERM =<< getProcessID + redirect NotRunningR + +{- Use a custom page to avoid putting long polling elements on it that will + - fail and cause the web browser to show an error once the webapp is + - truely stopped. -} +getNotRunningR :: Handler Html +getNotRunningR = customPage' False Nothing $ + $(widgetFile "control/notrunning") + +getRestartR :: Handler Html +getRestartR = do + liftAssistant prepRestart + url <- liftAssistant runRestart + liftAssistant $ postRestart url + redirect url getRestartThreadR :: ThreadName -> Handler () getRestartThreadR name = do @@ -67,5 +75,5 @@ getLogR :: Handler Html getLogR = page "Logs" Nothing $ do logfile <- liftAnnex $ fromRepo gitAnnexLogFile logs <- liftIO $ listLogs logfile - logcontent <- liftIO $ concat <$> mapM readFile logs + logcontent <- liftIO $ concat <$> mapM readFileStrictAnyEncoding logs $(widgetFile "control/log") diff --git a/Assistant/WebApp/Form.hs b/Assistant/WebApp/Form.hs index 3446e4fdee..03fd34615f 100644 --- a/Assistant/WebApp/Form.hs +++ b/Assistant/WebApp/Form.hs @@ -67,8 +67,7 @@ withExpandableNote :: (Monad m, ToWidget (HandlerSite m) w) => Field m v -> (Str withExpandableNote :: Field sub master v -> (String, GWidget sub master ()) -> Field sub master v #endif withExpandableNote field (toggle, note) = withNote field $ [whamlet| - - #{toggle} +#{toggle}
^{note} |] diff --git a/Assistant/WebApp/Gpg.hs b/Assistant/WebApp/Gpg.hs index 87fdf5f412..ed9c5d53ed 100644 --- a/Assistant/WebApp/Gpg.hs +++ b/Assistant/WebApp/Gpg.hs @@ -18,6 +18,7 @@ import qualified Git.Construct import qualified Annex.Branch import qualified Git.GCrypt import qualified Remote.GCrypt as GCrypt +import Git.Types (RemoteName) import Assistant.WebApp.MakeRemote import Logs.Remote @@ -63,7 +64,7 @@ withNewSecretKey use = do - branch from the gcrypt remote and merges it in, and then looks up - the name. -} -getGCryptRemoteName :: UUID -> String -> Annex Git.Remote.RemoteName +getGCryptRemoteName :: UUID -> String -> Annex RemoteName getGCryptRemoteName u repoloc = do tmpremote <- uniqueRemoteName "tmpgcryptremote" 0 <$> gitRepo void $ inRepo $ Git.Command.runBool diff --git a/Assistant/WebApp/MakeRemote.hs b/Assistant/WebApp/MakeRemote.hs index 153e4dcef6..3a86331474 100644 --- a/Assistant/WebApp/MakeRemote.hs +++ b/Assistant/WebApp/MakeRemote.hs @@ -17,7 +17,7 @@ import qualified Remote import qualified Config import Config.Cost import Types.StandardGroups -import Git.Remote +import Git.Types (RemoteName) import Logs.PreferredContent import Assistant.MakeRemote diff --git a/Assistant/WebApp/Notifications.hs b/Assistant/WebApp/Notifications.hs index 6749abb723..9183709573 100644 --- a/Assistant/WebApp/Notifications.hs +++ b/Assistant/WebApp/Notifications.hs @@ -50,7 +50,6 @@ autoUpdate tident geturl ms_delay ms_startdelay = do let startdelay = Aeson.String (T.pack (show ms_startdelay)) let ident = Aeson.String tident #endif - addScript $ StaticR longpolling_js $(widgetFile "notifications/longpolling") {- Notifier urls are requested by the javascript, to avoid allocation @@ -82,6 +81,9 @@ getNotifierRepoListR reposelector = notifierUrl route getRepoListBroadcaster where route nid = RepoListR nid reposelector +getNotifierGlobalRedirR :: Handler RepPlain +getNotifierGlobalRedirR = notifierUrl GlobalRedirR getGlobalRedirBroadcaster + getTransferBroadcaster :: Assistant NotificationBroadcaster getTransferBroadcaster = transferNotifier <$> getDaemonStatus @@ -93,3 +95,12 @@ getBuddyListBroadcaster = getBuddyBroadcaster <$> getAssistant buddyList getRepoListBroadcaster :: Assistant NotificationBroadcaster getRepoListBroadcaster = syncRemotesNotifier <$> getDaemonStatus + +getGlobalRedirBroadcaster :: Assistant NotificationBroadcaster +getGlobalRedirBroadcaster = globalRedirNotifier <$> getDaemonStatus + +getGlobalRedirR :: NotificationId -> Handler RepPlain +getGlobalRedirR nid = do + waitNotifier getGlobalRedirBroadcaster nid + maybe (getGlobalRedirR nid) (return . RepPlain . toContent . T.pack) + =<< globalRedirUrl <$> liftAssistant getDaemonStatus diff --git a/Assistant/WebApp/OtherRepos.hs b/Assistant/WebApp/OtherRepos.hs index cc1207934a..e7c813a58f 100644 --- a/Assistant/WebApp/OtherRepos.hs +++ b/Assistant/WebApp/OtherRepos.hs @@ -12,14 +12,9 @@ module Assistant.WebApp.OtherRepos where import Assistant.Common import Assistant.WebApp.Types import Assistant.WebApp.Page -import qualified Git.Construct -import qualified Git.Config import Config.Files -import qualified Utility.Url as Url import Utility.Yesod - -import Control.Concurrent -import System.Process (cwd) +import Assistant.Restart getRepositorySwitcherR :: Handler Html getRepositorySwitcherR = page "Switch repository" Nothing $ do @@ -35,34 +30,7 @@ listOtherRepos = do names <- mapM relHome gooddirs return $ sort $ zip names gooddirs -{- Starts up the assistant in the repository, and waits for it to create - - a gitAnnexUrlFile. Waits for the assistant to be up and listening for - - connections by testing the url. Once it's running, redirect to it. - -} getSwitchToRepositoryR :: FilePath -> Handler Html getSwitchToRepositoryR repo = do - liftIO $ startAssistant repo liftIO $ addAutoStartFile repo -- make this the new default repo - redirect =<< liftIO geturl - where - geturl = do - r <- Git.Config.read =<< Git.Construct.fromPath repo - waiturl $ gitAnnexUrlFile r - waiturl urlfile = do - v <- tryIO $ readFile urlfile - case v of - Left _ -> delayed $ waiturl urlfile - Right url -> ifM (listening url) - ( return url - , delayed $ waiturl urlfile - ) - listening url = catchBoolIO $ fst <$> Url.exists url [] Nothing - delayed a = do - threadDelay 100000 -- 1/10th of a second - a - -startAssistant :: FilePath -> IO () -startAssistant repo = do - program <- readProgramFile - void $ forkIO $ void $ createProcess $ - (proc program ["assistant"]) { cwd = Just repo } + redirect =<< liftIO (newAssistantUrl repo) diff --git a/Assistant/WebApp/Page.hs b/Assistant/WebApp/Page.hs index 7afba47433..5d5a205b36 100644 --- a/Assistant/WebApp/Page.hs +++ b/Assistant/WebApp/Page.hs @@ -50,18 +50,26 @@ page title navbaritem content = customPage navbaritem $ do {- A custom page, with no title or sidebar set. -} customPage :: Maybe NavBarItem -> Widget -> Handler Html -customPage navbaritem content = do +customPage = customPage' True + +customPage' :: Bool -> Maybe NavBarItem -> Widget -> Handler Html +customPage' with_longpolling navbaritem content = do webapp <- getYesod - navbar <- map navdetails <$> selectNavBar - pageinfo <- widgetToPageContent $ do - addStylesheet $ StaticR css_bootstrap_css - addStylesheet $ StaticR css_bootstrap_responsive_css - addScript $ StaticR jquery_full_js - addScript $ StaticR js_bootstrap_dropdown_js - addScript $ StaticR js_bootstrap_modal_js - addScript $ StaticR js_bootstrap_collapse_js - $(widgetFile "page") - giveUrlRenderer $(Hamlet.hamletFile $ hamletTemplate "bootstrap") + case cannotRun webapp of + Nothing -> do + navbar <- map navdetails <$> selectNavBar + pageinfo <- widgetToPageContent $ do + addStylesheet $ StaticR css_bootstrap_css + addStylesheet $ StaticR css_bootstrap_responsive_css + addScript $ StaticR jquery_full_js + addScript $ StaticR js_bootstrap_dropdown_js + addScript $ StaticR js_bootstrap_modal_js + addScript $ StaticR js_bootstrap_collapse_js + when with_longpolling $ + addScript $ StaticR longpolling_js + $(widgetFile "page") + giveUrlRenderer $(Hamlet.hamletFile $ hamletTemplate "bootstrap") + Just msg -> error msg where navdetails i = (navBarName i, navBarRoute i, Just i == navbaritem) diff --git a/Assistant/WebApp/RepoId.hs b/Assistant/WebApp/RepoId.hs new file mode 100644 index 0000000000..b314c52253 --- /dev/null +++ b/Assistant/WebApp/RepoId.hs @@ -0,0 +1,40 @@ +{- git-annex assistant webapp RepoId type + - + - Copyright 2012,2013 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module Assistant.WebApp.RepoId where + +import Common.Annex +import Git.Types (RemoteName) +import qualified Remote + +{- Parts of the webapp need to be able to act on repositories that may or + - may not have a UUID. -} +data RepoId + = RepoUUID UUID + | RepoName RemoteName + deriving (Eq, Ord, Show, Read) + +mkRepoId :: Remote -> RepoId +mkRepoId r = case Remote.uuid r of + NoUUID -> RepoName (Remote.name r) + u -> RepoUUID u + + +describeRepoId :: RepoId -> Annex String +describeRepoId (RepoUUID u) = Remote.prettyUUID u +describeRepoId (RepoName n) = return n + +repoIdRemote :: RepoId -> Annex (Maybe Remote) +repoIdRemote (RepoUUID u) = Remote.remoteFromUUID u +repoIdRemote (RepoName n) = Remote.byNameOnly n + +lacksUUID :: RepoId -> Bool +lacksUUID r = asUUID r == NoUUID + +asUUID :: RepoId -> UUID +asUUID (RepoUUID u) = u +asUUID _ = NoUUID diff --git a/Assistant/WebApp/RepoList.hs b/Assistant/WebApp/RepoList.hs index af8d5104d8..824d0a4a53 100644 --- a/Assistant/WebApp/RepoList.hs +++ b/Assistant/WebApp/RepoList.hs @@ -12,7 +12,6 @@ module Assistant.WebApp.RepoList where import Assistant.WebApp.Common import Assistant.DaemonStatus import Assistant.WebApp.Notifications -import Assistant.Ssh import qualified Annex import qualified Remote import qualified Types.Remote as Remote @@ -22,20 +21,22 @@ import Logs.Remote import Logs.Trust import Logs.Group import Config -import Git.Config import Git.Remote import Assistant.Sync import Config.Cost import Utility.NotificationBroadcaster import qualified Git -#ifdef WITH_XMPP -#endif import qualified Data.Map as M import qualified Data.Set as S import qualified Data.Text as T import Data.Function +type RepoList = [(RepoDesc, RepoId, Actions)] + +type RepoDesc = String + +{- Actions that can be performed on a repo in the list. -} data Actions = DisabledRepoActions { setupRepoLink :: Route WebApp } @@ -50,21 +51,21 @@ data Actions | UnwantedRepoActions { setupRepoLink :: Route WebApp } -mkSyncingRepoActions :: UUID -> Actions -mkSyncingRepoActions u = SyncingRepoActions - { setupRepoLink = EditRepositoryR u - , syncToggleLink = DisableSyncR u +mkSyncingRepoActions :: RepoId -> Actions +mkSyncingRepoActions repoid = SyncingRepoActions + { setupRepoLink = EditRepositoryR repoid + , syncToggleLink = DisableSyncR repoid } -mkNotSyncingRepoActions :: UUID -> Actions -mkNotSyncingRepoActions u = NotSyncingRepoActions - { setupRepoLink = EditRepositoryR u - , syncToggleLink = EnableSyncR u +mkNotSyncingRepoActions :: RepoId -> Actions +mkNotSyncingRepoActions repoid = NotSyncingRepoActions + { setupRepoLink = EditRepositoryR repoid + , syncToggleLink = EnableSyncR repoid } -mkUnwantedRepoActions :: UUID -> Actions -mkUnwantedRepoActions u = UnwantedRepoActions - { setupRepoLink = EditRepositoryR u +mkUnwantedRepoActions :: RepoId -> Actions +mkUnwantedRepoActions repoid = UnwantedRepoActions + { setupRepoLink = EditRepositoryR repoid } needsEnabled :: Actions -> Bool @@ -122,9 +123,6 @@ repoListDisplay reposelector = do $(widgetFile "repolist") where ident = "repolist" - unfinished uuid = uuid == NoUUID - -type RepoList = [(String, UUID, Actions)] {- A list of known repositories, with actions that can be taken on them. -} repoList :: RepoSelector -> Handler RepoList @@ -133,27 +131,27 @@ repoList reposelector | otherwise = list =<< (++) <$> configured <*> unconfigured where configured = do - syncing <- S.fromList . map Remote.uuid . syncRemotes - <$> liftAssistant getDaemonStatus + syncremotes <- syncRemotes <$> liftAssistant getDaemonStatus + let syncing = S.fromList $ map mkRepoId syncremotes liftAnnex $ do unwanted <- S.fromList - <$> filterM inUnwantedGroup (S.toList syncing) + <$> filterM inUnwantedGroup (map Remote.uuid syncremotes) rs <- filter selectedrepo . concat . Remote.byCost <$> Remote.remoteList - let us = map Remote.uuid rs - let maker u - | u `S.member` unwanted = mkUnwantedRepoActions u - | u `S.member` syncing = mkSyncingRepoActions u - | otherwise = mkNotSyncingRepoActions u - let l = zip us $ map (maker . Remote.uuid) rs + let l = flip map (map mkRepoId rs) $ \r -> case r of + (RepoUUID u) + | u `S.member` unwanted -> (r, mkUnwantedRepoActions r) + _ + | r `S.member` syncing -> (r, mkSyncingRepoActions r) + | otherwise -> (r, mkNotSyncingRepoActions r) if includeHere reposelector then do - u <- getUUID + r <- RepoUUID <$> getUUID autocommit <- annexAutoCommit <$> Annex.getGitConfig let hereactions = if autocommit - then mkSyncingRepoActions u - else mkNotSyncingRepoActions u - let here = (u, hereactions) + then mkSyncingRepoActions r + else mkNotSyncingRepoActions r + let here = (r, hereactions) return $ here : l else return l unconfigured = liftAnnex $ do @@ -164,7 +162,9 @@ repoList reposelector <$> trustExclude DeadTrusted (M.keys m) selectedrepo r | Remote.readonly r = False - | onlyCloud reposelector = Git.repoIsUrl (Remote.repo r) && not (isXMPPRemote r) + | onlyCloud reposelector = Git.repoIsUrl (Remote.repo r) + && Remote.uuid r /= NoUUID + && not (isXMPPRemote r) | otherwise = True selectedremote Nothing = False selectedremote (Just (iscloud, _)) @@ -190,23 +190,23 @@ repoList reposelector _ -> Nothing where getconfig k = M.lookup k =<< M.lookup u m - val iscloud r = Just (iscloud, (u, DisabledRepoActions $ r u)) - list l = liftAnnex $ do - let l' = nubBy ((==) `on` fst) l - l'' <- zip - <$> Remote.prettyListUUIDs (map fst l') - <*> pure l' - return $ map (\(name, (uuid, actions)) -> (name, uuid, actions)) l'' + val iscloud r = Just (iscloud, (RepoUUID u, DisabledRepoActions $ r u)) + list l = liftAnnex $ + forM (nubBy ((==) `on` fst) l) $ \(repoid, actions) -> + (,,) + <$> describeRepoId repoid + <*> pure repoid + <*> pure actions -getEnableSyncR :: UUID -> Handler () +getEnableSyncR :: RepoId -> Handler () getEnableSyncR = flipSync True -getDisableSyncR :: UUID -> Handler () +getDisableSyncR :: RepoId -> Handler () getDisableSyncR = flipSync False -flipSync :: Bool -> UUID -> Handler () -flipSync enable uuid = do - mremote <- liftAnnex $ Remote.remoteFromUUID uuid +flipSync :: Bool -> RepoId -> Handler () +flipSync enable repoid = do + mremote <- liftAnnex $ repoIdRemote repoid liftAssistant $ changeSyncable mremote enable redirectBack @@ -238,29 +238,3 @@ reorderCosts remote rs = zip rs'' (insertCostAfter costs i) costs = map Remote.cost rs' rs'' = (\(x, y) -> x ++ [remote] ++ y) $ splitAt (i + 1) rs' -{- Checks to see if any repositories with NoUUID have annex-ignore set. - - That could happen if there's a problem contacting a ssh remote - - soon after it was added. -} -getCheckUnfinishedRepositoriesR :: Handler Html -getCheckUnfinishedRepositoriesR = page "Unfinished repositories" (Just Configuration) $ do - stalled <- liftAnnex findStalled - $(widgetFile "configurators/checkunfinished") - -findStalled :: Annex [Remote] -findStalled = filter isstalled <$> remoteListRefresh - where - isstalled r = Remote.uuid r == NoUUID - && remoteAnnexIgnore (Remote.gitconfig r) - -getRetryUnfinishedRepositoriesR :: Handler () -getRetryUnfinishedRepositoriesR = do - liftAssistant $ mapM_ unstall =<< liftAnnex findStalled - redirect DashboardR - where - unstall r = do - liftIO fixSshKeyPair - liftAnnex $ setConfig - (remoteConfig (Remote.repo r) "ignore") - (boolConfig False) - syncRemote r - liftAnnex $ void remoteListRefresh diff --git a/Assistant/WebApp/SideBar.hs b/Assistant/WebApp/SideBar.hs index 7e977a67be..2c33ec86fb 100644 --- a/Assistant/WebApp/SideBar.hs +++ b/Assistant/WebApp/SideBar.hs @@ -50,6 +50,7 @@ sideBarDisplay = do let message = renderAlertMessage alert let messagelines = T.lines message let multiline = length messagelines > 1 + let buttons = zip (alertButtons alert) [1..] $(widgetFile "sidebar/alert") {- Called by client to get a sidebar display. @@ -79,16 +80,20 @@ getCloseAlert :: AlertId -> Handler () getCloseAlert = liftAssistant . removeAlert {- When an alert with a button is clicked on, the button takes us here. -} -getClickAlert :: AlertId -> Handler () -getClickAlert i = do +getClickAlert :: AlertId -> Int -> Handler () +getClickAlert i bnum = do m <- alertMap <$> liftAssistant getDaemonStatus case M.lookup i m of - Just (Alert { alertButton = Just b }) -> do - {- Spawn a thread to run the action while redirecting. -} - case buttonAction b of - Nothing -> noop - Just a -> liftIO $ void $ forkIO $ a i - redirect $ buttonUrl b + Just (Alert { alertButtons = bs }) + | length bs >= bnum -> do + let b = bs !! (bnum - 1) + {- Spawn a thread to run the action + - while redirecting. -} + case buttonAction b of + Nothing -> noop + Just a -> liftIO $ void $ forkIO $ a i + redirect $ buttonUrl b + | otherwise -> redirectBack _ -> redirectBack htmlIcon :: AlertIcon -> Widget @@ -97,6 +102,7 @@ htmlIcon SyncIcon = [whamlet||] htmlIcon InfoIcon = bootstrapIcon "info-sign" htmlIcon SuccessIcon = bootstrapIcon "ok" htmlIcon ErrorIcon = bootstrapIcon "exclamation-sign" +htmlIcon UpgradeIcon = bootstrapIcon "arrow-up" -- utf-8 umbrella (utf-8 cloud looks too stormy) htmlIcon TheCloud = [whamlet|☂|] diff --git a/Assistant/WebApp/Types.hs b/Assistant/WebApp/Types.hs index 718dbcf732..937324934a 100644 --- a/Assistant/WebApp/Types.hs +++ b/Assistant/WebApp/Types.hs @@ -24,6 +24,8 @@ import Logs.Transfer import Utility.Gpg (KeyId) import Build.SysConfig (packageversion) import Types.ScheduledActivity +import Assistant.WebApp.RepoId +import Types.Distribution import Yesod.Static import Text.Hamlet @@ -43,6 +45,7 @@ data WebApp = WebApp , relDir :: Maybe FilePath , getStatic :: Static , postFirstRun :: Maybe (IO String) + , cannotRun :: Maybe String , noAnnex :: Bool , listenHost ::Maybe HostName } @@ -161,6 +164,10 @@ data RemovableDrive = RemovableDrive data RepoKey = RepoKey KeyId | NoRepoKey deriving (Read, Show, Eq, Ord) +instance PathPiece Bool where + toPathPiece = pack . show + fromPathPiece = readish . unpack + instance PathPiece RemovableDrive where toPathPiece = pack . show fromPathPiece = readish . unpack @@ -216,3 +223,11 @@ instance PathPiece ThreadName where instance PathPiece ScheduledActivity where toPathPiece = pack . show fromPathPiece = readish . unpack + +instance PathPiece RepoId where + toPathPiece = pack . show + fromPathPiece = readish . unpack + +instance PathPiece GitAnnexDistribution where + toPathPiece = pack . show + fromPathPiece = readish . unpack diff --git a/Assistant/WebApp/routes b/Assistant/WebApp/routes index ddfd23c0fc..ac5b12a6fb 100644 --- a/Assistant/WebApp/routes +++ b/Assistant/WebApp/routes @@ -9,6 +9,7 @@ /shutdown ShutdownR GET /shutdown/confirm ShutdownConfirmedR GET +/shutdown/complete NotRunningR GET /restart RestartR GET /restart/thread/#ThreadName RestartThreadR GET /log LogR GET @@ -21,6 +22,9 @@ /config/xmpp/needcloudrepo/#UUID NeedCloudRepoR GET /config/fsck ConfigFsckR GET POST /config/fsck/preferences ConfigFsckPreferencesR POST +/config/upgrade/start/#GitAnnexDistribution ConfigStartUpgradeR GET +/config/upgrade/finish ConfigFinishUpgradeR GET +/config/upgrade/automatically ConfigEnableAutomaticUpgradeR GET /config/addrepository AddRepositoryR GET /config/repository/new NewRepositoryR GET POST @@ -29,13 +33,12 @@ /config/repository/switcher RepositorySwitcherR GET /config/repository/switchto/#FilePath SwitchToRepositoryR GET /config/repository/combine/#FilePath/#UUID CombineRepositoryR GET -/config/repository/edit/#UUID EditRepositoryR GET POST +/config/repository/edit/#RepoId EditRepositoryR GET POST /config/repository/edit/new/#UUID EditNewRepositoryR GET POST /config/repository/edit/new/cloud/#UUID EditNewCloudRepositoryR GET POST -/config/repository/sync/disable/#UUID DisableSyncR GET -/config/repository/sync/enable/#UUID EnableSyncR GET -/config/repository/unfinished/check CheckUnfinishedRepositoriesR GET -/config/repository/unfinished/retry RetryUnfinishedRepositoriesR GET +/config/repository/sync/disable/#RepoId DisableSyncR GET +/config/repository/sync/enable/#RepoId EnableSyncR GET +/config/repository/upgrade/#RepoId UpgradeRepositoryR GET /config/repository/add/drive AddDriveR GET POST /config/repository/add/drive/confirm/#RemovableDrive ConfirmAddDriveR GET @@ -101,8 +104,11 @@ /repolist/#NotificationId/#RepoSelector RepoListR GET /notifier/repolist/#RepoSelector NotifierRepoListR GET +/globalredir/#NotificationId GlobalRedirR GET +/notifier/globalredir NotifierGlobalRedirR GET + /alert/close/#AlertId CloseAlert GET -/alert/click/#AlertId ClickAlert GET +/alert/click/#AlertId/#Int ClickAlert GET /filebrowser FileBrowserR GET POST /transfer/pause/#Transfer PauseTransferR GET POST diff --git a/Assistant/XMPP.hs b/Assistant/XMPP.hs index 0360ce8603..09b7daf4e5 100644 --- a/Assistant/XMPP.hs +++ b/Assistant/XMPP.hs @@ -21,7 +21,7 @@ import qualified Data.Map as M import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.XML.Types -import qualified Codec.Binary.Base64 as B64 +import qualified "dataenc" Codec.Binary.Base64 as B64 {- Name of the git-annex tag, in our own XML namespace. - (Not using a namespace URL to avoid unnecessary bloat.) -} diff --git a/Build/BundledPrograms.hs b/Build/BundledPrograms.hs index d071ae3aa3..3c53f06fba 100644 --- a/Build/BundledPrograms.hs +++ b/Build/BundledPrograms.hs @@ -30,6 +30,7 @@ bundledPrograms = catMaybes #endif , Just "rsync" , Just "ssh" + , Just "ssh-keygen" #ifndef mingw32_HOST_OS , Just "sh" #endif @@ -44,6 +45,11 @@ bundledPrograms = catMaybes , SysConfig.sha512 , SysConfig.sha224 , SysConfig.sha384 +#ifdef linux_HOST_OS + -- used to unpack the tarball when upgrading + , Just "gunzip" + , Just "tar" +#endif -- nice and ionice are not included in the bundle; we rely on the -- system's own version, which may better match its kernel ] diff --git a/Build/Configure.hs b/Build/Configure.hs index 262ac2080f..d17f6cbf05 100644 --- a/Build/Configure.hs +++ b/Build/Configure.hs @@ -7,7 +7,7 @@ import Data.List import System.Process import Control.Applicative import System.FilePath -import System.Environment +import System.Environment (getArgs) import Data.Maybe import Control.Monad.IfElse import Data.Char @@ -17,11 +17,13 @@ import Build.Version import Utility.SafeCommand import Utility.Monad import Utility.ExternalSHA +import Utility.Env import qualified Git.Version tests :: [TestCase] tests = [ TestCase "version" getVersion + , TestCase "UPGRADE_LOCATION" getUpgradeLocation , TestCase "git" $ requireCmd "git" "git --version >/dev/null" , TestCase "git version" getGitVersion , testCp "cp_a" "-a" @@ -33,6 +35,7 @@ tests = , TestCase "wget" $ testCmd "wget" "wget --version >/dev/null" , TestCase "bup" $ testCmd "bup" "bup --version >/dev/null" , TestCase "quvi" $ testCmd "quvi" "quvi --version >/dev/null" + , TestCase "newquvi" $ testCmd "newquvi" "quvi info >/dev/null" , TestCase "nice" $ testCmd "nice" "nice true >/dev/null" , TestCase "ionice" $ testCmd "ionice" "ionice -c3 true >/dev/null" , TestCase "gpg" $ maybeSelectCmd "gpg" @@ -90,6 +93,11 @@ testCp k option = TestCase cmd $ testCmd k cmdline cmd = "cp " ++ option cmdline = cmd ++ " " ++ testFile ++ " " ++ testFile ++ ".new" +getUpgradeLocation :: Test +getUpgradeLocation = do + e <- getEnv "UPGRADE_LOCATION" + return $ Config "upgradelocation" $ MaybeStringConfig e + getGitVersion :: Test getGitVersion = Config "gitversion" . StringConfig . show <$> Git.Version.installed @@ -130,4 +138,3 @@ androidConfig c = overrides ++ filter (not . overridden) c ] overridden (Config k _) = k `elem` overridekeys overridekeys = map (\(Config k _) -> k) overrides - diff --git a/Build/DistributionUpdate.hs b/Build/DistributionUpdate.hs new file mode 100644 index 0000000000..0afc2211f6 --- /dev/null +++ b/Build/DistributionUpdate.hs @@ -0,0 +1,64 @@ +{- Builds distributon info files for each git-annex release in a directory + - tree, which must itself be part of a git-annex repository. Only files + - that are present have their info file created. -} + +import Common.Annex +import Types.Distribution +import Build.Version +import Utility.UserInfo +import Utility.Path +import qualified Git.Construct +import qualified Annex +import Annex.Content +import Backend +import Git.Command + +import Data.Time.Clock + +main = do + state <- Annex.new =<< Git.Construct.fromPath =<< getRepoDir + Annex.eval state makeinfos + +makeinfos :: Annex () +makeinfos = do + basedir <- liftIO getRepoDir + version <- liftIO getChangelogVersion + now <- liftIO getCurrentTime + liftIO $ putStrLn $ "building info files for version " ++ version ++ " in " ++ basedir + fs <- liftIO $ dirContentsRecursiveSkipping (== "info") (basedir "git-annex") + forM_ fs $ \f -> do + v <- lookupFile f + case v of + Nothing -> noop + Just (k, _b) -> whenM (inAnnex k) $ do + liftIO $ putStrLn f + let infofile = f ++ ".info" + liftIO $ writeFile infofile $ show $ GitAnnexDistribution + { distributionUrl = mkUrl basedir f + , distributionKey = k + , distributionVersion = version + , distributionReleasedate = now + , distributionUrgentUpgrade = Nothing + } + void $ inRepo $ runBool [Param "add", Param infofile] + void $ inRepo $ runBool + [ Param "commit" + , Param "-m" + , Param $ "publishing git-annex " ++ version + ] + void $ inRepo $ runBool + [ Param "annex" + , Params "move --to website" + ] + void $ inRepo $ runBool + [ Param "annex" + , Params "sync" + ] + +getRepoDir :: IO FilePath +getRepoDir = do + home <- liftIO myHomeDir + return $ home "lib" "downloads" + +mkUrl :: FilePath -> FilePath -> String +mkUrl basedir f = "https://downloads.kitenet.net/" ++ relPathDirToFile basedir f diff --git a/Build/EvilSplicer.hs b/Build/EvilSplicer.hs index f40d100331..35dba49688 100644 --- a/Build/EvilSplicer.hs +++ b/Build/EvilSplicer.hs @@ -584,7 +584,7 @@ text_builder_hack = replace "Data.Text.Lazy.Builder.Internal.fromText" "Data.Tex parsecAndReplace :: Parser String -> String -> String parsecAndReplace p s = case parse find "" s of Left e -> s - Right l -> concatMap (either (\c -> [c]) id) l + Right l -> concatMap (either return id) l where find :: Parser [Either Char String] find = many $ try (Right <$> p) <|> (Left <$> anyChar) diff --git a/Build/OSXMkLibs.hs b/Build/OSXMkLibs.hs index ed12a945f1..dae9bc0aea 100644 --- a/Build/OSXMkLibs.hs +++ b/Build/OSXMkLibs.hs @@ -144,7 +144,7 @@ getLibName lib libmap = case M.lookup lib libmap of Just n -> (n, libmap) Nothing -> (nextfreename, M.insert lib nextfreename libmap) where - names = map (\c -> [c]) ['A' .. 'Z'] ++ + names = map pure ['A' .. 'Z'] ++ [[n, l] | n <- ['0' .. '9'], l <- ['A' .. 'Z']] used = S.fromList $ M.elems libmap nextfreename = fromMaybe (error "ran out of short library names!") $ diff --git a/BuildFlags.hs b/BuildFlags.hs index 40d5bb29b3..1dba47eafa 100644 --- a/BuildFlags.hs +++ b/BuildFlags.hs @@ -59,5 +59,8 @@ buildFlags = filter (not . null) #endif #ifdef WITH_CRYPTOHASH , "CryptoHash" +#endif +#ifdef WITH_EKG + , "EKG" #endif ] diff --git a/Command/Add.hs b/Command/Add.hs index e0a8269aa9..9f1beb28ac 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -23,10 +23,11 @@ import Annex.Perms import Annex.Link import qualified Annex import qualified Annex.Queue +#ifdef WITH_CLIBS #ifndef __ANDROID__ import Utility.Touch #endif -import Utility.FileMode +#endif import Config import Utility.InodeCache import Annex.FileMatcher @@ -86,11 +87,6 @@ start file = ifAnnexed file addpresent add - So a KeySource is returned. Its inodeCache can be used to detect any - changes that might be made to the file after it was locked down. - - - In indirect mode, the write bit is removed from the file as part of lock - - down to guard against further writes, and because objects in the annex - - have their write bit disabled anyway. This is not done in direct mode, - - because files there need to remain writable at all times. - - - When possible, the file is hard linked to a temp directory. This guards - against some changes, like deletion or overwrite of the file, and - allows lsof checks to be done more efficiently when adding a lot of files. @@ -103,16 +99,28 @@ lockDown file = ifM crippledFileSystem , do tmp <- fromRepo gitAnnexTmpDir createAnnexDirectory tmp - unlessM isDirect $ - void $ liftIO $ tryIO $ preventWrite file - liftIO $ catchMaybeIO $ do + eitherToMaybe <$> tryAnnexIO (go tmp) + ) + where + {- In indirect mode, the write bit is removed from the file as part + - of lock down to guard against further writes, and because objects + - in the annex have their write bit disabled anyway. + - + - Freezing the content early also lets us fail early when + - someone else owns the file. + - + - This is not done in direct mode, because files there need to + - remain writable at all times. + -} + go tmp = do + unlessM isDirect $ + freezeContent file + liftIO $ do (tmpfile, h) <- openTempFile tmp $ relatedTemplate $ takeFileName file hClose h nukeFile tmpfile withhardlink tmpfile `catchIO` const nohardlink - ) - where nohardlink = do cache <- genInodeCache file return KeySource @@ -205,12 +213,14 @@ link file key mcache = flip catchAnnex (undo file key) $ do l <- inRepo $ gitAnnexLink file key replaceFile file $ makeAnnexLink l +#ifdef WITH_CLIBS #ifndef __ANDROID__ -- touch symlink to have same time as the original file, -- as provided in the InodeCache case mcache of Just c -> liftIO $ touch file (TimeSpec $ inodeCacheToMtime c) False Nothing -> noop +#endif #endif return l diff --git a/Command/Fix.hs b/Command/Fix.hs index da26276193..a63a10f8f9 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -14,9 +14,11 @@ import System.PosixCompat.Files import Common.Annex import Command import qualified Annex.Queue +#ifdef WITH_CLIBS #ifndef __ANDROID__ import Utility.Touch #endif +#endif def :: [Command] def = [notDirect $ noCommit $ command "fix" paramPaths seek @@ -36,16 +38,20 @@ start file (key, _) = do perform :: FilePath -> FilePath -> CommandPerform perform file link = do liftIO $ do +#ifdef WITH_CLIBS #ifndef __ANDROID__ -- preserve mtime of symlink mtime <- catchMaybeIO $ TimeSpec . modificationTime <$> getSymbolicLinkStatus file +#endif #endif createDirectoryIfMissing True (parentDir file) removeFile file createSymbolicLink link file +#ifdef WITH_CLIBS #ifndef __ANDROID__ maybe noop (\t -> touch file t False) mtime +#endif #endif next $ cleanup file diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 3b89c550cb..a8e52af986 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -218,9 +218,10 @@ verifyLocationLog key desc = do {- Since we're checking that a key's file is present, throw - in a permission fixup here too. -} - when (present && not direct) $ do - file <- calcRepo $ gitAnnexLocation key + file <- calcRepo $ gitAnnexLocation key + when (present && not direct) $ freezeContent file + whenM (liftIO $ doesDirectoryExist $ parentDir file) $ freezeContentDir file {- In direct mode, modified files will show up as not present, diff --git a/Command/GCryptSetup.hs b/Command/GCryptSetup.hs index a27e470c1b..bdd770f159 100644 --- a/Command/GCryptSetup.hs +++ b/Command/GCryptSetup.hs @@ -23,13 +23,17 @@ seek = [withStrings start] start :: String -> CommandStart start gcryptid = next $ next $ do - g <- gitRepo u <- getUUID + when (u /= NoUUID) $ + error "gcryptsetup refusing to run; this repository already has a git-annex uuid!" + + g <- gitRepo gu <- Remote.GCrypt.getGCryptUUID True g - if u == NoUUID && gu == Nothing + let newgu = genUUIDInNameSpace gCryptNameSpace gcryptid + if gu == Nothing || gu == Just newgu then if Git.repoIsLocalBare g then do void $ Remote.GCrypt.setupRepo gcryptid g return True else error "cannot use gcrypt in a non-bare repository" - else error "gcryptsetup permission denied" + else error "gcryptsetup uuid mismatch" diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs index 7f54643c97..45a0d3b7ee 100644 --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -106,7 +106,7 @@ downloadFeed url = do liftIO $ withTmpFile "feed" $ \f h -> do fileEncoding h ifM (Url.download url [] [] f ua) - ( liftIO $ parseFeedString <$> hGetContentsStrict h + ( parseFeedString <$> hGetContentsStrict h , return Nothing ) diff --git a/Command/Indirect.hs b/Command/Indirect.hs index a2512ea961..8b857e2f61 100644 --- a/Command/Indirect.hs +++ b/Command/Indirect.hs @@ -20,9 +20,9 @@ import Config import qualified Annex import Annex.Direct import Annex.Content +import Annex.Content.Direct import Annex.CatFile import Annex.Version -import Annex.Perms import Annex.Exception import Init import qualified Command.Add @@ -77,7 +77,8 @@ perform = do Just s | isSymbolicLink s -> void $ flip whenAnnexed f $ \_ (k, _) -> do - cleandirect k + removeInodeCache k + removeAssociatedFiles k return Nothing | otherwise -> maybe noop (fromdirect f) @@ -87,8 +88,8 @@ perform = do fromdirect f k = do showStart "indirect" f - thawContentDir =<< calcRepo (gitAnnexLocation k) - cleandirect k -- clean before content directory gets frozen + removeInodeCache k + removeAssociatedFiles k whenM (liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f) $ do v <-tryAnnexIO (moveAnnex k f) case v of @@ -103,10 +104,6 @@ perform = do warnlocked e = do warning $ show e warning "leaving this file as-is; correct this problem and run git annex add on it" - - cleandirect k = do - liftIO . nukeFile =<< calcRepo (gitAnnexInodeCache k) - liftIO . nukeFile =<< calcRepo (gitAnnexMapping k) cleanup :: CommandCleanup cleanup = do diff --git a/Command/Info.hs b/Command/Info.hs new file mode 100644 index 0000000000..d465f2d841 --- /dev/null +++ b/Command/Info.hs @@ -0,0 +1,384 @@ +{- git-annex command + - + - Copyright 2011 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE BangPatterns #-} + +module Command.Info where + +import "mtl" Control.Monad.State.Strict +import qualified Data.Map as M +import Text.JSON +import Data.Tuple +import Data.Ord +import System.PosixCompat.Files + +import Common.Annex +import qualified Remote +import qualified Command.Unused +import qualified Git +import qualified Annex +import Command +import Utility.DataUnits +import Utility.DiskFree +import Annex.Content +import Types.Key +import Logs.UUID +import Logs.Trust +import Remote +import Config +import Utility.Percentage +import Logs.Transfer +import Types.TrustLevel +import Types.FileMatcher +import qualified Limit + +-- a named computation that produces a statistic +type Stat = StatState (Maybe (String, StatState String)) + +-- data about a set of keys +data KeyData = KeyData + { countKeys :: Integer + , sizeKeys :: Integer + , unknownSizeKeys :: Integer + , backendsKeys :: M.Map String Integer + } + +data NumCopiesStats = NumCopiesStats + { numCopiesVarianceMap :: M.Map Variance Integer + } + +newtype Variance = Variance Int + deriving (Eq, Ord) + +instance Show Variance where + show (Variance n) + | n >= 0 = "numcopies +" ++ show n + | otherwise = "numcopies " ++ show n + +-- cached info that multiple Stats use +data StatInfo = StatInfo + { presentData :: Maybe KeyData + , referencedData :: Maybe KeyData + , numCopiesStats :: Maybe NumCopiesStats + } + +-- a state monad for running Stats in +type StatState = StateT StatInfo Annex + +def :: [Command] +def = [noCommit $ command "info" paramPaths seek + SectionQuery "shows general information about the annex"] + +seek :: [CommandSeek] +seek = [withWords start] + +start :: [FilePath] -> CommandStart +start [] = do + globalInfo + stop +start ps = do + mapM_ localInfo =<< filterM isdir ps + stop + where + isdir = liftIO . catchBoolIO . (isDirectory <$$> getFileStatus) + +globalInfo :: Annex () +globalInfo = do + stats <- selStats global_fast_stats global_slow_stats + showCustom "info" $ do + evalStateT (mapM_ showStat stats) (StatInfo Nothing Nothing Nothing) + return True + +localInfo :: FilePath -> Annex () +localInfo dir = showCustom (unwords ["info", dir]) $ do + stats <- selStats (tostats local_fast_stats) (tostats local_slow_stats) + evalStateT (mapM_ showStat stats) =<< getLocalStatInfo dir + return True + where + tostats = map (\s -> s dir) + +selStats :: [Stat] -> [Stat] -> Annex [Stat] +selStats fast_stats slow_stats = do + fast <- Annex.getState Annex.fast + return $ if fast + then fast_stats + else fast_stats ++ slow_stats + +{- Order is significant. Less expensive operations, and operations + - that share data go together. + -} +global_fast_stats :: [Stat] +global_fast_stats = + [ repository_mode + , remote_list Trusted + , remote_list SemiTrusted + , remote_list UnTrusted + , transfer_list + , disk_size + ] +global_slow_stats :: [Stat] +global_slow_stats = + [ tmp_size + , bad_data_size + , local_annex_keys + , local_annex_size + , known_annex_files + , known_annex_size + , bloom_info + , backend_usage + ] +local_fast_stats :: [FilePath -> Stat] +local_fast_stats = + [ local_dir + , const local_annex_keys + , const local_annex_size + , const known_annex_files + , const known_annex_size + ] +local_slow_stats :: [FilePath -> Stat] +local_slow_stats = + [ const numcopies_stats + ] + +stat :: String -> (String -> StatState String) -> Stat +stat desc a = return $ Just (desc, a desc) + +nostat :: Stat +nostat = return Nothing + +json :: JSON j => (j -> String) -> StatState j -> String -> StatState String +json serialize a desc = do + j <- a + lift $ maybeShowJSON [(desc, j)] + return $ serialize j + +nojson :: StatState String -> String -> StatState String +nojson a _ = a + +showStat :: Stat -> StatState () +showStat s = maybe noop calc =<< s + where + calc (desc, a) = do + (lift . showHeader) desc + lift . showRaw =<< a + +repository_mode :: Stat +repository_mode = stat "repository mode" $ json id $ lift $ + ifM isDirect + ( return "direct", return "indirect" ) + +remote_list :: TrustLevel -> Stat +remote_list level = stat n $ nojson $ lift $ do + us <- M.keys <$> (M.union <$> uuidMap <*> remoteMap Remote.name) + rs <- fst <$> trustPartition level us + s <- prettyPrintUUIDs n rs + return $ if null s then "0" else show (length rs) ++ "\n" ++ beginning s + where + n = showTrustLevel level ++ " repositories" + +local_dir :: FilePath -> Stat +local_dir dir = stat "directory" $ json id $ return dir + +local_annex_keys :: Stat +local_annex_keys = stat "local annex keys" $ json show $ + countKeys <$> cachedPresentData + +local_annex_size :: Stat +local_annex_size = stat "local annex size" $ json id $ + showSizeKeys <$> cachedPresentData + +known_annex_files :: Stat +known_annex_files = stat "annexed files in working tree" $ json show $ + countKeys <$> cachedReferencedData + +known_annex_size :: Stat +known_annex_size = stat "size of annexed files in working tree" $ json id $ + showSizeKeys <$> cachedReferencedData + +tmp_size :: Stat +tmp_size = staleSize "temporary directory size" gitAnnexTmpDir + +bad_data_size :: Stat +bad_data_size = staleSize "bad keys size" gitAnnexBadDir + +bloom_info :: Stat +bloom_info = stat "bloom filter size" $ json id $ do + localkeys <- countKeys <$> cachedPresentData + capacity <- fromIntegral <$> lift Command.Unused.bloomCapacity + let note = aside $ + if localkeys >= capacity + then "appears too small for this repository; adjust annex.bloomcapacity" + else showPercentage 1 (percentage capacity localkeys) ++ " full" + + -- Two bloom filters are used at the same time, so double the size + -- of one. + size <- roughSize memoryUnits False . (* 2) . fromIntegral . fst <$> + lift Command.Unused.bloomBitsHashes + + return $ size ++ note + +transfer_list :: Stat +transfer_list = stat "transfers in progress" $ nojson $ lift $ do + uuidmap <- Remote.remoteMap id + ts <- getTransfers + return $ if null ts + then "none" + else multiLine $ + map (uncurry $ line uuidmap) $ sort ts + where + line uuidmap t i = unwords + [ showLcDirection (transferDirection t) ++ "ing" + , fromMaybe (key2file $ transferKey t) (associatedFile i) + , if transferDirection t == Upload then "to" else "from" + , maybe (fromUUID $ transferUUID t) Remote.name $ + M.lookup (transferUUID t) uuidmap + ] + +disk_size :: Stat +disk_size = stat "available local disk space" $ json id $ lift $ + calcfree + <$> (annexDiskReserve <$> Annex.getGitConfig) + <*> inRepo (getDiskFree . gitAnnexDir) + where + calcfree reserve (Just have) = unwords + [ roughSize storageUnits False $ nonneg $ have - reserve + , "(+" ++ roughSize storageUnits False reserve + , "reserved)" + ] + calcfree _ _ = "unknown" + + nonneg x + | x >= 0 = x + | otherwise = 0 + +backend_usage :: Stat +backend_usage = stat "backend usage" $ nojson $ + calc + <$> (backendsKeys <$> cachedReferencedData) + <*> (backendsKeys <$> cachedPresentData) + where + calc x y = multiLine $ + map (\(n, b) -> b ++ ": " ++ show n) $ + reverse $ sort $ map swap $ M.toList $ + M.unionWith (+) x y + +numcopies_stats :: Stat +numcopies_stats = stat "numcopies stats" $ nojson $ + calc <$> (maybe M.empty numCopiesVarianceMap <$> cachedNumCopiesStats) + where + calc = multiLine + . map (\(variance, count) -> show variance ++ ": " ++ show count) + . reverse . sortBy (comparing snd) . M.toList + +cachedPresentData :: StatState KeyData +cachedPresentData = do + s <- get + case presentData s of + Just v -> return v + Nothing -> do + v <- foldKeys <$> lift getKeysPresent + put s { presentData = Just v } + return v + +cachedReferencedData :: StatState KeyData +cachedReferencedData = do + s <- get + case referencedData s of + Just v -> return v + Nothing -> do + !v <- lift $ Command.Unused.withKeysReferenced + emptyKeyData addKey + put s { referencedData = Just v } + return v + +-- currently only available for local info +cachedNumCopiesStats :: StatState (Maybe NumCopiesStats) +cachedNumCopiesStats = numCopiesStats <$> get + +getLocalStatInfo :: FilePath -> Annex StatInfo +getLocalStatInfo dir = do + fast <- Annex.getState Annex.fast + matcher <- Limit.getMatcher + (presentdata, referenceddata, numcopiesstats) <- + Command.Unused.withKeysFilesReferencedIn dir initial + (update matcher fast) + return $ StatInfo (Just presentdata) (Just referenceddata) (Just numcopiesstats) + where + initial = (emptyKeyData, emptyKeyData, emptyNumCopiesStats) + update matcher fast key file vs@(presentdata, referenceddata, numcopiesstats) = + ifM (matcher $ FileInfo file file) + ( do + !presentdata' <- ifM (inAnnex key) + ( return $ addKey key presentdata + , return presentdata + ) + let !referenceddata' = addKey key referenceddata + !numcopiesstats' <- if fast + then return numcopiesstats + else updateNumCopiesStats key file numcopiesstats + return $! (presentdata', referenceddata', numcopiesstats') + , return vs + ) + +emptyKeyData :: KeyData +emptyKeyData = KeyData 0 0 0 M.empty + +emptyNumCopiesStats :: NumCopiesStats +emptyNumCopiesStats = NumCopiesStats M.empty + +foldKeys :: [Key] -> KeyData +foldKeys = foldl' (flip addKey) emptyKeyData + +addKey :: Key -> KeyData -> KeyData +addKey key (KeyData count size unknownsize backends) = + KeyData count' size' unknownsize' backends' + where + {- All calculations strict to avoid thunks when repeatedly + - applied to many keys. -} + !count' = count + 1 + !backends' = M.insertWith' (+) (keyBackendName key) 1 backends + !size' = maybe size (+ size) ks + !unknownsize' = maybe (unknownsize + 1) (const unknownsize) ks + ks = keySize key + +updateNumCopiesStats :: Key -> FilePath -> NumCopiesStats -> Annex NumCopiesStats +updateNumCopiesStats key file (NumCopiesStats m) = do + !variance <- Variance <$> numCopiesCheck file key (-) + let !m' = M.insertWith' (+) variance 1 m + let !ret = NumCopiesStats m' + return ret + +showSizeKeys :: KeyData -> String +showSizeKeys d = total ++ missingnote + where + total = roughSize storageUnits False $ sizeKeys d + missingnote + | unknownSizeKeys d == 0 = "" + | otherwise = aside $ + "+ " ++ show (unknownSizeKeys d) ++ + " unknown size" + +staleSize :: String -> (Git.Repo -> FilePath) -> Stat +staleSize label dirspec = go =<< lift (dirKeys dirspec) + where + go [] = nostat + go keys = onsize =<< sum <$> keysizes keys + onsize 0 = nostat + onsize size = stat label $ + json (++ aside "clean up with git-annex unused") $ + return $ roughSize storageUnits False size + keysizes keys = do + dir <- lift $ fromRepo dirspec + liftIO $ forM keys $ \k -> catchDefaultIO 0 $ + fromIntegral . fileSize + <$> getFileStatus (dir keyFile k) + +aside :: String -> String +aside s = " (" ++ s ++ ")" + +multiLine :: [String] -> String +multiLine = concatMap (\l -> "\n\t" ++ l) diff --git a/Command/List.hs b/Command/List.hs index fda8f3dc7c..12c27c0228 100644 --- a/Command/List.hs +++ b/Command/List.hs @@ -22,7 +22,7 @@ import Logs.UUID import Annex.UUID import qualified Option import qualified Annex -import Git.Remote +import Git.Types (RemoteName) def :: [Command] def = [noCommit $ withOptions [allrepos] $ command "list" paramPaths seek diff --git a/Command/Map.hs b/Command/Map.hs index 41beb4b92b..91f4a02510 100644 --- a/Command/Map.hs +++ b/Command/Map.hs @@ -74,7 +74,7 @@ drawMap rs umap ts = Dot.graph $ repos ++ trusted ++ others hostname :: Git.Repo -> String hostname r - | Git.repoIsUrl r = Git.Url.host r + | Git.repoIsUrl r = fromMaybe (Git.repoLocation r) (Git.Url.host r) | otherwise = "localhost" basehostname :: Git.Repo -> String diff --git a/Command/Merge.hs b/Command/Merge.hs index 5d6b2ffd2f..31db7a99f9 100644 --- a/Command/Merge.hs +++ b/Command/Merge.hs @@ -34,6 +34,5 @@ mergeBranch = do mergeSynced :: CommandStart mergeSynced = do - branch <- inRepo Git.Branch.current prepMerge - maybe stop mergeLocal branch + mergeLocal =<< inRepo Git.Branch.current diff --git a/Command/Reinject.hs b/Command/Reinject.hs index e4abeef3c8..c49af00601 100644 --- a/Command/Reinject.hs +++ b/Command/Reinject.hs @@ -14,7 +14,7 @@ import Annex.Content import qualified Command.Fsck def :: [Command] -def = [notDirect $ command "reinject" (paramPair "SRC" "DEST") seek +def = [command "reinject" (paramPair "SRC" "DEST") seek SectionUtility "sets content of annexed file"] seek :: [CommandSeek] diff --git a/Command/SendKey.hs b/Command/SendKey.hs index 039a3d7ca6..24b1821c3f 100644 --- a/Command/SendKey.hs +++ b/Command/SendKey.hs @@ -46,6 +46,4 @@ fieldTransfer direction key a = do ok <- maybe (a $ const noop) (\u -> runTransfer (Transfer direction (toUUID u) key) afile noRetry a) =<< Fields.getField Fields.remoteUUID - liftIO $ if ok - then exitSuccess - else exitFailure + liftIO $ exitBool ok diff --git a/Command/Status.hs b/Command/Status.hs index 44d868f6bb..5dc6259947 100644 --- a/Command/Status.hs +++ b/Command/Status.hs @@ -1,384 +1,89 @@ {- git-annex command - - - Copyright 2011 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE BangPatterns #-} - module Command.Status where -import "mtl" Control.Monad.State.Strict -import qualified Data.Map as M -import Text.JSON -import Data.Tuple -import Data.Ord -import System.PosixCompat.Files - import Common.Annex -import qualified Remote -import qualified Command.Unused -import qualified Git -import qualified Annex import Command -import Utility.DataUnits -import Utility.DiskFree -import Annex.Content -import Types.Key -import Logs.UUID -import Logs.Trust -import Remote +import Annex.CatFile +import Annex.Content.Direct import Config -import Utility.Percentage -import Logs.Transfer -import Types.TrustLevel -import Types.FileMatcher -import qualified Limit - --- a named computation that produces a statistic -type Stat = StatState (Maybe (String, StatState String)) - --- data about a set of keys -data KeyData = KeyData - { countKeys :: Integer - , sizeKeys :: Integer - , unknownSizeKeys :: Integer - , backendsKeys :: M.Map String Integer - } - -data NumCopiesStats = NumCopiesStats - { numCopiesVarianceMap :: M.Map Variance Integer - } - -newtype Variance = Variance Int - deriving (Eq, Ord) - -instance Show Variance where - show (Variance n) - | n >= 0 = "numcopies +" ++ show n - | otherwise = "numcopies " ++ show n - --- cached info that multiple Stats use -data StatInfo = StatInfo - { presentData :: Maybe KeyData - , referencedData :: Maybe KeyData - , numCopiesStats :: Maybe NumCopiesStats - } - --- a state monad for running Stats in -type StatState = StateT StatInfo Annex +import qualified Git.LsFiles as LsFiles +import qualified Git.Ref +import qualified Git def :: [Command] -def = [noCommit $ command "status" paramPaths seek - SectionQuery "shows status information about the annex"] +def = [notBareRepo $ noCommit $ noMessages $ + command "status" paramPaths seek SectionCommon + "show the working tree status"] seek :: [CommandSeek] -seek = [withWords start] +seek = + [ withWords start + ] start :: [FilePath] -> CommandStart start [] = do - globalStatus - stop -start ps = do - mapM_ localStatus =<< filterM isdir ps - stop - where - isdir = liftIO . catchBoolIO . (isDirectory <$$> getFileStatus) - -globalStatus :: Annex () -globalStatus = do - stats <- selStats global_fast_stats global_slow_stats - showCustom "status" $ do - evalStateT (mapM_ showStat stats) (StatInfo Nothing Nothing Nothing) - return True - -localStatus :: FilePath -> Annex () -localStatus dir = showCustom (unwords ["status", dir]) $ do - stats <- selStats (tostats local_fast_stats) (tostats local_slow_stats) - evalStateT (mapM_ showStat stats) =<< getLocalStatInfo dir - return True - where - tostats = map (\s -> s dir) - -selStats :: [Stat] -> [Stat] -> Annex [Stat] -selStats fast_stats slow_stats = do - fast <- Annex.getState Annex.fast - return $ if fast - then fast_stats - else fast_stats ++ slow_stats - -{- Order is significant. Less expensive operations, and operations - - that share data go together. - -} -global_fast_stats :: [Stat] -global_fast_stats = - [ repository_mode - , remote_list Trusted - , remote_list SemiTrusted - , remote_list UnTrusted - , transfer_list - , disk_size - ] -global_slow_stats :: [Stat] -global_slow_stats = - [ tmp_size - , bad_data_size - , local_annex_keys - , local_annex_size - , known_annex_files - , known_annex_size - , bloom_info - , backend_usage - ] -local_fast_stats :: [FilePath -> Stat] -local_fast_stats = - [ local_dir - , const local_annex_keys - , const local_annex_size - , const known_annex_files - , const known_annex_size - ] -local_slow_stats :: [FilePath -> Stat] -local_slow_stats = - [ const numcopies_stats - ] - -stat :: String -> (String -> StatState String) -> Stat -stat desc a = return $ Just (desc, a desc) - -nostat :: Stat -nostat = return Nothing - -json :: JSON j => (j -> String) -> StatState j -> String -> StatState String -json serialize a desc = do - j <- a - lift $ maybeShowJSON [(desc, j)] - return $ serialize j - -nojson :: StatState String -> String -> StatState String -nojson a _ = a - -showStat :: Stat -> StatState () -showStat s = maybe noop calc =<< s - where - calc (desc, a) = do - (lift . showHeader) desc - lift . showRaw =<< a - -repository_mode :: Stat -repository_mode = stat "repository mode" $ json id $ lift $ - ifM isDirect - ( return "direct", return "indirect" ) - -remote_list :: TrustLevel -> Stat -remote_list level = stat n $ nojson $ lift $ do - us <- M.keys <$> (M.union <$> uuidMap <*> remoteMap Remote.name) - rs <- fst <$> trustPartition level us - s <- prettyPrintUUIDs n rs - return $ if null s then "0" else show (length rs) ++ "\n" ++ beginning s - where - n = showTrustLevel level ++ " repositories" + -- Like git status, when run without a directory, behave as if + -- given the path to the top of the repository. + cwd <- liftIO getCurrentDirectory + top <- fromRepo Git.repoPath + next $ perform [relPathDirToFile cwd top] +start locs = next $ perform locs -local_dir :: FilePath -> Stat -local_dir dir = stat "directory" $ json id $ return dir +perform :: [FilePath] -> CommandPerform +perform locs = do + (l, cleanup) <- inRepo $ LsFiles.modifiedOthers locs + getstatus <- ifM isDirect + ( return statusDirect + , return $ Just <$$> statusIndirect + ) + forM_ l $ \f -> maybe noop (showFileStatus f) =<< getstatus f + void $ liftIO cleanup + next $ return True -local_annex_keys :: Stat -local_annex_keys = stat "local annex keys" $ json show $ - countKeys <$> cachedPresentData +data Status + = NewFile + | DeletedFile + | ModifiedFile -local_annex_size :: Stat -local_annex_size = stat "local annex size" $ json id $ - showSizeKeys <$> cachedPresentData +showStatus :: Status -> String +showStatus NewFile = "?" +showStatus DeletedFile = "D" +showStatus ModifiedFile = "M" -known_annex_files :: Stat -known_annex_files = stat "annexed files in working tree" $ json show $ - countKeys <$> cachedReferencedData +showFileStatus :: FilePath -> Status -> Annex () +showFileStatus f s = liftIO $ putStrLn $ showStatus s ++ " " ++ f -known_annex_size :: Stat -known_annex_size = stat "size of annexed files in working tree" $ json id $ - showSizeKeys <$> cachedReferencedData - -tmp_size :: Stat -tmp_size = staleSize "temporary directory size" gitAnnexTmpDir - -bad_data_size :: Stat -bad_data_size = staleSize "bad keys size" gitAnnexBadDir - -bloom_info :: Stat -bloom_info = stat "bloom filter size" $ json id $ do - localkeys <- countKeys <$> cachedPresentData - capacity <- fromIntegral <$> lift Command.Unused.bloomCapacity - let note = aside $ - if localkeys >= capacity - then "appears too small for this repository; adjust annex.bloomcapacity" - else showPercentage 1 (percentage capacity localkeys) ++ " full" - - -- Two bloom filters are used at the same time, so double the size - -- of one. - size <- roughSize memoryUnits False . (* 2) . fromIntegral . fst <$> - lift Command.Unused.bloomBitsHashes - - return $ size ++ note - -transfer_list :: Stat -transfer_list = stat "transfers in progress" $ nojson $ lift $ do - uuidmap <- Remote.remoteMap id - ts <- getTransfers - return $ if null ts - then "none" - else multiLine $ - map (uncurry $ line uuidmap) $ sort ts +statusDirect :: FilePath -> Annex (Maybe Status) +statusDirect f = checkstatus =<< liftIO (catchMaybeIO $ getFileStatus f) where - line uuidmap t i = unwords - [ showLcDirection (transferDirection t) ++ "ing" - , fromMaybe (key2file $ transferKey t) (associatedFile i) - , if transferDirection t == Upload then "to" else "from" - , maybe (fromUUID $ transferUUID t) Remote.name $ - M.lookup (transferUUID t) uuidmap - ] + checkstatus Nothing = return $ Just DeletedFile + checkstatus (Just s) + -- Git thinks that present direct mode files modifed, + -- so have to check. + | not (isSymbolicLink s) = checkkey s =<< catKeyFile f + | otherwise = Just <$> checkNew f + + checkkey s (Just k) = ifM (sameFileStatus k s) + ( return Nothing + , return $ Just ModifiedFile + ) + checkkey _ Nothing = Just <$> checkNew f -disk_size :: Stat -disk_size = stat "available local disk space" $ json id $ lift $ - calcfree - <$> (annexDiskReserve <$> Annex.getGitConfig) - <*> inRepo (getDiskFree . gitAnnexDir) +statusIndirect :: FilePath -> Annex Status +statusIndirect f = ifM (liftIO $ isJust <$> catchMaybeIO (getFileStatus f)) + ( checkNew f + , return DeletedFile + ) where - calcfree reserve (Just have) = unwords - [ roughSize storageUnits False $ nonneg $ have - reserve - , "(+" ++ roughSize storageUnits False reserve - , "reserved)" - ] - calcfree _ _ = "unknown" - nonneg x - | x >= 0 = x - | otherwise = 0 - -backend_usage :: Stat -backend_usage = stat "backend usage" $ nojson $ - calc - <$> (backendsKeys <$> cachedReferencedData) - <*> (backendsKeys <$> cachedPresentData) - where - calc x y = multiLine $ - map (\(n, b) -> b ++ ": " ++ show n) $ - reverse $ sort $ map swap $ M.toList $ - M.unionWith (+) x y - -numcopies_stats :: Stat -numcopies_stats = stat "numcopies stats" $ nojson $ - calc <$> (maybe M.empty numCopiesVarianceMap <$> cachedNumCopiesStats) - where - calc = multiLine - . map (\(variance, count) -> show variance ++ ": " ++ show count) - . reverse . sortBy (comparing snd) . M.toList - -cachedPresentData :: StatState KeyData -cachedPresentData = do - s <- get - case presentData s of - Just v -> return v - Nothing -> do - v <- foldKeys <$> lift getKeysPresent - put s { presentData = Just v } - return v - -cachedReferencedData :: StatState KeyData -cachedReferencedData = do - s <- get - case referencedData s of - Just v -> return v - Nothing -> do - !v <- lift $ Command.Unused.withKeysReferenced - emptyKeyData addKey - put s { referencedData = Just v } - return v - --- currently only available for local status -cachedNumCopiesStats :: StatState (Maybe NumCopiesStats) -cachedNumCopiesStats = numCopiesStats <$> get - -getLocalStatInfo :: FilePath -> Annex StatInfo -getLocalStatInfo dir = do - fast <- Annex.getState Annex.fast - matcher <- Limit.getMatcher - (presentdata, referenceddata, numcopiesstats) <- - Command.Unused.withKeysFilesReferencedIn dir initial - (update matcher fast) - return $ StatInfo (Just presentdata) (Just referenceddata) (Just numcopiesstats) - where - initial = (emptyKeyData, emptyKeyData, emptyNumCopiesStats) - update matcher fast key file vs@(presentdata, referenceddata, numcopiesstats) = - ifM (matcher $ FileInfo file file) - ( do - !presentdata' <- ifM (inAnnex key) - ( return $ addKey key presentdata - , return presentdata - ) - let !referenceddata' = addKey key referenceddata - !numcopiesstats' <- if fast - then return numcopiesstats - else updateNumCopiesStats key file numcopiesstats - return $! (presentdata', referenceddata', numcopiesstats') - , return vs - ) - -emptyKeyData :: KeyData -emptyKeyData = KeyData 0 0 0 M.empty - -emptyNumCopiesStats :: NumCopiesStats -emptyNumCopiesStats = NumCopiesStats M.empty - -foldKeys :: [Key] -> KeyData -foldKeys = foldl' (flip addKey) emptyKeyData - -addKey :: Key -> KeyData -> KeyData -addKey key (KeyData count size unknownsize backends) = - KeyData count' size' unknownsize' backends' - where - {- All calculations strict to avoid thunks when repeatedly - - applied to many keys. -} - !count' = count + 1 - !backends' = M.insertWith' (+) (keyBackendName key) 1 backends - !size' = maybe size (+ size) ks - !unknownsize' = maybe (unknownsize + 1) (const unknownsize) ks - ks = keySize key - -updateNumCopiesStats :: Key -> FilePath -> NumCopiesStats -> Annex NumCopiesStats -updateNumCopiesStats key file (NumCopiesStats m) = do - !variance <- Variance <$> numCopiesCheck file key (-) - let !m' = M.insertWith' (+) variance 1 m - let !ret = NumCopiesStats m' - return ret - -showSizeKeys :: KeyData -> String -showSizeKeys d = total ++ missingnote - where - total = roughSize storageUnits False $ sizeKeys d - missingnote - | unknownSizeKeys d == 0 = "" - | otherwise = aside $ - "+ " ++ show (unknownSizeKeys d) ++ - " unknown size" - -staleSize :: String -> (Git.Repo -> FilePath) -> Stat -staleSize label dirspec = go =<< lift (dirKeys dirspec) - where - go [] = nostat - go keys = onsize =<< sum <$> keysizes keys - onsize 0 = nostat - onsize size = stat label $ - json (++ aside "clean up with git-annex unused") $ - return $ roughSize storageUnits False size - keysizes keys = do - dir <- lift $ fromRepo dirspec - liftIO $ forM keys $ \k -> catchDefaultIO 0 $ - fromIntegral . fileSize - <$> getFileStatus (dir keyFile k) - -aside :: String -> String -aside s = " (" ++ s ++ ")" - -multiLine :: [String] -> String -multiLine = concatMap (\l -> "\n\t" ++ l) +checkNew :: FilePath -> Annex Status +checkNew f = ifM (isJust <$> catObjectDetails (Git.Ref.fileRef f)) + ( return ModifiedFile + , return NewFile + ) diff --git a/Command/Sync.hs b/Command/Sync.hs index 1fbd9c0288..c41f46f8a6 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -45,13 +45,15 @@ seek rs = do prepMerge -- There may not be a branch checked out until after the commit, - -- so only look it up once needed, and only look it up once. + -- or perhaps after it gets merged from the remote. + -- So only look it up once it's needed, and if once there is a + -- branch, cache it. mvar <- liftIO newEmptyMVar let getbranch = ifM (liftIO $ isEmptyMVar mvar) ( do - branch <- fromMaybe (error "no branch is checked out") - <$> inRepo Git.Branch.current - liftIO $ putMVar mvar branch + branch <- inRepo Git.Branch.current + when (isJust branch) $ + liftIO $ putMVar mvar branch return branch , liftIO $ readMVar mvar ) @@ -73,10 +75,10 @@ prepMerge :: Annex () prepMerge = liftIO . setCurrentDirectory =<< fromRepo Git.repoPath syncBranch :: Git.Ref -> Git.Ref -syncBranch = Git.Ref.under "refs/heads/synced/" +syncBranch = Git.Ref.under "refs/heads/synced" . fromDirectBranch remoteBranch :: Remote -> Git.Ref -> Git.Ref -remoteBranch remote = Git.Ref.under $ "refs/remotes/" ++ Remote.name remote +remoteBranch remote = Git.Ref.underBase $ "refs/remotes/" ++ Remote.name remote syncRemotes :: [String] -> Annex [Remote] syncRemotes rs = ifM (Annex.getState Annex.fast) ( nub <$> pickfast , wanted ) @@ -116,8 +118,9 @@ commit = next $ next $ ifM isDirect _ <- inRepo $ tryIO . Git.Command.runQuiet params return True -mergeLocal :: Git.Ref -> CommandStart -mergeLocal branch = go =<< needmerge +mergeLocal :: Maybe Git.Ref -> CommandStart +mergeLocal Nothing = stop +mergeLocal (Just branch) = go =<< needmerge where syncbranch = syncBranch branch needmerge = ifM isBareRepo @@ -132,9 +135,16 @@ mergeLocal branch = go =<< needmerge showStart "merge" $ Git.Ref.describe syncbranch next $ next $ mergeFrom syncbranch -pushLocal :: Git.Ref -> CommandStart -pushLocal branch = do +pushLocal :: Maybe Git.Ref -> CommandStart +pushLocal Nothing = stop +pushLocal (Just branch) = do + -- Update the sync branch to match the new state of the branch inRepo $ updateBranch $ syncBranch branch + -- In direct mode, we're operating on some special direct mode + -- branch, rather than the intended branch, so update the indended + -- branch. + whenM isDirect $ + inRepo $ updateBranch $ fromDirectBranch branch stop updateBranch :: Git.Ref -> Git.Repo -> IO () @@ -147,13 +157,13 @@ updateBranch syncbranch g = , Param $ show $ Git.Ref.base syncbranch ] g -pullRemote :: Remote -> Git.Ref -> CommandStart +pullRemote :: Remote -> Maybe Git.Ref -> CommandStart pullRemote remote branch = do showStart "pull" (Remote.name remote) next $ do showOutput stopUnless fetch $ - next $ mergeRemote remote (Just branch) + next $ mergeRemote remote branch where fetch = inRepo $ Git.Command.runBool [Param "fetch", Param $ Remote.name remote] @@ -175,8 +185,9 @@ mergeRemote remote b = case b of branchlist Nothing = [] branchlist (Just branch) = [branch, syncBranch branch] -pushRemote :: Remote -> Git.Ref -> CommandStart -pushRemote remote branch = go =<< needpush +pushRemote :: Remote -> Maybe Git.Ref -> CommandStart +pushRemote _remote Nothing = stop +pushRemote remote (Just branch) = go =<< needpush where needpush = anyM (newer remote) [syncBranch branch, Annex.Branch.name] go False = stop @@ -227,7 +238,7 @@ pushBranch remote branch g = tryIO (directpush g) `after` syncpush g , refspec branch ] directpush = Git.Command.runQuiet $ pushparams - [show $ Git.Ref.base branch] + [show $ Git.Ref.base $ fromDirectBranch branch] pushparams branches = [ Param "push" , Param $ Remote.name remote @@ -310,6 +321,7 @@ resolveMerge = do , Param "-m" , Param "git-annex automatic merge conflict fix" ] + showLongNote "Merge conflict was automatically resolved; you may want to examine the result." return merged resolveMerge' :: LsFiles.Unmerged -> Annex (Maybe FilePath) diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs index 3270ad8f79..5bb53d98d9 100644 --- a/Command/TransferKey.hs +++ b/Command/TransferKey.hs @@ -56,4 +56,4 @@ fromPerform remote key file = go $ getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p go :: Annex Bool -> CommandPerform -go a = ifM a ( liftIO exitSuccess, liftIO exitFailure) +go a = a >>= liftIO . exitBool diff --git a/Command/Unused.hs b/Command/Unused.hs index 844cdb19b5..1e5cdc1632 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -332,11 +332,13 @@ withUnusedMaps a params = do unused <- readUnusedLog "" unusedbad <- readUnusedLog "bad" unusedtmp <- readUnusedLog "tmp" + let m = unused `M.union` unusedbad `M.union` unusedtmp return $ map (a $ UnusedMaps unused unusedbad unusedtmp) $ - concatMap unusedSpec params + concatMap (unusedSpec m) params -unusedSpec :: String -> [Int] -unusedSpec spec +unusedSpec :: UnusedMap -> String -> [Int] +unusedSpec m spec + | spec == "all" = [fst (M.findMin m)..fst (M.findMax m)] | "-" `isInfixOf` spec = range $ separate (== '-') spec | otherwise = maybe badspec (: []) (readish spec) where diff --git a/Command/Upgrade.hs b/Command/Upgrade.hs index 88ca8622d3..c6c0f7a8c4 100644 --- a/Command/Upgrade.hs +++ b/Command/Upgrade.hs @@ -11,6 +11,7 @@ import Common.Annex import Command import Upgrade import Annex.Version +import Config def :: [Command] def = [dontCheck repoExists $ -- because an old version may not seem to exist @@ -23,6 +24,5 @@ seek = [withNothing start] start :: CommandStart start = do showStart "upgrade" "." - r <- upgrade - setVersion defaultVersion + r <- upgrade False next $ next $ return r diff --git a/Command/Watch.hs b/Command/Watch.hs index 0b34b0f846..a33fc633c0 100644 --- a/Command/Watch.hs +++ b/Command/Watch.hs @@ -32,5 +32,5 @@ start :: Bool -> Bool -> Bool -> Maybe Duration -> CommandStart start assistant foreground stopdaemon startdelay = do if stopdaemon then stopDaemon - else startDaemon assistant foreground startdelay Nothing Nothing -- does not return + else startDaemon assistant foreground startdelay Nothing Nothing Nothing -- does not return stop diff --git a/Command/WebApp.hs b/Command/WebApp.hs index 88c1537d0d..70f28a1138 100644 --- a/Command/WebApp.hs +++ b/Command/WebApp.hs @@ -30,6 +30,8 @@ import qualified Git.CurrentRepo import qualified Annex import Config.Files import qualified Option +import Upgrade +import Annex.Version import Control.Concurrent import Control.Concurrent.STM @@ -56,10 +58,14 @@ start = start' True start' :: Bool -> Maybe HostName -> CommandStart start' allowauto listenhost = do liftIO ensureInstalled - ifM isInitialized ( go , auto ) + ifM isInitialized + ( go + , auto + ) stop where go = do + cannotrun <- needsUpgrade . fromMaybe (error "no version") =<< getVersion browser <- fromRepo webBrowser f <- liftIO . absPath =<< fromRepo gitAnnexHtmlShim ifM (checkpid <&&> checkshim f) @@ -69,7 +75,7 @@ start' allowauto listenhost = do url <- liftIO . readFile =<< fromRepo gitAnnexUrlFile liftIO $ openBrowser browser f url Nothing Nothing - , startDaemon True True Nothing listenhost $ Just $ + , startDaemon True True Nothing cannotrun listenhost $ Just $ \origout origerr url htmlshim -> if isJust listenhost then maybe noop (`hPutStrLn` url) origout @@ -133,7 +139,7 @@ firstRun listenhost = do let callback a = Just $ a v runAssistant d $ do startNamedThread urlrenderer $ - webAppThread d urlrenderer True listenhost + webAppThread d urlrenderer True Nothing listenhost (callback signaler) (callback mainthread) waitNamedThreads @@ -155,7 +161,7 @@ firstRun listenhost = do _wait <- takeMVar v state <- Annex.new =<< Git.CurrentRepo.get Annex.eval state $ - startDaemon True True Nothing listenhost $ Just $ + startDaemon True True Nothing Nothing listenhost $ Just $ sendurlback v sendurlback v _origout _origerr url _htmlshim = do recordUrl url diff --git a/Config.hs b/Config.hs index ac251983a5..0c6b64f50d 100644 --- a/Config.hs +++ b/Config.hs @@ -71,11 +71,6 @@ getNumCopies Nothing = annexNumCopies <$> Annex.getGitConfig isDirect :: Annex Bool isDirect = annexDirect <$> Annex.getGitConfig -setDirect :: Bool -> Annex () -setDirect b = do - setConfig (annexConfig "direct") (Git.Config.boolConfig b) - Annex.changeGitConfig $ \c -> c { annexDirect = b } - crippledFileSystem :: Annex Bool crippledFileSystem = annexCrippledFileSystem <$> Annex.getGitConfig diff --git a/Git/Branch.hs b/Git/Branch.hs index 01d028f55f..7b3297d74d 100644 --- a/Git/Branch.hs +++ b/Git/Branch.hs @@ -13,7 +13,7 @@ import Common import Git import Git.Sha import Git.Command -import Git.Ref (headRef) +import qualified Git.Ref {- The currently checked out branch. - @@ -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 headRef] r + <$> pipeReadStrict [Param "symbolic-ref", Param $ show Git.Ref.headRef] r where parse l | null l = Nothing @@ -97,7 +97,7 @@ commit message branch parentrefs repo = do sha <- getSha "commit-tree" $ pipeWriteRead (map Param $ ["commit-tree", show tree] ++ ps) (Just $ flip hPutStr message) repo - run [Param "update-ref", Param $ show branch, Param $ show sha] repo + update branch sha repo return sha where ps = concatMap (\r -> ["-p", show r]) parentrefs @@ -105,3 +105,29 @@ commit message branch parentrefs repo = do {- A leading + makes git-push force pushing a branch. -} forcePush :: String -> String forcePush b = "+" ++ b + +{- Updates a branch (or other ref) to a new Sha. -} +update :: Branch -> Sha -> Repo -> IO () +update branch sha = run + [ Param "update-ref" + , Param $ show branch + , Param $ show sha + ] + +{- Checks out a branch, creating it if necessary. -} +checkout :: Branch -> Repo -> IO () +checkout branch = run + [ Param "checkout" + , Param "-q" + , Param "-B" + , Param $ show $ Git.Ref.base branch + ] + +{- Removes a branch. -} +delete :: Branch -> Repo -> IO () +delete branch = run + [ Param "branch" + , Param "-q" + , Param "-D" + , Param $ show $ Git.Ref.base branch + ] diff --git a/Git/Command.hs b/Git/Command.hs index 8b027d2c3c..adcc53bcdd 100644 --- a/Git/Command.hs +++ b/Git/Command.hs @@ -21,7 +21,8 @@ import Git.FilePath {- Constructs a git command line operating on the specified repo. -} gitCommandLine :: [CommandParam] -> Repo -> [CommandParam] -gitCommandLine params Repo { location = l@(Local _ _ ) } = setdir : settree ++ params +gitCommandLine params r@(Repo { location = l@(Local _ _ ) }) = + setdir : settree ++ gitGlobalOpts r ++ params where setdir = Param $ "--git-dir=" ++ gitpath (gitdir l) settree = case worktree l of diff --git a/Git/Config.hs b/Git/Config.hs index a41712addf..b5c1be04a2 100644 --- a/Git/Config.hs +++ b/Git/Config.hs @@ -110,8 +110,13 @@ store s repo = do -} updateLocation :: Repo -> IO Repo updateLocation r@(Repo { location = LocalUnknown d }) - | isBare r = updateLocation' r $ Local d Nothing - | otherwise = updateLocation' r $ Local (d ".git") (Just d) + | isBare r = ifM (doesDirectoryExist dotgit) + ( updateLocation' r $ Local dotgit Nothing + , updateLocation' r $ Local d Nothing + ) + | otherwise = updateLocation' r $ Local dotgit (Just d) + where + dotgit = (d ".git") updateLocation r@(Repo { location = l@(Local {}) }) = updateLocation' r l updateLocation r = return r @@ -153,7 +158,10 @@ boolConfig True = "true" boolConfig False = "false" isBare :: Repo -> Bool -isBare r = fromMaybe False $ isTrue =<< getMaybe "core.bare" r +isBare r = fromMaybe False $ isTrue =<< getMaybe coreBare r + +coreBare :: String +coreBare = "core.bare" {- Runs a command to get the configuration of a repo, - and returns a repo populated with the configuration, as well as the raw diff --git a/Git/Construct.hs b/Git/Construct.hs index 6514b80bce..71a13f49f9 100644 --- a/Git/Construct.hs +++ b/Git/Construct.hs @@ -104,14 +104,16 @@ localToUrl :: Repo -> Repo -> Repo localToUrl reference r | not $ repoIsUrl reference = error "internal error; reference repo not url" | repoIsUrl r = r - | otherwise = r { location = Url $ fromJust $ parseURI absurl } - where - absurl = concat - [ Url.scheme reference - , "//" - , Url.authority reference - , repoPath r - ] + | otherwise = case Url.authority reference of + Nothing -> r + Just auth -> + let absurl = concat + [ Url.scheme reference + , "//" + , auth + , repoPath r + ] + in r { location = Url $ fromJust $ parseURI absurl } {- Calculates a list of a repo's configured remotes, by parsing its config. -} fromRemotes :: Repo -> IO [Repo] @@ -228,6 +230,7 @@ newFrom l = return Repo , remotes = [] , remoteName = Nothing , gitEnv = Nothing + , gitGlobalOpts = [] } diff --git a/Git/Fsck.hs b/Git/Fsck.hs index 2c94230054..8bfddb4ba9 100644 --- a/Git/Fsck.hs +++ b/Git/Fsck.hs @@ -17,7 +17,6 @@ import Common import Git import Git.Command import Git.Sha -import Git.CatFile import Utility.Batch import qualified Data.Set as S @@ -40,7 +39,7 @@ type FsckResults = Maybe MissingObjects findBroken :: Bool -> Repo -> IO FsckResults findBroken batchmode r = do (output, fsckok) <- processTranscript command' (toCommand params') Nothing - let objs = parseFsckOutput output + let objs = findShas output badobjs <- findMissing objs r if S.null badobjs && not fsckok then return Nothing @@ -57,30 +56,23 @@ foundBroken (Just s) = not (S.null s) {- Finds objects that are missing from the git repsitory, or are corrupt. - - - Note that catting a corrupt object will cause cat-file to crash; - - this is detected and it's restarted. + - This does not use git cat-file --batch, because catting a corrupt + - object can cause it to crash, or to report incorrect size information.a -} findMissing :: [Sha] -> Repo -> IO MissingObjects -findMissing objs r = go objs [] =<< start +findMissing objs r = S.fromList <$> filterM (not <$$> present) objs where - start = catFileStart' False r - go [] c h = do - catFileStop h - return $ S.fromList c - go (o:os) c h = do - v <- tryIO $ isNothing <$> catObjectDetails h o - case v of - Left _ -> do - void $ tryIO $ catFileStop h - go os (o:c) =<< start - Right True -> go os (o:c) h - Right False -> go os c h + present o = either (const False) (const True) <$> tryIO (dump o) + dump o = runQuiet + [ Param "show" + , Param (show o) + ] r -parseFsckOutput :: String -> [Sha] -parseFsckOutput = catMaybes . map extractSha . concat . map words . lines +findShas :: String -> [Sha] +findShas = catMaybes . map extractSha . concat . map words . lines fsckParams :: Repo -> [CommandParam] -fsckParams = gitCommandLine +fsckParams = gitCommandLine $ [ Param "fsck" , Param "--no-dangling" , Param "--no-reflogs" diff --git a/Git/GCrypt.hs b/Git/GCrypt.hs index 0da68bf24f..156441daeb 100644 --- a/Git/GCrypt.hs +++ b/Git/GCrypt.hs @@ -15,7 +15,6 @@ import Git.Construct import qualified Git.Config as Config import qualified Git.Command as Command import Utility.Gpg -import Git.Remote urlPrefix :: String urlPrefix = "gcrypt::" diff --git a/Git/Hook.hs b/Git/Hook.hs new file mode 100644 index 0000000000..d56a4a5651 --- /dev/null +++ b/Git/Hook.hs @@ -0,0 +1,54 @@ +{- git hooks + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Git.Hook where + +import Common +import Git +import Utility.Tmp + +data Hook = Hook + { hookName :: FilePath + , hookScript :: String + } + +hookFile :: Hook -> Repo -> FilePath +hookFile h r = localGitDir r "hooks" hookName h + +{- Writes a hook. Returns False if the hook already exists with a different + - content. -} +hookWrite :: Hook -> Repo -> IO Bool +hookWrite h r = do + let f = hookFile h r + ifM (doesFileExist f) + ( expectedContent h r + , do + viaTmp writeFile f (hookScript h) + p <- getPermissions f + setPermissions f $ p {executable = True} + return True + ) + +{- Removes a hook. Returns False if the hook contained something else, and + - could not be removed. -} +hookUnWrite :: Hook -> Repo -> IO Bool +hookUnWrite h r = do + let f = hookFile h r + ifM (doesFileExist f) + ( ifM (expectedContent h r) + ( do + removeFile f + return True + , return False + ) + , return True + ) + +expectedContent :: Hook -> Repo -> IO Bool +expectedContent h r = do + content <- readFile $ hookFile h r + return $ content == hookScript h diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs index 98cbac58e8..8aaa09067f 100644 --- a/Git/LsFiles.hs +++ b/Git/LsFiles.hs @@ -11,6 +11,7 @@ module Git.LsFiles ( allFiles, deleted, modified, + modifiedOthers, staged, stagedNotDeleted, stagedOthersDetails, @@ -65,6 +66,12 @@ modified l repo = pipeNullSplit params repo where params = [Params "ls-files --modified -z --"] ++ map File l +{- Files that have been modified or are not checked into git. -} +modifiedOthers :: [FilePath] -> Repo -> IO ([FilePath], IO Bool) +modifiedOthers l repo = pipeNullSplit params repo + where + params = [Params "ls-files --modified --others -z --"] ++ map File l + {- Returns a list of all files that are staged for commit. -} staged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool) staged = staged' [] diff --git a/Git/Objects.hs b/Git/Objects.hs index b1c5805332..d9d2c67018 100644 --- a/Git/Objects.hs +++ b/Git/Objects.hs @@ -9,6 +9,7 @@ module Git.Objects where import Common import Git +import Git.Sha objectsDir :: Repo -> FilePath objectsDir r = localGitDir r "objects" @@ -16,12 +17,17 @@ objectsDir r = localGitDir r "objects" packDir :: Repo -> FilePath packDir r = objectsDir r "pack" +packIdxFile :: FilePath -> FilePath +packIdxFile = flip replaceExtension "idx" + listPackFiles :: Repo -> IO [FilePath] listPackFiles r = filter (".pack" `isSuffixOf`) <$> catchDefaultIO [] (dirContents $ packDir r) -packIdxFile :: FilePath -> FilePath -packIdxFile = flip replaceExtension "idx" +listLooseObjectShas :: Repo -> IO [Sha] +listLooseObjectShas r = catchDefaultIO [] $ + mapMaybe (extractSha . concat . reverse . take 2 . reverse . splitDirectories) + <$> dirContentsRecursiveSkipping (== "pack") (objectsDir r) looseObjectFile :: Repo -> Sha -> FilePath looseObjectFile r sha = objectsDir r prefix rest diff --git a/Git/Ref.hs b/Git/Ref.hs index 954b61a2e5..6ce1b87845 100644 --- a/Git/Ref.hs +++ b/Git/Ref.hs @@ -29,17 +29,42 @@ base = Ref . remove "refs/heads/" . remove "refs/remotes/" . show | prefix `isPrefixOf` s = drop (length prefix) s | otherwise = s +{- Given a directory and any ref, takes the basename of the ref and puts + - it under the directory. -} +under :: String -> Ref -> Ref +under dir r = Ref $ dir ++ "/" ++ + (reverse $ takeWhile (/= '/') $ reverse $ show 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. -} -under :: String -> Ref -> Ref -under dir r = Ref $ dir show (base r) +underBase :: String -> Ref -> Ref +underBase dir r = Ref $ dir ++ "/" ++ show (base r) + +{- A Ref that can be used to refer to a file in the repository, as staged + - in the index. + - + - Prefixing the file with ./ makes this work even if in a subdirectory + - of a repo. + -} +fileRef :: FilePath -> Ref +fileRef f = Ref $ ":./" ++ f + +{- A Ref that can be used to refer to a file in the repository as it + - appears in a given Ref. -} +fileFromRef :: Ref -> FilePath -> Ref +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] +{- 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 + {- Checks if HEAD exists. It generally will, except for in a repository - that was just created. -} headExists :: Repo -> IO Bool diff --git a/Git/Remote.hs b/Git/Remote.hs index dfb6a721c0..9d969c416e 100644 --- a/Git/Remote.hs +++ b/Git/Remote.hs @@ -11,6 +11,7 @@ module Git.Remote where import Common import Git +import Git.Types import qualified Git.Command import qualified Git.BuildVersion @@ -21,8 +22,6 @@ import Network.URI import Git.FilePath #endif -type RemoteName = String - {- Construct a legal git remote name out of an arbitrary input string. - - There seems to be no formal definition of this in the git source, @@ -62,6 +61,10 @@ remoteLocationIsUrl :: RemoteLocation -> Bool remoteLocationIsUrl (RemoteUrl _) = True remoteLocationIsUrl _ = False +remoteLocationIsSshUrl :: RemoteLocation -> Bool +remoteLocationIsSshUrl (RemoteUrl u) = "ssh://" `isPrefixOf` u +remoteLocationIsSshUrl _ = False + {- Determines if a given remote location is an url, or a local - path. Takes the repository's insteadOf configuration into account. -} parseRemoteLocation :: String -> Repo -> RemoteLocation diff --git a/Git/Repair.hs b/Git/Repair.hs index fb877bfb76..2fe9f38960 100644 --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -8,12 +8,14 @@ module Git.Repair ( runRepair, runRepairOf, + successfulRepair, cleanCorruptObjects, retrieveMissingObjects, resetLocalBranches, removeTrackingBranches, - rewriteIndex, checkIndex, + missingIndex, + nukeIndex, emptyGoodCommits, ) where @@ -34,71 +36,38 @@ import qualified Git.UpdateIndex as UpdateIndex import qualified Git.Branch as Branch import Utility.Tmp import Utility.Rsync +import Utility.FileMode import qualified Data.Set as S import qualified Data.ByteString.Lazy as L import Data.Tuple.Utils -{- Given a set of bad objects found by git fsck, removes all - - corrupt objects, and returns a list of missing objects, - - which need to be found elsewhere to finish recovery. - - - - Since git fsck may crash on corrupt objects, and so not - - report the full set of corrupt or missing objects, - - this removes corrupt objects, and re-runs fsck, until it - - stabalizes. - - - - To remove corrupt objects, unpack all packs, and remove the packs - - (to handle corrupt packs), and remove loose object files. +{- Given a set of bad objects found by git fsck, which may not + - be complete, finds and removes all corrupt objects, and + - returns a list of missing objects, which need to be + - found elsewhere to finish recovery. -} -cleanCorruptObjects :: FsckResults -> Repo -> IO MissingObjects -cleanCorruptObjects mmissing r = check mmissing - where - check Nothing = do - putStrLn "git fsck found a problem but no specific broken objects. Perhaps a corrupt pack file?" - ifM (explodePacks r) - ( retry S.empty - , return S.empty - ) - check (Just bad) - | S.null bad = return S.empty - | otherwise = do - putStrLn $ unwords - [ "git fsck found" - , show (S.size bad) - , "broken objects." - ] - exploded <- explodePacks r - removed <- removeLoose r bad - if exploded || removed - then retry bad - else return bad - retry oldbad = do - putStrLn "Re-running git fsck to see if it finds more problems." - v <- findBroken False r - case v of - Nothing -> error $ unwords - [ "git fsck found a problem, which was not corrected after removing" - , show (S.size oldbad) - , "corrupt objects." - ] - Just newbad -> do - removed <- removeLoose r newbad - let s = S.union oldbad newbad - if not removed || s == oldbad - then return s - else retry s +cleanCorruptObjects :: FsckResults -> Repo -> IO (Maybe MissingObjects) +cleanCorruptObjects fsckresults r = do + void $ explodePacks r + objs <- listLooseObjectShas r + bad <- findMissing objs r + void $ removeLoose r $ S.union bad (fromMaybe S.empty fsckresults) + -- Rather than returning the loose objects that were removed, re-run + -- fsck. Other missing objects may have been in the packs, + -- and this way fsck will find them. + findBroken False r removeLoose :: Repo -> MissingObjects -> IO Bool removeLoose r s = do - let fs = map (looseObjectFile r) (S.toList s) - count <- length <$> filterM doesFileExist fs - if (count > 0) + fs <- filterM doesFileExist (map (looseObjectFile r) (S.toList s)) + let count = length fs + if count > 0 then do putStrLn $ unwords - [ "removing" + [ "Removing" , show count - , "corrupt loose objects" + , "corrupt loose objects." ] mapM_ nukeFile fs return True @@ -114,57 +83,62 @@ explodePacks r = do mapM_ go packs return True where - go packfile = do + go packfile = withTmpFileIn (localGitDir r) "pack" $ \tmp _ -> do + moveFile packfile tmp + nukeFile $ packIdxFile packfile + allowRead tmp -- May fail, if pack file is corrupt. void $ tryIO $ - pipeWrite [Param "unpack-objects"] r $ \h -> - L.hPut h =<< L.readFile packfile - nukeFile packfile - nukeFile $ packIdxFile packfile + pipeWrite [Param "unpack-objects", Param "-r"] r $ \h -> + L.hPut h =<< L.readFile tmp {- Try to retrieve a set of missing objects, from the remotes of a - repository. Returns any that could not be retreived. - - + - - If another clone of the repository exists locally, which might not be a - remote of the repo being repaired, its path can be passed as a reference - repository. + + - Can also be run with Nothing, if it's not known which objects are + - missing, just that some are. (Ie, fsck failed badly.) -} -retrieveMissingObjects :: MissingObjects -> Maybe FilePath -> Repo -> IO MissingObjects +retrieveMissingObjects :: Maybe MissingObjects -> Maybe FilePath -> Repo -> IO (Maybe MissingObjects) retrieveMissingObjects missing referencerepo r - | S.null missing = return missing + | missing == Just S.empty = return $ Just S.empty | otherwise = withTmpDir "tmprepo" $ \tmpdir -> do unlessM (boolSystem "git" [Params "init", File tmpdir]) $ error $ "failed to create temp repository in " ++ tmpdir tmpr <- Config.read =<< Construct.fromAbsPath tmpdir stillmissing <- pullremotes tmpr (remotes r) fetchrefstags missing - if S.null stillmissing - then return stillmissing + if stillmissing == Just S.empty + then return $ Just S.empty else pullremotes tmpr (remotes r) fetchallrefs stillmissing where pullremotes tmpr [] fetchrefs stillmissing = case referencerepo of Nothing -> return stillmissing Just p -> ifM (fetchfrom p fetchrefs tmpr) ( do + void $ explodePacks tmpr void $ copyObjects tmpr r - findMissing (S.toList stillmissing) r + case stillmissing of + Nothing -> return $ Just S.empty + Just s -> Just <$> findMissing (S.toList s) r , return stillmissing ) - pullremotes tmpr (rmt:rmts) fetchrefs s - | S.null s = return s + pullremotes tmpr (rmt:rmts) fetchrefs ms + | ms == Just S.empty = return $ Just S.empty | otherwise = do - putStrLn $ "Trying to recover missing objects from remote " ++ repoDescribe rmt + putStrLn $ "Trying to recover missing objects from remote " ++ repoDescribe rmt ++ "." ifM (fetchfrom (repoLocation rmt) fetchrefs tmpr) ( do + void $ explodePacks tmpr void $ copyObjects tmpr r - stillmissing <- findMissing (S.toList s) r - pullremotes tmpr rmts fetchrefs stillmissing - , do - putStrLn $ unwords - [ "failed to fetch from remote" - , repoDescribe rmt - , "(will continue without it, but making this remote available may improve recovery)" - ] - pullremotes tmpr rmts fetchrefs s + case ms of + Nothing -> pullremotes tmpr rmts fetchrefs ms + Just s -> do + stillmissing <- findMissing (S.toList s) r + pullremotes tmpr rmts fetchrefs (Just stillmissing) + , pullremotes tmpr rmts fetchrefs ms ) fetchfrom fetchurl ps = runBool $ [ Param "fetch" @@ -178,7 +152,7 @@ retrieveMissingObjects missing referencerepo r fetchallrefs = [ Param "+*:*" ] {- Copies all objects from the src repository to the dest repository. - - This is done using rsync, so it copies all missing object, and all + - This is done using rsync, so it copies all missing objects, and all - objects they rely on. -} copyObjects :: Repo -> Repo -> IO Bool copyObjects srcr destr = rsync @@ -237,51 +211,44 @@ removeTrackingBranches missing goodcommits r = {- Gets all refs, including ones that are corrupt. - git show-ref does not output refs to commits that are directly - corrupted, so it is not used. + - + - Relies on packed refs being exploded before it's called. -} getAllRefs :: Repo -> IO [Ref] -getAllRefs r = do - packedrs <- mapMaybe parsePacked . lines - <$> catchDefaultIO "" (readFile $ packedRefsFile r) - loosers <- map toref <$> dirContentsRecursive refdir - return $ packedrs ++ loosers +getAllRefs r = map toref <$> dirContentsRecursive refdir where refdir = localGitDir r "refs" toref = Ref . relPathDirToFile (localGitDir r) +explodePackedRefsFile :: Repo -> IO () +explodePackedRefsFile r = do + let f = packedRefsFile r + whenM (doesFileExist f) $ do + rs <- mapMaybe parsePacked . lines + <$> catchDefaultIO "" (safeReadFile f) + forM_ rs makeref + nukeFile f + where + makeref (sha, ref) = do + let dest = localGitDir r ++ show ref + createDirectoryIfMissing True (parentDir dest) + unlessM (doesFileExist dest) $ + writeFile dest (show sha) + packedRefsFile :: Repo -> FilePath packedRefsFile r = localGitDir r "packed-refs" -parsePacked :: String -> Maybe Ref +parsePacked :: String -> Maybe (Sha, Ref) parsePacked l = case words l of (sha:ref:[]) - | isJust (extractSha sha) -> Just $ Ref ref + | isJust (extractSha sha) && Ref.legal True ref -> + Just (Ref sha, Ref ref) _ -> Nothing {- git-branch -d cannot be used to remove a branch that is directly - - pointing to a corrupt commit. However, it's tried first. -} + - pointing to a corrupt commit. -} nukeBranchRef :: Branch -> Repo -> IO () -nukeBranchRef b r = void $ usegit <||> byhand - where - usegit = runBool - [ Param "branch" - , Params "-r -d" - , Param $ show $ Ref.base b - ] r - byhand = do - nukeFile $ localGitDir r show b - whenM (doesFileExist packedrefs) $ - withTmpFile "packed-refs" $ \tmp h -> do - ls <- lines <$> readFile packedrefs - hPutStr h $ unlines $ - filter (not . skiprefline) ls - hClose h - renameFile tmp packedrefs - return True - skiprefline l = case parsePacked l of - Just packedref - | packedref == b -> True - _ -> False - packedrefs = packedRefsFile r +nukeBranchRef b r = nukeFile $ localGitDir r show 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. @@ -368,7 +335,9 @@ verifyTree missing treesha r -- as long as ls-tree succeeded, we're good else cleanup -{- Checks that the index file only refers to objects that are not missing. -} +{- Checks that the index file only refers to objects that are not missing, + - and is not itself corrupt. Note that a missing index file is not + - considered a problem (repo may be new). -} checkIndex :: MissingObjects -> Repo -> IO Bool checkIndex missing r = do (bad, _good, cleanup) <- partitionIndex missing r @@ -378,6 +347,9 @@ checkIndex missing r = do void cleanup return False +missingIndex :: Repo -> IO Bool +missingIndex r = not <$> doesFileExist (localGitDir r "index") + partitionIndex :: MissingObjects -> Repo -> IO ([LsFiles.StagedDetails], [LsFiles.StagedDetails], IO Bool) partitionIndex missing r = do (indexcontents, cleanup) <- LsFiles.stagedDetails [repoPath r] r @@ -396,7 +368,7 @@ rewriteIndex missing r | otherwise = do (bad, good, cleanup) <- partitionIndex missing r unless (null bad) $ do - nukeFile (localGitDir r "index") + nukeIndex r UpdateIndex.streamUpdateIndex r =<< (catMaybes <$> mapM reinject good) void cleanup @@ -408,6 +380,9 @@ rewriteIndex missing r UpdateIndex.stageFile sha blobtype file r reinject _ = return Nothing +nukeIndex :: Repo -> IO () +nukeIndex r = nukeFile (localGitDir r "index") + newtype GoodCommits = GoodCommits (S.Set Sha) emptyGoodCommits :: GoodCommits @@ -432,39 +407,88 @@ displayList items header | numitems > 10 = take 10 items ++ ["(and " ++ show (numitems - 10) ++ " more)"] | otherwise = items +{- Fix problems that would prevent repair from working at all + - + - A missing or corrupt .git/HEAD makes git not treat the repository as a + - git repo. If there is a git repo in a parent directory, it may move up + - the tree and use that one instead. So, cannot use `git show-ref HEAD` to + - test it. + - + - Explode the packed refs file, to simplify dealing with refs, and because + - fsck can complain about bad refs in it. + -} +preRepair :: Repo -> IO () +preRepair g = do + unlessM (validhead <$> catchDefaultIO "" (safeReadFile headfile)) $ do + nukeFile headfile + writeFile headfile "ref: refs/heads/master" + explodePackedRefsFile g + where + headfile = localGitDir g "HEAD" + validhead s = "ref: refs/" `isPrefixOf` s || isJust (extractSha s) + {- Put it all together. -} runRepair :: Bool -> Repo -> IO (Bool, MissingObjects, [Branch]) runRepair forced g = do + preRepair g putStrLn "Running git fsck ..." fsckresult <- findBroken False g if foundBroken fsckresult - then runRepairOf fsckresult forced Nothing g + then runRepair' fsckresult forced Nothing g else do putStrLn "No problems found." return (True, S.empty, []) runRepairOf :: FsckResults -> Bool -> Maybe FilePath -> Repo -> IO (Bool, MissingObjects, [Branch]) runRepairOf fsckresult forced referencerepo g = do + preRepair g + runRepair' fsckresult forced referencerepo g + +runRepair' :: FsckResults -> Bool -> Maybe FilePath -> Repo -> IO (Bool, MissingObjects, [Branch]) +runRepair' fsckresult forced referencerepo g = do missing <- cleanCorruptObjects fsckresult g stillmissing <- retrieveMissingObjects missing referencerepo g - if S.null stillmissing - then successfulfinish stillmissing [] - else do - putStrLn $ unwords - [ show (S.size stillmissing) - , "missing objects could not be recovered!" - ] - if forced - then continuerepairs stillmissing - else unsuccessfulfinish stillmissing + case stillmissing of + Just s + | S.null s -> if repoIsLocalBare g + then successfulfinish S.empty [] + else ifM (checkIndex S.empty g) + ( successfulfinish s [] + , do + putStrLn "No missing objects found, but the index file is corrupt!" + if forced + then corruptedindex + else needforce S.empty + ) + | otherwise -> if forced + then ifM (checkIndex s g) + ( continuerepairs s + , corruptedindex + ) + else do + putStrLn $ unwords + [ show (S.size s) + , "missing objects could not be recovered!" + ] + unsuccessfulfinish s + Nothing + | forced -> ifM (pure (repoIsLocalBare g) <||> checkIndex S.empty g) + ( do + missing' <- cleanCorruptObjects Nothing g + case missing' of + Nothing -> return (False, S.empty, []) + Just stillmissing' -> continuerepairs stillmissing' + , corruptedindex + ) + | otherwise -> unsuccessfulfinish S.empty where continuerepairs stillmissing = do (remotebranches, goodcommits) <- removeTrackingBranches stillmissing emptyGoodCommits g unless (null remotebranches) $ putStrLn $ unwords - [ "removed" + [ "Removed" , show (length remotebranches) - , "remote tracking branches that referred to missing objects" + , "remote tracking branches that referred to missing objects." ] (resetbranches, deletedbranches, _) <- resetLocalBranches stillmissing goodcommits g displayList (map show resetbranches) @@ -491,17 +515,37 @@ runRepairOf fsckresult forced referencerepo g = do putStrLn "Successfully recovered repository!" putStrLn "Please carefully check that the changes mentioned above are ok.." return (True, stillmissing, modifiedbranches) + + corruptedindex = do + nukeIndex g + -- The corrupted index can prevent fsck from finding other + -- problems, so re-run repair. + fsckresult' <- findBroken False g + result <- runRepairOf fsckresult' forced referencerepo g + putStrLn "Removed the corrupted index file. You should look at what files are present in your working tree and git add them back to the index when appropriate." + return result + successfulfinish stillmissing modifiedbranches = do mapM_ putStrLn [ "Successfully recovered repository!" - , "You should run \"git fsck\" to make sure, but it looks like" - , "everything was recovered ok." + , "You should run \"git fsck\" to make sure, but it looks like everything was recovered ok." ] return (True, stillmissing, modifiedbranches) unsuccessfulfinish stillmissing = do if repoIsLocalBare g then do - putStrLn "If you have a clone of this bare repository, you should add it as a remote of this repository, and re-run git-recover-repository." - putStrLn "If there are no clones of this repository, you can instead run git-recover-repository with the --force parameter to force recovery to a possibly usable state." - else putStrLn "To force a recovery to a usable state, run this command again with the --force parameter." + putStrLn "If you have a clone of this bare repository, you should add it as a remote of this repository, and retry." + putStrLn "If there are no clones of this repository, you can instead retry with the --force parameter to force recovery to a possibly usable state." + return (False, stillmissing, []) + else needforce stillmissing + needforce stillmissing = do + putStrLn "To force a recovery to a usable state, retry with the --force parameter." return (False, stillmissing, []) + +successfulRepair :: (Bool, MissingObjects, [Branch]) -> Bool +successfulRepair = fst3 + +safeReadFile :: FilePath -> IO String +safeReadFile f = do + allowRead f + readFileStrictAnyEncoding f diff --git a/Git/Types.hs b/Git/Types.hs index abfb99f9fe..e63e93077f 100644 --- a/Git/Types.hs +++ b/Git/Types.hs @@ -10,6 +10,7 @@ module Git.Types where import Network.URI import qualified Data.Map as M import System.Posix.Types +import Utility.SafeCommand {- Support repositories on local disk, and repositories accessed via an URL. - @@ -35,11 +36,15 @@ data Repo = Repo , fullconfig :: M.Map String [String] , remotes :: [Repo] -- remoteName holds the name used for this repo in remotes - , remoteName :: Maybe String + , remoteName :: Maybe RemoteName -- alternate environment to use when running git commands , gitEnv :: Maybe [(String, String)] + -- global options to pass to git when running git commands + , gitGlobalOpts :: [CommandParam] } deriving (Show, Eq) +type RemoteName = String + {- A git ref. Can be a sha1, or a branch or tag name. -} newtype Ref = Ref String deriving (Eq, Ord) diff --git a/Git/Url.hs b/Git/Url.hs index 7befc46690..d383a6acab 100644 --- a/Git/Url.hs +++ b/Git/Url.hs @@ -37,32 +37,33 @@ uriRegName' a = fixup $ uriRegName a fixup x = x {- Hostname of an URL repo. -} -host :: Repo -> String +host :: Repo -> Maybe String host = authpart uriRegName' {- Port of an URL repo, if it has a nonstandard one. -} port :: Repo -> Maybe Integer port r = case authpart uriPort r of - ":" -> Nothing - (':':p) -> readish p - _ -> Nothing + Nothing -> Nothing + Just ":" -> Nothing + Just (':':p) -> readish p + Just _ -> Nothing {- Hostname of an URL repo, including any username (ie, "user@host") -} -hostuser :: Repo -> String -hostuser r = authpart uriUserInfo r ++ authpart uriRegName' r +hostuser :: Repo -> Maybe String +hostuser r = (++) + <$> authpart uriUserInfo r + <*> authpart uriRegName' r {- The full authority portion an URL repo. (ie, "user@host:port") -} -authority :: Repo -> String +authority :: Repo -> Maybe String authority = authpart assemble where assemble a = uriUserInfo a ++ uriRegName' a ++ uriPort a {- Applies a function to extract part of the uriAuthority of an URL repo. -} -authpart :: (URIAuth -> a) -> Repo -> a -authpart a Repo { location = Url u } = a auth - where - auth = fromMaybe (error $ "bad url " ++ show u) (uriAuthority u) +authpart :: (URIAuth -> a) -> Repo -> Maybe a +authpart a Repo { location = Url u } = a <$> uriAuthority u authpart _ repo = notUrl repo notUrl :: Repo -> a diff --git a/GitAnnex.hs b/GitAnnex.hs index b73cd94162..61d8b918a4 100644 --- a/GitAnnex.hs +++ b/GitAnnex.hs @@ -5,7 +5,7 @@ - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, OverloadedStrings #-} module GitAnnex where @@ -46,6 +46,7 @@ import qualified Command.Whereis import qualified Command.List import qualified Command.Log import qualified Command.Merge +import qualified Command.Info import qualified Command.Status import qualified Command.Migrate import qualified Command.Uninit @@ -87,6 +88,9 @@ import qualified Command.XMPPGit import qualified Command.Test import qualified Command.FuzzTest #endif +#ifdef WITH_EKG +import System.Remote.Monitoring +#endif cmds :: [Command] cmds = concat @@ -140,6 +144,7 @@ cmds = concat , Command.List.def , Command.Log.def , Command.Merge.def + , Command.Info.def , Command.Status.def , Command.Migrate.def , Command.Map.def @@ -169,4 +174,8 @@ header :: String header = "git-annex command [option ...]" run :: [String] -> IO () -run args = dispatch True args cmds options [] header Git.CurrentRepo.get +run args = do +#ifdef WITH_EKG + _ <- forkServer "localhost" 4242 +#endif + dispatch True args cmds options [] header Git.CurrentRepo.get diff --git a/GitAnnex/Options.hs b/GitAnnex/Options.hs index 7f4cb60c2b..88fad948aa 100644 --- a/GitAnnex/Options.hs +++ b/GitAnnex/Options.hs @@ -11,6 +11,7 @@ import System.Console.GetOpt import Common.Annex import qualified Git.Config +import Git.Types import Command import Types.TrustLevel import qualified Annex @@ -59,12 +60,14 @@ options = Option.common ++ "Trust Amazon Glacier inventory" ] ++ Option.matcher where + trustArg t = ReqArg (Remote.forceTrust t) paramRemote setnumcopies v = maybe noop (\n -> Annex.changeState $ \s -> s { Annex.forcenumcopies = Just n }) (readish v) setuseragent v = Annex.changeState $ \s -> s { Annex.useragent = Just v } - setgitconfig v = Annex.changeGitRepo =<< inRepo (Git.Config.store v) - trustArg t = ReqArg (Remote.forceTrust t) paramRemote + setgitconfig v = inRepo (Git.Config.store v) + >>= pure . (\r -> r { gitGlobalOpts = gitGlobalOpts r ++ [Param "-c", Param v] }) + >>= Annex.changeGitRepo keyOptions :: [Option] keyOptions = diff --git a/Init.hs b/Init.hs index 7e7e5041d0..ad18039953 100644 --- a/Init.hs +++ b/Init.hs @@ -12,11 +12,10 @@ module Init ( isInitialized, initialize, uninitialize, - probeCrippledFileSystem + probeCrippledFileSystem, ) where import Common.Annex -import Utility.Tmp import Utility.Network import qualified Annex import qualified Git @@ -26,16 +25,18 @@ import qualified Annex.Branch import Logs.UUID import Annex.Version import Annex.UUID -import Utility.Shell import Config import Annex.Direct import Annex.Content.Direct import Annex.Environment +import Annex.Perms import Backend #ifndef mingw32_HOST_OS import Utility.UserInfo import Utility.FileMode #endif +import Annex.Hook +import Upgrade genDescription :: Maybe String -> Annex String genDescription (Just d) = return d @@ -53,10 +54,19 @@ genDescription Nothing = do initialize :: Maybe String -> Annex () initialize mdescription = do prepUUID - setVersion defaultVersion - checkCrippledFileSystem checkFifoSupport - gitPreCommitHookWrite + checkCrippledFileSystem + unlessM isBare $ + hookWrite preCommitHook + ifM (crippledFileSystem <&&> not <$> isBare) + ( do + enableDirectMode + setDirect True + setVersion directModeVersion + , do + setVersion defaultVersion + setDirect False + ) createInodeSentinalFile u <- getUUID {- This will make the first commit to git, so ensure git is set up @@ -67,16 +77,19 @@ initialize mdescription = do uninitialize :: Annex () uninitialize = do - gitPreCommitHookUnWrite + hookUnWrite preCommitHook removeRepoUUID removeVersion {- Will automatically initialize if there is already a git-annex - branch from somewhere. Otherwise, require a manual init - to avoid git-annex accidentially being run in git - - repos that did not intend to use it. -} + - repos that did not intend to use it. + - + - Checks repository version and handles upgrades too. + -} ensureInitialized :: Annex () -ensureInitialized = getVersion >>= maybe needsinit checkVersion +ensureInitialized = getVersion >>= maybe needsinit checkUpgrade where needsinit = ifM Annex.Branch.hasSibling ( initialize Nothing @@ -87,45 +100,8 @@ ensureInitialized = getVersion >>= maybe needsinit checkVersion isInitialized :: Annex Bool isInitialized = maybe Annex.Branch.hasSibling (const $ return True) =<< getVersion -{- set up a git pre-commit hook, if one is not already present -} -gitPreCommitHookWrite :: Annex () -gitPreCommitHookWrite = unlessBare $ do - hook <- preCommitHook - ifM (liftIO $ doesFileExist hook) - ( do - content <- liftIO $ readFile hook - when (content /= preCommitScript) $ - warning $ "pre-commit hook (" ++ hook ++ ") already exists, not configuring" - , unlessM crippledFileSystem $ - liftIO $ do - viaTmp writeFile hook preCommitScript - p <- getPermissions hook - setPermissions hook $ p {executable = True} - ) - -gitPreCommitHookUnWrite :: Annex () -gitPreCommitHookUnWrite = unlessBare $ do - hook <- preCommitHook - whenM (liftIO $ doesFileExist hook) $ - ifM (liftIO $ (==) preCommitScript <$> readFile hook) - ( liftIO $ removeFile hook - , warning $ "pre-commit hook (" ++ hook ++ - ") contents modified; not deleting." ++ - " Edit it to remove call to git annex." - ) - -unlessBare :: Annex () -> Annex () -unlessBare = unlessM $ fromRepo Git.repoIsLocalBare - -preCommitHook :: Annex FilePath -preCommitHook = () <$> fromRepo Git.localGitDir <*> pure "hooks/pre-commit" - -preCommitScript :: String -preCommitScript = unlines - [ shebang_local - , "# automatically configured by git-annex" - , "git annex pre-commit ." - ] +isBare :: Annex Bool +isBare = fromRepo Git.repoIsLocalBare {- A crippled filesystem is one that does not allow making symlinks, - or removing write access from files. -} @@ -136,9 +112,8 @@ probeCrippledFileSystem = do #else tmp <- fromRepo gitAnnexTmpDir let f = tmp "gaprobe" - liftIO $ do - createDirectoryIfMissing True tmp - writeFile f "" + createAnnexDirectory tmp + liftIO $ writeFile f "" uncrippled <- liftIO $ probe f liftIO $ removeFile f return $ not uncrippled @@ -158,25 +133,15 @@ checkCrippledFileSystem = whenM probeCrippledFileSystem $ do warning "Detected a crippled filesystem." setCrippledFileSystem True - {- Normally git disables core.symlinks itself when the filesystem does - - not support them, but in Cygwin, git does support symlinks, while - - git-annex, not linking with Cygwin, does not. -} + {- Normally git disables core.symlinks itself when the + - filesystem does not support them, but in Cygwin, git + - does support symlinks, while git-annex, not linking + - with Cygwin, does not. -} whenM (coreSymlinks <$> Annex.getGitConfig) $ do warning "Disabling core.symlinks." setConfig (ConfigKey "core.symlinks") (Git.Config.boolConfig False) - unlessBare $ do - unlessM isDirect $ do - warning "Enabling direct mode." - top <- fromRepo Git.repoPath - (l, clean) <- inRepo $ Git.LsFiles.inRepo [top] - forM_ l $ \f -> - maybe noop (`toDirect` f) =<< isAnnexLink f - void $ liftIO clean - setDirect True - setVersion directModeVersion - probeFifoSupport :: Annex Bool probeFifoSupport = do #ifdef mingw32_HOST_OS @@ -184,8 +149,8 @@ probeFifoSupport = do #else tmp <- fromRepo gitAnnexTmpDir let f = tmp "gaprobe" + createAnnexDirectory tmp liftIO $ do - createDirectoryIfMissing True tmp nukeFile f ms <- tryIO $ do createNamedPipe f ownerReadMode @@ -199,3 +164,12 @@ checkFifoSupport = unlessM probeFifoSupport $ do warning "Detected a filesystem without fifo support." warning "Disabling ssh connection caching." setConfig (annexConfig "sshcaching") (Git.Config.boolConfig False) + +enableDirectMode :: Annex () +enableDirectMode = unlessM isDirect $ do + warning "Enabling direct mode." + top <- fromRepo Git.repoPath + (l, clean) <- inRepo $ Git.LsFiles.inRepo [top] + forM_ l $ \f -> + maybe noop (`toDirect` f) =<< isAnnexLink f + void $ liftIO clean diff --git a/Logs/UUID.hs b/Logs/UUID.hs index ef1074e78b..154f86d512 100644 --- a/Logs/UUID.hs +++ b/Logs/UUID.hs @@ -56,7 +56,7 @@ fixBadUUID = M.fromList . map fixup . M.toList | otherwise = (k, v) where kuuid = fromUUID k - isbad = not (isuuid kuuid) && isuuid lastword + isbad = not (isuuid kuuid) && not (null ws) && isuuid lastword ws = words $ value v lastword = Prelude.last ws fixeduuid = toUUID lastword diff --git a/Logs/UUIDBased.hs b/Logs/UUIDBased.hs index c1901eef7f..10b3bf55d1 100644 --- a/Logs/UUIDBased.hs +++ b/Logs/UUIDBased.hs @@ -63,6 +63,11 @@ parseLogWithUUID :: (UUID -> String -> Maybe a) -> String -> Log a parseLogWithUUID parser = M.fromListWith best . mapMaybe parse . lines where parse line + -- This is a workaround for a bug that caused + -- NoUUID items to be stored in the log. + -- It can be removed at any time; is just here to clean + -- up logs where that happened temporarily. + | " " `isPrefixOf` line = Nothing | null ws = Nothing | otherwise = parser u (unwords info) >>= makepair where diff --git a/Makefile b/Makefile index 0f8fdd849e..92c5f6dcc6 100644 --- a/Makefile +++ b/Makefile @@ -30,12 +30,8 @@ git-annex-shell.1: doc/git-annex-shell.mdwn # These are not built normally. git-union-merge.1: doc/git-union-merge.mdwn ./Build/mdwn2man git-union-merge 1 doc/git-union-merge.mdwn > git-union-merge.1 -git-recover-repository.1: doc/git-recover-repository.mdwn - ./Build/mdwn2man git-recover-repository 1 doc/git-recover-repository.mdwn > git-recover-repository.1 git-union-merge: $(GHC) --make -threaded $@ -git-recover-repository: - $(GHC) --make -threaded $@ install-mans: $(mans) install -d $(DESTDIR)$(PREFIX)/share/man/man1 @@ -81,10 +77,10 @@ clean: rm -rf tmp dist git-annex $(mans) configure *.tix .hpc \ doc/.ikiwiki html dist tags Build/SysConfig.hs build-stamp \ Setup Build/InstallDesktopFile Build/EvilSplicer \ - Build/Standalone Build/OSXMkLibs \ - git-union-merge git-recover-repository - find -name \*.o -exec rm {} \; - find -name \*.hi -exec rm {} \; + Build/Standalone Build/OSXMkLibs Build/DistributionUpdate \ + git-union-merge + find . -name \*.o -exec rm {} \; + find . -name \*.hi -exec rm {} \; Build/InstallDesktopFile: Build/InstallDesktopFile.hs $(GHC) --make $@ @@ -137,6 +133,8 @@ linuxstandalone: Build/Standalone sort "$(LINUXSTANDALONE_DEST)/libdirs.tmp" | uniq > "$(LINUXSTANDALONE_DEST)/libdirs" rm -f "$(LINUXSTANDALONE_DEST)/libdirs.tmp" + cd tmp/git-annex.linux && find . -type f > git-annex.MANIFEST + cd tmp/git-annex.linux && find . -type l >> git-annex.MANIFEST cd tmp && tar czf git-annex-standalone-$(shell dpkg --print-architecture).tar.gz git-annex.linux OSXAPP_DEST=tmp/build-dmg/git-annex.app @@ -161,18 +159,18 @@ osxapp: Build/Standalone Build/OSXMkLibs install -d "$(OSXAPP_BASE)/templates" ./Build/OSXMkLibs $(OSXAPP_BASE) + cd $(OSXAPP_DEST) && find . -type f > Contents/MacOS/git-annex.MANIFEST + cd $(OSXAPP_DEST) && find . -type l >> Contents/MacOS/git-annex.MANIFEST rm -f tmp/git-annex.dmg - hdiutil create -size 640m -format UDRW -srcfolder tmp/build-dmg \ + hdiutil create -format UDBZ -srcfolder tmp/build-dmg \ -volname git-annex -o tmp/git-annex.dmg - rm -f tmp/git-annex.dmg.bz2 - bzip2 --fast tmp/git-annex.dmg -ANDROID_FLAGS?=-f-XMPP +ANDROID_FLAGS?= # Cross compile for Android. # Uses https://github.com/neurocyte/ghc-android android: Build/EvilSplicer echo "Running native build, to get TH splices.." - if [ ! -e dist/setup/setup ]; then $(CABAL) configure -f-Production -O0 $(ANDROID_FLAGS); fi + if [ ! -e dist/setup/setup ]; then $(CABAL) configure -f-Production -O0 $(ANDROID_FLAGS) -fAndroidSplice; fi mkdir -p tmp if ! $(CABAL) build --ghc-options=-ddump-splices 2> tmp/dump-splices; then tail tmp/dump-splices >&2; exit 1; fi echo "Setting up Android build tree.." @@ -189,14 +187,16 @@ android: Build/EvilSplicer sed -i 's/GHC-Options: \(.*\)-Wall/GHC-Options: \1-Wall -fno-warn-unused-imports /i' tmp/androidtree/git-annex.cabal # Cabal cannot cross compile with custom build type, so workaround. sed -i 's/Build-type: Custom/Build-type: Simple/' tmp/androidtree/git-annex.cabal - if [ ! -e tmp/androidtree/dist/setup/setup ]; then \ - cd tmp/androidtree && $$HOME/.ghc/android-14/arm-linux-androideabi-4.7/arm-linux-androideabi/bin/cabal configure -fAndroid $(ANDROID_FLAGS); \ +# Build just once, but link twice, for 2 different versions of Android. + mkdir -p tmp/androidtree/dist/build/git-annex/4.0 tmp/androidtree/dist/build/git-annex/4.3 + if [ ! -e tmp/androidtree/dist/setup-config ]; then \ + cd tmp/androidtree && $$HOME/.ghc/$(shell cat standalone/android/abiversion)/arm-linux-androideabi/bin/cabal configure -fAndroid $(ANDROID_FLAGS); \ fi - cd tmp/androidtree && $$HOME/.ghc/android-14/arm-linux-androideabi-4.7/arm-linux-androideabi/bin/cabal build - -adb: - ANDROID_FLAGS="-Production" $(MAKE) android - adb push tmp/androidtree/dist/build/git-annex/git-annex /data/data/ga.androidterm/bin/git-annex + cd tmp/androidtree && $$HOME/.ghc/$(shell cat standalone/android/abiversion)/arm-linux-androideabi/bin/cabal build \ + && mv dist/build/git-annex/git-annex dist/build/git-annex/4.0/git-annex + cd tmp/androidtree && $$HOME/.ghc/$(shell cat standalone/android/abiversion)/arm-linux-androideabi/bin/cabal build \ + --ghc-options=-optl-z --ghc-options=-optlnocopyreloc \ + && mv dist/build/git-annex/git-annex dist/build/git-annex/4.3/git-annex androidapp: $(MAKE) android @@ -221,4 +221,8 @@ hdevtools: hdevtools --stop-server || true hdevtools check git-annex.hs -g -cpp -g -i -g -idist/build/git-annex/git-annex-tmp -g -i. -g -idist/build/autogen -g -Idist/build/autogen -g -Idist/build/git-annex/git-annex-tmp -g -IUtility -g -DWITH_TESTSUITE -g -DWITH_S3 -g -DWITH_ASSISTANT -g -DWITH_INOTIFY -g -DWITH_DBUS -g -DWITH_PAIRING -g -DWITH_XMPP -g -optP-include -g -optPdist/build/autogen/cabal_macros.h -g -odir -g dist/build/git-annex/git-annex-tmp -g -hidir -g dist/build/git-annex/git-annex-tmp -g -stubdir -g dist/build/git-annex/git-annex-tmp -g -threaded -g -Wall -g -XHaskell98 -g -XPackageImports +distributionupdate: + ghc --make Build/DistributionUpdate + ./Build/DistributionUpdate + .PHONY: git-annex git-union-merge git-recover-repository tags build-stamp diff --git a/Remote.hs b/Remote.hs index 71db09ce76..e355b09751 100644 --- a/Remote.hs +++ b/Remote.hs @@ -24,6 +24,7 @@ module Remote ( remoteMap, uuidDescriptions, byName, + byNameOnly, byNameWithUUID, byCost, prettyPrintUUIDs, @@ -58,7 +59,7 @@ import Logs.Trust import Logs.Location hiding (logStatus) import Remote.List import Config -import Git.Remote +import Git.Types (RemoteName) {- Map from UUIDs of Remotes to a calculated value. -} remoteMap :: (Remote -> a) -> Annex (M.Map UUID a) @@ -89,11 +90,12 @@ byNameWithUUID = checkuuid <=< byName where checkuuid Nothing = return Nothing checkuuid (Just r) - | uuid r == NoUUID = do - let e = "cannot determine uuid for " ++ name r + | uuid r == NoUUID = if remoteAnnexIgnore (gitconfig r) - then error $ e ++ " (" ++ show (remoteConfig (repo r) "ignore") ++ " is set)" - else error e + then error $ noRemoteUUIDMsg r ++ + " (" ++ show (remoteConfig (repo r) "ignore") ++ + " is set)" + else error $ noRemoteUUIDMsg r | otherwise = return $ Just r byName' :: RemoteName -> Annex (Either String Remote) @@ -104,16 +106,27 @@ byName' n = handle . filter matching <$> remoteList handle (match:_) = Right match matching r = n == name r || toUUID n == uuid r +{- Only matches remote name, not UUID -} +byNameOnly :: RemoteName -> Annex (Maybe Remote) +byNameOnly n = headMaybe . filter matching <$> remoteList + where + matching r = n == name r + +noRemoteUUIDMsg :: Remote -> String +noRemoteUUIDMsg r = "cannot determine uuid for " ++ name r + {- Looks up a remote by name (or by UUID, or even by description), - - and returns its UUID. Finds even remotes that are not configured in - - .git/config. -} + - and returns its UUID. Finds even repositories that are not + - configured in .git/config. -} nameToUUID :: RemoteName -> Annex UUID nameToUUID "." = getUUID -- special case for current repo nameToUUID "here" = getUUID nameToUUID "" = error "no remote specified" nameToUUID n = byName' n >>= go where - go (Right r) = return $ uuid r + go (Right r) = case uuid r of + NoUUID -> error $ noRemoteUUIDMsg r + u -> return u go (Left e) = fromMaybe (error e) <$> bydescription bydescription = do m <- uuidMap diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 16535070ee..e6deee4bf4 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -56,7 +56,7 @@ gen r u c gc = do whereisKey = Nothing, remoteFsck = Nothing, repairRepo = Nothing, - config = M.empty, + config = c, repo = r, gitconfig = gc, localpath = Just dir, diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index a421668f8e..e1b6811c78 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -109,7 +109,7 @@ gen' r u c gc = do , whereisKey = Nothing , remoteFsck = Nothing , repairRepo = Nothing - , config = M.empty + , config = c , localpath = localpathCalc r , repo = r , gitconfig = gc { remoteGitConfig = Just $ extractGitConfig r } diff --git a/Remote/Git.hs b/Remote/Git.hs index ba247078b4..d4e5987dc5 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -120,7 +120,7 @@ gen r u c gc , repairRepo = if Git.repoIsUrl r then Nothing else Just $ repairRemote r - , config = M.empty + , config = c , localpath = localpathCalc r , repo = r , gitconfig = gc diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs index 35655f00b2..8cf9275a0c 100644 --- a/Remote/Helper/Ssh.hs +++ b/Remote/Helper/Ssh.hs @@ -30,7 +30,7 @@ toRepo r sshcmd = do g <- fromRepo id let c = extractRemoteGitConfig g (Git.repoDescribe r) let opts = map Param $ remoteAnnexSshOptions c - let host = Git.Url.hostuser r + let host = fromMaybe (error "bad ssh url") $ Git.Url.hostuser r params <- sshCachingOptions (host, Git.Url.port r) opts return $ params ++ Param host : sshcmd diff --git a/Remote/Hook.hs b/Remote/Hook.hs index fdb24d0cb3..55ff785141 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -54,7 +54,7 @@ gen r u c gc = do whereisKey = Nothing, remoteFsck = Nothing, repairRepo = Nothing, - config = M.empty, + config = c, localpath = Nothing, repo = r, gitconfig = gc, diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 6bc5fd78f8..91638de98b 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -81,7 +81,7 @@ gen r u c gc = do , whereisKey = Nothing , remoteFsck = Nothing , repairRepo = Nothing - , config = M.empty + , config = c , repo = r , gitconfig = gc , localpath = if islocal diff --git a/Remote/Web.hs b/Remote/Web.hs index 7c98dbf40a..0a8df35d58 100644 --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -25,8 +25,6 @@ import Annex.Quvi import qualified Utility.Quvi as Quvi #endif -import qualified Data.Map as M - remote :: RemoteType remote = RemoteType { typename = "web", @@ -44,7 +42,7 @@ list = do return [r] gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote) -gen r _ _ gc = +gen r _ c gc = return $ Just Remote { uuid = webUUID, cost = expensiveRemoteCost, @@ -58,7 +56,7 @@ gen r _ _ gc = whereisKey = Just getUrls, remoteFsck = Nothing, repairRepo = Nothing, - config = M.empty, + config = c, gitconfig = gc, localpath = Nothing, repo = r, diff --git a/Seek.hs b/Seek.hs index 7f74f6728d..b2782fc360 100644 --- a/Seek.hs +++ b/Seek.hs @@ -141,13 +141,15 @@ withNothing _ _ = error "This command takes no parameters." withKeyOptions :: (Key -> CommandStart) -> CommandSeek -> CommandSeek withKeyOptions keyop fallbackop params = do bare <- fromRepo Git.repoIsLocalBare - allkeys <- Annex.getFlag "all" <||> pure bare + allkeys <- Annex.getFlag "all" unused <- Annex.getFlag "unused" auto <- Annex.getState Annex.auto - case (allkeys , unused, auto ) of + case (allkeys || bare , unused, auto ) of (True , False , False) -> go loggedKeys (False , True , False) -> go unusedKeys - (True , True , _ ) -> error "Cannot use --all with --unused." + (True , True , _ ) + | bare && not allkeys -> go unusedKeys + | otherwise -> error "Cannot use --all with --unused." (False , False , _ ) -> fallbackop params (_ , _ , True ) | bare -> error "Cannot use --auto in a bare repository." diff --git a/Test.hs b/Test.hs index 93af175852..4c7281fce5 100644 --- a/Test.hs +++ b/Test.hs @@ -9,12 +9,14 @@ module Test where -import Test.HUnit -import Test.QuickCheck -import Test.QuickCheck.Test +import Test.Tasty +import Test.Tasty.Runners +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck import System.PosixCompat.Files import Control.Exception.Extensible +import Data.Monoid import qualified Data.Map as M import System.IO.HVFS (SystemFS(..)) import qualified Text.JSON @@ -72,111 +74,101 @@ type TestEnv = M.Map String String main :: IO () main = do - divider - putStrLn "First, some automated quick checks of properties ..." - divider - qcok <- all isSuccess <$> sequence quickcheck - divider - putStrLn "Now, some broader checks ..." - putStrLn " (Do not be alarmed by odd output here; it's normal." - putStrLn " wait for the last line to see how it went.)" - rs <- runhunit =<< prepare False #ifndef mingw32_HOST_OS - directrs <- runhunit =<< prepare True + indirectenv <- prepare False + directenv <- prepare True + let tests = testGroup "Tests" + [ localOption (QuickCheckTests 1000) properties + , unitTests directenv "(direct)" + , unitTests indirectenv "(indirect)" + ] #else -- Windows is only going to use direct mode, so don't test twice. - let directrs = [] + env <- prepare False + let tests = testGroup "Tests" + [properties, unitTests env ""] #endif - divider - propigate (rs++directrs) qcok - where - divider = putStrLn $ replicate 70 '-' - runhunit env = do - r <- forM hunit $ \t -> do - divider - t env - cleanup tmpdir - return r - -propigate :: [Counts] -> Bool -> IO () -propigate cs qcok - | countsok && qcok = putStrLn "All tests ok." - | otherwise = do - unless qcok $ - putStrLn "Quick check tests failed! This is a bug in git-annex." - unless countsok $ do - putStrLn "Some tests failed!" + let runner = tryIngredients [consoleTestReporter] mempty tests + ifM (maybe (error "tasty failed to return a runner!") id runner) + ( exitSuccess + , do putStrLn " (This could be due to a bug in git-annex, or an incompatability" putStrLn " with utilities, such as git, installed on this system.)" - exitFailure - where - noerrors (Counts { errors = e , failures = f }) = e + f == 0 - countsok = all noerrors cs + exitFailure + ) -quickcheck :: [IO Result] -quickcheck = - [ check "prop_idempotent_deencode_git" Git.Filename.prop_idempotent_deencode - , check "prop_idempotent_deencode" Utility.Format.prop_idempotent_deencode - , check "prop_idempotent_fileKey" Locations.prop_idempotent_fileKey - , check "prop_idempotent_key_encode" Types.Key.prop_idempotent_key_encode - , check "prop_idempotent_key_decode" Types.Key.prop_idempotent_key_decode - , check "prop_idempotent_shellEscape" Utility.SafeCommand.prop_idempotent_shellEscape - , check "prop_idempotent_shellEscape_multiword" Utility.SafeCommand.prop_idempotent_shellEscape_multiword - , check "prop_logs_sane" Logs.prop_logs_sane - , check "prop_idempotent_configEscape" Logs.Remote.prop_idempotent_configEscape - , check "prop_parse_show_Config" Logs.Remote.prop_parse_show_Config - , check "prop_parentDir_basics" Utility.Path.prop_parentDir_basics - , check "prop_relPathDirToFile_basics" Utility.Path.prop_relPathDirToFile_basics - , check "prop_relPathDirToFile_regressionTest" Utility.Path.prop_relPathDirToFile_regressionTest - , check "prop_cost_sane" Config.Cost.prop_cost_sane - , check "prop_matcher_sane" Utility.Matcher.prop_matcher_sane - , check "prop_HmacSha1WithCipher_sane" Crypto.prop_HmacSha1WithCipher_sane - , check "prop_TimeStamp_sane" Logs.UUIDBased.prop_TimeStamp_sane - , check "prop_addLog_sane" Logs.UUIDBased.prop_addLog_sane - , check "prop_verifiable_sane" Utility.Verifiable.prop_verifiable_sane - , check "prop_segment_regressionTest" Utility.Misc.prop_segment_regressionTest - , check "prop_read_write_transferinfo" Logs.Transfer.prop_read_write_transferinfo - , check "prop_read_show_inodecache" Utility.InodeCache.prop_read_show_inodecache - , check "prop_parse_show_log" Logs.Presence.prop_parse_show_log - , check "prop_read_show_TrustLevel" Types.TrustLevel.prop_read_show_TrustLevel - , check "prop_parse_show_TrustLog" Logs.Trust.prop_parse_show_TrustLog - , check "prop_hashes_stable" Utility.Hash.prop_hashes_stable - , check "prop_schedule_roundtrips" Utility.Scheduled.prop_schedule_roundtrips - , check "prop_duration_roundtrips" Utility.HumanTime.prop_duration_roundtrips +properties :: TestTree +properties = testGroup "QuickCheck" + [ testProperty "prop_idempotent_deencode_git" Git.Filename.prop_idempotent_deencode + , testProperty "prop_idempotent_deencode" Utility.Format.prop_idempotent_deencode + , testProperty "prop_idempotent_fileKey" Locations.prop_idempotent_fileKey + , testProperty "prop_idempotent_key_encode" Types.Key.prop_idempotent_key_encode + , testProperty "prop_idempotent_key_decode" Types.Key.prop_idempotent_key_decode + , testProperty "prop_idempotent_shellEscape" Utility.SafeCommand.prop_idempotent_shellEscape + , testProperty "prop_idempotent_shellEscape_multiword" Utility.SafeCommand.prop_idempotent_shellEscape_multiword + , testProperty "prop_logs_sane" Logs.prop_logs_sane + , testProperty "prop_idempotent_configEscape" Logs.Remote.prop_idempotent_configEscape + , testProperty "prop_parse_show_Config" Logs.Remote.prop_parse_show_Config + , testProperty "prop_parentDir_basics" Utility.Path.prop_parentDir_basics + , testProperty "prop_relPathDirToFile_basics" Utility.Path.prop_relPathDirToFile_basics + , testProperty "prop_relPathDirToFile_regressionTest" Utility.Path.prop_relPathDirToFile_regressionTest + , testProperty "prop_cost_sane" Config.Cost.prop_cost_sane + , testProperty "prop_matcher_sane" Utility.Matcher.prop_matcher_sane + , testProperty "prop_HmacSha1WithCipher_sane" Crypto.prop_HmacSha1WithCipher_sane + , testProperty "prop_TimeStamp_sane" Logs.UUIDBased.prop_TimeStamp_sane + , testProperty "prop_addLog_sane" Logs.UUIDBased.prop_addLog_sane + , testProperty "prop_verifiable_sane" Utility.Verifiable.prop_verifiable_sane + , testProperty "prop_segment_regressionTest" Utility.Misc.prop_segment_regressionTest + , testProperty "prop_read_write_transferinfo" Logs.Transfer.prop_read_write_transferinfo + , testProperty "prop_read_show_inodecache" Utility.InodeCache.prop_read_show_inodecache + , testProperty "prop_parse_show_log" Logs.Presence.prop_parse_show_log + , testProperty "prop_read_show_TrustLevel" Types.TrustLevel.prop_read_show_TrustLevel + , testProperty "prop_parse_show_TrustLog" Logs.Trust.prop_parse_show_TrustLog + , 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 ] - where - check desc prop = do - putStrLn desc - quickCheckResult prop -hunit :: [TestEnv -> IO Counts] -hunit = +unitTests :: TestEnv -> String -> TestTree +unitTests env note = testGroup ("Unit Tests " ++ note) -- test order matters, later tests may rely on state from earlier [ check "init" test_init , check "add" test_add + , check "add sha1dup" test_add_sha1dup + , check "add subdirs" test_add_subdirs , check "reinject" test_reinject - , check "unannex" test_unannex - , check "drop" test_drop + , check "unannex (no copy)" test_unannex_nocopy + , check "unannex (with copy)" test_unannex_withcopy + , check "drop (no remote)" test_drop_noremote + , check "drop (with remote)" test_drop_withremote + , check "drop (untrusted remote)" test_drop_untrustedremote , check "get" test_get , check "move" test_move , check "copy" test_copy , check "lock" test_lock - , check "edit" test_edit + , check "edit (no pre-commit)" test_edit + , check "edit (pre-commit)" test_edit_precommit , check "fix" test_fix , check "trust" test_trust - , check "fsck" test_fsck + , check "fsck (basics)" test_fsck_basic + , check "fsck (bare)" test_fsck_bare + , check "fsck (local untrusted)" test_fsck_localuntrusted + , check "fsck (remote untrusted)" test_fsck_remoteuntrusted , check "migrate" test_migrate + , check "migrate (via gitattributes)" test_migrate_via_gitattributes , check" unused" test_unused , check "describe" test_describe , check "find" test_find , check "merge" test_merge - , check "status" test_status + , check "info" test_info , check "version" test_version , check "sync" test_sync , check "union merge regression" test_union_merge_regression - , check "conflict resolution" test_conflict_resolution + , check "conflict resolution" test_conflict_resolution_movein_bug + , check "conflict_resolution (mixed directory and file)" test_mixed_conflict_resolution , check "map" test_map , check "uninit" test_uninit + , check "uninit (in git-annex branch)" test_uninit_inbranch , check "upgrade" test_upgrade , check "whereis" test_whereis , check "hook remote" test_hook_remote @@ -185,61 +177,74 @@ hunit = , check "bup remote" test_bup_remote , check "crypto" test_crypto , check "preferred content" test_preferred_content + , check "global cleanup" test_global_cleanup ] where - check desc t env = do - putStrLn desc - runTestTT (t env) + check desc t = testCase desc (t env) -test_init :: TestEnv -> Test -test_init env = "git-annex init" ~: TestCase $ innewrepo env $ do +test_global_cleanup :: TestEnv -> Assertion +test_global_cleanup _env = cleanup tmpdir + +test_init :: TestEnv -> Assertion +test_init env = innewrepo env $ do git_annex env "init" [reponame] @? "init failed" handleforcedirect env where reponame = "test repo" -test_add :: TestEnv -> Test -test_add env = "git-annex add" ~: TestList [basic, sha1dup, subdirs] - where - -- this test case runs in the main repo, to set up a basic - -- annexed file that later tests will use - basic = TestCase $ inmainrepo env $ do - writeFile annexedfile $ content annexedfile - git_annex env "add" [annexedfile] @? "add failed" - annexed_present annexedfile - writeFile sha1annexedfile $ content sha1annexedfile - git_annex env "add" [sha1annexedfile, "--backend=SHA1"] @? "add with SHA1 failed" - annexed_present sha1annexedfile - checkbackend sha1annexedfile backendSHA1 - writeFile wormannexedfile $ content wormannexedfile - git_annex env "add" [wormannexedfile, "--backend=WORM"] @? "add with WORM failed" - annexed_present wormannexedfile - checkbackend wormannexedfile backendWORM - boolSystem "git" [Params "rm --force -q", File wormannexedfile] @? "git rm failed" - writeFile ingitfile $ content ingitfile - boolSystem "git" [Param "add", File ingitfile] @? "git add failed" - boolSystem "git" [Params "commit -q -m commit"] @? "git commit failed" - git_annex env "add" [ingitfile] @? "add ingitfile should be no-op" - unannexed ingitfile - sha1dup = TestCase $ intmpclonerepo env $ do - writeFile sha1annexedfiledup $ content sha1annexedfiledup - git_annex env "add" [sha1annexedfiledup, "--backend=SHA1"] @? "add of second file with same SHA1 failed" - annexed_present sha1annexedfiledup - annexed_present sha1annexedfile - subdirs = TestCase $ intmpclonerepo env $ do - createDirectory "dir" - writeFile ("dir" "foo") $ content annexedfile - git_annex env "add" ["dir"] @? "add of subdir failed" - createDirectory "dir2" - writeFile ("dir2" "foo") $ content annexedfile +-- this test case runs in the main repo, to set up a basic +-- annexed file that later tests will use +test_add :: TestEnv -> Assertion +test_add env = inmainrepo env $ do + writeFile annexedfile $ content annexedfile + git_annex env "add" [annexedfile] @? "add failed" + annexed_present annexedfile + writeFile sha1annexedfile $ content sha1annexedfile + git_annex env "add" [sha1annexedfile, "--backend=SHA1"] @? "add with SHA1 failed" + annexed_present sha1annexedfile + checkbackend sha1annexedfile backendSHA1 + writeFile wormannexedfile $ content wormannexedfile + git_annex env "add" [wormannexedfile, "--backend=WORM"] @? "add with WORM failed" + annexed_present wormannexedfile + checkbackend wormannexedfile backendWORM + ifM (annexeval Config.isDirect) + ( do + boolSystem "rm" [Params "-f", File wormannexedfile] @? "rm failed" + 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" + git_annex env "sync" [] @? "sync failed" + , do + boolSystem "git" [Params "rm --force -q", File wormannexedfile] @? "git rm failed" + writeFile ingitfile $ content ingitfile + boolSystem "git" [Param "add", File ingitfile] @? "git add failed" + boolSystem "git" [Params "commit -q -m commit"] @? "git commit failed" + git_annex env "add" [ingitfile] @? "add ingitfile should be no-op" + unannexed ingitfile + ) + +test_add_sha1dup :: TestEnv -> Assertion +test_add_sha1dup env = intmpclonerepo env $ do + writeFile sha1annexedfiledup $ content sha1annexedfiledup + git_annex env "add" [sha1annexedfiledup, "--backend=SHA1"] @? "add of second file with same SHA1 failed" + annexed_present sha1annexedfiledup + annexed_present sha1annexedfile + +test_add_subdirs :: TestEnv -> Assertion +test_add_subdirs env = intmpclonerepo env $ do + createDirectory "dir" + writeFile ("dir" "foo") $ content annexedfile + git_annex env "add" ["dir"] @? "add of subdir failed" + createDirectory "dir2" + writeFile ("dir2" "foo") $ content annexedfile #ifndef mingw32_HOST_OS - {- This does not work on Windows, for whatever reason. -} - setCurrentDirectory "dir" - git_annex env "add" [".." "dir2"] @? "add of ../subdir failed" + {- This does not work on Windows, for whatever reason. -} + setCurrentDirectory "dir" + git_annex env "add" [".." "dir2"] @? "add of ../subdir failed" #endif -test_reinject :: TestEnv -> Test -test_reinject env = "git-annex reinject/fromkey" ~: TestCase $ intmpclonerepoInDirect env $ do +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 $ @@ -251,53 +256,57 @@ test_reinject env = "git-annex reinject/fromkey" ~: TestCase $ intmpclonerepoInD where tmp = "tmpfile" -test_unannex :: TestEnv -> Test -test_unannex env = "git-annex unannex" ~: TestList [nocopy, withcopy] - where - nocopy = "no content" ~: intmpclonerepo env $ do - annexed_notpresent annexedfile - git_annex env "unannex" [annexedfile] @? "unannex failed with no copy" - annexed_notpresent annexedfile - withcopy = "with content" ~: intmpclonerepo env $ do - git_annex env "get" [annexedfile] @? "get failed" - annexed_present annexedfile - git_annex env "unannex" [annexedfile, sha1annexedfile] @? "unannex failed" - unannexed annexedfile - git_annex env "unannex" [annexedfile] @? "unannex failed on non-annexed file" - unannexed annexedfile +test_unannex_nocopy :: TestEnv -> Assertion +test_unannex_nocopy env = intmpclonerepo env $ do + annexed_notpresent annexedfile + git_annex env "unannex" [annexedfile] @? "unannex failed with no copy" + annexed_notpresent annexedfile + +test_unannex_withcopy :: TestEnv -> Assertion +test_unannex_withcopy env = intmpclonerepo env $ do + git_annex env "get" [annexedfile] @? "get failed" + annexed_present annexedfile + git_annex env "unannex" [annexedfile, sha1annexedfile] @? "unannex failed" + unannexed annexedfile + git_annex env "unannex" [annexedfile] @? "unannex failed on non-annexed file" + unannexed annexedfile + unlessM (annexeval Config.isDirect) $ do git_annex env "unannex" [ingitfile] @? "unannex ingitfile should be no-op" unannexed ingitfile -test_drop :: TestEnv -> Test -test_drop env = "git-annex drop" ~: TestList [noremote, withremote, untrustedremote] - where - noremote = "no remotes" ~: TestCase $ intmpclonerepo env $ do - git_annex env "get" [annexedfile] @? "get failed" - boolSystem "git" [Params "remote rm origin"] - @? "git remote rm origin failed" - not <$> git_annex env "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of file" - annexed_present annexedfile - git_annex env "drop" ["--force", annexedfile] @? "drop --force failed" - annexed_notpresent annexedfile - git_annex env "drop" [annexedfile] @? "drop of dropped file failed" +test_drop_noremote :: TestEnv -> Assertion +test_drop_noremote env = intmpclonerepo env $ do + git_annex env "get" [annexedfile] @? "get failed" + boolSystem "git" [Params "remote rm origin"] + @? "git remote rm origin failed" + not <$> git_annex env "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of file" + annexed_present annexedfile + git_annex env "drop" ["--force", annexedfile] @? "drop --force failed" + annexed_notpresent annexedfile + git_annex env "drop" [annexedfile] @? "drop of dropped file failed" + unlessM (annexeval Config.isDirect) $ do git_annex env "drop" [ingitfile] @? "drop ingitfile should be no-op" unannexed ingitfile - withremote = "with remote" ~: TestCase $ intmpclonerepo env $ do - git_annex env "get" [annexedfile] @? "get failed" - annexed_present annexedfile - git_annex env "drop" [annexedfile] @? "drop failed though origin has copy" - annexed_notpresent annexedfile - inmainrepo env $ annexed_present annexedfile - untrustedremote = "untrusted remote" ~: TestCase $ intmpclonerepo env $ do - git_annex env "untrust" ["origin"] @? "untrust of origin failed" - git_annex env "get" [annexedfile] @? "get failed" - annexed_present annexedfile - not <$> git_annex env "drop" [annexedfile] @? "drop wrongly suceeded with only an untrusted copy of the file" - annexed_present annexedfile - inmainrepo env $ annexed_present annexedfile -test_get :: TestEnv -> Test -test_get env = "git-annex get" ~: TestCase $ intmpclonerepo env $ do +test_drop_withremote :: TestEnv -> Assertion +test_drop_withremote env = intmpclonerepo env $ do + git_annex env "get" [annexedfile] @? "get failed" + annexed_present annexedfile + git_annex env "drop" [annexedfile] @? "drop failed though origin has copy" + annexed_notpresent annexedfile + inmainrepo env $ annexed_present annexedfile + +test_drop_untrustedremote :: TestEnv -> Assertion +test_drop_untrustedremote env = intmpclonerepo env $ do + git_annex env "untrust" ["origin"] @? "untrust of origin failed" + git_annex env "get" [annexedfile] @? "get failed" + annexed_present annexedfile + not <$> git_annex env "drop" [annexedfile] @? "drop wrongly suceeded with only an untrusted copy of the file" + annexed_present annexedfile + inmainrepo env $ annexed_present annexedfile + +test_get :: TestEnv -> Assertion +test_get env = intmpclonerepo env $ do inmainrepo env $ annexed_present annexedfile annexed_notpresent annexedfile git_annex env "get" [annexedfile] @? "get of file failed" @@ -306,14 +315,15 @@ test_get env = "git-annex get" ~: TestCase $ intmpclonerepo env $ do git_annex env "get" [annexedfile] @? "get of file already here failed" inmainrepo env $ annexed_present annexedfile annexed_present annexedfile - inmainrepo env $ unannexed ingitfile - unannexed ingitfile - git_annex env "get" [ingitfile] @? "get ingitfile should be no-op" - inmainrepo env $ unannexed ingitfile - unannexed ingitfile + unlessM (annexeval Config.isDirect) $ do + inmainrepo env $ unannexed ingitfile + unannexed ingitfile + git_annex env "get" [ingitfile] @? "get ingitfile should be no-op" + inmainrepo env $ unannexed ingitfile + unannexed ingitfile -test_move :: TestEnv -> Test -test_move env = "git-annex move" ~: TestCase $ intmpclonerepo env $ do +test_move :: TestEnv -> Assertion +test_move env = intmpclonerepo env $ do annexed_notpresent annexedfile inmainrepo env $ annexed_present annexedfile git_annex env "move" ["--from", "origin", annexedfile] @? "move --from of file failed" @@ -328,17 +338,18 @@ test_move env = "git-annex move" ~: TestCase $ intmpclonerepo env $ do git_annex env "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed" inmainrepo env $ annexed_present annexedfile annexed_notpresent annexedfile - unannexed ingitfile - inmainrepo env $ unannexed ingitfile - git_annex env "move" ["--to", "origin", ingitfile] @? "move of ingitfile should be no-op" - unannexed ingitfile - inmainrepo env $ unannexed ingitfile - git_annex env "move" ["--from", "origin", ingitfile] @? "move of ingitfile should be no-op" - unannexed ingitfile - inmainrepo env $ unannexed ingitfile + unlessM (annexeval Config.isDirect) $ do + unannexed ingitfile + inmainrepo env $ unannexed ingitfile + git_annex env "move" ["--to", "origin", ingitfile] @? "move of ingitfile should be no-op" + unannexed ingitfile + inmainrepo env $ unannexed ingitfile + git_annex env "move" ["--from", "origin", ingitfile] @? "move of ingitfile should be no-op" + unannexed ingitfile + inmainrepo env $ unannexed ingitfile -test_copy :: TestEnv -> Test -test_copy env = "git-annex copy" ~: TestCase $ intmpclonerepo env $ do +test_copy :: TestEnv -> Assertion +test_copy env = intmpclonerepo env $ do annexed_notpresent annexedfile inmainrepo env $ annexed_present annexedfile git_annex env "copy" ["--from", "origin", annexedfile] @? "copy --from of file failed" @@ -353,17 +364,18 @@ test_copy env = "git-annex copy" ~: TestCase $ intmpclonerepo env $ do git_annex env "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed" annexed_notpresent annexedfile inmainrepo env $ annexed_present annexedfile - unannexed ingitfile - inmainrepo env $ unannexed ingitfile - git_annex env "copy" ["--to", "origin", ingitfile] @? "copy of ingitfile should be no-op" - unannexed ingitfile - inmainrepo env $ unannexed ingitfile - git_annex env "copy" ["--from", "origin", ingitfile] @? "copy of ingitfile should be no-op" - checkregularfile ingitfile - checkcontent ingitfile + unlessM (annexeval Config.isDirect) $ do + unannexed ingitfile + inmainrepo env $ unannexed ingitfile + git_annex env "copy" ["--to", "origin", ingitfile] @? "copy of ingitfile should be no-op" + unannexed ingitfile + inmainrepo env $ unannexed ingitfile + git_annex env "copy" ["--from", "origin", ingitfile] @? "copy of ingitfile should be no-op" + checkregularfile ingitfile + checkcontent ingitfile -test_preferred_content :: TestEnv -> Test -test_preferred_content env = "git-annex preferred-content" ~: TestCase $ intmpclonerepo env $ do +test_preferred_content :: TestEnv -> Assertion +test_preferred_content env = intmpclonerepo env $ do annexed_notpresent annexedfile -- get --auto only looks at numcopies when preferred content is not -- set, and with 1 copy existing, does not get the file. @@ -396,8 +408,8 @@ test_preferred_content env = "git-annex preferred-content" ~: TestCase $ intmpcl git_annex env "get" ["--auto", annexedfile] @? "get --auto of file failed with exclude=*" annexed_notpresent annexedfile -test_lock :: TestEnv -> Test -test_lock env = "git-annex unlock/lock" ~: intmpclonerepoInDirect env $ do +test_lock :: TestEnv -> Assertion +test_lock env = intmpclonerepoInDirect env $ do -- regression test: unlock of not present file should skip it annexed_notpresent annexedfile not <$> git_annex env "unlock" [annexedfile] @? "unlock failed to fail with not present file" @@ -423,9 +435,14 @@ test_lock env = "git-annex unlock/lock" ~: intmpclonerepoInDirect env $ do r' <- git_annex env "drop" [annexedfile] not r' @? "drop wrongly succeeded with no known copy of modified file" -test_edit :: TestEnv -> Test -test_edit env = "git-annex edit/commit" ~: TestList [t False, t True] - where t precommit = TestCase $ intmpclonerepoInDirect env $ do +test_edit :: TestEnv -> Assertion +test_edit = test_edit' False + +test_edit_precommit :: TestEnv -> Assertion +test_edit_precommit = test_edit' True + +test_edit' :: Bool -> TestEnv -> Assertion +test_edit' precommit env = intmpclonerepoInDirect env $ do git_annex env "get" [annexedfile] @? "get of file failed" annexed_present annexedfile git_annex env "edit" [annexedfile] @? "edit failed" @@ -443,8 +460,8 @@ test_edit env = "git-annex edit/commit" ~: TestList [t False, t True] assertEqual "content of modified file" c (changedcontent annexedfile) not <$> git_annex env "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of modified file" -test_fix :: TestEnv -> Test -test_fix env = "git-annex fix" ~: intmpclonerepoInDirect env $ do +test_fix :: TestEnv -> Assertion +test_fix env = intmpclonerepoInDirect env $ do annexed_notpresent annexedfile git_annex env "fix" [annexedfile] @? "fix of not present failed" annexed_notpresent annexedfile @@ -463,8 +480,8 @@ test_fix env = "git-annex fix" ~: intmpclonerepoInDirect env $ do subdir = "s" newfile = subdir ++ "/" ++ annexedfile -test_trust :: TestEnv -> Test -test_trust env = "git-annex trust/untrust/semitrust/dead" ~: intmpclonerepo env $ do +test_trust :: TestEnv -> Assertion +test_trust env = intmpclonerepo env $ do git_annex env "trust" [repo] @? "trust failed" trustcheck Logs.Trust.Trusted "trusted 1" git_annex env "trust" [repo] @? "trust of trusted failed" @@ -490,33 +507,15 @@ test_trust env = "git-annex trust/untrust/semitrust/dead" ~: intmpclonerepo env return $ u `elem` l assertBool msg present -test_fsck :: TestEnv -> Test -test_fsck env = "git-annex fsck" ~: TestList [basicfsck, barefsck, withlocaluntrusted, withremoteuntrusted] +test_fsck_basic :: TestEnv -> Assertion +test_fsck_basic env = intmpclonerepo env $ do + git_annex env "fsck" [] @? "fsck failed" + boolSystem "git" [Params "config annex.numcopies 2"] @? "git config failed" + fsck_should_fail env "numcopies unsatisfied" + boolSystem "git" [Params "config annex.numcopies 1"] @? "git config failed" + corrupt annexedfile + corrupt sha1annexedfile where - basicfsck = TestCase $ intmpclonerepo env $ do - git_annex env "fsck" [] @? "fsck failed" - boolSystem "git" [Params "config annex.numcopies 2"] @? "git config failed" - fsck_should_fail "numcopies unsatisfied" - boolSystem "git" [Params "config annex.numcopies 1"] @? "git config failed" - corrupt annexedfile - corrupt sha1annexedfile - barefsck = TestCase $ intmpbareclonerepo env $ do - git_annex env "fsck" [] @? "fsck failed" - withlocaluntrusted = TestCase $ intmpclonerepo env $ do - git_annex env "get" [annexedfile] @? "get failed" - git_annex env "untrust" ["origin"] @? "untrust of origin repo failed" - git_annex env "untrust" ["."] @? "untrust of current repo failed" - fsck_should_fail "content only available in untrusted (current) repository" - git_annex env "trust" ["."] @? "trust of current repo failed" - git_annex env "fsck" [annexedfile] @? "fsck failed on file present in trusted repo" - withremoteuntrusted = TestCase $ intmpclonerepo env $ do - boolSystem "git" [Params "config annex.numcopies 2"] @? "git config failed" - git_annex env "get" [annexedfile] @? "get failed" - git_annex env "get" [sha1annexedfile] @? "get failed" - git_annex env "fsck" [] @? "fsck failed with numcopies=2 and 2 copies" - git_annex env "untrust" ["origin"] @? "untrust of origin failed" - fsck_should_fail "content not replicated to enough non-untrusted repositories" - corrupt f = do git_annex env "get" [f] @? "get of file failed" Utility.FileMode.allowWrite f @@ -526,12 +525,41 @@ test_fsck env = "git-annex fsck" ~: TestList [basicfsck, barefsck, withlocaluntr , not <$> git_annex env "fsck" [] @? "fsck failed to fail with corrupted file content" ) git_annex env "fsck" [] @? "fsck unexpectedly failed again; previous one did not fix problem with " ++ f - fsck_should_fail m = do - not <$> git_annex env "fsck" [] @? "fsck failed to fail with " ++ m -test_migrate :: TestEnv -> Test -test_migrate env = "git-annex migrate" ~: TestList [t False, t True] - where t usegitattributes = TestCase $ intmpclonerepoInDirect env $ do +test_fsck_bare :: TestEnv -> Assertion +test_fsck_bare env = intmpbareclonerepo env $ do + git_annex env "fsck" [] @? "fsck failed" + +test_fsck_localuntrusted :: TestEnv -> Assertion +test_fsck_localuntrusted env = intmpclonerepo env $ do + git_annex env "get" [annexedfile] @? "get failed" + git_annex env "untrust" ["origin"] @? "untrust of origin repo failed" + git_annex env "untrust" ["."] @? "untrust of current repo failed" + fsck_should_fail env "content only available in untrusted (current) repository" + git_annex env "trust" ["."] @? "trust of current repo failed" + git_annex env "fsck" [annexedfile] @? "fsck failed on file present in trusted repo" + +test_fsck_remoteuntrusted :: TestEnv -> Assertion +test_fsck_remoteuntrusted env = intmpclonerepo env $ do + boolSystem "git" [Params "config annex.numcopies 2"] @? "git config failed" + git_annex env "get" [annexedfile] @? "get failed" + git_annex env "get" [sha1annexedfile] @? "get failed" + git_annex env "fsck" [] @? "fsck failed with numcopies=2 and 2 copies" + git_annex env "untrust" ["origin"] @? "untrust of origin failed" + fsck_should_fail env "content not replicated to enough non-untrusted repositories" + +fsck_should_fail :: TestEnv -> String -> Assertion +fsck_should_fail env m = not <$> git_annex env "fsck" [] + @? "fsck failed to fail with " ++ m + +test_migrate :: TestEnv -> Assertion +test_migrate = test_migrate' False + +test_migrate_via_gitattributes :: TestEnv -> Assertion +test_migrate_via_gitattributes = test_migrate' True + +test_migrate' :: Bool -> TestEnv -> Assertion +test_migrate' usegitattributes env = intmpclonerepoInDirect env $ do annexed_notpresent annexedfile annexed_notpresent sha1annexedfile git_annex env "migrate" [annexedfile] @? "migrate of not present failed" @@ -568,9 +596,9 @@ test_migrate env = "git-annex migrate" ~: TestList [t False, t True] checkbackend annexedfile backendSHA256 checkbackend sha1annexedfile backendSHA256 -test_unused :: TestEnv -> Test +test_unused :: TestEnv -> Assertion -- This test is broken in direct mode -test_unused env = "git-annex unused/dropunused" ~: intmpclonerepoInDirect env $ do +test_unused env = intmpclonerepoInDirect env $ do -- keys have to be looked up before files are removed annexedfilekey <- annexeval $ findkey annexedfile sha1annexedfilekey <- annexeval $ findkey sha1annexedfile @@ -640,13 +668,13 @@ test_unused env = "git-annex unused/dropunused" ~: intmpclonerepoInDirect env $ r <- Backend.lookupFile f return $ fst $ fromJust r -test_describe :: TestEnv -> Test -test_describe env = "git-annex describe" ~: intmpclonerepo env $ do +test_describe :: TestEnv -> Assertion +test_describe env = intmpclonerepo env $ do git_annex env "describe" [".", "this repo"] @? "describe 1 failed" git_annex env "describe" ["origin", "origin repo"] @? "describe 2 failed" -test_find :: TestEnv -> Test -test_find env = "git-annex find" ~: intmpclonerepo env $ do +test_find :: TestEnv -> Assertion +test_find env = intmpclonerepo env $ do annexed_notpresent annexedfile git_annex_expectoutput env "find" [] [] git_annex env "get" [annexedfile] @? "get failed" @@ -668,23 +696,23 @@ test_find env = "git-annex find" ~: intmpclonerepo env $ do git_annex_expectoutput env "find" ["--include", "*", "--exclude", annexedfile, "--exclude", sha1annexedfile] ["dir/subfile"] git_annex_expectoutput env "find" ["--exclude", "*"] [] -test_merge :: TestEnv -> Test -test_merge env = "git-annex merge" ~: intmpclonerepo env $ do +test_merge :: TestEnv -> Assertion +test_merge env = intmpclonerepo env $ do git_annex env "merge" [] @? "merge failed" -test_status :: TestEnv -> Test -test_status env = "git-annex status" ~: intmpclonerepo env $ do - json <- git_annex_output env "status" ["--json"] +test_info :: TestEnv -> Assertion +test_info env = intmpclonerepo env $ do + json <- git_annex_output env "info" ["--json"] case Text.JSON.decodeStrict json :: Text.JSON.Result (Text.JSON.JSObject Text.JSON.JSValue) of Text.JSON.Ok _ -> return () Text.JSON.Error e -> assertFailure e -test_version :: TestEnv -> Test -test_version env = "git-annex version" ~: intmpclonerepo env $ do +test_version :: TestEnv -> Assertion +test_version env = intmpclonerepo env $ do git_annex env "version" [] @? "version failed" -test_sync :: TestEnv -> Test -test_sync env = "git-annex sync" ~: intmpclonerepo env $ do +test_sync :: TestEnv -> Assertion +test_sync env = intmpclonerepo env $ do git_annex env "sync" [] @? "sync failed" {- Regression test for bug fixed in - 7b0970b340d7faeb745c666146c7f701ec71808f, where in direct mode @@ -693,8 +721,8 @@ test_sync env = "git-annex sync" ~: intmpclonerepo env $ do {- Regression test for union merge bug fixed in - 0214e0fb175a608a49b812d81b4632c081f63027 -} -test_union_merge_regression :: TestEnv -> Test -test_union_merge_regression env = "union merge regression" ~: +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 @@ -720,45 +748,47 @@ test_union_merge_regression env = "union merge regression" ~: - thought the file was still in r2 -} git_annex_expectoutput env "find" ["--in", "r2"] [] -test_conflict_resolution :: TestEnv -> Test -test_conflict_resolution env = "automatic conflict resolution" ~: - TestList [movein_bug, check_mixed_conflict True, check_mixed_conflict False] - where - {- Regression test for the automatic conflict resolution bug fixed - - in f4ba19f2b8a76a1676da7bb5850baa40d9c388e2. -} - movein_bug = TestCase $ withtmpclonerepo env False $ \r1 -> do - withtmpclonerepo env False $ \r2 -> do - let rname r = if r == r1 then "r1" else "r2" - forM_ [r1, r2] $ \r -> indir env r $ do - {- Get all files, see check below. -} - git_annex env "get" [] @? "get failed" - pair r1 r2 - forM_ [r1, r2] $ \r -> indir env r $ do - {- Set up a conflict. -} - let newcontent = content annexedfile ++ rname r - ifM (annexeval Config.isDirect) - ( writeFile annexedfile newcontent - , do - git_annex env "unlock" [annexedfile] @? "unlock failed" - writeFile annexedfile newcontent - ) - {- Sync twice in r1 so it gets the conflict resolution - - update from r2 -} - forM_ [r1, r2, r1] $ \r -> indir env r $ do - git_annex env "sync" [] @? "sync failed in " ++ rname r - {- After the sync, it should be possible to get all - - files. This includes both sides of the conflict, - - although the filenames are not easily predictable. - - - - The bug caused, in direct mode, one repo to - - be missing the content of the file that had - - been put in it. -} - forM_ [r1, r2] $ \r -> indir env r $ do - git_annex env "get" [] @? "unable to get all files after merge conflict resolution in " ++ rname r +{- 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 + withtmpclonerepo env False $ \r2 -> do + let rname r = if r == r1 then "r1" else "r2" + forM_ [r1, r2] $ \r -> indir env r $ do + {- Get all files, see check below. -} + git_annex env "get" [] @? "get failed" + pair env r1 r2 + forM_ [r1, r2] $ \r -> indir env r $ do + {- Set up a conflict. -} + let newcontent = content annexedfile ++ rname r + ifM (annexeval Config.isDirect) + ( writeFile annexedfile newcontent + , do + git_annex env "unlock" [annexedfile] @? "unlock failed" + writeFile annexedfile newcontent + ) + {- Sync twice in r1 so it gets the conflict resolution + - update from r2 -} + forM_ [r1, r2, r1] $ \r -> indir env r $ do + 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, + - although the filenames are not easily predictable. + - + - The bug caused, in direct mode, one repo to + - be missing the content of the file that had + - been put in it. -} + forM_ [r1, r2] $ \r -> indir env r $ do + git_annex env "get" [] @? "unable to get all files after merge conflict resolution in " ++ rname r - {- Check merge conflict resolution when one side is an annexed - - file, and the other is a directory. -} - check_mixed_conflict inr1 = TestCase $ withtmpclonerepo env False $ \r1 -> +{- Check merge conflict resolution when one side is an annexed + - file, and the other is a directory. -} +test_mixed_conflict_resolution :: TestEnv -> Assertion +test_mixed_conflict_resolution env = do + check_mixed_conflict True + check_mixed_conflict False + where + check_mixed_conflict inr1 = withtmpclonerepo env False $ \r1 -> withtmpclonerepo env False $ \r2 -> do indir env r1 $ do writeFile conflictor "conflictor" @@ -769,50 +799,59 @@ test_conflict_resolution env = "automatic conflict resolution" ~: writeFile (conflictor "subfile") "subfile" git_annex env "add" [conflictor] @? "add conflicter failed" git_annex env "sync" [] @? "sync failed" - pair r1 r2 + pair env r1 r2 let r = if inr1 then r1 else r2 indir env r $ do git_annex env "sync" [] @? "sync failed in mixed conflict" + checkmerge r1 + checkmerge r2 where conflictor = "conflictor" + variantprefix = conflictor ++ ".variant" + checkmerge d = do + doesDirectoryExist (d conflictor) @? (d ++ " conflictor directory missing") + (any (variantprefix `isPrefixOf`) + <$> getDirectoryContents d) + @? (d ++ "conflictor file missing") - {- Set up repos as remotes of each other; - - remove origin since we're going to sync - - some changes to a file. -} - pair r1 r2 = forM_ [r1, r2] $ \r -> indir env r $ do - when (r /= r1) $ - boolSystem "git" [Params "remote add r1", File ("../../" ++ r1)] @? "remote add" - when (r /= r2) $ - boolSystem "git" [Params "remote add r2", File ("../../" ++ r2)] @? "remote add" - boolSystem "git" [Params "remote rm origin"] @? "remote rm" +{- Set up repos as remotes of each other; + - remove origin since we're going to sync + - some changes to a file. -} +pair :: TestEnv -> FilePath -> FilePath -> Assertion +pair env r1 r2 = forM_ [r1, r2] $ \r -> indir env r $ do + when (r /= r1) $ + boolSystem "git" [Params "remote add r1", File ("../../" ++ r1)] @? "remote add" + when (r /= r2) $ + boolSystem "git" [Params "remote add r2", File ("../../" ++ r2)] @? "remote add" + boolSystem "git" [Params "remote rm origin"] @? "remote rm" -test_map :: TestEnv -> Test -test_map env = "git-annex map" ~: intmpclonerepo env $ do +test_map :: TestEnv -> Assertion +test_map env = intmpclonerepo env $ do -- set descriptions, that will be looked for in the map git_annex env "describe" [".", "this repo"] @? "describe 1 failed" git_annex env "describe" ["origin", "origin repo"] @? "describe 2 failed" -- --fast avoids it running graphviz, not a build dependency git_annex env "map" ["--fast"] @? "map failed" -test_uninit :: TestEnv -> Test -test_uninit env = "git-annex uninit" ~: TestList [inbranch, normal] - where - inbranch = "in branch" ~: intmpclonerepoInDirect env $ do - boolSystem "git" [Params "checkout git-annex"] @? "git checkout git-annex" - not <$> git_annex env "uninit" [] @? "uninit failed to fail when git-annex branch was checked out" - normal = "normal" ~: intmpclonerepo env $ do - git_annex env "get" [] @? "get failed" - annexed_present annexedfile - _ <- git_annex env "uninit" [] -- exit status not checked; does abnormal exit - checkregularfile annexedfile - doesDirectoryExist ".git" @? ".git vanished in uninit" +test_uninit :: TestEnv -> Assertion +test_uninit env = intmpclonerepo env $ do + git_annex env "get" [] @? "get failed" + annexed_present annexedfile + _ <- git_annex env "uninit" [] -- exit status not checked; does abnormal exit + checkregularfile annexedfile + doesDirectoryExist ".git" @? ".git vanished in uninit" -test_upgrade :: TestEnv -> Test -test_upgrade env = "git-annex upgrade" ~: intmpclonerepo env $ do +test_uninit_inbranch :: TestEnv -> Assertion +test_uninit_inbranch env = intmpclonerepoInDirect env $ do + boolSystem "git" [Params "checkout git-annex"] @? "git checkout git-annex" + not <$> git_annex env "uninit" [] @? "uninit failed to fail when git-annex branch was checked out" + +test_upgrade :: TestEnv -> Assertion +test_upgrade env = intmpclonerepo env $ do git_annex env "upgrade" [] @? "upgrade from same version failed" -test_whereis :: TestEnv -> Test -test_whereis env = "git-annex whereis" ~: intmpclonerepo env $ do +test_whereis :: TestEnv -> Assertion +test_whereis env = intmpclonerepo env $ do annexed_notpresent annexedfile git_annex env "whereis" [annexedfile] @? "whereis on non-present file failed" git_annex env "untrust" ["origin"] @? "untrust failed" @@ -821,8 +860,8 @@ test_whereis env = "git-annex whereis" ~: intmpclonerepo env $ do annexed_present annexedfile git_annex env "whereis" [annexedfile] @? "whereis on present file failed" -test_hook_remote :: TestEnv -> Test -test_hook_remote env = "git-annex hook remote" ~: intmpclonerepo env $ do +test_hook_remote :: TestEnv -> Assertion +test_hook_remote env = intmpclonerepo env $ do #ifndef mingw32_HOST_OS git_annex env "initremote" (words "foo type=hook encryption=none hooktype=foo") @? "initremote failed" createDirectory dir @@ -854,8 +893,8 @@ test_hook_remote env = "git-annex hook remote" ~: intmpclonerepo env $ do noop #endif -test_directory_remote :: TestEnv -> Test -test_directory_remote env = "git-annex directory remote" ~: 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 "get" [annexedfile] @? "get of file failed" @@ -869,8 +908,8 @@ test_directory_remote env = "git-annex directory remote" ~: intmpclonerepo env $ not <$> git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail" annexed_present annexedfile -test_rsync_remote :: TestEnv -> Test -test_rsync_remote env = "git-annex rsync remote" ~: intmpclonerepo env $ do +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" @@ -889,8 +928,8 @@ test_rsync_remote env = "git-annex rsync remote" ~: intmpclonerepo env $ do noop #endif -test_bup_remote :: TestEnv -> Test -test_bup_remote env = "git-annex bup remote" ~: intmpclonerepo env $ when Build.SysConfig.bup $ do +test_bup_remote :: TestEnv -> Assertion +test_bup_remote env = intmpclonerepo env $ when Build.SysConfig.bup $ do dir <- absPath "dir" -- bup special remote needs an absolute path createDirectory dir git_annex env "initremote" (words $ "foo type=bup encryption=none buprepo="++dir) @? "initremote failed" @@ -906,47 +945,50 @@ test_bup_remote env = "git-annex bup remote" ~: intmpclonerepo env $ when Build. annexed_present annexedfile -- gpg is not a build dependency, so only test when it's available -test_crypto :: TestEnv -> Test +test_crypto :: TestEnv -> Assertion #ifndef mingw32_HOST_OS -test_crypto env = "git-annex crypto" ~: TestList $ flip map ["shared","hybrid","pubkey"] $ - \scheme -> TestCase $ intmpclonerepo env $ whenM (Utility.Path.inPath Utility.Gpg.gpgcmd) $ do - Utility.Gpg.testTestHarness @? "test harness self-test failed" - Utility.Gpg.testHarness $ do - createDirectory "dir" - let a cmd = git_annex env cmd $ - [ "foo" - , "type=directory" - , "encryption=" ++ scheme - , "directory=dir" - , "highRandomQuality=false" - ] ++ if scheme `elem` ["hybrid","pubkey"] - then ["keyid=" ++ Utility.Gpg.testKeyId] - else [] - a "initremote" @? "initremote failed" - not <$> a "initremote" @? "initremote failed to fail when run twice in a row" - a "enableremote" @? "enableremote failed" - a "enableremote" @? "enableremote failed when run twice in a row" - git_annex env "get" [annexedfile] @? "get of file failed" - annexed_present annexedfile - git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to encrypted remote failed" - (c,k) <- annexeval $ do - uuid <- Remote.nameToUUID "foo" - rs <- Logs.Remote.readRemoteLog - Just (k,_) <- Backend.lookupFile annexedfile - return (fromJust $ M.lookup uuid rs, k) - let key = if scheme `elem` ["hybrid","pubkey"] - then Just $ Utility.Gpg.KeyIds [Utility.Gpg.testKeyId] - else Nothing - testEncryptedRemote scheme key c [k] @? "invalid crypto setup" - - annexed_present annexedfile - git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed" - annexed_notpresent annexedfile - git_annex env "move" [annexedfile, "--from", "foo"] @? "move --from encrypted remote failed" - annexed_present annexedfile - not <$> git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail" - annexed_present annexedfile +test_crypto env = do + testscheme "shared" + testscheme "hybrid" + testscheme "pubkey" where + testscheme scheme = intmpclonerepo env $ whenM (Utility.Path.inPath Utility.Gpg.gpgcmd) $ do + Utility.Gpg.testTestHarness @? "test harness self-test failed" + Utility.Gpg.testHarness $ do + createDirectory "dir" + let a cmd = git_annex env cmd $ + [ "foo" + , "type=directory" + , "encryption=" ++ scheme + , "directory=dir" + , "highRandomQuality=false" + ] ++ if scheme `elem` ["hybrid","pubkey"] + then ["keyid=" ++ Utility.Gpg.testKeyId] + else [] + a "initremote" @? "initremote failed" + not <$> a "initremote" @? "initremote failed to fail when run twice in a row" + a "enableremote" @? "enableremote failed" + a "enableremote" @? "enableremote failed when run twice in a row" + git_annex env "get" [annexedfile] @? "get of file failed" + annexed_present annexedfile + git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to encrypted remote failed" + (c,k) <- annexeval $ do + uuid <- Remote.nameToUUID "foo" + rs <- Logs.Remote.readRemoteLog + Just (k,_) <- Backend.lookupFile annexedfile + return (fromJust $ M.lookup uuid rs, k) + let key = if scheme `elem` ["hybrid","pubkey"] + then Just $ Utility.Gpg.KeyIds [Utility.Gpg.testKeyId] + else Nothing + testEncryptedRemote scheme key c [k] @? "invalid crypto setup" + + annexed_present annexedfile + git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed" + annexed_notpresent annexedfile + git_annex env "move" [annexedfile, "--from", "foo"] @? "move --from encrypted remote failed" + annexed_present annexedfile + not <$> git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail" + annexed_present annexedfile {- Ensure the configuration complies with the encryption scheme, and - that all keys are encrypted properly for the given directory remote. -} testEncryptedRemote scheme ks c keys = case Remote.Helper.Encryptable.extractCipher c of @@ -974,7 +1016,7 @@ test_crypto env = "git-annex crypto" ~: TestList $ flip map ["shared","hybrid"," key2files cipher = Locations.keyPaths . Crypto.encryptKey Types.Crypto.HmacSha1 cipher #else -test_crypto _env = "git-annex crypto" ~: putStrLn "gpg testing not implemented on Windows" +test_crypto _env = putStrLn "gpg testing not implemented on Windows" #endif -- This is equivilant to running git-annex, but it's all run in-process diff --git a/Types/Distribution.hs b/Types/Distribution.hs new file mode 100644 index 0000000000..4201f49ad8 --- /dev/null +++ b/Types/Distribution.hs @@ -0,0 +1,38 @@ +{- Data type for a distribution of git-annex + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Types.Distribution where + +import Types.Key +import Data.Time.Clock +import Git.Config (isTrue, boolConfig) + +data GitAnnexDistribution = GitAnnexDistribution + { distributionUrl :: String + , distributionKey :: Key + , distributionVersion :: GitAnnexVersion + , distributionReleasedate :: UTCTime + , distributionUrgentUpgrade :: Maybe GitAnnexVersion + } + deriving (Read, Show, Eq) + +type GitAnnexVersion = String + +data AutoUpgrade = AskUpgrade | AutoUpgrade | NoAutoUpgrade + deriving (Eq) + +toAutoUpgrade :: (Maybe String) -> AutoUpgrade +toAutoUpgrade Nothing = AskUpgrade +toAutoUpgrade (Just s) + | s == "ask" = AskUpgrade + | isTrue s == Just True = AutoUpgrade + | otherwise = NoAutoUpgrade + +fromAutoUpgrade :: AutoUpgrade -> String +fromAutoUpgrade AskUpgrade = "ask" +fromAutoUpgrade AutoUpgrade = boolConfig True +fromAutoUpgrade NoAutoUpgrade = boolConfig False diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs index b573a9a254..7224f43ff9 100644 --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -17,6 +17,7 @@ import qualified Git import qualified Git.Config import Utility.DataUnits import Config.Cost +import Types.Distribution {- Main git-annex settings. Each setting corresponds to a git-config key - such as annex.foo -} @@ -42,6 +43,7 @@ data GitConfig = GitConfig , annexCrippledFileSystem :: Bool , annexLargeFiles :: Maybe String , annexFsckNudge :: Bool + , annexAutoUpgrade :: AutoUpgrade , coreSymlinks :: Bool , gcryptId :: Maybe String } @@ -70,6 +72,7 @@ extractGitConfig r = GitConfig , annexCrippledFileSystem = getbool (annex "crippledfilesystem") False , annexLargeFiles = getmaybe (annex "largefiles") , annexFsckNudge = getbool (annex "fscknudge") True + , annexAutoUpgrade = toAutoUpgrade $ getmaybe (annex "autoupgrade") , coreSymlinks = getbool "core.symlinks" True , gcryptId = getmaybe "core.gcrypt-id" } diff --git a/Types/Key.hs b/Types/Key.hs index f900ece2b8..598d5ed20b 100644 --- a/Types/Key.hs +++ b/Types/Key.hs @@ -60,7 +60,9 @@ key2file Key { keyBackendName = b, keySize = s, keyMtime = m, keyName = n } = _ ?: _ = "" file2key :: FilePath -> Maybe Key -file2key s = if key == Just stubKey || (keyName <$> key) == Just "" then Nothing else key +file2key s + | key == Just stubKey || (keyName <$> key) == Just "" || (keyBackendName <$> key) == Just "" = Nothing + | otherwise = key where key = startbackend stubKey s @@ -91,6 +93,4 @@ prop_idempotent_key_encode :: Key -> Bool prop_idempotent_key_encode k = Just k == (file2key . key2file) k prop_idempotent_key_decode :: FilePath -> Bool -prop_idempotent_key_decode f - | null f = True -- skip illegal empty filename - | otherwise = maybe True (\k -> key2file k == f) (file2key f) +prop_idempotent_key_decode f = maybe True (\k -> key2file k == f) (file2key f) diff --git a/Types/Remote.hs b/Types/Remote.hs index 9afcbbe559..8a94dcc05b 100644 --- a/Types/Remote.hs +++ b/Types/Remote.hs @@ -18,7 +18,7 @@ import Types.UUID import Types.GitConfig import Config.Cost import Utility.Metered -import Git.Remote +import Git.Types import Utility.SafeCommand type RemoteConfigKey = String diff --git a/Upgrade.hs b/Upgrade.hs index f0166bf8ef..7385268e89 100644 --- a/Upgrade.hs +++ b/Upgrade.hs @@ -1,6 +1,6 @@ {- git-annex upgrade support - - - Copyright 2010 Joey Hess + - Copyright 2010, 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -11,14 +11,40 @@ module Upgrade where import Common.Annex import Annex.Version +import Config #ifndef mingw32_HOST_OS import qualified Upgrade.V0 import qualified Upgrade.V1 #endif import qualified Upgrade.V2 +import qualified Upgrade.V4 -upgrade :: Annex Bool -upgrade = go =<< getVersion +checkUpgrade :: Version -> Annex () +checkUpgrade = maybe noop error <=< needsUpgrade + +needsUpgrade :: Version -> Annex (Maybe String) +needsUpgrade v + | v `elem` supportedVersions = ok + | v `elem` autoUpgradeableVersions = ifM (upgrade True) + ( ok + , err "Automatic upgrade failed!" + ) + | v `elem` upgradableVersions = err "Upgrade this repository: git-annex upgrade" + | otherwise = err "Upgrade git-annex." + where + err msg = return $ Just $ "Repository version " ++ v ++ + " is not supported. " ++ msg + ok = return Nothing + +upgrade :: Bool -> Annex Bool +upgrade automatic = do + upgraded <- go =<< getVersion + when upgraded $ + ifM isDirect + ( setVersion directModeVersion + , setVersion defaultVersion + ) + return upgraded where #ifndef mingw32_HOST_OS go (Just "0") = Upgrade.V0.upgrade @@ -28,4 +54,5 @@ upgrade = go =<< getVersion go (Just "1") = error "upgrade from v1 on Windows not supported" #endif go (Just "2") = Upgrade.V2.upgrade + go (Just "4") = Upgrade.V4.upgrade automatic go _ = return True diff --git a/Upgrade/V4.hs b/Upgrade/V4.hs new file mode 100644 index 0000000000..147ace5598 --- /dev/null +++ b/Upgrade/V4.hs @@ -0,0 +1,23 @@ +{- git-annex v4 -> v5 uppgrade support + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Upgrade.V4 where + +import Common.Annex +import Config +import Annex.Direct + +{- Direct mode only upgrade. -} +upgrade :: Bool -> Annex Bool +upgrade automatic = ifM isDirect + ( do + unless automatic $ + showAction "v4 to v5" + setDirect True + return True + , return False + ) diff --git a/Utility/Base64.hs b/Utility/Base64.hs index ec660108a6..0c6c8677a9 100644 --- a/Utility/Base64.hs +++ b/Utility/Base64.hs @@ -7,7 +7,7 @@ module Utility.Base64 (toB64, fromB64Maybe, fromB64) where -import Codec.Binary.Base64 +import "dataenc" Codec.Binary.Base64 import Data.Bits.Utils import Control.Applicative import Data.Maybe diff --git a/Utility/Batch.hs b/Utility/Batch.hs index 011d30c941..035a2eb041 100644 --- a/Utility/Batch.hs +++ b/Utility/Batch.hs @@ -10,7 +10,9 @@ module Utility.Batch where import Common +#ifndef mingw32_HOST_OS import qualified Build.SysConfig +#endif #if defined(linux_HOST_OS) || defined(__ANDROID__) import Control.Concurrent.Async diff --git a/Utility/DirWatcher.hs b/Utility/DirWatcher.hs index d28381fae9..5231286fc8 100644 --- a/Utility/DirWatcher.hs +++ b/Utility/DirWatcher.hs @@ -1,10 +1,10 @@ {- generic directory watching interface - - - Uses inotify, or kqueue, or fsevents to watch a directory + - Uses inotify, or kqueue, or fsevents, or win32-notify to watch a directory - (and subdirectories) for changes, and runs hooks for different - sorts of events as they occur. - - - Copyright 2012 Joey Hess + - Copyright 2012-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -27,11 +27,15 @@ import Control.Concurrent import qualified Utility.FSEvents as FSEvents import qualified System.OSX.FSEvents as FSEvents #endif +#if WITH_WIN32NOTIFY +import qualified Utility.Win32Notify as Win32Notify +import qualified System.Win32.Notify as Win32Notify +#endif type Pruner = FilePath -> Bool canWatch :: Bool -#if (WITH_INOTIFY || WITH_KQUEUE || WITH_FSEVENTS) +#if (WITH_INOTIFY || WITH_KQUEUE || WITH_FSEVENTS || WITH_WIN32NOTIFY) canWatch = True #else #if defined linux_HOST_OS @@ -47,7 +51,7 @@ canWatch = False - OTOH, with kqueue, often only one event is received, indicating the most - recent state of the file. -} eventsCoalesce :: Bool -#if WITH_INOTIFY +#if (WITH_INOTIFY || WITH_WIN32NOTIFY) eventsCoalesce = False #else #if (WITH_KQUEUE || WITH_FSEVENTS) @@ -68,7 +72,7 @@ eventsCoalesce = undefined - still being written to, and then no add event will be received once the - writer closes it. -} closingTracked :: Bool -#if (WITH_INOTIFY || WITH_FSEVENTS) +#if (WITH_INOTIFY || WITH_FSEVENTS || WITH_WIN32NOTIFY) closingTracked = True #else #if WITH_KQUEUE @@ -83,7 +87,7 @@ closingTracked = undefined - Fsevents generates events when an existing file is reopened and rewritten, - but not necessarily when it's opened once and modified repeatedly. -} modifyTracked :: Bool -#if (WITH_INOTIFY || WITH_FSEVENTS) +#if (WITH_INOTIFY || WITH_FSEVENTS || WITH_WIN32NOTIFY) modifyTracked = True #else #if WITH_KQUEUE @@ -119,27 +123,35 @@ watchDir :: FilePath -> Pruner -> WatchHooks -> (IO FSEvents.EventStream -> IO F watchDir dir prune hooks runstartup = runstartup $ FSEvents.watchDir dir prune hooks #else +#if WITH_WIN32NOTIFY +type DirWatcherHandle = Win32Notify.WatchManager +watchDir :: FilePath -> Pruner -> WatchHooks -> (IO Win32Notify.WatchManager -> IO Win32Notify.WatchManager) -> IO DirWatcherHandle +watchDir dir prune hooks runstartup = + runstartup $ Win32Notify.watchDir dir prune hooks +#else type DirWatcherHandle = () watchDir :: FilePath -> Pruner -> WatchHooks -> (IO () -> IO ()) -> IO DirWatcherHandle watchDir = undefined #endif #endif #endif +#endif -#if WITH_INOTIFY stopWatchDir :: DirWatcherHandle -> IO () +#if WITH_INOTIFY stopWatchDir = INotify.killINotify #else #if WITH_KQUEUE -stopWatchDir :: DirWatcherHandle -> IO () stopWatchDir = killThread #else #if WITH_FSEVENTS -stopWatchDir :: DirWatcherHandle -> IO () stopWatchDir = FSEvents.eventStreamDestroy #else -stopWatchDir :: DirWatcherHandle -> IO () +#if WITH_WIN32NOTIFY +stopWatchDir = Win32Notify.killWatchManager +#else stopWatchDir = undefined #endif #endif #endif +#endif diff --git a/Utility/FileMode.hs b/Utility/FileMode.hs index d76fb5703c..46c6a31f5f 100644 --- a/Utility/FileMode.hs +++ b/Utility/FileMode.hs @@ -64,13 +64,20 @@ preventWrite f = modifyFileMode f $ removeModes writeModes allowWrite :: FilePath -> IO () allowWrite f = modifyFileMode f $ addModes [ownerWriteMode] +{- Turns a file's owner read bit back on. -} +allowRead :: FilePath -> IO () +allowRead f = modifyFileMode f $ addModes [ownerReadMode] + {- Allows owner and group to read and write to a file. -} -groupWriteRead :: FilePath -> IO () -groupWriteRead f = modifyFileMode f $ addModes +groupSharedModes :: [FileMode] +groupSharedModes = [ ownerWriteMode, groupWriteMode , ownerReadMode, groupReadMode ] +groupWriteRead :: FilePath -> IO () +groupWriteRead f = modifyFileMode f $ addModes groupSharedModes + checkMode :: FileMode -> FileMode -> Bool checkMode checkfor mode = checkfor `intersectFileModes` mode == checkfor diff --git a/Utility/Misc.hs b/Utility/Misc.hs index a2c9c8184b..68199c8283 100644 --- a/Utility/Misc.hs +++ b/Utility/Misc.hs @@ -15,11 +15,15 @@ import Foreign import Data.Char import Data.List import Control.Applicative +import System.Exit #ifndef mingw32_HOST_OS import System.Posix.Process (getAnyProcessStatus) import Utility.Exception #endif +import Utility.FileSystemEncoding +import Utility.Monad + {- A version of hgetContents that is not lazy. Ensures file is - all read before it gets closed. -} hGetContentsStrict :: Handle -> IO String @@ -29,6 +33,13 @@ hGetContentsStrict = hGetContents >=> \s -> length s `seq` return s readFileStrict :: FilePath -> IO String readFileStrict = readFile >=> \s -> length s `seq` return s +{- Reads a file strictly, and using the FileSystemEncofing, so it will + - never crash on a badly encoded file. -} +readFileStrictAnyEncoding :: FilePath -> IO String +readFileStrictAnyEncoding f = withFile f ReadMode $ \h -> do + fileEncoding h + hClose h `after` hGetContentsStrict h + {- Like break, but the item matching the condition is not included - in the second result list. - @@ -136,3 +147,7 @@ reapZombies = do #else reapZombies = return () #endif + +exitBool :: Bool -> IO a +exitBool False = exitFailure +exitBool True = exitSuccess diff --git a/Utility/Process.hs b/Utility/Process.hs index 53b6d2f2f6..398e8a3526 100644 --- a/Utility/Process.hs +++ b/Utility/Process.hs @@ -44,8 +44,10 @@ import qualified Control.Exception as E import Control.Monad #ifndef mingw32_HOST_OS import System.Posix.IO -import Data.Maybe +#else +import Control.Applicative #endif +import Data.Maybe import Utility.Misc import Utility.Exception @@ -161,6 +163,8 @@ createBackgroundProcess p a = a =<< createProcess p - whether it succeeded or failed. -} processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool) #ifndef mingw32_HOST_OS +{- This implementation interleves stdout and stderr in exactly the order + - the process writes them. -} processTranscript cmd opts input = do (readf, writef) <- createPipe readh <- fdToHandle readf @@ -173,10 +177,7 @@ processTranscript cmd opts input = do } hClose writeh - -- fork off a thread to start consuming the output - transcript <- hGetContents readh - outMVar <- newEmptyMVar - _ <- forkIO $ E.evaluate (length transcript) >> putMVar outMVar () + get <- mkreader readh -- now write and flush any input case input of @@ -188,15 +189,46 @@ processTranscript cmd opts input = do hClose inh Nothing -> return () - -- wait on the output - takeMVar outMVar - hClose readh + transcript <- get ok <- checkSuccessProcess pid return (transcript, ok) #else -processTranscript = error "processTranscript TODO" +{- This implementation for Windows puts stderr after stdout. -} +processTranscript cmd opts input = do + p@(_, _, _, pid) <- createProcess $ + (proc cmd opts) + { std_in = if isJust input then CreatePipe else Inherit + , std_out = CreatePipe + , std_err = CreatePipe + } + + getout <- mkreader (stdoutHandle p) + geterr <- mkreader (stderrHandle p) + + case input of + Just s -> do + let inh = stdinHandle p + unless (null s) $ do + hPutStr inh s + hFlush inh + hClose inh + Nothing -> return () + + transcript <- (++) <$> getout <*> geterr + ok <- checkSuccessProcess pid + return (transcript, ok) #endif + where + mkreader h = do + s <- hGetContents h + v <- newEmptyMVar + void $ forkIO $ do + void $ E.evaluate (length s) + putMVar v () + return $ do + takeMVar v + return s {- Runs a CreateProcessRunner, on a CreateProcess structure, that - is adjusted to pipe only from/to a single StdHandle, and passes diff --git a/Utility/Quvi.hs b/Utility/Quvi.hs index 5df1a4da72..4039167ac6 100644 --- a/Utility/Quvi.hs +++ b/Utility/Quvi.hs @@ -11,9 +11,13 @@ module Utility.Quvi where import Common import Utility.Url +import Build.SysConfig (newquvi) import Data.Aeson import Data.ByteString.Lazy.UTF8 (fromString) +import qualified Data.Map as M +import Network.URI (uriAuthority, uriRegName) +import Data.Char data Page = Page { pageTitle :: String @@ -25,6 +29,7 @@ data Link = Link , linkUrl :: URLString } deriving (Show) +{- JSON instances for quvi 0.4. -} instance FromJSON Page where parseJSON (Object v) = Page <$> v .: "page_title" @@ -37,6 +42,20 @@ instance FromJSON Link where <*> v .: "url" parseJSON _ = mzero +{- "enum" format used by quvi 0.9 -} +parseEnum :: String -> Maybe Page +parseEnum s = Page + <$> get "QUVI_MEDIA_PROPERTY_TITLE" + <*> ((:[]) <$> + ( Link + <$> get "QUVI_MEDIA_STREAM_PROPERTY_CONTAINER" + <*> get "QUVI_MEDIA_STREAM_PROPERTY_URL" + ) + ) + where + get = flip M.lookup m + m = M.fromList $ map (separate (== '=')) $ lines s + type Query a = [CommandParam] -> URLString -> IO a {- Throws an error when quvi is not installed. -} @@ -54,8 +73,11 @@ query :: Query (Maybe Page) query ps url = flip catchNonAsync (const $ return Nothing) (query' ps url) query' :: Query (Maybe Page) -query' ps url = decode . fromString - <$> readProcess "quvi" (toCommand $ ps ++ [Param url]) +query' ps url + | newquvi = parseEnum + <$> readProcess "quvi" (toCommand $ [Param "dump", Param "-p", Param "enum"] ++ ps ++ [Param url]) + | otherwise = decode . fromString + <$> readProcess "quvi" (toCommand $ ps ++ [Param url]) queryLinks :: Query [URLString] queryLinks ps url = maybe [] (map linkUrl . pageLinks) <$> query ps url @@ -65,17 +87,47 @@ queryLinks ps url = maybe [] (map linkUrl . pageLinks) <$> query ps url check :: Query Bool check ps url = maybe False (not . null . pageLinks) <$> query ps url -{- Checks if an url is supported by quvi, without hitting it, or outputting +{- Checks if an url is supported by quvi, as quickly as possible + - (without hitting it if possible), and without outputting - anything. Also returns False if quvi is not installed. -} supported :: URLString -> IO Bool -supported url = boolSystem "quvi" [Params "-v mute --support", Param url] +supported url + {- Use quvi-info to see if the url's domain is supported. + - If so, have to do a online verification of the url. -} + | newquvi = (firstlevel <&&> secondlevel) + `catchNonAsync` (\_ -> return False) + | otherwise = boolSystem "quvi" [Params "--verbosity mute --support", Param url] + where + firstlevel = case uriAuthority =<< parseURIRelaxed url of + Nothing -> return False + Just auth -> do + let domain = map toLower $ uriRegName auth + let basedomain = intercalate "." $ reverse $ take 2 $ reverse $ split "." domain + any (\h -> domain `isSuffixOf` h || basedomain `isSuffixOf` h) + . map (map toLower) <$> listdomains + secondlevel = snd <$> processTranscript "quvi" + (toCommand [Param "dump", Param "-o", Param url]) Nothing +listdomains :: IO [String] +listdomains + | newquvi = concatMap (split ",") + . concatMap (drop 1 . words) + . filter ("domains: " `isPrefixOf`) . lines + <$> readProcess "quvi" + (toCommand [Param "info", Param "-p", Param "domains"]) + | otherwise = return [] + +{- Disables progress, but not information output. -} quiet :: CommandParam -quiet = Params "-v quiet" - -noredir :: CommandParam -noredir = Params "-e -resolve" +quiet + -- Cannot use quiet as it now disables informational output. + -- No way to disable progress. + | newquvi = Params "--verbosity verbose" + | otherwise = Params "--verbosity quiet" {- Only return http results, not streaming protocols. -} httponly :: CommandParam -httponly = Params "-c http" +httponly + -- No way to do it with 0.9? + | newquvi = Params "" + | otherwise = Params "-c http" diff --git a/Utility/Url.hs b/Utility/Url.hs index 97296c920d..03c311fd23 100644 --- a/Utility/Url.hs +++ b/Utility/Url.hs @@ -14,7 +14,8 @@ module Utility.Url ( checkBoth, exists, download, - downloadQuiet + downloadQuiet, + parseURIRelaxed ) where import Common diff --git a/Utility/Win32Notify.hs b/Utility/Win32Notify.hs new file mode 100644 index 0000000000..edde5309ce --- /dev/null +++ b/Utility/Win32Notify.hs @@ -0,0 +1,65 @@ +{- Win32-notify interface + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Utility.Win32Notify where + +import Common hiding (isDirectory) +import Utility.DirWatcher.Types + +import System.Win32.Notify +import qualified System.PosixCompat.Files as Files + +watchDir :: FilePath -> (FilePath -> Bool) -> WatchHooks -> IO WatchManager +watchDir dir ignored hooks = do + scan dir + wm <- initWatchManager + void $ watchDirectory wm dir True [Create, Delete, Modify, Move] handle + return wm + where + handle evt + | ignoredPath ignored (filePath evt) = noop + | otherwise = case evt of + (Deleted _ _) + | isDirectory evt -> runhook delDirHook Nothing + | otherwise -> runhook delHook Nothing + (Created _ _) + | isDirectory evt -> noop + | otherwise -> runhook addHook Nothing + (Modified _ _) + | isDirectory evt -> noop + {- Add hooks are run when a file is modified for + - compatability with INotify, which calls the add + - hook when a file is closed, and so tends to call + - both add and modify for file modifications. -} + | otherwise -> do + runhook addHook Nothing + runhook modifyHook Nothing + where + runhook h s = maybe noop (\a -> a (filePath evt) s) (h hooks) + + scan d = unless (ignoredPath ignored d) $ + mapM_ go =<< dirContentsRecursive d + where + go f + | ignoredPath ignored f = noop + | otherwise = do + ms <- getstatus f + case ms of + Nothing -> noop + Just s + | Files.isRegularFile s -> + runhook addHook ms + | otherwise -> + noop + where + runhook h s = maybe noop (\a -> a f s) (h hooks) + + getstatus = catchMaybeIO . getFileStatus + +{- Check each component of the path to see if it's ignored. -} +ignoredPath :: (FilePath -> Bool) -> FilePath -> Bool +ignoredPath ignored = any ignored . map dropTrailingPathSeparator . splitPath diff --git a/debian/changelog b/debian/changelog index 193976ac92..0a84e93079 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,110 @@ +git-annex (5.20131127) unstable; urgency=low + + * webapp: Detect when upgrades are available, and upgrade if the user + desires. + (Only when git-annex is installed using the prebuilt binaries + from git-annex upstream, not from eg Debian.) + * assistant: Detect when the git-annex binary is modified or replaced, + and either prompt the user to restart the program, or automatically + restart it. + * annex.autoupgrade configures both the above upgrade behaviors. + * Added support for quvi 0.9. Slightly suboptimal due to limitations in its + interface compared with the old version. + * Bug fix: annex.version did not get set on automatic upgrade to v5 direct + mode repo, so the upgrade was performed repeatedly, slowing commands down. + * webapp: Fix bug that broke switching between local repositories + that use the new guarded direct mode. + * Android: Fix stripping of the git-annex binary. + * Android: Make terminal app show git-annex version number. + * Android: Re-enable XMPP support. + * reinject: Allow to be used in direct mode. + * Futher improvements to git repo repair. Has now been tested in tens + of thousands of intentionally damaged repos, and successfully + repaired them all. + * Allow use of --unused in bare repository. + + -- Joey Hess Wed, 27 Nov 2013 18:41:44 -0400 + +git-annex (5.20131120) unstable; urgency=low + + * Fix Debian package to not try to run test suite, since haskell-tasty + is not out of new or in Build-Depends yet. + * dropunused, addunused: Allow "all" instead of a range to + act on all unused data. + * Ensure execute bit is set on directories when core.sharedrepository is set. + * Ensure that core.sharedrepository is honored when creating the .git/annex + directory. + * Improve repair code in the case where the index file is corrupt, + and this hides other problems from git fsck. + + -- Joey Hess Wed, 20 Nov 2013 12:54:18 -0400 + +git-annex (5.20131118) unstable; urgency=low + + * Direct mode repositories now have core.bare=true set, to prevent + accidentally running git commands that try to operate on the work tree, + and so do the wrong thing in direct mode. + * annex.version is now set to 5 for direct mode repositories. + This upgrade is handled fully automatically, no need to run + git annex upgrade + * The "status" command has been renamed to "info", to allow + "git annex status" to be used in direct mode repositories, now that + "git status" won't work in them. + * The -c option now not only modifies the git configuration seen by + git-annex, but it is passed along to every git command git-annex runs. + * watcher: Avoid loop when adding a file owned by someone else fails + in indirect mode because its permissions cannot be modified. + * webapp: Avoid encoding problems when displaying the daemon log file. + * webapp: Improve UI around remote that have no annex.uuid set, + either because setup of them is incomplete, or because the remote + git repository is not a git-annex repository. + * Include ssh-keygen in standalone bundle. + * Allow optionally configuring git-annex with -fEKG to enable awesome + remote monitoring interfaceat http://localhost:4242/ + * Fix bug that caused bad information to be written to the git-annex branch + when running describe or other commands with a remote that has no uuid. + * Work around Android linker problem that had prevented git-annex from + running on Android 4.3 and 4.4. + * repair: Handle case where index file is corrupt, but all objects are ok. + * assistant: Notice on startup when the index file is corrupt, and + auto-repair. + * Fix direct mode merge bug when a direct mode file was deleted and replaced + with a directory. An ordering problem caused the directory to not get + created in this case. + Thanks to Tim for the test case. + * Direct mode .git/annex/objects directories are no longer left writable, + because that allowed writing to symlinks of files that are not present, + which followed the link and put bad content in an object location. + Thanks to Tim for the test case. + * fsck: Fix up .git/annex/object directory permissions. + * Switched to the tasty test framework. + * Android: Adjust default .gitignore to ignore .thumbnails at any location + in the tree, not just at its top. + * webapp: Check annex.version. + + -- Joey Hess Mon, 18 Nov 2013 10:45:43 -0400 + +git-annex (4.20131106) unstable; urgency=low + + * Improve local pairing behavior when two computers both try to start + the pairing process separately. + * sync: Work even when the local git repository is new and empty, + with no master branch. + * gcrypt, bup: Fix bug that prevented using these special remotes + with encryption=pubkey. + * Fix enabling of gcrypt repository accessed over ssh; + git-annex-shell gcryptsetup had a bug that caused it to fail + with permission denied. + * Fix zombie process that occurred when switching between repository + views in the webapp. + * map: Work when there are gcrypt remotes. + * Fix build w/o webapp. + * Fix exception handling bug that could cause .git/annex/index to be used + for git commits outside the git-annex branch. Known to affect git-annex + when used with the git shipped with Ubuntu 13.10. + + -- Joey Hess Wed, 06 Nov 2013 11:17:47 -0400 + git-annex (4.20131101) unstable; urgency=low * The "git annex content" command is renamed to "git annex wanted". diff --git a/debian/control b/debian/control index 9119746049..6fbd2a06a7 100644 --- a/debian/control +++ b/debian/control @@ -53,7 +53,7 @@ Build-Depends: libghc-feed-dev, ikiwiki, perlmagick, - git, + git (>= 1:1.8.4), rsync, wget, curl, @@ -68,7 +68,7 @@ Package: git-annex Architecture: any Section: utils Depends: ${misc:Depends}, ${shlibs:Depends}, - git (>= 1:1.7.7.6), + git (>= 1:1.8.4), rsync, wget, curl, diff --git a/debian/rules b/debian/rules index 3a0511fa67..91854aa15b 100755 --- a/debian/rules +++ b/debian/rules @@ -9,6 +9,9 @@ export RELEASE_BUILD=1 %: dh $@ +override_dh_auto_test: + echo test suite currently disabled until haskell-tasty is out of NEW + # Not intended for use by anyone except the author. announcedir: @echo ${HOME}/src/git-annex/doc/news diff --git a/doc/assistant/downloadupgrade.png b/doc/assistant/downloadupgrade.png new file mode 100644 index 0000000000..157eaddc7b Binary files /dev/null and b/doc/assistant/downloadupgrade.png differ diff --git a/doc/assistant/remote_sharing_walkthrough/comment_4_978fab3cd165b4ca245e32fc48cf0970._comment b/doc/assistant/remote_sharing_walkthrough/comment_4_978fab3cd165b4ca245e32fc48cf0970._comment new file mode 100644 index 0000000000..ab0b19160a --- /dev/null +++ b/doc/assistant/remote_sharing_walkthrough/comment_4_978fab3cd165b4ca245e32fc48cf0970._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.246" + subject="comment 4" + date="2013-11-12T18:18:16Z" + content=""" +You can easily use a removable drive as a transfer repository to sync two computers that have no network connection. Just use the webapp to add the drive on one computer. The drive will be set up as a transfer repository by default. The webapp will automatically start copying all your files to it. Then you can disconnect the drive, bring it to the other computer, and repeat the process. Everything from the first computer will then sync over from the drive to the second computer. And repeat moving the drive back and forth to keep things in sync. +"""]] diff --git a/doc/assistant/remote_sharing_walkthrough/comment_4_d7e879f7b098964040df2e27a18eda72._comment b/doc/assistant/remote_sharing_walkthrough/comment_4_d7e879f7b098964040df2e27a18eda72._comment new file mode 100644 index 0000000000..71f57e9b3a --- /dev/null +++ b/doc/assistant/remote_sharing_walkthrough/comment_4_d7e879f7b098964040df2e27a18eda72._comment @@ -0,0 +1,18 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmkXtBdMgE1d9nCz2iBc4f85xh4izZ_auU" + nickname="Ulrich" + subject="Using a portable drive as another transfer device?" + date="2013-11-12T16:52:12Z" + content=""" +I try to understand how to setup git-annex for the following use case: + +Two computers, that are paired via remote sharing, using some cloud repository for transfer, and a local NAS for backups. + +These two computers are sometimes in the same network, sometimes in different networks, and sometimes even without network at all. From what I read, it should be possible to bypass the cloud when these two machines are on the same network, which sounds great. + +Would it be possible to use a portable drive as \"another link\" between these two computers that can be used to sync them even if there is no network between them? + +And as you write, if the pairing has been set up manually, then everything is fine - so could it be that it is really easy and only necessary to setup the git-annex on the local drive as an additional remote on both (or only one?) machine? + +thanks for any insight! +"""]] diff --git a/doc/assistant/remote_sharing_walkthrough/comment_5_00852736d47c05772b15c5ff54ae7da7._comment b/doc/assistant/remote_sharing_walkthrough/comment_5_00852736d47c05772b15c5ff54ae7da7._comment new file mode 100644 index 0000000000..a66fcd098d --- /dev/null +++ b/doc/assistant/remote_sharing_walkthrough/comment_5_00852736d47c05772b15c5ff54ae7da7._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmkXtBdMgE1d9nCz2iBc4f85xh4izZ_auU" + nickname="Ulrich" + subject="Using a portable drive as another transfer device? – cool." + date="2013-11-14T19:05:56Z" + content=""" +Thanks - I was hoping that it is that easy. I'll try that as soon as I have a working version of the latest git-annex (trying to build with brew for Mac OS X 10.9, but without success so far). +"""]] diff --git a/doc/assistant/upgradecomplete.png b/doc/assistant/upgradecomplete.png new file mode 100644 index 0000000000..3f8c7f3c2b Binary files /dev/null and b/doc/assistant/upgradecomplete.png differ diff --git a/doc/bare_repositories.mdwn b/doc/bare_repositories.mdwn index 7fa0359856..975a638b87 100644 --- a/doc/bare_repositories.mdwn +++ b/doc/bare_repositories.mdwn @@ -39,7 +39,7 @@ Now configure the remote and do the initial push: git remote add origin example.com:bare-annex.git git push origin master git-annex -Now `git annex status` should show the configured bare remote. If it does not, you may have to pull from the remote first (older versions of `git-annex`) +Now `git annex info` should show the configured bare remote. If it does not, you may have to pull from the remote first (older versions of `git-annex`) If you wish to configure git such that you can push/pull without arguments, set the upstream branch: diff --git a/doc/bugs/127.0.0.1_references_on_remote_assistant_access.mdwn b/doc/bugs/127.0.0.1_references_on_remote_assistant_access.mdwn new file mode 100644 index 0000000000..bf62df8d53 --- /dev/null +++ b/doc/bugs/127.0.0.1_references_on_remote_assistant_access.mdwn @@ -0,0 +1,20 @@ +### Please describe the problem. +When I use git-annex webapp with a remote IP of a headless computer, I am sometimes redirected to a 127.0.0.1 address (with a different port as well) + +### What steps will reproduce the problem? +1. Install git-annex as usual. +2. Open git-annex assistant from a headless machine and access the webapp with the --listen option. (e.g. git annex webapp --listen=xxx.yyy.zzz.www) +3. Create your first local repository. Then create a second local repository. +4. When assistant asks you if you want to merge these 2 repositories, try to select the second option (to keep them separated). +5. You are redirected from your remote IP to 127.0.0.1 to a new port number. + +(I also encountered the same error at another menu or function, but I don't remember where. Sorry.) + +### What version of git-annex are you using? On what operating system? +4.20130815 +Ubuntu 13.10 64-bit (kernel 3.11.0-13-generic x86_64) + +### Please provide any additional information below. +Please ask me for any additional information that may be useful. + +> [[dup]] of [[Hangs_on_creating_repository_when_using_--listen]]; [[done]] --[[Joey]] diff --git a/doc/bugs/Android:_Clocking_on___34__Files__34___in_the_Dashboard_seems_to_do_nothing.mdwn b/doc/bugs/Android:_Clocking_on___34__Files__34___in_the_Dashboard_seems_to_do_nothing.mdwn new file mode 100644 index 0000000000..a13bb95e31 --- /dev/null +++ b/doc/bugs/Android:_Clocking_on___34__Files__34___in_the_Dashboard_seems_to_do_nothing.mdwn @@ -0,0 +1,21 @@ +### Please describe the problem. + +I expected at least a listing of files... ideally with basic navigation and options to select/deselect to be fetched/dropped + +### What steps will reproduce the problem? + +Click on "Files" link near "Repository: " on top right of the Dashboard + +### What version of git-annex are you using? On what operating system? + +last Android build from Nov 18 2013 + +### 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/Android:_Clocking_on___34__Files__34___in_the_Dashboard_seems_to_do_nothing/comment_1_a9b03d4f4760fea2754a4dc93547f0a3._comment b/doc/bugs/Android:_Clocking_on___34__Files__34___in_the_Dashboard_seems_to_do_nothing/comment_1_a9b03d4f4760fea2754a4dc93547f0a3._comment new file mode 100644 index 0000000000..69cfaefd2f --- /dev/null +++ b/doc/bugs/Android:_Clocking_on___34__Files__34___in_the_Dashboard_seems_to_do_nothing/comment_1_a9b03d4f4760fea2754a4dc93547f0a3._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.64" + subject="comment 1" + date="2013-11-26T16:12:42Z" + content=""" +git-annex does not have a built-in file manager. I don't know how to get android to display a file manager; if there's a command that can be run, or an intent that can be used to get one, git-annex could do that. But I don't think android typically includes a file manager, I have only seen them as OEM addons on some of the more laptop form factor android devices. + +I think that the android web browser also does not support browsing file:// uri, which is what git-annex falls back to when it cannot file a file manager to top. +"""]] diff --git a/doc/bugs/Android:_Clocking_on___34__Files__34___in_the_Dashboard_seems_to_do_nothing/comment_2_015e859a16b1ce4c0c7601df0594d555._comment b/doc/bugs/Android:_Clocking_on___34__Files__34___in_the_Dashboard_seems_to_do_nothing/comment_2_015e859a16b1ce4c0c7601df0594d555._comment new file mode 100644 index 0000000000..039acd4401 --- /dev/null +++ b/doc/bugs/Android:_Clocking_on___34__Files__34___in_the_Dashboard_seems_to_do_nothing/comment_2_015e859a16b1ce4c0c7601df0594d555._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://yarikoptic.myopenid.com/" + nickname="site-myopenid" + subject="comment 2" + date="2013-11-27T04:36:14Z" + content=""" +Thanks for the explanation! Might be better then to remove Files in Android build to prevent confusion? + +OI filemanager http://www.openintents.org/en/filemanager I believe is open source. according to app info it is only 1.53MB (thus negligible in comparison) and probably could be 'collaborated with' so they could ship basic support for annex (git annex get/drop)... I just don't know if it would be possible to start existing OI manager under annex user (that would be needed right?). +"""]] diff --git a/doc/bugs/Android___34__This_build_of_git-annex_does_not_support_XMPP_pairing__34__.mdwn b/doc/bugs/Android___34__This_build_of_git-annex_does_not_support_XMPP_pairing__34__.mdwn new file mode 100644 index 0000000000..08b44fc933 --- /dev/null +++ b/doc/bugs/Android___34__This_build_of_git-annex_does_not_support_XMPP_pairing__34__.mdwn @@ -0,0 +1,24 @@ +### Please describe the problem. + +Upon a new (re-)installation of Android ("proper" build as from http://downloads.kitenet.net/git-annex/android/current/4.0/git-annex.apk Last-Modified: Mon, 18 Nov 2013 11:57:25 GMT), as well as whatever was day before a daily build, I am getting a message in web ui "not supported This build of git-annex does not support XMPP pairing. Sorry!" whenever I am entering "Share with your other devices" among "Add more repositories". + +### What steps will reproduce the problem? + +I had some older and then freshier (yesterday daily build) installed. Then uninstalled and current "proper" build installed. +it picked up initialized repository I did yesterday but when I went into "Share ..." link I saw the message without any option to add such another device + +### What version of git-annex are you using? On what operating system? + +Android + +About says 5.20131118-gc7e5cde. + +### 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/Android___34__This_build_of_git-annex_does_not_support_XMPP_pairing__34__/comment_1_c034bb84e58b2dda1038ba205ec78c56._comment b/doc/bugs/Android___34__This_build_of_git-annex_does_not_support_XMPP_pairing__34__/comment_1_c034bb84e58b2dda1038ba205ec78c56._comment new file mode 100644 index 0000000000..ef0661cb8f --- /dev/null +++ b/doc/bugs/Android___34__This_build_of_git-annex_does_not_support_XMPP_pairing__34__/comment_1_c034bb84e58b2dda1038ba205ec78c56._comment @@ -0,0 +1,273 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.64" + subject="comment 1" + date="2013-11-26T17:23:52Z" + content=""" +I think that older Android builds did support this (IIRC). However, I recently rebootstrapped my android dev environment, and when I enable the XMPP flag now: + +
+system.c:222:0:  error: undefined reference to 'pthread_atfork'
+
+cipher.c:213:0:  error: undefined reference to 'nettle_cbc_encrypt'
+
+cipher.c:213:0:  error: undefined reference to 'nettle_cbc_decrypt'
+
+cipher.c:213:0:  error: undefined reference to 'nettle_des_encrypt'
+
+cipher.c:213:0:  error: undefined reference to 'nettle_des_decrypt'
+
+cipher.c:213:0:
+     error: undefined reference to 'nettle_arcfour_crypt'
+
+cipher.c:213:0:
+     error: undefined reference to 'nettle_des3_encrypt'
+
+cipher.c:213:0:
+     error: undefined reference to 'nettle_des3_decrypt'
+
+cipher.c:213:0:
+     error: undefined reference to 'nettle_arctwo_encrypt'
+
+cipher.c:213:0:
+     error: undefined reference to 'nettle_arctwo_decrypt'
+
+cipher.c:265:0:
+     error: undefined reference to 'nettle_arcfour_set_key'
+
+cipher.c:68:0:
+     error: undefined reference to 'nettle_aes_set_encrypt_key'
+
+cipher.c:69:0:
+     error: undefined reference to 'nettle_aes_invert_key'
+
+cipher.c:96:0:
+     error: undefined reference to 'nettle_camellia_set_encrypt_key'
+
+cipher.c:97:0:
+     error: undefined reference to 'nettle_camellia_invert_key'
+
+cipher.c:268:0:
+     error: undefined reference to 'nettle_arctwo_set_key'
+
+cipher.c:239:0:
+     error: undefined reference to 'nettle_des_fix_parity'
+
+cipher.c:242:0:
+     error: undefined reference to 'nettle_des3_set_key'
+
+cipher.c:255:0:
+     error: undefined reference to 'nettle_des_fix_parity'
+
+cipher.c:257:0:  error: undefined reference to 'nettle_des_set_key'
+
+cipher.c:83:0:  error: undefined reference to 'nettle_aes_decrypt'
+
+cipher.c:76:0:  error: undefined reference to 'nettle_aes_encrypt'
+
+cipher.c:111:0:
+     error: undefined reference to 'nettle_camellia_crypt'
+
+cipher.c:104:0:
+     error: undefined reference to 'nettle_camellia_crypt'
+
+mac.c:146:0:
+     error: undefined reference to 'nettle_hmac_sha256_update'
+
+mac.c:146:0:
+     error: undefined reference to 'nettle_hmac_sha224_digest'
+
+mac.c:146:0:
+     error: undefined reference to 'nettle_hmac_sha224_set_key'
+
+mac.c:146:0:
+     error: undefined reference to 'nettle_hmac_md5_update'
+
+mac.c:146:0:
+     error: undefined reference to 'nettle_hmac_md5_digest'
+
+mac.c:146:0:
+     error: undefined reference to 'nettle_hmac_md5_set_key'
+
+mac.c:146:0:
+     error: undefined reference to 'nettle_hmac_sha1_update'
+
+mac.c:146:0:
+     error: undefined reference to 'nettle_hmac_sha1_digest'
+
+mac.c:146:0:
+     error: undefined reference to 'nettle_hmac_sha1_set_key'
+
+mac.c:146:0:
+     error: undefined reference to 'nettle_hmac_sha256_digest'
+
+mac.c:146:0:
+     error: undefined reference to 'nettle_hmac_sha256_set_key'
+
+mac.c:146:0:
+     error: undefined reference to 'nettle_hmac_sha512_update'
+
+mac.c:146:0:
+     error: undefined reference to 'nettle_hmac_sha384_digest'
+
+mac.c:146:0:
+     error: undefined reference to 'nettle_hmac_sha384_set_key'
+
+mac.c:146:0:
+     error: undefined reference to 'nettle_hmac_sha512_digest'
+
+mac.c:146:0:
+     error: undefined reference to 'nettle_hmac_sha512_set_key'
+
+mac.c:243:0:  error: undefined reference to 'nettle_sha224_init'
+
+mac.c:222:0:  error: undefined reference to 'nettle_md5_init'
+
+mac.c:229:0:  error: undefined reference to 'nettle_sha1_init'
+
+mac.c:236:0:  error: undefined reference to 'nettle_md2_init'
+
+mac.c:250:0:  error: undefined reference to 'nettle_sha256_init'
+
+mac.c:257:0:  error: undefined reference to 'nettle_sha384_init'
+
+mac.c:264:0:  error: undefined reference to 'nettle_sha512_init'
+
+mac.c:278:0:  error: undefined reference to 'nettle_sha256_update'
+
+mac.c:278:0:  error: undefined reference to 'nettle_sha224_digest'
+
+mac.c:278:0:  error: undefined reference to 'nettle_md5_update'
+
+mac.c:278:0:  error: undefined reference to 'nettle_md5_digest'
+
+mac.c:278:0:  error: undefined reference to 'nettle_sha1_update'
+
+mac.c:278:0:  error: undefined reference to 'nettle_sha1_digest'
+
+mac.c:278:0:  error: undefined reference to 'nettle_md2_update'
+
+mac.c:278:0:  error: undefined reference to 'nettle_md2_digest'
+
+mac.c:278:0:  error: undefined reference to 'nettle_sha256_digest'
+
+mac.c:278:0:  error: undefined reference to 'nettle_sha512_update'
+
+mac.c:278:0:  error: undefined reference to 'nettle_sha384_digest'
+
+mac.c:278:0:  error: undefined reference to 'nettle_sha512_digest'
+
+mpi.c:48:0:
+     error: undefined reference to 'nettle_mpz_sizeinbase_256_u'
+
+mpi.c:80:0:  error: undefined reference to 'nettle_mpz_get_str_256'
+
+mpi.c:76:0:  error: undefined reference to 'nettle_mpz_get_str_256'
+
+mpi.c:52:0:
+     error: undefined reference to 'nettle_mpz_sizeinbase_256_s'
+
+mpi.c:56:0:
+     error: undefined reference to 'nettle_mpz_sizeinbase_256_u'
+
+mpi.c:142:0:
+     error: undefined reference to 'nettle_mpz_set_str_256_u'
+
+mpi.c:117:0:
+     error: undefined reference to 'nettle_mpz_set_str_256_u'
+
+mpi.c:121:0:
+     error: undefined reference to 'nettle_mpz_set_str_256_s'
+
+mpi.c:470:0:
+     error: undefined reference to 'nettle_mpz_set_str_256_u'
+
+mpi.c:496:0:
+     error: undefined reference to 'nettle_mpz_set_str_256_u'
+
+pk.c:505:0:
+     error: undefined reference to 'nettle_dsa_public_key_init'
+
+pk.c:506:0:
+     error: undefined reference to 'nettle_dsa_private_key_init'
+
+pk.c:515:0:
+     error: undefined reference to 'nettle_dsa_generate_keypair'
+
+pk.c:545:0:
+     error: undefined reference to 'nettle_dsa_private_key_clear'
+
+pk.c:546:0:
+     error: undefined reference to 'nettle_dsa_public_key_clear'
+
+pk.c:558:0:
+     error: undefined reference to 'nettle_rsa_public_key_init'
+
+pk.c:559:0:
+     error: undefined reference to 'nettle_rsa_private_key_init'
+
+pk.c:563:0:
+     error: undefined reference to 'nettle_rsa_generate_keypair'
+
+pk.c:598:0:
+     error: undefined reference to 'nettle_rsa_private_key_clear'
+
+pk.c:599:0:
+     error: undefined reference to 'nettle_rsa_public_key_clear'
+
+pk.c:598:0:
+     error: undefined reference to 'nettle_rsa_private_key_clear'
+
+pk.c:599:0:
+     error: undefined reference to 'nettle_rsa_public_key_clear'
+
+pk.c:545:0:
+     error: undefined reference to 'nettle_dsa_private_key_clear'
+
+pk.c:546:0:
+     error: undefined reference to 'nettle_dsa_public_key_clear'
+
+pk.c:286:0:
+     error: undefined reference to 'nettle_dsa_signature_init'
+
+pk.c:296:0:  error: undefined reference to '_nettle_dsa_sign'
+
+pk.c:309:0:
+     error: undefined reference to 'nettle_dsa_signature_clear'
+
+pk.c:344:0:
+     error: undefined reference to 'nettle_rsa_compute_root'
+
+pk.c:309:0:
+     error: undefined reference to 'nettle_dsa_signature_clear'
+
+pk.c:231:0:
+     error: undefined reference to 'nettle_rsa_compute_root'
+
+pk.c:441:0:  error: undefined reference to '_nettle_dsa_verify'
+
+rnd.c:222:0:
+     error: undefined reference to 'nettle_yarrow256_update'
+
+rnd.c:340:0:
+     error: undefined reference to 'nettle_yarrow256_update'
+
+rnd.c:284:0:
+     error: undefined reference to 'nettle_yarrow256_update'
+
+rnd.c:388:0:
+     error: undefined reference to 'nettle_yarrow256_slow_reseed'
+
+rnd.c:465:0:
+     error: undefined reference to 'nettle_yarrow256_random'
+
+rnd.c:421:0:  error: undefined reference to 'nettle_yarrow256_init'
+
+rnd.c:437:0:
+     error: undefined reference to 'nettle_yarrow256_slow_reseed'
+collect2: error: ld returned 1 exit status
+make: *** [android] Error 1
+
+ + +"""]] diff --git a/doc/bugs/Android___34__This_build_of_git-annex_does_not_support_XMPP_pairing__34__/comment_2_99a754f41d59fdd401ba6d169945e7c9._comment b/doc/bugs/Android___34__This_build_of_git-annex_does_not_support_XMPP_pairing__34__/comment_2_99a754f41d59fdd401ba6d169945e7c9._comment new file mode 100644 index 0000000000..6c5f48d5c6 --- /dev/null +++ b/doc/bugs/Android___34__This_build_of_git-annex_does_not_support_XMPP_pairing__34__/comment_2_99a754f41d59fdd401ba6d169945e7c9._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.64" + subject="comment 2" + date="2013-11-26T19:40:55Z" + content=""" +Managed to get it to build with XMPP, but it was quite a hack job getting the C libraries to behave, and I have not been able to test it yet. The daily build has it if you want to give it a try. +"""]] diff --git a/doc/bugs/Assistant_has_created_155_semitrusted_repositories.mdwn b/doc/bugs/Assistant_has_created_155_semitrusted_repositories.mdwn new file mode 100644 index 0000000000..b1caf530d4 --- /dev/null +++ b/doc/bugs/Assistant_has_created_155_semitrusted_repositories.mdwn @@ -0,0 +1,191 @@ +### Please describe the problem. +git annex status reports 160 semitrusted repositories. Four of them are the ones I created (only via webapp, I think I never edited any git-annex config file). One is 00000000-0000-0000-0000-000000000001 -- web + and although I do not know what it is, it is not something new. The remaining 155 appeared spontaneously after several Gb of data (mostly many small files) were added to an Annex (in an 'archive' directory) operated in direct mode by the assistant. + + + +### What steps will reproduce the problem? +Add several Gb of files was enough to trigger this problem, but I did not try to reproduce it. It happened the day I installed the 4.20131106~bpo70+1 version. + +### What version of git-annex are you using? On what operating system? + +4.20131106~bpo70+1 on debian squeeze (7.2), with git 1.8.4.rc3. + + +### Please provide any additional information below. +May be related or not: at some point the webapp displayed two warning boxes. One of them held a message that I did not wirte down and proposed to "Restart the thread". This apparently worked since the box disappeared. The other warning box indicated "NetWatcherFallback crashed: unknown response from git cat-file" and proposed to restart the thread. Trying to "restart the thread" via the provided button just did not trigger any response of the webapp which seemed dead at that point. + +In spite of the git annex status shown below, the webapp still shows only the expected four repositories. + +Output of git annex status (hostname and xmpp account name were edited away): +[[!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 +repository mode: direct +trusted repositories: +0 +semitrusted repositories: 160 + 00000000-0000-0000-0000-000000000001 -- web + 0ab193eb-0c76-4559-a93c-2e30ed8630a8 -- someMachineIown_datadir (archive) + 1384784127.91222s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384784164.437824s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384784176.944372s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384784179.254498s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384785147.558938s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785147.717223s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785159.041203s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785159.199504s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785185.79485s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785187.318128s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785215.236504s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785215.389096s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785313.539843s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785313.701305s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785315.596206s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785344.184461s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785348.192805s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785402.70316s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785406.524044s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785446.074236s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384873605.313126s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384873697.029999s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384873761.687234s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384873774.608376s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384926279.456728s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384926368.736s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384926454.99433s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384926494.152645s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384926504.438232s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384934790.89717s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384934848.757067s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384934899.087168s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384934908.238587s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384948772.14552s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384948805.441196s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384948813.397132s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384948921.45481s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384948924.855852s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384949073.988946s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384949082.298976s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384949399.608138s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384949581.12213s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384949583.9923s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384949700.22807s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384949765.484768s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384955202.85962s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384955230.953995s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384955402.534938s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384955457.1885s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384955524.603709s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384955611.891061s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384955677.84592s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384955689.293082s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384955894.057476s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384955910.723021s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384955914.732132s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384955968.717875s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384955969.634658s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384956004.284925s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384956029.567195s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384956188.628995s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384956379.844701s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384956381.613833s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384956387.923418s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384956395.418701s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384956408.792928s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384956504.019733s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384956519.578085s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384956524.419783s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384965891.562742s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384965891.815119s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384965903.355602s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384965905.276128s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384965978.806653s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384965979.393089s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384966097.495566s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384966097.704474s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384966154.97658s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384966156.967406s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384966233.310488s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384966233.522324s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384966241.284523s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384966241.475381s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384966301.688497s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384966303.427685s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384966392.875983s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384966393.38718s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384966404.708568s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384966406.441164s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384966553.557387s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384966555.752786s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384966653.725847s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384966654.23288s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384966695.201885s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384966695.689398s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384966784.556877s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384966786.574886s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384966791.446852s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384966793.218318s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384966884.335685s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384966886.147083s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384967054.857465s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384967055.158871s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384967190.980027s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384967193.176584s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384967328.93796s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384967330.428095s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384967526.127311s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384967526.588491s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384967627.132549s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384967627.685201s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384967686.283694s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384967686.728086s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384967768.270887s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384967768.58402s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384967769.245615s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384967771.122238s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384967813.8197s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384967814.168477s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384967915.243469s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384967917.020051s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384968031.757775s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384968032.190452s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384968035.733635s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384968036.03299s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384968144.555556s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384968144.714535s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384968150.090148s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384968150.820567s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384968304.393177s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384968304.613624s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384968604.499519s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384968604.813256s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384968702.566939s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384968704.427767s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384968725.375289s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384968725.939271s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384968798.402904s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384968798.659754s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384969055.285004s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384969055.715448s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384969159.885115s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384969162.382266s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384969184.633052s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384969185.413769s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384969374.791849s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384969377.497842s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384969475.469111s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384969489.697737s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384969492.087023s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384969492.58214s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384969784.725195s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384969786.49773s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384969814.984624s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384969815.397676s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 391b0557-dc68-4e40-b6d0-da3033588753 -- here (client) + 668ef9d8-68c6-484e-89e5-06634d590a11 -- rsync.net_datadir_annex (transfer) + b0d3c000-0ac9-4a05-aef4-47f826d5c759 -- user.name (client) + + +# End of transcript or log. +"""]] diff --git a/doc/bugs/Assistant_has_created_155_semitrusted_repositories/comment_1_169b24b34cce3f5c8446c2150beb6827._comment b/doc/bugs/Assistant_has_created_155_semitrusted_repositories/comment_1_169b24b34cce3f5c8446c2150beb6827._comment new file mode 100644 index 0000000000..99bb737e4f --- /dev/null +++ b/doc/bugs/Assistant_has_created_155_semitrusted_repositories/comment_1_169b24b34cce3f5c8446c2150beb6827._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.64" + subject="comment 1" + date="2013-11-22T16:54:53Z" + content=""" +Please post the output of `git show git-annex:uuid.log` run in the repository. +"""]] diff --git a/doc/bugs/Assistant_has_created_155_semitrusted_repositories/comment_2_6acd6f38297772a07d8d5fb999bd2eaa._comment b/doc/bugs/Assistant_has_created_155_semitrusted_repositories/comment_2_6acd6f38297772a07d8d5fb999bd2eaa._comment new file mode 100644 index 0000000000..6db2a8fcae --- /dev/null +++ b/doc/bugs/Assistant_has_created_155_semitrusted_repositories/comment_2_6acd6f38297772a07d8d5fb999bd2eaa._comment @@ -0,0 +1,183 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnNqLKszWk9EoD4CDCqNXJRIklKFBCN1Ao" + nickname="maurizio" + subject="comment 2" + date="2013-11-22T17:23:19Z" + content=""" +Here it is (user name edited): + +[[!format sh \"\"\" + + +0ab193eb-0c76-4559-a93c-2e30ed8630a8 archive timestamp=1384664310.014349s +0ab193eb-0c76-4559-a93c-2e30ed8630a8 datadir on st08 timestamp=1384522780.868451s +0ab193eb-0c76-4559-a93c-2e30ed8630a8 username@st08:~/datadir_annex timestamp=1384540428.076617s +0ab193eb-0c76-4559-a93c-2e30ed8630a8 username@st08:~/datadir_annex timestamp=1384541057.852874s +0ab193eb-0c76-4559-a93c-2e30ed8630a8 username@st08:~/datadir_annex timestamp=1384548609.891111s +1384784127.91222s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384784164.437824s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384784176.944372s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384784179.254498s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384785147.558938s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384785147.717223s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384785159.041203s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384785159.199504s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384785185.79485s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384785187.318128s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384785215.236504s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384785215.389096s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384785313.539843s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384785313.701305s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384785315.596206s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384785344.184461s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384785348.192805s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384785402.70316s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384785406.524044s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384785446.074236s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384873605.313126s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384873697.029999s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384873761.687234s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384873774.608376s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384926279.456728s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384926368.736s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384926454.99433s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384926494.152645s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384926504.438232s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384934790.89717s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384934848.757067s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384934899.087168s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384934908.238587s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384948772.14552s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384948805.441196s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384948813.397132s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384948921.45481s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384948924.855852s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384949073.988946s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384949082.298976s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384949399.608138s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384949581.12213s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384949583.9923s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384949700.22807s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384949765.484768s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384955202.85962s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384955230.953995s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384955402.534938s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384955457.1885s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384955524.603709s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384955611.891061s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384955677.84592s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384955689.293082s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384955894.057476s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384955910.723021s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384955914.732132s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384955968.717875s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384955969.634658s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384956004.284925s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384956029.567195s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384956188.628995s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384956379.844701s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384956381.613833s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384956387.923418s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384956395.418701s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384956408.792928s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384956504.019733s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384956519.578085s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384956524.419783s 1 391b0557-dc68-4e40-b6d0-da3033588753 +1384965891.562742s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384965891.815119s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384965903.355602s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384965905.276128s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384965978.806653s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384965979.393089s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384966097.495566s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384966097.704474s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384966154.97658s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384966156.967406s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384966233.310488s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384966233.522324s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384966241.284523s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384966241.475381s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384966301.688497s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384966303.427685s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384966392.875983s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384966393.38718s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384966404.708568s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384966406.441164s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384966553.557387s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384966555.752786s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384966653.725847s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384966654.23288s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384966695.201885s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384966695.689398s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384966784.556877s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384966786.574886s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384966791.446852s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384966793.218318s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384966884.335685s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384966886.147083s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384967054.857465s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384967055.158871s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384967190.980027s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384967193.176584s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384967328.93796s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384967330.428095s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384967526.127311s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384967526.588491s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384967627.132549s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384967627.685201s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384967686.283694s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384967686.728086s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384967768.270887s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384967768.58402s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384967769.245615s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384967771.122238s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384967813.8197s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384967814.168477s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384967915.243469s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384967917.020051s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384968031.757775s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384968032.190452s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384968035.733635s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384968036.03299s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384968144.555556s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384968144.714535s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384968150.090148s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384968150.820567s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384968304.393177s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384968304.613624s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384968604.499519s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384968604.813256s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384968702.566939s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384968704.427767s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384968725.375289s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384968725.939271s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384968798.402904s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384968798.659754s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384969055.285004s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384969055.715448s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384969159.885115s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384969162.382266s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384969184.633052s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384969185.413769s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384969374.791849s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384969377.497842s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384969475.469111s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384969489.697737s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384969492.087023s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384969492.58214s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384969784.725195s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384969786.49773s 0 391b0557-dc68-4e40-b6d0-da3033588753 +1384969814.984624s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 +1384969815.397676s 0 391b0557-dc68-4e40-b6d0-da3033588753 +391b0557-dc68-4e40-b6d0-da3033588753 client timestamp=1384528843.958836s +391b0557-dc68-4e40-b6d0-da3033588753 username@big:~/datadir/Annex timestamp=1384521164.194035s +668ef9d8-68c6-484e-89e5-06634d590a11 cipher=dFpZLzI4M3ZqVUl1S0p3ajl5N25vUUJyTFJXand5T2pNSGliOGo5WXBkN2NNY3ZqR3pvNmN0L2tLOFFKZW1aWDdHYUpCMGF1UGxybk9zeUdQOEpsMGZ5RzgwTVo1S2N6Rlo1eTVnNXFGYjJmblV0bzRjT3lTb29uZnY1QmpwMVVwYlZEOGVlaVlNR0R5dTcxNW50TFcrU1dSVi9PUXk5RkR6Zm14UFJzZEEvOHB5MTZXbkp5TW13Qm5UZ2FkUEsrUTdVZ2cxVWZnai9mbGRDYWVXYlpDVzFQL2tzanNTMU16aGxuVktETXpOY04vR1lSZnEzNVdJSkpDUEtMV1pPWXczVUVNTEJCNGtmUldiTVZoWWdlYm9NTTN4T2c1RXRvTXEzTytXazNaaFNKeUtsSlNmOUFXdTIrYnZLbkgvSFljSFVPOVlid0lCSHFlSDk0ZVQ3M3E4eHR6ckM1SjdIbjF0dmRSTGVibFFSdzUrdnVMM3p6UDl5R0JOUWNhL3Q4MXVVVGF0RjFjNGoyditZUGRzOUEraHZ5Z29hNkk0SDNiaVdYVnJFQmxTRTdTd3hOcjR3amJzRkd3d1VEUXFFZDhLNTBhWGF6bUY5LzZCZ2F5U1lOZEFDdXdSU2pMOU9qVGJWM29wVGNhNEt1Z09jU1JXRnQ0QUhoZXMxZlpvN1Qzc1o4WTQ3S1dUNVdJM3FjK05aQm5kUk10Nm8zSG1Ccys3cFdDUWVaUGJCbUhwK2ozdGw0cmxhK3FydkF5b3ZOM0xmbEJKdVBpTHNxd3JSUEpXdndkSENzQjlteHovZW9JOUtWUGJKNGxoRExSRVloNDUrNFZ6YmFZQVNZdkcxV2JxSzZTc2ZING90cmRBREZtTFRlRnc3OW92ZXBxQ0pPa21UMFFuR0ZJNG89Cg== encryption=shared name=rsync.net_datadir_annex rsyncurl=rsusername@git-annex-ch-s011.rsync.net-rsusername_datadir_annex.2F:datadir_annex/ type=rsync timestamp=1384948273.302009s +668ef9d8-68c6-484e-89e5-06634d590a11 cipher=dFpZLzI4M3ZqVUl1S0p3ajl5N25vUUJyTFJXand5T2pNSGliOGo5WXBkN2NNY3ZqR3pvNmN0L2tLOFFKZW1aWDdHYUpCMGF1UGxybk9zeUdQOEpsMGZ5RzgwTVo1S2N6Rlo1eTVnNXFGYjJmblV0bzRjT3lTb29uZnY1QmpwMVVwYlZEOGVlaVlNR0R5dTcxNW50TFcrU1dSVi9PUXk5RkR6Zm14UFJzZEEvOHB5MTZXbkp5TW13Qm5UZ2FkUEsrUTdVZ2cxVWZnai9mbGRDYWVXYlpDVzFQL2tzanNTMU16aGxuVktETXpOY04vR1lSZnEzNVdJSkpDUEtMV1pPWXczVUVNTEJCNGtmUldiTVZoWWdlYm9NTTN4T2c1RXRvTXEzTytXazNaaFNKeUtsSlNmOUFXdTIrYnZLbkgvSFljSFVPOVlid0lCSHFlSDk0ZVQ3M3E4eHR6ckM1SjdIbjF0dmRSTGVibFFSdzUrdnVMM3p6UDl5R0JOUWNhL3Q4MXVVVGF0RjFjNGoyditZUGRzOUEraHZ5Z29hNkk0SDNiaVdYVnJFQmxTRTdTd3hOcjR3amJzRkd3d1VEUXFFZDhLNTBhWGF6bUY5LzZCZ2F5U1lOZEFDdXdSU2pMOU9qVGJWM29wVGNhNEt1Z09jU1JXRnQ0QUhoZXMxZlpvN1Qzc1o4WTQ3S1dUNVdJM3FjK05aQm5kUk10Nm8zSG1Ccys3cFdDUWVaUGJCbUhwK2ozdGw0cmxhK3FydkF5b3ZOM0xmbEJKdVBpTHNxd3JSUEpXdndkSENzQjlteHovZW9JOUtWUGJKNGxoRExSRVloNDUrNFZ6YmFZQVNZdkcxV2JxSzZTc2ZING90cmRBREZtTFRlRnc3OW92ZXBxQ0pPa21UMFFuR0ZJNG89Cg== encryption=shared name=rsync.net_datadir_annex rsyncurl=rsusername@git-annex-ch-s011.rsync.net-rsusername_datadir_annex:datadir_annex/ type=rsync timestamp=1384547300.727425s +668ef9d8-68c6-484e-89e5-06634d590a11 rsync.net_datadir_annex timestamp=1384547300.725734s +668ef9d8-68c6-484e-89e5-06634d590a11 rsync.net_datadir_annex timestamp=1384948273.280063s +668ef9d8-68c6-484e-89e5-06634d590a11 transfer timestamp=1384948273.352386s +b0d3c000-0ac9-4a05-aef4-47f826d5c759 client timestamp=1384575989.965159s +b0d3c000-0ac9-4a05-aef4-47f826d5c759 username@mezzo:~/datadir/Annex timestamp=1384547220.353298s + +\"\"\"]] +"""]] diff --git a/doc/bugs/Assistant_has_created_155_semitrusted_repositories/comment_3_6a4118e5c5fbe5e84d27094ac72b741b._comment b/doc/bugs/Assistant_has_created_155_semitrusted_repositories/comment_3_6a4118e5c5fbe5e84d27094ac72b741b._comment new file mode 100644 index 0000000000..2d31d1a7a6 --- /dev/null +++ b/doc/bugs/Assistant_has_created_155_semitrusted_repositories/comment_3_6a4118e5c5fbe5e84d27094ac72b741b._comment @@ -0,0 +1,22 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.64" + subject="comment 3" + date="2013-11-22T17:47:30Z" + content=""" +Any chance I could get a copy of this git repository? (Excluding the .git/annex part) + +Feel free to email me id@joeyh.name to arrange a secure transfer. + +Otherwise, I need to see what the git-annex:uuid.log file looked like before this happened to it. The corruption may have occurred progressively in several commits, or all at once. + +You might also still have some logs in `.git/annex/daemon.log*`, and sending those might help, assuming the strange messages you mentioned are logged in there. + +> 1384785215.389096s 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + +This is pretty weird thing to be in the uuid.log. The \"1\" makes me think this might be a scrambled version of what's normally stored in the trust.log: + +> 511f4722-63d5-11e1-8b26-1bb951ea9f7b 1 timestamp=1330630786.417597s + +This seems to be the same bug as [[bugs/non-repos in repositories list (+ other weird output) from git annex status]] +"""]] diff --git a/doc/bugs/Assistant_has_created_155_semitrusted_repositories/comment_4_04daa20d5d7c74bb34ec48e752ed9fe8._comment b/doc/bugs/Assistant_has_created_155_semitrusted_repositories/comment_4_04daa20d5d7c74bb34ec48e752ed9fe8._comment new file mode 100644 index 0000000000..dd037bcc02 --- /dev/null +++ b/doc/bugs/Assistant_has_created_155_semitrusted_repositories/comment_4_04daa20d5d7c74bb34ec48e752ed9fe8._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.64" + subject="comment 4" + date="2013-11-22T17:48:37Z" + content=""" +What hardware are you running git-annex on? +"""]] diff --git a/doc/bugs/Assistant_has_created_155_semitrusted_repositories/comment_5_11af8ab2587e6eeb671051ba8191995b._comment b/doc/bugs/Assistant_has_created_155_semitrusted_repositories/comment_5_11af8ab2587e6eeb671051ba8191995b._comment new file mode 100644 index 0000000000..de9d4fd719 --- /dev/null +++ b/doc/bugs/Assistant_has_created_155_semitrusted_repositories/comment_5_11af8ab2587e6eeb671051ba8191995b._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnNqLKszWk9EoD4CDCqNXJRIklKFBCN1Ao" + nickname="maurizio" + subject="comment 5" + date="2013-11-22T18:22:55Z" + content=""" +One client is a thinkpad 121e, the other one a hp Z420 workstation. The archive is a basic Dell desktop. All of them run wheezy with git-annex and git from official backports. The transfer repository is at rsync.net. + +The daemon.log file was empty at the time I noticed the situation. Now git-annex has been scanning this repository for some time and the log has information again but it looks a bit too long to be posted here. I will email about the repository copy and the log. + +"""]] diff --git a/doc/bugs/Assistant_has_created_155_semitrusted_repositories/comment_6_26236cdc2bce532017854791bcd727d1._comment b/doc/bugs/Assistant_has_created_155_semitrusted_repositories/comment_6_26236cdc2bce532017854791bcd727d1._comment new file mode 100644 index 0000000000..8b5c80f6bb --- /dev/null +++ b/doc/bugs/Assistant_has_created_155_semitrusted_repositories/comment_6_26236cdc2bce532017854791bcd727d1._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnNqLKszWk9EoD4CDCqNXJRIklKFBCN1Ao" + nickname="maurizio" + subject="comment 6" + date="2013-11-22T19:29:08Z" + content=""" +Some additional information (useful at least from user's point of view): the data that was in the annex but outside of the archive is still accessible from both clients. Part of the data that was in the archive does not seem to be accessible on one client: ```git annex get``` says it gets data in an amount which seems correct but the link to the data remains broken. Fortunately I can still access the data on the other client. Some of the data in the archive is still accessible in both clients. The part that is still accessible was put in the annex a few days ago, only the last directory which was added and seems to have triggered the problem is \"broken\" on one client. It is possible (not sure, sorry) that this directory was first added in the annex, and then moved to the archive shortly after, before the first addition had propagated to the other client. +"""]] diff --git a/doc/bugs/Assistant_has_created_155_semitrusted_repositories/comment_7_3c532dd5b8a01ecdeda1300b49aba675._comment b/doc/bugs/Assistant_has_created_155_semitrusted_repositories/comment_7_3c532dd5b8a01ecdeda1300b49aba675._comment new file mode 100644 index 0000000000..00abc500bd --- /dev/null +++ b/doc/bugs/Assistant_has_created_155_semitrusted_repositories/comment_7_3c532dd5b8a01ecdeda1300b49aba675._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnNqLKszWk9EoD4CDCqNXJRIklKFBCN1Ao" + nickname="maurizio" + subject="comment 7" + date="2013-11-23T13:16:10Z" + content=""" +OK, sorry but it will be difficult to provide you with a copy of this repository. I hope I can still help in spite of being only a very novice git user. I checked that the git-annex:uuid.log file at the first commit was identical to the one above. The only difference is that in this first commit file there is a mention at the bottom of who created the file (me@somedomain.com) with the mention \"created repository\". + +So it is very possible that these nonexisting remotes are present since day 1. It is possible that I did not notice it earlier (I am not sure I had ever run git annex status in this repository since I am looking for a dropbox-like experience). What triggered my curiosity was the difficulty I had to get some data. At that point it might be that there are two independent problems. One with these nonexisting repositories, and another one with the fact that I cannot get some data in this client. + +Would it be useful to you to have the full history (52 revisions) of the git-annex:uuid.log file? +"""]] diff --git a/doc/bugs/Assistant_has_created_155_semitrusted_repositories/comment_8_119142c5ebc499f0ee0926dbca265308._comment b/doc/bugs/Assistant_has_created_155_semitrusted_repositories/comment_8_119142c5ebc499f0ee0926dbca265308._comment new file mode 100644 index 0000000000..d50964f64c --- /dev/null +++ b/doc/bugs/Assistant_has_created_155_semitrusted_repositories/comment_8_119142c5ebc499f0ee0926dbca265308._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.64" + subject="comment 8" + date="2013-11-26T16:34:13Z" + content=""" +Yes, it would be helpful to have the full history of the file. + +You might try running `git annex fsck` on the file in the client that it says it has gotten but that you cannot access. +"""]] diff --git a/doc/bugs/Assistant_redirects_to_127.0.0.1_in_some_cases__44___although_used_remotely.mdwn b/doc/bugs/Assistant_redirects_to_127.0.0.1_in_some_cases__44___although_used_remotely.mdwn new file mode 100644 index 0000000000..1b1738aecd --- /dev/null +++ b/doc/bugs/Assistant_redirects_to_127.0.0.1_in_some_cases__44___although_used_remotely.mdwn @@ -0,0 +1,29 @@ +### Please describe the problem. +When I use git-annex webapp with a remote IP of a headless computer, +I am sometimes redirected to a 127.0.0.1 address (with a different +port as well) + +### What steps will reproduce the problem? +1. Install git-annex as usual. +2. Open git-annex assistant from a headless machine and access the +webapp with the --listen option. (e.g. git annex webapp +--listen=xxx.yyy.zzz.www) +3. Create your first local repository. Then create a second local +repository. +4. When assistant asks you if you want to merge these 2 +repositories, try to select the second option (to keep them +separated). +5. You are redirected from your remote IP to 127.0.0.1 to a new port number. + +(I also encountered the same error at another menu or function, but +I don't remember where. Sorry.) + +### What version of git-annex are you using? On what operating system? +4.20130815 +Ubuntu 13.10 64-bit (kernel 3.11.0-13-generic x86_64) + +### Please provide any additional information below. +Please ask me for any additional information that may be useful. + +> This is a duplicate of [[Switching_repositories_in_webapp_on_a_remote_server_is_not_honoring_--listen_parameter]] +> [[done]] --[[Joey]] diff --git a/doc/bugs/Assistant_uses_obsolete_GDU_volume_monitor/comment_3_d86aba42d014c4b4f708dcb5fe86e055._comment b/doc/bugs/Assistant_uses_obsolete_GDU_volume_monitor/comment_3_d86aba42d014c4b4f708dcb5fe86e055._comment index c1bc52f2c8..6256086c76 100644 --- a/doc/bugs/Assistant_uses_obsolete_GDU_volume_monitor/comment_3_d86aba42d014c4b4f708dcb5fe86e055._comment +++ b/doc/bugs/Assistant_uses_obsolete_GDU_volume_monitor/comment_3_d86aba42d014c4b4f708dcb5fe86e055._comment @@ -6,5 +6,5 @@ content=""" I've just committed support for using the new name. I've not been able to test it yet, as I don't have a new enough gnome here. Any testing you can do much appreciated. -Leaving this bug open until it gets tested, and also because it's certianly appealing to just use poll rather than this fragile dbus stuff. And in any case, should add OSX support. +Leaving this bug open until it gets tested, and also because it's certainly appealing to just use poll rather than this fragile dbus stuff. And in any case, should add OSX support. """]] diff --git a/doc/bugs/Can__39__t_add_a_git_repo_to_git_annex:___34__Invalid_path_repo__47__.git__47__X__34___for_many_X/comment_5_118d61dea9ef0faa2960da6f2f62ec8b._comment b/doc/bugs/Can__39__t_add_a_git_repo_to_git_annex:___34__Invalid_path_repo__47__.git__47__X__34___for_many_X/comment_5_118d61dea9ef0faa2960da6f2f62ec8b._comment new file mode 100644 index 0000000000..28299c372d --- /dev/null +++ b/doc/bugs/Can__39__t_add_a_git_repo_to_git_annex:___34__Invalid_path_repo__47__.git__47__X__34___for_many_X/comment_5_118d61dea9ef0faa2960da6f2f62ec8b._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="https://id.koumbit.net/anarcat" + ip="2001:1928:1:9::1" + subject="sources" + date="2013-11-21T18:41:12Z" + content=""" +I tried to find a canonical source for why (or if?) git ignores any \".git\" directory, and it turns out it also ignores .git *files*, according to [this stackoverflow thread](http://stackoverflow.com/questions/6839781/what-happens-when-you-run-git-add-git-in-a-git-repository). It's hardcoded in the source code and \"will likely not change\". + +I guess this should therefore be taken upstream, but I am not sure how this could justified there. + +I do think git-annex should support that. It's turning more and more as a \"generic backup solution\" or \"i want my files in the cloud\" kind of solution, which is awesome, but small things like this are making it harder to use... --[[anarcat]] +"""]] diff --git a/doc/bugs/Can__39__t_add_a_git_repo_to_git_annex:___34__Invalid_path_repo__47__.git__47__X__34___for_many_X/comment_6_3978557c6e85608243e5b4eb698ac5a5._comment b/doc/bugs/Can__39__t_add_a_git_repo_to_git_annex:___34__Invalid_path_repo__47__.git__47__X__34___for_many_X/comment_6_3978557c6e85608243e5b4eb698ac5a5._comment new file mode 100644 index 0000000000..da52be6912 --- /dev/null +++ b/doc/bugs/Can__39__t_add_a_git_repo_to_git_annex:___34__Invalid_path_repo__47__.git__47__X__34___for_many_X/comment_6_3978557c6e85608243e5b4eb698ac5a5._comment @@ -0,0 +1,27 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkkyBDsfOB7JZvPZ4a8F3rwv0wk6Nb9n48" + nickname="Abdó" + subject="comment 6" + date="2013-11-21T20:04:22Z" + content=""" +After I wrote my last post in this thread I did write a patch for git doing two things: + +* make git ignore .git only at the root of the working tree, but not '.git' files or directories nested deeper into the working tree. +* add config option to prevent git from converting directories containing .git into gitlinks. It turns out that git already has an internal setting for this, it only needed to be exposed in the config files! + +It kind of worked, but I've never used nor completed this, though (if I recall correctly, something had to be done regarding the default gitingores, which contains .git). I don't think upstream would accept these changes, though. It is a potentially risky change that does not gives them any benefit. Plus commiting a git repo inside an other is kind of crazy. I'm not convinced this is a good solution anymore. + +Being able to put a git repo inside an assistant-controled directory would be nice, though. Additionally, letting the outermost git repo recognize the internal git repo as a git repo, instead of moving files blindly, would also be nice, and probably more reasonable. And that leads to submodules... + +My particular problem is: I want to syncing a directory with lots of little git repos across several machines, without having to configure remotes for every single one of them (so no mr) and having someone take care of the files which are ignored by the little git repos, possibly as annexed files. Currently I just sync that folder containing the little git repos with unison. + +Now, instead of commiting git repos inside git repos, I'm more inclined to a potential solution using git-annex + submodules. Ideally I'd like something like this: + +1. A git-annex repo at ~/work +2. All my little git repos inside ~/work are automatically recognized as submodules by git-annex +3. The outermost git-annex takes care of the .gitignored files for the inner git repos +4. git pull/push --recursive on the outermost annex repo pulls/pushes submodules (I think [something like this](https://github.com/jlehmann/git-submod-enhancements/wiki/Recursive-submodule-checkout) is written by Jens Lehmann) +5. The urls in .gitmodules are relative paths from the outermost annex working tree. Then a git fetch --recursive from the outermost annex can use an outermost remote + the submodule relative path. No need to manually configure remotes for every machine on every submodule! + +The problem with this approach, is that 2,4,5 are science-fiction for now, and probably 3 too. Realizing this would imply a lot of work, and commiting a lot of submodule stuff to upstream git. But probably stuff that makes sense and they would accept. Anyway, I'd like to know what Joey thinks about all this... +"""]] diff --git a/doc/bugs/Can__39__t_add_a_git_repo_to_git_annex:___34__Invalid_path_repo__47__.git__47__X__34___for_many_X/comment_7_e6dfc41d2042402b40efb6f6139d5662._comment b/doc/bugs/Can__39__t_add_a_git_repo_to_git_annex:___34__Invalid_path_repo__47__.git__47__X__34___for_many_X/comment_7_e6dfc41d2042402b40efb6f6139d5662._comment new file mode 100644 index 0000000000..374d193c02 --- /dev/null +++ b/doc/bugs/Can__39__t_add_a_git_repo_to_git_annex:___34__Invalid_path_repo__47__.git__47__X__34___for_many_X/comment_7_e6dfc41d2042402b40efb6f6139d5662._comment @@ -0,0 +1,18 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.64" + subject="comment 7" + date="2013-11-22T16:50:31Z" + content=""" +I appreciate the investigation. + +Now that there's a direct mode guard, it would be possible to have git-annex translate .git directories to some other name when adding files to git. This seems more likely than getting git changed. + +However, I am not convinced *at all* that it makes any sense to try to sync git repositories in this way. I realize that some people drop git checkouts into dropbox and use that, but it's a fundamentally unsound thing to do, and those people are just lucky if they manage to avoid running into problems doing that. + +If you have two clones of a repo, and a git repository is checked into both, and they become partitioned for a while and larger re-merge, then there can be conflicts in the files that make up the git repository. Which git-annex would auto-resolve, with the effect that the checked-in git repository would appear to be broken. + +Also, this feature would only be used by a small number of users, on the border between people who can use git the Correct Way, and people who don't use git other than with the assistant. + +It would make sense to make git-annex refuse to add files inside nested git repositories though. +"""]] diff --git a/doc/bugs/Can__39__t_add_a_git_repo_to_git_annex:___34__Invalid_path_repo__47__.git__47__X__34___for_many_X/comment_8_33a84937c87dd2406bc090a0d2969683._comment b/doc/bugs/Can__39__t_add_a_git_repo_to_git_annex:___34__Invalid_path_repo__47__.git__47__X__34___for_many_X/comment_8_33a84937c87dd2406bc090a0d2969683._comment new file mode 100644 index 0000000000..df97625f79 --- /dev/null +++ b/doc/bugs/Can__39__t_add_a_git_repo_to_git_annex:___34__Invalid_path_repo__47__.git__47__X__34___for_many_X/comment_8_33a84937c87dd2406bc090a0d2969683._comment @@ -0,0 +1,30 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkkyBDsfOB7JZvPZ4a8F3rwv0wk6Nb9n48" + nickname="Abdó" + subject="comment 8" + date="2013-11-22T18:44:35Z" + content=""" +> I am not convinced at all that it makes any sense to try to sync git repositories in this way + +I agree this is not a good solution. + + +> I realize that some people drop git checkouts into dropbox and use that, but it's a fundamentally unsound thing to do, and those people are just lucky if they manage to avoid running into problems doing that. + +Well, I don't use dropbox (nor annex assistant) but I sync a lot of git repos with unison. It is not luck, it is being careful not to create conflicts. I agree this is not ideal, and I'm looking for a better way to deal with this. + + +> Also, this feature would only be used by a small number of users + +I'm not convinced of that. If done right, nested git repos inside annex could have value. + +Let's say you work with 40 git repos some private of yours, others tracking upstream, and you want to sync them across 4 machines (home, work, cloud server, backup). I imagine your preferred solution would be to configure the 4 machines as remotes on every git repo and use mr, am I right? + +This has its problems: + +1. The set of files you want in the project git repo may not be the same as the set of files you want synced across machines. For instance, I use a large software project that I compile from sources. I want to sync binaries across machines (it takes forever to compile!), but of course I don't want them commited into the project, not even as annexed files. +2. Configuring remotes for every project is tedious. What if some remote changes url? what if I want to change the path of some of the git projects? Every time I add a new repo I need to configure all the 4 remotes. This can be scripted of course, but is not my ideal solution. + +What do you think about the submodules route I proposed? I don't like submodules very much, but in this case, I think it could become a good solution. In particular it would solve 1, 2 above and be able to merge conflicting changes on the nested repos. + +"""]] diff --git a/doc/bugs/Conflicting_archive_descriptions.mdwn b/doc/bugs/Conflicting_archive_descriptions.mdwn new file mode 100644 index 0000000000..832daa4ea2 --- /dev/null +++ b/doc/bugs/Conflicting_archive_descriptions.mdwn @@ -0,0 +1,16 @@ +This is confusing: + +"Next we come to the archive repositories.The archive repositories coordinate together, so that each file is archived in only one place. **When you move files into a folder named "archive"**, they'll be moved to an archive repository, and removed from all your client repositories. This is handy if you have old files you don't need anymore, but want to keep archived for later. When you copy or move a file out of an "archive" folder, it'll be retrieved from the archive repository." + +"The small archive repositories are like other archive repositories, but smaller. While archive repositories normally accumulate every file they can, small archive repositories only accumulate files **once you put them in an "archive" directory.**" + +Based upon those descriptions, I don't know what the difference is. + +> Improved wording to not imply that files are only put into archive +> repositories once the files are moved to archive directories. +> (Which is how small archive repositories work.) +> +> If you're still confused about it, see +> +> +> [[done]] --[[Joey]] diff --git a/doc/bugs/Corrupted_drive:_Assistant_seems_consider_files_deleted_and_deletes_them_elsewhere_too/comment_3_a9f202a1d3eb652b83bc54e6b017084a._comment b/doc/bugs/Corrupted_drive:_Assistant_seems_consider_files_deleted_and_deletes_them_elsewhere_too/comment_3_a9f202a1d3eb652b83bc54e6b017084a._comment deleted file mode 100644 index 7359f2f805..0000000000 --- a/doc/bugs/Corrupted_drive:_Assistant_seems_consider_files_deleted_and_deletes_them_elsewhere_too/comment_3_a9f202a1d3eb652b83bc54e6b017084a._comment +++ /dev/null @@ -1,12 +0,0 @@ -[[!comment format=mdwn - username="https://www.google.com/accounts/o8/id?id=AItOawnZEanlyzay_QlEAL0CWpyZcRTyN7vay8U" - nickname="Carlo" - subject="comment 3" - date="2013-10-30T15:04:44Z" - content=""" -The assistant autorecovered my work repo before I noticed, so it looks like I can't provide the necessary info. There were a bunch of files missing that got re-synced from my home PC. - -For what it's worth, I noticed that on my phone, when cutting the internet connection while syncing, the assistant downloaded existing files into placeholder files, and then continued actually downloading files when they were around. - - -"""]] diff --git a/doc/bugs/Corrupted_drive:_Assistant_seems_consider_files_deleted_and_deletes_them_elsewhere_too/comment_4_d5fc95f8909d3fd7786afef451558053._comment b/doc/bugs/Corrupted_drive:_Assistant_seems_consider_files_deleted_and_deletes_them_elsewhere_too/comment_4_d5fc95f8909d3fd7786afef451558053._comment deleted file mode 100644 index 4d8e9f5985..0000000000 --- a/doc/bugs/Corrupted_drive:_Assistant_seems_consider_files_deleted_and_deletes_them_elsewhere_too/comment_4_d5fc95f8909d3fd7786afef451558053._comment +++ /dev/null @@ -1,12 +0,0 @@ -[[!comment format=mdwn - username="https://www.google.com/accounts/o8/id?id=AItOawnZEanlyzay_QlEAL0CWpyZcRTyN7vay8U" - nickname="Carlo" - subject="comment 4" - date="2013-10-30T15:05:17Z" - content=""" -The assistant autorecovered my work repo before I noticed, so it looks like I can't provide the necessary info. There were a bunch of files missing that got re-synced from my home PC. - -For what it's worth, I noticed that on my phone, when cutting the internet connection while syncing, the assistant downloaded existing files into placeholder files, and then continued actually downloading files when the network connection was restored. - - -"""]] diff --git a/doc/bugs/Corrupted_drive:_Assistant_seems_consider_files_deleted_and_deletes_them_elsewhere_too/comment_5_6058a22b733cb02126286af950074ed4._comment b/doc/bugs/Corrupted_drive:_Assistant_seems_consider_files_deleted_and_deletes_them_elsewhere_too/comment_5_6058a22b733cb02126286af950074ed4._comment new file mode 100644 index 0000000000..33e85c7724 --- /dev/null +++ b/doc/bugs/Corrupted_drive:_Assistant_seems_consider_files_deleted_and_deletes_them_elsewhere_too/comment_5_6058a22b733cb02126286af950074ed4._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.47" + subject="comment 5" + date="2013-11-03T01:17:39Z" + content=""" +I don't understand what you mean by \"The assistant autorecovered my work repo before I noticed\". What repo is the work repo, and how could the assistant \"autorecover\" it, and what did it do? + +At this point, I am completely in the dark about whether you're reporting a problem, and what the problem is. +"""]] diff --git a/doc/bugs/Corrupted_drive:_Assistant_seems_consider_files_deleted_and_deletes_them_elsewhere_too/comment_6_5a348c5f327f16e1192ef6bd7f2880bb._comment b/doc/bugs/Corrupted_drive:_Assistant_seems_consider_files_deleted_and_deletes_them_elsewhere_too/comment_6_5a348c5f327f16e1192ef6bd7f2880bb._comment new file mode 100644 index 0000000000..7e611cebd4 --- /dev/null +++ b/doc/bugs/Corrupted_drive:_Assistant_seems_consider_files_deleted_and_deletes_them_elsewhere_too/comment_6_5a348c5f327f16e1192ef6bd7f2880bb._comment @@ -0,0 +1,15 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnZEanlyzay_QlEAL0CWpyZcRTyN7vay8U" + nickname="Carlo" + subject="comment 6" + date="2013-11-19T09:48:26Z" + content=""" +Sorry, missed the comment. + +My work repo is the repository on my work laptop, where deletions got synced to. + +Git annex had then run repository repair automatically, so the odd symlinks where no longer there for me to check out. + +It is possible that I ran some git commands in direct mode I shouldn't have; I put the files back in and it's working nicely now. So this might have been a \"no direct mode guard\" issue. + +"""]] diff --git a/doc/bugs/Discrepancy_between_git_annex_add_and_git_annex_watch.mdwn b/doc/bugs/Discrepancy_between_git_annex_add_and_git_annex_watch.mdwn new file mode 100644 index 0000000000..8e836e345f --- /dev/null +++ b/doc/bugs/Discrepancy_between_git_annex_add_and_git_annex_watch.mdwn @@ -0,0 +1,33 @@ +### Please describe the problem. + +`git annex add` does not add dotfiles (as per the man page) while `git annex watch` does (nothing on the man page). It's not a bug, but rather a surprise (at least to me). + +### What steps will reproduce the problem? + +[[!format sh """ +git init dotfiles +cd dotfiles +git annex init "my dotfiles" +echo test > test.txt +echo dottest > .dotest.txt +git annex add +git commit -a -m "initial dots" +git annex whereis .dotest.txt # no answer, as expected +git annex watch +git annex whereis .dotest.txt # answers that .dotest.txt is here +"""]] + +### What version of git-annex are you using? On what operating system? +git-annex version: 4.20131101, ubuntu 12.04 with all updates. + +### 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. +"""]] + +> Improved documentation. [[done]] --[[Joey]] diff --git a/doc/bugs/During_synchronisation_top-level_folder_suddenly_appear_in_sub-sub-folder.mdwn b/doc/bugs/During_synchronisation_top-level_folder_suddenly_appear_in_sub-sub-folder.mdwn index 5d60b64da3..d011e44163 100644 --- a/doc/bugs/During_synchronisation_top-level_folder_suddenly_appear_in_sub-sub-folder.mdwn +++ b/doc/bugs/During_synchronisation_top-level_folder_suddenly_appear_in_sub-sub-folder.mdwn @@ -3743,3 +3743,5 @@ To repoB:/media/srv/img/ (Recording state in git...) # End of transcript or log. """]] + +> [[done]], seems this was caused by the bug I alread fixed. --[[Joey]] diff --git a/doc/bugs/During_synchronisation_top-level_folder_suddenly_appear_in_sub-sub-folder/comment_3_650dc9ede4e16ef668d96840f63dad47._comment b/doc/bugs/During_synchronisation_top-level_folder_suddenly_appear_in_sub-sub-folder/comment_3_650dc9ede4e16ef668d96840f63dad47._comment new file mode 100644 index 0000000000..4e7d6491ce --- /dev/null +++ b/doc/bugs/During_synchronisation_top-level_folder_suddenly_appear_in_sub-sub-folder/comment_3_650dc9ede4e16ef668d96840f63dad47._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.47" + subject="comment 3" + date="2013-11-02T20:03:33Z" + content=""" +I don't understand why there are so many commits that need to be reverted. I'd have thought that it would have only made one bad commit due to the bug, and reverting that would do. Or even just adding back any symlinks removed by any of the bad commits, without an explicit revert would accomplish the same. + +You should be able to check with `git annex whereis --not --in .` what git-annex thinks about the 200 broken symlinks. Clearly their content is not in the local repisitory; it may be present elsewhere, or you might have to restore those files from backup. + +Once you have the git tree of the repository back in good shape, assuming you did it by committing changes, and possibly committing git reverts, you should be able to just use normal git annex syncing to sync those changes to the second repo. Ie, `git annex sync` in both, or running the assistant. +"""]] diff --git a/doc/bugs/During_synchronisation_top-level_folder_suddenly_appear_in_sub-sub-folder/comment_4_721cf184fb5a5244ec5c15de3302ebf7._comment b/doc/bugs/During_synchronisation_top-level_folder_suddenly_appear_in_sub-sub-folder/comment_4_721cf184fb5a5244ec5c15de3302ebf7._comment new file mode 100644 index 0000000000..3876444cd5 --- /dev/null +++ b/doc/bugs/During_synchronisation_top-level_folder_suddenly_appear_in_sub-sub-folder/comment_4_721cf184fb5a5244ec5c15de3302ebf7._comment @@ -0,0 +1,33 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnh6wz0pMA3NLPFg2j_I3S5JeinaOVqnng" + nickname="Felix" + subject="Number of commits" + date="2013-11-21T20:26:46Z" + content=""" +I have no idea where this large number of commits come from, but maybe the sheer number of files explains it: + +Files appearing in the wrong place (probably due to me starting the assistant in a subdirectory of the repo): + + $ git log --stat | grep \"5d/20.*+$\" |wc -l + 1148 + +Me wondering where they come from and deleting them manually step by step when I found them: + + $ git log --stat | grep \"5d/20.*-$\" |wc -l + 1095 + +git-annex removing the original files that have been mirrored in the wrong place (and maybe a few more as I was working on stuff there as well): + + $ git log --stat | grep \"^ 20.*-$\" | wc -l + 1152 + +Maybe this explains the large number (approx. 500) of commits? + +--- + +The missing 200 files have not been in a different repo, so apart from 3 that were not available they have been restored from the backup. + +--- + +As my setup needs some changes anyway I'm going to start from scratch. +"""]] diff --git a/doc/bugs/Endless_SSH_password_prompts.mdwn b/doc/bugs/Endless_SSH_password_prompts.mdwn new file mode 100644 index 0000000000..26def613f3 --- /dev/null +++ b/doc/bugs/Endless_SSH_password_prompts.mdwn @@ -0,0 +1,15 @@ +### Please describe the problem. +Yesterday I installed git-annex on two computers and paired their repos. Today I logged back in to one of them, and as soon as the webapp loaded (autostarted in the background), it popped up an OpenSSH prompt wanting my key's password. I typed it in, and it popped up another. This went on several times. When I hit Cancel instead, it popped up a prompt wanting the password for the user account on my other computer. Even with that, once wasn't enough. + +This is bad enough, but worse is that the password prompt captures the keyboard input so I can't even open my Yakuake console to kill git-annex. Well, it's difficult and requires hitting Escape rapidly over and over until I can squeeze in a keystroke to the rest of the system. + +I don't understand why this is happening. + +1. Shouldn't git-annex have installed a passwordless key on my paired system? It did that for my remote repo. + +2. The prompt it's using has no option to remember the pasword. I use ssh-agent, but usually by running ssh-add in a terminal. Maybe if it would use a prompt that works with the agent it wouldn't ask for the password multiple times. + +3. I think it's opening multiple SSH connections at once, before I've entered the password even once, so even after I enter the password, it will keep asking for it until I've entered it for every SSH process that was already started. + +### What version of git-annex are you using? On what operating system? +1 Nov 2013 Linux tarball on Ubuntu Raring 13.04 diff --git a/doc/bugs/Endless_SSH_password_prompts/comment_1_b3a32d7a53c30478f409a47f856282ab._comment b/doc/bugs/Endless_SSH_password_prompts/comment_1_b3a32d7a53c30478f409a47f856282ab._comment new file mode 100644 index 0000000000..b1ea715265 --- /dev/null +++ b/doc/bugs/Endless_SSH_password_prompts/comment_1_b3a32d7a53c30478f409a47f856282ab._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.47" + subject="comment 1" + date="2013-11-03T00:29:14Z" + content=""" +Pairing sets up the same kind of dedicated passwordless ssh key that is used when adding a ssh server. + +It's not clear from your description what program is asking for the password, or even if it's asking for the password for a ssh key. You need to provide more details. +"""]] diff --git a/doc/bugs/Endless_SSH_password_prompts/comment_2_0a1fc4b4580d8be4c37064e0a16de99b._comment b/doc/bugs/Endless_SSH_password_prompts/comment_2_0a1fc4b4580d8be4c37064e0a16de99b._comment new file mode 100644 index 0000000000..fec729ddbd --- /dev/null +++ b/doc/bugs/Endless_SSH_password_prompts/comment_2_0a1fc4b4580d8be4c37064e0a16de99b._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmNu4V5fvpLlBhaCUfXXOB0MI5NXwh8SkU" + nickname="Adam" + subject="comment 2" + date="2013-11-03T00:39:38Z" + content=""" +I'm not sure which program is doing the asking either. The title bar says \"OpenSSH\". It is asking for the SSH key password, but if I dismiss the dialog without entering the password, it will open another dialog asking for the user account's password, e.g. me@laptop, indicating it's SSH falling back to password auth. +"""]] diff --git a/doc/bugs/Endless_SSH_password_prompts/comment_3_46210f7745b8c7c237fc8b08309390fe._comment b/doc/bugs/Endless_SSH_password_prompts/comment_3_46210f7745b8c7c237fc8b08309390fe._comment new file mode 100644 index 0000000000..aacf1cc01c --- /dev/null +++ b/doc/bugs/Endless_SSH_password_prompts/comment_3_46210f7745b8c7c237fc8b08309390fe._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawlHNJ7FpiXJNwSmojlwKwXhhF5QvwpNPmI" + nickname="Colin" + subject="Confirmed" + date="2013-11-14T17:57:23Z" + content=""" +I am seeing the same problem. It happened on a machine running git-annex on Debian Testing some weeks ago, and I eventually disabled the offending repository for my sanity (incidentally - it seems to have vanished so I don't know how to re-enable it apart from adding it again). + +It has just very recently (some days) started on this machine running Debian Unstable. + +"""]] diff --git a/doc/bugs/Error_when_moving_annexed_file_to_a_.gitignored_location/comment_1_b524e70156e8bc1219d5c6741974ad99._comment b/doc/bugs/Error_when_moving_annexed_file_to_a_.gitignored_location/comment_1_b524e70156e8bc1219d5c6741974ad99._comment new file mode 100644 index 0000000000..6b741e85ed --- /dev/null +++ b/doc/bugs/Error_when_moving_annexed_file_to_a_.gitignored_location/comment_1_b524e70156e8bc1219d5c6741974ad99._comment @@ -0,0 +1,18 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawlq4ClC5EMN1Vq1DpWXAqP5TiDnCK1mSfk" + nickname="Jonas" + subject="Happens with import, too" + date="2013-11-24T23:24:09Z" + content=""" +This happens to me when using git annex import, too (on version 4.20131106) + + (Recording state in git...) + The following paths are ignored by one of your .gitignore files: + path/to/some/directory/.svn + Use -f if you really want to add them. + fatal: no files added + + git-annex: user error (xargs [\"-0\",\"git\",\"--git-dir=/path/to/annex/.git\",\"--work-tree=/path/to/annex\",\"add\",\"--\"] exited 123) +failed + +"""]] diff --git a/doc/bugs/Error_when_moving_annexed_file_to_a_.gitignored_location/comment_2_ff7349c396d1249204d621e71f6a7a52._comment b/doc/bugs/Error_when_moving_annexed_file_to_a_.gitignored_location/comment_2_ff7349c396d1249204d621e71f6a7a52._comment new file mode 100644 index 0000000000..2ee7f79b61 --- /dev/null +++ b/doc/bugs/Error_when_moving_annexed_file_to_a_.gitignored_location/comment_2_ff7349c396d1249204d621e71f6a7a52._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.64" + subject="comment 2" + date="2013-11-26T20:04:23Z" + content=""" +This bug was fixed, and closed 2 years ago. Posting a comment about another, related problem is not very useful. + +Yes, git annex import does not finish importing files if you've configured .gititnore to not allow those files to be added. If you need to do that, you could use `git annex import --force`, which will add the files despite the gitignore. +"""]] diff --git a/doc/bugs/Error_when_moving_annexed_file_to_a_.gitignored_location/comment_4_4bc7d4c51faea3fdafc977cb66b7f73a._comment b/doc/bugs/Error_when_moving_annexed_file_to_a_.gitignored_location/comment_4_4bc7d4c51faea3fdafc977cb66b7f73a._comment new file mode 100644 index 0000000000..a3a6fc10a6 --- /dev/null +++ b/doc/bugs/Error_when_moving_annexed_file_to_a_.gitignored_location/comment_4_4bc7d4c51faea3fdafc977cb66b7f73a._comment @@ -0,0 +1,26 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawlq4ClC5EMN1Vq1DpWXAqP5TiDnCK1mSfk" + nickname="Jonas" + subject="comment 4" + date="2013-11-27T17:36:39Z" + content=""" +Sorry, my bug triaging skills are limited. This one happened to have exactly the same error message... + +This might again be the wrong thread, but... how does git annex decide which files to ignore? In particular, it seems not always to agree with git: + + $ cd /tmp + $ mkdir annex + $ cd annex + $ git init + $ git annex init \"Testing annex in /tmp\" + $ echo \"This file is hidden\" > .hidden_file + $ git status + shows .hidden_file as \"untracked\" + $ git annex add . + does nothing + $ git annex add --force . + does nothing, either + $ git add . + adds the file as expected + +"""]] diff --git a/doc/bugs/Finding_an_Unused_file.mdwn b/doc/bugs/Finding_an_Unused_file.mdwn index 2117558295..c0e6131636 100644 --- a/doc/bugs/Finding_an_Unused_file.mdwn +++ b/doc/bugs/Finding_an_Unused_file.mdwn @@ -146,7 +146,7 @@ upgrade supported from repository versions: 0 1 2 """]] > If `git log -S` does not find the key, then it was not used for any -> commit currently in the git repository. Which is certianly possible; +> commit currently in the git repository. Which is certainly possible; > for example `git annex add file; git rm file`. > > This is a dup of [[todo/wishlist: option to print more info with 'unused']]; [[done]] --[[Joey]] diff --git a/doc/bugs/Freshly_initialized_repo_has_staged_change___34__deleted:_uuid.log__34__.mdwn b/doc/bugs/Freshly_initialized_repo_has_staged_change___34__deleted:_uuid.log__34__.mdwn new file mode 100644 index 0000000000..d66196acd3 --- /dev/null +++ b/doc/bugs/Freshly_initialized_repo_has_staged_change___34__deleted:_uuid.log__34__.mdwn @@ -0,0 +1,44 @@ +### Please describe the problem. +Using the webapp to generate a new (local) repository instantly takes it to the following state: +[[!format sh """ +user@local:~/Annex$ git status +# On branch master +# Changes to be committed: +# (use "git reset HEAD ..." to unstage) +# +# deleted: uuid.log +# +user@local:~/Annex$ git branch + git-annex +* master +user@local:~/Annex$ git log +commit 90bfcaf17b0576d8ecdc48ae44dda22d41464acc +Author: local +Date: Sun Nov 3 15:30:17 2013 +0100 + + created repository +user@local:~/Annex$ git show HEAD +commit 90bfcaf17b0576d8ecdc48ae44dda22d41464acc +Author: local +Date: Sun Nov 3 15:30:17 2013 +0100 + + created repository + +diff --git a/uuid.log b/uuid.log +new file mode 100644 +index 0000000..9df3670 +--- /dev/null ++++ b/uuid.log +@@ -0,0 +1 @@ ++987e7b9a-aa9d-41db-ae92-23fcae7f6187 user@local:~/Annex timestamp=1383489017.181 +user@local:~/Annex$ +"""]] + +I'm new to git-annex, so I'm not quite sure, but looking at [[internals]] this file should only exist in the git-annex branch, not in master. Furthermore, from this state it seems impossible to get "sync with your other devices" to work, because of a merge conflict on this change. + +Perhaps some sort of a race-condition with the annex-assistant picking up the uuid.log file while the repository is being initialized? + +### What version of git-annex are you using? On what operating system? +Ubuntu 13.10 with git-annex 4.20130815 + +> [[fixed|done]]; see comments. (This fix needs to be backported to Ubuntu.) --[[Joey]] diff --git a/doc/bugs/Freshly_initialized_repo_has_staged_change___34__deleted:_uuid.log__34__/comment_1_6441dd04adc158df22589c81746108a9._comment b/doc/bugs/Freshly_initialized_repo_has_staged_change___34__deleted:_uuid.log__34__/comment_1_6441dd04adc158df22589c81746108a9._comment new file mode 100644 index 0000000000..6080e88e41 --- /dev/null +++ b/doc/bugs/Freshly_initialized_repo_has_staged_change___34__deleted:_uuid.log__34__/comment_1_6441dd04adc158df22589c81746108a9._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.47" + subject="comment 1" + date="2013-11-03T16:48:25Z" + content=""" +I can't reproduce this at all. What version of git do you have installed? Did you install git-annex from ubuntu's repository? Does the same thing happen if you install the standalone linux tarball and use it to make a new repository? + +git-annex never creates a file named uuid.log on disk, so it's quite strange that it shows up in the initial commit to the master branch. It sort of looks like somehow git-annex's normal use of a separate index file to stage the uuid.log to the git-annex branch is failing. Since I have never seen any problem with that, I have to suspect that the ubuntu build is somehow badly broken. Or that the git in Ubuntu is for some reason ignoring `GIT_INDEX_FILE`. +"""]] diff --git a/doc/bugs/Freshly_initialized_repo_has_staged_change___34__deleted:_uuid.log__34__/comment_2_d1c5d7642284a375f9c455dbf76efa5c._comment b/doc/bugs/Freshly_initialized_repo_has_staged_change___34__deleted:_uuid.log__34__/comment_2_d1c5d7642284a375f9c455dbf76efa5c._comment new file mode 100644 index 0000000000..50bff5f41e --- /dev/null +++ b/doc/bugs/Freshly_initialized_repo_has_staged_change___34__deleted:_uuid.log__34__/comment_2_d1c5d7642284a375f9c455dbf76efa5c._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.47" + subject="comment 2" + date="2013-11-03T17:02:47Z" + content=""" +I made an Ubuntu saucy chroot, apt-get installed git-annex from universe, and ran the webapp in there. I did not reproduce this problem. + +The cause of the problem, it seems, must be something local to your system. Perhaps you have an environment variable set that is messing up git. Or perhaps you have a different, broken version of git installed. + +Can you \"git show git-annex\" in the repository? It should show a commit made to the git-annex branch that adds the uuid.log there. +"""]] diff --git a/doc/bugs/Freshly_initialized_repo_has_staged_change___34__deleted:_uuid.log__34__/comment_3_4b863da1c8ba73ad54da20f7d2ec6e5c._comment b/doc/bugs/Freshly_initialized_repo_has_staged_change___34__deleted:_uuid.log__34__/comment_3_4b863da1c8ba73ad54da20f7d2ec6e5c._comment new file mode 100644 index 0000000000..7acab1c37f --- /dev/null +++ b/doc/bugs/Freshly_initialized_repo_has_staged_change___34__deleted:_uuid.log__34__/comment_3_4b863da1c8ba73ad54da20f7d2ec6e5c._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="tanen" + ip="83.128.159.25" + subject="comment 3" + date="2013-11-03T17:35:00Z" + content=""" +Very strange: this is on a machine that I wiped and reinstalled just a few hours ago, it's a completely fresh Ubuntu 13.10 install with barely anything installed but the defaults. Git version is 1.8.3.2-1 + +I initially just pulled git-annex from the Ubuntu repo. After that I grabbed a more recent version from https://launchpad.net/ubuntu/+source/git-annex/4.20131101/+build/5189754 which is showing the same behavior. + +\"git show git-annex\" indeed shows the commit creating the uuid.log file on the git-annex branch. master has just one commit, with description \"created repository\" and creates a \"uuid.log\" file. The contents of the master uuid.log are identical to the one in the git-annex branch. + +I'm currently in the middle of trying out a git-annex setup so I can't switch versions again right now, but given the above I imagine a fresh 13.10 VM should show the same behavior. +"""]] diff --git a/doc/bugs/Freshly_initialized_repo_has_staged_change___34__deleted:_uuid.log__34__/comment_4_8e0f489305ce30ad578b9f8526e86416._comment b/doc/bugs/Freshly_initialized_repo_has_staged_change___34__deleted:_uuid.log__34__/comment_4_8e0f489305ce30ad578b9f8526e86416._comment new file mode 100644 index 0000000000..c020fc3a84 --- /dev/null +++ b/doc/bugs/Freshly_initialized_repo_has_staged_change___34__deleted:_uuid.log__34__/comment_4_8e0f489305ce30ad578b9f8526e86416._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.47" + subject="comment 4" + date="2013-11-06T15:09:19Z" + content=""" +Intriguing -- I was able to reproduce this bug after installing the Ubuntu server ISO in a VM. + +Which is really strange, the only difference between this and my debootstrapped chroot should be the kernel.. +"""]] diff --git a/doc/bugs/Freshly_initialized_repo_has_staged_change___34__deleted:_uuid.log__34__/comment_5_c699034c8e02b2354516414d0ab73aab._comment b/doc/bugs/Freshly_initialized_repo_has_staged_change___34__deleted:_uuid.log__34__/comment_5_c699034c8e02b2354516414d0ab73aab._comment new file mode 100644 index 0000000000..a323d78358 --- /dev/null +++ b/doc/bugs/Freshly_initialized_repo_has_staged_change___34__deleted:_uuid.log__34__/comment_5_c699034c8e02b2354516414d0ab73aab._comment @@ -0,0 +1,53 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.47" + subject="comment 5" + date="2013-11-06T16:27:49Z" + content=""" +Running the prebuilt tarball build of git-annex, the bug does not occur. + +However, if I remove the git shipped with the prebuilt tarball, so it uses the system git, I do see the bug. So, it's apparently git version dependent. + +Also, I was able to reproduce it in a amd64 chroot. My other chroot was i386. Somehow architecture specific bug? + +--- + +Instrumenting all calls to git to be logged with the full environment and command, I found this: + +
+GIT_INDEX_FILE='/home/foo/annex/.git/annex/index'
+--git-dir=/home/foo/annex/.git --work-tree=/home/foo/annex commit --quiet --allow-empty -m created repository
+
+ +This certainly looks like the index file setting for the git-annex branch is somehow leaking out past the branch commit operations. It continued setting that while setting up `gc.auto`; the next call to git after that stopped setting the index file. + +The only way I can see offhand this could possibly happen is due to an exception. It may be that on ubuntu an exception is thrown by code that runs a git command with the index file set, for whatever reason, and this causes the code that normally resets it back to not run. + +---- + +Ok, found it! + +
+\"withIndex entered\"
+
+*** Please tell me who you are.
+
+Run
+
+  git config --global user.email \"you@example.com\"
+  git config --global user.name \"Your Name\"
+
+to set your account's default identity.
+Omit --global to set the identity only in this repository.
+
+fatal: unable to auto-detect email address (got 'foo@darkstar.(none)')
+\"withIndex entered\"
+\"withIndex cleaned up\"
+
+ +Note lack of clean up after the first withIndex call. Thus leaving the environment passed to git polluted for further calls. + +This also explains why it's only happening on some systems, or with some versions of git. git's got all kinds of complexity around its username and email handling code. + +I have fixed this in git. +"""]] diff --git a/doc/bugs/Freshly_initialized_repo_has_staged_change___34__deleted:_uuid.log__34__/comment_6_786cb7e643811dfd2496ceeff8f34f44._comment b/doc/bugs/Freshly_initialized_repo_has_staged_change___34__deleted:_uuid.log__34__/comment_6_786cb7e643811dfd2496ceeff8f34f44._comment new file mode 100644 index 0000000000..ea3e97e8e0 --- /dev/null +++ b/doc/bugs/Freshly_initialized_repo_has_staged_change___34__deleted:_uuid.log__34__/comment_6_786cb7e643811dfd2496ceeff8f34f44._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.47" + subject="comment 6" + date="2013-11-06T16:40:57Z" + content=""" +Ubuntu bug report about this: + +It should be pretty easy to backport the fix to the version in Ubuntu. The relevant git commits are ee23be55fd3e7e202bc721c124f78b79d1aba6df and 81117e8a9d19d4739d3773d0515006e1ea41c266 +"""]] diff --git a/doc/bugs/Git_annex_add_fails_on_read-only_files.mdwn b/doc/bugs/Git_annex_add_fails_on_read-only_files.mdwn new file mode 100644 index 0000000000..26ee29e6d9 --- /dev/null +++ b/doc/bugs/Git_annex_add_fails_on_read-only_files.mdwn @@ -0,0 +1,37 @@ +### Please describe the problem. + +Git annex cannot add/import files in folders without w or x permission + +Note that (as stated in the comments) this might not be a bug. The problem might somewhere within Git, because Git does not manage file permissions very well. I was just hoping that I could import large directory trees into git-annex with a simple call to "git annex import"; now it seems I have to fix their permissions first. + +### What steps will reproduce the problem? + + $ cd /tmp + $ mkdir -p folder/subfolder + $ echo "some text" > folder/subfolder/some_file.txt + $ chmod 500 folder/subfolder + $ mkdir annex + $ cd annex + $ git init + $ git annex init "Testing git annex" + $ git annex import ../folder + Fails + $ chmod 600 ../folder/subfolder + $ git annex import ../folder + Fails + $ chmod 700 ../folder/subfolder + $ git annex import ../folder + Works. Subfolder now has 755 permissions + +### What version of git-annex are you using? On what operating system? + + git-annex version: 4.20131106 + build flags: Assistant Webapp Pairing Testsuite S3 WebDAV Inotify DBus XMPP 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 glacier hook + local repository version: 3 + default repository version: 3 + supported repository versions: 3 4 + upgrade supported from repository versions: 0 1 2 + + git version 1.8.4.3 diff --git a/doc/bugs/Git_annex_add_fails_on_read-only_files/comment_1_d31018e8bf31d729ee9fee43a0a07934._comment b/doc/bugs/Git_annex_add_fails_on_read-only_files/comment_1_d31018e8bf31d729ee9fee43a0a07934._comment new file mode 100644 index 0000000000..0a4e61bc57 --- /dev/null +++ b/doc/bugs/Git_annex_add_fails_on_read-only_files/comment_1_d31018e8bf31d729ee9fee43a0a07934._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.64" + subject="comment 1" + date="2013-11-26T19:47:28Z" + content=""" +I cannot reproduce this problem on Linux, with version 4.20131106. I tried in both direct and indirect mode, on Linux. + +I was, however, able to exactly reproduce the error message if I made the *directory* be not writable, and used indirect mode. This is because git-annex has to move the file the .git/annex/objects, and put a symlink in place, and so has to be allowed to write to the directory. Interestingly, direct mode does not have this limiation, although I doubt git-annex would ever be very useful when run in a directory you lack write permission to. +"""]] diff --git a/doc/bugs/Git_annex_add_fails_on_read-only_files/comment_2_e38e7048749f890169cd0be602be6ee7._comment b/doc/bugs/Git_annex_add_fails_on_read-only_files/comment_2_e38e7048749f890169cd0be602be6ee7._comment new file mode 100644 index 0000000000..610eea7139 --- /dev/null +++ b/doc/bugs/Git_annex_add_fails_on_read-only_files/comment_2_e38e7048749f890169cd0be602be6ee7._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawlq4ClC5EMN1Vq1DpWXAqP5TiDnCK1mSfk" + nickname="Jonas" + subject="comment 2" + date="2013-11-27T18:05:02Z" + content=""" +Thank you for looking into this, and sorry about the low quality of the initial bug report. I now replaced the example by a better one. + +As you say, this might not be a bug. I was just not aware that migrating files into git-annex would mean forsaking their permissions. +"""]] diff --git a/doc/bugs/Glacier_remote_uploads_duplicates/comment_7_e96187bad3dae2f5f95118f6df87a1ec._comment b/doc/bugs/Glacier_remote_uploads_duplicates/comment_7_e96187bad3dae2f5f95118f6df87a1ec._comment index 618f35765a..26cbb5a473 100644 --- a/doc/bugs/Glacier_remote_uploads_duplicates/comment_7_e96187bad3dae2f5f95118f6df87a1ec._comment +++ b/doc/bugs/Glacier_remote_uploads_duplicates/comment_7_e96187bad3dae2f5f95118f6df87a1ec._comment @@ -6,5 +6,5 @@ content=""" Ok, I've merged the glacier branch into master. I would still be happy to see some testing of this before my next release (in a week). -I guess I'll close this bug report. There are certianly still problems that can happen if there are multiple repositories all writing to glacier independently. Seems to me that one good way to deal with this is to set up a single remote that is configured to be a gateway to glacier. +I guess I'll close this bug report. There are certainly still problems that can happen if there are multiple repositories all writing to glacier independently. Seems to me that one good way to deal with this is to set up a single remote that is configured to be a gateway to glacier. """]] diff --git a/doc/bugs/Glacier_remote_uploads_duplicates/comment_8_34216b514a6fca788cfacb8579ce5311._comment b/doc/bugs/Glacier_remote_uploads_duplicates/comment_8_34216b514a6fca788cfacb8579ce5311._comment new file mode 100644 index 0000000000..67fd5354b7 --- /dev/null +++ b/doc/bugs/Glacier_remote_uploads_duplicates/comment_8_34216b514a6fca788cfacb8579ce5311._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmZgZuUhZlHpd_AbbcixY0QQiutb2I7GWY" + nickname="Jimmy" + subject="For those on Mac OS X" + date="2013-11-18T00:00:32Z" + content=""" +The duplicates script fails because the BSD/MacOS version of uniq doesn't support the -D option. + +You can work around this by installing the GNU version using Homebrew ('brew install coreutils') and then replacing the 'uniq' in the script with 'guniq' (Homebrew prefixes the coreutils with \"g\" by default). + +I seem to still be running in to this bug using git annex version 4.20131106 and 'git annex copy --to glacier' without the '--not --in glacier' flags. It's not a problem to use the extra flags but I wasn't originally aware of this issue and the duplicates don't seem to always occur. I'll do some more testing and see whether I can reliably predict what will create duplicates and what won't. +"""]] diff --git a/doc/bugs/Handling_of_files_inside_and_outside_archive_directory_at_the_same_time/comment_2_ead9fa75a12ef36be9a92637b144e74f._comment b/doc/bugs/Handling_of_files_inside_and_outside_archive_directory_at_the_same_time/comment_2_ead9fa75a12ef36be9a92637b144e74f._comment index 5b355e070d..2be39d451a 100644 --- a/doc/bugs/Handling_of_files_inside_and_outside_archive_directory_at_the_same_time/comment_2_ead9fa75a12ef36be9a92637b144e74f._comment +++ b/doc/bugs/Handling_of_files_inside_and_outside_archive_directory_at_the_same_time/comment_2_ead9fa75a12ef36be9a92637b144e74f._comment @@ -6,7 +6,7 @@ content=""" This turns out to be much worse in direct mode than in indirect mode. -In indirect mode, it only does extra work during the full startup scan. Suppose there are 3 files with the same content, 1, archive/2, and 3. It will download 1, and then will drop archive/2, and then will download 3. This certianly is not ideal, especially when the file content is large. +In indirect mode, it only does extra work during the full startup scan. Suppose there are 3 files with the same content, 1, archive/2, and 3. It will download 1, and then will drop archive/2, and then will download 3. This certainly is not ideal, especially when the file content is large. In indirect mode, it continally and repeatedly downloads the drops the files, as long as it's running. Which is beyond unacceptable. diff --git a/doc/bugs/Impossible_to_enable_an_existing_gcrypt_repo_in_the_webapp.mdwn b/doc/bugs/Impossible_to_enable_an_existing_gcrypt_repo_in_the_webapp.mdwn new file mode 100644 index 0000000000..4a8006f064 --- /dev/null +++ b/doc/bugs/Impossible_to_enable_an_existing_gcrypt_repo_in_the_webapp.mdwn @@ -0,0 +1,21 @@ +### Please describe the problem. +As described earlier in [[tips/fully_encrypted_git_repositories_with_gcrypt]] + +### What steps will reproduce the problem? +- A: use the webapp to create a new repository +- A: add a remote server to the repository using the 'gcrypt' method +- A: add a jabber account + +- B: use the webapp to create a new repository +- B: add the jabber account +- B: see the previously created 'cloud repository' with status 'not enabled' +- B: click enable, see that the stored credentials are correct, and press "verify this server" +- B: enter the ssh password twice +- B: get redirected to a blank screen (on the url /config/repository/enable/gcrypt/UUID "x"?auth=y) + +The assistent logfiles show nothing after the "Your public key has been saved in", the server shows that no public key for B was added to the account. + +This is with git-annex installed on the remote server; without it the process gets stuck after clicking "encrypt repository" in step 2, it will just indefinitely keep prompting for the SSH password. + +### What version of git-annex are you using? On what operating system? +Latest nightly build on ubuntu 13.10 diff --git a/doc/bugs/Impossible_to_enable_an_existing_gcrypt_repo_in_the_webapp/comment_1_17814787e333d15da3ab4e57c7d31d4b._comment b/doc/bugs/Impossible_to_enable_an_existing_gcrypt_repo_in_the_webapp/comment_1_17814787e333d15da3ab4e57c7d31d4b._comment new file mode 100644 index 0000000000..5bd45d6866 --- /dev/null +++ b/doc/bugs/Impossible_to_enable_an_existing_gcrypt_repo_in_the_webapp/comment_1_17814787e333d15da3ab4e57c7d31d4b._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.246" + subject="comment 1" + date="2013-11-13T16:51:40Z" + content=""" +I've tried to reproduce this, and cannot; it enabled the repository without trouble. + +Also, I have never seen the webapp fail with a blank screen, so that's strange. + +I think you need to show your `~/annex/.git/annex/daemon.log` from B. +"""]] diff --git a/doc/bugs/Incorrect_merge__44___direct_repos___40__2__41__.mdwn b/doc/bugs/Incorrect_merge__44___direct_repos___40__2__41__.mdwn new file mode 100644 index 0000000000..9b5d522201 --- /dev/null +++ b/doc/bugs/Incorrect_merge__44___direct_repos___40__2__41__.mdwn @@ -0,0 +1,44 @@ +### Please describe the problem. +Incorrect merge of direct repos. + +### What steps will reproduce the problem? + +[[!format sh """ +# setting up stuff +test/a$ git init +test/a$ git annex init +test/a$ git annex direct +test/a$ touch firstfile +test/a$ git annex add firstfile +$ git clone test/a +$ mv a test/b +test/b$ git annex direct + +# actual scenario +test/b$ echo bbbb > f +test/b$ git annex add f +test/b$ git annex sync +test/a$ mkdir f +test/a$ echo aaaa > f/f +test/a$ git annex add f/f +test/a$ git annex sync +test/b$ git annex sync +test/b$ rm f +test/b$ git annex sync +test/b$ ls +test/b$ firstfile +test/b$ f.variant-SHA256E-s5--4551db5fd4d56e27be71a8a943070cfaa4342b8e960a326e2d6427b3aa0a5a48.variant-43f5 +test/a$ git annex sync # A's f/f is no longer to be found +"""]] + +### What version of git-annex are you using? On what operating system? +[[!format sh """ +git-annex version: 4.20131031-g7d99d14 +build flags: Assistant Webapp Pairing Testsuite S3 WebDAV Inotify DBus 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 glacier hook + +Linux ceilingcat 3.11.6-1-ARCH #1 SMP PREEMPT Fri Oct 18 23:22:36 CEST 2013 x86_64 GNU/Linux +"""]] + +> [[fixed|done]] --[[Joey]] diff --git a/doc/bugs/Incorrect_merge__44___direct_repos___40__2__41__/comment_1_15c354c4841d364e78882d2b46a0a764._comment b/doc/bugs/Incorrect_merge__44___direct_repos___40__2__41__/comment_1_15c354c4841d364e78882d2b46a0a764._comment new file mode 100644 index 0000000000..53c9f79153 --- /dev/null +++ b/doc/bugs/Incorrect_merge__44___direct_repos___40__2__41__/comment_1_15c354c4841d364e78882d2b46a0a764._comment @@ -0,0 +1,66 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.246" + subject="comment 1" + date="2013-11-14T17:06:50Z" + content=""" +I verify this bug. And it's specific to direct mode as you say. Here is a shell script which automates the proccess: + +[[!format sh \"\"\" +#!/bin/sh +set -e +mkdir test +cd test +git init a + +cd a +git annex init +git annex direct +touch firstfile +git annex add firstfile +git annex sync # think this was left out of recipe + +cd .. + +git clone a b +cd b +git annex direct +echo bbbb > f +git annex add f +git annex sync || true +cd .. +cd a +mkdir f +echo aaaa > f/f +git annex add f/f +git annex sync || true +cd .. +cd b +git annex sync +echo \"after merge:\" +ls +\"\"\"]] + +At this point, b only has the file version of f; the directory form has been removed. (Syncing to a of course then does the same thing there.) + +And from the trascript, we can see what's going on: + +
+Adding f/f
+CONFLICT (directory/file): There is a directory with name f in HEAD. Adding f as f~refs_heads_synced_master
+Automatic merge failed; fix conflicts and then commit the result.
+(Recording state in git...)
+f: needs merge
+[master 0600854] git-annex automatic merge conflict fix
+
+  Merge conflict was automatically resolved; you may want to examine the result.
+
+ +The problem seems to be that direct mode merge does not find the `f~refs_heads_synced_master` created by the merge, so fails to copy it from the temp merge tree into the work tree. + +`Command.Sync.cleanConflictCruft` is relevant, but was only made to work in indirect mode, it seems. + +---- + +Obviously, if someone runs into this bug and seems to lose data, they can get the data back by reverting the changes from the automatic merge. Direct mode does preserve file contents when removing them from the work tree in a merge. +"""]] diff --git a/doc/bugs/Incorrect_merge__44___direct_repos___40__2__41__/comment_2_8bc496226a977dbeeb1ce3f06122f1c2._comment b/doc/bugs/Incorrect_merge__44___direct_repos___40__2__41__/comment_2_8bc496226a977dbeeb1ce3f06122f1c2._comment new file mode 100644 index 0000000000..f9d3c7ffe3 --- /dev/null +++ b/doc/bugs/Incorrect_merge__44___direct_repos___40__2__41__/comment_2_8bc496226a977dbeeb1ce3f06122f1c2._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.246" + subject="comment 2" + date="2013-11-15T17:39:37Z" + content=""" +My initial guess was wrong.. This is not actually a bug in conflicted merge resolution at all. + +The bug is that in direct mode, it diffs the old and new tree when doing a normal merge, so see what files in the work tree need to be changed. This was written to go through the diff and replay the deletes and adds. In this case, since f/f and f are different items, they can appear in either order in the diff But the code only worked when f was first deleted, and f/f was then added. And it turns out that in this case, the diff had the two items the other way around. + +So, I think it needs to do 2 passes, first deleting and then adding. +"""]] diff --git a/doc/bugs/Incorrect_merge___40__a_special_case__41__.mdwn b/doc/bugs/Incorrect_merge___40__a_special_case__41__.mdwn new file mode 100644 index 0000000000..8e25ed6cbc --- /dev/null +++ b/doc/bugs/Incorrect_merge___40__a_special_case__41__.mdwn @@ -0,0 +1,48 @@ +### Please describe the problem. +(Minor issue.) + +Incorrect merge of direct repos in the special case where at repo A a symlink to a file whose contents aren't yet available, are overwritten, while at repo B the file is deleted. + +Result: file is deleted on both side. + +Expected: B.f is gone, A.f is still present + +### What steps will reproduce the problem? + +[[!format sh """ +# setting up stuff +test/a$ git init +test/a$ git annex init +test/a$ git annex direct +test/a$ touch firstfile +test/a$ git annex add firstfile +$ git clone test/a +$ mv a test/b +test/b$ git annex direct + +# actual scenario +test/b$ echo bbbb > f +test/b$ git annex add f +test/b$ git annex sync +test/a$ git annex sync +test/a$ echo aaaa > f +test/a$ git annex add f +test/a$ git annex sync +test/b$ rm f +test/b$ git annex sync +test/a$ git annex sync +# test/a/f is now gone, lost +"""]] + +### What version of git-annex are you using? On what operating system? +[[!format sh """ +git-annex version: 4.20131031-g7d99d14 +build flags: Assistant Webapp Pairing Testsuite S3 WebDAV Inotify DBus 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 glacier hook + +Linux ceilingcat 3.11.6-1-ARCH #1 SMP PREEMPT Fri Oct 18 23:22:36 CEST 2013 x86_64 GNU/Linux +"""]] + +> [[fixed|done]]; direct mode now freezes the content directory as indirect +> mode already did. fsck will fix up the permissions too. --[[Joey]] diff --git a/doc/bugs/Incorrect_merge___40__a_special_case__41__/comment_1_c80418d76b501c688e3a9fb4831520fd._comment b/doc/bugs/Incorrect_merge___40__a_special_case__41__/comment_1_c80418d76b501c688e3a9fb4831520fd._comment new file mode 100644 index 0000000000..0594ddabe6 --- /dev/null +++ b/doc/bugs/Incorrect_merge___40__a_special_case__41__/comment_1_c80418d76b501c688e3a9fb4831520fd._comment @@ -0,0 +1,41 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.246" + subject="comment 1" + date="2013-11-14T17:10:55Z" + content=""" +I suspect this might be the same underlying problem as [[bugs/Incorrect merge, direct repos (2)]]. However, I cannot reproduce it using the recipe given.. perhaps something was left out? + +I wrote this shell script to try to codify the recipe in a runnable form: + +[[!format sh \"\"\" +#!/bin/sh +set -e +mkdir test +cd test +git init a + +cd a +git annex init +git annex direct +touch firstfile +git annex add firstfile +git annex sync # think this was left out of recipe + +cd .. + +git clone a b +cd b +git annex direct +echo bbbb > f +git annex add f +git annex sync || true +cd .. +cd a +echo aaaa > f +git annex add f +git annex sync +\"\"\"]] + +At this point, a has 2 variants of f, and no amount of syncing in either repo will cause either variant to go away. +"""]] diff --git a/doc/bugs/Incorrect_merge___40__a_special_case__41__/comment_2_8b2a188696f46819f6e3f0e9660362d2._comment b/doc/bugs/Incorrect_merge___40__a_special_case__41__/comment_2_8b2a188696f46819f6e3f0e9660362d2._comment new file mode 100644 index 0000000000..39bb908772 --- /dev/null +++ b/doc/bugs/Incorrect_merge___40__a_special_case__41__/comment_2_8b2a188696f46819f6e3f0e9660362d2._comment @@ -0,0 +1,45 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawlWskoNgUB7r70OXglR-4iKI4bOuPJb-xg" + nickname="Tim" + subject="comment 2" + date="2013-11-14T18:06:55Z" + content=""" +You were missing a: test/a$ git annex sync + +This did the trick on my system +[[!format sh \"\"\" +#!/bin/sh +set -e +mkdir test +cd test +git init a + +cd a +git annex init +git annex direct +touch firstfile +git annex add firstfile +git annex sync # think this was left out of recipe # indeed it was + +cd .. + +git clone a b +cd b +git annex direct +echo bbbb > f +git annex add f +git annex sync || true # why add a || true? +cd ../a +git annex sync +echo aaaa > f +git annex add f +git annex sync +cd ../b +rm f +git annex sync +ls +cd ../a +git annex sync +ls +\"\"\"]] +"""]] diff --git a/doc/bugs/Incorrect_merge___40__a_special_case__41__/comment_3_8cdbb1fda506b9e53a0e9ab88b2569c1._comment b/doc/bugs/Incorrect_merge___40__a_special_case__41__/comment_3_8cdbb1fda506b9e53a0e9ab88b2569c1._comment new file mode 100644 index 0000000000..ce5c144e13 --- /dev/null +++ b/doc/bugs/Incorrect_merge___40__a_special_case__41__/comment_3_8cdbb1fda506b9e53a0e9ab88b2569c1._comment @@ -0,0 +1,15 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.246" + subject="comment 3" + date="2013-11-15T17:48:42Z" + content=""" +Hmm. In your script, when you run `git annex sync` in a and then `echo aaaa > f`, f already exists at that point as a symlink. This actually ends up following the link and writing to .git/annex/objects. (fsck will detect that junk has been written there) + +That's a bug on its own; seems like direct mode is neglecting to lock down the .git/annex/objects directories to prevent writing to them like this. + +---- + +However, this means that your script does not demonstrate the bug you originally reported. +You remove b/f and sync, and since a/f has not been changed, the deleting is correctly synced to a, removing a/f. +"""]] diff --git a/doc/bugs/Incorrect_merge___40__a_special_case__41__/comment_4_9d74e2854a5d77f0f793f56fa0cff9e2._comment b/doc/bugs/Incorrect_merge___40__a_special_case__41__/comment_4_9d74e2854a5d77f0f793f56fa0cff9e2._comment new file mode 100644 index 0000000000..c7bb027654 --- /dev/null +++ b/doc/bugs/Incorrect_merge___40__a_special_case__41__/comment_4_9d74e2854a5d77f0f793f56fa0cff9e2._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.246" + subject="comment 4" + date="2013-11-15T17:52:38Z" + content=""" +Looking back at the original bug description: + +\"repo A a symlink to a file whose contents aren't yet available, are overwritten, while at repo B the file is deleted.\" + +I think the \"overwritten\" is key. I suspect you were always doing echo > f where f was a symlink, and this does not actually overwrite the symlink, it just puts data (that fsck will reject) into the annex. + +So, proceeding as if the real bug here is the ability to write through symlink in direct mode, unless told otherwise.. +"""]] diff --git a/doc/bugs/Incorrect_version_of_Git_Annex___40__1.0.52__41___as_seen_by_Android.mdwn b/doc/bugs/Incorrect_version_of_Git_Annex___40__1.0.52__41___as_seen_by_Android.mdwn new file mode 100644 index 0000000000..95db65e25c --- /dev/null +++ b/doc/bugs/Incorrect_version_of_Git_Annex___40__1.0.52__41___as_seen_by_Android.mdwn @@ -0,0 +1,24 @@ +### Please describe the problem. + +Git Annex is listed as of version 1.0.52 if you check out its entry in the list of applications in the Android configuration. I guess that one is of the terminal app which kickstarts the annex. + +### What steps will reproduce the problem? + +install apk + +### What version of git-annex are you using? On what operating system? + +android +5.2013whatever + +### 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/JSON_output_broken_with___34__git_annex_sync__34__/comment_1_380a49b3c132f9f529729a1cb5a69621._comment b/doc/bugs/JSON_output_broken_with___34__git_annex_sync__34__/comment_1_380a49b3c132f9f529729a1cb5a69621._comment index f0eff45c1d..d1ad05842e 100644 --- a/doc/bugs/JSON_output_broken_with___34__git_annex_sync__34__/comment_1_380a49b3c132f9f529729a1cb5a69621._comment +++ b/doc/bugs/JSON_output_broken_with___34__git_annex_sync__34__/comment_1_380a49b3c132f9f529729a1cb5a69621._comment @@ -4,5 +4,5 @@ subject="comment 1" date="2012-11-27T21:13:08Z" content=""" -Yeah, so git-annex has --json as a option available to any command, but the set of commands where it's actually useful is rather smaller, and certianly does not include this one. In general there are quite a lot of places where third-party program output is allowed to show through to provide necessary progress or debugging output, and that of course makes the json mode invalid. +Yeah, so git-annex has --json as a option available to any command, but the set of commands where it's actually useful is rather smaller, and certainly does not include this one. In general there are quite a lot of places where third-party program output is allowed to show through to provide necessary progress or debugging output, and that of course makes the json mode invalid. """]] diff --git a/doc/bugs/Local_pairing_fails:_received_PairMsg_loop.mdwn b/doc/bugs/Local_pairing_fails:_received_PairMsg_loop.mdwn new file mode 100644 index 0000000000..63f423e2c7 --- /dev/null +++ b/doc/bugs/Local_pairing_fails:_received_PairMsg_loop.mdwn @@ -0,0 +1,39 @@ +### Please describe the problem. +Pairing over my local network doesn't work. The pairing process never finishes. The log shows that the same PairMsg messages are repeated endlessly. + +### What steps will reproduce the problem? + + +### What version of git-annex are you using? On what operating system? +I'm on Ubuntu Raring 13.04. I installed git-annex 4.20131024 from the Precise PPA. It is working fine with a remote ssh repo, just not local pairing. + +### 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 +[2013-11-01 16:55:21 CDT] main: Pairing in progress +[2013-11-01 16:55:55 CDT] PairListener: received "PairMsg (Verifiable {verifiableVal = (PairReq,PairData {remoteHostName = Just \"Onyx\", remoteUserName = \"me\", remoteDirectory = \"~/annex\", remoteSshPubKey = \"ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDBT0Y6TTzTg8nWwonmgUPPwJmPIaJzfEoJl8DbuylpgXqGCQ4doJXuvBODHIehPfyMr1xCWqNlNNLkcWg/a/eHFceyt3IlcD9XaZ1aKPzPmpjYKKf5amiYd6mAssw8zFaZUvwaXkNuHZpXVZyg6C6TkT6kdfln+6fOJZpSGQzksy0jka/Rzx0KXjsp3oqO4tQJbC7AX0nvmD0zvLtyCURzfGV+n2IqQxpPf2nP75Evt8jamcuqm6pWoe+hj9zjGytIXpSKe35wzRwUAUrjgmZ9NweuWfi2uMPJlDv8/n+Q3HyjygA+GzixBGuYXDt1CD8ISZvuoygS+9+jeY9uYH8b me@Onyx\\n\", pairUUID = UUID \"834b4f39-ca66-4baf-9323-57ef7058d7d0\"},IPv4Addr 2281744576), verifiableDigest = \"8d5d380542f7377f09a4584a38b0dbcea9ea215c\"})" +[2013-11-01 16:55:56 CDT] PairListener: received "PairMsg (Verifiable {verifiableVal = (PairReq,PairData {remoteHostName = Just \"kubbie\", remoteUserName = \"me\", remoteDirectory = \"~/annex\", remoteSshPubKey = \"ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQCvBEWT+AiAmehOFyTQWlSdwDs7DDbkw7rfZ4W/IeG5awZjMgT5BefIv9cmar8vGIIEFMZLpf8cL3xIargDz0xE2wuqj5CLkdz+DKp5f2FGs11Ax/62DZr+eCiVtPnwijFw0Cz0wMRzkN93uedrvzP/KkNRcczgWh3aZqn8WxlkCia1fyykm/pP3W80MNkiJYX5vXpu1NCV5KLu+UXQzKhM2njOauJ3W5wsMvSl8faZIpEmKVCD3BMDDruxTIxggA3kt9GCGvIbPawy+fGOpp/j6pHqnX3GB2kkT47RIZKYEv99HuLyvea+oY5R11FsC2yYY3ujIdUU0fXnV8pvrqSv me@kubbie\\n\", pairUUID = UUID \"fd6a6858-76c9-4eea-b733-9359c7313e72\"},IPv4Addr 1879091392), verifiableDigest = \"cbd8197c3d78c8c68bb30f63aa974cd88dd0fb13\"})" +[2013-11-01 16:55:57 CDT] PairListener: received "PairMsg (Verifiable {verifiableVal = (PairReq,PairData {remoteHostName = Just \"Onyx\", remoteUserName = \"me\", remoteDirectory = \"~/annex\", remoteSshPubKey = \"ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDBT0Y6TTzTg8nWwonmgUPPwJmPIaJzfEoJl8DbuylpgXqGCQ4doJXuvBODHIehPfyMr1xCWqNlNNLkcWg/a/eHFceyt3IlcD9XaZ1aKPzPmpjYKKf5amiYd6mAssw8zFaZUvwaXkNuHZpXVZyg6C6TkT6kdfln+6fOJZpSGQzksy0jka/Rzx0KXjsp3oqO4tQJbC7AX0nvmD0zvLtyCURzfGV+n2IqQxpPf2nP75Evt8jamcuqm6pWoe+hj9zjGytIXpSKe35wzRwUAUrjgmZ9NweuWfi2uMPJlDv8/n+Q3HyjygA+GzixBGuYXDt1CD8ISZvuoygS+9+jeY9uYH8b me@Onyx\\n\", pairUUID = UUID \"834b4f39-ca66-4baf-9323-57ef7058d7d0\"},IPv4Addr 2281744576), verifiableDigest = \"8d5d380542f7377f09a4584a38b0dbcea9ea215c\"})" +[2013-11-01 16:55:58 CDT] PairListener: received "PairMsg (Verifiable {verifiableVal = (PairReq,PairData {remoteHostName = Just \"kubbie\", remoteUserName = \"me\", remoteDirectory = \"~/annex\", remoteSshPubKey = \"ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQCvBEWT+AiAmehOFyTQWlSdwDs7DDbkw7rfZ4W/IeG5awZjMgT5BefIv9cmar8vGIIEFMZLpf8cL3xIargDz0xE2wuqj5CLkdz+DKp5f2FGs11Ax/62DZr+eCiVtPnwijFw0Cz0wMRzkN93uedrvzP/KkNRcczgWh3aZqn8WxlkCia1fyykm/pP3W80MNkiJYX5vXpu1NCV5KLu+UXQzKhM2njOauJ3W5wsMvSl8faZIpEmKVCD3BMDDruxTIxggA3kt9GCGvIbPawy+fGOpp/j6pHqnX3GB2kkT47RIZKYEv99HuLyvea+oY5R11FsC2yYY3ujIdUU0fXnV8pvrqSv me@kubbie\\n\", pairUUID = UUID \"fd6a6858-76c9-4eea-b733-9359c7313e72\"},IPv4Addr 1879091392), verifiableDigest = \"cbd8197c3d78c8c68bb30f63aa974cd88dd0fb13\"})" +[2013-11-01 16:55:59 CDT] PairListener: received "PairMsg (Verifiable {verifiableVal = (PairReq,PairData {remoteHostName = Just \"Onyx\", remoteUserName = \"me\", remoteDirectory = \"~/annex\", remoteSshPubKey = \"ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDBT0Y6TTzTg8nWwonmgUPPwJmPIaJzfEoJl8DbuylpgXqGCQ4doJXuvBODHIehPfyMr1xCWqNlNNLkcWg/a/eHFceyt3IlcD9XaZ1aKPzPmpjYKKf5amiYd6mAssw8zFaZUvwaXkNuHZpXVZyg6C6TkT6kdfln+6fOJZpSGQzksy0jka/Rzx0KXjsp3oqO4tQJbC7AX0nvmD0zvLtyCURzfGV+n2IqQxpPf2nP75Evt8jamcuqm6pWoe+hj9zjGytIXpSKe35wzRwUAUrjgmZ9NweuWfi2uMPJlDv8/n+Q3HyjygA+GzixBGuYXDt1CD8ISZvuoygS+9+jeY9uYH8b me@Onyx\\n\", pairUUID = UUID \"834b4f39-ca66-4baf-9323-57ef7058d7d0\"},IPv4Addr 2281744576), verifiableDigest = \"8d5d380542f7377f09a4584a38b0dbcea9ea215c\"})" +[2013-11-01 16:56:00 CDT] PairListener: received "PairMsg (Verifiable {verifiableVal = (PairReq,PairData {remoteHostName = Just \"kubbie\", remoteUserName = \"me\", remoteDirectory = \"~/annex\", remoteSshPubKey = \"ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQCvBEWT+AiAmehOFyTQWlSdwDs7DDbkw7rfZ4W/IeG5awZjMgT5BefIv9cmar8vGIIEFMZLpf8cL3xIargDz0xE2wuqj5CLkdz+DKp5f2FGs11Ax/62DZr+eCiVtPnwijFw0Cz0wMRzkN93uedrvzP/KkNRcczgWh3aZqn8WxlkCia1fyykm/pP3W80MNkiJYX5vXpu1NCV5KLu+UXQzKhM2njOauJ3W5wsMvSl8faZIpEmKVCD3BMDDruxTIxggA3kt9GCGvIbPawy+fGOpp/j6pHqnX3GB2kkT47RIZKYEv99HuLyvea+oY5R11FsC2yYY3ujIdUU0fXnV8pvrqSv me@kubbie\\n\", pairUUID = UUID \"fd6a6858-76c9-4eea-b733-9359c7313e72\"},IPv4Addr 1879091392), verifiableDigest = \"cbd8197c3d78c8c68bb30f63aa974cd88dd0fb13\"})" +[2013-11-01 16:56:01 CDT] PairListener: received "PairMsg (Verifiable {verifiableVal = (PairReq,PairData {remoteHostName = Just \"Onyx\", remoteUserName = \"me\", remoteDirectory = \"~/annex\", remoteSshPubKey = \"ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDBT0Y6TTzTg8nWwonmgUPPwJmPIaJzfEoJl8DbuylpgXqGCQ4doJXuvBODHIehPfyMr1xCWqNlNNLkcWg/a/eHFceyt3IlcD9XaZ1aKPzPmpjYKKf5amiYd6mAssw8zFaZUvwaXkNuHZpXVZyg6C6TkT6kdfln+6fOJZpSGQzksy0jka/Rzx0KXjsp3oqO4tQJbC7AX0nvmD0zvLtyCURzfGV+n2IqQxpPf2nP75Evt8jamcuqm6pWoe+hj9zjGytIXpSKe35wzRwUAUrjgmZ9NweuWfi2uMPJlDv8/n+Q3HyjygA+GzixBGuYXDt1CD8ISZvuoygS+9+jeY9uYH8b me@Onyx\\n\", pairUUID = UUID \"834b4f39-ca66-4baf-9323-57ef7058d7d0\"},IPv4Addr 2281744576), verifiableDigest = \"8d5d380542f7377f09a4584a38b0dbcea9ea215c\"})" +...and so on and so on... +# End of transcript or log. +"""]] + +> I was able to reproduce something very like this by starting +> pairing separately on both computers under poor network conditions (ie, +> weak wifi on my front porch). +> +> So, I've made a new PairReq message that has not been seen before +> always make the alert pop up, even if the assistant thinks it is +> in the middle of its own pairing process (or even another pairing process +> with a different box on the LAN). +> +> (This shouldn't cause a rogue PairAck to disrupt a pairing process part +> way through.) +> +> [[done]] --[[Joey]] diff --git a/doc/bugs/Local_pairing_fails:_received_PairMsg_loop/comment_1_b8c485bafd98be8c21595597af361255._comment b/doc/bugs/Local_pairing_fails:_received_PairMsg_loop/comment_1_b8c485bafd98be8c21595597af361255._comment new file mode 100644 index 0000000000..39587ee908 --- /dev/null +++ b/doc/bugs/Local_pairing_fails:_received_PairMsg_loop/comment_1_b8c485bafd98be8c21595597af361255._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmNu4V5fvpLlBhaCUfXXOB0MI5NXwh8SkU" + nickname="Adam" + subject="comment 1" + date="2013-11-01T23:10:12Z" + content=""" +Also, when I initiate the pairing process on one computer only, I can see the PairMsg being constantly received in the other computer's log, but the prompt to finish pairing never appears. +"""]] diff --git a/doc/bugs/Local_pairing_fails:_received_PairMsg_loop/comment_2_bc63489334f44a423645021415ffe196._comment b/doc/bugs/Local_pairing_fails:_received_PairMsg_loop/comment_2_bc63489334f44a423645021415ffe196._comment new file mode 100644 index 0000000000..f10b16f3c9 --- /dev/null +++ b/doc/bugs/Local_pairing_fails:_received_PairMsg_loop/comment_2_bc63489334f44a423645021415ffe196._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmNu4V5fvpLlBhaCUfXXOB0MI5NXwh8SkU" + nickname="Adam" + subject="comment 2" + date="2013-11-01T23:27:24Z" + content=""" +Well I installed the 1 Nov release from the tarball and then it picked up the pair request from the other system. I don't know if it was a bug in the previous version or something to do with the PPA. It's weird that the assistant just wasn't doing anything about the pair request it received. + +Thanks for your work on git-annex assistant. +"""]] diff --git a/doc/bugs/Local_pairing_fails:_received_PairMsg_loop/comment_3_6345b174d04b6613c2c55a6ec9e50c21._comment b/doc/bugs/Local_pairing_fails:_received_PairMsg_loop/comment_3_6345b174d04b6613c2c55a6ec9e50c21._comment new file mode 100644 index 0000000000..a7eff67441 --- /dev/null +++ b/doc/bugs/Local_pairing_fails:_received_PairMsg_loop/comment_3_6345b174d04b6613c2c55a6ec9e50c21._comment @@ -0,0 +1,16 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.47" + subject="comment 3" + date="2013-11-02T19:02:55Z" + content=""" +There is something a little strange in the logs. It shows both Onyx and kubbie are sending PairReqs. Probably one of those is the local computer, logging its own broadcast messages which loop back to it. But normally in pairing, one side starts the pairing process with a PairReq, and the other side pops up an alert and continues the process with a PairAck. It's not normal for both sides to request that pairing start. + +Is it possible that you started pairing on both computers separately? + +I tried doing that with gnu and darkstar. First I started pairing on gnu. darkstar saw the pair request, but I ignored the alert message about that, and went and started a separate pairing process on darkstar. gnu never showed an alert message for that; it ignored darkstar's PairReqs since it was sending its own. + +It's unlikely you'd ignore the alert, but the same thing could happen if the two computers were not able to communicate over the network initially, and pairing were started on both separately. So neither gets a chance to see the other's PairReq and show the alert. Even when they came into communication, they'd each ignore the other's PairReq. + +So, that seems like a bug.. +"""]] diff --git a/doc/bugs/Local_pairing_fails:_received_PairMsg_loop/comment_4_f39ec6c3d5a016b3c5260162c0b42177._comment b/doc/bugs/Local_pairing_fails:_received_PairMsg_loop/comment_4_f39ec6c3d5a016b3c5260162c0b42177._comment new file mode 100644 index 0000000000..cacbad03f4 --- /dev/null +++ b/doc/bugs/Local_pairing_fails:_received_PairMsg_loop/comment_4_f39ec6c3d5a016b3c5260162c0b42177._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmNu4V5fvpLlBhaCUfXXOB0MI5NXwh8SkU" + nickname="Adam" + subject="comment 4" + date="2013-11-02T22:52:31Z" + content=""" +I did indeed try to pair from both systems. What happened was, after I started the pair request, I went to the other system, and there was no pair request listed. So I misunderstood the directions and thought I was supposed to go ahead and enter the same password into the other system. (It says that pairing will complete as soon as the password is entered on the other system, so it seems reasonable to try that.) Then both systems were constantly issuing pair requests, but neither system was responding to the requests, even though it was receiving them. + +Both systems were always on the network and always able to communicate over it. The bug went away when I upgraded to the 1 Nov release...but then I had some very confusing issues with partially-paired repos from different git-annex versions...I ended up having to start git-annex over from scratch on both systems with the 1 Nov build. + +So I'm not sure where to go from here with this bug. Thanks for your help. +"""]] diff --git a/doc/bugs/Local_pairing_fails:_received_PairMsg_loop/comment_5_ca0c5ef6e6a6d2c4b64430ac68370b6a._comment b/doc/bugs/Local_pairing_fails:_received_PairMsg_loop/comment_5_ca0c5ef6e6a6d2c4b64430ac68370b6a._comment new file mode 100644 index 0000000000..413ca952e7 --- /dev/null +++ b/doc/bugs/Local_pairing_fails:_received_PairMsg_loop/comment_5_ca0c5ef6e6a6d2c4b64430ac68370b6a._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmNu4V5fvpLlBhaCUfXXOB0MI5NXwh8SkU" + nickname="Adam" + subject="comment 5" + date="2013-11-02T22:55:42Z" + content=""" +Oh, now I see your comment up there that you fixed it. Awesome. :) +"""]] diff --git a/doc/bugs/Lost_S3_Remote/comment_1_6e80e6db6671581d471fc9a54181c04c._comment b/doc/bugs/Lost_S3_Remote/comment_1_6e80e6db6671581d471fc9a54181c04c._comment index b4f7bdc3cf..d6595ad5bc 100644 --- a/doc/bugs/Lost_S3_Remote/comment_1_6e80e6db6671581d471fc9a54181c04c._comment +++ b/doc/bugs/Lost_S3_Remote/comment_1_6e80e6db6671581d471fc9a54181c04c._comment @@ -6,5 +6,5 @@ content=""" Despite `status` listing S3 support, your git-annex is actually built with S3stub, probably because it failed to find the necessary S3 module at build time. Rebuild git-annex and watch closely, you'll see \"** building without S3 support\". Look above that for the error and fix it. -It was certianly a bug that it showed S3 as supported when built without it. I've fixed that. +It was certainly a bug that it showed S3 as supported when built without it. I've fixed that. """]] diff --git a/doc/bugs/Mac_OS_10.9_GPG_erro_when_creating_USB_repo___40__solved__41__.mdwn b/doc/bugs/Mac_OS_10.9_GPG_erro_when_creating_USB_repo___40__solved__41__.mdwn new file mode 100644 index 0000000000..2875e63e43 --- /dev/null +++ b/doc/bugs/Mac_OS_10.9_GPG_erro_when_creating_USB_repo___40__solved__41__.mdwn @@ -0,0 +1,23 @@ +### Please describe the problem. + +Creating a USB repo fails with a GPG error. + +### What steps will reproduce the problem? + + * Build git-annex and git-annex assistant using the instructions at https://gist.github.com/calmyournerves/7144127 + * Run git-annex app to launch web interface + * Create local repo using web interface + * Try to create USB repo using web interface + +### What version of git-annex are you using? On what operating system? + +git-annex version 4.20131105-g136b030 on Mac OS 10.9 Mavericks. + +### Please provide any additional information below. + +[[!format sh """ +07/Nov/2013:06:51:07 +1100 [Error#yesod-core] user error (gpg ["--batch","--no-tty","--use-agent","--quiet","--trust-model","always","--with-colons","--list-secret-keys","--fixed-list-mode"] exited 5) @(yesod-core-1.2.4.5:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:485:5) +"""]] + +> [[fixed|done]]; it seems that this was a local build issue ad does not +> affect the autobuild. --[[Joey]] diff --git a/doc/bugs/Mac_OS_10.9_GPG_erro_when_creating_USB_repo___40__solved__41__/comment_1_0b4dcedc58e5071733e1239490aed2ea._comment b/doc/bugs/Mac_OS_10.9_GPG_erro_when_creating_USB_repo___40__solved__41__/comment_1_0b4dcedc58e5071733e1239490aed2ea._comment new file mode 100644 index 0000000000..34d8d94b1f --- /dev/null +++ b/doc/bugs/Mac_OS_10.9_GPG_erro_when_creating_USB_repo___40__solved__41__/comment_1_0b4dcedc58e5071733e1239490aed2ea._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmZgZuUhZlHpd_AbbcixY0QQiutb2I7GWY" + nickname="Jimmy" + subject="Updated version 4.20131105-g136b030 seems to work" + date="2013-11-07T20:28:55Z" + content=""" +I've updated to the latest version as of 12 hours ago and I was able to create a USB repo on two computers. 4.20131105-g136b030 showing on the web app but 20131106 on the command line. + +Is there an easy way of checking the repo is correctly encrypted? I didn't see anything about encrypting (now the previous error has disappeared) when creating the repo - is this what I should expect? +"""]] diff --git a/doc/bugs/Mac_OS_10.9_GPG_erro_when_creating_USB_repo___40__solved__41__/comment_2_1cb1ef0292a3357874b461a77c13373e._comment b/doc/bugs/Mac_OS_10.9_GPG_erro_when_creating_USB_repo___40__solved__41__/comment_2_1cb1ef0292a3357874b461a77c13373e._comment new file mode 100644 index 0000000000..83e0b23170 --- /dev/null +++ b/doc/bugs/Mac_OS_10.9_GPG_erro_when_creating_USB_repo___40__solved__41__/comment_2_1cb1ef0292a3357874b461a77c13373e._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="108.236.230.124" + subject="comment 2" + date="2013-11-08T17:36:53Z" + content=""" +USB repos are not set up encryption unless you explicitly request it. +"""]] diff --git a/doc/bugs/Mac_OS_10.9_GPG_erro_when_creating_USB_repo___40__solved__41__/comment_3_e5ec1e3ab304d738e3b0847287a47af4._comment b/doc/bugs/Mac_OS_10.9_GPG_erro_when_creating_USB_repo___40__solved__41__/comment_3_e5ec1e3ab304d738e3b0847287a47af4._comment new file mode 100644 index 0000000000..0b3a804b94 --- /dev/null +++ b/doc/bugs/Mac_OS_10.9_GPG_erro_when_creating_USB_repo___40__solved__41__/comment_3_e5ec1e3ab304d738e3b0847287a47af4._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmZgZuUhZlHpd_AbbcixY0QQiutb2I7GWY" + nickname="Jimmy" + subject="Yes, I just figured that out" + date="2013-11-08T22:09:40Z" + content=""" +I figured it out a couple of hours ago when I was able to use the existing USB repo on a new computer that doesn't have any of my private keys on it. + +I didn't see an option in the web interface to use encryption - is it command line only? +"""]] diff --git a/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__.mdwn b/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__.mdwn new file mode 100644 index 0000000000..5c70527fd8 --- /dev/null +++ b/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__.mdwn @@ -0,0 +1,28 @@ +### Please describe the problem. + +Creating a remote S3 repository using the git-annex assistant web interface fails with a GPG error. (I'm also getting a GPG error trying to create a USB repo but it's slightly different so I'll post a different bug.) + +### What steps will reproduce the problem? + + * Build git-annex and git-annex assistant using the instructions at https://gist.github.com/calmyournerves/7144127 + * Run git-annex app to launch web interface + * Create local repo using web interface + * Try to create encrypted S3 remote repo using web interface + +### What version of git-annex are you using? On what operating system? + +git-annex version 4.20131105-g136b030 on MacOS 10.9 Mavericks. + +### Please provide any additional information below. + +[[!format sh """ + +(encryption setup) dyld: Library not loaded: @rpath/libz.1.2.8.dylib + Referenced from: /Applications/git-annex.app/Contents/MacOS/bundle/gpg + Reason: image not found +07/Nov/2013:06:38:27 +1100 [Error#yesod-core] user error (gpg ["--batch","--no-tty","--use-agent","--quiet","--trust-model","always","--gen-random","--armor","1","512"] exited 5) @(yesod-core-1.2.4.5:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:485:5) + +"""]] + +> [[fixed|done]]; it seems that this was a local build issue ad does not +> affect the autobuild. --[[Joey]] diff --git a/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__/comment_1_d95accb43bd18cc9acbbf1d4069f86b3._comment b/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__/comment_1_d95accb43bd18cc9acbbf1d4069f86b3._comment new file mode 100644 index 0000000000..0f1e34e31e --- /dev/null +++ b/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__/comment_1_d95accb43bd18cc9acbbf1d4069f86b3._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmZgZuUhZlHpd_AbbcixY0QQiutb2I7GWY" + nickname="Jimmy" + subject="S3 works without encryption" + date="2013-11-06T21:09:26Z" + content=""" +Not surprisingly, S3 repos work without encryption. +"""]] diff --git a/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__/comment_2_452a3c524974832f0742efb00df4d576._comment b/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__/comment_2_452a3c524974832f0742efb00df4d576._comment new file mode 100644 index 0000000000..6b3ca2a0b3 --- /dev/null +++ b/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__/comment_2_452a3c524974832f0742efb00df4d576._comment @@ -0,0 +1,13 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmZgZuUhZlHpd_AbbcixY0QQiutb2I7GWY" + nickname="Jimmy" + subject="Still fails with git-annex version 4.20131105-g136b030" + date="2013-11-07T20:32:09Z" + content=""" +Updating seems to have fixed my other problem with creating a USB repo but still fails when trying to create an encrypted S3 repo. + + (encryption setup) dyld: Library not loaded: @rpath/libz.1.2.8.dylib + Referenced from: /Applications/git-annex.app/Contents/MacOS/bundle/gpg + Reason: image not found + 08/Nov/2013:07:30:11 +1100 [Error#yesod-core] user error (gpg [\"--batch\",\"--no-tty\",\"--use-agent\",\"--quiet\",\"--trust-model\",\"always\",\"--gen-random\",\"--armor\",\"1\",\"512\"] exited 5) @(yesod-core-1.2.4.5:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:485:5) +"""]] diff --git a/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__/comment_3_f8f6d1e0065e5ba56cd405b1c021ca09._comment b/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__/comment_3_f8f6d1e0065e5ba56cd405b1c021ca09._comment new file mode 100644 index 0000000000..e2ae9c3dcb --- /dev/null +++ b/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__/comment_3_f8f6d1e0065e5ba56cd405b1c021ca09._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="108.236.230.124" + subject="comment 3" + date="2013-11-08T17:38:40Z" + content=""" +Looks like it failed to include libz.1.2.8.dylib in the bundle for some reason despite gpg needing it. + +I don't really see the point in building an app bundle if you're going to install it back to the same machine you built it on. It's much easier to just `cabal install git-annex` in this case. +"""]] diff --git a/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__/comment_4_b524649cee751532d20a4894d71c5cf3._comment b/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__/comment_4_b524649cee751532d20a4894d71c5cf3._comment new file mode 100644 index 0000000000..8c7450ca6b --- /dev/null +++ b/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__/comment_4_b524649cee751532d20a4894d71c5cf3._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmZgZuUhZlHpd_AbbcixY0QQiutb2I7GWY" + nickname="Jimmy" + subject="Maybe I'm missing something..." + date="2013-11-08T22:12:04Z" + content=""" +But does cabal install git-annex install the assistant? On the Mac, I use the app bundle to launch the web interface from my applications folder. +"""]] diff --git a/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__/comment_5_8312ba868ef616ec00563446c9c3464f._comment b/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__/comment_5_8312ba868ef616ec00563446c9c3464f._comment new file mode 100644 index 0000000000..f94f2d9c8a --- /dev/null +++ b/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__/comment_5_8312ba868ef616ec00563446c9c3464f._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmZgZuUhZlHpd_AbbcixY0QQiutb2I7GWY" + nickname="Jimmy" + subject="To answer my own question - "git annex webapp"" + date="2013-11-09T00:10:28Z" + content=""" +Will open the web app from the command line. + +But now I get a different error trying to create an encrypted S3 repo. + + (encryption setup) 09/Nov/2013:11:08:56 +1100 [Error#yesod-core] user error (gpg [\"--quiet\",\"--trust-model\",\"always\",\"--gen-random\",\"--armor\",\"1\",\"512\"] exited 127) @(yesod-core-1.2.4.5:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:485:5) +"""]] diff --git a/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__/comment_6_1af75c691d27c97397f1901f7c2483b0._comment b/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__/comment_6_1af75c691d27c97397f1901f7c2483b0._comment new file mode 100644 index 0000000000..19313d9a74 --- /dev/null +++ b/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__/comment_6_1af75c691d27c97397f1901f7c2483b0._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmZgZuUhZlHpd_AbbcixY0QQiutb2I7GWY" + nickname="Jimmy" + subject="Works with git annex on command line" + date="2013-11-09T20:18:38Z" + content=""" +git annex initremote cloud type=S3 keyid=key correct creates an encrypted S3 repo and I'm able to upload files. +"""]] diff --git a/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__/comment_7_e519df252875de87c4ef5b727f033bdf._comment b/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__/comment_7_e519df252875de87c4ef5b727f033bdf._comment new file mode 100644 index 0000000000..a67c59451a --- /dev/null +++ b/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__/comment_7_e519df252875de87c4ef5b727f033bdf._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.246" + subject="comment 7" + date="2013-11-15T19:00:25Z" + content=""" +It would be useful if you could test with the 10.9 build now available in [[install/OSX]]. +"""]] diff --git a/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__/comment_8_4bb959e2659991cd392853e8beacf708._comment b/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__/comment_8_4bb959e2659991cd392853e8beacf708._comment new file mode 100644 index 0000000000..cff7e9dee5 --- /dev/null +++ b/doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__/comment_8_4bb959e2659991cd392853e8beacf708._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmZgZuUhZlHpd_AbbcixY0QQiutb2I7GWY" + nickname="Jimmy" + subject="comment 8" + date="2013-11-15T21:31:40Z" + content=""" +Thanks Joey - I was able to create an encrypted S3 repo using the new Mavericks build. Files are transferring across and are encrypted. +"""]] diff --git a/doc/bugs/OSX_.dmg_unnecessarily_large_and_not_inherently_compressed.mdwn b/doc/bugs/OSX_.dmg_unnecessarily_large_and_not_inherently_compressed.mdwn new file mode 100644 index 0000000000..bf74aebe6a --- /dev/null +++ b/doc/bugs/OSX_.dmg_unnecessarily_large_and_not_inherently_compressed.mdwn @@ -0,0 +1,68 @@ +### Please describe the problem. + +The .dmg the OSX build is distributed in is unnecessarily large (fixed size) and is externally compressed. + +I did a quick survey of .dmg images used for distributing other pieces of software which I had downloaded to my Mac, and most of them seem to be the UDBZ or the (older) UDZO formats which are internally compressed with bzip2 or zlib. According to "man hdiutil", the UDBZ format is supported since 10.4 (Tiger). + +Below are a pair of patches: first to enable "make clean" to work on OSX, second to build the .dmg in the UDBZ format and without an explicit size (it seems to infer a correct size). When I tested building it, it results in a .dmg which is slightly smaller than the old .dmg.bz2 + +(This will also require a change to remove the .bz2 from the download links elsewhere in the wiki.) + +
+From 251e23bbe66cc63e98089554f91b2528a097e818 Mon Sep 17 00:00:00 2001
+From: Mike Magin 
+Date: Sun, 17 Nov 2013 08:11:05 -0800
+Subject: [PATCH 1/2] Add explicit path to find invocation in "make clean" target.
+
+---
+ Makefile | 4 ++--
+ 1 file changed, 2 insertions(+), 2 deletions(-)
+
+diff --git a/Makefile b/Makefile
+index 3f3ed35..5a0cebb 100644
+--- a/Makefile
++++ b/Makefile
+@@ -83,8 +83,8 @@ clean:
+ 		Setup Build/InstallDesktopFile Build/EvilSplicer \
+ 		Build/Standalone Build/OSXMkLibs \
+ 		git-union-merge git-recover-repository
+-	find -name \*.o -exec rm {} \;
+-	find -name \*.hi -exec rm {} \;
++	find . -name \*.o -exec rm {} \;
++	find . -name \*.hi -exec rm {} \;
+ 
+ Build/InstallDesktopFile: Build/InstallDesktopFile.hs
+ 	$(GHC) --make $@
+-- 
+1.8.4.3
+
+From e66f767893b5ef70cbf69d420cb589071f88c784 Mon Sep 17 00:00:00 2001
+From: Mike Magin 
+Date: Sun, 17 Nov 2013 08:40:07 -0800
+Subject: [PATCH 2/2] Change .dmg build to include compression and not be fixed size.
+
+---
+ Makefile | 3 +--
+ 1 file changed, 1 insertion(+), 2 deletions(-)
+
+diff --git a/Makefile b/Makefile
+index 5a0cebb..b6ac549 100644
+--- a/Makefile
++++ b/Makefile
+@@ -162,10 +162,9 @@ osxapp: Build/Standalone Build/OSXMkLibs
+ 
+ 	./Build/OSXMkLibs $(OSXAPP_BASE)
+ 	rm -f tmp/git-annex.dmg
+-	hdiutil create -size 640m -format UDRW -srcfolder tmp/build-dmg \
++	hdiutil create -format UDBZ -srcfolder tmp/build-dmg \
+ 		-volname git-annex -o tmp/git-annex.dmg
+ 	rm -f tmp/git-annex.dmg.bz2
+-	bzip2 --fast tmp/git-annex.dmg
+ 
+ ANDROID_FLAGS?=-f-XMPP
+ # Cross compile for Android.
+-- 
+1.8.4.3
+
+ +> Ah, that never seemed optimal. [[done]] --[[Joey]] diff --git a/doc/bugs/Selfsigned_certificates_with_jabber_fail_miserably./comment_3_1e7578dd1321f399b12197056495b0b6._comment b/doc/bugs/Selfsigned_certificates_with_jabber_fail_miserably./comment_3_1e7578dd1321f399b12197056495b0b6._comment new file mode 100644 index 0000000000..62d723c7b3 --- /dev/null +++ b/doc/bugs/Selfsigned_certificates_with_jabber_fail_miserably./comment_3_1e7578dd1321f399b12197056495b0b6._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://launchpad.net/~psycojoker" + nickname="psycojoker" + subject="comment 3" + date="2013-11-25T09:54:33Z" + content=""" +Just to confirm that I'm also affected. Maybe you should add the possibility in the error message next to \"is the password correct?\". +"""]] diff --git a/doc/bugs/The_restricted_ssh_key_pair_makes_password_login___40__nearly__41___impossible/comment_20_b685050ee6fbb1a685e33f9656a10e84._comment b/doc/bugs/The_restricted_ssh_key_pair_makes_password_login___40__nearly__41___impossible/comment_20_b685050ee6fbb1a685e33f9656a10e84._comment index 0ef43779b9..83ab46051f 100644 --- a/doc/bugs/The_restricted_ssh_key_pair_makes_password_login___40__nearly__41___impossible/comment_20_b685050ee6fbb1a685e33f9656a10e84._comment +++ b/doc/bugs/The_restricted_ssh_key_pair_makes_password_login___40__nearly__41___impossible/comment_20_b685050ee6fbb1a685e33f9656a10e84._comment @@ -4,5 +4,5 @@ subject="comment 20" date="2013-04-14T20:59:26Z" content=""" -Ok, I don't know how gnome-keyring communicates with ssh, but that's good enough evidence for me: It was certianly gnome-keyring that got us into this mess! +Ok, I don't know how gnome-keyring communicates with ssh, but that's good enough evidence for me: It was certainly gnome-keyring that got us into this mess! """]] diff --git a/doc/bugs/Too_many_open_files.mdwn b/doc/bugs/Too_many_open_files.mdwn new file mode 100644 index 0000000000..3bb53e74df --- /dev/null +++ b/doc/bugs/Too_many_open_files.mdwn @@ -0,0 +1,55 @@ +### Please describe the problem. + +The transferrer crashes after a while due to too many open files + +### What steps will reproduce the problem? + +Have a huge annex. Connect two local machines, one with the huge annex, the other one without. Let them copy files… + +### What version of git-annex are you using? On what operating system? + +latest version +git-annex version: 5.20131117-gbd514dc +build flags: Assistant Webapp Pairing Testsuite 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 glacier hook + +on Mac OS X 10.9 + +### 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 + +[2013-11-22 10:49:19 CET] Transferrer: Downloaded oktaeder.png +[2013-11-22 10:49:19 CET] Transferrer: Downloaded oktaeder.png +[2013-11-22 10:49:19 CET] Transferrer: Downloaded oktaeder.png +[2013-11-22 10:49:20 CET] Transferrer: Downloaded klett-cover-neu.jpg +[2013-11-22 10:49:20 CET] Transferrer: Downloaded klett-cover-neu.jpg +[2013-11-22 10:49:20 CET] Transferrer: Downloaded kara-worl..ditor.gif +git-annex: runInteractiveProcess: pipe: Too many open files +Committer crashed: lsof: createProcess: resource exhausted (Too many open files) +[2013-11-22 10:49:20 CET] Committer: warning Committer crashed: lsof: createProcess: resource exhausted (Too many open files) +[2013-11-22 10:49:20 CET] Transferrer: Downloaded kara-worl..ditor.gif +[2013-11-22 10:49:20 CET] Transferrer: Downloaded kara-worl..ditor.gif +[2013-11-22 10:49:20 CET] Transferrer: Downloaded image1.png +[2013-11-22 10:49:21 CET] Transferrer: Downloaded image1.png +[2013-11-22 10:49:21 CET] Transferrer: Downloaded image.png +[2013-11-22 10:49:21 CET] Transferrer: Downloaded image.png +[2013-11-22 10:49:21 CET] Transferrer: Downloaded ikoseder.png +[2013-11-22 10:49:21 CET] Transferrer: Downloaded ikoseder.png +[2013-11-22 10:49:22 CET] Transferrer: Downloaded ikoseder.png +[2013-11-22 10:49:22 CET] Transferrer: Downloaded ikosaeder.jpg +git-annex: runInteractiveProcess: pipe: Too many open files +ok +(Recording state in git...) +git-annex: socket: resource exhausted (Too many open files) +[2013-11-22 10:49:22 CET] Transferrer: Downloaded ikosaeder.jpg +Transferrer crashed: getCurrentDirectory: resource exhausted (Too many open files) +[2013-11-22 10:49:22 CET] Transferrer: warning Transferrer crashed: getCurrentDirectory: resource exhausted (Too many open files) +git-annex: runInteractiveProcess: pipe: Too many open files +git-annex: runInteractiveProcess: pipe: Too many open files + +# End of transcript or log. +"""]] diff --git a/doc/bugs/Too_many_open_files/comment_1_d5d509b9b431d2ea6000ebc0aed62857._comment b/doc/bugs/Too_many_open_files/comment_1_d5d509b9b431d2ea6000ebc0aed62857._comment new file mode 100644 index 0000000000..4771926921 --- /dev/null +++ b/doc/bugs/Too_many_open_files/comment_1_d5d509b9b431d2ea6000ebc0aed62857._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.64" + subject="comment 1" + date="2013-11-26T16:28:25Z" + content=""" +You can use `lsof -c git-annex` to find out what files git-annex has open. (lsof is included in the git-annex.app bundle on OSX) That would be very helpful in tracking this down. +"""]] diff --git a/doc/bugs/Transfers_continue_after_daemon_stopped.mdwn b/doc/bugs/Transfers_continue_after_daemon_stopped.mdwn new file mode 100644 index 0000000000..0d9b4f6488 --- /dev/null +++ b/doc/bugs/Transfers_continue_after_daemon_stopped.mdwn @@ -0,0 +1,5 @@ +After creating a new pairing, I stopped the daemon through the webapp while it was syncing. The webapp shut down and was no longer accessible, but git-annex continued running in the background, along with git-annex-shell, and they continued to run new transfers with new rsync processes. This continued until I killed them all. + +I expected that when I stopped the daemon in the webapp, all git-annex processes and all transfers would stop. + +Using the 20131101 tarball. diff --git a/doc/bugs/Transfers_continue_after_daemon_stopped/comment_1_39eb527d64367e6762281246f1d49b1f._comment b/doc/bugs/Transfers_continue_after_daemon_stopped/comment_1_39eb527d64367e6762281246f1d49b1f._comment new file mode 100644 index 0000000000..9d504f743c --- /dev/null +++ b/doc/bugs/Transfers_continue_after_daemon_stopped/comment_1_39eb527d64367e6762281246f1d49b1f._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.47" + subject="comment 1" + date="2013-11-05T16:01:14Z" + content=""" +I've checked, and shutting down the daemon does cause it to stop any transfers it is running. + +However, this does not stop other transfers initiated by the other paired computer. + +I'm ambivilant about whether local pairing should only allow transfers when both daemons are running. +"""]] diff --git a/doc/bugs/Tries_to_upload_to_remote_although_remote_is_dead/comment_3_0a785b5dfbf4eef30854d6bedb12b7d1._comment b/doc/bugs/Tries_to_upload_to_remote_although_remote_is_dead/comment_3_0a785b5dfbf4eef30854d6bedb12b7d1._comment index 4eeedcd6bf..e839e7a156 100644 --- a/doc/bugs/Tries_to_upload_to_remote_although_remote_is_dead/comment_3_0a785b5dfbf4eef30854d6bedb12b7d1._comment +++ b/doc/bugs/Tries_to_upload_to_remote_although_remote_is_dead/comment_3_0a785b5dfbf4eef30854d6bedb12b7d1._comment @@ -4,7 +4,7 @@ subject="comment 3" date="2012-11-13T18:00:42Z" content=""" -I've tried & failed to reproduce this using the assistant. When I mark a repo as dead, and go into Configuration -> Manage repositories, the repository is not shown in the list of repositories it'll sync to, and it certianly doesn't upload any files to it. +I've tried & failed to reproduce this using the assistant. When I mark a repo as dead, and go into Configuration -> Manage repositories, the repository is not shown in the list of repositories it'll sync to, and it certainly doesn't upload any files to it. """]] diff --git a/doc/bugs/Truncated_file_transferred_via_S3/comment_1_5962358e6067448f633cc0eaf42f9ca7._comment b/doc/bugs/Truncated_file_transferred_via_S3/comment_1_5962358e6067448f633cc0eaf42f9ca7._comment index 6a05b9750f..f3583d31bb 100644 --- a/doc/bugs/Truncated_file_transferred_via_S3/comment_1_5962358e6067448f633cc0eaf42f9ca7._comment +++ b/doc/bugs/Truncated_file_transferred_via_S3/comment_1_5962358e6067448f633cc0eaf42f9ca7._comment @@ -6,5 +6,5 @@ content=""" Did you get a chance to run `git annex fsck` on the file? I'd hope it would detect this problem. -It's certianly possible for data to get corrupted somehow in transit. git-annex does not check that it got the expected contents until a fsck happens. +It's certainly possible for data to get corrupted somehow in transit. git-annex does not check that it got the expected contents until a fsck happens. """]] diff --git a/doc/bugs/Unnecessary_remote_transfers.mdwn b/doc/bugs/Unnecessary_remote_transfers.mdwn new file mode 100644 index 0000000000..9ae23e5a0b --- /dev/null +++ b/doc/bugs/Unnecessary_remote_transfers.mdwn @@ -0,0 +1,24 @@ +### Please describe the problem. +This is related to [[http://git-annex.branchable.com/bugs/assistant_does_not_always_use_repo_cost_info_when_queueing_downloads/]] + +### What steps will reproduce the problem? +1. Make a client repo on two machines on the local network. +2. Pair them. +3. Make a remote transfer repo. +4. Set up Jabber on both local machines. +5. Put a large file into the annex on one of the local machines. +6. Watch as the source client repo copies the file directly to the local paired machine, but also copies it to the remote transfer repo. +7. Wait for the local paired transfer to finish. +8. Manually disable syncing to the remote transfer repo. +9. Manually reenable it. +10. Watch as the remote transfer is not resumed. + +### What version of git-annex are you using? On what operating system? +Using the 1 Nov Linux tarball, Ubuntu Raring. + +### Please provide any additional information below. +This is a problem because unless I manually disable the remote repo, it will continue uploading the large file until it finishes, which uses the limited upstream bandwidth on my Internet connection--and this could take hours depending on the size of the file. + +The remote transfer wasn't even necessary to begin with, because it already had a direct connection to the local paired repo. But even so, it should at least abort the remote transfer when the local transfer finishes. + +Thanks for your work on git-annex assistant. diff --git a/doc/bugs/Unnecessary_remote_transfers/comment_10_b778fbb1386f0f51bf057ffacd590ebb._comment b/doc/bugs/Unnecessary_remote_transfers/comment_10_b778fbb1386f0f51bf057ffacd590ebb._comment new file mode 100644 index 0000000000..8c985243ab --- /dev/null +++ b/doc/bugs/Unnecessary_remote_transfers/comment_10_b778fbb1386f0f51bf057ffacd590ebb._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmNu4V5fvpLlBhaCUfXXOB0MI5NXwh8SkU" + nickname="Adam" + subject="comment 10" + date="2013-11-03T02:19:04Z" + content=""" +Thanks, Joey. I didn't realize that there were two instances of the assistant running. + +Forgive my ignorance, but if I disable the assistant running in the backup repo, will the other assistant still backup files to it? + +Also, from a UI perspective, does the webapp currently not seem to support secondary internal drives, at least in a useful way? +"""]] diff --git a/doc/bugs/Unnecessary_remote_transfers/comment_11_55430eac842d0a192dc7f41d7730e4d5._comment b/doc/bugs/Unnecessary_remote_transfers/comment_11_55430eac842d0a192dc7f41d7730e4d5._comment new file mode 100644 index 0000000000..808c5bca69 --- /dev/null +++ b/doc/bugs/Unnecessary_remote_transfers/comment_11_55430eac842d0a192dc7f41d7730e4d5._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.47" + subject="comment 11" + date="2013-11-03T02:32:47Z" + content=""" +Yes, either of the assistants will still back up files to it, as long as they have it configured as a git remote. The same way that your transfer repository is (probably) not running the git-annex assistant. + +It does sound like using the removable drive UI would have saved you some trouble. I'm not sure why the webapp would not list a llvm device as a removable drive -- from inspecting the code, it seems like it would not be filtered out, as long as /proc/mounts shows the decive as /dev/something (I don't have a llvm device handy to check what it looks like). +"""]] diff --git a/doc/bugs/Unnecessary_remote_transfers/comment_1_00c18e07678dc513a02d974fe059df73._comment b/doc/bugs/Unnecessary_remote_transfers/comment_1_00c18e07678dc513a02d974fe059df73._comment new file mode 100644 index 0000000000..7baa584890 --- /dev/null +++ b/doc/bugs/Unnecessary_remote_transfers/comment_1_00c18e07678dc513a02d974fe059df73._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.47" + subject="comment 1" + date="2013-11-02T19:54:44Z" + content=""" +In what order does the webapp list your repositories? + +When a new file appears, it will always go through the list of repositories in order, and try to transfer the file to each in turn, unless the configuration indicates it shouldn't. So, if the remote transfer repo is listed before the local repo, it will first upload the file to the transfer repo, and then upload it to the local repo. (And then later on, remove it from the transfer repo, since the file has reached all clients, probably.) OTOH, if the local repo comes first, it will upload the file to it over the LAN, and then when it comes to the transfer repo, if the file has successfully been sent to all clients, the transfer repo will no longer want it, and so no expensive upload is done over the internet. + +You can re-order the repository list in the webapp by dragging them up and down. It should default to having your locally paired repos first, unless you've changed it. If you think it came up with the wrong order, paste in your .git/config before you re-order the repositories.. +"""]] diff --git a/doc/bugs/Unnecessary_remote_transfers/comment_2_2e9992dbfceabd6df535a2770626de16._comment b/doc/bugs/Unnecessary_remote_transfers/comment_2_2e9992dbfceabd6df535a2770626de16._comment new file mode 100644 index 0000000000..cc0cb067ea --- /dev/null +++ b/doc/bugs/Unnecessary_remote_transfers/comment_2_2e9992dbfceabd6df535a2770626de16._comment @@ -0,0 +1,35 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmNu4V5fvpLlBhaCUfXXOB0MI5NXwh8SkU" + nickname="Adam" + subject="comment 2" + date="2013-11-02T22:48:18Z" + content=""" +The webapp has the remote repo at the bottom of the list. But here's .git/config. It has a high repo cost for the local paired repo, and no cost listed for the remote one: + +[[!format sh \"\"\" +[core] + repositoryformatversion = 0 + filemode = true + bare = false + logallrefupdates = true +[annex] + uuid = 946f9095-588b-4421-b66a-4a1e5632ff6b + version = 3 + direct = true + diskreserve = 1 megabyte + numcopies = 1 + debug = false +[gc] + auto = 0 +[remote \"Onyx\"] + url = ssh://me@git-annex-Onyx.local-me_annex/~/annex/ + annex-uuid = 80709bc2-3cbe-434b-b7b9-306278b9a4e9 + annex-cost = 125.0 + fetch = +refs/heads/*:refs/remotes/Onyx/* +[remote \"Remote\"] + annex-rsyncurl = username@git-annex-example.net-username_annex:annex/ + annex-uuid = 33930bae-63d2-4a52-b330-58872aaeb1bf + fetch = + annex-sync = true +\"\"\"]] +"""]] diff --git a/doc/bugs/Unnecessary_remote_transfers/comment_3_a98f3091a6a658919f0562cf396439c2._comment b/doc/bugs/Unnecessary_remote_transfers/comment_3_a98f3091a6a658919f0562cf396439c2._comment new file mode 100644 index 0000000000..b6900f339d --- /dev/null +++ b/doc/bugs/Unnecessary_remote_transfers/comment_3_a98f3091a6a658919f0562cf396439c2._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmNu4V5fvpLlBhaCUfXXOB0MI5NXwh8SkU" + nickname="Adam" + subject="comment 3" + date="2013-11-02T22:59:18Z" + content=""" +Also, I just realized that it's uploading two large files to my remote transfer repo, even though I already have both files in my local paired repo on both systems; i.e. there's no need to send it to the transfer repo at all. And it was yesterday when the two files were transferred. So I have no idea why today it thinks it needs to upload them to the transfer repo. :/ +"""]] diff --git a/doc/bugs/Unnecessary_remote_transfers/comment_4_417c1e8e27ee1a1f9ebf9160560605c5._comment b/doc/bugs/Unnecessary_remote_transfers/comment_4_417c1e8e27ee1a1f9ebf9160560605c5._comment new file mode 100644 index 0000000000..b0d4c11460 --- /dev/null +++ b/doc/bugs/Unnecessary_remote_transfers/comment_4_417c1e8e27ee1a1f9ebf9160560605c5._comment @@ -0,0 +1,96 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmNu4V5fvpLlBhaCUfXXOB0MI5NXwh8SkU" + nickname="Adam" + subject="Super confused" + date="2013-11-02T23:30:41Z" + content=""" +I think now I'm double- or triple-confused. Here is me@desktop:~/annex/.git/config: + +[[!format sh \"\"\" +[core] + repositoryformatversion = 0 + filemode = true + bare = false + logallrefupdates = true +[annex] + uuid = 80709bc2-3cbe-434b-b7b9-306278b9a4e9 + version = 3 + direct = true + fscknudge = true +[gc] + auto = 0 +[remote \"laptop\"] + url = ssh://me@git-annex-laptop-me_annex/~/annex/ + annex-uuid = 946f9095-588b-4421-b66a-4a1e5632ff6b + annex-cost = 175.0 + fetch = +refs/heads/*:refs/remotes/laptop/* +[remote \"Remote\"] + annex-rsyncurl = username@example.net:annex/ + annex-uuid = 33930bae-63d2-4a52-b330-58872aaeb1bf + fetch = + annex-sync = false +[remote \"backupOndesktop\"] + url = /mnt/debian/home/me/annex-backup + annex-uuid = 86535965-6ca7-4bf3-89af-bca3a07f96f9 + fetch = +refs/heads/*:refs/remotes/backupOndesktop/* +\"\"\"]] + +What I have set up (or intended to set up) is: + +* Client: me@laptop:~/annex +* Client: me@desktop:~/annex +* Transfer: username@example.net:~/annex +* Full Backup: me@desktop:/mnt/debian/home/me/annex-backup + +What I expected was that: + +1. The two Client repos would sync directly over the LAN whenever possible. +2. The transfer repo would be used only to sync the laptop and desktop, and then only if my laptop were not on the LAN with my desktop. +3. The Full Backup repo would be synced directly with the me@desktop Client repo, within the same system, from one hard disk to the other. + +But what I'm seeing is...not quite that. + +1. It's very confusing (to me, at least) that on my desktop system I can look at my annex setup from the \"perspective\" of both local repos. When I \"switch\" to the other repo, the setup looks different: even the same repos can have different names and descriptions, and can be enabled and disabled independently depending on the \"perspective\"...but their Type is still the same. + +2. Looking from the \"perspective\" of the Full Backup repo, I'm seeing files being transferred to the Transfer repo, even though those files are already present in both Client repos, and even though the webapp says that the Full Backup repo has been synced. When I disable and reenable the Transfer repo, it starts those transfers over again, even though they aren't necessary. For example, here is the log from disabling and reenabling the Transfer repo from the \"perspective\" of the Full Backup repo: + +[[!format sh \"\"\" +[2013-11-02 18:24:35 CDT] main: Syncing with example.net_annex +(gpg) +gpg: Terminated caught ... exiting +[2013-11-02 18:24:49 CDT] call: git [\"--git-dir=/mnt/debian/home/me/annex-backup/.git\",\"--work-tree=/mnt/debian/home/me/annex-backup\",\"config\",\"remote.example.net_annex.annex-sync\",\"true\"] +[2013-11-02 18:24:49 CDT] read: git [\"config\",\"--null\",\"--list\"] +[2013-11-02 18:24:49 CDT] read: git [\"config\",\"--null\",\"--list\"] +[2013-11-02 18:24:49 CDT] read: git [\"config\",\"--null\",\"--list\"] +[2013-11-02 18:24:49 CDT] main: Syncing with example.net_annex +[2013-11-02 18:24:49 CDT] read: git [\"--git-dir=/mnt/debian/home/me/annex-backup/.git\",\"--work-tree=/mnt/debian/home/me/annex-backup\",\"symbolic-ref\",\"HEAD\"] +[2013-11-02 18:24:49 CDT] read: git [\"--git-dir=/mnt/debian/home/me/annex-backup/.git\",\"--work-tree=/mnt/debian/home/me/annex-backup\",\"show-ref\",\"refs/heads/master\"] +[2013-11-02 18:24:49 CDT] read: git [\"--git-dir=/mnt/debian/home/me/annex-backup/.git\",\"--work-tree=/mnt/debian/home/me/annex-backup\",\"show-ref\",\"git-annex\"] +[2013-11-02 18:24:49 CDT] read: git [\"--git-dir=/mnt/debian/home/me/annex-backup/.git\",\"--work-tree=/mnt/debian/home/me/annex-backup\",\"show-ref\",\"--hash\",\"refs/heads/git-annex\"] +[2013-11-02 18:24:49 CDT] read: git [\"--git-dir=/mnt/debian/home/me/annex-backup/.git\",\"--work-tree=/mnt/debian/home/me/annex-backup\",\"log\",\"refs/heads/git-annex..2c42d607c099b6ec4a20603b809f44d161e42489\",\"--oneline\",\"-n1\"] +[2013-11-02 18:24:49 CDT] read: git [\"--git-dir=/mnt/debian/home/me/annex-backup/.git\",\"--work-tree=/mnt/debian/home/me/annex-backup\",\"symbolic-ref\",\"HEAD\"] +[2013-11-02 18:24:49 CDT] read: git [\"--git-dir=/mnt/debian/home/me/annex-backup/.git\",\"--work-tree=/mnt/debian/home/me/annex-backup\",\"show-ref\",\"refs/heads/master\"] +[2013-11-02 18:24:49 CDT] TransferScanner: starting scan of [Remote { name =\"example.net_annex\" }] +[2013-11-02 18:24:49 CDT] read: git [\"--git-dir=/mnt/debian/home/me/annex-backup/.git\",\"--work-tree=/mnt/debian/home/me/annex-backup\",\"ls-files\",\"--cached\",\"-z\",\"--\"] +[2013-11-02 18:24:49 CDT] TransferScanner: queued Upload UUID \"33930bae-63d2-4a52-b330-58872aaeb1bf\" video.flv Nothing : expensive scan found missing object +[2013-11-02 18:24:49 CDT] Transferrer: Transferring: Upload UUID \"33930bae-63d2-4a52-b330-58872aaeb1bf\" video.flv Nothing +[2013-11-02 18:24:49 CDT] TransferScanner: queued Upload UUID \"33930bae-63d2-4a52-b330-58872aaeb1bf\" image.jpg Nothing : expensive scan found missing object +[2013-11-02 18:24:49 CDT] call: /home/me/.bin/git-annex.linux/git-annex [\"transferkeys\",\"--readfd\",\"35\",\"--writefd\",\"34\"] +[2013-11-02 18:24:49 CDT] TransferScanner: queued Upload UUID \"33930bae-63d2-4a52-b330-58872aaeb1bf\" linux-image-3.8.0-29-generic_3.8.0-29.42_i386.deb Nothing : expensive scan found missing object +[2013-11-02 18:24:49 CDT] TransferScanner: finished scan of [Remote { name =\"example.net_annex\" }] +[2013-11-02 18:24:49 CDT] read: git [\"--git-dir=/mnt/debian/home/me/annex-backup/.git\",\"--work-tree=/mnt/debian/home/me/annex-backup\",\"show-ref\",\"git-annex\"] +[2013-11-02 18:24:49 CDT] read: git [\"--git-dir=/mnt/debian/home/me/annex-backup/.git\",\"--work-tree=/mnt/debian/home/me/annex-backup\",\"show-ref\",\"--hash\",\"refs/heads/git-annex\"] +[2013-11-02 18:24:49 CDT] read: git [\"--git-dir=/mnt/debian/home/me/annex-backup/.git\",\"--work-tree=/mnt/debian/home/me/annex-backup\",\"log\",\"refs/heads/git-annex..2c42d607c099b6ec4a20603b809f44d161e42489\",\"--oneline\",\"-n1\"] +[2013-11-02 18:24:49 CDT] chat: git [\"--git-dir=/mnt/debian/home/me/annex-backup/.git\",\"--work-tree=/mnt/debian/home/me/annex-backup\",\"cat-file\",\"--batch\"] +[2013-11-02 18:24:49 CDT] read: git [\"config\",\"--null\",\"--list\"] +[2013-11-02 18:24:49 CDT] TransferWatcher: transfer starting: Upload UUID \"33930bae-63d2-4a52-b330-58872aaeb1bf\" video.flv Nothing +(gpg) [2013-11-02 18:24:49 CDT] chat: gpg [\"--batch\",\"--no-tty\",\"--use-agent\",\"--quiet\",\"--trust-model\",\"always\",\"--batch\",\"--passphrase-fd\",\"20\",\"--symmetric\",\"--force-mdc\",\"--no-textmode\"] +[2013-11-02 18:24:50 CDT] call: git [\"--git-dir=/mnt/debian/home/me/annex-backup/.git\",\"--work-tree=/mnt/debian/home/me/annex-backup\",\"config\",\"remote.example.net_annex.annex-sync\",\"false\"] +[2013-11-02 18:24:50 CDT] read: git [\"config\",\"--null\",\"--list\"] +[2013-11-02 18:24:50 CDT] read: git [\"config\",\"--null\",\"--list\"] +[2013-11-02 18:24:50 CDT] read: git [\"config\",\"--null\",\"--list\"] + +gpg: Terminated caught ... exiting\"\"\"]] + +I have no idea why it's doing that, because all three of those files are already in both Client repos and the Full Backup repo. +"""]] diff --git a/doc/bugs/Unnecessary_remote_transfers/comment_5_eb5a2717a1f0c7bb761d2a7866b23def._comment b/doc/bugs/Unnecessary_remote_transfers/comment_5_eb5a2717a1f0c7bb761d2a7866b23def._comment new file mode 100644 index 0000000000..0e2ec4ec80 --- /dev/null +++ b/doc/bugs/Unnecessary_remote_transfers/comment_5_eb5a2717a1f0c7bb761d2a7866b23def._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmNu4V5fvpLlBhaCUfXXOB0MI5NXwh8SkU" + nickname="Adam" + subject="Deleting repos from different perspectives" + date="2013-11-02T23:33:48Z" + content=""" +One other thing, sorry, but I think this is important: From the perspective of the Full Backup repo, I set the Transfer repo to be deleted, thinking that would prevent the desktop's Client and Full Backup repos from syncing through the Transfer repo. But then when I switch to the perspective of the desktop's Client repo, it is \"cleaning out\" the Transfer repo--but I wanted the Transfer repo to be used for syncing the two Client repos! So I set it back to Transfer instead of Unwanted...but then when I switch back to the Full Backup perspective, the Transfer repo is no longer Unwanted. +"""]] diff --git a/doc/bugs/Unnecessary_remote_transfers/comment_6_89f756db1f3f2e60a3bd1f35f55fee43._comment b/doc/bugs/Unnecessary_remote_transfers/comment_6_89f756db1f3f2e60a3bd1f35f55fee43._comment new file mode 100644 index 0000000000..509cc3f3f2 --- /dev/null +++ b/doc/bugs/Unnecessary_remote_transfers/comment_6_89f756db1f3f2e60a3bd1f35f55fee43._comment @@ -0,0 +1,40 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmNu4V5fvpLlBhaCUfXXOB0MI5NXwh8SkU" + nickname="Adam" + subject="config from backup repo" + date="2013-11-03T00:20:11Z" + content=""" +Sorry for posting over and over again, just trying to provide info when I discover it. + +Here's **/mnt/debian/home/me/annex-backup/.git/config** + +[[!format sh \"\"\" +[core] + repositoryformatversion = 0 + filemode = true + bare = false + logallrefupdates = true +[annex] + uuid = 86535965-6ca7-4bf3-89af-bca3a07f96f9 + version = 3 + direct = true + fscknudge = true + diskreserve = 100 megabyte + numcopies = 1 + debug = false +[gc] + auto = 0 +[remote \"desktop\"] + url = /home/me/annex + fetch = +refs/heads/*:refs/remotes/desktop/* + annex-uuid = 80709bc2-3cbe-434b-b7b9-306278b9a4e9 +[remote \"Remote\"] + annex-rsyncurl = username@example.net:annex/ + annex-uuid = 33930bae-63d2-4a52-b330-58872aaeb1bf + annex-sync = false + fetch =\"\"\"]] + +1. Should I remove the \"Remote\" Transfer repo from this config file to prevent it from using the Transfer repo? I only want this repo to sync directly with the other internal hard disk. + +2. Is it correct for git-annex to add this Transfer repo to this config file in the first place? +"""]] diff --git a/doc/bugs/Unnecessary_remote_transfers/comment_7_5aaf8766a7ba05c4f92715e5d5175a8f._comment b/doc/bugs/Unnecessary_remote_transfers/comment_7_5aaf8766a7ba05c4f92715e5d5175a8f._comment new file mode 100644 index 0000000000..f117f15c11 --- /dev/null +++ b/doc/bugs/Unnecessary_remote_transfers/comment_7_5aaf8766a7ba05c4f92715e5d5175a8f._comment @@ -0,0 +1,13 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.47" + subject="comment 7" + date="2013-11-03T00:45:09Z" + content=""" +* The costs you show look fine. +* Yes, deleting a repository in the webapp actually deletes it. It doesn't just remove the remote from .git/config. Most people using the webapp don't want to draw such a fine distinction, I think. +* It's not a very usual configuration to have 2 repositories on the same machine with the git-annex assistant running in both. You might just want to configure the assistant to not run in the backup repository. + +Some of the things you've said suggest that the backup repository might not be immediately noticing when changes are pushed to it. Since its location is shown as /mnt/debian/home/me, I have to wonder if that's some NFS mount or other network filesystem causing problems. + +"""]] diff --git a/doc/bugs/Unnecessary_remote_transfers/comment_8_e856b350632cc865d16d1995a6cdf065._comment b/doc/bugs/Unnecessary_remote_transfers/comment_8_e856b350632cc865d16d1995a6cdf065._comment new file mode 100644 index 0000000000..1177205e3c --- /dev/null +++ b/doc/bugs/Unnecessary_remote_transfers/comment_8_e856b350632cc865d16d1995a6cdf065._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmNu4V5fvpLlBhaCUfXXOB0MI5NXwh8SkU" + nickname="Adam" + subject="comment 8" + date="2013-11-03T01:07:31Z" + content=""" +> It's not a very usual configuration to have 2 repositories on the same machine with the git-annex assistant running in both. You might just want to configure the assistant to not run in the backup repository. + +Maybe that's the crux of the problem. But I'm not sure what I did wrong to make that happen. I have a second internal hard disk in my desktop system, and I wanted to put a Full Backup repo on it. I tried to add a \"Removable drive\" repo (since I sometimes unplug it to swap cables with a DVD drive), but since the assistant didn't detect any actual removable drives, that didn't work. So I used \"Add another repository\" and set it to a Full Backup repo. Is that the wrong way to do it? :) + +> Some of the things you've said suggest that the backup repository might not be immediately noticing when changes are pushed to it. Since its location is shown as /mnt/debian/home/me, I have to wonder if that's some NFS mount or other network filesystem causing problems. + +/mnt/debian is /dev/mapper/lvm-root, another internal disk. The disk is working fine. :) +"""]] diff --git a/doc/bugs/Unnecessary_remote_transfers/comment_9_64f831545b34b78452952cf49b5f5b05._comment b/doc/bugs/Unnecessary_remote_transfers/comment_9_64f831545b34b78452952cf49b5f5b05._comment new file mode 100644 index 0000000000..03127c4adf --- /dev/null +++ b/doc/bugs/Unnecessary_remote_transfers/comment_9_64f831545b34b78452952cf49b5f5b05._comment @@ -0,0 +1,25 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.47" + subject="comment 9" + date="2013-11-03T01:52:56Z" + content=""" +Ok, since we don't have NFS craziness, I'm going to put theories about it not noticing incoming syncs on hold. (I think I probably misunderstood [this comment](http://git-annex.branchable.com/bugs/Unnecessary_remote_transfers/#comment-39490c318620c141e7557b7bcba0e5c8) and anyway the assistant has some throttling so won't always immediately load config changes that have been synced to it if some other config changes were loaded a minute before.) + +I think this behavior can probably be explained without resorting to any bugs, now that I have, I think, a full picture of the repository network: + +
+laptop <-> desktop <-> backup
+    |         |       |
+    v         v       v
+      transfer (cloud)
+
+ +Now when a file is added to desktop, it immediately copies it to backup, which is on the same machine, so that happens quite quickly. Then it starts sending it across the LAN to laptop. + +Meanwhile, the assistant daemon running on backup wakes up, notices it's just received an object, and sees that this object is currently located on only desktop and backup, but not yet on laptop or transfer. Which means that it should send the object to transfer, from which it will eventually reach laptop. + +The only ways I can think of to avoid such an unnecessary transfer would be a) for desktop could somehow tell backup that it's in the process of sending the file to laptop or b) for a map of current state of the network to be constructed and maintained and analyzed automatically, so it it could conclude backup does not need to send files to transfer if they're already present on desktop. There is some discussion about this in [[design/assistant/syncing]]. Hard problem in general I think, although slightly less hard in this specific case since desktop and backup know they're in the same machine. + +But it should be easy to configure it so this doesn't happen. Just make backup not have the transfer repository configured as a remote (or just pause it syncing to there in the webapp). Or, don't run the assistant at all on backup (see `~/.config/git-annex/autostart`). +"""]] diff --git a/doc/bugs/Watcher_crashed_in_Android_on___47__storage__47__sdcard1_-_bug__63__/comment_3_1a7542249b9c37507126e97441057c12._comment b/doc/bugs/Watcher_crashed_in_Android_on___47__storage__47__sdcard1_-_bug__63__/comment_3_1a7542249b9c37507126e97441057c12._comment new file mode 100644 index 0000000000..9bc0c90e64 --- /dev/null +++ b/doc/bugs/Watcher_crashed_in_Android_on___47__storage__47__sdcard1_-_bug__63__/comment_3_1a7542249b9c37507126e97441057c12._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.246" + subject="comment 3" + date="2013-11-10T18:18:09Z" + content=""" +Seems to me this was probably fixed in [[!commit 6b37fcffd872b62fb78047a77e4cee5ab0bb57f1]]. + +However, I don't know why permission problems would happen on Android, which typically uses a filesystem that does not have restricted permissions for the sdcard. + +If you upgrade, you should be able to see if it fixed the crash, and it will also mention any file or directory that it's unable to read in the log. +"""]] diff --git a/doc/bugs/With_S3__44___GPG_ask_for_a_new_passphrase/comment_2_e5d42b623017acedf6a3890ce15680a3._comment b/doc/bugs/With_S3__44___GPG_ask_for_a_new_passphrase/comment_2_e5d42b623017acedf6a3890ce15680a3._comment index d742bbe58d..7b26ca7388 100644 --- a/doc/bugs/With_S3__44___GPG_ask_for_a_new_passphrase/comment_2_e5d42b623017acedf6a3890ce15680a3._comment +++ b/doc/bugs/With_S3__44___GPG_ask_for_a_new_passphrase/comment_2_e5d42b623017acedf6a3890ce15680a3._comment @@ -4,7 +4,7 @@ subject="comment 2" date="2013-01-16T02:17:26Z" content=""" -Someone else reported what sounds like the same bug at [[encryption_given_a_gpg_keyid_still_uses_symmetric_encryption]]. It sounds like this is somehow an agent bug. I cannot reproduce it. I can hypothesise that, if this bug is occurring, you'll be prompted for a passphrase when running this command.. which if it happens would certianly be a bug in gpg or its agent +Someone else reported what sounds like the same bug at [[encryption_given_a_gpg_keyid_still_uses_symmetric_encryption]]. It sounds like this is somehow an agent bug. I cannot reproduce it. I can hypothesise that, if this bug is occurring, you'll be prompted for a passphrase when running this command.. which if it happens would certainly be a bug in gpg or its agent touch foo; echo foo| gpg --symmetric --passphrase-fd=0 foo diff --git a/doc/bugs/Zombie_processes_and__47__or_stuck_git_processes.mdwn b/doc/bugs/Zombie_processes_and__47__or_stuck_git_processes.mdwn new file mode 100644 index 0000000000..e7ff537238 --- /dev/null +++ b/doc/bugs/Zombie_processes_and__47__or_stuck_git_processes.mdwn @@ -0,0 +1,44 @@ +### Please describe the problem. +git-annex assistant is currently running. Here is the output of **ps -A u | grep -i git**: + +[[!format sh """ +5457 pts/2 Z+ 0:00 [git-annex] +5510 ? Sl 0:05 git-annex assistant +5522 ? S 0:00 git --git-dir=/home/me/annex/.git --work-tree=/home/me/annex cat-file --batch +5573 ? S 0:00 git --git-dir=/home/me/annex/.git --work-tree=/home/me/annex cat-file --batch +5679 ? SN 0:00 git --git-dir=/home/me/annex/.git --work-tree=/home/me/annex check-attr -z --stdin annex.backend annex.numcopies -- +5680 ? Z 0:03 [git-annex] +5710 ? Z 0:00 [git-annex] +5732 pts/2 Z+ 0:00 [git-annex] +5752 pts/2 Z+ 0:00 [git-annex] +5785 ? Ss 0:00 ssh: .git/annex/ssh/example.net [mux] +5905 ? Z 0:00 [git-annex] +5923 ? Z 0:00 [git-annex] +6513 pts/2 Z+ 0:00 [git-annex] +6552 ? Z 0:00 [git-annex] +7797 ? Z 0:00 [git-annex] +7873 pts/2 Z 0:00 [git-annex] +8708 pts/2 Z+ 0:00 [git-annex] +9821 ? Z 0:00 [git-annex] +9841 pts/2 Z+ 0:00 [git-annex] +10462 ? Z 0:00 [git-annex] +10522 pts/2 Z 0:00 [git-annex] +12777 pts/2 Z+ 0:00 [git-annex] +13878 pts/2 Z+ 0:00 [git-annex] +14254 ? Z 0:00 [git-annex] +14276 pts/2 Z+ 0:00 [git-annex] +15932 ? Sl 0:00 git-annex transferkeys --readfd 37 --writefd 20 +16022 pts/2 Sl 0:00 git-annex transferkeys --readfd 28 --writefd 22 +16079 pts/2 S 0:00 git --git-dir=/mnt/debian/home/me/annex-backup/.git --work-tree=/mnt/debian/home/me/annex-backup cat-file --batch +16081 ? S 0:00 git --git-dir=/home/me/annex/.git --work-tree=/home/me/annex cat-file --batch +31565 pts/2 Sl+ 0:20 git-annex webapp +31580 pts/2 S+ 0:00 git --git-dir=/mnt/debian/home/me/annex-backup/.git --work-tree=/mnt/debian/home/me/annex-backup cat-file --batch +31590 pts/2 S+ 0:00 git --git-dir=/mnt/debian/home/me/annex-backup/.git --work-tree=/mnt/debian/home/me/annex-backup cat-file --batch +31618 pts/2 S+ 0:00 git --git-dir=/mnt/debian/home/me/annex-backup/.git --work-tree=/mnt/debian/home/me/annex-backup cat-file --batch +31635 ? Sl 9:26 /usr/lib/firefox/firefox /mnt/debian/home/me/annex-backup/.git/annex/webapp.html +31689 pts/2 SN+ 0:00 git --git-dir=/mnt/debian/home/me/annex-backup/.git --work-tree=/mnt/debian/home/me/annex-backup check-attr -z --stdin annex.backend annex.numcopies -- +31812 pts/2 Z 0:00 [git-annex] +31835 ? Ss 0:02 ssh: .git/annex/ssh/example.net [mux] +"""]] + +> [[fixed|done]] --[[Joey]] diff --git a/doc/bugs/Zombie_processes_and__47__or_stuck_git_processes/comment_1_0f8b248025722309e9577d7dad74b76b._comment b/doc/bugs/Zombie_processes_and__47__or_stuck_git_processes/comment_1_0f8b248025722309e9577d7dad74b76b._comment new file mode 100644 index 0000000000..578fecb58e --- /dev/null +++ b/doc/bugs/Zombie_processes_and__47__or_stuck_git_processes/comment_1_0f8b248025722309e9577d7dad74b76b._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.47" + subject="comment 1" + date="2013-11-03T01:12:25Z" + content=""" +This is apparently the same repository where [[all_this_went_on|bugs/Unnecessary_remote_transfers]]. + +I don't know if this is indicative of a problem. I see more zombies than I would normally expect, but I don't know if the number is growing, or shrinking, or staying the same. You should at least look at ps -f to see which of the multiple git-annex assistant daemons you have configured to run on this machine (not a usual configuration) is the parent of the zombies. +"""]] diff --git a/doc/bugs/Zombie_processes_and__47__or_stuck_git_processes/comment_2_f5f7db688a2a93ee7453674fb742043b._comment b/doc/bugs/Zombie_processes_and__47__or_stuck_git_processes/comment_2_f5f7db688a2a93ee7453674fb742043b._comment new file mode 100644 index 0000000000..ceb05ea0c5 --- /dev/null +++ b/doc/bugs/Zombie_processes_and__47__or_stuck_git_processes/comment_2_f5f7db688a2a93ee7453674fb742043b._comment @@ -0,0 +1,52 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmNu4V5fvpLlBhaCUfXXOB0MI5NXwh8SkU" + nickname="Adam" + subject="comment 2" + date="2013-11-03T01:19:42Z" + content=""" +Indeed. I've been looking forward to setting up git-annex assistant for a long time, waiting until I had more free time, and was finally pushed to do it when I had a weird problem with Dropbox. I'm not sure what I did wrong to make such a mess, haha. + +I see \"5510 git-annex assistant\" and \"31565 git-annex webapp\"--does the \"webapp\" one count as an assistant process too? +[[!format sh \"\"\"$ ps -ef | gi git +UID PID PPID C STIME TTY TIME CMD +me 3404 31565 0 17:44 pts/2 00:00:04 [git-annex] +me 5457 31565 0 17:59 pts/2 00:00:00 [git-annex] +me 5510 1 0 17:59 ? 00:00:06 git-annex assistant +me 5522 5510 0 17:59 ? 00:00:00 git --git-dir=/home/me/annex/.git --work-tree=/home/me/annex cat-file --batch +me 5573 5510 0 17:59 ? 00:00:00 git --git-dir=/home/me/annex/.git --work-tree=/home/me/annex cat-file --batch +me 5679 5510 0 17:59 ? 00:00:00 git --git-dir=/home/me/annex/.git --work-tree=/home/me/annex check-attr -z --stdin annex.backend annex.numcopies -- +me 5680 5510 0 17:59 ? 00:00:03 [git-annex] +me 5710 5510 0 18:00 ? 00:00:00 [git-annex] +me 5732 31565 0 18:00 pts/2 00:00:00 [git-annex] +me 5752 31565 0 18:00 pts/2 00:00:00 [git-annex] +me 5785 1 0 18:01 ? 00:00:00 ssh: .git/annex/ssh/example.net [mux] +me 5905 5510 0 18:02 ? 00:00:00 [git-annex] +me 5923 5510 0 18:02 ? 00:00:00 [git-annex] +me 6513 31565 0 18:05 pts/2 00:00:00 [git-annex] +me 6552 5510 0 18:06 ? 00:00:00 [git-annex] +me 7797 5510 0 18:09 ? 00:00:00 [git-annex] +me 7873 31565 0 18:09 pts/2 00:00:00 [git-annex] +me 8708 31565 0 18:10 pts/2 00:00:00 [git-annex] +me 9821 5510 0 18:12 ? 00:00:00 [git-annex] +me 9841 31565 0 18:14 pts/2 00:00:00 [git-annex] +me 10462 5510 0 18:23 ? 00:00:00 [git-annex] +me 10522 31565 0 18:24 pts/2 00:00:00 [git-annex] +me 12777 31565 0 18:34 pts/2 00:00:00 [git-annex] +me 13878 31565 0 18:35 pts/2 00:00:00 [git-annex] +me 14254 5510 0 18:36 ? 00:00:00 [git-annex] +me 14276 31565 0 18:36 pts/2 00:00:00 [git-annex] +me 15932 5510 0 18:55 ? 00:00:00 git-annex transferkeys --readfd 37 --writefd 20 +me 16022 31565 0 18:55 pts/2 00:00:00 git-annex transferkeys --readfd 28 --writefd 22 +me 16079 16022 0 18:55 pts/2 00:00:00 git --git-dir=/mnt/debian/home/me/annex-backup/.git --work-tree=/mnt/debian/home/me/annex-backup cat-file --batch +me 16081 15932 0 18:55 ? 00:00:00 git --git-dir=/home/me/annex/.git --work-tree=/home/me/annex cat-file --batch +me 25136 25135 0 20:15 pts/6 00:00:00 grep -i git +me 31565 31478 0 17:42 pts/2 00:00:21 git-annex webapp +me 31580 31565 0 17:42 pts/2 00:00:00 git --git-dir=/mnt/debian/home/me/annex-backup/.git --work-tree=/mnt/debian/home/me/annex-backup cat-file --batch +me 31590 31565 0 17:42 pts/2 00:00:00 git --git-dir=/mnt/debian/home/me/annex-backup/.git --work-tree=/mnt/debian/home/me/annex-backup cat-file --batch +me 31618 31565 0 17:42 pts/2 00:00:00 git --git-dir=/mnt/debian/home/me/annex-backup/.git --work-tree=/mnt/debian/home/me/annex-backup cat-file --batch +me 31635 27578 8 17:42 ? 00:13:42 /usr/lib/firefox/firefox /mnt/debian/home/me/annex-backup/.git/annex/webapp.html +me 31689 31565 0 17:42 pts/2 00:00:00 git --git-dir=/mnt/debian/home/me/annex-backup/.git --work-tree=/mnt/debian/home/me/annex-backup check-attr -z --stdin annex.backend annex.numcopies -- +me 31812 31565 0 17:42 pts/2 00:00:00 [git-annex] +me 31835 1 0 17:42 ? 00:00:02 ssh: .git/annex/ssh/example.net [mux]\"\"\"]] + +"""]] diff --git a/doc/bugs/Zombie_processes_and__47__or_stuck_git_processes/comment_3_ffcae976aa3dc2426188797c1aaffb82._comment b/doc/bugs/Zombie_processes_and__47__or_stuck_git_processes/comment_3_ffcae976aa3dc2426188797c1aaffb82._comment new file mode 100644 index 0000000000..78e816f06e --- /dev/null +++ b/doc/bugs/Zombie_processes_and__47__or_stuck_git_processes/comment_3_ffcae976aa3dc2426188797c1aaffb82._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.47" + subject="comment 3" + date="2013-11-03T01:31:26Z" + content=""" +`ps fax` is much easier to read + +Yes, the assistant can be started by either `git annex assistant` or, if it's not already running, `git annex webapp` +"""]] diff --git a/doc/bugs/Zombie_processes_and__47__or_stuck_git_processes/comment_4_8a7ff6841ad7c27ead06bf12f46b20a0._comment b/doc/bugs/Zombie_processes_and__47__or_stuck_git_processes/comment_4_8a7ff6841ad7c27ead06bf12f46b20a0._comment new file mode 100644 index 0000000000..2bf32bd373 --- /dev/null +++ b/doc/bugs/Zombie_processes_and__47__or_stuck_git_processes/comment_4_8a7ff6841ad7c27ead06bf12f46b20a0._comment @@ -0,0 +1,49 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmNu4V5fvpLlBhaCUfXXOB0MI5NXwh8SkU" + nickname="Adam" + subject="comment 4" + date="2013-11-03T01:35:32Z" + content=""" +Ah, thank you. I get lost in ps's man page. :) + +[[!format sh \"\"\" +31635 ? Rl 16:16 \_ /usr/lib/firefox/firefox /mnt/debian/home/me/annex-backup/.git/annex/webapp.html +31565 pts/2 Sl+ 0:21 | \_ git-annex webapp +31580 pts/2 S+ 0:00 | \_ git --git-dir=/mnt/debian/home/me/annex-backup/.git --work-tree=/mnt/debian/home/me/annex-backup cat-file --batch +31590 pts/2 S+ 0:00 | \_ git --git-dir=/mnt/debian/home/me/annex-backup/.git --work-tree=/mnt/debian/home/me/annex-backup cat-file --batch +31618 pts/2 S+ 0:00 | \_ git --git-dir=/mnt/debian/home/me/annex-backup/.git --work-tree=/mnt/debian/home/me/annex-backup cat-file --batch +31689 pts/2 SN+ 0:00 | \_ git --git-dir=/mnt/debian/home/me/annex-backup/.git --work-tree=/mnt/debian/home/me/annex-backup check-attr -z --stdin annex.backend annex.numcopies -- +31812 pts/2 Z 0:00 | \_ [git-annex] + 3404 pts/2 Z 0:04 | \_ [git-annex] + 5457 pts/2 Z+ 0:00 | \_ [git-annex] + 5732 pts/2 Z+ 0:00 | \_ [git-annex] + 5752 pts/2 Z+ 0:00 | \_ [git-annex] + 6513 pts/2 Z+ 0:00 | \_ [git-annex] + 7873 pts/2 Z 0:00 | \_ [git-annex] + 8708 pts/2 Z+ 0:00 | \_ [git-annex] + 9841 pts/2 Z+ 0:00 | \_ [git-annex] +10522 pts/2 Z 0:00 | \_ [git-annex] +12777 pts/2 Z+ 0:00 | \_ [git-annex] +13878 pts/2 Z+ 0:00 | \_ [git-annex] +14276 pts/2 Z+ 0:00 | \_ [git-annex] +16022 pts/2 Sl 0:00 | \_ git-annex transferkeys --readfd 28 --writefd 22 +16079 pts/2 S 0:00 | \_ git --git-dir=/mnt/debian/home/me/annex-backup/.git --work-tree=/mnt/debian/home/me/annex-backup cat-file --batch +26828 pts/6 S+ 0:00 | \_ grep -i git +31835 ? Ss 0:02 ssh: .git/annex/ssh/example.net [mux] + 5510 ? Sl 0:06 git-annex assistant + 5522 ? S 0:00 \_ git --git-dir=/home/me/annex/.git --work-tree=/home/me/annex cat-file --batch + 5573 ? S 0:00 \_ git --git-dir=/home/me/annex/.git --work-tree=/home/me/annex cat-file --batch + 5679 ? SN 0:00 \_ git --git-dir=/home/me/annex/.git --work-tree=/home/me/annex check-attr -z --stdin annex.backend annex.numcopies -- + 5680 ? Z 0:03 \_ [git-annex] + 5710 ? Z 0:00 \_ [git-annex] + 5905 ? Z 0:00 \_ [git-annex] + 5923 ? Z 0:00 \_ [git-annex] + 6552 ? Z 0:00 \_ [git-annex] + 7797 ? Z 0:00 \_ [git-annex] + 9821 ? Z 0:00 \_ [git-annex] +10462 ? Z 0:00 \_ [git-annex] +14254 ? Z 0:00 \_ [git-annex] +15932 ? Sl 0:00 \_ git-annex transferkeys --readfd 37 --writefd 20 +16081 ? S 0:00 \_ git --git-dir=/home/me/annex/.git --work-tree=/home/me/annex cat-file --batch + 5785 ? Ss 0:00 ssh: .git/annex/ssh/example.net [mux] \"\"\"]] +"""]] diff --git a/doc/bugs/Zombie_processes_and__47__or_stuck_git_processes/comment_5_406fdee0728680774a69d28446163f10._comment b/doc/bugs/Zombie_processes_and__47__or_stuck_git_processes/comment_5_406fdee0728680774a69d28446163f10._comment new file mode 100644 index 0000000000..f8f223524e --- /dev/null +++ b/doc/bugs/Zombie_processes_and__47__or_stuck_git_processes/comment_5_406fdee0728680774a69d28446163f10._comment @@ -0,0 +1,26 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.47" + subject="comment 5" + date="2013-11-03T02:33:14Z" + content=""" +I believe that these zombies were all caused by switching between repository views in the webapp. I was able to reproduce 1 zombie per switch between repos. + +There are a few other places where git-annex execs itself, but not many, and most of them are often used and it would be noticed if they were crypts from which pour forth the living dead. (Oddly the TV show I was thinking about watching this evening.) + +
+joey@darkstar:~/src/git-annex>git grep readProgramFile
+Assistant/Repair.hs:		program <- readProgramFile
+Assistant/Threads/Cronner.hs:	program <- liftIO $ readProgramFile
+Assistant/Threads/Cronner.hs:			program <- readProgramFile
+Assistant/Threads/Transferrer.hs:	program <- liftIO readProgramFile
+Assistant/TransferSlots.hs:		program <- liftIO readProgramFile
+Assistant/WebApp/Control.hs:		program <- readProgramFile
+Assistant/WebApp/OtherRepos.hs:	program <- readProgramFile
+Assistant/XMPP/Git.hs:		program <- readProgramFile
+Command/Assistant.hs:	program <- readProgramFile
+Config/Files.hs:readProgramFile :: IO FilePath
+Config/Files.hs:readProgramFile = do
+Remote/Git.hs:		program <- readProgramFile
+
+"""]] diff --git a/doc/bugs/__34__Configuring_Jabber_Account__34___fails_with_a___34__Network_unreachable__34___error./comment_3_ed36f503f88611382b50687608b9b7e7._comment b/doc/bugs/__34__Configuring_Jabber_Account__34___fails_with_a___34__Network_unreachable__34___error./comment_3_ed36f503f88611382b50687608b9b7e7._comment new file mode 100644 index 0000000000..a69763af7a --- /dev/null +++ b/doc/bugs/__34__Configuring_Jabber_Account__34___fails_with_a___34__Network_unreachable__34___error./comment_3_ed36f503f88611382b50687608b9b7e7._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="108.236.230.124" + subject="comment 3" + date="2013-11-08T18:42:22Z" + content=""" +Seems like I should fix the standalone linux tarball to either include the host program, or better, build git-annex with the Haskell [DNS library](https://hackage.haskell.org/package/dns). (I think that the Mac app and other builds are built with DNS by default, since they have dependencies installed using cabal directly). + +I need to first get that library included in Debian, so I can install it reliably on my build systems. +"""]] diff --git a/doc/bugs/__91__wishlistAndroid:_bundle_an_ssh_server___40__dropbear__63____41___and_add_an_option_to_start_it_easily_with_the_terminal_app_menu.mdwn b/doc/bugs/__91__wishlistAndroid:_bundle_an_ssh_server___40__dropbear__63____41___and_add_an_option_to_start_it_easily_with_the_terminal_app_menu.mdwn new file mode 100644 index 0000000000..7366e6ff2d --- /dev/null +++ b/doc/bugs/__91__wishlistAndroid:_bundle_an_ssh_server___40__dropbear__63____41___and_add_an_option_to_start_it_easily_with_the_terminal_app_menu.mdwn @@ -0,0 +1,21 @@ +### Please describe the problem. + +quite often is desired to fetch/navigate through the git annex installation under git annex user, e.g. to fetch the log to be provided here for the "additional information". +Given already big size of the app bundling some lightweight ssh server should not be a major size hit, but would ease troubleshooting and bug reporting + +### What steps will reproduce the problem? + + +### What version of git-annex are you using? On what operating system? + +Android from Nov 18 + +### 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/__91__wishlistAndroid:_bundle_an_ssh_server___40__dropbear__63____41___and_add_an_option_to_start_it_easily_with_the_terminal_app_menu/comment_1_9bb53c45d685b368c7ba1758885f2874._comment b/doc/bugs/__91__wishlistAndroid:_bundle_an_ssh_server___40__dropbear__63____41___and_add_an_option_to_start_it_easily_with_the_terminal_app_menu/comment_1_9bb53c45d685b368c7ba1758885f2874._comment new file mode 100644 index 0000000000..36440eac50 --- /dev/null +++ b/doc/bugs/__91__wishlistAndroid:_bundle_an_ssh_server___40__dropbear__63____41___and_add_an_option_to_start_it_easily_with_the_terminal_app_menu/comment_1_9bb53c45d685b368c7ba1758885f2874._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.64" + subject="comment 1" + date="2013-11-26T16:09:19Z" + content=""" +This was previously suggested in the forum: [[forum/Suggestion:_Put_ssh_server_back_into_android_version]] + +As said there, I feel that `adb` is a better option in these situations. Of course, the git-annex bundle already has a ssh client, so you can rsync files from it to other ssh servers too. + +Also, the bundle is too big, I don't want to make it any bigger. +"""]] diff --git a/doc/bugs/__91__wishlistAndroid:_bundle_an_ssh_server___40__dropbear__63____41___and_add_an_option_to_start_it_easily_with_the_terminal_app_menu/comment_2_251311a04f1a610e54ebe8e9b92de72e._comment b/doc/bugs/__91__wishlistAndroid:_bundle_an_ssh_server___40__dropbear__63____41___and_add_an_option_to_start_it_easily_with_the_terminal_app_menu/comment_2_251311a04f1a610e54ebe8e9b92de72e._comment new file mode 100644 index 0000000000..48707e82b3 --- /dev/null +++ b/doc/bugs/__91__wishlistAndroid:_bundle_an_ssh_server___40__dropbear__63____41___and_add_an_option_to_start_it_easily_with_the_terminal_app_menu/comment_2_251311a04f1a610e54ebe8e9b92de72e._comment @@ -0,0 +1,13 @@ +[[!comment format=mdwn + username="http://yarikoptic.myopenid.com/" + nickname="site-myopenid" + subject="comment 2" + date="2013-11-27T04:30:53Z" + content=""" +we just shrinked the bundle by 60MB so there could be some space for sshd. + +adb might indeed be more powerful but would require usb connection (right?) -- at times not convenient + +syncing via ssh from phone: that is what I was trying to avoid -- working in the shell on the phone -- it is possible but a bit \"inconvenient\" +sshd could be ran on any unprivileged port while letting the user who starts it know the IP and the port, thus making it easy to connect. +"""]] diff --git a/doc/bugs/android:_high_CPU_usage__44___unclear_how_to_quit/comment_7_d38d6f40db4c9437764c7b2ddf36b5a9._comment b/doc/bugs/android:_high_CPU_usage__44___unclear_how_to_quit/comment_7_d38d6f40db4c9437764c7b2ddf36b5a9._comment index 66a5601914..819d316721 100644 --- a/doc/bugs/android:_high_CPU_usage__44___unclear_how_to_quit/comment_7_d38d6f40db4c9437764c7b2ddf36b5a9._comment +++ b/doc/bugs/android:_high_CPU_usage__44___unclear_how_to_quit/comment_7_d38d6f40db4c9437764c7b2ddf36b5a9._comment @@ -4,7 +4,7 @@ subject="comment 7" date="2013-08-26T20:00:39Z" content=""" -It's certianly possible that the terminal app eats cpu for some reason even when sitting idle. It's hard for me to tell since I've been measuring cpu use by running top inside that terminal, which necessarily seems to use a lot of the CPU just to draw the screen. +It's certainly possible that the terminal app eats cpu for some reason even when sitting idle. It's hard for me to tell since I've been measuring cpu use by running top inside that terminal, which necessarily seems to use a lot of the CPU just to draw the screen. If it's the terminal at fault, it would continue after you shutdown the git-annex daemon, since that doesn't close the terminal. """]] diff --git a/doc/bugs/assistant_doesn__39__t_sync_empty_directories/comment_5_440f349781d7d9ca2d1ed81386f7dd26._comment b/doc/bugs/assistant_doesn__39__t_sync_empty_directories/comment_5_440f349781d7d9ca2d1ed81386f7dd26._comment new file mode 100644 index 0000000000..0d5f0aa295 --- /dev/null +++ b/doc/bugs/assistant_doesn__39__t_sync_empty_directories/comment_5_440f349781d7d9ca2d1ed81386f7dd26._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmNu4V5fvpLlBhaCUfXXOB0MI5NXwh8SkU" + nickname="Adam" + subject="comment 5" + date="2013-11-01T22:12:04Z" + content=""" +I agree that this is very confusing. Also having to manually delete empty, renamed directories is...less than ideal. :) +"""]] diff --git a/doc/bugs/assistant_doesn__39__t_sync_file_permissions/comment_3_4d5ae51b4c7e6177d934d7c9f21b912c._comment b/doc/bugs/assistant_doesn__39__t_sync_file_permissions/comment_3_4d5ae51b4c7e6177d934d7c9f21b912c._comment new file mode 100644 index 0000000000..6bf1894145 --- /dev/null +++ b/doc/bugs/assistant_doesn__39__t_sync_file_permissions/comment_3_4d5ae51b4c7e6177d934d7c9f21b912c._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmNu4V5fvpLlBhaCUfXXOB0MI5NXwh8SkU" + nickname="Adam" + subject="comment 3" + date="2013-11-02T23:49:49Z" + content=""" +Dropbox handles permissions, e.g. if I \"chmod -x\" a file on one system, it does the same to my other systems. It would be a bit of a step backward if git-annex can't do this. :/ Just my two cents. +"""]] diff --git a/doc/bugs/assistant_ignore_.gitignore/comment_2_22f75af80c779dcb4d6033b90373f74e._comment b/doc/bugs/assistant_ignore_.gitignore/comment_2_22f75af80c779dcb4d6033b90373f74e._comment new file mode 100644 index 0000000000..893be90551 --- /dev/null +++ b/doc/bugs/assistant_ignore_.gitignore/comment_2_22f75af80c779dcb4d6033b90373f74e._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnNqLKszWk9EoD4CDCqNXJRIklKFBCN1Ao" + nickname="maurizio" + subject="git-annex from wheezy-backports should depend on a more recent git version on debian wheezy (7.2) " + date="2013-11-12T18:57:52Z" + content=""" +It is correct that the bug is solved on the git-annex package found on wheezy-backports, but this package does not force an update of git to a more recent version. Therefore the bug still affects wheezy users. The way to solve it is to install git also from wheezy-backports. + + +"""]] diff --git a/doc/bugs/assistant_ignore_.gitignore/comment_3_8b2a400e1d44a1c9b183e2b7861efbe3._comment b/doc/bugs/assistant_ignore_.gitignore/comment_3_8b2a400e1d44a1c9b183e2b7861efbe3._comment new file mode 100644 index 0000000000..e58d460842 --- /dev/null +++ b/doc/bugs/assistant_ignore_.gitignore/comment_3_8b2a400e1d44a1c9b183e2b7861efbe3._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.246" + subject="comment 3" + date="2013-11-12T19:10:48Z" + content=""" +Agreed, I've made the changes so the next update of the backport will do so. +"""]] diff --git a/doc/bugs/data_loss:_incorrect_merge_upon_conflicting_directory-file_of_direct_repos/comment_6_d80c4b631bdf58901a06f29a2c5682e2._comment b/doc/bugs/data_loss:_incorrect_merge_upon_conflicting_directory-file_of_direct_repos/comment_6_d80c4b631bdf58901a06f29a2c5682e2._comment new file mode 100644 index 0000000000..29457da8af --- /dev/null +++ b/doc/bugs/data_loss:_incorrect_merge_upon_conflicting_directory-file_of_direct_repos/comment_6_d80c4b631bdf58901a06f29a2c5682e2._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawlWskoNgUB7r70OXglR-4iKI4bOuPJb-xg" + nickname="Tim" + subject="comment 6" + date="2013-11-14T14:58:10Z" + content=""" +Ah indeed, tried it again and it's indeed fixed. Tried some other things as well, and conflict resolution ended up doing just fine. +"""]] diff --git a/doc/bugs/direct_mode_sync_should_avoid_git_commit.mdwn b/doc/bugs/direct_mode_sync_should_avoid_git_commit.mdwn new file mode 100644 index 0000000000..ed4bb8f470 --- /dev/null +++ b/doc/bugs/direct_mode_sync_should_avoid_git_commit.mdwn @@ -0,0 +1,5 @@ +Per forum post linking to this bug, git commit can be very slow when run in a filesystem without symlink support, and seems to be reading the content of files just in order to show typechanged messages in the status. + +So, git annex sync should stop using git commit when in direct mode, and instead manually make its own commit. Git.Branch.commit and Git.Branch.update should be able to easily be used for this. + +PS: this page was created elsewhere, and therefore not listed in bugs page diff --git a/doc/bugs/get_from_bup-remote_with_pubkey_failing.mdwn b/doc/bugs/get_from_bup-remote_with_pubkey_failing.mdwn new file mode 100644 index 0000000000..5ec1aa9aaa --- /dev/null +++ b/doc/bugs/get_from_bup-remote_with_pubkey_failing.mdwn @@ -0,0 +1,93 @@ +### Please describe the problem. + +I'm unable to 'git annex get' a file from a bup-remote with encryption set to 'pubkey'. + +### What steps will reproduce the problem? + +I added a bup-remote using [these instructions](http://git-annex.branchable.com/walkthrough/using_bup/): + + bash-3.2$ git annex initremote mybup type=bup encryption=pubkey keyid=0xABE8244505D63E81 buprepo=gumdrop:/home/gert/.bup + + # now adding files and moving them: + bash-3.2$ mkdir orgmode && touch orgmode/some.org + bash-3.2$ git annex add orgmode/some.org + add orgmode/some.org (checksum...) ok + (Recording state in git...) + bash-3.2$ git commit + [master bce8c83] Some.org + 1 file changed, 1 insertion(+) + create mode 120000 orgmode/some.org + bash-3.2$ git annex move orgmode/ --to=mybup + move orgmode/another.org (gpg) + U moet een geheime zin opgeven om de geheime sleutel te gebruiken + van: “email” + 4096-bit RSA key, ID 0xFF8DE378DE223820, created 2013-11-10 + (sub-sleutel bij hoofd sleutel ID 0xE9B90528FDA4E1E6) + + (checking mybup...) ok + (Recording state in git...) + bash-3.2$ less orgmode/another.org + orgmode/another.org: No such file or directory + bash-3.2$ git annex get orgmode/another.org --debug + [2013-11-13 16:18:07 CET] read: git ["--git-dir=/Users/gert/annex/.git","--work-tree=/Users/gert/annex","ls-files","--cached","-z","--","orgmode/another.org"] + get orgmode/another.org [2013-11-13 16:18:08 CET] read: git ["--git-dir=/Users/gert/annex/.git","--work-tree=/Users/gert/annex","show-ref","git-annex"] + [2013-11-13 16:18:08 CET] read: git ["--git-dir=/Users/gert/annex/.git","--work-tree=/Users/gert/annex","show-ref","--hash","refs/heads/git-annex"] + [2013-11-13 16:18:08 CET] read: git ["--git-dir=/Users/gert/annex/.git","--work-tree=/Users/gert/annex","log","refs/heads/git-annex..f25f9bb2b78a8b9c4b64087f1378c68fb5c0a2f1","--oneline","-n1"] + [2013-11-13 16:18:08 CET] read: git ["--git-dir=/Users/gert/annex/.git","--work-tree=/Users/gert/annex","log","refs/heads/git-annex..1b0a3dd72be437d800e58d659837d6e528cbbc39","--oneline","-n1"] + [2013-11-13 16:18:08 CET] read: git ["--git-dir=/Users/gert/annex/.git","--work-tree=/Users/gert/annex","log","refs/heads/git-annex..f62419efea58245d232a52ceaf0eaefe3b0fdced","--oneline","-n1"] + [2013-11-13 16:18:08 CET] read: git ["--git-dir=/Users/gert/annex/.git","--work-tree=/Users/gert/annex","log","refs/heads/git-annex..eb6f0cd983d9a3637e984aa815537fe20a5c2a69","--oneline","-n1"] + [2013-11-13 16:18:08 CET] read: git ["--git-dir=/Users/gert/annex/.git","--work-tree=/Users/gert/annex","log","refs/heads/git-annex..5362118e643462a0875bfe31d493ffe64413f2d8","--oneline","-n1"] + [2013-11-13 16:18:08 CET] read: git ["--git-dir=/Users/gert/annex/.git","--work-tree=/Users/gert/annex","log","refs/heads/git-annex..e5afaf82ce25f60a108c0ae873b6fd57c5d28ca7","--oneline","-n1"] + [2013-11-13 16:18:08 CET] chat: git ["--git-dir=/Users/gert/annex/.git","--work-tree=/Users/gert/annex","cat-file","--batch"] + [2013-11-13 16:18:08 CET] read: git ["config","--null","--list"] + (from mybup...) (gpg) [2013-11-13 16:18:08 CET] chat: gpg ["--quiet","--trust-model","always","--decrypt"] + + U moet een geheime zin opgeven om de geheime sleutel te gebruiken + van: “” + 4096-bit RSA key, ID 0xFF8DE378DE223820, created 2013-11-10 + (sub-sleutel bij hoofd sleutel ID 0xE9B90528FDA4E1E6) + + [2013-11-13 16:18:15 CET] read: bup ["join","-r","gumdrop:/home/gert/.bup","GPGHMACSHA1--67aec1b62d05d000442cf8e7d9df8d327eaf26d5"] + [2013-11-13 16:18:15 CET] chat: gpg ["--quiet","--trust-model","always","--batch","--decrypt"] + gpg: kan geheime zin niet opvragen in batch modus + gpg: decoderen mislukt: secret key not available + + Unable to access these remotes: mybup + + Try making some of these repositories available: + 080e97d2-4f82-4292-acb7-a48d82009258 -- mybup (mybupmy bup repository at gumdrop) + + (Note that these git remotes have annex-ignore set: origin) + failed + git-annex: get: 1 failed + +### What version of git-annex are you using? On what operating system? + +Running git-annex version 4.20131105-g136b030 on OSX 10.8.5. + +### Please provide any additional information below. + +My ideas: + +"Unable to access these remotes: mybup" is weird, I just moved files there. + +"secret key not available" makes me think it's looking for the primary secret key (which is indeed offline). +When I encrypt a file with the same key I used to create the remote it just works: + + $ gpg --armor --recipient 0xABE8244505D63E81 --encrypt file.txt + $ gpg --decrypt file.txt.asc + +When prompting for my passphrase it states "4096-bit RSA key, ID 0xFF8DE378DE223820, created 2013-11-10". +That is a different subkey than what I entered when I setting up the remote. + +My keys/subkeys: + + pub 4096R/0xE9B90528FDA4E1E6 aangemaakt: 2013-11-10 vervaldatum: 2014-11-10 gebruik: SC + vertrouwen: ultimate geldigheid: ultimate + sub 4096R/0x98816CFB398B4666 aangemaakt: 2013-11-10 vervaldatum: 2014-11-10 gebruik: E + sub 4096R/0x91951718D5F11CDD aangemaakt: 2013-11-10 vervaldatum: 2014-11-10 gebruik: S + sub 4096R/0xABE8244505D63E81 aangemaakt: 2013-11-10 vervaldatum: 2014-11-10 gebruik: E + sub 4096R/0xB44520A46B27144D aangemaakt: 2013-11-10 vervaldatum: 2014-11-10 gebruik: S + sub 4096R/0xFF8DE378DE223820 aangemaakt: 2013-11-10 vervaldatum: 2014-11-10 gebruik: E + +> This was already fixed in version 4.20131106. [[done]] --[[Joey]] diff --git a/doc/bugs/git-annex-shell:_gcryptsetup_permission_denied.mdwn b/doc/bugs/git-annex-shell:_gcryptsetup_permission_denied.mdwn new file mode 100644 index 0000000000..260ab99810 --- /dev/null +++ b/doc/bugs/git-annex-shell:_gcryptsetup_permission_denied.mdwn @@ -0,0 +1,48 @@ +### Please describe the problem. +I followed the tip on [fully encrypted git repositories with gcrypt](http://git-annex.branchable.com/tips/fully_encrypted_git_repositories_with_gcrypt/) to create encrypted git-annex repository on a ssh server. When I try to checkout the repository, things break as follows: + +`git clone gcrypt::ssh://my.server/home/me/encryptedrepo myrepo` + +works as expected but when in the myrepo directory, + +`git annex enableremote encryptedrepo gitrepo=ssh://my.server/home/me/encryptedrepo` + +issues the following text (among normal messages): + +`git-annex-shell: gcryptsetup permission denied` + +Then while the links are there, + +`git annex get --from encryptedrepo` + +does nothing (in the sense that the content is not retrieved). + +This seems to have everything to do with git-annex-shell as the exact same manipulations but with a local repository work perfectly. Unfortunately, I don't know haskell so [this code](https://github.com/joeyh/git-annex/blob/master/Command/GCryptSetup.hs) is cryptic to me. I can guess there is a problem getting the uuid of the repository, but as far as I can tell the bare distant repo looks fine. + +### What steps will reproduce the problem? + +Create a standard git annex local repository and then follow the [fully encrypted git repositories with gcrypt tip](http://git-annex.branchable.com/tips/fully_encrypted_git_repositories_with_gcrypt/) to create an encrypted git-annex repository on a ssh server. Then follow the instructions in the same tip to clone the remote repository. + +### What version of git-annex are you using? On what operating system? +Both computers run ubuntu 12.04 with all updates and the latest git annex from the ppa, that is: + +git-annex version: 4.20131024 + +build flags: Assistant Webapp Pairing Testsuite 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 glacier hook + + +### 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/git-annex-shell:_gcryptsetup_permission_denied/comment_1_f4584158b35b80ece1060308883e2dc4._comment b/doc/bugs/git-annex-shell:_gcryptsetup_permission_denied/comment_1_f4584158b35b80ece1060308883e2dc4._comment new file mode 100644 index 0000000000..6312a58a53 --- /dev/null +++ b/doc/bugs/git-annex-shell:_gcryptsetup_permission_denied/comment_1_f4584158b35b80ece1060308883e2dc4._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.47" + subject="comment 1" + date="2013-11-02T19:46:28Z" + content=""" +It seems to me that the `git-annex-shell` on the remote system must be too old a version to support the gcryptsetup command. You can check this by running `git-annex-shell` there and seeing if it lists gcryptsetup in its usage message. +"""]] diff --git a/doc/bugs/git-annex-shell:_gcryptsetup_permission_denied/comment_2_a4d7aae848340771a9b8e2c87abeea42._comment b/doc/bugs/git-annex-shell:_gcryptsetup_permission_denied/comment_2_a4d7aae848340771a9b8e2c87abeea42._comment new file mode 100644 index 0000000000..f2fb4f14f1 --- /dev/null +++ b/doc/bugs/git-annex-shell:_gcryptsetup_permission_denied/comment_2_a4d7aae848340771a9b8e2c87abeea42._comment @@ -0,0 +1,26 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkbpbjP5j8MqWt_K4NASwv0WvB8T4rQ-pM" + nickname="Fabrice" + subject="comment 2" + date="2013-11-02T21:53:37Z" + content=""" +The git-annex version on the remote server is the same as the one on the client, the latest one available from the ppa (4.20131024). When I run git-annex-shell on both computers, I obtain: +[[!format sh \"\"\" +git-annex-shell: bad parameters + +Usage: git-annex-shell [-c] command [parameters ...] [option ...] + +Plumbing commands: + +commit DIRECTORY commits any staged changes to the git-annex branch +configlist DIRECTORY outputs relevant git configuration +dropkey DIRECTORY KEY ... drops annexed content for specified keys +gcryptsetup DIRECTORY VALUE sets up gcrypt repository +inannex DIRECTORY KEY ... checks if keys are present in the annex +recvkey DIRECTORY KEY runs rsync in server mode to receive content +sendkey DIRECTORY KEY runs rsync in server mode to send content +transferinfo DIRECTORY KEY updates sender on number of bytes of content received +\"\"\"]] + +Both sides seem to understand the gcryptsetup action. Actually, the message gcryptsetup permission denied comes from git-annex-shell, as far as I understand (and from the haskell source linked in the report). +"""]] diff --git a/doc/bugs/git-annex-shell:_gcryptsetup_permission_denied/comment_3_06bda101ad584b4b882de8b2e202d679._comment b/doc/bugs/git-annex-shell:_gcryptsetup_permission_denied/comment_3_06bda101ad584b4b882de8b2e202d679._comment new file mode 100644 index 0000000000..863f401cef --- /dev/null +++ b/doc/bugs/git-annex-shell:_gcryptsetup_permission_denied/comment_3_06bda101ad584b4b882de8b2e202d679._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.47" + subject="comment 3" + date="2013-11-02T23:51:13Z" + content=""" +I should have looked at that error message more closely. The gcryptsetup command will print a permission denied if the repository it's being run in already has a annex.uuid or already has a gcrypt id. Probably that latter needs to be relaxed for enableremote to work. +"""]] diff --git a/doc/bugs/git-annex-shell:_gcryptsetup_permission_denied/comment_4_4fc6b25401b645cabc04b510bdfa6863._comment b/doc/bugs/git-annex-shell:_gcryptsetup_permission_denied/comment_4_4fc6b25401b645cabc04b510bdfa6863._comment new file mode 100644 index 0000000000..e1049ce605 --- /dev/null +++ b/doc/bugs/git-annex-shell:_gcryptsetup_permission_denied/comment_4_4fc6b25401b645cabc04b510bdfa6863._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.47" + subject="comment 4" + date="2013-11-03T00:15:30Z" + content=""" +While I've fixed this bug, in my testing the bug only caused git-annex to fall back to accessing the remote repository using rsync, rather than using git-annex-shell to talk to it, and so `git annex get --from encryptedrepo` was able to retrieve files that were stored in that remote despite the bug. That may have failed for you for some other reason. + +You can set git.encryptedrepo.annex-gcrypt to to \"true\" to make it use the degraded rsync mode, or to \"shell\" to make it use git-annex-shell. Setting it to shell should be all that you need to do to recover from (or indeed, work around this bug). +"""]] diff --git a/doc/bugs/git-annex-shell:_gcryptsetup_permission_denied/comment_5_4e193306801680bba433e75eb4dcba05._comment b/doc/bugs/git-annex-shell:_gcryptsetup_permission_denied/comment_5_4e193306801680bba433e75eb4dcba05._comment new file mode 100644 index 0000000000..137638aa5c --- /dev/null +++ b/doc/bugs/git-annex-shell:_gcryptsetup_permission_denied/comment_5_4e193306801680bba433e75eb4dcba05._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkbpbjP5j8MqWt_K4NASwv0WvB8T4rQ-pM" + nickname="Fabrice" + subject="comment 5" + date="2013-11-03T11:24:28Z" + content=""" +There is something very strange that I did not notice in my first report. When I try `git annex get --from encryptedrepo` nothing happens in the sense that git annex is not even trying to connect to the remote (no ssh connection attempt) while git.encryptedrepo.annex-gcrypt is set to true. When I set it to shell, nothing happens either. + +Another thing I did not report is that I tried the exact same manipulations with another server on which git annex is not installed. The `gcryptsetup permission denied` message was replaced by a `git-annex-shell not found` (or something similar), as expected. But the rest of the behavior was the same: no way to get the actual content with `git annex get --from`. Again, all of this is with 4.20131024, not with the ongoing version. + +I'll try got do more test with the new version. +"""]] diff --git a/doc/bugs/git-annex-shell:_gcryptsetup_permission_denied/comment_6_76ccdf0542e76e4dbd61f3b3228d40ba._comment b/doc/bugs/git-annex-shell:_gcryptsetup_permission_denied/comment_6_76ccdf0542e76e4dbd61f3b3228d40ba._comment new file mode 100644 index 0000000000..0ad9768f60 --- /dev/null +++ b/doc/bugs/git-annex-shell:_gcryptsetup_permission_denied/comment_6_76ccdf0542e76e4dbd61f3b3228d40ba._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.47" + subject="comment 6" + date="2013-11-04T17:12:05Z" + content=""" +It's entirely normal for `git annex get --from remote` to skip files that it does not think are present on the remote. + +What does `git annex whereis` say? +"""]] diff --git a/doc/bugs/git-annex-shell:_gcryptsetup_permission_denied/comment_7_cd964d0a375c5cba299bf2bbbbb86acb._comment b/doc/bugs/git-annex-shell:_gcryptsetup_permission_denied/comment_7_cd964d0a375c5cba299bf2bbbbb86acb._comment new file mode 100644 index 0000000000..3a24f43492 --- /dev/null +++ b/doc/bugs/git-annex-shell:_gcryptsetup_permission_denied/comment_7_cd964d0a375c5cba299bf2bbbbb86acb._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkbpbjP5j8MqWt_K4NASwv0WvB8T4rQ-pM" + nickname="Fabrice" + subject="comment 7" + date="2013-11-04T18:54:54Z" + content=""" +`git annex whereis` says the files are not on the remote git, while they are because of the copy. If I do _exactly_ what's on the tip, that is if I clone the encrypted git just after having done `git annex copy --to encryptedbackup`, the remotes seems to ignore that it has the data. To have it working, I had to call `git annex sync` (push will do, I guess) in the original remote after doing the `git annex copy`. Then I can `git pull` and `git annex whereis` knows where the files are (or I can clone the encrypted remote after doing the sync/pull). + +It seems a bit strange that the copy command does not record the propagation of the file to the encrypted git. I guess this is because gcrypt is the only special remote that stores also the git part, right? Would that be a good idea (and possible) to handle it in a special way? + +Thanks Joey for everything, by the way, both the software and the amazing support via email and the website. +"""]] diff --git a/doc/bugs/git-annex-shell:_gcryptsetup_permission_denied/comment_8_9bac87c85deb5bb15795df28533d0cde._comment b/doc/bugs/git-annex-shell:_gcryptsetup_permission_denied/comment_8_9bac87c85deb5bb15795df28533d0cde._comment new file mode 100644 index 0000000000..da2fef585c --- /dev/null +++ b/doc/bugs/git-annex-shell:_gcryptsetup_permission_denied/comment_8_9bac87c85deb5bb15795df28533d0cde._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.47" + subject="comment 8" + date="2013-11-04T19:14:04Z" + content=""" +Right -- Normally a special remote doesn't include a git repository. And when using a regular git remote, `git-annex-shell` is used to receive files into the repository and it records immediately that the repo has the file so there's no need to sync in that case. So gcrypt is special in this way. + +For now, I have fixed the tip to show syncing after sending files to gcrypt. It might be the case that it would make sense to do a push of the git-annex branch automatically in that case, will have to think about that and see if people get tripped up on this. +"""]] diff --git a/doc/bugs/git-annex_broken_on_Android_4.3.mdwn b/doc/bugs/git-annex_broken_on_Android_4.3.mdwn index da1f7fd282..4c1b356fb4 100644 --- a/doc/bugs/git-annex_broken_on_Android_4.3.mdwn +++ b/doc/bugs/git-annex_broken_on_Android_4.3.mdwn @@ -1,3 +1,7 @@ As per [[install/Android/#comment-e218073735d67691a2c3f66cc53ca6ac]] and [[install/Android/#comment-29bd13ab9cb830ffcd7850b84fb111c8]] : git-annex is broken on Android 4.3; both on Nexus 4 and Nexus 7. + +> [[Fixed|done]]. A 4.3 build of the apk is now available. +> (Unfortunately the fix breaks support for older versions of Android, +> so two versions of the apk have to be built now.) --[[Joey]] diff --git a/doc/bugs/git-annex_broken_on_Android_4.3/comment_10_e47c073f1614f7b57f86acedeeb1cadc._comment b/doc/bugs/git-annex_broken_on_Android_4.3/comment_10_e47c073f1614f7b57f86acedeeb1cadc._comment new file mode 100644 index 0000000000..5d56dc84c8 --- /dev/null +++ b/doc/bugs/git-annex_broken_on_Android_4.3/comment_10_e47c073f1614f7b57f86acedeeb1cadc._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawm7qEQF8yzbY0_PHq3QERHxUGuXmW6qw8o" + nickname="Anton" + subject="comment 10" + date="2013-11-10T22:10:49Z" + content=""" +I can confirm that the Hello World program works with the Nexus 7 2013, running Android 4.3. +"""]] diff --git a/doc/bugs/git-annex_broken_on_Android_4.3/comment_11_ce34578c45060b7c8b759efd1c1d8df8._comment b/doc/bugs/git-annex_broken_on_Android_4.3/comment_11_ce34578c45060b7c8b759efd1c1d8df8._comment new file mode 100644 index 0000000000..d84a59b763 --- /dev/null +++ b/doc/bugs/git-annex_broken_on_Android_4.3/comment_11_ce34578c45060b7c8b759efd1c1d8df8._comment @@ -0,0 +1,13 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnegApaT6kTI0Gxy9SNmI9Og-k_fC_aS7Y" + nickname="Michael Alan" + subject="Hooray!" + date="2013-11-10T22:21:46Z" + content=""" +I have a Nexus 7 (2013) with 4.3 that I'll test it on---I expect that my test will be successful. + +I'll also run the test on my Nexus 5, running 4.4. + +Getting git-annex working on 4.3 was the last thing keeping me from being able to ditch Dropbox entirely. I'm so glad to hear there's some potential progress. + +"""]] diff --git a/doc/bugs/git-annex_broken_on_Android_4.3/comment_12_75965395dc33046ce34ac5ba972b7d64._comment b/doc/bugs/git-annex_broken_on_Android_4.3/comment_12_75965395dc33046ce34ac5ba972b7d64._comment new file mode 100644 index 0000000000..3f520d7e42 --- /dev/null +++ b/doc/bugs/git-annex_broken_on_Android_4.3/comment_12_75965395dc33046ce34ac5ba972b7d64._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.246" + subject="comment 12" + date="2013-11-10T22:23:49Z" + content=""" +Full rebuild in progress (takes about 6 hours +- manual fixing). +"""]] diff --git a/doc/bugs/git-annex_broken_on_Android_4.3/comment_13_f07bc76dd3c5580fc0855a33ae835c8d._comment b/doc/bugs/git-annex_broken_on_Android_4.3/comment_13_f07bc76dd3c5580fc0855a33ae835c8d._comment new file mode 100644 index 0000000000..f2a57f7310 --- /dev/null +++ b/doc/bugs/git-annex_broken_on_Android_4.3/comment_13_f07bc76dd3c5580fc0855a33ae835c8d._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnegApaT6kTI0Gxy9SNmI9Og-k_fC_aS7Y" + nickname="Michael Alan" + subject="Oh, and if a 4.3 device would be helpful..." + date="2013-11-10T22:28:48Z" + content=""" +I have Samsung Epic 4G (epic_mtd) that I'm no longer using and would be quite happy to send you---it's older, and slow, but it is at least currently supported by CyanogenMod, so it should be possible to install 10.2 milestone builds on it and at least do basic testing. + +Hell, if it would really facilitate Android support, I'd happily pick up something like a B&N Nook HD+ and send it to you---that should be similarly amenable to CM installs and testing. + +Though I will also understand if you don't necessarily want to have a bunch of superfluous hardware laying around. +"""]] diff --git a/doc/bugs/git-annex_broken_on_Android_4.3/comment_14_637c59becc68a1e4f60069d8873489ff._comment b/doc/bugs/git-annex_broken_on_Android_4.3/comment_14_637c59becc68a1e4f60069d8873489ff._comment new file mode 100644 index 0000000000..6336a3bd48 --- /dev/null +++ b/doc/bugs/git-annex_broken_on_Android_4.3/comment_14_637c59becc68a1e4f60069d8873489ff._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnegApaT6kTI0Gxy9SNmI9Og-k_fC_aS7Y" + nickname="Michael Alan" + subject="Works on KitKat" + date="2013-11-10T23:15:28Z" + content=""" +I skipped testing on my Nexus 7, figuring that would be duplicative, and instead ran it on my Nexus 5, and it worked great. +"""]] diff --git a/doc/bugs/git-annex_broken_on_Android_4.3/comment_15_d80b87055f72873f5678a01d2630bea4._comment b/doc/bugs/git-annex_broken_on_Android_4.3/comment_15_d80b87055f72873f5678a01d2630bea4._comment new file mode 100644 index 0000000000..6bca41b3ae --- /dev/null +++ b/doc/bugs/git-annex_broken_on_Android_4.3/comment_15_d80b87055f72873f5678a01d2630bea4._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.246" + subject="comment 15" + date="2013-11-11T04:34:21Z" + content=""" +6 hours later, and: + +testing appreciated! +"""]] diff --git a/doc/bugs/git-annex_broken_on_Android_4.3/comment_16_57ac84868b223b30f005704eefa01b8d._comment b/doc/bugs/git-annex_broken_on_Android_4.3/comment_16_57ac84868b223b30f005704eefa01b8d._comment new file mode 100644 index 0000000000..204845eb55 --- /dev/null +++ b/doc/bugs/git-annex_broken_on_Android_4.3/comment_16_57ac84868b223b30f005704eefa01b8d._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://launchpad.net/~subito" + nickname="subito" + subject="Nexus 5 Android 4.4" + date="2013-11-11T10:07:07Z" + content=""" +Does not work for me. Same error as in the original Bug report. +"""]] diff --git a/doc/bugs/git-annex_broken_on_Android_4.3/comment_17_a41f4d8a72c07ad770e6479e9b8c7f1d._comment b/doc/bugs/git-annex_broken_on_Android_4.3/comment_17_a41f4d8a72c07ad770e6479e9b8c7f1d._comment new file mode 100644 index 0000000000..9712f5944a --- /dev/null +++ b/doc/bugs/git-annex_broken_on_Android_4.3/comment_17_a41f4d8a72c07ad770e6479e9b8c7f1d._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnegApaT6kTI0Gxy9SNmI9Og-k_fC_aS7Y" + nickname="Michael Alan" + subject="Same error as before, Nexus 5 and 7" + date="2013-11-11T13:06:17Z" + content=""" +Unfortunately, my experience mirrors subito's---same error as before on both 4.3 and 4.4. +"""]] diff --git a/doc/bugs/git-annex_broken_on_Android_4.3/comment_18_7d36637f11cda51de395303d5c1c6a3f._comment b/doc/bugs/git-annex_broken_on_Android_4.3/comment_18_7d36637f11cda51de395303d5c1c6a3f._comment new file mode 100644 index 0000000000..2dc32cf157 --- /dev/null +++ b/doc/bugs/git-annex_broken_on_Android_4.3/comment_18_7d36637f11cda51de395303d5c1c6a3f._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.246" + subject="comment 18" + date="2013-11-11T13:27:49Z" + content=""" +Hmm, maybe the problem is caused by stripping the program? If so, this should fail the same way: +"""]] diff --git a/doc/bugs/git-annex_broken_on_Android_4.3/comment_19_c8609c3f7f62ae5427fd8c60bc9546ed._comment b/doc/bugs/git-annex_broken_on_Android_4.3/comment_19_c8609c3f7f62ae5427fd8c60bc9546ed._comment new file mode 100644 index 0000000000..2f22ad21c2 --- /dev/null +++ b/doc/bugs/git-annex_broken_on_Android_4.3/comment_19_c8609c3f7f62ae5427fd8c60bc9546ed._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnegApaT6kTI0Gxy9SNmI9Og-k_fC_aS7Y" + nickname="Michael Alan" + subject="Unfortunately, it would not appear that easy..." + date="2013-11-11T14:33:05Z" + content=""" +The stripped binary for hello worked fine. +"""]] diff --git a/doc/bugs/git-annex_broken_on_Android_4.3/comment_20_0886bca6d0c6a9415a7794d256be2e9d._comment b/doc/bugs/git-annex_broken_on_Android_4.3/comment_20_0886bca6d0c6a9415a7794d256be2e9d._comment new file mode 100644 index 0000000000..2b547d9a70 --- /dev/null +++ b/doc/bugs/git-annex_broken_on_Android_4.3/comment_20_0886bca6d0c6a9415a7794d256be2e9d._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.246" + subject="comment 20" + date="2013-11-11T16:23:11Z" + content=""" +To bisect the problem space further, in case the apk build machinery is at fault, here's a git-annex binary not included in an apk. (Run same as the hello world.) + + + +And here's a more minimal git-annex binary (trying to look identical to hello world from the linker's perspective, just a bit larger..). + + +"""]] diff --git a/doc/bugs/git-annex_broken_on_Android_4.3/comment_21_2b39729f95c9c4bba620ecdd3d1558ed._comment b/doc/bugs/git-annex_broken_on_Android_4.3/comment_21_2b39729f95c9c4bba620ecdd3d1558ed._comment new file mode 100644 index 0000000000..5513348195 --- /dev/null +++ b/doc/bugs/git-annex_broken_on_Android_4.3/comment_21_2b39729f95c9c4bba620ecdd3d1558ed._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmqz6wCn-Q1vzrsHGvEJHOt_T5ZESilxhc" + nickname="Sören" + subject="Galaxy S4 Android 4.3" + date="2013-11-11T18:47:23Z" + content=""" +hello and hello.stripped both work here but the git-annex binaries don't (still the same error as in the bug report). +"""]] diff --git a/doc/bugs/git-annex_broken_on_Android_4.3/comment_22_8d90d92951919aa70638b31e9248bec5._comment b/doc/bugs/git-annex_broken_on_Android_4.3/comment_22_8d90d92951919aa70638b31e9248bec5._comment new file mode 100644 index 0000000000..e4937e0f8f --- /dev/null +++ b/doc/bugs/git-annex_broken_on_Android_4.3/comment_22_8d90d92951919aa70638b31e9248bec5._comment @@ -0,0 +1,16 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnegApaT6kTI0Gxy9SNmI9Og-k_fC_aS7Y" + nickname="Michael Alan" + subject="Both fail..." + date="2013-11-11T18:53:34Z" + content=""" +Same linking issue for both. + +I don't *think* it should make any difference at all, but to spare myself a little bit of typing on this soft keyboard, I'm using a small variation on your script; I'm sharing it so other testers can use it, too, and so someone can point out if I'm doing something wrong: + + D=/data/data/ga/androidterm/tmp/gatest + cp $D + chmod +x $D + $D + +"""]] diff --git a/doc/bugs/git-annex_broken_on_Android_4.3/comment_23_6398271f5cd9e94996202ef3bce6f6ed._comment b/doc/bugs/git-annex_broken_on_Android_4.3/comment_23_6398271f5cd9e94996202ef3bce6f6ed._comment new file mode 100644 index 0000000000..05cb634e67 --- /dev/null +++ b/doc/bugs/git-annex_broken_on_Android_4.3/comment_23_6398271f5cd9e94996202ef3bce6f6ed._comment @@ -0,0 +1,20 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.246" + subject="comment 23" + date="2013-11-11T19:14:59Z" + content=""" +Script variation is ok. + +So, it's looking like perhaps a problem with the way cabal links the executable, which I notice is a two stage process, vs the way ghc links it with --make. + +To narrow down, here is hello built using cabal: + + + +Here is git-annex built not using cabal: + + + +(For my own reference, it's also built without WITH_CLIBS.) +"""]] diff --git a/doc/bugs/git-annex_broken_on_Android_4.3/comment_24_c9e399833cc6235077161f490dfa866f._comment b/doc/bugs/git-annex_broken_on_Android_4.3/comment_24_c9e399833cc6235077161f490dfa866f._comment new file mode 100644 index 0000000000..c8fea212b3 --- /dev/null +++ b/doc/bugs/git-annex_broken_on_Android_4.3/comment_24_c9e399833cc6235077161f490dfa866f._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmqz6wCn-Q1vzrsHGvEJHOt_T5ZESilxhc" + nickname="Sören" + subject="comment 24" + date="2013-11-11T19:56:04Z" + content=""" +hello-cabal working, git-annex-byhand not. +"""]] diff --git a/doc/bugs/git-annex_broken_on_Android_4.3/comment_25_cf093737eefb2b99f6f0eac9bf3e74b3._comment b/doc/bugs/git-annex_broken_on_Android_4.3/comment_25_cf093737eefb2b99f6f0eac9bf3e74b3._comment new file mode 100644 index 0000000000..e28a9508bc --- /dev/null +++ b/doc/bugs/git-annex_broken_on_Android_4.3/comment_25_cf093737eefb2b99f6f0eac9bf3e74b3._comment @@ -0,0 +1,9 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnegApaT6kTI0Gxy9SNmI9Og-k_fC_aS7Y" + nickname="Michael Alan" + subject="I got the same results as Sören." + date="2013-11-11T20:37:08Z" + content=""" +cabal doesn't seem to be the culprit. + +"""]] diff --git a/doc/bugs/git-annex_broken_on_Android_4.3/comment_26_c122ce53175fc9e0e114a8acd2385c0d._comment b/doc/bugs/git-annex_broken_on_Android_4.3/comment_26_c122ce53175fc9e0e114a8acd2385c0d._comment new file mode 100644 index 0000000000..1c72cd27bc --- /dev/null +++ b/doc/bugs/git-annex_broken_on_Android_4.3/comment_26_c122ce53175fc9e0e114a8acd2385c0d._comment @@ -0,0 +1,29 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.246" + subject="finally getting debugger spun up" + date="2013-11-12T01:08:24Z" + content=""" + seems relevant (and the patches to fix it seem likely to have led to the linker rejecting this). + +So I can probably stop torturing your soft keyboards. I need a binary where `arm-linux-androideabi-4.8/bin/arm-linux-androideabi-readelf -r` does not contain `R_ARM_COPY`. Checking against the binaries so far, this consistently matches the test results, all the git-annex binaries have: + +
+ Offset     Info    Type            Sym.Value  Sym. Name
+011d05f0  00004e14 R_ARM_COPY        011d05f0   environ
+
+ +(Which is itself interesting; I've had to work around some problems with the haskell port not supporting getting the environment (Annex.Branch.withIndex). Possibly because it was copied and the linker screwed that up? ) + +Ok, here's a binary that meets those criteria. Obtained by passing -z nocopyreloc to the gold linker (ghc options -optl-z -optlnocopyreloc) + + + +Also, here's a hello world binary that *should* fail. It attempts to read and print the environment, and has the same `R_ARM_COPY` relocation. + + + +And, here's a hello world binary that *might* successfully print out the full environment (like `set` does). If it does, I can also remove the ugly hack in Annex.Branch.withIndex. Which would be an unexpected reward. + + +"""]] diff --git a/doc/bugs/git-annex_broken_on_Android_4.3/comment_27_237e41e61781bb058f5fd39362a904e4._comment b/doc/bugs/git-annex_broken_on_Android_4.3/comment_27_237e41e61781bb058f5fd39362a904e4._comment new file mode 100644 index 0000000000..dd911955a7 --- /dev/null +++ b/doc/bugs/git-annex_broken_on_Android_4.3/comment_27_237e41e61781bb058f5fd39362a904e4._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnegApaT6kTI0Gxy9SNmI9Og-k_fC_aS7Y" + nickname="Michael Alan" + subject="nocopy variants work!" + date="2013-11-12T03:17:09Z" + content=""" +I tested both the hello-env-nocopy and the git-annex-nocopy binaries successfully. hello-env-copy failed as you predicted. + +Yay! +"""]] diff --git a/doc/bugs/git-annex_broken_on_Android_4.3/comment_28_97f423a41ee9d2d74291594fae20dd4e._comment b/doc/bugs/git-annex_broken_on_Android_4.3/comment_28_97f423a41ee9d2d74291594fae20dd4e._comment new file mode 100644 index 0000000000..6341aae80f --- /dev/null +++ b/doc/bugs/git-annex_broken_on_Android_4.3/comment_28_97f423a41ee9d2d74291594fae20dd4e._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.246" + subject="comment 28" + date="2013-11-12T03:58:56Z" + content=""" +This fix is now in place in the android autobuilds. + +Just to be sure, hello-env-nocopy managed to print out multiple environment variables? +"""]] diff --git a/doc/bugs/git-annex_broken_on_Android_4.3/comment_29_7b3fbe7e38f637fcea511441ac243d93._comment b/doc/bugs/git-annex_broken_on_Android_4.3/comment_29_7b3fbe7e38f637fcea511441ac243d93._comment new file mode 100644 index 0000000000..1cd4c356f6 --- /dev/null +++ b/doc/bugs/git-annex_broken_on_Android_4.3/comment_29_7b3fbe7e38f637fcea511441ac243d93._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmqz6wCn-Q1vzrsHGvEJHOt_T5ZESilxhc" + nickname="Sören" + subject="APK now works too" + date="2013-11-12T09:10:49Z" + content=""" +I got the same results as Michael. The output of hello-nocopy is a longer list of environment variables. +Even better, the apk from the autobuilder now seems to work fine as well, including the webapp. +Great work! Thanks for digging into this. +"""]] diff --git a/doc/bugs/git-annex_broken_on_Android_4.3/comment_30_26c04584c3c6dacf59e1b6c82042c97c._comment b/doc/bugs/git-annex_broken_on_Android_4.3/comment_30_26c04584c3c6dacf59e1b6c82042c97c._comment new file mode 100644 index 0000000000..3409b9c4a7 --- /dev/null +++ b/doc/bugs/git-annex_broken_on_Android_4.3/comment_30_26c04584c3c6dacf59e1b6c82042c97c._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnegApaT6kTI0Gxy9SNmI9Og-k_fC_aS7Y" + nickname="Michael Alan" + subject="Yep, the env was printed" + date="2013-11-12T10:18:56Z" + content=""" +I would recognize the output of a Show instance anywhere. +"""]] diff --git a/doc/bugs/git-annex_broken_on_Android_4.3/comment_8_f58897eff6b4693f0c73474ccfe6e733._comment b/doc/bugs/git-annex_broken_on_Android_4.3/comment_8_f58897eff6b4693f0c73474ccfe6e733._comment new file mode 100644 index 0000000000..52326b8e28 --- /dev/null +++ b/doc/bugs/git-annex_broken_on_Android_4.3/comment_8_f58897eff6b4693f0c73474ccfe6e733._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmhfodZquCI_EEl-f3h7HkROTszlsQL6yA" + nickname="Joe" + subject="Samsung Galaxy S4 also affected" + date="2013-11-09T02:47:54Z" + content=""" +Verizon just pushed out 4.3 to Samsung Galaxy S4 devices. This issue is affecting me now too. +"""]] diff --git a/doc/bugs/git-annex_broken_on_Android_4.3/comment_9_ddba87b2f20d8a63f7b8ebdb9bd13515._comment b/doc/bugs/git-annex_broken_on_Android_4.3/comment_9_ddba87b2f20d8a63f7b8ebdb9bd13515._comment new file mode 100644 index 0000000000..015efd7ce3 --- /dev/null +++ b/doc/bugs/git-annex_broken_on_Android_4.3/comment_9_ddba87b2f20d8a63f7b8ebdb9bd13515._comment @@ -0,0 +1,18 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.246" + subject="comment 9" + date="2013-11-10T20:12:47Z" + content=""" +I have finally managed to get ghc to build with the newest version of the NDK. I hope this means it will make binaries that work with 4.3, but I don't have a device to test. + +Here is a hello world program built with it: + + +After downloading it to an Android device, you can test it by opening the +git-annex terminal, and running: `D=/data/data/ga.androidterm/tmp; cp hello $D; chmod +x $D/hello; $D/hello` + +Tested working on android 4.0.4 + +Also, I have filed a bug upstream about this at +"""]] diff --git a/doc/bugs/git-annex_directory_hashing_problems_on_osx/comment_7_0f4f471102e394ebb01da40e4d0fd9f6._comment b/doc/bugs/git-annex_directory_hashing_problems_on_osx/comment_7_0f4f471102e394ebb01da40e4d0fd9f6._comment index c3aee6c579..92b205bc33 100644 --- a/doc/bugs/git-annex_directory_hashing_problems_on_osx/comment_7_0f4f471102e394ebb01da40e4d0fd9f6._comment +++ b/doc/bugs/git-annex_directory_hashing_problems_on_osx/comment_7_0f4f471102e394ebb01da40e4d0fd9f6._comment @@ -6,7 +6,7 @@ content=""" git 1.7.4 does not make things better. With it, if I add first \"X/foo\" and then \"x/bar\", it commits \"X/bar\". -That will *certianly* cause problems when interoperating with a repo clone on a case-sensative filesystem, since +That will *certainly* cause problems when interoperating with a repo clone on a case-sensative filesystem, since git-annex there will not see the location log that git committed to the wrong case directory. It's possible there is some interoperability problem when pulling from linux like you did, onto HFS+, too. I am not quite sure. Ah, I did find one.. if I clone the repo with \"X/foo\" in it to a case-sensative filesystem, and add a \"x/foo\" there, diff --git a/doc/bugs/git-annex_does_not_install_on_windows_without_admin_rights.mdwn b/doc/bugs/git-annex_does_not_install_on_windows_without_admin_rights.mdwn new file mode 100644 index 0000000000..b36d5e84c6 --- /dev/null +++ b/doc/bugs/git-annex_does_not_install_on_windows_without_admin_rights.mdwn @@ -0,0 +1,19 @@ +### Please describe the problem. + +Installing on Windows requires installing git followed by git-annex. Installing the former works without admin rights, but the latter cannot be installed afterwards. + +### What steps will reproduce the problem? + +1. Create a Windows account without admin rights +2. Install git +3. Install git-annex + +### What version of git-annex are you using? On what operating system? + +Latest release on MS Windows. + +### Please provide any additional information below. + + +Installing git creates read-only directories that cannot be used by the git-annex install afterwards. Without admin rights, the read-only flag of the git dir cannot be altered. + diff --git a/doc/bugs/git-annex_does_not_install_on_windows_without_admin_rights/comment_1_2533800ab5a95c5d71c3b47a630e751a._comment b/doc/bugs/git-annex_does_not_install_on_windows_without_admin_rights/comment_1_2533800ab5a95c5d71c3b47a630e751a._comment new file mode 100644 index 0000000000..32fc0311e7 --- /dev/null +++ b/doc/bugs/git-annex_does_not_install_on_windows_without_admin_rights/comment_1_2533800ab5a95c5d71c3b47a630e751a._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.64" + subject="comment 1" + date="2013-11-26T16:19:41Z" + content=""" +Thanks, this had been reported in the forum before, but they did not point at the directory permissions as the problem. + +It would be possible to modify the installer to install git-annex somewhere else and add it to the PATH, but it seems this is a utter nightmare on windows and I'd have to pull in enormous NSIS scripts from their wiki, of unknown provenance. Which is why I am piggybacking on the git installation's PATH. +"""]] diff --git a/doc/bugs/git-annex_does_not_install_on_windows_without_admin_rights/comment_2_5b71785acf16a8d9ea457726599daef3._comment b/doc/bugs/git-annex_does_not_install_on_windows_without_admin_rights/comment_2_5b71785acf16a8d9ea457726599daef3._comment new file mode 100644 index 0000000000..4bd5c2c0ed --- /dev/null +++ b/doc/bugs/git-annex_does_not_install_on_windows_without_admin_rights/comment_2_5b71785acf16a8d9ea457726599daef3._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://me.yahoo.com/a/bBy7WkgQicYHIiiyj.Vm0TcMbxi2quzbPFef#6f9f7" + nickname="Frederik Vanrenterghem" + subject="comment 2" + date="2013-11-26T21:57:28Z" + content=""" +Just wondering how git succeeds in installing as non-admin user. The folder it goes in is also read-only. +"""]] diff --git a/doc/bugs/git-annex_merge_stalls/comment_3_ced9b0d724fb55c756106b64c3721003._comment b/doc/bugs/git-annex_merge_stalls/comment_3_ced9b0d724fb55c756106b64c3721003._comment index 6000443546..382f8c835b 100644 --- a/doc/bugs/git-annex_merge_stalls/comment_3_ced9b0d724fb55c756106b64c3721003._comment +++ b/doc/bugs/git-annex_merge_stalls/comment_3_ced9b0d724fb55c756106b64c3721003._comment @@ -12,7 +12,7 @@ joeyh for example, if you ran it and ctrl-z'd at just the right time, it could b joeyh (or the kernel coud have gotten confused, which given you also had a crash, who knows..) dp sounds logical joeyh forcing locks is always a problimatic thing -joeyh but git-annex could certianly notice if it seems to be stalled and print some useful messages +joeyh but git-annex could certainly notice if it seems to be stalled and print some useful messages joeyh and maybe have a way to run with locks forced """]] diff --git a/doc/bugs/git_annex_add_removes_file_with_no_data_left/comment_1_8f081aeba7065d143a453dc128543f59._comment b/doc/bugs/git_annex_add_removes_file_with_no_data_left/comment_1_8f081aeba7065d143a453dc128543f59._comment index 99bc8277d9..89531ca168 100644 --- a/doc/bugs/git_annex_add_removes_file_with_no_data_left/comment_1_8f081aeba7065d143a453dc128543f59._comment +++ b/doc/bugs/git_annex_add_removes_file_with_no_data_left/comment_1_8f081aeba7065d143a453dc128543f59._comment @@ -14,5 +14,5 @@ The link that you show: If I understand you correctly, it's only happening with one particular file content. -I think you either need to rule out it being due to the way you've installed git-annex, perhaps by installing the linux standalone tarball, and seeing if you can get the same behavior with that. Or you could send me the repository by email (joey@kitenet.net) and I'll see if I can reproduce it, and if so, will certianly be able to debug and fix it. +I think you either need to rule out it being due to the way you've installed git-annex, perhaps by installing the linux standalone tarball, and seeing if you can get the same behavior with that. Or you could send me the repository by email (joey@kitenet.net) and I'll see if I can reproduce it, and if so, will certainly be able to debug and fix it. """]] diff --git a/doc/bugs/git_annex_add_removes_file_with_no_data_left/comment_2_54a4b10723fd8a80dd486377ff15ce0d._comment b/doc/bugs/git_annex_add_removes_file_with_no_data_left/comment_2_54a4b10723fd8a80dd486377ff15ce0d._comment index 1aefe452dc..7ac34e7512 100644 --- a/doc/bugs/git_annex_add_removes_file_with_no_data_left/comment_2_54a4b10723fd8a80dd486377ff15ce0d._comment +++ b/doc/bugs/git_annex_add_removes_file_with_no_data_left/comment_2_54a4b10723fd8a80dd486377ff15ce0d._comment @@ -4,7 +4,7 @@ subject="comment 2" date="2013-07-18T19:46:12Z" content=""" -Hmm, given the size of the repo, please don't email it directly, if you choose to do that. But getting me access to it would certianly be useful. +Hmm, given the size of the repo, please don't email it directly, if you choose to do that. But getting me access to it would certainly be useful. """]] diff --git a/doc/bugs/git_annex_describe_can_break_uuid.log.mdwn b/doc/bugs/git_annex_describe_can_break_uuid.log.mdwn new file mode 100644 index 0000000000..16e6981f5b --- /dev/null +++ b/doc/bugs/git_annex_describe_can_break_uuid.log.mdwn @@ -0,0 +1,46 @@ +### Please describe the problem. + +`uuid.log` can end up in a state where `git annex describe` (and probably other things) stops working. + +### What steps will reproduce the problem? + +Run `git annex describe` against a remote that is not a an initialized git-annex repo. + +### What version of git-annex are you using? On what operating system? + +debian-packaged git-annex 4.20131106 on Linux Mint 13/Maya (Ubuntu Precise/12.04) + +### Please provide any additional information below. + +I will follow comments, but can also be found at [[https://microca.st/clacke]]. + +Full transcript to reproduce: + +[[!format sh """ +$ git init a +Initialized empty Git repository in /tmp/annex/a/.git/ +$ git init b +Initialized empty Git repository in /tmp/annex/b/.git/ +$ cd a/ +$ git annex init +init ok +(Recording state in git...) +$ git remote add -f b ../b +Updating b +$ git annex describe b b # this should not be ok +describe b ok +(Recording state in git...) +$ git annex describe b b +describe b git-annex: Prelude.last: empty list +$ git cat-file blob git-annex:uuid.log + b timestamp=1383987654.900868s +... + +# End of transcript. +"""]] + +> Fixed the bug and made git breakage not crash git-annex. [[done]] +> --[[Joey]] + +> > Update: Also made it automatically clean up the cruft this put in the +> > log. --[[Joey]] diff --git a/doc/bugs/git_annex_describe_can_break_uuid.log/comment_2_9ead36f13cbde6c822b231441de636ae._comment b/doc/bugs/git_annex_describe_can_break_uuid.log/comment_2_9ead36f13cbde6c822b231441de636ae._comment new file mode 100644 index 0000000000..a5616234ef --- /dev/null +++ b/doc/bugs/git_annex_describe_can_break_uuid.log/comment_2_9ead36f13cbde6c822b231441de636ae._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://id.clacke.se/" + nickname="clacke" + subject="comment 2" + date="2013-11-11T05:32:14Z" + content=""" +Great, thanks! +"""]] diff --git a/doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9.mdwn b/doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9.mdwn index 372c06ba93..2169372a2f 100644 --- a/doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9.mdwn +++ b/doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9.mdwn @@ -216,3 +216,5 @@ Binary Images: # End of transcript or log. """]] + +> [[fixed|done]] --[[Joey]] diff --git a/doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9/comment_19_9881db7bb6fef4e47c54cdc23e995f17._comment b/doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9/comment_19_9881db7bb6fef4e47c54cdc23e995f17._comment new file mode 100644 index 0000000000..96356e0478 --- /dev/null +++ b/doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9/comment_19_9881db7bb6fef4e47c54cdc23e995f17._comment @@ -0,0 +1,13 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnt7phVzBQ0xO5rCO6sfmEmxQItmFMyqls" + nickname="Kevin" + subject="comment 19" + date="2013-11-02T00:58:31Z" + content=""" +I tried @flabbergast's dmg. It seems to work fine (including the web app) on my Air, but the web app fails on my iMac with + + $ git annex webapp + Launching web browser on file:///Users/kw/Desktop/annex/.git/annex/webapp.html + error: git-annex died of signal 4 + $ +"""]] diff --git a/doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9/comment_20_41e2ea458669f59f96b5860825745910._comment b/doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9/comment_20_41e2ea458669f59f96b5860825745910._comment new file mode 100644 index 0000000000..fca9ba58e6 --- /dev/null +++ b/doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9/comment_20_41e2ea458669f59f96b5860825745910._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnt7phVzBQ0xO5rCO6sfmEmxQItmFMyqls" + nickname="Kevin" + subject="comment 20" + date="2013-11-02T01:02:18Z" + content=""" +Also, to avoid hurt feelings etc., it might be best to make it clear on your home page and kickstarter that you do not intend to support OS X yourself. +"""]] diff --git a/doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9/comment_21_515039e321e0595f95430d8082bd54a5._comment b/doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9/comment_21_515039e321e0595f95430d8082bd54a5._comment new file mode 100644 index 0000000000..a0a175d304 --- /dev/null +++ b/doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9/comment_21_515039e321e0595f95430d8082bd54a5._comment @@ -0,0 +1,20 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="108.236.230.124" + subject="comment 21" + date="2013-11-08T19:22:17Z" + content=""" +Now that I can try running the 10.8 dmg on 10.9 myself, I get this failure: + +
+oberon:~ joeyh$ /Volumes/git-annex/git-annex.app/Contents/MacOS/git-annex
+dyld: Symbol not found: _objc_debug_taggedpointer_mask
+  Referenced from: /System/Library/Frameworks/CoreFoundation.framework/Versions/A/CoreFoundation
+  Expected in: /Volumes/git-annex/git-annex.app/Contents/MacOS/bundle/I
+ in /System/Library/Frameworks/CoreFoundation.framework/Versions/A/CoreFoundation
+
+ +This makes me think that that adding back the OSX frameworks might possibly yield a dmg that can work on both versions. Although that's probably more likely to work if it's built on 10.8 and used on 10.9 than the other way around. Might be worth a try to revert commit 900351ab8585c171486cef853eff4a95ec151e6f and commit 9b663c7f8cf82cee523b75be1a8786fa7d34b428 to try that. + +Oh well, I should have a native 10.9 dmg autobuild set up before too long. 10.8 autobuilder has built its last image unfortunately, due to being upgraded to 10.9. +"""]] diff --git a/doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9/comment_22_9412236296871c570c66f5b4c7f9681e._comment b/doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9/comment_22_9412236296871c570c66f5b4c7f9681e._comment new file mode 100644 index 0000000000..e5942bfd42 --- /dev/null +++ b/doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9/comment_22_9412236296871c570c66f5b4c7f9681e._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.246" + subject="comment 22" + date="2013-11-14T18:55:54Z" + content=""" +Native 10.9 autobuilder is now running. + +Lacks XMPP support until I get libxml2 linked on the autobuilder. Only tested on the build machine so far. +"""]] diff --git a/doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9/comment_23_e4e7d13be6c0bc63f426e535de6172f8._comment b/doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9/comment_23_e4e7d13be6c0bc63f426e535de6172f8._comment new file mode 100644 index 0000000000..db8d835d2f --- /dev/null +++ b/doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9/comment_23_e4e7d13be6c0bc63f426e535de6172f8._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnmF_9CAtfqdZkC4e-_dCX-rK5bqh4RWkw" + nickname="Carl" + subject="comment 23" + date="2013-11-14T19:22:16Z" + content=""" +Seems to work on my Mavericks Macbook Air. Thank you! +"""]] diff --git a/doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9/comment_24_c73e1277c5f284b1019362fb2bef94a8._comment b/doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9/comment_24_c73e1277c5f284b1019362fb2bef94a8._comment new file mode 100644 index 0000000000..c3a0d3bec3 --- /dev/null +++ b/doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9/comment_24_c73e1277c5f284b1019362fb2bef94a8._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmL8pteP2jbYJUn1M3CbeLDvz2SWAA1wtg" + nickname="Kristian" + subject="comment 24" + date="2013-11-17T17:01:14Z" + content=""" +Thanks Joey! It works great +"""]] diff --git a/doc/bugs/git_annex_fork_bombs_on_gpg_file/comment_11_ad13e3221ae06086e86800316912d951._comment b/doc/bugs/git_annex_fork_bombs_on_gpg_file/comment_11_ad13e3221ae06086e86800316912d951._comment index ba2f442e42..301b0f9736 100644 --- a/doc/bugs/git_annex_fork_bombs_on_gpg_file/comment_11_ad13e3221ae06086e86800316912d951._comment +++ b/doc/bugs/git_annex_fork_bombs_on_gpg_file/comment_11_ad13e3221ae06086e86800316912d951._comment @@ -4,7 +4,7 @@ subject="comment 11" date="2013-05-19T21:13:41Z" content=""" -You're certianly welcome. +You're certainly welcome. So, you did not install git-annex from the dmg? That bundles its own gpg. diff --git a/doc/bugs/git_annex_fork_bombs_on_gpg_file/comment_6_7eb535ca38b3e84d44d0f8cbf5e61b8b._comment b/doc/bugs/git_annex_fork_bombs_on_gpg_file/comment_6_7eb535ca38b3e84d44d0f8cbf5e61b8b._comment index 80a047025e..03f213c439 100644 --- a/doc/bugs/git_annex_fork_bombs_on_gpg_file/comment_6_7eb535ca38b3e84d44d0f8cbf5e61b8b._comment +++ b/doc/bugs/git_annex_fork_bombs_on_gpg_file/comment_6_7eb535ca38b3e84d44d0f8cbf5e61b8b._comment @@ -8,7 +8,7 @@ So there are a lot of uploads attempts being made (and apparently failing), and The repeated \"(gpg)\" is an interesting clue, since normally git-annex only runs gpg once, to unlock an encrypted special remote's encryption key, and then should retain the key, cached in memory. I was able to reproduce this part of the bug (but not the zombie processes) when I purposfully broke the bup special remote by making it throw an error when it was supposed to run bup to send a file. That defeats the caching, since the state, including the cache, is thrown away when there's an exception. Working on a fix for that.. -That doesn't explain what's actually causing the problem for you, but it does certianly suggest the bup special remote code is failing in some unusual way. What happens if rather than starting the assistant, you use git-annex manually to send files to the remote? Run: +That doesn't explain what's actually causing the problem for you, but it does certainly suggest the bup special remote code is failing in some unusual way. What happens if rather than starting the assistant, you use git-annex manually to send files to the remote? Run:
 git annex copy --to ffe41272-608e-43c4-8f35-e9cd63087892 --debug
diff --git a/doc/bugs/git_annex_indirect_can_fail_catastrophically.mdwn b/doc/bugs/git_annex_indirect_can_fail_catastrophically.mdwn
index 34096d8943..3dc1936833 100644
--- a/doc/bugs/git_annex_indirect_can_fail_catastrophically.mdwn
+++ b/doc/bugs/git_annex_indirect_can_fail_catastrophically.mdwn
@@ -70,7 +70,7 @@ index 7835988..ed8ea6c 100644
 
 Any update on this? Why is `-a` used here? -- [[anarcat]]
 
-> -a is not really the problem. You certianly do usually want
+> -a is not really the problem. You certainly do usually want
 > to commit your changes before converting to direct mode.
 > 
 > [[done]]; now when this happens it catches the exception and 
diff --git a/doc/bugs/git_version_in_prebuilt_linux_tarball_is_outdated.mdwn b/doc/bugs/git_version_in_prebuilt_linux_tarball_is_outdated.mdwn
index 8aed26bba8..e5960b62e6 100644
--- a/doc/bugs/git_version_in_prebuilt_linux_tarball_is_outdated.mdwn
+++ b/doc/bugs/git_version_in_prebuilt_linux_tarball_is_outdated.mdwn
@@ -6,3 +6,6 @@ Download the current prebuilt linux tarball from [[/install]], extract it, run "
 
 ### What version of git-annex are you using? On what operating system?
 git-annex-standalone-amd64.tar.gz	2013-09-22 09:56 (Linux Ubuntu Precise)
+
+> Updated to wheezy backport 1.8.4. [[done]] for now, obviously it will go
+> out of date again eventually.. --[[Joey]]
diff --git a/doc/bugs/gitignore_for_DCIM_on_Android_misses_some_files.mdwn b/doc/bugs/gitignore_for_DCIM_on_Android_misses_some_files.mdwn
new file mode 100644
index 0000000000..449a99753e
--- /dev/null
+++ b/doc/bugs/gitignore_for_DCIM_on_Android_misses_some_files.mdwn
@@ -0,0 +1,17 @@
+### Please describe the problem.
+
+When git-annex assistant on Android setups up the DCIM repo a .gitignore file is dropped into place which ignores .thumbnails/* . Unfortunately this doesn't match .thumbnails/.thumbdata* - I have a 700MB file which matches this pattern.
+
+I suspect that making the pattern in .gitignore just .thumbnails should resolve this.
+
+### What steps will reproduce the problem?
+
+Create a repo
+
+### What version of git-annex are you using? On what operating system?
+
+Nightly build for Android from yesterday (2013-11-16)
+
+### Please provide any additional information below.
+
+> [[fixed|done]] --[[Joey]]
diff --git a/doc/bugs/gitignore_for_DCIM_on_Android_misses_some_files/comment_1_f683ecf93e5a17c5c9c06225dbcce2a9._comment b/doc/bugs/gitignore_for_DCIM_on_Android_misses_some_files/comment_1_f683ecf93e5a17c5c9c06225dbcce2a9._comment
new file mode 100644
index 0000000000..b90108bc4b
--- /dev/null
+++ b/doc/bugs/gitignore_for_DCIM_on_Android_misses_some_files/comment_1_f683ecf93e5a17c5c9c06225dbcce2a9._comment
@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.64"
+ subject="comment 1"
+ date="2013-11-16T22:45:52Z"
+ content="""
+\".thumbnails/*\" in .gitignore makes git ignore dotfiles in the directory in my testing, and according to git's own documentation.
+
+However, it is the case that subdir/.thumbnails/* are not ignored by \".thumbnails/*\", but \".thumbnails\" will indeed ignore .thumbnails directories at any point in the tree. So, I've made the change you suggested.
+
+(I also tested on android, with 1.8.4.1.559 and the assistant was able to honor the .gitignore, and did not add any files from `.thumbnails/`.)
+"""]]
diff --git a/doc/bugs/gpg_fails_on_Mac_OS_10.9_when_creating_a_new_remote_repository_via_assistant.mdwn b/doc/bugs/gpg_fails_on_Mac_OS_10.9_when_creating_a_new_remote_repository_via_assistant.mdwn
new file mode 100644
index 0000000000..1a0680c795
--- /dev/null
+++ b/doc/bugs/gpg_fails_on_Mac_OS_10.9_when_creating_a_new_remote_repository_via_assistant.mdwn
@@ -0,0 +1,55 @@
+### Please describe the problem.
+
+When I use the web app and try to create a remote on a remote server (via ssh connection) the assistant shows a gpg error.
+
+### What steps will reproduce the problem?
+
+1. Start the the web app using git-annex web app
+2. create a local repository
+3. create a new repository on a Remote server (Set up a repository on a remote server using ssh).
+4. provide correct server address, user, port, etc.
+
+Then gpg fails. 
+
+### What version of git-annex are you using? On what operating system?
+
+git-annex version: 4.20131106
+build flags: Assistant Webapp Pairing Testsuite 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 glacier hook
+local repository version: unknown
+default repository version: 3
+supported repository versions: 3 4
+upgrade supported from repository versions: 0 1 2
+
+On Mac OS X 10.9 Mavericks, build 13A603.
+
+### 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
+
+[2013-11-14 21:03:47 CET] main: starting assistant version 4.20131106
+[2013-11-14 21:03:47 CET] Cronner: You should enable consistency checking to protect your data. 
+(Recording state in git...)
+(scanning...) [2013-11-14 21:03:47 CET] Watcher: Performing startup scan
+(started...) [2013-11-14 21:04:47 CET] Cronner: Consistency check in progress
+[2013-11-14 21:05:21 CET] Committer: Adding sunflower.html test.html cindy.css d3.js d3.min.js Accessors.js Essentials.js List.js Namespace.js and 6 other files
+
+(Recording state in git...)
+
+add /Users/ulli/Documents/annex/test.html (checksum...) ok
+### several similar adds removed for privacy reasons.
+ 
+[2013-11-14 21:05:22 CET] Committer: Committing changes to git
+ok
+(Recording state in git...)
+(Recording state in git...)
+14/Nov/2013:21:21:05 +0100 [Error#yesod-core] user error (gpg ["--quiet","--trust-model","always","--with-colons","--list-secret-keys","--fixed-list-mode"] exited 127) @(yesod-core-1.2.5:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:485:5)
+
+# End of transcript or log.
+"""]]
+
+> I've had reports from others that gpg works when installing from the
+> bundle. [[done]] --[[Joey]] 
diff --git a/doc/bugs/gpg_fails_on_Mac_OS_10.9_when_creating_a_new_remote_repository_via_assistant/comment_1_7b409701c650b55b3472accd70555f16._comment b/doc/bugs/gpg_fails_on_Mac_OS_10.9_when_creating_a_new_remote_repository_via_assistant/comment_1_7b409701c650b55b3472accd70555f16._comment
new file mode 100644
index 0000000000..7b1ed74204
--- /dev/null
+++ b/doc/bugs/gpg_fails_on_Mac_OS_10.9_when_creating_a_new_remote_repository_via_assistant/comment_1_7b409701c650b55b3472accd70555f16._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawmkXtBdMgE1d9nCz2iBc4f85xh4izZ_auU"
+ nickname="Ulrich"
+ subject="Easy to fix."
+ date="2013-11-14T20:36:17Z"
+ content="""
+Well, this only happens when gpg is not available. Everything works fine after a quick \"brew install gpg\".
+"""]]
diff --git a/doc/bugs/gpg_fails_on_Mac_OS_10.9_when_creating_a_new_remote_repository_via_assistant/comment_2_40b00f7258512677516ec5036b89090f._comment b/doc/bugs/gpg_fails_on_Mac_OS_10.9_when_creating_a_new_remote_repository_via_assistant/comment_2_40b00f7258512677516ec5036b89090f._comment
new file mode 100644
index 0000000000..ecc9717d2d
--- /dev/null
+++ b/doc/bugs/gpg_fails_on_Mac_OS_10.9_when_creating_a_new_remote_repository_via_assistant/comment_2_40b00f7258512677516ec5036b89090f._comment
@@ -0,0 +1,14 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.246"
+ subject="comment 2"
+ date="2013-11-14T22:10:32Z"
+ content="""
+gpg is included in the bundle though:
+
+
+oberon:tmp joeyh$ /Volumes/git-annex/git-annex.app/Contents/MacOS/runshell
+bash-3.2$ which gpg
+/Volumes/git-annex/git-annex.app/Contents/MacOS/bundle/gpg
+
+"""]] diff --git a/doc/bugs/importfeed_should_allow_pubdate_in_the_template.mdwn b/doc/bugs/importfeed_should_allow_pubdate_in_the_template.mdwn new file mode 100644 index 0000000000..44d25b02d2 --- /dev/null +++ b/doc/bugs/importfeed_should_allow_pubdate_in_the_template.mdwn @@ -0,0 +1,5 @@ +importfeed is a great feature, but it doesn't allow templating the filename with the publish date. + +I would suggest adding pubdate option, which would fix this problem. + +> duplicate of [[todo/importfeed: allow ${itemdate} with --template]] [[done]] --[[Joey]] diff --git a/doc/bugs/internal_server_error:_hGetContents:_invalid_argument___40__invalid_byte_sequence__41__.mdwn b/doc/bugs/internal_server_error:_hGetContents:_invalid_argument___40__invalid_byte_sequence__41__.mdwn new file mode 100644 index 0000000000..8c9703ed23 --- /dev/null +++ b/doc/bugs/internal_server_error:_hGetContents:_invalid_argument___40__invalid_byte_sequence__41__.mdwn @@ -0,0 +1,29 @@ +### Please describe the problem. + +Some logs fail to be displayed, and instead of displaying parts of the log, no logs at all are displayed in the webapp. + +The problem character is, I believe, a latin-1 encoded filename (as opposed to UTF-8). --[[anarcat]] + +### What steps will reproduce the problem? + +1. download [this logfile](http://paste.anarc.at/daemon.log.1) +2. install it in .git/annex/daemon.log +3. load the webapp +4. visit the logs page + +### What version of git-annex are you using? On what operating system? + +4.20131105-g8efdc1a + +### 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 +Internal Server Error +/srv/video/.git/annex/daemon.log.1: hGetContents: invalid argument (invalid byte sequence) +git-annex version 4.20131105-g8efdc1a +# End of transcript or log. +"""]] + +> [[fixed|done]] --[[Joey]] diff --git a/doc/bugs/internal_server_error:_unknown_UUID_on_webapp.mdwn b/doc/bugs/internal_server_error:_unknown_UUID_on_webapp.mdwn new file mode 100644 index 0000000000..307eed308a --- /dev/null +++ b/doc/bugs/internal_server_error:_unknown_UUID_on_webapp.mdwn @@ -0,0 +1,147 @@ +### Please describe the problem. + +I am having trouble using the webapp with a setup I did on the commandline that was working fine. + +I have two machines: one, a server called `marcos`, is available on the internetz and I cloned a repo from there into `markov`, a workstation that is hidden behind a NAT connexion (so I can't add it as a remote). + +It seems that because the remote is not locally available as a git remote, the webapp is freaking out because it doesn't recognize `markov` as a proper remote. + +### What steps will reproduce the problem? + +1. setup git annex locally (on `marcos`) in a repository (probably `git annex init; git annex direct; git annex add .` i somewhat followed [[tips/Git_annex_and_Calibre/]]) +2. `git clone` that repo on a remote, unaccessible (NAT'd) server (`markov`) +3. start doing some git annex get, get tired, run the web app on `markov` +4. let that run over there, go back to `marcos` +5. be curious about what is going on on `markov`, run the webapp and enter the path to the repository created in step one when prompted (it's the first time i run the webapp) +6. it starts up fine, but doesn't seem to detect `markov`, marking transfers as going to the remote named `unknown` +7. click on the `unknown` link, crash +8. go back to the dashboard, crash + +From there on, the webapp is pretty much crashed, starting it from scratch asks me if i want to create a git annex repo. + +### What version of git-annex are you using? On what operating system? + +4.20130921-gd4739c5 compiled and installed by hand on debian wheezy. + +### Please provide any additional information below. + +[[!format sh """ +# Here's everything that has been logged by the git-annex assistant, as well as by programs it has run. + +[2013-11-04 22:42:50 EST] main: starting assistant version 4.20130921-gd4739c5 +(merging synced/git-annex into git-annex...) +(Recording state in git...) + + No known network monitor available through dbus; falling back to polling +Already up-to-date. + +(scanning...) [2013-11-04 22:42:50 EST] Watcher: Performing startup scan +04/Nov/2013:22:42:51 -0500 [Error#yesod-core] Unknown UUID @(yesod-core-1.2.4.2:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:485:5) +04/Nov/2013:22:42:52 -0500 [Error#yesod-core] Unknown UUID @(yesod-core-1.2.4.2:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:485:5) +04/Nov/2013:22:42:52 -0500 [Error#yesod-core] Unknown UUID @(yesod-core-1.2.4.2:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:485:5) +(Recording state in git...) +(Recording state in git...) +(started...) + + metadata.db still has writers, not adding +[2013-11-04 22:42:59 EST] Committer: Adding cover.jpg Ars Techn..ibre.epub Cyberpres..ibre.epub cover.jpg cover.jpg Ars Techn..ibre.epub cover.jpg Democracy..ibre.epub cover.jpg and 11 other files +add Calibre/Ars Technica [dim., 03 nov. 2013] (645)/cover.jpg (checksum...) ok +add Calibre/Ars Technica [dim., 03 nov. 2013] (645)/Ars Technica [dim., 03 nov. 2013] - Calibre.epub (checksum...) ok +add Calibre/Cyberpresse [lun., 04 nov. 2013] (647)/Cyberpresse [lun., 04 nov. 2013] - Calibre.epub (checksum...) ok +add Calibre/Cyberpresse [lun., 04 nov. 2013] (647)/cover.jpg (checksum...) ok +add Calibre/Ars Technica [sam., 02 nov. 2013] (642)/cover.jpg (checksum...) ok +add Calibre/Ars Technica [sam., 02 nov. 2013] (642)/Ars Technica [sam., 02 nov. 2013] - Calibre.epub (checksum...) ok +add Calibre/Democracy now! [lun., 04 nov. 2013] (649)/cover.jpg (checksum...) ok +add Calibre/Democracy now! [lun., 04 nov. 2013] (649)/Democracy now! [lun., 04 nov. 2013] - Calibre.epub (checksum...) ok +add Calibre/xkcd [lun., 04 nov. 2013] (646)/cover.jpg (checksum...) ok +add Calibre/xkcd [lun., 04 nov. 2013] (646)/xkcd [lun., 04 nov. 2013] - Calibre.epub (checksum...) ok +add Calibre/Cyberpresse [dim., 03 nov. 2013] (644)/cover.jpg (checksum...) ok +add Calibre/Cyberpresse [dim., 03 nov. 2013] (644)/Cyberpresse [dim., 03 nov. 2013] - Calibre.epub (checksum...) ok +add Calibre/Le Devoir [sam., 02 nov., 2013] (640)/cover.jpg (checksum...) ok +add Calibre/Le Devoir [sam., 02 nov., 2013] (640)/Le Devoir [sam., 02 nov., 2013] - Calibre.epub (checksum...) ok +add Calibre/Le Devoir [lun., 04 nov., 2013] (648)/cover.jpg (checksum...) ok +add Calibre/Le Devoir [lun., 04 nov., 2013] (648)/Le Devoir [lun., 04 nov., 2013] - Calibre.epub (checksum...) ok +add Calibre/Cyberpresse [sam., 02 nov. 2013] (641)/cover.jpg (checksum...) ok +add Calibre/Cyberpresse [sam., 02 nov. 2013] (641)/Cyberpresse [sam., 02 nov. 2013] - Calibre.epub (checksum...) ok +add Calibre/Le Devoir [dim., 03 nov., 2013] (643)/cover.jpg (checksum...) ok +add Calibre/Le Devoir [dim., 03 nov., 2013] (643)/Le Devoir [dim., 03 nov., 2013] - Calibre.epub (checksum...) [2013-11-04 22:43:01 EST] Committer: Committing changes to git +ok +(Recording state in git...) +(Recording state in git...) +04/Nov/2013:22:43:51 -0500 [Error#yesod-core] Unknown UUID @(yesod-core-1.2.4.2:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:485:5) +04/Nov/2013:22:47:24 -0500 [Error#yesod-core] Unknown UUID @(yesod-core-1.2.4.2:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:485:5) +04/Nov/2013:22:47:24 -0500 [Error#yesod-core] Unknown UUID @(yesod-core-1.2.4.2:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:485:5) +04/Nov/2013:22:47:24 -0500 [Error#yesod-core] Unknown UUID @(yesod-core-1.2.4.2:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:485:5) +04/Nov/2013:22:52:29 -0500 [Error#yesod-core] Unknown UUID @(yesod-core-1.2.4.2:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:485:5) +04/Nov/2013:22:52:30 -0500 [Error#yesod-core] Unknown UUID @(yesod-core-1.2.4.2:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:485:5) +04/Nov/2013:22:52:30 -0500 [Error#yesod-core] Unknown UUID @(yesod-core-1.2.4.2:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:485:5) +04/Nov/2013:22:56:47 -0500 [Error#yesod-core] Unknown UUID @(yesod-core-1.2.4.2:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:485:5) +[2013-11-04 22:57:08 EST] Committer: Adding metadata.db-journal +add metadata.db-journal (checksum...) [2013-11-04 22:57:08 EST] Committer: Committing changes to git +[2013-11-04 22:57:09 EST] Committer: Adding metadata.db-journal metadata.db +ok +(Recording state in git...) +(Recording state in git...) +add metadata.db (checksum...) [2013-11-04 22:57:09 EST] Committer: Committing changes to git +ok +(Recording state in git...) +(Recording state in git...) +04/Nov/2013:22:57:12 -0500 [Error#yesod-core] Unknown UUID @(yesod-core-1.2.4.2:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:485:5) +04/Nov/2013:22:57:15 -0500 [Error#yesod-core] Unknown UUID @(yesod-core-1.2.4.2:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:485:5) +04/Nov/2013:22:57:18 -0500 [Error#yesod-core] Unknown UUID @(yesod-core-1.2.4.2:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:485:5) +04/Nov/2013:22:57:20 -0500 [Error#yesod-core] Unknown UUID @(yesod-core-1.2.4.2:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:485:5) +"""]] + +> I wonder if this couldn't be related to [[cannot determine uuid for origin]], although in this case the remote is just not added to `.git/config`. --[[anarcat]] + +> This was fixed in commit 44e1524be53373ddbf28d643bedf5455433c2b2e +> on Sep 29th. You should update. [[done]] +> +> (It also sounds like your repository on markov is for some reason not +> able to push its git repository to marcos. You might need to fix +> something in your setup to get syncing working) --[[Joey]] +> +> > Humm.. Weird. Upgrading fixes the crash, but `marcos` still sees only +> > one repository. It sees some syncs going on from `unknown`, and when +> > I click on that `unknown` link, I get to edit that repository, and +> > it sees it as `here`. So I am not sure I understand what is going +> > on here. +> > +> > (As for the repo on `markov`, it does sync properly: +> > +> > anarcat@desktop008:books$ git annex sync +> > commit +> > ok +> > pull origin +> > From anarc.at:/srv/books +> > 3b4fa7b..c35b13e git-annex -> origin/git-annex +> > ok +> > +> > Or rather - it doesn't fail. But it doesn't push! +> > +> > anarcat@desktop008:books$ git push +> > Everything up-to-date +> > +> > Note that git on `marcos` is the 1.8.4 backport for some reason. +> > I know that branch tracking changed with that release, maybe +> > that's the problem? --[[anarcat]]) +> > +> > > So yep, I confirm that even in 4.20131105-g8efdc1a, the webapp +> > > doesn't find the `markov` remote properly, even though +> > > `git annex status` can: +> > > +> > > $ git annex status +> > > repository mode: direct +> > > trusted repositories: 0 +> > > semitrusted repositories: 3 +> > > 00000000-0000-0000-0000-000000000001 -- web +> > > a75cbbf7-e055-423e-b375-443e0552c9e2 -- here (anarcat@marcos:/srv/books) +> > > aa500f29-42d9-4777-ae02-4a2c3d47db44 -- anarcat@markov:~/books +> > > +> > > I see transfers happening, but they go to "unknown". The link is: +> > > +> > > http://127.0.0.1:56577/config/repository/edit/UUID%20%22aa500f29-42d9-4777-ae02-4a2c3d47db44%22?auth=... +> > > +> > > -- [[anarcat]] +> > > +> > > > I have filed this as a separate bug to close the discussion properly here, sorry for the noise. :) see [[bugs/remote_not_showing_up_in_webapp]] --[[anarcat]] diff --git a/doc/bugs/microsd__47__thumbdrives_seem_to_die_when_using_the_ARM_build/comment_2_926a87b60e20d286d49639c8dad13a1a._comment b/doc/bugs/microsd__47__thumbdrives_seem_to_die_when_using_the_ARM_build/comment_2_926a87b60e20d286d49639c8dad13a1a._comment new file mode 100644 index 0000000000..878e8fd7df --- /dev/null +++ b/doc/bugs/microsd__47__thumbdrives_seem_to_die_when_using_the_ARM_build/comment_2_926a87b60e20d286d49639c8dad13a1a._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.47" + subject="correlation does not imply causation" + date="2013-11-01T16:37:31Z" + content=""" +I've been using git-annex on thumbdrives for years without problems. It seems more likely to me that you have a general problem with your hardware than that one program that does nothing special is somehow at fault. +"""]] diff --git a/doc/bugs/microsd__47__thumbdrives_seem_to_die_when_using_the_ARM_build/comment_3_c509fba1a9adacfd26a2bd12b4aea988._comment b/doc/bugs/microsd__47__thumbdrives_seem_to_die_when_using_the_ARM_build/comment_3_c509fba1a9adacfd26a2bd12b4aea988._comment new file mode 100644 index 0000000000..01ab119d27 --- /dev/null +++ b/doc/bugs/microsd__47__thumbdrives_seem_to_die_when_using_the_ARM_build/comment_3_c509fba1a9adacfd26a2bd12b4aea988._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnZEanlyzay_QlEAL0CWpyZcRTyN7vay8U" + nickname="Carlo" + subject="comment 3" + date="2013-11-02T17:29:55Z" + content=""" +True, and good to know. Didn't necessarily want to trigger a big bug hunt here anyway, just some data/logs in case any more correlation comes up. +"""]] diff --git a/doc/bugs/non-repos_in_repositories_list___40__+_other_weird_output__41___from_git_annex_status/comment_4_d0e55585f1612148163039d157253258._comment b/doc/bugs/non-repos_in_repositories_list___40__+_other_weird_output__41___from_git_annex_status/comment_4_d0e55585f1612148163039d157253258._comment index dccc5cd6a3..1e2a8fe247 100644 --- a/doc/bugs/non-repos_in_repositories_list___40__+_other_weird_output__41___from_git_annex_status/comment_4_d0e55585f1612148163039d157253258._comment +++ b/doc/bugs/non-repos_in_repositories_list___40__+_other_weird_output__41___from_git_annex_status/comment_4_d0e55585f1612148163039d157253258._comment @@ -4,7 +4,7 @@ subject="comment 4" date="2013-07-26T16:52:26Z" content=""" -The 4201 dangling blobs is a little bit strange, although it could certianly happen in some normal scenarios. +The 4201 dangling blobs is a little bit strange, although it could certainly happen in some normal scenarios. Overall, your repository seems to be ok except for this weird data in the one file. I do not anticipate the extra garbage causing any problems at all. To track this down, we need to find the commit that added the garbage. One way, assuming you're using indirect mode, is to `git checkout git-annex; git blame uuid.log` and `git show` the commit that added the garbage. If you're using direct mode, you should first `git clone` the repository and do that in the clone. diff --git a/doc/bugs/remote_not_showing_up_in_webapp.mdwn b/doc/bugs/remote_not_showing_up_in_webapp.mdwn new file mode 100644 index 0000000000..f8b4da7b1e --- /dev/null +++ b/doc/bugs/remote_not_showing_up_in_webapp.mdwn @@ -0,0 +1,88 @@ +### Please describe the problem. + +This is a followup on [[bugs/internal_server_error:_unknown_UUID_on_webapp]]. In that issue, webapps previous to 20130929 would crash with `internal server error: unknown UUID`. This was fixed at that date, but some problems remain, namely that the remote that is recognized on the commandline doesn't show up in the webapp. + +`markov` is able to push to `marcos`, but not the reverse because `markov` is hidden behind a NAT. `git annex sync` seems to do the right thing accordingly on both ends (which is: `marcos` doesn't try to push to `markov` but `markov` pushes to `marcos`). + +### What steps will reproduce the problem? + +See [[bugs/internal_server_error:_unknown_UUID_on_webapp]]. I didn't do any further changes other than upgrade `git-annex` on both ends. + +### What version of git-annex are you using? On what operating system? + +`marcos` is now running `Version: 4.20131105-g8efdc1a Build flags: Assistant Webapp Pairing Testsuite S3 WebDAV Inotify DBus XMPP DNS Feeds Quvi TDFA CryptoHash` + +`markov` is now running the wheezy backport, `4.20131002~bpo70+1`. + +### Please provide any additional information below. + +#### On `marcos` + +Here's the output of `git annex status` on `marcos`: + +[[!format sh """ +anarcat@marcos:books$ git annex status +repository mode: direct +trusted repositories: 0 +semitrusted repositories: 3 + 00000000-0000-0000-0000-000000000001 -- web + a75cbbf7-e055-423e-b375-443e0552c9e2 -- here (anarcat@marcos:/srv/books) + aa500f29-42d9-4777-ae02-4a2c3d47db44 -- anarcat@markov:~/books +untrusted repositories: 0 +transfers in progress: none +available local disk space: 7.04 gigabytes (+1 megabyte reserved) +local annex keys: 736 +local annex size: 3.92 gigabytes +annexed files in working tree: 721 +size of annexed files in working tree: 3.92 gigabytes +bloom filter size: 16 mebibytes (0.1% full) +backend usage: + SHA256E: 1457 +# End of transcript or log. +"""]] + +Here's a screenshot of the idle webapp on marcos: + + + +You can clearly see that the webapp doesn't see the `markov` remote. + +When `markov` transfers stuff, `marcos` sees the transfers happening, but marks it as going to the `unknown` remote: + + + +Clicking on that link is what was previously triggering [[bugs/internal_server_error:_unknown_UUID_on_webapp]] but now yields a "Unknown remote" error. + + + +#### On `markov`: + +Here is a screenshot from `markov` that shows *it* knows about both repositories and seem to behave properly: + + + +And here's the output of `git annex status` on markov: + +[[!format sh """ +anarcat@desktop008:books$ git annex status +repository mode: indirect +trusted repositories: 0 +semitrusted repositories: 3 + 00000000-0000-0000-0000-000000000001 -- web + a75cbbf7-e055-423e-b375-443e0552c9e2 -- origin (anarcat@marcos:/srv/books) + aa500f29-42d9-4777-ae02-4a2c3d47db44 -- here (anarcat@markov:~/books) +untrusted repositories: 0 +transfers in progress: + downloading Patrick K. O'Brien/Philip's Atlas of World History, Concise Edition (115)/Philip's Atlas of World History, Concise Edition - Patrick K. O'Brien.pdf from origin +available local disk space: 93.25 gigabytes (+1 megabyte reserved) +temporary directory size: 50.07 megabytes (clean up with git-annex unused) +local annex keys: 708 +local annex size: 3.81 gigabytes +known annex keys: 721 +known annex size: 3.92 gigabytes +bloom filter size: 16 mebibytes (0.1% full) +backend usage: + SHA256E: 1429 +"""]] + +Finally, note that you sometimes see `desktop008` above: it turns out I am running `git annex` from my workstation, which NFS-mounts the `/home` directory of `markov` into `/srv/musique`. --[[anarcat]] diff --git a/doc/bugs/remote_not_showing_up_in_webapp/comment_1_2a269732fd528f505777542d3556437a._comment b/doc/bugs/remote_not_showing_up_in_webapp/comment_1_2a269732fd528f505777542d3556437a._comment new file mode 100644 index 0000000000..4582a30715 --- /dev/null +++ b/doc/bugs/remote_not_showing_up_in_webapp/comment_1_2a269732fd528f505777542d3556437a._comment @@ -0,0 +1,17 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.47" + subject="comment 1" + date="2013-11-06T16:38:47Z" + content=""" +marcov does not show up in the webapp because there is no configured git remote for it. + +This is a slightly confusing corner of the webapp. The webapp will show repositories that do not have a configured remote, but it only does it for special remotes. ssh repos, being regular git remotes, don't currently show up in the webapp unless that repository is actually set up as a remote. + +It should certainly not show it as \"unknown\"; it would be much better to use the full repo description here, since it does not have a remote name. +(Unless the description is really long!) + +I think you'll also get the \"unknown uuid\" screen even for a special remote that is not configured in the local repository. So that needs to be fixed. + +Finally, it would probably be good for the webapp to show ssh repos that don't have remotes as existing, and let the user enter a ssh address to configure them. The problem with trying to do this is it actually has no idea that this is a ssh repo. It could just as easily be a local directory. The UI to configure it would be pretty elaborate. +"""]] diff --git a/doc/bugs/rename:_permission_denied__44___after_direct_mode_switch/comment_2_93af8f48a01b6e2d011bd6f60499ccd2._comment b/doc/bugs/rename:_permission_denied__44___after_direct_mode_switch/comment_2_93af8f48a01b6e2d011bd6f60499ccd2._comment new file mode 100644 index 0000000000..a0e73cc5e0 --- /dev/null +++ b/doc/bugs/rename:_permission_denied__44___after_direct_mode_switch/comment_2_93af8f48a01b6e2d011bd6f60499ccd2._comment @@ -0,0 +1,23 @@ +[[!comment format=mdwn + username="http://nicolas-schodet.myopenid.com/" + ip="81.56.19.53" + subject="comment 2" + date="2013-11-23T14:38:21Z" + content=""" +Here are the files in details: + +[[!format sh \"\"\" +Umba:.../.git$ ls -ld $(find . -name SHA256-s2819887-\*) # the bad file +drwxr-xr-t 4 marie-eve staff 136 Aug 17 17:05 ./annex/objects/wq/3j/SHA256-s2819887--987f9811d7b5c7a287a74b7adbb852be4d18eeda61c3507f4e08c534d2356f4c/ +-rw-r--r-- 1 marie-eve staff 560 Nov 23 15:25 ./annex/objects/wq/3j/SHA256-s2819887--987f9811d7b5c7a287a74b7adbb852be4d18eeda61c3507f4e08c534d2356f4c/SHA256-s2819887--987f9811d7b5c7a287a74b7adbb852be4d18eeda61c3507f4e08c534d2356f4c.cache +-rw------- 1 marie-eve staff 33 Aug 17 17:05 ./annex/objects/wq/3j/SHA256-s2819887--987f9811d7b5c7a287a74b7adbb852be4d18eeda61c3507f4e08c534d2356f4c/SHA256-s2819887--987f9811d7b5c7a287a74b7adbb852be4d18eeda61c3507f4e08c534d2356f4c.map +-rw-r--r-- 1 marie-eve staff 52 Aug 17 17:06 ./annex/transfer/failed/download/13fd5d5a-ed97-11e2-9178-574d3b1c0618/SHA256-s2819887--987f9811d7b5c7a287a74b7adbb852be4d18eeda61c3507f4e08c534d2356f4c +-rw-r--r-- 1 marie-eve staff 51 Aug 17 10:13 ./annex/transfer/failed/download/95443f2e-ed96-11e2-9d3f-8ffa5b1aae7a/SHA256-s2819887--987f9811d7b5c7a287a74b7adbb852be4d18eeda61c3507f4e08c534d2356f4c +Umba:.../.git$ ls -ld $(find . -name SHA256-s5066556-\*) # a good file +dr-xr-xr-x 3 marie-eve staff 102 Nov 23 15:27 ./annex/objects/Fx/w0/SHA256-s5066556--0e4a47efdc14c884d07c017ba5506a56affb136d87bef5700145774fd9089f25/ +-r--r--r-- 1 marie-eve staff 5066556 Nov 6 17:43 ./annex/objects/Fx/w0/SHA256-s5066556--0e4a47efdc14c884d07c017ba5506a56affb136d87bef5700145774fd9089f25/SHA256-s5066556--0e4a47efdc14c884d07c017ba5506a56affb136d87bef5700145774fd9089 +Umba:.../.git$ +\"\"\"]] + +No more idea on how it reached this situation. +"""]] diff --git a/doc/bugs/rename:_permission_denied__44___after_direct_mode_switch/comment_3_f8fba1955e62360061613e5898b3d74e._comment b/doc/bugs/rename:_permission_denied__44___after_direct_mode_switch/comment_3_f8fba1955e62360061613e5898b3d74e._comment new file mode 100644 index 0000000000..d7d05da85d --- /dev/null +++ b/doc/bugs/rename:_permission_denied__44___after_direct_mode_switch/comment_3_f8fba1955e62360061613e5898b3d74e._comment @@ -0,0 +1,16 @@ +[[!comment format=mdwn + username="http://nicolas-schodet.myopenid.com/" + ip="81.56.19.53" + subject="comment 3" + date="2013-11-23T15:42:26Z" + content=""" +The link seems to be special: + +[[!format sh \"\"\" +Umba:2013-07-31$ ls -lO 2013-07-31_180411.jpg +lrwxr-xr-x 1 marie-eve staff uchg 191 Aug 12 21:45 2013-07-31_180411.jpg@ -> ../.git/annex/objects/wq/3j/SHA256-s2819887--987f9811d7b5c7a287a74b7adbb852be4d18eeda61c3507f4e08c534d2356f4c/SHA256-s2819887--987f9811d7b5c7a287a74b7adbb852be4d18eeda61c3507f4e08c534d2356f4c +Umba:2013-07-31$ +\"\"\"]] + +I tried the chflags command with no success... I suppose I need a MAC specialist. +"""]] diff --git a/doc/bugs/repair_fails_when_home_on_seperate_partition.mdwn b/doc/bugs/repair_fails_when_home_on_seperate_partition.mdwn new file mode 100644 index 0000000000..19780c7dec --- /dev/null +++ b/doc/bugs/repair_fails_when_home_on_seperate_partition.mdwn @@ -0,0 +1,60 @@ +### Please describe the problem. + + +### What steps will reproduce the problem? + +(1) Place a broken repo on a different mount point than the root partition. + +(2) Run + git annex repair. + +### What version of git-annex are you using? On what operating system? + + 5.20131118-gc7e5cde on Ubuntu 12.04 + +### 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 annex repair --force + +Running git fsck ... +git fsck found 74 broken objects. +Unpacking all pack files. +Unpacking objects: 100% (2307/2307), done. +Unpacking objects: 100% (241565/241565), done. +Re-running git fsck to see if it finds more problems. +Initialized empty Git repository in /tmp/tmprepo.0/.git/ +Trying to recover missing objects from remote pi.fritz.box__var_lib_store_annex +Trying to recover missing objects from remote pi.fritz.box__var_lib_store_annex +74 missing objects could not be recovered! + + +Deleted remote branch pi.fritz.box__var_lib_store_annex/master (was dffa056). +error: Could not read 4e01bbdc7ce31247ad66ab13ca46925ac2c8db9a +fatal: Failed to traverse parents of commit 718525a48b4d6b3404eda5e189332d73c968a2be +Deleted remote branch pi.fritz.box__var_lib_store_annex/synced/git-annex (was 718525a). +Deleted remote branch pi.fritz.box__var_lib_store_annex/synced/master (was 9aedf69). +Deleted remote branch pi.fritz.box_annex/synced/master (was 92b1042). +Deleted remote branch store/master (was b059380). +removed 5 remote tracking branches that referred to missing objects +fatal: bad object refs/heads/git-annex +fatal: bad object refs/heads/git-annex +fatal: bad object refs/heads/git-annex +error: remote branch 'git-annex' not found. + +git-annex: /tmp/packed-refs19813: rename: unsupported operation (Invalid cross-device link) +failed +git-annex: repair: 1 failed + + +# End of transcript or log. +"""]] + +> Thanks for reporting. As far as I can see, this was fixed +> accidentially, when I rewrote the packed refs file handling code to not +> re-write the file. It had been using a temp file, and renaming it, thus +> the problem. I checked the repair code and can find no other probems +> of this sort currently in it. [[done]] --[[Joey]] diff --git a/doc/bugs/size_of_the_Android_installation_is_HUGE_--_please_seek_possibility_to_shrink.mdwn b/doc/bugs/size_of_the_Android_installation_is_HUGE_--_please_seek_possibility_to_shrink.mdwn new file mode 100644 index 0000000000..3f8c7fc482 --- /dev/null +++ b/doc/bugs/size_of_the_Android_installation_is_HUGE_--_please_seek_possibility_to_shrink.mdwn @@ -0,0 +1,41 @@ +### Please describe the problem. + +ATM git annex assistant app is the largest one installed on my phone. I simply keep hitting the available storage space limits and keep pruning some apps + +According to file +$> file lib/armeabi/lib.git-annex.so +lib/armeabi/lib.git-annex.so: ELF 32-bit LSB executable, ARM, EABI5 version 1 (SYSV), dynamically linked (uses shared libs), not stripped +so largest annex's .so is 133M and is not stripped. stripping it seems to half its size: + +$> ls -l lib.git-annex.so +62052 -rw------- 1 yoh yoh 63468304 Nov 25 22:21 lib.git-annex.so +$> file lib.git-annex.so +lib.git-annex.so: ELF 32-bit LSB executable, ARM, version 1 (SYSV), dynamically linked (uses shared libs), stripped + +so may be it could be the first step to make the .apk and installation itself more lightweight and thus easier to "manage" + +thanks in advance + +### What steps will reproduce the problem? + +install provided .apk on Android + +### What version of git-annex are you using? On what operating system? + +Android, just fetched the most recent "release" apk from the +http://downloads.kitenet.net/git-annex/android/current/4.0/git-annex.apk +Last-Modified: Mon, 18 Nov 2013 11:57:25 GMT + +### 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. +"""]] + +> Seems that I lost stripping of the git-annex binary when adding the build +> for the newer android versions. [[fixed|done]] (There is not otherwise +> much way to shrink the size.) --[[Joey]] diff --git a/doc/bugs/size_of_the_Android_installation_is_HUGE_--_please_seek_possibility_to_shrink/comment_1_d2faaff98386433110dcf7aae87916b7._comment b/doc/bugs/size_of_the_Android_installation_is_HUGE_--_please_seek_possibility_to_shrink/comment_1_d2faaff98386433110dcf7aae87916b7._comment new file mode 100644 index 0000000000..894c487841 --- /dev/null +++ b/doc/bugs/size_of_the_Android_installation_is_HUGE_--_please_seek_possibility_to_shrink/comment_1_d2faaff98386433110dcf7aae87916b7._comment @@ -0,0 +1,9 @@ +[[!comment format=mdwn + username="http://yarikoptic.myopenid.com/" + nickname="site-myopenid" + subject="sure there is no other ways to shrink?" + date="2013-11-27T04:26:35Z" + content=""" +Might be quite a stretch but it is hard to grasp that all 60MB are really needed... although with haskell -- it might indeed be the case, but I thought that may be there could be some symbols pulled in which aren't used, and for which when in gcc/ld world there are ways to get rid of them, e.g. -dead_strip (just excercising ideas) + +"""]] diff --git a/doc/bugs/size_of_the_Android_installation_is_HUGE_--_please_seek_possibility_to_shrink/comment_2_1359ddf1b5db4303f8bd219d3f07df3a._comment b/doc/bugs/size_of_the_Android_installation_is_HUGE_--_please_seek_possibility_to_shrink/comment_2_1359ddf1b5db4303f8bd219d3f07df3a._comment new file mode 100644 index 0000000000..5f7688d1fe --- /dev/null +++ b/doc/bugs/size_of_the_Android_installation_is_HUGE_--_please_seek_possibility_to_shrink/comment_2_1359ddf1b5db4303f8bd219d3f07df3a._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.64" + subject="comment 2" + date="2013-11-27T04:55:51Z" + content=""" +The git-annex binary is around 45 mb on Linux. The android binary statically links a few additional C libraries, so is slightly larger. + +The only way I know of to potentially shrink it is to fix certian ghc / ld interactions that, in my limited understanding, cause functions that are never used to be linked into the binary if another function in the same file (or module) is used. That might half its size or something. +"""]] diff --git a/doc/bugs/ssh-keygen_failed_when_adding_remote_server_repo.mdwn b/doc/bugs/ssh-keygen_failed_when_adding_remote_server_repo.mdwn index 671041e671..3aa3188afe 100644 --- a/doc/bugs/ssh-keygen_failed_when_adding_remote_server_repo.mdwn +++ b/doc/bugs/ssh-keygen_failed_when_adding_remote_server_repo.mdwn @@ -40,3 +40,5 @@ ssh-keygen: symbol lookup error: /lib64/libldap-2.4.so.2: undefined symbol: ber_ # End of transcript or log. """]] + +> Added ssh-keygen to bundle. [[fixed|done]] --[[Joey]] diff --git a/doc/bugs/ssh-keygen_failed_when_adding_remote_server_repo/comment_1_52180983b59c247389a55a9523ec435b._comment b/doc/bugs/ssh-keygen_failed_when_adding_remote_server_repo/comment_1_52180983b59c247389a55a9523ec435b._comment new file mode 100644 index 0000000000..f0f50151ac --- /dev/null +++ b/doc/bugs/ssh-keygen_failed_when_adding_remote_server_repo/comment_1_52180983b59c247389a55a9523ec435b._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="108.236.230.124" + subject="comment 1" + date="2013-11-08T18:28:37Z" + content=""" +Apologies for not following up on this bug sooner.. + +It seems to me that your system has a broken ssh-keygen program. You didn't say how you installed git-annex, but based on the git rev in the version number, I'm guessing you either built it yourself, or you're using the standalone tarball I build. + +In the case of the latter, it didn't include ssh-keygen, so would try to use the one that comes with fedora. It seems likely that the problem comes from the libraries included in the bundle being used with a binary not in the bundle, that in turn is also using additional libraries. + +So, I think I should add ssh-keygen to the standalone bundle! +"""]] diff --git a/doc/bugs/test_failures_on_window_for_5.20131118.mdwn b/doc/bugs/test_failures_on_window_for_5.20131118.mdwn new file mode 100644 index 0000000000..490bdf2c83 --- /dev/null +++ b/doc/bugs/test_failures_on_window_for_5.20131118.mdwn @@ -0,0 +1,20 @@ +### Please describe the problem. + +git annex test reports failures + +### What steps will reproduce the problem? + +running git annex test (from standard cmd, with: git version: 1.7.11.msysgit.1) + +### What version of git-annex are you using? On what operating system? + +5.20131118 from installers + +### Please provide any additional information below. + +operating system: + +windows XP, NTFS = 1 FAIL +windows 7, NTFS = 2 FAILs + +see attachment for full log of git annex test output diff --git a/doc/bugs/test_failures_on_window_for_5.20131118/comment_1_5a7a284625c12d54390fe4a4ec1d4211._comment b/doc/bugs/test_failures_on_window_for_5.20131118/comment_1_5a7a284625c12d54390fe4a4ec1d4211._comment new file mode 100644 index 0000000000..d27e69b305 --- /dev/null +++ b/doc/bugs/test_failures_on_window_for_5.20131118/comment_1_5a7a284625c12d54390fe4a4ec1d4211._comment @@ -0,0 +1,188 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkJafmCf-sg9_OM0pynFYM3AO4WCgJiaMI" + nickname="Michele" + subject="seems i'm not allowed to attach full logs." + date="2013-11-23T16:06:17Z" + content=""" +here's an excerpt (the context of FAIL), hopefully i've interpreted correctely the test begin message. + +win7: + + unannex (with copy): Detected a filesystem without fifo support. + Disabling ssh connection caching. + Detected a crippled filesystem. + Enabling direct mode. +get foo (merging origin/git-annex into git-annex...) +(Recording state in git...) +(from origin...) +foo + 20 100% 0.00kB/s 0:00:00 + 20 100% 0.00kB/s 0:00:00 (xfer#1, to-check=0/1) + +sent 87 bytes received 31 bytes 236.00 bytes/sec +total size is 20 speedup is 0.17 +ok +(Recording state in git...) +unannex foo +git-annex: M:\gitannex.test\.t\tmprepo4\.git\annex\objects\6cd\e82\SHA256E-s20--e394a389d787383843decc5d3d99b6d184ffa5fddeec23b911f9ee7fc8b9ea77\SHA256E-s20--e394a389d787383843decc5d3d99b6d184ffa5fddeec23b911f9ee7fc8b9ea77.map4432.tmp: MoveFileEx \"M:\\gitannex.test\\.t\\tmprepo4\\.git\\annex\\objects\\6cd\\e82\\SHA256E-s20--e394a389d787383843decc5d3d99b6d184ffa5fddeec23b911f9ee7fc8b9ea77\\SHA256E-s20--e394a389d787383843decc5d3d99b6d184ffa5fddeec23b911f9ee7fc8b9ea77.map4432.tmp\" \"M:\\gitannex.test\\.t\\tmprepo4\\.git\\annex\\objects\\6cd\\e82\\SHA256E-s20--e394a389d787383843decc5d3d99b6d184ffa5fddeec23b911f9ee7fc8b9ea77\\SHA256E-s20--e394a389d787383843decc5d3d99b6d184ffa5fddeec23b911f9ee7fc8b9ea77.map\": permission denied (Access is denied.) +failed +git-annex: unannex: 1 failed +FAIL + + conflict_resolution (mixed directory and file): Detected a filesystem without fifo support. + Disabling ssh connection caching. + Detected a crippled filesystem. + Enabling direct mode. + Detected a filesystem without fifo support. + Disabling ssh connection caching. + Detected a crippled filesystem. + Enabling direct mode. + add conflictor (checksum...) ok + (Recording state in git...) + (merging origin/git-annex origin/synced/git-annex into git-annex...) + (Recording state in git...) + commit + ok + pull origin bash.exe: warning: could not find /tmp, please create! + + ok + push origin bash.exe: warning: could not find /tmp, please create! + To M:/gitannex.test/.t\repo + 32fb7c0..38147e0 git-annex -> synced/git-annex + 7684984..4116595 annex/direct/master -> synced/master + + ok + add conflictor/subfile (checksum...) ok + (Recording state in git...) + (merging origin/git-annex origin/synced/git-annex into git-annex...) + (Recording state in git...) + commit + ok + pull origin bash.exe: warning: could not find /tmp, please create! + From M:/gitannex.test/.t\repo + 7684984..4116595 master -> origin/master + 32fb7c0..38147e0 synced/git-annex -> origin/synced/git-annex + 7684984..4116595 synced/master -> origin/synced/master + Adding conflictor/subfile + CONFLICT (directory/file): There is a directory with name conflictor in HEAD. Adding conflictor as conflictor~refs_remotes_origin_synced_master + Automatic merge failed; fix conflicts and then commit the result. + Ignoring path ./conflictor.variant-cc12 + conflictor: needs merge + [annex/direct/master 27c52e4] git-annex automatic merge conflict fix + + + (Recording state in git...) + + Merge conflict was automatically resolved; you may want to examine the result. + ok + (merging origin/synced/git-annex into git-annex...) + (Recording state in git...) + push origin bash.exe: warning: could not find /tmp, please create! + To M:/gitannex.test/.t\repo + 38147e0..02916ee git-annex -> synced/git-annex + 4116595..27c52e4 annex/direct/master -> synced/master + + ok + commit + ok + pull r2 bash.exe: warning: could not find /tmp, please create! + From ../../.t\tmprepo35 + * [new branch] annex/direct/master -> r2/annex/direct/master + * [new branch] git-annex -> r2/git-annex + * [new branch] master -> r2/master + * [new branch] synced/master -> r2/synced/master + Updating 4116595..27c52e4 + Fast-forward + conflictor | 1 - + conflictor/subfile | 1 + + 2 files changed, 1 insertion(+), 1 deletion(-) + delete mode 120000 conflictor + create mode 120000 conflictor/subfile + Already up-to-date. + + + + ok + (merging r2/git-annex into git-annex...) + FAIL + + +windowsXP: + + conflict_resolution (mixed directory and file): Detected a filesystem without fifo support. + Disabling ssh connection caching. + Detected a crippled filesystem. + Enabling direct mode. + Detected a filesystem without fifo support. + Disabling ssh connection caching. + Detected a crippled filesystem. + Enabling direct mode. +add conflictor (checksum...) ok +(Recording state in git...) +(merging origin/git-annex origin/synced/git-annex into git-annex...) +(Recording state in git...) +commit +ok +pull origin bash.exe: warning: could not find /tmp, please create! + +ok +push origin bash.exe: warning: could not find /tmp, please create! +To C:/Documents and Settings/Silvia/.t\repo + edd69f1..83c6a5a git-annex -> synced/git-annex + bed393e..978ac14 annex/direct/master -> synced/master + +ok +add conflictor/subfile (checksum...) ok +(Recording state in git...) +(merging origin/git-annex origin/synced/git-annex into git-annex...) +(Recording state in git...) +commit +ok +pull origin bash.exe: warning: could not find /tmp, please create! +From C:/Documents and Settings/Silvia/.t\repo + bed393e..978ac14 master -> origin/master + edd69f1..83c6a5a synced/git-annex -> origin/synced/git-annex + bed393e..978ac14 synced/master -> origin/synced/master +Adding conflictor/subfile +CONFLICT (directory/file): There is a directory with name conflictor in HEAD. Adding conflictor as conflictor~refs_remotes_origin_synced_master +Automatic merge failed; fix conflicts and then commit the result. +Ignoring path ./conflictor.variant-cc12 +conflictor: needs merge +[annex/direct/master e3e39fc] git-annex automatic merge conflict fix + + +(Recording state in git...) + + Merge conflict was automatically resolved; you may want to examine the result. +ok +(merging origin/synced/git-annex into git-annex...) +(Recording state in git...) +push origin bash.exe: warning: could not find /tmp, please create! +To C:/Documents and Settings/Silvia/.t\repo + 83c6a5a..e1a1678 git-annex -> synced/git-annex + 978ac14..e3e39fc annex/direct/master -> synced/master + +ok +commit +ok +pull r2 bash.exe: warning: could not find /tmp, please create! +From ../../.t\tmprepo35 + * [new branch] annex/direct/master -> r2/annex/direct/master + * [new branch] git-annex -> r2/git-annex + * [new branch] master -> r2/master + * [new branch] synced/master -> r2/synced/master +Updating 978ac14..e3e39fc +Fast-forward + conflictor | 1 - + conflictor/subfile | 1 + + 2 files changed, 1 insertion(+), 1 deletion(-) + delete mode 120000 conflictor + create mode 120000 conflictor/subfile +Already up-to-date. + + + +ok +(merging r2/git-annex into git-annex...) +FAIL +"""]] diff --git a/doc/bugs/tmp_file_handling/comment_2_cc14c7a79a544e47654e4cd8abc85edd._comment b/doc/bugs/tmp_file_handling/comment_2_cc14c7a79a544e47654e4cd8abc85edd._comment index e8e48abc8d..d6ae5bcf04 100644 --- a/doc/bugs/tmp_file_handling/comment_2_cc14c7a79a544e47654e4cd8abc85edd._comment +++ b/doc/bugs/tmp_file_handling/comment_2_cc14c7a79a544e47654e4cd8abc85edd._comment @@ -4,5 +4,5 @@ subject="comment 2" date="2012-10-24T15:50:40Z" content=""" -`rsynctmp` is only used when sending files to a rsync special remote. You can certianly delete it if you got a stale one, but the next time a file is sent to a rsync special remote it should delete it anyway. +`rsynctmp` is only used when sending files to a rsync special remote. You can certainly delete it if you got a stale one, but the next time a file is sent to a rsync special remote it should delete it anyway. """]] diff --git a/doc/bugs/typo_on_the_Mac_OS_10.7.5_Lion_build.mdwn b/doc/bugs/typo_on_the_Mac_OS_10.7.5_Lion_build.mdwn new file mode 100644 index 0000000000..8f5e8c3241 --- /dev/null +++ b/doc/bugs/typo_on_the_Mac_OS_10.7.5_Lion_build.mdwn @@ -0,0 +1,11 @@ +As told in http://git-annex.branchable.com/bugs/OSX_app_issues/#comment-2a69d531bd3bb593c1a49dc8cdb34b1e the Mac OS 10.7.5 (Lion) build fails to run. + + $ /Applications/git-annex.app/Contents/MacOS/git-annex + + /Applications/git-annex.app/Contents/MacOS/runshell: line 25: syntax error near unexpected token `&' + +Manually editing /Applications/git-annex.app/Contents/MacOS/runshell as told in http://git-annex.branchable.com/bugs/OSX_app_issues/#comment-5579c2150ad4d2ccc207a253fe57612a fixes the issue. + +Furthermore, this build is quite outdated... + +> [[fixed|done]] --[[Joey]] diff --git a/doc/bugs/typo_on_the_Mac_OS_10.7.5_Lion_build/comment_1_e8df4b36a89b37edd94f3a318ae93a32._comment b/doc/bugs/typo_on_the_Mac_OS_10.7.5_Lion_build/comment_1_e8df4b36a89b37edd94f3a318ae93a32._comment new file mode 100644 index 0000000000..d67330a22c --- /dev/null +++ b/doc/bugs/typo_on_the_Mac_OS_10.7.5_Lion_build/comment_1_e8df4b36a89b37edd94f3a318ae93a32._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.246" + subject="comment 1" + date="2013-11-14T15:26:01Z" + content=""" +This is unfortunate.. The Lion autobuilder is running, but has been failing for various reasons for some time, and I have not managed to get ahold of Jimmy to fix them. Also, that machine may be upgraded from Lion before too long. +"""]] diff --git a/doc/bugs/typo_on_the_Mac_OS_10.7.5_Lion_build/comment_2_3b2c3c84bd1910280c549a2ee1c622b9._comment b/doc/bugs/typo_on_the_Mac_OS_10.7.5_Lion_build/comment_2_3b2c3c84bd1910280c549a2ee1c622b9._comment new file mode 100644 index 0000000000..bd1763ca0c --- /dev/null +++ b/doc/bugs/typo_on_the_Mac_OS_10.7.5_Lion_build/comment_2_3b2c3c84bd1910280c549a2ee1c622b9._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkSq2FDpK2n66QRUxtqqdbyDuwgbQmUWus" + nickname="Jimmy" + subject="comment 2" + date="2013-11-15T20:57:27Z" + content=""" +The builder is back, I was away from the office when it broke. It should be spitting out builds on a daily basis again. +"""]] diff --git a/doc/bugs/unfinished_repository_when_using_annex-ignore_true_.mdwn b/doc/bugs/unfinished_repository_when_using_annex-ignore_true_.mdwn new file mode 100644 index 0000000000..848f1b30b2 --- /dev/null +++ b/doc/bugs/unfinished_repository_when_using_annex-ignore_true_.mdwn @@ -0,0 +1,25 @@ +### Please describe the problem. + +When using a git remote which doesn't support git-annex (f.e. gitlab) and is configured with `annex-ignore true` the remote is shown as `unfinished repository` in the webapp. + +It would be nice if the webapp would recognize this and show the remote as git-only remote including sync-state and remote name (or even better: the remote details, like the URL to the remote) + +### What steps will reproduce the problem? + +Add a normal git remote and configure `git config remote..annex-ignore true`. +Start the webapp. + +### What version of git-annex are you using? On what operating system? + + git-annex version: 4.20131101-gf59a6d1 + build flags: Assistant Webapp Pairing Testsuite 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 glacier hook + local repository version: 3 + default repository version: 3 + supported repository versions: 3 4 + upgrade supported from repository versions: 0 1 2 + +Kubuntu 13.10 x86_64 + +> [[fixed|done]] --[[Joey]] diff --git a/doc/bugs/utf8/comment_13_7044d2c5bb1c91ee37eb9868963a1ff2._comment b/doc/bugs/utf8/comment_13_7044d2c5bb1c91ee37eb9868963a1ff2._comment index fce51ac322..651e434384 100644 --- a/doc/bugs/utf8/comment_13_7044d2c5bb1c91ee37eb9868963a1ff2._comment +++ b/doc/bugs/utf8/comment_13_7044d2c5bb1c91ee37eb9868963a1ff2._comment @@ -37,5 +37,5 @@ And still cannot replicate the bug; as expected it does not use the socket since copy foo (checking foo...) [2013-07-27 16:40:42 EDT] call: ssh [\"-T\",\"fozz@git-annex-markdown.lang.speechmarks.com-fozz_phone.2Dannex.IdWwlXHtSsjVUMcq\",\"git-annex-shell 'inannex' '' 'SHA256E-s29--093429efb0d1427753d1f038f5279ec4df66785a1b2429b3fa5e3a01bcb75bd8' --uuid 111\"] -So, I don't understand how this could have happened. Although my recent changes mean it'll use a 62 byte path max on Android now, which certianly should avoid the problem, even if there's some actual bug here that I cannot reproduce. +So, I don't understand how this could have happened. Although my recent changes mean it'll use a 62 byte path max on Android now, which certainly should avoid the problem, even if there's some actual bug here that I cannot reproduce. """]] diff --git a/doc/bugs/web_app_loops_over_a_non-addable_file.mdwn b/doc/bugs/web_app_loops_over_a_non-addable_file.mdwn new file mode 100644 index 0000000000..a1f4900613 --- /dev/null +++ b/doc/bugs/web_app_loops_over_a_non-addable_file.mdwn @@ -0,0 +1,56 @@ +### Please describe the problem. + +I started the webapp on a pre-existing repo today, and it started adding all sorts of files which I didn't manually add, which is a little bit surprising, but "okay". + +The problem is that it would loop over this one file over and over again. Adding it on the commandline yields a proper error, but this doesn't seem to properly propagate to the frontend. + +### What steps will reproduce the problem? + +Unclear. + +### What version of git-annex are you using? On what operating system? + +4.20131105-g8efdc1a + +### Please provide any additional information below. + +Here's the daemon.log: + +[[!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 + +add clips/A31-05-12_21.22.amr (checksum...) [2013-11-06 10:21:10 EST] Committer: Committing changes to git +[2013-11-06 10:21:11 EST] Committer: Adding A31-05-12_21.22.amr +(Recording state in git...) +(Recording state in git...) +add clips/A31-05-12_21.22.amr (checksum...) [2013-11-06 10:21:11 EST] Committer: Committing changes to git +[2013-11-06 10:21:12 EST] Committer: Adding A31-05-12_21.22.amr +(Recording state in git...) +(Recording state in git...) +add clips/A31-05-12_21.22.amr (checksum...) [2013-11-06 10:21:12 EST] Committer: Committing changes to git +[2013-11-06 10:21:13 EST] Committer: Adding A31-05-12_21.22.amr +(Recording state in git...) +add clips/A31-05-12_21.22.amr (checksum...) [2013-11-06 10:21:13 EST] Committer: Committing changes to git +[2013-11-06 10:21:14 EST] Committer: Adding A31-05-12_21.22.amr +(Recording state in git...) +(Recording state in git...) +add clips/A31-05-12_21.22.amr (checksum...) [2013-11-06 10:21:14 EST] Committer: Committing changes to git +# End of transcript or log. +"""]] + +And here's the attempt on the commandline, which is way more informative: + +[[!format sh """ +anarcat@marcos:video$ git annex add . +add clips/96_257.mp3 ok +add clips/A31-05-12_21.22.amr (checksum...) +git-annex: /srv/video/.git/annex/objects/z3/96/SHA256E-s260070--46f0d657cdd79032d431e2aebb04b63685ab26e7d00963036e0b64c9f86998f8.22.amr/SHA256E-s260070--46f0d657cdd79032d431e2aebb04b63685ab26e7d00963036e0b64c9f86998f8.22.amr: setFileMode: permission denied (Operation not permitted) +failed +"""]] + +Turns out that file is owned by root, so it's an expected failure. But the webapp should simply skip this file, not loop over it. + +The workaround is obviously to give this file to the proper user. --[[anarcat]] + +> [[fixed|done]] --[[Joey]] diff --git a/doc/bugs/webapp_usability:_fails_mysteriously_on_newer_repo_layouts.mdwn b/doc/bugs/webapp_usability:_fails_mysteriously_on_newer_repo_layouts.mdwn new file mode 100644 index 0000000000..73908f40bb --- /dev/null +++ b/doc/bugs/webapp_usability:_fails_mysteriously_on_newer_repo_layouts.mdwn @@ -0,0 +1,34 @@ +### Please describe the problem. + +Starting the webapp on a repository that was hastily created by copying an existing one with an older version yields an undecipherable error. + +Rather minor. + +### What steps will reproduce the problem? + +1. Install git-annex from git +2. make a repo +3. copy it over to an external hard drive +4. connect that drive to a wheezy box running git-annex from backports +5. add the external hard drive to the webapp as a new repo +6. boom + +I expected git-annex to tell me: + + git-annex: Repository version 5 is not supported. Upgrade git-annex. + +Instead, it popped a red box saying a scary "Internal server error". I couldn't read the daemon logs either. + +### What version of git-annex are you using? On what operating system? + +original version is: + + git-annex version: 5.20131109-gf2cb5b9 + +the failing version is running the one from wheezy backports. + +### Please provide any additional information below. + +screenshot coming up. + +> [[fixed|done]] --[[Joey]] diff --git a/doc/builds.mdwn b/doc/builds.mdwn index b6ada2bc2c..49dfc8859b 100644 --- a/doc/builds.mdwn +++ b/doc/builds.mdwn @@ -9,8 +9,8 @@

Android

-

OSX Mountain Lion

-

OSX Lion