diff --git a/.gitignore b/.gitignore index b842cc93c1..624675d275 100644 --- a/.gitignore +++ b/.gitignore @@ -23,6 +23,9 @@ html dist # Sandboxed builds cabal-dev +.cabal-sandbox +cabal.sandbox.config +cabal.config # Project-local emacs configuration .dir-locals.el # OSX related diff --git a/Annex.hs b/Annex.hs index 820c1d5698..8233e18b9f 100644 --- a/Annex.hs +++ b/Annex.hs @@ -5,12 +5,11 @@ - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE GeneralizedNewtypeDeriving, PackageImports #-} +{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, PackageImports #-} module Annex ( Annex, AnnexState(..), - PreferredContentMap, new, run, eval, @@ -60,11 +59,13 @@ import Types.FileMatcher import Types.NumCopies import Types.LockPool import Types.MetaData +import Types.DesktopNotify import Types.CleanupActions -import qualified Utility.Matcher import qualified Data.Map as M import qualified Data.Set as S +#ifdef WITH_QUVI import Utility.Quvi (QuviVersion) +#endif {- git-annex's monad is a ReaderT around an AnnexState stored in a MVar. - This allows modifying the state in an exception-safe fashion. @@ -80,9 +81,6 @@ newtype Annex a = Annex { runAnnex :: ReaderT (MVar AnnexState) IO a } Applicative ) -type Matcher a = Either [Utility.Matcher.Token a] (Utility.Matcher.Matcher a) -type PreferredContentMap = M.Map UUID (Utility.Matcher.Matcher (S.Set UUID -> MatchInfo -> Annex Bool)) - -- internal state storage data AnnexState = AnnexState { repo :: Git.Repo @@ -103,9 +101,10 @@ data AnnexState = AnnexState , forcebackend :: Maybe String , globalnumcopies :: Maybe NumCopies , forcenumcopies :: Maybe NumCopies - , limit :: Matcher (MatchInfo -> Annex Bool) + , limit :: ExpandableMatcher Annex , uuidmap :: Maybe UUIDMap - , preferredcontentmap :: Maybe PreferredContentMap + , preferredcontentmap :: Maybe (FileMatcherMap Annex) + , requiredcontentmap :: Maybe (FileMatcherMap Annex) , shared :: Maybe SharedRepository , forcetrust :: TrustMap , trustmap :: Maybe TrustMap @@ -120,8 +119,11 @@ data AnnexState = AnnexState , useragent :: Maybe String , errcounter :: Integer , unusedkeys :: Maybe (S.Set Key) +#ifdef WITH_QUVI , quviversion :: Maybe QuviVersion +#endif , existinghooks :: M.Map Git.Hook.Hook Bool + , desktopnotify :: DesktopNotify } newState :: GitConfig -> Git.Repo -> AnnexState @@ -144,9 +146,10 @@ newState c r = AnnexState , forcebackend = Nothing , globalnumcopies = Nothing , forcenumcopies = Nothing - , limit = Left [] + , limit = BuildingMatcher [] , uuidmap = Nothing , preferredcontentmap = Nothing + , requiredcontentmap = Nothing , shared = Nothing , forcetrust = M.empty , trustmap = Nothing @@ -161,8 +164,11 @@ newState c r = AnnexState , useragent = Nothing , errcounter = 0 , unusedkeys = Nothing +#ifdef WITH_QUVI , quviversion = Nothing +#endif , existinghooks = M.empty + , desktopnotify = mempty } {- Makes an Annex state object for the specified git repo. diff --git a/Annex/Branch/Transitions.hs b/Annex/Branch/Transitions.hs index 42c61d96a6..5c2c145484 100644 --- a/Annex/Branch/Transitions.hs +++ b/Annex/Branch/Transitions.hs @@ -32,8 +32,12 @@ getTransitionCalculator ForgetDeadRemotes = Just dropDead dropDead :: FilePath -> String -> TrustMap -> FileTransition dropDead f content trustmap = case getLogVariety f of - Just UUIDBasedLog -> ChangeFile $ - UUIDBased.showLog id $ dropDeadFromUUIDBasedLog trustmap $ UUIDBased.parseLog Just content + Just UUIDBasedLog + -- Don't remove the dead repo from the trust log, + -- because git remotes may still exist, and they need + -- to still know it's dead. + | f == trustLog -> PreserveFile + | otherwise -> ChangeFile $ UUIDBased.showLog id $ dropDeadFromUUIDBasedLog trustmap $ UUIDBased.parseLog Just content Just NewUUIDBasedLog -> ChangeFile $ UUIDBased.showLogNew id $ dropDeadFromUUIDBasedLog trustmap $ UUIDBased.parseLogNew Just content Just (PresenceLog _) -> diff --git a/Annex/FileMatcher.hs b/Annex/FileMatcher.hs index ae1bbb77bf..da6a5e0e93 100644 --- a/Annex/FileMatcher.hs +++ b/Annex/FileMatcher.hs @@ -13,7 +13,6 @@ import Common.Annex import Limit import Utility.Matcher import Types.Group -import Types.Limit import Logs.Group import Logs.Remote import Annex.UUID @@ -25,12 +24,10 @@ import Types.Remote (RemoteConfig) import Data.Either import qualified Data.Set as S -type FileMatcher = Matcher MatchFiles - -checkFileMatcher :: FileMatcher -> FilePath -> Annex Bool +checkFileMatcher :: (FileMatcher Annex) -> FilePath -> Annex Bool checkFileMatcher matcher file = checkMatcher matcher Nothing (Just file) S.empty True -checkMatcher :: FileMatcher -> Maybe Key -> AssociatedFile -> AssumeNotPresent -> Bool -> Annex Bool +checkMatcher :: (FileMatcher Annex) -> Maybe Key -> AssociatedFile -> AssumeNotPresent -> Bool -> Annex Bool checkMatcher matcher mkey afile notpresent def | isEmpty matcher = return def | otherwise = case (mkey, afile) of @@ -48,15 +45,15 @@ fileMatchInfo file = do , relFile = file } -matchAll :: FileMatcher +matchAll :: FileMatcher Annex matchAll = generate [] -parsedToMatcher :: [Either String (Token MatchFiles)] -> Either String FileMatcher +parsedToMatcher :: [Either String (Token (MatchFiles Annex))] -> Either String (FileMatcher Annex) parsedToMatcher parsed = case partitionEithers parsed of ([], vs) -> Right $ generate vs (es, _) -> Left $ unwords $ map ("Parse failure: " ++) es -exprParser :: FileMatcher -> FileMatcher -> GroupMap -> M.Map UUID RemoteConfig -> Maybe UUID -> String -> [Either String (Token MatchFiles)] +exprParser :: FileMatcher Annex -> FileMatcher Annex -> GroupMap -> M.Map UUID RemoteConfig -> Maybe UUID -> String -> [Either String (Token (MatchFiles Annex))] exprParser matchstandard matchgroupwanted groupmap configmap mu expr = map parse $ tokenizeMatcher expr where @@ -69,7 +66,7 @@ exprParser matchstandard matchgroupwanted groupmap configmap mu expr = preferreddir = fromMaybe "public" $ M.lookup "preferreddir" =<< (`M.lookup` configmap) =<< mu -parseToken :: FileMatcher -> FileMatcher -> MkLimit -> MkLimit -> GroupMap -> String -> Either String (Token MatchFiles) +parseToken :: FileMatcher Annex -> FileMatcher Annex -> MkLimit Annex -> MkLimit Annex -> GroupMap -> String -> Either String (Token (MatchFiles Annex)) parseToken matchstandard matchgroupwanted checkpresent checkpreferreddir groupmap t | t `elem` tokens = Right $ token t | t == "standard" = call matchstandard @@ -106,7 +103,7 @@ tokenizeMatcher = filter (not . null ) . concatMap splitparens . words {- Generates a matcher for files large enough (or meeting other criteria) - to be added to the annex, rather than directly to git. -} -largeFilesMatcher :: Annex FileMatcher +largeFilesMatcher :: Annex (FileMatcher Annex) largeFilesMatcher = go =<< annexLargeFiles <$> Annex.getGitConfig where go Nothing = return matchAll diff --git a/Annex/Notification.hs b/Annex/Notification.hs new file mode 100644 index 0000000000..608bda7e21 --- /dev/null +++ b/Annex/Notification.hs @@ -0,0 +1,101 @@ +{- git-annex desktop notifications + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Annex.Notification (NotifyWitness, notifyTransfer, notifyDrop) where + +import Common.Annex +import Logs.Transfer +#ifdef WITH_DBUS_NOTIFICATIONS +import qualified Annex +import Types.DesktopNotify +import qualified DBus.Notify as Notify +import qualified DBus.Client +#endif + +-- Witness that notification has happened. +data NotifyWitness = NotifyWitness + +{- Wrap around an action that performs a transfer, which may run multiple + - attempts. Displays notification when supported and when the user asked + - for it. -} +notifyTransfer :: Direction -> Maybe FilePath -> (NotifyWitness -> Annex Bool) -> Annex Bool +notifyTransfer _ Nothing a = a NotifyWitness +#ifdef WITH_DBUS_NOTIFICATIONS +notifyTransfer direction (Just f) a = do + wanted <- Annex.getState Annex.desktopnotify + if (notifyStart wanted || notifyFinish wanted) + then do + client <- liftIO DBus.Client.connectSession + startnotification <- liftIO $ if notifyStart wanted + then Just <$> Notify.notify client (startedTransferNote direction f) + else pure Nothing + ok <- a NotifyWitness + when (notifyFinish wanted) $ liftIO $ void $ maybe + (Notify.notify client $ finishedTransferNote ok direction f) + (\n -> Notify.replace client n $ finishedTransferNote ok direction f) + startnotification + return ok + else a NotifyWitness +#else +notifyTransfer _ (Just _) a = do a NotifyWitness +#endif + +notifyDrop :: Maybe FilePath -> Bool -> Annex () +notifyDrop Nothing _ = noop +#ifdef WITH_DBUS_NOTIFICATIONS +notifyDrop (Just f) ok = do + wanted <- Annex.getState Annex.desktopnotify + when (notifyFinish wanted) $ liftIO $ do + client <- DBus.Client.connectSession + void $ Notify.notify client (droppedNote ok f) +#else +notifyDrop (Just _) _ = noop +#endif + +#ifdef WITH_DBUS_NOTIFICATIONS +startedTransferNote :: Direction -> FilePath -> Notify.Note +startedTransferNote Upload = mkNote Notify.Transfer Notify.Low iconUpload + "Uploading" +startedTransferNote Download = mkNote Notify.Transfer Notify.Low iconDownload + "Downloading" + +finishedTransferNote :: Bool -> Direction -> FilePath -> Notify.Note +finishedTransferNote False Upload = mkNote Notify.TransferError Notify.Normal iconFailure + "Failed to upload" +finishedTransferNote False Download = mkNote Notify.TransferError Notify.Normal iconFailure + "Failed to download" +finishedTransferNote True Upload = mkNote Notify.TransferComplete Notify.Low iconSuccess + "Finished uploading" +finishedTransferNote True Download = mkNote Notify.TransferComplete Notify.Low iconSuccess + "Finished downloading" + +droppedNote :: Bool -> FilePath -> Notify.Note +droppedNote False = mkNote Notify.TransferError Notify.Normal iconFailure + "Failed to drop" +droppedNote True = mkNote Notify.TransferComplete Notify.Low iconSuccess + "Dropped" + +iconUpload, iconDownload, iconFailure, iconSuccess :: String +iconUpload = "network-transmit" +iconDownload = "network-receive" +iconFailure = "dialog-error" +iconSuccess = "git-annex" -- Is there a standard icon for success/completion? + +mkNote :: Notify.Category -> Notify.UrgencyLevel -> String -> String -> FilePath -> Notify.Note +mkNote category urgency icon desc path = Notify.blankNote + { Notify.appName = "git-annex" + , Notify.appImage = Just (Notify.Icon icon) + , Notify.summary = desc ++ " " ++ path + , Notify.hints = + [ Notify.Category category + , Notify.Urgency urgency + , Notify.SuppressSound True + ] + } +#endif diff --git a/Annex/Transfer.hs b/Annex/Transfer.hs new file mode 100644 index 0000000000..df5aba09cf --- /dev/null +++ b/Annex/Transfer.hs @@ -0,0 +1,131 @@ +{- git-annex transfers + - + - Copyright 2012-2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Annex.Transfer ( + module X, + upload, + download, + runTransfer, + noRetry, + forwardRetry, +) where + +import Common.Annex +import Logs.Transfer as X +import Annex.Notification as X +import Annex.Perms +import Annex.Exception +import Utility.Metered +#ifdef mingw32_HOST_OS +import Utility.WinLock +#endif + +import Control.Concurrent + +upload :: UUID -> Key -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex Bool) -> NotifyWitness -> Annex Bool +upload u key f d a _witness = runTransfer (Transfer Upload u key) f d a + +download :: UUID -> Key -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex Bool) -> NotifyWitness -> Annex Bool +download u key f d a _witness = runTransfer (Transfer Download u key) f d a + +{- Runs a transfer action. Creates and locks the lock file while the + - action is running, and stores info in the transfer information + - file. + - + - If the transfer action returns False, the transfer info is + - left in the failedTransferDir. + - + - If the transfer is already in progress, returns False. + - + - An upload can be run from a read-only filesystem, and in this case + - no transfer information or lock file is used. + -} +runTransfer :: Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex Bool) -> Annex Bool +runTransfer t file shouldretry a = do + info <- liftIO $ startTransferInfo file + (meter, tfile, metervar) <- mkProgressUpdater t info + mode <- annexFileMode + (fd, inprogress) <- liftIO $ prep tfile mode info + if inprogress + then do + showNote "transfer already in progress" + return False + else do + ok <- retry info metervar $ + bracketIO (return fd) (cleanup tfile) (const $ a meter) + unless ok $ recordFailedTransfer t info + return ok + where +#ifndef mingw32_HOST_OS + prep tfile mode info = do + mfd <- catchMaybeIO $ + openFd (transferLockFile tfile) ReadWrite (Just mode) + defaultFileFlags { trunc = True } + case mfd of + Nothing -> return (Nothing, False) + Just fd -> do + locked <- catchMaybeIO $ + setLock fd (WriteLock, AbsoluteSeek, 0, 0) + if isNothing locked + then return (Nothing, True) + else do + void $ tryIO $ writeTransferInfoFile info tfile + return (mfd, False) +#else + prep tfile _mode info = do + v <- catchMaybeIO $ lockExclusive (transferLockFile tfile) + case v of + Nothing -> return (Nothing, False) + Just Nothing -> return (Nothing, True) + Just (Just lockhandle) -> do + void $ tryIO $ writeTransferInfoFile info tfile + return (Just lockhandle, False) +#endif + cleanup _ Nothing = noop + cleanup tfile (Just lockhandle) = do + void $ tryIO $ removeFile tfile +#ifndef mingw32_HOST_OS + void $ tryIO $ removeFile $ transferLockFile tfile + closeFd lockhandle +#else + {- Windows cannot delete the lockfile until the lock + - is closed. So it's possible to race with another + - process that takes the lock before it's removed, + - so ignore failure to remove. + -} + dropLock lockhandle + void $ tryIO $ removeFile $ transferLockFile tfile +#endif + retry oldinfo metervar run = do + v <- tryAnnex run + case v of + Right b -> return b + Left _ -> do + b <- getbytescomplete metervar + let newinfo = oldinfo { bytesComplete = Just b } + if shouldretry oldinfo newinfo + then retry newinfo metervar run + else return False + getbytescomplete metervar + | transferDirection t == Upload = + liftIO $ readMVar metervar + | otherwise = do + f <- fromRepo $ gitAnnexTmpObjectLocation (transferKey t) + liftIO $ catchDefaultIO 0 $ + fromIntegral . fileSize <$> getFileStatus f + +type RetryDecider = TransferInfo -> TransferInfo -> Bool + +noRetry :: RetryDecider +noRetry _ _ = False + +{- Retries a transfer when it fails, as long as the failed transfer managed + - to send some data. -} +forwardRetry :: RetryDecider +forwardRetry old new = bytesComplete old < bytesComplete new diff --git a/Assistant/Alert/Utility.hs b/Assistant/Alert/Utility.hs index 73843be4cf..be631e9991 100644 --- a/Assistant/Alert/Utility.hs +++ b/Assistant/Alert/Utility.hs @@ -14,7 +14,6 @@ import Utility.Tense import qualified Data.Text as T import Data.Text (Text) import qualified Data.Map as M -import Data.Monoid {- This is as many alerts as it makes sense to display at a time. - A display might be smaller, or larger, the point is to not overwhelm the diff --git a/Assistant/Install.hs b/Assistant/Install.hs index d29cefb8cd..883ca484c6 100644 --- a/Assistant/Install.hs +++ b/Assistant/Install.hs @@ -35,11 +35,14 @@ standaloneAppBase = getEnv "GIT_ANNEX_APP_BASE" - - Note that this is done every time it's started, so if the user moves - it around, the paths this sets up won't break. + - + - Nautilus hook script installation is done even for packaged apps, + - since it has to go into the user's home directory. -} ensureInstalled :: IO () ensureInstalled = go =<< standaloneAppBase where - go Nothing = noop + go Nothing = installNautilus "git-annex" go (Just base) = do let program = base "git-annex" programfile <- programFile @@ -78,6 +81,33 @@ ensureInstalled = go =<< standaloneAppBase viaTmp writeFile shim content modifyFileMode shim $ addModes [ownerExecuteMode] + installNautilus program + +installNautilus :: FilePath -> IO () +#ifdef linux_HOST_OS +installNautilus program = do + scriptdir <- (\d -> d "nautilus" "scripts") <$> userDataDir + whenM (doesDirectoryExist scriptdir) $ do + genscript scriptdir "get" + genscript scriptdir "drop" + where + genscript scriptdir action = + installscript (scriptdir scriptname action) $ unlines + [ shebang_local + , autoaddedcomment + , "exec " ++ program ++ " " ++ action ++ " --notify-start --notify-finish -- \"$@\"" + ] + scriptname action = "git-annex " ++ action + installscript f c = whenM (safetoinstallscript f) $ do + writeFile f c + modifyFileMode f $ addModes [ownerExecuteMode] + safetoinstallscript f = catchDefaultIO True $ + elem autoaddedcomment . lines <$> readFileStrict f + autoaddedcomment = "# Automatically added by git-annex, do not edit. (To disable, chmod 600 this file.)" +#else +installNautilus _ = noop +#endif + {- Returns a cleaned up environment that lacks settings used to make the - standalone builds use their bundled libraries and programs. - Useful when calling programs not included in the standalone builds. diff --git a/Assistant/Ssh.hs b/Assistant/Ssh.hs index acb2fc11c6..4dd32f7d92 100644 --- a/Assistant/Ssh.hs +++ b/Assistant/Ssh.hs @@ -197,7 +197,7 @@ authorizedKeysLine gitannexshellonly dir pubkey - long perl script. -} | otherwise = pubkey where - limitcommand = "command=\"GIT_ANNEX_SHELL_DIRECTORY="++shellEscape dir++" ~/.ssh/git-annex-shell\",no-agent-forwarding,no-port-forwarding,no-X11-forwarding,no-pty " + limitcommand = "command=\"env GIT_ANNEX_SHELL_DIRECTORY="++shellEscape dir++" ~/.ssh/git-annex-shell\",no-agent-forwarding,no-port-forwarding,no-X11-forwarding,no-pty " {- Generates a ssh key pair. -} genSshKeyPair :: IO SshKeyPair diff --git a/Assistant/Threads/ConfigMonitor.hs b/Assistant/Threads/ConfigMonitor.hs index a92c7d7859..d02e53db55 100644 --- a/Assistant/Threads/ConfigMonitor.hs +++ b/Assistant/Threads/ConfigMonitor.hs @@ -62,15 +62,17 @@ configFilesActions = , (groupLog, void $ liftAnnex groupMapLoad) , (numcopiesLog, void $ liftAnnex globalNumCopiesLoad) , (scheduleLog, void updateScheduleLog) - -- Preferred content settings depend on most of the other configs, - -- so will be reloaded whenever any configs change. + -- Preferred and required content settings depend on most of the + -- other configs, so will be reloaded whenever any configs change. , (preferredContentLog, noop) + , (requiredContentLog, noop) + , (groupPreferredContentLog, noop) ] reloadConfigs :: Configs -> Assistant () reloadConfigs changedconfigs = do sequence_ as - void $ liftAnnex preferredContentMapLoad + void $ liftAnnex preferredRequiredMapsLoad {- Changes to the remote log, or the trust log, can affect the - syncRemotes list. Changes to the uuid log may affect its - display so are also included. -} diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index 8a8e8faf04..97ccf083e8 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -35,6 +35,7 @@ import Annex.CatFile import Annex.CheckIgnore import Annex.Link import Annex.FileMatcher +import Types.FileMatcher import Annex.ReplaceFile import Git.Types import Config @@ -196,7 +197,7 @@ runHandler handler file filestatus = void $ do | otherwise = f {- Small files are added to git as-is, while large ones go into the annex. -} -add :: FileMatcher -> FilePath -> Assistant (Maybe Change) +add :: FileMatcher Annex -> FilePath -> Assistant (Maybe Change) add bigfilematcher file = ifM (liftAnnex $ checkFileMatcher bigfilematcher file) ( pendingAddChange file , do @@ -205,7 +206,7 @@ add bigfilematcher file = ifM (liftAnnex $ checkFileMatcher bigfilematcher file) madeChange file AddFileChange ) -onAdd :: FileMatcher -> Handler +onAdd :: FileMatcher Annex -> Handler onAdd matcher file filestatus | maybe False isRegularFile filestatus = unlessIgnored file $ @@ -218,7 +219,7 @@ shouldRestage ds = scanComplete ds || forceRestage ds {- In direct mode, add events are received for both new files, and - modified existing files. -} -onAddDirect :: Bool -> FileMatcher -> Handler +onAddDirect :: Bool -> FileMatcher Annex -> Handler onAddDirect symlinkssupported matcher file fs = do v <- liftAnnex $ catKeyFile file case (v, fs) of diff --git a/Build/BundledPrograms.hs b/Build/BundledPrograms.hs index d1f8cfd4a7..dd78994b04 100644 --- a/Build/BundledPrograms.hs +++ b/Build/BundledPrograms.hs @@ -45,7 +45,12 @@ bundledPrograms = catMaybes #endif , SysConfig.gpg , ifset SysConfig.curl "curl" +#ifndef darwin_HOST_OS + -- wget on OSX has been problimatic, looking for certs in the wrong + -- places. Don't ship it, use curl or the OSX's own wget if it has + -- one. , ifset SysConfig.wget "wget" +#endif , ifset SysConfig.bup "bup" , SysConfig.lsof , SysConfig.gcrypt diff --git a/Build/LinuxMkLibs.hs b/Build/LinuxMkLibs.hs index be605c5a58..3db724b0ad 100644 --- a/Build/LinuxMkLibs.hs +++ b/Build/LinuxMkLibs.hs @@ -14,12 +14,10 @@ import System.FilePath import System.Directory import Control.Monad import Data.List -import Data.List.Utils import System.Posix.Files -import Data.Char import Control.Monad.IfElse -import Utility.PartialPrelude +import Utility.LinuxMkLibs import Utility.Directory import Utility.Process import Utility.Monad @@ -41,7 +39,7 @@ mklibs top = do libs <- parseLdd <$> readProcess "ldd" exes glibclibs <- glibcLibs let libs' = nub $ libs ++ glibclibs - libdirs <- nub . catMaybes <$> mapM (installLib top) libs' + libdirs <- nub . catMaybes <$> mapM (installLib installFile top) libs' -- Various files used by runshell to set up env vars used by the -- linker shims. @@ -53,26 +51,6 @@ mklibs top = do mapM_ (installLinkerShim top) exes -{- Installs a library. If the library is a symlink to another file, - - install the file it links to, and update the symlink to be relative. -} -installLib :: FilePath -> FilePath -> IO (Maybe FilePath) -installLib top lib = ifM (doesFileExist lib) - ( do - installFile top lib - checksymlink lib - return $ Just $ parentDir lib - , return Nothing - ) - where - checksymlink f = whenM (isSymbolicLink <$> getSymbolicLinkStatus (inTop top f)) $ do - l <- readSymbolicLink (inTop top f) - let absl = absPathFrom (parentDir f) l - let target = relPathDirToFile (parentDir f) absl - installFile top absl - nukeFile (top ++ f) - createSymbolicLink target (inTop top f) - checksymlink absl - {- Installs a linker shim script around a binary. - - Note that each binary is put into its own separate directory, @@ -108,10 +86,6 @@ installFile top f = do where destdir = inTop top $ parentDir f --- Note that f is not relative, so cannot use -inTop :: FilePath -> FilePath -> FilePath -inTop top f = top ++ f -- - checkExe :: FilePath -> IO Bool checkExe f | ".so" `isSuffixOf` f = return False @@ -127,18 +101,3 @@ checkFileExe s = and [ "ELF" `isInfixOf` s , "executable" `isInfixOf` s || "shared object" `isInfixOf` s ] - -{- Parse ldd output, getting all the libraries that the input files - - link to. Note that some of the libraries may not exist - - (eg, linux-vdso.so) -} -parseLdd :: String -> [FilePath] -parseLdd = catMaybes . map (getlib . dropWhile isSpace) . lines - where - getlib l = headMaybe . words =<< lastMaybe (split " => " l) - -{- Get all glibc libs and other support files, including gconv files - - - - XXX Debian specific. -} -glibcLibs :: IO [FilePath] -glibcLibs = lines <$> readProcess "sh" - ["-c", "dpkg -L libc6:$(dpkg --print-architecture) libgcc1:$(dpkg --print-architecture) | egrep '\\.so|gconv'"] diff --git a/BuildFlags.hs b/BuildFlags.hs index e36cf6a14c..59a060cb5e 100644 --- a/BuildFlags.hs +++ b/BuildFlags.hs @@ -57,6 +57,9 @@ buildFlags = filter (not . null) #ifdef WITH_DBUS , "DBus" #endif +#ifdef WITH_DESKTOP_NOTIFY + , "DesktopNotify" +#endif #ifdef WITH_XMPP , "XMPP" #else diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs index 3604681f96..9f6eb5ff09 100644 --- a/CmdLine/GitAnnex.hs +++ b/CmdLine/GitAnnex.hs @@ -89,6 +89,7 @@ import qualified Command.WebApp #ifdef WITH_XMPP import qualified Command.XMPPGit #endif +import qualified Command.RemoteDaemon #endif import qualified Command.Test #ifdef WITH_TESTSUITE @@ -176,6 +177,7 @@ cmds = concat #ifdef WITH_XMPP , Command.XMPPGit.def #endif + , Command.RemoteDaemon.def #endif , Command.Test.def #ifdef WITH_TESTSUITE diff --git a/CmdLine/GitAnnexShell.hs b/CmdLine/GitAnnexShell.hs index f490792b07..6c212b24d3 100644 --- a/CmdLine/GitAnnexShell.hs +++ b/CmdLine/GitAnnexShell.hs @@ -29,6 +29,7 @@ import qualified Command.RecvKey import qualified Command.SendKey import qualified Command.TransferInfo import qualified Command.Commit +import qualified Command.NotifyChanges import qualified Command.GCryptSetup cmds_readonly :: [Command] @@ -37,6 +38,7 @@ cmds_readonly = concat , gitAnnexShellCheck Command.InAnnex.def , gitAnnexShellCheck Command.SendKey.def , gitAnnexShellCheck Command.TransferInfo.def + , gitAnnexShellCheck Command.NotifyChanges.def ] cmds_notreadonly :: [Command] diff --git a/CmdLine/Option.hs b/CmdLine/Option.hs index 915b06849e..ce44d2acee 100644 --- a/CmdLine/Option.hs +++ b/CmdLine/Option.hs @@ -20,6 +20,7 @@ import System.Console.GetOpt import Common.Annex import qualified Annex import Types.Messages +import Types.DesktopNotify import Limit import CmdLine.Usage @@ -41,6 +42,10 @@ commonOptions = "don't show debug messages" , Option ['b'] ["backend"] (ReqArg setforcebackend paramName) "specify key-value backend to use" + , Option [] ["notify-finish"] (NoArg (setdesktopnotify mkNotifyFinish)) + "show desktop notification after transfer finishes" + , Option [] ["notify-start"] (NoArg (setdesktopnotify mkNotifyStart)) + "show desktop notification after transfer completes" ] where setforce v = Annex.changeState $ \s -> s { Annex.force = v } @@ -49,6 +54,7 @@ commonOptions = setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v } setdebug = Annex.changeGitConfig $ \c -> c { annexDebug = True } unsetdebug = Annex.changeGitConfig $ \c -> c { annexDebug = False } + setdesktopnotify v = Annex.changeState $ \s -> s { Annex.desktopnotify = Annex.desktopnotify s <> v } matcherOptions :: [Option] matcherOptions = diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs index e95b9f0059..abbe52af85 100644 --- a/CmdLine/Seek.hs +++ b/CmdLine/Seek.hs @@ -30,14 +30,15 @@ withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek withFilesInGit a params = seekActions $ prepFiltered a $ seekHelper LsFiles.inRepo params -withFilesNotInGit :: (FilePath -> CommandStart) -> CommandSeek -withFilesNotInGit a params = do - {- dotfiles are not acted on unless explicitly listed -} - files <- filter (not . dotfile) <$> - seekunless (null ps && not (null params)) ps - dotfiles <- seekunless (null dotps) dotps - seekActions $ prepFiltered a $ - return $ concat $ segmentPaths params (files++dotfiles) +withFilesNotInGit :: Bool -> (FilePath -> CommandStart) -> CommandSeek +withFilesNotInGit skipdotfiles a params + | skipdotfiles = do + {- dotfiles are not acted on unless explicitly listed -} + files <- filter (not . dotfile) <$> + seekunless (null ps && not (null params)) ps + dotfiles <- seekunless (null dotps) dotps + go (files++dotfiles) + | otherwise = go =<< seekunless False params where (dotps, ps) = partition dotfile params seekunless True _ = return [] @@ -45,6 +46,8 @@ withFilesNotInGit a params = do force <- Annex.getState Annex.force g <- gitRepo liftIO $ Git.Command.leaveZombie <$> LsFiles.notInRepo force l g + go l = seekActions $ prepFiltered a $ + return $ concat $ segmentPaths params l withPathContents :: ((FilePath, FilePath) -> CommandStart) -> CommandSeek withPathContents a params = seekActions $ diff --git a/Command/Add.hs b/Command/Add.hs index 0c8e2a48d4..f9e2b33421 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -34,8 +34,12 @@ import Annex.ReplaceFile import Utility.Tmp def :: [Command] -def = [notBareRepo $ command "add" paramPaths seek SectionCommon - "add files to annex"] +def = [notBareRepo $ withOptions [includeDotFilesOption] $ + command "add" paramPaths seek SectionCommon + "add files to annex"] + +includeDotFilesOption :: Option +includeDotFilesOption = flagOption [] "include-dotfiles" "don't skip dotfiles" {- Add acts on both files not checked into git yet, and unlocked files. - @@ -47,7 +51,8 @@ seek ps = do ( start file , stop ) - go withFilesNotInGit + skipdotfiles <- not <$> Annex.getFlag (optionName includeDotFilesOption) + go $ withFilesNotInGit skipdotfiles ifM isDirect ( go withFilesMaybeModified , go withFilesUnlocked diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index a0978a88d6..b108be5078 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -26,7 +26,7 @@ import Types.KeySource import Config import Annex.Content.Direct import Logs.Location -import qualified Logs.Transfer as Transfer +import qualified Annex.Transfer as Transfer #ifdef WITH_QUVI import Annex.Quvi import qualified Utility.Quvi as Quvi @@ -116,9 +116,10 @@ addUrlFileQuvi relaxed quviurl videourl file = do prepGetViaTmpChecked sizedkey $ do tmp <- fromRepo $ gitAnnexTmpObjectLocation key showOutput - ok <- Transfer.download webUUID key (Just file) Transfer.forwardRetry $ const $ do - liftIO $ createDirectoryIfMissing True (parentDir tmp) - downloadUrl [videourl] tmp + ok <- Transfer.notifyTransfer Transfer.Download (Just file) $ + Transfer.download webUUID key (Just file) Transfer.forwardRetry $ const $ do + liftIO $ createDirectoryIfMissing True (parentDir tmp) + downloadUrl [videourl] tmp if ok then cleanup quviurl file key (Just tmp) else return False @@ -133,17 +134,20 @@ perform relaxed url file = ifAnnexed file addurl geturl | relaxed = do setUrlPresent key url next $ return True - | otherwise = do - (exists, samesize) <- Url.withUrlOptions $ Url.check url (keySize key) - if exists && samesize - then do - setUrlPresent key url - next $ return True - else do - warning $ if exists - then "url does not have expected file size (use --relaxed to bypass this check) " ++ url - else "failed to verify url exists: " ++ url - stop + | otherwise = ifM (elem url <$> getUrls key) + ( stop + , do + (exists, samesize) <- Url.withUrlOptions $ Url.check url (keySize key) + if exists && samesize + then do + setUrlPresent key url + next $ return True + else do + warning $ "while adding a new url to an already annexed file, " ++ if exists + then "url does not have expected file size (use --relaxed to bypass this check) " ++ url + else "failed to verify url exists: " ++ url + stop + ) addUrlFile :: Bool -> URLString -> FilePath -> Annex Bool addUrlFile relaxed url file = do @@ -179,7 +183,7 @@ download url file = do , return False ) where - runtransfer dummykey tmp = + runtransfer dummykey tmp = Transfer.notifyTransfer Transfer.Download (Just file) $ Transfer.download webUUID dummykey (Just file) Transfer.forwardRetry $ const $ do liftIO $ createDirectoryIfMissing True (parentDir tmp) downloadUrl [url] tmp diff --git a/Command/ConfigList.hs b/Command/ConfigList.hs index 58b7388645..219685c21c 100644 --- a/Command/ConfigList.hs +++ b/Command/ConfigList.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010 Joey Hess + - Copyright 2010-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -10,6 +10,8 @@ module Command.ConfigList where import Common.Annex import Command import Annex.UUID +import Annex.Init +import qualified Annex.Branch import qualified Git.Config import Remote.GCrypt (coreGCryptId) @@ -22,9 +24,23 @@ seek = withNothing start start :: CommandStart start = do - u <- getUUID + u <- findOrGenUUID showConfig "annex.uuid" $ fromUUID u showConfig coreGCryptId =<< fromRepo (Git.Config.get coreGCryptId "") stop where showConfig k v = liftIO $ putStrLn $ k ++ "=" ++ v + +{- The repository may not yet have a UUID; automatically initialize it + - when there's a git-annex branch available. -} +findOrGenUUID :: Annex UUID +findOrGenUUID = do + u <- getUUID + if u /= NoUUID + then return u + else ifM Annex.Branch.hasSibling + ( do + initialize Nothing + getUUID + , return NoUUID + ) diff --git a/Command/Drop.hs b/Command/Drop.hs index d29195b050..269c4c26be 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -14,9 +14,13 @@ import qualified Annex import Annex.UUID import Logs.Location import Logs.Trust +import Logs.PreferredContent import Config.NumCopies import Annex.Content import Annex.Wanted +import Annex.Notification + +import qualified Data.Set as S def :: [Command] def = [withOptions [dropFromOption] $ command "drop" paramPaths seek @@ -44,27 +48,34 @@ start from file (key, _) = checkDropAuto from file key $ \numcopies -> startLocal :: AssociatedFile -> NumCopies -> Key -> Maybe Remote -> CommandStart startLocal afile numcopies key knownpresentremote = stopUnless (inAnnex key) $ do showStart' "drop" key afile - next $ performLocal key numcopies knownpresentremote + next $ performLocal key afile numcopies knownpresentremote startRemote :: AssociatedFile -> NumCopies -> Key -> Remote -> CommandStart startRemote afile numcopies key remote = do showStart' ("drop " ++ Remote.name remote) key afile - next $ performRemote key numcopies remote + next $ performRemote key afile numcopies remote -performLocal :: Key -> NumCopies -> Maybe Remote -> CommandPerform -performLocal key numcopies knownpresentremote = lockContent key $ do +performLocal :: Key -> AssociatedFile -> NumCopies -> Maybe Remote -> CommandPerform +performLocal key afile numcopies knownpresentremote = lockContent key $ do (remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key let trusteduuids' = case knownpresentremote of Nothing -> trusteduuids Just r -> nub (Remote.uuid r:trusteduuids) untrusteduuids <- trustGet UnTrusted let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids'++untrusteduuids) - stopUnless (canDropKey key numcopies trusteduuids' tocheck []) $ do - removeAnnex key - next $ cleanupLocal key + u <- getUUID + ifM (canDrop u key afile numcopies trusteduuids' tocheck []) + ( do + removeAnnex key + notifyDrop afile True + next $ cleanupLocal key + , do + notifyDrop afile False + stop + ) -performRemote :: Key -> NumCopies -> Remote -> CommandPerform -performRemote key numcopies remote = lockContent key $ do +performRemote :: Key -> AssociatedFile -> NumCopies -> Remote -> CommandPerform +performRemote key afile numcopies remote = lockContent key $ do -- Filter the remote it's being dropped from out of the lists of -- places assumed to have the key, and places to check. -- When the local repo has the key, that's one additional copy. @@ -76,7 +87,7 @@ performRemote key numcopies remote = lockContent key $ do untrusteduuids <- trustGet UnTrusted let tocheck = filter (/= remote) $ Remote.remotesWithoutUUID remotes (have++untrusteduuids) - stopUnless (canDropKey key numcopies have tocheck [uuid]) $ do + stopUnless (canDrop uuid key afile numcopies have tocheck [uuid]) $ do ok <- Remote.removeKey remote key next $ cleanupRemote key remote ok where @@ -95,13 +106,19 @@ cleanupRemote key remote ok = do {- Checks specified remotes to verify that enough copies of a key exist to - allow it to be safely removed (with no data loss). Can be provided with - - some locations where the key is known/assumed to be present. -} -canDropKey :: Key -> NumCopies -> [UUID] -> [Remote] -> [UUID] -> Annex Bool -canDropKey key numcopies have check skip = do - force <- Annex.getState Annex.force - if force || numcopies == NumCopies 0 - then return True - else findCopies key numcopies skip have check + - some locations where the key is known/assumed to be present. + - + - Also checks if it's required content, and refuses to drop if so. + - + - --force overrides and always allows dropping. + -} +canDrop :: UUID -> Key -> AssociatedFile -> NumCopies -> [UUID] -> [Remote] -> [UUID] -> Annex Bool +canDrop dropfrom key afile numcopies have check skip = ifM (Annex.getState Annex.force) + ( return True + , checkRequiredContent dropfrom key afile + <&&> + findCopies key numcopies skip have check + ) findCopies :: Key -> NumCopies -> [UUID] -> [UUID] -> [Remote] -> Annex Bool findCopies key need skip = helper [] [] @@ -137,6 +154,19 @@ notEnoughCopies key need have skip bad = do unsafe = showNote "unsafe" hint = showLongNote "(Use --force to override this check, or adjust numcopies.)" +checkRequiredContent :: UUID -> Key -> AssociatedFile -> Annex Bool +checkRequiredContent u k afile = + ifM (isRequiredContent (Just u) S.empty (Just k) afile False) + ( requiredContent + , return True + ) + +requiredContent :: Annex Bool +requiredContent = do + showLongNote "That file is required content, it cannot be dropped!" + showLongNote "(Use --force to override this check, or adjust required content configuration.)" + return False + {- In auto mode, only runs the action if there are enough - copies on other semitrusted repositories. -} checkDropAuto :: Maybe Remote -> FilePath -> Key -> (NumCopies -> CommandStart) -> CommandStart diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index 345d030328..ce49795c92 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -34,8 +34,8 @@ perform numcopies key = maybe droplocal dropremote =<< Remote.byNameWithUUID =<< where dropremote r = do showAction $ "from " ++ Remote.name r - Command.Drop.performRemote key numcopies r - droplocal = Command.Drop.performLocal key numcopies Nothing + Command.Drop.performRemote key Nothing numcopies r + droplocal = Command.Drop.performLocal key Nothing numcopies Nothing from = Annex.getField $ optionName Command.Drop.dropFromOption performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform diff --git a/Command/Get.hs b/Command/Get.hs index f436b15b56..bef4667240 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -11,7 +11,7 @@ import Common.Annex import Command import qualified Remote import Annex.Content -import Logs.Transfer +import Annex.Transfer import Config.NumCopies import Annex.Wanted import qualified Command.Move @@ -69,15 +69,15 @@ getKeyFile' key afile dest = dispatch showNote "not available" showlocs return False - dispatch remotes = trycopy remotes remotes - trycopy full [] = do + dispatch remotes = notifyTransfer Download afile $ trycopy remotes remotes + trycopy full [] _ = do Remote.showTriedRemotes full showlocs return False - trycopy full (r:rs) = + trycopy full (r:rs) witness = ifM (probablyPresent r) - ( docopy r (trycopy full rs) - , trycopy full rs + ( docopy r witness <||> trycopy full rs witness + , trycopy full rs witness ) showlocs = Remote.showLocations key [] "No other repository is known to contain the file." @@ -87,8 +87,6 @@ getKeyFile' key afile dest = dispatch | Remote.hasKeyCheap r = either (const False) id <$> Remote.hasKey r key | otherwise = return True - docopy r continue = do - ok <- download (Remote.uuid r) key afile noRetry $ \p -> do - showAction $ "from " ++ Remote.name r - Remote.retrieveKeyFile r key afile dest p - if ok then return ok else continue + docopy r = download (Remote.uuid r) key afile noRetry $ \p -> do + showAction $ "from " ++ Remote.name r + Remote.retrieveKeyFile r key afile dest p diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs index 50f4278b6b..3f629af6ec 100644 --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -15,6 +15,8 @@ import Text.Feed.Types import qualified Data.Set as S import qualified Data.Map as M import Data.Time.Clock +import Data.Time.Format +import System.Locale import Common.Annex import qualified Annex @@ -212,6 +214,7 @@ feedFile tmpl i extension = Utility.Format.format tmpl $ M.fromList , fieldMaybe "itemdescription" $ getItemDescription $ item i , fieldMaybe "itemrights" $ getItemRights $ item i , fieldMaybe "itemid" $ snd <$> getItemId (item i) + , fieldMaybe "itempubdate" $ pubdate $ item i , ("extension", sanitizeFilePath extension) ] where @@ -221,6 +224,12 @@ feedFile tmpl i extension = Utility.Format.format tmpl $ M.fromList fieldMaybe k Nothing = (k, "none") fieldMaybe k (Just v) = field k v + pubdate itm = case getItemPublishDate itm :: Maybe (Maybe UTCTime) of + Just (Just d) -> Just $ + formatTime defaultTimeLocale "%F" d + -- if date cannot be parsed, use the raw string + _ -> replace "/" "-" <$> getItemPublishDateString itm + {- Called when there is a problem with a feed. - Throws an error if the feed is broken, otherwise shows a warning. -} feedProblem :: URLString -> String -> Annex () diff --git a/Command/List.hs b/Command/List.hs index ba62513338..1fa2064050 100644 --- a/Command/List.hs +++ b/Command/List.hs @@ -38,7 +38,7 @@ seek ps = do getList :: Annex [(UUID, RemoteName, TrustLevel)] getList = ifM (Annex.getFlag $ optionName allrepos) - ( nubBy ((==) `on` fst3) <$> ((++) <$> getRemotes <*> getAll) + ( nubBy ((==) `on` fst3) <$> ((++) <$> getRemotes <*> getAllUUIDs) , getRemotes ) where @@ -48,7 +48,7 @@ getList = ifM (Annex.getFlag $ optionName allrepos) hereu <- getUUID heretrust <- lookupTrust hereu return $ (hereu, "here", heretrust) : zip3 (map uuid rs) (map name rs) ts - getAll = do + getAllUUIDs = do rs <- M.toList <$> uuidMap rs3 <- forM rs $ \(u, n) -> (,,) <$> pure u diff --git a/Command/Move.hs b/Command/Move.hs index 3a39e1de0d..206a875b7c 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -14,8 +14,8 @@ import qualified Annex import Annex.Content import qualified Remote import Annex.UUID +import Annex.Transfer import Logs.Presence -import Logs.Transfer def :: [Command] def = [withOptions moveOptions $ command "move" paramPaths seek @@ -98,8 +98,9 @@ toPerform dest move key afile fastcheck isthere = moveLock move key $ stop Right False -> do showAction $ "to " ++ Remote.name dest - ok <- upload (Remote.uuid dest) key afile noRetry $ - Remote.storeKey dest key afile + ok <- notifyTransfer Upload afile $ + upload (Remote.uuid dest) key afile noRetry $ + Remote.storeKey dest key afile if ok then do Remote.logStatus dest key InfoPresent @@ -155,9 +156,10 @@ fromPerform src move key afile = moveLock move key $ , handle move =<< go ) where - go = download (Remote.uuid src) key afile noRetry $ \p -> do - showAction $ "from " ++ Remote.name src - getViaTmp key $ \t -> Remote.retrieveKeyFile src key afile t p + go = notifyTransfer Download afile $ + download (Remote.uuid src) key afile noRetry $ \p -> do + showAction $ "from " ++ Remote.name src + getViaTmp key $ \t -> Remote.retrieveKeyFile src key afile t p handle _ False = stop -- failed handle False True = next $ return True -- copy complete handle True True = do -- finish moving diff --git a/Command/NotifyChanges.hs b/Command/NotifyChanges.hs new file mode 100644 index 0000000000..d0df055515 --- /dev/null +++ b/Command/NotifyChanges.hs @@ -0,0 +1,83 @@ +{- git-annex-shell command + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.NotifyChanges where + +import Common.Annex +import Command +import Utility.DirWatcher +import Utility.DirWatcher.Types +import qualified Git +import Git.Sha +import RemoteDaemon.Transport.Ssh.Types + +import Control.Concurrent +import Control.Concurrent.Async +import Control.Concurrent.STM + +def :: [Command] +def = [noCommit $ command "notifychanges" paramNothing seek SectionPlumbing + "sends notification when git refs are changed"] + +seek :: CommandSeek +seek = withNothing start + +start :: CommandStart +start = do + -- This channel is used to accumulate notifcations, + -- because the DirWatcher might have multiple threads that find + -- changes at the same time. + chan <- liftIO newTChanIO + + g <- gitRepo + let refdir = Git.localGitDir g "refs" + liftIO $ createDirectoryIfMissing True refdir + + let notifyhook = Just $ notifyHook chan + let hooks = mkWatchHooks + { addHook = notifyhook + , modifyHook = notifyhook + } + + void $ liftIO $ watchDir refdir (const False) True hooks id + + let sender = do + send READY + forever $ send . CHANGED =<< drain chan + + -- No messages need to be received from the caller, + -- but when it closes the connection, notice and terminate. + let receiver = forever $ void $ getLine + void $ liftIO $ concurrently sender receiver + stop + +notifyHook :: TChan Git.Sha -> FilePath -> Maybe FileStatus -> IO () +notifyHook chan reffile _ + | ".lock" `isSuffixOf` reffile = noop + | otherwise = void $ do + sha <- catchDefaultIO Nothing $ + extractSha <$> readFile reffile + maybe noop (atomically . writeTChan chan) sha + +-- When possible, coalesce ref writes that occur closely together +-- in time. Delay up to 0.05 seconds to get more ref writes. +drain :: TChan Git.Sha -> IO [Git.Sha] +drain chan = do + r <- atomically $ readTChan chan + threadDelay 50000 + rs <- atomically $ drain' chan + return (r:rs) + +drain' :: TChan Git.Sha -> STM [Git.Sha] +drain' chan = loop [] + where + loop rs = maybe (return rs) (\r -> loop (r:rs)) =<< tryReadTChan chan + +send :: Notification -> IO () +send n = do + putStrLn $ unwords $ formatMessage n + hFlush stdout diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs index fa34ad245d..412b9ae08e 100644 --- a/Command/PreCommit.hs +++ b/Command/PreCommit.hs @@ -5,6 +5,8 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE CPP #-} + module Command.PreCommit where import Common.Annex @@ -16,11 +18,17 @@ import Annex.Direct import Annex.Hook import Annex.View import Annex.View.ViewedFile +import Annex.Perms +import Annex.Exception import Logs.View import Logs.MetaData import Types.View import Types.MetaData +#ifdef mingw32_HOST_OS +import Utility.WinLock +#endif + import qualified Data.Set as S def :: [Command] @@ -28,7 +36,7 @@ def = [command "pre-commit" paramPaths seek SectionPlumbing "run by git pre-commit hook"] seek :: CommandSeek -seek ps = ifM isDirect +seek ps = lockPreCommitHook $ ifM isDirect ( do -- update direct mode mappings for committed files withWords startDirect ps @@ -82,3 +90,22 @@ showMetaDataChange = showLongNote . unlines . concatMap showmeta . fromMetaData showset v | isSet v = "+" | otherwise = "-" + +{- Takes exclusive lock; blocks until available. -} +lockPreCommitHook :: Annex a -> Annex a +lockPreCommitHook a = do + lockfile <- fromRepo gitAnnexPreCommitLock + createAnnexDirectory $ takeDirectory lockfile + mode <- annexFileMode + bracketIO (lock lockfile mode) unlock (const a) + where +#ifndef mingw32_HOST_OS + lock lockfile mode = do + l <- liftIO $ noUmask mode $ createFile lockfile mode + liftIO $ waitToSetLock l (WriteLock, AbsoluteSeek, 0, 0) + return l + unlock = closeFd +#else + lock lockfile _mode = liftIO $ waitToLock $ lockExclusive lockfile + unlock = dropLock +#endif diff --git a/Command/RemoteDaemon.hs b/Command/RemoteDaemon.hs new file mode 100644 index 0000000000..61c3a7d846 --- /dev/null +++ b/Command/RemoteDaemon.hs @@ -0,0 +1,24 @@ +{- git-annex command + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.RemoteDaemon where + +import Common.Annex +import Command +import RemoteDaemon.Core + +def :: [Command] +def = [noCommit $ command "remotedaemon" paramNothing seek SectionPlumbing + "detects when remotes have changed, and fetches from them"] + +seek :: CommandSeek +seek = withNothing start + +start :: CommandStart +start = do + liftIO runForeground + stop diff --git a/Command/SendKey.hs b/Command/SendKey.hs index 2215b16b2c..a201d1b89a 100644 --- a/Command/SendKey.hs +++ b/Command/SendKey.hs @@ -12,7 +12,7 @@ import Command import Annex.Content import Annex import Utility.Rsync -import Logs.Transfer +import Annex.Transfer import qualified CmdLine.GitAnnexShell.Fields as Fields import Utility.Metered diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs index b6b2374678..13bfd825e1 100644 --- a/Command/TransferKey.hs +++ b/Command/TransferKey.hs @@ -11,7 +11,7 @@ import Common.Annex import Command import Annex.Content import Logs.Location -import Logs.Transfer +import Annex.Transfer import qualified Remote import Types.Remote @@ -41,7 +41,7 @@ start to from file key = _ -> error "specify either --from or --to" toPerform :: Remote -> Key -> AssociatedFile -> CommandPerform -toPerform remote key file = go $ +toPerform remote key file = go Upload file $ upload (uuid remote) key file forwardRetry $ \p -> do ok <- Remote.storeKey remote key file p when ok $ @@ -49,9 +49,9 @@ toPerform remote key file = go $ return ok fromPerform :: Remote -> Key -> AssociatedFile -> CommandPerform -fromPerform remote key file = go $ +fromPerform remote key file = go Upload file $ download (uuid remote) key file forwardRetry $ \p -> getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p -go :: Annex Bool -> CommandPerform -go a = a >>= liftIO . exitBool +go :: Direction -> AssociatedFile -> (NotifyWitness -> Annex Bool) -> CommandPerform +go direction file a = notifyTransfer direction file a >>= liftIO . exitBool diff --git a/Command/TransferKeys.hs b/Command/TransferKeys.hs index b426286092..05129005b7 100644 --- a/Command/TransferKeys.hs +++ b/Command/TransferKeys.hs @@ -13,11 +13,10 @@ import Common.Annex import Command import Annex.Content import Logs.Location -import Logs.Transfer +import Annex.Transfer import qualified Remote import Types.Key - -import GHC.IO.Handle +import Utility.SimpleProtocol (ioHandles) data TransferRequest = TransferRequest Direction Remote Key AssociatedFile @@ -29,34 +28,21 @@ seek :: CommandSeek seek = withNothing start start :: CommandStart -start = withHandles $ \(readh, writeh) -> do +start = do + (readh, writeh) <- liftIO ioHandles runRequests readh writeh runner stop where runner (TransferRequest direction remote key file) - | direction == Upload = + | direction == Upload = notifyTransfer direction file $ upload (Remote.uuid remote) key file forwardRetry $ \p -> do ok <- Remote.storeKey remote key file p when ok $ Remote.logStatus remote key InfoPresent return ok - | otherwise = download (Remote.uuid remote) key file forwardRetry $ \p -> - getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p - -{- stdin and stdout are connected with the caller, to be used for - - communication with it. But doing a transfer might involve something - - that tries to read from stdin, or write to stdout. To avoid that, close - - stdin, and duplicate stderr to stdout. Return two new handles - - that are duplicates of the original (stdin, stdout). -} -withHandles :: ((Handle, Handle) -> Annex a) -> Annex a -withHandles a = do - readh <- liftIO $ hDuplicate stdin - writeh <- liftIO $ hDuplicate stdout - liftIO $ do - nullh <- openFile devNull ReadMode - nullh `hDuplicateTo` stdin - stderr `hDuplicateTo` stdout - a (readh, writeh) + | otherwise = notifyTransfer direction file $ + download (Remote.uuid remote) key file forwardRetry $ \p -> + getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p runRequests :: Handle diff --git a/Command/Unannex.hs b/Command/Unannex.hs index 1f29784308..3da7c2a411 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -16,15 +16,47 @@ import qualified Annex import Annex.Content import Annex.Content.Direct import qualified Git.Command -import qualified Git.LsFiles as LsFiles +import qualified Git.Ref +import qualified Git.DiffTree as DiffTree import Utility.CopyFile +import Command.PreCommit (lockPreCommitHook) def :: [Command] def = [command "unannex" paramPaths seek SectionUtility "undo accidential add command"] seek :: CommandSeek -seek = withFilesInGit $ whenAnnexed start +seek = wrapUnannex . (withFilesInGit $ whenAnnexed start) + +wrapUnannex :: Annex a -> Annex a +wrapUnannex a = ifM isDirect + ( a + {- Run with the pre-commit hook disabled, to avoid confusing + - behavior if an unannexed file is added back to git as + - a normal, non-annexed file and then committed. + - Otherwise, the pre-commit hook would think that the file + - has been unlocked and needs to be re-annexed. + - + - At the end, make a commit removing the unannexed files. + -} + , ifM cleanindex + ( lockPreCommitHook $ commit `after` a + , error "Cannot proceed with uncommitted changes staged in the index. Recommend you: git commit" + ) + ) + where + commit = inRepo $ Git.Command.run + [ Param "commit" + , Param "-q" + , Param "--allow-empty" + , Param "--no-verify" + , Param "-m", Param "content removed from git annex" + ] + cleanindex = do + (diff, cleanup) <- inRepo $ DiffTree.diffIndex Git.Ref.headRef + if null diff + then void (liftIO cleanup) >> return True + else void (liftIO cleanup) >> return False start :: FilePath -> (Key, Backend) -> CommandStart start file (key, _) = stopUnless (inAnnex key) $ do @@ -36,26 +68,7 @@ start file (key, _) = stopUnless (inAnnex key) $ do performIndirect :: FilePath -> Key -> CommandPerform performIndirect file key = do liftIO $ removeFile file - - -- git rm deletes empty directory without --cached inRepo $ Git.Command.run [Params "rm --cached --force --quiet --", File file] - - -- If the file was already committed, it is now staged for removal. - -- Commit that removal now, to avoid later confusing the - -- pre-commit hook, if this file is later added back to - -- git as a normal non-annexed file, to thinking that the - -- file has been unlocked and needs to be re-annexed. - (s, reap) <- inRepo $ LsFiles.staged [file] - unless (null s) $ - inRepo $ Git.Command.run - [ Param "commit" - , Param "-q" - , Param "--no-verify" - , Param "-m", Param "content removed from git annex" - , Param "--", File file - ] - void $ liftIO reap - next $ cleanupIndirect file key cleanupIndirect :: FilePath -> Key -> CommandCleanup diff --git a/Command/Uninit.hs b/Command/Uninit.hs index 2a9e3e687e..5b2adf0bd1 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -36,7 +36,7 @@ check = do seek :: CommandSeek seek ps = do - withFilesNotInGit (whenAnnexed startCheckIncomplete) ps + withFilesNotInGit False (whenAnnexed startCheckIncomplete) ps withFilesInGit (whenAnnexed Command.Unannex.start) ps finish diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs index c62769c955..d7d5229da2 100644 --- a/Command/Vicfg.hs +++ b/Command/Vicfg.hs @@ -61,6 +61,7 @@ data Cfg = Cfg { cfgTrustMap :: TrustMap , cfgGroupMap :: M.Map UUID (S.Set Group) , cfgPreferredContentMap :: M.Map UUID PreferredContentExpression + , cfgRequiredContentMap :: M.Map UUID PreferredContentExpression , cfgGroupPreferredContentMap :: M.Map Group PreferredContentExpression , cfgScheduleMap :: M.Map UUID [ScheduledActivity] } @@ -70,6 +71,7 @@ getCfg = Cfg <$> trustMapRaw -- without local trust overrides <*> (groupsByUUID <$> groupMap) <*> preferredContentMapRaw + <*> requiredContentMapRaw <*> groupPreferredContentMapRaw <*> scheduleMap @@ -79,6 +81,7 @@ setCfg curcfg newcfg = do mapM_ (uncurry trustSet) $ M.toList $ cfgTrustMap diff mapM_ (uncurry groupSet) $ M.toList $ cfgGroupMap diff mapM_ (uncurry preferredContentSet) $ M.toList $ cfgPreferredContentMap diff + mapM_ (uncurry requiredContentSet) $ M.toList $ cfgRequiredContentMap diff mapM_ (uncurry groupPreferredContentSet) $ M.toList $ cfgGroupPreferredContentMap diff mapM_ (uncurry scheduleSet) $ M.toList $ cfgScheduleMap diff @@ -87,6 +90,7 @@ diffCfg curcfg newcfg = Cfg { cfgTrustMap = diff cfgTrustMap , cfgGroupMap = diff cfgGroupMap , cfgPreferredContentMap = diff cfgPreferredContentMap + , cfgRequiredContentMap = diff cfgRequiredContentMap , cfgGroupPreferredContentMap = diff cfgGroupPreferredContentMap , cfgScheduleMap = diff cfgScheduleMap } @@ -102,6 +106,7 @@ genCfg cfg descs = unlines $ intercalate [""] , preferredcontent , grouppreferredcontent , standardgroups + , requiredcontent , schedule ] where @@ -137,6 +142,11 @@ genCfg cfg descs = unlines $ intercalate [""] [ com "Repository preferred contents" ] (\(s, u) -> line "wanted" u s) (\u -> line "wanted" u "standard") + + requiredcontent = settings cfg descs cfgRequiredContentMap + [ com "Repository required contents" ] + (\(s, u) -> line "required" u s) + (\u -> line "required" u "") grouppreferredcontent = settings' cfg allgroups cfgGroupPreferredContentMap [ com "Group preferred contents" @@ -228,6 +238,12 @@ parseCfg curcfg = go [] curcfg . lines Nothing -> let m = M.insert u value (cfgPreferredContentMap cfg) in Right $ cfg { cfgPreferredContentMap = m } + | setting == "required" = + case checkPreferredContentExpression value of + Just e -> Left e + Nothing -> + let m = M.insert u value (cfgRequiredContentMap cfg) + in Right $ cfg { cfgRequiredContentMap = m } | setting == "groupwanted" = case checkPreferredContentExpression value of Just e -> Left e @@ -255,7 +271,6 @@ parseCfg curcfg = go [] curcfg . lines [ com "** There was a problem parsing your input!" , com "** Search for \"Parse error\" to find the bad lines." , com "** Either fix the bad lines, or delete them (to discard your changes)." - , "" ] parseerr = com "** Parse error in next line: " diff --git a/Common.hs b/Common.hs index 6612c9c544..4d6165ac55 100644 --- a/Common.hs +++ b/Common.hs @@ -11,6 +11,7 @@ import Control.Exception.Extensible as X (IOException) import Data.Maybe as X import Data.List as X hiding (head, tail, init, last) import Data.String.Utils as X hiding (join) +import Data.Monoid as X import System.FilePath as X import System.Directory as X diff --git a/Config.hs b/Config.hs index 10d4fd190f..32644263f2 100644 --- a/Config.hs +++ b/Config.hs @@ -32,7 +32,10 @@ getConfigMaybe (ConfigKey key) = fromRepo $ Git.Config.getMaybe key setConfig :: ConfigKey -> String -> Annex () setConfig (ConfigKey key) value = do inRepo $ Git.Command.run [Param "config", Param key, Param value] - Annex.changeGitRepo =<< inRepo Git.Config.reRead + reloadConfig + +reloadConfig :: Annex () +reloadConfig = Annex.changeGitRepo =<< inRepo Git.Config.reRead {- Unsets a git config setting. (Leaves it in state currently.) -} unsetConfig :: ConfigKey -> Annex () diff --git a/Git/Types.hs b/Git/Types.hs index 8029225323..950fe4b00c 100644 --- a/Git/Types.hs +++ b/Git/Types.hs @@ -27,7 +27,7 @@ data RepoLocation | LocalUnknown FilePath | Url URI | Unknown - deriving (Show, Eq) + deriving (Show, Eq, Ord) data Repo = Repo { location :: RepoLocation @@ -41,7 +41,7 @@ data Repo = Repo , gitEnv :: Maybe [(String, String)] -- global options to pass to git when running git commands , gitGlobalOpts :: [CommandParam] - } deriving (Show, Eq) + } deriving (Show, Eq, Ord) type RemoteName = String diff --git a/Limit.hs b/Limit.hs index 7654842e16..b46ff1a06f 100644 --- a/Limit.hs +++ b/Limit.hs @@ -20,7 +20,6 @@ import Types.TrustLevel import Types.Key import Types.Group import Types.FileMatcher -import Types.Limit import Types.MetaData import Logs.MetaData import Logs.Group @@ -45,21 +44,20 @@ getMatcher :: Annex (MatchInfo -> Annex Bool) getMatcher = Utility.Matcher.matchM <$> getMatcher' getMatcher' :: Annex (Utility.Matcher.Matcher (MatchInfo -> Annex Bool)) -getMatcher' = do - m <- Annex.getState Annex.limit - case m of - Right r -> return r - Left l -> do - let matcher = Utility.Matcher.generate (reverse l) - Annex.changeState $ \s -> - s { Annex.limit = Right matcher } - return matcher +getMatcher' = go =<< Annex.getState Annex.limit + where + go (CompleteMatcher matcher) = return matcher + go (BuildingMatcher l) = do + let matcher = Utility.Matcher.generate (reverse l) + Annex.changeState $ \s -> + s { Annex.limit = CompleteMatcher matcher } + return matcher {- Adds something to the limit list, which is built up reversed. -} add :: Utility.Matcher.Token (MatchInfo -> Annex Bool) -> Annex () add l = Annex.changeState $ \s -> s { Annex.limit = prepend $ Annex.limit s } where - prepend (Left ls) = Left $ l:ls + prepend (BuildingMatcher ls) = BuildingMatcher $ l:ls prepend _ = error "internal" {- Adds a new token. -} @@ -67,21 +65,21 @@ addToken :: String -> Annex () addToken = add . Utility.Matcher.token {- Adds a new limit. -} -addLimit :: Either String MatchFiles -> Annex () +addLimit :: Either String (MatchFiles Annex) -> Annex () addLimit = either error (\l -> add $ Utility.Matcher.Operation $ l S.empty) {- Add a limit to skip files that do not match the glob. -} addInclude :: String -> Annex () addInclude = addLimit . limitInclude -limitInclude :: MkLimit +limitInclude :: MkLimit Annex limitInclude glob = Right $ const $ return . matchGlobFile glob {- Add a limit to skip files that match the glob. -} addExclude :: String -> Annex () addExclude = addLimit . limitExclude -limitExclude :: MkLimit +limitExclude :: MkLimit Annex limitExclude glob = Right $ const $ return . not . matchGlobFile glob matchGlobFile :: String -> (MatchInfo -> Bool) @@ -119,10 +117,10 @@ addIn s = addLimit =<< mk else inAnnex key {- Limit to content that is currently present on a uuid. -} -limitPresent :: Maybe UUID -> MkLimit +limitPresent :: Maybe UUID -> MkLimit Annex limitPresent u _ = Right $ matchPresent u -matchPresent :: Maybe UUID -> MatchFiles +matchPresent :: Maybe UUID -> MatchFiles Annex matchPresent u _ = checkKey $ \key -> do hereu <- getUUID if u == Just hereu || isNothing u @@ -132,7 +130,7 @@ matchPresent u _ = checkKey $ \key -> do return $ maybe False (`elem` us) u {- Limit to content that is in a directory, anywhere in the repository tree -} -limitInDir :: FilePath -> MkLimit +limitInDir :: FilePath -> MkLimit Annex limitInDir dir = const $ Right $ const go where go (MatchingFile fi) = return $ elem dir $ splitPath $ takeDirectory $ matchFile fi @@ -143,7 +141,7 @@ limitInDir dir = const $ Right $ const go addCopies :: String -> Annex () addCopies = addLimit . limitCopies -limitCopies :: MkLimit +limitCopies :: MkLimit Annex limitCopies want = case split ":" want of [v, n] -> case parsetrustspec v of Just checker -> go n $ checktrust checker @@ -169,7 +167,7 @@ limitCopies want = case split ":" want of addLackingCopies :: Bool -> String -> Annex () addLackingCopies approx = addLimit . limitLackingCopies approx -limitLackingCopies :: Bool -> MkLimit +limitLackingCopies :: Bool -> MkLimit Annex limitLackingCopies approx want = case readish want of Just needed -> Right $ \notpresent mi -> flip checkKey mi $ handle mi needed notpresent @@ -191,7 +189,7 @@ limitLackingCopies approx want = case readish want of - This has a nice optimisation: When a file exists, - its key is obviously not unused. -} -limitUnused :: MatchFiles +limitUnused :: MatchFiles Annex limitUnused _ (MatchingFile _) = return False limitUnused _ (MatchingKey k) = S.member k <$> unusedKeys @@ -202,7 +200,7 @@ addInAllGroup groupname = do m <- groupMap addLimit $ limitInAllGroup m groupname -limitInAllGroup :: GroupMap -> MkLimit +limitInAllGroup :: GroupMap -> MkLimit Annex limitInAllGroup m groupname | S.null want = Right $ const $ const $ return True | otherwise = Right $ \notpresent -> checkKey $ check notpresent @@ -219,7 +217,7 @@ limitInAllGroup m groupname addInBackend :: String -> Annex () addInBackend = addLimit . limitInBackend -limitInBackend :: MkLimit +limitInBackend :: MkLimit Annex limitInBackend name = Right $ const $ checkKey check where check key = pure $ keyBackendName key == name @@ -231,7 +229,7 @@ addLargerThan = addLimit . limitSize (>) addSmallerThan :: String -> Annex () addSmallerThan = addLimit . limitSize (<) -limitSize :: (Maybe Integer -> Maybe Integer -> Bool) -> MkLimit +limitSize :: (Maybe Integer -> Maybe Integer -> Bool) -> MkLimit Annex limitSize vs s = case readSize dataUnits s of Nothing -> Left "bad size" Just sz -> Right $ go sz @@ -249,7 +247,7 @@ limitSize vs s = case readSize dataUnits s of addMetaData :: String -> Annex () addMetaData = addLimit . limitMetaData -limitMetaData :: MkLimit +limitMetaData :: MkLimit Annex limitMetaData s = case parseMetaData s of Left e -> Left e Right (f, v) -> diff --git a/Locations.hs b/Locations.hs index 74cace156a..5bff63eaf6 100644 --- a/Locations.hs +++ b/Locations.hs @@ -41,6 +41,7 @@ module Locations ( gitAnnexMergeDir, gitAnnexJournalDir, gitAnnexJournalLock, + gitAnnexPreCommitLock, gitAnnexIndex, gitAnnexIndexStatus, gitAnnexViewIndex, @@ -257,6 +258,10 @@ gitAnnexJournalDir r = addTrailingPathSeparator $ gitAnnexDir r "journal" gitAnnexJournalLock :: Git.Repo -> FilePath gitAnnexJournalLock r = gitAnnexDir r "journal.lck" +{- Lock file for the pre-commit hook. -} +gitAnnexPreCommitLock :: Git.Repo -> FilePath +gitAnnexPreCommitLock r = gitAnnexDir r "precommit.lck" + {- .git/annex/index is used to stage changes to the git-annex branch -} gitAnnexIndex :: Git.Repo -> FilePath gitAnnexIndex r = gitAnnexDir r "index" diff --git a/Logs.hs b/Logs.hs index 2a2fc430e0..c9d58157a5 100644 --- a/Logs.hs +++ b/Logs.hs @@ -35,6 +35,7 @@ topLevelUUIDBasedLogs = , trustLog , groupLog , preferredContentLog + , requiredContentLog , scheduleLog ] @@ -70,6 +71,9 @@ groupLog = "group.log" preferredContentLog :: FilePath preferredContentLog = "preferred-content.log" +requiredContentLog :: FilePath +requiredContentLog = "required-content.log" + groupPreferredContentLog :: FilePath groupPreferredContentLog = "group-preferred-content.log" diff --git a/Logs/PreferredContent.hs b/Logs/PreferredContent.hs index 5580c062db..ead303f1f4 100644 --- a/Logs/PreferredContent.hs +++ b/Logs/PreferredContent.hs @@ -6,16 +6,19 @@ -} module Logs.PreferredContent ( - preferredContentLog, preferredContentSet, + requiredContentSet, groupPreferredContentSet, isPreferredContent, + isRequiredContent, preferredContentMap, - preferredContentMapLoad, preferredContentMapRaw, + requiredContentMap, + requiredContentMapRaw, groupPreferredContentMapRaw, checkPreferredContentExpression, setStandardGroup, + preferredRequiredMapsLoad, ) where import qualified Data.Map as M @@ -28,43 +31,57 @@ import qualified Annex.Branch import qualified Annex import Logs import Logs.UUIDBased -import qualified Utility.Matcher +import Utility.Matcher hiding (tokens) import Annex.FileMatcher import Annex.UUID -import Types.Limit import Types.Group import Types.Remote (RemoteConfig) import Logs.Group import Logs.Remote +import Types.FileMatcher import Types.StandardGroups import Limit {- Checks if a file is preferred content for the specified repository - (or the current repository if none is specified). -} isPreferredContent :: Maybe UUID -> AssumeNotPresent -> Maybe Key -> AssociatedFile -> Bool -> Annex Bool -isPreferredContent mu notpresent mkey afile def = do +isPreferredContent = checkMap preferredContentMap + +isRequiredContent :: Maybe UUID -> AssumeNotPresent -> Maybe Key -> AssociatedFile -> Bool -> Annex Bool +isRequiredContent = checkMap requiredContentMap + +checkMap :: Annex (FileMatcherMap Annex) -> Maybe UUID -> AssumeNotPresent -> Maybe Key -> AssociatedFile -> Bool -> Annex Bool +checkMap getmap mu notpresent mkey afile def = do u <- maybe getUUID return mu - m <- preferredContentMap + m <- getmap case M.lookup u m of Nothing -> return def Just matcher -> checkMatcher matcher mkey afile notpresent def -{- The map is cached for speed. -} -preferredContentMap :: Annex Annex.PreferredContentMap -preferredContentMap = maybe preferredContentMapLoad return +preferredContentMap :: Annex (FileMatcherMap Annex) +preferredContentMap = maybe (fst <$> preferredRequiredMapsLoad) return =<< Annex.getState Annex.preferredcontentmap -{- Loads the map, updating the cache. -} -preferredContentMapLoad :: Annex Annex.PreferredContentMap -preferredContentMapLoad = do +requiredContentMap :: Annex (FileMatcherMap Annex) +requiredContentMap = maybe (snd <$> preferredRequiredMapsLoad) return + =<< Annex.getState Annex.requiredcontentmap + +preferredRequiredMapsLoad :: Annex (FileMatcherMap Annex, FileMatcherMap Annex) +preferredRequiredMapsLoad = do groupmap <- groupMap configmap <- readRemoteLog - groupwantedmap <- groupPreferredContentMapRaw - m <- simpleMap - . parseLogWithUUID ((Just .) . makeMatcher groupmap configmap groupwantedmap) - <$> Annex.Branch.get preferredContentLog - Annex.changeState $ \s -> s { Annex.preferredcontentmap = Just m } - return m + let genmap l gm = simpleMap + . parseLogWithUUID ((Just .) . makeMatcher groupmap configmap gm) + <$> Annex.Branch.get l + pc <- genmap preferredContentLog =<< groupPreferredContentMapRaw + rc <- genmap requiredContentLog M.empty + -- Required content is implicitly also preferred content, so OR + let m = M.unionWith MOr pc rc + Annex.changeState $ \s -> s + { Annex.preferredcontentmap = Just m + , Annex.requiredcontentmap = Just rc + } + return (m, rc) {- This intentionally never fails, even on unparsable expressions, - because the configuration is shared among repositories and newer @@ -75,11 +92,11 @@ makeMatcher -> M.Map Group PreferredContentExpression -> UUID -> PreferredContentExpression - -> FileMatcher + -> FileMatcher Annex makeMatcher groupmap configmap groupwantedmap u = go True True where go expandstandard expandgroupwanted expr - | null (lefts tokens) = Utility.Matcher.generate $ rights tokens + | null (lefts tokens) = generate $ rights tokens | otherwise = unknownMatcher u where tokens = exprParser matchstandard matchgroupwanted groupmap configmap (Just u) expr @@ -102,10 +119,10 @@ makeMatcher groupmap configmap groupwantedmap u = go True True - - This avoid unwanted/expensive changes to the content, until the problem - is resolved. -} -unknownMatcher :: UUID -> FileMatcher -unknownMatcher u = Utility.Matcher.generate [present] +unknownMatcher :: UUID -> FileMatcher Annex +unknownMatcher u = generate [present] where - present = Utility.Matcher.Operation $ matchPresent (Just u) + present = Operation $ matchPresent (Just u) {- Checks if an expression can be parsed, if not returns Just error -} checkPreferredContentExpression :: PreferredContentExpression -> Maybe String diff --git a/Logs/PreferredContent/Raw.hs b/Logs/PreferredContent/Raw.hs index ce91c2dcdd..bbf5a1edc1 100644 --- a/Logs/PreferredContent/Raw.hs +++ b/Logs/PreferredContent/Raw.hs @@ -21,14 +21,23 @@ import Types.Group {- Changes the preferred content configuration of a remote. -} preferredContentSet :: UUID -> PreferredContentExpression -> Annex () -preferredContentSet uuid@(UUID _) val = do +preferredContentSet = setLog preferredContentLog + +requiredContentSet :: UUID -> PreferredContentExpression -> Annex () +requiredContentSet = setLog requiredContentLog + +setLog :: FilePath -> UUID -> PreferredContentExpression -> Annex () +setLog logfile uuid@(UUID _) val = do ts <- liftIO getPOSIXTime - Annex.Branch.change preferredContentLog $ + Annex.Branch.change logfile $ showLog id . changeLog ts uuid val . parseLog Just - Annex.changeState $ \s -> s { Annex.preferredcontentmap = Nothing } -preferredContentSet NoUUID _ = error "unknown UUID; cannot modify" + Annex.changeState $ \s -> s + { Annex.preferredcontentmap = Nothing + , Annex.requiredcontentmap = Nothing + } +setLog _ NoUUID _ = error "unknown UUID; cannot modify" {- Changes the preferred content configuration of a group. -} groupPreferredContentSet :: Group -> PreferredContentExpression -> Annex () @@ -44,6 +53,10 @@ preferredContentMapRaw :: Annex (M.Map UUID PreferredContentExpression) preferredContentMapRaw = simpleMap . parseLog Just <$> Annex.Branch.get preferredContentLog +requiredContentMapRaw :: Annex (M.Map UUID PreferredContentExpression) +requiredContentMapRaw = simpleMap . parseLog Just + <$> Annex.Branch.get requiredContentLog + groupPreferredContentMapRaw :: Annex (M.Map Group PreferredContentExpression) groupPreferredContentMapRaw = simpleMap . parseMapLog Just Just <$> Annex.Branch.get groupPreferredContentLog diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index 742bdc7b9a..c96d9cd1e7 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -88,108 +88,6 @@ percentComplete :: Transfer -> TransferInfo -> Maybe Percentage percentComplete (Transfer { transferKey = key }) info = percentage <$> keySize key <*> Just (fromMaybe 0 $ bytesComplete info) -type RetryDecider = TransferInfo -> TransferInfo -> Bool - -noRetry :: RetryDecider -noRetry _ _ = False - -{- Retries a transfer when it fails, as long as the failed transfer managed - - to send some data. -} -forwardRetry :: RetryDecider -forwardRetry old new = bytesComplete old < bytesComplete new - -upload :: UUID -> Key -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex Bool) -> Annex Bool -upload u key = runTransfer (Transfer Upload u key) - -download :: UUID -> Key -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex Bool) -> Annex Bool -download u key = runTransfer (Transfer Download u key) - -{- Runs a transfer action. Creates and locks the lock file while the - - action is running, and stores info in the transfer information - - file. - - - - If the transfer action returns False, the transfer info is - - left in the failedTransferDir. - - - - If the transfer is already in progress, returns False. - - - - An upload can be run from a read-only filesystem, and in this case - - no transfer information or lock file is used. - -} -runTransfer :: Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex Bool) -> Annex Bool -runTransfer t file shouldretry a = do - info <- liftIO $ startTransferInfo file - (meter, tfile, metervar) <- mkProgressUpdater t info - mode <- annexFileMode - (fd, inprogress) <- liftIO $ prep tfile mode info - if inprogress - then do - showNote "transfer already in progress" - return False - else do - ok <- retry info metervar $ - bracketIO (return fd) (cleanup tfile) (const $ a meter) - unless ok $ recordFailedTransfer t info - return ok - where -#ifndef mingw32_HOST_OS - prep tfile mode info = do - mfd <- catchMaybeIO $ - openFd (transferLockFile tfile) ReadWrite (Just mode) - defaultFileFlags { trunc = True } - case mfd of - Nothing -> return (Nothing, False) - Just fd -> do - locked <- catchMaybeIO $ - setLock fd (WriteLock, AbsoluteSeek, 0, 0) - if isNothing locked - then return (Nothing, True) - else do - void $ tryIO $ writeTransferInfoFile info tfile - return (mfd, False) -#else - prep tfile _mode info = do - v <- catchMaybeIO $ lockExclusive (transferLockFile tfile) - case v of - Nothing -> return (Nothing, False) - Just Nothing -> return (Nothing, True) - Just (Just lockhandle) -> do - void $ tryIO $ writeTransferInfoFile info tfile - return (Just lockhandle, False) -#endif - cleanup _ Nothing = noop - cleanup tfile (Just lockhandle) = do - void $ tryIO $ removeFile tfile -#ifndef mingw32_HOST_OS - void $ tryIO $ removeFile $ transferLockFile tfile - closeFd lockhandle -#else - {- Windows cannot delete the lockfile until the lock - - is closed. So it's possible to race with another - - process that takes the lock before it's removed, - - so ignore failure to remove. - -} - dropLock lockhandle - void $ tryIO $ removeFile $ transferLockFile tfile -#endif - retry oldinfo metervar run = do - v <- tryAnnex run - case v of - Right b -> return b - Left _ -> do - b <- getbytescomplete metervar - let newinfo = oldinfo { bytesComplete = Just b } - if shouldretry oldinfo newinfo - then retry newinfo metervar run - else return False - getbytescomplete metervar - | transferDirection t == Upload = - liftIO $ readMVar metervar - | otherwise = do - f <- fromRepo $ gitAnnexTmpObjectLocation (transferKey t) - liftIO $ catchDefaultIO 0 $ - fromIntegral . fileSize <$> getFileStatus f - {- Generates a callback that can be called as transfer progresses to update - the transfer info file. Also returns the file it'll be updating, and a - MVar that can be used to read the number of bytesComplete. -} diff --git a/Makefile b/Makefile index 45b9a578b8..5c474e9ca1 100644 --- a/Makefile +++ b/Makefile @@ -140,7 +140,7 @@ OSXAPP_BASE=$(OSXAPP_DEST)/Contents/MacOS/bundle osxapp: Build/Standalone Build/OSXMkLibs $(MAKE) git-annex - rm -rf "$(OSXAPP_DEST)" + rm -rf "$(OSXAPP_DEST)" "$(OSXAPP_BASE)" install -d tmp/build-dmg cp -R standalone/osx/git-annex.app "$(OSXAPP_DEST)" diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs index 1e17a2c4c5..983764f701 100644 --- a/Remote/External/Types.hs +++ b/Remote/External/Types.hs @@ -6,6 +6,7 @@ -} {-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module Remote.External.Types ( External(..), @@ -15,9 +16,9 @@ module Remote.External.Types ( withExternalLock, ExternalState(..), PrepareStatus(..), - parseMessage, - Sendable(..), - Receivable(..), + Proto.parseMessage, + Proto.Sendable(..), + Proto.Receivable(..), Request(..), needsPREPARE, Response(..), @@ -39,12 +40,11 @@ import Logs.Transfer (Direction(..)) import Config.Cost (Cost) import Types.Remote (RemoteConfig) import Types.Availability (Availability(..)) +import qualified Utility.SimpleProtocol as Proto -import Data.Char import Control.Concurrent.STM -- If the remote is not yet running, the ExternalState TMVar is empty. --- The data External = External { externalType :: ExternalType , externalUUID :: UUID @@ -85,22 +85,6 @@ withExternalLock external = bracketIO setup cleanup cleanup = atomically . putTMVar v v = externalLock external --- Messages that git-annex can send. -class Sendable m where - formatMessage :: m -> [String] - --- Messages that git-annex can receive. -class Receivable m where - -- Passed the first word of the message, returns - -- a Parser that can be be fed the rest of the message to generate - -- the value. - parseCommand :: String -> Parser m - -parseMessage :: (Receivable m) => String -> Maybe m -parseMessage s = parseCommand command rest - where - (command, rest) = splitWord s - -- Messages that can be sent to the external remote to request it do something. data Request = PREPARE @@ -118,15 +102,19 @@ needsPREPARE PREPARE = False needsPREPARE INITREMOTE = False needsPREPARE _ = True -instance Sendable Request where +instance Proto.Sendable Request where formatMessage PREPARE = ["PREPARE"] formatMessage INITREMOTE = ["INITREMOTE"] formatMessage GETCOST = ["GETCOST"] formatMessage GETAVAILABILITY = ["GETAVAILABILITY"] formatMessage (TRANSFER direction key file) = - [ "TRANSFER", serialize direction, serialize key, serialize file ] - formatMessage (CHECKPRESENT key) = [ "CHECKPRESENT", serialize key ] - formatMessage (REMOVE key) = [ "REMOVE", serialize key ] + [ "TRANSFER" + , Proto.serialize direction + , Proto.serialize key + , Proto.serialize file + ] + formatMessage (CHECKPRESENT key) = [ "CHECKPRESENT", Proto.serialize key ] + formatMessage (REMOVE key) = [ "REMOVE", Proto.serialize key ] -- Responses the external remote can make to requests. data Response @@ -146,22 +134,22 @@ data Response | UNSUPPORTED_REQUEST deriving (Show) -instance Receivable Response where - parseCommand "PREPARE-SUCCESS" = parse0 PREPARE_SUCCESS - parseCommand "PREPARE-FAILURE" = parse1 PREPARE_FAILURE - parseCommand "TRANSFER-SUCCESS" = parse2 TRANSFER_SUCCESS - parseCommand "TRANSFER-FAILURE" = parse3 TRANSFER_FAILURE - parseCommand "CHECKPRESENT-SUCCESS" = parse1 CHECKPRESENT_SUCCESS - parseCommand "CHECKPRESENT-FAILURE" = parse1 CHECKPRESENT_FAILURE - parseCommand "CHECKPRESENT-UNKNOWN" = parse2 CHECKPRESENT_UNKNOWN - parseCommand "REMOVE-SUCCESS" = parse1 REMOVE_SUCCESS - parseCommand "REMOVE-FAILURE" = parse2 REMOVE_FAILURE - parseCommand "COST" = parse1 COST - parseCommand "AVAILABILITY" = parse1 AVAILABILITY - parseCommand "INITREMOTE-SUCCESS" = parse0 INITREMOTE_SUCCESS - parseCommand "INITREMOTE-FAILURE" = parse1 INITREMOTE_FAILURE - parseCommand "UNSUPPORTED-REQUEST" = parse0 UNSUPPORTED_REQUEST - parseCommand _ = parseFail +instance Proto.Receivable Response where + parseCommand "PREPARE-SUCCESS" = Proto.parse0 PREPARE_SUCCESS + parseCommand "PREPARE-FAILURE" = Proto.parse1 PREPARE_FAILURE + parseCommand "TRANSFER-SUCCESS" = Proto.parse2 TRANSFER_SUCCESS + parseCommand "TRANSFER-FAILURE" = Proto.parse3 TRANSFER_FAILURE + parseCommand "CHECKPRESENT-SUCCESS" = Proto.parse1 CHECKPRESENT_SUCCESS + parseCommand "CHECKPRESENT-FAILURE" = Proto.parse1 CHECKPRESENT_FAILURE + parseCommand "CHECKPRESENT-UNKNOWN" = Proto.parse2 CHECKPRESENT_UNKNOWN + parseCommand "REMOVE-SUCCESS" = Proto.parse1 REMOVE_SUCCESS + parseCommand "REMOVE-FAILURE" = Proto.parse2 REMOVE_FAILURE + parseCommand "COST" = Proto.parse1 COST + parseCommand "AVAILABILITY" = Proto.parse1 AVAILABILITY + parseCommand "INITREMOTE-SUCCESS" = Proto.parse0 INITREMOTE_SUCCESS + parseCommand "INITREMOTE-FAILURE" = Proto.parse1 INITREMOTE_FAILURE + parseCommand "UNSUPPORTED-REQUEST" = Proto.parse0 UNSUPPORTED_REQUEST + parseCommand _ = Proto.parseFail -- Requests that the external remote can send at any time it's in control. data RemoteRequest @@ -181,22 +169,22 @@ data RemoteRequest | DEBUG String deriving (Show) -instance Receivable RemoteRequest where - parseCommand "VERSION" = parse1 VERSION - parseCommand "PROGRESS" = parse1 PROGRESS - parseCommand "DIRHASH" = parse1 DIRHASH - parseCommand "SETCONFIG" = parse2 SETCONFIG - parseCommand "GETCONFIG" = parse1 GETCONFIG - parseCommand "SETCREDS" = parse3 SETCREDS - parseCommand "GETCREDS" = parse1 GETCREDS - parseCommand "GETUUID" = parse0 GETUUID - parseCommand "GETGITDIR" = parse0 GETGITDIR - parseCommand "SETWANTED" = parse1 SETWANTED - parseCommand "GETWANTED" = parse0 GETWANTED - parseCommand "SETSTATE" = parse2 SETSTATE - parseCommand "GETSTATE" = parse1 GETSTATE - parseCommand "DEBUG" = parse1 DEBUG - parseCommand _ = parseFail +instance Proto.Receivable RemoteRequest where + parseCommand "VERSION" = Proto.parse1 VERSION + parseCommand "PROGRESS" = Proto.parse1 PROGRESS + parseCommand "DIRHASH" = Proto.parse1 DIRHASH + parseCommand "SETCONFIG" = Proto.parse2 SETCONFIG + parseCommand "GETCONFIG" = Proto.parse1 GETCONFIG + parseCommand "SETCREDS" = Proto.parse3 SETCREDS + parseCommand "GETCREDS" = Proto.parse1 GETCREDS + parseCommand "GETUUID" = Proto.parse0 GETUUID + parseCommand "GETGITDIR" = Proto.parse0 GETGITDIR + parseCommand "SETWANTED" = Proto.parse1 SETWANTED + parseCommand "GETWANTED" = Proto.parse0 GETWANTED + parseCommand "SETSTATE" = Proto.parse2 SETSTATE + parseCommand "GETSTATE" = Proto.parse1 GETSTATE + parseCommand "DEBUG" = Proto.parse1 DEBUG + parseCommand _ = Proto.parseFail -- Responses to RemoteRequest. data RemoteResponse @@ -204,21 +192,21 @@ data RemoteResponse | CREDS String String deriving (Show) -instance Sendable RemoteResponse where - formatMessage (VALUE s) = [ "VALUE", serialize s ] - formatMessage (CREDS login password) = [ "CREDS", serialize login, serialize password ] +instance Proto.Sendable RemoteResponse where + formatMessage (VALUE s) = [ "VALUE", Proto.serialize s ] + formatMessage (CREDS login password) = [ "CREDS", Proto.serialize login, Proto.serialize password ] -- Messages that can be sent at any time by either git-annex or the remote. data AsyncMessage = ERROR ErrorMsg deriving (Show) -instance Sendable AsyncMessage where - formatMessage (ERROR err) = [ "ERROR", serialize err ] +instance Proto.Sendable AsyncMessage where + formatMessage (ERROR err) = [ "ERROR", Proto.serialize err ] -instance Receivable AsyncMessage where - parseCommand "ERROR" = parse1 ERROR - parseCommand _ = parseFail +instance Proto.Receivable AsyncMessage where + parseCommand "ERROR" = Proto.parse1 ERROR + parseCommand _ = Proto.parseFail -- Data types used for parameters when communicating with the remote. -- All are serializable. @@ -229,11 +217,7 @@ type ProtocolVersion = Int supportedProtocolVersions :: [ProtocolVersion] supportedProtocolVersions = [1] -class ExternalSerializable a where - serialize :: a -> String - deserialize :: String -> Maybe a - -instance ExternalSerializable Direction where +instance Proto.Serializable Direction where serialize Upload = "STORE" serialize Download = "RETRIEVE" @@ -241,23 +225,23 @@ instance ExternalSerializable Direction where deserialize "RETRIEVE" = Just Download deserialize _ = Nothing -instance ExternalSerializable Key where +instance Proto.Serializable Key where serialize = key2file deserialize = file2key -instance ExternalSerializable [Char] where +instance Proto.Serializable [Char] where serialize = id deserialize = Just -instance ExternalSerializable ProtocolVersion where +instance Proto.Serializable ProtocolVersion where serialize = show deserialize = readish -instance ExternalSerializable Cost where +instance Proto.Serializable Cost where serialize = show deserialize = readish -instance ExternalSerializable Availability where +instance Proto.Serializable Availability where serialize GloballyAvailable = "GLOBAL" serialize LocallyAvailable = "LOCAL" @@ -265,37 +249,6 @@ instance ExternalSerializable Availability where deserialize "LOCAL" = Just LocallyAvailable deserialize _ = Nothing -instance ExternalSerializable BytesProcessed where +instance Proto.Serializable BytesProcessed where serialize (BytesProcessed n) = show n deserialize = BytesProcessed <$$> readish - -{- Parsing the parameters of messages. Using the right parseN ensures - - that the string is split into exactly the requested number of words, - - which allows the last parameter of a message to contain arbitrary - - whitespace, etc, without needing any special quoting. - -} -type Parser a = String -> Maybe a - -parseFail :: Parser a -parseFail _ = Nothing - -parse0 :: a -> Parser a -parse0 mk "" = Just mk -parse0 _ _ = Nothing - -parse1 :: ExternalSerializable p1 => (p1 -> a) -> Parser a -parse1 mk p1 = mk <$> deserialize p1 - -parse2 :: (ExternalSerializable p1, ExternalSerializable p2) => (p1 -> p2 -> a) -> Parser a -parse2 mk s = mk <$> deserialize p1 <*> deserialize p2 - where - (p1, p2) = splitWord s - -parse3 :: (ExternalSerializable p1, ExternalSerializable p2, ExternalSerializable p3) => (p1 -> p2 -> p3 -> a) -> Parser a -parse3 mk s = mk <$> deserialize p1 <*> deserialize p2 <*> deserialize p3 - where - (p1, rest) = splitWord s - (p2, p3) = splitWord rest - -splitWord :: String -> (String, String) -splitWord = separate isSpace diff --git a/Remote/Git.hs b/Remote/Git.hs index 995d667795..209312d674 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -24,7 +24,7 @@ import qualified Git.Command import qualified Git.GCrypt import qualified Annex import Logs.Presence -import Logs.Transfer +import Annex.Transfer import Annex.UUID import Annex.Exception import qualified Annex.Content @@ -321,7 +321,7 @@ copyFromRemote' r key file dest case v of Nothing -> return False Just (object, checksuccess) -> - upload u key file noRetry + runTransfer (Transfer Download u key) file noRetry (rsyncOrCopyFile params object dest) <&&> checksuccess | Git.repoIsSsh (repo r) = feedprogressback $ \feeder -> do @@ -418,7 +418,7 @@ copyToRemote r key file p ( return True , do ensureInitialized - download u key file noRetry $ const $ + runTransfer (Transfer Download u key) file noRetry $ const $ Annex.Content.saveState True `after` Annex.Content.getViaTmpChecked (liftIO checksuccessio) key (\d -> rsyncOrCopyFile params object d p) diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs index fe6f53a771..eb274714b4 100644 --- a/Remote/Glacier.hs +++ b/Remote/Glacier.hs @@ -82,7 +82,7 @@ glacierSetup' enabling u c = do unless enabling $ genVault fullconfig u gitConfigSpecialRemote u fullconfig "glacier" "true" - return (c', u) + return (fullconfig, u) where remotename = fromJust (M.lookup "name" c) defvault = remotename ++ "-" ++ fromUUID u @@ -225,7 +225,8 @@ glacierParams :: RemoteConfig -> [CommandParam] -> [CommandParam] glacierParams c params = datacenter:params where datacenter = Param $ "--region=" ++ - fromJust (M.lookup "datacenter" c) + fromMaybe (error "Missing datacenter configuration") + (M.lookup "datacenter" c) glacierEnv :: RemoteConfig -> UUID -> Annex (Maybe [(String, String)]) glacierEnv c u = go =<< getRemoteCredPairFor "glacier" c creds @@ -239,7 +240,8 @@ glacierEnv c u = go =<< getRemoteCredPairFor "glacier" c creds (uk, pk) = credPairEnvironment creds getVault :: RemoteConfig -> Vault -getVault = fromJust . M.lookup "vault" +getVault = fromMaybe (error "Missing vault configuration") + . M.lookup "vault" archive :: Remote -> Key -> Archive archive r k = fileprefix ++ key2file k diff --git a/Remote/Tahoe.hs b/Remote/Tahoe.hs index 56a17eb624..d265d7ac12 100644 --- a/Remote/Tahoe.hs +++ b/Remote/Tahoe.hs @@ -216,7 +216,7 @@ readTahoe hdl command params = withTahoeConfigDir hdl $ \configdir -> tahoeParams :: TahoeConfigDir -> String -> [CommandParam] -> [CommandParam] tahoeParams configdir command params = - Param command : Param "-d" : File configdir : params + Param "-d" : File configdir : Param command : params storeCapability :: UUID -> Key -> Capability -> Annex () storeCapability u k cap = setRemoteState u k cap diff --git a/RemoteDaemon/Common.hs b/RemoteDaemon/Common.hs new file mode 100644 index 0000000000..29aeb00d3b --- /dev/null +++ b/RemoteDaemon/Common.hs @@ -0,0 +1,42 @@ +{- git-remote-daemon utilities + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module RemoteDaemon.Common + ( liftAnnex + , inLocalRepo + , checkNewShas + ) where + +import qualified Annex +import Common.Annex +import RemoteDaemon.Types +import qualified Git +import Annex.CatFile + +import Control.Concurrent + +-- Runs an Annex action. Long-running actions should be avoided, +-- since only one liftAnnex can be running at a time, amoung all +-- transports. +liftAnnex :: TransportHandle -> Annex a -> IO a +liftAnnex (TransportHandle _ annexstate) a = do + st <- takeMVar annexstate + (r, st') <- Annex.run st a + putMVar annexstate st' + return r + +inLocalRepo :: TransportHandle -> (Git.Repo -> IO a) -> IO a +inLocalRepo (TransportHandle g _) a = a g + +-- Check if any of the shas are actally new in the local git repo, +-- to avoid unnecessary fetching. +checkNewShas :: TransportHandle -> [Git.Sha] -> IO Bool +checkNewShas transporthandle = check + where + check [] = return True + check (r:rs) = maybe (check rs) (const $ return False) + =<< liftAnnex transporthandle (catObjectDetails r) diff --git a/RemoteDaemon/Core.hs b/RemoteDaemon/Core.hs new file mode 100644 index 0000000000..b32be98ef4 --- /dev/null +++ b/RemoteDaemon/Core.hs @@ -0,0 +1,118 @@ +{- git-remote-daemon core + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module RemoteDaemon.Core (runForeground) where + +import qualified Annex +import Common +import Types.GitConfig +import RemoteDaemon.Common +import RemoteDaemon.Types +import RemoteDaemon.Transport +import qualified Git +import qualified Git.Types as Git +import qualified Git.CurrentRepo +import Utility.SimpleProtocol +import Config + +import Control.Concurrent.Async +import Control.Concurrent +import Network.URI +import qualified Data.Map as M + +runForeground :: IO () +runForeground = do + (readh, writeh) <- ioHandles + ichan <- newChan :: IO (Chan Consumed) + ochan <- newChan :: IO (Chan Emitted) + + let reader = forever $ do + l <- hGetLine readh + case parseMessage l of + Nothing -> error $ "protocol error: " ++ l + Just cmd -> writeChan ichan cmd + let writer = forever $ do + msg <- readChan ochan + hPutStrLn writeh $ unwords $ formatMessage msg + hFlush writeh + let controller = runController ichan ochan + + -- If any thread fails, the rest will be killed. + void $ tryIO $ + reader `concurrently` writer `concurrently` controller + +type RemoteMap = M.Map Git.Repo (IO (), Chan Consumed) + +-- Runs the transports, dispatching messages to them, and handling +-- the main control messages. +runController :: Chan Consumed -> Chan Emitted -> IO () +runController ichan ochan = do + h <- genTransportHandle + m <- genRemoteMap h ochan + startrunning m + go h False m + where + go h paused m = do + cmd <- readChan ichan + case cmd of + RELOAD -> do + liftAnnex h reloadConfig + m' <- genRemoteMap h ochan + let common = M.intersection m m' + let new = M.difference m' m + let old = M.difference m m' + stoprunning old + unless paused $ + startrunning new + go h paused (M.union common new) + PAUSE -> do + stoprunning m + go h True m + RESUME -> do + when paused $ + startrunning m + go h False m + STOP -> exitSuccess + -- All remaining messages are sent to + -- all Transports. + msg -> do + unless paused $ + forM_ chans (`writeChan` msg) + go h paused m + where + chans = map snd (M.elems m) + + startrunning m = forM_ (M.elems m) startrunning' + startrunning' (transport, _) = void $ async transport + + -- Ask the transport nicely to stop. + stoprunning m = forM_ (M.elems m) stoprunning' + stoprunning' (_, c) = writeChan c STOP + +-- Generates a map with a transport for each supported remote in the git repo, +-- except those that have annex.sync = false +genRemoteMap :: TransportHandle -> Chan Emitted -> IO RemoteMap +genRemoteMap h@(TransportHandle g _) ochan = + M.fromList . catMaybes <$> mapM gen (Git.remotes g) + where + gen r = case Git.location r of + Git.Url u -> case M.lookup (uriScheme u) remoteTransports of + Just transport + | remoteAnnexSync (extractRemoteGitConfig r (Git.repoDescribe r)) -> do + ichan <- newChan :: IO (Chan Consumed) + return $ Just + ( r + , (transport r (Git.repoDescribe r) h ichan ochan, ichan) + ) + _ -> return Nothing + _ -> return Nothing + +genTransportHandle :: IO TransportHandle +genTransportHandle = do + annexstate <- newMVar =<< Annex.new =<< Git.CurrentRepo.get + g <- Annex.repo <$> readMVar annexstate + return $ TransportHandle g annexstate diff --git a/RemoteDaemon/Transport.hs b/RemoteDaemon/Transport.hs new file mode 100644 index 0000000000..1bac7f8778 --- /dev/null +++ b/RemoteDaemon/Transport.hs @@ -0,0 +1,21 @@ +{- git-remote-daemon transports + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module RemoteDaemon.Transport where + +import RemoteDaemon.Types +import qualified RemoteDaemon.Transport.Ssh + +import qualified Data.Map as M + +-- Corresponds to uriScheme +type TransportScheme = String + +remoteTransports :: M.Map TransportScheme Transport +remoteTransports = M.fromList + [ ("ssh:", RemoteDaemon.Transport.Ssh.transport) + ] diff --git a/RemoteDaemon/Transport/Ssh.hs b/RemoteDaemon/Transport/Ssh.hs new file mode 100644 index 0000000000..557a3dce90 --- /dev/null +++ b/RemoteDaemon/Transport/Ssh.hs @@ -0,0 +1,72 @@ +{- git-remote-daemon, git-annex-shell over ssh transport + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module RemoteDaemon.Transport.Ssh (transport) where + +import Common.Annex +import RemoteDaemon.Types +import RemoteDaemon.Common +import Remote.Helper.Ssh +import qualified RemoteDaemon.Transport.Ssh.Types as SshRemote +import Utility.SimpleProtocol +import Git.Command + +import Control.Concurrent.Chan +import Control.Concurrent.Async +import System.Process (std_in, std_out) + +transport :: Transport +transport r remotename transporthandle ichan ochan = do + v <- liftAnnex transporthandle $ git_annex_shell r "notifychanges" [] [] + case v of + Nothing -> noop + Just (cmd, params) -> go cmd (toCommand params) + where + go cmd params = do + (Just toh, Just fromh, _, pid) <- createProcess (proc cmd params) + { std_in = CreatePipe + , std_out = CreatePipe + } + + let shutdown = do + hClose toh + hClose fromh + void $ waitForProcess pid + send DISCONNECTED + + let fromshell = forever $ do + l <- hGetLine fromh + case parseMessage l of + Just SshRemote.READY -> send CONNECTED + Just (SshRemote.CHANGED shas) -> + whenM (checkNewShas transporthandle shas) $ + fetch + Nothing -> shutdown + + -- The only control message that matters is STOP. + -- + -- Note that a CHANGED control message is not handled; + -- we don't push to the ssh remote. The assistant + -- and git-annex sync both handle pushes, so there's no + -- need to do it here. + let handlecontrol = forever $ do + msg <- readChan ichan + case msg of + STOP -> ioError (userError "done") + _ -> noop + + -- Run both threads until one finishes. + void $ tryIO $ concurrently fromshell handlecontrol + shutdown + + send msg = writeChan ochan (msg remotename) + + fetch = do + send SYNCING + ok <- inLocalRepo transporthandle $ + runBool [Param "fetch", Param remotename] + send (DONESYNCING ok) diff --git a/RemoteDaemon/Transport/Ssh/Types.hs b/RemoteDaemon/Transport/Ssh/Types.hs new file mode 100644 index 0000000000..d3fd314b49 --- /dev/null +++ b/RemoteDaemon/Transport/Ssh/Types.hs @@ -0,0 +1,32 @@ +{- git-remote-daemon, git-annex-shell notifychanges protocol types + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module RemoteDaemon.Transport.Ssh.Types ( + Notification(..), + Proto.serialize, + Proto.deserialize, + Proto.formatMessage, +) where + +import qualified Utility.SimpleProtocol as Proto +import RemoteDaemon.Types (RefList) + +data Notification + = READY + | CHANGED RefList + +instance Proto.Sendable Notification where + formatMessage READY = ["READY"] + formatMessage (CHANGED shas) = ["CHANGED", Proto.serialize shas] + +instance Proto.Receivable Notification where + parseCommand "READY" = Proto.parse0 READY + parseCommand "CHANGED" = Proto.parse1 CHANGED + parseCommand _ = Proto.parseFail diff --git a/RemoteDaemon/Types.hs b/RemoteDaemon/Types.hs new file mode 100644 index 0000000000..025c602df0 --- /dev/null +++ b/RemoteDaemon/Types.hs @@ -0,0 +1,93 @@ +{- git-remote-daemon data types. + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module RemoteDaemon.Types where + +import qualified Annex +import qualified Git.Types as Git +import qualified Utility.SimpleProtocol as Proto + +import Control.Concurrent + +-- A Transport for a particular git remote consumes some messages +-- from a Chan, and emits others to another Chan. +type Transport = RemoteRepo -> RemoteName -> TransportHandle -> Chan Consumed -> Chan Emitted -> IO () + +type RemoteRepo = Git.Repo +type LocalRepo = Git.Repo + +-- All Transports share a single AnnexState MVar +data TransportHandle = TransportHandle LocalRepo (MVar Annex.AnnexState) + +-- Messages that the daemon emits. +data Emitted + = CONNECTED RemoteName + | DISCONNECTED RemoteName + | SYNCING RemoteName + | DONESYNCING Bool RemoteName + +-- Messages that the deamon consumes. +data Consumed + = PAUSE + | RESUME + | CHANGED RefList + | RELOAD + | STOP + +type RemoteName = String +type RefList = [Git.Ref] + +instance Proto.Sendable Emitted where + formatMessage (CONNECTED remote) = + ["CONNECTED", Proto.serialize remote] + formatMessage (DISCONNECTED remote) = + ["DISCONNECTED", Proto.serialize remote] + formatMessage (SYNCING remote) = + ["SYNCING", Proto.serialize remote] + formatMessage (DONESYNCING status remote) = + ["DONESYNCING", Proto.serialize status, Proto.serialize remote] + +instance Proto.Sendable Consumed where + formatMessage PAUSE = ["PAUSE"] + formatMessage RESUME = ["RESUME"] + formatMessage (CHANGED refs) =["CHANGED", Proto.serialize refs] + formatMessage RELOAD = ["RELOAD"] + formatMessage STOP = ["STOP"] + +instance Proto.Receivable Emitted where + parseCommand "CONNECTED" = Proto.parse1 CONNECTED + parseCommand "DISCONNECTED" = Proto.parse1 DISCONNECTED + parseCommand "SYNCING" = Proto.parse1 SYNCING + parseCommand "DONESYNCING" = Proto.parse2 DONESYNCING + parseCommand _ = Proto.parseFail + +instance Proto.Receivable Consumed where + parseCommand "PAUSE" = Proto.parse0 PAUSE + parseCommand "RESUME" = Proto.parse0 RESUME + parseCommand "CHANGED" = Proto.parse1 CHANGED + parseCommand "RELOAD" = Proto.parse0 RELOAD + parseCommand "STOP" = Proto.parse0 STOP + parseCommand _ = Proto.parseFail + +instance Proto.Serializable [Char] where + serialize = id + deserialize = Just + +instance Proto.Serializable RefList where + serialize = unwords . map Git.fromRef + deserialize = Just . map Git.Ref . words + +instance Proto.Serializable Bool where + serialize False = "0" + serialize True = "1" + + deserialize "0" = Just False + deserialize "1" = Just True + deserialize _ = Nothing diff --git a/Types/DesktopNotify.hs b/Types/DesktopNotify.hs new file mode 100644 index 0000000000..f8494487de --- /dev/null +++ b/Types/DesktopNotify.hs @@ -0,0 +1,27 @@ +{- git-annex DesktopNotify type + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Types.DesktopNotify where + +import Data.Monoid + +data DesktopNotify = DesktopNotify + { notifyStart :: Bool + , notifyFinish :: Bool + } + deriving (Show) + +instance Monoid DesktopNotify where + mempty = DesktopNotify False False + mappend (DesktopNotify s1 f1) (DesktopNotify s2 f2) = + DesktopNotify (s1 || s2) (f1 || f2) + +mkNotifyStart :: DesktopNotify +mkNotifyStart = DesktopNotify True False + +mkNotifyFinish :: DesktopNotify +mkNotifyFinish = DesktopNotify False True diff --git a/Types/FileMatcher.hs b/Types/FileMatcher.hs index e2d4eadc1b..03a86a38c6 100644 --- a/Types/FileMatcher.hs +++ b/Types/FileMatcher.hs @@ -7,7 +7,12 @@ module Types.FileMatcher where +import Types.UUID (UUID) import Types.Key (Key) +import Utility.Matcher (Matcher, Token) + +import qualified Data.Map as M +import qualified Data.Set as S data MatchInfo = MatchingFile FileInfo @@ -17,3 +22,19 @@ data FileInfo = FileInfo { relFile :: FilePath -- may be relative to cwd , matchFile :: FilePath -- filepath to match on; may be relative to top } + +type FileMatcherMap a = M.Map UUID (Utility.Matcher.Matcher (S.Set UUID -> MatchInfo -> a Bool)) + +type MkLimit a = String -> Either String (MatchFiles a) + +type AssumeNotPresent = S.Set UUID + +type MatchFiles a = AssumeNotPresent -> MatchInfo -> a Bool + +type FileMatcher a = Matcher (MatchFiles a) + +-- This is a matcher that can have tokens added to it while it's being +-- built, and once complete is compiled to an unchangable matcher. +data ExpandableMatcher a + = BuildingMatcher [Token (MatchInfo -> a Bool)] + | CompleteMatcher (Matcher (MatchInfo -> a Bool)) diff --git a/Types/Limit.hs b/Types/Limit.hs deleted file mode 100644 index 2b009a7585..0000000000 --- a/Types/Limit.hs +++ /dev/null @@ -1,20 +0,0 @@ -{- types for limits - - - - Copyright 2013 Joey Hess - - - - Licensed under the GNU GPL version 3 or higher. - -} - -{-# LANGUAGE CPP #-} - -module Types.Limit where - -import Common.Annex -import Types.FileMatcher - -import qualified Data.Set as S - -type MkLimit = String -> Either String MatchFiles - -type AssumeNotPresent = S.Set UUID -type MatchFiles = AssumeNotPresent -> MatchInfo -> Annex Bool diff --git a/Types/MetaData.hs b/Types/MetaData.hs index 706d037bcc..8df56734dd 100644 --- a/Types/MetaData.hs +++ b/Types/MetaData.hs @@ -264,7 +264,9 @@ parseMetaData p = (,) instance Arbitrary MetaData where arbitrary = do size <- arbitrarySizedBoundedIntegral `suchThat` (< 500) - MetaData . M.fromList <$> vector size + MetaData . M.filterWithKey legal . M.fromList <$> vector size + where + legal k _v = legalField $ fromMetaField k instance Arbitrary MetaValue where arbitrary = MetaValue <$> arbitrary <*> arbitrary diff --git a/Utility/FileMode.hs b/Utility/FileMode.hs index d8fb866aeb..9c15da8c43 100644 --- a/Utility/FileMode.hs +++ b/Utility/FileMode.hs @@ -9,15 +9,18 @@ module Utility.FileMode where -import Common - +import System.IO +import Control.Monad import Control.Exception (bracket) import System.PosixCompat.Types +import Utility.PosixFiles #ifndef mingw32_HOST_OS import System.Posix.Files #endif import Foreign (complement) +import Utility.Exception + {- Applies a conversion function to a file's mode. -} modifyFileMode :: FilePath -> (FileMode -> FileMode) -> IO () modifyFileMode f convert = void $ modifyFileMode' f convert @@ -56,6 +59,12 @@ readModes = [ownerReadMode, groupReadMode, otherReadMode] executeModes :: [FileMode] executeModes = [ownerExecuteMode, groupExecuteMode, otherExecuteMode] +otherGroupModes :: [FileMode] +otherGroupModes = + [ groupReadMode, otherReadMode + , groupWriteMode, otherWriteMode + ] + {- Removes the write bits from a file. -} preventWrite :: FilePath -> IO () preventWrite f = modifyFileMode f $ removeModes writeModes @@ -145,9 +154,5 @@ setSticky f = modifyFileMode f $ addModes [stickyMode] writeFileProtected :: FilePath -> String -> IO () writeFileProtected file content = withUmask 0o0077 $ withFile file WriteMode $ \h -> do - void $ tryIO $ modifyFileMode file $ - removeModes - [ groupReadMode, otherReadMode - , groupWriteMode, otherWriteMode - ] + void $ tryIO $ modifyFileMode file $ removeModes otherGroupModes hPutStr h content diff --git a/Utility/LinuxMkLibs.hs b/Utility/LinuxMkLibs.hs new file mode 100644 index 0000000000..76e6266dda --- /dev/null +++ b/Utility/LinuxMkLibs.hs @@ -0,0 +1,61 @@ +{- Linux library copier and binary shimmer + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Utility.LinuxMkLibs where + +import Control.Applicative +import Data.Maybe +import System.Directory +import Data.List.Utils +import System.Posix.Files +import Data.Char +import Control.Monad.IfElse + +import Utility.PartialPrelude +import Utility.Directory +import Utility.Process +import Utility.Monad +import Utility.Path + +{- Installs a library. If the library is a symlink to another file, + - install the file it links to, and update the symlink to be relative. -} +installLib :: (FilePath -> FilePath -> IO ()) -> FilePath -> FilePath -> IO (Maybe FilePath) +installLib installfile top lib = ifM (doesFileExist lib) + ( do + installfile top lib + checksymlink lib + return $ Just $ parentDir lib + , return Nothing + ) + where + checksymlink f = whenM (isSymbolicLink <$> getSymbolicLinkStatus (inTop top f)) $ do + l <- readSymbolicLink (inTop top f) + let absl = absPathFrom (parentDir f) l + let target = relPathDirToFile (parentDir f) absl + installfile top absl + nukeFile (top ++ f) + createSymbolicLink target (inTop top f) + checksymlink absl + +-- Note that f is not relative, so cannot use +inTop :: FilePath -> FilePath -> FilePath +inTop top f = top ++ f + +{- Parse ldd output, getting all the libraries that the input files + - link to. Note that some of the libraries may not exist + - (eg, linux-vdso.so) -} +parseLdd :: String -> [FilePath] +parseLdd = catMaybes . map (getlib . dropWhile isSpace) . lines + where + getlib l = headMaybe . words =<< lastMaybe (split " => " l) + +{- Get all glibc libs and other support files, including gconv files + - + - XXX Debian specific. -} +glibcLibs :: IO [FilePath] +glibcLibs = lines <$> readProcess "sh" + ["-c", "dpkg -L libc6:$(dpkg --print-architecture) libgcc1:$(dpkg --print-architecture) | egrep '\\.so|gconv'"] diff --git a/Utility/Matcher.hs b/Utility/Matcher.hs index e0a51ff6ab..eabc585f4c 100644 --- a/Utility/Matcher.hs +++ b/Utility/Matcher.hs @@ -19,7 +19,7 @@ module Utility.Matcher ( Token(..), - Matcher, + Matcher(..), token, tokens, generate, diff --git a/Utility/Rsync.hs b/Utility/Rsync.hs index 2c5e39b6ea..82166f645e 100644 --- a/Utility/Rsync.hs +++ b/Utility/Rsync.hs @@ -124,6 +124,9 @@ rsyncUrlIsPath s - after the \r is the number of bytes processed. After the number, - there must appear some whitespace, or we didn't get the whole number, - and return the \r and part we did get, for later processing. + - + - In some locales, the number will have one or more commas in the middle + - of it. -} parseRsyncProgress :: String -> (Maybe Integer, String) parseRsyncProgress = go [] . reverse . progresschunks @@ -142,7 +145,7 @@ parseRsyncProgress = go [] . reverse . progresschunks parsebytes s = case break isSpace s of ([], _) -> Nothing (_, []) -> Nothing - (b, _) -> readish b + (b, _) -> readish $ filter (/= ',') b {- Filters options to those that are safe to pass to rsync in server mode, - without causing it to eg, expose files. -} diff --git a/Utility/Scheduled.hs b/Utility/Scheduled.hs index acbee70ff0..1b25cb4c70 100644 --- a/Utility/Scheduled.hs +++ b/Utility/Scheduled.hs @@ -10,7 +10,11 @@ module Utility.Scheduled ( Recurrance(..), ScheduledTime(..), NextTime(..), + WeekDay, + MonthDay, + YearDay, nextTime, + startTime, fromSchedule, fromScheduledTime, toScheduledTime, @@ -21,9 +25,13 @@ module Utility.Scheduled ( prop_schedule_roundtrips ) where -import Common +import Utility.Data import Utility.QuickCheck +import Utility.PartialPrelude +import Utility.Misc +import Control.Applicative +import Data.List import Data.Time.Clock import Data.Time.LocalTime import Data.Time.Calendar @@ -41,9 +49,9 @@ data Recurrance | Weekly (Maybe WeekDay) | Monthly (Maybe MonthDay) | Yearly (Maybe YearDay) - -- Days, Weeks, or Months of the year evenly divisible by a number. - -- (Divisible Year is years evenly divisible by a number.) | Divisible Int Recurrance + -- ^ Days, Weeks, or Months of the year evenly divisible by a number. + -- (Divisible Year is years evenly divisible by a number.) deriving (Eq, Read, Show, Ord) type WeekDay = Int @@ -78,7 +86,7 @@ nextTime schedule lasttime = do {- Calculate the next time that fits a Schedule, based on the - last time it occurred, and the current time. -} calcNextTime :: Schedule -> Maybe LocalTime -> LocalTime -> Maybe NextTime -calcNextTime (Schedule recurrance scheduledtime) lasttime currenttime +calcNextTime schedule@(Schedule recurrance scheduledtime) lasttime currenttime | scheduledtime == AnyTime = do next <- findfromtoday True return $ case next of @@ -100,65 +108,71 @@ calcNextTime (Schedule recurrance scheduledtime) lasttime currenttime window startd endd = NextTimeWindow (LocalTime startd nexttime) (LocalTime endd (TimeOfDay 23 59 0)) - findfrom r afterday day = case r of + findfrom r afterday candidate + | ynum candidate > (ynum (localDay currenttime)) + 100 = + -- avoid possible infinite recusion + error $ "bug: calcNextTime did not find a time within 100 years to run " ++ + show (schedule, lasttime, currenttime) + | otherwise = findfromChecked r afterday candidate + findfromChecked r afterday candidate = case r of Daily - | afterday -> Just $ exactly $ addDays 1 day - | otherwise -> Just $ exactly day + | afterday -> Just $ exactly $ addDays 1 candidate + | otherwise -> Just $ exactly candidate Weekly Nothing | afterday -> skip 1 - | otherwise -> case (wday <$> lastday, wday day) of - (Nothing, _) -> Just $ window day (addDays 6 day) + | otherwise -> case (wday <$> lastday, wday candidate) of + (Nothing, _) -> Just $ window candidate (addDays 6 candidate) (Just old, curr) - | old == curr -> Just $ window day (addDays 6 day) + | old == curr -> Just $ window candidate (addDays 6 candidate) | otherwise -> skip 1 Monthly Nothing | afterday -> skip 1 - | maybe True (\old -> mnum day > mday old && mday day >= (mday old `mod` minmday)) lastday -> + | maybe True (\old -> mday candidate > mday old && mday candidate >= (mday old `mod` minmday)) lastday -> -- Window only covers current month, -- in case there is a Divisible requirement. - Just $ window day (endOfMonth day) + Just $ window candidate (endOfMonth candidate) | otherwise -> skip 1 Yearly Nothing | afterday -> skip 1 - | maybe True (\old -> ynum day > ynum old && yday day >= (yday old `mod` minyday)) lastday -> - Just $ window day (endOfYear day) + | maybe True (\old -> ynum candidate > ynum old && yday candidate >= (yday old `mod` minyday)) lastday -> + Just $ window candidate (endOfYear candidate) | otherwise -> skip 1 Weekly (Just w) | w < 0 || w > maxwday -> Nothing - | w == wday day -> if afterday - then Just $ exactly $ addDays 7 day - else Just $ exactly day + | w == wday candidate -> if afterday + then Just $ exactly $ addDays 7 candidate + else Just $ exactly candidate | otherwise -> Just $ exactly $ - addDays (fromIntegral $ (w - wday day) `mod` 7) day + addDays (fromIntegral $ (w - wday candidate) `mod` 7) candidate Monthly (Just m) | m < 0 || m > maxmday -> Nothing -- TODO can be done more efficiently than recursing - | m == mday day -> if afterday + | m == mday candidate -> if afterday then skip 1 - else Just $ exactly day + else Just $ exactly candidate | otherwise -> skip 1 Yearly (Just y) | y < 0 || y > maxyday -> Nothing - | y == yday day -> if afterday + | y == yday candidate -> if afterday then skip 365 - else Just $ exactly day + else Just $ exactly candidate | otherwise -> skip 1 Divisible n r'@Daily -> handlediv n r' yday (Just maxyday) Divisible n r'@(Weekly _) -> handlediv n r' wnum (Just maxwnum) Divisible n r'@(Monthly _) -> handlediv n r' mnum (Just maxmnum) Divisible n r'@(Yearly _) -> handlediv n r' ynum Nothing - Divisible _ r'@(Divisible _ _) -> findfrom r' afterday day + Divisible _ r'@(Divisible _ _) -> findfrom r' afterday candidate where - skip n = findfrom r False (addDays n day) + skip n = findfrom r False (addDays n candidate) handlediv n r' getval mmax | n > 0 && maybe True (n <=) mmax = - findfromwhere r' (divisible n . getval) afterday day + findfromwhere r' (divisible n . getval) afterday candidate | otherwise = Nothing - findfromwhere r p afterday day + findfromwhere r p afterday candidate | maybe True (p . getday) next = next | otherwise = maybe Nothing (findfromwhere r p True . getday) next where - next = findfrom r afterday day + next = findfrom r afterday candidate getday = localDay . startTime divisible n v = v `rem` n == 0 diff --git a/Utility/SimpleProtocol.hs b/Utility/SimpleProtocol.hs new file mode 100644 index 0000000000..1119cd986a --- /dev/null +++ b/Utility/SimpleProtocol.hs @@ -0,0 +1,90 @@ +{- Simple line-based protocols. + - + - Copyright 2013-2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Utility.SimpleProtocol ( + Sendable(..), + Receivable(..), + parseMessage, + Serializable(..), + Parser, + parseFail, + parse0, + parse1, + parse2, + parse3, + ioHandles, +) where + +import Data.Char +import GHC.IO.Handle + +import Common + +-- Messages that can be sent. +class Sendable m where + formatMessage :: m -> [String] + +-- Messages that can be received. +class Receivable m where + -- Passed the first word of the message, returns + -- a Parser that can be be fed the rest of the message to generate + -- the value. + parseCommand :: String -> Parser m + +parseMessage :: (Receivable m) => String -> Maybe m +parseMessage s = parseCommand command rest + where + (command, rest) = splitWord s + +class Serializable a where + serialize :: a -> String + deserialize :: String -> Maybe a + +{- Parsing the parameters of messages. Using the right parseN ensures + - that the string is split into exactly the requested number of words, + - which allows the last parameter of a message to contain arbitrary + - whitespace, etc, without needing any special quoting. + -} +type Parser a = String -> Maybe a + +parseFail :: Parser a +parseFail _ = Nothing + +parse0 :: a -> Parser a +parse0 mk "" = Just mk +parse0 _ _ = Nothing + +parse1 :: Serializable p1 => (p1 -> a) -> Parser a +parse1 mk p1 = mk <$> deserialize p1 + +parse2 :: (Serializable p1, Serializable p2) => (p1 -> p2 -> a) -> Parser a +parse2 mk s = mk <$> deserialize p1 <*> deserialize p2 + where + (p1, p2) = splitWord s + +parse3 :: (Serializable p1, Serializable p2, Serializable p3) => (p1 -> p2 -> p3 -> a) -> Parser a +parse3 mk s = mk <$> deserialize p1 <*> deserialize p2 <*> deserialize p3 + where + (p1, rest) = splitWord s + (p2, p3) = splitWord rest + +splitWord :: String -> (String, String) +splitWord = separate isSpace + +{- When a program speaks a simple protocol over stdio, any other output + - to stdout (or anything that attempts to read from stdin) + - will mess up the protocol. To avoid that, close stdin, and + - and duplicate stderr to stdout. Return two new handles + - that are duplicates of the original (stdin, stdout). -} +ioHandles :: IO (Handle, Handle) +ioHandles = do + readh <- hDuplicate stdin + writeh <- hDuplicate stdout + nullh <- openFile devNull ReadMode + nullh `hDuplicateTo` stdin + stderr `hDuplicateTo` stdout + return (readh, writeh) diff --git a/Utility/ThreadScheduler.hs b/Utility/ThreadScheduler.hs index dbb6cb317d..dd88dc8792 100644 --- a/Utility/ThreadScheduler.hs +++ b/Utility/ThreadScheduler.hs @@ -10,10 +10,13 @@ module Utility.ThreadScheduler where -import Common - +import Control.Monad import Control.Concurrent #ifndef mingw32_HOST_OS +import Control.Monad.IfElse +import System.Posix.IO +#endif +#ifndef mingw32_HOST_OS import System.Posix.Signals #ifndef __ANDROID__ import System.Posix.Terminal diff --git a/Utility/Url.hs b/Utility/Url.hs index 3ab14ebe49..eddcd0a5d0 100644 --- a/Utility/Url.hs +++ b/Utility/Url.hs @@ -77,7 +77,8 @@ exists url uo = case parseURIRelaxed url of Nothing -> dne | otherwise -> if Build.SysConfig.curl then do - output <- readProcess "curl" $ toCommand curlparams + output <- catchDefaultIO "" $ + readProcess "curl" $ toCommand curlparams case lastMaybe (lines output) of Just ('2':_:_) -> return (True, extractsize output) _ -> dne diff --git a/Utility/WebApp.hs b/Utility/WebApp.hs index 8e08ab9e0a..1a76988700 100644 --- a/Utility/WebApp.hs +++ b/Utility/WebApp.hs @@ -33,7 +33,6 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as TE import Blaze.ByteString.Builder.Char.Utf8 (fromText) import Blaze.ByteString.Builder (Builder) -import Data.Monoid import Control.Arrow ((***)) import Control.Concurrent #ifdef WITH_WEBAPP_SECURE diff --git a/debian/changelog b/debian/changelog index d795e4f0c3..2bb3d13921 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,72 @@ +git-annex (5.20140412) unstable; urgency=high + + * Last release didn't quite fix the high cpu issue in all cases, this should. + + -- Joey Hess Fri, 11 Apr 2014 17:14:38 -0400 + +git-annex (5.20140411) unstable; urgency=high + + * importfeed: Filename template can now contain an itempubdate variable. + Needs feed 0.3.9.2. + * Fix rsync progress parsing in locales that use comma in number display. + Closes: #744148 + * assistant: Fix high CPU usage triggered when a monthly fsck is scheduled, + and the last time the job ran was a day of the month > 12. This caused a + runaway loop. Thanks to Anarcat for his assistance, and to Maximiliano + Curia for identifying the cause of this bug. + * Remove wget from OSX dmg, due to issues with cert paths that broke + git-annex automatic upgrading. Instead, curl is used, unless the + OSX system has wget installed, which will then be used. + + -- Joey Hess Fri, 11 Apr 2014 14:59:49 -0400 + +git-annex (5.20140405) unstable; urgency=medium + + * git-annex-shell: Added notifychanges command. + * Improve display of dbus notifications. Thanks, Johan Kiviniemi. + * Fix nautilus script installation to not crash when the nautilus script dir + does not exist. Instead, only install scripts when the directory already + exists. + + -- Joey Hess Sat, 05 Apr 2014 16:54:33 -0400 + +git-annex (5.20140402) unstable; urgency=medium + + * unannex, uninit: Avoid committing after every file is unannexed, + for massive speedup. + * --notify-finish switch will cause desktop notifications after each + file upload/download/drop completes + (using the dbus Desktop Notifications Specification) + * --notify-start switch will show desktop notifications when each + file upload/download starts. + * webapp: Automatically install Nautilus integration scripts + to get and drop files. + * tahoe: Pass -d parameter before subcommand; putting it after + the subcommand no longer works with tahoe-lafs version 1.10. + (Thanks, Alberto Berti) + * forget --drop-dead: Avoid removing the dead remote from the trust.log, + so that if git remotes for it still exist anywhere, git annex info + will still know it's dead and not show it. + * git-annex-shell: Make configlist automatically initialize + a remote git repository, as long as a git-annex branch has + been pushed to it, to simplify setup of remote git repositories, + including via gitolite. + * add --include-dotfiles: New option, perhaps useful for backups. + * Version 5.20140227 broke creation of glacier repositories, + not including the datacenter and vault in their configuration. + This bug is fixed, but glacier repositories set up with the broken + version of git-annex need to have the datacenter and vault set + in order to be usable. This can be done using git annex enableremote + to add the missing settings. For details, see + http://git-annex.branchable.com/bugs/problems_with_glacier/ + * Added required content configuration. + * assistant: Improve ssh authorized keys line generated in local pairing + or for a remote ssh server to set environment variables in an + alternative way that works with the non-POSIX fish shell, as well + as POSIX shells. + + -- Joey Hess Wed, 02 Apr 2014 16:42:53 -0400 + git-annex (5.20140320~bpo70+1) wheezy-backports; urgency=medium * Updating backport to newest release. diff --git a/debian/control b/debian/control index 1c8c1975f1..42fd39bb45 100644 --- a/debian/control +++ b/debian/control @@ -29,6 +29,7 @@ Build-Depends: libghc-hinotify-dev [linux-any], libghc-stm-dev (>= 2.3), libghc-dbus-dev (>= 0.10.3) [linux-any], + libghc-fdo-notify-dev (>= 0.3) [linux-any], libghc-yesod-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc], libghc-yesod-static-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc], libghc-yesod-default-dev [i386 amd64 kfreebsd-amd64 powerpc sparc], @@ -50,7 +51,7 @@ Build-Depends: libghc-xml-types-dev, libghc-async-dev, libghc-http-dev, - libghc-feed-dev, + libghc-feed-dev (>= 0.3.9.2), libghc-regex-tdfa-dev [!mipsel !s390], libghc-regex-compat-dev [mipsel s390], lsof [!kfreebsd-i386 !kfreebsd-amd64], diff --git a/doc/assistant/connection.png b/doc/assistant/connection.png new file mode 100644 index 0000000000..3cd6bef868 Binary files /dev/null and b/doc/assistant/connection.png differ diff --git a/doc/assistant/downloadnotification.png b/doc/assistant/downloadnotification.png new file mode 100644 index 0000000000..32b04f122d Binary files /dev/null and b/doc/assistant/downloadnotification.png differ diff --git a/doc/assistant/nautilusmenu.png b/doc/assistant/nautilusmenu.png new file mode 100644 index 0000000000..d7926e34f2 Binary files /dev/null and b/doc/assistant/nautilusmenu.png differ diff --git a/doc/assistant/release_notes.mdwn b/doc/assistant/release_notes.mdwn index 13b7c62abf..1ed622ba3b 100644 --- a/doc/assistant/release_notes.mdwn +++ b/doc/assistant/release_notes.mdwn @@ -1,3 +1,14 @@ +## version 5.20140411 + +This release fixes a bug that could cause the assistant to use a *lot* of +CPU, when monthly fscking was set up. + +Automatic upgrading was broken on OSX for previous versions. This has been +fixed, but you'll need to manually upgrade to this version to get it going +again. (Note that the fix is currently only available in the daily builds, +not a released version.) Workaround: Remove the wget bundled inside the +git-annex dmg. + ## version 5.20140221 The Windows port of the assistant and webapp is now considered to be beta diff --git a/doc/automatic_conflict_resolution/comment_4_80539e11e36a0b64cee83b6b373bd843._comment b/doc/automatic_conflict_resolution/comment_4_80539e11e36a0b64cee83b6b373bd843._comment new file mode 100644 index 0000000000..d67514452f --- /dev/null +++ b/doc/automatic_conflict_resolution/comment_4_80539e11e36a0b64cee83b6b373bd843._comment @@ -0,0 +1,17 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawn3p4i4lk_zMilvjnJ9sS6g2nerpgz0Fjc" + nickname="Matthias" + subject="merge for master branch?" + date="2014-03-23T23:02:23Z" + content=""" +As far as I observed, \"git annex merge\" only merges the \"git-annex\" branch. My wish is to have the conflict resolution from \"git annex sync\" in the \"master\" branch, but no automatic commit, such that the user can verify and possibly correct the merge. The proposed merge could go to the index. Consider the following scenario: + +1. We have repo A, B, and CENTRAL +2. All three start with a root commit in \"master\" branch +3. Then A commits a file \"test.txt\" with content \"a\" and syncs with CENTRAL +4. Meanwhile, B commits \"test.txt\" with content \"b\" +5. When B tries to sync with CENTRAL, the proposed conflict resolution having two files \"test.txt-variantXXXX\" and \"test.txt-variantYYYY\" should be staged in the index, but not committed yet. +6. B can now commit a custom merge, e.g. with file content \"ab\". + +The point is that I really like the conflict resolution, but still want to force the user to check the result. +"""]] diff --git a/doc/automatic_conflict_resolution/comment_5_00ac9e4a47ce9a886dbf573480f151bd._comment b/doc/automatic_conflict_resolution/comment_5_00ac9e4a47ce9a886dbf573480f151bd._comment new file mode 100644 index 0000000000..4d1e7c4bcd --- /dev/null +++ b/doc/automatic_conflict_resolution/comment_5_00ac9e4a47ce9a886dbf573480f151bd._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.41" + subject="comment 5" + date="2014-03-26T18:56:30Z" + content=""" +@Matthias you need to install git-annex 4.20130709 or newer. Then `git-annex merge` will do what you want. As I said before. + +As for committing the merge, you can always adjust the result after the fact and use `git commit --amend`. +"""]] diff --git a/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory.mdwn b/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory.mdwn new file mode 100644 index 0000000000..954d26ec23 --- /dev/null +++ b/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory.mdwn @@ -0,0 +1,520 @@ +I have a git annex assistant process using 1.2 gigabytes of RAM and a git cat-file --batch child consuming CPU time constantly. I am running 5.20140320 on Ubuntu 12.04. + +[[!format sh """ + PID USER PR NI VIRT RES SHR S %CPU %MEM TIME+ COMMAND +11775 ion 20 0 1350m 1.2g 12m S 48 62.4 425:56.85 git-annex +11787 ion 20 0 9856 1484 1232 R 54 0.1 366:16.14 git +"""]] + +The assistant UI looks perfectly normal and does not indicate it is doing anything. daemon.log is empty and the assistant process seems to be logging into a rotated and deleted log file. + +[[!format sh """ +COMMAND PID USER FD TYPE DEVICE SIZE/OFF NODE NAME +git-annex 11775 ion 1w REG 9,127 80841 55181369 /storage/ion/media/video/.git/annex/daemon.log.10 (deleted) +git-annex 11775 ion 2w REG 9,127 80841 55181369 /storage/ion/media/video/.git/annex/daemon.log.10 (deleted) +"""]] + +strace -s10000 -e trace=read,write -p 11787 indicates that the assistant is having the cat-file process cat same objects over and over again. + +[[!format sh """ +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:a84/f1f/SHA256E-s47051987--dcfd0413db883506ccb8c45e3b2d60cb3ff5c83cc55c9c7e44818d7556dbc07f.mp4.log\n", 4096) = 121 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "6c0ff555a1a34337c9379d8856c8283429bef973 blob 231\n", 50) = 50 +write(1, "1396057829.505426s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057839.859236s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057839.875213s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.77741s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:50a/5fc/SHA256E-s275654757--52823cd2061375910ccbd8de38865eca91511d9b4621243d2ef96a974d7546aa.flv.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "cdbc7ce6b426dfcce9d718387b6c412e870a2d12 blob 232\n", 50) = 50 +write(1, "1396057828.887576s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.117938s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.197196s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.687354s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:9b5/545/SHA256E-s32710--6005b5faf1a6d42d499053f8cca87d080536abfa8442b33c87f7966e86726e4f.fin.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "82a98cbfe8f24d336a537cecea2182922c4681e1 blob 231\n", 50) = 50 +write(1, "1396057825.390306s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.37922s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.386029s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.588219s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:d28/166/SHA256E-s59188--9c04581bd67ea7c78b537a164d104bea5ac91a4a69f06b477cf07892a2d9b852.fih.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "d95950acebb5c4318329d7b989d36d01b76b7801 blob 232\n", 50) = 50 +write(1, "1396057825.366657s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.538068s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.560144s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.538542s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:a84/f1f/SHA256E-s47051987--dcfd0413db883506ccb8c45e3b2d60cb3ff5c83cc55c9c7e44818d7556dbc07f.mp4.log\n", 4096) = 121 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "6c0ff555a1a34337c9379d8856c8283429bef973 blob 231\n", 50) = 50 +write(1, "1396057829.505426s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057839.859236s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057839.875213s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.77741s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:50a/5fc/SHA256E-s275654757--52823cd2061375910ccbd8de38865eca91511d9b4621243d2ef96a974d7546aa.flv.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "cdbc7ce6b426dfcce9d718387b6c412e870a2d12 blob 232\n", 50) = 50 +write(1, "1396057828.887576s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.117938s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.197196s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.687354s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:9b5/545/SHA256E-s32710--6005b5faf1a6d42d499053f8cca87d080536abfa8442b33c87f7966e86726e4f.fin.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "82a98cbfe8f24d336a537cecea2182922c4681e1 blob 231\n", 50) = 50 +write(1, "1396057825.390306s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.37922s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.386029s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.588219s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:d28/166/SHA256E-s59188--9c04581bd67ea7c78b537a164d104bea5ac91a4a69f06b477cf07892a2d9b852.fih.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "d95950acebb5c4318329d7b989d36d01b76b7801 blob 232\n", 50) = 50 +write(1, "1396057825.366657s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.538068s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.560144s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.538542s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:a84/f1f/SHA256E-s47051987--dcfd0413db883506ccb8c45e3b2d60cb3ff5c83cc55c9c7e44818d7556dbc07f.mp4.log\n", 4096) = 121 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "6c0ff555a1a34337c9379d8856c8283429bef973 blob 231\n", 50) = 50 +write(1, "1396057829.505426s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057839.859236s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057839.875213s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.77741s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:50a/5fc/SHA256E-s275654757--52823cd2061375910ccbd8de38865eca91511d9b4621243d2ef96a974d7546aa.flv.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "cdbc7ce6b426dfcce9d718387b6c412e870a2d12 blob 232\n", 50) = 50 +write(1, "1396057828.887576s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.117938s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.197196s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.687354s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:9b5/545/SHA256E-s32710--6005b5faf1a6d42d499053f8cca87d080536abfa8442b33c87f7966e86726e4f.fin.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "82a98cbfe8f24d336a537cecea2182922c4681e1 blob 231\n", 50) = 50 +write(1, "1396057825.390306s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.37922s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.386029s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.588219s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:d28/166/SHA256E-s59188--9c04581bd67ea7c78b537a164d104bea5ac91a4a69f06b477cf07892a2d9b852.fih.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "d95950acebb5c4318329d7b989d36d01b76b7801 blob 232\n", 50) = 50 +write(1, "1396057825.366657s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.538068s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.560144s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.538542s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:a84/f1f/SHA256E-s47051987--dcfd0413db883506ccb8c45e3b2d60cb3ff5c83cc55c9c7e44818d7556dbc07f.mp4.log\n", 4096) = 121 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "6c0ff555a1a34337c9379d8856c8283429bef973 blob 231\n", 50) = 50 +write(1, "1396057829.505426s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057839.859236s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057839.875213s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.77741s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:50a/5fc/SHA256E-s275654757--52823cd2061375910ccbd8de38865eca91511d9b4621243d2ef96a974d7546aa.flv.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "cdbc7ce6b426dfcce9d718387b6c412e870a2d12 blob 232\n", 50) = 50 +write(1, "1396057828.887576s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.117938s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.197196s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.687354s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:9b5/545/SHA256E-s32710--6005b5faf1a6d42d499053f8cca87d080536abfa8442b33c87f7966e86726e4f.fin.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "82a98cbfe8f24d336a537cecea2182922c4681e1 blob 231\n", 50) = 50 +write(1, "1396057825.390306s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.37922s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.386029s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.588219s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:d28/166/SHA256E-s59188--9c04581bd67ea7c78b537a164d104bea5ac91a4a69f06b477cf07892a2d9b852.fih.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "d95950acebb5c4318329d7b989d36d01b76b7801 blob 232\n", 50) = 50 +write(1, "1396057825.366657s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.538068s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.560144s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.538542s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:a84/f1f/SHA256E-s47051987--dcfd0413db883506ccb8c45e3b2d60cb3ff5c83cc55c9c7e44818d7556dbc07f.mp4.log\n", 4096) = 121 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "6c0ff555a1a34337c9379d8856c8283429bef973 blob 231\n", 50) = 50 +write(1, "1396057829.505426s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057839.859236s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057839.875213s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.77741s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:50a/5fc/SHA256E-s275654757--52823cd2061375910ccbd8de38865eca91511d9b4621243d2ef96a974d7546aa.flv.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "cdbc7ce6b426dfcce9d718387b6c412e870a2d12 blob 232\n", 50) = 50 +write(1, "1396057828.887576s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.117938s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.197196s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.687354s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:9b5/545/SHA256E-s32710--6005b5faf1a6d42d499053f8cca87d080536abfa8442b33c87f7966e86726e4f.fin.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "82a98cbfe8f24d336a537cecea2182922c4681e1 blob 231\n", 50) = 50 +write(1, "1396057825.390306s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.37922s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.386029s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.588219s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:d28/166/SHA256E-s59188--9c04581bd67ea7c78b537a164d104bea5ac91a4a69f06b477cf07892a2d9b852.fih.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "d95950acebb5c4318329d7b989d36d01b76b7801 blob 232\n", 50) = 50 +write(1, "1396057825.366657s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.538068s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.560144s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.538542s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:a84/f1f/SHA256E-s47051987--dcfd0413db883506ccb8c45e3b2d60cb3ff5c83cc55c9c7e44818d7556dbc07f.mp4.log\n", 4096) = 121 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "6c0ff555a1a34337c9379d8856c8283429bef973 blob 231\n", 50) = 50 +write(1, "1396057829.505426s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057839.859236s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057839.875213s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.77741s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:50a/5fc/SHA256E-s275654757--52823cd2061375910ccbd8de38865eca91511d9b4621243d2ef96a974d7546aa.flv.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "cdbc7ce6b426dfcce9d718387b6c412e870a2d12 blob 232\n", 50) = 50 +write(1, "1396057828.887576s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.117938s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.197196s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.687354s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:9b5/545/SHA256E-s32710--6005b5faf1a6d42d499053f8cca87d080536abfa8442b33c87f7966e86726e4f.fin.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "82a98cbfe8f24d336a537cecea2182922c4681e1 blob 231\n", 50) = 50 +write(1, "1396057825.390306s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.37922s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.386029s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.588219s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:d28/166/SHA256E-s59188--9c04581bd67ea7c78b537a164d104bea5ac91a4a69f06b477cf07892a2d9b852.fih.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "d95950acebb5c4318329d7b989d36d01b76b7801 blob 232\n", 50) = 50 +write(1, "1396057825.366657s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.538068s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.560144s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.538542s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:a84/f1f/SHA256E-s47051987--dcfd0413db883506ccb8c45e3b2d60cb3ff5c83cc55c9c7e44818d7556dbc07f.mp4.log\n", 4096) = 121 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "6c0ff555a1a34337c9379d8856c8283429bef973 blob 231\n", 50) = 50 +write(1, "1396057829.505426s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057839.859236s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057839.875213s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.77741s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:50a/5fc/SHA256E-s275654757--52823cd2061375910ccbd8de38865eca91511d9b4621243d2ef96a974d7546aa.flv.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "cdbc7ce6b426dfcce9d718387b6c412e870a2d12 blob 232\n", 50) = 50 +write(1, "1396057828.887576s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.117938s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.197196s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.687354s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:9b5/545/SHA256E-s32710--6005b5faf1a6d42d499053f8cca87d080536abfa8442b33c87f7966e86726e4f.fin.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "82a98cbfe8f24d336a537cecea2182922c4681e1 blob 231\n", 50) = 50 +write(1, "1396057825.390306s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.37922s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.386029s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.588219s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:d28/166/SHA256E-s59188--9c04581bd67ea7c78b537a164d104bea5ac91a4a69f06b477cf07892a2d9b852.fih.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "d95950acebb5c4318329d7b989d36d01b76b7801 blob 232\n", 50) = 50 +write(1, "1396057825.366657s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.538068s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.560144s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.538542s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:a84/f1f/SHA256E-s47051987--dcfd0413db883506ccb8c45e3b2d60cb3ff5c83cc55c9c7e44818d7556dbc07f.mp4.log\n", 4096) = 121 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "6c0ff555a1a34337c9379d8856c8283429bef973 blob 231\n", 50) = 50 +write(1, "1396057829.505426s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057839.859236s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057839.875213s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.77741s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:50a/5fc/SHA256E-s275654757--52823cd2061375910ccbd8de38865eca91511d9b4621243d2ef96a974d7546aa.flv.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "cdbc7ce6b426dfcce9d718387b6c412e870a2d12 blob 232\n", 50) = 50 +write(1, "1396057828.887576s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.117938s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.197196s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.687354s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:9b5/545/SHA256E-s32710--6005b5faf1a6d42d499053f8cca87d080536abfa8442b33c87f7966e86726e4f.fin.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "82a98cbfe8f24d336a537cecea2182922c4681e1 blob 231\n", 50) = 50 +write(1, "1396057825.390306s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.37922s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.386029s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.588219s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:d28/166/SHA256E-s59188--9c04581bd67ea7c78b537a164d104bea5ac91a4a69f06b477cf07892a2d9b852.fih.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "d95950acebb5c4318329d7b989d36d01b76b7801 blob 232\n", 50) = 50 +write(1, "1396057825.366657s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.538068s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.560144s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.538542s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:a84/f1f/SHA256E-s47051987--dcfd0413db883506ccb8c45e3b2d60cb3ff5c83cc55c9c7e44818d7556dbc07f.mp4.log\n", 4096) = 121 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "6c0ff555a1a34337c9379d8856c8283429bef973 blob 231\n", 50) = 50 +write(1, "1396057829.505426s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057839.859236s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057839.875213s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.77741s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:50a/5fc/SHA256E-s275654757--52823cd2061375910ccbd8de38865eca91511d9b4621243d2ef96a974d7546aa.flv.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "cdbc7ce6b426dfcce9d718387b6c412e870a2d12 blob 232\n", 50) = 50 +write(1, "1396057828.887576s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.117938s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.197196s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.687354s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:9b5/545/SHA256E-s32710--6005b5faf1a6d42d499053f8cca87d080536abfa8442b33c87f7966e86726e4f.fin.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "82a98cbfe8f24d336a537cecea2182922c4681e1 blob 231\n", 50) = 50 +write(1, "1396057825.390306s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.37922s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.386029s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.588219s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:d28/166/SHA256E-s59188--9c04581bd67ea7c78b537a164d104bea5ac91a4a69f06b477cf07892a2d9b852.fih.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "d95950acebb5c4318329d7b989d36d01b76b7801 blob 232\n", 50) = 50 +write(1, "1396057825.366657s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.538068s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.560144s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.538542s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:a84/f1f/SHA256E-s47051987--dcfd0413db883506ccb8c45e3b2d60cb3ff5c83cc55c9c7e44818d7556dbc07f.mp4.log\n", 4096) = 121 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "6c0ff555a1a34337c9379d8856c8283429bef973 blob 231\n", 50) = 50 +write(1, "1396057829.505426s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057839.859236s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057839.875213s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.77741s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:50a/5fc/SHA256E-s275654757--52823cd2061375910ccbd8de38865eca91511d9b4621243d2ef96a974d7546aa.flv.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "cdbc7ce6b426dfcce9d718387b6c412e870a2d12 blob 232\n", 50) = 50 +write(1, "1396057828.887576s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.117938s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.197196s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.687354s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:9b5/545/SHA256E-s32710--6005b5faf1a6d42d499053f8cca87d080536abfa8442b33c87f7966e86726e4f.fin.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "82a98cbfe8f24d336a537cecea2182922c4681e1 blob 231\n", 50) = 50 +write(1, "1396057825.390306s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.37922s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.386029s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.588219s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:d28/166/SHA256E-s59188--9c04581bd67ea7c78b537a164d104bea5ac91a4a69f06b477cf07892a2d9b852.fih.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "d95950acebb5c4318329d7b989d36d01b76b7801 blob 232\n", 50) = 50 +write(1, "1396057825.366657s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.538068s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.560144s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.538542s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:a84/f1f/SHA256E-s47051987--dcfd0413db883506ccb8c45e3b2d60cb3ff5c83cc55c9c7e44818d7556dbc07f.mp4.log\n", 4096) = 121 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "6c0ff555a1a34337c9379d8856c8283429bef973 blob 231\n", 50) = 50 +write(1, "1396057829.505426s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057839.859236s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057839.875213s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.77741s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:50a/5fc/SHA256E-s275654757--52823cd2061375910ccbd8de38865eca91511d9b4621243d2ef96a974d7546aa.flv.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "cdbc7ce6b426dfcce9d718387b6c412e870a2d12 blob 232\n", 50) = 50 +write(1, "1396057828.887576s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.117938s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.197196s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.687354s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:9b5/545/SHA256E-s32710--6005b5faf1a6d42d499053f8cca87d080536abfa8442b33c87f7966e86726e4f.fin.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "82a98cbfe8f24d336a537cecea2182922c4681e1 blob 231\n", 50) = 50 +write(1, "1396057825.390306s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.37922s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.386029s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.588219s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:d28/166/SHA256E-s59188--9c04581bd67ea7c78b537a164d104bea5ac91a4a69f06b477cf07892a2d9b852.fih.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "d95950acebb5c4318329d7b989d36d01b76b7801 blob 232\n", 50) = 50 +write(1, "1396057825.366657s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.538068s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.560144s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.538542s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:a84/f1f/SHA256E-s47051987--dcfd0413db883506ccb8c45e3b2d60cb3ff5c83cc55c9c7e44818d7556dbc07f.mp4.log\n", 4096) = 121 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "6c0ff555a1a34337c9379d8856c8283429bef973 blob 231\n", 50) = 50 +write(1, "1396057829.505426s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057839.859236s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057839.875213s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.77741s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:50a/5fc/SHA256E-s275654757--52823cd2061375910ccbd8de38865eca91511d9b4621243d2ef96a974d7546aa.flv.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "cdbc7ce6b426dfcce9d718387b6c412e870a2d12 blob 232\n", 50) = 50 +write(1, "1396057828.887576s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.117938s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.197196s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.687354s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:9b5/545/SHA256E-s32710--6005b5faf1a6d42d499053f8cca87d080536abfa8442b33c87f7966e86726e4f.fin.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "82a98cbfe8f24d336a537cecea2182922c4681e1 blob 231\n", 50) = 50 +write(1, "1396057825.390306s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.37922s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.386029s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.588219s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:d28/166/SHA256E-s59188--9c04581bd67ea7c78b537a164d104bea5ac91a4a69f06b477cf07892a2d9b852.fih.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "d95950acebb5c4318329d7b989d36d01b76b7801 blob 232\n", 50) = 50 +write(1, "1396057825.366657s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.538068s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.560144s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.538542s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:a84/f1f/SHA256E-s47051987--dcfd0413db883506ccb8c45e3b2d60cb3ff5c83cc55c9c7e44818d7556dbc07f.mp4.log\n", 4096) = 121 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "6c0ff555a1a34337c9379d8856c8283429bef973 blob 231\n", 50) = 50 +write(1, "1396057829.505426s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057839.859236s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057839.875213s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.77741s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:50a/5fc/SHA256E-s275654757--52823cd2061375910ccbd8de38865eca91511d9b4621243d2ef96a974d7546aa.flv.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "cdbc7ce6b426dfcce9d718387b6c412e870a2d12 blob 232\n", 50) = 50 +write(1, "1396057828.887576s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.117938s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.197196s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.687354s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:9b5/545/SHA256E-s32710--6005b5faf1a6d42d499053f8cca87d080536abfa8442b33c87f7966e86726e4f.fin.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "82a98cbfe8f24d336a537cecea2182922c4681e1 blob 231\n", 50) = 50 +write(1, "1396057825.390306s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.37922s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.386029s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.588219s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:d28/166/SHA256E-s59188--9c04581bd67ea7c78b537a164d104bea5ac91a4a69f06b477cf07892a2d9b852.fih.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "d95950acebb5c4318329d7b989d36d01b76b7801 blob 232\n", 50) = 50 +write(1, "1396057825.366657s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.538068s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.560144s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.538542s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:ee2/2ee/SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "977039ea431522e6e27a78bdec2c1299f883eb85 blob 232\n", 50) = 50 +write(1, "1396057823.999737s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057835.133409s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057835.215084s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.468307s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:a84/f1f/SHA256E-s47051987--dcfd0413db883506ccb8c45e3b2d60cb3ff5c83cc55c9c7e44818d7556dbc07f.mp4.log\n", 4096) = 121 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "6c0ff555a1a34337c9379d8856c8283429bef973 blob 231\n", 50) = 50 +write(1, "1396057829.505426s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057839.859236s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057839.875213s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.77741s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:50a/5fc/SHA256E-s275654757--52823cd2061375910ccbd8de38865eca91511d9b4621243d2ef96a974d7546aa.flv.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "cdbc7ce6b426dfcce9d718387b6c412e870a2d12 blob 232\n", 50) = 50 +write(1, "1396057828.887576s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.117938s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.197196s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.687354s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 232) = 232 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:9b5/545/SHA256E-s32710--6005b5faf1a6d42d499053f8cca87d080536abfa8442b33c87f7966e86726e4f.fin.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +read(3, "", 214) = 0 +write(1, "82a98cbfe8f24d336a537cecea2182922c4681e1 blob 231\n", 50) = 50 +write(1, "1396057825.390306s 1 3f89d0d8-6162-4362-852a-cb688d6c0696\n1396057866.37922s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396057866.386029s 1 161c3d7f-eb60-4294-84d2-eb611786c91e\n1396058160.588219s 0 3f89d0d8-6162-4362-852a-cb688d6c0696\n", 231) = 231 +write(1, "\n", 1) = 1 +read(0, "refs/heads/git-annex:d28/166/SHA256E-s59188--9c04581bd67ea7c78b537a164d104bea5ac91a4a69f06b477cf07892a2d9b852.fih.srt.log\n", 4096) = 122 +read(3, "0936a1fdd849b8b46abb879d7cf82cc758b367e3\n", 255) = 41 +"""]] diff --git a/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_1_ac8c39e362e6c806b9d68befc0199ccd._comment b/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_1_ac8c39e362e6c806b9d68befc0199ccd._comment new file mode 100644 index 0000000000..e9c5d3fff8 --- /dev/null +++ b/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_1_ac8c39e362e6c806b9d68befc0199ccd._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.244" + subject="comment 1" + date="2014-04-02T18:48:51Z" + content=""" +All I can tell from the strace is that it's looking at location logs, and it's looking at the same few keys, but not a single on in a tight loop. + +It would probably help a lot to run the assistant with --debug and get a debug log while this is going on. We need to pinpoint the part of the assistant that is affected, and there may be other activity too. +"""]] diff --git a/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_2_b2941bf7901a1b2237b7210c8f0af2a5._comment b/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_2_b2941bf7901a1b2237b7210c8f0af2a5._comment new file mode 100644 index 0000000000..c9e798c28c --- /dev/null +++ b/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_2_b2941bf7901a1b2237b7210c8f0af2a5._comment @@ -0,0 +1,22 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.244" + subject="comment 2" + date="2014-04-07T21:07:35Z" + content=""" +Except of log when this apparently happened. Note the 6 minute time discontinuity when it was apparently looping: + +
+[2014-04-07 23:24:24 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"write-tree\"]
+[2014-04-07 23:24:24 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"rev-parse\",\"84068090af4bcd3d24f16d865ac07b0478f20ada:\"]
+[2014-04-07 23:24:24 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"symbolic-ref\",\"HEAD\"]
+[2014-04-07 23:24:24 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"show-ref\",\"refs/heads/master\"]
+[2014-04-07 23:30:13 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"show-ref\",\"git-annex\"]
+[2014-04-07 23:30:13 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"show-ref\",\"--hash\",\"refs/heads/git-annex\"]
+[2014-04-07 23:30:13 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"log\",\"refs/heads/git-annex..214ed317536695b91c8dd5bed059c46c11ad00be\",\"--oneline\",\"-n1\"]
+
+ +Also probably relevant, the network topology AIUI was: `client --> server` where both nodes ran the assistant. This happened on the server shortly after the client dropped off a refs/heads/synced/master. + +(Also, the \"logging to a deleted file\" appears to have been a local misconfiguration; a cron job that repeatedly tried to start the assistant. Only one will start, but later ones will rotate the logs before noticing it's running and giving up.) +"""]] diff --git a/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_3_1429ca784a03bc424b3537cbe0449421._comment b/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_3_1429ca784a03bc424b3537cbe0449421._comment new file mode 100644 index 0000000000..fd9fa89715 --- /dev/null +++ b/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_3_1429ca784a03bc424b3537cbe0449421._comment @@ -0,0 +1,23 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.244" + subject="comment 3" + date="2014-04-07T21:55:19Z" + content=""" +Unfortunately all I have been able to tell for sure from this log is that it seems that the expensive transfer scan is not running, and this is unlikely to be a repository auto-repair. + +My best guess as to what might be going on is an update of the git-annex branch. + +[2014-04-07 23:24:24 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"write-tree\"] + +This is prep for an index file commit, probably to the git-annex branch. + +[2014-04-07 23:24:24 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"rev-parse\",\"84068090af4bcd3d24f16d865ac07b0478f20ada:\"] + +This is a getting the parent commit's tree. + +The git-cat-file churn could then be a union merge reading the contents of the git-annex branch to union-merge it into the `.git/annex/index` (in `mergeIndex`). This would reuse the main git cat-file process. + +That does not explain why it would need to read eg, SHA256E-s106800355--c70e31d511e7eec4881a15dfba521ea3d1fe14694968f81ae1819f1a2a93f9be.mp4.log 28 times. +Normally, during a union merge only files listed by `diff-index` need to be read, and it lists each file only once. +"""]] diff --git a/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_4_f9e65cf5598b4b14eeee1f41f46d4084._comment b/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_4_f9e65cf5598b4b14eeee1f41f46d4084._comment new file mode 100644 index 0000000000..148920c233 --- /dev/null +++ b/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_4_f9e65cf5598b4b14eeee1f41f46d4084._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.244" + subject="comment 4" + date="2014-04-07T21:57:32Z" + content=""" +Does `git log git-annex` show a commit that was made at 23:30? + +Does it show a commit 84068090af4bcd3d24f16d865ac07b0478f20ada? + +Is 84068090af4bcd3d24f16d865ac07b0478f20ada the parent of the 23:30 commit? +"""]] diff --git a/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_5_044ecac2d2e670e1ef69809c944093d1._comment b/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_5_044ecac2d2e670e1ef69809c944093d1._comment new file mode 100644 index 0000000000..6013650041 --- /dev/null +++ b/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_5_044ecac2d2e670e1ef69809c944093d1._comment @@ -0,0 +1,19 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.244" + subject="comment 5" + date="2014-04-07T22:12:14Z" + content=""" +Is the repository using direct mode? + +Another theory is that: + +* test/hello appears +* watcher sees new symlink, tries to make a commit with it +* master branch already has that symlink +* this is why the write-tree is not followed by a commit-tree. The commit would have been empty. + +If this is the case, then 84068090af4bcd3d24f16d865ac07b0478f20ada will be a ref on the master branch. + +And all of the above is normal operation. But it does suggest, that if this repo is in direct mode, it might be running a direct mode work tree update around then. Which requires a lot of cat-file queries of the git-annex branch. And would certainly make repeated queries at least if the repository has duplicate copies of some files.. +"""]] diff --git a/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_6_6f4f51e1583bed5e7e601e4f30f4207b._comment b/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_6_6f4f51e1583bed5e7e601e4f30f4207b._comment new file mode 100644 index 0000000000..0b5f904894 --- /dev/null +++ b/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_6_6f4f51e1583bed5e7e601e4f30f4207b._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.244" + subject="comment 6" + date="2014-04-07T22:17:16Z" + content=""" +Does the git log have any recent commits that were \"git-annex automatic merge conflict fix\" ? +"""]] diff --git a/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_7_683a0a3d4caea0ee625e41ae8a6c7c06._comment b/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_7_683a0a3d4caea0ee625e41ae8a6c7c06._comment new file mode 100644 index 0000000000..1705e738cb --- /dev/null +++ b/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_7_683a0a3d4caea0ee625e41ae8a6c7c06._comment @@ -0,0 +1,81 @@ +[[!comment format=mdwn + username="http://johan.kiviniemi.name/" + nickname="Johan" + subject="comment 7" + date="2014-04-07T22:44:33Z" + content=""" +In the git-annex branch, there is + +* [[!toggle id=\"4deec8203e0baf7bb5b7d5d868d82439261ab3bc\" text=\"a commit at 23:21:51\"]] from my desktop box where I added `test/hello` + +[[!toggleable id=\"4deec8203e0baf7bb5b7d5d868d82439261ab3bc\" text=\"\"\" + commit 4deec8203e0baf7bb5b7d5d868d82439261ab3bc + Author: Johan Kiviniemi + Date: Mon Apr 7 23:21:51 2014 +0300 + + update + + diff --git a/992/280/SHA256E-s6--5891b5b522d5df086d0ff0b110fbd9d21bb4fc7163af34d08286a2e846f6be03.log b/992/280/SHA256E-s6--5891b5b522d5df086d0ff0b110fbd9d21bb4fc7163af34d08286a2e846f6be03.log + new file mode 100644 + index 0000000..1cf060c + --- /dev/null + +++ b/992/280/SHA256E-s6--5891b5b522d5df086d0ff0b110fbd9d21bb4fc7163af34d08286a2e846f6be03.log + @@ -0,0 +1 @@ + +1396902111.893785s 1 86e07a59-8bba-4878-8d0b-5dfe8c6366c4 +\"\"\"]] + +* [[!toggle id=\"2e0884d9c8859339855ceee396b9ea9ae05865b4\" text=\"a commit at 23:21:54\"]] when the desktop box synced to the server (from which the log excerpt came) + +[[!toggleable id=\"2e0884d9c8859339855ceee396b9ea9ae05865b4\" text=\"\"\" + commit 2e0884d9c8859339855ceee396b9ea9ae05865b4 + Author: Johan Kiviniemi + Date: Mon Apr 7 23:21:54 2014 +0300 + + update + + diff --git a/992/280/SHA256E-s6--5891b5b522d5df086d0ff0b110fbd9d21bb4fc7163af34d08286a2e84 + 6f6be03.log b/992/280/SHA256E-s6--5891b5b522d5df086d0ff0b110fbd9d21bb4fc7163af34d08286a2e8 + 46f6be03.log + index 1cf060c..cd0bccc 100644 + --- a/992/280/SHA256E-s6--5891b5b522d5df086d0ff0b110fbd9d21bb4fc7163af34d08286a2e846f6be03 + .log + +++ b/992/280/SHA256E-s6--5891b5b522d5df086d0ff0b110fbd9d21bb4fc7163af34d08286a2e846f6be03 + .log + @@ -1 +1,2 @@ + +1396902112.657779s 1 09ada430-8802-47da-bbfa-f5256a3c55d2 + 1396902111.893785s 1 86e07a59-8bba-4878-8d0b-5dfe8c6366c4 +\"\"\"]] + +* [[!toggle id=\"214ed317536695b91c8dd5bed059c46c11ad00be\" text=\"a commit at 23:24:24\"]] (2.5 minutes later!) when the assistant on the server finally merged `synced/git-annex` into `git-annex` (`test/hello` became visible in the working tree at that time). + +[[!toggleable id=\"214ed317536695b91c8dd5bed059c46c11ad00be\" text=\"\"\" + commit 214ed317536695b91c8dd5bed059c46c11ad00be + Merge: 4deec82 2e0884d + Author: sarjat + Date: Mon Apr 7 23:24:24 2014 +0300 + + merging synced/git-annex into git-annex +\"\"\"]] + +There is no commit in the `git-annex` branch at 23:30. The next commit is from unrelated changes at 00:06. + +[[!toggle id=\"84068090af4bcd3d24f16d865ac07b0478f20ada\" text=\"84068090af4bcd3d24f16d865ac07b0478f20ada\"]] is the commit in `master` which added `test/hello` at 23:21:51. + +[[!toggleable id=\"84068090af4bcd3d24f16d865ac07b0478f20ada\" text=\"\"\" + commit 84068090af4bcd3d24f16d865ac07b0478f20ada + Author: Johan Kiviniemi + Date: Mon Apr 7 23:21:51 2014 +0300 + + diff --git a/test/hello b/test/hello + new file mode 120000 + index 0000000..8c2678f + --- /dev/null + +++ b/test/hello + @@ -0,0 +1 @@ + +../.git/annex/objects/zK/02/SHA256E-s6--5891b5b522d5df086d0ff0b110fbd9d21bb4fc7163af34d08 + \ No newline at end of file +\"\"\"]] + +The repository on the server is in indirect mode. + +"""]] diff --git a/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_8_03dd76b01f46a7cc66eddac3e054c8ad._comment b/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_8_03dd76b01f46a7cc66eddac3e054c8ad._comment new file mode 100644 index 0000000000..d6aa43da05 --- /dev/null +++ b/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_8_03dd76b01f46a7cc66eddac3e054c8ad._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://johan.kiviniemi.name/" + nickname="Johan" + subject="comment 8" + date="2014-04-07T22:48:18Z" + content=""" +There are no commits in `master` or `git-annex` that have the word conflict in the description. +"""]] diff --git a/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_9_5f4444f03cbebaa44628288095383679._comment b/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_9_5f4444f03cbebaa44628288095383679._comment new file mode 100644 index 0000000000..09383141e0 --- /dev/null +++ b/doc/bugs/Assistant_having_a_child_git_cat-file_--batch_do_the_same_thing_over_and_over_and_using_a_lot_of_memory/comment_9_5f4444f03cbebaa44628288095383679._comment @@ -0,0 +1,89 @@ +[[!comment format=mdwn + username="http://johan.kiviniemi.name/" + nickname="Johan" + subject="comment 9" + date="2014-04-07T22:55:12Z" + content=""" +[[!toggle id=\"excerpt\" text=\"The full log excerpt\"]] which includes the sync from the client and the final messages after the cat-file loop ended and things stabilized (but a memory leak of 30 MB in the git-annex assistant process remained). + +[[!toggleable id=\"excerpt\" text=\"\"\" + [2014-04-04 10:55:00 EEST] main: starting assistant version 5.20140402 + + + + [2014-04-07 23:21:08 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"show-ref\",\"git-annex\"] + [2014-04-07 23:21:08 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"show-ref\",\"--hash\",\"refs/heads/git-annex\"] + [2014-04-07 23:21:08 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"log\",\"refs/heads/git-annex..20d1f5538f6aa430f29ef938f6db045f5a69425d\",\"--oneline\",\"-n1\"] + [2014-04-07 23:21:08 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"log\",\"refs/heads/git-annex..b402a6e7b9268e25dbd9c6a027f4a5258993980d\",\"--oneline\",\"-n1\"] + [2014-04-07 23:21:08 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"log\",\"refs/heads/git-annex..7b18a191d58d779aab5789b923adb09863938ffe\",\"--oneline\",\"-n1\"] + [2014-04-07 23:21:08 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"ls-tree\",\"--full-tree\",\"-z\",\"--\",\"refs/heads/git-annex\",\"uuid.log\",\"remote.log\",\"trust.log\",\"group.log\",\"numcopies.log\",\"schedule.log\",\"preferred-content.log\",\"required-content.log\",\"group-preferred-content.log\"] + [2014-04-07 23:21:52 EEST] TransferWatcher: transfer starting: Download UUID \"86e07a59-8bba-4878-8d0b-5dfe8c6366c4\" SHA256E-s6--5891b5b522d5df086d0ff0b110fbd9d21bb4fc7163af34d08286a2e846f6be03 Nothing + [2014-04-07 23:21:52 EEST] read: git [\"config\",\"--null\",\"--list\"] + [2014-04-07 23:21:52 EEST] TransferWatcher: transfer starting: Download UUID \"86e07a59-8bba-4878-8d0b-5dfe8c6366c4\" test/hello Nothing + [2014-04-07 23:21:52 EEST] read: git [\"config\",\"--null\",\"--list\"] + [2014-04-07 23:21:52 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"show-ref\",\"git-annex\"] + [2014-04-07 23:21:52 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"show-ref\",\"--hash\",\"refs/heads/git-annex\"] + [2014-04-07 23:21:52 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"log\",\"refs/heads/git-annex..20d1f5538f6aa430f29ef938f6db045f5a69425d\",\"--oneline\",\"-n1\"] + [2014-04-07 23:21:52 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"log\",\"refs/heads/git-annex..4deec8203e0baf7bb5b7d5d868d82439261ab3bc\",\"--oneline\",\"-n1\"] + [2014-04-07 23:21:52 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"log\",\"refs/heads/git-annex..b402a6e7b9268e25dbd9c6a027f4a5258993980d\",\"--oneline\",\"-n1\"] + [2014-04-07 23:21:52 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"log\",\"refs/heads/git-annex..7b18a191d58d779aab5789b923adb09863938ffe\",\"--oneline\",\"-n1\"] + [2014-04-07 23:21:52 EEST] feed: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"update-index\",\"-z\",\"--index-info\"] + [2014-04-07 23:21:52 EEST] TransferWatcher: transfer finishing: Transfer {transferDirection = Download, transferUUID = UUID \"86e07a59-8bba-4878-8d0b-5dfe8c6366c4\", transferKey = Key {keyName = \"5891b5b522d5df086d0ff0b110fbd9d21bb4fc7163af34d08286a2e846f6be03\", keyBackendName = \"SHA256E\", keySize = Just 6, keyMtime = Nothing}} + [2014-04-07 23:21:52 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"diff-index\",\"--raw\",\"-z\",\"-r\",\"--no-renames\",\"-l0\",\"--cached\",\"4deec8203e0baf7bb5b7d5d868d82439261ab3bc\"] + [2014-04-07 23:21:52 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"log\",\"4deec8203e0baf7bb5b7d5d868d82439261ab3bc..refs/heads/git-annex\",\"--oneline\",\"-n1\"] + [2014-04-07 23:21:52 EEST] call: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"update-ref\",\"refs/heads/git-annex\",\"4deec8203e0baf7bb5b7d5d868d82439261ab3bc\"] + [2014-04-07 23:22:08 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"ls-tree\",\"--full-tree\",\"-z\",\"--\",\"refs/heads/git-annex\",\"uuid.log\",\"remote.log\",\"trust.log\",\"group.log\",\"numcopies.log\",\"schedule.log\",\"preferred-content.log\",\"required-content.log\",\"group-preferred-content.log\"] + [2014-04-07 23:24:24 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"symbolic-ref\",\"HEAD\"] + [2014-04-07 23:24:24 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"show-ref\",\"refs/heads/master\"] + [2014-04-07 23:24:24 EEST] Merger: merging refs/heads/synced/master into refs/heads/master + [2014-04-07 23:24:24 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"show-ref\",\"--hash\",\"refs/heads/master\"] + [2014-04-07 23:24:24 EEST] call: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"merge\",\"--no-edit\",\"refs/heads/synced/master\"] + Updating 645e474..8406809 + Fast-forward + test/hello | 1 + + 1 file changed, 1 insertion(+) + create mode 120000 test/hello + [2014-04-07 23:24:24 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"show-ref\",\"git-annex\"] + [2014-04-07 23:24:24 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"show-ref\",\"--hash\",\"refs/heads/git-annex\"] + [2014-04-07 23:24:24 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"log\",\"refs/heads/git-annex..4deec8203e0baf7bb5b7d5d868d82439261ab3bc\",\"--oneline\",\"-n1\"] + [2014-04-07 23:24:24 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"log\",\"refs/heads/git-annex..2e0884d9c8859339855ceee396b9ea9ae05865b4\",\"--oneline\",\"-n1\"] + [2014-04-07 23:24:24 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"log\",\"refs/heads/git-annex..b402a6e7b9268e25dbd9c6a027f4a5258993980d\",\"--oneline\",\"-n1\"] + [2014-04-07 23:24:24 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"log\",\"refs/heads/git-annex..7b18a191d58d779aab5789b923adb09863938ffe\",\"--oneline\",\"-n1\"] + [2014-04-07 23:24:24 EEST] chat: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"hash-object\",\"-w\",\"--stdin-paths\",\"--no-filters\"] + [2014-04-07 23:24:24 EEST] feed: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"update-index\",\"-z\",\"--index-info\"] + [2014-04-07 23:24:24 EEST] feed: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"update-index\",\"-z\",\"--index-info\"] + [2014-04-07 23:24:24 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"diff-index\",\"--raw\",\"-z\",\"-r\",\"--no-renames\",\"-l0\",\"--cached\",\"2e0884d9c8859339855ceee396b9ea9ae05865b4\"] + [2014-04-07 23:24:24 EEST] chat: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"hash-object\",\"-t\",\"blob\",\"-w\",\"--stdin\",\"--no-filters\"] + [2014-04-07 23:24:24 EEST] feed: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"update-index\",\"-z\",\"--index-info\"] + [2014-04-07 23:24:24 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"diff-index\",\"--raw\",\"-z\",\"-r\",\"--no-renames\",\"-l0\",\"--cached\",\"refs/heads/git-annex\"] + [2014-04-07 23:24:24 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"write-tree\"] + [2014-04-07 23:24:24 EEST] chat: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"commit-tree\",\"0bd4352b4008165d356bc9b1250bdb456c675175\",\"-p\",\"refs/heads/git-annex\",\"-p\",\"2e0884d9c8859339855ceee396b9ea9ae05865b4\"] + [2014-04-07 23:24:24 EEST] call: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"update-ref\",\"refs/heads/git-annex\",\"214ed317536695b91c8dd5bed059c46c11ad00be\"] + [2014-04-07 23:24:24 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"ls-tree\",\"--full-tree\",\"-z\",\"--\",\"refs/heads/git-annex\",\"uuid.log\",\"remote.log\",\"trust.log\",\"group.log\",\"numcopies.log\",\"schedule.log\",\"preferred-content.log\",\"required-content.log\",\"group-preferred-content.log\"] + [2014-04-07 23:24:24 EEST] Watcher: add symlink test/hello + [2014-04-07 23:24:24 EEST] chat: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"hash-object\",\"-t\",\"blob\",\"-w\",\"--stdin\",\"--no-filters\"] + [2014-04-07 23:24:24 EEST] Committer: committing 1 changes + [2014-04-07 23:24:24 EEST] Committer: Committing changes to git + [2014-04-07 23:24:24 EEST] feed: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"update-index\",\"-z\",\"--index-info\"] + [2014-04-07 23:24:24 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"symbolic-ref\",\"HEAD\"] + [2014-04-07 23:24:24 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"show-ref\",\"--hash\",\"refs/heads/master\"] + [2014-04-07 23:24:24 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"write-tree\"] + [2014-04-07 23:24:24 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"rev-parse\",\"84068090af4bcd3d24f16d865ac07b0478f20ada:\"] + [2014-04-07 23:24:24 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"symbolic-ref\",\"HEAD\"] + [2014-04-07 23:24:24 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"show-ref\",\"refs/heads/master\"] + [2014-04-07 23:30:13 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"show-ref\",\"git-annex\"] + [2014-04-07 23:30:13 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"show-ref\",\"--hash\",\"refs/heads/git-annex\"] + [2014-04-07 23:30:13 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"log\",\"refs/heads/git-annex..214ed317536695b91c8dd5bed059c46c11ad00be\",\"--oneline\",\"-n1\"] + [2014-04-07 23:30:13 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"log\",\"refs/heads/git-annex..2e0884d9c8859339855ceee396b9ea9ae05865b4\",\"--oneline\",\"-n1\"] + [2014-04-07 23:30:13 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"log\",\"refs/heads/git-annex..b402a6e7b9268e25dbd9c6a027f4a5258993980d\",\"--oneline\",\"-n1\"] + [2014-04-07 23:30:13 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"log\",\"refs/heads/git-annex..7b18a191d58d779aab5789b923adb09863938ffe\",\"--oneline\",\"-n1\"] + [2014-04-07 23:30:13 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"ls-tree\",\"--full-tree\",\"-z\",\"--\",\"refs/heads/git-annex\",\"uuid.log\",\"remote.log\",\"trust.log\",\"group.log\",\"numcopies.log\",\"schedule.log\",\"preferred-content.log\",\"required-content.log\",\"group-preferred-content.log\"] + [2014-04-07 23:30:13 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"show-ref\",\"git-annex\"] + [2014-04-07 23:30:13 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"show-ref\",\"--hash\",\"refs/heads/git-annex\"] + [2014-04-07 23:30:13 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"log\",\"refs/heads/git-annex..214ed317536695b91c8dd5bed059c46c11ad00be\",\"--oneline\",\"-n1\"] + [2014-04-07 23:30:13 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"log\",\"refs/heads/git-annex..2e0884d9c8859339855ceee396b9ea9ae05865b4\",\"--oneline\",\"-n1\"] + [2014-04-07 23:30:13 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"log\",\"refs/heads/git-annex..b402a6e7b9268e25dbd9c6a027f4a5258993980d\",\"--oneline\",\"-n1\"] + [2014-04-07 23:30:13 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"log\",\"refs/heads/git-annex..7b18a191d58d779aab5789b923adb09863938ffe\",\"--oneline\",\"-n1\"] + [2014-04-07 23:31:13 EEST] read: git [\"--git-dir=/storage/sarjat/annex-sarjat/.git\",\"--work-tree=/storage/sarjat/annex-sarjat\",\"ls-tree\",\"--full-tree\",\"-z\",\"--\",\"refs/heads/git-annex\",\"uuid.log\",\"remote.log\",\"trust.log\",\"group.log\",\"numcopies.log\",\"schedule.log\",\"preferred-content.log\",\"required-content.log\",\"group-preferred-content.log\"] +\"\"\"]] +"""]] diff --git a/doc/bugs/Assistant_lost_dbus_connection_spamming_log.mdwn b/doc/bugs/Assistant_lost_dbus_connection_spamming_log.mdwn index 3b50742fdb..a4a0b0221e 100644 --- a/doc/bugs/Assistant_lost_dbus_connection_spamming_log.mdwn +++ b/doc/bugs/Assistant_lost_dbus_connection_spamming_log.mdwn @@ -76,3 +76,13 @@ accept: unsupported operation (Function not implemented) lost dbus connection; falling back to polling (SocketError {socketErrorMessage = "connect: does not exist (No such file or directory)", socketErrorFatal = True, socketErrorAddress = Just (Address "unix:path=/var/run/dbus/system_bus_socket")}) """]] + +> [[done]]; This turned out to not be dbus related, but the http server failing, +> and I fixed that bug. +> +> AFAICS the user running git-annex did not have their own dbus daemon +> running, and that's why the low-volume dbus messages come up. +> Probably because this is an embedded device, and so no desktop +> environment. git-annex only uses dbus for detecting network connection +> changes and removable media mounts. None of which probably matter in an +> embedded environment. --[[Joey]] diff --git a/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_13_37aa5274874242861dc128efa1d29486._comment b/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_13_37aa5274874242861dc128efa1d29486._comment new file mode 100644 index 0000000000..5a99e0f55e --- /dev/null +++ b/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_13_37aa5274874242861dc128efa1d29486._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://schnouki.net/" + nickname="Schnouki" + subject="comment 13" + date="2014-03-20T23:54:51Z" + content=""" +Sorry for the delay (my laptop hard drive died so I was offline for a few days). + +Just tested git-annex 5.20140320 on my NAS and it works just fine! The webapp is running, I can connect to it, and there's no more spam in the daemon.log (except for the dbus message every minute, but that's not really a problem). + +Thanks a lot Joey! +"""]] diff --git a/doc/bugs/Compilation_error_when_building_version_5.20140402_in_cabal_sandbox.mdwn b/doc/bugs/Compilation_error_when_building_version_5.20140402_in_cabal_sandbox.mdwn new file mode 100644 index 0000000000..425831a12c --- /dev/null +++ b/doc/bugs/Compilation_error_when_building_version_5.20140402_in_cabal_sandbox.mdwn @@ -0,0 +1,36 @@ +### Please describe the problem. +[[!format sh """ +cabal install -O2 -j1 -f-webdav -f-s3 git-annex +Resolving dependencies... +Configuring dns-1.2.0... +Building dns-1.2.0... +Preprocessing library dns-1.2.0... + +Network/DNS/Decode.hs:15:8: + Could not find module `Data.Conduit.Network' + It is a member of the hidden package `conduit-extra-1.1.0'. + Perhaps you need to add `conduit-extra' to the build-depends in your .cabal file. + Use -v to see a list of the files searched for. +Failed to install dns-1.2.0 +cabal: Error: some packages failed to install: +dns-1.2.0 failed during the building phase. The exception was: +ExitFailure 1 +git-annex-5.20140402 depends on dns-1.2.0 which failed to install. +"""]] + +### What steps will reproduce the problem? + +[[!format sh """ +cabal update +mkdir -p ~/haskell/git-annex +cd ~/haskell/git-annex +cabal sandbox init +cabal install -O2 -j1 -f-webdav -f-s3 c2hs git-annex +"""]] +### What version of git-annex are you using? On what operating system? + +5.20140402, Gentoo Linux + +### Please provide any additional information below. + +> [[fixed|done]] --[[Joey]] diff --git a/doc/bugs/Compilation_error_when_building_version_5.20140402_in_cabal_sandbox/comment_1_bd830cadaeffda0366b3ae46b34c0c55._comment b/doc/bugs/Compilation_error_when_building_version_5.20140402_in_cabal_sandbox/comment_1_bd830cadaeffda0366b3ae46b34c0c55._comment new file mode 100644 index 0000000000..8ac4f017f7 --- /dev/null +++ b/doc/bugs/Compilation_error_when_building_version_5.20140402_in_cabal_sandbox/comment_1_bd830cadaeffda0366b3ae46b34c0c55._comment @@ -0,0 +1,39 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawl1D_4vD5ueaDw8gRsIYPO3UHRKEpFfg9I" + nickname="Dmitry" + subject="comment 1" + date="2014-04-04T06:40:21Z" + content=""" +Author of \"dns\" library already fixed this issue. + +Next error is: +[[!format sh \"\"\" +Preprocessing executable 'git-annex' for git-annex-5.20140402... + +Utility/Yesod.hs:36:8: + Could not find module `Text.Hamlet' + It is a member of the hidden package `shakespeare-2.0.0.1'. + Perhaps you need to add `shakespeare' to the build-depends in your .cabal file. + Use -v to see a list of the files searched for. +cabal: Error: some packages failed to install: +\"\"\"]] + +Here is the fix: + + +[[!format diff \"\"\" +Index: git-annex/git-annex.cabal +=================================================================== +--- git-annex.orig/git-annex.cabal ++++ git-annex/git-annex.cabal +@@ -101,7 +101,7 @@ Executable git-annex + base (>= 4.5 && < 4.9), monad-control, MonadCatchIO-transformers, + IfElse, text, QuickCheck >= 2.1, bloomfilter, edit-distance, process, + SafeSemaphore, uuid, random, dlist, unix-compat, async, stm (>= 2.3), +- data-default, case-insensitive ++ data-default, case-insensitive, shakespeare + CC-Options: -Wall + GHC-Options: -Wall + Extensions: PackageImports +\"\"\"]] +"""]] diff --git a/doc/bugs/Could_not_read_from_remote_repository/comment_3_95d16045dc238dba19a98808de2eeedf._comment b/doc/bugs/Could_not_read_from_remote_repository/comment_3_95d16045dc238dba19a98808de2eeedf._comment new file mode 100644 index 0000000000..a8d2705a62 --- /dev/null +++ b/doc/bugs/Could_not_read_from_remote_repository/comment_3_95d16045dc238dba19a98808de2eeedf._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnvVfFLW4CTKs7UjdiLIsOn_cxj1Jnh64I" + nickname="Charl" + subject="Could it be gmail.com XMPP throttling?" + date="2014-03-23T19:26:08Z" + content=""" +I was seeing similar error messages, until I registered for a different XMPP account at jabber.de and started using that instead of my gmail.com account. + +My current suspicion is that it could be Google performing throttling on their XMPP service. See here: http://stackoverflow.com/questions/1843837/what-is-the-throttling-rate-that-gtalk-applies-to-xmpp-messages + +"""]] diff --git a/doc/bugs/Crash_when_disabling_syncing_in_the_webapp.mdwn b/doc/bugs/Crash_when_disabling_syncing_in_the_webapp.mdwn new file mode 100644 index 0000000000..e69a145a6b --- /dev/null +++ b/doc/bugs/Crash_when_disabling_syncing_in_the_webapp.mdwn @@ -0,0 +1,23 @@ +### Please describe the problem. +The watcher crashes. + +I only need to restart the thread in the pop-up to get everything to work again, but I'm reporting just in case that this issue has any other implications. + + +### What steps will reproduce the problem? +I open the webapp and in the minutes before it starts syncing (syncing is enabled) I disable it (clicking in the 'syncing enabled' text). + +This produces a crash every time. + + +### What version of git-annex are you using? On what operating system? +5.20140320 in Debian sid and testing + + +### Please provide any additional information below. +This is all I can see in the logs + +[[!format sh """ +Watcher crashed: PauseWatcher +[2014-03-26 08:54:57 CET] Watcher: warning Watcher crashed: PauseWatcher +"""]] diff --git a/doc/bugs/Crash_when_disabling_syncing_in_the_webapp/comment_1_e25dd80370820782f9c6a877101d8703._comment b/doc/bugs/Crash_when_disabling_syncing_in_the_webapp/comment_1_e25dd80370820782f9c6a877101d8703._comment new file mode 100644 index 0000000000..ce4af5caa5 --- /dev/null +++ b/doc/bugs/Crash_when_disabling_syncing_in_the_webapp/comment_1_e25dd80370820782f9c6a877101d8703._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.41" + subject="comment 1" + date="2014-03-26T17:36:00Z" + content=""" +How did you install git-annex? Is this Debian Linux? + +I have not been able to reproduce a crash. It's indeed the case that a PauseWatcher exception is thrown, but the Watcher explicitly catches that exception. +"""]] diff --git a/doc/bugs/Crash_when_disabling_syncing_in_the_webapp/comment_2_4031c16362137747717e9595cb5c8a15._comment b/doc/bugs/Crash_when_disabling_syncing_in_the_webapp/comment_2_4031c16362137747717e9595cb5c8a15._comment new file mode 100644 index 0000000000..07efa451d7 --- /dev/null +++ b/doc/bugs/Crash_when_disabling_syncing_in_the_webapp/comment_2_4031c16362137747717e9595cb5c8a15._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawk9nck8WX8-ADF3Fdh5vFo4Qrw1I_bJcR8" + nickname="Jon Ander" + subject="comment 2" + date="2014-04-01T08:04:51Z" + content=""" +Yes, this is Debian Linux and I've been able to reproduce it in i386 and amd64. git-annex is installed from the Debian repositories. + +I'll try to continue testing the issue and will report back if I can find any useful info. +"""]] diff --git a/doc/bugs/Crash_when_disabling_syncing_in_the_webapp/comment_3_0667f39f60bdaba6670f5b8304a8a77c._comment b/doc/bugs/Crash_when_disabling_syncing_in_the_webapp/comment_3_0667f39f60bdaba6670f5b8304a8a77c._comment new file mode 100644 index 0000000000..60f82a5b30 --- /dev/null +++ b/doc/bugs/Crash_when_disabling_syncing_in_the_webapp/comment_3_0667f39f60bdaba6670f5b8304a8a77c._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.244" + subject="comment 3" + date="2014-04-02T20:38:12Z" + content=""" +So we have the same version of git-annex from the same build, and only you see the problem. Hmm.. + +You mentioned that you see the problem if you disable syncing at a particular time. Does it only crash at that time, or at any time? + +If you create a brand new empty repository and run the webapp in it, can you reporoduce the problem there? Ie, \"mkdir test; cd test; git init; git annex init; git annex webapp\" +"""]] diff --git a/doc/bugs/Feature_request:_Flag_to_make_git_annex_add_not_ignore_dotfiles.mdwn b/doc/bugs/Feature_request:_Flag_to_make_git_annex_add_not_ignore_dotfiles.mdwn new file mode 100644 index 0000000000..686bf18871 --- /dev/null +++ b/doc/bugs/Feature_request:_Flag_to_make_git_annex_add_not_ignore_dotfiles.mdwn @@ -0,0 +1,14 @@ +When using git annex as part of an automated backup system, it's sometimes important that we archive all files, including dotfiles. + +AFAICT there's no way to tell git annex add to add all dotfiles in a given directory; the only way to do it is to list every dotfile individually. (git annex add --force doesn't seem to do it.) + +This can be worked around with find and xargs, but this is more work than it should be, I think. + +It might also be nice if git annex add displayed a warning when adding a directory with dotfiles; something like "Warning, N files ignored; pass --whatever to add them." + +> [[!commit 34abd7bca80a8cc012f92d64116014449b1b2392]] explains +> the rationalle for dotfiles to be skipped. Such as it was. +> +> I don't think it makes sense for --force to be the flag to override +> this, because you may want to add dotfiles, but not .gitignored +> files. So, made a new --include-dotfiles option. [[done]] --[[Joey]] diff --git a/doc/bugs/Feature_request:_Flag_to_make_git_annex_add_not_ignore_dotfiles/comment_1_c258016dd545b0426e75a7c0132154d8._comment b/doc/bugs/Feature_request:_Flag_to_make_git_annex_add_not_ignore_dotfiles/comment_1_c258016dd545b0426e75a7c0132154d8._comment new file mode 100644 index 0000000000..c591e7643b --- /dev/null +++ b/doc/bugs/Feature_request:_Flag_to_make_git_annex_add_not_ignore_dotfiles/comment_1_c258016dd545b0426e75a7c0132154d8._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmUJBh1lYmvfCCiGr3yrdx-QhuLCSRnU5c" + nickname="Justin" + subject="comment 1" + date="2014-03-24T07:03:42Z" + content=""" +Maybe the right solution is to make --force not ignore dotfiles, although perhaps that would break people who rely on its current behavior. +"""]] diff --git a/doc/bugs/Feature_request:_Flag_to_make_git_annex_add_not_ignore_dotfiles/comment_2_c506f609390f8bf46433b67fc2a9ddf8._comment b/doc/bugs/Feature_request:_Flag_to_make_git_annex_add_not_ignore_dotfiles/comment_2_c506f609390f8bf46433b67fc2a9ddf8._comment new file mode 100644 index 0000000000..e170fcb198 --- /dev/null +++ b/doc/bugs/Feature_request:_Flag_to_make_git_annex_add_not_ignore_dotfiles/comment_2_c506f609390f8bf46433b67fc2a9ddf8._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmUJBh1lYmvfCCiGr3yrdx-QhuLCSRnU5c" + nickname="Justin" + subject="comment 2" + date="2014-04-03T01:44:58Z" + content=""" +Thanks a lot for adding this flag! +"""]] diff --git a/doc/bugs/Fix_to_thaoe_remote_to_work_with_latest_tahoe-lafs___40__v._1.10.0__41__.mdwn b/doc/bugs/Fix_to_thaoe_remote_to_work_with_latest_tahoe-lafs___40__v._1.10.0__41__.mdwn new file mode 100644 index 0000000000..d4392ff6a2 --- /dev/null +++ b/doc/bugs/Fix_to_thaoe_remote_to_work_with_latest_tahoe-lafs___40__v._1.10.0__41__.mdwn @@ -0,0 +1,62 @@ +### Please describe the problem. +Just a small patch to Tahoe.hs which fixes "initremote repo +type=thaoe" when using the latest tahoe-lafs release available for +download. + +I'm trying to add an attachment here but the UI says "prohibited by +allowed_attachments (user is not an admin)" so please have a look also +here: + +### What steps will reproduce the problem? + +1. Install latest tahoe-lafs +2. run "TAHOE_FURL=... git annex initremote repo type=tahoe" + +### What version of git-annex are you using? On what operating system? + +OS: Debian Sid updated to latest packages +git-annex: version 5.20140306 + +> Thanks, I've fixed this. [[done]] --[[Joey]] + +### Please provide any additional information below. + +I would like to add few things if i'm able (it's my first time for +haskell, and I'm a bit lost as now): + +1. add an optional parameter or envvar for a root dir cap and switch +from storing anonymous files to saving a tree of dirs and files +(much like the webdav back-end) so that i can later renew the +leases on the files to prevent tahoe's garbage collection process +expiration (for details see +) + +The poor man way to that without touching git-annex is to in some +way collect the caps of the files from annex metadatas and to link +them to a directory, which where i can then run "tahoe deep-check +--add-lease" on; + +> When I talked this over with Zooko before, he +> thought it was better for git-annex to not use tahoe's directories, +> which is why it doesn't. See [[todo/tahoe_lfs_for_reals]]. +> +> This is the first I have heard about tahoe garbage collection. +> It sounds like it's an optional process. +> +> It would certainly be possible to pull the caps for files out of +> git-annex's remote state log. +> --[[Joey]] + +2. add convergence as an optional parameter. As of now many of the +files that i'm willing to manage with git-annex are already on my +grid, mostly because i've used tahoe's backup command to upload +them in the past. By using the same convergence value that i've +already setup on my other tahoe client installation i would be able +to save much time and space by avoiding duplicates. + +Do you have any good pointers to pieces code of git-annex that i can +read and hack to try to implement this or any other suggestion? + +> It was not documented, but you can already pass +> `shared-convergence-secret=xxx` to `initremote`. +> I have documented it. --[[Joey]] diff --git a/doc/bugs/Git-Annex_requires_all_repositories_to_repair.mdwn b/doc/bugs/Git-Annex_requires_all_repositories_to_repair.mdwn new file mode 100644 index 0000000000..f13431f7e2 --- /dev/null +++ b/doc/bugs/Git-Annex_requires_all_repositories_to_repair.mdwn @@ -0,0 +1,2 @@ +I recently had my git-annex repository die and it needed to be repaired. Two of my repositories are external hard drives. When I tried to use git-annex repair, it would churn for some hours, then error because the external hard drives were not plugged in. When I brought the two hard drives home from the various places that they are (safely) stored, it all worked fine, but it would have been great if git-annex repair could somehow do what it could with what was connected and do the rest as and when the other drives are plugged in. This must only become more of a problem as git-annex is used for longer, as one may have a handful of USB keys storing a little on each. + diff --git a/doc/bugs/Git-Annex_requires_all_repositories_to_repair/comment_1_dff1424e48835d7d3eb8653fc59de18a._comment b/doc/bugs/Git-Annex_requires_all_repositories_to_repair/comment_1_dff1424e48835d7d3eb8653fc59de18a._comment new file mode 100644 index 0000000000..d44c30f323 --- /dev/null +++ b/doc/bugs/Git-Annex_requires_all_repositories_to_repair/comment_1_dff1424e48835d7d3eb8653fc59de18a._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.244" + subject="comment 1" + date="2014-04-07T19:25:25Z" + content=""" +Repair does not require access to remotes, but it will certianly yield a better result to have one remote available. Otherwise, information that cannot be repaired will be missing from the repository. Repair will still successfully complete in this situation though. + +If you have an error message, please paste it. +"""]] diff --git a/doc/bugs/Race_condition_between_watch__47__assistant_and_addurl.mdwn b/doc/bugs/Race_condition_between_watch__47__assistant_and_addurl.mdwn new file mode 100644 index 0000000000..1fee439281 --- /dev/null +++ b/doc/bugs/Race_condition_between_watch__47__assistant_and_addurl.mdwn @@ -0,0 +1,195 @@ +Addurl can fail due to an apparent race condition when watch or assistant is running and the repository is in direct mode. The following stress test script encounters the bug consistently on my system. I am running git-annex 5.20140320 on on Ubuntu 13.10. + +[[!format sh """ +#!/bin/sh +set -eu + +cleanup() { + local dir + dir="$1"; shift + if [ -d "$dir" ]; then + ( + set -x + fuser -k -w "$dir/annex/.git/annex/daemon.log" || : + find "$dir" -type d -exec chmod 700 '{}' '+' + find "$dir" -type f -exec chmod 600 '{}' '+' + rm -fr "$dir" + ) + fi +} + +go() { + local dir + dir="$(mktemp -d "${TMP:-/tmp}/stress-annex.XXXXXXXXXX")" + trap "cleanup '$dir'" 0 1 2 13 15 + + ( + cd "$dir" + mkdir annex + cd annex + set -x + + git init + git annex init + git annex direct + git annex watch + + for n in $(seq 100); do + git annex addurl --file=foo http://heh.fi/robots.txt + git annex sync + rm -f foo + git annex sync + done + + git annex watch --stop + git annex uninit + ) + + cleanup "$dir" + trap - 0 1 2 13 14 +} + +go +"""]] + +Script output: + +[[!format sh """ +% ./stress-annex ++ git init +Initialized empty Git repository in /tmp/stress-annex.OKj6D8kVmV/annex/.git/ ++ git annex init +init ok +(Recording state in git...) ++ git annex direct +commit +On branch master + +Initial commit + +nothing to commit +ok +direct ok ++ git annex watch ++ seq 100 ++ git annex addurl --file=foo http://heh.fi/robots.txt +addurl foo (downloading http://heh.fi/robots.txt ...) +--2014-03-27 03:14:29-- http://heh.fi/robots.txt +Resolving heh.fi (heh.fi)... 83.145.237.222 +Connecting to heh.fi (heh.fi)|83.145.237.222|:80... connected. +HTTP request sent, awaiting response... 200 OK +Length: 0 [text/plain] +Saving to: ‘/tmp/stress-annex.OKj6D8kVmV/annex/.git/annex/tmp/URL--http&c%%heh.fi%robots.txt’ + + [ <=> ] 0 --.-K/s in 0s + +2014-03-27 03:14:29 (0.00 B/s) - ‘/tmp/stress-annex.OKj6D8kVmV/annex/.git/annex/tmp/URL--http&c%%heh.fi%robots.txt’ saved [0/0] + +(Recording state in git...) +ok +(Recording state in git...) ++ git annex sync +commit ok ++ rm -f foo ++ git annex sync +commit (Recording state in git...) +ok +(Recording state in git...) ++ git annex addurl --file=foo http://heh.fi/robots.txt +addurl foo (downloading http://heh.fi/robots.txt ...) +--2014-03-27 03:14:29-- http://heh.fi/robots.txt +Resolving heh.fi (heh.fi)... 83.145.237.222 +Connecting to heh.fi (heh.fi)|83.145.237.222|:80... connected. +HTTP request sent, awaiting response... 200 OK +Length: 0 [text/plain] +Saving to: ‘/tmp/stress-annex.OKj6D8kVmV/annex/.git/annex/tmp/URL--http&c%%heh.fi%robots.txt’ + + [ <=> ] 0 --.-K/s in 0s + +2014-03-27 03:14:29 (0.00 B/s) - ‘/tmp/stress-annex.OKj6D8kVmV/annex/.git/annex/tmp/URL--http&c%%heh.fi%robots.txt’ saved [0/0] + +(Recording state in git...) +ok +(Recording state in git...) ++ git annex sync +commit ok ++ rm -f foo ++ git annex sync +commit (Recording state in git...) +ok +(Recording state in git...) ++ git annex addurl --file=foo http://heh.fi/robots.txt +addurl foo (downloading http://heh.fi/robots.txt ...) +--2014-03-27 03:14:29-- http://heh.fi/robots.txt +Resolving heh.fi (heh.fi)... 83.145.237.222 +Connecting to heh.fi (heh.fi)|83.145.237.222|:80... connected. +HTTP request sent, awaiting response... 200 OK +Length: 0 [text/plain] +Saving to: ‘/tmp/stress-annex.OKj6D8kVmV/annex/.git/annex/tmp/URL--http&c%%heh.fi%robots.txt’ + + [ <=> ] 0 --.-K/s in 0s + +2014-03-27 03:14:29 (0.00 B/s) - ‘/tmp/stress-annex.OKj6D8kVmV/annex/.git/annex/tmp/URL--http&c%%heh.fi%robots.txt’ saved [0/0] + + +git-annex: /tmp/stress-annex.OKj6D8kVmV/annex/.git/annex/objects/pX/ZJ/SHA256E-s0--e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855/: openTempFile: permission denied (Permission denied) +failed +git-annex: addurl: 1 failed ++ fuser -k -w /tmp/stress-annex.OKj6D8kVmV/annex/.git/annex/daemon.log +/tmp/stress-annex.OKj6D8kVmV/annex/.git/annex/daemon.log: 30704 30709 30735 30738 30778 ++ find /tmp/stress-annex.OKj6D8kVmV -type d -exec chmod 700 {} + ++ find /tmp/stress-annex.OKj6D8kVmV -type f -exec chmod 600 {} + ++ rm -fr /tmp/stress-annex.OKj6D8kVmV +"""]] + +The script also seems to encounter another issue. The output when seq 100 is changed to seq 1 and addurl happens to succeed: + +[[!format sh """ ++ git init +Initialized empty Git repository in /tmp/stress-annex.QEs0pNyS9z/annex/.git/ ++ git annex init +init ok +(Recording state in git...) ++ git annex direct +commit +On branch master + +Initial commit + +nothing to commit +ok +direct ok ++ git annex watch ++ seq 1 ++ git annex addurl --file=foo http://heh.fi/robots.txt +addurl foo (downloading http://heh.fi/robots.txt ...) +--2014-03-27 03:17:20-- http://heh.fi/robots.txt +Resolving heh.fi (heh.fi)... 83.145.237.222 +Connecting to heh.fi (heh.fi)|83.145.237.222|:80... connected. +HTTP request sent, awaiting response... 200 OK +Length: 0 [text/plain] +Saving to: ‘/tmp/stress-annex.QEs0pNyS9z/annex/.git/annex/tmp/URL--http&c%%heh.fi%robots.txt’ + + [ <=> ] 0 --.-K/s in 0s + +2014-03-27 03:17:20 (0.00 B/s) - ‘/tmp/stress-annex.QEs0pNyS9z/annex/.git/annex/tmp/URL--http&c%%heh.fi%robots.txt’ saved [0/0] + +(Recording state in git...) +ok +(Recording state in git...) ++ git annex sync +commit ok ++ rm -f foo ++ git annex sync +commit (Recording state in git...) +ok +(Recording state in git...) ++ git annex watch --stop ++ git annex uninit +git-annex: /tmp/stress-annex.QEs0pNyS9z/annex/.git/annex/objects/pX/ZJ/SHA256E-s0--e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855/SHA256E-s0--e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855.map: removeLink: permission denied (Permission denied) ++ fuser -k -w /tmp/stress-annex.QEs0pNyS9z/annex/.git/annex/daemon.log ++ : ++ find /tmp/stress-annex.QEs0pNyS9z -type d -exec chmod 700 {} + ++ find /tmp/stress-annex.QEs0pNyS9z -type f -exec chmod 600 {} + ++ rm -fr /tmp/stress-annex.QEs0pNyS9z +"""]] diff --git a/doc/bugs/Race_condition_between_watch__47__assistant_and_addurl/comment_1_8f56b8661a600729d7a9d569e8a0ba70._comment b/doc/bugs/Race_condition_between_watch__47__assistant_and_addurl/comment_1_8f56b8661a600729d7a9d569e8a0ba70._comment new file mode 100644 index 0000000000..cf010cd253 --- /dev/null +++ b/doc/bugs/Race_condition_between_watch__47__assistant_and_addurl/comment_1_8f56b8661a600729d7a9d569e8a0ba70._comment @@ -0,0 +1,55 @@ +[[!comment format=mdwn + username="http://johan.kiviniemi.name/" + nickname="Johan" + subject="Another race condition" + date="2014-03-31T03:42:42Z" + content=""" +Here’s another race condition which seems related: + +[[!format sh \"\"\" +% git annex addurl 'quvi:http://youtu.be/-CbFj9K9AQg' +addurl David_Raymond_Christiansen___Dependently_Typed_Programming_in_Idris___A_Demo.webm +--2014-03-31 05:45:49-- http://r4---sn-oxc0a5-ixae.googlevideo.com/videoplayback? +Resolving r4---sn-oxc0a5-ixae.googlevideo.com (r4---sn-oxc0a5-ixae.googlevideo.com)... 83.145.196.143, 2001:1bc8:100:1b::f +Connecting to r4---sn-oxc0a5-ixae.googlevideo.com (r4---sn-oxc0a5-ixae.googlevideo.com)|83.145.196.143|:80... connected. +HTTP request sent, awaiting response... 302 Found +Location: http://r13---sn-5go7dn7s.googlevideo.com/videoplayback? [following] +--2014-03-31 05:45:49-- http://r13---sn-5go7dn7s.googlevideo.com/videoplayback? +Resolving r13---sn-5go7dn7s.googlevideo.com (r13---sn-5go7dn7s.googlevideo.com)... 173.194.48.18, 2a00:1450:400f::12 +Connecting to r13---sn-5go7dn7s.googlevideo.com (r13---sn-5go7dn7s.googlevideo.com)|173.194.48.18|:80... connected. +HTTP request sent, awaiting response... 200 OK +Length: 320557466 (306M) [video/webm] +Saving to: ‘/home/ion/nobackup/media/video/.git/annex/tmp/URL--quvi&chttp&c%%youtu.be%-CbFj9K9AQg’ + +100%[======================================>] 320,557,466 895KB/s in 6m 14s + +2014-03-31 05:52:04 (837 KB/s) - ‘/home/ion/nobackup/media/video/.git/annex/tmp/URL--quvi&chttp&c%%youtu.be%-CbFj9K9AQg’ saved [320557466/320557466] + +(Recording state in git...) +fatal: Unable to create '/home/ion/nobackup/media/video/.git/index.lock': File exists. + +If no other git process is currently running, this probably means a +git process crashed in this repository earlier. Make sure no other git +process is running and remove the file manually to continue. + +git-annex: user error (xargs [\"-0\",\"git\",\"--git-dir=/home/ion/nobackup/media/video/.git\",\"--work-tree=/home/ion/nobackup/media/video\",\"-c\",\"core.bare=false\",\"add\",\"--\"] exited 123) +failed +git-annex: addurl: 1 failed + +% ls -l /home/ion/nobackup/media/video/.git/index.lock +ls: cannot access /home/ion/nobackup/media/video/.git/index.lock: No such file or directory +\"\"\"]] + +The only lines in daemon.log from that time: + +[[!format sh \"\"\" +[2014-03-31 05:52:04 EEST] Committer: Committing changes to git +[2014-03-31 05:52:04 EEST] Pusher: Syncing with heh.fi +Already up-to-date. +To heh.fi:/storage/ion/media/video + 3df241b..095d6c3 git-annex -> synced/git-annex + 10b3166..98074c1 annex/direct/master -> synced/master +Already up-to-date. +\"\"\"]] + +"""]] diff --git a/doc/bugs/Race_condition_between_watch__47__assistant_and_addurl/comment_2_46dc67bdcd174cd50ccc421ec56735ad._comment b/doc/bugs/Race_condition_between_watch__47__assistant_and_addurl/comment_2_46dc67bdcd174cd50ccc421ec56735ad._comment new file mode 100644 index 0000000000..ec3c974d98 --- /dev/null +++ b/doc/bugs/Race_condition_between_watch__47__assistant_and_addurl/comment_2_46dc67bdcd174cd50ccc421ec56735ad._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.244" + subject="comment 2" + date="2014-04-02T20:17:19Z" + content=""" +These races look beniegn, as far as I can see it doesn't cause any data to be lost, or indeed anything to happen that wouldn't have happened if addurl had been run without the assistant running. + +The first race probably has addurl and the assistant both trying to move the file object into the annex at the same time. One wins and moves it; the other loses and sulks. + +The second race has addurl trying to `git add` the file, while the assistant has already noticed the file appeared, `git add`ed it, and committed the add. + +The only way to really avoid these races would be to add a lot of lock checking. Or just make `git annex addurl` and presumably also `git annex add` and maybe several other commands refuse to run when the assistant is running. +"""]] diff --git a/doc/bugs/Repository_Information_Is_Lost.mdwn b/doc/bugs/Repository_Information_Is_Lost.mdwn new file mode 100644 index 0000000000..e757f963d0 --- /dev/null +++ b/doc/bugs/Repository_Information_Is_Lost.mdwn @@ -0,0 +1,31 @@ +### Please describe the problem. + +Clone of a repository does not contain the names of other repositories. + +### What steps will reproduce the problem? + + +### What version of git-annex are you using? On what operating system? + +Mac OS X + +git-annex version: 5.20140308-g06fb279 +build flags: Assistant Webapp Pairing Testsuite S3 WebDAV FsEvents XMPP DNS Feeds Qu +vi TDFA CryptoHash +key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 + SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 WORM URL +remote types: git gcrypt S3 bup directory rsync web webdav tahoe glacier hook extern +al + + +### Please provide any additional information below. + +Clones of my repositories lost all track of other repositories they only seem to know about them selfs attempting to remove other repositories (git annex dead name-of-an-existing-repo) fails, telling me that the repository with the name is not found. + +[[!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/Repository_Information_Is_Lost/comment_1_bae0ed4c0a6baf1675f8de1663042f43._comment b/doc/bugs/Repository_Information_Is_Lost/comment_1_bae0ed4c0a6baf1675f8de1663042f43._comment new file mode 100644 index 0000000000..8534442b68 --- /dev/null +++ b/doc/bugs/Repository_Information_Is_Lost/comment_1_bae0ed4c0a6baf1675f8de1663042f43._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.244" + subject="comment 1" + date="2014-04-07T19:24:12Z" + content=""" +Have you run `git-annex repair` or used the assistant to repair this repository? This can result in data going missing until the repository is able to pull the data from one of its remotes. +"""]] diff --git a/doc/bugs/Use_a_git_repository_on_the_server_don__39__t_work/comment_8_35c949aca52de83af4881a9da6340185._comment b/doc/bugs/Use_a_git_repository_on_the_server_don__39__t_work/comment_8_35c949aca52de83af4881a9da6340185._comment new file mode 100644 index 0000000000..7a59e296b7 --- /dev/null +++ b/doc/bugs/Use_a_git_repository_on_the_server_don__39__t_work/comment_8_35c949aca52de83af4881a9da6340185._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawk_QeJTzgCJj2ZC8EAJEODsLvxJ7dCOCVM" + nickname="Sindre" + subject="Non-ASCII Hostname fails" + date="2014-04-02T05:36:54Z" + content=""" +This bug still persists when specifying non-ascii hostnames. +"""]] diff --git a/doc/bugs/Use_a_git_repository_on_the_server_don__39__t_work/comment_9_9100031689eaa460791191d9bfb746d8._comment b/doc/bugs/Use_a_git_repository_on_the_server_don__39__t_work/comment_9_9100031689eaa460791191d9bfb746d8._comment new file mode 100644 index 0000000000..6fa440f235 --- /dev/null +++ b/doc/bugs/Use_a_git_repository_on_the_server_don__39__t_work/comment_9_9100031689eaa460791191d9bfb746d8._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.244" + subject="comment 9" + date="2014-04-02T19:46:36Z" + content=""" +Sorry, but this bug report is closed. If you think you have a bug in git-annex, file a *new* bug report with full details for how I can reproduce it. +"""]] diff --git a/doc/bugs/__96__git_annex_forget_--drop-dead_--force__96_____95__revives__95___repositories.mdwn b/doc/bugs/__96__git_annex_forget_--drop-dead_--force__96_____95__revives__95___repositories.mdwn new file mode 100644 index 0000000000..ef0f856621 --- /dev/null +++ b/doc/bugs/__96__git_annex_forget_--drop-dead_--force__96_____95__revives__95___repositories.mdwn @@ -0,0 +1,88 @@ +As per topic, `git annex forget --drop-dead --force` does not behave as expected. Instead of getting rid of dead repositories, it actually revives them. + +I messed up the initial setup of the S3 special remote and instead of risking manual intervention, I figured it would be cleanest to nuke the old special remotes, using a new one instead. +And yes, I should have used a test repo :( + +As this is apu.debconf.org, you could get access to the repo if that helps. + + +[[!format sh """ +richih@apu (git)-[master] /srv/video/video.debian.net % git annex info +repository mode: indirect +trusted repositories: 0 +semitrusted repositories: 4 + 00000000-0000-0000-0000-000000000001 -- web + 070cff8a-6302-4aa7-a63c-3fdd34e598a2 -- amazon_s3_us_east--SHA512E + 0bae683f-bede-43dd-a815-c4f8fb6db32d -- aws_s3_us_east--SHA512E + 92e9fac9-97ec-401f-a421-33f6b4f43e47 -- here (apu.debconf.org/srv/video/conference_videos.annex) +untrusted repositories: 0 +transfers in progress: none +available local disk space: 136.3 gigabytes (+1 megabyte reserved) +local annex keys: 4392 +local annex size: 884.64 gigabytes +annexed files in working tree: 4628 +size of annexed files in working tree: 885.68 gigabytes +bloom filter size: 16 mebibytes (0.9% full) +backend usage: + SHA512E: 9020 +richih@apu (git)-[master] /srv/video/video.debian.net % git annex dead 070cff8a-6302-4aa7-a63c-3fdd34e598a2 +dead 070cff8a-6302-4aa7-a63c-3fdd34e598a2 ok +(Recording state in git...) +richih@apu (git)-[master] /srv/video/video.debian.net % git annex dead 0bae683f-bede-43dd-a815-c4f8fb6db32d +dead 0bae683f-bede-43dd-a815-c4f8fb6db32d ok +(Recording state in git...) +richih@apu (git)-[master] /srv/video/video.debian.net % git annex initremote amazon_aws_s3-us_east_1--SHA512E type=S3 encryption='none' embedcreds='no' fileprefix='SHA512E/' bucket='debian-video' +initremote amazon_aws_s3-us_east_1--SHA512E (checking bucket...) git-annex: This bucket is already in use by a different S3 special remote, with UUID: 0bae683f-bede-43dd-a815-c4f8fb6db32d +richih@apu (git)-[master] /srv/video/video.debian.net % git annex info +repository mode: indirect +trusted repositories: 0 +semitrusted repositories: 2 + 00000000-0000-0000-0000-000000000001 -- web + 92e9fac9-97ec-401f-a421-33f6b4f43e47 -- here (apu.debconf.org/srv/video/conference_videos.annex) +untrusted repositories: 0 +transfers in progress: none +available local disk space: 136.3 gigabytes (+1 megabyte reserved) +local annex keys: 4392 +local annex size: 884.64 gigabytes +annexed files in working tree: 4628 +size of annexed files in working tree: 885.68 gigabytes +bloom filter size: 16 mebibytes (0.9% full) +backend usage: + SHA512E: 9020 +richih@apu (git)-[master] /srv/video/video.debian.net % git annex forget --drop-dead --force +forget git-annex (Recording state in git...) +ok +(Recording state in git...) +richih@apu (git)-[master] /srv/video/video.debian.net % git annex info +repository mode: indirect +trusted repositories: 0 +semitrusted repositories: 4 + 00000000-0000-0000-0000-000000000001 -- web + 070cff8a-6302-4aa7-a63c-3fdd34e598a2 -- amazon_s3_us_east--SHA512E + 0bae683f-bede-43dd-a815-c4f8fb6db32d -- aws_s3_us_east--SHA512E + 92e9fac9-97ec-401f-a421-33f6b4f43e47 -- here (apu.debconf.org/srv/video/conference_videos.annex) +untrusted repositories: 0 +transfers in progress: none +available local disk space: 136.3 gigabytes (+1 megabyte reserved) +local annex keys: 4392 +local annex size: 884.64 gigabytes +annexed files in working tree: 4628 +size of annexed files in working tree: 885.68 gigabytes +bloom filter size: 16 mebibytes (0.9% full) +backend usage: + SHA512E: 9020 +richih@apu (git)-[master] /srv/video/video.debian.net % git annex version +git-annex version: 5.20140117~bpo70+2 +build flags: Assistant Webapp Pairing S3 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 tahoe glacier hook external +local repository version: 5 +supported repository version: 5 +upgrade supported from repository versions: 0 1 2 4 +richih@apu (git)-[master] /srv/video/video.debian.net % cat /etc/issue +Debian GNU/Linux 7 \n \l + +richih@apu (git)-[master] /srv/video/video.debian.net % +"""]] + +> [[fixed|done]] via not removing from trust.log --[[Joey]] diff --git a/doc/bugs/__96__git_annex_forget_--drop-dead_--force__96_____95__revives__95___repositories/comment_1_930b40e0f68da95d335eea5bd4216126._comment b/doc/bugs/__96__git_annex_forget_--drop-dead_--force__96_____95__revives__95___repositories/comment_1_930b40e0f68da95d335eea5bd4216126._comment new file mode 100644 index 0000000000..05aa545ef6 --- /dev/null +++ b/doc/bugs/__96__git_annex_forget_--drop-dead_--force__96_____95__revives__95___repositories/comment_1_930b40e0f68da95d335eea5bd4216126._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.41" + subject="comment 1" + date="2014-03-26T17:19:58Z" + content=""" +You still have git remotes configured with the uuid of the remote, so `git annex info` pulls that data in. Since --drop-dead removes all mention of the remote from the git-annex branch, including that its trust level is dead, the remaining info from the .git/config takes effect. + +--drop-dead could `git remote rm` but that won't help other clones of the repo that also have the dead remote. Instead, I think it may make sense for --drop-dead to avoid removing the uuid from trust.log, so it will still know this remote is dead. + +(Of course, you can easily deal with this locally by `git remote rm` yourself.) +"""]] diff --git a/doc/bugs/__96__git_annex_forget_--drop-dead_--force__96_____95__revives__95___repositories/comment_2_5397d488bc337cb3d7cb46ed774d0437._comment b/doc/bugs/__96__git_annex_forget_--drop-dead_--force__96_____95__revives__95___repositories/comment_2_5397d488bc337cb3d7cb46ed774d0437._comment new file mode 100644 index 0000000000..8bdde8972f --- /dev/null +++ b/doc/bugs/__96__git_annex_forget_--drop-dead_--force__96_____95__revives__95___repositories/comment_2_5397d488bc337cb3d7cb46ed774d0437._comment @@ -0,0 +1,90 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawl9sYlePmv1xK-VvjBdN-5doOa_Xw-jH4U" + nickname="Richard" + subject="comment 2" + date="2014-03-26T22:39:34Z" + content=""" +Sorry, I had to remove the fixed tag. + + +The bug makes sense, as does your fix. I didn't even consider that this may be the cause. Still, `git remote rm` and `git annex forget --drop-dead --force` does not seem to be enough to truly get rid of the repo (and its UUID & state): + +[[!format sh \"\"\" +richih@apu [2] [0] (git)-[master] /srv/video/video.debian.net % git annex info +repository mode: indirect +trusted repositories: 0 +semitrusted repositories: 4 + 00000000-0000-0000-0000-000000000001 -- web + 070cff8a-6302-4aa7-a63c-3fdd34e598a2 -- amazon_s3_us_east--SHA512E + 0bae683f-bede-43dd-a815-c4f8fb6db32d -- aws_s3_us_east--SHA512E + 92e9fac9-97ec-401f-a421-33f6b4f43e47 -- here (apu.debconf.org/srv/video/conference_videos.annex) +untrusted repositories: 0 +transfers in progress: none +available local disk space: 136.3 gigabytes (+1 megabyte reserved) +local annex keys: git4392 +local annex size: 884.64 gigabytes +annexed files in working tree: am4628 +size of annexed files in working tree: 885.68 gigabytes +bloom filter size: 16 mebibytes (0.9% full) +backend usage: + SHA512E: 9020 +richih@apu [2] [0] (git)-[master] /srv/video/video.debian.net % git annex dead amazon_s3_us_east--SHA512E +dead amazon_s3_us_east--SHA512E ok +(Recording state in git...) +richih@apu [2] [0] (git)-[master] /srv/video/video.debian.net % git annex dead aws_s3_us_east--SHA512E +dead aws_s3_us_east--SHA512E ok +(Recording state in git...) +richih@apu [2] [0] (git)-[master] /srv/video/video.debian.net % git remote rm amazon_s3_us_east--SHA512E +richih@apu [2] [0] (git)-[master] /srv/video/video.debian.net % git remote rm aws_s3_us_east--SHA512E +richih@apu [2] [0] (git)-[master] /srv/video/video.debian.net % git annex forget --drop-dead --force +forget git-annex (Recording state in git...) +ok +(Recording state in git...) +richih@apu [2] [0] (git)-[master] /srv/video/video.debian.net % git annex info +repository mode: indirect +trusted repositories: 0 +semitrusted repositories: 2 + 00000000-0000-0000-0000-000000000001 -- web + 92e9fac9-97ec-401f-a421-33f6b4f43e47 -- here (apu.debconf.org/srv/video/conference_videos.annex) +untrusted repositories: 0 +transfers in progress: none +available local disk space: 136.3 gigabytes (+1 megabyte reserved) +local annex keys: 4392 +local annex size: 884.64 gigabytes +annexed files in working tree: 4628 +size of annexed files in working tree: 885.68 gigabytes +bloom filter size: 16 mebibytes (0.9% full) +backend usage: + SHA512E: 9020 +richih@apu [2] [0] (git)-[master] /srv/video/video.debian.net % git annex initremote amazon_aws_s3-us_east_1--SHA512E type=S3 encryption='none' embedcreds='no' fileprefix='SHA512E/' bucket='debian-video' +initremote amazon_aws_s3-us_east_1--SHA512E (checking bucket...) git-annex: This bucket is already in use by a different S3 special remote, with UUID: 0bae683f-bede-43dd-a815-c4f8fb6db32d +richih@apu [2] [0] (git)-[master] /srv/video/video.debian.net % cat .git/annex +cat: .git/annex: Ist ein Verzeichnis +richih@apu [2] [0] (git)-[master] /srv/video/video.debian.net % cat .git/config +[core] + repositoryformatversion = 0 + filemode = true + bare = false + logallrefupdates = true +[annex] + uuid = 92e9fac9-97ec-401f-a421-33f6b4f43e47 + version = 5 +richih@apu [2] [0] (git)-[master] /srv/video/video.debian.net % git annex info 537 23:33:37 Mi 26.03.2014 +repository mode: indirect +trusted repositories: 0 +semitrusted repositories: 2 + 00000000-0000-0000-0000-000000000001 -- web + 92e9fac9-97ec-401f-a421-33f6b4f43e47 -- here (apu.debconf.org/srv/video/conference_videos.annex) +untrusted repositories: 0 +transfers in progress: none +available local disk space: 136.3 gigabytes (+1 megabyte reserved) +local annex keys: 4392 +local annex size: 884.64 gigabytes +annexed files in working tree: 4628 +size of annexed files in working tree: 885.68 gigabytes +bloom filter size: 16 mebibytes (0.9% full) +backend usage: + SHA512E: 9020 +richih@apu [2] [0] (git)-[master] /srv/video/video.debian.net % +\"\"\"]] +"""]] diff --git a/doc/bugs/__96__git_annex_forget_--drop-dead_--force__96_____95__revives__95___repositories/comment_3_1b30e7611ec824dc6e79ef35e43ac740._comment b/doc/bugs/__96__git_annex_forget_--drop-dead_--force__96_____95__revives__95___repositories/comment_3_1b30e7611ec824dc6e79ef35e43ac740._comment new file mode 100644 index 0000000000..5b57840123 --- /dev/null +++ b/doc/bugs/__96__git_annex_forget_--drop-dead_--force__96_____95__revives__95___repositories/comment_3_1b30e7611ec824dc6e79ef35e43ac740._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.41" + subject="comment 3" + date="2014-03-27T17:40:51Z" + content=""" +git-annex stores the uuid of a S3 remote inside the bucket for various reasons. Now that you have removed all knowledge of the remote from the repository, when you attempt to reuse the same bucket for some reason, git-annex has no way to know that this is a remote it used to use with that bucket. + +I think this behavior is entirely reasonable. Also, it's not what you filed the original bug report about; I fixed that bug. I'm going to re-close this. +"""]] diff --git a/doc/bugs/_impossible_to_switch_repositories_on_android__in_webapp/comment_3_9ffafbeb572e110b3e072029d1ce177c._comment b/doc/bugs/_impossible_to_switch_repositories_on_android__in_webapp/comment_3_9ffafbeb572e110b3e072029d1ce177c._comment new file mode 100644 index 0000000000..b181a4fa13 --- /dev/null +++ b/doc/bugs/_impossible_to_switch_repositories_on_android__in_webapp/comment_3_9ffafbeb572e110b3e072029d1ce177c._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="yasin.zaehringer" + ip="90.218.200.128" + subject="comment 3" + date="2014-04-02T11:43:52Z" + content=""" +The bug still exists. It is not possible to change the repository in the WebApp. +"""]] diff --git a/doc/bugs/assistant_eats_all_CPU.mdwn b/doc/bugs/assistant_eats_all_CPU.mdwn index 4939bf4567..719fca425a 100644 --- a/doc/bugs/assistant_eats_all_CPU.mdwn +++ b/doc/bugs/assistant_eats_all_CPU.mdwn @@ -520,3 +520,10 @@ $ ps -O start xf | grep git-annex 13761 23:56:38 Z ? 00:00:00 \_ [git] 6252 12:56:59 S ? 00:01:09 /usr/bin/emacs23 """]] + +#### This bug is fixed + +> [[fixed|done]]. This was a Cronner bug, triggered when you had a +> scheduled fsck job that runs monthly at any time, and the last time it ran was on a day of a +> month > 12. Workaround: Disable scheduled fsck jobs, or change them to +> run on a specific day of the month. Or upgrade. --[[Joey]] diff --git a/doc/bugs/assistant_eats_all_CPU/comment_23_48a4c8d9dcc6cec243c6072090f26b6d._comment b/doc/bugs/assistant_eats_all_CPU/comment_23_48a4c8d9dcc6cec243c6072090f26b6d._comment new file mode 100644 index 0000000000..b6d2dec76a --- /dev/null +++ b/doc/bugs/assistant_eats_all_CPU/comment_23_48a4c8d9dcc6cec243c6072090f26b6d._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.191" + subject="comment 23" + date="2014-04-11T16:32:47Z" + content=""" + the clock_gettime(0x2 and clock_gettime(0x3 are consistent with getCurrentTime and getTimeZone of nextTime + +So, that strongly points to the Cronner thread, and I doubt this is specific to stable at all. + +Please run git-annex vicfg, and paste all the \"schedule\" lines, from a repository that has the problem. That should allow me to reproduce and fix this bug. +"""]] diff --git a/doc/bugs/git-annex_fails_to_initialize_under_Windows.mdwn b/doc/bugs/git-annex_fails_to_initialize_under_Windows.mdwn new file mode 100644 index 0000000000..589ec562d8 --- /dev/null +++ b/doc/bugs/git-annex_fails_to_initialize_under_Windows.mdwn @@ -0,0 +1,212 @@ +### Please describe the problem. +Git-annex fails to initialize and fails tests. + +### What steps will reproduce the problem? +Attempted initialization: + + C:\Users\Andrew\Documents\GitHub\git-annex-test [master]> git annex init + init + Detected a filesystem without fifo support. + + Disabling ssh connection caching. + + Detected a crippled filesystem. + + Enabling direct mode. + fatal: index file open failed: Invalid argument + git-annex: git [Param "checkout",Param "-q",Param "-B",Param "annex/direct/master"] failed + +Tests: + + C:\Users\Andrew\Documents\GitHub\git-annex-test [master]> git annex test + Tests + QuickCheck + prop_idempotent_deencode_git: OK + +++ OK, passed 1000 tests. + prop_idempotent_deencode: OK + +++ OK, passed 1000 tests. + prop_idempotent_fileKey: OK + +++ OK, passed 1000 tests. + prop_idempotent_key_encode: OK + +++ OK, passed 1000 tests. + prop_idempotent_key_decode: OK + +++ OK, passed 1000 tests. + prop_idempotent_shellEscape: OK + +++ OK, passed 1000 tests. + prop_idempotent_shellEscape_multiword: OK + +++ OK, passed 1000 tests. + prop_logs_sane: OK + +++ OK, passed 1000 tests. + prop_idempotent_configEscape: OK + +++ OK, passed 1000 tests. + prop_parse_show_Config: OK + +++ OK, passed 1000 tests. + prop_parentDir_basics: OK + +++ OK, passed 1000 tests. + prop_relPathDirToFile_basics: OK + +++ OK, passed 1000 tests. + prop_relPathDirToFile_regressionTest: OK + +++ OK, passed 1000 tests. + prop_cost_sane: OK + +++ OK, passed 1000 tests. + prop_matcher_sane: OK + +++ OK, passed 1000 tests. + prop_HmacSha1WithCipher_sane: OK + +++ OK, passed 1000 tests. + prop_TimeStamp_sane: OK + +++ OK, passed 1000 tests. + prop_addLog_sane: OK + +++ OK, passed 1000 tests. + prop_verifiable_sane: OK + +++ OK, passed 1000 tests. + prop_segment_regressionTest: OK + +++ OK, passed 1000 tests. + prop_read_write_transferinfo: OK + +++ OK, passed 1000 tests. + prop_read_show_inodecache: OK + +++ OK, passed 1000 tests. + prop_parse_show_log: OK + +++ OK, passed 1000 tests. + prop_read_show_TrustLevel: OK + +++ OK, passed 1000 tests. + prop_parse_show_TrustLog: OK + +++ OK, passed 1000 tests. + prop_hashes_stable: OK + +++ OK, passed 1000 tests. + prop_schedule_roundtrips: OK + +++ OK, passed 1000 tests. + prop_duration_roundtrips: OK + +++ OK, passed 1000 tests. + prop_metadata_sane: OK + +++ OK, passed 1000 tests. + prop_metadata_serialize: OK + +++ OK, passed 1000 tests. + prop_branchView_legal: OK + +++ OK, passed 1000 tests. + prop_view_roundtrips: OK + +++ OK, passed 1000 tests. + prop_viewedFile_rountrips: I n i t TOeKs + ts + i n+i+t+: OK, passed 1000 tests. + Unit Tests + add sha1dup: git-annex: System.PosixCompat.User.getEffectiveUserID: not support + ed: illegal operation + FAIL + init failed + add: git-annex: System.PosixCompat.User.getEffectiveUserID: not supported: illegal operation + FAIL + add failed + + 2 out of 2 tests failed + FAIL + Exception: init tests failed! cannot continue + add extras: FAIL + Exception: init tests failed! cannot continue + reinject: FAIL + Exception: init tests failed! cannot continue + unannex (no copy): FAIL + Exception: init tests failed! cannot continue + unannex (with copy): FAIL + Exception: init tests failed! cannot continue + drop (no remote): FAIL + Exception: init tests failed! cannot continue + drop (with remote): FAIL + Exception: init tests failed! cannot continue + drop (untrusted remote): FAIL + Exception: init tests failed! cannot continue + get: FAIL + Exception: init tests failed! cannot continue + move: FAIL + Exception: init tests failed! cannot continue + copy: FAIL + Exception: init tests failed! cannot continue + lock: FAIL + Exception: init tests failed! cannot continue + edit (no pre-commit): FAIL + Exception: init tests failed! cannot continue + edit (pre-commit): FAIL + Exception: init tests failed! cannot continue + fix: FAIL + Exception: init tests failed! cannot continue + trust: FAIL + Exception: init tests failed! cannot continue + fsck (basics): FAIL + Exception: init tests failed! cannot continue + fsck (bare): FAIL + Exception: init tests failed! cannot continue + fsck (local untrusted): FAIL + Exception: init tests failed! cannot continue + fsck (remote untrusted): FAIL + Exception: init tests failed! cannot continue + migrate: FAIL + Exception: init tests failed! cannot continue + migrate (via gitattributes): FAIL + Exception: init tests failed! cannot continue + unused: FAIL + Exception: init tests failed! cannot continue + describe: FAIL + Exception: init tests failed! cannot continue + find: FAIL + Exception: init tests failed! cannot continue + merge: FAIL + Exception: init tests failed! cannot continue + info: FAIL + Exception: init tests failed! cannot continue + version: FAIL + Exception: init tests failed! cannot continue + sync: FAIL + Exception: init tests failed! cannot continue + union merge regression: FAIL + Exception: init tests failed! cannot continue + conflict resolution: FAIL + Exception: init tests failed! cannot continue + conflict_resolution (mixed directory and file): FAIL + Exception: init tests failed! cannot continue + conflict_resolution (mixed directory and file) 2: FAIL + Exception: init tests failed! cannot continue + map: FAIL + Exception: init tests failed! cannot continue + uninit: FAIL + Exception: init tests failed! cannot continue + uninit (in git-annex branch): FAIL + Exception: init tests failed! cannot continue + upgrade: FAIL + Exception: init tests failed! cannot continue + whereis: FAIL + Exception: init tests failed! cannot continue + hook remote: FAIL + Exception: init tests failed! cannot continue + directory remote: FAIL + Exception: init tests failed! cannot continue + rsync remote: FAIL + Exception: init tests failed! cannot continue + bup remote: FAIL + Exception: init tests failed! cannot continue + crypto: FAIL + Exception: init tests failed! cannot continue + preferred content: FAIL + Exception: init tests failed! cannot continue + add subdirs: FAIL + Exception: init tests failed! cannot continue + + 45 out of 78 tests failed + (This could be due to a bug in git-annex, or an incompatability + with utilities, such as git, installed on this system.) + +### What version of git-annex are you using? On what operating system? + C:\Users\Andrew\Documents\GitHub\git-annex-test [master]> git --version + git version 1.8.4.msysgit.0 + C:\Users\Andrew\Documents\GitHub\git-annex-test [master]> git annex version + git-annex version: 5.20140227-gd872677 + build flags: Assistant Webapp Pairing Testsuite S3 WebDAV DNS Feeds Quvi TDFA CryptoHash + key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN256 + SKEIN512 WORM URL + remote types: git gcrypt S3 bup directory rsync web webdav tahoe glacier hook external + local repository version: 5 + supported repository version: 5 + upgrade supported from repository versions: 2 3 4 + C:\Users\Andrew\Documents\GitHub\git-annex-test [master]> (Get-WmiObject -class Win32_OperatingSystem).Caption + Microsoft Windows 8.1 + +### Please provide any additional information below. +^^^ See above diff --git a/doc/bugs/git-annex_fails_to_initialize_under_Windows/comment_1_082277b9b906a2cc0fcace6790f5cfad._comment b/doc/bugs/git-annex_fails_to_initialize_under_Windows/comment_1_082277b9b906a2cc0fcace6790f5cfad._comment new file mode 100644 index 0000000000..781528bcb4 --- /dev/null +++ b/doc/bugs/git-annex_fails_to_initialize_under_Windows/comment_1_082277b9b906a2cc0fcace6790f5cfad._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.41" + subject="comment 1" + date="2014-03-26T20:50:55Z" + content=""" +That's a fairly old version of git-annex, so you could try upgrading. + +This might happen if your shell environment you're using to run git-annex does not have either USERPROFILE or HOME envorironment variable set, or does not have one of USERNAME, USER, and LOGNAME set. +"""]] diff --git a/doc/bugs/git-annex_fails_to_initialize_under_Windows/comment_2_b9a3a0104bc56f9110fc58c9df140f12._comment b/doc/bugs/git-annex_fails_to_initialize_under_Windows/comment_2_b9a3a0104bc56f9110fc58c9df140f12._comment new file mode 100644 index 0000000000..1fcfc5a512 --- /dev/null +++ b/doc/bugs/git-annex_fails_to_initialize_under_Windows/comment_2_b9a3a0104bc56f9110fc58c9df140f12._comment @@ -0,0 +1,34 @@ +[[!comment format=mdwn + username="ayutheos" + ip="49.124.177.13" + subject="comment 2" + date="2014-04-10T07:52:36Z" + content=""" +I'm getting this error too. + + user@NOTEBOOK /d/pictures + $ git annex init \"photos\" + init photos + Detected a filesystem without fifo support. + + Disabling ssh connection caching. + + Detected a crippled filesystem. + + Enabling direct mode. + fatal: index file open failed: Invalid argument + git-annex: git [Param \"checkout\",Param \"-q\",Param \"-B\",Param \"annex/direct/master\"] failed + +git-annex version: + + user@NOTEBOOK /d/pictures + $ git annex version + git-annex version: 5.20140403-gdfa17fc + build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3 WebDAV DNS Feeds Quvi TDFA CryptoHash + key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 WORM URL + remote types: git gcrypt S3 bup directory rsync web webdav tahoe glacier hook external + local repository version: 5 + supported repository version: 5 + upgrade supported from repository versions: 2 3 4 + +"""]] diff --git a/doc/bugs/git-annex_fails_to_start_when_nautilus_script_directory_is_missing.mdwn b/doc/bugs/git-annex_fails_to_start_when_nautilus_script_directory_is_missing.mdwn new file mode 100644 index 0000000000..e3441489d2 --- /dev/null +++ b/doc/bugs/git-annex_fails_to_start_when_nautilus_script_directory_is_missing.mdwn @@ -0,0 +1,49 @@ +### Please describe the problem. +Starting the webapp fails if the Nautilus scripts directory doesn't exist. + +### What steps will reproduce the problem? + +[[!format sh """ +$ mv ~/.local/share/nautilus ~/.local/share/nautilus.bak +$ git-annex webapp + +git-annex: /home/brunksn/.local/share/nautilus/scripts/git-annex get: openFile: does not exist (No such file or directory) +failed +git-annex: webapp: 1 failed +"""]] + +### What version of git-annex are you using? On what operating system? +5.20140402, Debian testing + +### Please provide any additional information below. + +Workaround for users without Gnome/Nautilus: +[[!format sh """ +$ mkdir -p ~/.local/share/nautilus +"""]] + +It seems git-annex tries to create the scripts without checking if the actually directory exists. One solution would be to just create it if it doesn't exist or to only write the scripts if it exists already. Patch for the latter below. Works for me but my haskell knowledge is still very limited. + +By the way, what is the preferred way to contribute patches for git-annex? I couldn't find any information about that on the website. + +[[!format diff """ +diff --git a/Assistant/Install.hs b/Assistant/Install.hs +index 4d02c0e..883ca48 100644 +--- a/Assistant/Install.hs ++++ b/Assistant/Install.hs +@@ -87,8 +87,9 @@ installNautilus :: FilePath -> IO () + #ifdef linux_HOST_OS + installNautilus program = do + scriptdir <- (\d -> d "nautilus" "scripts") <$> userDataDir +- genscript scriptdir "get" +- genscript scriptdir "drop" ++ whenM (doesDirectoryExist scriptdir) $ do ++ genscript scriptdir "get" ++ genscript scriptdir "drop" + where + genscript scriptdir action = + installscript (scriptdir scriptname action) $ unlines +"""]] + +> [[applied|done]]. thanks! That's a fine way to send a small patch, or +> make a git branch somewhere for a larger one. --[[Joey]] diff --git a/doc/bugs/git_annex_sync_in_direct_mode_does_not_honor_skip-worktree/comment_5_cb98789c50c58f01055183dbaf7b4eba._comment b/doc/bugs/git_annex_sync_in_direct_mode_does_not_honor_skip-worktree/comment_5_cb98789c50c58f01055183dbaf7b4eba._comment new file mode 100644 index 0000000000..d40d2d7891 --- /dev/null +++ b/doc/bugs/git_annex_sync_in_direct_mode_does_not_honor_skip-worktree/comment_5_cb98789c50c58f01055183dbaf7b4eba._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="EvanDeaubl" + ip="24.251.129.149" + subject="comment 5" + date="2014-04-09T03:28:24Z" + content=""" +I'm afraid I abandoned this patch. It worked, but was still fidgety for being able to ignore parts of the tree. I found another way to do what I wanted by loading an indirect repo into /data and taking advantage of a surprise side effect in how the /sdcard filesystem translated the symlinks from the ext4 filesystem. + +I can probably scare it up from my archives, but it hasn't been kept up to date. The good news is (as I recall) the patch was pretty small. + +"""]] diff --git a/doc/bugs/git_annex_test_under_windows_8.1.mdwn b/doc/bugs/git_annex_test_under_windows_8.1.mdwn new file mode 100644 index 0000000000..2ca64eb61a --- /dev/null +++ b/doc/bugs/git_annex_test_under_windows_8.1.mdwn @@ -0,0 +1,67 @@ +### Please describe the problem. +I installed git and git annex under Windows (8.1) and ran git annex test. All except one tests passed with "ok" + +### What steps will reproduce the problem? +git annex test +under Windows 8.1 + +### What version of git-annex are you using? On what operating system? +$ git --version +git version 1.9.0.msysgit.0 + +$ git annex version +git-annex version: 5.20140320-g63535e3 +build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3 WebDAV DNS Feeds Quvi TDFA CryptoHash key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 WORM URL +remote types: git gcrypt S3 bup directory rsync web webdav tahoe glacier hook external local repository version: 5 supported repository version: 5 upgrade supported from repository versions: 2 3 4 + +Windows 8.1 + +### 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 + + prop_view_roundtrips: FAIL + *** Failed! Falsifiable (after 814 tests and 5 shrinks): + "a" + IMneitta DTaetsat s( +fr o miLniistt: [(MetaField "1\194",fromList [MetaValue (CurrentlySet True) "\r ++\231Gb\157\227\ETB\bG",MetaValue (CurrentlySet True) "\DEL\239~\243_p\DC2."]),( +MetaField "EG",fromList [MetaValue (CurrentlySet True) "",MetaValue (CurrentlySe +t True) "\v\205] .T(",MetaValue (CurrentlySet False) "\NAK\128lo\169w",MetaValue + (CurrentlySet True) "\SYN\STX\ENQ\n#u\ETXv\CANP\128\US~p",MetaValue (CurrentlySet False) "\250C\b\DC1\17 +6\154KT\191\SOf?\SI"]),(MetaField "\225a",fromList [MetaValue (CurrentlySet True +) "",MetaValue (CurrentlySet True) "\b\ETB\b",MetaValue (CurrentlySet True) "\f\ +161\FS\176h-\ta\169\t",MetaValue (CurrentlySet False) "4",MetaValue (CurrentlySe +t True) "A\FS\244V:\249kl5\ETX\SOH\SI)",MetaValue (CurrentlySet False) "Z",MetaV +alue (CurrentlySet True) "\\Lt~\235v\"\211\DLE\NAK\210",MetaValue (CurrentlySet +False) "a\SYNN",MetaValue (CurrentlySet True) "g:init test repo U5j\167G\ap-\ETX +",MetaValue (CurrentlySet False) "l\NULoW\238rD",MetaValue (CurrentlySet True) " +}\202\141\183Nxr",MetaValue (CurrentlySet False) "\170=\216S\ETB\187\SUB+!\DC3", +MetaValue (CurrentlySet True) "\240H\GS\NAK\ETB\SYNRq\153\&4\204\EOT"])]) + True + Use --quickcheck-replay '13 347062936 40785707' to reproduce. + prop_viewedFile_rountrips: OK + +++ OK, passed 1000 t +e s tDse.t + +# End of transcript or log. +"""]] + +> A sort of windows-specific bug in the test suite. I've fixed it. [[done]] +> --[[Joey]] diff --git a/doc/bugs/issues_with_non-posix_compatible_shells.mdwn b/doc/bugs/issues_with_non-posix_compatible_shells.mdwn new file mode 100644 index 0000000000..34fb72a1ce --- /dev/null +++ b/doc/bugs/issues_with_non-posix_compatible_shells.mdwn @@ -0,0 +1,41 @@ +### Please describe the problem. +Some internals of git annex does not check if the shell it is running is Posix-compatible, ie. bash. + +I am using fish, and after setting up local pairing, and working, I switched back the login-shell to fish, and when syncing a file, I got this error, read from daemon.log: + +fish: Unknown command 'GIT_ANNEX_SHELL_DIRECTORY=/home/s/annex'. Did you mean to run ~/.ssh/git-annex-shell with a modified environment? Try 'env GIT_ANNEX_SHELL_DIRECTORY=/home/s/annex ~/.ssh/git-annex-shell...'. See the help section on the set command by typing 'help set'. +Standard input: GIT_ANNEX_SHELL_DIRECTORY='/home/s/annex' ~/.ssh/git-annex-shell + ^ +fatal: Could not read from remote repository. + +Please make sure you have the correct access rights +and the repository exists. + +### What steps will reproduce the problem? +Set up local pairing ( I believe having sh/bash as login terminal is necessary for this). +Switch back to fish as login-shell with chsh -s /usr/bin/fish +Add a file to either repository. + +### What version of git-annex are you using? On what operating system? +[s@b ~]$ git annex version +git-annex version: 5.20140320-g63535e3 +build flags: Assistant Webapp Webapp-secure 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 tahoe glacier hook external + +### 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]] so +> +> I have not tried to make the assistant go back and fix up existing +> `authorized_keys` lines. So if someone had been using a posix shell and +> switched to fish, they'll hit this and need to fix it themselves. I judge +> this is pretty small number of users. --[[Joey]] diff --git a/doc/bugs/issues_with_non-posix_compatible_shells/comment_1_076948499a9d581a50da52b7690e5d4e._comment b/doc/bugs/issues_with_non-posix_compatible_shells/comment_1_076948499a9d581a50da52b7690e5d4e._comment new file mode 100644 index 0000000000..72b3e48e92 --- /dev/null +++ b/doc/bugs/issues_with_non-posix_compatible_shells/comment_1_076948499a9d581a50da52b7690e5d4e._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://johan.kiviniemi.name/" + nickname="Johan" + subject="comment 1" + date="2014-04-02T08:40:17Z" + content=""" +FWIW, `env foo=bar cmd` would probably work on every system on which the `foo=bar cmd` invocation works now. +"""]] diff --git a/doc/bugs/nautilus__47__scripts__47__git-annex_get:_openFile:_does_not_exist___40__No_such_file_or_directory__41__.mdwn b/doc/bugs/nautilus__47__scripts__47__git-annex_get:_openFile:_does_not_exist___40__No_such_file_or_directory__41__.mdwn new file mode 100644 index 0000000000..8dca631bab --- /dev/null +++ b/doc/bugs/nautilus__47__scripts__47__git-annex_get:_openFile:_does_not_exist___40__No_such_file_or_directory__41__.mdwn @@ -0,0 +1,30 @@ +### Please describe the problem. +When I try to start the webapp, it fails, complaining about a nautilus script. + + +### What version of git-annex are you using? On what operating system? +Mythbuntu 12.04 (which is based on XFCE and doesn't have nautilus) +$ git-annex version +git-annex version: 5.20140402 +build flags: Assistant Webapp Webapp-secure Pairing S3 WebDAV Inotify DBus DesktopNotify XMPP DNS Feeds Quvi TDFA CryptoHash +key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 WORM URL +remote types: git gcrypt S3 bup directory rsync web webdav tahoe glacier hook external +local repository version: 5 +supported repository version: 5 +upgrade supported from repository versions: 0 1 2 4 + +### 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 webapp + +git-annex: /home/mythbuntu/.local/share/nautilus/scripts/git-annex get: openFile: does not exist (No such file or directory) +failed +git-annex: webapp: 1 failed + +# End of transcript or log. +"""]] + +[[fixed|done]] --[[Joey]] diff --git a/doc/bugs/nautilus__47__scripts__47__git-annex_get:_openFile:_does_not_exist___40__No_such_file_or_directory__41__/comment_1_9fdeaa51ccc7c71dcfeea3ea783d3b50._comment b/doc/bugs/nautilus__47__scripts__47__git-annex_get:_openFile:_does_not_exist___40__No_such_file_or_directory__41__/comment_1_9fdeaa51ccc7c71dcfeea3ea783d3b50._comment new file mode 100644 index 0000000000..d251886585 --- /dev/null +++ b/doc/bugs/nautilus__47__scripts__47__git-annex_get:_openFile:_does_not_exist___40__No_such_file_or_directory__41__/comment_1_9fdeaa51ccc7c71dcfeea3ea783d3b50._comment @@ -0,0 +1,9 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmqz6wCn-Q1vzrsHGvEJHOt_T5ZESilxhc" + nickname="Sören" + subject="comment 1" + date="2014-04-06T11:34:37Z" + content=""" +The problem has been reported [here](http://git-annex.branchable.com/bugs/git-annex_fails_to_start_when_nautilus_script_directory_is_missing/) as well and is already fixed in the latest [release](http://git-annex.branchable.com/news/version_5.20140405/). + +"""]] diff --git a/doc/bugs/preferred_content:_include_statement_does_not_allow_spaces_in_filenames.mdwn b/doc/bugs/preferred_content:_include_statement_does_not_allow_spaces_in_filenames.mdwn new file mode 100644 index 0000000000..7715a6f28f --- /dev/null +++ b/doc/bugs/preferred_content:_include_statement_does_not_allow_spaces_in_filenames.mdwn @@ -0,0 +1,29 @@ +### Please describe the problem. +Filenames for the *include* statement for [preferred content](http://git-annex.branchable.com/preferred_content/) can not contain spaces. + +### What steps will reproduce the problem? + +* Create an annex repo +* Run `git annex vicfg` +* Enter expression *include='pictures/dir with spaces'* +* git annex complains: # ** Parse error in next line: Parse failure: near "with" Parse failure: near "spaces'" + +(The *'* is interpreted as part of the filepath.) + +### What version of git-annex are you using? On what operating system? + +I am using the current binaries from Debian stable amd64. + +
+git-annex version: 5.20140320~bpo70+1
+build flags: Assistant Webapp Pairing S3 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 tahoe glacier hook external
+local repository version: 5
+supported repository version: 5
+upgrade supported from repository versions: 0 1 2 4
+
+ +### Please provide any additional information below. + +The only workaround I found is to use a glob for the filepath which only works for the first space: *include='pictures/dir\*'*. diff --git a/doc/bugs/preferred_content:_include_statement_does_not_allow_spaces_in_filenames/comment_1_ca10638d4b4b178cfd0de8736542c4dc._comment b/doc/bugs/preferred_content:_include_statement_does_not_allow_spaces_in_filenames/comment_1_ca10638d4b4b178cfd0de8736542c4dc._comment new file mode 100644 index 0000000000..a7438c559e --- /dev/null +++ b/doc/bugs/preferred_content:_include_statement_does_not_allow_spaces_in_filenames/comment_1_ca10638d4b4b178cfd0de8736542c4dc._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.244" + subject="comment 1" + date="2014-04-02T18:45:36Z" + content=""" +A better workaround is: + +include='pictures/dir?with?spaces' + +Tokenizing text with embedded quotes is a bit of a PITA, certianly doable I suppose.. +"""]] diff --git a/doc/bugs/preferred_content:_include_statement_does_not_allow_spaces_in_filenames/comment_2_986a393a512229d35e529ba242b77b1e._comment b/doc/bugs/preferred_content:_include_statement_does_not_allow_spaces_in_filenames/comment_2_986a393a512229d35e529ba242b77b1e._comment new file mode 100644 index 0000000000..7dbeb3d088 --- /dev/null +++ b/doc/bugs/preferred_content:_include_statement_does_not_allow_spaces_in_filenames/comment_2_986a393a512229d35e529ba242b77b1e._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://ypid.wordpress.com/" + ip="213.153.84.215" + subject="comment 2" + date="2014-04-02T21:29:54Z" + content=""" +Thanks for your workaround ... Works for me after removing the single quote signs. + +With this workaround on hand one could include/match any filename. Works for me ;) +"""]] diff --git a/doc/bugs/problem_to_addurl_--file_with_ftp.mdwn b/doc/bugs/problem_to_addurl_--file_with_ftp.mdwn new file mode 100644 index 0000000000..99381b9610 --- /dev/null +++ b/doc/bugs/problem_to_addurl_--file_with_ftp.mdwn @@ -0,0 +1,67 @@ +### Please describe the problem. +I want to addurl using ftp protocol. +`git annex addurl ftp://...` works fine, but `git annex addurl --file` fails with an error "failed to verify url exists". + +### What steps will reproduce the problem? + +setting up a new repo + + % alias ga + ga=/home/applis/git-annex.linux/git-annex + % ga init + init ok + (Recording state in git...) + +addurl --file works with http + + % wget http://downloads.kitenet.net/git-annex/linux/current/git-annex-standalone-amd64.tar.gz + [...] + 2014-03-27 15:25:06 (10,1 MB/s) - ‘git-annex-standalone-amd64.tar.gz’ saved [30689438/30689438] + % ga add git-annex-standalone-amd64.tar.gz + add git-annex-standalone-amd64.tar.gz ok + (Recording state in git...) + % ga addurl http://downloads.kitenet.net/git-annex/linux/current/git-annex-standalone-amd64.tar.gz --file git-annex-standalone-amd64.tar.gz + addurl git-annex-standalone-amd64.tar.gz ok + (Recording state in git...) + +addurl works with ftp: + + % ga addurl ftp://ftp.belnet.be/debian-cd/7.4.0-live/i386/iso-hybrid/debian-live-7.4-i386-lxde-desktop.iso.log + addurl ftp.belnet.be_debian_cd_7.4.0_live_i386_iso_hybrid_debian_live_7.4_i386_lxde_desktop.iso.log (downloading ftp://ftp.belnet.be/debian-cd/7.4.0-live/i386/iso-hybrid/debian-live-7.4-i386-lxde-desktop.iso.log ...) + [...] + 2014-03-27 15:27:47 (11,1 MB/s) - ‘/data/annex/.git/annex/tmp/URL--ftp&c%%ftp.belnet.be%debian-cd%7.4.0-live%i386%iso-hybrid%debian-live-7.4-i386-lxde-desktop.iso.log’ saved [1235181] + ok + (Recording state in git...) + +addurl --file doesn't work with ftp + + % wget ftp://ftp.belnet.be/debian-cd/7.4.0-live/i386/iso-hybrid/debian-live-7.4-i386-standard.iso.zsync + [...] + 2014-03-27 15:29:32 (19,4 MB/s) - ‘debian-live-7.4-i386-standard.iso.zsync’ saved [1932014] + % ga add debian-live-7.4-i386-standard.iso.zsync + add debian-live-7.4-i386-standard.iso.zsync ok + (Recording state in git...) + % ga addurl ftp://ftp.belnet.be/debian-cd/7.4.0-live/i386/iso-hybrid/debian-live-7.4-i386-standard.iso.zsync --file debian-live-7.4-i386-standard.iso.zsync + addurl debian-live-7.4-i386-standard.iso.zsync + failed to verify url exists: ftp://ftp.belnet.be/debian-cd/7.4.0-live/i386/iso-hybrid/debian-live-7.4-i386-standard.iso.zsync + failed + git-annex: addurl: 1 failed + +### What version of git-annex are you using? On what operating system? + +I am using current git-annex binary linux version on Fedora 19. + + % which git ; git --version + /usr/bin/git + git version 1.8.3.1 + % which ga ; ga version + ga=/home/applis/git-annex.linux/git-annex + git-annex version: 5.20140320-g63535e3 + build flags: Assistant Webapp Webapp-secure 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 tahoe glacier hook external + local repository version: 5 + supported repository version: 5 + upgrade supported from repository versions: 0 1 2 4 + +> [[done]] --[[Joey]] diff --git a/doc/bugs/problem_to_addurl_--file_with_ftp/comment_1_2bf44f1653069fb2ed0b124cf8581a48._comment b/doc/bugs/problem_to_addurl_--file_with_ftp/comment_1_2bf44f1653069fb2ed0b124cf8581a48._comment new file mode 100644 index 0000000000..f4e98a6210 --- /dev/null +++ b/doc/bugs/problem_to_addurl_--file_with_ftp/comment_1_2bf44f1653069fb2ed0b124cf8581a48._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.41" + subject="comment 1" + date="2014-03-27T17:27:58Z" + content=""" +--file does not change git-annex addurl's network communication in any way. I think this ftp server is sometimes working, and other times failing. It seems to be returning a 350 result code. The FTP spec is not clear what that means, but it does not seem to indicate success. +"""]] diff --git a/doc/bugs/problem_to_addurl_--file_with_ftp/comment_2_c85266a9359a9f45e632f31c016a45dc._comment b/doc/bugs/problem_to_addurl_--file_with_ftp/comment_2_c85266a9359a9f45e632f31c016a45dc._comment new file mode 100644 index 0000000000..bab883611f --- /dev/null +++ b/doc/bugs/problem_to_addurl_--file_with_ftp/comment_2_c85266a9359a9f45e632f31c016a45dc._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmdbVIGiDH8KarAGAy8y2FHJD_F990JzXI" + nickname="François" + subject="comment 2" + date="2014-04-01T08:55:29Z" + content=""" +Ok, it works when adding option --relaxed. For some reason there seems to be a problem when checking file size. +"""]] diff --git a/doc/bugs/problem_to_addurl_--file_with_ftp/comment_3_5bba62e1dd4118bcf7e1c990c7009239._comment b/doc/bugs/problem_to_addurl_--file_with_ftp/comment_3_5bba62e1dd4118bcf7e1c990c7009239._comment new file mode 100644 index 0000000000..11265f6db2 --- /dev/null +++ b/doc/bugs/problem_to_addurl_--file_with_ftp/comment_3_5bba62e1dd4118bcf7e1c990c7009239._comment @@ -0,0 +1,22 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.244" + subject="comment 3" + date="2014-04-02T19:18:19Z" + content=""" +Yes, --relaxed bypasses the code that uses curl to check the file size. + +Ok, I have figured out what's going on. + +git annex addurl --file foo ftp://host # this succeeds + +run the command a second time, and it fails. Why? Because the file is already present in the annex, and you are running addurl in a different mode. In this mode, it is adding a *new* url to the file in the annex. (In this particular case, the new and old url are the same, but it's possible to see this bug in cases where they are not, too.) + +As a sanity check, when adding a new url to an existing file, git-annex wants to check that the new url has the same size as the file. Otherwise it surely has different content. However, as I noted this ftp server is returning a weird 350 response when curl is used to try to get the size of the url. So that fails, and git-annex cannot add the new url to the file. Which would be pointless in this case anyway, since it's the same as the old url. + +So, I can fix two things. I can make it detect when the url it's adding to an existing file in the annex is already a known url of that file, and skip doing anything in this case since it would be a no-op anyway. Done that. + +And, I can improve the error message so the user is not confused about what they're asking git-annex to do, and why it's unable to. Fixed that. + +This leaves the question of why curl sees a 350 code from this ftp server. But since it doesn't cause problems when using addurl, with or without --file to download the file from it, I think it's best to punt on that one. +"""]] diff --git a/doc/bugs/problems_with_glacier.mdwn b/doc/bugs/problems_with_glacier.mdwn new file mode 100644 index 0000000000..60e2f7e698 --- /dev/null +++ b/doc/bugs/problems_with_glacier.mdwn @@ -0,0 +1,65 @@ +### Please describe the problem. +Annex errors when copying to glacier. + +### What version of git-annex are you using? On what operating system? + +OS X 10.9.2 Build 13C64 + + git-annex version: 5.20140318-gdcf93d0 + build flags: Assistant Webapp Webapp-secure 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 tahoe glacier hook external + local repository version: 5 + supported repository version: 5 + upgrade supported from repository versions: 0 1 2 4 + +### 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 initremote glacier type=glacier encryption=hybrid keyid=E9053BDA datacenter=us-west-1 ║██████████╠ ∞ ∞ +initremote glacier (encryption setup) (hybrid cipher with gpg key B608B8F6E9053BDA) ok +(Recording state in git...) +> git annex copy Cobalt\ Strike\ Tradecraft --to=glacier --debug +[2014-03-27 07:27:39 PDT] read: git ["--git-dir=/Users/akraut/Desktop/annexes/media/.git","--work-tree=/Users/akraut/Desktop/annexes/media","show-ref","git-annex"] +[2014-03-27 07:27:39 PDT] read: git ["--git-dir=/Users/akraut/Desktop/annexes/media/.git","--work-tree=/Users/akraut/Desktop/annexes/media","show-ref","--hash","refs/heads/git-annex"] +[2014-03-27 07:27:39 PDT] read: git ["--git-dir=/Users/akraut/Desktop/annexes/media/.git","--work-tree=/Users/akraut/Desktop/annexes/media","log","refs/heads/git-annex..9f59057d857784e6ae6b3dcd6793092264375913","--oneline","-n1"] +[2014-03-27 07:27:39 PDT] chat: git ["--git-dir=/Users/akraut/Desktop/annexes/media/.git","--work-tree=/Users/akraut/Desktop/annexes/media","cat-file","--batch"] +[2014-03-27 07:27:39 PDT] read: git ["config","--null","--list"] +[2014-03-27 07:27:39 PDT] read: git ["--git-dir=/Users/akraut/Desktop/annexes/media/.git","--work-tree=/Users/akraut/Desktop/annexes/media","ls-files","--cached","-z","--","Cobalt Strike Tradecraft"] +copy Cobalt Strike Tradecraft/Tradecraft__1_of_9____Introduction.mp4 (gpg) [2014-03-27 07:27:39 PDT] chat: gpg ["--quiet","--trust-model","always","--decrypt"] + +You need a passphrase to unlock the secret key for +user: "Andrew Mark Kraut " +4096-bit ELG-E key, ID 353E49B9, created 2008-11-11 (main key ID E9053BDA) + +(checking glacier...) [2014-03-27 07:27:46 PDT] read: glacier ["--region=us-west-1","archive","checkpresent","git-annex: Maybe.fromJust: Nothing + +# End of transcript or log. +"""]] + +> This was a bug introduced last month, it forgot to receord the +> datacenter and vault used when initializing the glacier repository. +> +> I've fixed the bug, but this does not fix repositories created with +> the broken version. I considered just making it use the default +> datacenter and vault for such a repository, but +> a) those may change in the future +> and I don't want to have to worry about breaking such a repository +> going forward and b) someone may have overridden it to use another +> datacenter or vault name and so it shouldn't blindly assume the defaults. +> +> Instead, there's a manual fix up step you need to do. Luckily quite easy. +> For example: +> +> git annex enableremote myglacier datacenter=us-east-1 vault=myglacier-fae9be57-8eb4-47af-932f-136b9b40e669 +> +> The default datacenter is us-east-1, and the default vault name is +> "$remotename-$uuid". So you just have to tell it these values +> once with an enableremote command, and it will then work. + +> You don't even need to get the fixed version of git-annex to work +> around the bug this way.. Although it does have better error messages +> too. [[fixed|done]] --[[Joey]] diff --git a/doc/bugs/problems_with_glacier/comment_1_8d233428a16ae4276d9c69b329e8216b._comment b/doc/bugs/problems_with_glacier/comment_1_8d233428a16ae4276d9c69b329e8216b._comment new file mode 100644 index 0000000000..e4556dc827 --- /dev/null +++ b/doc/bugs/problems_with_glacier/comment_1_8d233428a16ae4276d9c69b329e8216b._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmRFKwny4rArBaz-36xTcsJYqKIgdDaw5Q" + nickname="Andrew" + subject="comment 1" + date="2014-03-27T14:46:19Z" + content=""" +I just updated to the latest glacier-cli and boto and have confirmed that those are working properly and that the vault has been created on glacier: +[[!format sh \"\"\" +> glacier --region=us-west-1 vault list +glacier-571d1ec3-8870-46cb-977e-15830a2b474d +\"\"\"]] +"""]] diff --git a/doc/bugs/set_metadata_on_wrong_files.mdwn b/doc/bugs/set_metadata_on_wrong_files.mdwn new file mode 100644 index 0000000000..e317147840 --- /dev/null +++ b/doc/bugs/set_metadata_on_wrong_files.mdwn @@ -0,0 +1,90 @@ +### Please describe the problem. + +For an example I wanted to add different metadata to some test files, +but the outcome is that the last metadata gets applied to all three files. see transcript below. + + + +### What steps will reproduce the problem? + +1. Create a git annex repository +2. add a few files +3. add some metadata to the files, same keys, differnt values +4. watch the metadata, only the last added one is shown for all files + + +### What version of git-annex are you using? On what operating system? + $cat /etc/debian_version; uname -a; git annex version + 7.4 + Linux jupiter 3.13.0ct #33 SMP PREEMPT Tue Jan 21 05:04:01 CET 2014 x86_64 GNU/Linux + git-annex version: 5.20140306~bpo70+1 + build flags: Assistant Webapp Pairing S3 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 tahoe glacier hook external + local repository version: 5 + supported repository version: 5 + upgrade supported from repository versions: 0 1 2 4 + + +### Please provide any additional information below. + +Debian/Wheezy with git annex from backports. The test was done in /tmp which is a tmpfs. + + +[[!format sh """ +$export LC_ALL=C +$mkdir /tmp/annextest +$cd /tmp/annextest +$git init +Initialized empty Git repository in /tmp/annextest/.git/ +$git annex init +init ok +(Recording state in git...) + +$touch a.txt b.txt c.txt +$git annex add a.txt b.txt c.txt +add a.txt ok +add b.txt ok +add c.txt ok +(Recording state in git...) +$git commit -m init +[master (root-commit) 5470bdb] init + 3 files changed, 3 insertions(+) + create mode 120000 a.txt + create mode 120000 b.txt + create mode 120000 c.txt + +$git annex metadata a.txt -s foo=bar -s num=1 +metadata a.txt + foo=bar + num=1 +ok +(Recording state in git...) +$git annex metadata b.txt -s foo=baz -s num=2 +metadata b.txt + foo=baz + num=2 +ok +(Recording state in git...) +$git annex metadata c.txt -s foo=barf -s num=3 +metadata c.txt + foo=barf + num=3 +ok +(Recording state in git...) +$git annex metadata +metadata a.txt + foo=barf + num=3 +ok +metadata b.txt + foo=barf + num=3 +ok +metadata c.txt + foo=barf + num=3 +ok +"""]] + +> [[fixed|done]]; documentation improved --[[Joey]] diff --git a/doc/bugs/set_metadata_on_wrong_files/comment_1_074f124e5d313e90b3e9217325799587._comment b/doc/bugs/set_metadata_on_wrong_files/comment_1_074f124e5d313e90b3e9217325799587._comment new file mode 100644 index 0000000000..f7a47d2fea --- /dev/null +++ b/doc/bugs/set_metadata_on_wrong_files/comment_1_074f124e5d313e90b3e9217325799587._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.41" + subject="comment 1" + date="2014-03-26T20:55:07Z" + content=""" +This is because metadata applies to the contents of files, and all 3 of your files have the same single content. I will update the documentation to make it more clear metadata works this way. +"""]] diff --git a/doc/bugs/ssh_keys_have_wrong_permissions___40__Ubuntu_12.04_LTS__44___current_linux_build_as_of_Mar_6th___39__14__41__.mdwn b/doc/bugs/ssh_keys_have_wrong_permissions___40__Ubuntu_12.04_LTS__44___current_linux_build_as_of_Mar_6th___39__14__41__.mdwn new file mode 100644 index 0000000000..d03943da63 --- /dev/null +++ b/doc/bugs/ssh_keys_have_wrong_permissions___40__Ubuntu_12.04_LTS__44___current_linux_build_as_of_Mar_6th___39__14__41__.mdwn @@ -0,0 +1,10 @@ +### Please describe the problem. +git annex webapp created SSH keys for remote directory. SSH keys have wrong permission (chmod 600 fixed it) and thus the key-based login to the remote fails. + +### What steps will reproduce the problem? +Creating a SSH remote using the git annex webapp. + +### What version of git-annex are you using? On what operating system? +'current linux build for amd64', downloaded Mar 6th 2014, on Ubuntu 12.04.4 LTS. + +> [[done]] diff --git a/doc/bugs/ssh_keys_have_wrong_permissions___40__Ubuntu_12.04_LTS__44___current_linux_build_as_of_Mar_6th___39__14__41__/comment_1_462c377dca2484e5598a0b71d91ab64a._comment b/doc/bugs/ssh_keys_have_wrong_permissions___40__Ubuntu_12.04_LTS__44___current_linux_build_as_of_Mar_6th___39__14__41__/comment_1_462c377dca2484e5598a0b71d91ab64a._comment new file mode 100644 index 0000000000..92dbf283cd --- /dev/null +++ b/doc/bugs/ssh_keys_have_wrong_permissions___40__Ubuntu_12.04_LTS__44___current_linux_build_as_of_Mar_6th___39__14__41__/comment_1_462c377dca2484e5598a0b71d91ab64a._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.244" + subject="comment 1" + date="2014-04-02T19:53:04Z" + content=""" +This is a duplicate of [[bugs/ssh:_unprotected_private_key_file]], which was fixed on March 14th. +"""]] diff --git a/doc/contribute.mdwn b/doc/contribute.mdwn new file mode 100644 index 0000000000..540c1c4b14 --- /dev/null +++ b/doc/contribute.mdwn @@ -0,0 +1,15 @@ +Help make git-annex better! + +* This website is a wiki, so you can edit and improve any page. +* Write a [[new_tip|tips]] explaining how to accomplish something with + git-annex. +* [[download]] the source code and send patches! +* If you know Haskell, git-annex has lots of Haskell code that + could be improved. See the [[coding_style]] and have at it. +* If you don't know Haskell, git-annex has many other coding opportunities. + You could work to improve the Android port (Java etc) or improve the + Javascript and CSS of the git-annex webapp, or work on porting libraries + needed by the Windows port. + +To send patches, either include the patch in a bug report (small patch) +or put up a branch in a git repository containing your changes. diff --git a/doc/copies.mdwn b/doc/copies.mdwn index 205d2d5b12..3e0ebc6c69 100644 --- a/doc/copies.mdwn +++ b/doc/copies.mdwn @@ -30,3 +30,6 @@ refuse to do so. With N=2, in order to drop the file content from Laptop, it would need access to both USB and Server. + +For more complicated requirements about which repositories contain which +content, see [[required_content]]. diff --git a/doc/design/assistant.mdwn b/doc/design/assistant.mdwn index daf6fce0bd..052c536782 100644 --- a/doc/design/assistant.mdwn +++ b/doc/design/assistant.mdwn @@ -3,7 +3,7 @@ These are the design pages for the git-annex [[/assistant]]. Parts of the design is still being fleshed out, still many ideas and use cases to add. Feel free to chip in with comments! --[[Joey]] -See [[roadmap]] for current plans. +See [[roadmap]] for current plans, as this list was mostly completed. ## initial development kickstarter year overview (2012-2013) diff --git a/doc/design/assistant/polls/prioritizing_special_remotes.mdwn b/doc/design/assistant/polls/prioritizing_special_remotes.mdwn index f7462af0d6..c6dbb376cb 100644 --- a/doc/design/assistant/polls/prioritizing_special_remotes.mdwn +++ b/doc/design/assistant/polls/prioritizing_special_remotes.mdwn @@ -6,7 +6,7 @@ locally paired systems, and remote servers with rsync. Help me prioritize my work: What special remote would you most like to use with the git-annex assistant? -[[!poll open=yes 16 "Amazon S3 (done)" 12 "Amazon Glacier (done)" 9 "Box.com (done)" 71 "My phone (or MP3 player)" 25 "Tahoe-LAFS" 10 "OpenStack SWIFT" 31 "Google Drive"]] +[[!poll open=yes 16 "Amazon S3 (done)" 12 "Amazon Glacier (done)" 9 "Box.com (done)" 71 "My phone (or MP3 player)" 25 "Tahoe-LAFS" 10 "OpenStack SWIFT" 33 "Google Drive"]] This poll is ordered with the options I consider easiest to build listed first. Mostly because git-annex already supports them and they diff --git a/doc/design/assistant/telehash.mdwn b/doc/design/assistant/telehash.mdwn index b9755736f3..3b427b42f0 100644 --- a/doc/design/assistant/telehash.mdwn +++ b/doc/design/assistant/telehash.mdwn @@ -11,6 +11,9 @@ git-annex (assistant) repositories. * Rapid development, situation may change in a month or 2. * Is it secure? A security review should be done by competant people (not Joey). See +* **Haskell version** + + Development on v2 in haskell is just starting up! ## implementation basics @@ -63,8 +66,7 @@ encryption. ## separate daemon? -A `gathd` could contain all the telehash specific code, and git-annex -communicate with it via a local socket. +See [[git-remote-daemon]] for a design. Advantages: @@ -85,8 +87,4 @@ Advantages: Disadvantages: -* Adds a memcopy when large files are being transferred through telehash. - Unlikely to be a bottleneck. * Adds some complexity. -* What IPC to use on Windows? Might have to make git-annex communicate - with it over its stdin/stdout there. diff --git a/doc/design/git-remote-daemon.mdwn b/doc/design/git-remote-daemon.mdwn new file mode 100644 index 0000000000..6b8e0646ff --- /dev/null +++ b/doc/design/git-remote-daemon.mdwn @@ -0,0 +1,177 @@ +# goals + +* be configured like a regular git remote, with an unusual url + or other configuration +* receive notifications when a remote has received new commits, + and take some action +* optionally, do receive-pack and send-pack to a remote that + is only accessible over an arbitrary network transport + (like assistant does with XMPP) +* optionally, send/receive git-annex objects to remote + over an arbitrary network transport + +# difficulties + +* authentication & configuration +* multiple nodes may be accessible over a single network transport, + with it desirable to sync with any/all of them. For example, with + XMPP, there can be multiple friends synced with. This means that + one git remote can map to multiple remote nodes. Specific to git-annex, + this means that a set of UUIDs known to be associated with the remote + needs to be maintained, while currently each remote can only have one + annex-uuid in .git/config. + +# payoffs + +* support [[assistant/telehash]]! +* Allow running against a normal ssh git remote. This would run + git-annex-shell on the remote, watching for changes, and so be able to + notify when a commit was pushed to the remote repo. This would let the + assistant immediately notice and pull. So the assistant would be fully + usable with a single ssh remote and no other configuration! + **do this first** +* clean up existing XMPP support, make it not a special case, and not + tightly tied to the assistant +* git-remote-daemon could be used independantly of git-annex, + in any git repository. + +# design + +Let git-remote-daemon be the name. Or for git-annex, +`git annex remotedaemon`. + +It runs in one of two ways: + +1. Forked to background, using a named pipe for the control protocol. +2. With --foreground, the control protocol goes over stdio. + +Either way, behavior is the same: + +* Get a list of remotes to act on by looking at .git/config +* Automatically notices when a remote has changes to branches + matching remote.$name.fetch, and pulls them down to the appropriate + location. +* When the control protocol informs it about a new ref that's available, + it offers the ref to any interested remotes. + +# control protocol + +This is an asynchronous protocol. Ie, either side can send any message +at any time, and the other side does not send a reply. + +It is line based and intended to be low volume and not used for large data. + +TODO: Expand with commands for sending/receiving git-annex objects, and +progress during transfer. + +TODO: Will probably need to add something for whatever pairing is done by +the webapp. + +## emitted messages + +* `CONNECTED $remote` + + Sent when a connection has been made with a remote. + +* `DISCONNECTED $remote` + + Sent when connection with a remote has been lost. + +* `SYNCING $remote` + + Indicates that a pull or a push with a remote is in progress. + Always followed by DONESYNCING. + +* `DONESYNCING 1|0 $remote` + + Indicates that syncing with a remote is done, and either succeeded + (1) or failed (0). + +## consumed messages + +* `PAUSE` + + This indicates that the network connection has gone down, + or the user has requested a pause. + git-remote-daemon should close connections and idle. + + Affects all remotes. + +* `RESUME` + + This indicates that the network connection has come back up, or the user + has asked it to run again. Start back up network connections. + + Affects all remotes. + +* `CHANGED ref ...` + + Indicates that a ref is new or has changed. These can be offered to peers, + and peers that are interested in them can pull the content. + +* `RELOAD` + + Indicates that configs have changed. Daemon should reload .git/config + and/or restart. + + Possible config changes include adding a new remote, removing a remote, + or setting `remote..annex-sync` to configure whether to sync with a + particular remote. + +* `STOP` + + Shut down git-remote-daemon + + (When using stdio, it also should shutdown when it reaches EOF on + stdin.) + +# encryption & authentication + +For simplicity, the network transports have to do their own end-to-end +encryption. Encryption is not part of this design. + +(XMPP does not do end-to-end encryption, but might be supported +transitionally.) + +Ditto for authentication that we're talking to who we indend to talk to. +Any public key data etc used for authenticion is part of the remote's +configuration (or hidden away in a secure chmodded file, if neccesary). +This design does not concern itself with authenticating the remote node, +it just takes the auth token and uses it. + +For example, in telehash, each node has its own keypair, which is used +or authentication and encryption, and is all that's needed to route +messages to that node. + +# network level protocol + +How do peers communicate with one another over the network? + +This seems to need to be network-layer dependant. Telehash will need +one design, and git-annex-shell on a central ssh server has a very different +(and much simpler) design. + +## ssh + +`git-annex-shell notifychanges` is run, and speaks a simple protocol +over stdio to inform when refs on the remote have changed. + +No pushing is done for CHANGED, since git handles ssh natively. + +TODO: + +* Remote system might not be available. Find a smart way to detect it, + ideally w/o generating network traffic. One way might be to check + if the ssh connection caching control socket exists, for example. +* Remote system might be available, and connection get lost. Should + reconnect, but needs to avoid bad behavior (ie, constant reconnect + attempts.) +* Detect if old system had a too old git-annex-shell and avoid bad behavior + +## telehash + +TODO + +## xmpp + +Reuse [[assistant/xmpp]] diff --git a/doc/design/git-remote-daemon/comment_1_bfa8f33a3fdb6e271dfbdd0378b5d364._comment b/doc/design/git-remote-daemon/comment_1_bfa8f33a3fdb6e271dfbdd0378b5d364._comment new file mode 100644 index 0000000000..d93bab0902 --- /dev/null +++ b/doc/design/git-remote-daemon/comment_1_bfa8f33a3fdb6e271dfbdd0378b5d364._comment @@ -0,0 +1,16 @@ +[[!comment format=mdwn + username="http://johan.kiviniemi.name/" + nickname="Johan" + subject="Rolling hash chunking" + date="2014-04-04T14:16:25Z" + content=""" +I am not sure which page is the best for this comment, but this one seems somewhat relevant. + +Given that a future telehash implementation may download files from multiple peers, it might be a good idea to download files in chunks, possibly in parallel. In this case, it might be a good idea to use a rolling hash for chunking (like rsync et al). [There is a package for that on Hackage](http://hackage.haskell.org/package/hash-0.2.0.1/docs/Data-Hash-Rolling.html). + +git-annex could store a list of chunk checksums in `.git/annex/objects/…/SHA….chunks` whenever the repository holds a copy of the file. The checksum list would be a small fraction of the file in size, but all the checksum lists for all the files in a repository might take up too much space to store in the `git-annex` branch. + +When getting an object, git-annex could first download the `.chunks` file from a remote/peer and then proceed to download missing chunks in a BitTorrent-like fashion. + +If git-annex has an idea about what locally present object might be an earlier version of the file, it could compare the checksum lists and only download the parts that have changed (à la rsync). +"""]] diff --git a/doc/design/roadmap.mdwn b/doc/design/roadmap.mdwn index 7458468f08..b7c48830d0 100644 --- a/doc/design/roadmap.mdwn +++ b/doc/design/roadmap.mdwn @@ -10,8 +10,8 @@ Now in the * Month 4 [[!traillink assistant/windows text="Windows webapp"]], Linux arm, [[!traillink todo/support_for_writing_external_special_remotes]] * Month 5 user-driven features and polishing * Month 6 get Windows out of beta, [[!traillink design/metadata text="metadata and views"]] -* **Month 7 user-driven features and polishing** -* Month 8 [[!traillink assistant/telehash]] +* Month 7 user-driven features and polishing +* **Month 8 [[!traillink git-remote-daemon]] [[!traillink assistant/telehash]]** * Month 9 [[!traillink assistant/gpgkeys]] [[!traillink assistant/sshpassword]] * Month 10 get [[assistant/Android]] out of beta * Month 11 [[!traillink assistant/chunks]] [[!traillink assistant/deltas]] diff --git a/doc/devblog/day_-4__forgetting/comment_8_3f7045a00905b4287d950b08d5a77a82._comment b/doc/devblog/day_-4__forgetting/comment_8_3f7045a00905b4287d950b08d5a77a82._comment new file mode 100644 index 0000000000..f0ba50990c --- /dev/null +++ b/doc/devblog/day_-4__forgetting/comment_8_3f7045a00905b4287d950b08d5a77a82._comment @@ -0,0 +1,9 @@ +[[!comment format=mdwn + username="stp" + ip="188.193.207.34" + subject="Any update on cleaning up commands?" + date="2014-03-21T16:32:43Z" + content=""" +Is there any update on cleaning up object/file references to objects/content not at all present and lost. I would love my git annex fsck --all to show current failures and not these old files all the time. +Thanks +"""]] diff --git a/doc/devblog/day_139-140__traveling.mdwn b/doc/devblog/day_139-140__traveling.mdwn new file mode 100644 index 0000000000..3025e45b5c --- /dev/null +++ b/doc/devblog/day_139-140__traveling.mdwn @@ -0,0 +1,17 @@ +Yesterday coded up one nice improvement on the plane -- `git annex unannex` +(and `uninit`) is now tons faster. Before it did a git commit after every +file processed, now there's just 1 commit at the end. This required using +some locking to prevent the `pre-commit` hook from running in a confusing +state. + +Today. LibrePlanet and a surprising amount of development. I've +added [[tips/file_manager_integration]], only for Nautilus so far. +The main part of this was adding --notify-start and --notify-finish, which +use dbus desktop notifications to provide feedback. + +(Made possible thanks to Max Rabkin for updating +[fdo-notify](http://hackage.haskell.org/package/fdo-notify) to use the +new dbus library, and ion for developing the initial Nautilus integration +scripts.) + +Today's work and LibrePlanet visit was sponsored by Jürgen Lüters. diff --git a/doc/devblog/day_141__f-droid_sprint.mdwn b/doc/devblog/day_141__f-droid_sprint.mdwn new file mode 100644 index 0000000000..2a9e30b553 --- /dev/null +++ b/doc/devblog/day_141__f-droid_sprint.mdwn @@ -0,0 +1,3 @@ +Attended at the f-droid sprint at LibrePlanet, and have been getting a +handle on how their build server works with an eye toward adding git-annex +to it. Not entirely successful getting vagrant to build an image yet. diff --git a/doc/devblog/day_141__f-droid_sprint/comment_1_1cc76207020ac478747117c76d7b5f9c._comment b/doc/devblog/day_141__f-droid_sprint/comment_1_1cc76207020ac478747117c76d7b5f9c._comment new file mode 100644 index 0000000000..9971f33da5 --- /dev/null +++ b/doc/devblog/day_141__f-droid_sprint/comment_1_1cc76207020ac478747117c76d7b5f9c._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmJuOOkYYguRbWhXzxihIPBavxITJIMyww" + nickname="Matt" + subject="Excellent News" + date="2014-03-26T14:14:35Z" + content=""" +It will be great to see git-annex on f-droid! +"""]] diff --git a/doc/devblog/day_142__digging_out.mdwn b/doc/devblog/day_142__digging_out.mdwn new file mode 100644 index 0000000000..fc2ceea365 --- /dev/null +++ b/doc/devblog/day_142__digging_out.mdwn @@ -0,0 +1,13 @@ +Catching up on conference backlog. 36 messages backlog remains. + +Fixed `git-annex-shell configlist` to automatically initialize a +git remote when a git-annex branch had been pushed to it. This is necessary +for gitolite to be easy to use, and I'm sure it used to work. + +Updated the Debian backport and made a Debian package of the +fdo-notify haskell library used for notifications. + +Applied a patch from Alberto Berti to fix support for tahoe-lafs +1.10. + +And various other bug fixes and small improvements. diff --git a/doc/devblog/day_143__foolish_hiatus.mdwn b/doc/devblog/day_143__foolish_hiatus.mdwn new file mode 100644 index 0000000000..f6763dff30 --- /dev/null +++ b/doc/devblog/day_143__foolish_hiatus.mdwn @@ -0,0 +1,20 @@ +Last week's trip was productive, but I came home more tired than I +realized. Found myself being snappy & stressed, so I have been on break. + +I did do a little git-annex dev in the past 5 days. On Saturday I +implemented [[todo/preferred_content]] (although without the active checks +I think it probably ought to have.) Yesterday I had a long conversation +with the Tahoe developers about improving git-annex's tahoe integration. + +Today, I have been wrapping up [building propellor](http://joeyh.name/code/propellor/). +To test its docker support, I used propellor to build and deploy a +container that is a git-annex autobuilder. I'll be replacing the old +autobuilder setup with this shortly, and expect to also publish docker +images for git-annex autobuilders, so anyone who wants to can run their +own autobuilder really easily. + +--- + +I have April penciled in on the roadmap as the month to do telehash. +I don't know if telehash-c is ready for me yet, but it has had a lot of +activity lately, so this schedule may still work out! diff --git a/doc/devblog/day_144__catching_up.mdwn b/doc/devblog/day_144__catching_up.mdwn new file mode 100644 index 0000000000..52e25f0d58 --- /dev/null +++ b/doc/devblog/day_144__catching_up.mdwn @@ -0,0 +1,12 @@ +Got caught up on all recent bugs and questions, although I still have a +backlog of 27 older things that I really should find time for. + +Fixed a couple of bugs. One was that the assistant set up ssh +`authorized_keys` that didn't work with the fish shell. + +Also got caught up on the current state of telehash-c. Have not quite +gotten it to work, but it seems pretty close to being able to see it do +something useful for the first time. + +Pushing out a release this evening with a good number of changes left over +from March. diff --git a/doc/devblog/day_144__catching_up/comment_1_311a7245dd12f1a7e432168d16041348._comment b/doc/devblog/day_144__catching_up/comment_1_311a7245dd12f1a7e432168d16041348._comment new file mode 100644 index 0000000000..f13ed82ae3 --- /dev/null +++ b/doc/devblog/day_144__catching_up/comment_1_311a7245dd12f1a7e432168d16041348._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://id.koumbit.net/anarcat" + ip="70.82.37.38" + subject="comment 1" + date="2014-04-02T21:28:15Z" + content=""" +awesome! can't wait to see telehash land! :) +"""]] diff --git a/doc/devblog/day_145__a_plan.mdwn b/doc/devblog/day_145__a_plan.mdwn new file mode 100644 index 0000000000..5f18ab8064 --- /dev/null +++ b/doc/devblog/day_145__a_plan.mdwn @@ -0,0 +1,16 @@ +I have a plan for this month. While waiting for telehash, I am going to +build [[design/git-remote-daemon]], which is the infrastructure git-annex +will need, to use telehash. Since it's generalized to support other protocols, +I'll be able to start using it before telehash is ready. + +In fact, I plan to first make it work with ssh:// remotes, where +it will talk with git-annex-shell on the remote server. This will let the +assistant immediately know when the server has received a commit, and that +will simplify using the assistant with a ssh server -- no more need for +XMPP in this case! It should also work with git-remote-gcrypt encrypted +repositories, so also covers the case of an untrusted ssh server where +everything is end-to-end encrypted. + +Building the git-annex-shell part of this should be pretty easy, and +building enough of the [[design/git-remote-daemon]] design to support it +also not hard. diff --git a/doc/devblog/day_145__a_plan/comment_1_c0ceea77443be1172527ed8549f000a4._comment b/doc/devblog/day_145__a_plan/comment_1_c0ceea77443be1172527ed8549f000a4._comment new file mode 100644 index 0000000000..6bcc18bc2a --- /dev/null +++ b/doc/devblog/day_145__a_plan/comment_1_c0ceea77443be1172527ed8549f000a4._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="https://id.koumbit.net/anarcat" + ip="2001:1928:1:9::1" + subject="look at mosh" + date="2014-04-04T14:07:51Z" + content=""" +you may want to look at how \"mosh\" handles authentication: http://mosh.mit.edu/ + +from what i understand, it negociates an authentication token using SSH and then uses that to encrypt and authenticate UDP traffic. seems like similar issues here... +"""]] diff --git a/doc/devblog/day_146__halfway_to_git-remote-daemon.mdwn b/doc/devblog/day_146__halfway_to_git-remote-daemon.mdwn new file mode 100644 index 0000000000..977123f55a --- /dev/null +++ b/doc/devblog/day_146__halfway_to_git-remote-daemon.mdwn @@ -0,0 +1,17 @@ +Added `git-annex-shell notifychanges` command, which uses inotify (etc) +to detect when git refs have changed, and informs the caller about the +changes. This was relatively easy to write; I reused the existing inotify +code, and factored out code for simple line-based protocols from the +external special remote protocol. Also implemented the git-remote-daemon +protocol. 200 lines of code total. + +Meanwhile, Johan Kiviniemi improved the dbus notifications, making them +work on Ubuntu and adding icons. Awesome! + +There's going to be some fun to get git-annex-shell upgraded so that the +assistant can use this new notify feaure. While I have not started working +on the assistant side of this, you can get a jump by installing today's +upcoming release of git-annex. I had to push this out early because there +was a bug that prevented the webapp from running on non-gnome systems. Since +all changes in this release only affected Linux, today's release will be a +Linux-only release. diff --git a/doc/devblog/day_147__git-annex_remotedaemon.mdwn b/doc/devblog/day_147__git-annex_remotedaemon.mdwn new file mode 100644 index 0000000000..0e500ec406 --- /dev/null +++ b/doc/devblog/day_147__git-annex_remotedaemon.mdwn @@ -0,0 +1,5 @@ +Built `git-annex remotedaemon` command today. It's buggy, but it already +works! If you have a new enough git-annex-shell on a remote server, you can +run "git annex remotedaemon" in a git-annex repository, and it will notice +any pushes that get made to that remote from any other clone, and pull down +the changes. diff --git a/doc/devblog/day_148__too_many_documents.mdwn b/doc/devblog/day_148__too_many_documents.mdwn new file mode 100644 index 0000000000..3cb5e5baf8 --- /dev/null +++ b/doc/devblog/day_148__too_many_documents.mdwn @@ -0,0 +1,8 @@ +Various bug triage today. Was not good for much after shuffling paper for +the whole first part of the day, but did get a few little things done. + +Re , git-annex does not use OpenSSL itself, +but when using XMPP, the remote server's key could have been intercepted +using this new technique. Also, the git-annex autobuilds and this website +are served over https -- working on generating new https certificates now. +Be safe out there.. diff --git a/doc/devblog/day_149__remote_control_working.mdwn b/doc/devblog/day_149__remote_control_working.mdwn new file mode 100644 index 0000000000..56c108b7b7 --- /dev/null +++ b/doc/devblog/day_149__remote_control_working.mdwn @@ -0,0 +1,15 @@ +[[design/git-remote-daemon]] is tied into the assistant, and working! +Since it's not really ready yet, this is in the `remotecontrol` branch. + +My test case for this is two client repositories, both running +the assistant. Both have a bare git repository, accessed over ssh, +set up as their only remote, and no other way to keep in touch with +one-another. When I change a file in one repository, +the other one instantly notices the change and syncs. + +This is gonna be *awesome*. Much less need for XMPP. Windows will be fully +usable even without XMPP. Also, most of the work I did today will be fully +reused when the telehash backend gets built. The telehash-c developer is +making noises about it being almost ready for use, too! + +Today's work was sponsored by Frédéric Schütz. diff --git a/doc/devblog/day_149__signal.mdwn b/doc/devblog/day_149__signal.mdwn new file mode 100644 index 0000000000..7327c679c9 --- /dev/null +++ b/doc/devblog/day_149__signal.mdwn @@ -0,0 +1,16 @@ +[[!meta title="day 150 signal"]] + +The git-remote-daemon now robustly handles loss of signal, with +reconnection backoffs. And it detects if the remote ssh server has a too +old version of git-annex-shell and the webapp will display a warning +message. + +[[!img /assistant/connection.png]] + +Also, made the webapp show a network signal bars icon next to both +ssh and xmpp remotes that it's currently connected with. And, updated the +webapp's nudging to set up XMPP to now suggest either an XMPP or a ssh remote. + +I think that the `remotecontrol` branch is nearly ready for merging! + +Today's work was sponsored by Paul Tagliamonte. diff --git a/doc/encryption/comment_2_f19c9bb519a7017f0731fd0e8780ed74._comment b/doc/encryption/comment_2_f19c9bb519a7017f0731fd0e8780ed74._comment new file mode 100644 index 0000000000..bf43303830 --- /dev/null +++ b/doc/encryption/comment_2_f19c9bb519a7017f0731fd0e8780ed74._comment @@ -0,0 +1,22 @@ +[[!comment format=mdwn + username="https://openid.stackexchange.com/user/e65e6d0e-58ba-41de-84cc-1f2ba54cf574" + nickname="Mica Semrick" + subject="Encrypt with pub or sub?" + date="2014-04-08T03:56:36Z" + content=""" +Forgive me, I'm a bit new to PGP. + +I do: + + $ gpg --list-keys + /home/user/.gnupg/pubring.gpg + ------------------------------ + pub 2048R/41363A6A 2014-04-03 + uid A Guy (git-annex key) + sub 2048R/77998J8TDY 2014-04-03 + +and see the pub and the sub key. + +When I init a new special remote and want encryption, should I give the init command the pub or the sub key? Or does git annex sort that out itself? + +"""]] diff --git a/doc/forum/2_clients_using_an_encrypted_server_for_syncing_-_possible__63__.mdwn b/doc/forum/2_clients_using_an_encrypted_server_for_syncing_-_possible__63__.mdwn new file mode 100644 index 0000000000..84f92ae7ea --- /dev/null +++ b/doc/forum/2_clients_using_an_encrypted_server_for_syncing_-_possible__63__.mdwn @@ -0,0 +1,3 @@ +I have 2 clients (laptops) that would (usually) not be online at the same time. Is it possible to use git-annex for syncing these 2 clients through an encrypted server? + +I have tried to set this up with the assistant by using an USB-disk for copying the repository from one client to the other. The server is configured through the assistant as repository group 'transfer'. Now both clients see the encrypted ssh-server, each client copy stuff to the encrypted server, but no files are copied between the 2 clients. (In my case, running git-annex on the server is not an option. I have read through this forum, but it doesn't seem anyone has been able to get it to work.) diff --git a/doc/forum/2_clients_using_an_encrypted_server_for_syncing_-_possible__63__/comment_1_924521ad5972046bac44d2e04ec296c7._comment b/doc/forum/2_clients_using_an_encrypted_server_for_syncing_-_possible__63__/comment_1_924521ad5972046bac44d2e04ec296c7._comment new file mode 100644 index 0000000000..90b47a3a9a --- /dev/null +++ b/doc/forum/2_clients_using_an_encrypted_server_for_syncing_-_possible__63__/comment_1_924521ad5972046bac44d2e04ec296c7._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnvVfFLW4CTKs7UjdiLIsOn_cxj1Jnh64I" + nickname="Charl" + subject="Change the encrypted server repository group to "full backup"" + date="2014-03-23T21:00:01Z" + content=""" +Have you tried changing the repository group of the encrypted server to \"full backup\" instead of \"transfer\"? + +I've just started experimenting with git-annex, and this setup (two possibly remote laptops, one encrypted server) seems to be working after very limited testing. I'm currently importing a larger collection of about 40000 files, will see if it still does (it seems whilst one client is transferring to the remote server, the other client laptop is not beeing synced; it did sync after my first batch of copying however.) +"""]] diff --git a/doc/forum/2_clients_using_an_encrypted_server_for_syncing_-_possible__63__/comment_2_e2a7f34a3ccc1b6467e6da611c067d66._comment b/doc/forum/2_clients_using_an_encrypted_server_for_syncing_-_possible__63__/comment_2_e2a7f34a3ccc1b6467e6da611c067d66._comment new file mode 100644 index 0000000000..b50ba4b469 --- /dev/null +++ b/doc/forum/2_clients_using_an_encrypted_server_for_syncing_-_possible__63__/comment_2_e2a7f34a3ccc1b6467e6da611c067d66._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkvN0eFnwvgw2JyTSSHw0QouytcxtPLln8" + nickname="Stein Roald" + subject="No success" + date="2014-03-26T19:43:24Z" + content=""" +Thank you, Charl, for your suggestion. I've tried it, without success. (It doesn't seem like that change changed anything on the encrypted ssh-server.) +"""]] diff --git a/doc/forum/2_clients_using_an_encrypted_server_for_syncing_-_possible__63__/comment_3_f9a369a6ac69f091e6128990274d3228._comment b/doc/forum/2_clients_using_an_encrypted_server_for_syncing_-_possible__63__/comment_3_f9a369a6ac69f091e6128990274d3228._comment new file mode 100644 index 0000000000..1e42061447 --- /dev/null +++ b/doc/forum/2_clients_using_an_encrypted_server_for_syncing_-_possible__63__/comment_3_f9a369a6ac69f091e6128990274d3228._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.41" + subject="comment 3" + date="2014-03-26T21:10:39Z" + content=""" +What kind of encrypted remote are you using? An encrypted rsync special remote does not include the git repository, but only the content of the files, so cannot be used in this way. + +If you set up a [[gcrypt special remote|special_remotes/gcrypt]], it will be encrypted and includes the full git repository, as well as the content of the files, so can be used like this. +"""]] diff --git a/doc/forum/2_clients_using_an_encrypted_server_for_syncing_-_possible__63__/comment_4_91b422f8d55b68077245c606c4f7f87c._comment b/doc/forum/2_clients_using_an_encrypted_server_for_syncing_-_possible__63__/comment_4_91b422f8d55b68077245c606c4f7f87c._comment new file mode 100644 index 0000000000..4d8915b8df --- /dev/null +++ b/doc/forum/2_clients_using_an_encrypted_server_for_syncing_-_possible__63__/comment_4_91b422f8d55b68077245c606c4f7f87c._comment @@ -0,0 +1,28 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkvN0eFnwvgw2JyTSSHw0QouytcxtPLln8" + nickname="Stein Roald" + subject="Need some clarification" + date="2014-03-28T22:49:14Z" + content=""" +OK, thank you Joey for your help, and I think you have made some really excellent software. I've spent a couple of days to configure gpg and understand how to use it (glad I did, it has been on my todo-list for a long time...) + +First to your question: When I started, I just used the git-annex assistant to \"set up a repository on a remote server using ssh\" as a \"transfer repository\". Now I'll use git-remote-gcrypt instead. + +Now I have 2 questions: + +--- + +1) On this webpage: [[https://github.com/joeyh/git-remote-gcrypt]] these are the instructions for setting up a remote for two participants: + + git remote add cryptremote gcrypt::rsync://example.com:repo + git config remote.cryptremote.gcrypt-participants \"KEY1 KEY2\" + git push cryptremote master + +**Question 1:** As I own both computers myself, will syncing between the 2 computers work if I only use 1 KEY (the same KEY on both computers)? + +--- + +2) I am still struggling to understand git-annex assistant and the use of special remotes. Important reasons for using git-annex are backups and moving data to the cloud to free up disk space locally. If I've understood it correctly, git-annex assistant always encrypts data sent to special remotes. And it seems to me that this page [[http://git-annex.branchable.com/special_remotes/]] suggest that git-annex assistant makes it easy to transfer files between different computers that do not communicate directly. I must clearly have misunderstood something, as Joey's comment above seem to state that I can't use the assistant for setting up syncing between computers. + +**Question 2:** If I loose my computer, or it becomes corrupted, how can I get my files back if I don't set up special remotes as a gcrypt special remote? (And if I can't, what is the purpose of the special remotes made by the assistant?) +"""]] diff --git a/doc/forum/2_clients_using_an_encrypted_server_for_syncing_-_possible__63__/comment_5_f6128fe75ff3453747f69f12e0fd0a5b._comment b/doc/forum/2_clients_using_an_encrypted_server_for_syncing_-_possible__63__/comment_5_f6128fe75ff3453747f69f12e0fd0a5b._comment new file mode 100644 index 0000000000..8dcddbeef5 --- /dev/null +++ b/doc/forum/2_clients_using_an_encrypted_server_for_syncing_-_possible__63__/comment_5_f6128fe75ff3453747f69f12e0fd0a5b._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmNu4V5fvpLlBhaCUfXXOB0MI5NXwh8SkU" + nickname="Adam" + subject="Confused" + date="2014-03-31T03:18:41Z" + content=""" +>What kind of encrypted remote are you using? An encrypted rsync special remote does not include the git repository, but only the content of the files, so cannot be used in this way. + +Forgive me, Joey, I've been following your work on the assistant for almost as long as you've been working on it, and I use git a little bit, but I have yet to wrap my head around the complexities of git and how git-annex and the assistant...morph them. I've read all the design docs you've written, but I still don't understand this. From reading the OP it sounds like this is exactly what the encrypted rsync special remote is for: using a transfer repo to sync two devices that don't connect directly to each other. Why would he need to use a gcrypt repo instead? + +Thanks for your patience. I know you get asked these basic questions over and over again. +"""]] diff --git a/doc/forum/2_clients_using_an_encrypted_server_for_syncing_-_possible__63__/comment_6_9b90b4031a5ed26c375903b33ed65a10._comment b/doc/forum/2_clients_using_an_encrypted_server_for_syncing_-_possible__63__/comment_6_9b90b4031a5ed26c375903b33ed65a10._comment new file mode 100644 index 0000000000..5fc4286b27 --- /dev/null +++ b/doc/forum/2_clients_using_an_encrypted_server_for_syncing_-_possible__63__/comment_6_9b90b4031a5ed26c375903b33ed65a10._comment @@ -0,0 +1,17 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.244" + subject="comment 6" + date="2014-04-02T20:11:35Z" + content=""" +@Adam, an encrypted special remote does not contain the git repository (the gcrypt special remote is an exception to this rule). So you need to use another method to sync the git repository between machines. + +@Stein Roald once you have a clone of the git repository, you have the information that git-annex needs in able to get files from encrypted special remotes. + +Question 1: While gcrypt supports multi-key setups, when you use the git-annex assistant to set up a gcrypt remote it only sets it up to use one key. It's left to you to arrange for this key to be on every computer that needs it. Or use command-line stuff to add additional keys later. + +Question 2: You can certianly use the assistant to set up syncing between computers, but the only setup that currently provides 100% end-to-end enctyption of the git repository is using gcrypt. (Special remotes are 100% end-to-end encrypted, but as I've stated several times, do not contain the git repository data.) +Since you seemed to want 100% end to end encryption I suggested using gcrypt. There are simpler setups, like using XMPP, that encrypt everything but not end-to-end, so the XMPP server could snoop on it. + +If you loose your computer, you can get your files back from any other device where you've set up a clone of that repository. A backup drive, another computer , etc. +"""]] diff --git a/doc/forum/2_clients_using_an_encrypted_server_for_syncing_-_possible__63__/comment_7_acd64ce1b08a97ddf730622272e9f611._comment b/doc/forum/2_clients_using_an_encrypted_server_for_syncing_-_possible__63__/comment_7_acd64ce1b08a97ddf730622272e9f611._comment new file mode 100644 index 0000000000..f850253b18 --- /dev/null +++ b/doc/forum/2_clients_using_an_encrypted_server_for_syncing_-_possible__63__/comment_7_acd64ce1b08a97ddf730622272e9f611._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkvN0eFnwvgw2JyTSSHw0QouytcxtPLln8" + nickname="Stein Roald" + subject="comment 7" + date="2014-04-03T21:55:14Z" + content=""" +Thanks again, Joey, for your time and for your kind answers. + +I have tried to set up git-annex with 2 laptops, each with their own gpg-key in order to use a remote server with gcrypt (and those laptops have shared the keys with each other). I regularly use git, but so far I haven't been able to get this setup to work. But before I bother the world with these problems, I would be interested in learning how to do the following: + +*Question 3*: How can I use the git-annex assistant to set up a gcrypt remote (with one key)? It doesn't show up as an option as far as I can see (git-annex version: 4.20130815). + +*Promise*: When I get git-annex to work with gcrypt, I'll make a summary on how I did it (and maybe which mistakes I made so others can avoid them). +"""]] diff --git a/doc/forum/A_tiny_filesystem__63__.mdwn b/doc/forum/A_tiny_filesystem__63__.mdwn new file mode 100644 index 0000000000..44a397e2f6 --- /dev/null +++ b/doc/forum/A_tiny_filesystem__63__.mdwn @@ -0,0 +1,7 @@ +First of all, thanks for the amazing work! I've already tried Owncloud, SparkleShare, Unison, rsync and lsycnd. Finally I may have found the real deal. + +My main problem with git-annex right now is that it is not fast/reliable enough. The main issues being: broken links now and then (I've probably done something wrong) and the slow: "startup scans", "consistency checks", "attempting to fix here" and "syncing with server". (50 Giga, Work-Server-Home, setup via webapp assistant) + +Please, tell me if I'm wrong, but I have the impression that git-annex would get much more robust if it was 100% sure that nobody could mess with its file tree. One possibility would be to add the option (when creating a repo) to make a protected filesystem controlled by git-annex only via FUSE (not something like ShareBox). This could be a tiny filesystem (such as loggedfs) that does nothing but make sure that only git-annex can mount/change files. This would definitely add to speed (reducing checks) and stability. + +I'm I being too naive? Most likely there is something I'm overlooking, like the amount of work this would involve. diff --git a/doc/forum/A_tiny_filesystem__63__/comment_1_993e3f5dbe4bcbb5b7bd9e08ab9554f3._comment b/doc/forum/A_tiny_filesystem__63__/comment_1_993e3f5dbe4bcbb5b7bd9e08ab9554f3._comment new file mode 100644 index 0000000000..aa246b5ee7 --- /dev/null +++ b/doc/forum/A_tiny_filesystem__63__/comment_1_993e3f5dbe4bcbb5b7bd9e08ab9554f3._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.244" + subject="comment 1" + date="2014-04-05T22:34:32Z" + content=""" +git-annex can indeed be sped up by preventing modification of files in the tree. you can do this by running \"git annex indirect\" +"""]] diff --git a/doc/forum/A_tiny_filesystem__63__/comment_2_af57591d42868c8aa1cc1eda43ca8b98._comment b/doc/forum/A_tiny_filesystem__63__/comment_2_af57591d42868c8aa1cc1eda43ca8b98._comment new file mode 100644 index 0000000000..1d4bc4be7a --- /dev/null +++ b/doc/forum/A_tiny_filesystem__63__/comment_2_af57591d42868c8aa1cc1eda43ca8b98._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://id.koumbit.net/anarcat" + ip="2001:1928:1:9::1" + subject="comment 2" + date="2014-04-07T04:25:43Z" + content=""" +what's wrong with [sharebox](https://github.com/chmduquesne/sharebox-fs), actually? +"""]] diff --git a/doc/forum/A_tiny_filesystem__63__/comment_3_3869c0472b50d7cf5e29ac0720f4f20f._comment b/doc/forum/A_tiny_filesystem__63__/comment_3_3869c0472b50d7cf5e29ac0720f4f20f._comment new file mode 100644 index 0000000000..9c1613ca7c --- /dev/null +++ b/doc/forum/A_tiny_filesystem__63__/comment_3_3869c0472b50d7cf5e29ac0720f4f20f._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="augusto" + ip="177.98.104.136" + subject="comment 3" + date="2014-04-08T22:46:18Z" + content=""" +When I saw Sharebox's page on Github I had the impression it was vaporware. It has a section named \"Planned Interface\" and there are no updates for quite a while. + +Is it working? How to install/use it? +"""]] diff --git a/doc/forum/Automatically_dropping_files.mdwn b/doc/forum/Automatically_dropping_files.mdwn new file mode 100644 index 0000000000..dd47d87d68 --- /dev/null +++ b/doc/forum/Automatically_dropping_files.mdwn @@ -0,0 +1,7 @@ +I can make `git-annex` automatically fetch files with the [[/preferred content]] setting and the `--auto` flag, and it works almost exactly like I expect it to work. + +What I am missing is a way to make `git annex drop --auto` drop all files that are not wanted. + +I would like to work with metadata and tags in such a way that I can have clones (with views) that have only exactly those files available which carry a tag (done), and all other files automatically removed from the annex (unless that would be unsafe). + +Does anyone know how to achieve this? diff --git a/doc/forum/Folders_for___34__actions__34___-_now_that_views_have_disrupted_the_file_structure__63__.mdwn b/doc/forum/Folders_for___34__actions__34___-_now_that_views_have_disrupted_the_file_structure__63__.mdwn new file mode 100644 index 0000000000..61a8c7905d --- /dev/null +++ b/doc/forum/Folders_for___34__actions__34___-_now_that_views_have_disrupted_the_file_structure__63__.mdwn @@ -0,0 +1,20 @@ +The _views_ functionality has made the file structure dynamic. + +With this in mind would it be possible/suitable to make drag and drop targets for `git-annex get` and `git-annex drop` commands? +This would make available git annex most interesting feature to assistant users. + +I'm not entirely sure it's a good idea but it avoids file manager scripts and should be discoverable and easy to use. + +I see two possibilities: + +1. A folder in the annex root that contains a mirror of the tree but with only the unavailable files. Unavaliable files would then not be displayed in the live tree. Perhaps the folder can be called `remote`? Files can then be dragged from this tree to the live tree to trigger transfer of files. Any error/info gets displayed in the assistant +2. Flat droptargets in the annex root for `drop` and `get` commands. + + +Number one above makes discovering available files a bit cumbersome as you have to navigate down a parallell tree. It does make the available/remote distinction clearer which may be good for assistant users. + +The mechanism could be extended to include a folder or droptarget for each remote. + +The creation of droptargets/action folders could be triggered by a big visible button in the assistant interface **Manage Files** + +Is it messy? diff --git a/doc/forum/Generating_a_Temp_View_of_Available_Files.mdwn b/doc/forum/Generating_a_Temp_View_of_Available_Files.mdwn new file mode 100644 index 0000000000..bdb8ece692 --- /dev/null +++ b/doc/forum/Generating_a_Temp_View_of_Available_Files.mdwn @@ -0,0 +1 @@ +Is it possible to generate a view of files currently available on the annex? My use case is that I have pretty large repo (couple of TBs) and I have partial checkouts on multiple machines instead of seeing 100s of broken symlinks I would like to just filter filter files that are present on the machine? diff --git a/doc/forum/How_to_know_why_is_git-annex_uploading_a_file_to_a_transfer_repository.mdwn b/doc/forum/How_to_know_why_is_git-annex_uploading_a_file_to_a_transfer_repository.mdwn new file mode 100644 index 0000000000..48ad2d1d83 --- /dev/null +++ b/doc/forum/How_to_know_why_is_git-annex_uploading_a_file_to_a_transfer_repository.mdwn @@ -0,0 +1,3 @@ +I have git-annex set up with three clients and a transfer repository and everything was working fine, but a couple of days ago I noticed that git-annex was starting to upload to the transfer repository files that where already present on the three clients, and it hasn't stopped since. It's uploading all my files and I don't really know why. + +Is there a way to know why does git-annex think it needs to upload this files? diff --git a/doc/forum/How_to_know_why_is_git-annex_uploading_a_file_to_a_transfer_repository/comment_1_17db96492e6bc0e243fc7cb62565c4c4._comment b/doc/forum/How_to_know_why_is_git-annex_uploading_a_file_to_a_transfer_repository/comment_1_17db96492e6bc0e243fc7cb62565c4c4._comment new file mode 100644 index 0000000000..6cf5541e8f --- /dev/null +++ b/doc/forum/How_to_know_why_is_git-annex_uploading_a_file_to_a_transfer_repository/comment_1_17db96492e6bc0e243fc7cb62565c4c4._comment @@ -0,0 +1,17 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.41" + subject="comment 1" + date="2014-03-26T17:46:30Z" + content=""" +A few likely reasons: + +* If a 4th client repository had popped up. +* If you have configured a high number of copies, it might only be able to be met by keeping files on the transfer repository. +* Similarly, if a repository that used to have the files has been marked as dead or deleted, more copies might be needed to make up for that. +* For completeness, if the transfer repository accidentially had its type changed to some other kind of repository, like a full backup. + +You can enable debugging (start with --debug or go into the webapp's preferences) and it might say a little more, but the debugging info is not very good. + +The best thing is probably to look at one single file, use `git annex whereis` on the file to see what repositories contain it, and then think about how that interacts with the [[preferred_content_expression_of_the_transfer_repository|preferred_content/standard_groups]]. +"""]] diff --git a/doc/forum/How_to_know_why_is_git-annex_uploading_a_file_to_a_transfer_repository/comment_2_e772ea0383ac690cbcbcf125258986cf._comment b/doc/forum/How_to_know_why_is_git-annex_uploading_a_file_to_a_transfer_repository/comment_2_e772ea0383ac690cbcbcf125258986cf._comment new file mode 100644 index 0000000000..27f158ea1e --- /dev/null +++ b/doc/forum/How_to_know_why_is_git-annex_uploading_a_file_to_a_transfer_repository/comment_2_e772ea0383ac690cbcbcf125258986cf._comment @@ -0,0 +1,16 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawk9nck8WX8-ADF3Fdh5vFo4Qrw1I_bJcR8" + nickname="Jon Ander" + subject="comment 2" + date="2014-04-01T08:01:00Z" + content=""" +I thought I had already checked all does possibilities, the repositories where in the correct group and no new repositories had been added. *git annex info* didn't show anything weird and nor did *git annex whereis*. I finally found out *git annex vicfg* and I found two new repositories with no name in the repository groups. It looked something like this: + + # (for ) + group repository-hash = client + # (for ) + group repository-hash = client + + +No idea of how they got there, but setting both of them to unwanted solved the issue. +"""]] diff --git a/doc/forum/Link_to_local_remote_instead_of_broken_link_when_possible__63__.mdwn b/doc/forum/Link_to_local_remote_instead_of_broken_link_when_possible__63__.mdwn new file mode 100644 index 0000000000..dfe8afe2c9 --- /dev/null +++ b/doc/forum/Link_to_local_remote_instead_of_broken_link_when_possible__63__.mdwn @@ -0,0 +1,4 @@ +Hi, + +Suppose I have an annexed file whose content is stored on an extenal hard drive. +When the hard drive is mounted, is it possible to have immediately access to this file without transfering it, by modifying the symlink to point to the file content on the hard drive instead of having a broken link? diff --git a/doc/forum/Link_to_local_remote_instead_of_broken_link_when_possible__63__/comment_1_ce0464d5fca6ada9f1477831fd47ce09._comment b/doc/forum/Link_to_local_remote_instead_of_broken_link_when_possible__63__/comment_1_ce0464d5fca6ada9f1477831fd47ce09._comment new file mode 100644 index 0000000000..ee6ec690e9 --- /dev/null +++ b/doc/forum/Link_to_local_remote_instead_of_broken_link_when_possible__63__/comment_1_ce0464d5fca6ada9f1477831fd47ce09._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.244" + subject="comment 1" + date="2014-04-02T18:25:16Z" + content=""" +See [[todo/union_mounting]] +"""]] diff --git a/doc/forum/Tracking_a_directory_with_some_hg_and_git_repositories/comment_4_c889050d3079edefc4633451bd5baff8._comment b/doc/forum/Tracking_a_directory_with_some_hg_and_git_repositories/comment_4_c889050d3079edefc4633451bd5baff8._comment new file mode 100644 index 0000000000..55f9f2534e --- /dev/null +++ b/doc/forum/Tracking_a_directory_with_some_hg_and_git_repositories/comment_4_c889050d3079edefc4633451bd5baff8._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnvVfFLW4CTKs7UjdiLIsOn_cxj1Jnh64I" + nickname="Charl" + subject="use case: changing workstations mid-way through development session" + date="2014-03-23T21:22:15Z" + content=""" +An important use case for me with automatic synchronization, is being able to change computers mid-way through a development session. I used to do this with dropbox for years: I'd work in a git checkout, then take another laptop to go work elsewhere, and just continue in the \"same\" synchronized git repo. Having to remember to commit and push a long list of repos before changing workstations is error-prone. Also, I prefer to commit when a discrete atom of work has been completed, and to push when a topic branch is good and ready to be merged (for example), not every time that I feel like changing workstations. :) Dropbox never dropped a stitch in all this time. As long as all laptops are in a 1) connected and 2) synced up state, switching is possible. + +The limitation of not being able to sync the .git directories in git checkouts means that this use case can't currently be supported by git-annex (assistant). Is a work-around possible, or is this something that can't ever be supported due to the limitations of git itself? + +"""]] diff --git a/doc/forum/Using_git-annex_as_a_library/comment_3_ac52304a096ebc66967352efaffb060a._comment b/doc/forum/Using_git-annex_as_a_library/comment_3_ac52304a096ebc66967352efaffb060a._comment new file mode 100644 index 0000000000..cda6e0799a --- /dev/null +++ b/doc/forum/Using_git-annex_as_a_library/comment_3_ac52304a096ebc66967352efaffb060a._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="Alexcei" + ip="92.255.239.77" + subject="comment 3" + date="2014-03-25T05:43:36Z" + content=""" +With version 5.20140127 first approach became impossible. Why did you decide to remove json supported by the majority of command? +"""]] diff --git a/doc/forum/Using_git-annex_as_a_library/comment_4_d502fea60bf3a82f8a50f72a90a80c25._comment b/doc/forum/Using_git-annex_as_a_library/comment_4_d502fea60bf3a82f8a50f72a90a80c25._comment new file mode 100644 index 0000000000..642fda2fef --- /dev/null +++ b/doc/forum/Using_git-annex_as_a_library/comment_4_d502fea60bf3a82f8a50f72a90a80c25._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.41" + subject="comment 4" + date="2014-03-26T18:31:30Z" + content=""" +I didn't. I removed the --json options from commands that didn't necessarily output valid json when used with it. There are numerous commands that support --json (find, whereis, info, status, metadata, examinekey), and I'm open to adding it to other commands -- but it's probably not feasible to make commands like `get` output json, since their output includes progress info printed by rsync etc. +"""]] diff --git a/doc/forum/Walkthrough_for_direct_mode__63__.mdwn b/doc/forum/Walkthrough_for_direct_mode__63__.mdwn new file mode 100644 index 0000000000..b3fae29447 --- /dev/null +++ b/doc/forum/Walkthrough_for_direct_mode__63__.mdwn @@ -0,0 +1 @@ +Hello Joey, I would be very much interested in a walkthrough for direct mode, as detailed as the one currently published. I see the comments in the current walkthrough on some differences to direct mode, but to me it is not obvious what best practices for git-annex use would be in direct mode, with and without the assistant. For a mix of Linux, OS X and Windows installations in the homes, it may also be interesting to see how to best set up the individual machines. Many thanks - diff --git a/doc/forum/dot_git_slash_annex_slash_tmp/comment_14_92b1e8956513dbf52da31cec3f58e2c5._comment b/doc/forum/dot_git_slash_annex_slash_tmp/comment_14_92b1e8956513dbf52da31cec3f58e2c5._comment new file mode 100644 index 0000000000..b84e663ccc --- /dev/null +++ b/doc/forum/dot_git_slash_annex_slash_tmp/comment_14_92b1e8956513dbf52da31cec3f58e2c5._comment @@ -0,0 +1,104 @@ +[[!comment format=mdwn + username="http://alan.petitepomme.net/" + nickname="Alan Schmitt" + subject="comment 14" + date="2014-04-04T11:07:31Z" + content=""" +I just discovered there were 30GB in this tmp directory. Here are the file names. It seems that the file names are partial (they are missing some characters: it seems most file names are missing the last 16 characters and the file extension). As I'm in dire need of disk space, I'm going to delete this files now. + + schmitta@top-wifi ~/D/a/.g/a/tmp (GIT_DIR!)> pwd + /Users/schmitta/Documents/annex/.git/annex/tmp + schmitta@top-wifi ~/D/a/.g/a/tmp (GIT_DIR!)> ls -al + total 73802184 + drwxr-xr-x 91 schmitta staff 3094 16 mar 11:15 . + drwxr-xr-x 34 schmitta staff 1156 4 avr 12:58 .. + -r--r--r--@ 6 schmitta staff 132882914 8 déc 20:17 12426. + -r--r--r--@ 6 schmitta staff 113471066 8 déc 20:15 12426.2- + -r--r--r--@ 6 schmitta staff 148673586 8 déc 20:24 12427. + -r--r--r--@ 6 schmitta staff 96197733 8 déc 20:09 12427.2- + -r--r--r--@ 6 schmitta staff 132882914 8 déc 20:17 12489. + -r--r--r--@ 6 schmitta staff 113471066 8 déc 20:15 12489.2- + -r--r--r--@ 6 schmitta staff 148673586 8 déc 20:24 12490. + -r--r--r--@ 6 schmitta staff 96197733 8 déc 20:09 12490.2- + -r--r--r--@ 6 schmitta staff 132882914 8 déc 20:17 12498. + -r--r--r--@ 6 schmitta staff 113471066 8 déc 20:15 12498.2- + -r--r--r--@ 6 schmitta staff 148673586 8 déc 20:24 12499. + -r--r--r--@ 6 schmitta staff 96197733 8 déc 20:09 12499.2- + -r--r--r--@ 6 schmitta staff 132882914 8 déc 20:17 12504. + -r--r--r--@ 6 schmitta staff 113471066 8 déc 20:15 12504.2- + -r--r--r--@ 6 schmitta staff 148673586 8 déc 20:24 12505. + -r--r--r--@ 6 schmitta staff 96197733 8 déc 20:09 12505.2- + -r--r--r--@ 6 schmitta staff 132882914 8 déc 20:17 12562. + -r--r--r--@ 6 schmitta staff 113471066 8 déc 20:15 12562.2- + -r--r--r--@ 6 schmitta staff 148673586 8 déc 20:24 12563. + -r--r--r--@ 6 schmitta staff 96197733 8 déc 20:09 12563.2- + -r--r--r-- 2 schmitta staff 1237391994 21 déc 19:27 BTSM With Flowerchild Li562 + -r--r--r-- 2 schmitta staff 1097868668 18 déc 13:24 BTSM with Flowerchild 562 + -r--r--r-- 3 schmitta staff 181962494 1 déc 05:19 Cosmos - A Personal Voyage - Episod422 + -r--r--r-- 3 schmitta staff 199341564 17 déc 14:28 Cosmos - A Personal Voyage - Episod423 + -r--r--r-- 3 schmitta staff 196677905 9 jan 08:36 Cosmos - A Personal Voyage - Episod424 + -r--r--r-- 3 schmitta staff 196671683 26 déc 19:36 Cosmos - A Personal Voyage - Episod425 + -r--r--r-- 3 schmitta staff 199297657 19 jan 14:33 Cosmos - A Personal Voyage - Episod426 + -r--r--r-- 3 schmitta staff 194250261 18 jan 17:10 Cosmos - A Personal Voyage - Episod427 + -r--r--r-- 3 schmitta staff 216726281 16 jan 16:26 Cosmos - A Personal Voyage - Episod428 + -r--r--r-- 3 schmitta staff 204634401 16 jan 12:17 Cosmos - A Personal Voyage - Episod429 + -r--r--r-- 3 schmitta staff 179412519 11 jan 11:29 Cosmos - A Personal Voyage - Episod430 + -r--r--r-- 3 schmitta staff 181962494 1 déc 05:19 Cosmos - A Personal Voyage - Episod572 + -r--r--r-- 3 schmitta staff 199341564 17 déc 14:28 Cosmos - A Personal Voyage - Episod573 + -r--r--r-- 3 schmitta staff 196677905 9 jan 08:36 Cosmos - A Personal Voyage - Episod574 + -r--r--r-- 3 schmitta staff 196671683 26 déc 19:36 Cosmos - A Personal Voyage - Episod575 + -r--r--r-- 3 schmitta staff 199297657 19 jan 14:33 Cosmos - A Personal Voyage - Episod576 + -r--r--r-- 3 schmitta staff 194250261 18 jan 17:10 Cosmos - A Personal Voyage - Episod577 + -r--r--r-- 3 schmitta staff 216726281 16 jan 16:26 Cosmos - A Personal Voyage - Episod578 + -r--r--r-- 3 schmitta staff 204634401 16 jan 12:17 Cosmos - A Personal Voyage - Episod579 + -r--r--r-- 3 schmitta staff 179412519 11 jan 11:29 Cosmos - A Personal Voyage - Episod580 + -r--r--r-- 3 schmitta staff 237284500 15 mai 2012 Cosmos - A Personal Voyage - Episode422 + -r--r--r-- 3 schmitta staff 207386296 28 jan 18:39 Cosmos - A Personal Voyage - Episode423 + -r--r--r-- 3 schmitta staff 194659898 28 jan 20:35 Cosmos - A Personal Voyage - Episode424 + -r--r--r-- 3 schmitta staff 221944244 11 jan 07:18 Cosmos - A Personal Voyage - Episode425 + -r--r--r-- 3 schmitta staff 237284500 15 mai 2012 Cosmos - A Personal Voyage - Episode572 + -r--r--r-- 3 schmitta staff 207386296 28 jan 18:39 Cosmos - A Personal Voyage - Episode573 + -r--r--r-- 3 schmitta staff 194659898 28 jan 20:35 Cosmos - A Personal Voyage - Episode574 + -r--r--r-- 3 schmitta staff 221944244 11 jan 07:18 Cosmos - A Personal Voyage - Episode575 + -r--r--r-- 1 schmitta staff 166417358 25 nov 08:47 Icy Plays - Kerbal Space Program - Better Than Starting Mann456 + -r--r--r-- 2 schmitta staff 1110410229 28 déc 00:40 Kerbal Space Program - BTSM With Flowerchild Li562 + -r--r--r-- 1 schmitta staff 898936971 26 déc 06:22 Let's Play Minecraft Better Than Wolves Ep 10 _ HARDCORE _ Ooooh le petit mat572 + -r--r--r-- 1 schmitta staff 816306596 27 déc 05:08 Let's Play Minecraft Better Than Wolves Ep 11 _ HARDCORE _ Un peu de cannabis pour le moral 572 + -r--r--r-- 1 schmitta staff 897143936 27 déc 10:42 Let's Play Minecraft Better Than Wolves Ep 12 _ HARDCORE _ Chaud l'enf572 + -r--r--r-- 1 schmitta staff 922364739 29 déc 08:30 Let's Play Minecraft Better Than Wolves Ep 13 _ HARDCORE _ Walking dea572 + -r--r--r-- 1 schmitta staff 1321555505 1 jan 02:15 Let's Play Minecraft Better Than Wolves Ep 14 l HARDCORE l Couvre572 + -r--r--r-- 1 schmitta staff 889592223 5 jan 02:07 Let's Play Minecraft Better Than Wolves Ep 15 l HARDCORE l Pa572 + -r--r--r-- 1 schmitta staff 153571799 6 jan 03:56 Let's Play Minecraft Better Than Wolves Ep 16 l HARDCORE l Point de s572 + -r--r--r-- 1 schmitta staff 1036932250 9 jan 07:36 Let's Play Minecraft Better Than Wolves Ep 17 l HARDCORE l Satané meuh572 + -r--r--r-- 1 schmitta staff 1289798767 11 jan 22:08 Let's Play Minecraft Better Than Wolves Ep 18 l HARDCORE l Un Moulin572 + -r--r--r-- 1 schmitta staff 1582120875 19 jan 15:39 Let's Play Minecraft Better Than Wolves Ep 19 l HARDCORE l Explosion de ca572 + -r--r--r-- 1 schmitta staff 728469432 13 fév 07:02 Let's Play Minecraft Better Than Wolves Ep 2 _ HARDCORE _ Préparation pour l'explorat422 + -r--r--r-- 1 schmitta staff 911653518 22 jan 13:35 Let's Play Minecraft Better Than Wolves Ep 20 l HARDCORE l Minesha572 + -r--r--r-- 1 schmitta staff 1377428597 28 jan 08:43 Let's Play Minecraft Better Than Wolves Ep 21 l HARDCORE l Terreur en sous-sol o_O !572 + -r--r--r-- 1 schmitta staff 1376224927 4 fév 03:24 Let's Play Minecraft Better Than Wolves Ep 22 l HARDCORE l Machinerie infern572 + -r--r--r-- 1 schmitta staff 1102293665 13 fév 03:56 Let's Play Minecraft Better Than Wolves Ep 23 l HARDCORE l Piston chenil572 + -r--r--r-- 1 schmitta staff 1835677068 19 fév 09:14 Let's Play Minecraft Better Than Wolves Ep 24 l HARDCORE l Piston chenille et o_Oce572 + -r--r--r-- 1 schmitta staff 753740284 30 déc 19:31 Let's Play Minecraft Better Than Wolves Ep 3 _ HARDCORE _ First pioche en fer422 + -r--r--r-- 1 schmitta staff 1019022279 30 déc 18:38 Let's Play Minecraft Better Than Wolves Ep 5 _ HARDCORE _ Fonderie super desi572 + -r--r--r-- 1 schmitta staff 788714805 30 déc 17:47 Let's Play Minecraft Better Than Wolves Ep 6 _ HARDCORE _ Minage de la mor572 + -r--r--r-- 1 schmitta staff 778987710 23 déc 19:56 Let's Play Minecraft Better Than Wolves Ep 7 _ HARDCORE _ Diamant572 + -r--r--r-- 1 schmitta staff 644564981 23 déc 23:06 Let's Play Minecraft Better Than Wolves Ep 8 _ HARDCORE _ Et le poulet ma572 + -r--r--r-- 1 schmitta staff 871173289 24 déc 10:44 Let's Play Minecraft Better Than Wolves Ep 9 _ HARDCORE _ Araignée verte de la jun572 + -r--------@ 4 schmitta staff 149520850 14 aoû 2010 OPLSS10-Mc422 + -r--------@ 4 schmitta staff 95020824 14 aoû 2010 OPLSS10-Mc423 + -r--------@ 4 schmitta staff 98980596 1 sep 2010 OPLSS10-Mc424 + -r--------@ 4 schmitta staff 207525348 1 sep 2010 OPLSS10-Mc425 + -r--------@ 4 schmitta staff 149520850 14 aoû 2010 OPLSS10-Mc534 + -r--------@ 4 schmitta staff 95020824 14 aoû 2010 OPLSS10-Mc535 + -r--------@ 4 schmitta staff 98980596 1 sep 2010 OPLSS10-Mc536 + -r--------@ 4 schmitta staff 207525348 1 sep 2010 OPLSS10-Mc537 + -r--------@ 4 schmitta staff 149520850 14 aoû 2010 OPLSS10-Mc572 + -r--------@ 4 schmitta staff 95020824 14 aoû 2010 OPLSS10-Mc573 + -r--------@ 4 schmitta staff 98980596 1 sep 2010 OPLSS10-Mc574 + -r--------@ 4 schmitta staff 207525348 1 sep 2010 OPLSS10-Mc575 + -r--r--r--@ 2 schmitta staff 150781568 10 mar 13:34 XD300-23_68HighlightsAResearchCntAugHuma469 + -r--r--r--@ 2 schmitta staff 145745487 10 mar 13:36 XD300-24_68HighlightsAResearchCntAugHuma469 + -r--r--r--@ 2 schmitta staff 142414085 10 mar 13:36 XD300-25_68HighlightsAResearchCntAugHuma469 + -r--------@ 2 schmitta staff 548973365 7 jan 20:21 laumond-20120119449.mp4 + -r--r--r--@ 2 schmitta staff 1820482781 8 mar 18:15 salt-020131469 +"""]] diff --git a/doc/forum/faking_location_information.mdwn b/doc/forum/faking_location_information.mdwn new file mode 100644 index 0000000000..7c84e12e39 --- /dev/null +++ b/doc/forum/faking_location_information.mdwn @@ -0,0 +1,19 @@ +Hi + +I am using git-annex even if people I exchange data with (currently) don‘t use it for there data. My idea behind this is that I would like to know from where I got a file, whom I gave a file and who does (probably) still have a copy of the file. To do this you need to trick git-annex location tracking feature a bit. I successfully managed to achieve this in a simple data exchange which only consisted of me coping over files to one of my git-annex repos. I did the following to make git-annex believe that the files are in two repos without the need to *copy* them around the repos. + +This is what I did in this simple case: + +1. mounted the drive from someone +2. made a clone of my git-annex repo on the filesystem which should hold the copy of the data +3. initialized the cloned repo with `git annex init "Drive from person X"` +4. imported the files to the cloned repo with `git annex import --duplicate $path_to_files_from_person_x` +5. `git annex sync` in the cloned repo +6. `git annex sync` in main repo +7. `git annex move . --to origin` in the cloned repo + +The impotent part (and the limit) here was that you can not sync these two repos after you moved files to the main repo. The problem is that there will be situations where I will have to sync them also after moving files around (for example if I want to store new files in multiple repos (and not just one main repo), or if I also want to copy files over to drives from someone). + +Note: I have also worked out a solution to allow someone to choose which files he/she would like to get as described [on superuser.com](http://superuser.com/a/717689). + +Are there better ways to fake location information then the thing I came up with (except making multiple repos for one person/drive)? Can multiple remotes be merged to one remote? diff --git a/doc/forum/git_annex_assistant_-_Changing_repository_information.mdwn b/doc/forum/git_annex_assistant_-_Changing_repository_information.mdwn new file mode 100644 index 0000000000..c4ef39a8f9 --- /dev/null +++ b/doc/forum/git_annex_assistant_-_Changing_repository_information.mdwn @@ -0,0 +1 @@ +Here's one thing I don't fully understand yet. If I add a remote repository, like an archive repository on Box—or if I want to change a transfer repository to an archive repository—do I need to add it or change it separately on each of my computers? Or just one? diff --git a/doc/forum/ignore_changes_made_by_a_remote.mdwn b/doc/forum/ignore_changes_made_by_a_remote.mdwn new file mode 100644 index 0000000000..3659774b4c --- /dev/null +++ b/doc/forum/ignore_changes_made_by_a_remote.mdwn @@ -0,0 +1,8 @@ +Hi, + +I have two repo one in direct (on windows) and one in indirect mode. From time to time the files in the direct repo are replaced by empty files however running git annex fsck always solves it. +The problem is that today I did run git annex sync before running git annex fsck and git annex has then created two -variants for each of my files one empty and one with the content. +I guess the easier for me is to just scrap that repo and make a new one however how do I prevent the changes to propagate now? I guess that if I now run git annex sync on my other repo all those small files are going to have linked created for them there as well. + +I hope this is clear, +Thanks in advance. diff --git a/doc/forum/ignore_changes_made_by_a_remote/comment_1_825676069d2e1554499b76fd8c306c30._comment b/doc/forum/ignore_changes_made_by_a_remote/comment_1_825676069d2e1554499b76fd8c306c30._comment new file mode 100644 index 0000000000..8abc059f60 --- /dev/null +++ b/doc/forum/ignore_changes_made_by_a_remote/comment_1_825676069d2e1554499b76fd8c306c30._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.244" + subject="comment 1" + date="2014-04-02T20:02:19Z" + content=""" +I don't see any need to scrap the repository. Since you have an indirect mode repsitory, you can use `git log` in there to find commits you don't like, and run `git revert` to revert them. So if a bad commit comes down from windows, you can just undo it. That's why we use git, yes? + +I'm much more curious about the circumstances that cause empty files to end up in the direct mode repository. +"""]] diff --git a/doc/forum/ignore_changes_made_by_a_remote/comment_2_dff49b72f7e072fddaf68584beb97f3c._comment b/doc/forum/ignore_changes_made_by_a_remote/comment_2_dff49b72f7e072fddaf68584beb97f3c._comment new file mode 100644 index 0000000000..394a609b46 --- /dev/null +++ b/doc/forum/ignore_changes_made_by_a_remote/comment_2_dff49b72f7e072fddaf68584beb97f3c._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="bvaa" + ip="86.82.68.238" + subject="comment 2" + date="2014-04-03T19:20:31Z" + content=""" +Ok it makes indeed sense. +Regarding the empty files I am going to try to find out where that happens and if I can reproduce. +Thanks. +"""]] diff --git a/doc/forum/manual_update_of_.git__47__annex__47__objects/comment_2_a7bbf304b26650a786e358bdc01e3069._comment b/doc/forum/manual_update_of_.git__47__annex__47__objects/comment_2_a7bbf304b26650a786e358bdc01e3069._comment new file mode 100644 index 0000000000..5468ed3d06 --- /dev/null +++ b/doc/forum/manual_update_of_.git__47__annex__47__objects/comment_2_a7bbf304b26650a786e358bdc01e3069._comment @@ -0,0 +1,33 @@ +[[!comment format=mdwn + username="rasmus" + ip="109.201.154.177" + subject="But how to clean this folder?" + date="2014-03-20T21:55:26Z" + content=""" +Joey, + +I have sometimes experienced that there is way too much content in the `.git/annex/objects` folder. For instance, my terminal emulator recently crashed during a sync which seemed to create a lot of folders. + +In the annex repo where this happened I now got way too many folders (annex sometimes complain about no. of inodes or something like that) and I don't know how to clean it correctly. + +Here's a \"screenshot\": + + [doc.annex] $ ls -a + . .. documents .git .gitignore + [doc.annex] $ find . -type d | wc -l + 38568 + [doc.annex] $ git annex fsck > /dev/null 2>&1 + [doc.annex] $ find . -type d | wc -l + 38568 + [doc.annex] $ git annex repair > /dev/null 2>&1 + [doc.annex] $ find . -type d | wc -l + 38568 + [doc.annex] $ find documents -type d | wc -l + 1513 + [doc.annex] $ find .git/annex/objects -type d | wc -l + 36712 + +This is a `direct`-mode repo. With `.git/objectcts` I can use `git gc`. How can I tell annex to tidy up? I have tried `fsck`, `repair` and `forget`. + +Any hints on how to deal with this? Other than manually clean up by deleting `.git/annex/objects` and rerunning `fsck`? +"""]] diff --git a/doc/forum/manual_update_of_.git__47__annex__47__objects/comment_3_a855096b683c4c4f84e72c797e065d59._comment b/doc/forum/manual_update_of_.git__47__annex__47__objects/comment_3_a855096b683c4c4f84e72c797e065d59._comment new file mode 100644 index 0000000000..2271e04ffe --- /dev/null +++ b/doc/forum/manual_update_of_.git__47__annex__47__objects/comment_3_a855096b683c4c4f84e72c797e065d59._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.41" + subject="comment 3" + date="2014-03-26T19:09:07Z" + content=""" +1. This followup question seems to have nothing to do with the original question. (The aswer to the original question was `git annex fsck --fast`.) +2. I find it hard to believe that a crashing terminal emulator will create a lot of folders. +3. You show 36k subdirectories in .git/annex/objects. If I make a *tiny* 100 mb ext2 filesystem, it has 26k inodes. A 200 mb filesystem has 50k. So we're talking about a number of directories that is only large when using hardware from 1996. + +I'm not convinced yet that anything is wrong, or that there's anything you can do to improve matters. In any case, see [[todo/wishlist:_pack_metadata_in_direct_mode]]. +"""]] diff --git a/doc/forum/rsync.net:_Too_many_authentication_failures_for___42____42____42____42____42__.mdwn b/doc/forum/rsync.net:_Too_many_authentication_failures_for___42____42____42____42____42__.mdwn new file mode 100644 index 0000000000..2a22d6ee78 --- /dev/null +++ b/doc/forum/rsync.net:_Too_many_authentication_failures_for___42____42____42____42____42__.mdwn @@ -0,0 +1,13 @@ +When trying to setup an rsync.net repo I always get the following error: + +Permission denied, please try again. +Permission denied, please try again. +Received disconnect from 114.xxx.xxx.xxx: 2: Too many authentication failures for 2***** + +I can ssh into the account without any problems and couldn't find anything, which would have helped me any further. +Any ideas? Is the problem sitting in front of the computer? Is it a bug? + +Thanks. +David + +This is happening on Mavericks (10.9) diff --git a/doc/forum/rsync.net:_Too_many_authentication_failures_for___42____42____42____42____42__/comment_1_7754e2cfb72b034effe8642c1b3e593e._comment b/doc/forum/rsync.net:_Too_many_authentication_failures_for___42____42____42____42____42__/comment_1_7754e2cfb72b034effe8642c1b3e593e._comment new file mode 100644 index 0000000000..d29f6482c3 --- /dev/null +++ b/doc/forum/rsync.net:_Too_many_authentication_failures_for___42____42____42____42____42__/comment_1_7754e2cfb72b034effe8642c1b3e593e._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawn_3tllXjSmtgm__aGr9Z4gVNFgJgGyJ30" + nickname="David Alan" + subject="comment 1" + date="2014-04-02T15:58:57Z" + content=""" +This problem also exists, when connecting to other ssh remote servers. +The error msg would be: + + Failed to ssh to the server. Transcript: Permission denied, please try again. Received disconnect from 80.xxx.xxx.xxx: 2: Too many authentication failures for ssh-xxxxxx-git-annex-assist +"""]] diff --git a/doc/forum/rsync.net:_Too_many_authentication_failures_for___42____42____42____42____42__/comment_2_04e1da4352ef9f9be90253ea726e5f24._comment b/doc/forum/rsync.net:_Too_many_authentication_failures_for___42____42____42____42____42__/comment_2_04e1da4352ef9f9be90253ea726e5f24._comment new file mode 100644 index 0000000000..3181c4fe01 --- /dev/null +++ b/doc/forum/rsync.net:_Too_many_authentication_failures_for___42____42____42____42____42__/comment_2_04e1da4352ef9f9be90253ea726e5f24._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.244" + subject="comment 2" + date="2014-04-02T19:41:29Z" + content=""" +What version of git-annex? + +Do you have ssh-askpass installed? + +You might try running git webapp from a terminal, in case ssh is unable to prompt for the password in a window using ssh-askpass. +"""]] diff --git a/doc/forum/rsync.net:_Too_many_authentication_failures_for___42____42____42____42____42__/comment_3_84aceb9a9d3e5bd14c044861f47e3b9d._comment b/doc/forum/rsync.net:_Too_many_authentication_failures_for___42____42____42____42____42__/comment_3_84aceb9a9d3e5bd14c044861f47e3b9d._comment new file mode 100644 index 0000000000..ef70eea48a --- /dev/null +++ b/doc/forum/rsync.net:_Too_many_authentication_failures_for___42____42____42____42____42__/comment_3_84aceb9a9d3e5bd14c044861f47e3b9d._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawn_3tllXjSmtgm__aGr9Z4gVNFgJgGyJ30" + nickname="David Alan" + subject="comment 3" + date="2014-04-03T00:31:14Z" + content=""" +I'm running Version: 5.20140318-gdcf93d0. Do I have to install a ssh-askpass manually? I only found one thread referring to ssh-askpass, but didn't really know what to do with that information. So, no I don't have it installed as far as I know... _I_ never did anyway... + +Do I need it? Did I miss something in the docs? +"""]] diff --git a/doc/forum/telehash_syncing.mdwn b/doc/forum/telehash_syncing.mdwn new file mode 100644 index 0000000000..3a5266506e --- /dev/null +++ b/doc/forum/telehash_syncing.mdwn @@ -0,0 +1,10 @@ +Hi + +I have read some info about telehash. It looks verry promising. I was wondering though how syncing will work. For example. I have 2 computers. Normal PC and a laptop. Mostly only one is on at a time. + +* Sync messages will be sent over telehash protocoll ? +* What if I push some changes (they will be synced to a shared repository) and laptop is not online. How will git-annex know what to sync from a shared repository ? +* Do you plan to send files/commits directly to online clients ? If 2 friends are online at the same time. +* What will happen with data on a shared repository if all clients have synced content ? Will it be deleted since it is not longer needed ? + +I was thinking of a model where you sync directly (if possible), and just drop shared content to repo for offline users. Whan everyone have pulled content it may be removed from shared repo. diff --git a/doc/forum/unrelated_repositories_sync.mdwn b/doc/forum/unrelated_repositories_sync.mdwn new file mode 100644 index 0000000000..030fb380d7 --- /dev/null +++ b/doc/forum/unrelated_repositories_sync.mdwn @@ -0,0 +1,15 @@ +I have no idea how to search for this here, so I'll just go the "lazy web" approach and just ask. + +Say I have two "conference" repos. One is the famous [conference procedings](https://github.com/RichiH/conference_proceedings) repo, and another one is a totally unrelated repo of local conferences that are not of world-wide significance. Let's call this second repo `presentations`. + +I would like to have my videos of both repos in a single repo. + +Can I add the `conference procedings` repo as a git remote to the `presentations` repo and have it do the right thing? + +In fact, I'm not even sure what the right thing would be here, I guess that's the first thing I would like to clear up. But I would like to do things like what the new [[metadata]] system does. For example, I would have only the "Debian" directory from `conference procedings` in my `presentations` repo. + +How would that work? Would I need to do some [subtree merging](http://git-scm.com/book/ch6-7.html) magic? or `git subtree`? or submodules? or should i just use myrepos and pretend I never brought up this idea? + +thanks! -- [[anarcat]] + +related: [[tips/migrating_two_seperate_disconnected_directories_to_git_annex/]] - but that creates a merged repo... diff --git a/doc/forum/unrelated_repositories_sync/comment_1_c899b7b05a96d14e25c2efadff3b4e52._comment b/doc/forum/unrelated_repositories_sync/comment_1_c899b7b05a96d14e25c2efadff3b4e52._comment new file mode 100644 index 0000000000..7df8a0eb93 --- /dev/null +++ b/doc/forum/unrelated_repositories_sync/comment_1_c899b7b05a96d14e25c2efadff3b4e52._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.244" + subject="comment 1" + date="2014-04-02T19:51:06Z" + content=""" +It might help if you think about these two different repositories as branches. You have 2 branches with different files in them, and you want to produce a third branch with some mix of the two. + +I think git is perfectly capable of doing that. Where it gets hairy is dealing with merges when either of the 2 repositories change going forward. The same as if you've forked and modified source code, you will need to do *something* to resolve merges. +"""]] diff --git a/doc/forum/view_from_numeric_values.mdwn b/doc/forum/view_from_numeric_values.mdwn new file mode 100644 index 0000000000..e1fc48a0f2 --- /dev/null +++ b/doc/forum/view_from_numeric_values.mdwn @@ -0,0 +1,9 @@ +Hi Joey, + +it would be nice when views could take numeric comparisons as filters. + + git annex metadata -s length=273.0 john_cage_4_33.mp3 + + git annex view length<=300 + +... here is the catch, < and > don't work well in shell, this needs some other Syntax. I think the underlying machinery (using numeric comparisons instead globs) should be quite trivial. Any Ideas about a Syntax? diff --git a/doc/forum/view_from_numeric_values/comment_1_f3c440f3f0104002a0020ba96ddcf87b._comment b/doc/forum/view_from_numeric_values/comment_1_f3c440f3f0104002a0020ba96ddcf87b._comment new file mode 100644 index 0000000000..4df3034a2d --- /dev/null +++ b/doc/forum/view_from_numeric_values/comment_1_f3c440f3f0104002a0020ba96ddcf87b._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="cehteh" + ip="217.8.62.137" + subject="consistent syntax" + date="2014-03-25T15:25:43Z" + content=""" +Further thinking led to the idea to use the test(1) like syntax to filter matches. + + git annex view length=.* -lt 300 -gt 30 -o -eq 273 bpm=.* -eq 0 + +"""]] diff --git a/doc/forum/view_from_numeric_values/comment_2_2414e1a8cfd154c339d8fc0e4a630ae9._comment b/doc/forum/view_from_numeric_values/comment_2_2414e1a8cfd154c339d8fc0e4a630ae9._comment new file mode 100644 index 0000000000..ff4fcc551f --- /dev/null +++ b/doc/forum/view_from_numeric_values/comment_2_2414e1a8cfd154c339d8fc0e4a630ae9._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.41" + subject="comment 2" + date="2014-03-26T17:53:28Z" + content=""" +I'm a little bit worried about the potential to reinvent SQL, badly. ;) + +As shown in your example, once you have ranges, it's natural to also want disjunctions, and then probably parenthesized expressions, and suddenly things are very complicated. + +Also, it's important that views remain reversable, so that committing a moved file in a view can unambiguously calculate the new metadata for it. I think that quickly becomes hard when adding these complications. +"""]] diff --git a/doc/forum/view_from_numeric_values/comment_3_7879a11cc9767cdaac14f9993182dc25._comment b/doc/forum/view_from_numeric_values/comment_3_7879a11cc9767cdaac14f9993182dc25._comment new file mode 100644 index 0000000000..da6dded172 --- /dev/null +++ b/doc/forum/view_from_numeric_values/comment_3_7879a11cc9767cdaac14f9993182dc25._comment @@ -0,0 +1,13 @@ +[[!comment format=mdwn + username="cehteh" + ip="217.8.62.137" + subject="comment 3" + date="2014-03-26T18:55:41Z" + content=""" +I'm a little bit worried about the potential to reinvent SQL, badly. ;) + +As shown in your example, once you have ranges, it's natural to also want disjunctions, and then probably parenthesized expressions, and suddenly things are very complicated. + +Also, it's important that views remain reversable, so that committing a moved file in a view can unambiguously calculate the new metadata for it. I think that quickly becomes hard when adding these complications. + +"""]] diff --git a/doc/forum/view_from_numeric_values/comment_4_517c7659654a6fc608eb3332053df8a4._comment b/doc/forum/view_from_numeric_values/comment_4_517c7659654a6fc608eb3332053df8a4._comment new file mode 100644 index 0000000000..90cb1c22a9 --- /dev/null +++ b/doc/forum/view_from_numeric_values/comment_4_517c7659654a6fc608eb3332053df8a4._comment @@ -0,0 +1,28 @@ +[[!comment format=mdwn + username="cehteh" + ip="217.8.62.137" + subject="comment 4" + date="2014-03-26T20:03:51Z" + content=""" +I agree with you that things must stay simple. All what should be done is having the same effects like normal globs but adding arithmetic comparisons to it (could you think about a globbing extension over numeric values?). Then the generated views will have the same properties/semnatic as the normal glob'ed views without other side effects (if you want to go that far, this would even hold true for disjunct, parenthesized and otherwise complex expression). + +Example (how it should work, except my bug report 'set metadata on wrong files') + + git annex metadata a.txt -s foo=bar -s num=1 + git annex metadata b.txt -s foo=baz -s num=2 + git annex metadata c.txt -s foo=barf -s num=3 + + git annex view foo=bar* num=* -ne 2 + +should give + ./bar/1/a.txt ./barf/3/c.txt + +am I right now than one could + + mkdir -p ./baz/2 + mv /bar/1/a.txt ./baz/2 + +to change the metadata of a.txt, despite the foo=baz and num=2 fields where initially filtered out when creating the view? +If this assumption is true then having arithmetic filters, no matter how complex they are won't change the existing semantics over what globs do. + +"""]] diff --git a/doc/forum/view_including_files_with_no_tags.mdwn b/doc/forum/view_including_files_with_no_tags.mdwn new file mode 100644 index 0000000000..7ed64fc7df --- /dev/null +++ b/doc/forum/view_including_files_with_no_tags.mdwn @@ -0,0 +1,5 @@ +Hi + +Is it possible to create a view which also includes files with no tag? + +I use something like `git annex view 'rating=*'` to view files sorted by rating but this view does not include files which don‘t have a rating yet. What I was looking for is a way to show tagged files and untagged files in one view. diff --git a/doc/forum/view_including_files_with_no_tags/comment_1_b0aafc023fbec33af268576c4c199af3._comment b/doc/forum/view_including_files_with_no_tags/comment_1_b0aafc023fbec33af268576c4c199af3._comment new file mode 100644 index 0000000000..ec58308b75 --- /dev/null +++ b/doc/forum/view_including_files_with_no_tags/comment_1_b0aafc023fbec33af268576c4c199af3._comment @@ -0,0 +1,24 @@ +[[!comment format=mdwn + username="Xyem" + ip="87.194.19.134" + subject="comment 1" + date="2014-03-25T08:54:23Z" + content=""" +This is a TODO: + +http://git-annex.branchable.com/design/metadata/ + + unmatched files in filtered branches + + TODO Files not matching the view should be able to be included in the filtered branch, in a special location, an \"other\" directory. + +In the meantime, I do this before switching to the view: + + git annex metadata -s fieldIwant?=untagged + +This shows the files without any \"fieldIwant\" in the directory \"untagged\". Afterwards, I could (but don't need to in my workflow, it automatically gets removed), do this to remove it: + + git annex metadata -s fieldIwant-=untagged + +What the \"?=\" does is add that metadata only if the \"fieldIwant\" hasn't been set at all. +"""]] diff --git a/doc/forum/view_including_files_with_no_tags/comment_2_5ae9d5308371bdb1f94342c9f9b01aff._comment b/doc/forum/view_including_files_with_no_tags/comment_2_5ae9d5308371bdb1f94342c9f9b01aff._comment new file mode 100644 index 0000000000..3f16a163f8 --- /dev/null +++ b/doc/forum/view_including_files_with_no_tags/comment_2_5ae9d5308371bdb1f94342c9f9b01aff._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://ypid.wordpress.com/" + ip="213.153.84.215" + subject="Perfect" + date="2014-03-25T20:11:26Z" + content=""" +This works great. Nice workaround, thanks very much. +"""]] diff --git a/doc/git-annex-shell.mdwn b/doc/git-annex-shell.mdwn index c866154acb..26ccb9a409 100644 --- a/doc/git-annex-shell.mdwn +++ b/doc/git-annex-shell.mdwn @@ -26,7 +26,12 @@ first "/~/" or "/~user/" is expanded to the specified home directory. * configlist directory This outputs a subset of the git configuration, in the same form as - `git config --list` + `git config --list`. This is used to get the annex.uuid of the remote + repository. + + When run in a repository that does not yet have an annex.uuid, one + will be created, as long as a git-annex branch has already been pushed to + the repository. * inannex directory [key ...] @@ -60,6 +65,11 @@ first "/~/" or "/~user/" is expanded to the specified home directory. This commits any staged changes to the git-annex branch. It also runs the annex-content hook. +* notifychanges + + This is used by `git-annex remotedaemon` to be notified when + refs in the remote repository are changed. + * gcryptsetup gcryptid Sets up a repository as a gcrypt repository. @@ -96,6 +106,9 @@ changed. If set, disallows any command that could modify the repository. + Note that this does not prevent passing commands on to git-shell. + For that, you also need ... + * GIT_ANNEX_SHELL_LIMITED If set, disallows running git-shell to handle unknown commands. diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 32c8ec2662..03e05d934e 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -62,10 +62,14 @@ subdirectories). * `add [path ...]` - Adds files in the path to the annex. Files that are already checked into - git, or that git has been configured to ignore will be silently skipped. - (Use `--force` to add ignored files.) Dotfiles are skipped unless explicitly - listed. + Adds files in the path to the annex. If no path is specified, adds + files from the current directory and below. + + Files that are already checked into git, or that git has been configured + to ignore will be silently skipped. (Use `--force` to add ignored files.) + + Dotfiles are skipped unless explicitly listed, or the --include-dotfiles + option is used. * `get [path ...]` @@ -264,7 +268,7 @@ subdirectories). Use `--template` to control where the files are stored. The default template is '${feedtitle}/${itemtitle}${extension}' - (Other available variables: feedauthor, itemauthor, itemsummary, itemdescription, itemrights, itemid) + (Other available variables: feedauthor, itemauthor, itemsummary, itemdescription, itemrights, itemid, itempubdate) The `--relaxed` and `--fast` options behave the same as they do in addurl. @@ -707,8 +711,9 @@ subdirectories). * `metadata [path ...] [-s field=value -s field+=value -s field-=value ...] [-g field]` - Each file can have any number of metadata fields attached to it, - which each in turn have any number of values. + The content of a file can have any number of metadata fields + attached to it to describe it. Each metadata field can in turn + have any number of values. This command can be used to set metadata, or show the currently set metadata. @@ -917,6 +922,10 @@ subdirectories). There are several parameters, provided by Haskell's tasty test framework. +* `remotedaemon` + + Detects when remotes have changed and fetches from them. + * `xmppgit` This command is used internally to perform git pulls over XMPP. @@ -1053,6 +1062,19 @@ subdirectories). Overrides the User-Agent to use when downloading files from the web. +* `--notify-finish` + + Caused a desktop notification to be displayed after each successful + file download and upload. + + (Only supported on some platforms, eg Linux with dbus. A no-op when + not supported.) + +* `--notify-start` + + Caused a desktop notification to be displayed when a file upload + or download has started, or when a file is dropped. + * `-c name=value` Overrides git configuration settings. May be specified multiple times. @@ -1697,7 +1719,7 @@ used by git-annex. `~/.config/git-annex/autostart` is a list of git repositories to start the git-annex assistant in. -`.git/hooks/pre-commit-annex` in your git repsitory will be run whenever +`.git/hooks/pre-commit-annex` in your git repository will be run whenever a commit is made, either by git commit, git-annex sync, or the git-annex assistant. diff --git a/doc/index.mdwn b/doc/index.mdwn index 57bfe2408c..fd166212ed 100644 --- a/doc/index.mdwn +++ b/doc/index.mdwn @@ -39,7 +39,8 @@ files with git. ---- -git-annex is [[Free Software|license]] +git-annex is [[Free Software|license]], written in [Haskell](http://www.haskell.org/). +You can [[contribute]]! git-annex's wiki is powered by [Ikiwiki](http://ikiwiki.info/) and hosted by [Branchable](http://branchable.com/). diff --git a/doc/install.mdwn b/doc/install.mdwn index ecbf11a15f..d9715b7da3 100644 --- a/doc/install.mdwn +++ b/doc/install.mdwn @@ -14,6 +14,7 @@ detailed instructions | quick install   [[Gentoo]] | `emerge git-annex`   [[ScientificLinux5]] |   [[openSUSE]] | +  [[Docker]] | [[Windows]] | [download installer](http://downloads.kitenet.net/git-annex/windows/current/) **alpha** """]] diff --git a/doc/install/ArchLinux/comment_6_1d597d6a95f9c2df7dae6e98813e4865._comment b/doc/install/ArchLinux/comment_6_1d597d6a95f9c2df7dae6e98813e4865._comment new file mode 100644 index 0000000000..9f158347bc --- /dev/null +++ b/doc/install/ArchLinux/comment_6_1d597d6a95f9c2df7dae6e98813e4865._comment @@ -0,0 +1,36 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmqWbWVRH2k9spSMqKfIXBP1G3ekkj9Igg" + nickname="Rado" + subject="problem installing using cabal: language-javascript missing" + date="2014-03-28T22:38:04Z" + content=""" +Configuring gnuidn-0.2.1... +cabal: The program c2hs is required but it could not be found. +Failed to install gnuidn-0.2.1 +Configuring language-javascript-0.5.9... +cabal: The program happy version >=1.18.5 is required but it could not be +found. +Failed to install language-javascript-0.5.9 +cabal: Error: some packages failed to install: +git-annex-5.20140320 depends on language-javascript-0.5.9 which failed to +install. +gnuidn-0.2.1 failed during the configure step. The exception was: +ExitFailure 1 +hjsmin-0.1.4.6 depends on language-javascript-0.5.9 which failed to install. +language-javascript-0.5.9 failed during the configure step. The exception was: +ExitFailure 1 +network-protocol-xmpp-0.4.6 depends on gnuidn-0.2.1 which failed to install. +yesod-static-1.2.2.4 depends on language-javascript-0.5.9 which failed to +install. +[r-c@rc-laptop ~]$ cabal install language-javascript +Resolving dependencies... +Configuring language-javascript-0.5.9... +cabal: The program happy version >=1.18.5 is required but it could not be +found. +Failed to install language-javascript-0.5.9 +cabal: Error: some packages failed to install: +language-javascript-0.5.9 failed during the configure step. The exception was: +ExitFailure 1 + +Can you help how to solve? +"""]] diff --git a/doc/install/ArchLinux/comment_7_2d708977e2fad6b68803494576382df5._comment b/doc/install/ArchLinux/comment_7_2d708977e2fad6b68803494576382df5._comment new file mode 100644 index 0000000000..3d7826bc10 --- /dev/null +++ b/doc/install/ArchLinux/comment_7_2d708977e2fad6b68803494576382df5._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://alerque.com/" + nickname="Caleb" + subject="dep problems" + date="2014-03-28T22:50:37Z" + content=""" +@rado The Haskel dependencies can be a nightmare to sort out for the un-initiated. You can side-step the whole issue by uninstalling the pre-built version that that has all the dependencies built in out of the box. + +Just grab the git-annex-bin package from the AUR and be done with it. (The -bin and -standalone packages recently merged so there is just -bin now). +"""]] diff --git a/doc/install/ArchLinux/comment_8_5b5f5e0b64e5bfb1ea12e8b251c6fb5f._comment b/doc/install/ArchLinux/comment_8_5b5f5e0b64e5bfb1ea12e8b251c6fb5f._comment new file mode 100644 index 0000000000..3e6d6b3a82 --- /dev/null +++ b/doc/install/ArchLinux/comment_8_5b5f5e0b64e5bfb1ea12e8b251c6fb5f._comment @@ -0,0 +1,15 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmqWbWVRH2k9spSMqKfIXBP1G3ekkj9Igg" + nickname="Rado" + subject="I solved it installing dependencies....but dont know hot to start it..." + date="2014-03-29T07:45:19Z" + content=""" +cabal install gsasl +cabal install happy +cabal install language-javascript +cabal install alex +cabal install c2hs + +after installing writing in terminal: git-annex, git-annex webapp does nothing... +can you help how to start git-annex? +"""]] diff --git a/doc/install/Docker.mdwn b/doc/install/Docker.mdwn new file mode 100644 index 0000000000..3e0171dde2 --- /dev/null +++ b/doc/install/Docker.mdwn @@ -0,0 +1,27 @@ +There is not yet a pre-built Docker image for git-annex. However, it's +easy to add it to an image. + +For example: + + docker run -i -t joeyh/debian-unstable apt-get install git-annex + +# autobuilders + +The git-annex Linux autobuilds are built using a Docker container. +If you'd like to set up your own autobuilder in a Docker container, +the image that is used is not currently published, but you can build +a new image using [Propellor](http://joeyh.name/code/propellor). Just +install Propellor and add this to its `config.hs`: + +[[!format haskell """ +host hostname@"your.machine.net" = Just $ props + & Docker.configured + & Docker.docked container hostname "amd64-git-annex-builder" + +container _ "amd64-git-annex-builder" = in Just $ Docker.containerFrom + (image $ System (Debian Unstable) "amd64") + [ Docker.inside $ props & GitAnnexBuilder.builder "amd64" "15 * * * *" False ] +"""]] + +This will autobuild every hour at :15, and the autobuilt image will be +left inside the container in /home/builder/gitbuilder/out/ diff --git a/doc/internals.mdwn b/doc/internals.mdwn index 0c5124d0b9..bf0fa668c9 100644 --- a/doc/internals.mdwn +++ b/doc/internals.mdwn @@ -150,6 +150,13 @@ Files matching the expression are preferred to be retained in the repository, while files not matching it are preferred to be stored somewhere else. +## `required-content.log` + +Used to indicate which repositories are required to contain which file +contents. + +File format is identical to preferred-content.log. + ## `group-preferred-content.log` Contains standard preferred content settings for groups. (Overriding or diff --git a/doc/metadata.mdwn b/doc/metadata.mdwn index 9f3c314fa2..fed3323517 100644 --- a/doc/metadata.mdwn +++ b/doc/metadata.mdwn @@ -1,7 +1,7 @@ -git-annex allows you to store arbitrary metadata about files stored in the -git-annex repository. The metadata is stored in the `git-annex` branch, and -so is automatically kept in sync with the rest of git-annex's state, such -as [[location_tracking]] information. +git-annex allows you to store arbitrary metadata about the content of files +stored in the git-annex repository. The metadata is stored in the +`git-annex` branch, and so is automatically kept in sync with the rest of +git-annex's state, such as [[location_tracking]] information. Some of the things you can do with metadata include: @@ -12,7 +12,7 @@ Some of the things you can do with metadata include: or without particular metadata. For example `git annex find --metadata tag=foo --or --metadata tag=bar` * Using it in [[preferred_content]] expressions. - For example "tag=important or not author=me" + For example "metadata=tag=important or not metadata=author=me" Each file (actually the underlying key) can have any number of metadata fields, which each can have any number of values. For example, to tag diff --git a/doc/news/version_5.20140210.mdwn b/doc/news/version_5.20140210.mdwn deleted file mode 100644 index 3049e9d47f..0000000000 --- a/doc/news/version_5.20140210.mdwn +++ /dev/null @@ -1,42 +0,0 @@ -git-annex 5.20140210 released with [[!toggle text="these changes"]] -[[!toggleable text=""" - * --in can now refer to files that were located in a repository at - some past date. For example, --in="here@{yesterday}" - * Fixed direct mode annexed content locking code, which is used to - guard against recursive file drops. - * This is the first beta-level release of the Windows port with important - fixes (see below). - (The webapp and assistant are still alpha-level on Windows.) - * sync --content: Honor annex-ignore configuration. - * sync: Don't try to sync with xmpp remotes, which are only currently - supported when using the assistant. - * sync --content: Re-pull from remotes after downloading content, - since that can take a while and other changes may be pushed in the - meantime. - * sync --content: Reuse smart copy code from copy command, including - handling and repairing out of date location tracking info. - Closes: #[737480](http://bugs.debian.org/737480) - * sync --content: Drop files from remotes that don't want them after - getting them. - * sync: Fix bug in automatic merge conflict resolution code when used - on a filesystem not supporting symlinks, which resulted in it losing - track of the symlink bit of annexed files. - * Added ways to configure rsync options to be used only when uploading - or downloading from a remote. Useful to eg limit upload bandwidth. - * Fix initremote with encryption=pubkey to work with S3, glacier, webdav, - and external special remotes. - * Avoid building with DAV 0.6 which is badly broken (see #737902). - * Fix dropping of unused keys with spaces in their name. - * Fix build on platforms not supporting the webapp. - * Document in man page that sshcaching uses ssh ControlMaster. - Closes: #[737476](http://bugs.debian.org/737476) - * Windows: It's now safe to run multiple git-annex processes concurrently - on Windows; the lock files have been sorted out. - * Windows: Avoid using unix-compat's rename, which refuses to rename - directories. - * Windows: Fix deletion of repositories by test suite and webapp. - * Windows: Test suite 100% passes again. - * Windows: Fix bug in symlink calculation code. - * Windows: Fix handling of absolute unix-style git repository paths. - * Android: Avoid crashing when unable to set file mode for ssh config file - due to Android filesystem horribleness."""]] \ No newline at end of file diff --git a/doc/news/version_5.20140221.mdwn b/doc/news/version_5.20140221.mdwn deleted file mode 100644 index 50f85496e1..0000000000 --- a/doc/news/version_5.20140221.mdwn +++ /dev/null @@ -1,28 +0,0 @@ -git-annex 5.20140221 released with [[!toggle text="these changes"]] -[[!toggleable text=""" - * metadata: New command that can attach metadata to files. - * --metadata can be used to limit commands to acting on files - that have particular metadata. - * Preferred content expressions can use metadata=field=value - to limit them to acting on files that have particular metadata. - * view: New command that creates and checks out a branch that provides - a structured view of selected metadata. - * vfilter, vadd, vpop, vcycle: New commands for operating within views. - * pre-commit: Update metadata when committing changes to locations - of annexed files within a view. - * Add progress display for transfers to/from external special remotes. - * unused: Fix to actually detect unused keys when in direct mode. - * fsck: When run with --all or --unused, while .gitattributes - annex.numcopies cannot be honored since it's operating on keys - instead of files, make it honor the global numcopies setting, - and the annex.numcopies git config setting. - * trust, untrust, semitrust, dead: Warn when the trust level is - overridden in .git/config. - * glacier: Do not try to run glacier value create when an existing glacier - remote is enabled. - * fsck: Refuse to do anything if more than one of --incremental, --more, - and --incremental-schedule are given, since it's not clear which option - should win. - * Windows webapp: Can set up box.com, Amazon S3, and rsync.net remotes - * Windows webapp: Can create repos on removable drives. - * Windows: Ensure HOME is set, as needed by bundled cygwin utilities."""]] \ No newline at end of file diff --git a/doc/news/version_5.20140227.mdwn b/doc/news/version_5.20140227.mdwn deleted file mode 100644 index 57f0c9a539..0000000000 --- a/doc/news/version_5.20140227.mdwn +++ /dev/null @@ -1,32 +0,0 @@ -git-annex 5.20140227 released with [[!toggle text="these changes"]] -[[!toggleable text=""" - * metadata: Field names limited to alphanumerics and a few whitelisted - punctuation characters to avoid issues with views, etc. - * metadata: Field names are now case insensative. - * When constructing views, metadata is available about the location of the - file in the view's reference branch. Allows incorporating parts of the - directory hierarchy in a view. - For example `git annex view tag=* podcasts/=*` makes a view in the form - tag/showname. - * --metadata field=value can now use globs to match, and matches - case insensatively, the same as git annex view field=value does. - * annex.genmetadata can be set to make git-annex automatically set - metadata (year and month) when adding files. - * Make annex.web-options be used in several places that call curl. - * Fix handling of rsync remote urls containing a username, - including rsync.net. - * Preserve metadata when staging a new version of an annexed file. - * metadata: Support --json - * webapp: Fix creation of box.com and Amazon S3 and Glacier - repositories, broken in 5.20140221. - * webdav: When built with DAV 0.6.0, use the new DAV monad to avoid - locking files, which is not needed by git-annex's use of webdav, and - does not work on Box.com. - * webdav: Fix path separator bug when used on Windows. - * repair: Optimise unpacking of pack files, and avoid repeated error - messages about corrupt pack files. - * Add build dep on regex-compat to fix build on mipsel, which lacks - regex-tdfa. - * Disable test suite on sparc, which is missing optparse-applicative. - * Put non-object tmp files in .git/annex/misctmp, leaving .git/annex/tmp - for only partially transferred objects."""]] \ No newline at end of file diff --git a/doc/news/version_5.20140320.mdwn b/doc/news/version_5.20140320.mdwn new file mode 100644 index 0000000000..ee2e95d489 --- /dev/null +++ b/doc/news/version_5.20140320.mdwn @@ -0,0 +1,37 @@ +git-annex 5.20140320 released with [[!toggle text="these changes"]] +[[!toggleable text=""" + * Fix zombie leak and general inneficiency when copying files to a + local git repo. + * Fix ssh connection caching stop method to work with openssh 6.5p1, + which broke the old method. + * webapp: Added a "Sync now" item to each repository's menu. + * webapp: Use securemem for constant time auth token comparisons. + * copy --fast --to remote: Avoid printing anything for files that + are already believed to be present on the remote. + * Commands that allow specifying which repository to act on using + the repository's description will now fail when multiple repositories + match, rather than picking a repository at random. + (So will --in=) + * Better workaround for problem umasks when eg, setting up ssh keys. + * "standard" can now be used as a first-class keyword in preferred content + expressions. For example "standard or (include=otherdir/*)" + * groupwanted can be used in preferred content expressions. + * vicfg: Allows editing preferred content expressions for groups. + * Improve behavior when unable to parse a preferred content expression + (thanks, ion). + * metadata: Add --get + * metadata: Support --key option (and some other ones like --all) + * For each metadata field, there's now an automatically maintained + "$field-lastchanged" that gives the date of the last change to that + field. Also the "lastchanged" field for the date of the last change + to any of a file's metadata. + * unused: In direct mode, files that are deleted from the work tree + and so have no content present are no longer incorrectly detected as + unused. + * Avoid encoding errors when using the unused log file. + * map: Fix crash when one of the remotes of a repo is a local directory + that does not exist, or is not a git repo. + * repair: Improve memory usage when git fsck finds a great many broken + objects. + * Windows: Fix some filename encoding bugs. + * rsync special remote: Fix slashes when used on Windows."""]] \ No newline at end of file diff --git a/doc/news/version_5.20140402.mdwn b/doc/news/version_5.20140402.mdwn new file mode 100644 index 0000000000..e11dcd3215 --- /dev/null +++ b/doc/news/version_5.20140402.mdwn @@ -0,0 +1,34 @@ +git-annex 5.20140402 released with [[!toggle text="these changes"]] +[[!toggleable text=""" + * unannex, uninit: Avoid committing after every file is unannexed, + for massive speedup. + * --notify-finish switch will cause desktop notifications after each + file upload/download/drop completes + (using the dbus Desktop Notifications Specification) + * --notify-start switch will show desktop notifications when each + file upload/download starts. + * webapp: Automatically install Nautilus integration scripts + to get and drop files. + * tahoe: Pass -d parameter before subcommand; putting it after + the subcommand no longer works with tahoe-lafs version 1.10. + (Thanks, Alberto Berti) + * forget --drop-dead: Avoid removing the dead remote from the trust.log, + so that if git remotes for it still exist anywhere, git annex info + will still know it's dead and not show it. + * git-annex-shell: Make configlist automatically initialize + a remote git repository, as long as a git-annex branch has + been pushed to it, to simplify setup of remote git repositories, + including via gitolite. + * add --include-dotfiles: New option, perhaps useful for backups. + * Version 5.20140227 broke creation of glacier repositories, + not including the datacenter and vault in their configuration. + This bug is fixed, but glacier repositories set up with the broken + version of git-annex need to have the datacenter and vault set + in order to be usable. This can be done using git annex enableremote + to add the missing settings. For details, see + http://git-annex.branchable.com/bugs/problems\_with\_glacier/ + * Added required content configuration. + * assistant: Improve ssh authorized keys line generated in local pairing + or for a remote ssh server to set environment variables in an + alternative way that works with the non-POSIX fish shell, as well + as POSIX shells."""]] \ No newline at end of file diff --git a/doc/news/version_5.20140405.mdwn b/doc/news/version_5.20140405.mdwn new file mode 100644 index 0000000000..8f285f2224 --- /dev/null +++ b/doc/news/version_5.20140405.mdwn @@ -0,0 +1,7 @@ +git-annex 5.20140405 released with [[!toggle text="these changes"]] +[[!toggleable text=""" + * git-annex-shell: Added notifychanges command. + * Improve display of dbus notifications. Thanks, Johan Kiviniemi. + * Fix nautilus script installation to not crash when the nautilus script dir + does not exist. Instead, only install scripts when the directory already + exists."""]] \ No newline at end of file diff --git a/doc/news/version_5.20140411.mdwn b/doc/news/version_5.20140411.mdwn new file mode 100644 index 0000000000..8e4bb21210 --- /dev/null +++ b/doc/news/version_5.20140411.mdwn @@ -0,0 +1,13 @@ +git-annex 5.20140411 released with [[!toggle text="these changes"]] +[[!toggleable text=""" + * importfeed: Filename template can now contain an itempubdate variable. + Needs feed 0.3.9.2. + * Fix rsync progress parsing in locales that use comma in number display. + Closes: #[744148](http://bugs.debian.org/744148) + * assistant: Fix high CPU usage triggered when a monthly fsck is scheduled, + and the last time the job ran was a day of the month > 12. This caused a + runaway loop. Thanks to Anarcat for his assistance, and to Maximiliano + Curia for identifying the cause of this bug. + * Remove wget from OSX dmg, due to issues with cert paths that broke + git-annex automatic upgrading. Instead, curl is used, unless the + OSX system has wget installed, which will then be used."""]] \ No newline at end of file diff --git a/doc/preferred_content.mdwn b/doc/preferred_content.mdwn index af76a0e7b4..ec499de25a 100644 --- a/doc/preferred_content.mdwn +++ b/doc/preferred_content.mdwn @@ -1,7 +1,7 @@ git-annex tries to ensure that the configured number of [[copies]] of your data always exist, and leaves it up to you to use commands like `git annex get` and `git annex drop` to move the content to the repositories you want -to contain it. But sometimes, it can be good to have more fine-grained +to contain it. But often, it can be good to have more fine-grained control over which content is wanted by which repositories. Configuring this allows the git-annex assistant as well as `git annex get --auto`, `git annex drop --auto`, `git annex sync --content`, @@ -33,9 +33,9 @@ If it doesn't, the repository wants to drop its content To check at the command line which files are matched by preferred content settings, you can use the --want-get and --want-drop options. -For example, "git annex find --want-get --not --in ." will find all the -files that "git annex get --auto" will want to get, and "git annex find ---want-drop --in ." will find all the files that "git annex drop --auto" +For example, `git annex find --want-get --not --in .` will find all the +files that `git annex get --auto` will want to get, and `git annex find +--want-drop --in .` will find all the files that `git annex drop --auto` will want to drop. The expressions are very similar to the matching options documented @@ -144,6 +144,16 @@ Or, you could make a new group, with your own custom preferred content expression tuned for your needs, and every repository you put in this group and make its preferred content be "groupwanted" will use it. +### difference: metadata matching + +This: + + git annex get --metadata tag=done + +becomes + + metadata=tag=done + ## upgrades It's important that all clones of a repository can understand one-another's diff --git a/doc/preferred_content/standard_groups/comment_1_026e47e425d06c4b2580238b3187a379._comment b/doc/preferred_content/standard_groups/comment_1_026e47e425d06c4b2580238b3187a379._comment new file mode 100644 index 0000000000..9a06d3791e --- /dev/null +++ b/doc/preferred_content/standard_groups/comment_1_026e47e425d06c4b2580238b3187a379._comment @@ -0,0 +1,13 @@ +[[!comment format=mdwn + username="http://mildred.fr/" + ip="2a01:e35:2f7b:8350:290:f5ff:feea:5546" + subject="difference between source and unwanted" + date="2014-04-02T22:25:26Z" + content=""" +What's the difference between `source` and `unwanted` ? + +- `source` (`not copies=1`) will keep files that have less than 1 copies, meaning zero copies, meaning no files. +- `unwanted` will exclude all files. + +Both gets to the same results, all files are moved elsewhere. Right? +"""]] diff --git a/doc/preferred_content/standard_groups/comment_2_460bae34ba7c05357318a202b2932d25._comment b/doc/preferred_content/standard_groups/comment_2_460bae34ba7c05357318a202b2932d25._comment new file mode 100644 index 0000000000..c877a92222 --- /dev/null +++ b/doc/preferred_content/standard_groups/comment_2_460bae34ba7c05357318a202b2932d25._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.244" + subject="comment 2" + date="2014-04-02T22:44:14Z" + content=""" +@Mildred, I think both preferred content expressions will do the same thing. There is, however a difference between the groups: The webapp notices when all files have gone from an unwanted repository, and will help the user finish deleting the repository. +"""]] diff --git a/doc/related_software.mdwn b/doc/related_software.mdwn index 1b55796287..0cd7d7fc8f 100644 --- a/doc/related_software.mdwn +++ b/doc/related_software.mdwn @@ -11,4 +11,5 @@ designed to interoperate with it. utility, with a `-A` switch that enables git-annex support. * Emacs Org mode can auto-commit attached files to git-annex. * [git annex darktable integration](https://github.com/xxv/darktable-git-annex) -* [Nautilus file manager ingegration](https://gist.github.com/ion1/9660286) +* Emacs's [Magit mode](http://www.emacswiki.org/emacs/Magit) has + [magit integration](http://melpa.milkbox.net/?utm_source=dlvr.it&utm_medium=twitter#/magit-annex) diff --git a/doc/required_content.mdwn b/doc/required_content.mdwn new file mode 100644 index 0000000000..91c5614a80 --- /dev/null +++ b/doc/required_content.mdwn @@ -0,0 +1,17 @@ +Required content settings can be configured to do more complicated +things than just setting the required number of [[copies]] of your data. +For example, you could require that data be archived in at least two +archival repositories, and also require that one copy be stored offsite. + +The format of required content expressions is the same as +[[preferred_content]] expressions. + +Required content settings can be edited using `git annex vicfg`. +Each repository can have its own settings, and other repositories will +try to honor those settings when interacting with it. + +While [[preferred_content]] expresses a preference, it can be overridden +by simply using `git annex drop`. On the other hand, required content +settings are enforced; `git annex drop` will refuse to drop a file if +doing so would violate its required content settings. +(Although even this can be overridden using `--force`). diff --git a/doc/special_remotes/tahoe.mdwn b/doc/special_remotes/tahoe.mdwn index afe8c11da9..df1ca620fb 100644 --- a/doc/special_remotes/tahoe.mdwn +++ b/doc/special_remotes/tahoe.mdwn @@ -22,8 +22,12 @@ daemon as needed. These parameters can be passed to `git annex initremote` to configure the tahoe remote. +* `shared-convergence-secret` - Optional. Can be useful to set to + allow tahoe to deduplicate information. By default, a new + shared-convergence-secret is created for each tahoe remote. + * `embedcreds` - Optional. Set to "yes" embed the tahoe credentials - (specifically the introducer furl and shared-convergence-secret) + (specifically the introducer-furl and shared-convergence-secret) inside the git repository, which allows other clones to also use them in order to access the tahoe grid. diff --git a/doc/tips/Synology_NAS_and_git_annex/comment_1_ef7e19f1fd2005eb7cc74509ffb92766._comment b/doc/tips/Synology_NAS_and_git_annex/comment_1_ef7e19f1fd2005eb7cc74509ffb92766._comment new file mode 100644 index 0000000000..e7a1db9373 --- /dev/null +++ b/doc/tips/Synology_NAS_and_git_annex/comment_1_ef7e19f1fd2005eb7cc74509ffb92766._comment @@ -0,0 +1,9 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnrP-0DGtHDJbWSXeiyk0swNkK1aejoN3c" + nickname="sebastien" + subject="new dev site for syno dsm 5.0" + date="2014-03-25T10:20:46Z" + content=""" +There is a new website with documentation to create App for new synology dsm 5.0 here : http://www.synology.com/en-us/support/developer +A good way to distribute git annex to lot of people ? :) +"""]] diff --git a/doc/tips/automatically_adding_metadata.mdwn b/doc/tips/automatically_adding_metadata.mdwn index c3f50bb39f..e6d02defa7 100644 --- a/doc/tips/automatically_adding_metadata.mdwn +++ b/doc/tips/automatically_adding_metadata.mdwn @@ -17,7 +17,7 @@ like photos, mp3s, etc. Now any fields you list in metadata.extract to will be extracted and stored when files are committed. -To get a list of all possible fields, run: `extract -L | sed ' ' _` +To get a list of all possible fields, run: `extract -L | sed 's/ /_/g'` By default, if a git-annex already has a metadata field for a file, its value will not be overwritten with metadata taken from files. diff --git a/doc/tips/automatically_adding_metadata/comment_2_bd64a53914107bc000c887b4d4bdf6af._comment b/doc/tips/automatically_adding_metadata/comment_2_bd64a53914107bc000c887b4d4bdf6af._comment new file mode 100644 index 0000000000..13b3865e10 --- /dev/null +++ b/doc/tips/automatically_adding_metadata/comment_2_bd64a53914107bc000c887b4d4bdf6af._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="https://id.koumbit.net/anarcat" + ip="2001:1928:1:9::1" + subject="comment 2" + date="2014-04-01T04:18:10Z" + content=""" +is there a way for this to be done globally, without having to install and configure the hook for each repository? it seems like a fairly useful feature that could be factored in git-annex itself (as opposed to be shipped as a shell script)... + +also, is there a way to retroactively parse the tags from existing files (as opposed to only new files added to the repo). + +thanks +"""]] diff --git a/doc/tips/downloading_podcasts.mdwn b/doc/tips/downloading_podcasts.mdwn index d412a73bfa..876d8d4e1d 100644 --- a/doc/tips/downloading_podcasts.mdwn +++ b/doc/tips/downloading_podcasts.mdwn @@ -23,7 +23,8 @@ there's a --template option. The default is `--template='${feedtitle}/${itemtitle}${extension}'` Other available template variables: -feedauthor, itemauthor, itemsummary, itemdescription, itemrights, itemid +feedauthor, itemauthor, itemsummary, itemdescription, itemrights, itemid, +itempubdate ## catching up diff --git a/doc/tips/file_manager_integration.mdwn b/doc/tips/file_manager_integration.mdwn new file mode 100644 index 0000000000..1a1a557fcb --- /dev/null +++ b/doc/tips/file_manager_integration.mdwn @@ -0,0 +1,100 @@ +Integrating git-annex and your file manager provides an easy way to select +annexed files to get or drop. + +[[!toc]] + +## GNOME (nautilus) + +Recent git-annex comes with built-in nautilus integration. Just pick the +action from the menu. + +[[!img assistant/nautilusmenu.png]] + +[[!img assistant/downloadnotification.png]] + +This is set up by making simple scripts in +`~/.local/share/nautilus/scripts`, with names like "git-annex get" + +## KDE (Dolphin/Konqueror) + +Create a file `~/.kde4/share/kde4/services/ServiceMenus/git-annex.desktop` with the following contents: + + [Desktop Entry] + Type=Service + ServiceTypes=all/allfiles + MimeType=all/all; + Actions=GitAnnexGet;GitAnnexDrop; + X-KDE-Priority=TopLevel + X-KDE-Submenu=Git-Annex + X-KDE-Icon=git-annex + X-KDE-ServiceTypes=KonqPopupMenu/Plugin + + [Desktop Action GitAnnexGet] + Name=Get + Icon=git-annex + Exec=git-annex get --notify-start --notify-finish -- %U + + [Desktop Action GitAnnexDrop] + Name=Drop + Icon=git-annex + Exec=git-annex drop --notify-start --notify-finish -- %U + +## XFCE (Thunar) + +XFCE uses the Thunar file manager, which can also be easily configured to allow for custom actions. Just go to the "Configure custom actions..." item in the "Edit" menu, and create a custom action for get and drop with the following commands: + + git-annex drop --notify-start --notify-finish -- %F + +for drop, and for get: + + git-annex drop --notify-start --notify-finish -- %F + +This gives me the resulting config on disk, in `.config/Thunar/uca.xml`: + + + git-annex + git-annex get + 1396278104182858-3 + git-annex get --notify-start --notify-finish -- %F + get the files from a remote git annex repository + * + + + + + + + + + git-annex + git-annex drop + 1396278093174843-2 + git-annex drop --notify-start --notify-finish -- %F + drop the files from the local repository + * + + + + + + + + +The complete instructions on how to setup actions is [in the XFCE documentation](http://docs.xfce.org/xfce/thunar/custom-actions). + +## your file manager here + +Edit this page and add instructions! + +## general + +If your file manager can run a command on a file, it should be easy to +integrate git-annex with it. A simple script will suffice: + + #!/bun/sh + git-annex get --notify-start --notify-finish -- "$@" + +The --notify-start and --notify-stop options make git-annex display a +desktop notification. This is useful to give the user an indication that +their action took effect. Desktop notifications are currently only +implenented for Linux. diff --git a/doc/tips/googledriveannex/comment_2_c98c00e87bc921158c9c3698fd9f89c9._comment b/doc/tips/googledriveannex/comment_2_c98c00e87bc921158c9c3698fd9f89c9._comment new file mode 100644 index 0000000000..e90903b192 --- /dev/null +++ b/doc/tips/googledriveannex/comment_2_c98c00e87bc921158c9c3698fd9f89c9._comment @@ -0,0 +1,23 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawl64jV2rE8GMogJ6XuqESSkz78RVBgVdGw" + nickname="Mesut" + subject="I can't add google drive as remote" + date="2014-04-10T07:55:56Z" + content=""" +Hi, + +I am new to git-annex and I want to use google drive as remote but I can't. + +I create syslink to `googledriveannex` in `/usr/local/bin`. + +When I execute below command, command waiting but not make anything: + +`$ git annex initremote googledrive type=external externaltype=googledrive encryption=shared folder=gitannex` + +`initremote googledrive (encryption setup)` # Waiting but does not do anything. + +What I am doing wrong? + +Thanks for helps + +"""]] diff --git a/doc/tips/metadata_driven_views/comment_1_1d6793701fd8a1a66bae04662cf853ce._comment b/doc/tips/metadata_driven_views/comment_1_1d6793701fd8a1a66bae04662cf853ce._comment new file mode 100644 index 0000000000..808a332afc --- /dev/null +++ b/doc/tips/metadata_driven_views/comment_1_1d6793701fd8a1a66bae04662cf853ce._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawlFZFMFm-AapYAgV_V5X9HRJxWvhdiX9fY" + nickname="Reiner" + subject="comment 1" + date="2014-03-24T21:11:31Z" + content=""" +I have played around with views and found out that I can create new tags by creating directories in the view and that I can created files in those new directories that are not contained in the original working tree. The behavoiur of git annex in this behaviour is a bit strange. + +Assume for example you have a file \"foo\" with tag \"t1\" and switch to the tag view. Then create a directory \"t2\" and a file \"bar\" in it. Add the file, sync, and switch back to the master branch. If you enter the tag view again, the directory \"t2\" will be vanished, i.e. your newly created file is gone, too. This is not surprising, as the file has never been added to the original working tree. However, another \"git annex sync\" will restore the file. + +I am unsure what behaviour I would expect, maybe it shouldn't be possible to files to a view in the first place, or newly created files might be collected in a separate branch. On the other hand, it seems reasonable to add a new file with a new tag at the same time. Anyway, I found it confusing that I can seemingly lose a file like this. It took me a bit of time to figure out that another sync recovers the file. +"""]] diff --git a/doc/tips/shared_git_annex_directory_between_multiple_users/comment_1_01db8cf9dff016bd8e0498d36f325418._comment b/doc/tips/shared_git_annex_directory_between_multiple_users/comment_1_01db8cf9dff016bd8e0498d36f325418._comment new file mode 100644 index 0000000000..4b7b516c5f --- /dev/null +++ b/doc/tips/shared_git_annex_directory_between_multiple_users/comment_1_01db8cf9dff016bd8e0498d36f325418._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="madduck" + ip="2001:a60:f0fb:0:224:d7ff:fe04:c82c" + subject="Does not work" + date="2014-04-06T10:48:06Z" + content=""" +This does not seem to work, even with latest git-annex. I think it's because git-annex [[!debbug desc=\"creates files without honouring +s on the parent directory\" 729757]]. I just found out it also doesn't honour default ACLs. I hope this can be fixed soon. +"""]] diff --git a/doc/tips/using_gitolite_with_git-annex.mdwn b/doc/tips/using_gitolite_with_git-annex.mdwn index fcc3f96c3c..746b6b17f5 100644 --- a/doc/tips/using_gitolite_with_git-annex.mdwn +++ b/doc/tips/using_gitolite_with_git-annex.mdwn @@ -3,8 +3,6 @@ manager. Here's how to add git-annex support to gitolite, so you can `git annex copy` files to a gitolite repository, and `git annex get` files from it. -Warning : The method described here works with gitolite version g2, avaible in the g2 branch on github. There is an experimental support for g3 in the git-annex branch, if you tested it please add some feedback. - A nice feature of using gitolite with git-annex is that users can be given read-only access to a repository, and this allows them to `git annex get` file contents, but not change anything. @@ -12,7 +10,8 @@ file contents, but not change anything. First, you need new enough versions: * gitolite 2.2 is needed -- this version contains a git-annex-shell ADC - and supports "ua" ADCs. + and supports "ua" ADCs. Alternatively, gitoline g3 also recently added + support for git-annex. * git-annex 3.20111016 or newer needs to be installed on the gitolite server. Don't install an older version, it wouldn't be secure! @@ -39,6 +38,13 @@ cd /usr/local/lib/gitolite/adc/ua/ cp gitolite/contrib/adc/git-annex-shell . +If using gitolite g3, an additional setup step is needed: +In the ENABLE list in the rc file, add an entry like this: + +
+	'git-annex-shell ua',
+
+ Now all gitolite repositories can be used with git-annex just as any ssh remote normally would be used. For example: diff --git a/doc/tips/using_gitolite_with_git-annex/comment_19_33c19097b6f2b48dfe09ec4c8d952d06._comment b/doc/tips/using_gitolite_with_git-annex/comment_19_33c19097b6f2b48dfe09ec4c8d952d06._comment new file mode 100644 index 0000000000..636794abae --- /dev/null +++ b/doc/tips/using_gitolite_with_git-annex/comment_19_33c19097b6f2b48dfe09ec4c8d952d06._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnftLWVOF0DUdXr2HSW4IKzuqtW8V7X3YU" + nickname="Adrian" + subject="How can the git annex init command be called on the server?" + date="2014-03-25T06:58:56Z" + content=""" +The latest commit in the gitolite repository \"git-annex support, finally in master!\" looks really promissing. I'm currently using ubuntu trusty with updated gitolite3 package and the configuration provided by Khaije. One line needs to be changed: 'git-annex-shell' => 'ua', instead of 'git-annex-shell' =>1, + +However, one little detail is still open for me. I need to call the server side \"git annex init\" on the server (sudo su gitolite3; cd ~/repositories/testing.git && git annex init). I cannot find a way to initialize the server from client side. E.g. git annex init && git push --all is not enough. The man page describes git annex initremote for other server types but not for gitolite remotes. Wouldn't we need something similar for gitolite as well? Or is there a better solution which I do not recognize? + +"""]] diff --git a/doc/tips/using_gitolite_with_git-annex/comment_20_c82af00db3dd74ee9bfe12668e76e57b._comment b/doc/tips/using_gitolite_with_git-annex/comment_20_c82af00db3dd74ee9bfe12668e76e57b._comment new file mode 100644 index 0000000000..45ff960f43 --- /dev/null +++ b/doc/tips/using_gitolite_with_git-annex/comment_20_c82af00db3dd74ee9bfe12668e76e57b._comment @@ -0,0 +1,13 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.41" + subject="comment 20" + date="2014-03-26T18:24:30Z" + content=""" +@Adrian, that's good news. It would be helpful if someone could update the top of this page to document how to use git-annex with the new version of gitolite. +This is a wiki.. + +You're not supposed to need to use initremote when dealing with normal git remotes. It seems that something got lost that automatically initialize the remote repository in this situation. I've fixed it so that it will be set up when `git-annex-shell configlist` is run. + +(@wayne, this fixes the problem you reported too..) +"""]] diff --git a/doc/tips/using_the_web_as_a_special_remote/comment_5_5ee9717e74ca2afed98e81fc0ea98a95._comment b/doc/tips/using_the_web_as_a_special_remote/comment_5_5ee9717e74ca2afed98e81fc0ea98a95._comment new file mode 100644 index 0000000000..b1060147f2 --- /dev/null +++ b/doc/tips/using_the_web_as_a_special_remote/comment_5_5ee9717e74ca2afed98e81fc0ea98a95._comment @@ -0,0 +1,18 @@ +[[!comment format=mdwn + username="Xyem" + ip="87.194.19.134" + subject="comment 5" + date="2014-04-04T15:25:39Z" + content=""" +Adding videos from youtube ends up with it using the URL backend, even without fast. + + $ git init quvitest + $ cd quvitest/ + $ git annex init + $ git annex addurl https://www.youtube.com/watch?v=mghhLqu31cQ + (... file is downloaded ...) + $ find .git/annex/objects/ -type f + .git/annex/objects/1J/Wp/URL--quvi&chttps&c%%www.youtube.com%watch,63v,61mghhLqu31cQ/URL--quvi&chttps&c%%www.youtube.com%watch,63v,61mghhLqu31cQ + +Is migrating manually required or should I log a bug? +"""]] diff --git a/doc/tips/using_the_web_as_a_special_remote/comment_6_dceb15bd656e69eefa3ca975d9d642de._comment b/doc/tips/using_the_web_as_a_special_remote/comment_6_dceb15bd656e69eefa3ca975d9d642de._comment new file mode 100644 index 0000000000..0c39eb1831 --- /dev/null +++ b/doc/tips/using_the_web_as_a_special_remote/comment_6_dceb15bd656e69eefa3ca975d9d642de._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.244" + subject="comment 6" + date="2014-04-07T20:07:45Z" + content=""" +Using the URL backend for youtube is intentional. Youtube may serve up different encodings for the same video over time, and this way git-annex treats them all as equvilant. If you want to \"freeze\" the repository to the current one, use `git annex migrate`, and be prepared for `git annex get --from web` to not work long term. +"""]] diff --git a/doc/todo.mdwn b/doc/todo.mdwn index 79552298b6..62224c3bef 100644 --- a/doc/todo.mdwn +++ b/doc/todo.mdwn @@ -1,4 +1,4 @@ -This is git-annex's todo list. Link items to [[todo/done]] when done. +This is git-annex's todo list. Link items to [[todo/done]] when done. A more complete [[design/roadmap/]] is also available. [[!inline pages="./todo/* and !./todo/done and !link(done) and !*/Discussion" actions=yes postform=yes show=0 archive=yes]] diff --git a/doc/todo/Bittorrent-like_features.mdwn b/doc/todo/Bittorrent-like_features.mdwn index 41988a422f..1dfe2c627a 100644 --- a/doc/todo/Bittorrent-like_features.mdwn +++ b/doc/todo/Bittorrent-like_features.mdwn @@ -29,6 +29,8 @@ Another thing, this would be completely trackerless. You just use remote groups This was originally posted [[as a forum post|forum/Wishlist:_Bittorrent-like_transfers]] by [[users/GLITTAH]]. +Update: note how [[design/assistant/telehash/]] may be able to answer this specific use case. + Using an external client (addurl torrent support) ================================================= diff --git a/doc/todo/Bittorrent-like_features/comment_5_194dd0e8404ea72af9fb6ff34b994998._comment b/doc/todo/Bittorrent-like_features/comment_5_194dd0e8404ea72af9fb6ff34b994998._comment new file mode 100644 index 0000000000..620c82e973 --- /dev/null +++ b/doc/todo/Bittorrent-like_features/comment_5_194dd0e8404ea72af9fb6ff34b994998._comment @@ -0,0 +1,20 @@ +[[!comment format=mdwn + username="https://id.koumbit.net/anarcat" + ip="2001:1928:1:9::1" + subject="comment 5" + date="2014-04-01T04:43:16Z" + content=""" +re #3, sure, magnet link support would be awesome as well but i'd prefer to start with something i could digest more easily. + +looking at the source, it seems to me that the [quvi implementation](http://source.git-annex.branchable.com/?p=source.git;a=commitdiff;h=46b6d75) could serve as an example as to how this would work. more particularly, there's this concept of a [downloader](http://source.git-annex.branchable.com/?p=source.git;a=commitdiff;h=46b6d75#patch5) that can be used to tap into `addurl` directly. there's a check to see if the downloader is supported, for example. + +so we would need: + +1. see if the URL / magnet link can be turned into a .torrent somehow +2. figure out what the filename(s!) will be +3. start the torrent and wait for its completion, ideally with some progress bar + +i asked around to see if transmission-remote could do this, because it would be nice if we could use an existing daemon (instead of having to rebootstrap the whole DHT at every download). so far, I can't see how it could be done cleanly - maybe we would need to use the simpler \"bittorrent\" commandline client, or maybe tap into libtorrent... + +in any case, one of the key problems here is that addurl assumes that the URL maps to a single file, not a directory full of file, which is the way bittorrent works. I am not sure how to fix that assumption. +"""]] diff --git a/doc/todo/LIst_of_Available_Remotes_in_Webapp.mdwn b/doc/todo/LIst_of_Available_Remotes_in_Webapp.mdwn new file mode 100644 index 0000000000..89274bb8dd --- /dev/null +++ b/doc/todo/LIst_of_Available_Remotes_in_Webapp.mdwn @@ -0,0 +1 @@ +When using git-annex in a distributed fashion (lots of repos everywhere) It is easy to lose track of which remotes has a particular repo and enable it. Currently I have to run `git annex info` and see which remotes are available then add them through the webapp. Would it be possible to make webapp show all repos not just the ones it is syncing give an option to enable it. diff --git a/doc/todo/New_special_remote_suggeston_-_clean_directory.mdwn b/doc/todo/New_special_remote_suggeston_-_clean_directory.mdwn index 9fd3c5a202..98dd58d5e4 100644 --- a/doc/todo/New_special_remote_suggeston_-_clean_directory.mdwn +++ b/doc/todo/New_special_remote_suggeston_-_clean_directory.mdwn @@ -13,3 +13,11 @@ This special remote could be thought of as the 'least common denominator of spec First and foremost, this can't be (really really shouldn't be) a trusted remote; my wife could accidentally delete all files on the NAS while I am away. So my local git-annex shouldn't assume the NAS counts towards numcopies (unless I'm a real masochist). Secondly, what to do when files change/are added/removed on the special remote? Probably the same thing that the assistant does with everything. The only thing special is that new/modified files will need to be copied locally from this special remote before being added to the annex (to get hash and such). + +> This is not feaisble given git-annex's design. If I wanted to +> make something completely unlike git-annex, I suppose it could be done, +> but it's off topic here. [[wontfix|done]]. +> +> If you want to use git-annex on a Synology NAS, the arm standalone build +> will work, and then you can use the command-line, or the assistant +> to maintain a git repository that contains your files as desired. --[[Joey]] diff --git a/doc/todo/Pause_all_transfers_in_all_annexes_watched_by_the_assistant.mdwn b/doc/todo/Pause_all_transfers_in_all_annexes_watched_by_the_assistant.mdwn new file mode 100644 index 0000000000..2ce33f726b --- /dev/null +++ b/doc/todo/Pause_all_transfers_in_all_annexes_watched_by_the_assistant.mdwn @@ -0,0 +1,11 @@ +## Use case: + +You have a few annexes that the assistant is watching for you. You're somewhere with poor wifi speed. You also just added a bunch of big files to a few annexes. Now all of a sudden your connection suffers and you want an easy way to pause all transfers until you're on a faster connection without losing the automatic 'add' and such of the assistant (iow: without having to shutdown the daemon). + +## Proposal: + +A "Pause all transfers" button in the webapp that pauses all transfers from all annexes the assistant is watching. + +It should toggle to "Resume all transfers" when pushed so you can also easily start the transfers again when you get somewhere else. + +This may or may not make more sense if the webapp showed all watched repos in a single view (instead of the separate pages/views as it is now). diff --git a/doc/todo/Recursive_addurl_simlar_to_wget_--recursive.mdwn b/doc/todo/Recursive_addurl_simlar_to_wget_--recursive.mdwn new file mode 100644 index 0000000000..bd0d9f1703 --- /dev/null +++ b/doc/todo/Recursive_addurl_simlar_to_wget_--recursive.mdwn @@ -0,0 +1,7 @@ +## Use Case + +I want to import a bunch of files that are hosted somewhere, they nicely sorted by year and such. Instead of addurl'ing each by hand (or writing a custom script each time this happens) I want to simply: + +git-annex addurl --recursive http://somehost.tld/somedir/ + +For sanity, mimicking wget closely with default depth of 5, but customizable with the --level switch. diff --git a/doc/todo/Recursive_addurl_simlar_to_wget_--recursive/comment_1_4ecd9ddba1b63b571555ec9bef18e2d8._comment b/doc/todo/Recursive_addurl_simlar_to_wget_--recursive/comment_1_4ecd9ddba1b63b571555ec9bef18e2d8._comment new file mode 100644 index 0000000000..72326c478f --- /dev/null +++ b/doc/todo/Recursive_addurl_simlar_to_wget_--recursive/comment_1_4ecd9ddba1b63b571555ec9bef18e2d8._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.244" + subject="comment 1" + date="2014-04-07T20:10:51Z" + content=""" +Recursively traversing websites is *hard*, so I would rather leave it out of git-annex. +"""]] diff --git a/doc/todo/Time_Stamping_of_Events_in_Webapp.mdwn b/doc/todo/Time_Stamping_of_Events_in_Webapp.mdwn new file mode 100644 index 0000000000..a1f3fe6ea2 --- /dev/null +++ b/doc/todo/Time_Stamping_of_Events_in_Webapp.mdwn @@ -0,0 +1 @@ +Currently events happening in the webapp (sync upload etc. on the right) has no time stamp thus user has no way to tell when was the last sync happened. Which is problematic when not using XMPP and repos lag behind. diff --git a/doc/todo/Use_a_remote_as_a_sharing_site_for_files_with_obfuscated_URLs/comment_2_735afa6f87a93cdf333c17da32010620._comment b/doc/todo/Use_a_remote_as_a_sharing_site_for_files_with_obfuscated_URLs/comment_2_735afa6f87a93cdf333c17da32010620._comment new file mode 100644 index 0000000000..b2e6c0dace --- /dev/null +++ b/doc/todo/Use_a_remote_as_a_sharing_site_for_files_with_obfuscated_URLs/comment_2_735afa6f87a93cdf333c17da32010620._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://id.koumbit.net/anarcat" + ip="2001:1928:1:9::1" + subject="comment 2" + date="2014-04-07T04:35:39Z" + content=""" +i wonder if the assistant or the new daemon couldn't do this job as well... -- [[anarcat]] +"""]] diff --git a/doc/todo/Views_Demo.mdwn b/doc/todo/Views_Demo.mdwn index 2587642e34..54704afa69 100644 --- a/doc/todo/Views_Demo.mdwn +++ b/doc/todo/Views_Demo.mdwn @@ -11,3 +11,5 @@ So, are you considering a metadata syntax that can support complex metadata? One FWIW, Bob + +> [[closing|done]]; requested feature was already present --[[Joey]] diff --git a/doc/todo/clear_file_names_in_special_remotes.mdwn b/doc/todo/clear_file_names_in_special_remotes.mdwn new file mode 100644 index 0000000000..1b6a9f9355 --- /dev/null +++ b/doc/todo/clear_file_names_in_special_remotes.mdwn @@ -0,0 +1,13 @@ +To properly use amazon AWS S3 for CDN, we need to publish videos to S3. Ideally, we would like to do this via git-annex as the back-end of video.debian.net is being migrated to git-annex by me, atm. + +Obviously, we will need clear text names and proper directory structure, not SHA512E file names. This would need to be supported by the S3 special remote. + +I talked to TobiasTheViking in the past and he hinted at a reasonably clean way to do this, but that a clean solution would need support from git-annex. I will link him to this page and ask him to supply whatever info is needed. + + +Thanks, +Richard + +> This is not feaisble given git-annex's design. If I wanted to +> make something completely unlike git-annex, I suppose it could be done, +> but it's off topic here. [[wontfix|done]] --[[Joey]] diff --git a/doc/todo/clear_file_names_in_special_remotes/comment_1_630f17c9a7ce9a77d5d5867a6e0c799b._comment b/doc/todo/clear_file_names_in_special_remotes/comment_1_630f17c9a7ce9a77d5d5867a6e0c799b._comment new file mode 100644 index 0000000000..7ca8e19167 --- /dev/null +++ b/doc/todo/clear_file_names_in_special_remotes/comment_1_630f17c9a7ce9a77d5d5867a6e0c799b._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.41" + subject="comment 1" + date="2014-03-26T17:26:37Z" + content=""" +I don't see how this can possibly be done. A single git-annex object can have any number of file names, which can change at any time. +"""]] diff --git a/doc/todo/clear_file_names_in_special_remotes/comment_2_823c279683ac3f39c921be3fcbf6bfe2._comment b/doc/todo/clear_file_names_in_special_remotes/comment_2_823c279683ac3f39c921be3fcbf6bfe2._comment new file mode 100644 index 0000000000..b7f5a409ea --- /dev/null +++ b/doc/todo/clear_file_names_in_special_remotes/comment_2_823c279683ac3f39c921be3fcbf6bfe2._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawl9sYlePmv1xK-VvjBdN-5doOa_Xw-jH4U" + nickname="Richard" + subject="comment 2" + date="2014-03-26T22:32:18Z" + content=""" +In that case, we would need to export the same file name several times, just like direct mode does. + +Could files be tracked via metadata? And yes, fsck would be... interesting... +"""]] diff --git a/doc/todo/clear_file_names_in_special_remotes/comment_3_4704e465025b543e47c18d565abd2747._comment b/doc/todo/clear_file_names_in_special_remotes/comment_3_4704e465025b543e47c18d565abd2747._comment new file mode 100644 index 0000000000..a925cb2de4 --- /dev/null +++ b/doc/todo/clear_file_names_in_special_remotes/comment_3_4704e465025b543e47c18d565abd2747._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.41" + subject="comment 3" + date="2014-03-27T17:44:46Z" + content=""" +Sounds like \"I want a pony to me\". +"""]] diff --git a/doc/todo/make___34__itemdate__34___valid_importfeed_template_option.mdwn b/doc/todo/make___34__itemdate__34___valid_importfeed_template_option.mdwn new file mode 100644 index 0000000000..9b6f6ce7c0 --- /dev/null +++ b/doc/todo/make___34__itemdate__34___valid_importfeed_template_option.mdwn @@ -0,0 +1,18 @@ +Some podcasts don't include a sortable date as the first thing in their episode title, which makes listening to them in order challenging if not impossible. + +The date the item was posted is part of the RSS standard, so we should parse that and provide a new importfeed template option "itemdate". + +(For the curious, I tried "itemid" thinking that might give me something close, but it doesn't. I used --template='${feedtitle}/${itemid}-${itemtitle}${extension}' and get: + + http___openmetalcast.com__p_1163-Open_Metalcast_Episode__93__Headless_Chicken.ogg + +or + + http___www.folkalley.com_music_podcasts__name_2013_08_21_alleycast_6_13.mp3-Alleycast___06.13.mp3 + +that "works" but is ugly :) + +Would love to be able to put a YYYYMMDD at the beginning and then the title. + +> [[done]]; itempubdate will use form YYYY-MM-DD (or the raw date string +> if the feed does not use a parsable form). --[[Joey]] diff --git a/doc/todo/make___34__itemdate__34___valid_importfeed_template_option/comment_1_9fa523d1eabb6e029a91413770e9af72._comment b/doc/todo/make___34__itemdate__34___valid_importfeed_template_option/comment_1_9fa523d1eabb6e029a91413770e9af72._comment new file mode 100644 index 0000000000..c9cf2ba516 --- /dev/null +++ b/doc/todo/make___34__itemdate__34___valid_importfeed_template_option/comment_1_9fa523d1eabb6e029a91413770e9af72._comment @@ -0,0 +1,16 @@ +[[!comment format=mdwn + username="http://grossmeier.net/" + nickname="greg" + subject="Without knowing Haskell" + date="2014-04-06T04:55:31Z" + content=""" +Maybe this just requires adding: + + , fieldMaybe \"itemdate\" $ getFeedPubDate $ item i + +on line 214 in Command/ImportFeed.hs ?? + +It is supported by [Text.Feed.Query](http://hackage.haskell.org/package/feed-0.3.9.2/docs/Text-Feed-Query.html) + +I have no haskell dev env so I can't test this, but if my suggestion is true, I might set one up :) +"""]] diff --git a/doc/todo/make___34__itemdate__34___valid_importfeed_template_option/comment_2_9090bb66713f48fbdd1e2a3f1292b7ba._comment b/doc/todo/make___34__itemdate__34___valid_importfeed_template_option/comment_2_9090bb66713f48fbdd1e2a3f1292b7ba._comment new file mode 100644 index 0000000000..8ebc5fcd7a --- /dev/null +++ b/doc/todo/make___34__itemdate__34___valid_importfeed_template_option/comment_2_9090bb66713f48fbdd1e2a3f1292b7ba._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.244" + subject="comment 2" + date="2014-04-07T19:51:27Z" + content=""" +https://github.com/sof/feed/issues/6 +"""]] diff --git a/doc/todo/required_content.mdwn b/doc/todo/required_content.mdwn index 851e652aeb..6afeee5c9a 100644 --- a/doc/todo/required_content.mdwn +++ b/doc/todo/required_content.mdwn @@ -5,3 +5,19 @@ like preferred content, which is enforced. So, required content. For example, I might want a repository that is required to contain `*.jpeg`. This would make get --auto get it (it's implicitly part of the preferred content), and would make drop refuse to drop it. + +> I've implemented the basic required content. Currently only configurable +> via `vicfg`, because I don't think a lot of people are going to want to +> use it. +> +> Note that I did not yet add the active verification discussed below. +> So if required content is set to `not inallgroup=backup`, or +> `not copies=10`, trying to drop a file will not go off and prove +> that there are 10 copies or that the file is in every repository in +> the backup group. It will assume that the location log is accurate +> and go by that. +> +> I think this is enough to cover Richard's case, at least. +> In his example, A B and C are in group anchor and have required +> content set to `include=*`, and D E F have it set to +> `not inallgroup=anchor`. --[[Joey]] diff --git a/doc/todo/tahoe_lfs_for_reals.mdwn b/doc/todo/tahoe_lfs_for_reals.mdwn index e5b4a841d3..2caeef11d3 100644 --- a/doc/todo/tahoe_lfs_for_reals.mdwn +++ b/doc/todo/tahoe_lfs_for_reals.mdwn @@ -12,10 +12,12 @@ but a tahoe-lafs special remote would be more flexible. To support a special remote, a mapping is needed from git-annex keys to Tahoe keys, stored in the git-annex branch. -> This is now done, however, there are 2 known +> This is now done, however, there are 3 known > problems: > > * tahoe start run unncessarily > * web.port can conflict -> +> * Nothing renews leases, which is a problem on grids that expire. +> + > --[[Joey]] diff --git a/doc/todo/using_file_metadata_for_preferred___40__wanted__41___content.mdwn b/doc/todo/using_file_metadata_for_preferred___40__wanted__41___content.mdwn new file mode 100644 index 0000000000..d9226d21f8 --- /dev/null +++ b/doc/todo/using_file_metadata_for_preferred___40__wanted__41___content.mdwn @@ -0,0 +1,12 @@ +Having the option of choosing for every file if we want it in our repository or not would be a great feature. It is currently possible using the wanted expression, but it is not very flexible, or it becomes unmaintainable. + +I tried with two repositories a and b, with the following wanted expressions : + +* for a: `not metadata=unwanted=` +* for b: `not metadata=unwanted=` + +I think those expressions should be included in standard wanted expressions. + +Also, to improbe the feature, it should be possible to set (or remove) metadata in directories, and those should automatically affect their content. + +And we could imagine a `git annex unwant` command that would add the unwanted metadata to a file, copy it to other repositories, and attempt to drop it. diff --git a/doc/todo/wishlist:_special_remote_Ubuntu_One/comment_2_17e948acb1e29793cf172cd6def4160b._comment b/doc/todo/wishlist:_special_remote_Ubuntu_One/comment_2_17e948acb1e29793cf172cd6def4160b._comment new file mode 100644 index 0000000000..20230e3f98 --- /dev/null +++ b/doc/todo/wishlist:_special_remote_Ubuntu_One/comment_2_17e948acb1e29793cf172cd6def4160b._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="madduck" + ip="2001:a60:f0fb:0:224:d7ff:fe04:c82c" + subject="Ubuntu One to be discontinued" + date="2014-04-07T05:11:52Z" + content=""" +Thanksfully, Canonical have stopped this silliness, Ubuntu One will be discontinued, so this todo can be marked \"wontfix\" and archived. +"""]] diff --git a/doc/users/anarcat.mdwn b/doc/users/anarcat.mdwn index df98c93304..003d412b75 100644 --- a/doc/users/anarcat.mdwn +++ b/doc/users/anarcat.mdwn @@ -9,7 +9,7 @@ My tips ... or the ones I commented it, to be more precise. -[[!inline pages="tips/* and and link(users/anarcat) and !bugs/*/*" sort=mtime feeds=no actions=yes archive=yes show=0]] +[[!inline pages="tips/* and and link(users/anarcat)" sort=mtime feeds=no actions=yes archive=yes show=0]] My todos @@ -18,13 +18,13 @@ My todos ... same. [[!inline pages="todo/* and !todo/done and !link(todo/done) and -link(users/anarcat) and !todo/*/*" sort=mtime feeds=no actions=yes archive=yes show=0]] +link(users/anarcat)" sort=mtime feeds=no actions=yes archive=yes show=0]] Done ---- [[!inline pages="todo/* and !todo/done and link(todo/done) and -link(users/anarcat) and !todo/*/*" feeds=no actions=yes archive=yes show=0]] +link(users/anarcat)" feeds=no actions=yes archive=yes show=0]] My bugs ======= @@ -32,13 +32,13 @@ My bugs ... same. [[!inline pages="bugs/* and !bugs/done and !link(bugs/done) and -link(users/anarcat) and !bugs/*/*" sort=mtime feeds=no actions=yes archive=yes show=0]] +link(users/anarcat)" sort=mtime feeds=no actions=yes archive=yes show=0]] Fixed ----- [[!inline pages="bugs/* and !bugs/done and link(bugs/done) and -link(users/anarcat) and !bugs/*/*" feeds=no actions=yes archive=yes show=0]] +link(users/anarcat)" feeds=no actions=yes archive=yes show=0]] Forum posts =========== diff --git a/doc/walkthrough/backups/comment_1_d0244791d2abbf29553546a6a6568a0f._comment b/doc/walkthrough/backups/comment_1_d0244791d2abbf29553546a6a6568a0f._comment new file mode 100644 index 0000000000..466b3d3694 --- /dev/null +++ b/doc/walkthrough/backups/comment_1_d0244791d2abbf29553546a6a6568a0f._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="madduck" + ip="2001:a60:f0fb:0:224:d7ff:fe04:c82c" + subject="Warn while inconsistent" + date="2014-04-06T20:44:17Z" + content=""" +Sure, git-annex prevents me from dropping files unless there are numcopies around elsewhere, but shouldn't it also ensure that numcopies cannot be set unless that requirement is already met? + +Furthermore, shouldn't it ensure that when new files are added, they are automatically distributed to fulfill the requirement? +"""]] diff --git a/git-annex.cabal b/git-annex.cabal index 89146213c3..7c6901181a 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -1,5 +1,5 @@ Name: git-annex -Version: 5.20140320 +Version: 5.20140412 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess @@ -85,6 +85,9 @@ Flag Tahoe Flag CryptoHash Description: Enable use of cryptohash for checksumming +Flag DesktopNotify + Description: Enable desktop environment notifications + Flag EKG Description: Enable use of EKG to monitor git-annex as it runs (at http://localhost:4242/) Default: False @@ -98,7 +101,7 @@ Executable git-annex base (>= 4.5 && < 4.9), monad-control, MonadCatchIO-transformers, IfElse, text, QuickCheck >= 2.1, bloomfilter, edit-distance, process, SafeSemaphore, uuid, random, dlist, unix-compat, async, stm (>= 2.3), - data-default, case-insensitive + data-default, case-insensitive, shakespeare CC-Options: -Wall GHC-Options: -Wall Extensions: PackageImports @@ -168,10 +171,16 @@ Executable git-annex CPP-Options: -DWITH_KQUEUE C-Sources: Utility/libkqueue.c - if os(linux) && flag(Dbus) - Build-Depends: dbus (>= 0.10.3) - CPP-Options: -DWITH_DBUS + if (os(linux)) + if flag(Dbus) + Build-Depends: dbus (>= 0.10.3) + CPP-Options: -DWITH_DBUS + if flag(DesktopNotify) + if flag(Dbus) + Build-Depends: dbus (>= 0.10.3), fdo-notify (>= 0.3) + CPP-Options: -DWITH_DESKTOP_NOTIFY -DWITH_DBUS_NOTIFICATIONS + if flag(Android) Build-Depends: data-endian CPP-Options: -D__ANDROID__ -DANDROID_SPLICES -D__NO_TH__ @@ -202,7 +211,7 @@ Executable git-annex CPP-Options: -DWITH_DNS if flag(Feed) - Build-Depends: feed + Build-Depends: feed (>= 0.3.9.2) CPP-Options: -DWITH_FEED if flag(Quvi) diff --git a/standalone/android/buildchroot b/standalone/android/buildchroot index 44337eb0c1..396beab78f 100755 --- a/standalone/android/buildchroot +++ b/standalone/android/buildchroot @@ -20,7 +20,7 @@ chroot debian-stable-android "tmp/$(basename $0)-inchroot" echo echo -echo "debian-stable-android is set up, with a user androidbuilder" +echo "debian-stable-android is set up, with a user builder" echo "your next step is probably to check out git-annex in this chroot" echo "and run standalone/android/install-haskell-packages" echo diff --git a/standalone/android/buildchroot-inchroot b/standalone/android/buildchroot-inchroot index a5fa2ce858..add03f8472 100755 --- a/standalone/android/buildchroot-inchroot +++ b/standalone/android/buildchroot-inchroot @@ -7,7 +7,7 @@ if [ "$(whoami)" != root ]; then fi # java needs this mounted to work -mount -t proc proc /proc +mount -t proc proc /proc || true echo "deb-src http://ftp.us.debian.org/debian stable main" >> /etc/apt/sources.list apt-get update @@ -22,5 +22,5 @@ apt-get clean wget http://snapshot.debian.org/archive/debian/20130903T155330Z/pool/main/a/automake-1.14/automake_1.14-1_all.deb dpkg -i automake*.deb rm *.deb -useradd androidbuilder --create-home -su androidbuilder -c $0-asuser +useradd builder --create-home || true +su builder -c $0-asuser diff --git a/standalone/android/buildchroot-inchroot-asuser b/standalone/android/buildchroot-inchroot-asuser index 710e76e468..faf8cbc029 100755 --- a/standalone/android/buildchroot-inchroot-asuser +++ b/standalone/android/buildchroot-inchroot-asuser @@ -3,7 +3,7 @@ set -e cd -rm -rf .ghc .cabal +rm -rf .ghc .cabal .android cabal update cabal install happy alex --bindir=$HOME/bin PATH=$HOME/bin:$PATH diff --git a/standalone/android/haskell-patches/unbounded-delays_crossbuild.patch b/standalone/android/haskell-patches/unbounded-delays_crossbuild.patch new file mode 100644 index 0000000000..dd0a7fca90 --- /dev/null +++ b/standalone/android/haskell-patches/unbounded-delays_crossbuild.patch @@ -0,0 +1,25 @@ +From 0ad071f80ee72e7b8ca5b0b70dfae5bbf8677969 Mon Sep 17 00:00:00 2001 +From: Joey Hess +Date: Wed, 12 Mar 2014 12:18:17 -0400 +Subject: [PATCH] cross build + +--- + unbounded-delays.cabal | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/unbounded-delays.cabal b/unbounded-delays.cabal +index 76d0a50..0f27569 100644 +--- a/unbounded-delays.cabal ++++ b/unbounded-delays.cabal +@@ -1,7 +1,7 @@ + name: unbounded-delays + version: 0.1.0.6 + cabal-version: >= 1.6 +-build-type: Custom ++build-type: Simple + author: Bas van Dijk + Roel van Dijk + maintainer: Bas van Dijk +-- +1.7.10.4 + diff --git a/standalone/android/install-haskell-packages b/standalone/android/install-haskell-packages index 19e6b5c1cc..8f2702ab4c 100755 --- a/standalone/android/install-haskell-packages +++ b/standalone/android/install-haskell-packages @@ -108,6 +108,7 @@ install_pkgs () { patched gnutls patched libxml-sax patched network-protocol-xmpp + patched unbounded-delays cd ..