@@ -11,7 +11,6 @@ import Control.Monad.IO.Class (liftIO)
1111import Data.Attoparsec.ByteString.Char8 as A
1212import qualified Data.ByteString.Char8 as BC8
1313import Data.Default
14−import Data.List (sort)
1514import Data.Maybe
1615import Data.Monoid
1716import qualified Data.Text as T
@@ -23,6 +22,7 @@ import System.Process (delegate_ctlc, env, proc, readProcess)
2322
2423import Obelisk.App (MonadObelisk)
2524import Obelisk.CLI (Severity (..), callProcessAndLogOutput, failWith, withSpinner)
25+import Obelisk.CLI.Logging
2626import Obelisk.Command.Nix
2727import Obelisk.Command.Thunk
2828import Obelisk.Command.Utils
@@ -46,9 +46,12 @@ deployInit thunkPtr configDir deployDir sshKeyPath hostnames = do
4646 callProcessAndLogOutput (Notice, Error) $
4747 cp [sshKeyPath, localKey]
4848 liftIO $ setPermissions localKey $ setOwnerWritable True $ setOwnerReadable True emptyPermissions
49+ liftIO $ writeFile (deployDir </> "backend_hosts") $ unlines hostnames
50+ forM_ hostnames $ \hostname -> do
51+ putLog Notice $ "Verifying host keys (" <> T.pack hostname <> ")"
52+ verifyHostKey (deployDir </> "backend_known_hosts") localKey hostname
4953 liftIO $ do
5054 createThunk (deployDir </> "src") thunkPtr
51− writeFile (deployDir </> "backend_hosts") $ unlines hostnames
5255 initGit deployDir
5356
5457deployPush :: MonadObelisk m => FilePath -> m ()
@@ -85,7 +88,6 @@ deployPush deployPath = do
8588 deployAndSwitch outputPath sshAgentEnv = do
8689 withSpinner "Adding ssh key" $ do
8790 callProcess' sshAgentEnv "ssh-add" [deployPath </> "ssh_key"]
88− liftIO $ writeFile knownHostsPath . sortLines =<< sshKeyScan backendHosts
8991 withSpinner "Uploading closure" $ do
9092 let nixSshEnv = ("NIX_SSHOPTS", unwords sshOpts) : sshAgentEnv
9193 callProcess' nixSshEnv "nix-copy-closure" ["-v", "--to", "root@" <> host, "--gzip", outputPath]
@@ -127,8 +129,12 @@ sshAgent = do
127129 _ <- A.string ";" >> A.endOfLine <|> void (A.string ";")
128130 return (BC8.unpack key, BC8.unpack val)
129131
130−sshKeyScan :: String -> IO String
131−sshKeyScan hostsPath = readProcess "ssh-keyscan" ["-f", hostsPath] mempty
132−
133−sortLines :: String -> String
134−sortLines = unlines . sort . lines
132+verifyHostKey :: MonadObelisk m => FilePath -> FilePath -> String -> m ()
133+verifyHostKey knownHostsPath keyPath hostName =
134+ callProcessAndLogOutput (Notice, Warning) $ proc "ssh"
135+ [ "-o", "UserKnownHostsFile=" <> knownHostsPath
136+ , "-o", "StrictHostKeyChecking=ask"
137+ , "-i", keyPath
138+ , "root@" <> hostName
139+ , "exit"
140+ ]