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
|
{-
Copyright (C) 2006-2008 John Goerzen <jgoerzen@complete.org>
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
-}
module Actions(runAction) where
import Types
import Text.Printf
import Data.List
import System.FilePath
import System.Posix.Files
import System.Directory
import System.Process
import System.Environment
import System.Exit
import Control.Monad
runAction :: RunInfo -> [(Integer, [FilePath])] -> IO ()
runAction ri resultlist =
case action ri of
Print -> action_print ri resultlist
PrintFull -> action_printfull ri resultlist
Print0 -> action_print0 ri resultlist
Hardlink -> action_hardlink ri resultlist
Symlink -> action_symlink ri resultlist
Exec x -> action_exec x ri resultlist
formatBin :: RunInfo -> Integer -> String
formatBin ri bin =
printf (binFmt ri) bin
action_print :: RunInfo -> [(Integer, [FilePath])] -> IO ()
action_print ri =
putStr . unlines . concatMap procBin
where procBin (bin, fp) = map (procLine (formatBin ri bin)) fp
procLine bin fp = bin ++ "\t" ++ fp
action_printfull :: RunInfo -> [(Integer, [FilePath])] -> IO ()
action_printfull ri =
putStr . unlines . map toLine
where toLine (bin, files) =
formatBin ri bin ++ "\t" ++ (concat . intersperse "\t" $ files)
action_print0 :: RunInfo -> [(Integer, [FilePath])] -> IO ()
action_print0 ri =
putStr . concatMap toLine
where toLine (bin, files) = concatMap (fmtFile (formatBin ri bin)) files
fmtFile binstr file =
binstr ++ "\0" ++ file ++ "\0"
action_hardlink :: RunInfo -> [(Integer, [FilePath])] -> IO ()
action_hardlink = action_link createLink
action_symlink :: RunInfo -> [(Integer, [FilePath])] -> IO ()
action_symlink = action_link createSymbolicLink
action_link :: (FilePath -> FilePath -> IO ()) -> RunInfo -> [(Integer, [FilePath])] -> IO ()
action_link func ri =
mapM_ makeLink
where makeLink (bin, fpl) =
mapM_ (makeLink' (formatBin ri bin)) fpl
makeLink' bin fp =
if deepLinks ri
then do let dirname = bin ++ "/" ++ takeDirectory fp
createDirectoryIfMissing True dirname
func fp (dirname ++ "/" ++ takeFileName fp)
else do createDirectoryIfMissing False bin
func fp (bin ++ "/" ++ takeFileName fp)
action_exec :: String -> RunInfo -> [(Integer, [FilePath])] -> IO ()
action_exec cmd ri inp =
do baseenv <- getEnvironment
let dshell = case lookup "SHELL" baseenv of
Nothing -> "/bin/sh"
Just x -> x
mapM_ (execCommand dshell) inp
where execCommand sh (bin, fpl) =
do ph <- runProcess sh (["-c", cmd, sh, formatBin ri bin] ++ fpl)
Nothing Nothing Nothing Nothing Nothing
ec <- waitForProcess ph
when (ec /= ExitSuccess)
(fail $ "action_exec: command failed on bin " ++
formatBin ri bin ++ ": " ++ show ec)
|
