Don't allow the type of encryption of an existing special remote to be changed.

eg, git-annex enableremote foo encryption=none will not remove encryption,
and other encryption= settings don't change the type of encryption used.
Either of which would render data stored in a special remote inaccessible.

Probably fixes reversion introduced in
71f78fe45dc91dbef0bedd79b33d6a9fed85704d.
That commit got rid of the hasEncryptionConfig check, which I think would
have detected this before. I've not gone back to verify that.

Sponsored-by: mycroft

diff --git a/CHANGELOG b/CHANGELOG
index 8f71921a5698e0eed92913b0b08674f8e462a4b7..11787d6f6db0dae6230ece28d299824f22af2fb9 100644 (file)
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -27,6 +27,8 @@ git-annex (10.20250722) UNRELEASED; urgency=medium
   * Bump aws build dependency to 0.24.1.
   * stack.yaml: Update to lts-24.2.
   * Removed support for git versions older than 2.22.
+  * Don't allow the type of encryption of an existing special remote to be
+    changed. Fixes reversion introduced in version 7.20191230.
 
  -- Joey Hess <id@joeyh.name>  Wed, 30 Jul 2025 13:45:42 -0400
 

diff --git a/Remote/Adb.hs b/Remote/Adb.hs
index 41f815fb0e5ed2f551530536259256ff406ea53f..c512e9a4e6b96842ad32bb820d43bab33f4a2ea6 100644 (file)
--- a/Remote/Adb.hs
+++ b/Remote/Adb.hs
@@ -140,7 +140,7 @@ gen r u rc gc rs = do
                (remoteAnnexAndroidSerial gc)
 
 adbSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-adbSetup _ mu _ c gc = do
+adbSetup ss mu _ c gc = do
        u <- maybe (liftIO genUUID) return mu
 
        -- verify configuration
@@ -151,7 +151,7 @@ adbSetup _ mu _ c gc = do
        serial <- getserial =<< enumerateAdbConnected
        let c' = M.insert androidserialField (Proposed (fromAndroidSerial serial)) c
 
-       (c'', _encsetup) <- encryptionSetup c' gc
+       (c'', _encsetup) <- encryptionSetup ss c' gc
 
        ok <- adbShellBool serial
                [Param "mkdir", Param "-p", File (fromAndroidPath adir)]

diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index d98901d441184ae3e16d406fad010f4e0b4a0daa..b3f7c72ec1bf3a55d5cc157b76726a6e4b10bbd8 100644 (file)
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -124,13 +124,13 @@ gen r u rc gc rs = do
        buprepo = fromMaybe (giveup "missing buprepo") $ remoteAnnexBupRepo gc
 
 bupSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-bupSetup _ mu _ c gc = do
+bupSetup ss mu _ c gc = do
        u <- maybe (liftIO genUUID) return mu
 
        -- verify configuration is sane
        let buprepo = maybe (giveup "Specify buprepo=") fromProposedAccepted $
                M.lookup buprepoField c
-       (c', _encsetup) <- encryptionSetup c gc
+       (c', _encsetup) <- encryptionSetup ss c gc
 
        -- bup init will create the repository.
        -- (If the repository already exists, bup init again appears safe.)

diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs
index e9e0ba55891d6d4749ef327fdde30213d6d4687c..760dd4cdcad144f2403b3ba1f9aad137f4475e9e 100644 (file)
--- a/Remote/Ddar.hs
+++ b/Remote/Ddar.hs
@@ -115,13 +115,13 @@ gen r u rc gc rs = do
        ddarrepo = maybe (giveup "missing ddarrepo") (DdarRepo gc) (remoteAnnexDdarRepo gc)
 
 ddarSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-ddarSetup _ mu _ c gc = do
+ddarSetup ss mu _ c gc = do
        u <- maybe (liftIO genUUID) return mu
 
        -- verify configuration is sane
        let ddarrepo = maybe (giveup "Specify ddarrepo=") fromProposedAccepted $
                M.lookup ddarrepoField c
-       (c', _encsetup) <- encryptionSetup c gc
+       (c', _encsetup) <- encryptionSetup ss c gc
 
        -- The ddarrepo is stored in git config, as well as this repo's
        -- persistent state, so it can vary between hosts.

diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 5392caafa3fdede3ef19c5275e128d09fdbe2eb0..da97d06c0306ad63087dfd03e0f4c5b988d86d83 100644 (file)
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -151,7 +151,7 @@ gen r u rc gc rs = do
                (remoteAnnexDirectory gc)
 
 directorySetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-directorySetup _ mu _ c gc = do
+directorySetup ss mu _ c gc = do
        u <- maybe (liftIO genUUID) return mu
        -- verify configuration is sane
        let dir = maybe (giveup "Specify directory=") fromProposedAccepted $
@@ -159,7 +159,7 @@ directorySetup _ mu _ c gc = do
        absdir <- liftIO $ absPath (toOsPath dir)
        liftIO $ unlessM (doesDirectoryExist absdir) $
                giveup $ "Directory does not exist: " ++ fromOsPath absdir
-       (c', _encsetup) <- encryptionSetup c gc
+       (c', _encsetup) <- encryptionSetup ss c gc
 
        -- The directory is stored in git config, not in this remote's
        -- persistent state, so it can vary between hosts.

diff --git a/Remote/External.hs b/Remote/External.hs
index dcfbaacbf2372e2453ffa825faeeb8858c7a670c..c392b3f31e33b3f9157fa97e6b4894c37537b95b 100644 (file)
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -172,7 +172,7 @@ gen rt externalprogram r u rc gc rs
                                (remoteAnnexExternalType gc)
 
 externalSetup :: Maybe ExternalProgram -> Maybe (String, String) -> SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-externalSetup externalprogram setgitconfig _ mu _ c gc = do
+externalSetup externalprogram setgitconfig ss mu _ c gc = do
        u <- maybe (liftIO genUUID) return mu
        pc <- either giveup return $ parseRemoteConfig c (lenientRemoteConfigParser externalprogram)
        let readonlyconfig = getRemoteConfigValue readonlyField pc == Just True
@@ -180,7 +180,7 @@ externalSetup externalprogram setgitconfig _ mu _ c gc = do
                then "readonly"
                else fromMaybe (giveup "Specify externaltype=") $
                        getRemoteConfigValue externaltypeField pc
-       (c', _encsetup) <- encryptionSetup c gc
+       (c', _encsetup) <- encryptionSetup ss c gc
 
        c'' <- if readonlyconfig
                then do

diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index 180922783cfb4fecad34ee832e5801e11e6d40e7..0369856b1eb1382c2c863071af8280720b4f54bc 100644 (file)
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -220,12 +220,12 @@ unsupportedUrl :: a
 unsupportedUrl = giveup "unsupported repo url for gcrypt"
 
 gCryptSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-gCryptSetup _ mu _ c gc = go $ fromProposedAccepted <$> M.lookup gitRepoField c
+gCryptSetup ss mu _ c gc = go $ fromProposedAccepted <$> M.lookup gitRepoField c
   where
        remotename = fromJust (lookupName c)
        go Nothing = giveup "Specify gitrepo="
        go (Just gitrepo) = do
-               (c', _encsetup) <- encryptionSetup c gc
+               (c', _encsetup) <- encryptionSetup ss c gc
 
                let url = Git.GCrypt.urlPrefix ++ gitrepo
                rs <- Annex.getGitRemotes

diff --git a/Remote/GitLFS.hs b/Remote/GitLFS.hs
index fde56b05ed61310814825b4c274ce6a38f7144e5..2ec2f429d72acfcec08fa1bddd8d6f6e99e7f48d 100644 (file)
--- a/Remote/GitLFS.hs
+++ b/Remote/GitLFS.hs
@@ -148,7 +148,7 @@ mySetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteG
 mySetup ss mu _ c gc = do
        u <- maybe (liftIO genUUID) return mu
 
-       (c', _encsetup) <- encryptionSetup c gc
+       (c', _encsetup) <- encryptionSetup ss c gc
        pc <- either giveup return . parseRemoteConfig c' =<< configParser remote c'
        let failinitunlessforced msg = case ss of
                Init -> unlessM (Annex.getRead Annex.force) (giveup msg)

diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index 4e32b88cf0512cd99ea4dc4756b8e71f9e27c93e..c112ceb7dc91970a5ef9108c8e6f79500a90f248 100644 (file)
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -124,7 +124,7 @@ glacierSetup ss mu mcreds c gc = do
        glacierSetup' ss u mcreds c gc
 glacierSetup' :: SetupStage -> UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
 glacierSetup' ss u mcreds c gc = do
-       (c', encsetup) <- encryptionSetup (c `M.union` defaults) gc
+       (c', encsetup) <- encryptionSetup ss (c `M.union` defaults) gc
        pc <- either giveup return . parseRemoteConfig c'
                =<< configParser remote c'
        c'' <- setRemoteCredPair ss encsetup pc gc (AWS.creds u) mcreds

diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs
index 46ab018f7ae57a3da59542132d29eea6c1e6f725..c18c5acf7f685b66ad8f381871e9127141397238 100644 (file)
--- a/Remote/Helper/Encryptable.hs
+++ b/Remote/Helper/Encryptable.hs
@@ -163,8 +163,9 @@ parseMac (Just (Proposed s)) = case readMac s of
  - an encryption key, or not encrypt. An encrypted cipher is created, or is
  - updated to be accessible to an additional encryption key. Or the user
  - could opt to use a shared cipher, which is stored unencrypted. -}
-encryptionSetup :: RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, EncryptionIsSetup)
-encryptionSetup c gc = do
+encryptionSetup :: SetupStage -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, EncryptionIsSetup)
+encryptionSetup setupstage c gc = do
+       checkallowedchange
        pc <- either giveup return $ parseEncryptionConfig c
        gpgcmd <- gpgCmd <$> Annex.getGitConfig
        maybe (genCipher pc gpgcmd) (updateCipher pc gpgcmd) (extractCipher pc)
@@ -219,6 +220,23 @@ encryptionSetup c gc = do
                -- public-key encryption, hence we leave it on newer
                -- remotes (while being backward-compatible).
                (map Accepted ["keyid", "keyid+", "keyid-", "highRandomQuality"])
+       oldpc = either (const Nothing) Just $ parseEncryptionConfig $
+               case setupstage of
+                       Init -> mempty
+                       Enable oldc -> oldc
+                       AutoEnable oldc -> oldc
+       checkallowedchange = case oldpc of
+               Nothing -> return ()
+               Just oldpc' -> case extractCipher oldpc' of
+                       Nothing -> req NoneEncryption
+                       Just (EncryptedCipher _ Hybrid _) -> req HybridEncryption
+                       Just (EncryptedCipher _ PubKey _) -> req PubKeyEncryption
+                       Just (SharedCipher _) -> req SharedEncryption
+                       Just (SharedPubKeyCipher _ _) -> req SharedPubKeyEncryption
+         where
+               req v
+                       | encryption /= Right v = cannotchange
+                       | otherwise = return ()
 
 data CipherPurpose t = CipherAllPurpose t | CipherOnlyCreds t
 

diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index 02a3b22101a89ec24a0cdcb76adaac92f386aa90..5c6da728aef947a8f914d69ecb88d415a5e4f190 100644 (file)
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -97,11 +97,11 @@ gen r u rc gc rs = do
        hooktype = fromMaybe (giveup "missing hooktype") $ remoteAnnexHookType gc
 
 hookSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-hookSetup _ mu _ c gc = do
+hookSetup ss mu _ c gc = do
        u <- maybe (liftIO genUUID) return mu
        let hooktype = maybe (giveup "Specify hooktype=") fromProposedAccepted $
                M.lookup hooktypeField c
-       (c', _encsetup) <- encryptionSetup c gc
+       (c', _encsetup) <- encryptionSetup ss c gc
        gitConfigSpecialRemote u c' [("hooktype", hooktype)]
        return (c', u)
 

diff --git a/Remote/HttpAlso.hs b/Remote/HttpAlso.hs
index a7b38e27605e6b14bc8b0c9f51df8b9d2cabea34..5ff53b408916f23f1143c802781bdf6ab68f3b73 100644 (file)
--- a/Remote/HttpAlso.hs
+++ b/Remote/HttpAlso.hs
@@ -111,12 +111,12 @@ cannotModify = giveup "httpalso special remote is read only"
 httpAlsoSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
 httpAlsoSetup _ Nothing _ _ _ =
        giveup "Must use --sameas when initializing a httpalso remote."
-httpAlsoSetup _ (Just u) _ c gc = do
+httpAlsoSetup ss (Just u) _ c gc = do
        _url <- maybe (giveup "Specify url=")
                (return . fromProposedAccepted)
                (M.lookup urlField c)
        c' <- if isJust (M.lookup encryptionField c)
-               then fst <$> encryptionSetup c gc
+               then fst <$> encryptionSetup ss c gc
                else pure c
        gitConfigSpecialRemote u c' [("httpalso", "true")]
        return (c', u)

diff --git a/Remote/Mask.hs b/Remote/Mask.hs
index c17c370fdab63d6d91e96e5109551585206a9089..3db2578cc5abe69e66b918a41c904a6d1be8a654 100644 (file)
--- a/Remote/Mask.hs
+++ b/Remote/Mask.hs
@@ -116,7 +116,7 @@ maskSetup setupstage mu _ c gc = do
        setupremote r = do
                let c' = M.insert remoteUUIDField
                        (Proposed (fromUUID (uuid r) :: String)) c
-               (c'', encsetup) <- encryptionSetup c' gc
+               (c'', encsetup) <- encryptionSetup setupstage c' gc
                verifyencryptionok encsetup r
                
                u <- maybe (liftIO genUUID) return mu
@@ -137,7 +137,7 @@ maskSetup setupstage mu _ c gc = do
                                -- get autoenabled later, or need to be
                                -- manually enabled.
                                _ -> do
-                                       (c', _) <- encryptionSetup c gc
+                                       (c', _) <- encryptionSetup setupstage c gc
                                        u <- maybe (liftIO genUUID) return mu
                                        gitConfigSpecialRemote u c' [ ("mask", "true") ]
                                        return (c', u)

diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index c1e205a31c3370ea788769eda13b43da0ef2cbd8..5375940b1fec15775297e6e49d36af20d0629244 100644 (file)
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -200,12 +200,12 @@ rsyncTransport gc url
        fromNull as xs = if null xs then as else xs
 
 rsyncSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-rsyncSetup _ mu _ c gc = do
+rsyncSetup ss mu _ c gc = do
        u <- maybe (liftIO genUUID) return mu
        -- verify configuration is sane
        let url = maybe (giveup "Specify rsyncurl=") fromProposedAccepted $
                M.lookup rsyncUrlField c
-       (c', _encsetup) <- encryptionSetup c gc
+       (c', _encsetup) <- encryptionSetup ss c gc
 
        -- The rsyncurl is stored in git config, not only in this remote's
        -- persistent state, so it can vary between hosts.

diff --git a/Remote/S3.hs b/Remote/S3.hs
index f84c499b0eb8913fb0835b1ed3f30ef73f091502..566c8f58890066b2022a43a0684f6c32dd79cf36 100644 (file)
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -282,7 +282,7 @@ s3Setup'  ss u mcreds c gc
                return (fullconfig, u)
 
        defaulthost = do
-               (c', encsetup) <- encryptionSetup (c `M.union` defaults) gc
+               (c', encsetup) <- encryptionSetup ss (c `M.union` defaults) gc
                pc <- either giveup return . parseRemoteConfig c'
                        =<< configParser remote c'
                c'' <- if isAnonymous pc

diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index 222cadb876c373cc393d40e3ce23bf9b7f3286c4..2ad8470de06ea5d072c7a29c638d1a031bff3c91 100644 (file)
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -134,7 +134,7 @@ webdavSetup ss mu mcreds c gc = do
        url <- maybe (giveup "Specify url=")
                (return . fromProposedAccepted)
                (M.lookup urlField c)
-       (c', encsetup) <- encryptionSetup c gc
+       (c', encsetup) <- encryptionSetup ss c gc
        pc <- either giveup return . parseRemoteConfig c' =<< configParser remote c'
        creds <- maybe (getCreds pc gc u) (return . Just) mcreds
        case ss of

diff --git a/Types/Crypto.hs b/Types/Crypto.hs
index 2b3b065d71d1fe618bcd9e5fbff39db8346a92d5..50de9125023bca0305019f41dcbe396bbebcd9a2 100644 (file)
--- a/Types/Crypto.hs
+++ b/Types/Crypto.hs
@@ -33,7 +33,7 @@ data EncryptionMethod
        | PubKeyEncryption
        | SharedPubKeyEncryption
        | HybridEncryption
-       deriving (Typeable, Eq)
+       deriving (Typeable, Eq, Show)
 
 -- A base-64 encoded random value used for encryption.
 -- XXX ideally, this would be a locked memory region
@@ -44,6 +44,7 @@ data StorableCipher
        | SharedCipher ByteString
        | SharedPubKeyCipher ByteString KeyIds
        deriving (Ord, Eq)
+
 data EncryptedCipherVariant = Hybrid | PubKey
        deriving (Ord, Eq)
 

diff --git a/doc/bugs/prevent_enableremote_changing_encryption.mdwn b/doc/bugs/prevent_enableremote_changing_encryption.mdwn
index f12bfcf862bdf40c87d69c9e5a94333da916f989..b4e92e571e2445238dea8f53945731fda720b5f9 100644 (file)
--- a/doc/bugs/prevent_enableremote_changing_encryption.mdwn
+++ b/doc/bugs/prevent_enableremote_changing_encryption.mdwn
@@ -7,7 +7,8 @@ encryption for such a remote:
        enableremote d (encryption setup) (encryption key stored in git repository) ok
        (recording state in git...)
 
-This config change should not be allowed.
+This config change should not be allowed. This is a reversion,
+probably introduced around [[!commit 71f78fe45dc91dbef0bedd79b33d6a9fed85704d]]
 
 Also, the new onlyencryptcreds=yes setting can passed to enableremote,
 which changes a previously encrypted remote to not use encryption for the