@@ -22,6 +22,7 @@ import System.Process (delegate_ctlc, env, proc, readProcess)
23import Obelisk.App (MonadObelisk)
23import Obelisk.App (MonadObelisk)
24import Obelisk.CLI (Severity (..), callProcessAndLogOutput, failWith, withSpinner)
24import Obelisk.CLI (Severity (..), callProcessAndLogOutput, failWith, withSpinner)
25+import Obelisk.CLI.Logging
25import Obelisk.Command.Nix
26import Obelisk.Command.Nix
26import Obelisk.Command.Thunk
27import Obelisk.Command.Thunk
27import Obelisk.Command.Utils
28import Obelisk.Command.Utils
@@ -45,14 +46,18 @@ deployInit thunkPtr configDir deployDir sshKeyPath hostnames = do
45 callProcessAndLogOutput (Notice, Error) $
46 callProcessAndLogOutput (Notice, Error) $
46 cp [sshKeyPath, localKey]
47 cp [sshKeyPath, localKey]
47 liftIO $ setPermissions localKey $ setOwnerWritable True $ setOwnerReadable True emptyPermissions
48 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
48 liftIO $ do
53 liftIO $ do
49 createThunk (deployDir </> "src") thunkPtr
54 createThunk (deployDir </> "src") thunkPtr
50− writeFile (deployDir </> "backend_hosts") $ unlines hostnames
51 initGit deployDir
55 initGit deployDir
53deployPush :: MonadObelisk m => FilePath -> m ()
57deployPush :: MonadObelisk m => FilePath -> m ()
54deployPush deployPath = do
58deployPush deployPath = do
59+ let backendHosts = deployPath </> "backend_hosts"
55− host <- liftIO $ fmap (T.unpack . T.strip) $ T.readFile $ deployPath </> "backend_hosts"
60+ host <- liftIO $ fmap (T.unpack . T.strip) $ T.readFile backendHosts
56 let srcPath = deployPath </> "src"
61 let srcPath = deployPath </> "src"
57 build = do
62 build = do
58 buildOutput <- nixBuild $ def
63 buildOutput <- nixBuild $ def
@@ -78,13 +83,16 @@ deployPush deployPath = do
78 return Nothing
83 return Nothing
79 _ -> return Nothing
84 _ -> return Nothing
80 forM_ result $ \res -> do
85 forM_ result $ \res -> do
86+ let knownHostsPath = deployPath </> "backend_known_hosts"
87+ sshOpts = ["-o", "UserKnownHostsFile=" <> knownHostsPath, "-o", "StrictHostKeyChecking=yes"]
81− let deployAndSwitch outputPath sshAgentEnv = do
88+ deployAndSwitch outputPath sshAgentEnv = do
82 withSpinner "Adding ssh key" $ do
89 withSpinner "Adding ssh key" $ do
83 callProcess' sshAgentEnv "ssh-add" [deployPath </> "ssh_key"]
90 callProcess' sshAgentEnv "ssh-add" [deployPath </> "ssh_key"]
84 withSpinner "Uploading closure" $ do
91 withSpinner "Uploading closure" $ do
92+ let nixSshEnv = ("NIX_SSHOPTS", unwords sshOpts) : sshAgentEnv
85− callProcess' sshAgentEnv "nix-copy-closure" ["-v", "--to", "root@" <> host, "--gzip", outputPath]
93+ callProcess' nixSshEnv "nix-copy-closure" ["-v", "--to", "root@" <> host, "--gzip", outputPath]
86 withSpinner "Switching to new configuration" $ do
94 withSpinner "Switching to new configuration" $ do
87− callProcess' sshAgentEnv "ssh"
95+ callProcess' sshAgentEnv "ssh" $ sshOpts <>
88 [ "root@" <> host
96 [ "root@" <> host
90 [ "nix-env -p /nix/var/nix/profiles/system --set " <> outputPath
98 [ "nix-env -p /nix/var/nix/profiles/system --set " <> outputPath
@@ -121,3 +129,12 @@ sshAgent = do
121 _ <- A.string ";" >> A.endOfLine <|> void (A.string ";")
129 _ <- A.string ";" >> A.endOfLine <|> void (A.string ";")
122 return (BC8.unpack key, BC8.unpack val)
130 return (BC8.unpack key, BC8.unpack val)
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"
138+ , "root@" <> hostName