webapp gpg key generation
Now the webapp can generate a gpg key that is dedicated for use by git-annex. Since the key is single use, much of the complexity of generating gpg keys is avoided. Note that the key has no password, because gpg-agent is not available everywhere the assistant is installed. This is not a big security problem because the key is going to live on the same disk as the git annex repository, so an attacker with access to it can look directly in the repository to see the same files that get stored in the encrypted repository on the removable drive. There is no provision yet for backing up keys. This commit sponsored by Robert Beaty.
This commit is contained in:
parent
cac0688d0e
commit
9de189e788
8 changed files with 69 additions and 19 deletions
|
@ -265,21 +265,50 @@ getConfirmAddDriveR drive = ifM (liftIO $ doesDirectoryExist dir)
|
|||
<$> liftIO secretKeys
|
||||
page "Encrypt repository?" (Just Configuration) $
|
||||
$(widgetFile "configurators/adddrive/encrypt")
|
||||
knownrepo = getFinishAddDriveR (RemovableDriveKey drive Nothing)
|
||||
knownrepo = getFinishAddDriveR drive NoRepoKey
|
||||
askcombine = page "Combine repositories?" (Just Configuration) $
|
||||
$(widgetFile "configurators/adddrive/combine")
|
||||
|
||||
setupDriveModal :: Widget
|
||||
setupDriveModal = $(widgetFile "configurators/adddrive/setupmodal")
|
||||
|
||||
getFinishAddDriveR :: RemovableDriveKey -> Handler Html
|
||||
getFinishAddDriveR (RemovableDriveKey drive mkeyid) =
|
||||
maybe setupclear setupencrypted mkeyid
|
||||
genKeyModal :: Widget
|
||||
genKeyModal = $(widgetFile "configurators/genkeymodal")
|
||||
|
||||
getGenKeyForDriveR :: RemovableDrive -> Handler Html
|
||||
getGenKeyForDriveR drive = 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:_) -> 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)
|
||||
, getAddDriveR
|
||||
)
|
||||
|
||||
newUserId :: IO UserId
|
||||
newUserId = do
|
||||
oldkeys <- secretKeys
|
||||
username <- myUserName
|
||||
let basekeyname = username ++ " git-annex"
|
||||
return $ Prelude.head $ filter (\n -> M.null $ M.filter (== n) oldkeys)
|
||||
( basekeyname
|
||||
: map (\n -> basekeyname ++ show n) ([2..] :: [Int])
|
||||
)
|
||||
|
||||
getFinishAddDriveR :: RemovableDrive -> RepoKey -> Handler Html
|
||||
getFinishAddDriveR drive = go
|
||||
where
|
||||
setupclear = makewith $ \isnew -> (,)
|
||||
go NoRepoKey = makewith $ \isnew -> (,)
|
||||
<$> liftIO (initRepo isnew False dir $ Just remotename)
|
||||
<*> combineRepos dir remotename
|
||||
setupencrypted keyid = ifM (liftIO $ inPath "git-remote-gcrypt")
|
||||
go (RepoKey keyid) = ifM (liftIO $ inPath "git-remote-gcrypt")
|
||||
( makewith $ \_ -> do
|
||||
r <- liftAnnex $ addRemote $
|
||||
initSpecialRemote remotename GCrypt.remote $ M.fromList
|
||||
|
|
|
@ -160,7 +160,7 @@ data RemovableDrive = RemovableDrive
|
|||
}
|
||||
deriving (Read, Show, Eq, Ord)
|
||||
|
||||
data RemovableDriveKey = RemovableDriveKey RemovableDrive (Maybe KeyId)
|
||||
data RepoKey = RepoKey KeyId | NoRepoKey
|
||||
deriving (Read, Show, Eq, Ord)
|
||||
|
||||
{- Only needed to work around old-yesod bug that emits a warning message
|
||||
|
@ -176,7 +176,7 @@ instance PathPiece RemovableDrive where
|
|||
toPathPiece = pack . show
|
||||
fromPathPiece = readish . unpack
|
||||
|
||||
instance PathPiece RemovableDriveKey where
|
||||
instance PathPiece RepoKey where
|
||||
toPathPiece = pack . show
|
||||
fromPathPiece = readish . unpack
|
||||
|
||||
|
|
|
@ -37,7 +37,8 @@
|
|||
|
||||
/config/repository/add/drive AddDriveR GET POST
|
||||
/config/repository/add/drive/confirm/#RemovableDrive ConfirmAddDriveR GET
|
||||
/config/repository/add/drive/finish/#RemovableDriveKey FinishAddDriveR GET
|
||||
/config/repository/add/drive/genkey/#RemovableDrive GenKeyForDriveR GET
|
||||
/config/repository/add/drive/finish/#RemovableDrive/#RepoKey FinishAddDriveR GET
|
||||
/config/repository/add/ssh AddSshR GET POST
|
||||
/config/repository/add/ssh/confirm/#SshData ConfirmSshR GET
|
||||
/config/repository/add/ssh/retry/#SshData RetrySshR GET
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue