mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

blind enabling gcrypt repos on rsync.net

Browse source 
This pulls off quite a nice trick: When given a path on rsync.net, it
determines if it is an encrypted git repository that the user has
the key to decrypt, and merges with it. This is works even when
the local repository had no idea that the gcrypt remote exists!

(As previously done with local drives.)

This commit sponsored by Pedro Côrte-Real
This commit is contained in:
Joey Hess 2013-09-27 16:21:56 -04:00
parent 8888e825fc
commit e864c8d033
6 changed files with 111 additions and 58 deletions
Download patch file Download diff file Expand all files Collapse all files

28
Assistant/WebApp/Configurators/Local.hs
View file

@ -252,7 +252,7 @@ getConfirmAddDriveR drive = ifM (liftIO $ probeRepoExists dir)
mu <- liftIO $ probeUUID dir
case mu of
Nothing -> maybe askcombine isknownuuid
=<< liftIO (probeGCryptRemoteUUID dir)
=<< liftAnnex (probeGCryptRemoteUUID dir)
Just driveuuid -> isknownuuid driveuuid
, newrepo
)
@ -295,19 +295,17 @@ getFinishAddDriveR drive = go
makeGCryptRemote remotename dir keyid
return (Types.Remote.uuid r, r)
go NoRepoKey = checkGCryptRepoEncryption dir makeunencrypted $ do
mu <- liftIO $ probeGCryptRemoteUUID dir
mu <- liftAnnex $ probeGCryptRemoteUUID dir
case mu of
Just u -> enablegcryptremote u
Just u -> enableexistinggcryptremote u
Nothing -> error "The drive contains a gcrypt repository that is not a git-annex special remote. This is not supported."
enablegcryptremote u = do
mname <- liftAnnex $ getGCryptRemoteName u dir
case mname of
Nothing -> error $ "Cannot find configuration for the gcrypt remote at " ++ dir
Just name -> makewith $ const $ do
r <- liftAnnex $ addRemote $
enableSpecialRemote name GCrypt.remote $ M.fromList
[("gitrepo", dir)]
return (u, r)
enableexistinggcryptremote u = do
remotename' <- liftAnnex $ getGCryptRemoteName u dir
makewith $ const $ do
r <- liftAnnex $ addRemote $
enableSpecialRemote remotename' GCrypt.remote $ M.fromList
[("gitrepo", dir)]
return (u, r)
{- Making a new unencrypted repo, or combining with an existing one. -}
makeunencrypted = makewith $ \isnew -> (,)
<$> liftIO (initRepo isnew False dir $ Just remotename)
@ -471,9 +469,3 @@ probeUUID :: FilePath -> IO (Maybe UUID)
probeUUID dir = catchDefaultIO Nothing $ inDir dir $ do
u <- getUUID
return $ if u == NoUUID then Nothing else Just u
{- Gets the UUID of the gcrypt repo at a location, which may not exist.
- Only works if the gcrypt repo was created as a git-annex remote. -}
probeGCryptRemoteUUID :: FilePath -> IO (Maybe UUID)
probeGCryptRemoteUUID dir = catchDefaultIO Nothing $ do
GCrypt.getGCryptUUID =<< Git.Construct.fromAbsPath dir

47
Assistant/WebApp/Configurators/Ssh.hs
View file

@ -24,6 +24,7 @@ import Utility.Gpg
import Types.Remote (RemoteConfigKey)
import Git.Remote
import Assistant.WebApp.Utility
import qualified Remote.GCrypt as GCrypt
import qualified Data.Text as T
import qualified Data.Map as M
@ -344,7 +345,8 @@ postAddRsyncNetR = do
$(widgetFile "configurators/rsync.net/add")
case result of
FormSuccess sshinput
| isRsyncNet (inputHostname sshinput) -> prep sshinput
| isRsyncNet (inputHostname sshinput) ->
go sshinput
| otherwise ->
showform $ UnusableServer
"That is not a rsync.net host name."
@ -360,13 +362,28 @@ postAddRsyncNetR = do
The host name will be something like "usw-s001.rsync.net", and the #
user name something like "7491"
|]
prep sshinput = do
go 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")
prepRsyncNet sshinput reponame $ \sshdata -> inpage $
checkexistinggcrypt sshdata $ do
secretkeys <- sortBy (comparing snd) . M.toList
<$> liftIO secretKeys
$(widgetFile "configurators/rsync.net/encrypt")
{- Detect if the user entered an existing gcrypt repository,
- and enable it. -}
checkexistinggcrypt sshdata a = ifM (liftIO isGcryptInstalled)
( checkGCryptRepoEncryption repourl a $ do
mu <- liftAnnex $ probeGCryptRemoteUUID repourl
case mu of
Just u -> do
reponame <- liftAnnex $ getGCryptRemoteName u repourl
void $ liftH $ enableRsyncNetGCrypt' sshdata reponame
Nothing -> error "The location contains a gcrypt repository that is not a git-annex special remote. This is not supported."
, a
)
where
repourl = sshUrl True sshdata
getMakeRsyncNetSharedR :: SshData -> Handler Html
getMakeRsyncNetSharedR sshdata = makeSshRepo True sshdata
@ -387,16 +404,18 @@ enableRsyncNet :: SshInput -> String -> Handler Html
enableRsyncNet sshinput reponame =
prepRsyncNet sshinput reponame $ makeSshRepo True
enableRsyncNetGCrypt :: SshInput -> String -> Handler Html
enableRsyncNetGCrypt :: SshInput -> RemoteName -> Handler Html
enableRsyncNetGCrypt sshinput reponame =
prepRsyncNet sshinput reponame $ \sshdata -> do
let repourl = sshUrl True sshdata
checkGCryptRepoEncryption repourl notencrypted $
setupCloudRemote TransferGroup $
enableSpecialRemote reponame GCrypt.remote $ M.fromList
[("gitrepo", repourl)]
prepRsyncNet sshinput reponame $ \sshdata ->
checkGCryptRepoEncryption (sshUrl True sshdata) notencrypted $
enableRsyncNetGCrypt' sshdata reponame
where
notencrypted = error "Unexpectedly found a non-encrypted git repository, instead of the expected encrypted git repository."
notencrypted = error "Unexpectedly found a non-encrypted git repository, instead of the expected encrypted git repository."
enableRsyncNetGCrypt' :: SshData -> RemoteName -> Handler Html
enableRsyncNetGCrypt' sshdata reponame =
setupCloudRemote TransferGroup $
enableSpecialRemote reponame GCrypt.remote $ M.fromList
[("gitrepo", sshUrl True sshdata)]
{- Prepares rsync.net ssh key, and if successful, runs an action with
- its SshData. -}