fixes ssl renewal, replaces rsa with ecdsa for derivative certs

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

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" $> ()