Merge branch 'master' of git://git-annex.branchable.com
This commit is contained in:
commit
23fff40959
11 changed files with 141 additions and 23 deletions
|
@ -19,9 +19,9 @@ module Logs.PreferredContent (
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
import Data.Either
|
import Data.Either
|
||||||
import Data.Time.Clock.POSIX
|
|
||||||
|
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
|
import Logs.PreferredContent.Raw
|
||||||
import qualified Annex.Branch
|
import qualified Annex.Branch
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import Logs
|
import Logs
|
||||||
|
@ -36,15 +36,6 @@ import Logs.Group
|
||||||
import Logs.Remote
|
import Logs.Remote
|
||||||
import Types.StandardGroups
|
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
|
{- Checks if a file is preferred content for the specified repository
|
||||||
- (or the current repository if none is specified). -}
|
- (or the current repository if none is specified). -}
|
||||||
isPreferredContent :: Maybe UUID -> AssumeNotPresent -> FilePath -> Bool -> Annex Bool
|
isPreferredContent :: Maybe UUID -> AssumeNotPresent -> FilePath -> Bool -> Annex Bool
|
||||||
|
@ -71,15 +62,11 @@ preferredContentMapLoad = do
|
||||||
Annex.changeState $ \s -> s { Annex.preferredcontentmap = Just m }
|
Annex.changeState $ \s -> s { Annex.preferredcontentmap = Just m }
|
||||||
return 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,
|
{- This intentionally never fails, even on unparsable expressions,
|
||||||
- because the configuration is shared among repositories and newer
|
- because the configuration is shared among repositories and newer
|
||||||
- versions of git-annex may add new features. Instead, parse errors
|
- versions of git-annex may add new features. Instead, parse errors
|
||||||
- result in a Matcher that will always succeed. -}
|
- 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
|
makeMatcher groupmap configmap u expr
|
||||||
| expr == "standard" = standardMatcher groupmap configmap u
|
| expr == "standard" = standardMatcher groupmap configmap u
|
||||||
| null (lefts tokens) = Utility.Matcher.generate $ rights tokens
|
| null (lefts tokens) = Utility.Matcher.generate $ rights tokens
|
||||||
|
@ -95,7 +82,7 @@ standardMatcher groupmap configmap u =
|
||||||
getStandardGroup =<< u `M.lookup` groupsByUUID groupmap
|
getStandardGroup =<< u `M.lookup` groupsByUUID groupmap
|
||||||
|
|
||||||
{- Checks if an expression can be parsed, if not returns Just error -}
|
{- Checks if an expression can be parsed, if not returns Just error -}
|
||||||
checkPreferredContentExpression :: String -> Maybe String
|
checkPreferredContentExpression :: PreferredContentExpression -> Maybe String
|
||||||
checkPreferredContentExpression expr
|
checkPreferredContentExpression expr
|
||||||
| expr == "standard" = Nothing
|
| expr == "standard" = Nothing
|
||||||
| otherwise = case parsedToMatcher tokens of
|
| otherwise = case parsedToMatcher tokens of
|
||||||
|
|
31
Logs/PreferredContent/Raw.hs
Normal file
31
Logs/PreferredContent/Raw.hs
Normal file
|
@ -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
|
|
@ -18,6 +18,7 @@ import Remote.Helper.Encryptable
|
||||||
import Crypto
|
import Crypto
|
||||||
import Utility.Metered
|
import Utility.Metered
|
||||||
import Logs.Transfer
|
import Logs.Transfer
|
||||||
|
import Logs.PreferredContent.Raw
|
||||||
import Config.Cost
|
import Config.Cost
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
import Annex.UUID
|
import Annex.UUID
|
||||||
|
@ -206,7 +207,7 @@ handleRequest' lck external req mp responsehandler
|
||||||
handleRemoteRequest (PROGRESS bytesprocessed) =
|
handleRemoteRequest (PROGRESS bytesprocessed) =
|
||||||
maybe noop (\a -> liftIO $ a bytesprocessed) mp
|
maybe noop (\a -> liftIO $ a bytesprocessed) mp
|
||||||
handleRemoteRequest (DIRHASH k) =
|
handleRemoteRequest (DIRHASH k) =
|
||||||
sendMessage lck external $ VALUE $ hashDirMixed k
|
send $ VALUE $ hashDirMixed k
|
||||||
handleRemoteRequest (SETCONFIG setting value) =
|
handleRemoteRequest (SETCONFIG setting value) =
|
||||||
liftIO $ atomically $ do
|
liftIO $ atomically $ do
|
||||||
let v = externalConfig external
|
let v = externalConfig external
|
||||||
|
@ -215,7 +216,7 @@ handleRequest' lck external req mp responsehandler
|
||||||
handleRemoteRequest (GETCONFIG setting) = do
|
handleRemoteRequest (GETCONFIG setting) = do
|
||||||
value <- fromMaybe "" . M.lookup setting
|
value <- fromMaybe "" . M.lookup setting
|
||||||
<$> liftIO (atomically $ readTMVar $ externalConfig external)
|
<$> liftIO (atomically $ readTMVar $ externalConfig external)
|
||||||
sendMessage lck external $ VALUE value
|
send $ VALUE value
|
||||||
handleRemoteRequest (SETCREDS setting login password) = do
|
handleRemoteRequest (SETCREDS setting login password) = do
|
||||||
c <- liftIO $ atomically $ readTMVar $ externalConfig external
|
c <- liftIO $ atomically $ readTMVar $ externalConfig external
|
||||||
c' <- setRemoteCredPair' c (credstorage setting)
|
c' <- setRemoteCredPair' c (credstorage setting)
|
||||||
|
@ -225,14 +226,22 @@ handleRequest' lck external req mp responsehandler
|
||||||
c <- liftIO $ atomically $ readTMVar $ externalConfig external
|
c <- liftIO $ atomically $ readTMVar $ externalConfig external
|
||||||
creds <- fromMaybe ("", "") <$>
|
creds <- fromMaybe ("", "") <$>
|
||||||
getRemoteCredPair c (credstorage setting)
|
getRemoteCredPair c (credstorage setting)
|
||||||
sendMessage lck external $ CREDS (fst creds) (snd creds)
|
send $ CREDS (fst creds) (snd creds)
|
||||||
handleRemoteRequest GETUUID = sendMessage lck external $
|
handleRemoteRequest GETUUID = send $
|
||||||
VALUE $ fromUUID $ externalUUID external
|
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 _) =
|
handleRemoteRequest (VERSION _) =
|
||||||
sendMessage lck external $ ERROR "too late to send VERSION"
|
sendMessage lck external $ ERROR "too late to send VERSION"
|
||||||
|
|
||||||
handleAsyncMessage (ERROR err) = error $ "external special remote error: " ++ err
|
handleAsyncMessage (ERROR err) = error $ "external special remote error: " ++ err
|
||||||
|
|
||||||
|
send = sendMessage lck external
|
||||||
|
|
||||||
credstorage setting = CredPairStorage
|
credstorage setting = CredPairStorage
|
||||||
{ credPairFile = base
|
{ credPairFile = base
|
||||||
, credPairEnvironment = (base ++ "login", base ++ "password")
|
, credPairEnvironment = (base ++ "login", base ++ "password")
|
||||||
|
|
5
Remote/External/Types.hs
vendored
5
Remote/External/Types.hs
vendored
|
@ -33,6 +33,7 @@ module Remote.External.Types (
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
import Annex.Exception
|
import Annex.Exception
|
||||||
import Types.Key (file2key, key2file)
|
import Types.Key (file2key, key2file)
|
||||||
|
import Types.StandardGroups (PreferredContentExpression)
|
||||||
import Utility.Metered (BytesProcessed(..))
|
import Utility.Metered (BytesProcessed(..))
|
||||||
import Logs.Transfer (Direction(..))
|
import Logs.Transfer (Direction(..))
|
||||||
import Config.Cost (Cost)
|
import Config.Cost (Cost)
|
||||||
|
@ -167,6 +168,8 @@ data RemoteRequest
|
||||||
| SETCREDS Setting String String
|
| SETCREDS Setting String String
|
||||||
| GETCREDS Setting
|
| GETCREDS Setting
|
||||||
| GETUUID
|
| GETUUID
|
||||||
|
| SETWANTED PreferredContentExpression
|
||||||
|
| GETWANTED
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
instance Receivable RemoteRequest where
|
instance Receivable RemoteRequest where
|
||||||
|
@ -178,6 +181,8 @@ instance Receivable RemoteRequest where
|
||||||
parseCommand "SETCREDS" = parse3 SETCREDS
|
parseCommand "SETCREDS" = parse3 SETCREDS
|
||||||
parseCommand "GETCREDS" = parse1 GETCREDS
|
parseCommand "GETCREDS" = parse1 GETCREDS
|
||||||
parseCommand "GETUUID" = parse0 GETUUID
|
parseCommand "GETUUID" = parse0 GETUUID
|
||||||
|
parseCommand "SETWANTED" = parse1 SETWANTED
|
||||||
|
parseCommand "GETWANTED" = parse0 GETWANTED
|
||||||
parseCommand _ = parseFail
|
parseCommand _ = parseFail
|
||||||
|
|
||||||
-- Responses to RemoteRequest.
|
-- Responses to RemoteRequest.
|
||||||
|
|
|
@ -12,6 +12,8 @@ import Types.Remote (RemoteConfig)
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
|
||||||
|
type PreferredContentExpression = String
|
||||||
|
|
||||||
data StandardGroup
|
data StandardGroup
|
||||||
= ClientGroup
|
= ClientGroup
|
||||||
| TransferGroup
|
| TransferGroup
|
||||||
|
@ -71,7 +73,7 @@ associatedDirectory Nothing PublicGroup = Just "public"
|
||||||
associatedDirectory _ _ = Nothing
|
associatedDirectory _ _ = Nothing
|
||||||
|
|
||||||
{- See doc/preferred_content.mdwn for explanations of these expressions. -}
|
{- See doc/preferred_content.mdwn for explanations of these expressions. -}
|
||||||
preferredContent :: StandardGroup -> String
|
preferredContent :: StandardGroup -> PreferredContentExpression
|
||||||
preferredContent ClientGroup = lastResort $
|
preferredContent ClientGroup = lastResort $
|
||||||
"(exclude=*/archive/* and exclude=archive/*) or (" ++ notArchived ++ ")"
|
"(exclude=*/archive/* and exclude=archive/*) or (" ++ notArchived ++ ")"
|
||||||
preferredContent TransferGroup = lastResort $
|
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
|
{- Most repositories want any content that is only on untrusted
|
||||||
- or dead repositories. -}
|
- or dead repositories. -}
|
||||||
lastResort :: String -> String
|
lastResort :: String -> PreferredContentExpression
|
||||||
lastResort s = "(" ++ s ++ ") or (not copies=semitrusted+:1)"
|
lastResort s = "(" ++ s ++ ") or (not copies=semitrusted+:1)"
|
||||||
|
|
2
debian/changelog
vendored
2
debian/changelog
vendored
|
@ -1,7 +1,7 @@
|
||||||
git-annex (5.20131231) UNRELEASED; urgency=medium
|
git-annex (5.20131231) UNRELEASED; urgency=medium
|
||||||
|
|
||||||
* mirror: Support --all (and --unused).
|
* 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
|
* Windows: Fix bug in direct mode merge code that could cause files
|
||||||
in subdirectories to go missing.
|
in subdirectories to go missing.
|
||||||
* Windows: Avoid eating stdin when running ssh to add a authorized key,
|
* Windows: Avoid eating stdin when running ssh to add a authorized key,
|
||||||
|
|
|
@ -212,6 +212,16 @@ in control.
|
||||||
* `GETUUID`
|
* `GETUUID`
|
||||||
Queries for the UUID of the special remote being used.
|
Queries for the UUID of the special remote being used.
|
||||||
(git-annex replies with VALUE followed by the UUID.)
|
(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
|
## general messages
|
||||||
|
|
||||||
|
|
|
@ -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]].
|
||||||
|
"""]]
|
23
doc/devblog/day_90__slow_start.mdwn
Normal file
23
doc/devblog/day_90__slow_start.mdwn
Normal file
|
@ -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.
|
|
@ -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!
|
||||||
|
"""]]
|
|
@ -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
|
||||||
|
"""]]
|
Loading…
Add table
Add a link
Reference in a new issue