summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Assistant/MakeRemote.hs25
-rw-r--r--Assistant/Threads/WebApp.hs1
-rw-r--r--Locations.hs8
-rw-r--r--Remote/Helper/Encryptable.hs5
-rw-r--r--Remote/S3.hs104
-rw-r--r--Utility/Process.hs4
-rw-r--r--debian/changelog6
-rw-r--r--doc/special_remotes/S3.mdwn6
8 files changed, 106 insertions, 53 deletions
diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs
index 8e9867b2c..729b5126a 100644
--- a/Assistant/MakeRemote.hs
+++ b/Assistant/MakeRemote.hs
@@ -55,13 +55,10 @@ addRemote a = do
void remoteListRefresh
maybe (error "failed to add remote") return =<< Remote.byName (Just name)
-{- Inits a rsync special remote, and returns the name of the remote. -}
+{- Inits a rsync special remote, and returns its name. -}
makeRsyncRemote :: String -> String -> Annex String
-makeRsyncRemote name location = makeRemote name location $ const $ do
- (u, c) <- Command.InitRemote.findByName name
- c' <- R.setup Rsync.remote u $ M.union config c
- describeUUID u name
- configSet u c'
+makeRsyncRemote name location = makeRemote name location $
+ const $ makeSpecialRemote name Rsync.remote config
where
config = M.fromList
[ ("encryption", "shared")
@@ -69,6 +66,14 @@ makeRsyncRemote name location = makeRemote name location $ const $ do
, ("type", "rsync")
]
+{- Inits a special remote. -}
+makeSpecialRemote :: String -> RemoteType -> R.RemoteConfig -> Annex ()
+makeSpecialRemote name remotetype config = do
+ (u, c) <- Command.InitRemote.findByName name
+ c' <- R.setup remotetype u $ M.union config c
+ describeUUID u name
+ configSet u c'
+
{- Returns the name of the git remote it created. If there's already a
- remote at the location, returns its name. -}
makeGitRemote :: String -> String -> Annex String
@@ -86,7 +91,7 @@ makeRemote basename location a = do
r <- fromRepo id
if not (any samelocation $ Git.remotes r)
then do
- let name = uniqueRemoteName r basename 0
+ let name = uniqueRemoteName basename 0 r
a name
return name
else return basename
@@ -95,10 +100,10 @@ makeRemote basename location a = do
{- Generate an unused name for a remote, adding a number if
- necessary. -}
-uniqueRemoteName :: Git.Repo -> String -> Int -> String
-uniqueRemoteName r basename n
+uniqueRemoteName :: String -> Int -> Git.Repo -> String
+uniqueRemoteName basename n r
| null namecollision = name
- | otherwise = uniqueRemoteName r basename (succ n)
+ | otherwise = uniqueRemoteName basename (succ n) r
where
namecollision = filter samename (Git.remotes r)
samename x = Git.remoteName x == Just name
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs
index 8a5ab4ec6..cb5f58b2d 100644
--- a/Assistant/Threads/WebApp.hs
+++ b/Assistant/Threads/WebApp.hs
@@ -20,6 +20,7 @@ import Assistant.WebApp.Configurators
import Assistant.WebApp.Configurators.Local
import Assistant.WebApp.Configurators.Ssh
import Assistant.WebApp.Configurators.Pairing
+import Assistant.WebApp.Configurators.S3
import Assistant.WebApp.Documentation
import Assistant.WebApp.OtherRepos
import Assistant.ThreadedMonad
diff --git a/Locations.hs b/Locations.hs
index 98eabb172..72baf273b 100644
--- a/Locations.hs
+++ b/Locations.hs
@@ -20,6 +20,7 @@ module Locations (
gitAnnexUnusedLog,
gitAnnexFsckState,
gitAnnexTransferDir,
+ gitAnnexCredsDir,
gitAnnexJournalDir,
gitAnnexJournalLock,
gitAnnexIndex,
@@ -135,7 +136,12 @@ gitAnnexUnusedLog prefix r = gitAnnexDir r </> (prefix ++ "unused")
gitAnnexFsckState :: Git.Repo -> FilePath
gitAnnexFsckState r = gitAnnexDir r </> "fsckstate"
-{- .git/annex/transfer/ is used is used to record keys currently
+{- .git/annex/creds/ is used to store credentials to access some special
+ - remotes. -}
+gitAnnexCredsDir :: Git.Repo -> FilePath
+gitAnnexCredsDir r = addTrailingPathSeparator $ gitAnnexDir r </> "creds"
+
+{- .git/annex/transfer/ is used to record keys currently
- being transferred, and other transfer bookkeeping info. -}
gitAnnexTransferDir :: Git.Repo -> FilePath
gitAnnexTransferDir r = addTrailingPathSeparator $ gitAnnexDir r </> "transfer"
diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs
index 880db5c6a..8ed2fed63 100644
--- a/Remote/Helper/Encryptable.hs
+++ b/Remote/Helper/Encryptable.hs
@@ -88,6 +88,11 @@ remoteCipher c = go $ extractCipher c
Annex.changeState (\s -> s { Annex.ciphers = M.insert encipher cipher cache })
return $ Just cipher
+{- Checks if there is a trusted (non-shared) cipher. -}
+isTrustedCipher :: RemoteConfig -> Bool
+isTrustedCipher c =
+ isJust (M.lookup "cipherkeys" c) && isJust (M.lookup "cipher" c)
+
{- Gets encryption Cipher, and encrypted version of Key. -}
cipherKey :: Maybe RemoteConfig -> Key -> Annex (Maybe (Cipher, Key))
cipherKey Nothing _ = return Nothing
diff --git a/Remote/S3.hs b/Remote/S3.hs
index 65346809e..c4da0b2ec 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -5,7 +5,7 @@
- Licensed under the GNU GPL version 3 or higher.
-}
-module Remote.S3 (remote) where
+module Remote.S3 (remote, s3SetCredsEnv) where
import Network.AWS.AWSConnection
import Network.AWS.S3Object
@@ -27,6 +27,8 @@ import Remote.Helper.Encryptable
import Crypto
import Annex.Content
import Utility.Base64
+import Annex.Perms
+import Utility.FileMode
remote :: RemoteType
remote = RemoteType {
@@ -85,12 +87,12 @@ s3Setup u c = handlehost $ M.lookup "host" c
use fullconfig = do
gitConfigSpecialRemote u fullconfig "s3" "true"
- s3SetCreds fullconfig
+ s3SetCreds fullconfig u
defaulthost = do
c' <- encryptionSetup c
let fullconfig = c' `M.union` defaults
- genBucket fullconfig
+ genBucket fullconfig u
use fullconfig
archiveorg = do
@@ -206,7 +208,7 @@ s3Action r noconn action = do
when (isNothing $ config r) $
error $ "Missing configuration for special remote " ++ name r
let bucket = M.lookup "bucket" $ fromJust $ config r
- conn <- s3Connection $ fromJust $ config r
+ conn <- s3Connection (fromJust $ config r) (uuid r)
case (bucket, conn) of
(Just b, Just c) -> action (c, b)
_ -> return noconn
@@ -235,9 +237,9 @@ iaMunge = (>>= munge)
| isSpace c = []
| otherwise = "&" ++ show (ord c) ++ ";"
-genBucket :: RemoteConfig -> Annex ()
-genBucket c = do
- conn <- s3ConnectionRequired c
+genBucket :: RemoteConfig -> UUID -> Annex ()
+genBucket c u = do
+ conn <- s3ConnectionRequired c u
showAction "checking bucket"
loc <- liftIO $ getBucketLocation conn bucket
case loc of
@@ -253,13 +255,13 @@ genBucket c = do
bucket = fromJust $ M.lookup "bucket" c
datacenter = fromJust $ M.lookup "datacenter" c
-s3ConnectionRequired :: RemoteConfig -> Annex AWSConnection
-s3ConnectionRequired c =
- maybe (error "Cannot connect to S3") return =<< s3Connection c
+s3ConnectionRequired :: RemoteConfig -> UUID -> Annex AWSConnection
+s3ConnectionRequired c u =
+ maybe (error "Cannot connect to S3") return =<< s3Connection c u
-s3Connection :: RemoteConfig -> Annex (Maybe AWSConnection)
-s3Connection c = do
- creds <- s3GetCreds c
+s3Connection :: RemoteConfig -> UUID -> Annex (Maybe AWSConnection)
+s3Connection c u = do
+ creds <- s3GetCreds c u
case creds of
Just (ak, sk) -> return $ Just $ AWSConnection host port ak sk
_ -> do
@@ -272,52 +274,78 @@ s3Connection c = do
[(p, _)] -> p
_ -> error $ "bad S3 port value: " ++ s
-{- S3 creds come from the environment if set.
- - Otherwise, might be stored encrypted in the remote's config. -}
-s3GetCreds :: RemoteConfig -> Annex (Maybe (String, String))
-s3GetCreds c = maybe fromconfig (return . Just) =<< liftIO getenv
+{- S3 creds come from the environment if set, otherwise from the cache
+ - in gitAnnexCredsDir, or failing that, might be stored encrypted in
+ - the remote's config. -}
+s3GetCreds :: RemoteConfig -> UUID -> Annex (Maybe (String, String))
+s3GetCreds c u = maybe fromcache (return . Just) =<< liftIO getenv
where
getenv = liftM2 (,)
<$> get s3AccessKey
<*> get s3SecretKey
where
get = catchMaybeIO . getEnv
- setenv (ak, sk) = do
- setEnv s3AccessKey ak True
- setEnv s3SecretKey sk True
+ fromcache = do
+ d <- fromRepo gitAnnexCredsDir
+ let f = d </> fromUUID u
+ v <- liftIO $ catchMaybeIO $ readFile f
+ case lines <$> v of
+ Just (ak:sk:[]) -> return $ Just (ak, sk)
+ _ -> fromconfig
fromconfig = do
mcipher <- remoteCipher c
case (M.lookup "s3creds" c, mcipher) of
- (Just s3creds, Just cipher) ->
- liftIO $ decrypt s3creds cipher
+ (Just s3creds, Just cipher) -> do
+ creds <- liftIO $ decrypt s3creds cipher
+ case creds of
+ [ak, sk] -> do
+ s3CacheCreds (ak, sk) u
+ return $ Just (ak, sk)
+ _ -> do error "bad s3creds"
_ -> return Nothing
- decrypt s3creds cipher = do
- creds <- lines <$>
- withDecryptedContent cipher
- (return $ L.pack $ fromB64 s3creds)
- (return . L.unpack)
- case creds of
- [ak, sk] -> do
- setenv (ak, sk)
- return $ Just (ak, sk)
- _ -> do error "bad s3creds"
+ decrypt s3creds cipher = lines <$>
+ withDecryptedContent cipher
+ (return $ L.pack $ fromB64 s3creds)
+ (return . L.unpack)
-{- Stores S3 creds encrypted in the remote's config if possible. -}
-s3SetCreds :: RemoteConfig -> Annex RemoteConfig
-s3SetCreds c = do
- creds <- s3GetCreds c
+{- Stores S3 creds encrypted in the remote's config if possible to do so
+ - securely, and otherwise locally in gitAnnexCredsDir. -}
+s3SetCreds :: RemoteConfig -> UUID -> Annex RemoteConfig
+s3SetCreds c u = do
+ creds <- s3GetCreds c u
case creds of
Just (ak, sk) -> do
mcipher <- remoteCipher c
case mcipher of
- Just cipher -> do
+ Just cipher | isTrustedCipher c -> do
s <- liftIO $ withEncryptedContent cipher
(return $ L.pack $ unlines [ak, sk])
(return . L.unpack)
return $ M.insert "s3creds" (toB64 s) c
- Nothing -> return c
+ _ -> do
+ s3CacheCreds (ak, sk) u
+ return c
_ -> return c
+{- The S3 creds are cached in gitAnnexCredsDir. -}
+s3CacheCreds :: (String, String) -> UUID -> Annex ()
+s3CacheCreds (ak, sk) u = do
+ d <- fromRepo gitAnnexCredsDir
+ createAnnexDirectory d
+ liftIO $ do
+ let f = d </> fromUUID u
+ h <- openFile f WriteMode
+ modifyFileMode f $ removeModes
+ [groupReadMode, otherReadMode]
+ hPutStr h $ unlines [ak, sk]
+ hClose h
+
+{- Sets the S3 creds in the environment. -}
+s3SetCredsEnv :: (String, String) -> IO ()
+s3SetCredsEnv (ak, sk) = do
+ setEnv s3AccessKey ak True
+ setEnv s3SecretKey sk True
+
s3AccessKey :: String
s3AccessKey = "AWS_ACCESS_KEY_ID"
s3SecretKey :: String
diff --git a/Utility/Process.hs b/Utility/Process.hs
index 1e93569be..839cc4078 100644
--- a/Utility/Process.hs
+++ b/Utility/Process.hs
@@ -101,14 +101,14 @@ writeReadProcessEnv cmd args environ input = do
, env = environ
}
-{- Waits for a ProcessHandle, and throws an exception if the process
+{- Waits for a ProcessHandle, and throws an IOError if the process
- did not exit successfully. -}
forceSuccessProcess :: CreateProcess -> ProcessHandle -> IO ()
forceSuccessProcess p pid = do
code <- waitForProcess pid
case code of
ExitSuccess -> return ()
- ExitFailure n -> error $ showCmd p ++ " exited " ++ show n
+ ExitFailure n -> fail $ showCmd p ++ " exited " ++ show n
{- Waits for a ProcessHandle and returns True if it exited successfully. -}
checkSuccessProcess :: ProcessHandle -> IO Bool
diff --git a/debian/changelog b/debian/changelog
index 6ee322e1f..976b70903 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -10,6 +10,12 @@ git-annex (3.20120925) UNRELEASED; urgency=low
a specified amount of time.
* fsck: New --incremental-schedule option which is nice for scheduling
eg, monthly incremental fsck runs in cron jobs.
+ * Fix fallback to ~/Desktop when xdg-user-dir is not available.
+ Closes: #688833
+ * S3: When using a shared cipher, S3 credentials are not stored encrypted
+ in the git repository, as that would allow anyone with access to
+ the repository access to the S3 account. Instead, they're stored
+ in a 600 mode file in the local git repo.
-- Joey Hess <joeyh@debian.org> Mon, 24 Sep 2012 19:58:07 -0400
diff --git a/doc/special_remotes/S3.mdwn b/doc/special_remotes/S3.mdwn
index 333e0bac5..79a8e584a 100644
--- a/doc/special_remotes/S3.mdwn
+++ b/doc/special_remotes/S3.mdwn
@@ -9,8 +9,10 @@ See [[tips/using_Amazon_S3]] and
The standard environment variables `AWS_ACCESS_KEY_ID` and
`AWS_SECRET_ACCESS_KEY` are used to supply login credentials
for Amazon. When encryption is enabled, they are stored in encrypted form
-by `git annex initremote`, so you do not need to keep the environment
-variables set after the initial initalization of the remote.
+by `git annex initremote`. Without encryption, they are stored in a
+file only you can read inside the local git repository. So you do not
+need to keep the environment variables set after the initial
+initalization of the remote.
A number of parameters can be passed to `git annex initremote` to configure
the S3 remote.
generated by cgit v1.2.3 (git 2.39.1) at 2024-08-15 21:41:22 +0000