From d8d2faece72eabd18c2ff303e5fb63c3a69961f6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 22 Apr 2018 12:15:35 -0400 Subject: separate Hs-Source-Dirs for binaries This is a trick I only just learned about, see https://stackoverflow.com/questions/6711151/how-to-avoid-recompiling-in-this-cabal-file#6711739 Significantly increased propellor build speed when your config.hs is in a fork of the propellor repository, by avoiding redundant builds of propellor library. Also avoids needing to list all the build deps 3 times. Also avoids cabal 2.x wanting every module to be listed 3 times. Note that the bulk of wrapper.hs had to move into the propellor library, since that code depended on stuff not exposed by the library. This commit was sponsored by Henrik Riomar on Patreon. --- debian/changelog | 3 ++ executables/propellor-config.hs | 1 + executables/wrapper.hs | 6 +++ propellor.cabal | 53 ++++++++++--------------- src/Propellor/Wrapper.hs | 85 +++++++++++++++++++++++++++++++++++++++++ src/propellor-config.hs | 1 - src/wrapper.hs | 84 ---------------------------------------- 7 files changed, 116 insertions(+), 117 deletions(-) create mode 120000 executables/propellor-config.hs create mode 100644 executables/wrapper.hs create mode 100644 src/Propellor/Wrapper.hs delete mode 120000 src/propellor-config.hs delete mode 100644 src/wrapper.hs diff --git a/debian/changelog b/debian/changelog index 9af87222..e75d7f8f 100644 --- a/debian/changelog +++ b/debian/changelog @@ -2,6 +2,9 @@ propellor (5.3.5) UNRELEASED; urgency=medium * Apt.stdSourcesList now adds stable-updates suite Thanks, Sean Whitton + * Significantly increased propellor build speed when your config.hs + is in a fork of the propellor repository, by avoiding redundant builds + of propellor library. -- Joey Hess Wed, 18 Apr 2018 10:12:21 -0400 diff --git a/executables/propellor-config.hs b/executables/propellor-config.hs new file mode 120000 index 00000000..e3af968e --- /dev/null +++ b/executables/propellor-config.hs @@ -0,0 +1 @@ +../config.hs \ No newline at end of file diff --git a/executables/wrapper.hs b/executables/wrapper.hs new file mode 100644 index 00000000..3a6cee3a --- /dev/null +++ b/executables/wrapper.hs @@ -0,0 +1,6 @@ +module Main where + +import Propellor.Wrapper + +main :: IO () +main = runWrapper diff --git a/propellor.cabal b/propellor.cabal index 18d28db3..4e4102d0 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -35,38 +35,6 @@ Description: . It is configured using haskell. -Executable propellor - Default-Language: Haskell98 - Main-Is: wrapper.hs - GHC-Options: -threaded -Wall -fno-warn-tabs -O0 - if impl(ghc >= 8.0) - GHC-Options: -fno-warn-redundant-constraints - Default-Extensions: TypeOperators - Hs-Source-Dirs: src - Build-Depends: - -- propellor needs to support the ghc shipped in Debian stable, - -- and also only depends on packages in Debian stable. - base >= 4.5, base < 5, - directory, filepath, IfElse, process, bytestring, hslogger, split, - unix, unix-compat, ansi-terminal, containers (>= 0.5), network, async, - time, mtl, transformers, exceptions (>= 0.6), stm, text, hashable - Other-Modules: - Propellor.DotDir - -Executable propellor-config - Default-Language: Haskell98 - Main-Is: propellor-config.hs - GHC-Options: -threaded -Wall -fno-warn-tabs -O0 - if impl(ghc >= 8.0) - GHC-Options: -fno-warn-redundant-constraints - Default-Extensions: TypeOperators - Hs-Source-Dirs: src - Build-Depends: - base >= 4.5, base < 5, - directory, filepath, IfElse, process, bytestring, hslogger, split, - unix, unix-compat, ansi-terminal, containers (>= 0.5), network, async, - time, mtl, transformers, exceptions (>= 0.6), stm, text, hashable - Library Default-Language: Haskell98 GHC-Options: -Wall -fno-warn-tabs -O0 @@ -75,6 +43,8 @@ Library Default-Extensions: TypeOperators Hs-Source-Dirs: src Build-Depends: + -- propellor needs to support the ghc shipped in Debian stable, + -- and also only depends on packages in Debian stable. base >= 4.5, base < 5, directory, filepath, IfElse, process, bytestring, hslogger, split, unix, unix-compat, ansi-terminal, containers (>= 0.5), network, async, @@ -83,6 +53,7 @@ Library Exposed-Modules: Propellor Propellor.Base + Propellor.DotDir Propellor.Location Propellor.Property Propellor.Property.Aiccu @@ -211,6 +182,7 @@ Library Propellor.Types.ResultCheck Propellor.Types.Singletons Propellor.Types.ZFS + Propellor.Wrapper Other-Modules: Propellor.Bootstrap Propellor.Git @@ -254,6 +226,23 @@ Library System.Console.Concurrent System.Console.Concurrent.Internal System.Process.Concurrent + Paths_propellor + +Executable propellor-config + Default-Language: Haskell98 + Hs-Source-Dirs: executables + Main-Is: propellor-config.hs + GHC-Options: -threaded -Wall -fno-warn-tabs -O0 + if impl(ghc >= 8.0) + GHC-Options: -fno-warn-redundant-constraints + Default-Extensions: TypeOperators + Build-Depends: propellor, base + +Executable propellor + Default-Language: Haskell98 + Hs-Source-Dirs: executables + Main-Is: wrapper.hs + Build-Depends: propellor, base source-repository head type: git diff --git a/src/Propellor/Wrapper.hs b/src/Propellor/Wrapper.hs new file mode 100644 index 00000000..f399b2cf --- /dev/null +++ b/src/Propellor/Wrapper.hs @@ -0,0 +1,85 @@ +-- | This module is used to implement a wrapper program for propellor +-- distribution. +-- +-- Distributions should install this program into PATH. +-- (Cabal builds it as dist/build/propellor/propellor). +-- +-- This is not the propellor main program (that's config.hs). +-- This bootstraps ~/.propellor/config.hs, builds it if +-- it's not already built, and runs it. +-- +-- If ./config.hs exists and looks like a propellor config file, +-- it instead builds and runs in the current working directory. + +module Propellor.Wrapper (runWrapper) where + +import Propellor.DotDir +import Propellor.Message +import Propellor.Bootstrap +import Utility.Monad +import Utility.Directory +import Utility.FileMode +import Utility.Process +import Utility.Process.NonConcurrent +import Utility.FileSystemEncoding + +import System.Environment (getArgs) +import System.Exit +import System.Posix +import Data.List +import Control.Monad.IfElse +import Control.Applicative +import Prelude + +runWrapper :: IO () +runWrapper = withConcurrentOutput $ do + useFileSystemEncoding + go =<< getArgs + where + go ["--init"] = interactiveInit + go args = ifM configInCurrentWorkingDirectory + ( buildRunConfig args + , ifM (doesDirectoryExist =<< dotPropellor) + ( do + checkRepoUpToDate + changeWorkingDirectory =<< dotPropellor + buildRunConfig args + , error "Seems that ~/.propellor/ does not exist. To set it up, run: propellor --init" + ) + ) + +buildRunConfig :: [String] -> IO () +buildRunConfig args = do + unlessM (doesFileExist "propellor") $ do + buildPropellor Nothing + putStrLn "" + putStrLn "" + (_, _, _, pid) <- createProcessNonConcurrent (proc "./propellor" args) + exitWith =<< waitForProcessNonConcurrent pid + +configInCurrentWorkingDirectory :: IO Bool +configInCurrentWorkingDirectory = ifM (doesFileExist "config.hs") + ( do + -- This is a security check to avoid using the current + -- working directory as the propellor configuration + -- if it's not owned by the user, or is world-writable, + -- or group writable. (Some umasks may make directories + -- group writable, but typical ones do not.) + s <- getFileStatus "." + uid <- getRealUserID + if fileOwner s /= uid + then unsafe "you don't own the current directory" + else if checkMode groupWriteMode (fileMode s) + then unsafe "the current directory is group writable" + else if checkMode otherWriteMode (fileMode s) + then unsafe "the current directory is world-writable" + else ifM mentionspropellor + ( return True + , notusing "it does not seem to be a propellor config file" + ) + , return False + ) + where + unsafe s = notusing (s ++ ". This seems unsafe.") + notusing s = error $ "Not using ./config.hs because " ++ s + mentionspropellor = ("Propellor" `isInfixOf`) <$> readFile "config.hs" diff --git a/src/propellor-config.hs b/src/propellor-config.hs deleted file mode 120000 index e3af968e..00000000 --- a/src/propellor-config.hs +++ /dev/null @@ -1 +0,0 @@ -../config.hs \ No newline at end of file diff --git a/src/wrapper.hs b/src/wrapper.hs deleted file mode 100644 index 20b4d8c6..00000000 --- a/src/wrapper.hs +++ /dev/null @@ -1,84 +0,0 @@ --- | Wrapper program for propellor distribution. --- --- Distributions should install this program into PATH. --- (Cabal builds it as dist/build/propellor/propellor). --- --- This is not the propellor main program (that's config.hs). --- This bootstraps ~/.propellor/config.hs, builds it if --- it's not already built, and runs it. --- --- If ./config.hs exists and looks like a propellor config file, --- it instead builds and runs in the current working directory. - -module Main where - -import Propellor.DotDir -import Propellor.Message -import Propellor.Bootstrap -import Utility.Monad -import Utility.Directory -import Utility.FileMode -import Utility.Process -import Utility.Process.NonConcurrent -import Utility.FileSystemEncoding - -import System.Environment (getArgs) -import System.Exit -import System.Posix -import Data.List -import Control.Monad.IfElse -import Control.Applicative -import Prelude - -main :: IO () -main = withConcurrentOutput $ do - useFileSystemEncoding - go =<< getArgs - where - go ["--init"] = interactiveInit - go args = ifM configInCurrentWorkingDirectory - ( buildRunConfig args - , ifM (doesDirectoryExist =<< dotPropellor) - ( do - checkRepoUpToDate - changeWorkingDirectory =<< dotPropellor - buildRunConfig args - , error "Seems that ~/.propellor/ does not exist. To set it up, run: propellor --init" - ) - ) - -buildRunConfig :: [String] -> IO () -buildRunConfig args = do - unlessM (doesFileExist "propellor") $ do - buildPropellor Nothing - putStrLn "" - putStrLn "" - (_, _, _, pid) <- createProcessNonConcurrent (proc "./propellor" args) - exitWith =<< waitForProcessNonConcurrent pid - -configInCurrentWorkingDirectory :: IO Bool -configInCurrentWorkingDirectory = ifM (doesFileExist "config.hs") - ( do - -- This is a security check to avoid using the current - -- working directory as the propellor configuration - -- if it's not owned by the user, or is world-writable, - -- or group writable. (Some umasks may make directories - -- group writable, but typical ones do not.) - s <- getFileStatus "." - uid <- getRealUserID - if fileOwner s /= uid - then unsafe "you don't own the current directory" - else if checkMode groupWriteMode (fileMode s) - then unsafe "the current directory is group writable" - else if checkMode otherWriteMode (fileMode s) - then unsafe "the current directory is world-writable" - else ifM mentionspropellor - ( return True - , notusing "it does not seem to be a propellor config file" - ) - , return False - ) - where - unsafe s = notusing (s ++ ". This seems unsafe.") - notusing s = error $ "Not using ./config.hs because " ++ s - mentionspropellor = ("Propellor" `isInfixOf`) <$> readFile "config.hs" -- cgit v1.3-2-g0d8e