diff --git a/.hub b/.hub deleted file mode 100644 --- a/.hub +++ /dev/null @@ -1,1 +0,0 @@ -build-hub diff --git a/Hub/Commands.hs b/Hub/Commands.hs --- a/Hub/Commands.hs +++ b/Hub/Commands.hs @@ -56,8 +56,9 @@ _prog :: Hub -> Prog -> [String] -> IO () -_prog = execProg HubO (EE InheritRS InheritRS []) FullMDE - +_prog hub prog as = execProg HubO (EE InheritRS InheritRS [] ftr) FullMDE hub prog as + where + ftr = hub_ftr_env $ enmPROG prog _default :: IO () _default = defaultGlobalHubName >>= putStrLn @@ -200,10 +201,10 @@ _gc = gcDefaultDirectory discover VerboseGCM _list :: Hub -> IO () -_list hub = execP HubO (EE InheritRS InheritRS []) FullMDE hub Ghc_pkgP ["list"] +_list hub = execP HubO (EE InheritRS InheritRS [] []) FullMDE hub Ghc_pkgP ["list"] _check :: Hub -> IO () -_check hub = execP HubO (EE InheritRS InheritRS []) FullMDE hub Ghc_pkgP ["check"] +_check hub = execP HubO (EE InheritRS InheritRS [] []) FullMDE hub Ghc_pkgP ["check"] _save :: Hub -> IO () _save = save @@ -246,7 +247,7 @@ _install :: Hub -> [PkgNick] -> IO () _install hub pkns = do notLocked hub - execP HubO (EE InheritRS InheritRS []) FullMDE hub CabalP + execP HubO (EE InheritRS InheritRS [] []) FullMDE hub CabalP ("install":map prettyPkgNick pkns) _erase :: Hub -> [PkgNick] -> Bool -> IO () @@ -272,5 +273,5 @@ where fmt pkn = " " ++ prettyPkgNick pkn - unreg pkn = execP HubO (EE InheritRS DiscardRS []) UserMDE hub + unreg pkn = execP HubO (EE InheritRS DiscardRS [] []) UserMDE hub Ghc_pkgP ["unregister",prettyPkgNick pkn] diff --git a/Hub/Directory.hs b/Hub/Directory.hs --- a/Hub/Directory.hs +++ b/Hub/Directory.hs @@ -391,7 +391,7 @@ pkg_init :: Hub -> FilePath -> IO () pkg_init hub fp = - execP HubO (EE InheritRS InheritRS []) FullMDE hub Ghc_pkgP ["init",fp] + execP HubO (EE InheritRS InheritRS [] []) FullMDE hub Ghc_pkgP ["init",fp] user_hub_paths :: HubName -> IO (FilePath,FilePath,FilePath) diff --git a/Hub/Hub.hs b/Hub/Hub.hs --- a/Hub/Hub.hs +++ b/Hub/Hub.hs @@ -25,10 +25,12 @@ , Mode(..) , execP , execProg + , hub_ftr_env ) where import Data.Char import Text.Printf +--import System.IO import System.Exit import System.FilePath import System.Environment @@ -118,7 +120,24 @@ _ -> return () (exe,args,tdy) <- mk_prog hub prog args0 pth0 <- getEnv "PATH" - let ee = ee0 { extendEnvtEE = hub_env mde hub pth0 ++ extendEnvtEE ee0 } + let p = enmPROG prog + ee = + ee0 + { extendEnvtEE = hub_env p mde hub pth0 ++ extendEnvtEE ee0 + , filterEnvtEE = hub_ftr_env p ++ filterEnvtEE ee0 + } + -- h <- openFile "/hub/src/exec.log" AppendMode + -- hPutStrLn h "----- ee -------------" + -- hPutStrLn h $ show ee + -- hPutStrLn h "----- exe ------------" + -- hPutStrLn h $ show exe + -- hPutStrLn h "----- args -----------" + -- hPutStrLn h $ show args + -- hPutStrLn h "----- tdy ------------" + -- hPutStrLn h $ show tdy + -- hPutStrLn h "----------------------" + -- hPutStrLn h "" + -- hClose h ec <- exec ee exe args case tdy of Nothing -> return () @@ -152,7 +171,8 @@ db <- hubUserPackageDBPath hub let _ld = "--libdir=" ++ hd _pd = "--package-db=" ++ db - return ( cmd : _ld : _pd : as', Just hd ) + _hc = "--with-hsc2hs=hsc2hs" + return ( cmd : _ld : _pd : _hc : as', Just hd ) prog_name :: Hub -> Prog -> FilePath prog_name hub prog = @@ -160,11 +180,11 @@ (CabalP,Just ci_vrn) -> nmePROG prog ++ "-" ++ ci_vrn _ -> nmePROG prog -hub_env :: Mode -> Hub -> String -> [(String,String)] -hub_env mde hub pth0 = concat +hub_env :: P -> Mode -> Hub -> String -> [(String,String)] +hub_env p mde hub pth0 = concat [ [ (,) "HUB" hnm ] , [ (,) "PATH" pth | is_usr ] - , [ (,) "GHC_PACKAGE_PATH" ppt | is_usr ] + , [ (,) "GHC_PACKAGE_PATH" ppt | is_usr && p /= CabalP ] ] where is_usr = hk /= GlbHK @@ -183,6 +203,10 @@ hk = kind__HUB hub mb_usr = usr___HUB hub glb = glb_dbHUB hub + +hub_ftr_env :: P -> [String] +hub_ftr_env CabalP = ["GHC_PACKAGE_PATH"] +hub_ftr_env _ = [] -- diff --git a/Hub/PackageDB.hs b/Hub/PackageDB.hs --- a/Hub/PackageDB.hs +++ b/Hub/PackageDB.hs @@ -205,7 +205,7 @@ package_dump :: Hub -> IO String package_dump hub = do tf <- tmpFile "pkg-dump.txt" - let ee = EE (RedirctRS tf) DiscardRS [] + let ee = EE (RedirctRS tf) DiscardRS [] [] execP HubO ee UserMDE hub Ghc_pkgP ["dump"] ct <- readAFile tf removeFile tf diff --git a/Hub/System.hs b/Hub/System.hs --- a/Hub/System.hs +++ b/Hub/System.hs @@ -36,6 +36,7 @@ import System.Posix.Env import System.Posix.Files import System.Posix.Process +--import System.Posix.Signals import System.Posix.IO import Text.Printf import qualified Data.ByteString.UTF8 as U @@ -159,6 +160,7 @@ { redirctOutEE :: RedirectStream , redirctErrEE :: RedirectStream , extendEnvtEE :: [(String,String)] + , filterEnvtEE :: [String] } deriving (Show) data RedirectStream @@ -171,10 +173,14 @@ exec ee pr as = do so <- get_ss $ redirctOutEE ee se <- get_ss $ redirctErrEE ee - ev <- get_ev $ extendEnvtEE ee - let cp = (proc pr as) { std_out = so, std_err = se, env=ev } + ev <- get_ev (extendEnvtEE ee) (filterEnvtEE ee) + let cp = (proc pr as) { std_out = so, std_err = se, env=ev, create_group=False } (_,_,_,ph) <- createProcess cp + -- i_sh <- installHandler sigINT (Catch $ ppg ph) Nothing + -- q_sh <- installHandler sigQUIT (Catch $ ppg ph) Nothing ex <- waitForProcess ph + -- _ <- installHandler sigINT i_sh Nothing + -- _ <- installHandler sigQUIT q_sh Nothing clse so clse se return ex @@ -186,13 +192,22 @@ clse (UseHandle h) = hClose h clse _ = return () - get_ev [] = return Nothing - get_ev bs = + get_ev [] [] = return Nothing + get_ev bs ds = do bs0 <- getEnvironment let st = Map.fromList bs - f (nm,_) = not $ Map.member nm st + f (nm,_) = not (Map.member nm st) && not (nm `elem` ds) --putStrLn $ printf "---\n%s\n---\n\n" $ show (bs ++ filter f bs0) return $ Just $ bs ++ filter f bs0 + + -- ppg ph = lg "INT/QUIT" >> interruptProcessGroupOf ph + -- + -- lg msg = + -- do h <- openFile "/hub/src/exec.log" AppendMode + -- hPutStrLn h "----- exec -----------" + -- hPutStrLn h $ show msg + -- hPutStrLn h "----------------------" + -- hClose h readAFile :: FilePath -> IO String readAFile fp = U.toString `fmap` B.readFile fp diff --git a/Version.hs b/Version.hs --- a/Version.hs +++ b/Version.hs @@ -13,7 +13,7 @@ version :: String -version = "1.1.0" +version = "1.2.0" main :: IO () diff --git a/hub.cabal b/hub.cabal --- a/hub.cabal +++ b/hub.cabal @@ -1,6 +1,6 @@ Name: hub -Version: 1.1.0 -Copyright: Chris Dornan, 2011-2012 +Version: 1.2.0 +Copyright: Chris Dornan, 2011-2013 Maintainer: Chris Dornan Author: Chris Dornan License: BSD3 @@ -55,7 +55,7 @@ Stability: Beta Category: Development, Distribution -Homepage: https://justhub.org +Homepage: http://justhub.org Bug-Reports: https://github.com/haskell-hub/hub-src/issues Build-type: Simple Cabal-version: >= 1.10