From 5cbfe4e7d5cd2550ccb848a850366c27a4f5d999 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Wed, 5 Jul 2000 17:16:02 +0000
Subject: [PATCH] [project @ 2000-07-05 17:16:02 by simonmar] bullet-proof the
package code a bit more; check for write access to the configuration file
before doing anything, check whether we're adding a package that's already
there, etc.
---
ghc/driver/Main.hs | 35 +++++++++++++++++++++++++++--------
1 file changed, 27 insertions(+), 8 deletions(-)
diff --git a/ghc/driver/Main.hs b/ghc/driver/Main.hs
index 7910f9d8446f..883c0920809d 100644
--- a/ghc/driver/Main.hs
+++ b/ghc/driver/Main.hs
@@ -549,18 +549,45 @@ listPackages = do
newPackage :: IO ()
newPackage = do
+ checkConfigAccess
+ details <- readIORef package_details
hPutStr stdout "Reading package info from stdin... "
stuff <- getContents
let new_pkg = read stuff :: (String,Package)
catchAll new_pkg
(\e -> throwDyn (OtherError "parse error in package info"))
hPutStrLn stdout "done."
+ if (fst new_pkg `elem` map fst details)
+ then throwDyn (OtherError ("package `" ++ fst new_pkg ++
+ "' already installed"))
+ else do
conf_file <- readIORef package_config
savePackageConfig conf_file
maybeRestoreOldConfig conf_file $ do
writeNewConfig conf_file ( ++ [new_pkg])
exitWith ExitSuccess
+deletePackage :: String -> IO ()
+deletePackage pkg = do
+ checkConfigAccess
+ details <- readIORef package_details
+ if (pkg `notElem` map fst details)
+ then throwDyn (OtherError ("package `" ++ pkg ++ "' not installed"))
+ else do
+ conf_file <- readIORef package_config
+ savePackageConfig conf_file
+ maybeRestoreOldConfig conf_file $ do
+ writeNewConfig conf_file (filter ((/= pkg) . fst))
+ exitWith ExitSuccess
+
+checkConfigAccess :: IO ()
+checkConfigAccess = do
+ conf_file <- readIORef package_config
+ access <- fileAccess conf_file True True False
+ if not access
+ then throwDyn (OtherError "you don't have permission to modify the package configuration file")
+ else return ()
+
maybeRestoreOldConfig :: String -> IO () -> IO ()
maybeRestoreOldConfig conf_file io
= catchAllIO io (\e -> do
@@ -590,14 +617,6 @@ savePackageConfig conf_file = do
system ("mv " ++ conf_file ++ " " ++ conf_file ++ ".old")
hPutStrLn stdout "done."
-deletePackage :: String -> IO ()
-deletePackage pkg = do
- conf_file <- readIORef package_config
- savePackageConfig conf_file
- maybeRestoreOldConfig conf_file $ do
- writeNewConfig conf_file (filter ((/= pkg) . fst))
- exitWith ExitSuccess
-
-- package list is maintained in dependency order
packages = global ["std", "rts", "gmp"] :: IORef [String]
-- comma in value, so can't use macro, grrr
--
GitLab