cab 0.2.22 → 0.2.23

raw patch · 4 files changed

+48/−22 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +10/−0
• Distribution/Cab/Commands.hs +20/−20
• Distribution/Cab/Sandbox.hs +15/−0
• cab.cabal +3/−2

@@ -0,0 +1,10 @@+# ChangeLog for cab++## 0.2.23++* Security: external commands (`ghc-pkg`, `ghci`, `cabal`) are now+  invoked with argument lists instead of a shell. Previously, a crafted+  `package-db:` in a `cabal.sandbox.config` of the current or any+  ancestor directory could execute arbitrary shell commands via+  `cab check`, `cab uninstall` and `cab ghci`.+* New: `getSandboxOptsList` in `Distribution.Cab.Sandbox`.

@@ -17,7 +17,7 @@ import qualified Control.Exception as E import Control.Monad (forM_, unless, void, when) import Data.Char (toLower)-import Data.List (intercalate, isPrefixOf)+import Data.List (isPrefixOf) import qualified Data.Map.Strict as M import Distribution.Cab.GenPaths import Distribution.Cab.PkgDB@@ -29,7 +29,7 @@ import System.Exit (exitFailure) import System.FilePath (takeDirectory, takeFileName) import System.IO (hPutStrLn, stderr)-import System.Process (readProcess, system)+import System.Process (rawSystem, readProcess)  ---------------------------------------------------------------- @@ -150,7 +150,7 @@  purge :: Bool -> [Option] -> PkgInfo -> IO () purge doit opts pkgInfo = do-    sandboxOpts <- (makeOptList . getSandboxOpts2) <$> getSandbox+    sandboxOpts <- makeOptList . getSandboxOpts2 <$> getSandbox     dirs <- getDirs nameVer sandboxOpts     unregister doit opts nameVer     mapM_ unregisterInternal $ findInternalLibs pkgInfo name@@ -158,9 +158,11 @@   where     unregisterInternal subname = unregister doit opts (subname, ver)     nameVer@(name, ver) = pairNameOfPkgInfo pkgInfo-    makeOptList "" = []-    makeOptList x = [x] +makeOptList :: String -> [String]+makeOptList "" = []+makeOptList x = [x]+ getDirs :: (String, String) -> [String] -> IO [FilePath] getDirs (name, ver) sandboxOpts = do     importDirs <- queryGhcPkg "import-dirs"@@ -196,12 +198,13 @@     if doit         then do             putStrLn $ "Deleting " ++ name ++ " " ++ ver-            sandboxOpts <- getSandboxOpts2 <$> getSandbox-            when doit $ void . system $ script sandboxOpts+            sandboxOpts <- makeOptList . getSandboxOpts2 <$> getSandbox+            when doit $+                void $+                    rawSystem "ghc-pkg" $+                        ["unregister"] ++ sandboxOpts ++ [name ++ "-" ++ ver]         else             putStrLn $ name ++ " " ++ ver-  where-    script sandboxOpts = "ghc-pkg unregister " ++ sandboxOpts ++ " " ++ name ++ "-" ++ ver  ---------------------------------------------------------------- @@ -212,10 +215,8 @@  check :: FunctionCommand check _ _ _ = do-    sandboxOpts <- getSandboxOpts2 <$> getSandbox-    void . system $ script sandboxOpts-  where-    script sandboxOpts = "ghc-pkg check -v " ++ sandboxOpts+    sandboxOpts <- makeOptList . getSandboxOpts2 <$> getSandbox+    void $ rawSystem "ghc-pkg" $ ["check", "-v"] ++ sandboxOpts  ---------------------------------------------------------------- @@ -264,8 +265,9 @@ ----------------------------------------------------------------  initSandbox :: FunctionCommand-initSandbox [] _ _ = void . system $ "cabal v1-sandbox init"-initSandbox [path] _ _ = void . system $ "cabal v1-sandbox init --sandbox " ++ path+initSandbox [] _ _ = void $ rawSystem "cabal" ["v1-sandbox", "init"]+initSandbox [path] _ _ =+    void $ rawSystem "cabal" ["v1-sandbox", "init", "--sandbox", path] initSandbox _ _ _ = do     hPutStrLn stderr "Only one argument is allowed"     exitFailure@@ -273,7 +275,7 @@ ----------------------------------------------------------------  add :: FunctionCommand-add [src] _ _ = void . system $ "cabal v1-sandbox add-source " ++ src+add [src] _ _ = void $ rawSystem "cabal" ["v1-sandbox", "add-source", src] add _ _ _ = do     hPutStrLn stderr "A source path be specified."     exitFailure@@ -282,7 +284,5 @@  ghci :: FunctionCommand ghci args _ options = do-    sbxOpts <- getSandboxOpts <$> getSandbox-    void $-        system $-            "ghci" ++ " " ++ sbxOpts ++ " " ++ intercalate " " (options ++ args)+    sbxOpts <- getSandboxOptsList <$> getSandbox+    void $ rawSystem "ghci" $ sbxOpts ++ options ++ args

@@ -4,6 +4,7 @@     getSandbox,     getSandboxOpts,     getSandboxOpts2,+    getSandboxOptsList, ) where  import Control.Exception as E (SomeException, catch, throwIO)@@ -87,6 +88,20 @@     pkgOpt         | ghcver >= 706 = "--package-db"         | otherwise = "--package-conf"++-- | Like 'getSandboxOpts' but returns separate arguments+--   suitable for 'System.Process.rawSystem'.+--+-- >>> getSandboxOptsList (Just "/path/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d")+-- ["-package-db","/path/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d"]+getSandboxOptsList :: Maybe FilePath -> [String]+getSandboxOptsList Nothing = []+getSandboxOptsList (Just path) = [pkgOpt, path]+  where+    ghcver = extractGhcVer path+    pkgOpt+        | ghcver >= 706 = "-package-db"+        | otherwise = "-package-conf"  -- | Extracting GHC version from the path of package db. --   Exception is thrown if the string argument is incorrect.

@@ -1,6 +1,6 @@ cabal-version: >=1.10 name:          cab-version:       0.2.22+version:       0.2.23 license:       BSD3 license-file:  LICENSE maintainer:    Kazu Yamamoto <kazu@iij.ad.jp>@@ -18,10 +18,11 @@  category:      Distribution build-type:    Simple+extra-source-files: ChangeLog.md  source-repository head     type:     git-    location: git://github.com/kazu-yamamoto/cab.git+    location: https://github.com/kazu-yamamoto/cab.git  library     exposed-modules: