webapp: Support storing encrypted git repositories on rsync.net.
Does not yet support re-enabling such a repository though. This commit was sponsored by Jan Pieper.
This commit is contained in:
parent
e0b99f3960
commit
588494cbce
14 changed files with 177 additions and 66 deletions
36
Assistant/Gpg.hs
Normal file
36
Assistant/Gpg.hs
Normal file
|
@ -0,0 +1,36 @@
|
|||
{- git-annex assistant gpg stuff
|
||||
-
|
||||
- Copyright 2013 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE QuasiQuotes, TemplateHaskell, OverloadedStrings #-}
|
||||
|
||||
module Assistant.Gpg where
|
||||
|
||||
import Utility.Gpg
|
||||
import Utility.UserInfo
|
||||
import Types.Remote (RemoteConfigKey)
|
||||
|
||||
import qualified Data.Map as M
|
||||
|
||||
{- 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])
|
||||
)
|
||||
|
||||
data EnableEncryption = HybridEncryption | SharedEncryption | NoEncryption
|
||||
deriving (Eq)
|
||||
|
||||
{- Generates Remote configuration for encryption. -}
|
||||
configureEncryption :: EnableEncryption -> (RemoteConfigKey, String)
|
||||
configureEncryption SharedEncryption = ("encryption", "shared")
|
||||
configureEncryption NoEncryption = ("encryption", "none")
|
||||
configureEncryption HybridEncryption = ("encryption", "hybrid")
|
|
@ -14,6 +14,7 @@ import qualified Types.Remote as R
|
|||
import qualified Remote
|
||||
import Remote.List
|
||||
import qualified Remote.Rsync as Rsync
|
||||
import qualified Remote.GCrypt as GCrypt
|
||||
import qualified Git
|
||||
import qualified Git.Command
|
||||
import qualified Command.InitRemote
|
||||
|
@ -23,6 +24,8 @@ import Git.Remote
|
|||
import Config
|
||||
import Config.Cost
|
||||
import Creds
|
||||
import Assistant.Gpg
|
||||
import Utility.Gpg (KeyId)
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Map as M
|
||||
|
@ -31,7 +34,8 @@ import qualified Data.Map as M
|
|||
makeSshRemote :: Bool -> SshData -> Maybe Cost -> Assistant Remote
|
||||
makeSshRemote forcersync sshdata mcost = do
|
||||
r <- liftAnnex $
|
||||
addRemote $ maker (sshRepoName sshdata) sshurl
|
||||
addRemote $ maker (sshRepoName sshdata)
|
||||
(sshUrl forcersync sshdata)
|
||||
liftAnnex $ maybe noop (setRemoteCost r) mcost
|
||||
syncRemote r
|
||||
return r
|
||||
|
@ -40,17 +44,20 @@ makeSshRemote forcersync sshdata mcost = do
|
|||
maker
|
||||
| rsync = makeRsyncRemote
|
||||
| otherwise = makeGitRemote
|
||||
sshurl = T.unpack $ T.concat $
|
||||
if rsync
|
||||
then [u, h, T.pack ":", sshDirectory sshdata, T.pack "/"]
|
||||
else [T.pack "ssh://", u, h, d, T.pack "/"]
|
||||
where
|
||||
u = maybe (T.pack "") (\v -> T.concat [v, T.pack "@"]) $ sshUserName sshdata
|
||||
h = sshHostName sshdata
|
||||
d
|
||||
| T.pack "/" `T.isPrefixOf` sshDirectory sshdata = sshDirectory sshdata
|
||||
| T.pack "~/" `T.isPrefixOf` sshDirectory sshdata = T.concat [T.pack "/", sshDirectory sshdata]
|
||||
| otherwise = T.concat [T.pack "/~/", sshDirectory sshdata]
|
||||
|
||||
{- Generates a ssh or rsync url from a SshData. -}
|
||||
sshUrl :: Bool -> SshData -> String
|
||||
sshUrl forcersync sshdata = T.unpack $ T.concat $
|
||||
if (forcersync || rsyncOnly sshdata)
|
||||
then [u, h, T.pack ":", sshDirectory sshdata, T.pack "/"]
|
||||
else [T.pack "ssh://", u, h, d, T.pack "/"]
|
||||
where
|
||||
u = maybe (T.pack "") (\v -> T.concat [v, T.pack "@"]) $ sshUserName sshdata
|
||||
h = sshHostName sshdata
|
||||
d
|
||||
| T.pack "/" `T.isPrefixOf` sshDirectory sshdata = sshDirectory sshdata
|
||||
| T.pack "~/" `T.isPrefixOf` sshDirectory sshdata = T.concat [T.pack "/", sshDirectory sshdata]
|
||||
| otherwise = T.concat [T.pack "/~/", sshDirectory sshdata]
|
||||
|
||||
{- Runs an action that returns a name of the remote, and finishes adding it. -}
|
||||
addRemote :: Annex RemoteName -> Annex Remote
|
||||
|
@ -74,6 +81,16 @@ makeRsyncRemote name location = makeRemote name location $ const $ void $
|
|||
, ("type", "rsync")
|
||||
]
|
||||
|
||||
{- Inits a gcrypt special remote, and returns its name. -}
|
||||
makeGCryptRemote :: RemoteName -> String -> KeyId -> Annex RemoteName
|
||||
makeGCryptRemote remotename location keyid =
|
||||
initSpecialRemote remotename GCrypt.remote $ M.fromList
|
||||
[ ("type", "gcrypt")
|
||||
, ("gitrepo", location)
|
||||
, configureEncryption HybridEncryption
|
||||
, ("keyid", keyid)
|
||||
]
|
||||
|
||||
type SpecialRemoteMaker = RemoteName -> RemoteType -> R.RemoteConfig -> Annex RemoteName
|
||||
|
||||
{- Inits a new special remote. The name is used as a suggestion, but
|
||||
|
|
|
@ -24,6 +24,7 @@ import Types.Remote (RemoteConfig)
|
|||
import Types.StandardGroups
|
||||
import Logs.PreferredContent
|
||||
import Creds
|
||||
import Assistant.Gpg
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Map as M
|
||||
|
|
|
@ -24,6 +24,7 @@ import Logs.PreferredContent
|
|||
import Logs.Remote
|
||||
import qualified Utility.Url as Url
|
||||
import Creds
|
||||
import Assistant.Gpg
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Map as M
|
||||
|
|
|
@ -276,17 +276,14 @@ getConfirmAddDriveR drive = ifM (liftIO $ probeRepoExists dir)
|
|||
setupDriveModal :: Widget
|
||||
setupDriveModal = $(widgetFile "configurators/adddrive/setupmodal")
|
||||
|
||||
genKeyModal :: Widget
|
||||
genKeyModal = $(widgetFile "configurators/genkeymodal")
|
||||
|
||||
getGenKeyForDriveR :: RemovableDrive -> Handler Html
|
||||
getGenKeyForDriveR drive = withNewSecretKey $ \key -> do
|
||||
getGenKeyForDriveR drive = withNewSecretKey $ \keyid -> do
|
||||
{- Generating a key takes a long time, and
|
||||
- the removable drive may have been disconnected
|
||||
- in the meantime. Check that it is still mounted
|
||||
- before finishing. -}
|
||||
ifM (liftIO $ any (\d -> mountPoint d == mountPoint drive) <$> driveList)
|
||||
( getFinishAddDriveR drive (RepoKey key)
|
||||
( getFinishAddDriveR drive (RepoKey keyid)
|
||||
, getAddDriveR
|
||||
)
|
||||
|
||||
|
@ -295,13 +292,8 @@ getFinishAddDriveR drive = go
|
|||
where
|
||||
{- Set up new gcrypt special remote. -}
|
||||
go (RepoKey keyid) = whenGcryptInstalled $ makewith $ const $ do
|
||||
r <- liftAnnex $ addRemote $
|
||||
initSpecialRemote remotename GCrypt.remote $ M.fromList
|
||||
[ ("type", "gcrypt")
|
||||
, ("gitrepo", dir)
|
||||
, configureEncryption HybridEncryption
|
||||
, ("keyid", keyid)
|
||||
]
|
||||
r <- liftAnnex $ addRemote $
|
||||
makeGCryptRemote remotename dir keyid
|
||||
return (Types.Remote.uuid r, r)
|
||||
go NoRepoKey = do
|
||||
pr <- liftAnnex $ inRepo $ Git.GCrypt.probeRepo dir
|
||||
|
|
|
@ -11,6 +11,7 @@
|
|||
module Assistant.WebApp.Configurators.Ssh where
|
||||
|
||||
import Assistant.WebApp.Common
|
||||
import Assistant.WebApp.Gpg
|
||||
import Assistant.Ssh
|
||||
import Assistant.MakeRemote
|
||||
import Utility.Rsync (rsyncUrlIsShell)
|
||||
|
@ -19,10 +20,13 @@ import Remote
|
|||
import Logs.PreferredContent
|
||||
import Types.StandardGroups
|
||||
import Utility.UserInfo
|
||||
import Utility.Gpg
|
||||
import Assistant.Sync
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Map as M
|
||||
import Network.Socket
|
||||
import Data.Ord
|
||||
|
||||
sshConfigurator :: Widget -> Handler Html
|
||||
sshConfigurator = page "Add a remote server" (Just Configuration)
|
||||
|
@ -147,7 +151,7 @@ postEnableRsyncR u = do
|
|||
case result of
|
||||
FormSuccess sshinput'
|
||||
| isRsyncNet (inputHostname sshinput') ->
|
||||
void $ liftH $ makeRsyncNet sshinput' reponame (const noop)
|
||||
void $ liftH $ enableRsyncNet sshinput' reponame (const noop)
|
||||
| otherwise -> do
|
||||
s <- liftIO $ testServer sshinput'
|
||||
case s of
|
||||
|
@ -320,19 +324,17 @@ postAddRsyncNetR = do
|
|||
((result, form), enctype) <- runFormPost $
|
||||
renderBootstrap $ sshInputAForm hostnamefield $
|
||||
SshInput Nothing Nothing Nothing 22
|
||||
let showform status = page "Add a Rsync.net repository" (Just Configuration) $
|
||||
$(widgetFile "configurators/addrsync.net")
|
||||
let showform status = inpage $
|
||||
$(widgetFile "configurators/rsync.net/add")
|
||||
case result of
|
||||
FormSuccess sshinput
|
||||
| isRsyncNet (inputHostname sshinput) -> do
|
||||
let reponame = genSshRepoName "rsync.net"
|
||||
(maybe "" T.unpack $ inputDirectory sshinput)
|
||||
makeRsyncNet sshinput reponame setupGroup
|
||||
| isRsyncNet (inputHostname sshinput) -> prep sshinput
|
||||
| otherwise ->
|
||||
showform $ UnusableServer
|
||||
"That is not a rsync.net host name."
|
||||
_ -> showform UntestedServer
|
||||
where
|
||||
inpage = page "Add a Rsync.net repository" (Just Configuration)
|
||||
hostnamefield = textField `withExpandableNote` ("Help", help)
|
||||
help = [whamlet|
|
||||
<div>
|
||||
|
@ -342,9 +344,41 @@ postAddRsyncNetR = do
|
|||
The host name will be something like "usw-s001.rsync.net", and the #
|
||||
user name something like "7491"
|
||||
|]
|
||||
prep sshinput = do
|
||||
let reponame = genSshRepoName "rsync.net"
|
||||
(maybe "" T.unpack $ inputDirectory sshinput)
|
||||
prepRsyncNet sshinput reponame $ \sshdata -> inpage $ do
|
||||
secretkeys <- sortBy (comparing snd) . M.toList
|
||||
<$> liftIO secretKeys
|
||||
$(widgetFile "configurators/rsync.net/encrypt")
|
||||
|
||||
makeRsyncNet :: SshInput -> String -> (Remote -> Handler ()) -> Handler Html
|
||||
makeRsyncNet sshinput reponame setup = do
|
||||
getMakeRsyncNetSharedR :: SshData -> Handler Html
|
||||
getMakeRsyncNetSharedR sshdata = makeSshRepo True setupGroup sshdata
|
||||
|
||||
{- Make a gcrypt special remote on rsync.net. -}
|
||||
getMakeRsyncNetGCryptR :: SshData -> RepoKey -> Handler Html
|
||||
getMakeRsyncNetGCryptR sshdata NoRepoKey = withNewSecretKey $ \keyid ->
|
||||
getMakeRsyncNetGCryptR sshdata (RepoKey keyid)
|
||||
getMakeRsyncNetGCryptR sshdata (RepoKey keyid) = do
|
||||
sshSetup [sshhost, gitinit] [] $ do
|
||||
r <- liftAnnex $ addRemote $
|
||||
makeGCryptRemote (sshRepoName sshdata) (sshUrl True sshdata) keyid
|
||||
setupGroup r
|
||||
liftAssistant $ syncRemote r
|
||||
redirect $ EditNewCloudRepositoryR $ Remote.uuid r
|
||||
where
|
||||
sshhost = genSshHost (sshHostName sshdata) (sshUserName sshdata)
|
||||
gitinit = "git init --bare " ++ T.unpack (sshDirectory sshdata)
|
||||
|
||||
enableRsyncNet :: SshInput -> String -> (Remote -> Handler ()) -> Handler Html
|
||||
enableRsyncNet sshinput reponame setup =
|
||||
prepRsyncNet sshinput reponame $ \sshdata ->
|
||||
makeSshRepo True setup sshdata
|
||||
|
||||
{- Prepares rsync.net ssh key, and if successful, runs an action with
|
||||
- its SshData. -}
|
||||
prepRsyncNet :: SshInput -> String -> (SshData -> Handler Html) -> Handler Html
|
||||
prepRsyncNet sshinput reponame a = do
|
||||
knownhost <- liftIO $ maybe (return False) knownHost (inputHostname sshinput)
|
||||
keypair <- liftIO $ genSshKeyPair
|
||||
sshdata <- liftIO $ setupSshKeyPair keypair $
|
||||
|
@ -371,8 +405,7 @@ makeRsyncNet sshinput reponame setup = do
|
|||
, genSshHost (sshHostName sshdata) (sshUserName sshdata)
|
||||
, remotecommand
|
||||
]
|
||||
sshSetup sshopts (sshPubKey keypair) $
|
||||
makeSshRepo True setup sshdata
|
||||
sshSetup sshopts (sshPubKey keypair) $ a sshdata
|
||||
|
||||
isRsyncNet :: Maybe Text -> Bool
|
||||
isRsyncNet Nothing = False
|
||||
|
|
|
@ -20,6 +20,7 @@ import Types.Remote (RemoteConfig)
|
|||
import Types.StandardGroups
|
||||
import Logs.PreferredContent
|
||||
import Logs.Remote
|
||||
import Assistant.Gpg
|
||||
|
||||
import qualified Data.Map as M
|
||||
#endif
|
||||
|
|
|
@ -12,8 +12,8 @@
|
|||
|
||||
module Assistant.WebApp.Form where
|
||||
|
||||
import Types.Remote (RemoteConfigKey)
|
||||
import Assistant.WebApp.Types
|
||||
import Assistant.Gpg
|
||||
|
||||
import Yesod hiding (textField, passwordField)
|
||||
import Yesod.Form.Fields as F
|
||||
|
@ -75,9 +75,6 @@ withExpandableNote field (toggle, note) = withNote field $ [whamlet|
|
|||
where
|
||||
ident = "toggle_" ++ toggle
|
||||
|
||||
data EnableEncryption = HybridEncryption | SharedEncryption | NoEncryption
|
||||
deriving (Eq)
|
||||
|
||||
{- Adds a check box to an AForm to control encryption. -}
|
||||
#if MIN_VERSION_yesod(1,2,0)
|
||||
enableEncryptionField :: (RenderMessage site FormMessage) => AForm (HandlerT site IO) EnableEncryption
|
||||
|
@ -91,9 +88,3 @@ enableEncryptionField = areq (selectFieldList choices) "Encryption" (Just Shared
|
|||
[ ("Encrypt all data", SharedEncryption)
|
||||
, ("Disable encryption", NoEncryption)
|
||||
]
|
||||
|
||||
{- Generates Remote configuration for encryption. -}
|
||||
configureEncryption :: EnableEncryption -> (RemoteConfigKey, String)
|
||||
configureEncryption SharedEncryption = ("encryption", "shared")
|
||||
configureEncryption NoEncryption = ("encryption", "none")
|
||||
configureEncryption HybridEncryption = ("encryption", "hybrid")
|
||||
|
|
|
@ -10,8 +10,8 @@
|
|||
module Assistant.WebApp.Gpg where
|
||||
|
||||
import Assistant.WebApp.Common
|
||||
import Assistant.Gpg
|
||||
import Utility.Gpg
|
||||
import Utility.UserInfo
|
||||
import qualified Git.Command
|
||||
import qualified Git.Remote
|
||||
import qualified Annex.Branch
|
||||
|
@ -31,16 +31,15 @@ gpgKeyDisplay keyid userid = [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])
|
||||
)
|
||||
genKeyModal :: Widget
|
||||
genKeyModal = $(widgetFile "configurators/genkeymodal")
|
||||
|
||||
whenGcryptInstalled :: Handler Html -> Handler Html
|
||||
whenGcryptInstalled a = ifM (liftIO $ inPath "git-remote-gcrypt")
|
||||
( a
|
||||
, page "Need git-remote-gcrypt" (Just Configuration) $
|
||||
$(widgetFile "configurators/needgcrypt")
|
||||
)
|
||||
|
||||
withNewSecretKey :: (KeyId -> Handler Html) -> Handler Html
|
||||
withNewSecretKey use = do
|
||||
|
@ -73,9 +72,3 @@ getGCryptRemoteName u repoloc = do
|
|||
void $ inRepo $ Git.Remote.remove tmpremote
|
||||
return mname
|
||||
|
||||
whenGcryptInstalled :: Handler Html -> Handler Html
|
||||
whenGcryptInstalled a = ifM (liftIO $ inPath "git-remote-gcrypt")
|
||||
( a
|
||||
, page "Need git-remote-gcrypt" (Just Configuration) $
|
||||
$(widgetFile "configurators/needgcrypt")
|
||||
)
|
||||
|
|
|
@ -45,6 +45,8 @@
|
|||
/config/repository/add/ssh/make/git/#SshData MakeSshGitR GET
|
||||
/config/repository/add/ssh/make/rsync/#SshData MakeSshRsyncR GET
|
||||
/config/repository/add/cloud/rsync.net AddRsyncNetR GET POST
|
||||
/config/repository/add/cloud/rsync.net/shared/#SshData MakeRsyncNetSharedR GET
|
||||
/config/repository/add/cloud/rsync.net/gcrypt/#SshData/#RepoKey MakeRsyncNetGCryptR GET
|
||||
/config/repository/add/cloud/S3 AddS3R GET POST
|
||||
/config/repository/add/cloud/IA AddIAR GET POST
|
||||
/config/repository/add/cloud/glacier AddGlacierR GET POST
|
||||
|
|
1
debian/changelog
vendored
1
debian/changelog
vendored
|
@ -17,6 +17,7 @@ git-annex (4.20130921) UNRELEASED; urgency=low
|
|||
the user running the conversion.
|
||||
* add, import, assistant: Better preserve the mtime of symlinks,
|
||||
when when adding content that gets deduplicated.
|
||||
* webapp: Support storing encrypted git repositories on rsync.net.
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Sun, 22 Sep 2013 19:42:29 -0400
|
||||
|
||||
|
|
BIN
doc/assistant/rsync.net.encryption.png
Normal file
BIN
doc/assistant/rsync.net.encryption.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 40 KiB |
|
@ -27,14 +27,14 @@
|
|||
^{form}
|
||||
^{webAppFormAuthToken}
|
||||
<div .form-actions>
|
||||
<button .btn .btn-primary type=submit onclick="$('#testmodal').modal('show');">
|
||||
<button .btn .btn-primary type=submit onclick="$('#setupmodal').modal('show');">
|
||||
Use this rsync.net repository
|
||||
<div .modal .fade #testmodal>
|
||||
<div .modal .fade #setupmodal>
|
||||
<div .modal-header>
|
||||
<h3>
|
||||
Making repository ...
|
||||
Checking access to rsync.net ...
|
||||
<div .modal-body>
|
||||
<p>
|
||||
Setting up your rsync.net repository. This could take a minute.
|
||||
This could take a minute.
|
||||
<p>
|
||||
You may be prompted for your rsync.net ssh password.
|
43
templates/configurators/rsync.net/encrypt.hamlet
Normal file
43
templates/configurators/rsync.net/encrypt.hamlet
Normal file
|
@ -0,0 +1,43 @@
|
|||
<div .span9 .hero-unit>
|
||||
<h2>
|
||||
Ready to use rsync.net
|
||||
<p>
|
||||
All data will be encrypted before it is sent to rsync.net. #
|
||||
There are two options for how to encrypt your data.
|
||||
<h3>
|
||||
Simple shared encryption
|
||||
<p>
|
||||
This allows everyone who has a clone of this repository to decrypt the #
|
||||
files stored on rsync.net. That makes it good for sharing. #
|
||||
And it's easy to set up and use.
|
||||
<p>
|
||||
<a .btn href="@{MakeRsyncNetSharedR sshdata}" onclick="$('#setupmodal').modal('show');">
|
||||
<i .icon-lock></i> Use shared encryption
|
||||
<p style="text-align: center">
|
||||
-or-
|
||||
<h3>
|
||||
Encrypt with GnuPG key
|
||||
<p>
|
||||
This stores an encrypted clone of your repository on rsync.net, #
|
||||
unlike shared encryption which only stores file contents on rsync.net. #
|
||||
So it's good for backups. But the encryption will prevent you from #
|
||||
sharing the rsync.net repository with friends, or easily accessing #
|
||||
its contents on another computer.
|
||||
<p>
|
||||
$forall (keyid, name) <- secretkeys
|
||||
<p>
|
||||
<a .btn onclick="$('#setupmodal').modal('show');" href="@{MakeRsyncNetGCryptR sshdata (RepoKey keyid)}">
|
||||
<i .icon-lock></i> Encrypt repository #
|
||||
to ^{gpgKeyDisplay keyid (Just name)}
|
||||
<p>
|
||||
<a .btn onclick="$('#genkeymodal').modal('show');" href="@{MakeRsyncNetGCryptR sshdata NoRepoKey}">
|
||||
<i .icon-plus-sign></i> Encrypt repository #
|
||||
with a new encryption key
|
||||
^{genKeyModal}
|
||||
<div .modal .fade #setupmodal>
|
||||
<div .modal-header>
|
||||
<h3>
|
||||
Making repository ...
|
||||
<div .modal-body>
|
||||
<p>
|
||||
Setting up your rsync.net repository. This could take a minute.
|
Loading…
Reference in a new issue