I attached a fix which will NOT source a suspicious file and print out
a warning. Could anyone with Wintendo please confirm that the Posix-stuff
doesn't break anything for them?
--
Abstrakte Syntaxträume.
Volker Stolz * [EMAIL PROTECTED] * PGP + S/MIME
--- ghci/InteractiveUI.orig Mon Apr 30 09:41:28 2001
+++ ghci/InteractiveUI.hs Mon Apr 30 10:27:08 2001
@@ -40,12 +40,13 @@
import Directory
import IO
import Char
-import Monad ( when )
+import Monad ( when, unless )
import PrelGHC ( unsafeCoerce# )
import Foreign ( nullPtr )
import CString ( peekCString )
+import Posix
-----------------------------------------------------------------------------
ghciWelcomeMsg = "\
@@ -144,14 +145,33 @@
options = [ShowTiming] }
return ()
-
+-- check permissions on .ghci files, so we don't slurp any nasty stuff like ":! rm
+-rf"
+checkPerms :: String -> IO Bool
+checkPerms name = do
+ Exception.catch (do
+ st <- getFileStatus name
+ let owner = fileOwner st
+ me <- getRealUserID
+ if owner /= me then do
+ putStrLn $ "*** WARNING: " ++ name ++ " is owned by someone else, IGNORING!"
+ return False
+ else do
+ let mode = fileMode st
+ if (groupWriteMode == (mode `intersectFileModes` groupWriteMode)) ||
+(otherWriteMode == (mode `intersectFileModes` otherWriteMode)) then do
+ putStrLn $ "*** WARNING: " ++ name ++ " is writeable by someone else,
+IGNORING!"
+ return False
+ else return True
+ ) ( \_ -> return True) -- doesn't really matter
+
runGHCi :: GHCi ()
runGHCi = do
-- read in ./.ghci
- dot_ghci <- io (IO.try (openFile "./.ghci" ReadMode))
- case dot_ghci of
- Left e -> return ()
- Right hdl -> fileLoop hdl False
+ c <- io $ checkPerms "./.ghci"
+ when c $ do
+ dot_ghci <- io (IO.try (openFile "./.ghci" ReadMode))
+ case dot_ghci of
+ Left e -> return ()
+ Right hdl -> fileLoop hdl False
-- read in ~/.ghci
home <- io (IO.try (getEnv "HOME"))
@@ -160,11 +180,13 @@
Right dir -> do
cwd <- io (getCurrentDirectory)
when (dir /= cwd) $ do
- dot_ghci <- io (IO.try (openFile (dir ++ "/.ghci") ReadMode))
- case dot_ghci of
- Left e -> return ()
- Right hdl -> fileLoop hdl False
-
+ let file = dir ++ "/.ghci"
+ c <- io $ checkPerms file
+ when c $ do
+ dot_ghci <- io (IO.try (openFile file ReadMode))
+ case dot_ghci of
+ Left e -> return ()
+ Right hdl -> fileLoop hdl False
-- read commands from stdin
#ifndef NO_READLINE
readlineLoop
@@ -185,20 +207,18 @@
case l of
Left e | isEOFError e -> return ()
| otherwise -> throw e
- Right l ->
- case remove_spaces l of
- "" -> fileLoop hdl prompt
- l -> do quit <- runCommand l
- if quit then return () else fileLoop hdl prompt
+ Right l -> do
+ let l = remove_spaces l
+ quit <- runCommand l
+ unless quit $ fileLoop hdl prompt
stringLoop :: [String] -> GHCi ()
stringLoop [] = return ()
stringLoop (s:ss) = do
- st <- getGHCiState
- case remove_spaces s of
- "" -> stringLoop ss
- l -> do quit <- runCommand l
- if quit then return () else stringLoop ss
+ -- XXX [vs] NOP? st <- getGHCiState
+ let l = remove_spaces s
+ quit <- runCommand l
+ unless quit $ stringLoop ss
#ifndef NO_READLINE
readlineLoop :: GHCi ()
@@ -210,16 +230,17 @@
Nothing -> return ()
Just l ->
case remove_spaces l of
- "" -> readlineLoop
- l -> do
- io (addHistory l)
- quit <- runCommand l
- if quit then return () else readlineLoop
+ "" -> readlineLoop
+ l -> do
+ io (addHistory l)
+ quit <- runCommand l
+ unless quit readlineLoop
#endif
-- Top level exception handler, just prints out the exception
-- and carries on.
runCommand :: String -> GHCi Bool
+runCommand "" = return False
runCommand c =
ghciHandle ( \exception ->
(case exception of
PGP signature
