thereadme/serverman
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

fix: trim empty lines from remote file

Browse Source
This commit is contained in:
Mahdi Dibaiee 2017-04-09 17:04:09 +04:30
parent 9fe858ea5a
commit 5b76c2a15d
7 changed files with 84 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/System/Serverman.hs
View File

@ -19,6 +19,8 @@ module System.Serverman ( run
import Control.Monad.Free import Control.Monad.Free
import Debug.Trace
run :: Action r -> App r run :: Action r -> App r
run (Pure r) = return r run (Pure r) = return r
run (Free (DetectOS next)) = getOS >> run next run (Free (DetectOS next)) = getOS >> run next
@ -28,7 +30,7 @@ module System.Serverman ( run
run (Free (Call service remote next)) = callService service remote >> run next run (Free (Call service remote next)) = callService service remote >> run next
run (Free (Remote addrs action next)) = mapM_ (\addr -> runRemotely addr (run action)) addrs >> run next run (Free (Remote addrs action next)) = mapM_ (\addr -> unmountPath addr >> runRemotely addr (run action)) addrs >> run next
run (Free (FetchRepository next)) = fetchRepo False >> run next run (Free (FetchRepository next)) = fetchRepo False >> run next
run (Free (UpdateRepository next)) = fetchRepo True >> run next run (Free (UpdateRepository next)) = fetchRepo True >> run next

17
src/System/Serverman/Actions/Call.hs
View File

@ -18,10 +18,10 @@ module System.Serverman.Actions.Call (callService) where
import Data.Maybe import Data.Maybe
callService :: Service -> Maybe FilePath -> App () callService :: Service -> Maybe FilePath -> App ()
callService s@(Service { name, version }) remote = do callService s@Service { name, version } remote = do
done <- progressText $ "running service " ++ show s done <- progressText $ "running service " ++ show s
state@(AppState { repositoryURL, helpArg }) <- get state@AppState { repositoryURL, helpArg } <- get
put $ state { remoteMode = Nothing } put $ state { remoteMode = Nothing }
dir <- liftIO $ getAppUserDataDirectory "serverman" dir <- liftIO $ getAppUserDataDirectory "serverman"
@ -42,7 +42,7 @@ module System.Serverman.Actions.Call (callService) where
let finalEnv = map (mergeEnv $ parseKeyValue stackSourceEnv '=') (parseKeyValue stackEnv '=') let finalEnv = map (mergeEnv $ parseKeyValue stackSourceEnv '=') (parseKeyValue stackEnv '=')
backupEnv <- liftIO $ getEnvironment backupEnv <- liftIO getEnvironment
liftIO $ setEnvironment finalEnv liftIO $ setEnvironment finalEnv
func <- liftIO $ runInterpreter (getCall include entry) func <- liftIO $ runInterpreter (getCall include entry)
@ -79,7 +79,7 @@ module System.Serverman.Actions.Call (callService) where
where where
handleRemote (Just file) action = do handleRemote (Just file) action = do
list <- liftIO $ map read . lines <$> readFile file list <- liftIO $ map read . filter (not . null) . lines <$> readFile file
mapM_ (`runRemotely` action) list mapM_ (`runRemotely` action) list
handleRemote _ action = action handleRemote _ action = action
@ -92,14 +92,15 @@ module System.Serverman.Actions.Call (callService) where
getCall :: [FilePath] -> FilePath -> Interpreter (Service -> App ()) getCall :: [FilePath] -> FilePath -> Interpreter (Service -> App ())
getCall path entry = do getCall path entry = do
set [searchPath := path] initializeInterpreter path entry
loadModules [entry]
setTopLevelModules ["Main"]
interpret "call" (as :: Service -> App ()) interpret "call" (as :: Service -> App ())
getHelp :: [FilePath] -> FilePath -> Interpreter (App String) getHelp :: [FilePath] -> FilePath -> Interpreter (App String)
getHelp path entry = do getHelp path entry = do
initializeInterpreter path entry
interpret "help" (as :: App String)
initializeInterpreter path entry = do
set [searchPath := path] set [searchPath := path]
loadModules [entry] loadModules [entry]
setTopLevelModules ["Main"] setTopLevelModules ["Main"]
interpret "help" (as :: App String)

28
src/System/Serverman/Actions/Remote.hs
View File

@ -1,7 +1,8 @@
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
module System.Serverman.Actions.Remote ( runRemotely module System.Serverman.Actions.Remote ( runRemotely
, Address) where , Address
, unmountPath) where
import System.Serverman.Utils hiding (liftIO) import System.Serverman.Utils hiding (liftIO)
import System.Serverman.Actions.Env import System.Serverman.Actions.Env
import System.Serverman.Log import System.Serverman.Log
@ -22,8 +23,18 @@ module System.Serverman.Actions.Remote ( runRemotely
actionDelay = 1000000 actionDelay = 1000000
unmountPath :: Address -> App ()
unmountPath addr@(Address host port user) = do
tmp <- liftIO getTemporaryDirectory
let path = tmp </> ("serverman@" ++ host)
execute "fusermount" ["-u", path] "" False
return ()
runRemotely :: Address -> App r -> App () runRemotely :: Address -> App r -> App ()
runRemotely addr@(Address host port user) action = do runRemotely addr@(Address host port user) action = do
verbose $ "running action remotely on " ++ show addr
done <- progressText $ "connecting to server " ++ show addr done <- progressText $ "connecting to server " ++ show addr
tmp <- liftIO getTemporaryDirectory tmp <- liftIO getTemporaryDirectory
@ -58,7 +69,7 @@ module System.Serverman.Actions.Remote ( runRemotely
result <- execute "sshfs" (p ++ noPassword ++ uid ++ options ++ ["-o", "IdentityFile=" ++ keyPath, smConnection ++ ":/", path]) "" False result <- execute "sshfs" (p ++ noPassword ++ uid ++ options ++ ["-o", "IdentityFile=" ++ keyPath, smConnection ++ ":/", path]) "" False
state@(AppState { temps }) <- get state@AppState { temps } <- get
put $ state { temps = path:temps } put $ state { temps = path:temps }
return result return result
@ -71,8 +82,7 @@ module System.Serverman.Actions.Remote ( runRemotely
case result of case result of
Right _ -> do Right _ -> do
state <- get state <- get
liftIO $ do liftIO $ threadDelay actionDelay
threadDelay actionDelay
put $ state { remoteMode = Just (servermanAddr, keyPath) } put $ state { remoteMode = Just (servermanAddr, keyPath) }
getOS getOS
@ -82,10 +92,10 @@ module System.Serverman.Actions.Remote ( runRemotely
Left e -> do Left e -> do
info $ "it seems to be the first time you are using serverman for configuring " ++ show addr info $ "it seems to be the first time you are using serverman for configuring " ++ show addr
write $ "remotely. serverman will create a user, and add it to sudoers file. an ssh key will be created" write "remotely. serverman will create a user, and add it to sudoers file. an ssh key will be created"
write $ "and that will be used for connecting to the server from now on" write "and that will be used for connecting to the server from now on"
write $ "you will not be prompted for a password to connect to server with" write "you will not be prompted for a password to connect to server with"
write $ "please enable password authentication temporarily on your server for this step" write "please enable password authentication temporarily on your server for this step"
write $ "Enter password for " ++ connection write $ "Enter password for " ++ connection
@ -94,7 +104,7 @@ module System.Serverman.Actions.Remote ( runRemotely
done <- progressText $ "setting up serverman user in server " ++ show addr done <- progressText $ "setting up serverman user in server " ++ show addr
execIfMissing keyPath $ execute "ssh-keygen" ["-N", "", "-f", keyPath] "" True >> return () execIfMissing keyPath $ void $ execute "ssh-keygen" ["-N", "", "-f", keyPath] "" True
publicKey <- liftIO $ readFile pubPath publicKey <- liftIO $ readFile pubPath

20
src/System/Serverman/Log.hs
View File

@ -25,9 +25,9 @@ module System.Serverman.Log ( verbose
verbose :: String -> App () verbose :: String -> App ()
verbose str = do verbose str = do
(AppState { verboseMode }) <- get AppState { verboseMode } <- get
liftIO $ liftIO $
when verboseMode $ do when verboseMode $
putStrLn . format . F.gray $ read ("[verbose] " ++ str) putStrLn . format . F.gray $ read ("[verbose] " ++ str)
write :: String -> App () write :: String -> App ()
@ -50,19 +50,15 @@ module System.Serverman.Log ( verbose
clearLine :: IO () clearLine :: IO ()
clearLine = do clearLine = do
putStr $ "\ESC[2K\ESC[0;" putStr "\ESC[2K\ESC[0;"
hFlush stdout hFlush stdout
backward :: Int -> IO () backward :: Int -> IO ()
backward n = do backward n =
putStr $ "\ESC[" ++ (show n) ++ "D\ESC[0;" putStr $ "\ESC[" ++ show n ++ "D\ESC[0;"
progressText :: String -> App (App ()) progressText :: String -> App (App ())
progressText str = do progressText = progressListener
state <- get
p <- progressListener str
return p
progressCharacters = [". ", ".. ", "...", " ..", " .", " "] progressCharacters = [". ", ".. ", "...", " ..", " .", " "]
progressDelay = 200000 progressDelay = 200000
@ -85,12 +81,12 @@ module System.Serverman.Log ( verbose
liftIO $ do liftIO $ do
backward strLength backward strLength
putStr . format . (light . F.blue) $ read str putStr . format . light . F.blue $ read str
hFlush stdout hFlush stdout
return () return ()
stop process = do stop process =
liftIO $ do liftIO $ do
cancel process cancel process
backward strLength backward strLength

4
src/System/Serverman/Types.hs
View File

@ -71,7 +71,7 @@ module System.Serverman.Types ( Service (..)
readsPrec _ service = [(Service { name = service }, [])] readsPrec _ service = [(Service { name = service }, [])]
instance Show Service where instance Show Service where
show (Service { name, version }) = show Service { name, version } =
name ++ "@" ++ version name ++ "@" ++ version
type Repository = [Service] type Repository = [Service]
@ -91,7 +91,7 @@ module System.Serverman.Types ( Service (..)
} }
instance Show AppState where instance Show AppState where
show (AppState { remoteMode, repository, repositoryURL, os, arguments, ports, processes, temps, verboseMode }) = show AppState { remoteMode, repository, repositoryURL, os, arguments, ports, processes, temps, verboseMode } =
"remote: " ++ show remoteMode ++ "\n" ++ "remote: " ++ show remoteMode ++ "\n" ++
"repository:\n" ++ "repository:\n" ++
" - url: " ++ show repositoryURL ++ "\n" ++ " - url: " ++ show repositoryURL ++ "\n" ++

43
src/System/Serverman/Utils.hs
View File

@ -40,7 +40,6 @@ module System.Serverman.Utils ( App (..)
import Data.List import Data.List
import Control.Exception import Control.Exception
import System.Exit hiding (die) import System.Exit hiding (die)
import Data.Maybe
import System.Posix.Terminal import System.Posix.Terminal
import System.Posix.IO (stdInput) import System.Posix.IO (stdInput)
import Data.Maybe import Data.Maybe
@ -63,7 +62,7 @@ module System.Serverman.Utils ( App (..)
-- forward ports declared by `usingPort` -- forward ports declared by `usingPort`
liftIO :: IO a -> App a liftIO :: IO a -> App a
liftIO action = do liftIO action = do
state@(AppState { remoteMode, ports }) <- get state@AppState { remoteMode, ports } <- get
verbose $ "liftIO " ++ show remoteMode ++ ", " ++ show ports verbose $ "liftIO " ++ show remoteMode ++ ", " ++ show ports
case remoteMode of case remoteMode of
@ -73,14 +72,14 @@ module System.Serverman.Utils ( App (..)
tmp <- ST.liftIO getTemporaryDirectory tmp <- ST.liftIO getTemporaryDirectory
let path = tmp </> (user ++ "@" ++ host) let path = tmp </> (user ++ "@" ++ host)
verbose $ "forwarding ports" verbose "forwarding ports"
mapM_ (portForward rm) ports mapM_ (portForward rm) ports
verbose $ "chroot directory " ++ path verbose $ "chroot directory " ++ path
catchIOError catchIOError
(fchroot path $ ST.liftIO action) (fchroot path $ ST.liftIO action)
(\e -> err (show e) >> (ST.liftIO $ threadDelay 1000000) >> liftIO action) (\e -> err (show e) >> ST.liftIO (threadDelay 1000000) >> liftIO action)
where where
portForward (Address host port user, key) (source, destination) = do portForward (Address host port user, key) (source, destination) = do
let forward = source ++ ":" ++ host ++ ":" ++ destination let forward = source ++ ":" ++ host ++ ":" ++ destination
@ -89,7 +88,7 @@ module System.Serverman.Utils ( App (..)
(_, _, _, handle) <- ST.liftIO $ runInteractiveCommand $ "ssh -L " ++ forward ++ " " ++ connection ++ identity (_, _, _, handle) <- ST.liftIO $ runInteractiveCommand $ "ssh -L " ++ forward ++ " " ++ connection ++ identity
state@(AppState { processes }) <- get state@AppState { processes } <- get
put $ state { processes = handle:processes } put $ state { processes = handle:processes }
return () return ()
@ -97,7 +96,7 @@ module System.Serverman.Utils ( App (..)
-- this allows connections to ports on a remote server -- this allows connections to ports on a remote server
usingPort :: String -> App String usingPort :: String -> App String
usingPort port = do usingPort port = do
state@(AppState { ports, remoteMode }) <- get state@AppState { ports, remoteMode } <- get
case remoteMode of case remoteMode of
Nothing -> return port Nothing -> return port
@ -115,7 +114,7 @@ module System.Serverman.Utils ( App (..)
clearPort :: String -> App () clearPort :: String -> App ()
clearPort port = do clearPort port = do
verbose $ "freed port " ++ port verbose $ "freed port " ++ port
state@(AppState { ports, remoteMode }) <- get state@AppState { ports, remoteMode } <- get
let newPorts = filter ((/= port) . fst) ports let newPorts = filter ((/= port) . fst) ports
put $ state { ports = newPorts } put $ state { ports = newPorts }
return () return ()
@ -177,7 +176,7 @@ module System.Serverman.Utils ( App (..)
execIfMissing path action = do execIfMissing path action = do
exists <- ST.liftIO $ doesPathExist path exists <- ST.liftIO $ doesPathExist path
when (not exists) action unless exists action
-- execute an action if a path exists -- execute an action if a path exists
execIfExists :: (Applicative f, Monad f, MonadIO f) => FilePath -> f () -> f () execIfExists :: (Applicative f, Monad f, MonadIO f) => FilePath -> f () -> f ()
@ -196,7 +195,7 @@ module System.Serverman.Utils ( App (..)
appendAfter :: String -> String -> String -> String appendAfter :: String -> String -> String -> String
appendAfter content after line = appendAfter content after line =
let ls = lines content let ls = lines content
appended = concat $ map (\x -> if x == after then [x, line] else [x]) ls appended = concatMap (\x -> if x == after then [x, line] else [x]) ls
in unlines appended in unlines appended
@ -214,21 +213,21 @@ module System.Serverman.Utils ( App (..)
| otherwise = input | otherwise = input
execute :: String -> [String] -> String -> Bool -> App (Either String String) execute :: String -> [String] -> String -> Bool -> App (Either String String)
execute cmd args stdin logErrors = exec cmd args stdin Nothing logErrors execute cmd args stdin = exec cmd args stdin Nothing
-- execute a command in operating system -- execute a command in operating system
-- if in remote mode, runs `execRemote` -- if in remote mode, runs `execRemote`
exec :: String -> [String] -> String -> Maybe FilePath -> Bool -> App (Either String String) exec :: String -> [String] -> String -> Maybe FilePath -> Bool -> App (Either String String)
exec cmd args stdin cwd logErrors = do exec cmd args stdin cwd logErrors = do
verbose $ "exec: " ++ cmd ++ " " ++ show args verbose $ "exec: " ++ cmd ++ " " ++ show args
(AppState { remoteMode }) <- get AppState { remoteMode } <- get
if isJust remoteMode then do if isJust remoteMode then do
let (addr, key) = fromJust remoteMode let (addr, key) = fromJust remoteMode
execRemote addr (Just key) Nothing "" cmd args stdin cwd logErrors execRemote addr (Just key) Nothing "" cmd args stdin cwd logErrors
else do else do
let command = escape $ cmd ++ " " ++ intercalate " " args let command = escape $ cmd ++ " " ++ unwords args
cp = (proc (escape cmd) (map escape args)) { cwd = cwd } cp = (proc (escape cmd) (map escape args)) { cwd = cwd }
verbose $ "executing command |" ++ command ++ "|" verbose $ "executing command |" ++ command ++ "|"
@ -242,7 +241,7 @@ module System.Serverman.Utils ( App (..)
return $ Right stdout return $ Right stdout
Right (ExitFailure code, stdout, stderr) -> do Right (ExitFailure code, stdout, stderr) -> do
when (not logErrors) $ verbose $ "command failed: " ++ show code ++ ", stderr: " ++ stderr unless logErrors $ verbose $ "command failed: " ++ show code ++ ", stderr: " ++ stderr
when logErrors $ do when logErrors $ do
err command err command
err $ "exit code: " ++ show code err $ "exit code: " ++ show code
@ -250,7 +249,7 @@ module System.Serverman.Utils ( App (..)
err stderr err stderr
return $ Left stdout return $ Left stdout
Left e -> do Left e -> do
when (not logErrors) $ verbose $ "couldn't execute command: " ++ show e unless logErrors $ verbose $ "couldn't execute command: " ++ show e
when logErrors $ do when logErrors $ do
err command err command
err $ show e err $ show e
@ -284,12 +283,12 @@ module System.Serverman.Utils ( App (..)
cumulated = p ++ keyArgument ++ options cumulated = p ++ keyArgument ++ options
command = userArgument ++ ["sh -c \"", cmd] ++ args ++ ["\""] command = userArgument ++ ["sh -c \"", cmd] ++ args ++ ["\""]
complete = "-w" : "ssh" : (cumulated ++ [connection] ++ (intersperse " " command)) complete = "-w" : "ssh" : (cumulated ++ [connection] ++ intersperse " " command)
verbose $ "backing up environment variables" verbose "backing up environment variables"
backupEnv <- ST.liftIO getEnvironment backupEnv <- ST.liftIO getEnvironment
when (not . null $ password) $ do unless (null password) $ do
verbose $ "writing passwordFile for SSH " ++ passwordFile ++ " and setting SSH_ASKPASS" verbose $ "writing passwordFile for SSH " ++ passwordFile ++ " and setting SSH_ASKPASS"
ST.liftIO $ do ST.liftIO $ do
writeFile passwordFile $ "echo " ++ password writeFile passwordFile $ "echo " ++ password
@ -297,7 +296,7 @@ module System.Serverman.Utils ( App (..)
setEnv "SSH_ASKPASS" passwordFile True setEnv "SSH_ASKPASS" passwordFile True
state <- get state <- get
let (AppState { remoteMode = backup }) = state let AppState { remoteMode = backup } = state
put $ state { remoteMode = Nothing } put $ state { remoteMode = Nothing }
verbose $ "executing command |setsid " ++ show complete ++ "|" verbose $ "executing command |setsid " ++ show complete ++ "|"
@ -305,7 +304,7 @@ module System.Serverman.Utils ( App (..)
result <- exec "setsid" complete stdin cwd logErrors result <- exec "setsid" complete stdin cwd logErrors
put $ state { remoteMode = backup } put $ state { remoteMode = backup }
verbose $ "reseting environment and deleting password file" verbose "reseting environment and deleting password file"
ST.liftIO $ do ST.liftIO $ do
setEnvironment backupEnv setEnvironment backupEnv
execIfExists passwordFile $ removeFile passwordFile execIfExists passwordFile $ removeFile passwordFile
@ -322,7 +321,7 @@ module System.Serverman.Utils ( App (..)
foldl' rep "" str foldl' rep "" str
where where
rep acc n rep acc n
| takeEnd (l - 1) acc ++ [n] == replacable = (dropEnd (l - 1) acc) ++ alt | takeEnd (l - 1) acc ++ [n] == replacable = dropEnd (l - 1) acc ++ alt
| otherwise = acc ++ [n] | otherwise = acc ++ [n]
l = length replacable l = length replacable
@ -336,7 +335,7 @@ module System.Serverman.Utils ( App (..)
-- execute using sudo -- execute using sudo
executeRoot :: String -> [String] -> String -> Bool -> App (Either String String) executeRoot :: String -> [String] -> String -> Bool -> App (Either String String)
executeRoot cmd args stdin logErrors = execute "sudo" (cmd:args) stdin logErrors executeRoot cmd args = execute "sudo" (cmd:args)
-- read password from user input (don't show the input) -- read password from user input (don't show the input)
getPassword :: IO String getPassword :: IO String
@ -353,4 +352,4 @@ module System.Serverman.Utils ( App (..)
indent (keyvalue tabularized " ") indent (keyvalue tabularized " ")
where where
maxKey = maximum $ map (length . fst) entries maxKey = maximum $ map (length . fst) entries
tabularized = map (\(key, value) -> (key ++ (replicate (maxKey - length key + 1) ' '), value)) entries tabularized = map (\(key, value) -> (key ++ replicate (maxKey - length key + 1) ' ', value)) entries

45
src/System/Term.hs
View File

@ -1,4 +1,3 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
@ -29,7 +28,7 @@ module System.Term ( initialize ) where
-- parse parameters -- parse parameters
let params = parseParams args let params = parseParams args
isHelp = or $ map (`elem` args) ["help", "--help", "-h", "-?"] isHelp = any (`elem` args) ["help", "--help", "-h", "-?"]
-- Fetch repository first -- Fetch repository first
S.runApp $ do S.runApp $ do
@ -41,34 +40,34 @@ module System.Term ( initialize ) where
verbose $ show params verbose $ show params
-- fetch repository if running for the first time, set state -- fetch repository if running for the first time, set state
S.run (S.fetchRepository) S.run S.fetchRepository
-- detect local operating system -- detect local operating system
S.run (S.detectOS) S.run S.detectOS
state@(S.AppState { S.repository }) <- get state@S.AppState { S.repository } <- get
put $ state { arguments = rest params, helpArg = isHelp } put $ state { arguments = rest params, helpArg = isHelp }
case params of case params of
-- list services in repository -- list services in repository
(Params { listServices = True }) -> do Params { listServices = True } ->
mapM_ (write . show) repository mapM_ (write . show) repository
-- install a service -- install a service
p@(Params { install = Just service }) -> do p@Params { install = Just service } -> do
verbose $ "preparing to install " ++ service verbose $ "preparing to install " ++ service
ms <- findService service ms <- findService service
case ms of case ms of
Just s -> handleRemote p $ S.install s Just s -> handleRemote p $ S.install s
Nothing -> die $ "service not found: " ++ service Nothing -> die $ "service not found: " ++ service
p@(Params { update = True }) -> S.run (S.updateRepository) p@Params { update = True } -> S.run S.updateRepository
p@(Params { manage = Just (act, service) }) -> do p@Params { manage = Just (act, service) } -> do
verbose $ "preparing to " ++ show act ++ " " ++ service verbose $ "preparing to " ++ show act ++ " " ++ service
ms <- findService service ms <- findService service
case ms of case ms of
Just s -> do Just s ->
case act of case act of
Start -> Start ->
handleRemote p $ S.start s handleRemote p $ S.start s
@ -79,7 +78,7 @@ module System.Term ( initialize ) where
die $ "could not find any service matching " ++ service die $ "could not find any service matching " ++ service
-- install and call a service -- install and call a service
p@(Params { rest = (x:xs), remote }) -> do p@Params { rest = (x:xs), remote } ->
case x of case x of
(service, Nothing) -> do (service, Nothing) -> do
verbose $ "preparing to call " ++ service verbose $ "preparing to call " ++ service
@ -87,12 +86,12 @@ module System.Term ( initialize ) where
ms <- findService service ms <- findService service
case ms of case ms of
Just s -> do Just s -> do
when (not isHelp) $ do unless isHelp $
handleRemote p $ S.install s handleRemote p (S.install s)
S.run $ S.call s remote S.run $ S.call s remote
Nothing -> do Nothing ->
if isHelp then if isHelp then
servermanHelp servermanHelp
else else
@ -101,7 +100,7 @@ module System.Term ( initialize ) where
-- after the program is done, terminate remaining processes -- after the program is done, terminate remaining processes
-- and unmount/remove leftover temporary directories -- and unmount/remove leftover temporary directories
state@(S.AppState { S.processes, S.temps }) <- get state@S.AppState { S.processes, S.temps } <- get
put $ state { remoteMode = Nothing } put $ state { remoteMode = Nothing }
mapM_ (liftIO . terminateProcess) processes mapM_ (liftIO . terminateProcess) processes
@ -115,10 +114,10 @@ module System.Term ( initialize ) where
liftIO $ removeDirectoryRecursive path liftIO $ removeDirectoryRecursive path
-- if remote mode is set, read the file and run the action -- if remote mode is set, read the file and run the action
-- on servers, otherwise run action locally -- on servers, otherwise run action locally
handleRemote (Params { remote = Just file }) action = do handleRemote Params { remote = Just file } action = do
list <- liftIO $ map read . lines <$> readFile file list <- liftIO $ filter (not . null) . lines <$> readFile file
S.run (S.remote list action) S.run (S.remote (map read list) action)
handleRemote (Params { remote = Nothing }) action = S.run action handleRemote Params { remote = Nothing } action = S.run action
servermanHelp = do servermanHelp = do
write "serverman [--options] [command/service] [--service-options]" write "serverman [--options] [command/service] [--service-options]"
@ -145,7 +144,7 @@ module System.Term ( initialize ) where
} }
instance Show Params where instance Show Params where
show (Params { listServices, install, manage, update, remote, rest, verboseM }) = show Params { listServices, install, manage, update, remote, rest, verboseM } =
keyvalue [ ("list-services", show listServices) keyvalue [ ("list-services", show listServices)
, ("install", show install) , ("install", show install)
, ("manage", show manage) , ("manage", show manage)
@ -177,9 +176,9 @@ module System.Term ( initialize ) where
toPairs [] = [] toPairs [] = []
toPairs [x] = [(getWord x, Nothing)] toPairs [x] = [(getWord x, Nothing)]
toPairs (x:y:xs) toPairs (x:y:xs)
| flagName x && value y = [(getWord x, Just y)] ++ toPairs xs | flagName x && value y = (getWord x, Just y) : toPairs xs
| flagName y && value x = [(getWord x, Nothing)] ++ toPairs (y:xs) | flagName y && value x = (getWord x, Nothing) : toPairs (y:xs)
| flagName x && flagName y = [(getWord x, Nothing)] ++ toPairs (y:xs) | flagName x && flagName y = (getWord x, Nothing) : toPairs (y:xs)
| otherwise = toPairs xs | otherwise = toPairs xs
flagName = isPrefixOf "-" flagName = isPrefixOf "-"