[pkg-haskell-tools] 01/01: dht make: Make /tmp configurable
Joachim Breitner
nomeata at moszumanska.debian.org
Wed Aug 19 07:05:16 UTC 2015
This is an automated email from the git hooks/post-receive script.
nomeata pushed a commit to branch master
in repository pkg-haskell-tools.
commit 29a68cd3a9bab0da6cc633ac7b133f944f7b50b5
Author: Joachim Breitner <mail at joachim-breitner.de>
Date: Wed Aug 19 09:04:59 2015 +0200
dht make: Make /tmp configurable
in case you want to bindmound something else.
---
dht.cabal | 5 ++++-
src/Utils.hs | 41 +++++++++++++++++++++++++++++++++++++++++
src/make-all.hs | 15 ++++++++++++---
3 files changed, 57 insertions(+), 4 deletions(-)
diff --git a/dht.cabal b/dht.cabal
index 698b034..24ab27d 100644
--- a/dht.cabal
+++ b/dht.cabal
@@ -13,11 +13,14 @@ build-type: Simple
cabal-version: >=1.10
executable make-all
- main-is: make-all.hs
+ main-is: make-all.hs
+ other-modules: Utils
build-depends:
base >=4.6 && <4.8,
containers,
directory,
+ filepath,
+ time,
parsec,
text,
shake == 0.15.*,
diff --git a/src/Utils.hs b/src/Utils.hs
new file mode 100644
index 0000000..1829cec
--- /dev/null
+++ b/src/Utils.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Utils where
+
+import System.IO
+import Control.Concurrent.Extra
+import Control.Exception.Extra as E
+import GHC.IO.Handle(hDuplicate,hDuplicateTo)
+import System.Directory.Extra
+import System.IO.Error
+import System.FilePath
+import Data.Char
+import Data.Time.Clock
+
+import Development.Shake hiding (withTempDir)
+
+
+-- This is copied from extra and shake sources, because they do not allow to
+-- specify the temp directory
+newTempDir :: FilePath -> IO (FilePath, IO ())
+newTempDir tmpdir = do
+ dir <- create
+ del <- once $ ignore $ removeDirectoryRecursive dir
+ return (dir, del)
+ where
+ create = do
+ -- get the number of seconds during today (including floating point), and grab some interesting digits
+ rand :: Integer <- fmap (read . take 20 . filter isDigit . show . utctDayTime) getCurrentTime
+ find tmpdir rand
+
+ find tmpdir x = do
+ let dir = tmpdir </> "dht-" ++ show x
+ catchBool isAlreadyExistsError
+ (createDirectoryPrivate dir >> return dir) $
+ \e -> find tmpdir (x+1)
+
+withTempDir :: FilePath -> (FilePath -> Action a) -> Action a
+withTempDir tmpdir act = do
+ (dir,del) <- liftIO $ newTempDir tmpdir
+ act dir `actionFinally` del
+
diff --git a/src/make-all.hs b/src/make-all.hs
index 5f2f342..7a2c410 100644
--- a/src/make-all.hs
+++ b/src/make-all.hs
@@ -19,7 +19,7 @@ import Options.Applicative hiding (many)
import qualified Options.Applicative as O
import Options.Applicative.Types (readerAsk)
-import Development.Shake
+import Development.Shake hiding (withTempDir)
import Development.Shake.Classes
import Development.Shake.FilePath
@@ -30,11 +30,14 @@ import Debian.Control.Policy
import Text.Parsec hiding (option, oneOf)
import Text.Parsec.String
+import Utils
+
-- Option parsing
data Conf = Conf
{ distribution :: String
, excludedPackages :: [String]
, targetDir :: FilePath
+ , baseTmpDir :: FilePath
, jobs :: Int
, schrootName :: String
, shakeVerbosity' :: Verbosity
@@ -67,6 +70,13 @@ confSpec = Conf
showDefault <>
value "lab"
)
+ <*> strOption (
+ long "tmpdir" <>
+ metavar "DIR" <>
+ help "temporary directory (assumed to be bind-mounted in the schroot)" <>
+ showDefault <>
+ value "/tmp"
+ )
<*> option parseNat (
long "jobs" <>
short 'j' <>
@@ -392,7 +402,7 @@ shakeMain conf@(Conf {..}) = do
liftIO (listFiles targetDir)
let localDepPkgs = map debFileNameToPackage localDebs
- withTempDir $ \tmpdir -> do
+ withTempDir baseTmpDir $ \tmpdir -> do
-- Now monkey-patch dependencies out of the package lists
let fixup = tmpdir </> "fixup.sh"
liftIO $ writeFile fixup $ fixupScript localDepPkgs
@@ -436,4 +446,3 @@ shakeMain conf@(Conf {..}) = do
need [ "p" </> source </> f | f <- sourceFiles]
unit $ cmd (EchoStdout False) (Traced "debian2dsc") "dht" "debian2dsc" "-o" targetDir ("p" </> source </> "debian")
-
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-haskell/pkg-haskell-tools.git
More information about the Pkg-haskell-commits
mailing list