[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.

diff --git a/ghc/driver/Main.hs b/ghc/driver/Main.hs
index 7910f9d..883c092 100644 (file)
--- a/ghc/driver/Main.hs
+++ b/ghc/driver/Main.hs
@@ -549,18 +549,45 @@ listPackages = do
 
 newPackage :: IO ()
 newPackage = 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."
   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
 
   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
 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."
 
   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
 -- package list is maintained in dependency order
 packages = global ["std", "rts", "gmp"] :: IORef [String]
 -- comma in value, so can't use macro, grrr