1  {-# LANGUAGE OverloadedStrings #-}
  2  {-# LANGUAGE RecordWildCards #-}
  3  
  4  {- |
  5  Run an OCI container image in a Cloud Hypervisor VM.
  6  
  7  Usage: ch-run [OPTIONS] [IMAGE]
  8  
  9  Options:
 10    --cpus N     Number of vCPUs (default: from config)
 11    --mem N      Memory in MiB (default: from config)
 12  
 13  Environment:
 14    CONFIG_FILE  - Path to Dhall config (required, set by Nix wrapper)
 15  
 16  Example: ch-run ubuntu:24.04
 17           ch-run --cpus 4 --mem 8192 alpine:latest
 18  
 19  The CONFIG_FILE must be a Dhall expression of type:
 20    { chKernel : Text
 21    , chBusybox : Text
 22    , chInitScript : Text
 23    , chGpuInitScript : Optional Text
 24    , chDefaultCpus : Natural
 25    , chDefaultMemMib : Natural
 26    , chHugepages : Bool
 27    , chCacheDir : Text
 28    }
 29  -}
 30  module Main where
 31  
 32  import Aleph.Script hiding (FilePath)
 33  import Aleph.Script.Config (StorePath (..), storePathToFilePath)
 34  import qualified Aleph.Script.Oci as Oci
 35  import qualified Aleph.Script.Vm as Vm
 36  import Aleph.Script.Vm.Config (CloudHypervisorConfig (..), loadCloudHypervisorConfig)
 37  
 38  import Data.Maybe (fromMaybe)
 39  import Numeric.Natural (Natural)
 40  import System.Environment (getArgs, lookupEnv)
 41  import System.Exit (exitFailure)
 42  import Text.Read (readMaybe)
 43  
 44  -- | Parse command line arguments
 45  data CliArgs = CliArgs
 46      { argCpus :: Maybe Int
 47      , argMem :: Maybe Int
 48      , argImage :: String
 49      }
 50  
 51  parseArgs :: [String] -> CliArgs
 52  parseArgs = go (CliArgs Nothing Nothing "ubuntu:24.04")
 53    where
 54      go acc [] = acc
 55      go acc ("--cpus" : n : rest) = go acc{argCpus = readMaybe n} rest
 56      go acc ("--mem" : n : rest) = go acc{argMem = readMaybe n} rest
 57      go acc (img : rest)
 58          | Prelude.take 2 img /= "--" = go acc{argImage = img} rest
 59          | otherwise = go acc rest -- skip unknown flags
 60  
 61  main :: IO ()
 62  main = do
 63      -- Load config from Dhall file (set by Nix wrapper)
 64      configPath <- lookupEnv "CONFIG_FILE"
 65      case configPath of
 66          Nothing -> do
 67              putStrLn "Error: CONFIG_FILE environment variable not set"
 68              putStrLn "This binary must be run via the Nix-wrapped version."
 69              exitFailure
 70          Just path -> do
 71              cfg <- loadCloudHypervisorConfig path
 72              runWithConfig cfg
 73  
 74  runWithConfig :: CloudHypervisorConfig -> IO ()
 75  runWithConfig CloudHypervisorConfig{..} = do
 76      args <- parseArgs <$> getArgs
 77  
 78      -- Merge CLI args with config defaults
 79      let cpus = fromMaybe (fromIntegral chDefaultCpus) (argCpus args)
 80          mem = fromMaybe (fromIntegral chDefaultMemMib) (argMem args)
 81          image = argImage args
 82  
 83      script $ do
 84          echoErr $ ":: Cloud Hypervisor VM (" <> pack (show cpus) <> " CPUs, " <> pack (show mem) <> " MiB)"
 85  
 86          withTmpDir $ \workDir -> do
 87              let rootfsDir = workDir </> "rootfs"
 88                  disk = workDir </> "disk.raw"
 89                  kernelPath = storePathToFilePath chKernel
 90                  busyboxPath = storePathToFilePath chBusybox
 91                  initPath = storePathToFilePath chInitScript
 92  
 93              -- Pull image
 94              echoErr $ ":: Pulling " <> pack image
 95              mkdirP rootfsDir
 96              setEnv "SSL_CERT_FILE" "/etc/ssl/certs/ca-bundle.crt"
 97              _ <- Oci.pullOrCache Oci.defaultConfig (pack image)
 98  
 99              -- Export to rootfs
100              bash_ $ "crane export --platform linux/amd64 '" <> pack image <> "' - | tar -xf - -C " <> pack rootfsDir
101  
102              -- Inject busybox and init
103              echoErr ":: Injecting init"
104              Vm.injectBusybox busyboxPath rootfsDir
105              cp initPath (rootfsDir </> "init")
106              run_ "chmod" ["+x", pack (rootfsDir </> "init")]
107  
108              -- Build disk image (8GB for Cloud Hypervisor)
109              echoErr ":: Building rootfs"
110              Vm.buildExt4Sized (8 * 1024 * 1024) rootfsDir disk
111  
112              -- Boot
113              echoErr ":: Booting Cloud Hypervisor"
114              let vmCfg =
115                      Vm.defaultCloudHypervisorConfig
116                          { Vm.chKernel = kernelPath
117                          , Vm.chDisk = disk
118                          , Vm.chCpus = cpus
119                          , Vm.chMemMib = mem
120                          }
121              Vm.runCloudHypervisor vmCfg