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. --- src/Propellor/Wrapper.hs | 85 ++++++++++++++++++++++++++++++++++++++++++++++++ src/propellor-config.hs | 1 - src/wrapper.hs | 84 ----------------------------------------------- 3 files changed, 85 insertions(+), 85 deletions(-) create mode 100644 src/Propellor/Wrapper.hs delete mode 120000 src/propellor-config.hs delete mode 100644 src/wrapper.hs (limited to 'src') 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.2.3