diff --git a/Annex.hs b/Annex.hs index b427efd595..820c1d5698 100644 --- a/Annex.hs +++ b/Annex.hs @@ -60,6 +60,7 @@ import Types.FileMatcher import Types.NumCopies import Types.LockPool import Types.MetaData +import Types.CleanupActions import qualified Utility.Matcher import qualified Data.Map as M import qualified Data.Set as S @@ -88,6 +89,7 @@ data AnnexState = AnnexState , gitconfig :: GitConfig , backends :: [BackendA Annex] , remotes :: [Types.Remote.RemoteA Annex] + , remoteannexstate :: M.Map UUID AnnexState , output :: MessageState , force :: Bool , fast :: Bool @@ -113,7 +115,7 @@ data AnnexState = AnnexState , flags :: M.Map String Bool , fields :: M.Map String String , modmeta :: [ModMeta] - , cleanup :: M.Map String (Annex ()) + , cleanup :: M.Map CleanupAction (Annex ()) , inodeschanged :: Maybe Bool , useragent :: Maybe String , errcounter :: Integer @@ -128,6 +130,7 @@ newState c r = AnnexState , gitconfig = c , backends = [] , remotes = [] + , remoteannexstate = M.empty , output = defaultMessageState , force = False , fast = False @@ -208,9 +211,9 @@ setField field value = changeState $ \s -> s { fields = M.insertWith' const field value $ fields s } {- Adds a cleanup action to perform. -} -addCleanup :: String -> Annex () -> Annex () -addCleanup uid a = changeState $ \s -> - s { cleanup = M.insertWith' const uid a $ cleanup s } +addCleanup :: CleanupAction -> Annex () -> Annex () +addCleanup k a = changeState $ \s -> + s { cleanup = M.insertWith' const k a $ cleanup s } {- Sets the type of output to emit. -} setOutput :: OutputType -> Annex () diff --git a/Annex/CatFile.hs b/Annex/CatFile.hs index fc722c8e71..6a778db039 100644 --- a/Annex/CatFile.hs +++ b/Annex/CatFile.hs @@ -80,7 +80,7 @@ catKey = catKey' True catKey' :: Bool -> Ref -> FileMode -> Annex (Maybe Key) catKey' modeguaranteed ref mode | isSymLink mode = do - l <- fromInternalGitPath . encodeW8 . L.unpack <$> get + l <- fromInternalGitPath . decodeBS <$> get return $ if isLinkToAnnex l then fileKey $ takeFileName l else Nothing diff --git a/Annex/Content.hs b/Annex/Content.hs index 740ed8bbc7..9c71037de1 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -24,6 +24,7 @@ module Annex.Content ( removeAnnex, fromAnnex, moveBad, + KeyLocation(..), getKeysPresent, saveState, downloadUrl, @@ -466,22 +467,33 @@ moveBad key = do logStatus key InfoMissing return dest -{- List of keys whose content exists in the annex. -} -getKeysPresent :: Annex [Key] -getKeysPresent = do +data KeyLocation = InAnnex | InRepository + +{- List of keys whose content exists in the specified location. + + - InAnnex only lists keys under .git/annex/objects, + - while InRepository, in direct mode, also finds keys located in the + - work tree. + - + - Note that InRepository has to check whether direct mode files + - have goodContent. + -} +getKeysPresent :: KeyLocation -> Annex [Key] +getKeysPresent keyloc = do direct <- isDirect dir <- fromRepo gitAnnexObjectDir - liftIO $ traverse direct (2 :: Int) dir + s <- getstate direct + liftIO $ traverse s direct (2 :: Int) dir where - traverse direct depth dir = do + traverse s direct depth dir = do contents <- catchDefaultIO [] (dirContents dir) if depth == 0 then do - contents' <- filterM (present direct) contents + contents' <- filterM (present s direct) contents let keys = mapMaybe (fileKey . takeFileName) contents' continue keys [] else do - let deeper = traverse direct (depth - 1) + let deeper = traverse s direct (depth - 1) continue [] (map deeper contents) continue keys [] = return keys continue keys (a:as) = do @@ -489,15 +501,31 @@ getKeysPresent = do morekeys <- unsafeInterleaveIO a continue (morekeys++keys) as - {- In indirect mode, look for the key. In direct mode, - - the inode cache file is only present when a key's content - - is present, so can be used as a surrogate if the content - - is not located in the annex directory. -} - present False d = doesFileExist $ contentfile d - present True d = doesFileExist (contentfile d ++ ".cache") - <||> present False d + present _ False d = presentInAnnex d + present s True d = presentDirect s d <||> presentInAnnex d + + presentInAnnex = doesFileExist . contentfile contentfile d = d takeFileName d + presentDirect s d = case keyloc of + InAnnex -> return False + InRepository -> case fileKey (takeFileName d) of + Nothing -> return False + Just k -> Annex.eval s $ + anyM (goodContent k) =<< associatedFiles k + + {- In order to run Annex monad actions within unsafeInterleaveIO, + - the current state is taken and reused. No changes made to this + - state will be preserved. + - + - As an optimsation, call inodesChanged to prime the state with + - a cached value that will be used in the call to goodContent. + -} + getstate direct = do + when direct $ + void $ inodesChanged + Annex.getState id + {- Things to do to record changes to content when shutting down. - - It's acceptable to avoid committing changes to the branch, diff --git a/Annex/FileMatcher.hs b/Annex/FileMatcher.hs index 7507952803..ae1bbb77bf 100644 --- a/Annex/FileMatcher.hs +++ b/Annex/FileMatcher.hs @@ -56,23 +56,27 @@ parsedToMatcher parsed = case partitionEithers parsed of ([], vs) -> Right $ generate vs (es, _) -> Left $ unwords $ map ("Parse failure: " ++) es -exprParser :: GroupMap -> M.Map UUID RemoteConfig -> Maybe UUID -> String -> [Either String (Token MatchFiles)] -exprParser groupmap configmap mu expr = +exprParser :: FileMatcher -> FileMatcher -> GroupMap -> M.Map UUID RemoteConfig -> Maybe UUID -> String -> [Either String (Token MatchFiles)] +exprParser matchstandard matchgroupwanted groupmap configmap mu expr = map parse $ tokenizeMatcher expr where - parse = parseToken + parse = parseToken + matchstandard + matchgroupwanted (limitPresent mu) (limitInDir preferreddir) groupmap preferreddir = fromMaybe "public" $ M.lookup "preferreddir" =<< (`M.lookup` configmap) =<< mu -parseToken :: MkLimit -> MkLimit -> GroupMap -> String -> Either String (Token MatchFiles) -parseToken checkpresent checkpreferreddir groupmap t +parseToken :: FileMatcher -> FileMatcher -> MkLimit -> MkLimit -> GroupMap -> String -> Either String (Token MatchFiles) +parseToken matchstandard matchgroupwanted checkpresent checkpreferreddir groupmap t | t `elem` tokens = Right $ token t + | t == "standard" = call matchstandard + | t == "groupwanted" = call matchgroupwanted | t == "present" = use checkpresent | t == "inpreferreddir" = use checkpreferreddir - | t == "unused" = Right (Operation limitUnused) + | t == "unused" = Right $ Operation limitUnused | otherwise = maybe (Left $ "near " ++ show t) use $ M.lookup k $ M.fromList [ ("include", limitInclude) @@ -89,6 +93,8 @@ parseToken checkpresent checkpreferreddir groupmap t where (k, v) = separate (== '=') t use a = Operation <$> a v + call sub = Right $ Operation $ \notpresent mi -> + matchMrun sub $ \a -> a notpresent mi {- This is really dumb tokenization; there's no support for quoted values. - Open and close parens are always treated as standalone tokens; @@ -109,5 +115,5 @@ largeFilesMatcher = go =<< annexLargeFiles <$> Annex.getGitConfig rc <- readRemoteLog u <- getUUID either badexpr return $ - parsedToMatcher $ exprParser gm rc (Just u) expr + parsedToMatcher $ exprParser matchAll matchAll gm rc (Just u) expr badexpr e = error $ "bad annex.largefiles configuration: " ++ e diff --git a/Annex/Init.hs b/Annex/Init.hs index 57379535d5..e095aef61e 100644 --- a/Annex/Init.hs +++ b/Annex/Init.hs @@ -198,7 +198,7 @@ enableDirectMode = unlessM isDirect $ do -} fixBadBare :: Annex () fixBadBare = whenM checkBadBare $ do - ks <- getKeysPresent + ks <- getKeysPresent InAnnex liftIO $ debugM "Init" $ unwords [ "Detected bad bare repository with" , show (length ks) diff --git a/Annex/MetaData.hs b/Annex/MetaData.hs index 68aef33f1a..f382f0ab1a 100644 --- a/Annex/MetaData.hs +++ b/Annex/MetaData.hs @@ -5,11 +5,15 @@ - Licensed under the GNU GPL version 3 or higher. -} -module Annex.MetaData where +module Annex.MetaData ( + genMetaData, + module X +) where import Common.Annex import qualified Annex -import Types.MetaData +import Types.MetaData as X +import Annex.MetaData.StandardFields as X import Logs.MetaData import Annex.CatFile @@ -19,15 +23,6 @@ import Data.Time.Calendar import Data.Time.Clock import Data.Time.Clock.POSIX -tagMetaField :: MetaField -tagMetaField = mkMetaFieldUnchecked "tag" - -yearMetaField :: MetaField -yearMetaField = mkMetaFieldUnchecked "year" - -monthMetaField :: MetaField -monthMetaField = mkMetaFieldUnchecked "month" - {- Adds metadata for a file that has just been ingested into the - annex, but has not yet been committed to git. - diff --git a/Annex/MetaData/StandardFields.hs b/Annex/MetaData/StandardFields.hs new file mode 100644 index 0000000000..d41fb1506f --- /dev/null +++ b/Annex/MetaData/StandardFields.hs @@ -0,0 +1,47 @@ +{- git-annex metadata, standard fields + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Annex.MetaData.StandardFields ( + tagMetaField, + yearMetaField, + monthMetaField, + lastChangedField, + mkLastChangedField, + isLastChangedField +) where + +import Types.MetaData + +import Data.List + +tagMetaField :: MetaField +tagMetaField = mkMetaFieldUnchecked "tag" + +yearMetaField :: MetaField +yearMetaField = mkMetaFieldUnchecked "year" + +monthMetaField :: MetaField +monthMetaField = mkMetaFieldUnchecked "month" + +lastChangedField :: MetaField +lastChangedField = mkMetaFieldUnchecked lastchanged + +mkLastChangedField :: MetaField -> MetaField +mkLastChangedField f = mkMetaFieldUnchecked (fromMetaField f ++ lastchangedSuffix) + +isLastChangedField :: MetaField -> Bool +isLastChangedField f + | f == lastChangedField = True + | otherwise = lastchanged `isSuffixOf` s && s /= lastchangedSuffix + where + s = fromMetaField f + +lastchanged :: String +lastchanged = "lastchanged" + +lastchangedSuffix :: String +lastchangedSuffix = "-lastchanged" diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs index aedf418f87..bd10a40d40 100644 --- a/Annex/Ssh.hs +++ b/Annex/Ssh.hs @@ -9,7 +9,6 @@ module Annex.Ssh ( sshCachingOptions, - sshCleanup, sshCacheDir, sshReadPort, ) where @@ -24,6 +23,7 @@ import qualified Build.SysConfig as SysConfig import qualified Annex import Config import Utility.Env +import Types.CleanupActions #ifndef mingw32_HOST_OS import Annex.Perms #endif @@ -31,7 +31,9 @@ import Annex.Perms {- Generates parameters to ssh to a given host (or user@host) on a given - port, with connection caching. -} sshCachingOptions :: (String, Maybe Integer) -> [CommandParam] -> Annex [CommandParam] -sshCachingOptions (host, port) opts = go =<< sshInfo (host, port) +sshCachingOptions (host, port) opts = do + Annex.addCleanup SshCachingCleanup sshCleanup + go =<< sshInfo (host, port) where go (Nothing, params) = ret params go (Just socketfile, params) = do @@ -144,8 +146,9 @@ sshCleanup = go =<< sshCacheDir withQuietOutput createProcessSuccess $ (proc "ssh" $ toCommand $ [ Params "-O stop" - ] ++ params ++ [Param "any"]) + ] ++ params ++ [Param "localhost"]) { cwd = Just dir } + liftIO $ nukeFile socketfile -- Cannot remove the lock file; other processes may -- be waiting on our exclusive lock to use it. diff --git a/Assistant.hs b/Assistant.hs index 3c79c476cc..67398f23b8 100644 --- a/Assistant.hs +++ b/Assistant.hs @@ -45,7 +45,6 @@ import Assistant.Threads.XMPPClient import Assistant.Threads.XMPPPusher #endif #else -#warning Building without the webapp. You probably need to install Yesod.. import Assistant.Types.UrlRenderer #endif import qualified Utility.Daemon diff --git a/Assistant/Alert/Utility.hs b/Assistant/Alert/Utility.hs index db2ea19250..73843be4cf 100644 --- a/Assistant/Alert/Utility.hs +++ b/Assistant/Alert/Utility.hs @@ -14,6 +14,7 @@ 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 @@ -43,8 +44,8 @@ compareAlertPairs (aid, Alert { alertClass = aclass, alertPriority = aprio }) (bid, Alert { alertClass = bclass, alertPriority = bprio }) = compare aprio bprio - `thenOrd` compare aid bid - `thenOrd` compare aclass bclass + `mappend` compare aid bid + `mappend` compare aclass bclass sortAlertPairs :: [AlertPair] -> [AlertPair] sortAlertPairs = sortBy compareAlertPairs diff --git a/Assistant/Install/Menu.hs b/Assistant/Install/Menu.hs index 22ca1da9c2..d095cdd887 100644 --- a/Assistant/Install/Menu.hs +++ b/Assistant/Install/Menu.hs @@ -21,7 +21,7 @@ installMenu command menufile iconsrcdir icondir = do writeDesktopMenuFile (fdoDesktopMenu command) menufile installIcon (iconsrcdir "logo.svg") $ iconFilePath (iconBaseName ++ ".svg") "scalable" icondir - installIcon (iconsrcdir "favicon.png") $ + installIcon (iconsrcdir "logo_16x16.png") $ iconFilePath (iconBaseName ++ ".png") "16x16" icondir #endif diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs index f90f742870..8d977194b2 100644 --- a/Assistant/Threads/WebApp.hs +++ b/Assistant/Threads/WebApp.hs @@ -73,7 +73,7 @@ webAppThread assistantdata urlrenderer noannex cannotrun postfirstrun listenhost #endif webapp <- WebApp <$> pure assistantdata - <*> (pack <$> genRandomToken) + <*> genAuthToken <*> getreldir <*> pure staticRoutes <*> pure postfirstrun @@ -125,7 +125,7 @@ myUrl tlssettings webapp addr = unpack $ yesodRender webapp urlbase DashboardR [ getTlsSettings :: Annex (Maybe TLS.TLSSettings) getTlsSettings = do -#ifdef WITH_WEBAPP_HTTPS +#ifdef WITH_WEBAPP_SECURE cert <- fromRepo gitAnnexWebCertificate privkey <- fromRepo gitAnnexWebPrivKey ifM (liftIO $ allM doesFileExist [cert, privkey]) diff --git a/Assistant/WebApp.hs b/Assistant/WebApp.hs index ece75d7ba6..e81a1d7120 100644 --- a/Assistant/WebApp.hs +++ b/Assistant/WebApp.hs @@ -14,6 +14,7 @@ import Assistant.WebApp.Types import Assistant.Common import Utility.NotificationBroadcaster import Utility.Yesod +import Utility.WebApp import Data.Text (Text) import Control.Concurrent @@ -36,7 +37,7 @@ newNotifier getbroadcaster = liftAssistant $ do webAppFormAuthToken :: Widget webAppFormAuthToken = do webapp <- liftH getYesod - [whamlet||] + [whamlet||] {- A button with an icon, and maybe label or tooltip, that can be - clicked to perform some action. diff --git a/Assistant/WebApp/Notifications.hs b/Assistant/WebApp/Notifications.hs index 9183709573..9108805c30 100644 --- a/Assistant/WebApp/Notifications.hs +++ b/Assistant/WebApp/Notifications.hs @@ -22,6 +22,7 @@ import Assistant.DaemonStatus import Assistant.Types.Buddies import Utility.NotificationBroadcaster import Utility.Yesod +import Utility.WebApp import Data.Text (Text) import qualified Data.Text as T @@ -64,7 +65,7 @@ notifierUrl route broadcaster = do [ "/" , T.intercalate "/" urlbits , "?auth=" - , secretToken webapp + , fromAuthToken (authToken webapp) ] getNotifierTransfersR :: Handler RepPlain diff --git a/Assistant/WebApp/RepoList.hs b/Assistant/WebApp/RepoList.hs index 56a3b9ea43..6a93cb4b9b 100644 --- a/Assistant/WebApp/RepoList.hs +++ b/Assistant/WebApp/RepoList.hs @@ -31,6 +31,7 @@ import qualified Data.Map as M import qualified Data.Set as S import qualified Data.Text as T import Data.Function +import Control.Concurrent type RepoList = [(RepoDesc, RepoId, Actions)] @@ -238,3 +239,15 @@ reorderCosts remote rs = zip rs'' (insertCostAfter costs i) costs = map Remote.cost rs' rs'' = (\(x, y) -> x ++ [remote] ++ y) $ splitAt (i + 1) rs' +getSyncNowRepositoryR :: UUID -> Handler () +getSyncNowRepositoryR uuid = do + u <- liftAnnex getUUID + if u == uuid + then do + thread <- liftAssistant $ asIO $ + reconnectRemotes True + =<< (syncRemotes <$> getDaemonStatus) + void $ liftIO $ forkIO thread + else maybe noop (liftAssistant . syncRemote) + =<< liftAnnex (Remote.remoteFromUUID uuid) + redirectBack diff --git a/Assistant/WebApp/Types.hs b/Assistant/WebApp/Types.hs index 7a23e4f58d..5d117bc3ae 100644 --- a/Assistant/WebApp/Types.hs +++ b/Assistant/WebApp/Types.hs @@ -41,7 +41,7 @@ mkYesodData "WebApp" $(parseRoutesFile "Assistant/WebApp/routes") data WebApp = WebApp { assistantData :: AssistantData - , secretToken :: Text + , authToken :: AuthToken , relDir :: Maybe FilePath , getStatic :: Static , postFirstRun :: Maybe (IO String) @@ -52,11 +52,11 @@ data WebApp = WebApp instance Yesod WebApp where {- Require an auth token be set when accessing any (non-static) route -} - isAuthorized _ _ = checkAuthToken secretToken + isAuthorized _ _ = checkAuthToken authToken {- Add the auth token to every url generated, except static subsite - urls (which can show up in Permission Denied pages). -} - joinPath = insertAuthToken secretToken excludeStatic + joinPath = insertAuthToken authToken excludeStatic where excludeStatic [] = True excludeStatic (p:_) = p /= "static" diff --git a/Assistant/WebApp/routes b/Assistant/WebApp/routes index 43b5dd8773..44e07c6dba 100644 --- a/Assistant/WebApp/routes +++ b/Assistant/WebApp/routes @@ -82,6 +82,7 @@ /config/repository/reorder RepositoriesReorderR GET +/config/repository/syncnow/#UUID SyncNowRepositoryR GET /config/repository/disable/#UUID DisableRepositoryR GET /config/repository/delete/confirm/#UUID DeleteRepositoryR GET diff --git a/Build/Configure.hs b/Build/Configure.hs index 593e3ada79..116a44215f 100644 --- a/Build/Configure.hs +++ b/Build/Configure.hs @@ -3,20 +3,14 @@ module Build.Configure where import System.Directory -import Data.List -import System.Process import Control.Applicative -import System.FilePath import System.Environment (getArgs) -import Data.Maybe import Control.Monad.IfElse import Control.Monad -import Data.Char import Build.TestConfig import Build.Version import Utility.SafeCommand -import Utility.Monad import Utility.ExternalSHA import Utility.Env import qualified Git.Version diff --git a/Build/DesktopFile.hs b/Build/DesktopFile.hs index 9f4ba5992c..6a5838f810 100644 --- a/Build/DesktopFile.hs +++ b/Build/DesktopFile.hs @@ -24,9 +24,7 @@ import System.Directory import System.Environment #ifndef mingw32_HOST_OS import System.Posix.User -import System.Posix.Files #endif -import System.FilePath import Data.Maybe systemwideInstall :: IO Bool diff --git a/Build/NullSoftInstaller.hs b/Build/NullSoftInstaller.hs index 7cfb08f273..b3d323ce23 100644 --- a/Build/NullSoftInstaller.hs +++ b/Build/NullSoftInstaller.hs @@ -67,7 +67,7 @@ uninstaller :: FilePath uninstaller = "git-annex-uninstall.exe" gitInstallDir :: Exp FilePath -gitInstallDir = fromString "$PROGRAMFILES\\Git\\cmd" +gitInstallDir = fromString "$PROGRAMFILES\\Git\\bin" startMenuItem :: Exp FilePath startMenuItem = "$SMPROGRAMS/git-annex.lnk" diff --git a/Build/TestConfig.hs b/Build/TestConfig.hs index 8628ebe58f..e55641fb06 100644 --- a/Build/TestConfig.hs +++ b/Build/TestConfig.hs @@ -7,8 +7,6 @@ import Utility.Monad import Utility.SafeCommand import System.IO -import System.Cmd -import System.Exit import System.FilePath import System.Directory diff --git a/BuildFlags.hs b/BuildFlags.hs index c0918097b9..e36cf6a14c 100644 --- a/BuildFlags.hs +++ b/BuildFlags.hs @@ -14,24 +14,36 @@ buildFlags = filter (not . null) [ "" #ifdef WITH_ASSISTANT , "Assistant" +#else +#warning Building without the assistant. #endif #ifdef WITH_WEBAPP , "Webapp" +#else +#warning Building without the webapp. You probably need to install Yesod.. #endif -#ifdef WITH_WEBAPP_HTTPS - , "Webapp-https" +#ifdef WITH_WEBAPP_SECURE + , "Webapp-secure" #endif #ifdef WITH_PAIRING , "Pairing" +#else +#warning Building without local pairing. #endif #ifdef WITH_TESTSUITE , "Testsuite" +#else +#warning Building without the testsuite. #endif #ifdef WITH_S3 , "S3" +#else +#warning Building without S3. #endif #ifdef WITH_WEBDAV , "WebDAV" +#else +#warning Building without WebDAV. #endif #ifdef WITH_INOTIFY , "Inotify" @@ -47,21 +59,29 @@ buildFlags = filter (not . null) #endif #ifdef WITH_XMPP , "XMPP" +#else +#warning Building without XMPP. #endif #ifdef WITH_DNS , "DNS" #endif #ifdef WITH_FEED , "Feeds" +#else +#warning Building without Feeds. #endif #ifdef WITH_QUVI , "Quvi" +#else +#warning Building without quvi. #endif #ifdef WITH_TDFA , "TDFA" #endif #ifdef WITH_CRYPTOHASH , "CryptoHash" +#else +#warning Building without CryptoHash. #endif #ifdef WITH_EKG , "EKG" diff --git a/CmdLine.hs b/CmdLine.hs index a920898dce..a165b041ac 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -26,7 +26,6 @@ import qualified Annex import qualified Git import qualified Git.AutoCorrect import Annex.Content -import Annex.Ssh import Annex.Environment import Command import Types.Messages @@ -107,4 +106,3 @@ shutdown nocommit = do saveState nocommit sequence_ =<< M.elems <$> Annex.getState Annex.cleanup liftIO reapZombies -- zombies from long-running git processes - sshCleanup -- ssh connection caching diff --git a/CmdLine/Usage.hs b/CmdLine/Usage.hs index 64b512144d..1d0bba9543 100644 --- a/CmdLine/Usage.hs +++ b/CmdLine/Usage.hs @@ -73,6 +73,8 @@ paramNumRange :: String paramNumRange = "NUM|RANGE" paramRemote :: String paramRemote = "REMOTE" +paramField :: String +paramField = "FIELD" paramGlob :: String paramGlob = "GLOB" paramName :: String diff --git a/Command/Add.hs b/Command/Add.hs index 3361a430aa..0c8e2a48d4 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -93,12 +93,15 @@ start file = ifAnnexed file addpresent add - Lockdown can fail if a file gets deleted, and Nothing will be returned. -} lockDown :: FilePath -> Annex (Maybe KeySource) -lockDown file = ifM crippledFileSystem - ( liftIO $ catchMaybeIO nohardlink - , do +lockDown = either (\e -> showErr e >> return Nothing) (return . Just) <=< lockDown' + +lockDown' :: FilePath -> Annex (Either IOException KeySource) +lockDown' file = ifM crippledFileSystem + ( liftIO $ tryIO nohardlink + , tryAnnexIO $ do tmp <- fromRepo gitAnnexTmpMiscDir createAnnexDirectory tmp - eitherToMaybe <$> tryAnnexIO (go tmp) + go tmp ) where {- In indirect mode, the write bit is removed from the file as part diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 059f3e91e1..88a9915c41 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -29,6 +29,7 @@ import Utility.DataUnits import Utility.FileMode import Config import Types.Key +import Types.CleanupActions import Utility.HumanTime import Git.FilePath import Utility.PID @@ -93,7 +94,7 @@ getIncremental = do checkschedule Nothing = error "bad --incremental-schedule value" checkschedule (Just delta) = do - Annex.addCleanup "" $ do + Annex.addCleanup FsckCleanup $ do v <- getStartTime case v of Nothing -> noop diff --git a/Command/Info.hs b/Command/Info.hs index f27fdfb1d8..11ed98cd9c 100644 --- a/Command/Info.hs +++ b/Command/Info.hs @@ -281,7 +281,7 @@ cachedPresentData = do case presentData s of Just v -> return v Nothing -> do - v <- foldKeys <$> lift getKeysPresent + v <- foldKeys <$> lift (getKeysPresent InRepository) put s { presentData = Just v } return v diff --git a/Command/Map.hs b/Command/Map.hs index 9b80d2035d..7c11fb2ef7 100644 --- a/Command/Map.hs +++ b/Command/Map.hs @@ -158,7 +158,8 @@ absRepo reference r | Git.repoIsUrl r = return r | otherwise = liftIO $ do r' <- Git.Construct.fromAbsPath =<< absPath (Git.repoPath r) - flip Annex.eval Annex.gitRepo =<< Annex.new r' + r'' <- safely $ flip Annex.eval Annex.gitRepo =<< Annex.new r' + return (fromMaybe r' r'') {- Checks if two repos are the same. -} same :: Git.Repo -> Git.Repo -> Bool @@ -192,14 +193,9 @@ tryScan :: Git.Repo -> Annex (Maybe Git.Repo) tryScan r | Git.repoIsSsh r = sshscan | Git.repoIsUrl r = return Nothing - | otherwise = safely $ Git.Config.read r + | otherwise = liftIO $ safely $ Git.Config.read r where - safely a = do - result <- liftIO (try a :: IO (Either SomeException Git.Repo)) - case result of - Left _ -> return Nothing - Right r' -> return $ Just r' - pipedconfig cmd params = safely $ + pipedconfig cmd params = liftIO $ safely $ withHandle StdoutHandle createProcessSuccess p $ Git.Config.hRead r where @@ -247,3 +243,10 @@ combineSame = map snd . nubBy sameuuid . map pair where sameuuid (u1, _) (u2, _) = u1 == u2 && u1 /= NoUUID pair r = (getUncachedUUID r, r) + +safely :: IO Git.Repo -> IO (Maybe Git.Repo) +safely a = do + result <- try a :: IO (Either SomeException Git.Repo) + case result of + Left _ -> return Nothing + Right r' -> return $ Just r' diff --git a/Command/MetaData.hs b/Command/MetaData.hs index 55d67c6b77..d932315ab8 100644 --- a/Command/MetaData.hs +++ b/Command/MetaData.hs @@ -12,16 +12,24 @@ import qualified Annex import Command import Annex.MetaData import Logs.MetaData -import Types.MetaData import qualified Data.Set as S import Data.Time.Clock.POSIX def :: [Command] -def = [withOptions [setOption, tagOption, untagOption, jsonOption] $ +def = [withOptions metaDataOptions $ command "metadata" paramPaths seek SectionMetaData "sets metadata of a file"] +metaDataOptions :: [Option] +metaDataOptions = + [ setOption + , tagOption + , untagOption + , getOption + , jsonOption + ] ++ keyOptions + storeModMeta :: ModMeta -> Annex () storeModMeta modmeta = Annex.changeState $ \s -> s { Annex.modmeta = modmeta:Annex.modmeta s } @@ -31,6 +39,9 @@ setOption = Option ['s'] ["set"] (ReqArg mkmod "FIELD[+-]=VALUE") "set metadata" where mkmod = either error storeModMeta . parseModMeta +getOption :: Option +getOption = fieldOption ['g'] "get" paramField "get single metadata field" + tagOption :: Option tagOption = Option ['t'] ["tag"] (ReqArg mkmod "TAG") "set a tag" where @@ -44,19 +55,35 @@ untagOption = Option ['u'] ["untag"] (ReqArg mkmod "TAG") "remove a tag" seek :: CommandSeek seek ps = do modmeta <- Annex.getState Annex.modmeta + getfield <- getOptionField getOption $ \ms -> + return $ either error id . mkMetaField <$> ms now <- liftIO getPOSIXTime - withFilesInGit (whenAnnexed $ start now modmeta) ps + withKeyOptions + (startKeys now getfield modmeta) + (withFilesInGit (whenAnnexed $ start now getfield modmeta)) + ps -start :: POSIXTime -> [ModMeta] -> FilePath -> (Key, Backend) -> CommandStart -start now ms file (k, _) = do - showStart "metadata" file +start :: POSIXTime -> Maybe MetaField -> [ModMeta] -> FilePath -> (Key, Backend) -> CommandStart +start now f ms file (k, _) = start' (Just file) now f ms k + +startKeys :: POSIXTime -> Maybe MetaField -> [ModMeta] -> Key -> CommandStart +startKeys = start' Nothing + +start' :: AssociatedFile -> POSIXTime -> Maybe MetaField -> [ModMeta] -> Key -> CommandStart +start' afile now Nothing ms k = do + showStart' "metadata" k afile next $ perform now ms k +start' _ _ (Just f) _ k = do + l <- S.toList . currentMetaDataValues f <$> getCurrentMetaData k + liftIO $ forM_ l $ + putStrLn . fromMetaValue + stop perform :: POSIXTime -> [ModMeta] -> Key -> CommandPerform perform _ [] k = next $ cleanup k perform now ms k = do oldm <- getCurrentMetaData k - let m = foldl' unionMetaData emptyMetaData $ map (modMeta oldm) ms + let m = combineMetaData $ map (modMeta oldm) ms addMetaData' k m now next $ cleanup k diff --git a/Command/Move.hs b/Command/Move.hs index af3623da0c..3a39e1de0d 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -69,20 +69,29 @@ toStart dest move afile key = do ishere <- inAnnex key if not ishere || u == Remote.uuid dest then stop -- not here, so nothing to do - else do - showMoveAction move key afile - next $ toPerform dest move key afile -toPerform :: Remote -> Bool -> Key -> AssociatedFile -> CommandPerform -toPerform dest move key afile = moveLock move key $ do - -- Checking the remote is expensive, so not done in the start step. - -- In fast mode, location tracking is assumed to be correct, - -- and an explicit check is not done, when copying. When moving, - -- it has to be done, to avoid inaverdent data loss. + else toStart' dest move afile key + +toStart' :: Remote -> Bool -> AssociatedFile -> Key -> CommandStart +toStart' dest move afile key = do fast <- Annex.getState Annex.fast - let fastcheck = fast && not move && not (Remote.hasKeyCheap dest) - isthere <- if fastcheck - then Right <$> expectedpresent - else Remote.hasKey dest key + if fast && not move && not (Remote.hasKeyCheap dest) + then ifM (expectedPresent dest key) + ( stop + , go True (pure $ Right False) + ) + else go False (Remote.hasKey dest key) + where + go fastcheck isthere = do + showMoveAction move key afile + next $ toPerform dest move key afile fastcheck =<< isthere + +expectedPresent :: Remote -> Key -> Annex Bool +expectedPresent dest key = do + remotes <- Remote.keyPossibilities key + return $ dest `elem` remotes + +toPerform :: Remote -> Bool -> Key -> AssociatedFile -> Bool -> Either String Bool -> CommandPerform +toPerform dest move key afile fastcheck isthere = moveLock move key $ case isthere of Left err -> do showNote err @@ -100,7 +109,7 @@ toPerform dest move key afile = moveLock move key $ do warning "This could have failed because --fast is enabled." stop Right True -> do - unlessM expectedpresent $ + unlessM (expectedPresent dest key) $ Remote.logStatus dest key InfoPresent finish where @@ -109,9 +118,6 @@ toPerform dest move key afile = moveLock move key $ do removeAnnex key next $ Command.Drop.cleanupLocal key | otherwise = next $ return True - expectedpresent = do - remotes <- Remote.keyPossibilities key - return $ dest `elem` remotes {- Moves (or copies) the content of an annexed file from a remote - to the current repository. diff --git a/Command/Sync.hs b/Command/Sync.hs index 07006ef287..a4004736a2 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -376,5 +376,5 @@ syncFile rs f (k, _) = do put dest = do ok <- commandAction $ do showStart "copy" f - next $ Command.Move.toPerform dest False k (Just f) + Command.Move.toStart' dest False (Just f) k return (ok, if ok then Just (Remote.uuid dest) else Nothing) diff --git a/Command/Uninit.hs b/Command/Uninit.hs index 1c8d086895..2a9e3e687e 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -53,7 +53,7 @@ finish :: Annex () finish = do annexdir <- fromRepo gitAnnexDir annexobjectdir <- fromRepo gitAnnexObjectDir - leftovers <- removeUnannexed =<< getKeysPresent + leftovers <- removeUnannexed =<< getKeysPresent InAnnex if null leftovers then liftIO $ removeDirectoryRecursive annexdir else error $ unlines diff --git a/Command/Unused.hs b/Command/Unused.hs index 6b44755680..3e844e5a8b 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -10,7 +10,6 @@ module Command.Unused where import qualified Data.Set as S -import qualified Data.ByteString.Lazy as L import Data.BloomFilter import Data.BloomFilter.Easy import Data.BloomFilter.Hash @@ -71,7 +70,9 @@ checkUnused = chain 0 return [] findunused False = do showAction "checking for unused data" - excludeReferenced =<< getKeysPresent + -- InAnnex, not InRepository because if a direct mode + -- file exists, it is obviously not unused. + excludeReferenced =<< getKeysPresent InAnnex chain _ [] = next $ return True chain v (a:as) = do v' <- a v @@ -294,7 +295,7 @@ withKeysReferencedInGitRef a ref = do liftIO $ void clean where tKey True = fmap fst <$$> Backend.lookupFile . getTopFilePath . DiffTree.file - tKey False = fileKey . takeFileName . encodeW8 . L.unpack <$$> + tKey False = fileKey . takeFileName . decodeBS <$$> catFile ref . getTopFilePath . DiffTree.file {- Looks in the specified directory for bad/tmp keys, and returns a list diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs index 7608959c24..c62769c955 100644 --- a/Command/Vicfg.hs +++ b/Command/Vicfg.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2012 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -60,7 +60,8 @@ vicfg curcfg f = do data Cfg = Cfg { cfgTrustMap :: TrustMap , cfgGroupMap :: M.Map UUID (S.Set Group) - , cfgPreferredContentMap :: M.Map UUID String + , cfgPreferredContentMap :: M.Map UUID PreferredContentExpression + , cfgGroupPreferredContentMap :: M.Map Group PreferredContentExpression , cfgScheduleMap :: M.Map UUID [ScheduledActivity] } @@ -69,25 +70,40 @@ getCfg = Cfg <$> trustMapRaw -- without local trust overrides <*> (groupsByUUID <$> groupMap) <*> preferredContentMapRaw + <*> groupPreferredContentMapRaw <*> scheduleMap setCfg :: Cfg -> Cfg -> Annex () setCfg curcfg newcfg = do - let (trustchanges, groupchanges, preferredcontentchanges, schedulechanges) = diffCfg curcfg newcfg - mapM_ (uncurry trustSet) $ M.toList trustchanges - mapM_ (uncurry groupSet) $ M.toList groupchanges - mapM_ (uncurry preferredContentSet) $ M.toList preferredcontentchanges - mapM_ (uncurry scheduleSet) $ M.toList schedulechanges + let diff = diffCfg curcfg newcfg + mapM_ (uncurry trustSet) $ M.toList $ cfgTrustMap diff + mapM_ (uncurry groupSet) $ M.toList $ cfgGroupMap diff + mapM_ (uncurry preferredContentSet) $ M.toList $ cfgPreferredContentMap diff + mapM_ (uncurry groupPreferredContentSet) $ M.toList $ cfgGroupPreferredContentMap diff + mapM_ (uncurry scheduleSet) $ M.toList $ cfgScheduleMap diff -diffCfg :: Cfg -> Cfg -> (TrustMap, M.Map UUID (S.Set Group), M.Map UUID String, M.Map UUID [ScheduledActivity]) -diffCfg curcfg newcfg = (diff cfgTrustMap, diff cfgGroupMap, diff cfgPreferredContentMap, diff cfgScheduleMap) +diffCfg :: Cfg -> Cfg -> Cfg +diffCfg curcfg newcfg = Cfg + { cfgTrustMap = diff cfgTrustMap + , cfgGroupMap = diff cfgGroupMap + , cfgPreferredContentMap = diff cfgPreferredContentMap + , cfgGroupPreferredContentMap = diff cfgGroupPreferredContentMap + , cfgScheduleMap = diff cfgScheduleMap + } where diff f = M.differenceWith (\x y -> if x == y then Nothing else Just x) (f newcfg) (f curcfg) genCfg :: Cfg -> M.Map UUID String -> String -genCfg cfg descs = unlines $ concat - [intro, trust, groups, preferredcontent, schedule] +genCfg cfg descs = unlines $ intercalate [""] + [ intro + , trust + , groups + , preferredcontent + , grouppreferredcontent + , standardgroups + , schedule + ] where intro = [ com "git-annex configuration" @@ -95,22 +111,20 @@ genCfg cfg descs = unlines $ concat , com "Changes saved to this file will be recorded in the git-annex branch." , com "" , com "Lines in this file have the format:" - , com " setting uuid = value" + , com " setting field = value" ] - trust = settings cfgTrustMap - [ "" - , com "Repository trust configuration" + trust = settings cfg descs cfgTrustMap + [ com "Repository trust configuration" , com "(Valid trust levels: " ++ trustlevels ++ ")" ] (\(t, u) -> line "trust" u $ showTrustLevel t) (\u -> lcom $ line "trust" u $ showTrustLevel SemiTrusted) where - trustlevels = unwords $ map showTrustLevel [Trusted .. DeadTrusted] + trustlevels = unwords $ map showTrustLevel [Trusted .. DeadTrusted] - groups = settings cfgGroupMap - [ "" - , com "Repository groups" + groups = settings cfg descs cfgGroupMap + [ com "Repository groups" , com $ "(Standard groups: " ++ grouplist ++ ")" , com "(Separate group names with spaces)" ] @@ -119,33 +133,60 @@ genCfg cfg descs = unlines $ concat where grouplist = unwords $ map fromStandardGroup [minBound..] - preferredcontent = settings cfgPreferredContentMap - [ "" - , com "Repository preferred contents" - ] - (\(s, u) -> line "content" u s) - (\u -> line "content" u "") + preferredcontent = settings cfg descs cfgPreferredContentMap + [ com "Repository preferred contents" ] + (\(s, u) -> line "wanted" u s) + (\u -> line "wanted" u "standard") - schedule = settings cfgScheduleMap - [ "" - , com "Scheduled activities" + grouppreferredcontent = settings' cfg allgroups cfgGroupPreferredContentMap + [ com "Group preferred contents" + , com "(Used by repositories with \"groupwanted\" in their preferred contents)" + ] + (\(s, g) -> gline g s) + (\g -> gline g "standard") + where + gline g value = [ unwords ["groupwanted", g, "=", value] ] + allgroups = S.unions $ stdgroups : M.elems (cfgGroupMap cfg) + stdgroups = S.fromList $ map fromStandardGroup [minBound..maxBound] + + standardgroups = + [ com "Standard preferred contents" + , com "(Used by wanted or groupwanted expressions containing \"standard\")" + , com "(For reference only; built-in and cannot be changed!)" + ] + ++ map gline [minBound..maxBound] + where + gline g = com $ unwords + [ "standard" + , fromStandardGroup g, "=", standardPreferredContent g + ] + + schedule = settings cfg descs cfgScheduleMap + [ com "Scheduled activities" , com "(Separate multiple activities with \"; \")" ] (\(l, u) -> line "schedule" u $ fromScheduledActivities l) (\u -> line "schedule" u "") - settings field desc showvals showdefaults = concat - [ desc - , concatMap showvals $ sort $ map swap $ M.toList $ field cfg - , concatMap (lcom . showdefaults) $ missing field - ] - line setting u value = [ com $ "(for " ++ fromMaybe "" (M.lookup u descs) ++ ")" , unwords [setting, fromUUID u, "=", value] ] - lcom = map (\l -> if "#" `isPrefixOf` l then l else '#' : l) - missing field = S.toList $ M.keysSet descs `S.difference` M.keysSet (field cfg) + +settings :: Ord v => Cfg -> M.Map UUID String -> (Cfg -> M.Map UUID v) -> [String] -> ((v, UUID) -> [String]) -> (UUID -> [String]) -> [String] +settings cfg descs = settings' cfg (M.keysSet descs) + +settings' :: (Ord v, Ord f) => Cfg -> S.Set f -> (Cfg -> M.Map f v) -> [String] -> ((v, f) -> [String]) -> (f -> [String]) -> [String] +settings' cfg s field desc showvals showdefaults = concat + [ desc + , concatMap showvals $ sort $ map swap $ M.toList $ field cfg + , concatMap (lcom . showdefaults) missing + ] + where + missing = S.toList $ s `S.difference` M.keysSet (field cfg) + +lcom :: [String] -> [String] +lcom = map (\l -> if "#" `isPrefixOf` l then l else '#' : l) {- If there's a parse error, returns a new version of the file, - with the problem lines noted. -} @@ -163,16 +204,16 @@ parseCfg curcfg = go [] curcfg . lines parse l cfg | null l = Right cfg | "#" `isPrefixOf` l = Right cfg - | null setting || null u = Left "missing repository uuid" - | otherwise = handle cfg (toUUID u) setting value' + | null setting || null f = Left "missing field" + | otherwise = handle cfg f setting value' where (setting, rest) = separate isSpace l (r, value) = separate (== '=') rest value' = trimspace value - u = reverse $ trimspace $ reverse $ trimspace r + f = reverse $ trimspace $ reverse $ trimspace r trimspace = dropWhile isSpace - handle cfg u setting value + handle cfg f setting value | setting == "trust" = case readTrustLevel value of Nothing -> badval "trust value" value Just t -> @@ -181,18 +222,26 @@ parseCfg curcfg = go [] curcfg . lines | setting == "group" = let m = M.insert u (S.fromList $ words value) (cfgGroupMap cfg) in Right $ cfg { cfgGroupMap = m } - | setting == "content" = + | setting == "wanted" = case checkPreferredContentExpression value of Just e -> Left e Nothing -> let m = M.insert u value (cfgPreferredContentMap cfg) in Right $ cfg { cfgPreferredContentMap = m } + | setting == "groupwanted" = + case checkPreferredContentExpression value of + Just e -> Left e + Nothing -> + let m = M.insert f value (cfgGroupPreferredContentMap cfg) + in Right $ cfg { cfgGroupPreferredContentMap = m } | setting == "schedule" = case parseScheduledActivities value of Left e -> Left e Right l -> let m = M.insert u l (cfgScheduleMap cfg) in Right $ cfg { cfgScheduleMap = m } | otherwise = badval "setting" setting + where + u = toUUID f showerr (Just msg, l) = [parseerr ++ msg, l] showerr (Nothing, l) @@ -203,11 +252,12 @@ parseCfg curcfg = go [] curcfg . lines badval desc val = Left $ "unknown " ++ desc ++ " \"" ++ val ++ "\"" badheader = - [ 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)." + [ 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: " + parseerr = com "** Parse error in next line: " com :: String -> String com s = "# " ++ s diff --git a/Git/CatFile.hs b/Git/CatFile.hs index c7c51b8943..8e64fc5589 100644 --- a/Git/CatFile.hs +++ b/Git/CatFile.hs @@ -108,6 +108,6 @@ catTree h treeref = go <$> catObjectDetails h treeref dropsha = L.drop 21 parsemodefile b = - let (modestr, file) = separate (== ' ') (encodeW8 $ L.unpack b) + let (modestr, file) = separate (== ' ') (decodeBS b) in (file, readmode modestr) readmode = fst . fromMaybe (0, undefined) . headMaybe . readOct diff --git a/Git/Fsck.hs b/Git/Fsck.hs index e90683bc0e..80f76dd907 100644 --- a/Git/Fsck.hs +++ b/Git/Fsck.hs @@ -23,10 +23,17 @@ import Utility.Batch import qualified Git.Version import qualified Data.Set as S +import System.Process (std_out, std_err) +import Control.Concurrent.Async type MissingObjects = S.Set Sha -data FsckResults = FsckFoundMissing MissingObjects | FsckFailed +data FsckResults + = FsckFoundMissing + { missingObjects :: MissingObjects + , missingObjectsTruncated :: Bool + } + | FsckFailed deriving (Show) {- Runs fsck to find some of the broken objects in the repository. @@ -46,20 +53,32 @@ findBroken batchmode r = do (command', params') <- if batchmode then toBatchCommand (command, params) else return (command, params) - (output, fsckok) <- processTranscript command' (toCommand params') Nothing - let objs = findShas supportsNoDangling output - badobjs <- findMissing objs r + + p@(_, _, _, pid) <- createProcess $ + (proc command' (toCommand params')) + { std_out = CreatePipe + , std_err = CreatePipe + } + (bad1, bad2) <- concurrently + (readMissingObjs maxobjs r supportsNoDangling (stdoutHandle p)) + (readMissingObjs maxobjs r supportsNoDangling (stderrHandle p)) + fsckok <- checkSuccessProcess pid + let truncated = S.size bad1 == maxobjs || S.size bad1 == maxobjs + let badobjs = S.union bad1 bad2 + if S.null badobjs && not fsckok then return FsckFailed - else return $ FsckFoundMissing badobjs + else return $ FsckFoundMissing badobjs truncated + where + maxobjs = 10000 foundBroken :: FsckResults -> Bool foundBroken FsckFailed = True -foundBroken (FsckFoundMissing s) = not (S.null s) +foundBroken (FsckFoundMissing s _) = not (S.null s) knownMissing :: FsckResults -> MissingObjects knownMissing FsckFailed = S.empty -knownMissing (FsckFoundMissing s) = s +knownMissing (FsckFoundMissing s _) = s {- Finds objects that are missing from the git repsitory, or are corrupt. - @@ -69,6 +88,11 @@ knownMissing (FsckFoundMissing s) = s findMissing :: [Sha] -> Repo -> IO MissingObjects findMissing objs r = S.fromList <$> filterM (`isMissing` r) objs +readMissingObjs :: Int -> Repo -> Bool -> Handle -> IO MissingObjects +readMissingObjs maxobjs r supportsNoDangling h = do + objs <- take maxobjs . findShas supportsNoDangling <$> hGetContents h + findMissing objs r + isMissing :: Sha -> Repo -> IO Bool isMissing s r = either (const True) (const False) <$> tryIO dump where diff --git a/Git/Repair.hs b/Git/Repair.hs index cdd70329d4..67ded359f8 100644 --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -1,7 +1,6 @@ {- git repository recovery -import qualified Data.Set as S - - - Copyright 2013 Joey Hess + - Copyright 2013-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -45,35 +44,18 @@ import qualified Data.ByteString.Lazy as L import Data.Tuple.Utils {- Given a set of bad objects found by git fsck, which may not - - be complete, finds and removes all corrupt objects, - - and returns missing objects. - -} -cleanCorruptObjects :: FsckResults -> Repo -> IO FsckResults + - be complete, finds and removes all corrupt objects. -} +cleanCorruptObjects :: FsckResults -> Repo -> IO () cleanCorruptObjects fsckresults r = do void $ explodePacks r - objs <- listLooseObjectShas r - mapM_ (tryIO . allowRead . looseObjectFile r) objs - bad <- findMissing objs r - void $ removeLoose r $ S.union bad (knownMissing fsckresults) - -- Rather than returning the loose objects that were removed, re-run - -- fsck. Other missing objects may have been in the packs, - -- and this way fsck will find them. - findBroken False r - -removeLoose :: Repo -> MissingObjects -> IO Bool -removeLoose r s = do - fs <- filterM doesFileExist (map (looseObjectFile r) (S.toList s)) - let count = length fs - if count > 0 - then do - putStrLn $ unwords - [ "Removing" - , show count - , "corrupt loose objects." - ] - mapM_ nukeFile fs - return True - else return False + mapM_ removeLoose (S.toList $ knownMissing fsckresults) + mapM_ removeBad =<< listLooseObjectShas r + where + removeLoose s = nukeFile (looseObjectFile r s) + removeBad s = do + void $ tryIO $ allowRead $ looseObjectFile r s + whenM (isMissing s r) $ + removeLoose s {- Explodes all pack files, and deletes them. - @@ -132,7 +114,9 @@ retrieveMissingObjects missing referencerepo r void $ copyObjects tmpr r case stillmissing of FsckFailed -> return $ FsckFailed - FsckFoundMissing s -> FsckFoundMissing <$> findMissing (S.toList s) r + FsckFoundMissing s t -> FsckFoundMissing + <$> findMissing (S.toList s) r + <*> pure t , return stillmissing ) pullremotes tmpr (rmt:rmts) fetchrefs ms @@ -145,9 +129,9 @@ retrieveMissingObjects missing referencerepo r void $ copyObjects tmpr r case ms of FsckFailed -> pullremotes tmpr rmts fetchrefs ms - FsckFoundMissing s -> do + FsckFoundMissing s t -> do stillmissing <- findMissing (S.toList s) r - pullremotes tmpr rmts fetchrefs (FsckFoundMissing stillmissing) + pullremotes tmpr rmts fetchrefs (FsckFoundMissing stillmissing t) , pullremotes tmpr rmts fetchrefs ms ) fetchfrom fetchurl ps = runBool $ @@ -295,7 +279,7 @@ findUncorruptedCommit missing goodcommits branch r = do then return (Just c, gcs') else findfirst gcs' cs -{- Verifies tha none of the missing objects in the set are used by +{- Verifies that none of the missing objects in the set are used by - the commit. Also adds to a set of commit shas that have been verified to - be good, which can be passed into subsequent calls to avoid - redundant work when eg, chasing down branches to find the first @@ -465,10 +449,11 @@ runRepairOf fsckresult removablebranch forced referencerepo g = do runRepair' :: (Ref -> Bool) -> FsckResults -> Bool -> Maybe FilePath -> Repo -> IO (Bool, [Branch]) runRepair' removablebranch fsckresult forced referencerepo g = do - missing <- cleanCorruptObjects fsckresult g + cleanCorruptObjects fsckresult g + missing <- findBroken False g stillmissing <- retrieveMissingObjects missing referencerepo g case stillmissing of - FsckFoundMissing s + FsckFoundMissing s t | S.null s -> if repoIsLocalBare g then successfulfinish [] else ifM (checkIndex g) @@ -481,7 +466,7 @@ runRepair' removablebranch fsckresult forced referencerepo g = do ) | otherwise -> if forced then ifM (checkIndex g) - ( continuerepairs s + ( forcerepair s t , corruptedindex ) else do @@ -493,17 +478,17 @@ runRepair' removablebranch fsckresult forced referencerepo g = do FsckFailed | forced -> ifM (pure (repoIsLocalBare g) <||> checkIndex g) ( do - missing' <- cleanCorruptObjects FsckFailed g - case missing' of + cleanCorruptObjects FsckFailed g + stillmissing' <- findBroken False g + case stillmissing' of FsckFailed -> return (False, []) - FsckFoundMissing stillmissing' -> - continuerepairs stillmissing' + FsckFoundMissing s t -> forcerepair s t , corruptedindex ) | otherwise -> unsuccessfulfinish where - continuerepairs stillmissing = do - (removedbranches, goodcommits) <- removeBadBranches removablebranch stillmissing emptyGoodCommits g + repairbranches missing = do + (removedbranches, goodcommits) <- removeBadBranches removablebranch missing emptyGoodCommits g let remotebranches = filter isTrackingBranch removedbranches unless (null remotebranches) $ putStrLn $ unwords @@ -511,32 +496,43 @@ runRepair' removablebranch fsckresult forced referencerepo g = do , show (length remotebranches) , "remote tracking branches that referred to missing objects." ] - (resetbranches, deletedbranches, _) <- resetLocalBranches stillmissing goodcommits g + (resetbranches, deletedbranches, _) <- resetLocalBranches missing goodcommits g displayList (map fromRef resetbranches) "Reset these local branches to old versions before the missing objects were committed:" displayList (map fromRef deletedbranches) "Deleted these local branches, which could not be recovered due to missing objects:" + return (resetbranches ++ deletedbranches) + + forcerepair missing fscktruncated = do + modifiedbranches <- repairbranches missing deindexedfiles <- rewriteIndex g displayList deindexedfiles "Removed these missing files from the index. You should look at what files are present in your working tree and git add them back to the index when appropriate." - let modifiedbranches = resetbranches ++ deletedbranches - if null resetbranches && null deletedbranches - then successfulfinish modifiedbranches - else do - unless (repoIsLocalBare g) $ do - mcurr <- Branch.currentUnsafe g - case mcurr of - Nothing -> return () - Just curr -> when (any (== curr) modifiedbranches) $ do + + -- When the fsck results were truncated, try + -- fscking again, and as long as different + -- missing objects are found, continue + -- the repair process. + if fscktruncated + then do + fsckresult' <- findBroken False g + case fsckresult' of + FsckFailed -> do + putStrLn "git fsck is failing" + return (False, modifiedbranches) + FsckFoundMissing s _ + | S.null s -> successfulfinish modifiedbranches + | S.null (s `S.difference` missing) -> do putStrLn $ unwords - [ "You currently have" - , fromRef curr - , "checked out. You may have staged changes in the index that can be committed to recover the lost state of this branch!" + [ show (S.size s) + , "missing objects could not be recovered!" ] - putStrLn "Successfully recovered repository!" - putStrLn "Please carefully check that the changes mentioned above are ok.." - return (True, modifiedbranches) - + return (False, modifiedbranches) + | otherwise -> do + (ok, modifiedbranches') <- runRepairOf fsckresult' removablebranch forced referencerepo g + return (ok, modifiedbranches++modifiedbranches') + else successfulfinish modifiedbranches + corruptedindex = do nukeFile (indexFile g) -- The corrupted index can prevent fsck from finding other @@ -546,12 +542,28 @@ runRepair' removablebranch fsckresult forced referencerepo g = do putStrLn "Removed the corrupted index file. You should look at what files are present in your working tree and git add them back to the index when appropriate." return result - successfulfinish modifiedbranches = do - mapM_ putStrLn - [ "Successfully recovered repository!" - , "You should run \"git fsck\" to make sure, but it looks like everything was recovered ok." - ] - return (True, modifiedbranches) + successfulfinish modifiedbranches + | null modifiedbranches = do + mapM_ putStrLn + [ "Successfully recovered repository!" + , "You should run \"git fsck\" to make sure, but it looks like everything was recovered ok." + ] + return (True, modifiedbranches) + | otherwise = do + unless (repoIsLocalBare g) $ do + mcurr <- Branch.currentUnsafe g + case mcurr of + Nothing -> return () + Just curr -> when (any (== curr) modifiedbranches) $ do + putStrLn $ unwords + [ "You currently have" + , fromRef curr + , "checked out. You may have staged changes in the index that can be committed to recover the lost state of this branch!" + ] + putStrLn "Successfully recovered repository!" + putStrLn "Please carefully check that the changes mentioned above are ok.." + return (True, modifiedbranches) + unsuccessfulfinish = do if repoIsLocalBare g then do diff --git a/Limit.hs b/Limit.hs index 62c5456fe3..7654842e16 100644 --- a/Limit.hs +++ b/Limit.hs @@ -94,18 +94,16 @@ matchGlobFile glob = go {- Adds a limit to skip files not believed to be present - in a specfied repository. Optionally on a prior date. -} addIn :: String -> Annex () -addIn = addLimit . limitIn - -limitIn :: MkLimit -limitIn s = Right $ \notpresent -> checkKey $ \key -> - if name == "." - then if null date - then inhere notpresent key - else inuuid notpresent key =<< getUUID - else inuuid notpresent key =<< Remote.nameToUUID name +addIn s = addLimit =<< mk where (name, date) = separate (== '@') s - inuuid notpresent key u + mk + | name == "." = if null date + then use inhere + else use . inuuid =<< getUUID + | otherwise = use . inuuid =<< Remote.nameToUUID name + use a = return $ Right $ \notpresent -> checkKey (a notpresent) + inuuid u notpresent key | null date = do us <- Remote.keyLocations key return $ u `elem` us && u `S.notMember` notpresent @@ -122,7 +120,10 @@ limitIn s = Right $ \notpresent -> checkKey $ \key -> {- Limit to content that is currently present on a uuid. -} limitPresent :: Maybe UUID -> MkLimit -limitPresent u _ = Right $ const $ checkKey $ \key -> do +limitPresent u _ = Right $ matchPresent u + +matchPresent :: Maybe UUID -> MatchFiles +matchPresent u _ = checkKey $ \key -> do hereu <- getUUID if u == Just hereu || isNothing u then inAnnex key diff --git a/Logs.hs b/Logs.hs index 21908a9cf2..2a2fc430e0 100644 --- a/Logs.hs +++ b/Logs.hs @@ -24,7 +24,7 @@ getLogVariety :: FilePath -> Maybe LogVariety getLogVariety f | f `elem` topLevelUUIDBasedLogs = Just UUIDBasedLog | isRemoteStateLog f = Just NewUUIDBasedLog - | isMetaDataLog f || f == numcopiesLog = Just OtherLog + | isMetaDataLog f || f `elem` otherLogs = Just OtherLog | otherwise = PresenceLog <$> firstJust (presenceLogs f) {- All the uuid-based logs stored in the top of the git-annex branch. -} @@ -45,6 +45,13 @@ presenceLogs f = , locationLogFileKey f ] +{- Logs that are neither UUID based nor presence logs. -} +otherLogs :: [FilePath] +otherLogs = + [ numcopiesLog + , groupPreferredContentLog + ] + uuidLog :: FilePath uuidLog = "uuid.log" @@ -63,6 +70,9 @@ groupLog = "group.log" preferredContentLog :: FilePath preferredContentLog = "preferred-content.log" +groupPreferredContentLog :: FilePath +groupPreferredContentLog = "group-preferred-content.log" + scheduleLog :: FilePath scheduleLog = "schedule.log" diff --git a/Logs/FsckResults.hs b/Logs/FsckResults.hs index 3538bdc401..619dd586c6 100644 --- a/Logs/FsckResults.hs +++ b/Logs/FsckResults.hs @@ -23,25 +23,31 @@ writeFsckResults u fsckresults = do logfile <- fromRepo $ gitAnnexFsckResultsLog u liftIO $ case fsckresults of - FsckFailed -> store S.empty logfile - FsckFoundMissing s + FsckFailed -> store S.empty False logfile + FsckFoundMissing s t | S.null s -> nukeFile logfile - | otherwise -> store s logfile + | otherwise -> store s t logfile where - store s logfile = do + store s t logfile = do createDirectoryIfMissing True (parentDir logfile) - liftIO $ viaTmp writeFile logfile $ serialize s - serialize = unlines . map fromRef . S.toList + liftIO $ viaTmp writeFile logfile $ serialize s t + serialize s t = + let ls = map fromRef (S.toList s) + in if t + then unlines ("truncated":ls) + else unlines ls readFsckResults :: UUID -> Annex FsckResults readFsckResults u = do logfile <- fromRepo $ gitAnnexFsckResultsLog u - liftIO $ catchDefaultIO (FsckFoundMissing S.empty) $ - deserialize <$> readFile logfile + liftIO $ catchDefaultIO (FsckFoundMissing S.empty False) $ + deserialize . lines <$> readFile logfile where - deserialize l = - let s = S.fromList $ map Ref $ lines l - in if S.null s then FsckFailed else FsckFoundMissing s + deserialize ("truncated":ls) = deserialize' ls True + deserialize ls = deserialize' ls False + deserialize' ls t = + let s = S.fromList $ map Ref ls + in if S.null s then FsckFailed else FsckFoundMissing s t clearFsckResults :: UUID -> Annex () clearFsckResults = liftIO . nukeFile <=< fromRepo . gitAnnexFsckResultsLog diff --git a/Logs/MapLog.hs b/Logs/MapLog.hs new file mode 100644 index 0000000000..1725ef953f --- /dev/null +++ b/Logs/MapLog.hs @@ -0,0 +1,81 @@ +{- git-annex Map log + - + - This is used to store a Map, in a way that can be union merged. + - + - A line of the log will look like: "timestamp field value" + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Logs.MapLog where + +import qualified Data.Map as M +import Data.Time.Clock.POSIX +import Data.Time +import System.Locale + +import Common + +data TimeStamp = Unknown | Date POSIXTime + deriving (Eq, Ord, Show) + +data LogEntry v = LogEntry + { changed :: TimeStamp + , value :: v + } deriving (Eq, Show) + +type MapLog f v = M.Map f (LogEntry v) + +showMapLog :: (f -> String) -> (v -> String) -> MapLog f v -> String +showMapLog fieldshower valueshower = unlines . map showpair . M.toList + where + showpair (f, LogEntry (Date p) v) = + unwords [show p, fieldshower f, valueshower v] + showpair (f, LogEntry Unknown v) = + unwords ["0", fieldshower f, valueshower v] + +parseMapLog :: Ord f => (String -> Maybe f) -> (String -> Maybe v) -> String -> MapLog f v +parseMapLog fieldparser valueparser = M.fromListWith best . mapMaybe parse . lines + where + parse line = do + let (ts, rest) = splitword line + (sf, sv) = splitword rest + date <- Date . utcTimeToPOSIXSeconds <$> parseTime defaultTimeLocale "%s%Qs" ts + f <- fieldparser sf + v <- valueparser sv + Just (f, LogEntry date v) + splitword = separate (== ' ') + +changeMapLog :: Ord f => POSIXTime -> f -> v -> MapLog f v -> MapLog f v +changeMapLog t f v = M.insert f $ LogEntry (Date t) v + +{- Only add an LogEntry if it's newer (or at least as new as) than any + - existing LogEntry for a field. -} +addMapLog :: Ord f => f -> LogEntry v -> MapLog f v -> MapLog f v +addMapLog = M.insertWith' best + +{- Converts a MapLog into a simple Map without the timestamp information. + - This is a one-way trip, but useful for code that never needs to change + - the log. -} +simpleMap :: MapLog f v -> M.Map f v +simpleMap = M.map value + +best :: LogEntry v -> LogEntry v -> LogEntry v +best new old + | changed old > changed new = old + | otherwise = new + +-- Unknown is oldest. +prop_TimeStamp_sane :: Bool +prop_TimeStamp_sane = Unknown < Date 1 + +prop_addMapLog_sane :: Bool +prop_addMapLog_sane = newWins && newestWins + where + newWins = addMapLog ("foo") (LogEntry (Date 1) "new") l == l2 + newestWins = addMapLog ("foo") (LogEntry (Date 1) "newest") l2 /= l2 + + l = M.fromList [("foo", LogEntry (Date 0) "old")] + l2 = M.fromList [("foo", LogEntry (Date 1) "new")] diff --git a/Logs/MetaData.hs b/Logs/MetaData.hs index 6702c37337..b682ca005e 100644 --- a/Logs/MetaData.hs +++ b/Logs/MetaData.hs @@ -36,26 +36,54 @@ module Logs.MetaData ( import Common.Annex import Types.MetaData +import Annex.MetaData.StandardFields import qualified Annex.Branch import Logs import Logs.SingleValue import qualified Data.Set as S +import qualified Data.Map as M import Data.Time.Clock.POSIX +import Data.Time.Format +import System.Locale instance SingleValueSerializable MetaData where serialize = Types.MetaData.serialize deserialize = Types.MetaData.deserialize -getMetaData :: Key -> Annex (Log MetaData) -getMetaData = readLog . metaDataLogFile +getMetaDataLog :: Key -> Annex (Log MetaData) +getMetaDataLog = readLog . metaDataLogFile {- Go through the log from oldest to newest, and combine it all - - into a single MetaData representing the current state. -} + - into a single MetaData representing the current state. + - + - Automatically generates a lastchanged metadata for each field that's + - currently set, based on timestamps in the log. + -} getCurrentMetaData :: Key -> Annex MetaData -getCurrentMetaData = currentMetaData . collect <$$> getMetaData +getCurrentMetaData k = do + ls <- S.toAscList <$> getMetaDataLog k + let loggedmeta = currentMetaData $ combineMetaData $ map value ls + return $ currentMetaData $ unionMetaData loggedmeta + (lastchanged ls loggedmeta) where - collect = foldl' unionMetaData emptyMetaData . map value . S.toAscList + lastchanged [] _ = emptyMetaData + lastchanged ls (MetaData currentlyset) = + let m = foldl' (flip M.union) M.empty (map genlastchanged ls) + in MetaData $ + -- Add a overall lastchanged using the oldest log + -- item (log is in ascending order). + M.insert lastChangedField (lastchangedval $ Prelude.last ls) $ + M.mapKeys mkLastChangedField $ + -- Only include fields that are currently set. + m `M.intersection` currentlyset + -- Makes each field have the timestamp as its value. + genlastchanged l = + let MetaData m = value l + ts = lastchangedval l + in M.map (const ts) m + lastchangedval l = S.singleton $ toMetaValue $ showts $ changed l + showts = formatTime defaultTimeLocale "%F@%H-%M-%S" . posixSecondsToUTCTime {- Adds in some metadata, which can override existing values, or unset - them, but otherwise leaves any existing metadata as-is. -} @@ -67,10 +95,12 @@ addMetaData k metadata = addMetaData' k metadata =<< liftIO getPOSIXTime - will tend to be generated across the different log files, and so - git will be able to pack the data more efficiently. -} addMetaData' :: Key -> MetaData -> POSIXTime -> Annex () -addMetaData' k metadata now = Annex.Branch.change (metaDataLogFile k) $ +addMetaData' k (MetaData m) now = Annex.Branch.change (metaDataLogFile k) $ showLog . simplifyLog - . S.insert (LogEntry now metadata) + . S.insert (LogEntry now metadata) . parseLog + where + metadata = MetaData $ M.filterWithKey (\f _ -> not (isLastChangedField f)) m {- Simplify a log, removing historical values that are no longer - needed. @@ -148,7 +178,7 @@ copyMetaData :: Key -> Key -> Annex () copyMetaData oldkey newkey | oldkey == newkey = noop | otherwise = do - l <- getMetaData oldkey + l <- getMetaDataLog oldkey unless (S.null l) $ Annex.Branch.change (metaDataLogFile newkey) $ const $ showLog l diff --git a/Logs/PreferredContent.hs b/Logs/PreferredContent.hs index 4b25ea094c..5580c062db 100644 --- a/Logs/PreferredContent.hs +++ b/Logs/PreferredContent.hs @@ -1,6 +1,6 @@ {- git-annex preferred content matcher configuration - - - Copyright 2012 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -8,10 +8,12 @@ module Logs.PreferredContent ( preferredContentLog, preferredContentSet, + groupPreferredContentSet, isPreferredContent, preferredContentMap, preferredContentMapLoad, preferredContentMapRaw, + groupPreferredContentMapRaw, checkPreferredContentExpression, setStandardGroup, ) where @@ -35,6 +37,7 @@ import Types.Remote (RemoteConfig) import Logs.Group import Logs.Remote import Types.StandardGroups +import Limit {- Checks if a file is preferred content for the specified repository - (or the current repository if none is specified). -} @@ -56,40 +59,61 @@ preferredContentMapLoad :: Annex Annex.PreferredContentMap preferredContentMapLoad = do groupmap <- groupMap configmap <- readRemoteLog + groupwantedmap <- groupPreferredContentMapRaw m <- simpleMap - . parseLogWithUUID ((Just .) . makeMatcher groupmap configmap) + . parseLogWithUUID ((Just .) . makeMatcher groupmap configmap groupwantedmap) <$> Annex.Branch.get preferredContentLog Annex.changeState $ \s -> s { Annex.preferredcontentmap = Just m } return m {- This intentionally never fails, even on unparsable expressions, - because the configuration is shared among repositories and newer - - versions of git-annex may add new features. Instead, parse errors - - result in a Matcher that will always succeed. -} -makeMatcher :: GroupMap -> M.Map UUID RemoteConfig -> UUID -> PreferredContentExpression -> FileMatcher -makeMatcher groupmap configmap u expr - | expr == "standard" = standardMatcher groupmap configmap u - | null (lefts tokens) = Utility.Matcher.generate $ rights tokens - | otherwise = matchAll + - versions of git-annex may add new features. -} +makeMatcher + :: GroupMap + -> M.Map UUID RemoteConfig + -> M.Map Group PreferredContentExpression + -> UUID + -> PreferredContentExpression + -> FileMatcher +makeMatcher groupmap configmap groupwantedmap u = go True True where - tokens = exprParser groupmap configmap (Just u) expr + go expandstandard expandgroupwanted expr + | null (lefts tokens) = Utility.Matcher.generate $ rights tokens + | otherwise = unknownMatcher u + where + tokens = exprParser matchstandard matchgroupwanted groupmap configmap (Just u) expr + matchstandard + | expandstandard = maybe (unknownMatcher u) (go False False) + (standardPreferredContent <$> getStandardGroup mygroups) + | otherwise = unknownMatcher u + matchgroupwanted + | expandgroupwanted = maybe (unknownMatcher u) (go True False) + (groupwanted mygroups) + | otherwise = unknownMatcher u + mygroups = fromMaybe S.empty (u `M.lookup` groupsByUUID groupmap) + groupwanted s = case M.elems $ M.filterWithKey (\k _ -> S.member k s) groupwantedmap of + [pc] -> Just pc + _ -> Nothing -{- Standard matchers are pre-defined for some groups. If none is defined, - - or a repository is in multiple groups with standard matchers, match all. -} -standardMatcher :: GroupMap -> M.Map UUID RemoteConfig -> UUID -> FileMatcher -standardMatcher groupmap configmap u = - maybe matchAll (makeMatcher groupmap configmap u . preferredContent) $ - getStandardGroup =<< u `M.lookup` groupsByUUID groupmap +{- When a preferred content expression cannot be parsed, but is already + - in the log (eg, put there by a newer version of git-annex), + - the fallback behavior is to match only files that are currently present. + - + - This avoid unwanted/expensive changes to the content, until the problem + - is resolved. -} +unknownMatcher :: UUID -> FileMatcher +unknownMatcher u = Utility.Matcher.generate [present] + where + present = Utility.Matcher.Operation $ matchPresent (Just u) {- Checks if an expression can be parsed, if not returns Just error -} checkPreferredContentExpression :: PreferredContentExpression -> Maybe String -checkPreferredContentExpression expr - | expr == "standard" = Nothing - | otherwise = case parsedToMatcher tokens of - Left e -> Just e - Right _ -> Nothing +checkPreferredContentExpression expr = case parsedToMatcher tokens of + Left e -> Just e + Right _ -> Nothing where - tokens = exprParser emptyGroupMap M.empty Nothing expr + tokens = exprParser matchAll matchAll emptyGroupMap M.empty Nothing expr {- Puts a UUID in a standard group, and sets its preferred content to use - the standard expression for that group, unless something is already set. -} diff --git a/Logs/PreferredContent/Raw.hs b/Logs/PreferredContent/Raw.hs index 63f6118e42..ce91c2dcdd 100644 --- a/Logs/PreferredContent/Raw.hs +++ b/Logs/PreferredContent/Raw.hs @@ -1,6 +1,6 @@ {- unparsed preferred content expressions - - - Copyright 2012 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -15,17 +15,35 @@ import qualified Annex.Branch import qualified Annex import Logs import Logs.UUIDBased +import Logs.MapLog import Types.StandardGroups +import Types.Group {- Changes the preferred content configuration of a remote. -} preferredContentSet :: UUID -> PreferredContentExpression -> Annex () preferredContentSet uuid@(UUID _) val = do ts <- liftIO getPOSIXTime Annex.Branch.change preferredContentLog $ - showLog id . changeLog ts uuid val . parseLog Just + showLog id + . changeLog ts uuid val + . parseLog Just Annex.changeState $ \s -> s { Annex.preferredcontentmap = Nothing } preferredContentSet NoUUID _ = error "unknown UUID; cannot modify" +{- Changes the preferred content configuration of a group. -} +groupPreferredContentSet :: Group -> PreferredContentExpression -> Annex () +groupPreferredContentSet g val = do + ts <- liftIO getPOSIXTime + Annex.Branch.change groupPreferredContentLog $ + showMapLog id id + . changeMapLog ts g val + . parseMapLog Just Just + Annex.changeState $ \s -> s { Annex.preferredcontentmap = Nothing } + preferredContentMapRaw :: Annex (M.Map UUID PreferredContentExpression) preferredContentMapRaw = simpleMap . parseLog Just <$> Annex.Branch.get preferredContentLog + +groupPreferredContentMapRaw :: Annex (M.Map Group PreferredContentExpression) +groupPreferredContentMapRaw = simpleMap . parseMapLog Just Just + <$> Annex.Branch.get groupPreferredContentLog diff --git a/Logs/UUIDBased.hs b/Logs/UUIDBased.hs index 430c92d553..b403b6253c 100644 --- a/Logs/UUIDBased.hs +++ b/Logs/UUIDBased.hs @@ -26,9 +26,6 @@ module Logs.UUIDBased ( changeLog, addLog, simpleMap, - - prop_TimeStamp_sane, - prop_addLog_sane, ) where import qualified Data.Map as M @@ -38,21 +35,11 @@ import System.Locale import Common import Types.UUID +import Logs.MapLog -data TimeStamp = Unknown | Date POSIXTime - deriving (Eq, Ord, Show) +type Log v = MapLog UUID v -data LogEntry a = LogEntry - { changed :: TimeStamp - , value :: a - } deriving (Eq, Show) - -type Log a = M.Map UUID (LogEntry a) - -tskey :: String -tskey = "timestamp=" - -showLog :: (a -> String) -> Log a -> String +showLog :: (v -> String) -> Log v -> String showLog shower = unlines . map showpair . M.toList where showpair (k, LogEntry (Date p) v) = @@ -60,14 +47,6 @@ showLog shower = unlines . map showpair . M.toList showpair (k, LogEntry Unknown v) = unwords [fromUUID k, shower v] -showLogNew :: (a -> String) -> Log a -> String -showLogNew shower = unlines . map showpair . M.toList - where - showpair (k, LogEntry (Date p) v) = - unwords [show p, fromUUID k, shower v] - showpair (k, LogEntry Unknown v) = - unwords ["0", fromUUID k, shower v] - parseLog :: (String -> Maybe a) -> String -> Log a parseLog = parseLogWithUUID . const @@ -98,45 +77,17 @@ parseLogWithUUID parser = M.fromListWith best . mapMaybe parse . lines Nothing -> Unknown Just d -> Date $ utcTimeToPOSIXSeconds d -parseLogNew :: (String -> Maybe a) -> String -> Log a -parseLogNew parser = M.fromListWith best . mapMaybe parse . lines - where - parse line = do - let (ts, rest) = splitword line - (u, v) = splitword rest - date <- Date . utcTimeToPOSIXSeconds <$> parseTime defaultTimeLocale "%s%Qs" ts - val <- parser v - Just (toUUID u, LogEntry date val) - splitword = separate (== ' ') +showLogNew :: (v -> String) -> Log v -> String +showLogNew = showMapLog fromUUID -changeLog :: POSIXTime -> UUID -> a -> Log a -> Log a -changeLog t u v = M.insert u $ LogEntry (Date t) v +parseLogNew :: (String -> Maybe v) -> String -> Log v +parseLogNew = parseMapLog (Just . toUUID) -{- Only add an LogEntry if it's newer (or at least as new as) than any - - existing LogEntry for a UUID. -} -addLog :: UUID -> LogEntry a -> Log a -> Log a -addLog = M.insertWith' best +changeLog :: POSIXTime -> UUID -> v -> Log v -> Log v +changeLog = changeMapLog -{- Converts a Log into a simple Map without the timestamp information. - - This is a one-way trip, but useful for code that never needs to change - - the log. -} -simpleMap :: Log a -> M.Map UUID a -simpleMap = M.map value +addLog :: UUID -> LogEntry v -> Log v -> Log v +addLog = addMapLog -best :: LogEntry a -> LogEntry a -> LogEntry a -best new old - | changed old > changed new = old - | otherwise = new - --- Unknown is oldest. -prop_TimeStamp_sane :: Bool -prop_TimeStamp_sane = Unknown < Date 1 - -prop_addLog_sane :: Bool -prop_addLog_sane = newWins && newestWins - where - newWins = addLog (UUID "foo") (LogEntry (Date 1) "new") l == l2 - newestWins = addLog (UUID "foo") (LogEntry (Date 1) "newest") l2 /= l2 - - l = M.fromList [(UUID "foo", LogEntry (Date 0) "old")] - l2 = M.fromList [(UUID "foo", LogEntry (Date 1) "new")] +tskey :: String +tskey = "timestamp=" diff --git a/Logs/Unused.hs b/Logs/Unused.hs index d26d37dca7..cadf7ed9d1 100644 --- a/Logs/Unused.hs +++ b/Logs/Unused.hs @@ -67,7 +67,7 @@ updateUnusedLog prefix m = do writeUnusedLog :: FilePath -> UnusedLog -> Annex () writeUnusedLog prefix l = do logfile <- fromRepo $ gitAnnexUnusedLog prefix - liftIO $ viaTmp writeFile logfile $ unlines $ map format $ M.toList l + liftIO $ viaTmp writeFileAnyEncoding logfile $ unlines $ map format $ M.toList l where format (k, (i, Just t)) = show i ++ " " ++ key2file k ++ " " ++ show t format (k, (i, Nothing)) = show i ++ " " ++ key2file k @@ -77,7 +77,7 @@ readUnusedLog prefix = do f <- fromRepo $ gitAnnexUnusedLog prefix ifM (liftIO $ doesFileExist f) ( M.fromList . mapMaybe parse . lines - <$> liftIO (readFile f) + <$> liftIO (readFileStrictAnyEncoding f) , return M.empty ) where @@ -99,7 +99,6 @@ dateUnusedLog prefix = do f <- fromRepo $ gitAnnexUnusedLog prefix liftIO $ catchMaybeIO $ getModificationTime f #else -#warning foo -- old ghc's getModificationTime returned a ClockTime dateUnusedLog _prefix = return Nothing #endif diff --git a/Makefile b/Makefile index 50d1acd9a0..45b9a578b8 100644 --- a/Makefile +++ b/Makefile @@ -119,7 +119,7 @@ linuxstandalone-nobuild: Build/Standalone Build/LinuxMkLibs strip "$(LINUXSTANDALONE_DEST)/bin/git-annex" ln -sf git-annex "$(LINUXSTANDALONE_DEST)/bin/git-annex-shell" zcat standalone/licences.gz > $(LINUXSTANDALONE_DEST)/LICENSE - cp doc/favicon.png doc/logo.svg $(LINUXSTANDALONE_DEST) + cp doc/logo_16x16.png doc/logo.svg $(LINUXSTANDALONE_DEST) ./Build/Standalone "$(LINUXSTANDALONE_DEST)" diff --git a/Remote.hs b/Remote.hs index 5fc6d1c009..0f31b99b29 100644 --- a/Remote.hs +++ b/Remote.hs @@ -37,6 +37,7 @@ module Remote ( keyPossibilities, keyPossibilitiesTrusted, nameToUUID, + nameToUUID', showTriedRemotes, showLocations, forceTrust, @@ -48,7 +49,6 @@ module Remote ( import qualified Data.Map as M import Text.JSON import Text.JSON.Generic -import Data.Tuple import Data.Ord import Common.Annex @@ -121,23 +121,25 @@ noRemoteUUIDMsg r = "cannot determine uuid for " ++ name r - and returns its UUID. Finds even repositories that are not - configured in .git/config. -} nameToUUID :: RemoteName -> Annex UUID -nameToUUID "." = getUUID -- special case for current repo -nameToUUID "here" = getUUID -nameToUUID "" = error "no remote specified" -nameToUUID n = byName' n >>= go +nameToUUID = either error return <=< nameToUUID' + +nameToUUID' :: RemoteName -> Annex (Either String UUID) +nameToUUID' "." = Right <$> getUUID -- special case for current repo +nameToUUID' "here" = Right <$> getUUID +nameToUUID' n = byName' n >>= go where - go (Right r) = case uuid r of - NoUUID -> error $ noRemoteUUIDMsg r - u -> return u - go (Left e) = fromMaybe (error e) <$> bydescription - bydescription = do + go (Right r) = return $ case uuid r of + NoUUID -> Left $ noRemoteUUIDMsg r + u -> Right u + go (Left e) = do m <- uuidMap - case M.lookup n $ transform swap m of - Just u -> return $ Just u - Nothing -> return $ byuuid m - byuuid m = M.lookup (toUUID n) $ transform double m - transform a = M.fromList . map a . M.toList - double (a, _) = (a, a) + return $ case M.keys (M.filter (== n) m) of + [u] -> Right u + [] -> let u = toUUID n + in case M.keys (M.filterWithKey (\k _ -> k == u) m) of + [] -> Left e + _ -> Right u + _us -> Left "Found multiple repositories with that description" {- Pretty-prints a list of UUIDs of remotes, for human display. - diff --git a/Remote/External.hs b/Remote/External.hs index 50a0767eab..9be9175c74 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -11,6 +11,7 @@ import Remote.External.Types import qualified Annex import Common.Annex import Types.Remote +import Types.CleanupActions import qualified Git import Config import Remote.Helper.Special @@ -43,7 +44,7 @@ remote = RemoteType { gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote) gen r u c gc = do external <- newExternal externaltype u c - Annex.addCleanup (fromUUID u) $ stopExternal external + Annex.addCleanup (RemoteCleanup u) $ stopExternal external cst <- getCost external r gc avail <- getAvailability external r gc return $ Just $ encryptableRemote c diff --git a/Remote/Git.hs b/Remote/Git.hs index 4508d45554..995d667795 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -36,6 +36,7 @@ import Config import Config.Cost import Annex.Init import Types.Key +import Types.CleanupActions import qualified CmdLine.GitAnnexShell.Fields as Fields import Logs.Location import Utility.Metered @@ -144,7 +145,7 @@ repoAvail r else return True | Git.repoIsUrl r = return True | Git.repoIsLocalUnknown r = return False - | otherwise = liftIO $ catchBoolIO $ onLocal r $ return True + | otherwise = liftIO $ isJust <$> catchMaybeIO (Git.Config.read r) {- Tries to read the config for a specified remote, updates state, and - returns the updated repo. -} @@ -161,9 +162,12 @@ tryGitConfigRead r | Git.repoIsHttp r = store geturlconfig | Git.GCrypt.isEncrypted r = handlegcrypt =<< getConfigMaybe (remoteConfig r "uuid") | Git.repoIsUrl r = return r - | otherwise = store $ safely $ onLocal r $ do - ensureInitialized - Annex.getState Annex.repo + | otherwise = store $ safely $ do + s <- Annex.new r + Annex.eval s $ do + Annex.BranchState.disableUpdate + ensureInitialized + Annex.getState Annex.repo where haveconfig = not . M.null . Git.config @@ -267,8 +271,8 @@ inAnnex rmt key checkremote = Ssh.inAnnex r key checklocal = guardUsable r (cantCheck r) $ dispatch <$> check where - check = liftIO $ catchMsgIO $ onLocal r $ - Annex.Content.inAnnexSafe key + check = either (Left . show) Right + <$> tryAnnex (onLocal rmt $ Annex.Content.inAnnexSafe key) dispatch (Left e) = Left e dispatch (Right (Just b)) = Right b dispatch (Right Nothing) = cantCheck r @@ -291,7 +295,7 @@ keyUrls r key = map tourl locs' dropKey :: Remote -> Key -> Annex Bool dropKey r key | not $ Git.repoIsUrl (repo r) = - guardUsable (repo r) False $ commitOnCleanup r $ liftIO $ onLocal (repo r) $ do + guardUsable (repo r) False $ commitOnCleanup r $ onLocal r $ do ensureInitialized whenM (Annex.Content.inAnnex key) $ do Annex.Content.lockContent key $ @@ -311,7 +315,7 @@ copyFromRemote' r key file dest let params = Ssh.rsyncParams r Download u <- getUUID -- run copy from perspective of remote - liftIO $ onLocal (repo r) $ do + onLocal r $ do ensureInitialized v <- Annex.Content.prepSendAnnex key case v of @@ -410,7 +414,7 @@ copyToRemote r key file p let params = Ssh.rsyncParams r Upload u <- getUUID -- run copy from perspective of remote - liftIO $ onLocal (repo r) $ ifM (Annex.Content.inAnnex key) + onLocal r $ ifM (Annex.Content.inAnnex key) ( return True , do ensureInitialized @@ -439,19 +443,40 @@ fsckOnRemote r params {- The passed repair action is run in the Annex monad of the remote. -} repairRemote :: Git.Repo -> Annex Bool -> Annex (IO Bool) -repairRemote r a = return $ Remote.Git.onLocal r a - -{- Runs an action on a local repository inexpensively, by making an annex - - monad using that repository. -} -onLocal :: Git.Repo -> Annex a -> IO a -onLocal r a = do +repairRemote r a = return $ do s <- Annex.new r Annex.eval s $ do - -- No need to update the branch; its data is not used - -- for anything onLocal is used to do. Annex.BranchState.disableUpdate + ensureInitialized a +{- Runs an action from the perspective of a local remote. + - + - The AnnexState is cached for speed and to avoid resource leaks. + - + - The repository's git-annex branch is not updated, as an optimisation. + - No caller of onLocal can query data from the branch and be ensured + - it gets a current value. Caller of onLocal can make changes to + - the branch, however. + -} +onLocal :: Remote -> Annex a -> Annex a +onLocal r a = do + m <- Annex.getState Annex.remoteannexstate + case M.lookup (uuid r) m of + Nothing -> do + st <- liftIO $ Annex.new (repo r) + go st $ do + Annex.BranchState.disableUpdate + a + Just st -> go st a + where + cache st = Annex.changeState $ \s -> s + { Annex.remoteannexstate = M.insert (uuid r) st (Annex.remoteannexstate s) } + go st a' = do + (ret, st') <- liftIO $ Annex.run st a' + cache st' + return ret + {- Copys a file with rsync unless both locations are on the same - filesystem. Then cp could be faster. -} rsyncOrCopyFile :: [CommandParam] -> FilePath -> FilePath -> MeterUpdate -> Annex Bool @@ -486,9 +511,9 @@ rsyncOrCopyFile rsyncparams src dest p = commitOnCleanup :: Remote -> Annex a -> Annex a commitOnCleanup r a = go `after` a where - go = Annex.addCleanup (Git.repoLocation $ repo r) cleanup + go = Annex.addCleanup (RemoteCleanup $ uuid r) cleanup cleanup - | not $ Git.repoIsUrl (repo r) = liftIO $ onLocal (repo r) $ + | not $ Git.repoIsUrl (repo r) = onLocal r $ doQuietSideAction $ Annex.Branch.commit "update" | otherwise = void $ do diff --git a/Remote/Helper/Hooks.hs b/Remote/Helper/Hooks.hs index f876649f07..b7deae5770 100644 --- a/Remote/Helper/Hooks.hs +++ b/Remote/Helper/Hooks.hs @@ -13,6 +13,7 @@ import qualified Data.Map as M import Common.Annex import Types.Remote +import Types.CleanupActions import qualified Annex import Annex.LockPool #ifndef mingw32_HOST_OS @@ -74,7 +75,7 @@ runHooks r starthook stophook a = do -- So, requiring idempotency is the right approach. run starthook - Annex.addCleanup (remoteid ++ "-stop-command") $ runstop lck + Annex.addCleanup (StopHook $ uuid r) $ runstop lck runstop lck = do -- Drop any shared lock we have, and take an -- exclusive lock, without blocking. If the lock diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 8f00a767e4..7d051d6cd3 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -28,6 +28,7 @@ import Annex.UUID import Annex.Ssh import Remote.Helper.Special import Remote.Helper.Encryptable +import Remote.Rsync.RsyncUrl import Crypto import Utility.Rsync import Utility.CopyFile @@ -40,16 +41,6 @@ import Types.Creds import qualified Data.ByteString.Lazy as L import qualified Data.Map as M -type RsyncUrl = String - -data RsyncOpts = RsyncOpts - { rsyncUrl :: RsyncUrl - , rsyncOptions :: [CommandParam] - , rsyncUploadOptions :: [CommandParam] - , rsyncDownloadOptions :: [CommandParam] - , rsyncShellEscape :: Bool -} - remote :: RemoteType remote = RemoteType { typename = "rsync", @@ -148,17 +139,6 @@ rsyncSetup mu _ c = do gitConfigSpecialRemote u c' "rsyncurl" url return (c', u) -rsyncEscape :: RsyncOpts -> String -> String -rsyncEscape o s - | rsyncShellEscape o && rsyncUrlIsShell (rsyncUrl o) = shellEscape s - | otherwise = s - -rsyncUrls :: RsyncOpts -> Key -> [String] -rsyncUrls o k = map use annexHashes - where - use h = rsyncUrl o h k rsyncEscape o (f f) - f = keyFile k - store :: RsyncOpts -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool store o k _f p = sendAnnex k (void $ remove o k) $ rsyncSend o p k False diff --git a/Remote/Rsync/RsyncUrl.hs b/Remote/Rsync/RsyncUrl.hs new file mode 100644 index 0000000000..61bbe2f3fb --- /dev/null +++ b/Remote/Rsync/RsyncUrl.hs @@ -0,0 +1,46 @@ +{- Rsync urls. + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Remote.Rsync.RsyncUrl where + +import Types +import Locations +import Utility.Rsync +import Utility.SafeCommand + +import System.FilePath.Posix +#ifdef mingw32_HOST_OS +import Data.String.Utils +#endif + +type RsyncUrl = String + +data RsyncOpts = RsyncOpts + { rsyncUrl :: RsyncUrl + , rsyncOptions :: [CommandParam] + , rsyncUploadOptions :: [CommandParam] + , rsyncDownloadOptions :: [CommandParam] + , rsyncShellEscape :: Bool +} + +rsyncEscape :: RsyncOpts -> RsyncUrl -> RsyncUrl +rsyncEscape o u + | rsyncShellEscape o && rsyncUrlIsShell (rsyncUrl o) = shellEscape u + | otherwise = u + +rsyncUrls :: RsyncOpts -> Key -> [RsyncUrl] +rsyncUrls o k = map use annexHashes + where + use h = rsyncUrl o hash h rsyncEscape o (f f) + f = keyFile k +#ifndef mingw32_HOST_OS + hash h = h k +#else + hash h = replace "\\" "/" (h k) +#endif diff --git a/Setup.hs b/Setup.hs index 0a187bd953..470a0d3db8 100644 --- a/Setup.hs +++ b/Setup.hs @@ -16,15 +16,14 @@ import System.Directory import qualified Build.DesktopFile as DesktopFile import qualified Build.Configure as Configure +main :: IO () main = defaultMainWithHooks simpleUserHooks - { preConf = configure + { preConf = \_ _ -> do + Configure.run Configure.tests + return (Nothing, []) , postInst = myPostInst } -configure _ _ = do - Configure.run Configure.tests - return (Nothing, []) - myPostInst :: Args -> InstallFlags -> PackageDescription -> LocalBuildInfo -> IO () myPostInst _ (InstallFlags { installVerbosity }) pkg lbi = do installGitAnnexShell dest verbosity pkg lbi @@ -57,7 +56,7 @@ installManpages copyDest verbosity pkg lbi = manpages = ["git-annex.1", "git-annex-shell.1"] installDesktopFile :: CopyDest -> Verbosity -> PackageDescription -> LocalBuildInfo -> IO () -installDesktopFile copyDest verbosity pkg lbi = +installDesktopFile copyDest _verbosity pkg lbi = DesktopFile.install $ dstBinDir "git-annex" where dstBinDir = bindir $ absoluteInstallDirs pkg lbi copyDest diff --git a/Test.hs b/Test.hs index 0f52abf6cd..8fbaf1d944 100644 --- a/Test.hs +++ b/Test.hs @@ -17,12 +17,14 @@ import Test.Tasty.Ingredients.Rerun import Data.Monoid import Options.Applicative hiding (command) +#if MIN_VERSION_optparse_applicative(0,8,0) +import qualified Options.Applicative.Types as Opt +#endif import Control.Exception.Extensible import qualified Data.Map as M import System.IO.HVFS (SystemFS(..)) import qualified Text.JSON import System.Path -import qualified Data.ByteString.Lazy as L import Common @@ -43,7 +45,7 @@ import qualified Types.Backend import qualified Types.TrustLevel import qualified Types import qualified Logs -import qualified Logs.UUIDBased +import qualified Logs.MapLog import qualified Logs.Trust import qualified Logs.Remote import qualified Logs.Unused @@ -104,8 +106,7 @@ main ps = do -- parameters is "test". let pinfo = info (helper <*> suiteOptionParser ingredients tests) ( fullDesc <> header "Builtin test suite" ) - opts <- either (\f -> error =<< errMessage f "git-annex test") return $ - execParserPure (prefs idm) pinfo ps + opts <- parseOpts (prefs idm) pinfo ps case tryIngredients ingredients opts tests of Nothing -> error "No tests found!?" Just act -> ifM act @@ -115,6 +116,18 @@ main ps = do putStrLn " with utilities, such as git, installed on this system.)" exitFailure ) + where + progdesc = "git-annex test" + parseOpts pprefs pinfo args = +#if MIN_VERSION_optparse_applicative(0,8,0) + pure $ case execParserPure pprefs pinfo args of + Opt.Success v -> v + Opt.Failure f -> error $ fst $ Opt.execFailure f progdesc + Opt.CompletionInvoked _ -> error "completion not supported" +#else + either (error <=< flip errMessage progdesc) return $ + execParserPure pprefs pinfo args +#endif ingredients :: [Ingredient] ingredients = @@ -140,8 +153,8 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" , testProperty "prop_cost_sane" Config.Cost.prop_cost_sane , testProperty "prop_matcher_sane" Utility.Matcher.prop_matcher_sane , testProperty "prop_HmacSha1WithCipher_sane" Crypto.prop_HmacSha1WithCipher_sane - , testProperty "prop_TimeStamp_sane" Logs.UUIDBased.prop_TimeStamp_sane - , testProperty "prop_addLog_sane" Logs.UUIDBased.prop_addLog_sane + , testProperty "prop_TimeStamp_sane" Logs.MapLog.prop_TimeStamp_sane + , testProperty "prop_addMapLog_sane" Logs.MapLog.prop_addMapLog_sane , testProperty "prop_verifiable_sane" Utility.Verifiable.prop_verifiable_sane , testProperty "prop_segment_regressionTest" Utility.Misc.prop_segment_regressionTest , testProperty "prop_read_write_transferinfo" Logs.Transfer.prop_read_write_transferinfo @@ -1272,7 +1285,7 @@ test_add_subdirs env = intmpclonerepo env $ do {- Regression test for Windows bug where symlinks were not - calculated correctly for files in subdirs. -} git_annex env "sync" [] @? "sync failed" - l <- annexeval $ encodeW8 . L.unpack <$> Annex.CatFile.catObject (Git.Types.Ref "HEAD:dir/foo") + l <- annexeval $ decodeBS <$> Annex.CatFile.catObject (Git.Types.Ref "HEAD:dir/foo") "../.git/annex/" `isPrefixOf` l @? ("symlink from subdir to .git/annex is wrong: " ++ l) createDirectory "dir2" diff --git a/Types/CleanupActions.hs b/Types/CleanupActions.hs new file mode 100644 index 0000000000..498d5b4d7d --- /dev/null +++ b/Types/CleanupActions.hs @@ -0,0 +1,17 @@ +{- Enumeration of cleanup actions + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Types.CleanupActions where + +import Types.UUID + +data CleanupAction + = RemoteCleanup UUID + | StopHook UUID + | FsckCleanup + | SshCachingCleanup + deriving (Eq, Ord) diff --git a/Types/MetaData.hs b/Types/MetaData.hs index c37b31c512..706d037bcc 100644 --- a/Types/MetaData.hs +++ b/Types/MetaData.hs @@ -28,6 +28,7 @@ module Types.MetaData ( emptyMetaData, updateMetaData, unionMetaData, + combineMetaData, differenceMetaData, isSet, currentMetaData, @@ -140,7 +141,7 @@ toMetaField f - that would break views. - - So, require they have an alphanumeric first letter, with the remainder - - being either alphanumeric or a small set of shitelisted common punctuation. + - being either alphanumeric or a small set of whitelisted common punctuation. -} legalField :: String -> Bool legalField [] = False @@ -188,6 +189,9 @@ unionMetaData :: MetaData -> MetaData -> MetaData unionMetaData (MetaData old) (MetaData new) = MetaData $ M.unionWith S.union new old +combineMetaData :: [MetaData] -> MetaData +combineMetaData = foldl' unionMetaData emptyMetaData + differenceMetaData :: MetaData -> MetaData -> MetaData differenceMetaData (MetaData m) (MetaData excludem) = MetaData $ M.differenceWith diff m excludem diff --git a/Types/StandardGroups.hs b/Types/StandardGroups.hs index 2f5cd4b304..37ba6e9c64 100644 --- a/Types/StandardGroups.hs +++ b/Types/StandardGroups.hs @@ -8,6 +8,7 @@ module Types.StandardGroups where import Types.Remote (RemoteConfig) +import Types.Group import qualified Data.Map as M import Data.Maybe @@ -27,7 +28,7 @@ data StandardGroup | UnwantedGroup deriving (Eq, Ord, Enum, Bounded, Show) -fromStandardGroup :: StandardGroup -> String +fromStandardGroup :: StandardGroup -> Group fromStandardGroup ClientGroup = "client" fromStandardGroup TransferGroup = "transfer" fromStandardGroup BackupGroup = "backup" @@ -39,7 +40,7 @@ fromStandardGroup ManualGroup = "manual" fromStandardGroup PublicGroup = "public" fromStandardGroup UnwantedGroup = "unwanted" -toStandardGroup :: String -> Maybe StandardGroup +toStandardGroup :: Group -> Maybe StandardGroup toStandardGroup "client" = Just ClientGroup toStandardGroup "transfer" = Just TransferGroup toStandardGroup "backup" = Just BackupGroup @@ -77,21 +78,21 @@ specialRemoteOnly PublicGroup = True specialRemoteOnly _ = False {- See doc/preferred_content.mdwn for explanations of these expressions. -} -preferredContent :: StandardGroup -> PreferredContentExpression -preferredContent ClientGroup = lastResort $ +standardPreferredContent :: StandardGroup -> PreferredContentExpression +standardPreferredContent ClientGroup = lastResort $ "((exclude=*/archive/* and exclude=archive/*) or (" ++ notArchived ++ ")) and not unused" -preferredContent TransferGroup = lastResort $ - "not (inallgroup=client and copies=client:2) and (" ++ preferredContent ClientGroup ++ ")" -preferredContent BackupGroup = "include=* or unused" -preferredContent IncrementalBackupGroup = lastResort +standardPreferredContent TransferGroup = lastResort $ + "not (inallgroup=client and copies=client:2) and (" ++ standardPreferredContent ClientGroup ++ ")" +standardPreferredContent BackupGroup = "include=* or unused" +standardPreferredContent IncrementalBackupGroup = lastResort "(include=* or unused) and (not copies=incrementalbackup:1)" -preferredContent SmallArchiveGroup = lastResort $ - "(include=*/archive/* or include=archive/*) and (" ++ preferredContent FullArchiveGroup ++ ")" -preferredContent FullArchiveGroup = lastResort notArchived -preferredContent SourceGroup = "not (copies=1)" -preferredContent ManualGroup = "present and (" ++ preferredContent ClientGroup ++ ")" -preferredContent PublicGroup = "inpreferreddir" -preferredContent UnwantedGroup = "exclude=*" +standardPreferredContent SmallArchiveGroup = lastResort $ + "(include=*/archive/* or include=archive/*) and (" ++ standardPreferredContent FullArchiveGroup ++ ")" +standardPreferredContent FullArchiveGroup = lastResort notArchived +standardPreferredContent SourceGroup = "not (copies=1)" +standardPreferredContent ManualGroup = "present and (" ++ standardPreferredContent ClientGroup ++ ")" +standardPreferredContent PublicGroup = "inpreferreddir" +standardPreferredContent UnwantedGroup = "exclude=*" notArchived :: String notArchived = "not (copies=archive:1 or copies=smallarchive:1)" diff --git a/Utility/FileMode.hs b/Utility/FileMode.hs index b17cadc3bc..d8fb866aeb 100644 --- a/Utility/FileMode.hs +++ b/Utility/FileMode.hs @@ -99,13 +99,20 @@ noUmask :: FileMode -> IO a -> IO a #ifndef mingw32_HOST_OS noUmask mode a | mode == stdFileMode = a - | otherwise = bracket setup cleanup go + | otherwise = withUmask nullFileMode a +#else +noUmask _ a = a +#endif + +withUmask :: FileMode -> IO a -> IO a +#ifndef mingw32_HOST_OS +withUmask umask a = bracket setup cleanup go where - setup = setFileCreationMask nullFileMode + setup = setFileCreationMask umask cleanup = setFileCreationMask go _ = a #else -noUmask _ a = a +withUmask _ a = a #endif combineModes :: [FileMode] -> FileMode @@ -127,14 +134,20 @@ setSticky f = modifyFileMode f $ addModes [stickyMode] #endif {- Writes a file, ensuring that its modes do not allow it to be read - - by anyone other than the current user, before any content is written. + - or written by anyone other than the current user, + - before any content is written. + - + - When possible, this is done using the umask. - - On a filesystem that does not support file permissions, this is the same - as writeFile. -} writeFileProtected :: FilePath -> String -> IO () -writeFileProtected file content = withFile file WriteMode $ \h -> do - void $ tryIO $ - modifyFileMode file $ - removeModes [groupReadMode, otherReadMode] - hPutStr h content +writeFileProtected file content = withUmask 0o0077 $ + withFile file WriteMode $ \h -> do + void $ tryIO $ modifyFileMode file $ + removeModes + [ groupReadMode, otherReadMode + , groupWriteMode, otherWriteMode + ] + hPutStr h content diff --git a/Utility/FileSystemEncoding.hs b/Utility/FileSystemEncoding.hs index ac105e73d2..690942cbab 100644 --- a/Utility/FileSystemEncoding.hs +++ b/Utility/FileSystemEncoding.hs @@ -1,14 +1,17 @@ {- GHC File system encoding handling. - - - Copyright 2012-2013 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE CPP #-} + module Utility.FileSystemEncoding ( fileEncoding, withFilePath, md5FilePath, + decodeBS, decodeW8, encodeW8, truncateFilePath, @@ -22,13 +25,24 @@ import System.IO.Unsafe import qualified Data.Hash.MD5 as MD5 import Data.Word import Data.Bits.Utils +import qualified Data.ByteString.Lazy as L +#ifdef mingw32_HOST_OS +import qualified Data.ByteString.Lazy.UTF8 as L8 +#endif {- Sets a Handle to use the filesystem encoding. This causes data - written or read from it to be encoded/decoded the same - as ghc 7.4 does to filenames etc. This special encoding - - allows "arbitrary undecodable bytes to be round-tripped through it". -} + - allows "arbitrary undecodable bytes to be round-tripped through it". + -} fileEncoding :: Handle -> IO () +#ifndef mingw32_HOST_OS fileEncoding h = hSetEncoding h =<< Encoding.getFileSystemEncoding +#else +{- The file system encoding does not work well on Windows, + - and Windows only has utf FilePaths anyway. -} +fileEncoding h = hSetEncoding h Encoding.utf8 +#endif {- Marshal a Haskell FilePath into a NUL terminated C string using temporary - storage. The FilePath is encoded using the filesystem encoding, @@ -60,6 +74,16 @@ _encodeFilePath fp = unsafePerformIO $ do md5FilePath :: FilePath -> MD5.Str md5FilePath = MD5.Str . _encodeFilePath +{- Decodes a ByteString into a FilePath, applying the filesystem encoding. -} +decodeBS :: L.ByteString -> FilePath +#ifndef mingw32_HOST_OS +decodeBS = encodeW8 . L.unpack +#else +{- On Windows, we assume that the ByteString is utf-8, since Windows + - only uses unicode for filenames. -} +decodeBS = L8.toString +#endif + {- Converts a [Word8] to a FilePath, encoding using the filesystem encoding. - - w82c produces a String, which may contain Chars that are invalid @@ -84,6 +108,7 @@ decodeW8 = s2w8 . _encodeFilePath - cost of efficiency when running on a large FilePath. -} truncateFilePath :: Int -> FilePath -> FilePath +#ifndef mingw32_HOST_OS truncateFilePath n = go . reverse where go f = @@ -91,3 +116,17 @@ truncateFilePath n = go . reverse in if length bytes <= n then reverse f else go (drop 1 f) +#else +{- On Windows, count the number of bytes used by each utf8 character. -} +truncateFilePath n = reverse . go [] n . L8.fromString + where + go coll cnt bs + | cnt <= 0 = coll + | otherwise = case L8.decode bs of + Just (c, x) | c /= L8.replacement_char -> + let x' = fromIntegral x + in if cnt - x' < 0 + then coll + else go (c:coll) (cnt - x') (L8.drop 1 bs) + _ -> coll +#endif diff --git a/Utility/Misc.hs b/Utility/Misc.hs index 20007adad0..9c19df833a 100644 --- a/Utility/Misc.hs +++ b/Utility/Misc.hs @@ -109,18 +109,6 @@ massReplace vs = go [] vs go (replacement:acc) vs (drop (length val) s) | otherwise = go acc rest s -{- Given two orderings, returns the second if the first is EQ and returns - - the first otherwise. - - - - Example use: - - - - compare lname1 lname2 `thenOrd` compare fname1 fname2 - -} -thenOrd :: Ordering -> Ordering -> Ordering -thenOrd EQ x = x -thenOrd x _ = x -{-# INLINE thenOrd #-} - {- Wrapper around hGetBufSome that returns a String. - - The null string is returned on eof, otherwise returns whatever diff --git a/Utility/QuickCheck.hs b/Utility/QuickCheck.hs index e2539f3d69..7f7234c7c9 100644 --- a/Utility/QuickCheck.hs +++ b/Utility/QuickCheck.hs @@ -28,10 +28,10 @@ instance (Arbitrary v, Eq v, Ord v) => Arbitrary (S.Set v) where {- Times before the epoch are excluded. -} instance Arbitrary POSIXTime where - arbitrary = nonNegative arbitrarySizedIntegral + arbitrary = fromInteger <$> nonNegative arbitrarySizedIntegral instance Arbitrary EpochTime where - arbitrary = nonNegative arbitrarySizedIntegral + arbitrary = fromInteger <$> nonNegative arbitrarySizedIntegral {- Pids are never negative, or 0. -} instance Arbitrary ProcessID where diff --git a/Utility/WebApp.hs b/Utility/WebApp.hs index 31d3711f18..8e08ab9e0a 100644 --- a/Utility/WebApp.hs +++ b/Utility/WebApp.hs @@ -1,6 +1,6 @@ {- Yesod webapp - - - Copyright 2012 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -36,6 +36,10 @@ import Blaze.ByteString.Builder (Builder) import Data.Monoid import Control.Arrow ((***)) import Control.Concurrent +#ifdef WITH_WEBAPP_SECURE +import Data.SecureMem +import Data.Byteable +#endif #ifdef __ANDROID__ import Data.Endian #endif @@ -74,14 +78,14 @@ browserProc url = proc "xdg-open" [url] runWebApp :: Maybe TLSSettings -> Maybe HostName -> Wai.Application -> (SockAddr -> IO ()) -> IO () runWebApp tlssettings h app observer = withSocketsDo $ do sock <- getSocket h - void $ forkIO $ run webAppSettings sock app + void $ forkIO $ go webAppSettings sock app sockaddr <- fixSockAddr <$> getSocketName sock observer sockaddr where -#ifdef WITH_WEBAPP_HTTPS - run = (maybe runSettingsSocket (\ts -> runTLSSocket ts) tlssettings) +#ifdef WITH_WEBAPP_SECURE + go = (maybe runSettingsSocket (\ts -> runTLSSocket ts) tlssettings) #else - run = runSettingsSocket + go = runSettingsSocket #endif fixSockAddr :: SockAddr -> SockAddr @@ -208,15 +212,35 @@ webAppSessionBackend _ = do #endif #endif -{- Generates a random sha512 string, suitable to be used for an - - authentication secret. -} -genRandomToken :: IO String -genRandomToken = do +#ifdef WITH_WEBAPP_SECURE +type AuthToken = SecureMem +#else +type AuthToken = T.Text +#endif + +toAuthToken :: T.Text -> AuthToken +#ifdef WITH_WEBAPP_SECURE +toAuthToken = secureMemFromByteString . TE.encodeUtf8 +#else +toAuthToken = id +#endif + +fromAuthToken :: AuthToken -> T.Text +#ifdef WITH_WEBAPP_SECURE +fromAuthToken = TE.decodeLatin1 . toBytes +#else +fromAuthToken = id +#endif + +{- Generates a random sha512 string, encapsulated in a SecureMem, + - suitable to be used for an authentication secret. -} +genAuthToken :: IO AuthToken +genAuthToken = do g <- newGenIO :: IO SystemRandom return $ case genBytes 512 g of - Left e -> error $ "failed to generate secret token: " ++ show e - Right (s, _) -> show $ sha512 $ L.fromChunks [s] + Left e -> error $ "failed to generate auth token: " ++ show e + Right (s, _) -> toAuthToken $ T.pack $ show $ sha512 $ L.fromChunks [s] {- A Yesod isAuthorized method, which checks the auth cgi parameter - against a token extracted from the Yesod application. @@ -225,15 +249,15 @@ genRandomToken = do - possibly leaking the auth token in urls on that page! -} #if MIN_VERSION_yesod(1,2,0) -checkAuthToken :: (Monad m, Yesod.MonadHandler m) => (Yesod.HandlerSite m -> T.Text) -> m Yesod.AuthResult +checkAuthToken :: (Monad m, Yesod.MonadHandler m) => (Yesod.HandlerSite m -> AuthToken) -> m Yesod.AuthResult #else -checkAuthToken :: forall t sub. (t -> T.Text) -> Yesod.GHandler sub t Yesod.AuthResult +checkAuthToken :: forall t sub. (t -> AuthToken) -> Yesod.GHandler sub t Yesod.AuthResult #endif -checkAuthToken extractToken = do +checkAuthToken extractAuthToken = do webapp <- Yesod.getYesod req <- Yesod.getRequest let params = Yesod.reqGetParams req - if lookup "auth" params == Just (extractToken webapp) + if (toAuthToken <$> lookup "auth" params) == Just (extractAuthToken webapp) then return Yesod.Authorized else Yesod.sendResponseStatus unauthorized401 () @@ -243,21 +267,21 @@ checkAuthToken extractToken = do - - A typical predicate would exclude files under /static. -} -insertAuthToken :: forall y. (y -> T.Text) +insertAuthToken :: forall y. (y -> AuthToken) -> ([T.Text] -> Bool) -> y -> T.Text -> [T.Text] -> [(T.Text, T.Text)] -> Builder -insertAuthToken extractToken predicate webapp root pathbits params = +insertAuthToken extractAuthToken predicate webapp root pathbits params = fromText root `mappend` encodePath pathbits' encodedparams where pathbits' = if null pathbits then [T.empty] else pathbits encodedparams = map (TE.encodeUtf8 *** go) params' go "" = Nothing go x = Just $ TE.encodeUtf8 x - authparam = (T.pack "auth", extractToken webapp) + authparam = (T.pack "auth", fromAuthToken (extractAuthToken webapp)) params' | predicate pathbits = authparam:params | otherwise = params diff --git a/debian/changelog b/debian/changelog index 66fc6316e3..1c14cb1b50 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,43 @@ +git-annex (5.20140320) unstable; urgency=medium + + * 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. + + -- Joey Hess Thu, 20 Mar 2014 13:21:12 -0400 + git-annex (5.20140306~bpo70+1) wheezy-backports; urgency=high * Updating backport to newest release. diff --git a/debian/control b/debian/control index 1c8c1975f1..8fa7b8c779 100644 --- a/debian/control +++ b/debian/control @@ -38,6 +38,9 @@ Build-Depends: libghc-warp-tls-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc], libghc-wai-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc], libghc-wai-logger-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc], + libghc-securemem-dev, + libghc-byteable-dev, + libghc-dns-dev, libghc-case-insensitive-dev, libghc-http-types-dev, libghc-blaze-builder-dev, diff --git a/doc/Android/oldcomments/comment_1_cc9caa5dd22dd67e5c1d22d697096dd2._comment b/doc/Android/oldcomments/comment_1_cc9caa5dd22dd67e5c1d22d697096dd2._comment index 7fb38058c5..44b1a5d705 100644 --- a/doc/Android/oldcomments/comment_1_cc9caa5dd22dd67e5c1d22d697096dd2._comment +++ b/doc/Android/oldcomments/comment_1_cc9caa5dd22dd67e5c1d22d697096dd2._comment @@ -1,4 +1,4 @@ -[[!comment format=txt +[[!comment format=mdwn username="http://yarikoptic.myopenid.com/" nickname="site-myopenid" subject="Does it require the device to be rooted?" diff --git a/doc/assistant/remote_sharing_walkthrough/comment_6_770c4f1802fc40d76bbaf7783bb3b4ac._comment b/doc/assistant/remote_sharing_walkthrough/comment_6_770c4f1802fc40d76bbaf7783bb3b4ac._comment new file mode 100644 index 0000000000..69ae139b2b --- /dev/null +++ b/doc/assistant/remote_sharing_walkthrough/comment_6_770c4f1802fc40d76bbaf7783bb3b4ac._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="severo" + ip="88.182.182.135" + subject="git-assistant and transfer repository" + date="2014-03-16T17:05:43Z" + content=""" +In your comment http://git-annex.branchable.com/assistant/remote_sharing_walkthrough/#comment-f97efe1d05c0101232684b4e4edc4866, you describe a way to synchronize two devices using an intermediate USB drive configured as a \"transfer repository\". + +I understand that in that case, the USB drive can only be used as a \"transmitter\", in a git repository form, not as a copy of the files structure. This means the files contained by the USB drive cannot be accessed without git/git-annnex. + +Is there a way to use the USB drive as a \"client repository\" in order to allow synchronization, as described earlier, but also as a simple copy of the files, in order to access them from any device (opening them with windows in a cyber coffee for example). + +Thanks +"""]] diff --git a/doc/assistant/remote_sharing_walkthrough/comment_7_61c1f5b00381b2fa891a8578267881ab._comment b/doc/assistant/remote_sharing_walkthrough/comment_7_61c1f5b00381b2fa891a8578267881ab._comment new file mode 100644 index 0000000000..e34a462da5 --- /dev/null +++ b/doc/assistant/remote_sharing_walkthrough/comment_7_61c1f5b00381b2fa891a8578267881ab._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 7" + date="2014-03-17T19:50:48Z" + content=""" +@severo the web app does not support setting up that use case. However, you can make a non-bare clone of your repository onto a removable drive, and if you do the assistant will use it just the same as if you'd set up a removable drive using the webapp. Note that you will need to run `git annex sync` inside that repository in order to update the tree it displays. +"""]] diff --git a/doc/assistant/remote_sharing_walkthrough/comment_8_35e00cd10e89ae4bcc66af7dadf6bb5c._comment b/doc/assistant/remote_sharing_walkthrough/comment_8_35e00cd10e89ae4bcc66af7dadf6bb5c._comment new file mode 100644 index 0000000000..994d969e6c --- /dev/null +++ b/doc/assistant/remote_sharing_walkthrough/comment_8_35e00cd10e89ae4bcc66af7dadf6bb5c._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="severo" + ip="95.152.107.168" + subject="comment 8" + date="2014-03-18T10:06:50Z" + content=""" +Thansk @joeyh.name for your answer. Do you think this feature could be integrated into the git-annex assistant ? +"""]] diff --git a/doc/assistant/remote_sharing_walkthrough/comment_9_c900e4ef49388826c87cadef4235c073._comment b/doc/assistant/remote_sharing_walkthrough/comment_9_c900e4ef49388826c87cadef4235c073._comment new file mode 100644 index 0000000000..1766fcf631 --- /dev/null +++ b/doc/assistant/remote_sharing_walkthrough/comment_9_c900e4ef49388826c87cadef4235c073._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="severo" + ip="95.152.107.168" + subject="comment 9" + date="2014-03-18T11:16:19Z" + content=""" +Some explanations in French on how to do: http://seenthis.net/messages/237648#message238202 +"""]] diff --git a/doc/automatic_conflict_resolution/comment_1_307898855f91a2a189d4fa5eae62cce1._comment b/doc/automatic_conflict_resolution/comment_1_307898855f91a2a189d4fa5eae62cce1._comment index 69e136b44f..57a8c45f84 100644 --- a/doc/automatic_conflict_resolution/comment_1_307898855f91a2a189d4fa5eae62cce1._comment +++ b/doc/automatic_conflict_resolution/comment_1_307898855f91a2a189d4fa5eae62cce1._comment @@ -1,4 +1,4 @@ -[[!comment format=txt +[[!comment format=mdwn username="https://www.google.com/accounts/o8/id?id=AItOawnJTqmRu1YCKS2Hsm4vtOflLhP4fU-k98w" nickname="Ahmed" subject="Customise conflict resolution behaviour" diff --git a/doc/automatic_conflict_resolution/comment_2_0a8ea42764dde1a33d2112197b961c51._comment b/doc/automatic_conflict_resolution/comment_2_0a8ea42764dde1a33d2112197b961c51._comment new file mode 100644 index 0000000000..8c50ec4e22 --- /dev/null +++ b/doc/automatic_conflict_resolution/comment_2_0a8ea42764dde1a33d2112197b961c51._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawn3p4i4lk_zMilvjnJ9sS6g2nerpgz0Fjc" + nickname="Matthias" + subject="Use automatic merge without syncing" + date="2014-03-20T10:03:41Z" + content=""" +Is there a possibility to use the automatic merge logic without using \"git annex sync\"? I don't want to have the \"synced\"-branches, but the auto-conflict-resolution is very nice. +"""]] diff --git a/doc/automatic_conflict_resolution/comment_3_5c587c6633cae1c8547ca970d55ee97e._comment b/doc/automatic_conflict_resolution/comment_3_5c587c6633cae1c8547ca970d55ee97e._comment new file mode 100644 index 0000000000..58bdc56310 --- /dev/null +++ b/doc/automatic_conflict_resolution/comment_3_5c587c6633cae1c8547ca970d55ee97e._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.102" + subject="comment 3" + date="2014-03-20T16:10:10Z" + content=""" +@Matthias `git annex merge` will do what you want, as long as you have git-annex 4.20130709 or newer. +"""]] diff --git a/doc/bugs/Android_:_handling_DCIM__47__Camera_not_being_configurable.mdwn b/doc/bugs/Android_:_handling_DCIM__47__Camera_not_being_configurable.mdwn index 45475f7400..a52857d1f1 100644 --- a/doc/bugs/Android_:_handling_DCIM__47__Camera_not_being_configurable.mdwn +++ b/doc/bugs/Android_:_handling_DCIM__47__Camera_not_being_configurable.mdwn @@ -11,3 +11,6 @@ In order to handle the fact that the directory where pictures are saved is not c In the log, there are many "too many open files" errors like these : git:createProcess: runInteractiveProcess: pipe: resource exhausted (Too many open files) + +[[!tag moreinfo]] +[[!meta title="too many open files on android"]] diff --git a/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_10_b47d543e06a1a243211a2fa0cb5d09a3._comment b/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_10_b47d543e06a1a243211a2fa0cb5d09a3._comment new file mode 100644 index 0000000000..6d0abe8c6d --- /dev/null +++ b/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_10_b47d543e06a1a243211a2fa0cb5d09a3._comment @@ -0,0 +1,13 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="108.236.230.124" + subject="comment 10" + date="2014-03-10T17:34:56Z" + content=""" +I've found the 1 second delay on failure to accept in the warp source code. + +It's using Network.Socket.accept, which uses accept4 with NONBLOCK by default, but can be built without `HAVE_ACCEPT4` and in that case uses `accept` with blocking. + +I've put in a patch to build network without accept4 support, and am rebuilding the arm autobuilder. This will take a while.. + +"""]] diff --git a/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_11_399c1e4455dce105df95414fe3ff939d._comment b/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_11_399c1e4455dce105df95414fe3ff939d._comment new file mode 100644 index 0000000000..665b9d8dbe --- /dev/null +++ b/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_11_399c1e4455dce105df95414fe3ff939d._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 11" + date="2014-03-11T03:02:21Z" + content=""" +Autobuild is now updated with the accept fix. +"""]] diff --git a/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_12_1cfdd76e751ee3726bd80359cfc85c47._comment b/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_12_1cfdd76e751ee3726bd80359cfc85c47._comment new file mode 100644 index 0000000000..fe19bf87ef --- /dev/null +++ b/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_12_1cfdd76e751ee3726bd80359cfc85c47._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.102" + subject="ping?" + date="2014-03-19T20:29:12Z" + content=""" +Could either greg or Schnouki please test with the current arm autobuild and see if you can connect to the webapp? +"""]] diff --git a/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_5_6b9b87bfb8b94171b3dba51919fd1ceb._comment b/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_5_6b9b87bfb8b94171b3dba51919fd1ceb._comment new file mode 100644 index 0000000000..d612cf35f6 --- /dev/null +++ b/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_5_6b9b87bfb8b94171b3dba51919fd1ceb._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.146" + subject="comment 5" + date="2014-03-06T18:12:57Z" + content=""" +Again the accept message does not seem to be related to dbus. A dbus client has no reason to do that; a web server does. The use of `O_NONBLOCK` with accept4 seems likely to be the culprit to me. + +How frequently is dbus mentioned in the log? +"""]] diff --git a/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_6_51f35f069c95a5ea7bd4dbab47b5702b._comment b/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_6_51f35f069c95a5ea7bd4dbab47b5702b._comment new file mode 100644 index 0000000000..478cb5a375 --- /dev/null +++ b/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_6_51f35f069c95a5ea7bd4dbab47b5702b._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://schnouki.net/" + nickname="Schnouki" + subject="comment 6" + date="2014-03-07T08:52:12Z" + content=""" +Agreed, the dbus and accept messages are probably unrelated. I just commented here because it's the same bug I'm encountering. + +The dbus message only appears once in the log (shortly after startup). The accept messages appears every second. +"""]] diff --git a/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_7_691661d902acbf9c11d713541d5d39e4._comment b/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_7_691661d902acbf9c11d713541d5d39e4._comment new file mode 100644 index 0000000000..46f147c7d6 --- /dev/null +++ b/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_7_691661d902acbf9c11d713541d5d39e4._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.146" + subject="comment 7" + date="2014-03-07T17:03:30Z" + content=""" +Are you sure that the accept message happens every second? I don't see why the webapp would continue to try to bind a socket it it failed with a 1 second delay. (It does try 100 times if it fails, per [[!commit fe3009d83b08563875856152034e7c59a0c6ecca]], before ending with \"unable to bind to local socket\".) +"""]] diff --git a/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_8_ef559feb7b350f2014055680d087c2bc._comment b/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_8_ef559feb7b350f2014055680d087c2bc._comment new file mode 100644 index 0000000000..81af6d4317 --- /dev/null +++ b/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_8_ef559feb7b350f2014055680d087c2bc._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.146" + subject="comment 8" + date="2014-03-07T17:16:41Z" + content=""" +greg has confirmed that he can connect to the webapp, but it never replies to http requests. So, this could be the port being bound, but the accept failing. + +I don't know why it would retry the accept once per second, but this could be something in warp or the network library. +"""]] diff --git a/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_9_278b41aaa73a214b2b38881242a29b17._comment b/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_9_278b41aaa73a214b2b38881242a29b17._comment new file mode 100644 index 0000000000..e43f03f034 --- /dev/null +++ b/doc/bugs/Assistant_lost_dbus_connection_spamming_log/comment_9_278b41aaa73a214b2b38881242a29b17._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://schnouki.net/" + nickname="Schnouki" + subject="comment 9" + date="2014-03-09T16:29:26Z" + content=""" +I did some more testing today. + +I have this message when using either git-annex assistant or git-annex webapp. When running the webapp, I can connect to its port, but there's no response from git-annex (either from a browser or when using telnet to send a simple \"GET / HTTP/1.0\"). + +The accept message comes every second, the dbus one very minute (didn't test long enough last time, sorry about that). +"""]] diff --git a/doc/bugs/Auto-repair_greatly_slows_down_the_machine/comment_5_9fe529034ad0115792b58d7da99c167e._comment b/doc/bugs/Auto-repair_greatly_slows_down_the_machine/comment_5_9fe529034ad0115792b58d7da99c167e._comment new file mode 100644 index 0000000000..4683165c37 --- /dev/null +++ b/doc/bugs/Auto-repair_greatly_slows_down_the_machine/comment_5_9fe529034ad0115792b58d7da99c167e._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.146" + subject="comment 5" + date="2014-03-06T18:14:37Z" + content=""" +auto-repair is only done if git fsck detects a problem. You can run git fsck yourself to see. +"""]] diff --git a/doc/bugs/Auto-repair_greatly_slows_down_the_machine/comment_6_93ed991ef2a74c18575073ca72e06185._comment b/doc/bugs/Auto-repair_greatly_slows_down_the_machine/comment_6_93ed991ef2a74c18575073ca72e06185._comment new file mode 100644 index 0000000000..05935b034d --- /dev/null +++ b/doc/bugs/Auto-repair_greatly_slows_down_the_machine/comment_6_93ed991ef2a74c18575073ca72e06185._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnX1msQxnLoSeu7q-i-c9BWghonsN7Qmns" + nickname="Jan Ulrich" + subject="comment 6" + date="2014-03-10T14:14:06Z" + content=""" +I manually ran git fsck without problems but git-annex still wants to repair something. +"""]] diff --git a/doc/bugs/Backup_repository_doesn__39__t_get_all_files.mdwn b/doc/bugs/Backup_repository_doesn__39__t_get_all_files.mdwn index 00b2e59c6b..62a0524ee3 100644 --- a/doc/bugs/Backup_repository_doesn__39__t_get_all_files.mdwn +++ b/doc/bugs/Backup_repository_doesn__39__t_get_all_files.mdwn @@ -35,3 +35,6 @@ What this tells me is that any changes that occur whilst I am not networked are git-annex version: 5.20131130-gc25be33 +> This was fixed in 5.20140127; the assistant now does a daily sweep of +> unused files to move them to backup repositories when possible. [[done]] +> --[[Joey]] diff --git a/doc/bugs/Bug_Report_doesn__39__t_work.mdwn b/doc/bugs/Bug_Report_doesn__39__t_work.mdwn new file mode 100644 index 0000000000..cbf4a481d2 --- /dev/null +++ b/doc/bugs/Bug_Report_doesn__39__t_work.mdwn @@ -0,0 +1,20 @@ +### Please describe the problem. +Bug Report doesn't work + +### What steps will reproduce the problem? + + +### What version of git-annex are you using? On what operating system? + + +### Please provide any additional information below. + +[[!format sh """ +# If you can, paste a complete transcript of the problem occurring here. +# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log + + +# End of transcript or log. +"""]] + +[[fixed|done]] --[[Joey]] diff --git a/doc/bugs/Can__39__t_access_files_from___39__Removable_drive__39___repo_even_if_set_as_client.mdwn b/doc/bugs/Can__39__t_access_files_from___39__Removable_drive__39___repo_even_if_set_as_client.mdwn index ef59954b78..941ac9e5ac 100644 --- a/doc/bugs/Can__39__t_access_files_from___39__Removable_drive__39___repo_even_if_set_as_client.mdwn +++ b/doc/bugs/Can__39__t_access_files_from___39__Removable_drive__39___repo_even_if_set_as_client.mdwn @@ -19,3 +19,4 @@ I'm using 9e57edff287ac53fc4b1cefef7271e9ed17f2285 (Fri Feb 22 15:19:25 2013 +00 Ubuntu 12.10 x86_64 [[!tag /design/assistant]] +[[!meta title="assistant should set up non-bare repos on removable drives, and update them when syncing with them"]] diff --git a/doc/bugs/Corrupted_drive:_Assistant_seems_consider_files_deleted_and_deletes_them_elsewhere_too.mdwn b/doc/bugs/Corrupted_drive:_Assistant_seems_consider_files_deleted_and_deletes_them_elsewhere_too.mdwn index de879f5223..b6c9691eaf 100644 --- a/doc/bugs/Corrupted_drive:_Assistant_seems_consider_files_deleted_and_deletes_them_elsewhere_too.mdwn +++ b/doc/bugs/Corrupted_drive:_Assistant_seems_consider_files_deleted_and_deletes_them_elsewhere_too.mdwn @@ -31,3 +31,6 @@ I noticed the problem yesterday afternoon (Thu 24 Oct). # End of transcript or log. """]] + +> [[moreinfo]]; either I don't have enough information to work on this, +> or it might have just been user error. --[[Joey]] diff --git a/doc/bugs/Could_not_read_from_remote_repository.mdwn b/doc/bugs/Could_not_read_from_remote_repository.mdwn index e4f7b9c436..d54eb67822 100644 --- a/doc/bugs/Could_not_read_from_remote_repository.mdwn +++ b/doc/bugs/Could_not_read_from_remote_repository.mdwn @@ -22,3 +22,5 @@ fatal: Could not read from remote repository. Please make sure you have the correct access rights and the repository exists. """]] + +[[!meta title="xmpp syncing sometimes fails"]] diff --git a/doc/bugs/Disconcerting_warning_from_git-annex.mdwn b/doc/bugs/Disconcerting_warning_from_git-annex.mdwn index 169dc26d14..ef662441c1 100644 --- a/doc/bugs/Disconcerting_warning_from_git-annex.mdwn +++ b/doc/bugs/Disconcerting_warning_from_git-annex.mdwn @@ -4,3 +4,5 @@ I did a "git annex add" of a bunch of files on a storage server with low IOPS, a failed How is that even possible, when the server is doing nothing else? + +[[!tag moreinfo]] diff --git a/doc/bugs/Disconcerting_warning_from_git-annex/comment_3_13999207f4ddac2f9c345415f25f7ada._comment b/doc/bugs/Disconcerting_warning_from_git-annex/comment_3_13999207f4ddac2f9c345415f25f7ada._comment new file mode 100644 index 0000000000..142e6ecd11 --- /dev/null +++ b/doc/bugs/Disconcerting_warning_from_git-annex/comment_3_13999207f4ddac2f9c345415f25f7ada._comment @@ -0,0 +1,28 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.102" + subject="moreinfo" + date="2014-03-19T20:49:47Z" + content=""" +What I don't understand about this is, how does `open` fail due to a file being locked? This is Linux, it doesn't have mandatory locking that I know of, and git-annex certianly doesn't use such a thing. + +I really need a way to reproduce this and/or a strace. As it is, I've never seen this reported by anyone else and don't understand the failure mode at all. + +The relevant part of the code seems to be here: + +[[!format haskell \"\"\" +setJournalFile :: JournalLocked -> FilePath -> String -> Annex () +setJournalFile _jl file content = do + tmp <- fromRepo gitAnnexTmpMiscDir + createAnnexDirectory =<< fromRepo gitAnnexJournalDir + createAnnexDirectory tmp + -- journal file is written atomically + jfile <- fromRepo $ journalFile file + let tmpfile = tmp takeFileName jfile + liftIO $ do + writeBinaryFile tmpfile content + moveFile tmpfile jfile +\"\"\"]] + +While there is some ctnl locking going on, it locks a special sentinal file, not the file it's writing to. +"""]] diff --git a/doc/bugs/Impossible_to_enable_an_existing_gcrypt_repo_in_the_webapp.mdwn b/doc/bugs/Impossible_to_enable_an_existing_gcrypt_repo_in_the_webapp.mdwn index 4a8006f064..d9bae50190 100644 --- a/doc/bugs/Impossible_to_enable_an_existing_gcrypt_repo_in_the_webapp.mdwn +++ b/doc/bugs/Impossible_to_enable_an_existing_gcrypt_repo_in_the_webapp.mdwn @@ -19,3 +19,5 @@ This is with git-annex installed on the remote server; without it the process ge ### What version of git-annex are you using? On what operating system? Latest nightly build on ubuntu 13.10 + +[[!tag moreinfo]] diff --git a/doc/bugs/Incorrect_symlink_path_in_simple_submodule_use_case.mdwn b/doc/bugs/Incorrect_symlink_path_in_simple_submodule_use_case.mdwn index 823d12679d..b9cae01768 100644 --- a/doc/bugs/Incorrect_symlink_path_in_simple_submodule_use_case.mdwn +++ b/doc/bugs/Incorrect_symlink_path_in_simple_submodule_use_case.mdwn @@ -68,3 +68,5 @@ Mac OS X Mountain Lion. git-annex files are from within the downloadable git-ann Thanks for your help :) + +> This is a duplicate of [[Git_annexed_files_symlink_are_wrong_when_submodule_is_not_in_the_same_path]] [[done]] --[[Joey]] diff --git a/doc/bugs/Linux_stand_alone_build_20130723_breaks_support_for_glibc_2.13_debian_stable.txt b/doc/bugs/Linux_stand_alone_build_20130723_breaks_support_for_glibc_2.13_debian_stable.mdwn similarity index 100% rename from doc/bugs/Linux_stand_alone_build_20130723_breaks_support_for_glibc_2.13_debian_stable.txt rename to doc/bugs/Linux_stand_alone_build_20130723_breaks_support_for_glibc_2.13_debian_stable.mdwn diff --git a/doc/bugs/Mac_OS_X_Build_doesn__39__t_include_webapp.mdwn b/doc/bugs/Mac_OS_X_Build_doesn__39__t_include_webapp.mdwn new file mode 100644 index 0000000000..7401d79fbd --- /dev/null +++ b/doc/bugs/Mac_OS_X_Build_doesn__39__t_include_webapp.mdwn @@ -0,0 +1,12 @@ +Latest build for Mac OS X (both autobuild and release versions) does not contain webapp. + +git annex version for OS X, + + git-annex version: 5.20140306-g309a73c + build flags: Assistant 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 SKEIN2 56 SKEIN512 WORM URL + remote types: git gcrypt S3 bup directory rsync web webdav tahoe glacier hook external + +whereas on my Linux box build flags include webapp. On os x when I run git annex webapp it does nothing, just prints the help info. + +> [[fixed|done]] --[[Joey]] diff --git a/doc/bugs/Mac_OS_X_Build_doesn__39__t_include_webapp/comment_1_b918a741f2397b6588e7a9f1feca7e66._comment b/doc/bugs/Mac_OS_X_Build_doesn__39__t_include_webapp/comment_1_b918a741f2397b6588e7a9f1feca7e66._comment new file mode 100644 index 0000000000..b13eab08f3 --- /dev/null +++ b/doc/bugs/Mac_OS_X_Build_doesn__39__t_include_webapp/comment_1_b918a741f2397b6588e7a9f1feca7e66._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.146" + subject="comment 1" + date="2014-03-07T15:17:16Z" + content=""" +I've fixed the missing warp-tls dep on the autobuilder and updated the builds. +"""]] diff --git a/doc/bugs/Older_version_of_git_causes_Internal_Server_Error_when_push.default___61___simple.mdwn b/doc/bugs/Older_version_of_git_causes_Internal_Server_Error_when_push.default___61___simple.mdwn index 46ae06f6de..6d6df52a5e 100644 --- a/doc/bugs/Older_version_of_git_causes_Internal_Server_Error_when_push.default___61___simple.mdwn +++ b/doc/bugs/Older_version_of_git_causes_Internal_Server_Error_when_push.default___61___simple.mdwn @@ -62,3 +62,6 @@ My .gitconfig is as follows: > to a more recent version of git. done --[[Joey]] >> Reopened, because the Linux autobuilds have been downgraded to Debian >> stable and have this problem again. --[[Joey]] + +>>> Closing again! Autobuilders all run unstable and will have a current +>>> git. [[done]] --[[Joey]] diff --git a/doc/bugs/On_restart__44___most_repositories__44___including_original_one__44___gone..mdwn b/doc/bugs/On_restart__44___most_repositories__44___including_original_one__44___gone..mdwn index e01310336d..0d442437d7 100644 --- a/doc/bugs/On_restart__44___most_repositories__44___including_original_one__44___gone..mdwn +++ b/doc/bugs/On_restart__44___most_repositories__44___including_original_one__44___gone..mdwn @@ -228,3 +228,13 @@ Everything up-to-date """]] Well, I see that thing about "failed to lock". I can imagine that my 'killall git-annex' to kill a leftover process that was hanging around after I'd done git-annex assistant --stop might have left stale lock files, somewhere... but of course I only got as far as doing that because I was already encountering problems, just trying to return to the webapp. + +> The original bug report seems to be a case of user confusion, +> and not a bug. (Although perhaps the UI is confusing?) +> +> The "resource exhausted" that came up later is quite likely the problem +> fixed in [[!commit 4d06037fdd44ba38fcd4c118d1e6330f06e22366]], +> which affected local git remotes. +> +> [[closing|done]]; I don't see any value keeping this open, I'm afraid. +> --[[Joey]] diff --git a/doc/bugs/Share_with_friends_crash_in_osx.mdwn b/doc/bugs/Share_with_friends_crash_in_osx.mdwn index 21e385c602..d7ed801e77 100644 --- a/doc/bugs/Share_with_friends_crash_in_osx.mdwn +++ b/doc/bugs/Share_with_friends_crash_in_osx.mdwn @@ -366,3 +366,5 @@ Here is the crash report osx creates # End of transcript or log. """]] + +> Apparently this is [[fixed|done]] in the latest release. --[[Joey]] diff --git a/doc/bugs/Share_with_friends_crash_in_osx/comment_12_dfde39222a91923c570e5405d9e527f4._comment b/doc/bugs/Share_with_friends_crash_in_osx/comment_12_dfde39222a91923c570e5405d9e527f4._comment new file mode 100644 index 0000000000..cd2047a93c --- /dev/null +++ b/doc/bugs/Share_with_friends_crash_in_osx/comment_12_dfde39222a91923c570e5405d9e527f4._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkLdR1fuu5aEz3s9VKTBKVMize_SmeNRJM" + nickname="David" + subject="Seems to be working now" + date="2014-03-12T02:36:59Z" + content=""" +Just tried again off of the most recent osx release build and it appears to be working without crashing. Not sure what else you did but thanks! +"""]] diff --git a/doc/bugs/Share_with_friends_crash_in_osx/comment_13_65de2b5dd3af89c2f0f6508ffddda3b5._comment b/doc/bugs/Share_with_friends_crash_in_osx/comment_13_65de2b5dd3af89c2f0f6508ffddda3b5._comment new file mode 100644 index 0000000000..3a02f2f8c7 --- /dev/null +++ b/doc/bugs/Share_with_friends_crash_in_osx/comment_13_65de2b5dd3af89c2f0f6508ffddda3b5._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 13" + date="2014-03-12T17:01:12Z" + content=""" +Well that's good and unexpected news! + +I did make some changes on the OSX autobuilder recently. For one thing, I updated and rebuilt all the homebrew stuff, and remembered to pass --build-bottle when doing so. Which I think I had always done before.. Homebrew also removed some dependencies on gnutls in wget, and perhaps they also made other changes -- I'd not be surprised if a change to homebrew made --build-bottle start disabling some optimisations. + +In any case, I suppose I can close this bug now.. +"""]] diff --git a/doc/bugs/Should_UUID__39__s_for_Remotes_be_case_sensitive__63__.txt b/doc/bugs/Should_UUID__39__s_for_Remotes_be_case_sensitive__63__.mdwn similarity index 100% rename from doc/bugs/Should_UUID__39__s_for_Remotes_be_case_sensitive__63__.txt rename to doc/bugs/Should_UUID__39__s_for_Remotes_be_case_sensitive__63__.mdwn diff --git a/doc/bugs/Syncing_of_file_contents_seems_to_be_broken_in_recent_versions_of_the_assistant/comment_3_1504f8767f1f4415222d8c315c734e81._comment b/doc/bugs/Syncing_of_file_contents_seems_to_be_broken_in_recent_versions_of_the_assistant/comment_3_1504f8767f1f4415222d8c315c734e81._comment new file mode 100644 index 0000000000..07d6eec3a6 --- /dev/null +++ b/doc/bugs/Syncing_of_file_contents_seems_to_be_broken_in_recent_versions_of_the_assistant/comment_3_1504f8767f1f4415222d8c315c734e81._comment @@ -0,0 +1,9 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.146" + subject="comment 3" + date="2014-03-07T17:21:02Z" + content=""" +Any news on this? Does it happen with the current version? + +"""]] diff --git a/doc/bugs/USB_drive_not_syncing.mdwn b/doc/bugs/USB_drive_not_syncing.mdwn index 76a38b81e5..c933222a53 100644 --- a/doc/bugs/USB_drive_not_syncing.mdwn +++ b/doc/bugs/USB_drive_not_syncing.mdwn @@ -514,3 +514,6 @@ tyc20@im1:/media/A-DATA UFD/annex$ # End of transcript or log. """]] + +> [[done]]; seems to be some badly set up repository. Happy to help with +> fixing it, if you reply.. --[[Joey]] diff --git a/doc/bugs/Unicode_file_names_ignored_on_Windows.mdwn b/doc/bugs/Unicode_file_names_ignored_on_Windows.mdwn new file mode 100644 index 0000000000..5d0b73b17b --- /dev/null +++ b/doc/bugs/Unicode_file_names_ignored_on_Windows.mdwn @@ -0,0 +1,41 @@ +### Please describe the problem. + +The "add" command silently ignores all files and directories with non-ascii characters. + +### What steps will reproduce the problem? + +I created empty repository (git init, git annex init). I created some files with ascii and nonascii file names (hacky.txt, háčky.txt). + +git annex add . correctly adds only hacky.txt. + +git annex add "háčky.txt" does nothing. + +### What version of git-annex are you using? On what operating system? + +git 1.9.0, +git-annex installer from 2014-03-06 + +Windows XP and 7 with czech localization. CP1250 is used for czech characters on windows. + +### Please provide any additional information below. + + $ ls + hacky.txt h????ky.txt + $ git annex add . + add hacky.txt ok + (Recording state in git...) + $ git annex status + D h├í─Źky.txt + +According to https://github.com/msysgit/msysgit/wiki/Git-for-Windows-Unicode-Support ls prints junk, but only to console. + + D:\anntest>git annex add "háčky.txt" --debug + [2014-03-18 14:28:03 Central Europe Standard Time] read: git ["--git-dir=D:\\anntest\\.git","--work-tree=D:\\anntest","-c","core.bare=false","ls-files","--others","--exclude-standard","-z","--","h\225\269ky.txt"] + [2014-03-18 14:28:03 Central Europe Standard Time] chat: git ["--git-dir=D:\\anntest\\.git","--work-tree=D:\\anntest","-c","core.bare=false","cat-file","--batch"] + [2014-03-18 14:28:03 Central Europe Standard Time] read: git ["--git-dir=D:\\anntest\\.git","--work-tree=D:\\anntest","-c","core.bare=false","ls-files","--modified","-z","--","h\225\269ky.txt"] + +I can provide additional information, just tell me what you need. + +> [[fixed|done]], although this is not the end of encoding issues +> on Windows. Updating [[todo/windows_support]] to discuss some other ones. +> --[[Joey]] diff --git a/doc/bugs/Unicode_file_names_ignored_on_Windows/comment_1_3dfa4559dceec50c08ba180f41b4c220._comment b/doc/bugs/Unicode_file_names_ignored_on_Windows/comment_1_3dfa4559dceec50c08ba180f41b4c220._comment new file mode 100644 index 0000000000..c1778db780 --- /dev/null +++ b/doc/bugs/Unicode_file_names_ignored_on_Windows/comment_1_3dfa4559dceec50c08ba180f41b4c220._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="analysis" + date="2014-03-18T17:54:09Z" + content=""" +The `git ls-files --others -z output` is fine; the mojibake seems to occur in git-annex's reading of that output, which uses GHC's filesystem encoding. On Linux it reads \"h\225\269ky.txt\" but on Windows, \"h\195\161\196\56461ky.txt\". + +So, it's failing to compose the multibyte characters, and it seems to have escaped the last byte (which should be \"\141\" based on the other 3) out into the high code plane used for undecodable bytes. + +Note that on Linux with LANG=C, the add works, and it sees \"h\56515\56481\56516\56461ky.txt\" -- in this case, all 4 bytes are represented in the high code plane, and so round-trip through ok despite the locale not supporting the utf8 encoding. + +Interestingly, while both `[readFile \"h\225\269ky.txt\", readFile \"h\56515\56481\56516\56461ky.txt\"]` work on Linux, only the former does on Windows. +"""]] diff --git a/doc/bugs/Unicode_file_names_ignored_on_Windows/comment_2_4dafea4367d455c2e63b0f7b1cc39559._comment b/doc/bugs/Unicode_file_names_ignored_on_Windows/comment_2_4dafea4367d455c2e63b0f7b1cc39559._comment new file mode 100644 index 0000000000..97d7012a19 --- /dev/null +++ b/doc/bugs/Unicode_file_names_ignored_on_Windows/comment_2_4dafea4367d455c2e63b0f7b1cc39559._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 2" + date="2014-03-18T18:09:08Z" + content=""" +One approach might be to not use the GHC FileSystemEncoding on Windows, and assume that Windows filenames are always in a unicode encoding. After all, the FileSystemEncoding is only used by git-annex on Unix because Unix has no canonical encoding that will work for all filenames. + +Hmm, nope, I tried this and it just causes an \"invalid byte sequence\" crash when reading from git-ls-files. +"""]] diff --git a/doc/bugs/Unicode_file_names_ignored_on_Windows/comment_3_bdde68a990a330ee0cf626be44b1c132._comment b/doc/bugs/Unicode_file_names_ignored_on_Windows/comment_3_bdde68a990a330ee0cf626be44b1c132._comment new file mode 100644 index 0000000000..1f35dc9dd0 --- /dev/null +++ b/doc/bugs/Unicode_file_names_ignored_on_Windows/comment_3_bdde68a990a330ee0cf626be44b1c132._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 3" + date="2014-03-18T18:14:57Z" + content=""" +ghc docs on FileSystemEncoding: \"On Windows, this encoding *should not* be used if possible because the use of code pages is deprecated: Strings should be retrieved via the wide W-family of UTF-16 APIs instead\" +"""]] diff --git a/doc/bugs/Unicode_file_names_ignored_on_Windows/comment_4_9140fb8034b1449ee2f4762093bc1f89._comment b/doc/bugs/Unicode_file_names_ignored_on_Windows/comment_4_9140fb8034b1449ee2f4762093bc1f89._comment new file mode 100644 index 0000000000..e40a6ab336 --- /dev/null +++ b/doc/bugs/Unicode_file_names_ignored_on_Windows/comment_4_9140fb8034b1449ee2f4762093bc1f89._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 4" + date="2014-03-18T18:42:57Z" + content=""" +As well as the default encoding, I've tried `utf8`, `utf16`, `utf16le`, and `utf16be` encodings, and none of them is able to successfully read the git ls-files output, all fail with encoding error. (I also tried `mkUTF16 RoundtripFailure` but it completely broke git-annex.) + +Unsure where to go from here.. +"""]] diff --git a/doc/bugs/Unicode_file_names_ignored_on_Windows/comment_5_661ca15b68bc0e3fbe85f11400570446._comment b/doc/bugs/Unicode_file_names_ignored_on_Windows/comment_5_661ca15b68bc0e3fbe85f11400570446._comment new file mode 100644 index 0000000000..ccafb635eb --- /dev/null +++ b/doc/bugs/Unicode_file_names_ignored_on_Windows/comment_5_661ca15b68bc0e3fbe85f11400570446._comment @@ -0,0 +1,15 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawk5aY0oBmuQtnoTNtji-dPgDw9p7J24YeY" + nickname="Jiří" + subject="further info" + date="2014-03-18T23:46:08Z" + content=""" +On my windows 7 machine, ls-files does return something better + + c:\JSH\antest>git --work-tree=c:\JSH\antest ls-files --others + \"h\303\241\304\215ky.txt\" + +If I am correct, it is unicode 225 269, but as octal utf-8. ls-files -z return correct utf-8 (68 C3 A1 C4 8D 6B ...) + +I will test that tomorrow also on windows xp on my work pc. +"""]] diff --git a/doc/bugs/Unicode_file_names_ignored_on_Windows/comment_6_0e8820169c0300d296c697154fd05dc4._comment b/doc/bugs/Unicode_file_names_ignored_on_Windows/comment_6_0e8820169c0300d296c697154fd05dc4._comment new file mode 100644 index 0000000000..4f7ec51fa0 --- /dev/null +++ b/doc/bugs/Unicode_file_names_ignored_on_Windows/comment_6_0e8820169c0300d296c697154fd05dc4._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawk5aY0oBmuQtnoTNtji-dPgDw9p7J24YeY" + nickname="Jiří" + subject="further info 2" + date="2014-03-19T11:53:17Z" + content=""" +And on my windows xp computer, git ls-files returns valid utf-8 too. +"""]] diff --git a/doc/bugs/Unicode_file_names_ignored_on_Windows/comment_7_b23a2bf106053f105798b270536057e5._comment b/doc/bugs/Unicode_file_names_ignored_on_Windows/comment_7_b23a2bf106053f105798b270536057e5._comment new file mode 100644 index 0000000000..b5cf90ef05 --- /dev/null +++ b/doc/bugs/Unicode_file_names_ignored_on_Windows/comment_7_b23a2bf106053f105798b270536057e5._comment @@ -0,0 +1,38 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawk5aY0oBmuQtnoTNtji-dPgDw9p7J24YeY" + nickname="Jiří" + subject="further info 3" + date="2014-03-19T16:23:58Z" + content=""" +Also ghc doesn't seem to do any weird transformations with that string + + import System.Process + import qualified Data.ByteString as S + import qualified Data.ByteString.UTF8 as U + import GHC.IO.Handle + + files :: S.ByteString -> [S.ByteString] + files ps + | S.null ps = [] + | otherwise = case search ps of + Nothing -> [ps] + Just n -> S.take n ps : files (S.drop (n+1) ps) + where search = S.elemIndex 0 + + main = do + let prc = CreateProcess { + cmdspec = RawCommand \"git\" [\"--work-tree=D:\\antest\",\"ls-files\",\"--others\",\"-z\",\"--\",\"h\225\269ky.txt\"], + cwd = Nothing, + env = Nothing, + std_in = Inherit, + std_out = CreatePipe, + std_err = Inherit, + close_fds = False, + create_group = False } + (_,Just out,_,_) <- createProcess prc + hSetBinaryMode out True + str <- S.hGetContents out + print $ map U.toString $ files str + +prints correctly [\"h\225\269ky.txt\"] I don't think that FilesystemEncoding will do any good on windows, since git seems to use utf-8 instead of normal windows console encoding. +"""]] diff --git a/doc/bugs/Unicode_file_names_ignored_on_Windows/comment_8_7f23911705eaa58a9230f19ab890e87f._comment b/doc/bugs/Unicode_file_names_ignored_on_Windows/comment_8_7f23911705eaa58a9230f19ab890e87f._comment new file mode 100644 index 0000000000..2cd4b346e9 --- /dev/null +++ b/doc/bugs/Unicode_file_names_ignored_on_Windows/comment_8_7f23911705eaa58a9230f19ab890e87f._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.102" + subject="comment 8" + date="2014-03-19T19:57:00Z" + content=""" +Windows & haskell? I'd only be more surprised if spj wandered in here. ;) + +So, that works because you're using ByteStrings. But git-annex mostly does not use ByteStrings, and it would be a lot of work to switch to them everywhere it reads FilePaths from git. + +But it seems my test yesterday using `hSetEncoding h Encoding.utf8` went wrong somehow. That does work. git-annex can operate on the file with that change. +"""]] diff --git a/doc/bugs/Unnecessary_remote_transfers.mdwn b/doc/bugs/Unnecessary_remote_transfers.mdwn index 9ae23e5a0b..04ede7a02b 100644 --- a/doc/bugs/Unnecessary_remote_transfers.mdwn +++ b/doc/bugs/Unnecessary_remote_transfers.mdwn @@ -22,3 +22,6 @@ This is a problem because unless I manually disable the remote repo, it will con The remote transfer wasn't even necessary to begin with, because it already had a direct connection to the local paired repo. But even so, it should at least abort the remote transfer when the local transfer finishes. Thanks for your work on git-annex assistant. + +> From a re-read of the comments, this was resolved satisfactorily, +> and I don't need to make any changes. [[done]] --[[Joey]] diff --git a/doc/bugs/Unused_files_not_being_reported:_Do_not_take_remote_tracking_branches_into_account__63__.mdwn b/doc/bugs/Unused_files_not_being_reported:_Do_not_take_remote_tracking_branches_into_account__63__.mdwn index 0110891315..99043aa253 100644 --- a/doc/bugs/Unused_files_not_being_reported:_Do_not_take_remote_tracking_branches_into_account__63__.mdwn +++ b/doc/bugs/Unused_files_not_being_reported:_Do_not_take_remote_tracking_branches_into_account__63__.mdwn @@ -14,3 +14,5 @@ Delete origin/master and origin/synced/master --> Content is now reported as unu ### What version of git-annex are you using? On what operating system? 5.20131230 + +> Behaving as designed; [[done]] --[[Joey]] diff --git a/doc/bugs/Watcher_crashed_in_Android_on___47__storage__47__sdcard1_-_bug__63__.mdwn b/doc/bugs/Watcher_crashed_in_Android_on___47__storage__47__sdcard1_-_bug__63__.mdwn index d8b70a66ae..270a69ecb2 100644 --- a/doc/bugs/Watcher_crashed_in_Android_on___47__storage__47__sdcard1_-_bug__63__.mdwn +++ b/doc/bugs/Watcher_crashed_in_Android_on___47__storage__47__sdcard1_-_bug__63__.mdwn @@ -41,3 +41,5 @@ Android 4.1.1 Huawei Y300 Annex.apk v1.0.52 version 4.20130723 # End of transcript or log. """]] + +[[!tag moreinfo]] diff --git a/doc/bugs/__34__Configuring_Jabber_Account__34___fails_with_a___34__Network_unreachable__34___error..mdwn b/doc/bugs/__34__Configuring_Jabber_Account__34___fails_with_a___34__Network_unreachable__34___error..mdwn index 9befd7c801..94a124b232 100644 --- a/doc/bugs/__34__Configuring_Jabber_Account__34___fails_with_a___34__Network_unreachable__34___error..mdwn +++ b/doc/bugs/__34__Configuring_Jabber_Account__34___fails_with_a___34__Network_unreachable__34___error..mdwn @@ -37,3 +37,6 @@ OS: up-to-date ARCH system # End of transcript or log. """]] + +> [[done]]; I have enabled the haskell dns library on all the autobuilds. +> --[[Joey]] diff --git a/doc/bugs/__92____92___instead_of___47___on_rsync_special_remote_on_linux_accessed_from_a_windows_git-annex.mdwn b/doc/bugs/__92____92___instead_of___47___on_rsync_special_remote_on_linux_accessed_from_a_windows_git-annex.mdwn new file mode 100644 index 0000000000..5f6d35fad9 --- /dev/null +++ b/doc/bugs/__92____92___instead_of___47___on_rsync_special_remote_on_linux_accessed_from_a_windows_git-annex.mdwn @@ -0,0 +1,27 @@ +### Please describe the problem. + +Getting file from a linux rsync special remote from a windows machine is impossible. + +### What steps will reproduce the problem? +git annex get . + +### What version of git-annex are you using? On what operating system? +5.20140316-gbe47273 on windows 8. + +### Please provide any additional information below. + +Launching in debug mode, we see the wrong \\ used instead of / used. Syntax that rsync doesn't understand on a linux box. +[[!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 +read: rsync ["-e","'ssh' '-l' 'git' '-T' +","--progress","--inplace","git@strasser-family.ch:~/files/G5\\jj\\'SHA256E-s675 +--1112f74fc9ebea01460efe26e447171a1aacf8e551f06f62ef6fe683df02e03c.mat\\SHA256E- +s675--1112f74fc9ebea01460efe26e447171a1aacf8e551f06f62ef6fe683df02e03c.mat'","/c +ygdrive/c/Users/pablo/Desktop/Nouveau dossier/InnerResult/.git/annex/tmp/SHA256E +-s675--1112f74fc9ebea01460efe26e447171a1aacf8e551f06f62ef6fe683df02e03c.mat"] + +# End of transcript or log. +"""]] + +> [[fixed|done]] --[[Joey]] diff --git a/doc/bugs/__96__minimal_build__39____fails_due_to_missing_stm_dependency/comment_1_86e26ee9ec90aa00f25392052737f0f0._comment b/doc/bugs/__96__minimal_build__39____fails_due_to_missing_stm_dependency/comment_1_86e26ee9ec90aa00f25392052737f0f0._comment index 7b86c07cce..a1f52dc5e8 100644 --- a/doc/bugs/__96__minimal_build__39____fails_due_to_missing_stm_dependency/comment_1_86e26ee9ec90aa00f25392052737f0f0._comment +++ b/doc/bugs/__96__minimal_build__39____fails_due_to_missing_stm_dependency/comment_1_86e26ee9ec90aa00f25392052737f0f0._comment @@ -1,4 +1,4 @@ -[[!comment format=txt +[[!comment format=mdwn username="https://www.google.com/accounts/o8/id?id=AItOawnlotDRSLW2JVXY3SLSwhrcHteqUHhTtoY" nickname="Péter" subject="Not fixed." diff --git a/doc/forum/copy_fails_for_some_fails_without_explanation.mdwn b/doc/bugs/copy_fails_for_some_fails_without_explanation.mdwn similarity index 96% rename from doc/forum/copy_fails_for_some_fails_without_explanation.mdwn rename to doc/bugs/copy_fails_for_some_fails_without_explanation.mdwn index d4bcbf08c1..f4489de27f 100644 --- a/doc/forum/copy_fails_for_some_fails_without_explanation.mdwn +++ b/doc/bugs/copy_fails_for_some_fails_without_explanation.mdwn @@ -3,3 +3,5 @@ I have a large direct-mode repository whose files I'm trying to copy to a non-di When I do $ git annex copy --to pi dirs/to/copy, the copy starts out OK, but eventually many files fail to copy. The only diagnostic I get is "failed". Judging from the backscroll, I don't see a strong pattern to the files which fail to copy; they're kind of interspersed amongst files which were successfully copied. If I try to copy one of these failed files explicitly (git annex copy --to pi file/which/failed), this succeeds. I have plenty of free space on the disk. Is there a way to get more diagnostics out of git annex so I can see why these files are failing to copy? + +> [[fixed|done]] --[[Joey]] diff --git a/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_10_0c1a5837305b721fc4a529cae3f4c3fb._comment b/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_10_0c1a5837305b721fc4a529cae3f4c3fb._comment new file mode 100644 index 0000000000..b0127ed82a --- /dev/null +++ b/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_10_0c1a5837305b721fc4a529cae3f4c3fb._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmUJBh1lYmvfCCiGr3yrdx-QhuLCSRnU5c" + nickname="Justin" + subject="comment 10" + date="2014-03-06T21:38:53Z" + content=""" +Thanks a lot, Joey. + +Compiling all of the dependencies for git-annex was taking forever on my pi, so I'll probably wait until the next release to test this out. But I'll report back here if I have any problems. +"""]] diff --git a/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_11_dabfec2d74fb847f3b40093a2866045b._comment b/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_11_dabfec2d74fb847f3b40093a2866045b._comment new file mode 100644 index 0000000000..09fabcf1c7 --- /dev/null +++ b/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_11_dabfec2d74fb847f3b40093a2866045b._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="108.236.230.124" + subject="comment 11" + date="2014-03-10T19:20:42Z" + content=""" +Well you can always grab one of the daily builds, which include this fix. +"""]] diff --git a/doc/forum/copy_fails_for_some_fails_without_explanation/comment_1_e456604b26ed9c72b0a88cfb57f1a475._comment b/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_1_e456604b26ed9c72b0a88cfb57f1a475._comment similarity index 100% rename from doc/forum/copy_fails_for_some_fails_without_explanation/comment_1_e456604b26ed9c72b0a88cfb57f1a475._comment rename to doc/bugs/copy_fails_for_some_fails_without_explanation/comment_1_e456604b26ed9c72b0a88cfb57f1a475._comment diff --git a/doc/forum/copy_fails_for_some_fails_without_explanation/comment_2_4823d66bfb569605868af5cefe0d94dc._comment b/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_2_4823d66bfb569605868af5cefe0d94dc._comment similarity index 100% rename from doc/forum/copy_fails_for_some_fails_without_explanation/comment_2_4823d66bfb569605868af5cefe0d94dc._comment rename to doc/bugs/copy_fails_for_some_fails_without_explanation/comment_2_4823d66bfb569605868af5cefe0d94dc._comment diff --git a/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_3_46305aa2d43da000c1a7cb003c822572._comment b/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_3_46305aa2d43da000c1a7cb003c822572._comment new file mode 100644 index 0000000000..297c28a40e --- /dev/null +++ b/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_3_46305aa2d43da000c1a7cb003c822572._comment @@ -0,0 +1,18 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmUJBh1lYmvfCCiGr3yrdx-QhuLCSRnU5c" + nickname="Justin" + subject="comment 3" + date="2014-03-06T18:21:53Z" + content=""" +> How many files copied are we talking about before it begins to fail? + +Tens of thousands of files processed, but many of them were already on the other remote so didn't invoke cp (or anything else). ~3300 invocations of cp. + +I saved a log of ps aux, and, while the memory used by git annex remains relatively constant, I do observe /tons/ of zombie processes. 3300, actually. + +I didn't check all of them, but all of the zombie pids I checked appear to have corresponded to this command: + + /home/pi/git-annex.linux/shimmed/git/git --git-dir=/home/pi/hdd/annex/.git --work-tree=/home/pi/hdd/annex cat-file --batch + +Perhaps git annex is forgetting to reap this processes? +"""]] diff --git a/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_4_1dbdeded7f587e8fc2d1ac5170ecb928._comment b/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_4_1dbdeded7f587e8fc2d1ac5170ecb928._comment new file mode 100644 index 0000000000..537736a729 --- /dev/null +++ b/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_4_1dbdeded7f587e8fc2d1ac5170ecb928._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.146" + subject="comment 4" + date="2014-03-06T18:32:33Z" + content=""" +Old versions of git-annex have known bugs involving zombies. What version? +"""]] diff --git a/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_5_1e0c06a07345d85b3712339e6f0d9a9f._comment b/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_5_1e0c06a07345d85b3712339e6f0d9a9f._comment new file mode 100644 index 0000000000..ad2b80d666 --- /dev/null +++ b/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_5_1e0c06a07345d85b3712339e6f0d9a9f._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmUJBh1lYmvfCCiGr3yrdx-QhuLCSRnU5c" + nickname="Justin" + subject="comment 5" + date="2014-03-06T18:35:00Z" + content=""" +5.20140221-g1a47f5f -- I just downloaded it a week or two ago. +"""]] diff --git a/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_6_41798e92068eb227c5e75cae2edef68a._comment b/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_6_41798e92068eb227c5e75cae2edef68a._comment new file mode 100644 index 0000000000..a0554cd8ab --- /dev/null +++ b/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_6_41798e92068eb227c5e75cae2edef68a._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.146" + subject="comment 6" + date="2014-03-06T18:38:43Z" + content=""" +Hmm, that version should only start git cat-file --batch a maximum of 10 times (if it is crashing for some reason), and appears to wait on the process if it does crash. And if not, should only start one. + +I think you need to post some git-annex --debug output , to show when it's running this command. +"""]] diff --git a/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_7_1f33d694a08d8dcbf04595e3442b8cd5._comment b/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_7_1f33d694a08d8dcbf04595e3442b8cd5._comment new file mode 100644 index 0000000000..f846e290d0 --- /dev/null +++ b/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_7_1f33d694a08d8dcbf04595e3442b8cd5._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.146" + subject="comment 7" + date="2014-03-06T18:40:26Z" + content=""" +Actually, NM, I have reproduced the bug. +"""]] diff --git a/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_8_884f31ce917c8e5ce9a32a55da9b42d6._comment b/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_8_884f31ce917c8e5ce9a32a55da9b42d6._comment new file mode 100644 index 0000000000..5ba7442dc6 --- /dev/null +++ b/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_8_884f31ce917c8e5ce9a32a55da9b42d6._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.146" + subject="comment 8" + date="2014-03-06T20:21:16Z" + content=""" +Analysis: Remote.Git's onLocal calls Annex.new to make a new AnnexState for the local remote. This state is not cached, and is regenerated for each file. Since it runs a Annex.Branch check of the location log on the remote, it needs to start catFile, and since the state is not reused, a new CatFileHandle is allocated each time. I'm not sure, but there may have been a recent-ish change that caused the location log to get checked and so catfile to be run; the general inneficiency of making a new AnnexState each time is not new. + +Fixing this by caching the AnnexState will not only fix the resource leak, but should speed up local to local copies significantly! +"""]] diff --git a/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_9_ab770dafee3bd9212f553db222adbfe6._comment b/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_9_ab770dafee3bd9212f553db222adbfe6._comment new file mode 100644 index 0000000000..e6a23eed5a --- /dev/null +++ b/doc/bugs/copy_fails_for_some_fails_without_explanation/comment_9_ab770dafee3bd9212f553db222adbfe6._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.146" + subject="comment 9" + date="2014-03-06T21:17:14Z" + content=""" +Fixed in git. Also reduced the non-data-transfer work done by `git-annex copy` by around 8%. + +I'm going to move this thread to [[bugs]] so I can close it. ;) +"""]] diff --git a/doc/bugs/copy_to_--fast_should_not_mention_every_file_it_checks.mdwn b/doc/bugs/copy_to_--fast_should_not_mention_every_file_it_checks.mdwn index 7c0137fb1e..81d84b300c 100644 --- a/doc/bugs/copy_to_--fast_should_not_mention_every_file_it_checks.mdwn +++ b/doc/bugs/copy_to_--fast_should_not_mention_every_file_it_checks.mdwn @@ -23,3 +23,6 @@ No information whatsoever is printed during upload when ran without `--quite` it """]] [[!meta title="copy --fast --to remote should be quiet when nothing to do"]] + +> [[fixed|done]]; Avoided the unnecessary output in this situation. +> --[[Joey]] diff --git a/doc/bugs/copy_unused_and_unused_not_agreeing.mdwn b/doc/bugs/copy_unused_and_unused_not_agreeing.mdwn index 68328ac962..3790a0edfc 100644 --- a/doc/bugs/copy_unused_and_unused_not_agreeing.mdwn +++ b/doc/bugs/copy_unused_and_unused_not_agreeing.mdwn @@ -46,3 +46,5 @@ copy SHA256E-s293288--30f1367fc326f7b053012818863151206f9e3ddeab3c3fc5b5c1c573d1 copy SHA256E-s3672986--be960f6dc247df2496f634f7d788bd4a180fe556230e2dafc23ebc8fc1f10af3.JPG (checking synology...) ok $ """]] + +> [[fixed|done]] per my comment --[[Joey]] diff --git a/doc/bugs/copy_unused_and_unused_not_agreeing/comment_8_1aaeb808e20c67f89eaac5e45d9309f0._comment b/doc/bugs/copy_unused_and_unused_not_agreeing/comment_8_1aaeb808e20c67f89eaac5e45d9309f0._comment new file mode 100644 index 0000000000..3480ffa7e5 --- /dev/null +++ b/doc/bugs/copy_unused_and_unused_not_agreeing/comment_8_1aaeb808e20c67f89eaac5e45d9309f0._comment @@ -0,0 +1,15 @@ +[[!comment format=mdwn + username="http://grossmeier.net/" + nickname="greg" + subject="comment 8" + date="2014-03-06T18:54:08Z" + content=""" +The last key listed by unused (111 of 111): + +[[!format sh \"\"\" +greg@x200s:~/Documents/.git/annex/objects/q4/22/SHA256E-s12289--68a93144e03274664d50754882bdaf196134e06ec2b912157bdccae436d577d6.ods$ ls +SHA256E-s12289--68a93144e03274664d50754882bdaf196134e06ec2b912157bdccae436d577d6.ods.cache +SHA256E-s12289--68a93144e03274664d50754882bdaf196134e06ec2b912157bdccae436d577d6.ods.map +greg@x200s:~/Documents/.git/annex/objects/q4/22/SHA256E-s12289--68a93144e03274664d50754882bdaf196134e06ec2b912157bdccae436d577d6.ods$ +\"\"\"]] +"""]] diff --git a/doc/bugs/copy_unused_and_unused_not_agreeing/comment_9_6abca5f4927e09089cdc5f0bd27b798f._comment b/doc/bugs/copy_unused_and_unused_not_agreeing/comment_9_6abca5f4927e09089cdc5f0bd27b798f._comment new file mode 100644 index 0000000000..25edfd5edf --- /dev/null +++ b/doc/bugs/copy_unused_and_unused_not_agreeing/comment_9_6abca5f4927e09089cdc5f0bd27b798f._comment @@ -0,0 +1,26 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.146" + subject="analysis" + date="2014-03-06T21:37:15Z" + content=""" +[[!format haskell \"\"\" + {- In indirect mode, look for the key. In direct mode, + - the inode cache file is only present when a key's content + - is present, so can be used as a surrogate if the content + - is not located in the annex directory. -} +\"\"\"]] + +Seems that is wrong. + +I think that comment was based on removeAnnex calling removeInodeCache, which it does do. +And that is, afaik, the only point in git-annex where content files are removed from the annex. + +However, in direct mode, removeAnnex is not the only way to delete a key's content -- the user can simply delete the file! +(Or a disk error could put it in lost+found, or whatever.) + +That leaves the inode cache file present. unused will then behave as you describe. Also, uninit throws an ugly warning message +due to getKeysPresent giving it bad data. The only other caller of getKeysPresent is info, which will also operate on bad data and so generate slightly wrong stats. + +I'm leaning toward making getKeysPresent do a full check of the cache and map, checking that the work tree still contains a key's content. This will make it somewhat slower (by 2 file reads and a stat() per key). So it would make sense to make a variant that only lists keys with content present in .git/annex/objects/. That could be used by `unused`, since by definition unused keys cannot have their content located in the work tree, so must have it in the object directory. uninit could also use it, since it's only interested in cleaning out .git/annex/objects. Only `info` will be slowed down. +"""]] diff --git a/doc/forum/Too_big_to_fsck.mdwn b/doc/bugs/enormous_fsck_output_OOM.mdwn similarity index 58% rename from doc/forum/Too_big_to_fsck.mdwn rename to doc/bugs/enormous_fsck_output_OOM.mdwn index 975674b5c5..b06655354e 100644 --- a/doc/forum/Too_big_to_fsck.mdwn +++ b/doc/bugs/enormous_fsck_output_OOM.mdwn @@ -18,3 +18,13 @@ So I tried to follow your advice here and increase the stack: git-annex: Most RTS options are disabled. Link with -rtsopts to enable them. I wasn't sure what to do next, so any help would be appreciated. + +> Now only 20k problem shas max (more likely 10k) are collected from fsck, +> so it won't use much memory (60 mb or so). If it had to truncate +> shas from fsck, it will re-run fsck after the repair process, +> which should either find no problems left (common when eg when all missing shas +> were able to be fetched from remotes), or find a new set of problem +> shas, which it can feed back through the repair process. +> +> If the repository is very large, this means more work, but it shouldn't +> run out of memory now. [[fixed|done]] --[[Joey]] diff --git a/doc/forum/Too_big_to_fsck/comment_1_490b8bfe95b01a23408ecb5d63dcd40b._comment b/doc/bugs/enormous_fsck_output_OOM/comment_1_490b8bfe95b01a23408ecb5d63dcd40b._comment similarity index 100% rename from doc/forum/Too_big_to_fsck/comment_1_490b8bfe95b01a23408ecb5d63dcd40b._comment rename to doc/bugs/enormous_fsck_output_OOM/comment_1_490b8bfe95b01a23408ecb5d63dcd40b._comment diff --git a/doc/forum/Too_big_to_fsck/comment_2_2666c135dd3378cf6301aa4957049fbd._comment b/doc/bugs/enormous_fsck_output_OOM/comment_2_2666c135dd3378cf6301aa4957049fbd._comment similarity index 100% rename from doc/forum/Too_big_to_fsck/comment_2_2666c135dd3378cf6301aa4957049fbd._comment rename to doc/bugs/enormous_fsck_output_OOM/comment_2_2666c135dd3378cf6301aa4957049fbd._comment diff --git a/doc/forum/Too_big_to_fsck/comment_3_dfb169c441215b671f8c971184de3e16._comment b/doc/bugs/enormous_fsck_output_OOM/comment_3_dfb169c441215b671f8c971184de3e16._comment similarity index 100% rename from doc/forum/Too_big_to_fsck/comment_3_dfb169c441215b671f8c971184de3e16._comment rename to doc/bugs/enormous_fsck_output_OOM/comment_3_dfb169c441215b671f8c971184de3e16._comment diff --git a/doc/forum/Too_big_to_fsck/comment_4_19ef90803aa7ce158bce02378e18ea0f._comment b/doc/bugs/enormous_fsck_output_OOM/comment_4_19ef90803aa7ce158bce02378e18ea0f._comment similarity index 100% rename from doc/forum/Too_big_to_fsck/comment_4_19ef90803aa7ce158bce02378e18ea0f._comment rename to doc/bugs/enormous_fsck_output_OOM/comment_4_19ef90803aa7ce158bce02378e18ea0f._comment diff --git a/doc/forum/Too_big_to_fsck/comment_5_2b5406768fff2834f7aefa76ef949de2._comment b/doc/bugs/enormous_fsck_output_OOM/comment_5_2b5406768fff2834f7aefa76ef949de2._comment similarity index 100% rename from doc/forum/Too_big_to_fsck/comment_5_2b5406768fff2834f7aefa76ef949de2._comment rename to doc/bugs/enormous_fsck_output_OOM/comment_5_2b5406768fff2834f7aefa76ef949de2._comment diff --git a/doc/bugs/enormous_fsck_output_OOM/comment_6_0997f1a94c2fda9fe69824e074011518._comment b/doc/bugs/enormous_fsck_output_OOM/comment_6_0997f1a94c2fda9fe69824e074011518._comment new file mode 100644 index 0000000000..ddf69f94b0 --- /dev/null +++ b/doc/bugs/enormous_fsck_output_OOM/comment_6_0997f1a94c2fda9fe69824e074011518._comment @@ -0,0 +1,18 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnFjuvfPpi1kf6l54bxfFUm0Aw_Gf_IO0o" + nickname="Aaron" + subject="comment 6" + date="2014-03-08T00:08:22Z" + content=""" +That seemed to work, thanks: + + $ git fsck --no-reflogs |wc + Checking object directories: 100% (256/256), done. + error: refs/gcrypt/gitception+ does not point to a valid object! + error: refs/remotes/Beta/git-annex does not point to a valid object! + error: refs/remotes/Beta/master does not point to a valid object! + Checking connectivity: 128728, done. + 369082 1165340 20898546 + +Thanks for your help! +"""]] diff --git a/doc/bugs/enormous_fsck_output_OOM/comment_7_2cdc79f1e0f72693814e91dc88a758e1._comment b/doc/bugs/enormous_fsck_output_OOM/comment_7_2cdc79f1e0f72693814e91dc88a758e1._comment new file mode 100644 index 0000000000..14bdc17b8b --- /dev/null +++ b/doc/bugs/enormous_fsck_output_OOM/comment_7_2cdc79f1e0f72693814e91dc88a758e1._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="108.236.230.124" + subject="comment 7" + date="2014-03-10T18:02:46Z" + content=""" +Ok, that verifies my hypothesis that fsck is outputting a lot of lines. 369082 lines to be precise, comprising 20 mb of data in all. So it's not too surprising this ends up blowing up into a bad amount of memory use. + +I'm going to move this from a forum post over to a bug: +"""]] diff --git a/doc/bugs/enormous_fsck_output_OOM/comment_8_b9aab0aba4dab30260371b4762e0e51d._comment b/doc/bugs/enormous_fsck_output_OOM/comment_8_b9aab0aba4dab30260371b4762e0e51d._comment new file mode 100644 index 0000000000..fa437311fc --- /dev/null +++ b/doc/bugs/enormous_fsck_output_OOM/comment_8_b9aab0aba4dab30260371b4762e0e51d._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="108.236.230.124" + subject="comment 8" + date="2014-03-10T18:12:29Z" + content=""" +In a quick test with a 32 mb dummy fsck output, git-repair ballooned up to 1.7 gb. Clearly something not happy there, although in my case this did not cause it to crash. +"""]] diff --git a/doc/bugs/enormous_fsck_output_OOM/comment_9_8de694dff75e27856c8282d1f2d120b6._comment b/doc/bugs/enormous_fsck_output_OOM/comment_9_8de694dff75e27856c8282d1f2d120b6._comment new file mode 100644 index 0000000000..a26e58c584 --- /dev/null +++ b/doc/bugs/enormous_fsck_output_OOM/comment_9_8de694dff75e27856c8282d1f2d120b6._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="108.236.230.124" + subject="comment 9" + date="2014-03-10T19:17:34Z" + content=""" +I've gotten this down to 900 mb used, in the case where every single line lists a different sha. Possibly more important, if lines repeat shas, or are extraneous, memory usage will be significantly lower. This might be enough to get it working in Aaron's repository, especially if the bulk of the git fsck output was about dangling objects, which are now ignored without buffering them all in memory. + +The memory usage is just about as low as is possible; it takes a fair amount of memory just to hold 300 thousand shas in memory. And the git repair process needs to keep track of every broken sha. (Maybe there's a way to stream them, but I don't immediately see one.) + +I hesitate to say this means the problem is truly fixed. I have some much larger repositories with eg, `git count-objects -v` reporting 2 million objects. If they all went corrupt, it would still use too much memory. + +One improvement would be to store Shas in packed memory, rather than as strings like they are now. That would probably half the memory used. It still does not seem like a full solution. +"""]] diff --git a/doc/bugs/git-annex:___60__socket:_16__62__:_hPutBuf:_resource_vanished___40__Broken_pipe__41__.mdwn b/doc/bugs/git-annex:___60__socket:_16__62__:_hPutBuf:_resource_vanished___40__Broken_pipe__41__.mdwn index 2f4a6337ec..ac44498a0a 100644 --- a/doc/bugs/git-annex:___60__socket:_16__62__:_hPutBuf:_resource_vanished___40__Broken_pipe__41__.mdwn +++ b/doc/bugs/git-annex:___60__socket:_16__62__:_hPutBuf:_resource_vanished___40__Broken_pipe__41__.mdwn @@ -12,3 +12,5 @@ git-annex version: 4.20130521-g20710d4 (And multiple prior versions) .git/annex/daemon.log upload: http://paste.ubuntu.com/5694813/ I could find no debug.log? + +> [[moreinfo]] until it's reproduced with a current version.. --[[Joey]] diff --git a/doc/bugs/git-annex_sucking_up_all_available_RAM_after_startup/comment_6_7d0d49fd165af5e30606982e05335d34._comment b/doc/bugs/git-annex_sucking_up_all_available_RAM_after_startup/comment_6_7d0d49fd165af5e30606982e05335d34._comment new file mode 100644 index 0000000000..bd6fcad6ab --- /dev/null +++ b/doc/bugs/git-annex_sucking_up_all_available_RAM_after_startup/comment_6_7d0d49fd165af5e30606982e05335d34._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="108.236.230.124" + subject="comment 6" + date="2014-03-10T19:24:45Z" + content=""" +I suppose it would be useful to look at the output of `git log git-annex..13d365f16ffdb5a393f66362b840d3f21bb4c59c --oneline -n1` + +Either than command is outputting a huge amount of stuff, or it's actually causing git (not git-annex) to use a lot of memory. Not sure which it is from the description. +"""]] diff --git a/doc/bugs/git_annex_content_fails_with_a_parse_error.txt b/doc/bugs/git_annex_content_fails_with_a_parse_error.mdwn similarity index 100% rename from doc/bugs/git_annex_content_fails_with_a_parse_error.txt rename to doc/bugs/git_annex_content_fails_with_a_parse_error.mdwn diff --git a/doc/bugs/git_annex_dead_does_not_work_as_expected_when_multiple_repos_exist_with_the_same_name___40__notably_including_dead_ones__41__.mdwn b/doc/bugs/git_annex_dead_does_not_work_as_expected_when_multiple_repos_exist_with_the_same_name___40__notably_including_dead_ones__41__.mdwn index 7e26f63dfe..72a0c9cc3a 100644 --- a/doc/bugs/git_annex_dead_does_not_work_as_expected_when_multiple_repos_exist_with_the_same_name___40__notably_including_dead_ones__41__.mdwn +++ b/doc/bugs/git_annex_dead_does_not_work_as_expected_when_multiple_repos_exist_with_the_same_name___40__notably_including_dead_ones__41__.mdwn @@ -40,3 +40,5 @@ Now, git annex dead somecopy will randomly (based on the order of the UUIDs?) ch ### What version of git-annex are you using? On what operating system? git-annex 4.20131024 on linux. Also occurs on OSX. + +> [[fixed|done]] --[[Joey]] diff --git a/doc/bugs/git_annex_fsck_in_direct_mode_does_not_checksum_files/comment_2_4ac3b87ec0bc0514c4eff9f5a75b9f5d._comment b/doc/bugs/git_annex_fsck_in_direct_mode_does_not_checksum_files/comment_2_4ac3b87ec0bc0514c4eff9f5a75b9f5d._comment index 1eb8b18e7d..3befccd39e 100644 --- a/doc/bugs/git_annex_fsck_in_direct_mode_does_not_checksum_files/comment_2_4ac3b87ec0bc0514c4eff9f5a75b9f5d._comment +++ b/doc/bugs/git_annex_fsck_in_direct_mode_does_not_checksum_files/comment_2_4ac3b87ec0bc0514c4eff9f5a75b9f5d._comment @@ -1,4 +1,4 @@ -[[!comment format=txt +[[!comment format=mdwn username="https://www.google.com/accounts/o8/id?id=AItOawln3ckqKx0x_xDZMYwa9Q1bn4I06oWjkog" nickname="Michael" subject="comment 2" diff --git a/doc/bugs/git_annex_sync_deleted_a_bunch_of_files___40__not_expected__41__.mdwn b/doc/bugs/git_annex_sync_deleted_a_bunch_of_files___40__not_expected__41__.mdwn new file mode 100644 index 0000000000..619e8e5b85 --- /dev/null +++ b/doc/bugs/git_annex_sync_deleted_a_bunch_of_files___40__not_expected__41__.mdwn @@ -0,0 +1,42 @@ +### Please describe the problem. + +I plugged in a usb drive, did git annex sync and it git fast-forward and deleted about 600 files that I had added on my laptop. + +### What steps will reproduce the problem? + +Obviously, I'm not sure really because I don't plug this usb drive every day to sync so I don't remember what I did last time. But I suppose I just finished with git annex sync and unplugged it. When the accident occured: + + 1. The usb drive was in direct mode whereas the laptop was in indirect mode at the time. + 2. I git annex sync the usb drive + 3. I git annex sync the laptop + +Anyway, the big mistake I did was syncing the laptop as well, naively thinking it would correct the usb drive; but instead it also deleted the files on the laptop. I had a back up of most of it so it was okay. + +--- + +So now I git reset --hard to a commit before I synced, so I still have my files. But how can I fix this situation? + +### What version of git-annex are you using? On what operating system? + +Arch Linux + +git-annex version: 5.20140128 +build flags: S3 DBus 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 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 + + +# End of transcript or log. +"""]] + +> [[closing|done]], not a bug based on the limited description. --[[Joey]] diff --git a/doc/bugs/git_annex_sync_deleted_a_bunch_of_files___40__not_expected__41__/comment_1_e25451863622eefed664f6a210cbe67d._comment b/doc/bugs/git_annex_sync_deleted_a_bunch_of_files___40__not_expected__41__/comment_1_e25451863622eefed664f6a210cbe67d._comment new file mode 100644 index 0000000000..f0abd4507c --- /dev/null +++ b/doc/bugs/git_annex_sync_deleted_a_bunch_of_files___40__not_expected__41__/comment_1_e25451863622eefed664f6a210cbe67d._comment @@ -0,0 +1,72 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawno-jcsScu4CK6k2QLZqxMros1PQHf1NQY" + nickname="Hugo" + subject="Sync messed up" + date="2014-03-09T12:16:32Z" + content=""" +So, I have now reseted to a previous commit all the branches: git-annex, master, synced/git-annex and synced/master in other usb drives. i can git pull and git push, etc. But every time I try a git annex sync, it's deleting files again. + +For instance: + +``````````````` +(merging laptop/git-annex laptop/synced/git-annex into git-annex...) +(Recording state in git...) +commit ok +pull wdrouge +Depuis /run/media/hrd/WD-rouge/annex/hrd + * [nouvelle branche] git-annex -> wdrouge/git-annex + e5894a1..f5af709 master -> wdrouge/master + * [nouvelle branche] synced/git-annex -> wdrouge/synced/git-annex + * [nouvelle branche] synced/master -> wdrouge/synced/master +ok +pull origin +Depuis /home/hrd + + 93d883b...f5af709 git-annex -> origin/git-annex (mise à jour forcée) + e5894a1..f5af709 master -> origin/master + + c8c2481...f5af709 synced/git-annex -> origin/synced/git-annex (mise à jour forcée) + 1d2a028..ac708e3 synced/master -> origin/synced/master + * [nouvelle étiquette] should-be-fine-here -> should-be-fine-here + +Mise à jour f5af709..ac708e3 +Fast-forward + +→ a bunch of files + 621 files changed, 22 insertions(+), 599 deletions(-) + delete mode 120000 → the bunch of files…………… + … + delete mode 120000 org/gtd.org_archive +ok +pull laptop +Depuis /home/hrd + + 93d883b...f5af709 git-annex -> laptop/git-annex (mise à jour forcée) + + c8c2481...f5af709 synced/git-annex -> laptop/synced/git-annex (mise à jour forcée) + 1d2a028..ac708e3 synced/master -> laptop/synced/master + +Already up-to-date. +ok +push wdrouge +Counting objects: 6609, done. +Delta compression using up to 4 threads. +Compressing objects: 100% (3057/3057), done. +Writing objects: 100% (3331/3331), 511.27 KiB | 0 bytes/s, done. +Total 3331 (delta 2091), reused 0 (delta 0) +To /run/media/hrd/WD-rouge/annex/hrd + f5af709..16f17bf git-annex -> synced/git-annex + f5af709..ac708e3 master -> synced/master +ok +push origin +Counting objects: 6569, done. +Delta compression using up to 4 threads. +Compressing objects: 100% (3056/3056), done. +Writing objects: 100% (3330/3330), 511.05 KiB | 0 bytes/s, done. +Total 3330 (delta 2091), reused 0 (delta 0) +To /home/hrd/ + f5af709..16f17bf git-annex -> synced/git-annex +ok +push laptop +Everything up-to-date +ok +git annex sync 14.33s user 1.87s system 74% cpu 21.696 total +`````````````````` + +"""]] diff --git a/doc/bugs/git_annex_sync_deleted_a_bunch_of_files___40__not_expected__41__/comment_2_f49e6f4016b3a6f918961a2412902e03._comment b/doc/bugs/git_annex_sync_deleted_a_bunch_of_files___40__not_expected__41__/comment_2_f49e6f4016b3a6f918961a2412902e03._comment new file mode 100644 index 0000000000..277a72b63d --- /dev/null +++ b/doc/bugs/git_annex_sync_deleted_a_bunch_of_files___40__not_expected__41__/comment_2_f49e6f4016b3a6f918961a2412902e03._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="108.236.230.124" + subject="comment 2" + date="2014-03-10T17:11:41Z" + content=""" +Your laptop is in indirect mode, so we know that the only way files can be deleted by a merge is if a commit was made to git that deletes the files. + +My conclusion is that some repository, perhaps the usb drive, made a commit that deleted those files. You should be able to find this commit with `git log --stat`, and can just `git revert` it if you want to. + +So far, I don't see evidence of a bug. For all I know, you actually did delete the files on the usb drive, and that change got committed.. +"""]] diff --git a/doc/bugs/git_annex_sync_deleted_a_bunch_of_files___40__not_expected__41__/comment_3_a234e4f58d2cc3b0110e4e65aceeb2c3._comment b/doc/bugs/git_annex_sync_deleted_a_bunch_of_files___40__not_expected__41__/comment_3_a234e4f58d2cc3b0110e4e65aceeb2c3._comment new file mode 100644 index 0000000000..edf2b26a8b --- /dev/null +++ b/doc/bugs/git_annex_sync_deleted_a_bunch_of_files___40__not_expected__41__/comment_3_a234e4f58d2cc3b0110e4e65aceeb2c3._comment @@ -0,0 +1,20 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawno-jcsScu4CK6k2QLZqxMros1PQHf1NQY" + nickname="Hugo" + subject="comment 3" + date="2014-03-13T14:36:20Z" + content=""" +> My conclusion is that some repository, perhaps the usb drive, made a commit that deleted those files. You should be able to find this commit with git log --stat, and can just git revert it if you want to. + +It would be surprising if I did that. + +Anyway, I was not able to find which commit deleted the ~600 files. I just decided to re-start completely with git annex :-/ + +The good thing is that I did not lose any file, so in that regard git annex is great ;^) + +However, one thing that is quite confusing to me is the way git annex [sync] works. Am I supposed to run git annex sync in every repository? Because if I just run it once in 1 repo, then I usually don't get all the syncing done. Maybe I just don't understand something. + +Thanks for replying, + +[sync]: http://git-annex.branchable.com/sync/ +"""]] diff --git a/doc/bugs/git_annex_sync_deleted_a_bunch_of_files___40__not_expected__41__/comment_4_a01a867500fd94e6b317e74a0b0b1401._comment b/doc/bugs/git_annex_sync_deleted_a_bunch_of_files___40__not_expected__41__/comment_4_a01a867500fd94e6b317e74a0b0b1401._comment new file mode 100644 index 0000000000..6c519e6324 --- /dev/null +++ b/doc/bugs/git_annex_sync_deleted_a_bunch_of_files___40__not_expected__41__/comment_4_a01a867500fd94e6b317e74a0b0b1401._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 4" + date="2014-03-13T15:54:28Z" + content=""" +Did you run `git log --stat` and look for a commit that deleted a lot of files? +"""]] diff --git a/doc/bugs/git_annex_sync_in_direct_mode_does_not_honor_skip-worktree/comment_4_a7eab4171af7e46bcc637aacf630e9db._comment b/doc/bugs/git_annex_sync_in_direct_mode_does_not_honor_skip-worktree/comment_4_a7eab4171af7e46bcc637aacf630e9db._comment new file mode 100644 index 0000000000..c593d41e15 --- /dev/null +++ b/doc/bugs/git_annex_sync_in_direct_mode_does_not_honor_skip-worktree/comment_4_a7eab4171af7e46bcc637aacf630e9db._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.102" + subject="ping?" + date="2014-03-19T20:54:57Z" + content=""" +You had a patch, but never shared it. I'm curious to see it.. +"""]] diff --git a/doc/bugs/id__95__rsa_on_android.mdwn b/doc/bugs/id__95__rsa_on_android.mdwn new file mode 100644 index 0000000000..2aadd6c403 --- /dev/null +++ b/doc/bugs/id__95__rsa_on_android.mdwn @@ -0,0 +1,32 @@ +### Please describe the problem. + +I generated id_rsa and id_rsa.pub from the android shell. +After copying the id_rsa.pub file on my server, ssh on android complains because id_rsa permissions on the phone are too open (660). +Chmod 600 id_rsa on /sdcard/git-annex.home/.ssh/id_rsa has no effect, i.e. permissions remain 660. + +### What steps will reproduce the problem? +use ssh-keygen to generate keys, default location is /sdcard/git-annex.home/.ssh/ +copy id_rsa.pub on ssh server, try to connect from android to ssh server. + + +### What version of git-annex are you using? On what operating system? +latest git-annex.apk (2014-03-06) on android 4.4.2 + +### Please provide any additional information below. + + +root@android:/ # /data/data/ga.androidterm/runshell +Falling back to hardcoded app location; cannot find expected files in /data/app-lib + +root@android:/sdcard/git-annex.home # ssh MYSERVERIP -p PORT -l USERNAME + +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@ WARNING: UNPROTECTED PRIVATE KEY FILE! @ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +Permissions 0660 for '/sdcard/git-annex.home/.ssh/id_rsa' are too open. +It is required that your private key files are NOT accessible by others. +This private key will be ignored. +bad permissions: ignore key: /sdcard/git-annex.home/.ssh/id_rsa + + +> [[fixed|done]]; daily build is updated. --[[Joey]] diff --git a/doc/bugs/id__95__rsa_on_android/comment_1_58f4fd1c4ae29bc3d2f3ea0aa6f6c12b._comment b/doc/bugs/id__95__rsa_on_android/comment_1_58f4fd1c4ae29bc3d2f3ea0aa6f6c12b._comment new file mode 100644 index 0000000000..0a5a9e2307 --- /dev/null +++ b/doc/bugs/id__95__rsa_on_android/comment_1_58f4fd1c4ae29bc3d2f3ea0aa6f6c12b._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="108.236.230.124" + subject="comment 1" + date="2014-03-10T21:20:10Z" + content=""" +Hmm, I know that I and others have used git-annex on android with ssh, without encountering this problem. Odd. Oh well, was already patching out many other permissions checks in ssh, so added this one to the pile. +"""]] diff --git a/doc/bugs/id__95__rsa_on_android/comment_2_7039ed326c92211aa92e9276aba8c6b6._comment b/doc/bugs/id__95__rsa_on_android/comment_2_7039ed326c92211aa92e9276aba8c6b6._comment new file mode 100644 index 0000000000..8500c41e56 --- /dev/null +++ b/doc/bugs/id__95__rsa_on_android/comment_2_7039ed326c92211aa92e9276aba8c6b6._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://smcv.pseudorandom.co.uk/" + nickname="smcv" + subject="comment 2" + date="2014-03-12T07:54:08Z" + content=""" +Would it be better to put the home directory under git-annex' directory +in `/data`, so it isn't available to every app (and every user, if more +than one) on the device? If other apps can write to its `.gitconfig` +then I think they can make git-annex run arbitrary code with its own +permissions. +"""]] diff --git a/doc/bugs/id__95__rsa_on_android/comment_3_cbe24ed08a7ef91c8c0c20ab9b7d25b7._comment b/doc/bugs/id__95__rsa_on_android/comment_3_cbe24ed08a7ef91c8c0c20ab9b7d25b7._comment new file mode 100644 index 0000000000..b972139a6a --- /dev/null +++ b/doc/bugs/id__95__rsa_on_android/comment_3_cbe24ed08a7ef91c8c0c20ab9b7d25b7._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 3" + date="2014-03-12T19:45:24Z" + content=""" +Well, that would simplify the ssh patching. + +Putting a git repository on /sdcard also allows other apps to do things with .git/config. I don't know if git-annex has permissions other apps might want to exploit.. Maybe the ability to use the network? +"""]] diff --git a/doc/bugs/--json_is_broken_for_status.mdwn b/doc/bugs/json_is_broken_for_status.mdwn similarity index 100% rename from doc/bugs/--json_is_broken_for_status.mdwn rename to doc/bugs/json_is_broken_for_status.mdwn diff --git a/doc/bugs/map_error_after_forget/comment_1_81001ecda65d882ea946611d1e18d59f._comment b/doc/bugs/map_error_after_forget/comment_1_81001ecda65d882ea946611d1e18d59f._comment new file mode 100644 index 0000000000..96d4bbffb6 --- /dev/null +++ b/doc/bugs/map_error_after_forget/comment_1_81001ecda65d882ea946611d1e18d59f._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 1" + date="2014-03-15T15:53:17Z" + content=""" +This is a bit tricky because I'm not sure which repository the map is failing on. Probably the one that comes after /media/archive/annex in the `git remote list` output. + +If you go to each of the remotes and run `git config --null --list`, does it exit nonzero in any of them? +"""]] diff --git a/doc/bugs/map_error_after_forget/comment_2_24f3b6699f646ec0c20f3d4ca010e345._comment b/doc/bugs/map_error_after_forget/comment_2_24f3b6699f646ec0c20f3d4ca010e345._comment new file mode 100644 index 0000000000..6ac154ac1b --- /dev/null +++ b/doc/bugs/map_error_after_forget/comment_2_24f3b6699f646ec0c20f3d4ca010e345._comment @@ -0,0 +1,28 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkBEmz5XoJVzN0u-0nOtpn7BBBDHsiLmxY" + nickname="Eric" + subject="comment 2" + date="2014-03-15T16:17:18Z" + content=""" +actually i removed .../xubuntu/... from the initial bug report, here is the text scraped directly from xterm. + + +xubuntu@tab:/media/xubuntu/archive/annex$ git annex map --debug +map /media/xubuntu/archive/annex ok +[2014-03-15 11:10:17 CDT] read: git [\"config\",\"--null\",\"--list\"] +[2014-03-15 11:10:17 CDT] read: git [\"config\",\"--null\",\"--list\"] +[2014-03-15 11:10:17 CDT] read: git [\"config\",\"--null\",\"--list\"] + +git-annex: user error (git [\"config\",\"--null\",\"--list\"] exited 126) +failed +git-annex: map: 1 failed +xubuntu@tab:/media/xubuntu/archive/annex$ git remote +archive-backup +bkup06-a81d-1000 +bkup08-da84-1000 +bkup19-0064 +master +master-backup +... +no obvious errors on non-zero return codes from running `git config --null --list` on all remotes +"""]] diff --git a/doc/bugs/map_error_after_forget/comment_3_950e735c6d618e60cffffd1aebf06fd3._comment b/doc/bugs/map_error_after_forget/comment_3_950e735c6d618e60cffffd1aebf06fd3._comment new file mode 100644 index 0000000000..c6c56a326c --- /dev/null +++ b/doc/bugs/map_error_after_forget/comment_3_950e735c6d618e60cffffd1aebf06fd3._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 3" + date="2014-03-15T21:41:13Z" + content=""" +Since this is map, it could be one of the remotes of /media/xubuntu/archive/annex, or one of the remotes of one of the remotes, etc. Pretty sure it's a local repository it's choking on, and not a ssh remote though. +"""]] diff --git a/doc/bugs/map_error_after_forget/comment_4_39327211f3fd1f9ed196a1f09cf68bdc._comment b/doc/bugs/map_error_after_forget/comment_4_39327211f3fd1f9ed196a1f09cf68bdc._comment new file mode 100644 index 0000000000..2795a99629 --- /dev/null +++ b/doc/bugs/map_error_after_forget/comment_4_39327211f3fd1f9ed196a1f09cf68bdc._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkBEmz5XoJVzN0u-0nOtpn7BBBDHsiLmxY" + nickname="Eric" + subject="comment 4" + date="2014-03-16T04:52:19Z" + content=""" +i don't have any ssh remotes yet. these are all local. so if it is one of the remotes, then what do i do to get it un-choked? +"""]] diff --git a/doc/bugs/map_error_after_forget/comment_6_471a2f5792dfc7cde4f1eb793984abf1._comment b/doc/bugs/map_error_after_forget/comment_6_471a2f5792dfc7cde4f1eb793984abf1._comment new file mode 100644 index 0000000000..3825b2e54d --- /dev/null +++ b/doc/bugs/map_error_after_forget/comment_6_471a2f5792dfc7cde4f1eb793984abf1._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 6" + date="2014-03-17T19:30:37Z" + content=""" +I was able to easily reproduce this kind of failure by making a git repository have a remote that did not exist. +"""]] diff --git a/doc/bugs/pages_of_packfile_errors.mdwn b/doc/bugs/pages_of_packfile_errors.mdwn index 9d60dd2aa5..488bf5ab22 100644 --- a/doc/bugs/pages_of_packfile_errors.mdwn +++ b/doc/bugs/pages_of_packfile_errors.mdwn @@ -28,3 +28,5 @@ Auto-updated latest, I thought, but the about page says: Version: 5.20131230-g9a # End of transcript or log. """]] + +> I think I've fixed this bug. Followup if not.. [[done]] --[[Joey]] diff --git a/doc/bugs/ran_once_then_stopped_running_opensuse_13.1.mdwn b/doc/bugs/ran_once_then_stopped_running_opensuse_13.1.mdwn index 922b083472..271b429bf7 100644 --- a/doc/bugs/ran_once_then_stopped_running_opensuse_13.1.mdwn +++ b/doc/bugs/ran_once_then_stopped_running_opensuse_13.1.mdwn @@ -10,3 +10,4 @@ As far as version of git-annex... it prompted to upgrade and i think i saw a 5 and since it won't load anymore i guess there is no log. +[[!tag moreinfo]] diff --git a/doc/bugs/remote_files_appear_but_are_unreadable_because_their_symlink_targets_don__39__t_exist.mdwn b/doc/bugs/remote_files_appear_but_are_unreadable_because_their_symlink_targets_don__39__t_exist.mdwn index e90fb6a5fe..3bfdf9e1d9 100644 --- a/doc/bugs/remote_files_appear_but_are_unreadable_because_their_symlink_targets_don__39__t_exist.mdwn +++ b/doc/bugs/remote_files_appear_but_are_unreadable_because_their_symlink_targets_don__39__t_exist.mdwn @@ -63,3 +63,5 @@ New lines in .git/annex/daemon.log when I add another new file: """]] [[!meta title="local pairing git-annex-shell issue when using standalone tarball"]] + +[[!tag moreinfo]] diff --git a/doc/bugs/ssh:_unprotected_private_key_file.mdwn b/doc/bugs/ssh:_unprotected_private_key_file.mdwn new file mode 100644 index 0000000000..207ef76d1a --- /dev/null +++ b/doc/bugs/ssh:_unprotected_private_key_file.mdwn @@ -0,0 +1,62 @@ +### Please describe the problem. + +When pairing two machines with git-annex assistant, the assistant kept asking for the ssh password. Checking the git-annex daemon logs, I saw that ssh was refusing to use the key the assistant had created because it was group readable (see below for the log extract). + +### What steps will reproduce the problem? + +The assistant was installed from the ubuntu precise ppa backport on an up-to-date copy of ubuntu precise. +It was started using "git-annex webapp --listen=XYZ". +This was done on two machines on the same network. +Created a repository using the web-app, the same on both machines. +Did a pair request. This initially worked fine, until it got to the point of using ssh, when it started asking for the password many many times. + +### What version of git-annex are you using? On what operating system? + +git-annex version: 5.20140306 +build flags: Assistant Webapp Pairing S3 WebDAV Inotify DBus XMPP Feeds Quvi TDFA CryptoHash +key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 WORM URL +remote types: git gcrypt S3 bup directory rsync web webdav tahoe glacier hook external +local repository version: 5 +supported repository version: 5 +upgrade supported from repository versions: 0 1 2 4 + +Ubuntu 12.04.4 LTS + +### 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 + +(started...) Generating public/private rsa key pair. +Your identification has been saved in /tmp/git-annex-keygen.0/key. +Your public key has been saved in /tmp/git-annex-keygen.0/key.pub. +The key fingerprint is: +2b:f4:28:35:72:2c:9e:5b:d3:1d:d1:a1:b7:c7:a5:34 ABC@XYZ +The key's randomart image is: ++--[ RSA 2048]----+ +| . | +| o . | +| o o E .| +| . o + + | +| o * S . . + | +| . B = o . . | +| + = + . | +| + o | +| . | ++-----------------+ +[2014-03-14 13:35:45 GMT] main: Pairing in progress +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +@ WARNING: UNPROTECTED PRIVATE KEY FILE! @ +@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ +Permissions 0620 for 'ABC/.ssh/git-annex/key.git-annex-XYZ_annex' are too open. +It is required that your private key files are NOT accessible by others. +This private key will be ignored. +bad permissions: ignore key: ABC/.ssh/git-annex/key.git-annex-XYZ_annex +(merging XYZ_annex/git-annex into git-annex...) + +# End of transcript or log. +"""]] + +> [[Fixed|done]]; the code made sure the file did not have any group or +> world read bits, but did not clear write bits. --[[Joey]] diff --git a/doc/bugs/sync_command_tries_to_connect_new_remote_despite_not_being_asked_to.mdwn b/doc/bugs/sync_command_tries_to_connect_new_remote_despite_not_being_asked_to.mdwn index 014288d5fb..34b52213c2 100644 --- a/doc/bugs/sync_command_tries_to_connect_new_remote_despite_not_being_asked_to.mdwn +++ b/doc/bugs/sync_command_tries_to_connect_new_remote_despite_not_being_asked_to.mdwn @@ -42,3 +42,5 @@ so annex tries to sync with the "bad" remote, even though the command tells it t ### What version of git-annex are you using? On what operating system? git-annex version: 5.20131221 Debian Sid + +> Behaving as intended. [[done]] --[[Joey]] diff --git a/doc/bugs/unused_fails_due_to_commitBuffer_containing_an_invalid_argument.mdwn b/doc/bugs/unused_fails_due_to_commitBuffer_containing_an_invalid_argument.mdwn new file mode 100644 index 0000000000..cc9a4c57f9 --- /dev/null +++ b/doc/bugs/unused_fails_due_to_commitBuffer_containing_an_invalid_argument.mdwn @@ -0,0 +1,87 @@ +### Please describe the problem. + +#### git annex unused fails with the message: + +... + 86731 SHA256E-s13243--a6c5fe9710975e0b0ca01ec0b7eca6068a01b1b1c06adbd8ad7921e26d3b076d.h + + 86732 SHA256E-s12872--f50b73d313a116ea21649d684f601840dbc8ed3c264165dd77fa5d54a1c57464.c + + 86733 SHA256E-s6557264--6b502d56378b9919fd3c54c3bb2dc2906a326be8e9d477a8f3518419929f4706.dll + + 86734 SHA256E-s141--c6227fe715dab2b4447b6e43af2b170ac66d82043aa81a14013c56be922e11db.out + + 86735 SHA256E-s6564--ec4bcd833d071fff7d8cc81b908558acdeae2c9ba62f7d65b584effe6b36a8c6.c + +git-annex: /bluepool/data/.git/annex/unused32594.tmp: commitBuffer: invalid argument (invalid character) +failed + +git-annex: unused: 1 failed + +#### A subsequent git annex dropunused does not work (there are 86735 files unused). A simple: +"git annex dropunused 1-10" produces: + +git-annex: 1 not valid (run git annex unused for list) + +#### It seems that the list of unused files was not saved (committed) + +### What steps will reproduce the problem? + +I suspect it can be reproduced by having files with non-english characters. +This should be the sequence of commands to reproduce if one knew the invalid character: + +git init . + +git annex init . + +touch "Invalid character in file name" + +git annex add "Invalid character in file name" + +git commit + +git rm "Invalid character in file name" + +git commit + +git unused + +However, I usually have "git annex watch" running so this might also have an influence on how (maybe not-escaped) filenames are added. + +### What version of git-annex are you using? On what operating system? + +git annex standalone: + +git-annex version: 5.20140306-g6e2e021 + +build flags: Assistant Webapp Pairing Testsuite S3 WebDAV Inotify DBus XMPP Feeds Quvi TDFA CryptoHash + +key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 WORM URL + +remote types: git gcrypt S3 bup directory rsync web webdav tahoe glacier hook external + +local repository version: 5 + +supported repository version: 5 + +upgrade supported from repository versions: 0 1 2 4 + + + +Ubuntu Raring: Linux i3 3.11.4-031104-generic + + +### Please provide any additional information below. + +I guess I could provide the full output of git annex unused but I would rather not put it into this bug report for privacy reasons. + +[[!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. +"""]] + +> [[closing|done]], would still be nice to have verification my fix worked. +> --[[Joey]] diff --git a/doc/bugs/unused_fails_due_to_commitBuffer_containing_an_invalid_argument/comment_1_004cb3015895ad67386276f3e1f0de0d._comment b/doc/bugs/unused_fails_due_to_commitBuffer_containing_an_invalid_argument/comment_1_004cb3015895ad67386276f3e1f0de0d._comment new file mode 100644 index 0000000000..e1db22b2e2 --- /dev/null +++ b/doc/bugs/unused_fails_due_to_commitBuffer_containing_an_invalid_argument/comment_1_004cb3015895ad67386276f3e1f0de0d._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 1" + date="2014-03-15T16:01:53Z" + content=""" +I see the problem, although I have not quite managed to reproduce it. I think this would probably only happen if you have the unusual character in the extension of the file (or are using the WORM backend). + +I've put a fix in git. It will be available in the next autobuild, in half an hour or so. +"""]] diff --git a/doc/bugs/unused_fails_due_to_commitBuffer_containing_an_invalid_argument/comment_2_3fe298ebb3ff04d12f2528aa982d7084._comment b/doc/bugs/unused_fails_due_to_commitBuffer_containing_an_invalid_argument/comment_2_3fe298ebb3ff04d12f2528aa982d7084._comment new file mode 100644 index 0000000000..ed5733d041 --- /dev/null +++ b/doc/bugs/unused_fails_due_to_commitBuffer_containing_an_invalid_argument/comment_2_3fe298ebb3ff04d12f2528aa982d7084._comment @@ -0,0 +1,24 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmp1ThsNNAbSn46ju-gwFELfStlhl8usJo" + nickname="donkeyicydragon" + subject="Problem still occurs but maybe my update did not work" + date="2014-03-16T18:01:24Z" + content=""" +Hi Joey, thanks for the quick response. + +I tried to update and retry my \"git annex unused\" but it gave the same error. Maybe my updating did not work (see below). But is there a way I can retry it without running \"git annex unused\" again? The problem is that each run takes several hours with my amount of files. +It would be nice, if git annex recognized some error in the last approach and recovered. +The tmp files that are created by \"git annex unused\" are still in .git/annex/. + + +Regarding the updating: +I tried to obtain the autobuild version but on this website I could not find a link to download the latest autobuild. I could only find the build reports. But I used the git annex installer script from https://github.com/zerodogg/scriptbucket/blob/master/gitannex-install +and it apparently knows the location of the daily build. Is this the autobuild or is git annex autobuilt more often? + +This is my version after installing it yesterday evening approx. 2h hours after your answer to the bug description. + +git-annex version: 5.20140314-g48e0f18 +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 +"""]] diff --git a/doc/bugs/unused_fails_due_to_commitBuffer_containing_an_invalid_argument/comment_3_9302536d1577c12337d714fa3a9ea7a1._comment b/doc/bugs/unused_fails_due_to_commitBuffer_containing_an_invalid_argument/comment_3_9302536d1577c12337d714fa3a9ea7a1._comment new file mode 100644 index 0000000000..e74ccba1c5 --- /dev/null +++ b/doc/bugs/unused_fails_due_to_commitBuffer_containing_an_invalid_argument/comment_3_9302536d1577c12337d714fa3a9ea7a1._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 3" + date="2014-03-17T19:28:05Z" + content=""" +No, your version is from before I fixed it. + +You can get an autobuild from [[install/Linux_standalone]] +"""]] diff --git a/doc/bugs/unused_fails_due_to_commitBuffer_containing_an_invalid_argument/comment_4_c1c8de66192957b7026d99b9ff90589c._comment b/doc/bugs/unused_fails_due_to_commitBuffer_containing_an_invalid_argument/comment_4_c1c8de66192957b7026d99b9ff90589c._comment new file mode 100644 index 0000000000..b229545f62 --- /dev/null +++ b/doc/bugs/unused_fails_due_to_commitBuffer_containing_an_invalid_argument/comment_4_c1c8de66192957b7026d99b9ff90589c._comment @@ -0,0 +1,16 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmp1ThsNNAbSn46ju-gwFELfStlhl8usJo" + nickname="donkeyicydragon" + subject="Maybe the autobuild is broken?" + date="2014-03-17T20:32:19Z" + content=""" +The latest autobuild log for amd64 says: +Starting at: Fri Mar 14 21:42:07 UTC 2014 + +I downloaded the amd64 autobuild from https://git-annex.branchable.com/install/Linux_standalone/ + +and it indeed is from Friday. + +Cheers, +Marek +"""]] diff --git a/doc/bugs/unused_fails_due_to_commitBuffer_containing_an_invalid_argument/comment_5_8c2dad766e4115073d49b698919b5ed5._comment b/doc/bugs/unused_fails_due_to_commitBuffer_containing_an_invalid_argument/comment_5_8c2dad766e4115073d49b698919b5ed5._comment new file mode 100644 index 0000000000..360003fbaf --- /dev/null +++ b/doc/bugs/unused_fails_due_to_commitBuffer_containing_an_invalid_argument/comment_5_8c2dad766e4115073d49b698919b5ed5._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 5" + date="2014-03-18T19:07:25Z" + content=""" +cron was not running them for some reason, but they are up-to-date now. +"""]] diff --git a/doc/bugs/unused_fails_due_to_commitBuffer_containing_an_invalid_argument/comment_6_8da2a73381309ecef4b2796d8f2bb0bb._comment b/doc/bugs/unused_fails_due_to_commitBuffer_containing_an_invalid_argument/comment_6_8da2a73381309ecef4b2796d8f2bb0bb._comment new file mode 100644 index 0000000000..8532afaf7f --- /dev/null +++ b/doc/bugs/unused_fails_due_to_commitBuffer_containing_an_invalid_argument/comment_6_8da2a73381309ecef4b2796d8f2bb0bb._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmp1ThsNNAbSn46ju-gwFELfStlhl8usJo" + nickname="donkeyicydragon" + subject="Your changes to git annex worked" + date="2014-03-19T21:27:39Z" + content=""" +Thanks a lot. + +BTW, will you start a new funding round? +"""]] diff --git a/doc/bugs/variant-_files_are_created_even_though_the_content_has_the_same_hash.mdwn b/doc/bugs/variant-_files_are_created_even_though_the_content_has_the_same_hash.mdwn index 8bf3c3d205..9bc8911009 100644 --- a/doc/bugs/variant-_files_are_created_even_though_the_content_has_the_same_hash.mdwn +++ b/doc/bugs/variant-_files_are_created_even_though_the_content_has_the_same_hash.mdwn @@ -9,3 +9,5 @@ lrwxrwxrwx 1 jkt jkt 343 Mar 3 02:08 2011-02-05 Svatba Maruška Pavel/jkt/cam1/ """]] I don't know what determines the `P4/F7/` vs `38/pG/` directory names, but I would prefer if these duplicates were not created. + +> I guess I'm going to close this as not a bug. [[done]] --[[Joey]] diff --git a/doc/bugs/whereis_claims_file_is_not_here__44___but_it_is_available_both_here_and_in_another_remote.mdwn b/doc/bugs/whereis_claims_file_is_not_here__44___but_it_is_available_both_here_and_in_another_remote.mdwn index ee69014d27..98ee21d161 100644 --- a/doc/bugs/whereis_claims_file_is_not_here__44___but_it_is_available_both_here_and_in_another_remote.mdwn +++ b/doc/bugs/whereis_claims_file_is_not_here__44___but_it_is_available_both_here_and_in_another_remote.mdwn @@ -26,3 +26,5 @@ lrwxrwxrwx 1 jkt jkt 329 Mar 3 02:08 2011-08-13 Svatba Anička Fellnerová a v The directory names are valid UTF-8. These are very common on my machine and there is a ton of directories with these funny names here -- all working without any real trouble. As far as I know, the file which the links point to is absolutely correct and not corrupted. Looking at the files in the directory chronologically, it also appears that the symlinks point to a correct file. + +[[!tag moreinfo]] diff --git a/doc/bugs/whereis_claims_file_is_not_here__44___but_it_is_available_both_here_and_in_another_remote/comment_2_f430538101f0ef6114b5e953248fa599._comment b/doc/bugs/whereis_claims_file_is_not_here__44___but_it_is_available_both_here_and_in_another_remote/comment_2_f430538101f0ef6114b5e953248fa599._comment new file mode 100644 index 0000000000..e78971a90e --- /dev/null +++ b/doc/bugs/whereis_claims_file_is_not_here__44___but_it_is_available_both_here_and_in_another_remote/comment_2_f430538101f0ef6114b5e953248fa599._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.102" + subject="ping?" + date="2014-03-19T20:24:23Z" + content=""" +Have you tried running git-annex fsck? +"""]] diff --git a/doc/bugs/whereis_outputs_no_informaiton_for_unlocked_files/comment_1_47bd0fc8d1c65f8a868d9722e66c71db._comment b/doc/bugs/whereis_outputs_no_informaiton_for_unlocked_files/comment_1_47bd0fc8d1c65f8a868d9722e66c71db._comment new file mode 100644 index 0000000000..e92ec33f99 --- /dev/null +++ b/doc/bugs/whereis_outputs_no_informaiton_for_unlocked_files/comment_1_47bd0fc8d1c65f8a868d9722e66c71db._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.102" + subject="comment 1" + date="2014-03-19T20:52:08Z" + content=""" +The reason this doesn't work is that, in indirect mode, git-annex looks at the current state of the symlink in the work tree to know what key is associated with a file. And an unlocked file has no symlink. + +Direct mode avoids this problem, but at the expense of being less flexible and well, doing more work. +"""]] diff --git a/doc/design/assistant/blog/day_288__success_stories/comment_15_5749aef8b585b293385b20b75c40f9d8._comment b/doc/design/assistant/blog/day_288__success_stories/comment_15_5749aef8b585b293385b20b75c40f9d8._comment index d8c99640b5..cefc5045c6 100644 --- a/doc/design/assistant/blog/day_288__success_stories/comment_15_5749aef8b585b293385b20b75c40f9d8._comment +++ b/doc/design/assistant/blog/day_288__success_stories/comment_15_5749aef8b585b293385b20b75c40f9d8._comment @@ -1,4 +1,4 @@ -[[!comment format=txt +[[!comment format=mdwn username="http://jasonwoof.com/" nickname="JasonWoof" subject="It's been great!" diff --git a/doc/design/assistant/blog/day_45__long_polling/comment_3_5526c9dd4fd87da56cb8456083169f55._comment b/doc/design/assistant/blog/day_45__long_polling/comment_3_5526c9dd4fd87da56cb8456083169f55._comment index 4880bd98db..7881bcda56 100644 --- a/doc/design/assistant/blog/day_45__long_polling/comment_3_5526c9dd4fd87da56cb8456083169f55._comment +++ b/doc/design/assistant/blog/day_45__long_polling/comment_3_5526c9dd4fd87da56cb8456083169f55._comment @@ -1,4 +1,4 @@ -[[!comment format=txt +[[!comment format=mdwn username="https://www.google.com/accounts/o8/id?id=AItOawmz8d2M0lQDYWLSbDQSjYRHfrQkWKgPu60" nickname="Alex" subject="long polling in Widget form" diff --git a/doc/design/assistant/polls/Android_default_directory.mdwn b/doc/design/assistant/polls/Android_default_directory.mdwn index 0e5ade06ae..869aedf4b5 100644 --- a/doc/design/assistant/polls/Android_default_directory.mdwn +++ b/doc/design/assistant/polls/Android_default_directory.mdwn @@ -4,4 +4,4 @@ Same as the desktop webapp, users will be able to enter a directory they want the first time they run it, but to save typing on android, anything that gets enough votes will be included in a list of choices as well. -[[!poll open=yes expandable=yes 63 "/sdcard/annex" 6 "Whole /sdcard" 5 "DCIM directory (photos and videos only)" 1 "Same as for regular git-annex. ~/annex/"]] +[[!poll open=yes expandable=yes 66 "/sdcard/annex" 6 "Whole /sdcard" 6 "DCIM directory (photos and videos only)" 1 "Same as for regular git-annex. ~/annex/"]] diff --git a/doc/design/assistant/polls/prioritizing_special_remotes.mdwn b/doc/design/assistant/polls/prioritizing_special_remotes.mdwn index d934f74fc4..f7462af0d6 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)" 24 "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" 31 "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/caching_database.mdwn b/doc/design/caching_database.mdwn new file mode 100644 index 0000000000..9d688a9d4a --- /dev/null +++ b/doc/design/caching_database.mdwn @@ -0,0 +1,124 @@ +* [[metadata]] for views +* [direct mode mappings scale badly with thousands of identical files](/bugs/__34__Adding_4923_files__34___is_really_slow) +* [[bugs/incremental_fsck_should_not_use_sticky_bit]] +* [[todo/wishlist:_pack_metadata_in_direct_mode]] +* [[todo/cache_key_info]] + +What do all these have in common? They could all be improved by +using some kind of database to locally store the information in an +efficient way. + +The database should only function as a cache. It should be able to be +generated and updated by looking at the git repository. + +* Metadata can be updated by looking at the git-annex branch, + either its current state, or the diff between the old and new versions +* Direct mode mappings can be updated by looking at the current branch, + to see which files map to which key. Or the diff between the old + and new versions of the branch. +* Incremental fsck information is not stored in git, but can be + "regenerated" by running fsck again. + (Perhaps doesn't quite fit, but let it slide..) + +Store in the database the Ref of the branch that was used to construct it. +(Update in same transaction as cached data.) + +## implementation plan + +1. Implement for metadata, on a branch, with sqlite. +2. Make sure that builds on all platforms. +3. Add associated file mappings support. This is needed to fully + use the caching database to construct views. +4. Store incremental fsck info in db. +5. Replace .map files with 3. for direct mode. + +## case study: persistent with sqllite + +Here's a non-normalized database schema in persistent's syntax. + +
+CachedKey
+  key Key
+  associatedFiles [FilePath]
+  lastFscked Int Maybe
+  KeyIndex key
+
+CachedMetaData
+  key Key
+  metaDataField MetaDataField
+  metaDataValue MetaDataValue
+
+ +Using the above database schema and persistent with sqlite, I made +a database containing 30k Cache records. This took 5 seconds to create +and was 7 mb on disk. (Would be rather smaller, if a more packed Key +show/read instance were used.) + +Running 1000 separate queries to get 1000 CachedKeys took 0.688s with warm +cache. This was more than halved when all 1000 queries were done inside the +same `runSqlite` call. (Which could be done using a separate thread and some +MVars.) + +(Note that if the database is a cache, there is no need to perform migrations +when querying it. My benchmarks skip `runMigration`. Instead, if the query +fails, the database doesn't exist, or uses an incompatable schema, and the +cache can be rebuilt then. This avoids the problem that persistent's migrations +can sometimes fail.) + +Doubling the db to 60k scaled linearly in disk and cpu and did not affect +query time. + +---- + +Here's a normalized schema: + +
+CachedKey
+  key Key
+  KeyIndex key
+  deriving Show
+
+AssociatedFiles
+  keyId CachedKeyId Eq
+  associatedFile FilePath
+  KeyIdIndex keyId associatedFile
+  deriving Show
+
+CachedMetaField
+  field MetaField
+  FieldIndex field
+
+CachedMetaData
+  keyId CachedKeyId Eq
+  fieldId CachedMetaFieldId Eq
+  metaValue String
+
+LastFscked
+  keyId CachedKeyId Eq
+  localFscked Int Maybe
+
+ +With this, running 1000 joins to get the associated files of 1000 +Keys took 5.6s with warm cache. (When done in the same `runSqlite` call.) Ouch! + +Update: This performance was fixed by adding `KeyIdOutdex keyId associatedFile`, +which adds a uniqueness constraint on the tuple of key and associatedFile. +With this, 1000 queries takes 0.406s. Note that persistent is probably not +actually doing a join at the SQL level, so this could be sped up using +eg, esquelito. + +Update2: Using esquelito to do a join got this down to 0.250s. + +Code: + +Compare the above with 1000 calls to `associatedFiles`, which is approximately +as fast as just opening and reading 1000 files, so will take well under +0.05s with a **cold** cache. + +So, we're looking at nearly an order of magnitude slowdown using sqlite and +persistent for associated files. OTOH, the normalized schema should +perform better when adding an associated file to a key that already has many. + +For metadata, the story is much nicer. Querying for 30000 keys that all +have a particular tag in their metadata takes 0.65s. So fast enough to be +used in views. diff --git a/doc/design/metadata/comment_4_c32ade1524487e5fdc6f83b2db39f04c._comment b/doc/design/metadata/comment_4_c32ade1524487e5fdc6f83b2db39f04c._comment new file mode 100644 index 0000000000..01f917ef59 --- /dev/null +++ b/doc/design/metadata/comment_4_c32ade1524487e5fdc6f83b2db39f04c._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="bremner" + ip="198.164.160.48" + subject="convenient way to query metadata?" + date="2014-03-15T20:58:28Z" + content=""" +I'd like to be able to do something like \"git annex metadata -q fieldname\" and have that output the value(s) of fieldname. I see I could parse the json output but that isn't too convenient in a shell script. Or have I missed something that already exists? +"""]] diff --git a/doc/design/metadata/comment_5_0ac3132cd7a84f0e170fbe3a6f235fe7._comment b/doc/design/metadata/comment_5_0ac3132cd7a84f0e170fbe3a6f235fe7._comment new file mode 100644 index 0000000000..ca98f7f415 --- /dev/null +++ b/doc/design/metadata/comment_5_0ac3132cd7a84f0e170fbe3a6f235fe7._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 5" + date="2014-03-15T21:30:52Z" + content=""" +@bremner, you must be up to something interesting.. Added metadata --get for you. +"""]] diff --git a/doc/devblog/day_130__post_release.mdwn b/doc/devblog/day_130__post_release.mdwn new file mode 100644 index 0000000000..b6a2af6c8b --- /dev/null +++ b/doc/devblog/day_130__post_release.mdwn @@ -0,0 +1,17 @@ +Release made yesterday, but only finished up the armel build today. +And it turns out the OSX build was missing the webapp, so it's also been +updated today. + +Post release bug triage including: + +Added a nice piece of UI to the webapp on user request: A "Sync now" menu +item in the repository for each repo. (The one for the current repo syncs with +all its remotes.) + +Copying files to a git repository on the same computer turns out to have +had a resource leak issue, that caused 1 zombie process per file. With +some tricky monad state caching, fixed that, and also eliminated 8% of the work +done by git-annex in this case. + +Fixed `git annex unused` in direct mode to not think that files that were +deleted out of the work tree by the user still existed and were unused. diff --git a/doc/devblog/day_131__more_bug_squashing.mdwn b/doc/devblog/day_131__more_bug_squashing.mdwn new file mode 100644 index 0000000000..3c256f1fbd --- /dev/null +++ b/doc/devblog/day_131__more_bug_squashing.mdwn @@ -0,0 +1,11 @@ +Squashed three or four more bugs today. Unanswered message backlog is down +to 27. + +The most interesting problem today is that the git-repair code was using +too much memory when `git-fsck` output a lot of problems (300 thousand!). I +managed to half the memory use in the worst case (and reduced it much more +in more likely cases). But, don't really feel I can close that bug yet, +since really big, really badly broken repositories can still run it out of +memory. It would be good to find a way to reorganize the code so that the +broken objects list streams through git-repair and never has to all be +buffered in memory at once. But this is not easy. diff --git a/doc/devblog/day_132__database_musings.mdwn b/doc/devblog/day_132__database_musings.mdwn new file mode 100644 index 0000000000..76ce14c32d --- /dev/null +++ b/doc/devblog/day_132__database_musings.mdwn @@ -0,0 +1,17 @@ +Updated the Debian stable backport to the last release. Also it seems that +the last release unexpectedly fixed XMPP SIGILL on some OSX machines. +Apparently when I rebuilt all the libraries recently, it somehow fixed that +[[old_unsolved_bug|bugs/Share_with_friends_crash_in_osx]]. + +[RichiH](http://richardhartmann.de/) suggested "wrt ballooning memory on +repair: can you read in broken +stuff and simply stop reading once you reach a certain threshold, then +start repairing, re-run fsck, etc?" .. I had considered that but was +not sure it would work. I think I've gotten it to work. + +Now working on a design for using a [[design/caching_database]] +for some parts of git-annex. My initial benchmarks using SQLite +indicate it would slow down associated file lookups by nearly an order of +magnitude compared with the current ".map files" implementation. +(But would scale better in edge cases). OTOH, using a SQLite +database to index metadata for use in views looks very promising. diff --git a/doc/devblog/day_133__db_and_bugfixes.mdwn b/doc/devblog/day_133__db_and_bugfixes.mdwn new file mode 100644 index 0000000000..b844708dc8 --- /dev/null +++ b/doc/devblog/day_133__db_and_bugfixes.mdwn @@ -0,0 +1,20 @@ +Did some more exploration and perf tuning and thinking on caching +databases, and am pretty sure I know how I want to implement it. Will be +several stages, starting with using it for generating views, and ending(?) +with using it for direct mode file mappings. + +Not sure I'm ready to dive into that yet, so instead spent the rest of the +day working on small bugfixes and improvemnts. Only two significant ones.. + +Made the webapp use a constant time string comparison (from `securemem`) +to check if its auth token is valid. This could help avoid a potential +timing attack to guess the auth token, although that is theoretical. +Just best practice to do this. + +Seems that openssh 6.5p1 had another hidden surprise (in addition to +its now-fixed bug in handing hostnames in `.ssh/config`) -- it broke +the method git-annex was using for stopping a cached ssh connection, +which led to some timeouts for failing DNS lookups. If git-annex seems +to stall for a few seconds at startup/shutdown, that may be why +(--debug will say for sure). I seem to have found a workaround that +avoids this problem. diff --git a/doc/devblog/day_134-135__avoiding_the_turing_tarpit.mdwn b/doc/devblog/day_134-135__avoiding_the_turing_tarpit.mdwn new file mode 100644 index 0000000000..d18470ae03 --- /dev/null +++ b/doc/devblog/day_134-135__avoiding_the_turing_tarpit.mdwn @@ -0,0 +1,18 @@ +Added some power and convenience to [[preferred_content]] expressions. + +Before, "standard" was a special case. Now it's a first-class keyword, +so you can do things like "standard or present" to use the standard +preferred content expression, modified to also want any file that happens +to be present. + +Also added a way to write your own reusable preferred content expressions, +tied to groups. To make a repository use them, set its preferred +content to "groupwanted". Of course, "groupwanted" is also a first-class +keyword, so "not groupwanted" or something can also be done. + +While I was at it, I made `vicfg` show the built-in standard preferred +content expressions, for reference. This little IDE should be pretty +self-explanatory, I hope. + +So, preferred content is almost its own little programming language now. +Except I was careful to not allow recursion. ;) diff --git a/doc/devblog/day_136__frustrating_day.mdwn b/doc/devblog/day_136__frustrating_day.mdwn new file mode 100644 index 0000000000..9088093d4a --- /dev/null +++ b/doc/devblog/day_136__frustrating_day.mdwn @@ -0,0 +1,10 @@ +The website broke and I spent several hours fixing it, changing the +configuration to not let it break like this again, cleaning up after it, +etc. + +Did manage to make a few minor bugfixes and improvements, but nothing +stunning. + +---- + +I'll be attending LibrePlanet at MIT this weekend. diff --git a/doc/devblog/day_137-138__bug_triage_and_too_much_windows.mdwn b/doc/devblog/day_137-138__bug_triage_and_too_much_windows.mdwn new file mode 100644 index 0000000000..28b197356b --- /dev/null +++ b/doc/devblog/day_137-138__bug_triage_and_too_much_windows.mdwn @@ -0,0 +1,15 @@ +Yesterday, worked on cleaning up the todo list. Fixed Windows slash problem +with rsync remotes. Today, more Windows work; it turns out to have been +quite buggy in its handling of non-ASCII characters in filenames. Encoding +stuff is never easy for me, but I eventually managed to find a way to fix +that, although I think there are other filename encoding problems lurking +in git-annex on Windows still to be dealt with. + +Implemented an interesting metadata feature yesterday. It turns out that +metadata can have metadata. Particularly, it can be useful to know when a +field was last set. That was already beeing tracked, internally (to make +union merging work), so I was able to quite cheaply expose it as +"$field-lastchanged" metadata that can be used like any other metadata. + +I've been thinking about how to implement [[todo/required_content]] +expressions, and think I have a reasonably good handle on it. diff --git a/doc/devblog/day_82__rpi_and_synology/comment_1_d154ddcf22027fd06acf9da73e12c006._comment b/doc/devblog/day_82__rpi_and_synology/comment_1_d154ddcf22027fd06acf9da73e12c006._comment index 9b73a8e79c..33bc12e634 100644 --- a/doc/devblog/day_82__rpi_and_synology/comment_1_d154ddcf22027fd06acf9da73e12c006._comment +++ b/doc/devblog/day_82__rpi_and_synology/comment_1_d154ddcf22027fd06acf9da73e12c006._comment @@ -1,4 +1,4 @@ -[[!comment format=txt +[[!comment format=mdwn username="Attila" ip="213.163.19.162" subject="git-annex.org" diff --git a/doc/favicon.ico b/doc/favicon.ico index 5bb405931f..e754f5a48b 100644 Binary files a/doc/favicon.ico and b/doc/favicon.ico differ diff --git a/doc/favicon.png b/doc/favicon.png deleted file mode 100644 index 1efbebdd7c..0000000000 Binary files a/doc/favicon.png and /dev/null differ diff --git a/doc/forum/Add_a___34__local__34___remote.txt b/doc/forum/Add_a___34__local__34___remote.mdwn similarity index 100% rename from doc/forum/Add_a___34__local__34___remote.txt rename to doc/forum/Add_a___34__local__34___remote.mdwn diff --git a/doc/forum/Auto_sync_with_music_player/comment_2_a15e3f298c3d3faa5b3295355f9bb794._comment b/doc/forum/Auto_sync_with_music_player/comment_2_a15e3f298c3d3faa5b3295355f9bb794._comment new file mode 100644 index 0000000000..fc0d069683 --- /dev/null +++ b/doc/forum/Auto_sync_with_music_player/comment_2_a15e3f298c3d3faa5b3295355f9bb794._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="EvanDeaubl" + ip="67.128.198.190" + subject="Workaround using external app" + date="2014-03-07T14:57:39Z" + content=""" +A workaround for this is using an external app that pings the media scanner to rescan. It's an extra step to remember, but I haven't found it too much of a burden. + +I use this one: , but there are at least a dozen to choose from. + +"""]] diff --git a/doc/forum/Auto_sync_with_music_player/comment_3_99f65a0efaf5d5f9b8ff530acc122860._comment b/doc/forum/Auto_sync_with_music_player/comment_3_99f65a0efaf5d5f9b8ff530acc122860._comment new file mode 100644 index 0000000000..b0275abdc2 --- /dev/null +++ b/doc/forum/Auto_sync_with_music_player/comment_3_99f65a0efaf5d5f9b8ff530acc122860._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 3" + date="2014-03-18T19:59:07Z" + content=""" +Turns out there is an open todo about this with details: [[todo/Use_MediaScannerConnection_on_Android]] +"""]] diff --git a/doc/forum/GPG_passphrase_handling.txt b/doc/forum/GPG_passphrase_handling.mdwn similarity index 100% rename from doc/forum/GPG_passphrase_handling.txt rename to doc/forum/GPG_passphrase_handling.mdwn diff --git a/doc/forum/Git_annex_on_Windows/comment_6_79fb5ec1b47593ab3355543c5499284a._comment b/doc/forum/Git_annex_on_Windows/comment_6_79fb5ec1b47593ab3355543c5499284a._comment new file mode 100644 index 0000000000..c3f2ca2a81 --- /dev/null +++ b/doc/forum/Git_annex_on_Windows/comment_6_79fb5ec1b47593ab3355543c5499284a._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://alerque.com/" + nickname="Caleb" + subject="path issue" + date="2014-03-20T13:05:34Z" + content=""" +It seems the use of the cmd folder in the Windows git-annex installer no longer meshes with the git install from msysgit. Changing \"cmd\" to \"bin\" during the install process made it work for me. +"""]] diff --git a/doc/forum/Git_annex_on_Windows/comment_7_75d4450b4608ad0b453bc69159e708de._comment b/doc/forum/Git_annex_on_Windows/comment_7_75d4450b4608ad0b453bc69159e708de._comment new file mode 100644 index 0000000000..2d0b3ea3ce --- /dev/null +++ b/doc/forum/Git_annex_on_Windows/comment_7_75d4450b4608ad0b453bc69159e708de._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.102" + subject="comment 7" + date="2014-03-20T16:04:36Z" + content=""" +Hmm, putting git-annex.exe in to bin and not cmd with mysysgit 1.8.5.2 will make \"git annex\" work, but \"git-annex\" will not. + +What version of msysgit has the problem with bin? +"""]] diff --git a/doc/forum/Git_annex_on_Windows/comment_8_e4e5ad0cda34bb597fe1bb804acc15e9._comment b/doc/forum/Git_annex_on_Windows/comment_8_e4e5ad0cda34bb597fe1bb804acc15e9._comment new file mode 100644 index 0000000000..3a649c5013 --- /dev/null +++ b/doc/forum/Git_annex_on_Windows/comment_8_e4e5ad0cda34bb597fe1bb804acc15e9._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.102" + subject="comment 8" + date="2014-03-20T19:50:26Z" + content=""" +I upgraded to msysgit 1.9.0 and git annex works in cmd. + +Did you tell the msysgit installer to \"Run git from the windows command prompt\"? This is the default. If you chose \"Use git bash only\" then git-annex will only work from within git bash. +"""]] diff --git a/doc/forum/How_do_I_get_rid_of_a_wrong_remote_uuid__63__.mdwn b/doc/forum/How_do_I_get_rid_of_a_wrong_remote_uuid__63__.mdwn new file mode 100644 index 0000000000..209e0f6a78 --- /dev/null +++ b/doc/forum/How_do_I_get_rid_of_a_wrong_remote_uuid__63__.mdwn @@ -0,0 +1,16 @@ +Hello, + +I had some trouble adding a remote (the files would not appear when I was copying them to the remote), so I started over and cloned an existing repository. + +Of course, as I started over, I had a duplicate uuid for the remote, which would cause problems when trying to copy (I would have an error "git-annex-shell: expected repository UUID 70582c7b-0b57-4087-a9d1-77b5f5f3c75e but found UUID 335699ea-d5b8-49ff-b207-1571b5969afe"). + +I finally managed to find the wrong uuid in the .git/config file (there was a duplicated entry for the remote) and I'm now able to copy things to the remote repository, and "git annex sync" works well. However I still see a mention of this repository when I do a "git annex whereis": + + cody:games schmitta$ git annex whereis + whereis dungeon_keeper_1.1.0.11.dmg (3 copies) + 1cdfb490-0660-41fb-b7ce-74b89abb9aac -- top + 335699ea-d5b8-49ff-b207-1571b5969afe -- here (cody) + 70582c7b-0b57-4087-a9d1-77b5f5f3c75e + + +Where can I find where this last line come from, and how can I get rid of it? I tried saying that this uuid is dead, but git annex tells me it's not a remote name. diff --git a/doc/forum/How_do_I_get_rid_of_a_wrong_remote_uuid__63__/comment_1_b3c215cedba51fb47992ef10c60d6acc._comment b/doc/forum/How_do_I_get_rid_of_a_wrong_remote_uuid__63__/comment_1_b3c215cedba51fb47992ef10c60d6acc._comment new file mode 100644 index 0000000000..80b664dced --- /dev/null +++ b/doc/forum/How_do_I_get_rid_of_a_wrong_remote_uuid__63__/comment_1_b3c215cedba51fb47992ef10c60d6acc._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://alan.petitepomme.net/" + nickname="Alan Schmitt" + subject="comment 1" + date="2014-03-08T06:42:29Z" + content=""" +If it helps, I had a look at \"git annex vicfg\", and there is no mention of the extra UUID there. +"""]] diff --git a/doc/forum/How_do_I_get_rid_of_a_wrong_remote_uuid__63__/comment_2_85415e1fceb737919cc1cd9f37242458._comment b/doc/forum/How_do_I_get_rid_of_a_wrong_remote_uuid__63__/comment_2_85415e1fceb737919cc1cd9f37242458._comment new file mode 100644 index 0000000000..a251dade38 --- /dev/null +++ b/doc/forum/How_do_I_get_rid_of_a_wrong_remote_uuid__63__/comment_2_85415e1fceb737919cc1cd9f37242458._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 2" + date="2014-03-12T19:35:26Z" + content=""" +Probably this will fix it: + +`git annex dead 70582c7b-0b57-4087-a9d1-77b5f5f3c75e` +"""]] diff --git a/doc/forum/How_do_I_get_rid_of_a_wrong_remote_uuid__63__/comment_3_fb3a591dc60182f7922fc2b5c24f50f1._comment b/doc/forum/How_do_I_get_rid_of_a_wrong_remote_uuid__63__/comment_3_fb3a591dc60182f7922fc2b5c24f50f1._comment new file mode 100644 index 0000000000..bebd8f290d --- /dev/null +++ b/doc/forum/How_do_I_get_rid_of_a_wrong_remote_uuid__63__/comment_3_fb3a591dc60182f7922fc2b5c24f50f1._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="http://alan.petitepomme.net/" + nickname="Alan Schmitt" + subject="comment 3" + date="2014-03-13T20:05:53Z" + content=""" +Unfortunately git annex tells me there is no such remote: + + cody:games schmitta$ git annex dead 70582c7b-0b57-4087-a9d1-77b5f5f3c75e + dead 70582c7b-0b57-4087-a9d1-77b5f5f3c75e git-annex: there is no available git remote named \"70582c7b-0b57-4087-a9d1-77b5f5f3c75e\" +"""]] diff --git a/doc/forum/How_do_I_get_rid_of_a_wrong_remote_uuid__63__/comment_4_aed0be32e579c7a39c63aa7e3ec5f67b._comment b/doc/forum/How_do_I_get_rid_of_a_wrong_remote_uuid__63__/comment_4_aed0be32e579c7a39c63aa7e3ec5f67b._comment new file mode 100644 index 0000000000..99ac0d5a6a --- /dev/null +++ b/doc/forum/How_do_I_get_rid_of_a_wrong_remote_uuid__63__/comment_4_aed0be32e579c7a39c63aa7e3ec5f67b._comment @@ -0,0 +1,29 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 4" + date="2014-03-14T17:46:23Z" + content=""" +It seems that the git-annex branch's uuid.log must somehow not list this uuid, but it's used in the location tracking log files. + +The only way I can think of that this could happen is if you had set up a repository, run git-annex init, and then went in and changed the annex.uuid setting to this other uuid, and added files with that misconfiguration. Does that sound like what happened? + +The fix is just as evil as the cause -- you can edit .git/config to add a new, dummy git remote that has annex-uuid set to the problem uuid, and then `git-annex dead` can be used to kill the uuid via that remote. For example: + +[[!format sh \"\"\" +joey@darkstar:~/tmp/x>git annex whereis eep +whereis eep (1 copy) + 00000a6d-e770-4ab9-a640-7d6272e9ffff +ok +joey@darkstar:~/tmp/x>git annex dead 00000a6d-e770-4ab9-a640-7d6272e9ffff +dead 00000a6d-e770-4ab9-a640-7d6272e9ffff git-annex: there is no available git remote named \"00000a6d-e770-4ab9-a640-7d6272e9ffff\" +- exit 1 +joey@darkstar:~/tmp/x>git remote add dummy dummy +joey@darkstar:~/tmp/x>git config remote.dummy.annex-uuid 00000a6d-e770-4ab9-a640-7d6272e9ffff +joey@darkstar:~/tmp/x>git annex dead dummy +dead dummy ok +(Recording state in git...) +joey@darkstar:~/tmp/x>git annex whereis eep +whereis eep (0 copies) failed +\"\"\"]] +"""]] diff --git a/doc/forum/How_do_I_get_rid_of_a_wrong_remote_uuid__63__/comment_5_0c9a6c8a92d6c6e04ae3a8349b799c60._comment b/doc/forum/How_do_I_get_rid_of_a_wrong_remote_uuid__63__/comment_5_0c9a6c8a92d6c6e04ae3a8349b799c60._comment new file mode 100644 index 0000000000..9807fb7d9f --- /dev/null +++ b/doc/forum/How_do_I_get_rid_of_a_wrong_remote_uuid__63__/comment_5_0c9a6c8a92d6c6e04ae3a8349b799c60._comment @@ -0,0 +1,22 @@ +[[!comment format=mdwn + username="http://alan.petitepomme.net/" + nickname="Alan Schmitt" + subject="comment 5" + date="2014-03-14T18:11:52Z" + content=""" +Thanks, it worked! + +Regarding how I got into that state, here is what happened: +- I configured a new repository (git init, git annex init) on machine B +- I added that repository as a remote from machine A +- I started pushing files from machine A to machine B, starting with the file that later showed this problem +- I then noticed that, although the files were said to be successfully sent, I could not see them on machine B (no symbolic link was created), even after a \"git annex sync\" there +- I decided to start over, deleting the annex, and creating it from a clone of an existing annex +- This resulted in a duplicated UUID for the same path, which led to this problem + +Maybe some documentation on how to cleanly start over when things get in a bad state would be very useful. + +Thanks again, + +Alan +"""]] diff --git a/doc/forum/Import_options.txt b/doc/forum/Import_options.mdwn similarity index 100% rename from doc/forum/Import_options.txt rename to doc/forum/Import_options.mdwn diff --git a/doc/forum/Problems_with_large_numbers_of_files/comment_8_0070d1fbb643380b92bd974564fb9702._comment b/doc/forum/Problems_with_large_numbers_of_files/comment_8_0070d1fbb643380b92bd974564fb9702._comment deleted file mode 100644 index 8976942bf3..0000000000 --- a/doc/forum/Problems_with_large_numbers_of_files/comment_8_0070d1fbb643380b92bd974564fb9702._comment +++ /dev/null @@ -1,27 +0,0 @@ -[[!comment format=mdwn - username="https://www.google.com/accounts/o8/id?id=AItOawnFjuvfPpi1kf6l54bxfFUm0Aw_Gf_IO0o" - nickname="Aaron" - subject="Too big to fsck" - date="2014-02-17T22:33:38Z" - content=""" -Hi, - -My Webapp isn't working: -$ git-annex webapp -error: refs/gcrypt/gitception+ does not point to a valid object! -error: refs/remotes/Beta/git-annex does not point to a valid object! -error: refs/remotes/Beta/master does not point to a valid object! -fatal: unable to read tree 656e7db5be172f01c0b6994d01f1a08d1273af12 - -So I tried to repair it: -$ git-annex repair -Running git fsck ... -Stack space overflow: current size 8388608 bytes. -Use `+RTS -Ksize -RTS' to increase it. - -So I tried to follow your advice here and increase the stack: -$ git-annex +RTS -K35000000 -RTS fsck -git-annex: Most RTS options are disabled. Link with -rtsopts to enable them. - -I wasn't sure what to do next, so any help would be appreciated. -"""]] diff --git a/doc/forum/Purge_a_remote.txt b/doc/forum/Purge_a_remote.mdwn similarity index 100% rename from doc/forum/Purge_a_remote.txt rename to doc/forum/Purge_a_remote.mdwn diff --git a/doc/forum/Purge_a_remote/comment_2_dc65719157dee63b3979563ed57ee0ce._comment b/doc/forum/Purge_a_remote/comment_2_dc65719157dee63b3979563ed57ee0ce._comment index ddcab44dd9..86827c529a 100644 --- a/doc/forum/Purge_a_remote/comment_2_dc65719157dee63b3979563ed57ee0ce._comment +++ b/doc/forum/Purge_a_remote/comment_2_dc65719157dee63b3979563ed57ee0ce._comment @@ -1,4 +1,4 @@ -[[!comment format=txt +[[!comment format=mdwn username="https://www.google.com/accounts/o8/id?id=AItOawkzwmw_zyMpZC9_J7ey--woeYPoZkAOgGw" nickname="dxtrish" subject="comment 2" diff --git a/doc/forum/Sync_with_one_offline_peer.txt b/doc/forum/Sync_with_one_offline_peer.mdwn similarity index 100% rename from doc/forum/Sync_with_one_offline_peer.txt rename to doc/forum/Sync_with_one_offline_peer.mdwn diff --git a/doc/forum/USB_drive_in_transfer_group_keeps_growing_-_assistant.txt b/doc/forum/USB_drive_in_transfer_group_keeps_growing_-_assistant.mdwn similarity index 100% rename from doc/forum/USB_drive_in_transfer_group_keeps_growing_-_assistant.txt rename to doc/forum/USB_drive_in_transfer_group_keeps_growing_-_assistant.mdwn diff --git a/doc/forum/XBMC__44___NFS___38___git-annex_.txt b/doc/forum/XBMC__44___NFS___38___git-annex_.mdwn similarity index 100% rename from doc/forum/XBMC__44___NFS___38___git-annex_.txt rename to doc/forum/XBMC__44___NFS___38___git-annex_.mdwn diff --git a/doc/forum/central_non-bare_and_git_push.txt b/doc/forum/central_non-bare_and_git_push.mdwn similarity index 100% rename from doc/forum/central_non-bare_and_git_push.txt rename to doc/forum/central_non-bare_and_git_push.mdwn diff --git a/doc/forum/drop_old_versions_of_a_file.mdwn b/doc/forum/drop_old_versions_of_a_file.mdwn new file mode 100644 index 0000000000..95f103dcc9 --- /dev/null +++ b/doc/forum/drop_old_versions_of_a_file.mdwn @@ -0,0 +1,3 @@ +I have a music repository which has multiple versions of a music file(modified id3 tags etc,.) and in my music player same file is showing two times with two different id3 tags, one is from music directory and another is from .git-annex directory which is a older version(which I don't want to see). + +I was just wondering if there is a way I can drop old version of a file in android(direct mode). diff --git a/doc/forum/drop_old_versions_of_a_file/comment_1_799a413248fb8f98efbf226b1bc4300d._comment b/doc/forum/drop_old_versions_of_a_file/comment_1_799a413248fb8f98efbf226b1bc4300d._comment new file mode 100644 index 0000000000..09b01c8a8c --- /dev/null +++ b/doc/forum/drop_old_versions_of_a_file/comment_1_799a413248fb8f98efbf226b1bc4300d._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="108.236.230.124" + subject="comment 1" + date="2014-03-10T17:59:01Z" + content=""" +What you're looking for is `git annex unused` and `git annex dropunused` +"""]] diff --git a/doc/forum/git-annex_on_osx_10.9.1_just_crashes__47__closes__47__doesn__39__t_run_on_launch/comment_2_567bb460cec7cd2135386acf4e7dceb4._comment b/doc/forum/git-annex_on_osx_10.9.1_just_crashes__47__closes__47__doesn__39__t_run_on_launch/comment_2_567bb460cec7cd2135386acf4e7dceb4._comment new file mode 100644 index 0000000000..21141e45e7 --- /dev/null +++ b/doc/forum/git-annex_on_osx_10.9.1_just_crashes__47__closes__47__doesn__39__t_run_on_launch/comment_2_567bb460cec7cd2135386acf4e7dceb4._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.146" + subject="comment 2" + date="2014-03-07T15:17:50Z" + content=""" +Probably this was because the OSX build was missing the webapp. Fixed now. +"""]] diff --git a/doc/forum/git_annex_get_--want-get_another__95__repo.mdwn b/doc/forum/git_annex_get_--want-get_another__95__repo.mdwn new file mode 100644 index 0000000000..4ed0878766 --- /dev/null +++ b/doc/forum/git_annex_get_--want-get_another__95__repo.mdwn @@ -0,0 +1,68 @@ +Hi, + +Git-annex is really awesome. It has made my life really easier when having to +move files around. + +Yet, I have been struggling with a use case that I cannot get working with git +annex. + +In short, my request is: could it be possible to have --want-get and --want-drop +accept a repository as argument to match the preferred content of that +repository instead of here? + +Now, let me explain why I need this:a + +All my files are stored into a NAS accessible via a local network. + +I have an annex in my desktop computer. Using preferred content (via "git annex +wanted") and "git annex get|drop --auto", I am able to almost automatically +handle what files are put into my computer. What I do is to "git annex wanted" +to indicate what I want to be here and launch a home made script that basically +does "git annex get --auto" and "git annex drop --auto". + +Let's say I have a android phone to which I connect via ssh over adb. It +contains a git repository but few files are in it. It has no wifi and so no +access to the network, meaning no access to the NAS. + +The links between annexes then looks like: + + NAS <-> Computer <-> Phone + +When I want to put a file into my phone, I generally launch "git annex get file" +from my computer (then I get the file from the NAS) and "git annex copy --to +phone file". + +I want to be able to automatise this a bit by playing with preferred content +(like I do with my computer). This means that I want to launch "git annex +wanted" to edit the preferred content of the phone annex and then "git annex get +--auto" and launch "git annex copy --auto --to phone". This way, when I am not +in front of my computer, I can still from my phone run "git annex wanted here +'preferred content'" and hope for my synchronisation scripts (run in my +computer) to put the good files into my phone. + +Obviously those commands won't work since the git annex get --auto command will +only get what my computer wants, not what my phone wants. + +The intuitive (IMHO) way to do would be to launch: + + git annex get --want-get phone + git annex copy --auto --to phone + git annex drop --auto + +With "--want-get repository" meaning, "Matches files that the preferred content +settings for the repository make it want to get.". + +For the time being, I succeed in doing this with + + OLD_WANTED=$(git annex wanted here) + git annex wanted here $(git annex wanted phone) + git annex copy --auto --to phone + git annex wanted ${OLD_WANTED} + git annex drop --auto + +This is complicated and adds two extra commits in the git-annex branch (one for +each setting of git annex wanted) each time I call the script. + +What do you think? + +Thanks for reading. diff --git a/doc/forum/git_annex_get_--want-get_another__95__repo/comment_1_0be0b3981ddd0743ff26cf6d396e521d._comment b/doc/forum/git_annex_get_--want-get_another__95__repo/comment_1_0be0b3981ddd0743ff26cf6d396e521d._comment new file mode 100644 index 0000000000..7a58e35d62 --- /dev/null +++ b/doc/forum/git_annex_get_--want-get_another__95__repo/comment_1_0be0b3981ddd0743ff26cf6d396e521d._comment @@ -0,0 +1,16 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 1" + date="2014-03-12T17:15:23Z" + content=""" +Well, I suppose this is doable, but the way this scenario is generally handled is to make a transfer repository (which your desktop is serving as here) have a preferred content expression that makes it want files that the client repositories (phones) want, until the files have reached the clients: + +In your case you could have: + + (not inallgroup=phones and ($phone_preferred_content)) or ($desktop_preferred_content) + +Where `$desktop_preferred_content` is whatever files the desktop actually wants on its own, and `$phone_preferred_content` is a copy of the preferred content setting for the phone. + +To make this work, you also need to put your phone in the phones group. +"""]] diff --git a/doc/forum/git_annex_get_--want-get_another__95__repo/comment_2_b1ead1085a87818625579bf1ef151b5d._comment b/doc/forum/git_annex_get_--want-get_another__95__repo/comment_2_b1ead1085a87818625579bf1ef151b5d._comment new file mode 100644 index 0000000000..1f8ce270e8 --- /dev/null +++ b/doc/forum/git_annex_get_--want-get_another__95__repo/comment_2_b1ead1085a87818625579bf1ef151b5d._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 2" + date="2014-03-12T17:16:59Z" + content=""" +BTW expressing this in the preferred content as above also has the benefit that you can use the new `git annex sync --content` on the desktop and it will automatically get files, copy the right ones to the phone, and drop any then-unwanted files. +"""]] diff --git a/doc/forum/git_annex_get_--want-get_another__95__repo/comment_3_cf2018852c84b0bf1ac061def6f0ac5d._comment b/doc/forum/git_annex_get_--want-get_another__95__repo/comment_3_cf2018852c84b0bf1ac061def6f0ac5d._comment new file mode 100644 index 0000000000..c6bd20e1ff --- /dev/null +++ b/doc/forum/git_annex_get_--want-get_another__95__repo/comment_3_cf2018852c84b0bf1ac061def6f0ac5d._comment @@ -0,0 +1,27 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawm3vKzS4eOWYpKMoYXqMIjNsIg_nYF-loU" + nickname="Konubinix" + subject="That does it but not totally" + date="2014-03-13T11:36:02Z" + content=""" +I agree with the fact that it answers my initial question. + +Nevertheless, I guess it is really annoying to have to change the preferred content in two locations each time I change want to modify what is on my phone. +Indeed, I quite often change what should be really present on my phone, depending on several factors (my mood, the time I will have in transports and the phase of the moon). + +The reason why I use \"git annex wanted\" is that it is straightforward: I just launch : \"git annex wanted phone include=some/file\" and that's all. + +With the solution you propose, I would have to each time additionally launch \"git annex wanted here '(not inallgroup=phones and (include=some/file)) or ($desktop_preferred_content)'\" + +Where I probably have to previously launch \"git annex wanted here\" to remember what is the preferred content of my computer (and put it in $desktop_preferred_content). + +Another option would be to run \"git annex vicfg\" and edit both fields manually, but IMHO this appears also to be too complicated relatively to the use case. + +About your second comment, I really enjoy the idea if \"git annex sync --content\", but it is really long in big repositories. I guess it is because I cannot restrict the command to a directory like I do with get, drop, move and copy. + +Besides, the use case wants to get the files whenever they are and copy them only to the phone. With git annex sync --content, the files are also put in the other repositories. + +For the time being, I prefer falling back to explicit commands that are much faster when I know a directory to sync \"git annex get --auto directory && git annex copy --auto --to phone directory\". + +For example, I just tried \"git annex sync --content phone\" and I killed it after 5 minutes and nothing was copied yet. With the set of two commands above, the synchronization of directory (get --to phone directory + drop --from here directory) took about 3 minutes. +"""]] diff --git a/doc/forum/git_annex_get_--want-get_another__95__repo/comment_4_22562e8f1f2f91b9f9a5939ec9006cb5._comment b/doc/forum/git_annex_get_--want-get_another__95__repo/comment_4_22562e8f1f2f91b9f9a5939ec9006cb5._comment new file mode 100644 index 0000000000..25624c2c04 --- /dev/null +++ b/doc/forum/git_annex_get_--want-get_another__95__repo/comment_4_22562e8f1f2f91b9f9a5939ec9006cb5._comment @@ -0,0 +1,38 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawm3vKzS4eOWYpKMoYXqMIjNsIg_nYF-loU" + nickname="Konubinix" + subject="Precision of the use case" + date="2014-03-13T11:47:59Z" + content=""" +I realized that the directory restriction described earlier is not clear. Let me explain it. + +Say I have a big repository of files with the following structure. + +A/... +B/... +C/... +D/D1/... +D/D2/... +D/D3/... + +Imagine that each of A, B, C and D contains a lot of files. + +Now imagine that I have often put in the preferred content of my phone files in one of D1, D2 or D3. (for instance, include=D/D1/*) + +I implicitly know that I can restrict the command to D, and I can rely on preferred content to know what file from D I have to put into my phone. + +Then, I can run + $ git annex get --auto D + $ git annex copy --auto --to phone D + $ git annex drop --auto D + +This in my use case takes 3 minutes. + +When I run + $ git annex sync --content phone + +git annex goes recursively through A, B and C and that takes a long time (much more than 3 minutes). This time is really wasted since I know I only want to sync files from D. + +I cannot test the behavior of \"git annex sync --content\", but if I restrict the sync to phone, will it take the files from the NAS to put them on the phone? +If I don't precise phone in the command line, it will try to sync with other repositories not in sync that I don't want to be in sync for the time being. +"""]] diff --git a/doc/forum/git_annex_on_osx_only_creating_symlinks__63____63__/comment_2_978fc11c463a457382fddd668cd1d0dd._comment b/doc/forum/git_annex_on_osx_only_creating_symlinks__63____63__/comment_2_978fc11c463a457382fddd668cd1d0dd._comment index e50e0b0739..b3a848ffe3 100644 --- a/doc/forum/git_annex_on_osx_only_creating_symlinks__63____63__/comment_2_978fc11c463a457382fddd668cd1d0dd._comment +++ b/doc/forum/git_annex_on_osx_only_creating_symlinks__63____63__/comment_2_978fc11c463a457382fddd668cd1d0dd._comment @@ -1,4 +1,4 @@ -[[!comment format=txt +[[!comment format=mdwn username="https://www.google.com/accounts/o8/id?id=AItOawkipQLNyt8RHREHpg2k5wdYeRSCCvSNSBg" nickname="Tim" subject="I had this same problem too" diff --git a/doc/forum/git_annex_with_local_apache_webdav_server/comment_2_d8e9237cf6e7f7558f836ba1352f5517._comment b/doc/forum/git_annex_with_local_apache_webdav_server/comment_2_d8e9237cf6e7f7558f836ba1352f5517._comment new file mode 100644 index 0000000000..2b60a9967e --- /dev/null +++ b/doc/forum/git_annex_with_local_apache_webdav_server/comment_2_d8e9237cf6e7f7558f836ba1352f5517._comment @@ -0,0 +1,13 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawm7hS2LGu4sLUxLMdBA16PAMcVO7CDJmjw" + nickname="Damien" + subject="comment 2" + date="2014-03-10T12:16:43Z" + content=""" +I'm curious if anyone has set this up using a local apache webdav server? + +I'm stuck and could use some insight. + +thanks +Damien +"""]] diff --git a/doc/forum/handling_MP3_metadata_changes.txt b/doc/forum/handling_MP3_metadata_changes.mdwn similarity index 100% rename from doc/forum/handling_MP3_metadata_changes.txt rename to doc/forum/handling_MP3_metadata_changes.mdwn diff --git a/doc/forum/handling_MP3_metadata_changes/comment_1_aa4955fd64ea5aa836f1a591e185c4a2._comment b/doc/forum/handling_MP3_metadata_changes/comment_1_aa4955fd64ea5aa836f1a591e185c4a2._comment new file mode 100644 index 0000000000..483c1fb78d --- /dev/null +++ b/doc/forum/handling_MP3_metadata_changes/comment_1_aa4955fd64ea5aa836f1a591e185c4a2._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 1" + date="2014-03-18T19:29:53Z" + content=""" +Check out [[metadata]] +"""]] diff --git a/doc/forum/lost_in_walkthrough....txt b/doc/forum/lost_in_walkthrough....mdwn similarity index 100% rename from doc/forum/lost_in_walkthrough....txt rename to doc/forum/lost_in_walkthrough....mdwn diff --git a/doc/forum/manual_update_of_.git__47__annex__47__objects.txt b/doc/forum/manual_update_of_.git__47__annex__47__objects.mdwn similarity index 100% rename from doc/forum/manual_update_of_.git__47__annex__47__objects.txt rename to doc/forum/manual_update_of_.git__47__annex__47__objects.mdwn diff --git a/doc/forum/multiple_repositories_single_backup.txt b/doc/forum/multiple_repositories_single_backup.mdwn similarity index 100% rename from doc/forum/multiple_repositories_single_backup.txt rename to doc/forum/multiple_repositories_single_backup.mdwn diff --git a/doc/forum/multiple_repositories_single_backup/comment_2_bbe19eec0969385a0d4682bf9e9de21a._comment b/doc/forum/multiple_repositories_single_backup/comment_2_bbe19eec0969385a0d4682bf9e9de21a._comment index 8b81d56f43..bac577ce99 100644 --- a/doc/forum/multiple_repositories_single_backup/comment_2_bbe19eec0969385a0d4682bf9e9de21a._comment +++ b/doc/forum/multiple_repositories_single_backup/comment_2_bbe19eec0969385a0d4682bf9e9de21a._comment @@ -1,4 +1,4 @@ -[[!comment format=txt +[[!comment format=mdwn username="https://www.google.com/accounts/o8/id?id=AItOawkNE-H4vEcbcGndxq5daT8qUb7yIf7r1OE" nickname="Łukasz" subject="comment 2" diff --git a/doc/forum/partial_synchronisation._android_phone.txt b/doc/forum/partial_synchronisation._android_phone.mdwn similarity index 100% rename from doc/forum/partial_synchronisation._android_phone.txt rename to doc/forum/partial_synchronisation._android_phone.mdwn diff --git a/doc/forum/sync_between_indirect_and_direct_mode.mdwn b/doc/forum/sync_between_indirect_and_direct_mode.mdwn new file mode 100644 index 0000000000..66833cbe51 --- /dev/null +++ b/doc/forum/sync_between_indirect_and_direct_mode.mdwn @@ -0,0 +1,6 @@ +I have a music repository(direct mode) in my Nexus 5 which I want to sync with remote repository(indirect mode). + +When I run 'git annex sync --content', it did not sync the content but when I changed remote repository to direct mode, content got synced. + +Do I need to set some configuration ? +Is it possible to sync content between direct and indirect mode repositories ? diff --git a/doc/forum/sync_between_indirect_and_direct_mode/comment_1_7efc0d79196675582571c05fdd133b53._comment b/doc/forum/sync_between_indirect_and_direct_mode/comment_1_7efc0d79196675582571c05fdd133b53._comment new file mode 100644 index 0000000000..7cbcd3c39b --- /dev/null +++ b/doc/forum/sync_between_indirect_and_direct_mode/comment_1_7efc0d79196675582571c05fdd133b53._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="108.236.230.124" + subject="comment 1" + date="2014-03-10T17:57:51Z" + content=""" +There is no difference between direct and indirect mode repositories when it comes to communication between repositories, so they can be used in any combination. +"""]] diff --git a/doc/forum/sync_between_indirect_and_direct_mode/comment_2_8ac84dbaf7a4d503497487cbdb1749d8._comment b/doc/forum/sync_between_indirect_and_direct_mode/comment_2_8ac84dbaf7a4d503497487cbdb1749d8._comment new file mode 100644 index 0000000000..42b5126271 --- /dev/null +++ b/doc/forum/sync_between_indirect_and_direct_mode/comment_2_8ac84dbaf7a4d503497487cbdb1749d8._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnDXvDvWTXmCqQ90ATTD4dV3Ii4YbnE8E0" + nickname="sys" + subject="git annex direct when not all content is in this repo" + date="2014-03-12T14:41:53Z" + content=""" +what does git annex direct do when all the content isn't available in the current repo (i am assuming it will leave symlinks for the missing content) +"""]] diff --git a/doc/forum/sync_between_indirect_and_direct_mode/comment_3_9acb237711669ec6046a8d07f9ed3b2c._comment b/doc/forum/sync_between_indirect_and_direct_mode/comment_3_9acb237711669ec6046a8d07f9ed3b2c._comment new file mode 100644 index 0000000000..f743487b2b --- /dev/null +++ b/doc/forum/sync_between_indirect_and_direct_mode/comment_3_9acb237711669ec6046a8d07f9ed3b2c._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 3" + date="2014-03-12T17:03:30Z" + content=""" +Direct mode does not require all content be present any more than indirect mode does, and missing content is represented the same in both modes, with broken symlinks. +"""]] diff --git a/doc/forum/workspace.xml_file_disappeared__44___broken_symlink_showed_up/comment_5_50526283b35997cece2f087507cdd4ee._comment b/doc/forum/workspace.xml_file_disappeared__44___broken_symlink_showed_up/comment_5_50526283b35997cece2f087507cdd4ee._comment new file mode 100644 index 0000000000..ebf175cf22 --- /dev/null +++ b/doc/forum/workspace.xml_file_disappeared__44___broken_symlink_showed_up/comment_5_50526283b35997cece2f087507cdd4ee._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.146" + subject="comment 5" + date="2014-03-06T18:22:31Z" + content=""" +Do you edit this file in multiple places? This could be an occurance of this bug: [[bugs/direct_mode_merge_can_overwrite_local,_non-annexed_files]] which is fixed in the latest release. + +If the program that writes the workspace.xml file did so by first deleting it, and then writing the new version, this could result in the assistant committing the deletion, which makes the new version a local, non-annexed file, and then if a pull is received that modified the file, I think the above bug could happen. + +You could tell if this was the case by looking at the git log of the directory containing the file, and see if it has been repeatedly deleted and added back to the repository. The git log snippet you pasted unfortunately does not let me tell this information. +"""]] diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 30494e95c0..32c8ec2662 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -302,7 +302,8 @@ subdirectories). * `webapp` Opens a web app, that allows easy setup of a git-annex repository, - and control of the git-annex assistant. + and control of the git-annex assistant. If the assistant is not + already running, it will be started. By default, the webapp can only be accessed from localhost, and running it opens a browser window. @@ -476,8 +477,8 @@ subdirectories). * `vicfg` Opens EDITOR on a temp file containing most of the above configuration - settings, and when it exits, stores any changes made back to the git-annex - branch. + settings, as well as a few others, and when it exits, stores any changes + made back to the git-annex branch. * `direct` @@ -704,12 +705,20 @@ subdirectories). # METADATA COMMANDS -* `metadata [path ...] [-s field=value -s field+=value -s field-=value ...]` +* `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. This sets metadata - for the specified file or files, or if run without any values, shows - the current metadata. + which each in turn have any number of values. + + This command can be used to set metadata, or show the currently set + metadata. + + To show current metadata, run without any -s parameters. The --json + option will enable json output. + + To only get the value(s) of a single field, use -g field. + The values will be output one per line, with no other output, so + this is suitable for use in a script. To set a field's value, removing any old value(s), use -s field=value. diff --git a/doc/install/cabal/comment_33_8d4dfc33cada6091c30d3a43ce404b8b._comment b/doc/install/cabal/comment_33_8d4dfc33cada6091c30d3a43ce404b8b._comment new file mode 100644 index 0000000000..8fab5a45f7 --- /dev/null +++ b/doc/install/cabal/comment_33_8d4dfc33cada6091c30d3a43ce404b8b._comment @@ -0,0 +1,21 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawn3p4i4lk_zMilvjnJ9sS6g2nerpgz0Fjc" + nickname="Matthias" + subject="Build failure" + date="2014-03-20T09:10:44Z" + content=""" +I followed the instructions and the invocation of + + cabal install git-annex --bindir=$HOME/bin -f\"-assistant -webapp -webdav -pairing -xmpp -dns\" + +resulted in the following error: + + Test.hs:107:41: Not in scope: `errMessage' + Failed to install git-annex-5.20140306 + cabal: Error: some packages failed to install: + git-annex-5.20140306 failed during the building phase. The exception was: + ExitFailure 1 + +I used the Haskell Platform for Mac OS X (10.8) + +"""]] diff --git a/doc/install/cabal/comment_34_38451e751add6daf479b559c4b6a7c61._comment b/doc/install/cabal/comment_34_38451e751add6daf479b559c4b6a7c61._comment new file mode 100644 index 0000000000..619e790129 --- /dev/null +++ b/doc/install/cabal/comment_34_38451e751add6daf479b559c4b6a7c61._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://openid.stackexchange.com/user/a05bb829-932b-49f2-85a9-00dcda8b5e20" + nickname="Christian Pietsch" + subject="Re: Build failure" + date="2014-03-20T13:56:16Z" + content=""" +I get exactly the same error message as Matthias when attempting the minimal Cabal install on openSUSE 12.2 (x86_64) Linux. +"""]] diff --git a/doc/install/cabal/comment_35_4d44e4531e6686bd340f26836ad40026._comment b/doc/install/cabal/comment_35_4d44e4531e6686bd340f26836ad40026._comment new file mode 100644 index 0000000000..899e4fc01c --- /dev/null +++ b/doc/install/cabal/comment_35_4d44e4531e6686bd340f26836ad40026._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.102" + subject="comment 35" + date="2014-03-20T16:06:22Z" + content=""" +The `errMessage` build failure is due to a new version of optparse-applicative. I've added support for it in git master. +"""]] diff --git a/doc/install/cabal/comment_5_8789fc27466714faa5a3a7a6b8ec6e5d._comment b/doc/install/cabal/comment_5_8789fc27466714faa5a3a7a6b8ec6e5d._comment index 52606082e1..59bdbdd13c 100644 --- a/doc/install/cabal/comment_5_8789fc27466714faa5a3a7a6b8ec6e5d._comment +++ b/doc/install/cabal/comment_5_8789fc27466714faa5a3a7a6b8ec6e5d._comment @@ -1,4 +1,4 @@ -[[!comment format=txt +[[!comment format=mdwn username="https://www.google.com/accounts/o8/id?id=AItOawnaH44G3QbxBAYyDwy0PbvL0ls60XoaR3Y" nickname="Nigel" subject="Re: Comment 3" diff --git a/doc/install/fromscratch.mdwn b/doc/install/fromscratch.mdwn index 3843c31fa9..46ee5a055d 100644 --- a/doc/install/fromscratch.mdwn +++ b/doc/install/fromscratch.mdwn @@ -3,65 +3,16 @@ quite a lot. * Haskell stuff * [The Haskell Platform](http://haskell.org/platform/) (GHC 7.4 or newer) - * [mtl](http://hackage.haskell.org.package/mtl) (2.1.1 or newer) - * [MissingH](http://github.com/jgoerzen/missingh/wiki) - * [data-default](http://hackage.haskell.org/package/data-default) - * [utf8-string](http://hackage.haskell.org/package/utf8-string) - * [SHA](http://hackage.haskell.org/package/SHA) - * [cryptohash](http://hackage.haskell.org/package/cryptohash) (optional but recommended) - * [dataenc](http://hackage.haskell.org/package/dataenc) - * [monad-control](http://hackage.haskell.org/package/monad-control) - * [QuickCheck 2](http://hackage.haskell.org/package/QuickCheck) - * [json](http://hackage.haskell.org/package/json) - * [aeson](http://hackage.haskell.org/package/aeson) - * [IfElse](http://hackage.haskell.org/package/IfElse) - * [dlist](http://hackage.haskell.org/package/dlist) - * [bloomfilter](http://hackage.haskell.org/package/bloomfilter) - * [edit-distance](http://hackage.haskell.org/package/edit-distance) - * [hS3](http://hackage.haskell.org/package/hS3) (optional) - * [DAV](http://hackage.haskell.org/package/DAV) (optional) - * [SafeSemaphore](http://hackage.haskell.org/package/SafeSemaphore) - * [UUID](http://hackage.haskell.org/package/uuid) - * [regex-tdfa](http://hackage.haskell.org/package/regex-tdfa) - * [extensible-exceptions](http://hackage.haskell.org/package/extensible-exceptions) - * [feed](http://hackage.haskell.org/package/feed) - * [async](http://hackage.haskell.org/package/async) - * [case-insensitive](http://hackage.haskell.org/package/case-insensitive) - * [stm](http://hackage.haskell.org/package/stm) - (version 2.3 or newer) -* Optional haskell stuff, used by the [[assistant]] and its webapp - * [hinotify](http://hackage.haskell.org/package/hinotify) - (Linux only) - * [dbus](http://hackage.haskell.org/package/dbus) - * [yesod](http://hackage.haskell.org/package/yesod) - * [yesod-static](http://hackage.haskell.org/package/yesod-static) - * [yesod-default](http://hackage.haskell.org/package/yesod-default) - * [data-default](http://hackage.haskell.org/package/data-default) - * [http-types](http://hackage.haskell.org/package/http-types) - * [wai](http://hackage.haskell.org/package/wai) - * [wai-logger](http://hackage.haskell.org/package/wai-logger) - * [warp](http://hackage.haskell.org/package/warp) - * [warp-tls](http://hackage.haskell.org/package/warp-tls) - * [blaze-builder](http://hackage.haskell.org/package/blaze-builder) - * [crypto-api](http://hackage.haskell.org/package/crypto-api) - * [hamlet](http://hackage.haskell.org/package/hamlet) - * [clientsession](http://hackage.haskell.org/package/clientsession) - * [network-multicast](http://hackage.haskell.org/package/network-multicast) - * [network-info](http://hackage.haskell.org/package/network-info) - * [network-protocol-xmpp](http://hackage.haskell.org/package/network-protocol-xmpp) - * [dns](http://hackage.haskell.org/package/dns) - * [xml-types](http://hackage.haskell.org/package/xml-types) - * [HTTP](http://hackage.haskell.org/package/HTTP) - * [unix-compat](http://hackage.haskell.org/package/unix-compat) - * [MonadCatchIO-transformers](http://hackage.haskell.org/package/MonadCatchIO-transformers) + * A ton of haskell libraries. Rather than try to list them all here, + see git-annex.cabal. Probably the easiest way to install them: + `cabal update; cabal install git-annex --only-dependencies` * Shell commands - * [git](http://git-scm.com/) (1.7.2 or newer; 1.8.5 recommended) + * [git](http://git-scm.com/) (1.7.2 or newer; 1.8.5 or newer recommended) * [xargs](http://savannah.gnu.org/projects/findutils/) * [rsync](http://rsync.samba.org/) * [curl](http://http://curl.haxx.se/) (optional, but recommended) * [wget](http://www.gnu.org/software/wget/) (optional) - * [sha1sum](ftp://ftp.gnu.org/gnu/coreutils/) (optional, but recommended; - a sha1 command will also do) + * [sha*sum](ftp://ftp.gnu.org/gnu/coreutils/) (optional) * [gpg](http://gnupg.org/) (optional; needed for encryption) * [lsof](ftp://lsof.itap.purdue.edu/pub/tools/unix/lsof/) (optional; recommended for watch mode) diff --git a/doc/internals.mdwn b/doc/internals.mdwn index 4e003d9bc1..0c5124d0b9 100644 --- a/doc/internals.mdwn +++ b/doc/internals.mdwn @@ -150,6 +150,15 @@ Files matching the expression are preferred to be retained in the repository, while files not matching it are preferred to be stored somewhere else. +## `group-preferred-content.log` + +Contains standard preferred content settings for groups. (Overriding or +supplimenting the ones built into git-annex.) + +The file format is one line per group, staring with a timestamp, then a +space, then the group name followed by a space and then the preferred +content expression. + ## `aaa/bbb/*.log` These log files record [[location_tracking]] information diff --git a/doc/logo_16x16.png b/doc/logo_16x16.png new file mode 100644 index 0000000000..c98663d57d Binary files /dev/null and b/doc/logo_16x16.png differ diff --git a/doc/logo_32x32.png b/doc/logo_32x32.png new file mode 100644 index 0000000000..9075cc2b61 Binary files /dev/null and b/doc/logo_32x32.png differ diff --git a/doc/metadata.mdwn b/doc/metadata.mdwn index df873c4c1e..9f3c314fa2 100644 --- a/doc/metadata.mdwn +++ b/doc/metadata.mdwn @@ -23,12 +23,17 @@ The field names are limited to alphanumerics (and `[_-.]`), and are case insensitive. The metadata values can contain absolutely anything you like -- but you're recommended to keep it simple and reasonably short. -Here are some recommended metadata fields to use: +Here are some metadata fields that git-annex has special support for: * `tag` - With each tag being a different value. * `year`, `month` - When this particular version of the file came into being. - +* `$field-lastchanged` - This is automatically maintained for each + field that's set, and gives the date and time of the most recent + change to the field. It cannot be modified directly. +* `lastchanged` - This is automatically maintained, giving the data and time + of the last change to any of the metadata of a file. + To make git-annex automatically set the year and month when adding files, run `git config annex.genmetadata true`. Also, see [[tips/automatically_adding_metadata]]. diff --git a/doc/metadata/comment_1_d367fdaf0425b59d694bf16059d47192._comment b/doc/metadata/comment_1_d367fdaf0425b59d694bf16059d47192._comment new file mode 100644 index 0000000000..8fb93442c7 --- /dev/null +++ b/doc/metadata/comment_1_d367fdaf0425b59d694bf16059d47192._comment @@ -0,0 +1,9 @@ +[[!comment format=mdwn + username="bremner" + ip="198.164.160.48" + subject="access metadata by key?" + date="2014-03-17T01:26:44Z" + content=""" +I'm hacking around with using metadata from an external special remote. Those work with keys, not files, so one option would be to add a GETMETADATA to the protocol. It also seems like it would not be too hard to add +an option to \"git annex metadata\" to take a key rather than a file. +"""]] diff --git a/doc/metadata/comment_2_e15d2b5a405db4ccdb91d6aad4a22983._comment b/doc/metadata/comment_2_e15d2b5a405db4ccdb91d6aad4a22983._comment new file mode 100644 index 0000000000..1fd5a9fe1f --- /dev/null +++ b/doc/metadata/comment_2_e15d2b5a405db4ccdb91d6aad4a22983._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 2" + date="2014-03-17T19:32:39Z" + content=""" +I've made `git annex metadata --key` work. + +I'll wait and see what you come up with your special remote and add something to the protocol later if it makes sense. +"""]] diff --git a/doc/news/version_5.20140306.mdwn b/doc/news/version_5.20140306.mdwn new file mode 100644 index 0000000000..ef302495b9 --- /dev/null +++ b/doc/news/version_5.20140306.mdwn @@ -0,0 +1,34 @@ +git-annex 5.20140306 released with [[!toggle text="these changes"]] +[[!toggleable text=""" + * sync: Fix bug in direct mode that caused a file that was not + checked into git to be deleted when there was a conflicting + merge with a remote. + * webapp: Now supports HTTPS. + * webapp: No longer supports a port specified after --listen, since + it was buggy, and that use case is better supported by setting up HTTPS. + * annex.listen can be configured, instead of using --listen + * annex.startupscan can be set to false to disable the assistant's startup + scan. + * Probe for quvi version at run time. + * webapp: Filter out from Switch Repository list any + repositories listed in autostart file that don't have a + git directory anymore. (Or are bare) + * webapp: Refuse to start in a bare git repository. + * assistant --autostart: Refuse to start in a bare git repository. + * webapp: Don't list the public repository group when editing a + git repository; it only makes sense for special remotes. + * view, vfilter: Add support for filtering tags and values out of a view, + using !tag and field!=value. + * vadd: Allow listing multiple desired values for a field. + * view: Refuse to enter a view when no branch is currently checked out. + * metadata: To only set a field when it's not already got a value, use + -s field?=value + * Run .git/hooks/pre-commit-annex whenever a commit is made. + * sync: Automatically resolve merge conflict between and annexed file + and a regular git file. + * glacier: Pass --region to glacier checkpresent. + * webdav: When built with a new enough haskell DAV (0.6), disable + the http response timeout, which was only 5 seconds. + * webapp: Include no-pty in ssh authorized\_keys lines. + * assistant: Smarter log file rotation, which takes free disk space + into account."""]] \ No newline at end of file diff --git a/doc/preferred_content.mdwn b/doc/preferred_content.mdwn index 6d1acfb0f3..af76a0e7b4 100644 --- a/doc/preferred_content.mdwn +++ b/doc/preferred_content.mdwn @@ -2,7 +2,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 -control over which repositories prefer to have which content. Configuring +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`, etc to do smarter things. @@ -11,12 +11,32 @@ Preferred content settings can be edited using `git annex vicfg`, or viewed and set at the command line with `git annex wanted`. Each repository can have its own settings, and other repositories will try to honor those settings when interacting with it. -So there's no local `.git/config` for preferred content settings. +(So there's no local `.git/config` for preferred content settings.) + +[[!template id=note text=""" +### [[quickstart|standard_groups]] + +Rather than writing your own preferred content expression, you can use +several standard ones included in git-annex that are tuned to cover different +common use cases. + +You do this by putting a repository in a group, +and simply setting its preferred content to "standard" to match whatever +is standard for that group. See [[standard_groups]] for a list. +"""]] The idea is that you write an expression that files are matched against. -If a file matches, it's preferred to have its content stored in the -repository. If it doesn't, it's preferred to drop its content from -the repository (if there are enough copies elsewhere). +If a file matches, the repository wants to store its content. +If it doesn't, the repository wants to drop its content +(if there are enough copies elsewhere to allow removing it). + +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" +will want to drop. The expressions are very similar to the matching options documented on the [[git-annex]] man page. At the command line, you can use those @@ -54,7 +74,7 @@ and use "copies=transfer:1" To decide if content should be dropped, git-annex evaluates the preferred content expression under the assumption that the content has *already* been -dropped. If the content would not be preferred then, the drop can be done. +dropped. If the content would not be wanted then, the drop can be done. So, for example, `copies=2` in a preferred content expression lets content be dropped only when there are currently 3 copies of it, including the repo it's being dropped from. This is different than running `git annex @@ -63,7 +83,7 @@ drop --copies=2`, which will drop files that currently have 2 copies. ### difference: "present" There's a special "present" keyword you can use in a preferred content -expression. This means that content is preferred if it's present, +expression. This means that content is wanted if it's present, and not otherwise. This leaves it up to you to use git-annex manually to move content around. You can use this to avoid preferred content settings from affecting a subdirectory. For example: @@ -71,7 +91,7 @@ settings from affecting a subdirectory. For example: auto/* or (include=ad-hoc/* and present) Note that `not present` is a very bad thing to put in a preferred content -expression. It'll make it prefer to get content that's not present, and +expression. It'll make it want to get content that's not present, and drop content that is present! Don't go there.. ### difference: "inpreferreddir" @@ -86,130 +106,64 @@ The name of the directory can be configured using (If no directory name is configured, it uses "public" by default.) -## testing preferred content settings +### difference: "standard" -To check at the command line which files are matched by preferred content -settings, you can use the --want-get and --want-drop options. +git-annex comes with some built-in preferred content expressions, that +can be used with repositories that are in some [[standard_groups]]. -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. +When a repository is in exactly one such group, you can use the "standard" +keyword in its preferred content expression, to match whatever content +the group's expression matches. +(If a repository is put into multiple standard +groups, "standard" will match anything.. so don't do that!) -## standard expressions +Most often, the whole preferred content expression is simply "standard". +But, you can do more complicated things, for example: +"`standard or include=otherdir/*`" -git-annex comes with some standard preferred content expressions, that can -be used with repositories that are in some pre-defined groups. To make a -repository use one of these, just set its preferred content expression -to "standard", and put it in one of these groups. +### difference: "groupwanted" -(Note that most of these standard expressions also make the repository -prefer any content that is only currently available on untrusted and -dead repositories. So if an untrusted repository gets connected, -any repository that can will back it up.) +The "groupwanted" keyword can be used to refer to a preferred content +expression that is associated with a group. This is like the "standard" +keyword, but you can set up groupwanted preferred content expressions +using `git annex vicfg`. -### client +Note that when writing a groupwanted preferred content expression, +you can use all of the keywords listed above, including "standard". +(But not "groupwanted".) -All content is preferred, unless it's for a file in a "archive" directory, -which has reached an archive repository, or is unused. +For example, to make a variant of the standard client preferred content +expression that does not want files in the "out" directory, you +could set `groupwanted client = standard and exclude=out/*`. +Then repositories that are in the client group and have their preferred +content expression set to "groupwanted" will use that, while +other client repositories that have their preferred content expression +set to "standard" will use the standard expression. -`(((exclude=*/archive/* and exclude=archive/*) or (not (copies=archive:1 or copies=smallarchive:1))) and not unused) or roughlylackingcopies=1` +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. -### transfer +## upgrades -Use for repositories that are used to transfer data between other -repositories, but do not need to retain data themselves. For -example, a repository on a server, or in the cloud, or a small -USB drive used in a sneakernet. +It's important that all clones of a repository can understand one-another's +preferred content expressions, especially when using the git-annex +assistant. So using newly added keywords can cause a problem if +an older version of git-annex is in use elsewhere. -The preferred content expression for these causes them to get and retain -data until all clients have a copy. +Before git-annex version 5.20140320, when git-annex saw a keyword it +did not understand, it defaulted to assuming *all* files were +preferred content. From version 5.20140320, git-annex has a nicer fallback +behavior: When it is unable to parse a preferred content expression, +it assumes all files that are currently present are preferred content. -`(not (inallgroup=client and copies=client:2) and ($client)` +Here are recent changes to preferred content expressions, and the version +they were added in. -(Where $client is a copy of the preferred content expression used for -clients.) - -The "copies=client:2" part of the above handles the case where -there is only one client repository. It makes a transfer repository -speculatively prefer content in this case, even though it as of yet -has nowhere to transfer it to. Presumably, another client repository -will be added later. - -### backup - -All content is preferred. - -`include=* or unused` - -### incremental backup - -Only prefers content that's not already backed up to another backup -or incremental backup repository. - -`((include=* or unused) and (not copies=backup:1) and (not copies=incrementalbackup:1)) or approxlackingcopies=1` - -### small archive - -Only prefers content that's located in an "archive" directory, and -only if it's not already been archived somewhere else. - -`((include=*/archive/* or include=archive/*) and not (copies=archive:1 or copies=smallarchive:1)) or approxlackingcopies=1` - -### full archive - -All content is preferred, unless it's already been archived somewhere else. - -`(not (copies=archive:1 or copies=smallarchive:1)) or approxlackingcopies=1` - -Note that if you want to archive multiple copies (not a bad idea!), -you should instead configure all your archive repositories with a -version of the above preferred content expression with a larger -number of copies. - -### source - -Use for repositories where files are often added, but that do not need to -retain files for local use. For example, a repository on a camera, where -it's desirable to remove photos as soon as they're transferred elsewhere. - -The preferred content expression for these causes them to only retain -data until a copy has been sent to some other repository. - -`not (copies=1)` - -### manual - -This gives you nearly full manual control over what content is stored in the -repository. This allows using the [[assistant]] without it trying to keep a -local copy of every file. Instead, you can manually run `git annex get`, -`git annex drop`, etc to manage content. Only content that is present -is preferred. - -The exception to this manual control is that content that a client -repository would not want is not preferred. So, files in archive -directories are not preferred once their content has -reached an archive repository. - -`present and ($client)` - -(Where $client is a copy of the preferred content expression used for -clients.) - -### public - -This is used for publishing information to a repository that can be -publically accessed. Only files in a directory with a particular name -will be published. (The directory can be located anywhere in the -repository.) - -The name of the directory can be configured using -`git annex enableremote $remote preferreddir=$dirname` - -### unwanted - -Use for repositories that you don't want to exist. This will result -in any content on them being moved away to other repositories. (Works -best when the unwanted repository is also marked as untrusted or dead.) - -`exclude=*` +* "standard" 5.20140314 + (only when used in a more complicated expression; "standard" by + itself has been supported for a long time) +* "groupwanted=" 5.20140314 +* "metadata=" 5.20140221 +* "lackingcopies=", "approxlackingcopies=", "unused=" 5.20140127 +* "inpreferreddir=" 4.20130501 diff --git a/doc/preferred_content/standard_groups.mdwn b/doc/preferred_content/standard_groups.mdwn new file mode 100644 index 0000000000..dd73b669ff --- /dev/null +++ b/doc/preferred_content/standard_groups.mdwn @@ -0,0 +1,117 @@ +git-annex comes with some built-in [[preferred_content]] settings, that can +be used with repositories that are in special groups. To make a +repository use one of these, just set its preferred content expression +to "standard", and put it in one of these groups. + +(Note that most of these standard expressions also make the repository +want to get any content that is only currently available on untrusted and +dead repositories. So if an untrusted repository gets connected, +any repository that can will back it up.) + +### client + +All content is wanted, unless it's for a file in a "archive" directory, +which has reached an archive repository, or is unused. + +`(((exclude=*/archive/* and exclude=archive/*) or (not (copies=archive:1 or copies=smallarchive:1))) and not unused) or roughlylackingcopies=1` + +### transfer + +Use for repositories that are used to transfer data between other +repositories, but do not need to retain data themselves. For +example, a repository on a server, or in the cloud, or a small +USB drive used in a sneakernet. + +The preferred content expression for these causes them to get and retain +data until all clients have a copy. + +`not (inallgroup=client and copies=client:2) and ($client)` + +(Where $client is a copy of the preferred content expression used for +clients.) + +The "copies=client:2" part of the above handles the case where +there is only one client repository. It makes a transfer repository +speculatively prefer content in this case, even though it as of yet +has nowhere to transfer it to. Presumably, another client repository +will be added later. + +### backup + +All content is wanted. Even content of old/deleted files. + +`include=* or unused` + +### incremental backup + +Only wants content that's not already backed up to another backup +or incremental backup repository. + +`((include=* or unused) and (not copies=backup:1) and (not copies=incrementalbackup:1)) or approxlackingcopies=1` + +### small archive + +Only wants content that's located in an "archive" directory, and +only if it's not already been archived somewhere else. + +`((include=*/archive/* or include=archive/*) and not (copies=archive:1 or copies=smallarchive:1)) or approxlackingcopies=1` + +### full archive + +All content is wanted, unless it's already been archived somewhere else. + +`(not (copies=archive:1 or copies=smallarchive:1)) or approxlackingcopies=1` + +Note that if you want to archive multiple copies (not a bad idea!), +you can set `groupwanted archive` to a version of +the above preferred content expression with a larger number of copies +than 1. Then make the archive repositories have a preferred +content expression of "groupwanted" in order to use your modified +version. + +### source + +Use for repositories where files are often added, but that do not need to +retain files for local use. For example, a repository on a camera, where +it's desirable to remove photos as soon as they're transferred elsewhere. + +The preferred content expression for these causes them to only retain +data until a copy has been sent to some other repository. + +`not (copies=1)` + +### manual + +This gives you nearly full manual control over what content is stored in the +repository. This allows using the [[assistant]] without it trying to keep a +local copy of every file. Instead, you can manually run `git annex get`, +`git annex drop`, etc to manage content. Only content that is already +present is wanted. + +The exception to this manual control is that content that a client +repository would not want is not wanted. So, files in archive +directories are not wanted once their content has +reached an archive repository. + +`present and ($client)` + +(Where $client is a copy of the preferred content expression used for +clients.) + +### public + +This is used for publishing information to a repository that can be +publically accessed. Only files in a directory with a particular name +will be published. (The directory can be located anywhere in the +repository.) + +The name of the directory can be configured using +`git annex enableremote $remote preferreddir=$dirname` + +### unwanted + +Use for repositories that you don't want to exist. This will result +in any content on them being moved away to other repositories. (Works +best when the unwanted repository is also marked as untrusted or dead.) + +`exclude=*` diff --git a/doc/related_software.mdwn b/doc/related_software.mdwn index 66abad8df9..1b55796287 100644 --- a/doc/related_software.mdwn +++ b/doc/related_software.mdwn @@ -11,3 +11,4 @@ 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) diff --git a/doc/tips/googledriveannex/comment_1_ce7f2b04e83cc02d9dabb712f266e5cc._comment b/doc/tips/googledriveannex/comment_1_ce7f2b04e83cc02d9dabb712f266e5cc._comment new file mode 100644 index 0000000000..aac4a8e08c --- /dev/null +++ b/doc/tips/googledriveannex/comment_1_ce7f2b04e83cc02d9dabb712f266e5cc._comment @@ -0,0 +1,9 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmlnEK_po7A0xMC9Xdp0FdcBgYllsCORXM" + nickname="Johnny" + subject="Shared google drive on multiple hosts" + date="2014-03-14T16:40:11Z" + content=""" +I have now configured my Googledrive on Laptop1 according to the guide above, how do I add the same remote on Laptop2? It would be nice if this was described in the guide, include where the encryption keys are stored. + +"""]] diff --git a/doc/tips/what_to_do_when_you_lose_a_repository/comment_7_4e6baa41bfee6edf2b17d4ade2909c7b._comment b/doc/tips/what_to_do_when_you_lose_a_repository/comment_7_4e6baa41bfee6edf2b17d4ade2909c7b._comment new file mode 100644 index 0000000000..3b4b79da36 --- /dev/null +++ b/doc/tips/what_to_do_when_you_lose_a_repository/comment_7_4e6baa41bfee6edf2b17d4ade2909c7b._comment @@ -0,0 +1,16 @@ +[[!comment format=mdwn + username="http://alan.petitepomme.net/" + nickname="Alan Schmitt" + subject="still need to remove the remote after a "dead"" + date="2014-03-07T18:03:47Z" + content=""" +Hello, + +I decommissioned a machine and installed git annex on another machine, with the same IP as the initial one. To avoid errors, I declared the first repository as dead and created a new one (with a new remote). However, I also had to remove the git remote to the dead machine as \"git annex sync\" kept telling me synchronizing to this dead machine failed (the ssh succeeded, using the name automatically generated by git annex, but the repository was not at the same path on the new machine, so it could not find it). + +Should a dead repository not tried to be synchronized at all during git annex sync? + +Thanks, + +Alan +"""]] diff --git a/doc/forum/Feature_Request:_Sync_Now_Button_in_Webapp.mdwn b/doc/todo/Feature_Request:_Sync_Now_Button_in_Webapp.mdwn similarity index 86% rename from doc/forum/Feature_Request:_Sync_Now_Button_in_Webapp.mdwn rename to doc/todo/Feature_Request:_Sync_Now_Button_in_Webapp.mdwn index 01bec0e21d..e224215fc6 100644 --- a/doc/forum/Feature_Request:_Sync_Now_Button_in_Webapp.mdwn +++ b/doc/todo/Feature_Request:_Sync_Now_Button_in_Webapp.mdwn @@ -1 +1,3 @@ One Problem I am having is that I could never get the xmpp pairing to work so whenever I switch machines I have to manually run sync once on the command line to get the changes. Is it possible to have a sync now button of some sort that will trigger a sync on the repos? + +> moved from forum; [[done]] --[[Joey]] diff --git a/doc/todo/Feature_Request:_Sync_Now_Button_in_Webapp/comment_1_0d5c90eb0e8fe61b82a19c5fea343613._comment b/doc/todo/Feature_Request:_Sync_Now_Button_in_Webapp/comment_1_0d5c90eb0e8fe61b82a19c5fea343613._comment new file mode 100644 index 0000000000..a5f631d50f --- /dev/null +++ b/doc/todo/Feature_Request:_Sync_Now_Button_in_Webapp/comment_1_0d5c90eb0e8fe61b82a19c5fea343613._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnR6E5iUghMWdUGlbA9CCs8DKaoigMjJXw" + nickname="Efraim" + subject="comment 1" + date="2014-03-06T20:37:36Z" + content=""" +not quite a sync button, but when I want to force sync now I turn off and turn on sync for one of the repos from the webapp and then it syncs. +"""]] diff --git a/doc/todo/Feature_Request:_Sync_Now_Button_in_Webapp/comment_2_196552002d70390e8b52b4af61dca903._comment b/doc/todo/Feature_Request:_Sync_Now_Button_in_Webapp/comment_2_196552002d70390e8b52b4af61dca903._comment new file mode 100644 index 0000000000..41e05bf6ec --- /dev/null +++ b/doc/todo/Feature_Request:_Sync_Now_Button_in_Webapp/comment_2_196552002d70390e8b52b4af61dca903._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.146" + subject="comment 2" + date="2014-03-06T22:12:27Z" + content=""" +I've added a \"Sync now\" to the menu for each remote. So can be used to sync with an individual remote, or if picked from the menu for the local repository, it causes it to try to sync with every one if its remotes at once. +"""]] diff --git a/doc/todo/Wishlist:_additional_environment_variables_for_hooks/comment_1_d82cbbb478a81a651fbe6cb8b71c1192._comment b/doc/todo/Wishlist:_additional_environment_variables_for_hooks/comment_1_d82cbbb478a81a651fbe6cb8b71c1192._comment new file mode 100644 index 0000000000..4d0409d58e --- /dev/null +++ b/doc/todo/Wishlist:_additional_environment_variables_for_hooks/comment_1_d82cbbb478a81a651fbe6cb8b71c1192._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 1" + date="2014-03-18T19:36:08Z" + content=""" +Is this still relevant? +"""]] diff --git a/doc/todo/add_a_--branch_to_applicable_git-annex_commands.mdwn b/doc/todo/add_a_--branch_to_applicable_git-annex_commands.mdwn new file mode 100644 index 0000000000..b2678bee81 --- /dev/null +++ b/doc/todo/add_a_--branch_to_applicable_git-annex_commands.mdwn @@ -0,0 +1,2 @@ +My original use case was for using git-annex find from scripts, where I didn't want to depend on the branch +checked out at the time, but rather write something like "git annex find --branch=master $searchterms" diff --git a/doc/todo/add_a_--branch_to_applicable_git-annex_commands/comment_1_3e0a1d1c41f317514dfc496f2274ad1c._comment b/doc/todo/add_a_--branch_to_applicable_git-annex_commands/comment_1_3e0a1d1c41f317514dfc496f2274ad1c._comment new file mode 100644 index 0000000000..6d5320d41a --- /dev/null +++ b/doc/todo/add_a_--branch_to_applicable_git-annex_commands/comment_1_3e0a1d1c41f317514dfc496f2274ad1c._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 1" + date="2014-03-17T19:48:57Z" + content=""" +The difficulty with adding a --branch is that if it causes git-annex to operate on a list of (file, key) from the branch, then commands that actually modify the working tree would modify it, instead of the branch. So the options seem to be only generating a list of keys, and so only letting commands that operate on keys work (which rules out the `git annex find` example), or carefully arranging for commands that actually affect the work tree to not be usable with this option. + +I'm not sure how many commands are affected. The ones I can immediately think of are sync, lock, unlock. (Commands like get obviously affect the work tree in direct mode, but it's fine to have getting a file from a branch also update files in the work tree, if they pointed at the same key.) +"""]] diff --git a/doc/todo/add_an_icon_for_the_.desktop_file.mdwn b/doc/todo/add_an_icon_for_the_.desktop_file.mdwn index 3be158a0aa..56428ff4bc 100644 --- a/doc/todo/add_an_icon_for_the_.desktop_file.mdwn +++ b/doc/todo/add_an_icon_for_the_.desktop_file.mdwn @@ -1 +1,3 @@ Maybe add the icon /usr/share/doc/git-annex/html/logo.svg to the .desktp file. + +> [[done]] long ago.. --[[Joey]] diff --git a/doc/todo/assistant_parallel_file_transfers.txt b/doc/todo/assistant_parallel_file_transfers.mdwn similarity index 100% rename from doc/todo/assistant_parallel_file_transfers.txt rename to doc/todo/assistant_parallel_file_transfers.mdwn diff --git a/doc/todo/custom_f-droid_repo/comment_3_5a79abb8b1dd12426e111e733fa6493b._comment b/doc/todo/custom_f-droid_repo/comment_3_5a79abb8b1dd12426e111e733fa6493b._comment new file mode 100644 index 0000000000..dda348874d --- /dev/null +++ b/doc/todo/custom_f-droid_repo/comment_3_5a79abb8b1dd12426e111e733fa6493b._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmLB39PC89rfGaA8SwrsnB6tbumezj-aC0" + nickname="Tobias" + subject="comment 3" + date="2014-03-06T22:49:22Z" + content=""" +F-droid compiles all the binaries themselves internally. +"""]] diff --git a/doc/todo/openwrt_package.txt b/doc/todo/openwrt_package.mdwn similarity index 100% rename from doc/todo/openwrt_package.txt rename to doc/todo/openwrt_package.mdwn diff --git a/doc/todo/required_content/comment_1_42620a3c958666be2a0d5f5b8eadf7b4._comment b/doc/todo/required_content/comment_1_42620a3c958666be2a0d5f5b8eadf7b4._comment new file mode 100644 index 0000000000..7d490a9d75 --- /dev/null +++ b/doc/todo/required_content/comment_1_42620a3c958666be2a0d5f5b8eadf7b4._comment @@ -0,0 +1,23 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawl9sYlePmv1xK-VvjBdN-5doOa_Xw-jH4U" + nickname="Richard" + subject="comment 1" + date="2014-03-10T17:15:54Z" + content=""" +To give a specific example of what I want to do: + +I have a bunch of repos + +* A, Machine1 -- anchor repository and sometimes used to add new content +* B, Machine2 -- anchor repository, offsite +* C, External1 -- anchor repository, stored off-site +* D, Laptop -- transient repo to carry data around and to add new content +* E, USB1 -- transient, travel backups +* F, USB2 -- transient, travel backups + +A-C should get _all_ data. A-F trust A-C to always retain all data, online checks for availability are not needed because A-C run frequent fsck. Ideally, `git annex drop` should be no-op in A-C. + +D-F should retain data as long as it's not been saved in _all_ of A-C. As soon as A-C have copies, `git annex drop` in D-F should drop that content; before that, they _must not_ drop said content. + +Richard +"""]] diff --git a/doc/todo/required_content/comment_2_132ec6378db63af6281569cf5748b9d3._comment b/doc/todo/required_content/comment_2_132ec6378db63af6281569cf5748b9d3._comment new file mode 100644 index 0000000000..dece48c01b --- /dev/null +++ b/doc/todo/required_content/comment_2_132ec6378db63af6281569cf5748b9d3._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="partial implementation plan" + date="2014-03-19T16:37:05Z" + content=""" +* When there is a required content expression, OR it with the preferred content expression. This will make the assistant, --auto etc want to get required content. +* When checking if something can be dropped, check the required content expression. Only Command.Drop does this so nicely centralized in one place. +* When checking required content expression for drop, must do active verification of terminals that relate to other copies, for the same reason the numcopies check when dropping does active validation. This includes `copies=`, `lackingcopies=`, `approxlackingcopies=`, `inallgroup=`. + +The last is where the complication comes in. Seems to need a cache of places the key was just now verified to be present, which can be used to avoid unnecessary redundant active verification (for example \"not (copies=2 and inallgroup=bar)\" would otherwise redundantly check some remotes). The numcopies checking code should use the same cache too. + +* Finally, if the required content cannot be satisfied, it would be nice to know which terminal failed in order to show the user a useful error message. The current Matcher does not provide a way to do that though. Or could just say, \"unable to satisfy required content: $expression\" +"""]] diff --git a/doc/todo/union_mounting/comment_3_cf0a0d4fbd929f24f7056115b2acb7de._comment b/doc/todo/union_mounting/comment_3_cf0a0d4fbd929f24f7056115b2acb7de._comment new file mode 100644 index 0000000000..ae925adf05 --- /dev/null +++ b/doc/todo/union_mounting/comment_3_cf0a0d4fbd929f24f7056115b2acb7de._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://ypid.wordpress.com/" + nickname="ypid" + subject="Please add this ;)" + date="2014-03-13T19:10:17Z" + content=""" ++1 This would be so great. For me the only thing which is missing in this awesome project. +"""]] diff --git a/doc/todo/windows_support.mdwn b/doc/todo/windows_support.mdwn index 17accd62e5..0afcbb4fe1 100644 --- a/doc/todo/windows_support.mdwn +++ b/doc/todo/windows_support.mdwn @@ -29,6 +29,42 @@ now! --[[Joey]] * Deleting a git repository from inside the webapp fails "RemoveDirectory permision denied ... file is being used by another process" +## potential encoding problems + +[[bugs/Unicode_file_names_ignored_on_Windows]] is fixed, but some potential +problems remain, since the FileSystemEncoding that git-annex relies on +seems unreliable/broken on Windows. + +* When git-annex displays a filename that it's acting on, there + can be mojibake on Windows. For example, "háčky.txt" displays + the accented characters as instead the pairs of bytes making + up the utf-8. Tried doing various things to the stdout handle + to avoid this, but only ended up with encoding crashes, or worse + mojibake than this. + +* `md5FilePath` still uses the filesystem encoding, and so may produce the + wrong value on Windows. This would impact keys that contain problem characters + (probably coming from the filename extension), and might cause + interoperability problems when git-annex generates the hash directories of a + remote, for example a rsync remote. + +* `encodeW8` is used in Git.UnionMerge, and while I fixed the other calls to + encodeW8, which all involved ByteStrings reading from git and so can just + treat it as utf-8 on Windows (via `decodeBS`), in the union merge case, + the ByteString has no defined encoding. It may have been written on Unix + and contain keys with invalid unicode in them. On windows, the union + merge code should probably check if it's valid utf-8, and if not, + abort the merge. + +* If interoperating with a git-annex repository from a unix system, it's + possible for a key to contain some invalid utf-8, which means its filename + cannot even be represented on Windows, so who knows what will happen in that + case -- probably it will fail in some way when adding the object file + to the Windows repo. + +* If data from the git repo does not have a unicode encoding, it will be + mangled in various places on Windows, which can lead to undefined behavior. + ## minor problems * rsync special remotes with a rsyncurl of a local directory are known @@ -91,3 +127,5 @@ Options: of lots of yesod dependency chain to export modules referenced by TH splices, like had to be done on Android. Horrible pain. Ugly as hell. 2. Make a helper program with the XMPP support in it, that does not use TH. +3. Swich to a different XMPP client library, like + diff --git a/doc/todo/wishlist:_An_option_like_--git-dir.mdwn b/doc/todo/wishlist:_An_option_like_--git-dir.mdwn index cb9d374b39..0582d9892a 100644 --- a/doc/todo/wishlist:_An_option_like_--git-dir.mdwn +++ b/doc/todo/wishlist:_An_option_like_--git-dir.mdwn @@ -1,3 +1,5 @@ I'm currently integrating git-annex support into a filesystem synchronization tool that I use, and I have a use case where I'd like to run "git annex sync' on a local directory, and then automatically ssh over to remote hosts and run "git annex sync" in the related annex on that remote host. However, while I can easily "cd" on the local, there is no really easy way to "cd" on the remote without a hack. If I could say: git annex --annex-dir=PATH sync, where PATH is the annex directory, it would solve all my problems, and would also provide a nice correlation to the --git-dir option used by most Git commands. The basic idea is that I shouldn't have to be IN the directory to run git-annex commands, I should be able to tell git-annex which directory to apply its commands to. + +> AFAIK this is fully supported for some time, so [[done]] --[[Joey]] diff --git a/doc/todo/wishlist:_a_spec.remote_for_network_directories_that_would_mount_them_whenever_needed___40__e.g.__44___with_WebDAV__41__.mdwn b/doc/todo/wishlist:_a_spec.remote_for_network_directories_that_would_mount_them_whenever_needed___40__e.g.__44___with_WebDAV__41__.mdwn index f2c4254ad0..df589be932 100644 --- a/doc/todo/wishlist:_a_spec.remote_for_network_directories_that_would_mount_them_whenever_needed___40__e.g.__44___with_WebDAV__41__.mdwn +++ b/doc/todo/wishlist:_a_spec.remote_for_network_directories_that_would_mount_them_whenever_needed___40__e.g.__44___with_WebDAV__41__.mdwn @@ -23,3 +23,7 @@ whenever I wanted to update the revisions of the textbooks (or to download them So, this differs from [[tips/using box.com as a special remote]] in that the tip for WebDAV suggest to handle the mounting manually, and git-annex knows nothing about the WebDAV URL where the content comes from. So here's my wish: a [[special remote|special remotes]] to track the WebDAV URLs in the repo, and mount the remote directory automatically under the hood, whenever one wants to get a file from there. (Then I assume it should also unmount it immediately in order to clean up after itself, despite possible inefficiencies). + +> I think the hooks are enough.. If not, you can use a hook special remote +> or the external special remote protocol to make your own custom special +> remote. So, [[done]] --[[Joey]] diff --git a/doc/todo/wishlist:_assistant_autostart_port_and_secret_configuration.mdwn b/doc/todo/wishlist:_assistant_autostart_port_and_secret_configuration.mdwn index f0d27d0b1e..a1aec1d49d 100644 --- a/doc/todo/wishlist:_assistant_autostart_port_and_secret_configuration.mdwn +++ b/doc/todo/wishlist:_assistant_autostart_port_and_secret_configuration.mdwn @@ -1 +1,4 @@ When starting the assistant when logging in to the system (`--autostart`) it choses a new port an secret everytime. Having the assistant open in a pinned firefox tab which automatically restores when firefox starts we need to get the url from `.git/annex/url` and copy/paste it into the pinned tab. It would be very nice to have a configuration option which assigns a fixed port and secret so everytime the assistant is autostarted it uses the same settings and firefox is happy to open it automatically on start. + +> Closing, I've removed the option to choose webapp ports entirely. +> [[done]] --[[Joey]] diff --git a/doc/todo/wishlist:_define_remotes_that_must_have_all_files.mdwn b/doc/todo/wishlist:_define_remotes_that_must_have_all_files.mdwn index 156cfb0090..a3beaadae7 100644 --- a/doc/todo/wishlist:_define_remotes_that_must_have_all_files.mdwn +++ b/doc/todo/wishlist:_define_remotes_that_must_have_all_files.mdwn @@ -16,3 +16,7 @@ Based on existing output, this is what a warning message could look like: Warning What do you think? + +> I think that [[required_content]] will make it easy to configure +> such remotes, so this is another reason to build that. Closing +> this bug as a dup of that one; [[done]] --[[Joey]] diff --git a/doc/todo/wishlist:_git-annex_replicate.mdwn b/doc/todo/wishlist:_git-annex_replicate.mdwn index 0d926b3375..9ac6ade754 100644 --- a/doc/todo/wishlist:_git-annex_replicate.mdwn +++ b/doc/todo/wishlist:_git-annex_replicate.mdwn @@ -10,3 +10,13 @@ There might be the need to have a 'replication_priority' option for each remote * maxspace - A self imposed quota per remote machine. git-annex replicate should try to replicate files first to machines with more free space. maxspace would change the free space calculation to be `min(actual_free_space, maxspace - space_used_by_git_annex) * bandwidth - when replication files, copies should be done between machines with the highest available bandwidth. ( I think this option could be useful for git-annex get in general) + +> `git annex sync --content` handles this now. [[done]] +> +> You do need to run it, or the assistant, on each node that needs +> to copy files to spread them through the network. +> +> A `git annex rebalance` +> is essentially the same as sshing to the remote and running `git annex +> sync --content` there. Assuming the remote repository itself has enough +> remotes set up that git-annex is able to copy files around. --[[Joey]] diff --git a/doc/todo/wishlist:_git_annex_diff/comment_1_16ccf2e1036d9e1a913db81988731b5a._comment b/doc/todo/wishlist:_git_annex_diff/comment_1_16ccf2e1036d9e1a913db81988731b5a._comment new file mode 100644 index 0000000000..86772e2fdd --- /dev/null +++ b/doc/todo/wishlist:_git_annex_diff/comment_1_16ccf2e1036d9e1a913db81988731b5a._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 1" + date="2014-03-18T20:00:16Z" + content=""" +`git diff` is quite flexible; it can use external diff drivers to perform the diff. Someone could write a diff driver that knows about git-annex symlinks, and shows some kind of diff of the file contents (since the files are probably binary, this gets into how to display a diff of different file types..) +"""]] diff --git a/doc/todo/wishlist:_make_partial_files_available_during_transfer/comment_2_8b1cfae6f2b61929a9c6f48ae63c921d._comment b/doc/todo/wishlist:_make_partial_files_available_during_transfer/comment_2_8b1cfae6f2b61929a9c6f48ae63c921d._comment new file mode 100644 index 0000000000..c4c2224319 --- /dev/null +++ b/doc/todo/wishlist:_make_partial_files_available_during_transfer/comment_2_8b1cfae6f2b61929a9c6f48ae63c921d._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 2" + date="2014-03-18T20:08:13Z" + content=""" +There's now an easy way to do this: + + git annex find --include=* --format='.git/annex/tmp/${hashdirmixed}${key}/${key}\n' + +Pass it the file or files you're interested in to get their partially transferred contents. +"""]] diff --git a/doc/todo/wishlist:_metadata_metadata_view.mdwn b/doc/todo/wishlist:_metadata_metadata_view.mdwn new file mode 100644 index 0000000000..a4b243cdd7 --- /dev/null +++ b/doc/todo/wishlist:_metadata_metadata_view.mdwn @@ -0,0 +1,23 @@ +Currently looking at the metadata and views. + +One of the things I would like to do is have a view that shows files by metadata metadata.. for example, "when the file last had tags changed". + +Something along the lines of + + $ git annex view metadata-tag-mtime=YYYYMMDD + view (searching...) + + Switched to branch 'views/metadata/tag/mtime/YYYYMMDD' + ok + + $ ls + 20130816 + 20130921 + 20131015 + +This would allow me to review files that haven't had any tag changes applied for a while and thus, may need the tags updating. + +I've done this in every tagging system I've used by (ab)using mtime, but that requires an additional step (of touching the file). + +> [[done]]; "$field-lastchanged" is automatically made available for each +> field! --[[Joey]] diff --git a/doc/todo/wishlist:_metadata_metadata_view/comment_1_79dbf48cf2e0d649f32bd077f0c9bc5a._comment b/doc/todo/wishlist:_metadata_metadata_view/comment_1_79dbf48cf2e0d649f32bd077f0c9bc5a._comment new file mode 100644 index 0000000000..126a9148c8 --- /dev/null +++ b/doc/todo/wishlist:_metadata_metadata_view/comment_1_79dbf48cf2e0d649f32bd077f0c9bc5a._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 1" + date="2014-03-18T17:09:55Z" + content=""" +I think this would be pretty easy to do actually. No need to trawl through git history to find when a field changed; the metadata log file format includes the timestamp when a line was changed, so it would only need to find the newest timestamp for the field in the current version of the file. +"""]] diff --git a/doc/todo/wishlist:_metadata_metadata_view/comment_2_5763d0e403c476ac692c1cd50630f824._comment b/doc/todo/wishlist:_metadata_metadata_view/comment_2_5763d0e403c476ac692c1cd50630f824._comment new file mode 100644 index 0000000000..8b3fc31086 --- /dev/null +++ b/doc/todo/wishlist:_metadata_metadata_view/comment_2_5763d0e403c476ac692c1cd50630f824._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="Xyem" + ip="87.194.19.134" + subject="comment 2" + date="2014-03-19T11:18:19Z" + content=""" +Can $field be a glob? i.e. * + +I'm looking for the files to be organised to the last change date to *any* metadata, not a specific field. + +For example, I may have added some vacation photos and set some metadata (location=Malta), a couple of months later, gone through and added metadata to some of them (person=Susan, event=Wedding Reception). 3 months later, I want to see a directory containing those that were initially added and metadata'd(?) with \"location=Malta\" and not touched since, and another showing those that had gotten additional metadata so I know which ones I should be looking at. +"""]] diff --git a/doc/todo/wishlist:_metadata_metadata_view/comment_3_797e6578c60d8e2ed1f61a8d6403575f._comment b/doc/todo/wishlist:_metadata_metadata_view/comment_3_797e6578c60d8e2ed1f61a8d6403575f._comment new file mode 100644 index 0000000000..aff5afbcf2 --- /dev/null +++ b/doc/todo/wishlist:_metadata_metadata_view/comment_3_797e6578c60d8e2ed1f61a8d6403575f._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.102" + subject="comment 3" + date="2014-03-19T23:14:24Z" + content=""" +I added a toplevel \"lastchanged\" that applies to all the fields. (Also when the last change was unsetting a field, the toplevel lastchanged will show the time of that which is otherwise not visible by collecting the lastchanged-* fields). +"""]] diff --git a/doc/todo/wishlist:_metadata_metadata_view/comment_4_d271fe711b3fe5ffeb52f1caf44622b3._comment b/doc/todo/wishlist:_metadata_metadata_view/comment_4_d271fe711b3fe5ffeb52f1caf44622b3._comment new file mode 100644 index 0000000000..4bc147c4e7 --- /dev/null +++ b/doc/todo/wishlist:_metadata_metadata_view/comment_4_d271fe711b3fe5ffeb52f1caf44622b3._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="Xyem" + ip="87.194.19.134" + subject="comment 4" + date="2014-03-20T08:14:20Z" + content=""" +Awesome! :) + +Thank you for adding this, I hope others find it as useful as I will. +"""]] diff --git a/doc/todo/wishlist:_spec.remotes_for_other_peer_network_data_stores___40__gnunet__44___freenet__41__/comment_3_b4ff519ece76c6c3fb29b981320e2e1c._comment b/doc/todo/wishlist:_spec.remotes_for_other_peer_network_data_stores___40__gnunet__44___freenet__41__/comment_3_b4ff519ece76c6c3fb29b981320e2e1c._comment new file mode 100644 index 0000000000..dac3331740 --- /dev/null +++ b/doc/todo/wishlist:_spec.remotes_for_other_peer_network_data_stores___40__gnunet__44___freenet__41__/comment_3_b4ff519ece76c6c3fb29b981320e2e1c._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 3" + date="2014-03-18T19:49:09Z" + content=""" +The new [[special_remotes/external]] special remote's protocol has GETSTATE and SETSTATE commands that can be used to store per-remote values in the git-annex branch. + +So, please go make these special remotes using it! +"""]] diff --git a/doc/todo/wishlist:_special_remote_Ubuntu_One/comment_1_ab0c761030bc55e8fb75d1b344bb98b9._comment b/doc/todo/wishlist:_special_remote_Ubuntu_One/comment_1_ab0c761030bc55e8fb75d1b344bb98b9._comment new file mode 100644 index 0000000000..4fb9bc95ea --- /dev/null +++ b/doc/todo/wishlist:_special_remote_Ubuntu_One/comment_1_ab0c761030bc55e8fb75d1b344bb98b9._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 1" + date="2014-03-18T20:02:14Z" + content=""" +I suggest that if someone wants to build this, they use the new external special remote protocol to do it. +"""]] diff --git a/doc/todo/wishlist:alias_system/comment_1_5afad4b92f9a449d4a82a94ad31feec2._comment b/doc/todo/wishlist:alias_system/comment_1_5afad4b92f9a449d4a82a94ad31feec2._comment new file mode 100644 index 0000000000..ea8f2bd306 --- /dev/null +++ b/doc/todo/wishlist:alias_system/comment_1_5afad4b92f9a449d4a82a94ad31feec2._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.154" + subject="comment 1" + date="2014-03-18T19:38:19Z" + content=""" +Why not just use git's alias system? It can't make `git annex $foo` aliases, but `git $foo` is shorter anyway.. +"""]] diff --git a/doc/walkthrough.mdwn b/doc/walkthrough.mdwn index 94c31e4772..1d69daa88d 100644 --- a/doc/walkthrough.mdwn +++ b/doc/walkthrough.mdwn @@ -3,6 +3,7 @@ A walkthrough of the basic features of git-annex. [[!toc]] [[!inline feeds=no trail=yes show=0 template=walkthrough pagenames=""" + walkthrough/setup_git walkthrough/creating_a_repository walkthrough/adding_a_remote walkthrough/adding_files diff --git a/doc/walkthrough/setup_git.mdwn b/doc/walkthrough/setup_git.mdwn new file mode 100644 index 0000000000..9b4ef01857 --- /dev/null +++ b/doc/walkthrough/setup_git.mdwn @@ -0,0 +1,2 @@ +If you haven't configured your identity for GIT, you will have to do this before git annex will work. + diff --git a/git-annex.cabal b/git-annex.cabal index 24207ca8cc..94b29b5c24 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -1,5 +1,5 @@ Name: git-annex -Version: 5.20140306 +Version: 5.20140320 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess @@ -7,6 +7,7 @@ Author: Joey Hess Stability: Stable Copyright: 2010-2014 Joey Hess License-File: COPYRIGHT +Extra-Source-Files: CHANGELOG Homepage: http://git-annex.branchable.com/ Build-type: Custom Category: Utility @@ -43,8 +44,8 @@ Flag Assistant Flag Webapp Description: Enable git-annex webapp -Flag Webapp-https - Description: Enable git-annex webapp https +Flag Webapp-secure + Description: Secure webapp Flag Pairing Description: Enable pairing @@ -182,11 +183,12 @@ Executable git-annex yesod, yesod-default, yesod-static, yesod-form, yesod-core, http-types, transformers, wai, wai-logger, warp, warp-tls, blaze-builder, crypto-api, hamlet, clientsession, - template-haskell, data-default, aeson, network-conduit + template-haskell, data-default, aeson, network-conduit, + byteable CPP-Options: -DWITH_WEBAPP - if flag(Webapp) && flag (Webapp-https) - Build-Depends: warp-tls (>= 1.4) - CPP-Options: -DWITH_WEBAPP_HTTPS + if flag(Webapp) && flag (Webapp-secure) + Build-Depends: warp-tls (>= 1.4), securemem + CPP-Options: -DWITH_WEBAPP_SECURE if flag(Pairing) Build-Depends: network-multicast, network-info diff --git a/standalone/android/openssh.patch b/standalone/android/openssh.patch index 6cdb295960..996143d0ed 100644 --- a/standalone/android/openssh.patch +++ b/standalone/android/openssh.patch @@ -29,6 +29,18 @@ index 6623e0f..dd10253 100644 comparehome = 1; /* check the open file to avoid races */ +diff --git a/authfile.c b/authfile.c +index 7dd4496..00462e9 100644 +--- a/authfile.c ++++ b/authfile.c +@@ -613,6 +613,7 @@ int + key_perm_ok(int fd, const char *filename) + { + struct stat st; ++ return 1; /* check doesn't make sense on android */ + + if (fstat(fd, &st) < 0) + return 0; diff --git a/misc.c b/misc.c index 0bf2db6..4327d03 100644 --- a/misc.c diff --git a/standalone/linux/haskell-patches/network_disable_accept4.patch b/standalone/linux/haskell-patches/network_disable_accept4.patch new file mode 100644 index 0000000000..a1c07206ac --- /dev/null +++ b/standalone/linux/haskell-patches/network_disable_accept4.patch @@ -0,0 +1,26 @@ +From f89652f762cf40e4c737fc1b9d6f395eb8df1959 Mon Sep 17 00:00:00 2001 +From: Joey Hess +Date: Mon, 10 Mar 2014 13:28:25 -0400 +Subject: [PATCH] disable use of accept4, for compatability with older systems + +See http://git-annex.branchable.com/bugs/Assistant_lost_dbus_connection_spamming_log/ +--- + Network/Socket.hsc | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/Network/Socket.hsc b/Network/Socket.hsc +index 6d304bb..d7fe733 100644 +--- a/Network/Socket.hsc ++++ b/Network/Socket.hsc +@@ -510,7 +510,7 @@ accept sock@(MkSocket s family stype protocol status) = do + return new_sock + #else + with (fromIntegral sz) $ \ ptr_len -> do +-# ifdef HAVE_ACCEPT4 ++# if 0 + new_sock <- throwSocketErrorIfMinus1RetryMayBlock "accept" + (threadWaitRead (fromIntegral s)) + (c_accept4 s sockaddr ptr_len (#const SOCK_NONBLOCK)) +-- +1.9.0 + diff --git a/standalone/linux/install-haskell-packages b/standalone/linux/install-haskell-packages index f22bf17cb5..b47c39aadb 100755 --- a/standalone/linux/install-haskell-packages +++ b/standalone/linux/install-haskell-packages @@ -34,7 +34,7 @@ patched () { git config user.email dummy@example.com git add . git commit -m "pre-patched state of $pkg" - for patch in ../../../no-th/haskell-patches/${pkg}_*; do + for patch in ../../haskell-patches/${pkg}_* ../../../no-th/haskell-patches/${pkg}_*; do if [ -e "$patch" ]; then echo trying $patch if ! patch -p1 < $patch; then @@ -61,6 +61,7 @@ install_pkgs () { mkdir tmp cd tmp + patched network patched wai-app-static patched shakespeare patched shakespeare-css @@ -72,11 +73,12 @@ install_pkgs () { patched yesod-core patched persistent patched persistent-template - patched yesod + patched file-embed + patched shakespeare-text patched process-conduit patched yesod-static + patched yesod-persistent patched yesod-form - patched file-embed patched yesod-auth patched yesod patched generic-deriving @@ -84,7 +86,6 @@ install_pkgs () { patched reflection patched lens patched xml-hamlet - patched shakespeare-text patched DAV cd .. diff --git a/standalone/no-th/haskell-patches/hamlet_remove-TH.patch b/standalone/no-th/haskell-patches/hamlet_remove-TH.patch index c5c352fe47..04989b148b 100644 --- a/standalone/no-th/haskell-patches/hamlet_remove-TH.patch +++ b/standalone/no-th/haskell-patches/hamlet_remove-TH.patch @@ -1,17 +1,18 @@ -From f500a9e447912e68c12f011fe97b62e6a6c5c3ce Mon Sep 17 00:00:00 2001 -From: Joey Hess -Date: Tue, 17 Dec 2013 16:16:32 +0000 +From 60d7ac8aa1b3282a06ea7b17680dfc32c61fcbf6 Mon Sep 17 00:00:00 2001 +From: dummy +Date: Thu, 6 Mar 2014 23:19:40 +0000 Subject: [PATCH] remove TH --- - Text/Hamlet.hs | 310 ++++----------------------------------------------------- - 1 file changed, 17 insertions(+), 293 deletions(-) + Text/Hamlet.hs | 86 +++++++++++++++++----------------------------------- + Text/Hamlet/Parse.hs | 3 +- + 2 files changed, 29 insertions(+), 60 deletions(-) diff --git a/Text/Hamlet.hs b/Text/Hamlet.hs -index 4f873f4..10d8ba6 100644 +index 9500ecb..ec8471a 100644 --- a/Text/Hamlet.hs +++ b/Text/Hamlet.hs -@@ -11,34 +11,34 @@ +@@ -11,36 +11,36 @@ module Text.Hamlet ( -- * Plain HTML Html @@ -27,10 +28,14 @@ index 4f873f4..10d8ba6 100644 , HtmlUrl - , hamlet - , hamletFile +- , hamletFileReload +- , ihamletFileReload - , xhamlet - , xhamletFile + --, hamlet + --, hamletFile ++ --, hamletFileReload ++ --, ihamletFileReload + --, xhamlet + --, xhamletFile -- * I18N Hamlet @@ -63,7 +68,7 @@ index 4f873f4..10d8ba6 100644 , CloseStyle (..) -- * Used by generated code , condH -@@ -100,47 +100,9 @@ type HtmlUrl url = Render url -> Html +@@ -110,47 +110,9 @@ type HtmlUrl url = Render url -> Html -- | A function generating an 'Html' given a message translator and a URL rendering function. type HtmlUrlI18n msg url = Translate msg -> Render url -> Html @@ -111,255 +116,90 @@ index 4f873f4..10d8ba6 100644 mkConName :: DataConstr -> Name mkConName = mkName . conToStr -@@ -148,248 +110,10 @@ conToStr :: DataConstr -> String +@@ -158,6 +120,7 @@ conToStr :: DataConstr -> String conToStr (DCUnqualified (Ident x)) = x conToStr (DCQualified (Module xs) (Ident x)) = intercalate "." $ xs ++ [x] ---- Wildcards bind all of the unbound fields to variables whose name ---- matches the field name. ---- ---- For example: data R = C { f1, f2 :: Int } ---- C {..} is equivalent to C {f1=f1, f2=f2} ---- C {f1 = a, ..} is equivalent to C {f1=a, f2=f2} ---- C {f2 = a, ..} is equivalent to C {f1=f1, f2=a} --bindWildFields :: DataConstr -> [Ident] -> Q ([(Name, Pat)], [(Ident, Exp)]) --bindWildFields conName fields = do -- fieldNames <- recordToFieldNames conName -- let available n = nameBase n `notElem` map unIdent fields -- let remainingFields = filter available fieldNames -- let mkPat n = do -- e <- newName (nameBase n) -- return ((n,VarP e), (Ident (nameBase n), VarE e)) -- fmap unzip $ mapM mkPat remainingFields -- ---- Important note! reify will fail if the record type is defined in the ---- same module as the reify is used. This means quasi-quoted Hamlet ---- literals will not be able to use wildcards to match record types ---- defined in the same module. --recordToFieldNames :: DataConstr -> Q [Name] --recordToFieldNames conStr = do -- -- use 'lookupValueName' instead of just using 'mkName' so we reify the -- -- data constructor and not the type constructor if their names match. -- Just conName <- lookupValueName $ conToStr conStr -- DataConI _ _ typeName _ <- reify conName -- TyConI (DataD _ _ _ cons _) <- reify typeName -- [fields] <- return [fields | RecC name fields <- cons, name == conName] -- return [fieldName | (fieldName, _, _) <- fields] -- --docToExp :: Env -> HamletRules -> Scope -> Doc -> Q Exp --docToExp env hr scope (DocForall list idents inside) = do -- let list' = derefToExp scope list -- (pat, extraScope) <- bindingPattern idents -- let scope' = extraScope ++ scope -- mh <- [|F.mapM_|] -- inside' <- docsToExp env hr scope' inside -- let lam = LamE [pat] inside' -- return $ mh `AppE` lam `AppE` list' --docToExp env hr scope (DocWith [] inside) = do -- inside' <- docsToExp env hr scope inside -- return $ inside' --docToExp env hr scope (DocWith ((deref, idents):dis) inside) = do -- let deref' = derefToExp scope deref -- (pat, extraScope) <- bindingPattern idents -- let scope' = extraScope ++ scope -- inside' <- docToExp env hr scope' (DocWith dis inside) -- let lam = LamE [pat] inside' -- return $ lam `AppE` deref' --docToExp env hr scope (DocMaybe val idents inside mno) = do -- let val' = derefToExp scope val -- (pat, extraScope) <- bindingPattern idents -- let scope' = extraScope ++ scope -- inside' <- docsToExp env hr scope' inside -- let inside'' = LamE [pat] inside' -- ninside' <- case mno of -- Nothing -> [|Nothing|] -- Just no -> do -- no' <- docsToExp env hr scope no -- j <- [|Just|] -- return $ j `AppE` no' -- mh <- [|maybeH|] -- return $ mh `AppE` val' `AppE` inside'' `AppE` ninside' --docToExp env hr scope (DocCond conds final) = do -- conds' <- mapM go conds -- final' <- case final of -- Nothing -> [|Nothing|] -- Just f -> do -- f' <- docsToExp env hr scope f -- j <- [|Just|] -- return $ j `AppE` f' -- ch <- [|condH|] -- return $ ch `AppE` ListE conds' `AppE` final' -- where -- go :: (Deref, [Doc]) -> Q Exp -- go (d, docs) = do -- let d' = derefToExp ((specialOrIdent, VarE 'or):scope) d -- docs' <- docsToExp env hr scope docs -- return $ TupE [d', docs'] --docToExp env hr scope (DocCase deref cases) = do -- let exp_ = derefToExp scope deref -- matches <- mapM toMatch cases -- return $ CaseE exp_ matches -- where -- readMay s = -- case reads s of -- (x, ""):_ -> Just x -- _ -> Nothing -- toMatch :: (Binding, [Doc]) -> Q Match -- toMatch (idents, inside) = do -- (pat, extraScope) <- bindingPattern idents -- let scope' = extraScope ++ scope -- insideExp <- docsToExp env hr scope' inside -- return $ Match pat (NormalB insideExp) [] --docToExp env hr v (DocContent c) = contentToExp env hr v c -- --contentToExp :: Env -> HamletRules -> Scope -> Content -> Q Exp --contentToExp _ hr _ (ContentRaw s) = do -- os <- [|preEscapedText . pack|] -- let s' = LitE $ StringL s -- return $ hrFromHtml hr `AppE` (os `AppE` s') --contentToExp _ hr scope (ContentVar d) = do -- str <- [|toHtml|] -- return $ hrFromHtml hr `AppE` (str `AppE` derefToExp scope d) --contentToExp env hr scope (ContentUrl hasParams d) = -- case urlRender env of -- Nothing -> error "URL interpolation used, but no URL renderer provided" -- Just wrender -> wrender $ \render -> do -- let render' = return render -- ou <- if hasParams -- then [|\(u, p) -> $(render') u p|] -- else [|\u -> $(render') u []|] -- let d' = derefToExp scope d -- pet <- [|toHtml|] -- return $ hrFromHtml hr `AppE` (pet `AppE` (ou `AppE` d')) --contentToExp env hr scope (ContentEmbed d) = hrEmbed hr env $ derefToExp scope d --contentToExp env hr scope (ContentMsg d) = -- case msgRender env of -- Nothing -> error "Message interpolation used, but no message renderer provided" -- Just wrender -> wrender $ \render -> -- return $ hrFromHtml hr `AppE` (render `AppE` derefToExp scope d) --contentToExp _ hr scope (ContentAttrs d) = do -- html <- [|attrsToHtml . toAttributes|] -- return $ hrFromHtml hr `AppE` (html `AppE` derefToExp scope d) -- --shamlet :: QuasiQuoter --shamlet = hamletWithSettings htmlRules defaultHamletSettings -- --xshamlet :: QuasiQuoter --xshamlet = hamletWithSettings htmlRules xhtmlHamletSettings -- --htmlRules :: Q HamletRules --htmlRules = do -- i <- [|id|] -- return $ HamletRules i ($ (Env Nothing Nothing)) (\_ b -> return b) -- --hamlet :: QuasiQuoter --hamlet = hamletWithSettings hamletRules defaultHamletSettings -- --xhamlet :: QuasiQuoter --xhamlet = hamletWithSettings hamletRules xhtmlHamletSettings ++{- + -- Wildcards bind all of the unbound fields to variables whose name + -- matches the field name. + -- +@@ -296,10 +259,12 @@ hamlet = hamletWithSettings hamletRules defaultHamletSettings + + xhamlet :: QuasiQuoter + xhamlet = hamletWithSettings hamletRules xhtmlHamletSettings ++-} asHtmlUrl :: HtmlUrl url -> HtmlUrl url asHtmlUrl = id --hamletRules :: Q HamletRules --hamletRules = do -- i <- [|id|] -- let ur f = do -- r <- newName "_render" -- let env = Env -- { urlRender = Just ($ (VarE r)) -- , msgRender = Nothing -- } -- h <- f env -- return $ LamE [VarP r] h -- return $ HamletRules i ur em -- where -- em (Env (Just urender) Nothing) e = do -- asHtmlUrl' <- [|asHtmlUrl|] -- urender $ \ur' -> return ((asHtmlUrl' `AppE` e) `AppE` ur') -- em _ _ = error "bad Env" -- --ihamlet :: QuasiQuoter --ihamlet = hamletWithSettings ihamletRules defaultHamletSettings -- --ihamletRules :: Q HamletRules --ihamletRules = do -- i <- [|id|] -- let ur f = do -- u <- newName "_urender" -- m <- newName "_mrender" -- let env = Env -- { urlRender = Just ($ (VarE u)) -- , msgRender = Just ($ (VarE m)) -- } -- h <- f env -- return $ LamE [VarP m, VarP u] h -- return $ HamletRules i ur em -- where -- em (Env (Just urender) (Just mrender)) e = -- urender $ \ur' -> mrender $ \mr -> return (e `AppE` mr `AppE` ur') -- em _ _ = error "bad Env" -- --hamletWithSettings :: Q HamletRules -> HamletSettings -> QuasiQuoter --hamletWithSettings hr set = -- QuasiQuoter -- { quoteExp = hamletFromString hr set -- } -- --data HamletRules = HamletRules -- { hrFromHtml :: Exp -- , hrWithEnv :: (Env -> Q Exp) -> Q Exp -- , hrEmbed :: Env -> Exp -> Q Exp -- } -- --data Env = Env -- { urlRender :: Maybe ((Exp -> Q Exp) -> Q Exp) -- , msgRender :: Maybe ((Exp -> Q Exp) -> Q Exp) -- } -- --hamletFromString :: Q HamletRules -> HamletSettings -> String -> Q Exp --hamletFromString qhr set s = do -- hr <- qhr -- case parseDoc set s of -- Error s' -> error s' -- Ok (_mnl, d) -> hrWithEnv hr $ \env -> docsToExp env hr [] d -- --hamletFileWithSettings :: Q HamletRules -> HamletSettings -> FilePath -> Q Exp --hamletFileWithSettings qhr set fp = do --#ifdef GHC_7_4 -- qAddDependentFile fp --#endif -- contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp -- hamletFromString qhr set contents -- --hamletFile :: FilePath -> Q Exp --hamletFile = hamletFileWithSettings hamletRules defaultHamletSettings -- --xhamletFile :: FilePath -> Q Exp --xhamletFile = hamletFileWithSettings hamletRules xhtmlHamletSettings -- --shamletFile :: FilePath -> Q Exp --shamletFile = hamletFileWithSettings htmlRules defaultHamletSettings -- --xshamletFile :: FilePath -> Q Exp --xshamletFile = hamletFileWithSettings htmlRules xhtmlHamletSettings -- --ihamletFile :: FilePath -> Q Exp --ihamletFile = hamletFileWithSettings ihamletRules defaultHamletSettings -- --varName :: Scope -> String -> Exp --varName _ "" = error "Illegal empty varName" --varName scope v@(_:_) = fromMaybe (strToExp v) $ lookup (Ident v) scope -- --strToExp :: String -> Exp --strToExp s@(c:_) -- | all isDigit s = LitE $ IntegerL $ read s -- | isUpper c = ConE $ mkName s -- | otherwise = VarE $ mkName s --strToExp "" = error "strToExp on empty string" ++{- + hamletRules :: Q HamletRules + hamletRules = do + i <- [|id|] +@@ -360,6 +325,7 @@ hamletFromString :: Q HamletRules -> HamletSettings -> String -> Q Exp + hamletFromString qhr set s = do + hr <- qhr + hrWithEnv hr $ \env -> docsToExp env hr [] $ docFromString set s ++-} + + docFromString :: HamletSettings -> String -> [Doc] + docFromString set s = +@@ -367,6 +333,7 @@ docFromString set s = + Error s' -> error s' + Ok (_, d) -> d + ++{- + hamletFileWithSettings :: Q HamletRules -> HamletSettings -> FilePath -> Q Exp + hamletFileWithSettings qhr set fp = do + #ifdef GHC_7_4 +@@ -408,6 +375,7 @@ strToExp s@(c:_) + | isUpper c = ConE $ mkName s + | otherwise = VarE $ mkName s + strToExp "" = error "strToExp on empty string" ++-} -- | Checks for truth in the left value in each pair in the first argument. If -- a true exists, then the corresponding right action is performed. Only the +@@ -452,7 +420,7 @@ hamletUsedIdentifiers settings = + data HamletRuntimeRules = HamletRuntimeRules { + hrrI18n :: Bool + } +- ++{- + hamletFileReloadWithSettings :: HamletRuntimeRules + -> HamletSettings -> FilePath -> Q Exp + hamletFileReloadWithSettings hrr settings fp = do +@@ -479,7 +447,7 @@ hamletFileReloadWithSettings hrr settings fp = do + c VTUrlParam = [|EUrlParam|] + c VTMixin = [|\r -> EMixin $ \c -> r c|] + c VTMsg = [|EMsg|] +- ++-} + -- move to Shakespeare.Base? + readFileUtf8 :: FilePath -> IO String + readFileUtf8 fp = fmap TL.unpack $ readUtf8File fp +diff --git a/Text/Hamlet/Parse.hs b/Text/Hamlet/Parse.hs +index b7e2954..1f14946 100644 +--- a/Text/Hamlet/Parse.hs ++++ b/Text/Hamlet/Parse.hs +@@ -616,6 +616,7 @@ data NewlineStyle = NoNewlines -- ^ never add newlines + | DefaultNewlineStyle + deriving Show + ++{- + instance Lift NewlineStyle where + lift NoNewlines = [|NoNewlines|] + lift NewlinesText = [|NewlinesText|] +@@ -627,7 +628,7 @@ instance Lift (String -> CloseStyle) where + + instance Lift HamletSettings where + lift (HamletSettings a b c d) = [|HamletSettings $(lift a) $(lift b) $(lift c) $(lift d)|] +- ++-} + + htmlEmptyTags :: Set String + htmlEmptyTags = Set.fromAscList -- -1.8.5.1 +1.9.0 diff --git a/standalone/no-th/haskell-patches/lens_no-TH.patch b/standalone/no-th/haskell-patches/lens_no-TH.patch index 81e370146e..60600a3751 100644 --- a/standalone/no-th/haskell-patches/lens_no-TH.patch +++ b/standalone/no-th/haskell-patches/lens_no-TH.patch @@ -1,20 +1,21 @@ -From b9b3cd52735f9ede1a83960968dc1f0e91e061d6 Mon Sep 17 00:00:00 2001 +From 66fdbc0cb69036b61552a3bce7e995ea2a7f76c1 Mon Sep 17 00:00:00 2001 From: dummy -Date: Fri, 7 Feb 2014 21:49:11 +0000 -Subject: [PATCH] avoid TH +Date: Fri, 7 Mar 2014 05:43:33 +0000 +Subject: [PATCH] TH --- - lens.cabal | 14 +------------- - src/Control/Lens.hs | 6 ++---- - src/Control/Lens/Cons.hs | 2 -- - src/Control/Lens/Internal/Fold.hs | 2 -- - src/Control/Lens/Internal/Reflection.hs | 2 -- - src/Control/Lens/Prism.hs | 2 -- - src/Control/Monad/Primitive/Lens.hs | 1 - - 7 files changed, 3 insertions(+), 26 deletions(-) + lens.cabal | 19 +------------------ + src/Control/Lens.hs | 8 ++------ + src/Control/Lens/Cons.hs | 2 -- + src/Control/Lens/Internal/Fold.hs | 2 -- + src/Control/Lens/Internal/Reflection.hs | 2 -- + src/Control/Lens/Operators.hs | 2 +- + src/Control/Lens/Prism.hs | 2 -- + src/Control/Monad/Primitive/Lens.hs | 1 - + 8 files changed, 4 insertions(+), 34 deletions(-) diff --git a/lens.cabal b/lens.cabal -index cee2da7..1e467c4 100644 +index 790a9d7..7cd3ff9 100644 --- a/lens.cabal +++ b/lens.cabal @@ -10,7 +10,7 @@ stability: provisional @@ -26,7 +27,15 @@ index cee2da7..1e467c4 100644 -- build-tools: cpphs tested-with: GHC == 7.6.3 synopsis: Lenses, Folds and Traversals -@@ -216,7 +216,6 @@ library +@@ -177,7 +177,6 @@ flag lib-Werror + + library + build-depends: +- aeson >= 0.7 && < 0.8, + array >= 0.3.0.2 && < 0.6, + base >= 4.3 && < 5, + bifunctors >= 4 && < 5, +@@ -216,7 +215,6 @@ library Control.Exception.Lens Control.Lens Control.Lens.Action @@ -34,7 +43,12 @@ index cee2da7..1e467c4 100644 Control.Lens.Combinators Control.Lens.Cons Control.Lens.Each -@@ -256,17 +255,14 @@ library +@@ -251,22 +249,18 @@ library + Control.Lens.Level + Control.Lens.Loupe + Control.Lens.Operators +- Control.Lens.Plated + Control.Lens.Prism Control.Lens.Reified Control.Lens.Review Control.Lens.Setter @@ -52,7 +66,7 @@ index cee2da7..1e467c4 100644 Data.Array.Lens Data.Bits.Lens Data.ByteString.Lens -@@ -289,12 +285,8 @@ library +@@ -289,17 +283,10 @@ library Data.Typeable.Lens Data.Vector.Lens Data.Vector.Generic.Lens @@ -64,8 +78,13 @@ index cee2da7..1e467c4 100644 - Language.Haskell.TH.Lens Numeric.Lens - other-modules: -@@ -394,7 +386,6 @@ test-suite doctests +- other-modules: +- Control.Lens.Internal.TupleIxedTH +- + if flag(safe) + cpp-options: -DSAFE=1 + +@@ -396,7 +383,6 @@ test-suite doctests deepseq, doctest >= 0.9.1, filepath, @@ -73,7 +92,7 @@ index cee2da7..1e467c4 100644 mtl, nats, parallel, -@@ -432,7 +423,6 @@ benchmark plated +@@ -434,7 +420,6 @@ benchmark plated comonad, criterion, deepseq, @@ -81,7 +100,7 @@ index cee2da7..1e467c4 100644 lens, transformers -@@ -467,7 +457,6 @@ benchmark unsafe +@@ -469,7 +454,6 @@ benchmark unsafe comonads-fd, criterion, deepseq, @@ -89,7 +108,7 @@ index cee2da7..1e467c4 100644 lens, transformers -@@ -484,6 +473,5 @@ benchmark zipper +@@ -486,6 +470,5 @@ benchmark zipper comonads-fd, criterion, deepseq, @@ -97,7 +116,7 @@ index cee2da7..1e467c4 100644 lens, transformers diff --git a/src/Control/Lens.hs b/src/Control/Lens.hs -index 7e15267..bb4d87b 100644 +index 7e15267..433f1fc 100644 --- a/src/Control/Lens.hs +++ b/src/Control/Lens.hs @@ -41,7 +41,6 @@ @@ -108,7 +127,12 @@ index 7e15267..bb4d87b 100644 , module Control.Lens.Cons , module Control.Lens.Each , module Control.Lens.Empty -@@ -58,7 +57,7 @@ module Control.Lens +@@ -53,12 +52,11 @@ module Control.Lens + , module Control.Lens.Lens + , module Control.Lens.Level + , module Control.Lens.Loupe +- , module Control.Lens.Plated + , module Control.Lens.Prism , module Control.Lens.Reified , module Control.Lens.Review , module Control.Lens.Setter @@ -117,7 +141,7 @@ index 7e15267..bb4d87b 100644 , module Control.Lens.TH #endif , module Control.Lens.Traversal -@@ -69,7 +68,6 @@ module Control.Lens +@@ -69,7 +67,6 @@ module Control.Lens ) where import Control.Lens.Action @@ -125,7 +149,12 @@ index 7e15267..bb4d87b 100644 import Control.Lens.Cons import Control.Lens.Each import Control.Lens.Empty -@@ -86,7 +84,7 @@ import Control.Lens.Prism +@@ -81,12 +78,11 @@ import Control.Lens.Iso + import Control.Lens.Lens + import Control.Lens.Level + import Control.Lens.Loupe +-import Control.Lens.Plated + import Control.Lens.Prism import Control.Lens.Reified import Control.Lens.Review import Control.Lens.Setter @@ -148,7 +177,7 @@ index a80e9c8..7d27b80 100644 -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens diff --git a/src/Control/Lens/Internal/Fold.hs b/src/Control/Lens/Internal/Fold.hs -index 00e4b66..03c9cd2 100644 +index ab09c6b..43aa905 100644 --- a/src/Control/Lens/Internal/Fold.hs +++ b/src/Control/Lens/Internal/Fold.hs @@ -37,8 +37,6 @@ import Data.Maybe @@ -173,6 +202,19 @@ index bf09f2c..c9e112f 100644 class Typeable s => B s where reflectByte :: proxy s -> IntPtr +diff --git a/src/Control/Lens/Operators.hs b/src/Control/Lens/Operators.hs +index 3e14c55..989eb92 100644 +--- a/src/Control/Lens/Operators.hs ++++ b/src/Control/Lens/Operators.hs +@@ -110,7 +110,7 @@ module Control.Lens.Operators + , (<#~) + , (<#=) + -- * "Control.Lens.Plated" +- , (...) ++ --, (...) + -- * "Control.Lens.Review" + , ( # ) + -- * "Control.Lens.Setter" diff --git a/src/Control/Lens/Prism.hs b/src/Control/Lens/Prism.hs index 9e0bec7..0cf6737 100644 --- a/src/Control/Lens/Prism.hs @@ -199,5 +241,5 @@ index ee942c6..2f37134 100644 prim :: (PrimMonad m) => Iso' (m a) (State# (PrimState m) -> (# State# (PrimState m), a #)) prim = iso internal primitive -- -1.7.10.4 +1.9.0 diff --git a/standalone/no-th/haskell-patches/monad-logger_remove-TH.patch b/standalone/no-th/haskell-patches/monad-logger_remove-TH.patch index 78cf7be356..c24fa5aa26 100644 --- a/standalone/no-th/haskell-patches/monad-logger_remove-TH.patch +++ b/standalone/no-th/haskell-patches/monad-logger_remove-TH.patch @@ -1,150 +1,27 @@ -From 08aa9d495cb486c45998dfad95518c646b5fa8cc Mon Sep 17 00:00:00 2001 -From: Joey Hess -Date: Tue, 17 Dec 2013 16:24:31 +0000 -Subject: [PATCH] remove TH +From 8e78a25ce0cc19e52d063f66bd4cd316462393d4 Mon Sep 17 00:00:00 2001 +From: dummy +Date: Thu, 6 Mar 2014 23:27:06 +0000 +Subject: [PATCH] disable th --- - Control/Monad/Logger.hs | 109 ++++++++++-------------------------------------- - 1 file changed, 21 insertions(+), 88 deletions(-) + monad-logger.cabal | 4 ++-- + 1 file changed, 2 insertions(+), 2 deletions(-) -diff --git a/Control/Monad/Logger.hs b/Control/Monad/Logger.hs -index be756d7..d4979f8 100644 ---- a/Control/Monad/Logger.hs -+++ b/Control/Monad/Logger.hs -@@ -31,31 +31,31 @@ module Control.Monad.Logger - , withChannelLogger - , NoLoggingT (..) - -- * TH logging -- , logDebug -- , logInfo -- , logWarn -- , logError -- , logOther -+ --, logDebug -+ --, logInfo -+ --, logWarn -+ --, logError -+ --, logOther - -- * TH logging with source -- , logDebugS -- , logInfoS -- , logWarnS -- , logErrorS -- , logOtherS -+ --, logDebugS -+ --, logInfoS -+ --, logWarnS -+ --, logErrorS -+ --, logOtherS - -- * TH util -- , liftLoc -+ -- , liftLoc - -- * Non-TH logging -- , logDebugN -- , logInfoN -- , logWarnN -- , logErrorN -- , logOtherN -+ --, logDebugN -+ --, logInfoN -+ --, logWarnN -+ --, logErrorN -+ --, logOtherN - -- * Non-TH logging with source -- , logDebugNS -- , logInfoNS -- , logWarnNS -- , logErrorNS -- , logOtherNS -+ --, logDebugNS -+ --, logInfoNS -+ --, logWarnNS -+ --, logErrorNS -+ --, logOtherNS - ) where +diff --git a/monad-logger.cabal b/monad-logger.cabal +index b0aa271..cd56c0f 100644 +--- a/monad-logger.cabal ++++ b/monad-logger.cabal +@@ -14,8 +14,8 @@ cabal-version: >=1.8 - import Language.Haskell.TH.Syntax (Lift (lift), Q, Exp, Loc (..), qLocation) -@@ -115,13 +115,6 @@ import Control.Monad.Writer.Class ( MonadWriter (..) ) - data LogLevel = LevelDebug | LevelInfo | LevelWarn | LevelError | LevelOther Text - deriving (Eq, Prelude.Show, Prelude.Read, Ord) + flag template_haskell { + Description: Enable Template Haskell support +- Default: True +- Manual: True ++ Default: False ++ Manual: False + } --instance Lift LogLevel where -- lift LevelDebug = [|LevelDebug|] -- lift LevelInfo = [|LevelInfo|] -- lift LevelWarn = [|LevelWarn|] -- lift LevelError = [|LevelError|] -- lift (LevelOther x) = [|LevelOther $ pack $(lift $ unpack x)|] -- - type LogSource = Text - - class Monad m => MonadLogger m where -@@ -152,66 +145,6 @@ instance (MonadLogger m, Monoid w) => MonadLogger (Strict.WriterT w m) where DEF - instance (MonadLogger m, Monoid w) => MonadLogger (Strict.RWST r w s m) where DEF - #undef DEF - --logTH :: LogLevel -> Q Exp --logTH level = -- [|monadLoggerLog $(qLocation >>= liftLoc) (pack "") $(lift level) . (id :: Text -> Text)|] -- ---- | Generates a function that takes a 'Text' and logs a 'LevelDebug' message. Usage: ---- ---- > $(logDebug) "This is a debug log message" --logDebug :: Q Exp --logDebug = logTH LevelDebug -- ---- | See 'logDebug' --logInfo :: Q Exp --logInfo = logTH LevelInfo ---- | See 'logDebug' --logWarn :: Q Exp --logWarn = logTH LevelWarn ---- | See 'logDebug' --logError :: Q Exp --logError = logTH LevelError -- ---- | Generates a function that takes a 'Text' and logs a 'LevelOther' message. Usage: ---- ---- > $(logOther "My new level") "This is a log message" --logOther :: Text -> Q Exp --logOther = logTH . LevelOther -- ---- | Lift a location into an Exp. ---- ---- Since 0.3.1 --liftLoc :: Loc -> Q Exp --liftLoc (Loc a b c (d1, d2) (e1, e2)) = [|Loc -- $(lift a) -- $(lift b) -- $(lift c) -- ($(lift d1), $(lift d2)) -- ($(lift e1), $(lift e2)) -- |] -- ---- | Generates a function that takes a 'LogSource' and 'Text' and logs a 'LevelDebug' message. Usage: ---- ---- > $logDebugS "SomeSource" "This is a debug log message" --logDebugS :: Q Exp --logDebugS = [|\a b -> monadLoggerLog $(qLocation >>= liftLoc) a LevelDebug (b :: Text)|] -- ---- | See 'logDebugS' --logInfoS :: Q Exp --logInfoS = [|\a b -> monadLoggerLog $(qLocation >>= liftLoc) a LevelInfo (b :: Text)|] ---- | See 'logDebugS' --logWarnS :: Q Exp --logWarnS = [|\a b -> monadLoggerLog $(qLocation >>= liftLoc) a LevelWarn (b :: Text)|] ---- | See 'logDebugS' --logErrorS :: Q Exp --logErrorS = [|\a b -> monadLoggerLog $(qLocation >>= liftLoc) a LevelError (b :: Text)|] -- ---- | Generates a function that takes a 'LogSource', a level name and a 'Text' and logs a 'LevelOther' message. Usage: ---- ---- > $logOtherS "SomeSource" "My new level" "This is a log message" --logOtherS :: Q Exp --logOtherS = [|\src level msg -> monadLoggerLog $(qLocation >>= liftLoc) src (LevelOther level) (msg :: Text)|] -- - -- | Monad transformer that disables logging. - -- - -- Since 0.2.4 + library -- -1.8.5.1 +1.9.0 diff --git a/standalone/no-th/haskell-patches/reflection_remove-TH.patch b/standalone/no-th/haskell-patches/reflection_remove-TH.patch index 7c63f05fcf..4f8b4bc20f 100644 --- a/standalone/no-th/haskell-patches/reflection_remove-TH.patch +++ b/standalone/no-th/haskell-patches/reflection_remove-TH.patch @@ -1,17 +1,17 @@ -From 22c68b43dce437b3c22956f5a968f1b886e60e0c Mon Sep 17 00:00:00 2001 -From: Joey Hess -Date: Tue, 17 Dec 2013 19:15:16 +0000 +From c0f5dcfd6ba7a05bb84b6adc4664c8dde109e6ac Mon Sep 17 00:00:00 2001 +From: dummy +Date: Fri, 7 Mar 2014 04:30:22 +0000 Subject: [PATCH] remove TH --- - fast/Data/Reflection.hs | 80 +------------------------------------------------ - 1 file changed, 1 insertion(+), 79 deletions(-) + fast/Data/Reflection.hs | 8 +++++--- + 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/fast/Data/Reflection.hs b/fast/Data/Reflection.hs -index 119d773..cf99efa 100644 +index ca57d35..d3f8356 100644 --- a/fast/Data/Reflection.hs +++ b/fast/Data/Reflection.hs -@@ -58,7 +58,7 @@ module Data.Reflection +@@ -59,7 +59,7 @@ module Data.Reflection , Given(..) , give -- * Template Haskell reflection @@ -20,94 +20,40 @@ index 119d773..cf99efa 100644 -- * Useful compile time naturals , Z, D, SD, PD ) where -@@ -151,87 +151,9 @@ instance Reifies n Int => Reifies (PD n) Int where - reflect = (\n -> n + n - 1) <$> retagPD reflect - {-# INLINE reflect #-} +@@ -161,6 +161,7 @@ instance Reifies n Int => Reifies (PD n) Int where + -- instead of @$(int 3)@. Sometimes the two will produce the same + -- representation (if compiled without the @-DUSE_TYPE_LITS@ preprocessor + -- directive). ++{- + int :: Int -> TypeQ + int n = case quotRem n 2 of + (0, 0) -> conT ''Z +@@ -176,7 +177,7 @@ nat :: Int -> TypeQ + nat n + | n >= 0 = int n + | otherwise = error "nat: negative" +- ++-} + #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL < 704 + instance Show (Q a) + instance Eq (Q a) +@@ -195,6 +196,7 @@ instance Fractional a => Fractional (Q a) where + recip = fmap recip + fromRational = return . fromRational ---- | This can be used to generate a template haskell splice for a type level version of a given 'int'. ---- ---- This does not use GHC TypeLits, instead it generates a numeric type by hand similar to the ones used ---- in the \"Functional Pearl: Implicit Configurations\" paper by Oleg Kiselyov and Chung-Chieh Shan. --int :: Int -> TypeQ --int n = case quotRem n 2 of -- (0, 0) -> conT ''Z -- (q,-1) -> conT ''PD `appT` int q -- (q, 0) -> conT ''D `appT` int q -- (q, 1) -> conT ''SD `appT` int q -- _ -> error "ghc is bad at math" ++{- + -- | This permits the use of $(5) as a type splice. + instance Num Type where + #ifdef USE_TYPE_LITS +@@ -254,7 +256,7 @@ instance Num Exp where + abs = onProxyType1 abs + signum = onProxyType1 signum + fromInteger n = ConE 'Proxy `SigE` (ConT ''Proxy `AppT` fromInteger n) - ---- | This is a restricted version of 'int' that can only generate natural numbers. Attempting to generate ---- a negative number results in a compile time error. Also the resulting sequence will consist entirely of ---- Z, D, and SD constructors representing the number in zeroless binary. --nat :: Int -> TypeQ --nat n -- | n >= 0 = int n -- | otherwise = error "nat: negative" -- --#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL < 704 --instance Show (Q a) --instance Eq (Q a) --#endif --instance Num a => Num (Q a) where -- (+) = liftM2 (+) -- (*) = liftM2 (*) -- (-) = liftM2 (-) -- negate = fmap negate -- abs = fmap abs -- signum = fmap signum -- fromInteger = return . fromInteger -- --instance Fractional a => Fractional (Q a) where -- (/) = liftM2 (/) -- recip = fmap recip -- fromRational = return . fromRational -- ---- | This permits the use of $(5) as a type splice. --instance Num Type where --#ifdef USE_TYPE_LITS -- a + b = AppT (AppT (VarT ''(+)) a) b -- a * b = AppT (AppT (VarT ''(*)) a) b --#if MIN_VERSION_base(4,8,0) -- a - b = AppT (AppT (VarT ''(-)) a) b --#else -- (-) = error "Type.(-): undefined" --#endif -- fromInteger = LitT . NumTyLit --#else -- (+) = error "Type.(+): undefined" -- (*) = error "Type.(*): undefined" -- (-) = error "Type.(-): undefined" -- fromInteger n = case quotRem n 2 of -- (0, 0) -> ConT ''Z -- (q,-1) -> ConT ''PD `AppT` fromInteger q -- (q, 0) -> ConT ''D `AppT` fromInteger q -- (q, 1) -> ConT ''SD `AppT` fromInteger q -- _ -> error "ghc is bad at math" --#endif -- abs = error "Type.abs" -- signum = error "Type.signum" -- - plus, times, minus :: Num a => a -> a -> a - plus = (+) - times = (*) - minus = (-) - fract :: Fractional a => a -> a -> a - fract = (/) -- ---- | This permits the use of $(5) as an expression splice. --instance Num Exp where -- a + b = AppE (AppE (VarE 'plus) a) b -- a * b = AppE (AppE (VarE 'times) a) b -- a - b = AppE (AppE (VarE 'minus) a) b -- negate = AppE (VarE 'negate) -- signum = AppE (VarE 'signum) -- abs = AppE (VarE 'abs) -- fromInteger = LitE . IntegerL -- --instance Fractional Exp where -- a / b = AppE (AppE (VarE 'fract) a) b -- recip = AppE (VarE 'recip) -- fromRational = LitE . RationalL ++-} + #ifdef USE_TYPE_LITS + addProxy :: Proxy a -> Proxy b -> Proxy (a + b) + addProxy _ _ = Proxy -- -1.8.5.1 +1.9.0 diff --git a/standalone/no-th/haskell-patches/shakespeare_1.0.3_0001-export-symbol-used-by-TH-splices.patch b/standalone/no-th/haskell-patches/shakespeare_1.0.3_0001-export-symbol-used-by-TH-splices.patch deleted file mode 100644 index 51443b5d4e..0000000000 --- a/standalone/no-th/haskell-patches/shakespeare_1.0.3_0001-export-symbol-used-by-TH-splices.patch +++ /dev/null @@ -1,26 +0,0 @@ -From 4a75a2f0d77168aa3115b991284a5120484e18f0 Mon Sep 17 00:00:00 2001 -From: foo -Date: Sun, 22 Sep 2013 04:59:21 +0000 -Subject: [PATCH] TH exports - ---- - Text/Shakespeare.hs | 3 +++ - 1 file changed, 3 insertions(+) - -diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs -index 9eb06a2..1290ab1 100644 ---- a/Text/Shakespeare.hs -+++ b/Text/Shakespeare.hs -@@ -23,6 +23,9 @@ module Text.Shakespeare - , Deref - , Parser - -+ -- used by TH -+ , pack' -+ - #ifdef TEST_EXPORT - , preFilter - #endif --- -1.7.10.4 - diff --git a/standalone/no-th/haskell-patches/shakespeare_1.0.3_0002-remove-TH.patch b/standalone/no-th/haskell-patches/shakespeare_remove-th.patch similarity index 59% rename from standalone/no-th/haskell-patches/shakespeare_1.0.3_0002-remove-TH.patch rename to standalone/no-th/haskell-patches/shakespeare_remove-th.patch index 38c2cb0128..024ec2e203 100644 --- a/standalone/no-th/haskell-patches/shakespeare_1.0.3_0002-remove-TH.patch +++ b/standalone/no-th/haskell-patches/shakespeare_remove-th.patch @@ -1,39 +1,44 @@ -From b66f160fea86d8839572620892181eb4ada2ad29 Mon Sep 17 00:00:00 2001 +From 753f8ce37e096a343f1dd02a696a287bc91c24a0 Mon Sep 17 00:00:00 2001 From: Joey Hess -Date: Tue, 17 Dec 2013 06:17:26 +0000 -Subject: [PATCH 2/2] remove TH +Date: Thu, 6 Mar 2014 22:34:03 +0000 +Subject: [PATCH] remove TH --- - Text/Shakespeare.hs | 131 +++-------------------------------------------- - Text/Shakespeare/Base.hs | 28 ---------- - 2 files changed, 6 insertions(+), 153 deletions(-) + Text/Shakespeare.hs | 73 ++++++++++-------------------------------------- + Text/Shakespeare/Base.hs | 28 ------------------- + 2 files changed, 14 insertions(+), 87 deletions(-) diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs -index f908ff4..55cd1d1 100644 +index 68e344f..aef741c 100644 --- a/Text/Shakespeare.hs +++ b/Text/Shakespeare.hs -@@ -12,14 +12,14 @@ module Text.Shakespeare +@@ -14,17 +14,20 @@ module Text.Shakespeare , WrapInsertion (..) , PreConversion (..) , defaultShakespeareSettings - , shakespeare - , shakespeareFile - , shakespeareFileReload -+ --, shakespeare -+ --, shakespeareFile ++ -- , shakespeare ++ -- , shakespeareFile + -- , shakespeareFileReload -- * low-level - , shakespeareFromString - , shakespeareUsedIdentifiers + -- , shakespeareFromString -+ --, shakespeareUsedIdentifiers ++ -- , shakespeareUsedIdentifiers , RenderUrl -- , VarType -+ --, VarType + , VarType (..) , Deref , Parser -@@ -151,38 +151,6 @@ defaultShakespeareSettings = ShakespeareSettings { ++ -- used by TH ++ , pack' ++ + #ifdef TEST_EXPORT + , preFilter + #endif +@@ -154,38 +157,6 @@ defaultShakespeareSettings = ShakespeareSettings { , modifyFinalValue = Nothing } @@ -72,85 +77,46 @@ index f908ff4..55cd1d1 100644 type QueryParameters = [(TS.Text, TS.Text)] type RenderUrl url = (url -> QueryParameters -> TS.Text) -@@ -346,77 +314,12 @@ pack' = TS.pack +@@ -349,6 +320,7 @@ pack' = TS.pack {-# NOINLINE pack' #-} #endif --contentsToShakespeare :: ShakespeareSettings -> [Content] -> Q Exp --contentsToShakespeare rs a = do -- r <- newName "_render" -- c <- mapM (contentToBuilder r) a -- compiledTemplate <- case c of -- -- Make sure we convert this mempty using toBuilder to pin down the -- -- type appropriately -- [] -> fmap (AppE $ wrap rs) [|mempty|] -- [x] -> return x -- _ -> do -- mc <- [|mconcat|] -- return $ mc `AppE` ListE c -- fmap (maybe id AppE $ modifyFinalValue rs) $ -- if justVarInterpolation rs -- then return compiledTemplate -- else return $ LamE [VarP r] compiledTemplate -- where -- contentToBuilder :: Name -> Content -> Q Exp -- contentToBuilder _ (ContentRaw s') = do -- ts <- [|fromText . pack'|] -- return $ wrap rs `AppE` (ts `AppE` LitE (StringL s')) -- contentToBuilder _ (ContentVar d) = -- return $ (toBuilder rs `AppE` derefToExp [] d) -- contentToBuilder r (ContentUrl d) = do -- ts <- [|fromText|] -- return $ wrap rs `AppE` (ts `AppE` (VarE r `AppE` derefToExp [] d `AppE` ListE [])) -- contentToBuilder r (ContentUrlParam d) = do -- ts <- [|fromText|] -- up <- [|\r' (u, p) -> r' u p|] -- return $ wrap rs `AppE` (ts `AppE` (up `AppE` VarE r `AppE` derefToExp [] d)) -- contentToBuilder r (ContentMix d) = -- return $ derefToExp [] d `AppE` VarE r -- --shakespeare :: ShakespeareSettings -> QuasiQuoter --shakespeare r = QuasiQuoter { quoteExp = shakespeareFromString r } -- --shakespeareFromString :: ShakespeareSettings -> String -> Q Exp --shakespeareFromString r str = do -- s <- qRunIO $ preFilter Nothing r $ --#ifdef WINDOWS -- filter (/='\r') --#endif -- str -- contentsToShakespeare r $ contentFromString r s -- --shakespeareFile :: ShakespeareSettings -> FilePath -> Q Exp --shakespeareFile r fp = do --#ifdef GHC_7_4 -- qAddDependentFile fp --#endif -- readFileQ fp >>= shakespeareFromString r -- --data VarType = VTPlain | VTUrl | VTUrlParam | VTMixin -- --getVars :: Content -> [(Deref, VarType)] --getVars ContentRaw{} = [] --getVars (ContentVar d) = [(d, VTPlain)] --getVars (ContentUrl d) = [(d, VTUrl)] --getVars (ContentUrlParam d) = [(d, VTUrlParam)] --getVars (ContentMix d) = [(d, VTMixin)] ++{- + contentsToShakespeare :: ShakespeareSettings -> [Content] -> Q Exp + contentsToShakespeare rs a = do + r <- newName "_render" +@@ -400,16 +372,19 @@ shakespeareFile r fp = + qAddDependentFile fp >> + #endif + readFileQ fp >>= shakespeareFromString r ++-} + + data VarType = VTPlain | VTUrl | VTUrlParam | VTMixin + deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) + ++{- + getVars :: Content -> [(Deref, VarType)] + getVars ContentRaw{} = [] + getVars (ContentVar d) = [(d, VTPlain)] + getVars (ContentUrl d) = [(d, VTUrl)] + getVars (ContentUrlParam d) = [(d, VTUrlParam)] + getVars (ContentMix d) = [(d, VTMixin)] ++-} data VarExp url = EPlain Builder | EUrl url - | EUrlParam (url, [(TS.Text, TS.Text)]) - | EMixin (Shakespeare url) +@@ -418,8 +393,10 @@ data VarExp url = EPlain Builder + + -- | Determine which identifiers are used by the given template, useful for + -- creating systems like yesod devel. ++{- + shakespeareUsedIdentifiers :: ShakespeareSettings -> String -> [(Deref, VarType)] + shakespeareUsedIdentifiers settings = concatMap getVars . contentFromString settings ++-} ---- | Determine which identifiers are used by the given template, useful for ---- creating systems like yesod devel. --shakespeareUsedIdentifiers :: ShakespeareSettings -> String -> [(Deref, VarType)] --shakespeareUsedIdentifiers settings = concatMap getVars . contentFromString settings -- type MTime = UTCTime - {-# NOINLINE reloadMapRef #-} -@@ -432,28 +335,6 @@ insertReloadMap :: FilePath -> (MTime, [Content]) -> IO [Content] +@@ -436,28 +413,6 @@ insertReloadMap :: FilePath -> (MTime, [Content]) -> IO [Content] insertReloadMap fp (mt, content) = atomicModifyIORef reloadMapRef (\reloadMap -> (M.insert fp (mt, content) reloadMap, content)) @@ -180,7 +146,7 @@ index f908ff4..55cd1d1 100644 diff --git a/Text/Shakespeare/Base.hs b/Text/Shakespeare/Base.hs -index 9573533..49f1995 100644 +index a0e983c..23b4692 100644 --- a/Text/Shakespeare/Base.hs +++ b/Text/Shakespeare/Base.hs @@ -52,34 +52,6 @@ data Deref = DerefModulesIdent [String] Ident @@ -219,5 +185,5 @@ index 9573533..49f1995 100644 derefParens = between (char '(') (char ')') parseDeref derefCurlyBrackets = between (char '{') (char '}') parseDeref -- -1.8.5.1 +1.9.0 diff --git a/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch b/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch index adf0679ead..5609fb4598 100644 --- a/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch +++ b/standalone/no-th/haskell-patches/yesod-core_expand_TH.patch @@ -1,17 +1,19 @@ -From 5f30a68faaa379ac3fe9f0b016dd1a20969d548f Mon Sep 17 00:00:00 2001 +From be8d5895522da0397fd594d5553ed7d3641eb399 Mon Sep 17 00:00:00 2001 From: dummy -Date: Fri, 7 Feb 2014 23:04:06 +0000 +Date: Fri, 7 Mar 2014 01:40:29 +0000 Subject: [PATCH] remove and expand TH +fix Loc from MonadLogger --- - Yesod/Core.hs | 30 +++--- - Yesod/Core/Class/Yesod.hs | 248 ++++++++++++++++++++++++++++++-------------- - Yesod/Core/Dispatch.hs | 37 ++----- - Yesod/Core/Handler.hs | 25 ++--- - Yesod/Core/Internal/Run.hs | 4 +- - Yesod/Core/Internal/TH.hs | 111 -------------------- - Yesod/Core/Widget.hs | 32 +----- - 7 files changed, 209 insertions(+), 278 deletions(-) + Yesod/Core.hs | 30 +++--- + Yesod/Core/Class/Yesod.hs | 257 ++++++++++++++++++++++++++++++--------------- + Yesod/Core/Dispatch.hs | 37 ++----- + Yesod/Core/Handler.hs | 25 ++--- + Yesod/Core/Internal/Run.hs | 8 +- + Yesod/Core/Internal/TH.hs | 111 -------------------- + Yesod/Core/Types.hs | 3 +- + Yesod/Core/Widget.hs | 32 +----- + 8 files changed, 215 insertions(+), 288 deletions(-) diff --git a/Yesod/Core.hs b/Yesod/Core.hs index 12e59d5..2817a69 100644 @@ -67,10 +69,10 @@ index 12e59d5..2817a69 100644 , renderCssUrl ) where diff --git a/Yesod/Core/Class/Yesod.hs b/Yesod/Core/Class/Yesod.hs -index 140600b..6c718e2 100644 +index 140600b..75daabc 100644 --- a/Yesod/Core/Class/Yesod.hs +++ b/Yesod/Core/Class/Yesod.hs -@@ -5,11 +5,15 @@ +@@ -5,18 +5,22 @@ {-# LANGUAGE CPP #-} module Yesod.Core.Class.Yesod where @@ -87,7 +89,23 @@ index 140600b..6c718e2 100644 import Blaze.ByteString.Builder (Builder) import Blaze.ByteString.Builder.Char.Utf8 (fromText) -@@ -94,18 +98,27 @@ class RenderRoute site => Yesod site where + import Control.Arrow ((***), second) + import Control.Monad (forM, when, void) + import Control.Monad.IO.Class (MonadIO (liftIO)) +-import Control.Monad.Logger (LogLevel (LevelInfo, LevelOther), ++import Control.Monad.Logger (Loc, LogLevel (LevelInfo, LevelOther), + LogSource) + import qualified Data.ByteString.Char8 as S8 + import qualified Data.ByteString.Lazy as L +@@ -33,7 +37,6 @@ import qualified Data.Text.Encoding.Error as TEE + import Data.Text.Lazy.Builder (toLazyText) + import Data.Text.Lazy.Encoding (encodeUtf8) + import Data.Word (Word64) +-import Language.Haskell.TH.Syntax (Loc (..)) + import Network.HTTP.Types (encodePath) + import qualified Network.Wai as W + import Data.Default (def) +@@ -94,18 +97,27 @@ class RenderRoute site => Yesod site where defaultLayout w = do p <- widgetToPageContent w mmsg <- getMessage @@ -127,7 +145,7 @@ index 140600b..6c718e2 100644 -- | Override the rendering function for a particular URL. One use case for -- this is to offload static hosting to a different domain name to avoid -@@ -374,45 +387,103 @@ widgetToPageContent w = do +@@ -374,45 +386,103 @@ widgetToPageContent w = do -- modernizr should be at the end of the http://www.modernizr.com/docs/#installing -- the asynchronous loader means your page doesn't have to wait for all the js to load let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc @@ -270,7 +288,7 @@ index 140600b..6c718e2 100644 return $ PageContent title headAll $ case jsLoader master of -@@ -442,10 +513,13 @@ defaultErrorHandler NotFound = selectRep $ do +@@ -442,10 +512,13 @@ defaultErrorHandler NotFound = selectRep $ do r <- waiRequest let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r setTitle "Not Found" @@ -288,7 +306,7 @@ index 140600b..6c718e2 100644 provideRep $ return $ object ["message" .= ("Not Found" :: Text)] -- For API requests. -@@ -455,10 +529,11 @@ defaultErrorHandler NotFound = selectRep $ do +@@ -455,10 +528,11 @@ defaultErrorHandler NotFound = selectRep $ do defaultErrorHandler NotAuthenticated = selectRep $ do provideRep $ defaultLayout $ do setTitle "Not logged in" @@ -304,7 +322,7 @@ index 140600b..6c718e2 100644 provideRep $ do -- 401 *MUST* include a WWW-Authenticate header -@@ -480,10 +555,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do +@@ -480,10 +554,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do defaultErrorHandler (PermissionDenied msg) = selectRep $ do provideRep $ defaultLayout $ do setTitle "Permission Denied" @@ -322,7 +340,7 @@ index 140600b..6c718e2 100644 provideRep $ return $ object $ [ "message" .= ("Permission Denied. " <> msg) -@@ -492,30 +570,42 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do +@@ -492,30 +569,42 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do defaultErrorHandler (InvalidArgs ia) = selectRep $ do provideRep $ defaultLayout $ do setTitle "Invalid Arguments" @@ -380,6 +398,16 @@ index 140600b..6c718e2 100644 provideRep $ return $ object ["message" .= ("Bad method" :: Text), "method" .= TE.decodeUtf8With TEE.lenientDecode m] asyncHelper :: (url -> [x] -> Text) +@@ -682,8 +771,4 @@ loadClientSession key getCachedDate sessionName req = load + -- turn the TH Loc loaction information into a human readable string + -- leaving out the loc_end parameter + fileLocationToString :: Loc -> String +-fileLocationToString loc = (loc_package loc) ++ ':' : (loc_module loc) ++ +- ' ' : (loc_filename loc) ++ ':' : (line loc) ++ ':' : (char loc) +- where +- line = show . fst . loc_start +- char = show . snd . loc_start ++fileLocationToString loc = "unknown" diff --git a/Yesod/Core/Dispatch.hs b/Yesod/Core/Dispatch.hs index e6f489d..3ff37c1 100644 --- a/Yesod/Core/Dispatch.hs @@ -506,18 +534,29 @@ index 7c561c5..847d475 100644 -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'. hamletToRepHtml :: MonadHandler m => HtmlUrl (Route (HandlerSite m)) -> m Html diff --git a/Yesod/Core/Internal/Run.hs b/Yesod/Core/Internal/Run.hs -index 10871a2..6ed631e 100644 +index 10871a2..e8d1907 100644 --- a/Yesod/Core/Internal/Run.hs +++ b/Yesod/Core/Internal/Run.hs -@@ -16,7 +16,7 @@ import Control.Exception.Lifted (catch) +@@ -15,8 +15,8 @@ import qualified Control.Exception as E + import Control.Exception.Lifted (catch) import Control.Monad.IO.Class (MonadIO) import Control.Monad.IO.Class (liftIO) - import Control.Monad.Logger (LogLevel (LevelError), LogSource, +-import Control.Monad.Logger (LogLevel (LevelError), LogSource, - liftLoc) ++import Control.Monad.Logger (Loc, LogLevel (LevelError), LogSource, + ) import Control.Monad.Trans.Resource (runResourceT, withInternalState, runInternalState, createInternalState, closeInternalState) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 +@@ -30,7 +30,7 @@ import qualified Data.Text as T + import Data.Text.Encoding (encodeUtf8) + import Data.Text.Encoding (decodeUtf8With) + import Data.Text.Encoding.Error (lenientDecode) +-import Language.Haskell.TH.Syntax (Loc, qLocation) ++import Language.Haskell.TH.Syntax (qLocation) + import qualified Network.HTTP.Types as H + import Network.Wai + #if MIN_VERSION_wai(2, 0, 0) @@ -131,8 +131,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> ErrorResponse -> YesodApp @@ -646,6 +685,27 @@ index 7e84c1c..a273c29 100644 - [innerFun] - ] - return $ LetE [fun] (VarE helper) +diff --git a/Yesod/Core/Types.hs b/Yesod/Core/Types.hs +index de09f78..9183a64 100644 +--- a/Yesod/Core/Types.hs ++++ b/Yesod/Core/Types.hs +@@ -17,6 +17,7 @@ import Control.Exception (Exception) + import Control.Monad (liftM, ap) + import Control.Monad.Base (MonadBase (liftBase)) + import Control.Monad.IO.Class (MonadIO (liftIO)) ++import qualified Control.Monad.Logger + import Control.Monad.Logger (LogLevel, LogSource, + MonadLogger (..)) + import Control.Monad.Trans.Control (MonadBaseControl (..)) +@@ -179,7 +180,7 @@ data RunHandlerEnv site = RunHandlerEnv + , rheRoute :: !(Maybe (Route site)) + , rheSite :: !site + , rheUpload :: !(RequestBodyLength -> FileUpload) +- , rheLog :: !(Loc -> LogSource -> LogLevel -> LogStr -> IO ()) ++ , rheLog :: !(Control.Monad.Logger.Loc -> LogSource -> LogLevel -> LogStr -> IO ()) + , rheOnError :: !(ErrorResponse -> YesodApp) + -- ^ How to respond when an error is thrown internally. + -- diff --git a/Yesod/Core/Widget.hs b/Yesod/Core/Widget.hs index a972efa..156cd45 100644 --- a/Yesod/Core/Widget.hs @@ -707,5 +767,5 @@ index a972efa..156cd45 100644 ihamletToRepHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message) => HtmlUrlI18n message (Route (HandlerSite m)) -- -1.7.10.4 +1.9.0 diff --git a/standalone/no-th/haskell-patches/yesod-static_hack.patch b/standalone/no-th/haskell-patches/yesod-static_hack.patch index 678b8439ba..4cf977bae4 100644 --- a/standalone/no-th/haskell-patches/yesod-static_hack.patch +++ b/standalone/no-th/haskell-patches/yesod-static_hack.patch @@ -1,17 +1,17 @@ -From 4ea1e94794b59ba4eb0dab7384c4195a224f468d Mon Sep 17 00:00:00 2001 -From: androidbuilder -Date: Fri, 27 Dec 2013 00:28:51 -0400 +From 885cc873196f535de7cd1ac2ccfa217d10308d1f Mon Sep 17 00:00:00 2001 +From: dummy +Date: Fri, 7 Mar 2014 02:28:34 +0000 Subject: [PATCH] avoid building with jsmin jsmin needs language-javascript, which fails to build for android due to a problem or incompatability with happy. This also avoids all the TH code. - --- - Yesod/EmbeddedStatic/Generators.hs | 3 +-- - yesod-static.cabal | 7 ------- - 2 files changed, 1 insertion(+), 9 deletions(-) + Yesod/EmbeddedStatic/Generators.hs | 3 +-- + Yesod/Static.hs | 29 ++++++++++++++++++----------- + yesod-static.cabal | 7 ------- + 3 files changed, 19 insertions(+), 20 deletions(-) diff --git a/Yesod/EmbeddedStatic/Generators.hs b/Yesod/EmbeddedStatic/Generators.hs index e83785d..6b1c10e 100644 @@ -34,8 +34,132 @@ index e83785d..6b1c10e 100644 -- | Use to compress javascript. -- Assumes @uglifyjs@ is located in the path and uses options @[\"-m\", \"-c\"]@ +diff --git a/Yesod/Static.hs b/Yesod/Static.hs +index dd21791..37f7e00 100644 +--- a/Yesod/Static.hs ++++ b/Yesod/Static.hs +@@ -37,8 +37,8 @@ module Yesod.Static + , staticDevel + -- * Combining CSS/JS + -- $combining +- , combineStylesheets' +- , combineScripts' ++ --, combineStylesheets' ++ --, combineScripts' + -- ** Settings + , CombineSettings + , csStaticDir +@@ -48,13 +48,13 @@ module Yesod.Static + , csJsPreProcess + , csCombinedFolder + -- * Template Haskell helpers +- , staticFiles +- , staticFilesList +- , publicFiles ++ --, staticFiles ++ --, staticFilesList ++ --, publicFiles + -- * Hashing + , base64md5 + -- * Embed +- , embed ++ --, embed + #ifdef TEST_EXPORT + , getFileListPieces + #endif +@@ -64,7 +64,7 @@ import Prelude hiding (FilePath) + import qualified Prelude + import System.Directory + import Control.Monad +-import Data.FileEmbed (embedDir) ++import Data.FileEmbed + + import Yesod.Core + import Yesod.Core.Types +@@ -135,6 +135,7 @@ staticDevel dir = do + hashLookup <- cachedETagLookupDevel dir + return $ Static $ webAppSettingsWithLookup (F.decodeString dir) hashLookup + ++{- + -- | Produce a 'Static' based on embedding all of the static files' contents in the + -- executable at compile time. + -- +@@ -149,6 +150,7 @@ staticDevel dir = do + -- This will cause yesod to embed those assets into the generated HTML file itself. + embed :: Prelude.FilePath -> Q Exp + embed fp = [|Static (embeddedSettings $(embedDir fp))|] ++-} + + instance RenderRoute Static where + -- | A route on the static subsite (see also 'staticFiles'). +@@ -214,6 +216,7 @@ getFileListPieces = flip evalStateT M.empty . flip go id + put $ M.insert s s m + return s + ++{- + -- | Template Haskell function that automatically creates routes + -- for all of your static files. + -- +@@ -266,7 +269,7 @@ staticFilesList dir fs = + -- see if their copy is up-to-date. + publicFiles :: Prelude.FilePath -> Q [Dec] + publicFiles dir = mkStaticFiles' dir "StaticRoute" False +- ++-} + + mkHashMap :: Prelude.FilePath -> IO (M.Map F.FilePath S8.ByteString) + mkHashMap dir = do +@@ -309,6 +312,7 @@ cachedETagLookup dir = do + etags <- mkHashMap dir + return $ (\f -> return $ M.lookup f etags) + ++{- + mkStaticFiles :: Prelude.FilePath -> Q [Dec] + mkStaticFiles fp = mkStaticFiles' fp "StaticRoute" True + +@@ -356,6 +360,7 @@ mkStaticFilesList fp fs routeConName makeHash = do + [ Clause [] (NormalB $ (ConE route) `AppE` f' `AppE` qs) [] + ] + ] ++-} + + base64md5File :: Prelude.FilePath -> IO String + base64md5File = fmap (base64 . encode) . hashFile +@@ -394,7 +399,7 @@ base64 = map tr + -- single static file at compile time. + + data CombineType = JS | CSS +- ++{- + combineStatics' :: CombineType + -> CombineSettings + -> [Route Static] -- ^ files to combine +@@ -428,7 +433,7 @@ combineStatics' combineType CombineSettings {..} routes = do + case combineType of + JS -> "js" + CSS -> "css" +- ++-} + -- | Data type for holding all settings for combining files. + -- + -- This data type is a settings type. For more information, see: +@@ -504,6 +509,7 @@ instance Default CombineSettings where + errorIntro :: [FilePath] -> [Char] -> [Char] + errorIntro fps s = "Error minifying " ++ show fps ++ ": " ++ s + ++{- + liftRoutes :: [Route Static] -> Q Exp + liftRoutes = + fmap ListE . mapM go +@@ -550,4 +556,5 @@ combineScripts' :: Bool -- ^ development? if so, perform no combining + -> Q Exp + combineScripts' development cs con routes + | development = [| mapM_ (addScript . $(return $ ConE con)) $(liftRoutes routes) |] +- | otherwise = [| addScript $ $(return $ ConE con) $(combineStatics' JS cs routes) |] ++ | otherwise = [| addScript $ $(return $ ConE con) $(combineStatics' JS cs routes) |]a ++-} diff --git a/yesod-static.cabal b/yesod-static.cabal -index df05ecf..31abe1a 100644 +index 3423149..416aae6 100644 --- a/yesod-static.cabal +++ b/yesod-static.cabal @@ -48,18 +48,12 @@ library @@ -66,5 +190,5 @@ index df05ecf..31abe1a 100644 , filepath , resourcet -- -1.7.10.4 +1.9.0 diff --git a/standalone/no-th/haskell-patches/yesod_hack-TH.patch b/standalone/no-th/haskell-patches/yesod_hack-TH.patch index 4ee8aa5bb2..b8991b86ef 100644 --- a/standalone/no-th/haskell-patches/yesod_hack-TH.patch +++ b/standalone/no-th/haskell-patches/yesod_hack-TH.patch @@ -1,13 +1,13 @@ -From 69398345ff1e63bcc6a23fce18e42390328b78d2 Mon Sep 17 00:00:00 2001 +From 369c99b9de0c82578f5221fdabc42ea9ba59ddea Mon Sep 17 00:00:00 2001 From: dummy -Date: Tue, 17 Dec 2013 18:48:56 +0000 -Subject: [PATCH] hack for TH +Date: Fri, 7 Mar 2014 04:10:02 +0000 +Subject: [PATCH] hack to TH --- - Yesod.hs | 19 ++++++++++++-- - Yesod/Default/Main.hs | 23 ----------------- - Yesod/Default/Util.hs | 69 ++----------------------------------------------- - 3 files changed, 19 insertions(+), 92 deletions(-) + Yesod.hs | 19 ++++++++++++-- + Yesod/Default/Main.hs | 25 +------------------ + Yesod/Default/Util.hs | 69 ++------------------------------------------------- + 3 files changed, 20 insertions(+), 93 deletions(-) diff --git a/Yesod.hs b/Yesod.hs index b367144..fbe309c 100644 @@ -41,7 +41,7 @@ index b367144..fbe309c 100644 +insert = undefined + diff --git a/Yesod/Default/Main.hs b/Yesod/Default/Main.hs -index 0780539..2c73800 100644 +index 0780539..ad99ccd 100644 --- a/Yesod/Default/Main.hs +++ b/Yesod/Default/Main.hs @@ -1,10 +1,8 @@ @@ -55,6 +55,15 @@ index 0780539..2c73800 100644 , defaultRunner , defaultDevelApp , LogFunc +@@ -22,7 +20,7 @@ import Control.Monad (when) + import System.Environment (getEnvironment) + import Data.Maybe (fromMaybe) + import Safe (readMay) +-import Control.Monad.Logger (Loc, LogSource, LogLevel (LevelError), liftLoc) ++import Control.Monad.Logger (Loc, LogSource, LogLevel (LevelError)) + import System.Log.FastLogger (LogStr, toLogStr) + import Language.Haskell.TH.Syntax (qLocation) + @@ -54,27 +52,6 @@ defaultMain load getApp = do type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO () @@ -180,5 +189,5 @@ index a10358e..0547424 100644 - else return $ Just ex - else return Nothing -- -1.7.10.4 +1.9.0 diff --git a/static/favicon.ico b/static/favicon.ico index 5bb405931f..e754f5a48b 100644 Binary files a/static/favicon.ico and b/static/favicon.ico differ diff --git a/templates/repolist.hamlet b/templates/repolist.hamlet index f501cb20b3..0dc92ed4c0 100644 --- a/templates/repolist.hamlet +++ b/templates/repolist.hamlet @@ -39,13 +39,15 @@ $else - settings + actions