diff --git a/Assistant/WebApp/Configurators/Local.hs b/Assistant/WebApp/Configurators/Local.hs index 8c437d2937..00cc2e95ad 100644 --- a/Assistant/WebApp/Configurators/Local.hs +++ b/Assistant/WebApp/Configurators/Local.hs @@ -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 diff --git a/Assistant/WebApp/Types.hs b/Assistant/WebApp/Types.hs index 8dbb9dcd8d..17e7c89b30 100644 --- a/Assistant/WebApp/Types.hs +++ b/Assistant/WebApp/Types.hs @@ -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 diff --git a/Assistant/WebApp/routes b/Assistant/WebApp/routes index d4102fd06f..0b78e4f623 100644 --- a/Assistant/WebApp/routes +++ b/Assistant/WebApp/routes @@ -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 diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs index 594cc562d7..f9b3d55e83 100644 --- a/Utility/Gpg.hs +++ b/Utility/Gpg.hs @@ -172,6 +172,11 @@ type Passphrase = String type Size = Int data KeyType = Algo Int | DSA | RSA +{- The maximum key size that gpg currently offers in its UI when + - making keys. -} +maxRecommendedKeySize :: Size +maxRecommendedKeySize = 4096 + {- Generates a secret key using the experimental batch mode. - The key is added to the secret key ring. - Can take a very long time, depending on system entropy levels. @@ -182,16 +187,18 @@ genSecretKey keytype passphrase userid keysize = where params = ["--batch", "--gen-key"] feeder h = do - hPutStr h $ unlines - [ "Key-Type: " ++ + hPutStr h $ unlines $ catMaybes + [ Just $ "Key-Type: " ++ case keytype of DSA -> "DSA" RSA -> "RSA" Algo n -> show n - , "Key-Length: " ++ show keysize - , "Name-Real: " ++ userid - , "Expire-Date: 0" - , "Passphrase: " ++ passphrase + , Just $ "Key-Length: " ++ show keysize + , Just $ "Name-Real: " ++ userid + , Just $ "Expire-Date: 0" + , if null passphrase + then Nothing + else Just $ "Passphrase: " ++ passphrase ] hClose h diff --git a/doc/assistant/genkey.png b/doc/assistant/genkey.png new file mode 100644 index 0000000000..6c1e509715 Binary files /dev/null and b/doc/assistant/genkey.png differ diff --git a/templates/configurators/adddrive/combine.hamlet b/templates/configurators/adddrive/combine.hamlet index b97735956d..b11f3bf033 100644 --- a/templates/configurators/adddrive/combine.hamlet +++ b/templates/configurators/adddrive/combine.hamlet @@ -7,7 +7,7 @@

Do you want to combine these files into your repository?

- + Combine the repositories # The combined repositories will sync and share their files.

diff --git a/templates/configurators/adddrive/encrypt.hamlet b/templates/configurators/adddrive/encrypt.hamlet index 3a9fb0652f..5cc27798d4 100644 --- a/templates/configurators/adddrive/encrypt.hamlet +++ b/templates/configurators/adddrive/encrypt.hamlet @@ -9,12 +9,12 @@ will also prevent you from sharing the repository with friends, or # easily accessing its contents on another computer.

- + Do not encrypt repository # Anyone who has the drive can see the files stored on it. $forall (keyid, name) <- secretkeys

- + Encrypt repository # to @@ -24,7 +24,8 @@ $else #{name}

- + Encrypt repository # with a new encryption key ^{setupDriveModal} +^{genKeyModal} diff --git a/templates/configurators/genkeymodal.hamlet b/templates/configurators/genkeymodal.hamlet new file mode 100644 index 0000000000..71785de7f6 --- /dev/null +++ b/templates/configurators/genkeymodal.hamlet @@ -0,0 +1,12 @@ +

+
+

+ # + Generating a #{maxRecommendedKeySize} bit GnuPg key. +
+

+ Generating a GnuPg key can take a long time. To speed up the process, # + it actually helps to use your computer for other things, which helps # + generate random numbers that keep the GnuPg key secure. +

+ So if this is taking too long, go play a game or something!