diff --git a/agent/config/settings.yml b/agent/config/settings.yml index e86956673..1af22f3de 100644 --- a/agent/config/settings.yml +++ b/agent/config/settings.yml @@ -34,6 +34,6 @@ database: database: "start9_agent.sqlite3" poolsize: "_env:YESOD_SQLITE_POOLSIZE:10" -app-mgr-version-spec: "=0.2.5" +app-mgr-version-spec: "=0.2.6" #analytics: UA-YOURCODE diff --git a/agent/migrations/0.2.5::0.2.6 b/agent/migrations/0.2.5::0.2.6 new file mode 100644 index 000000000..b928005e2 --- /dev/null +++ b/agent/migrations/0.2.5::0.2.6 @@ -0,0 +1 @@ +SELECT TRUE; \ No newline at end of file diff --git a/agent/package.yaml b/agent/package.yaml index 5d4df9213..ee7c00ab2 100644 --- a/agent/package.yaml +++ b/agent/package.yaml @@ -1,5 +1,5 @@ name: ambassador-agent -version: 0.2.5 +version: 0.2.6 default-extensions: - NoImplicitPrelude diff --git a/agent/src/Application.hs b/agent/src/Application.hs index 1be93162b..e13488b46 100644 --- a/agent/src/Application.hs +++ b/agent/src/Application.hs @@ -19,6 +19,7 @@ module Application , handler , runDb , getAgentCtx + , sleep ) where @@ -65,6 +66,7 @@ import Lib.WebServer import Model import Settings import Lib.Background +import qualified Daemon.SslRenew as SSLRenew appMain :: IO () appMain = do @@ -81,10 +83,10 @@ appMain = do die . toS $ "Invalid Port: " <> n ["--git-hash"] -> do putStrLn @Text $embedGitRevision - exitWith ExitSuccess + exitSuccess ["--version"] -> do putStrLn @Text (show agentVersion) - exitWith ExitSuccess + exitSuccess _ -> pure settings createDirectoryIfMissing False (toS $ agentDataDirectory `relativeTo` appFilesystemBase settings') @@ -187,6 +189,10 @@ startupSequence foundation = do void . forkIO . forever $ forkIO (runReaderT AppNotifications.fetchAndSave foundation) >> threadDelay 5_000_000 withAgentVersionLog_ "App notifications refreshing" + withAgentVersionLog_ "Initializing SSL certificate renewal loop" + void . forkIO . forever $ forkIO (SSLRenew.renewSslLeafCert foundation) *> sleep 86_400 + withAgentVersionLog_ "SSL Renewal daemon started" + -- reloading avahi daemon -- DRAGONS! make sure this step happens AFTER system synchronization withAgentVersionLog_ "Publishing Agent to Avahi Daemon" @@ -199,6 +205,10 @@ startupSequence foundation = do withAgentVersionLog_ "Listening for Self-Update Signal" waitForUpdateSignal foundation +sleep :: Integer -> IO () +sleep n = let (full, r) = (n * 1_000_000) `divMod` (fromIntegral $ (maxBound :: Int)) in + replicateM_ (fromIntegral full) (threadDelay maxBound) *> threadDelay (fromIntegral r) + -------------------------------------------------------------- -- Functions for DevelMain.hs (a way to run the AgentCtx from GHCi) -------------------------------------------------------------- diff --git a/agent/src/Daemon/SslRenew.hs b/agent/src/Daemon/SslRenew.hs new file mode 100644 index 000000000..a0b47c97a --- /dev/null +++ b/agent/src/Daemon/SslRenew.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE QuasiQuotes #-} +module Daemon.SslRenew where + +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 Control.Carrier.Lift +import System.Directory ( renameDirectory + , removeDirectory + ) +import Lib.SystemCtl +import qualified Lib.Notifications as Notifications +import Database.Persist.Sql ( runSqlPool ) +import Lib.Types.Core +import Constants + +renewSslLeafCert :: AgentCtx -> IO () +renewSslLeafCert ctx = do + let base = appFilesystemBase . appSettings $ ctx + hn <- injectFilesystemBase base getStart9AgentHostname + tor <- injectFilesystemBase base getAgentHiddenServiceUrl + putStr @Text "SSL Renewal Required? " + needsRenew <- doesSslNeedRenew (toS $ entityCertPath hn `relativeTo` base) + print needsRenew + when needsRenew $ runM . injectFilesystemBase base $ do + intCaKeyPath <- toS <$> getAbsoluteLocationFor intermediateCaKeyPath + intCaConfPath <- toS <$> getAbsoluteLocationFor intermediateCaOpenSslConfPath + intCaCertPath <- toS <$> getAbsoluteLocationFor intermediateCaCertPath + + sslDirTmp <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> sslDirectory) + entKeyPathTmp <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> entityKeyPath hn) + entConfPathTmp <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> entityConfPath hn) + entCertPathTmp <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> entityCertPath hn) + + (ec, out, err) <- writeLeafCert + DeriveCertificate { applicantConfPath = entConfPathTmp + , applicantKeyPath = entKeyPathTmp + , applicantCertPath = entCertPathTmp + , signingConfPath = intCaConfPath + , signingKeyPath = intCaKeyPath + , signingCertPath = intCaCertPath + , duration = 365 + } + hn + tor + liftIO $ do + putStrLn @Text "openssl logs" + putStrLn @Text "exit code: " + print ec + 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 $ removeDirectory sslDir + liftIO $ renameDirectory sslDirTmp sslDir + liftIO $ systemCtl RestartService "nginx" $> () + + +doesSslNeedRenew :: FilePath -> IO Bool +doesSslNeedRenew cert = do + ec <- liftIO $ system [i|openssl x509 -checkend 2592000 -noout -in #{cert}|] + pure $ ec /= ExitSuccess diff --git a/agent/src/Handler/Register.hs b/agent/src/Handler/Register.hs index a6a2c24a5..734d821dd 100644 --- a/agent/src/Handler/Register.hs +++ b/agent/src/Handler/Register.hs @@ -1,4 +1,5 @@ {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} module Handler.Register where @@ -55,7 +56,7 @@ postRegisterR = handleS9ErrT $ do -- install new ssl CA cert + nginx conf and restart nginx registerResCert <- - runM . handleS9ErrC . (>>= liftEither) . liftIO . runM . injectFilesystemBaseFromContext settings $ do + runM . handleS9ErrC . liftEither <=< liftIO . runM . injectFilesystemBaseFromContext settings $ do bootupHttpNginx runError @S9Error $ bootupSslNginx rsaKeyFileContents diff --git a/agent/src/Handler/Register/Nginx.hs b/agent/src/Handler/Register/Nginx.hs index 59b4da6bc..bc42bba91 100644 --- a/agent/src/Handler/Register/Nginx.hs +++ b/agent/src/Handler/Register/Nginx.hs @@ -5,6 +5,7 @@ module Handler.Register.Nginx where import Startlude hiding ( ask , catchError + , err ) import Control.Carrier.Error.Church @@ -21,6 +22,7 @@ import Lib.Synchronizers import Lib.SystemPaths import Lib.Tor import System.Posix ( removeLink ) +import Lib.SystemCtl -- Left error, Right CA cert for hmac signing bootupSslNginx :: (HasFilesystemBase sig m, Has (Error S9Error) sig m, Has (Lift IO) sig m, MonadIO m) @@ -54,13 +56,13 @@ resetSslState = do traverse_ (liftIO . removePathForcibly . toS . flip relativeTo base) [ rootCaKeyPath - , relBase $ (rootCaCertPath `relativeTo` "/") <> ".csr" + , relBase $ (rootCaCertPath `relativeTo` base) <> ".csr" , rootCaCertPath , intermediateCaKeyPath - , relBase $ (intermediateCaCertPath `relativeTo` "/") <> ".csr" + , relBase $ (intermediateCaCertPath `relativeTo` base) <> ".csr" , intermediateCaCertPath , entityKeyPath host - , relBase $ (entityCertPath host `relativeTo` "/") <> ".csr" + , relBase $ (entityCertPath host `relativeTo` base) <> ".csr" , entityCertPath host , entityConfPath host , nginxSitesAvailable nginxSslConf @@ -74,10 +76,9 @@ resetSslState = do >>= traverse_ removePathForcibly writeFile (toS $ flip relativeTo base $ rootCaDirectory <> "/index.txt") "" writeFile (toS $ flip relativeTo base $ intermediateCaDirectory <> "/index.txt") "" - _ <- liftIO $ try @SomeException . removeLink . toS $ (nginxSitesEnabled nginxSslConf) `relativeTo` base + _ <- liftIO $ try @SomeException . removeLink . toS $ nginxSitesEnabled nginxSslConf `relativeTo` base pure () - bootupHttpNginx :: (HasFilesystemBase sig m, MonadIO m) => m () bootupHttpNginx = installAmbassadorUiNginxHTTP "start9-ambassador.conf" @@ -156,3 +157,73 @@ writeSslKeyAndCert rsaKeyFileContents = do ExitFailure ec -> throwError $ OpenSslE "leaf" ec str1' str2' readSystemPath' rootCaCertPath + +replaceDerivativeCerts :: (HasFilesystemBase sig m, Has (Error S9Error) sig m, MonadIO m) => m () +replaceDerivativeCerts = do + hn <- getStart9AgentHostname + tor <- getAgentHiddenServiceUrl + + caKeyPath <- toS <$> getAbsoluteLocationFor rootCaKeyPath + caConfPath <- toS <$> getAbsoluteLocationFor rootCaOpenSslConfPath + caCertPath <- toS <$> getAbsoluteLocationFor rootCaCertPath + + intCaKeyPath <- toS <$> getAbsoluteLocationFor intermediateCaKeyPath + intCaConfPath <- toS <$> getAbsoluteLocationFor intermediateCaOpenSslConfPath + intCaCertPath <- toS <$> getAbsoluteLocationFor intermediateCaCertPath + + sslDirTmp <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> sslDirectory) + entKeyPathTmp <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> entityKeyPath hn) + entConfPathTmp <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> entityConfPath hn) + entCertPathTmp <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> entityCertPath hn) + liftIO $ createDirectoryIfMissing True sslDirTmp + liftIO $ BS.writeFile entConfPathTmp (domain_CSR_CONF hn) + + -- ensure duplicate certificates are acceptable + base <- Fused.ask @"filesystemBase" + liftIO $ BS.writeFile (toS $ (rootCaDirectory <> "index.txt.attr") `relativeTo` base) "unique_subject = no\n" + liftIO $ BS.writeFile (toS $ (intermediateCaDirectory <> "index.txt.attr") `relativeTo` base) + "unique_subject = no\n" + + (ec, out, err) <- writeIntermediateCert DeriveCertificate { applicantConfPath = intCaConfPath + , applicantKeyPath = intCaKeyPath + , applicantCertPath = intCaCertPath + , signingConfPath = caConfPath + , signingKeyPath = caKeyPath + , signingCertPath = caCertPath + , duration = 3650 + } + liftIO $ do + putStrLn @Text "openssl logs" + putStrLn @Text "exit code: " + print ec + putStrLn @String $ "stdout: " <> out + putStrLn @String $ "stderr: " <> err + case ec of + ExitSuccess -> pure () + ExitFailure n -> throwError $ OpenSslE "leaf" n out err + + (ec', out', err') <- writeLeafCert + DeriveCertificate { applicantConfPath = entConfPathTmp + , applicantKeyPath = entKeyPathTmp + , applicantCertPath = entCertPathTmp + , signingConfPath = intCaConfPath + , signingKeyPath = intCaKeyPath + , signingCertPath = intCaCertPath + , duration = 365 + } + hn + tor + liftIO $ do + putStrLn @Text "openssl logs" + putStrLn @Text "exit code: " + print ec + putStrLn @String $ "stdout: " <> out' + putStrLn @String $ "stderr: " <> err' + case ec' of + ExitSuccess -> pure () + ExitFailure n -> throwError $ OpenSslE "leaf" n out' err' + + sslDir <- toS <$> getAbsoluteLocationFor sslDirectory + liftIO $ removeDirectory sslDir + liftIO $ renameDirectory sslDirTmp sslDir + liftIO $ systemCtl RestartService "nginx" $> () diff --git a/agent/src/Lib/Notifications.hs b/agent/src/Lib/Notifications.hs index 7e826e1cd..8da2e63ee 100644 --- a/agent/src/Lib/Notifications.hs +++ b/agent/src/Lib/Notifications.hs @@ -19,8 +19,8 @@ emit :: MonadIO m => AppId -> Version -> AgentNotification -> SqlPersistT m (Ent emit appId version ty = do uuid <- liftIO nextRandom now <- liftIO getCurrentTime - let k = (NotificationKey uuid) - let v = (Notification now Nothing appId version (toCode ty) (toTitle ty) (toMessage appId version ty)) + let k = NotificationKey uuid + let v = Notification now Nothing appId version (toCode ty) (toTitle ty) (toMessage appId version ty) insertKey k v putStrLn $ toMessage appId version ty pure $ Entity k v @@ -42,6 +42,7 @@ data AgentNotification = | RestoreFailed S9Error | RestartFailed S9Error | DockerFuckening + | CertRenewFailed ExitCode String String -- CODES -- RULES: @@ -54,6 +55,7 @@ data AgentNotification = -- The second digit indicates where the error was originated from as follows -- 0: Originates from Agent -- 1: Originates from App (Not presently used) +-- 2: Originates from Agent ABOUT THE AGENT -- -- The remaining section of the code may be as long as you want but must be at least one digit -- EXAMPLES: @@ -78,6 +80,7 @@ toCode (InstallFailedS9Error _) = "303" toCode (BackupFailed _) = "304" toCode (RestoreFailed _) = "305" toCode (RestartFailed _) = "306" +toCode CertRenewFailed{} = "320" toTitle :: AgentNotification -> Text toTitle InstallSuccess = "Install succeeded" @@ -90,6 +93,7 @@ toTitle (BackupFailed _) = "Backup failed" toTitle (RestoreFailed _) = "Restore failed" toTitle (RestartFailed _) = "Restart failed" toTitle DockerFuckening = "App unstoppable" +toTitle CertRenewFailed{} = "Embassy Certificate Renewal Failed" toMessage :: AppId -> Version -> AgentNotification -> Text toMessage appId version InstallSuccess = [i|Successfully installed #{appId} at version #{version}|] @@ -107,3 +111,10 @@ toMessage appId _version (BackupFailed reason) = [i|Failed to back up #{appId}: toMessage appId _version (RestoreFailed reason) = [i|Failed to restore #{appId}: #{errorMessage $ toError reason}|] toMessage appId _version (RestartFailed reason) = [i|Failed to restart #{appId}: #{errorMessage $ toError reason}. Please manually restart|] +toMessage _ version (CertRenewFailed ec o e) = [i|Failed to renew SSL Certificates for EmbassyOS (#{version}) +ExitCode: #{ec} +Stdout: +#{o} +Stderr: +#{e} +|] diff --git a/agent/src/Lib/Ssl.hs b/agent/src/Lib/Ssl.hs index 37dea7a5d..2bec299e6 100644 --- a/agent/src/Lib/Ssl.hs +++ b/agent/src/Lib/Ssl.hs @@ -1,6 +1,17 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE QuasiQuotes #-} -module Lib.Ssl where +module Lib.Ssl + ( DeriveCertificate(..) + , root_CA_CERT_NAME + , writeRootCaCert + , writeIntermediateCert + , domain_CSR_CONF + , writeLeafCert + , root_CA_OPENSSL_CONF + , intermediate_CA_OPENSSL_CONF + , segment + ) +where import Startlude @@ -295,7 +306,7 @@ data DeriveCertificate = DeriveCertificate writeIntermediateCert :: MonadIO m => DeriveCertificate -> m (ExitCode, String, String) writeIntermediateCert DeriveCertificate {..} = liftIO $ interpret $ do -- openssl genrsa -out dump/int.key 4096 - segment $ openssl [i|genrsa -out #{applicantKeyPath} 4096|] + segment $ openssl [i|ecparam -genkey -name prime256v1 -noout -out #{applicantKeyPath}|] -- openssl req -new -config dump/int-csr.conf -key dump/int.key -nodes -out dump/int.csr segment $ openssl [i|req -new -config #{applicantConfPath} @@ -317,7 +328,7 @@ writeIntermediateCert DeriveCertificate {..} = liftIO $ interpret $ do writeLeafCert :: MonadIO m => DeriveCertificate -> Text -> Text -> m (ExitCode, String, String) writeLeafCert DeriveCertificate {..} hostname torAddress = liftIO $ interpret $ do - segment $ openssl [i|genrsa -out #{applicantKeyPath} 4096|] + segment $ openssl [i|ecparam -genkey -name prime256v1 -noout -out #{applicantKeyPath}|] segment $ openssl [i|req -config #{applicantConfPath} -key #{applicantKeyPath} -new @@ -336,11 +347,11 @@ writeLeafCert DeriveCertificate {..} hostname torAddress = liftIO $ interpret $ |] liftIO $ readFile signingCertPath >>= appendFile applicantCertPath -openssl :: Text -> IO (ExitCode, String, String) -openssl = ($ "") . readProcessWithExitCode "openssl" . fmap toS . words +openssl :: MonadIO m => Text -> m (ExitCode, String, String) +openssl = liftIO . ($ "") . readProcessWithExitCode "openssl" . fmap toS . words {-# INLINE openssl #-} -interpret :: ExceptT ExitCode (StateT (String, String) IO) () -> IO (ExitCode, String, String) +interpret :: MonadIO m => ExceptT ExitCode (StateT (String, String) m) () -> m (ExitCode, String, String) interpret = fmap (over _1 (either id (const ExitSuccess)) . regroup) . flip runStateT ("", "") . runExceptT {-# INLINE interpret #-} @@ -348,8 +359,8 @@ regroup :: (a, (b, c)) -> (a, b, c) regroup (a, (b, c)) = (a, b, c) {-# INLINE regroup #-} -segment :: IO (ExitCode, String, String) -> ExceptT ExitCode (StateT (String, String) IO) () -segment action = liftIO action >>= \case +segment :: MonadIO m => m (ExitCode, String, String) -> ExceptT ExitCode (StateT (String, String) m) () +segment action = (lift . lift) action >>= \case (ExitSuccess, o, e) -> modify (bimap (<> o) (<> e)) (ec , o, e) -> modify (bimap (<> o) (<> e)) *> throwE ec {-# INLINE segment #-} diff --git a/agent/src/Lib/Synchronizers.hs b/agent/src/Lib/Synchronizers.hs index ae60630a2..7dfb6dbe0 100644 --- a/agent/src/Lib/Synchronizers.hs +++ b/agent/src/Lib/Synchronizers.hs @@ -61,6 +61,8 @@ import Settings import Util.File import qualified Lib.Algebra.Domain.AppMgr as AppMgr2 import Daemon.ZeroConf ( getStart9AgentHostname ) +import qualified Data.Text as T +import Handler.Register.Nginx ( replaceDerivativeCerts ) data Synchronizer = Synchronizer @@ -87,16 +89,16 @@ parseKernelVersion = do major' <- decimal minor' <- char '.' *> decimal patch' <- char '.' *> decimal - arch <- string "-v7l+" *> pure ArmV7 <|> string "-v8+" *> pure ArmV8 + arch <- string "-v7l+" $> ArmV7 <|> string "-v8+" $> ArmV8 pure $ KernelVersion (Version (major', minor', patch', 0)) arch synchronizer :: Synchronizer -synchronizer = sync_0_2_5 +synchronizer = sync_0_2_6 {-# INLINE synchronizer #-} -sync_0_2_5 :: Synchronizer -sync_0_2_5 = Synchronizer - "0.2.5" +sync_0_2_6 :: Synchronizer +sync_0_2_6 = Synchronizer + "0.2.6" [ syncCreateAgentTmp , syncCreateSshDir , syncRemoveAvahiSystemdDependency @@ -141,7 +143,7 @@ syncCreateSshDir = SyncOp "Create SSH directory" check migrate False syncRemoveAvahiSystemdDependency :: SyncOp syncRemoveAvahiSystemdDependency = SyncOp "Remove Avahi Systemd Dependency" check migrate False where - wanted = decodeUtf8 $ $(embedFile "config/agent.service") + wanted = decodeUtf8 $(embedFile "config/agent.service") check = do base <- asks $ appFilesystemBase . appSettings content <- liftIO $ readFile (toS $ agentServicePath `relativeTo` base) @@ -172,7 +174,7 @@ sync32BitKernel = SyncOp "32 Bit Kernel Switch" check migrate True check = do settings <- asks appSettings cfg <- injectFilesystemBaseFromContext settings getBootCfgPath - liftIO . run $ fmap isNothing $ (shell [i|grep "arm_64bit=0" #{cfg} || true|] $| conduit await) + liftIO . run $ isNothing <$> (shell [i|grep "arm_64bit=0" #{cfg} || true|] $| conduit await) migrate = do base <- asks $ appFilesystemBase . appSettings let tmpFile = bootConfigTempPath `relativeTo` base @@ -234,9 +236,9 @@ syncWriteConf name contents' confLocation = SyncOp [i|Write #{name} Conf|] check liftIO $ (Just <$> readFile (toS $ confLocation `relativeTo` base)) `catch` (\(e :: IOException) -> if isDoesNotExistError e then pure Nothing else throwIO e) - case conf of - Nothing -> pure True - Just co -> pure $ if co == contents then False else True + pure $ case conf of + Nothing -> True + Just co -> co /= contents migrate = do base <- asks $ appFilesystemBase . appSettings void . liftIO $ createDirectoryIfMissing True (takeDirectory (toS $ confLocation `relativeTo` base)) @@ -330,7 +332,7 @@ syncInstallAmbassadorUI = SyncOp "Install Ambassador UI" check migrate False streamUntar root stream = Conduit.runConduit $ Conduit.fromBStream stream .| Conduit.untar \f -> do let path = toS . (toS root ) . joinPath . drop 1 . splitPath . B8.unpack . Conduit.filePath $ f print path - if (Conduit.fileType f == Conduit.FTDirectory) + if Conduit.fileType f == Conduit.FTDirectory then liftIO $ createDirectoryIfMissing True path else Conduit.sinkFile path @@ -372,8 +374,8 @@ installAmbassadorUiNginx mSslOverrides fileName = do void . liftIO $ systemCtl RestartService "nginx" where ambassadorUiClientManifiest b = toS $ (ambassadorUiPath <> "/client-manifest.yaml") `relativeTo` b - nginxAvailableConf b = toS $ (nginxSitesAvailable fileName) `relativeTo` b - nginxEnabledConf b = toS $ (nginxSitesEnabled fileName) `relativeTo` b + nginxAvailableConf b = toS $ nginxSitesAvailable fileName `relativeTo` b + nginxEnabledConf b = toS $ nginxSitesEnabled fileName `relativeTo` b syncOpenHttpPorts :: SyncOp syncOpenHttpPorts = SyncOp "Open Hidden Service Port 80" check migrate False @@ -426,6 +428,30 @@ syncPersistLogs :: SyncOp syncPersistLogs = (syncWriteConf "Journald" $(embedFile "config/journald.conf") journaldConfig) { syncOpRequiresReboot = True } +syncRepairSsl :: SyncOp +syncRepairSsl = SyncOp "Repair SSL Certs" check migrate False + where + check = do + base <- asks $ appFilesystemBase . appSettings + let p = toS $ sslDirectory `relativeTo` base + liftIO $ not <$> doesDirectoryExist p + migrate = do + base <- asks $ appFilesystemBase . appSettings + let newCerts = toS $ (agentTmpDirectory <> sslDirectory) `relativeTo` base + liftIO $ renameDirectory newCerts (toS $ sslDirectory `relativeTo` base) + liftIO $ systemCtl RestartService "nginx" $> () + +syncConvertEcdsaCerts :: SyncOp +syncConvertEcdsaCerts = SyncOp "Convert Intermediate Cert to ECDSA P256" check migrate False + where + check = do + fs <- asks $ appFilesystemBase . appSettings + header <- liftIO $ headMay . lines <$> readFile (toS $ intermediateCaKeyPath `relativeTo` fs) + pure $ case header of + Nothing -> False + Just y -> "BEGIN RSA PRIVATE KEY" `T.isInfixOf` y + migrate = replaceDerivativeCerts + failUpdate :: S9Error -> ExceptT Void (ReaderT AgentCtx IO) () failUpdate e = do ref <- asks appIsUpdateFailed diff --git a/agent/src/Lib/SystemPaths.hs b/agent/src/Lib/SystemPaths.hs index d63da47ee..bbb4abb71 100644 --- a/agent/src/Lib/SystemPaths.hs +++ b/agent/src/Lib/SystemPaths.hs @@ -76,18 +76,15 @@ getAbsoluteLocationFor path = do readSystemPath :: (HasFilesystemBase sig m, MonadIO m) => SystemPath -> m (Maybe Text) readSystemPath path = do loadPath <- getAbsoluteLocationFor path - contents <- - liftIO + liftIO $ (Just <$> readFile (toS loadPath)) `catch` (\(e :: IOException) -> if isDoesNotExistError e then pure Nothing else throwIO e) - pure contents -- like the above, but throws IO error if file not found readSystemPath' :: (HasFilesystemBase sig m, MonadIO m) => SystemPath -> m Text readSystemPath' path = do loadPath <- getAbsoluteLocationFor path - contents <- liftIO . readFile . toS $ loadPath - pure contents + liftIO . readFile . toS $ loadPath writeSystemPath :: (HasFilesystemBase sig m, MonadIO m) => SystemPath -> Text -> m () writeSystemPath path contents = do