Commit 5cbfe4e7 authored by simonmar's avatar simonmar
Browse files

[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.
parent b2d52fc9
...@@ -549,18 +549,45 @@ listPackages = do ...@@ -549,18 +549,45 @@ listPackages = do
newPackage :: IO () newPackage :: IO ()
newPackage = do newPackage = do
checkConfigAccess
details <- readIORef package_details
hPutStr stdout "Reading package info from stdin... " hPutStr stdout "Reading package info from stdin... "
stuff <- getContents stuff <- getContents
let new_pkg = read stuff :: (String,Package) let new_pkg = read stuff :: (String,Package)
catchAll new_pkg catchAll new_pkg
(\e -> throwDyn (OtherError "parse error in package info")) (\e -> throwDyn (OtherError "parse error in package info"))
hPutStrLn stdout "done." 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 conf_file <- readIORef package_config
savePackageConfig conf_file savePackageConfig conf_file
maybeRestoreOldConfig conf_file $ do maybeRestoreOldConfig conf_file $ do
writeNewConfig conf_file ( ++ [new_pkg]) writeNewConfig conf_file ( ++ [new_pkg])
exitWith ExitSuccess 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 :: String -> IO () -> IO ()
maybeRestoreOldConfig conf_file io maybeRestoreOldConfig conf_file io
= catchAllIO io (\e -> do = catchAllIO io (\e -> do
...@@ -590,14 +617,6 @@ savePackageConfig conf_file = do ...@@ -590,14 +617,6 @@ savePackageConfig conf_file = do
system ("mv " ++ conf_file ++ " " ++ conf_file ++ ".old") system ("mv " ++ conf_file ++ " " ++ conf_file ++ ".old")
hPutStrLn stdout "done." 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 -- package list is maintained in dependency order
packages = global ["std", "rts", "gmp"] :: IORef [String] packages = global ["std", "rts", "gmp"] :: IORef [String]
-- comma in value, so can't use macro, grrr -- comma in value, so can't use macro, grrr
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment