Merge branch 'master' of git://git-annex.branchable.com

Logs/PreferredContent.hs

@@ -19,9 +19,9 @@ module Logs.PreferredContent (
 import qualified Data.Map as M
 import qualified Data.Set as S
 import Data.Either
-import Data.Time.Clock.POSIX
 
 import Common.Annex
+import Logs.PreferredContent.Raw
 import qualified Annex.Branch
 import qualified Annex
 import Logs
@@ -36,15 +36,6 @@ import Logs.Group
 import Logs.Remote
 import Types.StandardGroups
 
-{- Changes the preferred content configuration of a remote. -}
-preferredContentSet :: UUID -> String -> Annex ()
-preferredContentSet uuid@(UUID _) val = do
-	ts <- liftIO getPOSIXTime
-	Annex.Branch.change preferredContentLog $
-		showLog id . changeLog ts uuid val . parseLog Just
-	Annex.changeState $ \s -> s { Annex.preferredcontentmap = Nothing }
-preferredContentSet NoUUID _ = error "unknown UUID; cannot modify"
-
 {- Checks if a file is preferred content for the specified repository
  - (or the current repository if none is specified). -}
 isPreferredContent :: Maybe UUID -> AssumeNotPresent -> FilePath -> Bool -> Annex Bool
@@ -71,15 +62,11 @@ preferredContentMapLoad = do
 	Annex.changeState $ \s -> s { Annex.preferredcontentmap = Just m }
 	return m
 
-preferredContentMapRaw :: Annex (M.Map UUID String)
-preferredContentMapRaw = simpleMap . parseLog Just
-	<$> Annex.Branch.get preferredContentLog
-
 {- 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 -> String -> FileMatcher
+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
@@ -95,7 +82,7 @@ standardMatcher groupmap configmap u =
 		getStandardGroup =<< u `M.lookup` groupsByUUID groupmap
 
 {- Checks if an expression can be parsed, if not returns Just error -}
-checkPreferredContentExpression :: String -> Maybe String
+checkPreferredContentExpression :: PreferredContentExpression -> Maybe String
 checkPreferredContentExpression expr
 	| expr == "standard" = Nothing
 	| otherwise = case parsedToMatcher tokens of

Logs/PreferredContent/Raw.hs

@@ -0,0 +1,31 @@
+{- unparsed preferred content expressions
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Logs.PreferredContent.Raw where
+
+import qualified Data.Map as M
+import Data.Time.Clock.POSIX
+
+import Common.Annex
+import qualified Annex.Branch
+import qualified Annex
+import Logs
+import Logs.UUIDBased
+import Types.StandardGroups
+
+{- 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
+	Annex.changeState $ \s -> s { Annex.preferredcontentmap = Nothing }
+preferredContentSet NoUUID _ = error "unknown UUID; cannot modify"
+
+preferredContentMapRaw :: Annex (M.Map UUID PreferredContentExpression)
+preferredContentMapRaw = simpleMap . parseLog Just
+	<$> Annex.Branch.get preferredContentLog

Remote/External.hs

@@ -18,6 +18,7 @@ import Remote.Helper.Encryptable
 import Crypto
 import Utility.Metered
 import Logs.Transfer
+import Logs.PreferredContent.Raw
 import Config.Cost
 import Annex.Content
 import Annex.UUID
@@ -206,7 +207,7 @@ handleRequest' lck external req mp responsehandler
 	handleRemoteRequest (PROGRESS bytesprocessed) =
 		maybe noop (\a -> liftIO $ a bytesprocessed) mp
 	handleRemoteRequest (DIRHASH k) = 
-		sendMessage lck external $ VALUE $ hashDirMixed k
+		send $ VALUE $ hashDirMixed k
 	handleRemoteRequest (SETCONFIG setting value) =
 		liftIO $ atomically $ do
 			let v = externalConfig external
@@ -215,7 +216,7 @@ handleRequest' lck external req mp responsehandler
 	handleRemoteRequest (GETCONFIG setting) = do
 		value <- fromMaybe "" . M.lookup setting
 			<$> liftIO (atomically $ readTMVar $ externalConfig external)
-		sendMessage lck external $ VALUE value
+		send $ VALUE value
 	handleRemoteRequest (SETCREDS setting login password) = do
 		c <- liftIO $ atomically $ readTMVar $ externalConfig external
 		c' <- setRemoteCredPair' c (credstorage setting)
@@ -225,14 +226,22 @@ handleRequest' lck external req mp responsehandler
 		c <- liftIO $ atomically $ readTMVar $ externalConfig external
 		creds <- fromMaybe ("", "") <$> 
 			getRemoteCredPair c (credstorage setting)
-		sendMessage lck external $ CREDS (fst creds) (snd creds)
-	handleRemoteRequest GETUUID = sendMessage lck external $
+		send $ CREDS (fst creds) (snd creds)
+	handleRemoteRequest GETUUID = send $
 		VALUE $ fromUUID $ externalUUID external
+	handleRemoteRequest (SETWANTED expr) =
+		preferredContentSet (externalUUID external) expr
+	handleRemoteRequest GETWANTED = do
+		expr <- fromMaybe "" . M.lookup (externalUUID external)
+			<$> preferredContentMapRaw
+		send $ VALUE expr
 	handleRemoteRequest (VERSION _) =
 		sendMessage lck external $ ERROR "too late to send VERSION"
 
 	handleAsyncMessage (ERROR err) = error $ "external special remote error: " ++ err
 
+	send = sendMessage lck external
+
 	credstorage setting = CredPairStorage
 		{ credPairFile = base
 		, credPairEnvironment = (base ++ "login", base ++ "password")

Remote/External/Types.hs

@@ -33,6 +33,7 @@ module Remote.External.Types (
 import Common.Annex
 import Annex.Exception
 import Types.Key (file2key, key2file)
+import Types.StandardGroups (PreferredContentExpression)
 import Utility.Metered (BytesProcessed(..))
 import Logs.Transfer (Direction(..))
 import Config.Cost (Cost)
@@ -167,6 +168,8 @@ data RemoteRequest
 	| SETCREDS Setting String String
 	| GETCREDS Setting
 	| GETUUID
+	| SETWANTED PreferredContentExpression
+	| GETWANTED
 	deriving (Show)
 
 instance Receivable RemoteRequest where
@@ -178,6 +181,8 @@ instance Receivable RemoteRequest where
 	parseCommand "SETCREDS" = parse3 SETCREDS
 	parseCommand "GETCREDS" = parse1 GETCREDS
 	parseCommand "GETUUID" = parse0 GETUUID
+	parseCommand "SETWANTED" = parse1 SETWANTED
+	parseCommand "GETWANTED" = parse0 GETWANTED
 	parseCommand _ = parseFail
 
 -- Responses to RemoteRequest.

Types/StandardGroups.hs

@@ -12,6 +12,8 @@ import Types.Remote (RemoteConfig)
 import qualified Data.Map as M
 import Data.Maybe
 
+type PreferredContentExpression = String
+
 data StandardGroup
 	= ClientGroup
 	| TransferGroup
@@ -71,7 +73,7 @@ associatedDirectory Nothing PublicGroup = Just "public"
 associatedDirectory _ _ = Nothing
 
 {- See doc/preferred_content.mdwn for explanations of these expressions. -}
-preferredContent :: StandardGroup -> String
+preferredContent :: StandardGroup -> PreferredContentExpression
 preferredContent ClientGroup = lastResort $
 	"(exclude=*/archive/* and exclude=archive/*) or (" ++ notArchived ++ ")"
 preferredContent TransferGroup = lastResort $
@@ -92,5 +94,5 @@ notArchived = "not (copies=archive:1 or copies=smallarchive:1)"
   	
 {- Most repositories want any content that is only on untrusted
  - or dead repositories. -}
-lastResort :: String -> String
+lastResort :: String -> PreferredContentExpression
 lastResort s = "(" ++ s ++ ") or (not copies=semitrusted+:1)"

debian/changelog

@@ -1,7 +1,7 @@
 git-annex (5.20131231) UNRELEASED; urgency=medium
 
   * mirror: Support --all (and --unused).
-  * external special remote protocol: Added GETUUID.
+  * external special remote protocol: Added GETUUID, GETWANTED, SETWANTED.
   * Windows: Fix bug in direct mode merge code that could cause files
     in subdirectories to go missing.
   * Windows: Avoid eating stdin when running ssh to add a authorized key,

doc/design/external_special_remote_protocol.mdwn

@@ -212,6 +212,16 @@ in control.
 * `GETUUID`  
   Queries for the UUID of the special remote being used.  
   (git-annex replies with VALUE followed by the UUID.)
+* `SETWANTED PreferredContentExpression`  
+  Can be used to set the preferred content of a repository. Normally
+  this is not configured by a special remote, but it may make sense
+  in some situations to hint at the kind of content that should be stored
+  in the special remote. Note that if a unparsable expression is set,
+  git-annex will ignore it.
+* `GETWANTED`  
+  Gets the current preferred content setting of the repository.
+  (git-annex replies with VALUE followed by the preferred content
+  expression.)
 
 ## general messages
 

doc/design/external_special_remote_protocol/comment_9_15c4cfe064be37cc104dcb6aa049a449._comment

@@ -0,0 +1,14 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.227"
+ subject="comment 9"
+ date="2014-01-02T00:15:28Z"
+ content="""
+Tobias made some good points:
+
+* git-annex may not be in PATH depending on installation method
+* It would in theory be bad if a special remote ran some git-annex command that used the special remote and ran some git-annex command [...].
+* git-annex would need to tell the special remote what git repo it was being used with.
+
+So, added GETWANTED and SETWANTED. However, if I find myself recapitulating a lot of git-annex's command-line plumbing stuff in this protocol, I will need to revisit this decision and find a better way. Particularly, I narrowly escaped an intractable dependency loop in [[!commit 8e3032df2d5c6ddf07e43de4b3bb89cb578ae048]].
+"""]]

doc/devblog/day_90__slow_start.mdwn

@@ -0,0 +1,23 @@
+Various work on Debian, OSX, and Windows stuff. Mostly uninteresting, but
+took most of the day.
+
+Made `git annex mirror --all` work. I can see why I left it out; when the
+mirroring wants to drop an object, in --all mode it doesn't have an
+associated file in the tree, so it cannot look at the annex.numcopies in
+gitattributes. Same reason why `git annex drop --all` is not implemented.
+But decided to go ahead and only use other numcopies configuration for
+mirroring.
+
+Added GETWANTED and SETWANTED to the external special remote protocol, and
+that is as far as I want to go on adding git-annex plumbing stuff to the
+protocol. I expect Tobias will release a boatload of special remotes
+updated to the new protocol soon, which seems to prove it has everything
+that could reasonably be needed.
+
+This is a nice public git-annex repository containing a growing collection
+of tech conference videos. <https://github.com/RichiH/conference_proceedings>
+
+Did some design work on [[todo/untracked_remotes]], which I think will turn
+out to be read-only remotes. Being able to clone a repository and use
+git-annex in the clone without anything leaking back upstream is often
+desirable when using public repository, or a repository with many users.

doc/forum/How_to_resolve_a_interrupted_merge_in_direct_mode__63__/comment_2_031ab6b5a2765ed9e2b185b24a8cbd78._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawkYmMFDdf3GJ9Oba6NCVkzGc4JyB9WavMs"
+ nickname="Xinruo"
+ subject="Thanks"
+ date="2014-01-02T00:41:27Z"
+ content="""
+That did the trick! 
+"""]]

doc/todo/untracked_remotes/comment_3_0d07c5bc8d42f35351c11411eaca88df._comment

@@ -0,0 +1,29 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawl9sYlePmv1xK-VvjBdN-5doOa_Xw-jH4U"
+ nickname="Richard"
+ subject="comment 3"
+ date="2014-01-02T00:26:14Z"
+ content="""
+Regarding 1.: If two untracked repositories are talking to each other, they should not be tracked at all, so I don't see any issue there.
+If an untracked repository communicates with a tracked one, the untracked one should still send updates for the tracked one when synching.
+The solution might really simply be a specific untracked location log distinct from the rest.
+This would even allow merging changes back into the main log if the user decides to track a repository after all.
+
+Regarding pushing to tracking branches: This behavior will change soon and you can override it; see the manpage for `git-config(1)` at push.default.
+
+Location leaks could be solved by passing `00000000-0000-0000-0000-000000000002` as UUID.
+Using that UUID might also be the solution for all untracked repos as it's trivial to special case for this, but:
+* What happens when you switch a known repo to untracked? What happens to its UUID in various logs? Maybe introduce a specific discard log which tries to get rid of all data concerning those UUIDs?
+* What happens when you switch a repo from untracked to tracked? Simply generate (reactivate?) a UUID and switch all local occurences of `00000000-0000-0000-0000-000000000002` to the new UUID?
+
+`git annex drop --from publicrepo` is not allowed to take local copies into account to satisfy `numcopies`, simple as that.
+IMO, this is the only valid approach, as that mirrors the global view from all other repos.
+For all intents and purposes, an untracked repo does not exist.
+
+
+The complement, a read-only repo, would also be very useful.
+Such a repo would hold data, but it would never accept location data of anywhere besides itself and the web remote.
+
+
+Richard
+"""]]