packages feed

git-annex 5.20140306 → 5.20140320

raw patch · 190 files changed

+3205/−1937 lines, 190 filesdep +byteabledep +securememdep ~warp-tlssetup-changedbinary-added

Dependencies added: byteable, securemem

Dependency ranges changed: warp-tls

Files

Annex.hs view
@@ -60,6 +60,7 @@ 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 @@ 	, 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 @@ 	, 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 @@ 	, gitconfig = c 	, backends = [] 	, remotes = []+	, remoteannexstate = M.empty 	, output = defaultMessageState 	, force = False 	, fast = False@@ -208,9 +211,9 @@ 	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 ()
Annex/CatFile.hs view
@@ -80,7 +80,7 @@ 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
Annex/Content.hs view
@@ -24,6 +24,7 @@ 	removeAnnex, 	fromAnnex, 	moveBad,+	KeyLocation(..), 	getKeysPresent, 	saveState, 	downloadUrl,@@ -466,22 +467,33 @@ 	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,14 +501,30 @@ 		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.  -
Annex/FileMatcher.hs view
@@ -56,23 +56,27 @@ 	([], 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 @@   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 @@ 		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
Annex/Init.hs view
@@ -198,7 +198,7 @@  -} fixBadBare :: Annex () fixBadBare = whenM checkBadBare $ do-	ks <- getKeysPresent+	ks <- getKeysPresent InAnnex 	liftIO $ debugM "Init" $ unwords 		[ "Detected bad bare repository with" 		, show (length ks)
Annex/MetaData.hs view
@@ -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 @@ -18,15 +22,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.
+ Annex/MetaData/StandardFields.hs view
@@ -0,0 +1,47 @@+{- git-annex metadata, standard fields+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - 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"
Annex/Ssh.hs view
@@ -9,7 +9,6 @@  module Annex.Ssh ( 	sshCachingOptions,-	sshCleanup, 	sshCacheDir, 	sshReadPort, ) where@@ -24,6 +23,7 @@ import qualified Annex import Config import Utility.Env+import Types.CleanupActions #ifndef mingw32_HOST_OS import Annex.Perms #endif@@ -31,7 +31,9 @@ {- 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 @@ 			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.
Assistant.hs view
@@ -45,7 +45,6 @@ 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
Assistant/Alert/Utility.hs view
@@ -14,6 +14,7 @@ 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 @@ 	(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
Assistant/Install/Menu.hs view
@@ -21,7 +21,7 @@ 	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
Assistant/Threads/WebApp.hs view
@@ -73,7 +73,7 @@ #endif 	webapp <- WebApp 		<$> pure assistantdata-		<*> (pack <$> genRandomToken)+		<*> genAuthToken 		<*> getreldir 		<*> pure staticRoutes 		<*> pure postfirstrun@@ -125,9 +125,13 @@  getTlsSettings :: Annex (Maybe TLS.TLSSettings) getTlsSettings = do+#ifdef WITH_WEBAPP_SECURE 	cert <- fromRepo gitAnnexWebCertificate 	privkey <- fromRepo gitAnnexWebPrivKey 	ifM (liftIO $ allM doesFileExist [cert, privkey]) 		( return $ Just $ TLS.tlsSettings cert privkey 		, return Nothing 		)+#else+	return Nothing+#endif
Assistant/WebApp.hs view
@@ -14,6 +14,7 @@ import Assistant.Common import Utility.NotificationBroadcaster import Utility.Yesod+import Utility.WebApp  import Data.Text (Text) import Control.Concurrent@@ -36,7 +37,7 @@ webAppFormAuthToken :: Widget webAppFormAuthToken = do 	webapp <- liftH getYesod-	[whamlet|<input type="hidden" name="auth" value="#{secretToken webapp}">|]+	[whamlet|<input type="hidden" name="auth" value="#{fromAuthToken (authToken webapp)}">|]  {- A button with an icon, and maybe label or tooltip, that can be  - clicked to perform some action.
Assistant/WebApp/Notifications.hs view
@@ -22,6 +22,7 @@ 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 @@ 		[ "/" 		, T.intercalate "/" urlbits 		, "?auth="-		, secretToken webapp+		, fromAuthToken (authToken webapp) 		]  getNotifierTransfersR :: Handler RepPlain
Assistant/WebApp/RepoList.hs view
@@ -31,6 +31,7 @@ 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 @@ 	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
Assistant/WebApp/Types.hs view
@@ -41,7 +41,7 @@  data WebApp = WebApp 	{ assistantData :: AssistantData-	, secretToken :: Text+	, authToken :: AuthToken 	, relDir :: Maybe FilePath 	, getStatic :: Static 	, postFirstRun :: Maybe (IO String)@@ -52,11 +52,11 @@  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"
Assistant/WebApp/routes view
@@ -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
Build/Configure.hs view
@@ -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
Build/DesktopFile.hs view
@@ -24,9 +24,7 @@ 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
Build/NullSoftInstaller.hs view
@@ -67,7 +67,7 @@ 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"
Build/TestConfig.hs view
@@ -7,8 +7,6 @@ import Utility.SafeCommand  import System.IO-import System.Cmd-import System.Exit import System.FilePath import System.Directory
BuildFlags.hs view
@@ -14,21 +14,36 @@ 	[ "" #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_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"@@ -44,21 +59,29 @@ #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"
CHANGELOG view
@@ -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 <joeyh@debian.org>  Thu, 20 Mar 2014 13:21:12 -0400+ git-annex (5.20140306) unstable; urgency=high    * sync: Fix bug in direct mode that caused a file that was not
CmdLine.hs view
@@ -26,7 +26,6 @@ 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 @@ 	saveState nocommit 	sequence_ =<< M.elems <$> Annex.getState Annex.cleanup 	liftIO reapZombies -- zombies from long-running git processes-	sshCleanup -- ssh connection caching
CmdLine/Usage.hs view
@@ -73,6 +73,8 @@ paramNumRange = "NUM|RANGE" paramRemote :: String paramRemote = "REMOTE"+paramField :: String+paramField = "FIELD" paramGlob :: String paramGlob = "GLOB" paramName :: String
Command/Add.hs view
@@ -93,12 +93,15 @@  - 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
Command/Fsck.hs view
@@ -29,6 +29,7 @@ import Utility.FileMode import Config import Types.Key+import Types.CleanupActions import Utility.HumanTime import Git.FilePath import Utility.PID@@ -93,7 +94,7 @@  	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
Command/Info.hs view
@@ -281,7 +281,7 @@ 	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
Command/Map.hs view
@@ -158,7 +158,8 @@ 	| 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 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 @@   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'
Command/MetaData.hs view
@@ -12,16 +12,24 @@ 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 @@   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 @@ 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
Command/Move.hs view
@@ -69,20 +69,29 @@ 	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 @@ 						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 @@ 			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.
Command/Sync.hs view
@@ -376,5 +376,5 @@ 	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)
Command/Uninit.hs view
@@ -53,7 +53,7 @@ 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
Command/Unused.hs view
@@ -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 @@ 		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 @@ 	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
Command/Vicfg.hs view
@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2012 Joey Hess <joey@kitenet.net>+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -60,7 +60,8 @@ 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 @@ 	<$> 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 @@ 		, 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,34 +133,61 @@ 	  where 	  	grouplist = unwords $ map fromStandardGroup [minBound..] -	preferredcontent = settings cfgPreferredContentMap-		[ ""-		, com "Repository preferred contents"+	preferredcontent = settings cfg descs cfgPreferredContentMap+		[ com "Repository preferred contents" ]+		(\(s, u) -> line "wanted" u s)+		(\u -> line "wanted" u "standard")++	grouppreferredcontent = settings' cfg allgroups cfgGroupPreferredContentMap+		[ com "Group preferred contents"+		, com "(Used by repositories with \"groupwanted\" in their preferred contents)" 		]-		(\(s, u) -> line "content" u s)-		(\u -> line "content" u "")+		(\(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] -	schedule = settings cfgScheduleMap-		[ ""-		, com "Scheduled activities"+	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. -} parseCfg :: Cfg -> String -> Either String Cfg@@ -163,16 +204,16 @@ 	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 @@ 		| 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 @@  	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
Git/CatFile.hs view
@@ -108,6 +108,6 @@ 	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
Git/Fsck.hs view
@@ -23,10 +23,17 @@ 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 @@ 	(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.  -@@ -68,6 +87,11 @@  -} 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
Git/Repair.hs view
@@ -1,7 +1,6 @@ {- git repository recovery-import qualified Data.Set as S  -- - Copyright 2013 Joey Hess <joey@kitenet.net>+ - Copyright 2013-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -45,35 +44,18 @@ 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 @@ 				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 @@ 					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 @@ 			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 @@  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 @@ 					) 			| otherwise -> if forced 				then ifM (checkIndex g)-					( continuerepairs s+					( forcerepair s t 					, corruptedindex 					) 				else do@@ -493,17 +478,17 @@ 		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 @@ 				, 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 @@ 		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
Limit.hs view
@@ -94,18 +94,16 @@ {- 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 @@  {- 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
Logs.hs view
@@ -24,7 +24,7 @@ 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 @@ 	, locationLogFileKey f 	] +{- Logs that are neither UUID based nor presence logs. -}+otherLogs :: [FilePath]+otherLogs =+	[ numcopiesLog+	, groupPreferredContentLog+	]+ uuidLog :: FilePath uuidLog = "uuid.log" @@ -62,6 +69,9 @@  preferredContentLog :: FilePath preferredContentLog = "preferred-content.log"++groupPreferredContentLog :: FilePath+groupPreferredContentLog = "group-preferred-content.log"  scheduleLog :: FilePath scheduleLog = "schedule.log"
Logs/FsckResults.hs view
@@ -23,25 +23,31 @@ 	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
+ Logs/MapLog.hs view
@@ -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 <joey@kitenet.net>+ -+ - 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")]
Logs/MetaData.hs view
@@ -36,26 +36,54 @@  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 @@  - 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 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
Logs/PreferredContent.hs view
@@ -1,6 +1,6 @@ {- git-annex preferred content matcher configuration  -- - Copyright 2012 Joey Hess <joey@kitenet.net>+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>  -  - 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 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 = 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. -}
Logs/PreferredContent/Raw.hs view
@@ -1,6 +1,6 @@ {- unparsed preferred content expressions  -- - Copyright 2012 Joey Hess <joey@kitenet.net>+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -15,17 +15,35 @@ 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
Logs/UUIDBased.hs view
@@ -26,9 +26,6 @@ 	changeLog, 	addLog, 	simpleMap,--	prop_TimeStamp_sane,-	prop_addLog_sane, ) where  import qualified Data.Map as M@@ -38,21 +35,11 @@  import Common import Types.UUID--data TimeStamp = Unknown | Date POSIXTime-	deriving (Eq, Ord, Show)--data LogEntry a = LogEntry-	{ changed :: TimeStamp-	, value :: a-	} deriving (Eq, Show)--type Log a = M.Map UUID (LogEntry a)+import Logs.MapLog -tskey :: String-tskey = "timestamp="+type Log v = MapLog UUID v -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 @@ 	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 @@ 			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 (== ' ')--changeLog :: POSIXTime -> UUID -> a -> Log a -> Log a-changeLog t u v = M.insert u $ LogEntry (Date t) v--{- 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--{- 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+showLogNew :: (v -> String) -> Log v -> String+showLogNew = showMapLog fromUUID -best :: LogEntry a -> LogEntry a -> LogEntry a-best new old-	| changed old > changed new = old-	| otherwise = new+parseLogNew :: (String -> Maybe v) -> String -> Log v+parseLogNew = parseMapLog (Just . toUUID) --- Unknown is oldest.-prop_TimeStamp_sane :: Bool-prop_TimeStamp_sane = Unknown < Date 1+changeLog :: POSIXTime -> UUID -> v -> Log v -> Log v+changeLog = changeMapLog -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+addLog :: UUID -> LogEntry v -> Log v -> Log v+addLog = addMapLog -	l = M.fromList [(UUID "foo", LogEntry (Date 0) "old")]-	l2 = M.fromList [(UUID "foo", LogEntry (Date 1) "new")]+tskey :: String+tskey = "timestamp="
Logs/Unused.hs view
@@ -67,7 +67,7 @@ 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 @@ 	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 @@ 	f <- fromRepo $ gitAnnexUnusedLog prefix 	liftIO $ catchMaybeIO $ getModificationTime f #else-#warning foo -- old ghc's getModificationTime returned a ClockTime dateUnusedLog _prefix = return Nothing #endif
Makefile view
@@ -119,7 +119,7 @@ 	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)"
Remote.hs view
@@ -37,6 +37,7 @@ 	keyPossibilities, 	keyPossibilitiesTrusted, 	nameToUUID,+	nameToUUID', 	showTriedRemotes, 	showLocations, 	forceTrust,@@ -48,7 +49,6 @@ 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 @@  - 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.  -
Remote/External.hs view
@@ -11,6 +11,7 @@ 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 @@ 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
Remote/Git.hs view
@@ -36,6 +36,7 @@ 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 @@ 				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 @@ 	| 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 @@ 	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 @@ 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 @@ 		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 @@ 		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 @@  {- 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 @@ 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
Remote/Helper/Hooks.hs view
@@ -13,6 +13,7 @@  import Common.Annex import Types.Remote+import Types.CleanupActions import qualified Annex import Annex.LockPool #ifndef mingw32_HOST_OS@@ -74,7 +75,7 @@ 		-- 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
Remote/Rsync.hs view
@@ -28,6 +28,7 @@ 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 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",@@ -147,17 +138,6 @@ 	-- persistant state, so it can vary between hosts. 	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
+ Remote/Rsync/RsyncUrl.hs view
@@ -0,0 +1,46 @@+{- Rsync urls.+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - 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
Setup.hs view
@@ -16,15 +16,14 @@ 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 @@ 	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
Test.hs view
@@ -17,12 +17,14 @@ 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.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 @@ 	-- 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 @@ 				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 @@ 	, 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 @@ 	{- 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"
+ Types/CleanupActions.hs view
@@ -0,0 +1,17 @@+{- Enumeration of cleanup actions+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - 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)
Types/MetaData.hs view
@@ -28,6 +28,7 @@ 	emptyMetaData, 	updateMetaData, 	unionMetaData,+	combineMetaData, 	differenceMetaData, 	isSet, 	currentMetaData,@@ -140,7 +141,7 @@  - 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@@ -187,6 +188,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 $
Types/StandardGroups.hs view
@@ -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 @@ 	| 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 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 _ = 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)"
Utility/FileMode.hs view
@@ -99,13 +99,20 @@ #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 @@ #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
Utility/FileSystemEncoding.hs view
@@ -1,14 +1,17 @@ {- GHC File system encoding handling.  -- - Copyright 2012-2013 Joey Hess <joey@kitenet.net>+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>  -  - 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 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 @@ 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 @@  - 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 @@ 		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
Utility/Misc.hs view
@@ -109,18 +109,6 @@ 			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
Utility/QuickCheck.hs view
@@ -28,10 +28,10 @@  {- 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
Utility/WebApp.hs view
@@ -1,6 +1,6 @@ {- Yesod webapp  -- - Copyright 2012 Joey Hess <joey@kitenet.net>+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -36,6 +36,10 @@ 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,11 +78,15 @@ runWebApp :: Maybe TLSSettings -> Maybe HostName -> Wai.Application -> (SockAddr -> IO ()) -> IO () runWebApp tlssettings h app observer = withSocketsDo $ do 	sock <- getSocket h-	void $ forkIO $ -		(maybe runSettingsSocket (\ts -> runTLSSocket ts) tlssettings)-			webAppSettings sock app	+	void $ forkIO $ go webAppSettings sock app	 	sockaddr <- fixSockAddr <$> getSocketName sock 	observer sockaddr+  where+#ifdef WITH_WEBAPP_SECURE+	go = (maybe runSettingsSocket (\ts -> runTLSSocket ts) tlssettings)+#else+	go = runSettingsSocket+#endif  fixSockAddr :: SockAddr -> SockAddr #ifdef __ANDROID__@@ -204,15 +212,35 @@ #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.@@ -221,15 +249,15 @@  - 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 () @@ -239,21 +267,21 @@  -   - 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
debian/changelog view
@@ -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 <joeyh@debian.org>  Thu, 20 Mar 2014 13:21:12 -0400+ git-annex (5.20140306) unstable; urgency=high    * sync: Fix bug in direct mode that caused a file that was not
debian/control view
@@ -39,6 +39,9 @@ 	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,
doc/Android/oldcomments/comment_1_cc9caa5dd22dd67e5c1d22d697096dd2._comment view
@@ -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?"
− doc/bugs/--json_is_broken_for_status.mdwn 
@@ -1,34 +0,0 @@-### Please describe the problem.--bad json produced--### What steps will reproduce the problem?---[[!format sh """-$> git annex status --json-,"success":true}--in another one--$> git annex status --json-D hardware/g-box/builds/mine/.#yoh-debug-lastdidnotconnect.txt-,"success":true}-"""]]--### What version of git-annex are you using? On what operating system?--Debian sid 5.20140116--### 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.-"""]]--> Not all commands support json. Made this explict by making --json not be-> a global option. Added --json support to status. [[done]]. --[[Joey]]
doc/bugs/Android_:_handling_DCIM__47__Camera_not_being_configurable.mdwn view
@@ -11,3 +11,6 @@ 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"]]
doc/bugs/Backup_repository_doesn__39__t_get_all_files.mdwn view
@@ -35,3 +35,6 @@ 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]]
+ doc/bugs/Bug_Report_doesn__39__t_work.mdwn view
@@ -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]]
doc/bugs/Could_not_read_from_remote_repository.mdwn view
@@ -22,3 +22,5 @@ Please make sure you have the correct access rights and the repository exists. """]]++[[!meta title="xmpp syncing sometimes fails"]]
doc/bugs/Disconcerting_warning_from_git-annex.mdwn view
@@ -4,3 +4,5 @@ failed  How is that even possible, when the server is doing nothing else?++[[!tag moreinfo]]
doc/bugs/Impossible_to_enable_an_existing_gcrypt_repo_in_the_webapp.mdwn view
@@ -19,3 +19,5 @@  ### What version of git-annex are you using? On what operating system? Latest nightly build on ubuntu 13.10++[[!tag moreinfo]]
@@ -68,3 +68,5 @@   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]]
+ doc/bugs/Mac_OS_X_Build_doesn__39__t_include_webapp.mdwn view
@@ -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]]
doc/bugs/Share_with_friends_crash_in_osx.mdwn view
@@ -366,3 +366,5 @@  # End of transcript or log. """]]++> Apparently this is [[fixed|done]] in the latest release. --[[Joey]]
+ doc/bugs/Should_UUID__39__s_for_Remotes_be_case_sensitive__63__.mdwn view
@@ -0,0 +1,46 @@+> git annex status+supported backends: SHA256E SHA1E SHA512E SHA224E SHA384E SHA256 SHA1 SHA512 SHA224 SHA384 WORM URL+supported remote types: git gcrypt S3 bup directory rsync web webdav glacier hook+repository mode: indirect+trusted repositories: 0+semitrusted repositories: 8+	00000000-0000-0000-0000-000000000001 -- web+ 	44AF00F1-511F-4902-8235-DFF741B09400 -- here+ 	44af00f1-511f-4902-8235-dff741b09400 -- chrissy+ 	53499200-CA18-4B51-B6B3-651C18208349 -- stevedave+ 	56C56658-0995-4613-8A1B-B2FA534A834C -- olaf+ 	8FE9B19F-4FC8-4CFA-AD89-4B70EB432EDC -- passport+ 	AFC75641-B34A-4644-B566-C8D3127823F7 -- glacier+ 	B3238A12-D81B-40EA-BE89-3BDB318AE2B7 -- brodie+untrusted repositories: 0+transfers in progress: none+available local disk space: 78.8 gigabytes (+1 gigabyte reserved)+local annex keys: 3915+local annex size: 81.37 gigabytes+known annex keys: 5728+known annex size: 641.36 gigabytes+bloom filter size: 16 mebibytes (0.8% full)+backend usage:+	SHA256E: 8716+	URL: 927++> git annex version+git-annex version: 4.20130909+build flags: Assistant Webapp Pairing Testsuite S3 WebDAV FsEvents XMPP DNS Feeds Quvi+local repository version: 3+default repository version: 3+supported repository versions: 3 4+upgrade supported from repository versions: 0 1 2++> git-annex intentionally treats UUIDs as opaque strings,+> so it is not going to go to any bother to consider +> different byte sequences to be the same UUID, sorry.+> (The standard may be arbitrarily complicated, but I have arbitrarily+> decided to ignore it.)+> +> Since git-annex only ever generates each UUID once, and copies+> the exact sequence of bytes as necessary, the only way the situation+> you show above can happen is if you have manually gone in and entered+> UUIDs in two different cases.+> +> [[done]] --[[Joey]]
− doc/bugs/Should_UUID__39__s_for_Remotes_be_case_sensitive__63__.txt 
@@ -1,46 +0,0 @@-> git annex status-supported backends: SHA256E SHA1E SHA512E SHA224E SHA384E SHA256 SHA1 SHA512 SHA224 SHA384 WORM URL-supported remote types: git gcrypt S3 bup directory rsync web webdav glacier hook-repository mode: indirect-trusted repositories: 0-semitrusted repositories: 8-	00000000-0000-0000-0000-000000000001 -- web- 	44AF00F1-511F-4902-8235-DFF741B09400 -- here- 	44af00f1-511f-4902-8235-dff741b09400 -- chrissy- 	53499200-CA18-4B51-B6B3-651C18208349 -- stevedave- 	56C56658-0995-4613-8A1B-B2FA534A834C -- olaf- 	8FE9B19F-4FC8-4CFA-AD89-4B70EB432EDC -- passport- 	AFC75641-B34A-4644-B566-C8D3127823F7 -- glacier- 	B3238A12-D81B-40EA-BE89-3BDB318AE2B7 -- brodie-untrusted repositories: 0-transfers in progress: none-available local disk space: 78.8 gigabytes (+1 gigabyte reserved)-local annex keys: 3915-local annex size: 81.37 gigabytes-known annex keys: 5728-known annex size: 641.36 gigabytes-bloom filter size: 16 mebibytes (0.8% full)-backend usage:-	SHA256E: 8716-	URL: 927--> git annex version-git-annex version: 4.20130909-build flags: Assistant Webapp Pairing Testsuite S3 WebDAV FsEvents XMPP DNS Feeds Quvi-local repository version: 3-default repository version: 3-supported repository versions: 3 4-upgrade supported from repository versions: 0 1 2--> git-annex intentionally treats UUIDs as opaque strings,-> so it is not going to go to any bother to consider -> different byte sequences to be the same UUID, sorry.-> (The standard may be arbitrarily complicated, but I have arbitrarily-> decided to ignore it.)-> -> Since git-annex only ever generates each UUID once, and copies-> the exact sequence of bytes as necessary, the only way the situation-> you show above can happen is if you have manually gone in and entered-> UUIDs in two different cases.-> -> [[done]] --[[Joey]]
doc/bugs/USB_drive_not_syncing.mdwn view
@@ -514,3 +514,6 @@  # End of transcript or log. """]]++> [[done]]; seems to be some badly set up repository. Happy to help with+> fixing it, if you reply.. --[[Joey]]
+ doc/bugs/Unicode_file_names_ignored_on_Windows.mdwn view
@@ -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]]
doc/bugs/Unnecessary_remote_transfers.mdwn view
@@ -22,3 +22,6 @@ 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]]
+ doc/bugs/copy_fails_for_some_fails_without_explanation.mdwn view
@@ -0,0 +1,7 @@+I have a large direct-mode repository whose files I'm trying to copy to a non-direct-mode repository.  Both repositories live on an HDD attached to an rpi.++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]]
doc/bugs/copy_to_--fast_should_not_mention_every_file_it_checks.mdwn view
@@ -23,3 +23,6 @@ """]]  [[!meta title="copy --fast --to remote should be quiet when nothing to do"]]++> [[fixed|done]]; Avoided the unnecessary output in this situation.+> --[[Joey]]
doc/bugs/copy_unused_and_unused_not_agreeing.mdwn view
@@ -46,3 +46,5 @@ copy SHA256E-s3672986--be960f6dc247df2496f634f7d788bd4a180fe556230e2dafc23ebc8fc1f10af3.JPG (checking synology...) ok $ """]]++> [[fixed|done]] per my comment --[[Joey]]
+ doc/bugs/enormous_fsck_output_OOM.mdwn view
@@ -0,0 +1,30 @@+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.++> 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]]
+ doc/bugs/git_annex_content_fails_with_a_parse_error.mdwn view
@@ -0,0 +1,32 @@+### Please describe the problem.++I tried to use git annex content, but that failed with a parse error.+++### What steps will reproduce the problem?++Type this anywhere: ++git annex --debug content . "exclude(foo.ml)"+content . git-annex: Parse error: Parse failure: near "foo.ml"++It fails with the example of the man page:+   git annex content . "include(*.mp3) or include(*.ogg)"++However, it works when trying: git annex content . "include()".++### What version of git-annex are you using? On what operating system?++git-annex version: 4.20130709.1, ubuntu quantal++### 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 the example, thanks. --[[Joey]] [[done]]
− doc/bugs/git_annex_content_fails_with_a_parse_error.txt 
@@ -1,32 +0,0 @@-### Please describe the problem.--I tried to use git annex content, but that failed with a parse error.---### What steps will reproduce the problem?--Type this anywhere: --git annex --debug content . "exclude(foo.ml)"-content . git-annex: Parse error: Parse failure: near "foo.ml"--It fails with the example of the man page:-   git annex content . "include(*.mp3) or include(*.ogg)"--However, it works when trying: git annex content . "include()".--### What version of git-annex are you using? On what operating system?--git-annex version: 4.20130709.1, ubuntu quantal--### 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 the example, thanks. --[[Joey]] [[done]]
+ doc/bugs/id__95__rsa_on_android.mdwn view
@@ -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]]
+ doc/bugs/json_is_broken_for_status.mdwn view
@@ -0,0 +1,34 @@+### Please describe the problem.++bad json produced++### What steps will reproduce the problem?+++[[!format sh """+$> git annex status --json+,"success":true}++in another one++$> git annex status --json+D hardware/g-box/builds/mine/.#yoh-debug-lastdidnotconnect.txt+,"success":true}+"""]]++### What version of git-annex are you using? On what operating system?++Debian sid 5.20140116++### 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.+"""]]++> Not all commands support json. Made this explict by making --json not be+> a global option. Added --json support to status. [[done]]. --[[Joey]]
doc/bugs/pages_of_packfile_errors.mdwn view
@@ -28,3 +28,5 @@  # End of transcript or log. """]]++> I think I've fixed this bug. Followup if not.. [[done]] --[[Joey]]
doc/bugs/ran_once_then_stopped_running_opensuse_13.1.mdwn view
@@ -10,3 +10,4 @@  and since it won't load anymore i guess there is no log. +[[!tag moreinfo]]
+ doc/bugs/ssh:_unprotected_private_key_file.mdwn view
@@ -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]]
doc/design/assistant/polls/Android_default_directory.mdwn view
@@ -4,4 +4,4 @@ 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/"]]
doc/design/assistant/polls/prioritizing_special_remotes.mdwn view
@@ -6,7 +6,7 @@ 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
+ doc/design/caching_database.mdwn view
@@ -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.++<pre>+CachedKey+  key Key+  associatedFiles [FilePath]+  lastFscked Int Maybe+  KeyIndex key++CachedMetaData+  key Key+  metaDataField MetaDataField+  metaDataValue MetaDataValue+</pre>++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:++<pre>+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+</pre>++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: <http://lpaste.net/101141> <http://lpaste.net/101142>++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.
+ doc/design/metadata/comment_4_c32ade1524487e5fdc6f83b2db39f04c._comment view
@@ -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?+"""]]
+ doc/design/metadata/comment_5_0ac3132cd7a84f0e170fbe3a6f235fe7._comment view
@@ -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.+"""]]
+ doc/devblog/day_130__post_release.mdwn view
@@ -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.
+ doc/devblog/day_131__more_bug_squashing.mdwn view
@@ -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.
+ doc/devblog/day_132__database_musings.mdwn view
@@ -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.
+ doc/devblog/day_133__db_and_bugfixes.mdwn view
@@ -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.
+ doc/devblog/day_134-135__avoiding_the_turing_tarpit.mdwn view
@@ -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. ;)
+ doc/devblog/day_136__frustrating_day.mdwn view
@@ -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.
+ doc/devblog/day_137-138__bug_triage_and_too_much_windows.mdwn view
@@ -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.
doc/favicon.ico view

binary file changed (405 → 2550 bytes)

− doc/favicon.png

binary file changed (714 → absent bytes)

+ doc/forum/Add_a___34__local__34___remote.mdwn view
@@ -0,0 +1,13 @@+I have been playing around with annex assistent today (way late as I am one of the Kickstarter backers) and found the following puzzling.++I am running a fairly new version, my package manager calls it 4.20130323 (git-annex does not seem to have a --version switch). ++I have been playing around with the annex assistent webapp today and have the following questions/observations: ++1) The "remote" server creates a bare git repository as far as I can tell, the "local computer" probably does the right thing (but I cannot run it as the "other box" has no X or browser). Is there any way to remotely create a "local" copy (i.e. non-bare git repository, which can later be managed by the cli?)+2) It seems like git-annex-assistent (webapp) binds to localhost, is it possible to let it bind to either a specific ip-address (or all)? (Yes, I understand the security implications, but the use-case is the box from question 2 - i.e. on local network but no X and no browser). +3) what is being launched when I hit "files", on the video it starts a file-manager on my box nothing happens (and no errors as far as I can tell). ++Thank you in advance++Svenne
− doc/forum/Add_a___34__local__34___remote.txt 
@@ -1,13 +0,0 @@-I have been playing around with annex assistent today (way late as I am one of the Kickstarter backers) and found the following puzzling.--I am running a fairly new version, my package manager calls it 4.20130323 (git-annex does not seem to have a --version switch). --I have been playing around with the annex assistent webapp today and have the following questions/observations: --1) The "remote" server creates a bare git repository as far as I can tell, the "local computer" probably does the right thing (but I cannot run it as the "other box" has no X or browser). Is there any way to remotely create a "local" copy (i.e. non-bare git repository, which can later be managed by the cli?)-2) It seems like git-annex-assistent (webapp) binds to localhost, is it possible to let it bind to either a specific ip-address (or all)? (Yes, I understand the security implications, but the use-case is the box from question 2 - i.e. on local network but no X and no browser). -3) what is being launched when I hit "files", on the video it starts a file-manager on my box nothing happens (and no errors as far as I can tell). --Thank you in advance--Svenne
− doc/forum/Feature_Request:_Sync_Now_Button_in_Webapp.mdwn 
@@ -1,1 +0,0 @@-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?
+ doc/forum/GPG_passphrase_handling.mdwn view
@@ -0,0 +1,76 @@+[[!meta title="GPG passphrase handling on OSX"]]++Hello!+I'm using OSX 10.9 and have installed gpg (and gpg2, if it matters) through+homebrew and git-annex through cabal. I also installed+https://github.com/joeyh/git-remote-gcrypt like the UI told me.++Whenever I'm trying to add an encrypted remote through the web UI I get a+lot of "You need a passphrase to unlock the secret key for user:" on stdout+and, obviously, I can't enter my passphrase (If I could I wouldn't make this+post to begin with :))+Is this behavior normal? What should I do to work around it?+I did also try to not use the web UI by using this command:+git annex initremote rsync.net type=gcrypt gitrepo=user@host:directory encryption=pubkey keyid=X++Because of this I can't copy files to my remotes. All I get is:+-----+$ git annex copy --to rsync.net+copy MySecretFile (gpg) +You need a passphrase to unlock the secret key for+user: "user"+4096-bit RSA key, ID X, created 2013-10-01 (main key ID Y)++(checking rsync.net...) (to rsync.net...) gpg: no valid addressees+gpg: [stdin]: encryption failed: No user ID+failed+-----++Yes, I am using gpg-agent. When other applications ask for my passphrase I get+the pinentry dialog from GPGTools, just like I've configured it in+~/.gnupg/gpg-agent.conf, but this isn't the case with git-annex.++If I remove GPGTools from /usr/local/bin with: ``brew link --overwrite gnupg &&+brew link --overwrite gnupg2'' it works *slightly* better. +I get that pinentry dialog I want but when I do a copy I get:+-----+$ git annex copy --to rsync.net+copy MySecretFile (gpg) (checking rsync.net...) (to rsync.net...) gpg: no valid addressees+gpg: [stdin]: encryption failed: no such user id+failed+-----++--debug shows me it is executing gpg llke so:+-----+gpg ["--batch","--no-tty","--use-agent","--quiet","--trust-model","always","--batch","--encrypt","--no-encrypt-to","--no-default-recipient","--force-mdc","--no-textmode"]+-----++$ git annex version+git-annex version: 4.20131024+build flags: Assistant Webapp Pairing Testsuite S3 WebDAV FsEvents XMPP DNS Feeds Quvi TDFA CryptoHash+key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 WORM URL+remote types: git gcrypt S3 bup directory rsync web webdav glacier hook++$ gpg --version+gpg (GnuPG) 2.0.22+libgcrypt 1.5.3+Copyright (C) 2013 Free Software Foundation, Inc.+License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>+This is free software: you are free to change and redistribute it.+There is NO WARRANTY, to the extent permitted by law.++Home: ~/.gnupg+Supported algorithms:+Pubkey: RSA, ELG, DSA, ?, ?+Cipher: IDEA, 3DES, CAST5, BLOWFISH, AES, AES192, AES256, TWOFISH,+        CAMELLIA128, CAMELLIA192, CAMELLIA256+Hash: MD5, SHA1, RIPEMD160, SHA256, SHA384, SHA512, SHA224+Compression: Uncompressed, ZIP, ZLIB, BZIP2++ $ gpg-agent --version+gpg-agent (GnuPG/MacGPG2) 2.0.22+libgcrypt 1.5.3+Copyright (C) 2013 Free Software Foundation, Inc.+License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>+This is free software: you are free to change and redistribute it.+There is NO WARRANTY, to the extent permitted by law.
− doc/forum/GPG_passphrase_handling.txt 
@@ -1,76 +0,0 @@-[[!meta title="GPG passphrase handling on OSX"]]--Hello!-I'm using OSX 10.9 and have installed gpg (and gpg2, if it matters) through-homebrew and git-annex through cabal. I also installed-https://github.com/joeyh/git-remote-gcrypt like the UI told me.--Whenever I'm trying to add an encrypted remote through the web UI I get a-lot of "You need a passphrase to unlock the secret key for user:" on stdout-and, obviously, I can't enter my passphrase (If I could I wouldn't make this-post to begin with :))-Is this behavior normal? What should I do to work around it?-I did also try to not use the web UI by using this command:-git annex initremote rsync.net type=gcrypt gitrepo=user@host:directory encryption=pubkey keyid=X--Because of this I can't copy files to my remotes. All I get is:-------$ git annex copy --to rsync.net-copy MySecretFile (gpg) -You need a passphrase to unlock the secret key for-user: "user"-4096-bit RSA key, ID X, created 2013-10-01 (main key ID Y)--(checking rsync.net...) (to rsync.net...) gpg: no valid addressees-gpg: [stdin]: encryption failed: No user ID-failed--------Yes, I am using gpg-agent. When other applications ask for my passphrase I get-the pinentry dialog from GPGTools, just like I've configured it in-~/.gnupg/gpg-agent.conf, but this isn't the case with git-annex.--If I remove GPGTools from /usr/local/bin with: ``brew link --overwrite gnupg &&-brew link --overwrite gnupg2'' it works *slightly* better. -I get that pinentry dialog I want but when I do a copy I get:-------$ git annex copy --to rsync.net-copy MySecretFile (gpg) (checking rsync.net...) (to rsync.net...) gpg: no valid addressees-gpg: [stdin]: encryption failed: no such user id-failed----------debug shows me it is executing gpg llke so:-------gpg ["--batch","--no-tty","--use-agent","--quiet","--trust-model","always","--batch","--encrypt","--no-encrypt-to","--no-default-recipient","--force-mdc","--no-textmode"]--------$ git annex version-git-annex version: 4.20131024-build flags: Assistant Webapp Pairing Testsuite S3 WebDAV FsEvents XMPP DNS Feeds Quvi TDFA CryptoHash-key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 WORM URL-remote types: git gcrypt S3 bup directory rsync web webdav glacier hook--$ gpg --version-gpg (GnuPG) 2.0.22-libgcrypt 1.5.3-Copyright (C) 2013 Free Software Foundation, Inc.-License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>-This is free software: you are free to change and redistribute it.-There is NO WARRANTY, to the extent permitted by law.--Home: ~/.gnupg-Supported algorithms:-Pubkey: RSA, ELG, DSA, ?, ?-Cipher: IDEA, 3DES, CAST5, BLOWFISH, AES, AES192, AES256, TWOFISH,-        CAMELLIA128, CAMELLIA192, CAMELLIA256-Hash: MD5, SHA1, RIPEMD160, SHA256, SHA384, SHA512, SHA224-Compression: Uncompressed, ZIP, ZLIB, BZIP2-- $ gpg-agent --version-gpg-agent (GnuPG/MacGPG2) 2.0.22-libgcrypt 1.5.3-Copyright (C) 2013 Free Software Foundation, Inc.-License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>-This is free software: you are free to change and redistribute it.-There is NO WARRANTY, to the extent permitted by law.
+ doc/forum/How_do_I_get_rid_of_a_wrong_remote_uuid__63__.mdwn view
@@ -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.
+ doc/forum/Import_options.mdwn view
@@ -0,0 +1,14 @@+Thank you for adding import options to handle duplicates. Very handy when consolidating data from various sources.++Can deletion of the source files be decoupled from annex duplication/deduplication options? For example, I would like to import source files without deleting them and at the same time do not import duplicates.++Better yet, since deletion of source files is potentially dangerous, a delete option could be required for deletion to be performed. Example:++git annex import --deduplicate --delete_all_source_files+git annex import --deduplicate --delete_source_duplicates++Also, it would be great to have import "status" option which goes over files to be imported and logs their status ( to be imported, duplicate etc. ) without actually performing any changes. It would be great for testing and trial runs.++I hope the above make sense. It would make import feature more flexible.++Cheers,
− doc/forum/Import_options.txt 
@@ -1,14 +0,0 @@-Thank you for adding import options to handle duplicates. Very handy when consolidating data from various sources.--Can deletion of the source files be decoupled from annex duplication/deduplication options? For example, I would like to import source files without deleting them and at the same time do not import duplicates.--Better yet, since deletion of source files is potentially dangerous, a delete option could be required for deletion to be performed. Example:--git annex import --deduplicate --delete_all_source_files-git annex import --deduplicate --delete_source_duplicates--Also, it would be great to have import "status" option which goes over files to be imported and logs their status ( to be imported, duplicate etc. ) without actually performing any changes. It would be great for testing and trial runs.--I hope the above make sense. It would make import feature more flexible.--Cheers,
+ doc/forum/Purge_a_remote.mdwn view
@@ -0,0 +1,2 @@+How could I delete and purge a remote? I want to remove all traces of it+but I can't find out how to achieve this.
− doc/forum/Purge_a_remote.txt 
@@ -1,2 +0,0 @@-How could I delete and purge a remote? I want to remove all traces of it-but I can't find out how to achieve this.
doc/forum/Purge_a_remote/comment_2_dc65719157dee63b3979563ed57ee0ce._comment view
@@ -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"
+ doc/forum/Sync_with_one_offline_peer.mdwn view
@@ -0,0 +1,11 @@+Hello,++I use the assistant to set up two repositories A and B synced using jabber. A third repository C on my server is used as rsync transfer. Syncing works fine between both repos when both are online.++But when either A or B is offline the sync does not happen when it comes online again, though the file was synced to C.++Is this because C is only a rsync repository and can't hold metadata? How can I achieve that the sync happens also when one of the repositories is offline?++I also tried using the static build of git annex on my server. It seemed to run fine but during the setup the assistant got an error about too many command line arguments. On A und B I use the ArchLinux AUR build (https://aur.archlinux.org/packages/git-annex-standalone/), on C I use the static build. Could it be a version mismatch?++Thanks!
− doc/forum/Sync_with_one_offline_peer.txt 
@@ -1,11 +0,0 @@-Hello,--I use the assistant to set up two repositories A and B synced using jabber. A third repository C on my server is used as rsync transfer. Syncing works fine between both repos when both are online.--But when either A or B is offline the sync does not happen when it comes online again, though the file was synced to C.--Is this because C is only a rsync repository and can't hold metadata? How can I achieve that the sync happens also when one of the repositories is offline?--I also tried using the static build of git annex on my server. It seemed to run fine but during the setup the assistant got an error about too many command line arguments. On A und B I use the ArchLinux AUR build (https://aur.archlinux.org/packages/git-annex-standalone/), on C I use the static build. Could it be a version mismatch?--Thanks!
− doc/forum/Too_big_to_fsck.mdwn 
@@ -1,20 +0,0 @@-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.
+ doc/forum/USB_drive_in_transfer_group_keeps_growing_-_assistant.mdwn view
@@ -0,0 +1,22 @@+1. Set up two computers with a client repository.+2. Add a removable drive repository and set it to transfer group.+3. Start adding files to computer #1 repository. See how the files get synced to the usb drive.+4. Connect the usb drive to computer #2 and see the files getting transferred to computer #2. Everything is looking good.+++5. Connect the usb drive to computer #1 again. +6. Add a file that is larger than the remaining size of the usb drive, BUT smaller than the original size of the usb drive.+7. The file does not get transferred to the usb drive due to lack of disk space.++I would expect the assistant to make some space on the usb drive. Removing the files it knows has been transferred to computer #2, and then transfer the new file to the usb drive. But this does not seem to happen. ++Have I missed something about how the transfer group is supposed to work?++ +Using version:+git-annex version: 4.20130802-g0a52f02+build flags: Assistant Webapp Pairing Testsuite S3 WebDAV Inotify DBus XMPP++Pre built tar file.++
− doc/forum/USB_drive_in_transfer_group_keeps_growing_-_assistant.txt 
@@ -1,22 +0,0 @@-1. Set up two computers with a client repository.-2. Add a removable drive repository and set it to transfer group.-3. Start adding files to computer #1 repository. See how the files get synced to the usb drive.-4. Connect the usb drive to computer #2 and see the files getting transferred to computer #2. Everything is looking good.---5. Connect the usb drive to computer #1 again. -6. Add a file that is larger than the remaining size of the usb drive, BUT smaller than the original size of the usb drive.-7. The file does not get transferred to the usb drive due to lack of disk space.--I would expect the assistant to make some space on the usb drive. Removing the files it knows has been transferred to computer #2, and then transfer the new file to the usb drive. But this does not seem to happen. --Have I missed something about how the transfer group is supposed to work?-- -Using version:-git-annex version: 4.20130802-g0a52f02-build flags: Assistant Webapp Pairing Testsuite S3 WebDAV Inotify DBus XMPP--Pre built tar file.--
+ doc/forum/XBMC__44___NFS___38___git-annex_.mdwn view
@@ -0,0 +1,27 @@+Hi,++this is not a git-annex problem, but more likely a way some software handles symlinks and/or do file-type detection.++my setup is a following:+- multiple pc/laptop (linux)+- one NAS (debian) - main repo for music/films/photos - all in git-annex+- a Raspberry Pi (Raspbmc) - connected to the TV++I want to share all my films/music/.. to the Pi.+So, i setup a r/o NFS and mounted that in the XBMC.+So far this works, I see directories but XBMC do not recognize the media files.+It works, if I "git-annex edit ..." the file.++My _assumption_ is, that it follows the symlink, finds a file with no extension - and ignores that.+In XBMC-config there is a list of supported filetypes by extension. ( .avi,.mpg,.foo,.bar )++What I have think of so far:+- tell XBMC somehow to load all the files (did not work)+- having some kind of (FUSE?) filter, which hides the symlink in a transparent way+- creating via script hard-links in a seperate folder with same structure, mount that.+- using some alternative to NFS ( like ftp, smb ) or a other kind of media-server (server-side)++any comments, ideas ? +If i find a solution, I'll post it here.++.ka
− doc/forum/XBMC__44___NFS___38___git-annex_.txt 
@@ -1,27 +0,0 @@-Hi,--this is not a git-annex problem, but more likely a way some software handles symlinks and/or do file-type detection.--my setup is a following:-- multiple pc/laptop (linux)-- one NAS (debian) - main repo for music/films/photos - all in git-annex-- a Raspberry Pi (Raspbmc) - connected to the TV--I want to share all my films/music/.. to the Pi.-So, i setup a r/o NFS and mounted that in the XBMC.-So far this works, I see directories but XBMC do not recognize the media files.-It works, if I "git-annex edit ..." the file.--My _assumption_ is, that it follows the symlink, finds a file with no extension - and ignores that.-In XBMC-config there is a list of supported filetypes by extension. ( .avi,.mpg,.foo,.bar )--What I have think of so far:-- tell XBMC somehow to load all the files (did not work)-- having some kind of (FUSE?) filter, which hides the symlink in a transparent way-- creating via script hard-links in a seperate folder with same structure, mount that.-- using some alternative to NFS ( like ftp, smb ) or a other kind of media-server (server-side)--any comments, ideas ? -If i find a solution, I'll post it here.--.ka
+ doc/forum/central_non-bare_and_git_push.mdwn view
@@ -0,0 +1,9 @@+hi,++i have a usecase that i think many people have. a cental server which should be non-bare to be able to browse the files also via webdav.+multiple clients behind nat so only pushes via xmpp are possible.++i set everything up without xmpp, it works but if files are updated, none of the clients gets a git push of course because ssh works only unidirectional.+i couldnt figure out how to set up xmpp push and have a non-bare central repo at the same time because i have to choose between ssh and xmpp git remote on the clients to the server.++thanks!
− doc/forum/central_non-bare_and_git_push.txt 
@@ -1,9 +0,0 @@-hi,--i have a usecase that i think many people have. a cental server which should be non-bare to be able to browse the files also via webdav.-multiple clients behind nat so only pushes via xmpp are possible.--i set everything up without xmpp, it works but if files are updated, none of the clients gets a git push of course because ssh works only unidirectional.-i couldnt figure out how to set up xmpp push and have a non-bare central repo at the same time because i have to choose between ssh and xmpp git remote on the clients to the server.--thanks!
− doc/forum/copy_fails_for_some_fails_without_explanation.mdwn 
@@ -1,5 +0,0 @@-I have a large direct-mode repository whose files I'm trying to copy to a non-direct-mode repository.  Both repositories live on an HDD attached to an rpi.--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?
+ doc/forum/drop_old_versions_of_a_file.mdwn view
@@ -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).
+ doc/forum/git_annex_get_--want-get_another__95__repo.mdwn view
@@ -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.
+ doc/forum/handling_MP3_metadata_changes.mdwn view
@@ -0,0 +1,12 @@+Hello,++I'm still looking for a way to version control the metadata (title, artist, album name, ...) of my MP3s, I wonder if git annex could help for this problem ?+The method I use now (without git annex) is to export the MP3 metadata to an textual format with one line per tag. +It's this textual file I handles with git. +The problem is to handle the mapping between the orignal file and the export file with file renaming or moving.+I consider to use the checksum of the audio content (without metadata, this checksum never changes) to handle this problem.+Maybe git annex has a different approach (better) to solve this problem ?+How git annex would be use to solve the orignal problem ?++Regards,+Emmanuel Berry
− doc/forum/handling_MP3_metadata_changes.txt 
@@ -1,12 +0,0 @@-Hello,--I'm still looking for a way to version control the metadata (title, artist, album name, ...) of my MP3s, I wonder if git annex could help for this problem ?-The method I use now (without git annex) is to export the MP3 metadata to an textual format with one line per tag. -It's this textual file I handles with git. -The problem is to handle the mapping between the orignal file and the export file with file renaming or moving.-I consider to use the checksum of the audio content (without metadata, this checksum never changes) to handle this problem.-Maybe git annex has a different approach (better) to solve this problem ?-How git annex would be use to solve the orignal problem ?--Regards,-Emmanuel Berry
+ doc/forum/lost_in_walkthrough....mdwn view
@@ -0,0 +1,78 @@+I'm trying to follow the steps of the "walkthrough" but I'm experiencing the following issue: when+I sync one repository and do "git annex get ." I don't get the files from the other repository.+Here is the transcript of the steps I followed - I've put them in a script (ga.sh) so I can replay+them and show them on the shell while executing.+Basically I have two repositories, "/tmp/a/annex" and "/tmp/b/annex", the second cloned from+the first. All the other steps are the same as in the walkthrough.+-----------------------------------+> bash -x ga.sh ++ cd /tmp++ mkdir a++ mkdir b++ cd a++ mkdir annex++ cd annex++ git init+Initialized empty Git repository in /tmp/a/annex/.git/++ git annex init a+init a ok+(Recording state in git...)++ cd /tmp/b++ git clone /tmp/a/annex+Cloning into 'annex'...+done.+warning: remote HEAD refers to nonexistent ref, unable to checkout.+++ cd annex++ git annex init b+init b ok+(Recording state in git...)++ git remote add a /tmp/a/annex++ cd /tmp/a/annex++ git remote add b /tmp/b/annex++ dd if=/dev/urandom of=first bs=1024 count=1+1+0 records in+1+0 records out+1024 bytes (1.0 kB) copied, 9.9167e-05 s, 10.3 MB/s++ dd if=/dev/urandom of=second bs=1024 count=1+1+0 records in+1+0 records out+1024 bytes (1.0 kB) copied, 0.000241635 s, 4.2 MB/s++ git annex add .+add first (checksum...) ok+add second (checksum...) ok+(Recording state in git...)++ git commit -am added+[master (root-commit) 5078564] added+ 2 files changed, 2 insertions(+)+ create mode 120000 first+ create mode 120000 second++ git mv first e++ mkdir x++ git mv second x++ git commit -m moved+fix x/second ok+(Recording state in git...)+[master 422492d] moved+ 3 files changed, 1 insertion(+), 1 deletion(-)+ rename first => e (100%)+ delete mode 120000 second+ create mode 120000 x/second++ cd /tmp/b/annex++ git annex sync a+(merging origin/git-annex into git-annex...)+(Recording state in git...)+commit  +ok+git-annex: no branch is checked out++ git annex get .+-------------------++The last "git annex get ." does not retrieve the files in /tmp/a/annex ... why?+I guess the issue starts when cloning /tmp/a/annex where no commit was done.++Emanuele++PS: I'm using git v1.7.9.5 (ubuntu 12.04) and the latest git-annex static binary+downloaded a few minutes ago from the git-annex website.+
− doc/forum/lost_in_walkthrough....txt 
@@ -1,78 +0,0 @@-I'm trying to follow the steps of the "walkthrough" but I'm experiencing the following issue: when-I sync one repository and do "git annex get ." I don't get the files from the other repository.-Here is the transcript of the steps I followed - I've put them in a script (ga.sh) so I can replay-them and show them on the shell while executing.-Basically I have two repositories, "/tmp/a/annex" and "/tmp/b/annex", the second cloned from-the first. All the other steps are the same as in the walkthrough.-------------------------------------> bash -x ga.sh -+ cd /tmp-+ mkdir a-+ mkdir b-+ cd a-+ mkdir annex-+ cd annex-+ git init-Initialized empty Git repository in /tmp/a/annex/.git/-+ git annex init a-init a ok-(Recording state in git...)-+ cd /tmp/b-+ git clone /tmp/a/annex-Cloning into 'annex'...-done.-warning: remote HEAD refers to nonexistent ref, unable to checkout.--+ cd annex-+ git annex init b-init b ok-(Recording state in git...)-+ git remote add a /tmp/a/annex-+ cd /tmp/a/annex-+ git remote add b /tmp/b/annex-+ dd if=/dev/urandom of=first bs=1024 count=1-1+0 records in-1+0 records out-1024 bytes (1.0 kB) copied, 9.9167e-05 s, 10.3 MB/s-+ dd if=/dev/urandom of=second bs=1024 count=1-1+0 records in-1+0 records out-1024 bytes (1.0 kB) copied, 0.000241635 s, 4.2 MB/s-+ git annex add .-add first (checksum...) ok-add second (checksum...) ok-(Recording state in git...)-+ git commit -am added-[master (root-commit) 5078564] added- 2 files changed, 2 insertions(+)- create mode 120000 first- create mode 120000 second-+ git mv first e-+ mkdir x-+ git mv second x-+ git commit -m moved-fix x/second ok-(Recording state in git...)-[master 422492d] moved- 3 files changed, 1 insertion(+), 1 deletion(-)- rename first => e (100%)- delete mode 120000 second- create mode 120000 x/second-+ cd /tmp/b/annex-+ git annex sync a-(merging origin/git-annex into git-annex...)-(Recording state in git...)-commit  -ok-git-annex: no branch is checked out-+ git annex get .----------------------The last "git annex get ." does not retrieve the files in /tmp/a/annex ... why?-I guess the issue starts when cloning /tmp/a/annex where no commit was done.--Emanuele--PS: I'm using git v1.7.9.5 (ubuntu 12.04) and the latest git-annex static binary-downloaded a few minutes ago from the git-annex website.-
+ doc/forum/manual_update_of_.git__47__annex__47__objects.mdwn view
@@ -0,0 +1,8 @@+Let's suppose that I've manually modified files in .git/annex/objects,+for example I ran an rsync or some other file synchronization software+to copy files. As a result, some objects have disappeared, others have+appeared. After that `git annex whereis .' displays stale information,+it doesn't take the manual modifications to accound. `git annex fsck'+seems to fix this, but it runs the rehashing of all new files, so it's+slow. Is there a fast alternative, which notices all the object file+changes, trusts them, and just updates .git/annex/index quickly?
− doc/forum/manual_update_of_.git__47__annex__47__objects.txt 
@@ -1,8 +0,0 @@-Let's suppose that I've manually modified files in .git/annex/objects,-for example I ran an rsync or some other file synchronization software-to copy files. As a result, some objects have disappeared, others have-appeared. After that `git annex whereis .' displays stale information,-it doesn't take the manual modifications to accound. `git annex fsck'-seems to fix this, but it runs the rehashing of all new files, so it's-slow. Is there a fast alternative, which notices all the object file-changes, trusts them, and just updates .git/annex/index quickly?
+ doc/forum/multiple_repositories_single_backup.mdwn view
@@ -0,0 +1,6 @@+hi++is it possible to have multiple repositories that share single backup directory ?++for example.+i have mp3, docs on my laptop as separate repositories. i would like to use single backup directory that is on my usb drive.
− doc/forum/multiple_repositories_single_backup.txt 
@@ -1,6 +0,0 @@-hi--is it possible to have multiple repositories that share single backup directory ?--for example.-i have mp3, docs on my laptop as separate repositories. i would like to use single backup directory that is on my usb drive.
+ doc/forum/partial_synchronisation._android_phone.mdwn view
@@ -0,0 +1,7 @@+hi++i have a repository that is 30 gb large. i would like to sync some content onto my android phone. take mp3's for example. i would like to see whole content on android but my phone does not have that much flash space. i would like to manualy select what folders, files will be copied onto phone.++this use case may not even refer strictly to android devices but even pc's. for exaple i have small ssd drive on laptop. whole contentis kept on some hudge  raid array. i will see whole directory structure but whenever i want a file i will just shedule it for download.++is it possible ? or maybe i just can not find the answer on project page ?
− doc/forum/partial_synchronisation._android_phone.txt 
@@ -1,7 +0,0 @@-hi--i have a repository that is 30 gb large. i would like to sync some content onto my android phone. take mp3's for example. i would like to see whole content on android but my phone does not have that much flash space. i would like to manualy select what folders, files will be copied onto phone.--this use case may not even refer strictly to android devices but even pc's. for exaple i have small ssd drive on laptop. whole contentis kept on some hudge  raid array. i will see whole directory structure but whenever i want a file i will just shedule it for download.--is it possible ? or maybe i just can not find the answer on project page ?
+ doc/forum/sync_between_indirect_and_direct_mode.mdwn view
@@ -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 ?
doc/git-annex.mdwn view
@@ -302,7 +302,8 @@ * `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 @@ * `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 @@  # 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.
+ doc/install/cabal/comment_33_8d4dfc33cada6091c30d3a43ce404b8b._comment view
@@ -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)++"""]]
+ doc/install/cabal/comment_34_38451e751add6daf479b559c4b6a7c61._comment view
@@ -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.+"""]]
+ doc/install/cabal/comment_35_4d44e4531e6686bd340f26836ad40026._comment view
@@ -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.+"""]]
doc/install/cabal/comment_5_8789fc27466714faa5a3a7a6b8ec6e5d._comment view
@@ -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"
doc/install/fromscratch.mdwn view
@@ -3,65 +3,16 @@  * 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)
doc/internals.mdwn view
@@ -150,6 +150,15 @@ 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
+ doc/logo_16x16.png view

binary file changed (absent → 233 bytes)

+ doc/logo_32x32.png view

binary file changed (absent → 473 bytes)

doc/metadata.mdwn view
@@ -23,12 +23,17 @@ 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]].
+ doc/metadata/comment_1_d367fdaf0425b59d694bf16059d47192._comment view
@@ -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.+"""]]
+ doc/metadata/comment_2_e15d2b5a405db4ccdb91d6aad4a22983._comment view
@@ -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.+"""]]
− doc/news/version_5.20140210.mdwn 
@@ -1,42 +0,0 @@-git-annex 5.20140210 released with [[!toggle text="these changes"]]-[[!toggleable text="""-   * --in can now refer to files that were located in a repository at-     some past date. For example, --in="here@{yesterday}"-   * Fixed direct mode annexed content locking code, which is used to-     guard against recursive file drops.-   * This is the first beta-level release of the Windows port with important-     fixes (see below).-     (The webapp and assistant are still alpha-level on Windows.)-   * sync --content: Honor annex-ignore configuration.-   * sync: Don't try to sync with xmpp remotes, which are only currently-     supported when using the assistant.-   * sync --content: Re-pull from remotes after downloading content,-     since that can take a while and other changes may be pushed in the-     meantime.-   * sync --content: Reuse smart copy code from copy command, including-     handling and repairing out of date location tracking info.-     Closes: #[737480](http://bugs.debian.org/737480)-   * sync --content: Drop files from remotes that don't want them after-     getting them.-   * sync: Fix bug in automatic merge conflict resolution code when used-     on a filesystem not supporting symlinks, which resulted in it losing-     track of the symlink bit of annexed files.-   * Added ways to configure rsync options to be used only when uploading-     or downloading from a remote. Useful to eg limit upload bandwidth.-   * Fix initremote with encryption=pubkey to work with S3, glacier, webdav,-     and external special remotes.-   * Avoid building with DAV 0.6 which is badly broken (see #737902).-   * Fix dropping of unused keys with spaces in their name.-   * Fix build on platforms not supporting the webapp.-   * Document in man page that sshcaching uses ssh ControlMaster.-     Closes: #[737476](http://bugs.debian.org/737476)-   * Windows: It's now safe to run multiple git-annex processes concurrently-     on Windows; the lock files have been sorted out.-   * Windows: Avoid using unix-compat's rename, which refuses to rename-     directories.-   * Windows: Fix deletion of repositories by test suite and webapp.-   * Windows: Test suite 100% passes again.-   * Windows: Fix bug in symlink calculation code.-   * Windows: Fix handling of absolute unix-style git repository paths.-   * Android: Avoid crashing when unable to set file mode for ssh config file-     due to Android filesystem horribleness."""]]
+ doc/news/version_5.20140320.mdwn view
@@ -0,0 +1,37 @@+git-annex 5.20140320 released with [[!toggle text="these changes"]]+[[!toggleable text="""+   * Fix zombie leak and general inneficiency when copying files to a+     local git repo.+   * Fix ssh connection caching stop method to work with openssh 6.5p1,+     which broke the old method.+   * webapp: Added a "Sync now" item to each repository's menu.+   * webapp: Use securemem for constant time auth token comparisons.+   * copy --fast --to remote: Avoid printing anything for files that+     are already believed to be present on the remote.+   * Commands that allow specifying which repository to act on using+     the repository's description will now fail when multiple repositories+     match, rather than picking a repository at random.+     (So will --in=)+   * Better workaround for problem umasks when eg, setting up ssh keys.+   * "standard" can now be used as a first-class keyword in preferred content+     expressions. For example "standard or (include=otherdir/*)"+   * groupwanted can be used in preferred content expressions.+   * vicfg: Allows editing preferred content expressions for groups.+   * Improve behavior when unable to parse a preferred content expression+     (thanks, ion).+   * metadata: Add --get+   * metadata: Support --key option (and some other ones like --all)+   * For each metadata field, there's now an automatically maintained+     "$field-lastchanged" that gives the date of the last change to that+     field. Also the "lastchanged" field for the date of the last change+     to any of a file's metadata.+   * unused: In direct mode, files that are deleted from the work tree+     and so have no content present are no longer incorrectly detected as+     unused.+   * Avoid encoding errors when using the unused log file.+   * map: Fix crash when one of the remotes of a repo is a local directory+     that does not exist, or is not a git repo.+   * repair: Improve memory usage when git fsck finds a great many broken+     objects.+   * Windows: Fix some filename encoding bugs.+   * rsync special remote: Fix slashes when used on Windows."""]]
doc/preferred_content.mdwn view
@@ -2,7 +2,7 @@ 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,13 +11,33 @@ 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 options in commands like this:@@ -54,7 +74,7 @@  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 @@ ### 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 @@ 	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 @@  (If no directory name is configured, it uses "public" by default.) -## testing preferred content settings--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.--## standard expressions--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.--(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.)--### client--All content is preferred, 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 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.+### difference: "standard" -The preferred content expression for these causes them to only retain-data until a copy has been sent to some other repository.+git-annex comes with some built-in preferred content expressions, that+can be used with repositories that are in some [[standard_groups]]. -`not (copies=1)`+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!) -### manual+Most often, the whole preferred content expression is simply "standard".+But, you can do more complicated things, for example:+"`standard or include=otherdir/*`" -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.+### difference: "groupwanted" -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.+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`. -`present and ($client)`+Note that when writing a groupwanted preferred content expression,+you can use all of the keywords listed above, including "standard".+(But not "groupwanted".) -(Where $client is a copy of the preferred content expression used for-clients.)+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. -### public+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. -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.)+## upgrades -The name of the directory can be configured using-`git annex enableremote $remote preferreddir=$dirname`+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. -### unwanted+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. -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.)+Here are recent changes to preferred content expressions, and the version+they were added in. -`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
+ doc/preferred_content/standard_groups.mdwn view
@@ -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=*`
doc/related_software.mdwn view
@@ -11,3 +11,4 @@   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)
+ doc/todo/Feature_Request:_Sync_Now_Button_in_Webapp.mdwn view
@@ -0,0 +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]]
+ doc/todo/add_a_--branch_to_applicable_git-annex_commands.mdwn view
@@ -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"
doc/todo/add_an_icon_for_the_.desktop_file.mdwn view
@@ -1,1 +1,3 @@ Maybe add the icon /usr/share/doc/git-annex/html/logo.svg to the .desktp file.++> [[done]] long ago.. --[[Joey]]
+ doc/todo/assistant_parallel_file_transfers.mdwn view
@@ -0,0 +1,15 @@+Hi and thank you for an incredible piece of software and great work!++I've noticed that when I add new files to a repository and I have my USB drive connected, the assistant alternate it's transfers of files. And only transfers one queued file at the time.++file1 -->> Internet offsite computer+file1 -->> USB drive+file2 -->> Internet offsite computer+file2 -->> USB drive+++I would prefer a logic where the assistant transfer files in parallel to my different repositories. I know that it might not be a good thing doing that with network accessed repositories, but when I have "low cost", locally attached USB drives it would be great if the transfers could be done in parallel.+++Is there a configuration option for this already?+
− doc/todo/assistant_parallel_file_transfers.txt 
@@ -1,15 +0,0 @@-Hi and thank you for an incredible piece of software and great work!--I've noticed that when I add new files to a repository and I have my USB drive connected, the assistant alternate it's transfers of files. And only transfers one queued file at the time.--file1 -->> Internet offsite computer-file1 -->> USB drive-file2 -->> Internet offsite computer-file2 -->> USB drive---I would prefer a logic where the assistant transfer files in parallel to my different repositories. I know that it might not be a good thing doing that with network accessed repositories, but when I have "low cost", locally attached USB drives it would be great if the transfers could be done in parallel.---Is there a configuration option for this already?-
+ doc/todo/openwrt_package.mdwn view
@@ -0,0 +1,6 @@+hi++recently i have installed openwrt on my mikrotik routerboard. i am verry suprised how well it works. it lacks git-annex package. openwrt has git and i can install it.++how can i build one on a mips arch ?+is it possible to build multiple architecture standalone binaries ?
− doc/todo/openwrt_package.txt 
@@ -1,6 +0,0 @@-hi--recently i have installed openwrt on my mikrotik routerboard. i am verry suprised how well it works. it lacks git-annex package. openwrt has git and i can install it.--how can i build one on a mips arch ?-is it possible to build multiple architecture standalone binaries ?
+ doc/todo/union_mounting/comment_3_cf0a0d4fbd929f24f7056115b2acb7de._comment view
@@ -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.+"""]]
doc/todo/windows_support.mdwn view
@@ -29,6 +29,42 @@ * 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 @@    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+   <http://hackage.haskell.org/package/pontarius-xmpp>
doc/todo/wishlist:_An_option_like_--git-dir.mdwn view
@@ -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]]
doc/todo/wishlist:_assistant_autostart_port_and_secret_configuration.mdwn view
@@ -1,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]]
doc/todo/wishlist:_define_remotes_that_must_have_all_files.mdwn view
@@ -16,3 +16,7 @@ 	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]]
doc/todo/wishlist:_git-annex_replicate.mdwn view
@@ -10,3 +10,13 @@   * 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]]
+ doc/todo/wishlist:_metadata_metadata_view.mdwn view
@@ -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]]
doc/walkthrough.mdwn view
@@ -3,6 +3,7 @@ [[!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
+ doc/walkthrough/setup_git.mdwn view
@@ -0,0 +1,2 @@+If you haven't configured your identity for GIT, you will have to do this before git annex will work.+
git-annex.1 view
@@ -279,7 +279,8 @@ .IP .IP "\fBwebapp\fP" 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. .IP By default, the webapp can only be accessed from localhost, and running it opens a browser window.@@ -439,8 +440,8 @@ .IP .IP "\fBvicfg\fP" 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. .IP .IP "\fBdirect\fP" Switches a repository to use direct mode, where rather than symlinks to@@ -649,12 +650,20 @@ is not limited to git\-annex repositories. .IP .SH METADATA COMMANDS-.IP "\fBmetadata [path ...] [\-s field=value \-s field+=value \-s field\-=value ...]\fP"+.IP "\fBmetadata [path ...] [\-s field=value \-s field+=value \-s field\-=value ...] [\-g field]\fP" .IP 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. +.IP+This command can be used to set metadata, or show the currently set+metadata.+.IP+To show current metadata, run without any \-s parameters. The \-\-json+option will enable json output.+.IP+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. .IP To set a field's value, removing any old value(s), use \-s field=value. .IP
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 5.20140306+Version: 5.20140320 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess <joey@kitenet.net>@@ -7,6 +7,7 @@ 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,6 +44,9 @@ Flag Webapp   Description: Enable git-annex webapp +Flag Webapp-secure+  Description: Secure webapp+ Flag Pairing   Description: Enable pairing @@ -178,8 +182,12 @@      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-secure)+    Build-Depends: warp-tls (>= 1.4), securemem+    CPP-Options: -DWITH_WEBAPP_SECURE    if flag(Pairing)     Build-Depends: network-multicast, network-info
standalone/android/openssh.patch view
@@ -29,6 +29,18 @@  		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
+ standalone/linux/haskell-patches/network_disable_accept4.patch view
@@ -0,0 +1,26 @@+From f89652f762cf40e4c737fc1b9d6f395eb8df1959 Mon Sep 17 00:00:00 2001+From: Joey Hess <joey@kitenet.net>+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+
standalone/linux/install-haskell-packages view
@@ -34,7 +34,7 @@ 	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 @@ 	mkdir tmp 	cd tmp +	patched network 	patched wai-app-static 	patched shakespeare 	patched shakespeare-css@@ -72,11 +73,12 @@ 	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 @@ 	patched reflection 	patched lens 	patched xml-hamlet-	patched shakespeare-text 	patched DAV  	cd ..
standalone/no-th/haskell-patches/hamlet_remove-TH.patch view
@@ -1,17 +1,18 @@-From f500a9e447912e68c12f011fe97b62e6a6c5c3ce Mon Sep 17 00:00:00 2001-From: Joey Hess <joey@kitenet.net>-Date: Tue, 17 Dec 2013 16:16:32 +0000+From 60d7ac8aa1b3282a06ea7b17680dfc32c61fcbf6 Mon Sep 17 00:00:00 2001+From: dummy <dummy@example.com>+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 @@      , HtmlUrl -    , hamlet -    , hamletFile+-    , hamletFileReload+-    , ihamletFileReload -    , xhamlet -    , xhamletFile +    --, hamlet +    --, hamletFile++    --, hamletFileReload++    --, ihamletFileReload +    --, xhamlet +    --, xhamletFile        -- * I18N Hamlet@@ -63,7 +68,7 @@      , 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 @@  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++{-+ 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+                           } ---ihamletFile :: FilePath -> Q Exp--ihamletFile = hamletFileWithSettings ihamletRules defaultHamletSettings++{-+ 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|] ---varName :: Scope -> String -> Exp--varName _ "" = error "Illegal empty varName"--varName scope v@(_:_) = fromMaybe (strToExp v) $ lookup (Ident v) scope++-}+ -- 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)|] ---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"++-}  - -- | 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+ htmlEmptyTags :: Set String+ htmlEmptyTags = Set.fromAscList -- -1.8.5.1+1.9.0
standalone/no-th/haskell-patches/lens_no-TH.patch view
@@ -1,20 +1,21 @@-From b9b3cd52735f9ede1a83960968dc1f0e91e061d6 Mon Sep 17 00:00:00 2001+From 66fdbc0cb69036b61552a3bce7e995ea2a7f76c1 Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com>-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 @@  -- 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 @@      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 @@      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 @@ -    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 @@        mtl,        nats,        parallel,-@@ -432,7 +423,6 @@ benchmark plated+@@ -434,7 +420,6 @@ benchmark plated      comonad,      criterion,      deepseq,@@ -81,7 +100,7 @@      lens,      transformers  -@@ -467,7 +457,6 @@ benchmark unsafe+@@ -469,7 +454,6 @@ benchmark unsafe      comonads-fd,      criterion,      deepseq,@@ -89,7 +108,7 @@      lens,      transformers  -@@ -484,6 +473,5 @@ benchmark zipper+@@ -486,6 +470,5 @@ benchmark zipper      comonads-fd,      criterion,      deepseq,@@ -97,7 +116,7 @@      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 @@    , 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 @@    , 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 @@  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 @@  -- >>> :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 @@  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 @@  prim :: (PrimMonad m) => Iso' (m a) (State# (PrimState m) -> (# State# (PrimState m), a #))  prim = iso internal primitive -- -1.7.10.4+1.9.0
standalone/no-th/haskell-patches/monad-logger_remove-TH.patch view
@@ -1,150 +1,27 @@-From 08aa9d495cb486c45998dfad95518c646b5fa8cc Mon Sep 17 00:00:00 2001-From: Joey Hess <joey@kitenet.net>-Date: Tue, 17 Dec 2013 16:24:31 +0000-Subject: [PATCH] remove TH+From 8e78a25ce0cc19e52d063f66bd4cd316462393d4 Mon Sep 17 00:00:00 2001+From: dummy <dummy@example.com>+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- - 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)- --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+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  - 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+ flag template_haskell {+       Description: Enable Template Haskell support+-      Default:     True+-      Manual:      True++      Default:     False++      Manual:      False+ }  --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
standalone/no-th/haskell-patches/reflection_remove-TH.patch view
@@ -1,17 +1,17 @@-From 22c68b43dce437b3c22956f5a968f1b886e60e0c Mon Sep 17 00:00:00 2001-From: Joey Hess <joey@kitenet.net>-Date: Tue, 17 Dec 2013 19:15:16 +0000+From c0f5dcfd6ba7a05bb84b6adc4664c8dde109e6ac Mon Sep 17 00:00:00 2001+From: dummy <dummy@example.com>+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 @@      -- * 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 #-}- ---- | 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 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 = (/)+@@ -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" ----- | 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++-}+ #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 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) ---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
− standalone/no-th/haskell-patches/shakespeare_1.0.3_0002-remove-TH.patch 
@@ -1,223 +0,0 @@-From b66f160fea86d8839572620892181eb4ada2ad29 Mon Sep 17 00:00:00 2001-From: Joey Hess <joey@kitenet.net>-Date: Tue, 17 Dec 2013 06:17:26 +0000-Subject: [PATCH 2/2] remove TH------ Text/Shakespeare.hs      | 131 +++--------------------------------------------- Text/Shakespeare/Base.hs |  28 ----------- 2 files changed, 6 insertions(+), 153 deletions(-)--diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs-index f908ff4..55cd1d1 100644---- a/Text/Shakespeare.hs-+++ b/Text/Shakespeare.hs-@@ -12,14 +12,14 @@ module Text.Shakespeare-     , WrapInsertion (..)-     , PreConversion (..)-     , defaultShakespeareSettings--    , shakespeare--    , shakespeareFile--    , shakespeareFileReload-+    --, shakespeare-+    --, shakespeareFile-+    -- , shakespeareFileReload-     -- * low-level--    , shakespeareFromString--    , shakespeareUsedIdentifiers-+    -- , shakespeareFromString-+    --, shakespeareUsedIdentifiers-     , RenderUrl--    , VarType-+    --, VarType-     , Deref-     , Parser- -@@ -151,38 +151,6 @@ defaultShakespeareSettings = ShakespeareSettings {-   , modifyFinalValue = Nothing- }- --instance Lift PreConvert where--    lift (PreConvert convert ignore comment wrapInsertion) =--        [|PreConvert $(lift convert) $(lift ignore) $(lift comment) $(lift wrapInsertion)|]----instance Lift WrapInsertion where--    lift (WrapInsertion indent sb sep sc e wp) =--        [|WrapInsertion $(lift indent) $(lift sb) $(lift sep) $(lift sc) $(lift e) $(lift wp)|]----instance Lift PreConversion where--    lift (ReadProcess command args) =--        [|ReadProcess $(lift command) $(lift args)|]--    lift Id = [|Id|]----instance Lift ShakespeareSettings where--    lift (ShakespeareSettings x1 x2 x3 x4 x5 x6 x7 x8 x9) =--        [|ShakespeareSettings--            $(lift x1) $(lift x2) $(lift x3)--            $(liftExp x4) $(liftExp x5) $(liftExp x6) $(lift x7) $(lift x8) $(liftMExp x9)|]--      where--        liftExp (VarE n) = [|VarE $(liftName n)|]--        liftExp (ConE n) = [|ConE $(liftName n)|]--        liftExp _ = error "liftExp only supports VarE and ConE"--        liftMExp Nothing = [|Nothing|]--        liftMExp (Just e) = [|Just|] `appE` liftExp e--        liftName (Name (OccName a) b) = [|Name (OccName $(lift a)) $(liftFlavour b)|]--        liftFlavour NameS = [|NameS|]--        liftFlavour (NameQ (ModName a)) = [|NameQ (ModName $(lift a))|]--        liftFlavour (NameU _) = error "liftFlavour NameU" -- [|NameU $(lift $ fromIntegral a)|]--        liftFlavour (NameL _) = error "liftFlavour NameL" -- [|NameU $(lift $ fromIntegral a)|]--        liftFlavour (NameG ns (PkgName p) (ModName m)) = [|NameG $(liftNS ns) (PkgName $(lift p)) (ModName $(lift m))|]--        liftNS VarName = [|VarName|]--        liftNS DataName = [|DataName|]- - type QueryParameters = [(TS.Text, TS.Text)]- type RenderUrl url = (url -> QueryParameters -> TS.Text)-@@ -346,77 +314,12 @@ 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)]- - data VarExp url = EPlain Builder-                 | EUrl url-                 | EUrlParam (url, [(TS.Text, TS.Text)])-                 | EMixin (Shakespeare url)- ---- | 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]- insertReloadMap fp (mt, content) = atomicModifyIORef reloadMapRef-   (\reloadMap -> (M.insert fp (mt, content) reloadMap, content))- --shakespeareFileReload :: ShakespeareSettings -> FilePath -> Q Exp--shakespeareFileReload settings fp = do--    str <- readFileQ fp--    s <- qRunIO $ preFilter (Just fp) settings str--    let b = shakespeareUsedIdentifiers settings s--    c <- mapM vtToExp b--    rt <- [|shakespeareRuntime settings fp|]--    wrap' <- [|\x -> $(return $ wrap settings) . x|]--    return $ wrap' `AppE` (rt `AppE` ListE c)--  where--    vtToExp :: (Deref, VarType) -> Q Exp--    vtToExp (d, vt) = do--        d' <- lift d--        c' <- c vt--        return $ TupE [d', c' `AppE` derefToExp [] d]--      where--        c :: VarType -> Q Exp--        c VTPlain = [|EPlain . $(return $--          InfixE (Just $ unwrap settings) (VarE '(.)) (Just $ toBuilder settings))|]--        c VTUrl = [|EUrl|]--        c VTUrlParam = [|EUrlParam|]--        c VTMixin = [|\x -> EMixin $ \r -> $(return $ unwrap settings) $ x r|]- - - -diff --git a/Text/Shakespeare/Base.hs b/Text/Shakespeare/Base.hs-index 9573533..49f1995 100644---- a/Text/Shakespeare/Base.hs-+++ b/Text/Shakespeare/Base.hs-@@ -52,34 +52,6 @@ data Deref = DerefModulesIdent [String] Ident-            | DerefTuple [Deref]-     deriving (Show, Eq, Read, Data, Typeable, Ord)- --instance Lift Ident where--    lift (Ident s) = [|Ident|] `appE` lift s--instance Lift Deref where--    lift (DerefModulesIdent v s) = do--        dl <- [|DerefModulesIdent|]--        v' <- lift v--        s' <- lift s--        return $ dl `AppE` v' `AppE` s'--    lift (DerefIdent s) = do--        dl <- [|DerefIdent|]--        s' <- lift s--        return $ dl `AppE` s'--    lift (DerefBranch x y) = do--        x' <- lift x--        y' <- lift y--        db <- [|DerefBranch|]--        return $ db `AppE` x' `AppE` y'--    lift (DerefIntegral i) = [|DerefIntegral|] `appE` lift i--    lift (DerefRational r) = do--        n <- lift $ numerator r--        d <- lift $ denominator r--        per <- [|(%) :: Int -> Int -> Ratio Int|]--        dr <- [|DerefRational|]--        return $ dr `AppE` InfixE (Just n) per (Just d)--    lift (DerefString s) = [|DerefString|] `appE` lift s--    lift (DerefList x) = [|DerefList $(lift x)|]--    lift (DerefTuple x) = [|DerefTuple $(lift x)|]--- derefParens, derefCurlyBrackets :: UserParser a Deref- derefParens        = between (char '(') (char ')') parseDeref- derefCurlyBrackets = between (char '{') (char '}') parseDeref--- -1.8.5.1-
+ standalone/no-th/haskell-patches/shakespeare_remove-th.patch view
@@ -0,0 +1,189 @@+From 753f8ce37e096a343f1dd02a696a287bc91c24a0 Mon Sep 17 00:00:00 2001+From: Joey Hess <joey@kitenet.net>+Date: Thu, 6 Mar 2014 22:34:03 +0000+Subject: [PATCH] remove TH++---+ 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 68e344f..aef741c 100644+--- a/Text/Shakespeare.hs++++ b/Text/Shakespeare.hs+@@ -14,17 +14,20 @@ module Text.Shakespeare+     , WrapInsertion (..)+     , PreConversion (..)+     , defaultShakespeareSettings+-    , shakespeare+-    , shakespeareFile+-    , shakespeareFileReload++    -- , shakespeare++    -- , shakespeareFile++    -- , shakespeareFileReload+     -- * low-level+-    , shakespeareFromString+-    , shakespeareUsedIdentifiers++    -- , shakespeareFromString++    -- , shakespeareUsedIdentifiers+     , RenderUrl+     , VarType (..)+     , Deref+     , Parser+ ++    -- used by TH++    , pack'+++ #ifdef TEST_EXPORT+     , preFilter+ #endif+@@ -154,38 +157,6 @@ defaultShakespeareSettings = ShakespeareSettings {+   , modifyFinalValue = Nothing+ }+ +-instance Lift PreConvert where+-    lift (PreConvert convert ignore comment wrapInsertion) =+-        [|PreConvert $(lift convert) $(lift ignore) $(lift comment) $(lift wrapInsertion)|]+-+-instance Lift WrapInsertion where+-    lift (WrapInsertion indent sb sep sc e wp) =+-        [|WrapInsertion $(lift indent) $(lift sb) $(lift sep) $(lift sc) $(lift e) $(lift wp)|]+-+-instance Lift PreConversion where+-    lift (ReadProcess command args) =+-        [|ReadProcess $(lift command) $(lift args)|]+-    lift Id = [|Id|]+-+-instance Lift ShakespeareSettings where+-    lift (ShakespeareSettings x1 x2 x3 x4 x5 x6 x7 x8 x9) =+-        [|ShakespeareSettings+-            $(lift x1) $(lift x2) $(lift x3)+-            $(liftExp x4) $(liftExp x5) $(liftExp x6) $(lift x7) $(lift x8) $(liftMExp x9)|]+-      where+-        liftExp (VarE n) = [|VarE $(liftName n)|]+-        liftExp (ConE n) = [|ConE $(liftName n)|]+-        liftExp _ = error "liftExp only supports VarE and ConE"+-        liftMExp Nothing = [|Nothing|]+-        liftMExp (Just e) = [|Just|] `appE` liftExp e+-        liftName (Name (OccName a) b) = [|Name (OccName $(lift a)) $(liftFlavour b)|]+-        liftFlavour NameS = [|NameS|]+-        liftFlavour (NameQ (ModName a)) = [|NameQ (ModName $(lift a))|]+-        liftFlavour (NameU _) = error "liftFlavour NameU" -- [|NameU $(lift $ fromIntegral a)|]+-        liftFlavour (NameL _) = error "liftFlavour NameL" -- [|NameU $(lift $ fromIntegral a)|]+-        liftFlavour (NameG ns (PkgName p) (ModName m)) = [|NameG $(liftNS ns) (PkgName $(lift p)) (ModName $(lift m))|]+-        liftNS VarName = [|VarName|]+-        liftNS DataName = [|DataName|]+ + type QueryParameters = [(TS.Text, TS.Text)]+ type RenderUrl url = (url -> QueryParameters -> TS.Text)+@@ -349,6 +320,7 @@ pack' = TS.pack+ {-# NOINLINE pack' #-}+ #endif+ ++{-+ 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+@@ -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++-}+ + type MTime = UTCTime+ +@@ -436,28 +413,6 @@ insertReloadMap :: FilePath -> (MTime, [Content]) -> IO [Content]+ insertReloadMap fp (mt, content) = atomicModifyIORef reloadMapRef+   (\reloadMap -> (M.insert fp (mt, content) reloadMap, content))+ +-shakespeareFileReload :: ShakespeareSettings -> FilePath -> Q Exp+-shakespeareFileReload settings fp = do+-    str <- readFileQ fp+-    s <- qRunIO $ preFilter (Just fp) settings str+-    let b = shakespeareUsedIdentifiers settings s+-    c <- mapM vtToExp b+-    rt <- [|shakespeareRuntime settings fp|]+-    wrap' <- [|\x -> $(return $ wrap settings) . x|]+-    return $ wrap' `AppE` (rt `AppE` ListE c)+-  where+-    vtToExp :: (Deref, VarType) -> Q Exp+-    vtToExp (d, vt) = do+-        d' <- lift d+-        c' <- c vt+-        return $ TupE [d', c' `AppE` derefToExp [] d]+-      where+-        c :: VarType -> Q Exp+-        c VTPlain = [|EPlain . $(return $+-          InfixE (Just $ unwrap settings) (VarE '(.)) (Just $ toBuilder settings))|]+-        c VTUrl = [|EUrl|]+-        c VTUrlParam = [|EUrlParam|]+-        c VTMixin = [|\x -> EMixin $ \r -> $(return $ unwrap settings) $ x r|]+ + + +diff --git a/Text/Shakespeare/Base.hs b/Text/Shakespeare/Base.hs+index a0e983c..23b4692 100644+--- a/Text/Shakespeare/Base.hs++++ b/Text/Shakespeare/Base.hs+@@ -52,34 +52,6 @@ data Deref = DerefModulesIdent [String] Ident+            | DerefTuple [Deref]+     deriving (Show, Eq, Read, Data, Typeable, Ord)+ +-instance Lift Ident where+-    lift (Ident s) = [|Ident|] `appE` lift s+-instance Lift Deref where+-    lift (DerefModulesIdent v s) = do+-        dl <- [|DerefModulesIdent|]+-        v' <- lift v+-        s' <- lift s+-        return $ dl `AppE` v' `AppE` s'+-    lift (DerefIdent s) = do+-        dl <- [|DerefIdent|]+-        s' <- lift s+-        return $ dl `AppE` s'+-    lift (DerefBranch x y) = do+-        x' <- lift x+-        y' <- lift y+-        db <- [|DerefBranch|]+-        return $ db `AppE` x' `AppE` y'+-    lift (DerefIntegral i) = [|DerefIntegral|] `appE` lift i+-    lift (DerefRational r) = do+-        n <- lift $ numerator r+-        d <- lift $ denominator r+-        per <- [|(%) :: Int -> Int -> Ratio Int|]+-        dr <- [|DerefRational|]+-        return $ dr `AppE` InfixE (Just n) per (Just d)+-    lift (DerefString s) = [|DerefString|] `appE` lift s+-    lift (DerefList x) = [|DerefList $(lift x)|]+-    lift (DerefTuple x) = [|DerefTuple $(lift x)|]+-+ derefParens, derefCurlyBrackets :: UserParser a Deref+ derefParens        = between (char '(') (char ')') parseDeref+ derefCurlyBrackets = between (char '{') (char '}') parseDeref+-- +1.9.0+
standalone/no-th/haskell-patches/yesod-core_expand_TH.patch view
@@ -1,17 +1,19 @@-From 5f30a68faaa379ac3fe9f0b016dd1a20969d548f Mon Sep 17 00:00:00 2001+From be8d5895522da0397fd594d5553ed7d3641eb399 Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com>-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 @@      , 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 @@    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 @@        -- | 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 <head> 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 @@        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 @@      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 @@        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 @@      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 @@      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 @@  -- | 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 @@ -                    [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 @@  ihamletToRepHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message)                   => HtmlUrlI18n message (Route (HandlerSite m)) -- -1.7.10.4+1.9.0
standalone/no-th/haskell-patches/yesod-static_hack.patch view
@@ -1,17 +1,17 @@-From 4ea1e94794b59ba4eb0dab7384c4195a224f468d Mon Sep 17 00:00:00 2001-From: androidbuilder <androidbuilder@example.com>-Date: Fri, 27 Dec 2013 00:28:51 -0400+From 885cc873196f535de7cd1ac2ccfa217d10308d1f Mon Sep 17 00:00:00 2001+From: dummy <dummy@example.com>+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 @@    -- | Use <https://github.com/mishoo/UglifyJS2 UglifyJS2> 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 @@                     , filepath                     , resourcet -- -1.7.10.4+1.9.0
standalone/no-th/haskell-patches/yesod_hack-TH.patch view
@@ -1,13 +1,13 @@-From 69398345ff1e63bcc6a23fce18e42390328b78d2 Mon Sep 17 00:00:00 2001+From 369c99b9de0c82578f5221fdabc42ea9ba59ddea Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com>-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 @@ +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 @@      , 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 @@ -                else return $ Just ex -        else return Nothing -- -1.7.10.4+1.9.0
static/favicon.ico view

binary file changed (405 → 2550 bytes)

templates/repolist.hamlet view
@@ -39,13 +39,15 @@             $else               <span .dropdown #menu-#{show repoid}>                 <a .dropdown-toggle data-toggle="dropdown" href="#menu-#{show repoid}">-                  <i .icon-cog></i> settings+                  <i .icon-cog></i> actions                   <b .caret></b>                 <ul .dropdown-menu>                   <li>                     <a href="@{setupRepoLink actions}">                       <i .icon-pencil></i> Edit                     $if not (lacksUUID repoid)+                      <a href="@{SyncNowRepositoryR $ asUUID repoid}">+                        <i .icon-refresh></i> Sync now                       <a href="@{DisableRepositoryR $ asUUID repoid}">                         <i .icon-minus></i> Disable                       <a href="@{DeleteRepositoryR $ asUUID repoid}">