8062f6337f
When adding a removable drive, it's now detected if the drive contains a gcrypt special remote, and that's all handled nicely. This includes fetching the git-annex branch from the gcrypt repo in order to find out how to set up the special remote. Note that gcrypt repos that are not git-annex special remotes are not supported. It will attempt to detect such a gcrypt repo and refuse to use it. (But this is hard to do any may fail; see https://github.com/blake2-ppc/git-remote-gcrypt/issues/6) The problem with supporting regular gcrypt repos is that we don't know what the gcrypt.participants setting is intended to be for the repo. So even if we can decrypt it, if we push changes to it they might not be visible to other participants. Anyway, encrypted sneakernet (or mailnet) is now fully possible with the git-annex assistant! Assuming that the gpg key distribution is handled somehow, which the assistant doesn't yet help with. This commit was sponsored by Navishkar Rao.
75 lines
2.3 KiB
Haskell
75 lines
2.3 KiB
Haskell
{- git-annex webapp gpg stuff
|
|
-
|
|
- Copyright 2013 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE QuasiQuotes, TemplateHaskell #-}
|
|
|
|
module Assistant.WebApp.Gpg where
|
|
|
|
import Assistant.WebApp.Common
|
|
import Utility.Gpg
|
|
import Utility.UserInfo
|
|
import qualified Git.Command
|
|
import qualified Git.Remote
|
|
import qualified Annex.Branch
|
|
import qualified Git.GCrypt
|
|
import Assistant.MakeRemote
|
|
import Logs.Remote
|
|
|
|
import qualified Data.Map as M
|
|
|
|
gpgKeyDisplay :: KeyId -> Maybe UserId -> Widget
|
|
gpgKeyDisplay keyid userid = [whamlet|
|
|
<span title="key id #{keyid}">
|
|
<i .icon-user></i> #
|
|
^{displayname}
|
|
|]
|
|
where
|
|
displayname = case userid of
|
|
Just name | not (null name) -> [whamlet|#{name}|]
|
|
_ -> [whamlet|key id #{keyid}|]
|
|
|
|
{- Generates a gpg user id that is not used by any existing secret key -}
|
|
newUserId :: IO UserId
|
|
newUserId = do
|
|
oldkeys <- secretKeys
|
|
username <- myUserName
|
|
let basekeyname = username ++ "'s git-annex encryption key"
|
|
return $ Prelude.head $ filter (\n -> M.null $ M.filter (== n) oldkeys)
|
|
( basekeyname
|
|
: map (\n -> basekeyname ++ show n) ([2..] :: [Int])
|
|
)
|
|
|
|
withNewSecretKey :: (KeyId -> Handler Html) -> Handler Html
|
|
withNewSecretKey use = do
|
|
userid <- liftIO $ newUserId
|
|
liftIO $ genSecretKey RSA "" userid maxRecommendedKeySize
|
|
results <- M.keys . M.filter (== userid) <$> liftIO secretKeys
|
|
case results of
|
|
[] -> error "Failed to generate gpg key!"
|
|
(key:_) -> use key
|
|
|
|
{- Tries to find the name used in remote.log for a gcrypt repository
|
|
- with a given uuid.
|
|
-
|
|
- The gcrypt remote may not be on that is listed in the local remote.log
|
|
- (or the info may be out of date), so this actually fetches the git-annex
|
|
- branch from the gcrypt remote and merges it in, and then looks up
|
|
- the name.
|
|
-}
|
|
getGCryptRemoteName :: UUID -> String -> Annex (Maybe Git.Remote.RemoteName)
|
|
getGCryptRemoteName u repoloc = do
|
|
tmpremote <- uniqueRemoteName "tmpgcryptremote" 0 <$> gitRepo
|
|
void $ inRepo $ Git.Command.runBool
|
|
[Params "remote add", Param tmpremote, Param $ Git.GCrypt.urlPrefix ++ repoloc]
|
|
mname <- ifM (inRepo $ Git.Command.runBool [Param "fetch", Param tmpremote])
|
|
( do
|
|
void $ Annex.Branch.forceUpdate
|
|
(M.lookup "name" <=< M.lookup u) <$> readRemoteLog
|
|
, return Nothing
|
|
)
|
|
void $ inRepo $ Git.Remote.remove tmpremote
|
|
return mname
|