Integration/0.2.17 (#789)

* self-repair and prevention of ssl cert renewal bug

* bump to 0.2.17

* adjust ui for 0.2.17

* adds db migration

* add extra protection around ssl directory target

* liftIO

agent/ambassador-agent.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           ambassador-agent
-version:        0.2.16
+version:        0.2.17
 build-type:     Simple
 extra-source-files:
     ./migrations/0.1.0::0.1.0
@@ -22,6 +22,7 @@ extra-source-files:
     ./migrations/0.2.13::0.2.14
     ./migrations/0.2.14::0.2.15
     ./migrations/0.2.15::0.2.16
+    ./migrations/0.2.16::0.2.17
     ./migrations/0.2.1::0.2.2
     ./migrations/0.2.2::0.2.3
     ./migrations/0.2.3::0.2.4

agent/migrations/0.2.16::0.2.17

@@ -0,0 +1 @@
+SELECT TRUE;

agent/package.yaml

@@ -1,5 +1,5 @@
 name: ambassador-agent
-version: 0.2.16
+version: 0.2.17
 
 default-extensions:
   - NoImplicitPrelude

agent/src/Daemon/SslRenew.hs

@@ -6,22 +6,30 @@ import           Startlude               hiding ( err )
 import           Data.String.Interpolate        ( i )
 import           System.Process                 ( system )
 
-import           Foundation
-import           Lib.SystemPaths
-import           Settings
-import           Lib.Ssl
-import           Daemon.ZeroConf                ( getStart9AgentHostname )
-import           Lib.Tor
+import           Constants
 import           Control.Carrier.Lift
-import           System.Directory               ( doesPathExist
+import           Daemon.ZeroConf                ( getStart9AgentHostname )
+import qualified Data.ByteString               as BS
+import           Database.Persist.Sql           ( Filter
+                                                , SqlPersistT
+                                                , count
+                                                , runSqlPool
+                                                )
+import           Foundation
+import qualified Lib.Notifications             as Notifications
+import           Lib.Ssl
+import           Lib.SystemCtl
+import           Lib.SystemPaths
+import           Lib.Tor
+import           Lib.Types.Core
+import           Model
+import           Settings
+import           System.Directory               ( createDirectoryIfMissing
+                                                , doesPathExist
                                                 , removePathForcibly
                                                 , renameDirectory
                                                 )
-import           Lib.SystemCtl
-import qualified Lib.Notifications             as Notifications
-import           Database.Persist.Sql           ( runSqlPool )
-import           Lib.Types.Core
-import           Constants
+import           System.FilePath                ( takeDirectory )
 
 renewSslLeafCert :: AgentCtx -> IO ()
 renewSslLeafCert ctx = do
@@ -30,7 +38,7 @@ renewSslLeafCert ctx = do
     let hostname = sid <> ".local"
     tor <- injectFilesystemBase base getAgentHiddenServiceUrl
     putStr @Text "SSL Renewal Required? "
-    needsRenew <- doesSslNeedRenew (toS $ entityCertPath sid `relativeTo` base)
+    needsRenew <- flip runSqlPool (appConnPool ctx) $ doesSslNeedRenew (toS $ entityCertPath sid `relativeTo` base)
     print needsRenew
     when needsRenew $ runM . injectFilesystemBase base $ do
         intCaKeyPath   <- toS <$> getAbsoluteLocationFor intermediateCaKeyPath
@@ -42,6 +50,9 @@ renewSslLeafCert ctx = do
         entConfPathTmp <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> entityConfPath sid)
         entCertPathTmp <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> entityCertPath sid)
 
+        liftIO $ createDirectoryIfMissing True sslDirTmp
+        liftIO $ BS.writeFile entConfPathTmp (domain_CSR_CONF hostname)
+
         (ec, out, err) <- writeLeafCert
             DeriveCertificate { applicantConfPath = entConfPathTmp
                               , applicantKeyPath  = entKeyPathTmp
@@ -60,24 +71,28 @@ renewSslLeafCert ctx = do
             putStrLn @String $ "stdout: " <> out
             putStrLn @String $ "stderr: " <> err
         case ec of
-            ExitSuccess -> pure ()
             ExitFailure n ->
                 liftIO
                     . void
                     $ flip runSqlPool (appConnPool ctx)
                     $ Notifications.emit (AppId "EmbassyOS") agentVersion
                     $ Notifications.CertRenewFailed (ExitFailure n) out err
-        let sslDir = toS $ sslDirectory `relativeTo` base
-        liftIO $ removePathForcibly sslDir
-        liftIO $ renameDirectory sslDirTmp sslDir
-        liftIO $ systemCtl RestartService "nginx" $> ()
+            ExitSuccess -> liftIO $ do
+                let sslDir = toS $ sslDirectory `relativeTo` base
+                createDirectoryIfMissing True (takeDirectory sslDir)
+                removePathForcibly sslDir
+                renameDirectory sslDirTmp sslDir
+                systemCtl RestartService "nginx" $> ()
 
 
-doesSslNeedRenew :: FilePath -> IO Bool
+doesSslNeedRenew :: FilePath -> SqlPersistT IO Bool
 doesSslNeedRenew cert = do
-    exists <- doesPathExist cert
+    exists <- liftIO $ doesPathExist cert
     if exists
         then do
             ec <- liftIO $ system [i|openssl x509 -checkend 2592000 -noout -in #{cert}|]
             pure $ ec /= ExitSuccess
-        else pure False
+        else do
+            -- if we have set up the embassy already, then this is bad state that needs to be repaired
+            n <- count ([] :: [Filter Account])
+            pure $ n >= 1

agent/src/Lib/Ssl.hs

@@ -10,8 +10,7 @@ module Lib.Ssl
     , root_CA_OPENSSL_CONF
     , intermediate_CA_OPENSSL_CONF
     , segment
-    )
-where
+    ) where
 
 import           Startlude
 

agent/src/Lib/Synchronizers.hs

@@ -102,12 +102,12 @@ parseKernelVersion = do
     pure $ KernelVersion (Version (major', minor', patch', 0)) arch
 
 synchronizer :: Synchronizer
-synchronizer = sync_0_2_16
+synchronizer = sync_0_2_17
 {-# INLINE synchronizer #-}
 
-sync_0_2_16 :: Synchronizer
-sync_0_2_16 = Synchronizer
-    "0.2.16"
+sync_0_2_17 :: Synchronizer
+sync_0_2_17 = Synchronizer
+    "0.2.17"
     [ syncCreateAgentTmp
     , syncCreateSshDir
     , syncRemoveAvahiSystemdDependency