summaryrefslogtreecommitdiff
path: root/Omni/Deploy/Systemd.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Omni/Deploy/Systemd.hs')
-rw-r--r--Omni/Deploy/Systemd.hs269
1 files changed, 269 insertions, 0 deletions
diff --git a/Omni/Deploy/Systemd.hs b/Omni/Deploy/Systemd.hs
new file mode 100644
index 0000000..7b64d1f
--- /dev/null
+++ b/Omni/Deploy/Systemd.hs
@@ -0,0 +1,269 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | Systemd unit file generator for the mini-PaaS deployment system.
+--
+-- : out deploy-systemd
+-- : dep directory
+module Omni.Deploy.Systemd
+ ( generateUnit,
+ writeUnit,
+ createSymlink,
+ reloadAndRestart,
+ stopAndDisable,
+ removeUnit,
+ getRunningStorePath,
+ servicesDir,
+ main,
+ test,
+ )
+where
+
+import Alpha
+import qualified Data.Map as Map
+import qualified Data.Text as Text
+import qualified Data.Text.IO as Text.IO
+import Omni.Deploy.Manifest (Artifact (..), Exec (..), Hardening (..), Service (..), Systemd (..))
+import qualified Omni.Test as Test
+import qualified System.Directory as Dir
+import System.FilePath ((</>))
+import qualified System.Process as Process
+
+servicesDir :: FilePath
+servicesDir = "/var/lib/biz-deployer/services"
+
+generateUnit :: Service -> Text
+generateUnit Service {..} =
+ Text.unlines <| unitSection ++ serviceSection ++ hardeningSection ++ installSection
+ where
+ binary = fromMaybe serviceName (execCommand serviceExec)
+ execStart = storePath serviceArtifact <> "/bin/" <> binary
+
+ unitSection =
+ [ "[Unit]",
+ "Description=" <> serviceName,
+ "After=" <> Text.intercalate " " (systemdAfter serviceSystemd)
+ ]
+ ++ requiresLine
+
+ requiresLine =
+ ["Requires=" <> Text.intercalate " " (systemdRequires serviceSystemd) | not (null (systemdRequires serviceSystemd))]
+
+ serviceSection =
+ [ "",
+ "[Service]",
+ "Type=simple",
+ "ExecStart=" <> execStart,
+ "User=" <> execUser serviceExec,
+ "Group=" <> execGroup serviceExec,
+ "Restart=" <> systemdRestart serviceSystemd,
+ "RestartSec=" <> tshow (systemdRestartSec serviceSystemd)
+ ]
+ ++ envLines
+ ++ envFileLine
+
+ envLines =
+ Map.toList serviceEnv
+ |> map (\(k, v) -> "Environment=\"" <> k <> "=" <> v <> "\"")
+
+ envFileLine = case serviceEnvFile of
+ Nothing -> []
+ Just path -> ["EnvironmentFile=" <> path]
+
+ hardeningSection =
+ [ "",
+ "# Hardening",
+ "PrivateTmp=" <> boolToYesNo (hardeningPrivateTmp serviceHardening),
+ "ProtectSystem=" <> hardeningProtectSystem serviceHardening,
+ "ProtectHome=" <> boolToYesNo (hardeningProtectHome serviceHardening),
+ "NoNewPrivileges=yes"
+ ]
+ ++ readWritePathsLine
+
+ readWritePathsLine =
+ case Map.lookup "DATA_DIR" serviceEnv of
+ Just dataDir -> ["ReadWritePaths=" <> dataDir]
+ Nothing -> []
+
+ installSection =
+ [ "",
+ "[Install]",
+ "WantedBy=multi-user.target"
+ ]
+
+ boolToYesNo True = "yes"
+ boolToYesNo False = "no"
+
+writeUnit :: FilePath -> Service -> IO FilePath
+writeUnit baseDir svc = do
+ Dir.createDirectoryIfMissing True baseDir
+ let path = baseDir </> Text.unpack (serviceName svc) <> ".service"
+ content = generateUnit svc
+ Text.IO.writeFile path content
+ pure path
+
+createSymlink :: FilePath -> FilePath -> Service -> IO FilePath
+createSymlink baseDir sysDir svc = do
+ let unitPath = baseDir </> Text.unpack (serviceName svc) <> ".service"
+ linkPath = sysDir </> Text.unpack (serviceName svc) <> ".service"
+ exists <- Dir.doesPathExist linkPath
+ when exists <| Dir.removeFile linkPath
+ Dir.createFileLink unitPath linkPath
+ pure linkPath
+
+reloadAndRestart :: Text -> IO ()
+reloadAndRestart serviceName' = do
+ _ <- Process.readProcessWithExitCode "systemctl" ["daemon-reload"] ""
+ _ <-
+ Process.readProcessWithExitCode
+ "systemctl"
+ ["enable", "--now", Text.unpack serviceName' <> ".service"]
+ ""
+ pure ()
+
+stopAndDisable :: Text -> IO ()
+stopAndDisable serviceName' = do
+ _ <-
+ Process.readProcessWithExitCode
+ "systemctl"
+ ["disable", "--now", Text.unpack serviceName' <> ".service"]
+ ""
+ pure ()
+
+removeUnit :: FilePath -> FilePath -> Text -> IO ()
+removeUnit baseDir sysDir serviceName' = do
+ let unitPath = baseDir </> Text.unpack serviceName' <> ".service"
+ linkPath = sysDir </> Text.unpack serviceName' <> ".service"
+ linkExists <- Dir.doesPathExist linkPath
+ when linkExists <| Dir.removeFile linkPath
+ unitExists <- Dir.doesPathExist unitPath
+ when unitExists <| Dir.removeFile unitPath
+ _ <- Process.readProcessWithExitCode "systemctl" ["daemon-reload"] ""
+ pure ()
+
+-- | Get the store path of the currently running service by reading its unit file.
+getRunningStorePath :: Text -> IO (Maybe Text)
+getRunningStorePath serviceName' = do
+ let unitPath = servicesDir </> Text.unpack serviceName' <> ".service"
+ exists <- Dir.doesFileExist unitPath
+ if not exists
+ then pure Nothing
+ else do
+ content <- Text.IO.readFile unitPath
+ pure <| extractStorePath content
+ where
+ -- Extract /nix/store/...-service-name from ExecStart=/nix/store/.../bin/...
+ extractStorePath content =
+ content
+ |> Text.lines
+ |> find (Text.isPrefixOf "ExecStart=")
+ |> fmap (Text.drop (Text.length "ExecStart="))
+ |> fmap (Text.dropWhile (/= '/'))
+ |> fmap (Text.drop 1)
+ |> fmap (Text.takeWhile (/= '/'))
+ |> fmap ("/nix/store/" <>)
+
+test :: Test.Tree
+test =
+ Test.group
+ "Omni.Deploy.Systemd"
+ [ test_generateBasicUnit,
+ test_generateUnitWithEnv,
+ test_generateUnitWithCustomExec,
+ test_generateUnitWithEnvFile,
+ test_generateUnitWithDependencies,
+ test_generateUnitWithHardening
+ ]
+
+mkTestService :: Text -> Text -> Service
+mkTestService name path =
+ Service
+ { serviceName = name,
+ serviceArtifact = Artifact "nix-closure" path,
+ serviceHosts = ["biz"],
+ serviceExec = Exec Nothing "root" "root",
+ serviceEnv = mempty,
+ serviceEnvFile = Nothing,
+ serviceHttp = Nothing,
+ serviceSystemd = Systemd ["network-online.target"] [] "on-failure" 5,
+ serviceHardening = Hardening False True "strict" True,
+ serviceRevision = Nothing
+ }
+
+test_generateBasicUnit :: Test.Tree
+test_generateBasicUnit =
+ Test.unit "generates basic unit file" <| do
+ let svc = mkTestService "test-service" "/nix/store/abc123-test"
+ unit = generateUnit svc
+ Text.isInfixOf "[Unit]" unit Test.@=? True
+ Text.isInfixOf "Description=test-service" unit Test.@=? True
+ Text.isInfixOf "[Service]" unit Test.@=? True
+ Text.isInfixOf "ExecStart=/nix/store/abc123-test/bin/test-service" unit Test.@=? True
+ Text.isInfixOf "[Install]" unit Test.@=? True
+ Text.isInfixOf "WantedBy=multi-user.target" unit Test.@=? True
+
+test_generateUnitWithEnv :: Test.Tree
+test_generateUnitWithEnv =
+ Test.unit "generates unit with environment" <| do
+ let svc =
+ (mkTestService "env-test" "/nix/store/xyz")
+ { serviceEnv = Map.fromList [("PORT", "8000"), ("DEBUG", "true")]
+ }
+ unit = generateUnit svc
+ Text.isInfixOf "Environment=\"PORT=8000\"" unit Test.@=? True
+ Text.isInfixOf "Environment=\"DEBUG=true\"" unit Test.@=? True
+
+test_generateUnitWithCustomExec :: Test.Tree
+test_generateUnitWithCustomExec =
+ Test.unit "generates unit with custom exec" <| do
+ let svc =
+ (mkTestService "custom-exec" "/nix/store/abc")
+ { serviceExec = Exec (Just "my-binary") "www-data" "www-data"
+ }
+ unit = generateUnit svc
+ Text.isInfixOf "ExecStart=/nix/store/abc/bin/my-binary" unit Test.@=? True
+ Text.isInfixOf "User=www-data" unit Test.@=? True
+ Text.isInfixOf "Group=www-data" unit Test.@=? True
+
+test_generateUnitWithEnvFile :: Test.Tree
+test_generateUnitWithEnvFile =
+ Test.unit "generates unit with env file" <| do
+ let svc =
+ (mkTestService "env-file-test" "/nix/store/xyz")
+ { serviceEnvFile = Just "/var/lib/biz-secrets/test.env"
+ }
+ unit = generateUnit svc
+ Text.isInfixOf "EnvironmentFile=/var/lib/biz-secrets/test.env" unit Test.@=? True
+
+test_generateUnitWithDependencies :: Test.Tree
+test_generateUnitWithDependencies =
+ Test.unit "generates unit with dependencies" <| do
+ let svc =
+ (mkTestService "dep-test" "/nix/store/abc")
+ { serviceSystemd =
+ Systemd
+ ["network-online.target", "postgresql.service"]
+ ["postgresql.service"]
+ "on-failure"
+ 5
+ }
+ unit = generateUnit svc
+ Text.isInfixOf "After=network-online.target postgresql.service" unit Test.@=? True
+ Text.isInfixOf "Requires=postgresql.service" unit Test.@=? True
+
+test_generateUnitWithHardening :: Test.Tree
+test_generateUnitWithHardening =
+ Test.unit "generates unit with hardening" <| do
+ let svc =
+ (mkTestService "hardened" "/nix/store/abc")
+ { serviceHardening = Hardening False True "full" True
+ }
+ unit = generateUnit svc
+ Text.isInfixOf "PrivateTmp=yes" unit Test.@=? True
+ Text.isInfixOf "ProtectSystem=full" unit Test.@=? True
+ Text.isInfixOf "ProtectHome=yes" unit Test.@=? True
+ Text.isInfixOf "NoNewPrivileges=yes" unit Test.@=? True
+
+main :: IO ()
+main = Test.run test
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-19 08:10:55 +0000