Generate invidual key

Handler/YourAccount.hs

@@ -7,6 +7,10 @@ import Data.Conduit.Binary
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
 
+import System.Directory
+import System.Process
+import System.IO
+
 import Handler.Common (passwordConfirmField, updatePassword, isPasswordAcceptable, tooWeakPasswordMessage)
 import Handler.Shared
 
@@ -17,6 +21,8 @@ getYourAccountR = do
 
     enableTriggerToken userId (userTriggerToken user)
 
+    mIndividualKey <- fetchIndividualKey $ userLocalId user
+
     keyS <- runDB $ selectFirst [PublicKeyUser ==. userId] []
     let key = publicKeyPubkey <$> entityVal <$> keyS
     (formWidget, formEnctype) <- generateFormPost (yourAccountForm (userName user) (userLocalId user) key (userAltRepoScheme user) (userIsAnonymous user))
@@ -24,6 +30,34 @@ getYourAccountR = do
         setTitle "Your account"
         $(widgetFile "your-account")
 
+fetchIndividualKey :: Maybe Text -> Handler (Maybe Text)
+fetchIndividualKey Nothing = return Nothing
+fetchIndividualKey (Just localId) = do
+  arenaDir <- arena
+  let individualKeysDir = arenaDir ++ "/individual-keys"
+  liftIO $ createDirectoryIfMissing True individualKeysDir
+
+  let individualKeyPath = (unpack individualKeysDir) ++ "/" ++ (unpack localId)
+  let individualComment = (unpack localId) ++ "@gonito"
+
+  let individualPubKeyPath = individualKeyPath ++ ".pub"
+
+  isKeyGenerated <- liftIO $ doesFileExist individualPubKeyPath
+  if not isKeyGenerated
+   then
+    do
+          _ <- liftIO $ createProcess (proc "/usr/bin/ssh-keygen" ["-t", "RSA", "-f", individualKeyPath, "-N",  "", "-C", individualComment]){
+            std_err = UseHandle stderr,
+            std_out = UseHandle stderr}
+          return ()
+   else
+    return ()
+
+  fhandle <- liftIO $ openFile individualPubKeyPath ReadMode
+  contents <- liftIO $ System.IO.hGetContents fhandle
+
+  return $ Just $ pack contents
+
 postYourAccountR :: Handler Html
 postYourAccountR = do
     ((result, formWidget), formEnctype) <- runFormPost (yourAccountForm Nothing Nothing Nothing Nothing False)
@@ -32,6 +66,8 @@ postYourAccountR = do
 
     enableTriggerToken userId (userTriggerToken user)
 
+    mIndividualKey <- fetchIndividualKey $ userLocalId user
+
     let accountData = case result of
             FormSuccess res -> Just res
             _ -> Nothing

templates/your-account.hamlet

@@ -21,3 +21,6 @@
                <li class="list-group-item">Your token for triggering evaluation is <code>#{token}</code>
             $nothing
                <li class="list-group-item">Your token for triggering evaluation is not set yet, ask the administrator to do this
+        $maybe individualKey <- mIndividualKey
+          <p>If you'd like to give Gonito access to your repo other than hosted at Gonito used the following public key:
+          <pre>#{individualKey}