1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
{- Running a long or expensive batch operation niced.
-
- Copyright 2013-2020 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}
module Utility.Batch (
batch,
BatchCommandMaker,
nonBatchCommandMaker,
getBatchCommandMaker,
toBatchCommand,
batchCommand,
batchCommandEnv,
) where
import Common
#if defined(linux_HOST_OS)
import Control.Concurrent.Async
import System.Posix.Process
#endif
{- Runs an operation, at batch priority.
-
- This is done by running it in a bound thread, which on Linux can be set
- to have a different nice level than the rest of the program. Note that
- due to running in a bound thread, some operations may be more expensive
- to perform. Also note that if the action calls forkIO or forkOS itself,
- that will make a new thread that does not have the batch priority.
-
- POSIX threads do not support separate nice levels, so on other operating
- systems, the action is simply ran.
-}
batch :: IO a -> IO a
#if defined(linux_HOST_OS)
batch a = wait =<< batchthread
where
batchthread = asyncBound $ do
setProcessPriority 0 maxNice
a
maxNice = 19
#else
batch a = a
#endif
{- Makes a command be run by whichever of nice, ionice, and nocache
- are available in the path. -}
type BatchCommandMaker = (String, [CommandParam]) -> (String, [CommandParam])
nonBatchCommandMaker :: BatchCommandMaker
nonBatchCommandMaker = id
getBatchCommandMaker :: IO BatchCommandMaker
getBatchCommandMaker = do
#ifndef mingw32_HOST_OS
nicers <- filterM (inSearchPath . fst)
[ ("nice", [])
, ("ionice", ["-c3"])
, ("nocache", [])
]
return $ \(command, params) ->
case nicers of
[] -> (command, params)
(first:rest) -> (fst first, map Param (snd first ++ concatMap (\p -> fst p : snd p) rest ++ [command]) ++ params)
#else
return id
#endif
toBatchCommand :: (String, [CommandParam]) -> IO (String, [CommandParam])
toBatchCommand v = do
batchmaker <- getBatchCommandMaker
return $ batchmaker v
{- Runs a command in a way that's suitable for batch jobs that can be
- interrupted. -}
batchCommand :: String -> [CommandParam] -> IO Bool
batchCommand command params = batchCommandEnv command params Nothing
batchCommandEnv :: String -> [CommandParam] -> Maybe [(String, String)] -> IO Bool
batchCommandEnv command params environ = do
batchmaker <- getBatchCommandMaker
let (command', params') = batchmaker (command, params)
boolSystemEnv command' params' environ
|
