1 module Main (main) where
6 import Directory (setCurrentDirectory)
7 import System ( getEnv, exitWith, ExitCode(..) )
17 Standard shell practice: move std descriptors out of the way so
18 it's more convenient to set them up for children. Also set up an
19 interrupt handler which will put us back in the main loop.
24 dupTo stdInput myStdin >>
25 dupTo stdOutput myStdout >>
26 dupTo stdError myStderr >>
29 -- fdClose stdError >>
30 installHandler sigINT (Catch intr) Nothing >>
33 -- some random fd numbers...
38 -- For user interrupts
42 fdWrite myStdout "\n" >>
46 Simple command loop: print a prompt, read a command, process the command.
52 fdWrite myStdout "$ " >>
53 try (readCommand myStdin) >>=
56 if isEOFError err then
61 try (processCommand cmd) >>= either (\ err -> commandLoop) (\ succ -> commandLoop))
67 exitWith (ExitFailure 1)
70 Read a command a character at a time (to allow for fancy processing later).
71 On newline, you're done, unless the newline was escaped by a backslash.
74 readCommand :: Fd -> IO String
76 accumString "" >>= \ cmd ->
79 accumString :: String -> IO String
81 myGetChar fd >>= \ c ->
84 myGetChar fd >>= \ c' ->
86 '\n' -> return (reverse s)
87 ch -> accumString (ch:s)
89 myGetChar :: Fd -> IO Char
92 (s,len) <- fdRead chan 1
98 To process a command, first parse it into words, then do the necessary
99 redirections, and finally perform the desired command. Built-ins are
100 checked first, and if none match, we execute an external command.
103 processCommand :: String -> IO ()
104 processCommand "" = return ()
107 words <- parseCommand s
108 (inFile, outFile, words) <- parseRedirection words
109 performRedirections inFile outFile
119 Nothing -> exec cmd args
122 Redirections are a bit of a pain, really. If none are specified, we
123 dup our own file descriptors. Otherwise, we try to open the files
127 performRedirections :: Maybe String -> Maybe String -> IO ()
128 performRedirections inFile outFile =
130 Nothing -> dupTo myStdin stdInput
132 try (openFd x ReadOnly Nothing defaultFileFlags)
136 errMsg ("Can't redirect input from " ++ x) >>
137 fail (userError "redirect"))
138 (\ succ -> return ())) >>
141 dupTo myStdout stdOutput
143 try (createFile x stdFileMode) >>=
147 errMsg ("Can't redirect output to " ++ x)
149 fail (userError "redirect"))
150 (\ succ -> return ()))
153 We parse a command line into words according to the following rules:
154 1) Anything inside pairs of "" or '' is parsed literally.
155 2) Anything (outside of quotes) escaped by \ is taken literally.
156 3) '<' and '>' are words all by themselves, unless escaped or quoted.
157 4) Whitespace separates words
160 parseCommand :: String -> IO [String]
161 parseCommand = getTokens []
163 getTokens :: [String] -> String -> IO [String]
164 getTokens ts "" = return (reverse ts)
165 getTokens ts (c:cs) | isSpace c = getTokens ts cs
167 getToken s >>= \ (t, s') ->
170 getToken :: String -> IO (String, String)
172 | c == '<' || c == '>' = return ([c], cs)
173 | c == '"' || c == '\'' = accumQuote c "" cs
174 | otherwise = accumToken [c] cs
176 accumToken :: [Char] -> String -> IO (String, String)
177 accumToken cs "" = return (reverse cs, "")
178 accumToken cs ('\\':c:s) = accumToken (c:cs) s
179 accumToken cs x@(c:s)
180 | isSpace c || c == '<' || c == '>' = return (reverse cs, x)
181 | c == '"' || c == '\'' = accumQuote c cs s
182 | otherwise = accumToken (c:cs) s
184 accumQuote :: Char -> [Char] -> String -> IO (String, String)
186 errMsg ("Unmatched " ++ [q]) >>
187 fail (userError "unmatched quote")
188 accumQuote q cs (c:s)
189 | c == q = accumToken cs s
190 | otherwise = accumQuote q (c:cs) s
193 Here we look for "<" and ">". When we find one, we remove it and the
194 following word from the word list. The arguments following the redirection
195 symbols and the remaining words are returned to our caller. However, it's
196 an error to end a word list with a redirection or for the same redirection
200 parseRedirection :: [String] -> IO (Maybe String, Maybe String, [String])
201 parseRedirection = redirect Nothing Nothing []
203 redirect inFile outFile args [] =
204 return (inFile, outFile, reverse args)
205 redirect inFile outFile args [arg]
206 | arg == "<" || arg == ">" =
207 errMsg "Missing name for redirect" >>
208 fail (userError "parse redirect")
210 return (inFile, outFile, reverse (arg:args))
211 redirect inFile outFile args ("<":name:more)
212 | inFile == Nothing =
213 redirect (Just name) outFile args more
215 errMsg "Ambiguous input redirect" >>
216 fail (userError "parse redirect")
217 redirect inFile outFile args (">":name:more)
218 | outFile == Nothing =
219 redirect inFile (Just name) args more
221 errMsg "Ambiguous output redirect" >>
222 fail (userError "parse redirect")
223 redirect inFile outFile args (arg:more) =
224 redirect inFile outFile (arg:args) more
227 Executing an external command is pretty simple, but what if it fails?
228 Fortunately, we don't have any way to redirect stdError just yet,
229 so we let it complain and then exit.
232 exec :: String -> [String] -> IO ()
234 forkProcess >>= \ maybe_pid ->
238 dupTo myStderr stdError
242 executeFile cmd True args Nothing
245 fdWrite stdError ("command not found: " ++ cmd ++ ".\n") >>
246 exitImmediately (ExitFailure 1))
252 getProcessStatus True False pid
257 cd [arg] -> change directory (default to HOME)
258 exit ... -> exit successfully
260 Builtins must provide their own error messages, since the main command
261 loop ignores any errors.
264 builtin :: String -> Maybe ([String] -> IO ())
265 builtin "cd" = Just chdir
266 builtin "exit" = Just exit
269 chdir :: [String] -> IO ()
272 home <- getEnv "HOME"
273 setCurrentDirectory home `catch` \ err -> errMsg "cd: can't go home"
277 setCurrentDirectory dir `catch` \ err -> errMsg ("cd: can't chdir to " ++ dir)
278 chdir _ = errMsg "cd: too many arguments"
280 exit :: [String] -> IO ()
281 exit _ = exitWith ExitSuccess
283 -- Print an error message to my std error.
285 errMsg :: String -> IO ()
287 fdWrite myStderr ("hsh: " ++ msg ++ ".\n") >>