13 Standard shell practice: move std descriptors out of the way so
14 it's more convenient to set them up for children. Also set up an
15 interrupt handler which will put us back in the main loop.
20 dupChannelTo stdInput myStdin >>
21 dupChannelTo stdOutput myStdout >>
22 dupChannelTo stdError myStderr >>
23 closeChannel stdInput >>
24 closeChannel stdOutput >>
25 -- closeChannel stdError >>
26 installHandler sigINT (Catch intr) Nothing >>
29 myStdin = 16 :: Channel
30 myStdout = 17 :: Channel
31 myStderr = 18 :: Channel
33 -- For user interrupts
37 writeChannel myStdout "\n" >>
41 Simple command loop: print a prompt, read a command, process the command.
47 writeChannel myStdout "$ " >>
48 try (readCommand myStdin) >>=
54 try (processCommand cmd) >>=
56 (\ err -> commandLoop)
57 (\ succ -> commandLoop))
61 errMsg "read failed" >>
62 exitWith (ExitFailure 1)
65 Read a command a character at a time (to allow for fancy processing later).
66 On newline, you're done, unless the newline was escaped by a backslash.
69 readCommand :: Channel -> IO String
71 accumString "" >>= \ cmd ->
74 accumString :: String -> IO String
76 myGetChar chan >>= \ c ->
79 myGetChar chan >>= \ c' ->
81 '\n' -> return (reverse s)
82 ch -> accumString (ch:s)
84 myGetChar :: Channel -> IO Char
86 readChannel chan 1 >>= \ (s, len) ->
92 To process a command, first parse it into words, then do the necessary
93 redirections, and finally perform the desired command. Built-ins are
94 checked first, and if none match, we execute an external command.
97 processCommand :: String -> IO ()
98 processCommand "" = return ()
100 parseCommand s >>= \ words ->
101 parseRedirection words >>= \ (inFile, outFile, words) ->
102 performRedirections inFile outFile >>
110 closeChannel stdInput >>
111 closeChannel stdOutput
116 Redirections are a bit of a pain, really. If none are specified, we
117 dupChannel our own file descriptors. Otherwise, we try to open the files
121 performRedirections :: Maybe String -> Maybe String -> IO ()
122 performRedirections inFile outFile =
125 dupChannelTo myStdin stdInput
127 try (openChannel x ReadOnly Nothing False False False False False)
131 errMsg ("Can't redirect input from " ++ x)
133 failWith (UserError "redirect"))
134 (\ succ -> return ())) >>
137 dupChannelTo myStdout stdOutput
139 try (createFile x stdFileMode)
143 errMsg ("Can't redirect output to " ++ x)
145 closeChannel stdInput >>
146 failWith (UserError "redirect"))
147 (\ succ -> return ()))
150 We parse a command line into words according to the following rules:
151 1) Anything inside pairs of "" or '' is parsed literally.
152 2) Anything (outside of quotes) escaped by \ is taken literally.
153 3) '<' and '>' are words all by themselves, unless escaped or quoted.
154 4) Whitespace separates words
157 parseCommand :: String -> IO [String]
158 parseCommand = getTokens []
160 getTokens :: [String] -> String -> IO [String]
161 getTokens ts "" = return (reverse ts)
163 getToken s >>= \ (t, s') ->
166 getToken :: String -> IO (String, String)
168 | c == '<' || c == '>' = return ([c], cs)
169 | isSpace c = getToken cs
170 | c == '"' || c == '\'' = accumQuote c "" cs
171 | otherwise = accumToken [c] cs
173 accumToken :: [Char] -> String -> IO (String, String)
174 accumToken cs "" = return (reverse cs, "")
175 accumToken cs ('\\':c:s) = accumToken (c:cs) s
176 accumToken cs x@(c:s)
177 | isSpace c || c == '<' || c == '>' = return (reverse cs, x)
178 | c == '"' || c == '\'' = accumQuote c cs s
179 | otherwise = accumToken (c:cs) s
181 accumQuote :: Char -> [Char] -> String -> IO (String, String)
183 errMsg ("Unmatched " ++ [q]) >>
184 failWith (UserError "unmatched quote")
185 accumQuote q cs (c:s)
186 | c == q = accumToken cs s
187 | otherwise = accumQuote q (c:cs) s
190 Here we look for "<" and ">". When we find one, we remove it and the
191 following word from the word list. The arguments following the redirection
192 symbols and the remaining words are returned to our caller. However, it's
193 an error to end a word list with a redirection or for the same redirection
197 parseRedirection :: [String] -> IO (Maybe String, Maybe String, [String])
198 parseRedirection = redirect Nothing Nothing []
200 redirect inFile outFile args [] =
201 return (inFile, outFile, reverse args)
202 redirect inFile outFile args [arg]
203 | arg == "<" || arg == ">" =
204 errMsg "Missing name for redirect" >>
205 failWith (UserError "parse redirect")
207 return (inFile, outFile, reverse (arg:args))
208 redirect inFile outFile args ("<":name:more)
209 | inFile == Nothing =
210 redirect (Just name) outFile args more
212 errMsg "Ambiguous input redirect" >>
213 failWith (UserError "parse redirect")
214 redirect inFile outFile args (">":name:more)
215 | outFile == Nothing =
216 redirect inFile (Just name) args more
218 errMsg "Ambiguous output redirect" >>
219 failWith (UserError "parse redirect")
220 redirect inFile outFile args (arg:more) =
221 redirect inFile outFile (arg:args) more
224 Executing an external command is pretty simple, but what if it fails?
225 Fortunately, we don't have any way to redirect stdError just yet,
226 so we let it complain and then exit.
229 exec :: String -> [String] -> IO ()
231 forkProcess >>= \ maybe_pid ->
234 dupChannelTo myStderr stdError >>
235 closeChannel myStdin >>
236 closeChannel myStdout >>
237 closeChannel myStderr >>
238 executeFile cmd True args Nothing `handle`
240 writeChannel stdError ("command not found: " ++ cmd ++ ".\n")
242 exitImmediately (ExitFailure 1)
244 closeChannel stdInput >>
245 closeChannel stdOutput >>
246 -- closeChannel stdError >>
247 getProcessStatus True False pid >>
252 cd [arg] -> change directory (default to HOME)
253 exit ... -> exit successfully
255 Builtins must provide their own error messages, since the main command
256 loop ignores any errors.
259 builtin :: String -> Maybe ([String] -> IO ())
260 builtin "cd" = Just chdir
261 builtin "exit" = Just exit
264 chdir :: [String] -> IO ()
266 getEnvVar "HOME" >>= \ home ->
267 changeWorkingDirectory home `handle`
268 \ err -> errMsg "cd: can't go home"
271 changeWorkingDirectory dir `handle`
272 \ err -> errMsg ("cd: can't chdir to " ++ dir)
274 errMsg "cd: too many arguments"
276 exit :: [String] -> IO ()
277 exit _ = exitWith ExitSuccess
279 -- Print an error message to my std error.
281 errMsg :: String -> IO ()
283 writeChannel myStderr ("hsh: " ++ msg ++ ".\n") >>