ghc-pkg too happy to create ~/.ghc

[Ian Lynagh]

Hi,

The Debian autobuilders don't let you write to ~ (which seems
reasonable, as they are only compiling the software, not running it), so
my builds are failing with

----------
==fptools== /usr/bin/make boot -wr;
 in /build/buildd/ghc6-6.4/ghc/rts
[...]
../utils/ghc-pkg/ghc-pkg-inplace --force --update-package <package.conf.inplace
Creating user package database in /org/buildd/.ghc/sparc-linux-6.4/package.conf

Fail: createDirectory: permission denied (Permission denied)
----------

The patch below fixes it. I'm not sure I understand why the code is
written as it is, though. It looks to me like if any config file given
by a FlagConfig is missing then the readFile in readParseDatabase is
going to fall over. I don't know what should happen when modifying if
there are -f options, so can't suggest a complete replacement.


Thanks
Ian


--- ghc6-6.4.orig/ghc/utils/ghc-pkg/Main.hs
+++ ghc6-6.4/ghc/utils/ghc-pkg/Main.hs
@@ -269,10 +269,6 @@
    archdir   = appdir `joinFileName` subdir
    user_conf = archdir `joinFileName` "package.conf"
   b <- doesFileExist user_conf
-  when (not b) $ do
-   putStrLn ("Creating user package database in " ++ user_conf)
-   createDirectoryIfMissing True archdir
-   writeFile user_conf emptyPackageConfig

   let
    -- The semantics here are slightly strange.  If we are
@@ -281,20 +277,23 @@
    -- If we are not modifying (eg. list, describe etc.) then
    -- the user database is included by default.
    databases
-     | modify     = foldl addDB [global_conf] flags
-     | not modify = foldl addDB [user_conf,global_conf] flags
+     | modify || not b = foldl addDB [global_conf] flags
+     | not modify      = foldl addDB [user_conf,global_conf] flags

    -- implement the following rules:
    --  --user means overlap with the user database
    --  --global means reset to just the global database
    --  -f <file> means overlap with <file>
-   addDB dbs FlagUser       = if user_conf `elem` dbs 
-                   then dbs 
-                   else user_conf : dbs
+   addDB dbs FlagUser
+    | (modify || b) && (user_conf `notElem` dbs) = user_conf : dbs
    addDB dbs FlagGlobal     = [global_conf]
    addDB dbs (FlagConfig f) = f : dbs
    addDB dbs _      = dbs

+  when (not b && user_conf `elem` databases) $ do
+   putStrLn ("Creating user package database in " ++ user_conf)
+   createDirectoryIfMissing True archdir
+   writeFile user_conf emptyPackageConfig
   db_stack <- mapM readParseDatabase databases
   return db_stack