Start9/start-os
2
0
Fork 0
mirror of https://github.com/Start9Labs/start-os.git synced 2026-03-26 02:11:53 +00:00
Code Issues Packages Projects Releases Wiki Activity

fixes ssl renewal, replaces rsa with ecdsa for derivative certs

Browse Source
This commit is contained in:
Keagan McClelland
2020-11-30 17:44:18 -07:00
parent 02552eb278
commit f1208f281c
7 changed files with 223 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
agent/src/Application.hs
View File

@@ -65,6 +65,7 @@ import Lib.WebServer
import Model
import Settings
import Lib.Background
import qualified Daemon.SslRenew as SSLRenew
appMain :: IO ()
appMain = do
@@ -187,6 +188,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
withAgentVersionLog_ "SSL Renewal daemon started"
-- reloading avahi daemon
-- DRAGONS! make sure this step happens AFTER system synchronization
withAgentVersionLog_ "Publishing Agent to Avahi Daemon"

77
agent/src/Daemon/SslRenew.hs Normal file
View File

@@ -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

79
agent/src/Handler/Register/Nginx.hs
View File

@@ -5,6 +5,7 @@ module Handler.Register.Nginx where
import Startlude hiding ( ask
, catchError
, err
)
import Control.Carrier.Error.Church
@@ -23,6 +24,7 @@ import Lib.Tor
import System.Posix ( removeLink )
import Data.String.Interpolate.IsString
( i )
import Lib.SystemCtl
time :: MonadIO m => Text -> StateT UTCTime m ()
time t = do
@@ -67,13 +69,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
@@ -90,7 +92,6 @@ resetSslState = do
_ <- liftIO $ try @SomeException . removeLink . toS $ nginxSitesEnabled nginxSslConf `relativeTo` base
pure ()
bootupHttpNginx :: (HasFilesystemBase sig m, MonadIO m) => m ()
bootupHttpNginx = installAmbassadorUiNginxHTTP "start9-ambassador.conf"
@@ -172,3 +173,73 @@ writeSslKeyAndCert rsaKeyFileContents = fromSys $ 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" $> ()

15
agent/src/Lib/Notifications.hs
View File

@@ -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}
|]

1
agent/src/Lib/Ssl.hs
View File

@@ -9,6 +9,7 @@ module Lib.Ssl
, writeLeafCert
, root_CA_OPENSSL_CONF
, intermediate_CA_OPENSSL_CONF
, segment
)
where

59
agent/src/Lib/Synchronizers.hs
View File

@@ -87,7 +87,7 @@ 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
@@ -141,7 +141,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 +172,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 +234,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 +330,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 +372,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 +426,47 @@ 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
-- syncConvertEcdsaLeafCert :: SyncOp
-- syncConvertEcdsaLeafCert = SyncOp "Convert Intermediate Cert to ECDSA P256" check migrate False
-- where
-- check = do
-- fs <- asks $ appFilesystemBase . appSettings
-- h <- injectFilesystemBase fs getStart9AgentHostname
-- header <- liftIO $ headMay . lines <$> readFile (toS $ entityKeyPath h `relativeTo` fs)
-- pure $ case header of
-- Nothing -> False
-- Just y -> "BEGIN RSA PRIVATE" `T.isInfixOf` y
-- migrate = do
-- base <- asks $ appFilesystemBase . appSettings
-- _
-- syncRotateExpiringCerts :: SyncOp
-- syncRotateExpiringCerts = _
failUpdate :: S9Error -> ExceptT Void (ReaderT AgentCtx IO) ()
failUpdate e = do
ref <- asks appIsUpdateFailed

7
agent/src/Lib/SystemPaths.hs
View File

@@ -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