add P2P.Auth
authorJoey Hess <joeyh@joeyh.name>
Tue, 22 Nov 2016 18:37:19 +0000 (14:37 -0400)
committerJoey Hess <joeyh@joeyh.name>
Tue, 22 Nov 2016 18:37:50 +0000 (14:37 -0400)
Creds.hs
P2P/Auth.hs [new file with mode: 0644]
git-annex.cabal

index 6be9b339161bbabe6fd77bc28ac0a492be252b09..de3cd2a0636318b1c63f9eb82f3255afb44e5315 100644 (file)
--- a/Creds.hs
+++ b/Creds.hs
@@ -156,7 +156,7 @@ readCacheCredPair storage = maybe Nothing decodeCredPair
        <$> readCacheCreds (credPairFile storage)
 
 readCacheCreds :: FilePath -> Annex (Maybe Creds)
-readCacheCreds f = liftIO . catchMaybeIO . readFile =<< cacheCredsFile f
+readCacheCreds f = liftIO . catchMaybeIO . readFileStrict =<< cacheCredsFile f
 
 cacheCredsFile :: FilePath -> Annex FilePath
 cacheCredsFile basefile = do
diff --git a/P2P/Auth.hs b/P2P/Auth.hs
new file mode 100644 (file)
index 0000000..5c3feb7
--- /dev/null
@@ -0,0 +1,30 @@
+{- P2P protocol, authorization
+ -
+ - Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module P2P.Auth where
+
+import Common
+import Utility.AuthToken
+
+import qualified Data.Text as T
+
+-- Use .git/annex/creds/p2p to hold AuthTokens of authorized peers.
+getAuthTokens :: Annex AllowedAuthTokens
+getAuthTokens = allowedAuthTokens <$> getAuthTokens'
+
+getAuthTokens' :: Annex [AuthTokens]
+getAuthTokens' = mapMaybe toAuthToken
+       . map T.pack
+       . lines
+       . fromMaybe []
+       <$> readCacheCreds "tor"
+
+addAuthToken :: AuthToken -> Annex ()
+addAuthToken t = do
+       ts <- getAuthTokens'
+       let d = unlines $ map (T.unpack . fromAuthToken) (t:ts)
+       writeCacheCreds d "tor"
index fd8ce9ce23ad32982e8c64b54d1069dae7302d2a..bd8c36063fb7af195f392e277c9bee2dd520b9a9 100644 (file)
@@ -904,6 +904,7 @@ Executable git-annex
     Messages.Internal
     Messages.JSON
     Messages.Progress
+    P2P.Auth
     P2P.IO
     P2P.Protocol
     Remote