aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Assistant/Threads/MountWatcher.hs6
-rw-r--r--Config.hs7
-rw-r--r--Remote/Bup.hs4
-rw-r--r--Remote/Directory.hs4
-rw-r--r--Remote/GCrypt.hs68
-rw-r--r--Remote/Git.hs4
-rw-r--r--Remote/Glacier.hs4
-rw-r--r--Remote/Hook.hs4
-rw-r--r--Remote/List.hs9
-rw-r--r--Remote/Rsync.hs4
-rw-r--r--Remote/S3.hs4
-rw-r--r--Remote/Web.hs4
-rw-r--r--Remote/WebDAV.hs4
-rw-r--r--Types/Remote.hs2
-rw-r--r--debian/changelog1
15 files changed, 86 insertions, 43 deletions
diff --git a/Assistant/Threads/MountWatcher.hs b/Assistant/Threads/MountWatcher.hs
index 143ae9cee..970585b42 100644
--- a/Assistant/Threads/MountWatcher.hs
+++ b/Assistant/Threads/MountWatcher.hs
@@ -174,14 +174,14 @@ remotesUnder dir = do
pairs <- liftAnnex $ mapM (checkremote repotop) rs
let (waschanged, rs') = unzip pairs
when (any id waschanged) $ do
- liftAnnex $ Annex.changeState $ \s -> s { Annex.remotes = rs' }
+ liftAnnex $ Annex.changeState $ \s -> s { Annex.remotes = catMaybes rs' }
updateSyncRemotes
- return $ map snd $ filter fst pairs
+ return $ catMaybes $ map snd $ filter fst pairs
where
checkremote repotop r = case Remote.localpath r of
Just p | dirContains dir (absPathFrom repotop p) ->
(,) <$> pure True <*> updateRemote r
- _ -> return (False, r)
+ _ -> return (False, Just r)
type MountPoints = S.Set Mntent
diff --git a/Config.hs b/Config.hs
index 1e4d6caec..ac251983a 100644
--- a/Config.hs
+++ b/Config.hs
@@ -36,8 +36,11 @@ setConfig (ConfigKey key) value = do
{- Unsets a git config setting. (Leaves it in state currently.) -}
unsetConfig :: ConfigKey -> Annex ()
-unsetConfig (ConfigKey key) = inRepo $ Git.Command.run
- [Param "config", Param "--unset", Param key]
+unsetConfig ck@(ConfigKey key) = ifM (isJust <$> getConfigMaybe ck)
+ ( inRepo $ Git.Command.run
+ [Param "config", Param "--unset", Param key]
+ , noop -- avoid unsetting something not set; that would fail
+ )
{- A per-remote config setting in git config. -}
remoteConfig :: Git.Repo -> UnqualifiedConfigKey -> ConfigKey
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 09e89e38f..960ed4ada 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -42,7 +42,7 @@ remote = RemoteType {
setup = bupSetup
}
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
gen r u c gc = do
bupr <- liftIO $ bup2GitRemote buprepo
cst <- remoteCost gc $
@@ -72,7 +72,7 @@ gen r u c gc = do
, globallyAvailable = not $ bupLocal buprepo
, readonly = False
}
- return $ encryptableRemote c
+ return $ Just $ encryptableRemote c
(storeEncrypted new buprepo)
(retrieveEncrypted buprepo)
new
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 8eb317418..1c09e0e3c 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -37,11 +37,11 @@ remote = RemoteType {
setup = directorySetup
}
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
gen r u c gc = do
cst <- remoteCost gc cheapRemoteCost
let chunksize = chunkSize c
- return $ encryptableRemote c
+ return $ Just $ encryptableRemote c
(storeEncrypted dir (getGpgEncParams (c,gc)) chunksize)
(retrieveEncrypted dir chunksize)
Remote {
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index 3c0706989..cbe804c2f 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -18,6 +18,7 @@ import qualified Git
import qualified Git.Command
import qualified Git.Config
import qualified Git.GCrypt
+import qualified Git.Construct
import qualified Git.Types as Git ()
import qualified Annex.Branch
import qualified Annex.Content
@@ -32,6 +33,7 @@ import Annex.UUID
import Annex.Ssh
import qualified Remote.Rsync
import Utility.Rsync
+import Logs.Remote
remote :: RemoteType
remote = RemoteType {
@@ -43,7 +45,7 @@ remote = RemoteType {
setup = gCryptSetup
}
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
gen gcryptr u c gc = do
g <- gitRepo
-- get underlying git repo with real path, not gcrypt path
@@ -53,9 +55,32 @@ gen gcryptr u c gc = do
r'' <- if Git.repoIsLocalUnknown r'
then liftIO $ catchDefaultIO r' $ Git.Config.read r'
else return r'
- gen' r'' u c gc
-
-gen' :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+ -- doublecheck that local cache matches underlying repo's gcrypt-id
+ -- (which might not be set)
+ case (Git.Config.getMaybe "core.gcrypt-id" r'', Git.GCrypt.remoteRepoId g (Git.remoteName gcryptr)) of
+ (Just gcryptid, Just cachedgcryptid)
+ | gcryptid /= cachedgcryptid -> resetup gcryptid r''
+ _ -> gen' r'' u c gc
+ where
+ -- A different drive may have been mounted, making a different
+ -- gcrypt remote available. So need to set the cached
+ -- gcrypt-id and annex-uuid of the remote to match the remote
+ -- that is now available. Also need to set the gcrypt particiants
+ -- correctly.
+ resetup gcryptid r = do
+ let u' = genUUIDInNameSpace gCryptNameSpace gcryptid
+ v <- (M.lookup u' <$> readRemoteLog)
+ case (Git.remoteName gcryptr, v) of
+ (Just remotename, Just c') -> do
+ setGcryptEncryption c' remotename
+ setConfig (remoteConfig gcryptr "uuid") (fromUUID u')
+ setConfig (ConfigKey $ Git.GCrypt.remoteConfigKey "gcrypt-id" remotename) gcryptid
+ gen' r u' c' gc
+ _ -> do
+ warning $ "not using unknown gcrypt repository pointed to by remote " ++ Git.repoDescribe r
+ return Nothing
+
+gen' :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
gen' r u c gc = do
cst <- remoteCost gc $
if repoCheap r then nearlyCheapRemoteCost else expensiveRemoteCost
@@ -80,7 +105,7 @@ gen' r u c gc = do
, globallyAvailable = globallyAvailableCalc r
, remotetype = remote
}
- return $ encryptableRemote c
+ return $ Just $ encryptableRemote c
(store this rsyncopts)
(retrieve this rsyncopts)
this
@@ -117,14 +142,7 @@ gCryptSetup mu c = go $ M.lookup "gitrepo" c
, Param $ Git.GCrypt.urlPrefix ++ gitrepo
]
- {- Configure gcrypt to use the same list of keyids that
- - were passed to initremote, unless shared encryption
- - was used. -}
- case extractCipher c' of
- Nothing -> noCrypto
- Just (EncryptedCipher _ _ (KeyIds { keyIds = ks})) ->
- setConfig (ConfigKey $ Git.GCrypt.remoteParticipantConfigKey remotename) (unwords ks)
- _ -> noop
+ setGcryptEncryption c' remotename
{- Run a git fetch and a push to the git repo in order to get
- its gcrypt-id set up, so that later git annex commands
@@ -143,14 +161,34 @@ gCryptSetup mu c = go $ M.lookup "gitrepo" c
g <- inRepo Git.Config.reRead
case Git.GCrypt.remoteRepoId g (Just remotename) of
Nothing -> error "unable to determine gcrypt-id of remote"
- Just v -> do
- let u = genUUIDInNameSpace gCryptNameSpace v
+ Just gcryptid -> do
+ let u = genUUIDInNameSpace gCryptNameSpace gcryptid
if Just u == mu || mu == Nothing
then do
+ -- Store gcrypt-id in local
+ -- gcrypt repository, for later
+ -- double-check.
+ r <- inRepo $ Git.Construct.fromRemoteLocation gitrepo
+ when (Git.repoIsLocalUnknown r) $ do
+ r' <- liftIO $ Git.Config.read r
+ liftIO $ Git.Command.run [Param "config", Param "core.gcrypt-id", Param gcryptid] r'
gitConfigSpecialRemote u c' "gcrypt" "true"
return (c', u)
else error "uuid mismatch"
+{- Configure gcrypt to use the same list of keyids that
+ - were passed to initremote. (For shared encryption,
+ - gcrypt's default behavior is used.) -}
+setGcryptEncryption :: RemoteConfig -> String -> Annex ()
+setGcryptEncryption c remotename = do
+ let participants = ConfigKey $ Git.GCrypt.remoteParticipantConfigKey remotename
+ case extractCipher c of
+ Nothing -> noCrypto
+ Just (EncryptedCipher _ _ (KeyIds { keyIds = ks})) ->
+ setConfig participants (unwords ks)
+ Just (SharedCipher _) ->
+ unsetConfig participants
+
store :: Remote -> Remote.Rsync.RsyncOpts -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
store r rsyncopts (cipher, enck) k p
| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 795823ca6..d761b03ba 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -92,13 +92,13 @@ configRead r = do
(False, _, NoUUID) -> tryGitConfigRead r
_ -> return r
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
gen r u c gc
| Git.GCrypt.isEncrypted r = Remote.GCrypt.gen r u c gc
| otherwise = go <$> remoteCost gc defcst
where
defcst = if repoCheap r then cheapRemoteCost else expensiveRemoteCost
- go cst = new
+ go cst = Just new
where
new = Remote
{ uuid = u
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index f351c66e9..ecdc6a656 100644
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -40,10 +40,10 @@ remote = RemoteType {
setup = glacierSetup
}
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
where
- new cst = encryptableRemote c
+ new cst = Just $ encryptableRemote c
(storeEncrypted this)
(retrieveEncrypted this)
this
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index 6a8e44ab5..ba20f3566 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -35,10 +35,10 @@ remote = RemoteType {
setup = hookSetup
}
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
gen r u c gc = do
cst <- remoteCost gc expensiveRemoteCost
- return $ encryptableRemote c
+ return $ Just $ encryptableRemote c
(storeEncrypted hooktype $ getGpgEncParams (c,gc))
(retrieveEncrypted hooktype)
Remote {
diff --git a/Remote/List.hs b/Remote/List.hs
index f38c1daaa..271ee8794 100644
--- a/Remote/List.hs
+++ b/Remote/List.hs
@@ -67,7 +67,7 @@ remoteList = do
return rs'
else return rs
where
- process m t = enumerate t >>= mapM (remoteGen m t)
+ process m t = enumerate t >>= mapM (remoteGen m t) >>= return . catMaybes
{- Forces the remoteList to be re-generated, re-reading the git config. -}
remoteListRefresh :: Annex [Remote]
@@ -80,16 +80,17 @@ remoteListRefresh = do
remoteList
{- Generates a Remote. -}
-remoteGen :: (M.Map UUID RemoteConfig) -> RemoteType -> Git.Repo -> Annex Remote
+remoteGen :: (M.Map UUID RemoteConfig) -> RemoteType -> Git.Repo -> Annex (Maybe Remote)
remoteGen m t r = do
u <- getRepoUUID r
g <- fromRepo id
let gc = extractRemoteGitConfig g (Git.repoDescribe r)
let c = fromMaybe M.empty $ M.lookup u m
- addHooks <$> generate t r u c gc
+ mrmt <- generate t r u c gc
+ return $ addHooks <$> mrmt
{- Updates a local git Remote, re-reading its git config. -}
-updateRemote :: Remote -> Annex Remote
+updateRemote :: Remote -> Annex (Maybe Remote)
updateRemote remote = do
m <- readRemoteLog
remote' <- updaterepo $ repo remote
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index b328f6560..f1e6fd85e 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -58,14 +58,14 @@ remote = RemoteType {
setup = rsyncSetup
}
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
gen r u c gc = do
cst <- remoteCost gc expensiveRemoteCost
(transport, url) <- rsyncTransport gc $
fromMaybe (error "missing rsyncurl") $ remoteAnnexRsyncUrl gc
let o = genRsyncOpts c gc transport url
let islocal = rsyncUrlIsPath $ rsyncUrl o
- return $ encryptableRemote c
+ return $ Just $ encryptableRemote c
(storeEncrypted o $ getGpgEncParams (c,gc))
(retrieveEncrypted o)
Remote
diff --git a/Remote/S3.hs b/Remote/S3.hs
index 4f04bb7af..67d87df50 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -43,10 +43,10 @@ remote = RemoteType {
setup = s3Setup
}
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
where
- new cst = encryptableRemote c
+ new cst = Just $ encryptableRemote c
(storeEncrypted this)
(retrieveEncrypted this)
this
diff --git a/Remote/Web.hs b/Remote/Web.hs
index 5b8df2994..789aab698 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -43,9 +43,9 @@ list = do
r <- liftIO $ Git.Construct.remoteNamed "web" Git.Construct.fromUnknown
return [r]
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
gen r _ _ gc =
- return Remote {
+ return $ Just Remote {
uuid = webUUID,
cost = expensiveRemoteCost,
name = Git.repoDescribe r,
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index 7c1949047..97a6d96f9 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -46,10 +46,10 @@ remote = RemoteType {
setup = webdavSetup
}
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
where
- new cst = encryptableRemote c
+ new cst = Just $ encryptableRemote c
(storeEncrypted this)
(retrieveEncrypted this)
this
diff --git a/Types/Remote.hs b/Types/Remote.hs
index 6c0f89346..78008ce06 100644
--- a/Types/Remote.hs
+++ b/Types/Remote.hs
@@ -29,7 +29,7 @@ data RemoteTypeA a = RemoteType {
-- enumerates remotes of this type
enumerate :: a [Git.Repo],
-- generates a remote of this type
- generate :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> a (RemoteA a),
+ generate :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> a (Maybe (RemoteA a)),
-- initializes or changes a remote
setup :: Maybe UUID -> RemoteConfig -> a (RemoteConfig, UUID)
}
diff --git a/debian/changelog b/debian/changelog
index 493e13aa3..1a94257d1 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,5 +1,6 @@
git-annex (4.20130912) UNRELEASED; urgency=low
+ * Support hot-swapping of removable drives containing gcrypt repositories.
* remotes: New command, displays a compact table of remotes that
contain files.
(Thanks, anarcat for display code and mastensg for inspiration.)
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-10 08:40:49 +0000