Browse files

Cabal2macpkg now works with Tiger-format .mpkg files.

Unfortunately I've discovered that this is useless, you can't mix Tiger-format
and Leopard-format .pkg files in a Tiger-format .mpkg. I'll have to rework the
program to speak Leopard-formatted files -- there's some reverse-engineering to
be done there since Apple's doco is so poor.
  • Loading branch information...
1 parent ce5ff9b commit 881f4d154fb334bf01d793126a8c2b4b429ba2a4 @gregorycollins committed Apr 18, 2009
Showing with 452 additions and 177 deletions.
  1. +2 −0 .gitignore
  2. +76 −36 Distribution/OSX/InstallerScript.hs
  3. +8 −21 Main.hs
  4. +195 −1 Program/MakeMetaPackage.hs
  5. +31 −16 Program/MakePackage.hs
  6. +126 −40 Program/Options.hs
  7. +12 −2 Program/Util.hs
  8. +0 −61 TODO.markdown
  9. +2 −0 cabal2macpkg.cabal
View
2 .gitignore
@@ -1,3 +1,5 @@
dist/**
dist
*~
+#*#
+**/#*#
View
112 Distribution/OSX/InstallerScript.hs
@@ -1,65 +1,135 @@
{-# LANGUAGE NoMonomorphismRestriction #-}
-module Distribution.OSX.InstallerScript where
+module Distribution.OSX.InstallerScript
+( installerScript
+, writeInstallerScript
+, installerScriptToString
+, InstallerScript )
+where
import Data.Maybe
import Distribution.PackageDescription.Configuration
import Text.XML.HXT.Arrow
+------------------------------------------------------------------------
+-- exports
+------------------------------------------------------------------------
+data InstallerScript = InstallerScript {
+ title :: String
+ , background :: Maybe String
+ , welcome :: Maybe String
+ , readme :: Maybe String
+ , license :: Maybe String
+ , conclusion :: Maybe String
+ , pkgFileNames :: [String]
+}
+
+
+------------------------------------------------------------------------
+-- | Populate an InstallerScript object with the given values.
+installerScript :: String -- ^ package title
+ -> Maybe String -- ^ background image to use in the installer
+ -- (FIXME: currently ignored)
+ -> Maybe String -- ^ welcome blurb
+ -> Maybe String -- ^ readme blurb
+ -> Maybe String -- ^ license blurb
+ -> Maybe String -- ^ conclusion blurb
+ -> [String] -- ^ list of .pkg files to include
+ -> InstallerScript
+installerScript = InstallerScript
+
+
+------------------------------------------------------------------------
+-- | Write a populated installer script to a file.
+writeInstallerScript :: String -- ^ file to write the output to
+ -> InstallerScript -- ^ the values for the installer script
+ -> IO ()
+writeInstallerScript file is = runX ( mkInstallerScript is
+ >>>
+ writeDocument [(a_indent, v_1)] file )
+ >> return ()
+
+
+------------------------------------------------------------------------
+-- | Render a populated installer script into a string.
+installerScriptToString :: InstallerScript -> IO String
+installerScriptToString is = runX ( mkInstallerScript is
+ >>>
+ writeDocumentToString [(a_indent, v_1)] )
+ >>= return . concat
+
+
+------------------------------------------------------------------------
+-- local functions
+------------------------------------------------------------------------
+
+------------------------------------------------------------------------
simpleTag :: (ArrowXml a) => String -> String -> a n XmlTree
simpleTag tagName text = mkelem tagName [] [txt text]
+------------------------------------------------------------------------
mkTitle :: ArrowXml a => String -> a n XmlTree
mkTitle = simpleTag "title"
+------------------------------------------------------------------------
mkOptions :: (ArrowXml a) => a n XmlTree
mkOptions = mkelem "options" [ sattr "customize" "never"
, sattr "allow-external-scripts" "no"
, sattr "rootVolumeOnly" "false"] []
+------------------------------------------------------------------------
blurbAttrs :: (ArrowXml a) => [a n XmlTree]
blurbAttrs = [ sattr "language" "en"
, sattr "mime-type" "text/plain" ]
+------------------------------------------------------------------------
blurb :: (ArrowXml a) => String -> String -> a n XmlTree
blurb tagName txt = mkelem tagName blurbAttrs [cdata txt]
+------------------------------------------------------------------------
mkReadme :: (ArrowXml a) => String -> a n XmlTree
mkReadme = blurb "readme"
+------------------------------------------------------------------------
mkWelcome :: (ArrowXml a) => String -> a n XmlTree
mkWelcome = blurb "welcome"
+------------------------------------------------------------------------
mkLicense :: (ArrowXml a) => String -> a n XmlTree
mkLicense = blurb "license"
+------------------------------------------------------------------------
mkConclusion :: (ArrowXml a) => String -> a n XmlTree
mkConclusion = blurb "conclusion"
+------------------------------------------------------------------------
cdata :: (ArrowXml cat) => String -> cat a XmlTree
cdata = (>>> mkCdata) . arr . const
+------------------------------------------------------------------------
mkLine :: (ArrowXml a) => String -> a n XmlTree
mkLine choiceId = mkelem "line" [sattr "choice" choiceId] []
+------------------------------------------------------------------------
mkChoicesOutline :: (ArrowXml a) => [String] -> a n XmlTree
mkChoicesOutline choiceIds =
mkelem "choices-outline" [] (map mkLine choiceIds)
+------------------------------------------------------------------------
mkChoice :: (ArrowXml a) => String -> String -> String -> a n XmlTree
mkChoice id title pkgref =
mkelem "choice"
@@ -69,6 +139,7 @@ mkChoice id title pkgref =
[ mkelem "pkg-ref" [sattr "id" pkgref] [] ]
+------------------------------------------------------------------------
mkPkgRef :: (ArrowXml a) => String -> String -> [Char] -> a n XmlTree
mkPkgRef id installKBytes pkgFileName =
mkelem "pkg-ref"
@@ -79,36 +150,17 @@ mkPkgRef id installKBytes pkgFileName =
[ txt $ "file:./Contents/Packages/" ++ pkgFileName ]
+------------------------------------------------------------------------
installerScriptHead :: (ArrowXml a) => [a n XmlTree] -> a n XmlTree
installerScriptHead body =
root [] [ mkelem "installer-script"
[ sattr "minSpecVersion" "1.000000" ]
body ]
-data InstallerScript = InstallerScript {
- title :: String
- , background :: Maybe String
- , welcome :: Maybe String
- , readme :: Maybe String
- , license :: Maybe String
- , conclusion :: Maybe String
- , pkgFileNames :: [String]
-}
-
-
-mkInstallerScript :: String -- ^ title
- -> Maybe String -- ^ background image (FIXME: currently ignored)
- -> Maybe String -- ^ welcome blurb
- -> Maybe String -- ^ readme blurb
- -> Maybe String -- ^ license blurb
- -> Maybe String -- ^ conclusion blurb
- -> [String] -- ^ list of package files
- -> InstallerScript
-mkInstallerScript = InstallerScript
-
-
-installerScript is =
+------------------------------------------------------------------------
+mkInstallerScript :: (ArrowXml a) => InstallerScript -> a n XmlTree
+mkInstallerScript is =
installerScriptHead $ concat [
[ mkTitle (title is) ]
, catMaybes [
@@ -128,15 +180,3 @@ installerScript is =
choices = map (\(x,y) -> mkChoice x x y) (choiceIds `zip` pkgRefIds)
-- FIXME: installKBytes should not be "0"!
pkgRefs = map (\(x,y) -> mkPkgRef x "0" y) (pkgRefIds `zip` pkgFiles)
-
-
-writeInstallerScript :: InstallerScript -> String -> IO [XmlTree]
-writeInstallerScript is file = runX ( installerScript is
- >>>
- writeDocument [(a_indent, v_1)] file )
-
-
-installerScriptToString is = runX ( installerScript is
- >>>
- writeDocumentToString [(a_indent, v_1)] )
- >>= return . concat
View
29 Main.hs
@@ -33,17 +33,13 @@ module Main (
import Control.Exception
import Control.Monad
-import Distribution.PackageDescription.Configuration
-import Distribution.PackageDescription.Parse
-import Distribution.Simple.Utils hiding (intercalate)
-import Distribution.Verbosity as Verbosity
-
import System.IO
------------------------------------------------------------------------
-- local imports
import Program.MakePackage
+import Program.MakeMetaPackage
import Program.Options
import Program.Util
@@ -57,21 +53,12 @@ main = do
opts <- getOptions
bracket getTempDirectory
cleanupTempDirectory
- (runMakePackage opts)
-
-
+ (runMain opts)
-------------------------------------------------------------------------
--- | The program driver. Given the command-line options and a temp
--- directory path, searches the current working directory for a .cabal
--- file and builds an OSX package file based on its contents.
-------------------------------------------------------------------------
-runMakePackage :: Options -- ^ command-line options
- -> FilePath -- ^ temp directory path
- -> IO ()
-runMakePackage opts tmpdir = do
- cabalFile <- findPackageDesc "."
- pkgDesc <- flattenPackageDescription `liftM`
- readPackageDescription Verbosity.normal cabalFile
- makeMacPkg opts tmpdir pkgDesc
+runMain :: Options -> FilePath -> IO ()
+runMain opts tempdir =
+ if areBuildingMetaPackage opts then
+ runMakeMetaPkg opts tempdir
+ else
+ runMakePackage opts tempdir
View
196 Program/MakeMetaPackage.hs
@@ -1,19 +1,49 @@
+{-# LANGUAGE BangPatterns #-}
+
-- | This module contains routines for making a mac .mpkg file from a
-- .cabal file's dependencies. Note that for right now (until this
-- program develops further) the intention is to do just enough to be
-- able to build an installer for the Haskell Platform
------------------------------------------------------------------------
-module Program.MakeMetaPackage where
+module Program.MakeMetaPackage (runMakeMetaPkg)
+where
+import Control.Exception
import Control.Monad
+import Data.Maybe
+import Data.Version
+
import Distribution.Package
import Distribution.PackageDescription
+import Distribution.PackageDescription.Configuration
+import Distribution.PackageDescription.Parse
import Distribution.Simple.Utils hiding (intercalate)
+import Distribution.Verbosity as Verbosity
import Distribution.Version
+import System.Directory
+import System.Environment
+import System.FilePath
+import System.FilePath.Glob
+import System.IO
+
+import qualified Data.ByteString.Lazy as B
+
+import Text.Regex
+
+
+------------------------------------------------------------------------
+-- local imports
+------------------------------------------------------------------------
+import Distribution.OSX.InstallerScript
+import Program.MakePackage
+import Program.Options
+import Program.Util
+
+------------------------------------------------------------------------
-- | Until "cabal fetch" has an "-o" argument there isn't really any
-- | way to get at the .tar.gz file if you don't know the exact
-- | version string
@@ -24,3 +54,167 @@ checkDependenciesHaveExactVersions d =
where
isExact (Dependency _ (ThisVersion _)) = True
isExact _ = False
+
+
+------------------------------------------------------------------------
+-- | Builds an OSX .mpkg based on a .cabal file
+makeMacMetaPkg :: Options -- ^ command-line options
+ -> FilePath -- ^ path to temp directory
+ -> PackageDescription -- ^ a parsed .cabal file
+ -> IO ()
+makeMacMetaPkg opts tmpdir pkgDesc = do
+ cwd <- getCurrentDirectory
+ checkDependenciesHaveExactVersions deps
+ checkRootPrivileges
+
+ outputPackageDir <- makeAndCanonicalize $ fromMaybe cwd (packageOutputDir opts)
+ outputPackagePath <- makeAndCanonicalize $
+ fromMaybe (outputPackageDir </> computedPackageName)
+ (packageOutputFile opts)
+
+ contentsDir <- makeAndCanonicalize $ outputPackagePath </> "Contents"
+ packagesDir <- makeAndCanonicalize $ contentsDir </> "Packages"
+
+ let subOptions = opts { packageOutputDir = Just packagesDir
+ , packageOutputFile = Nothing }
+
+ (createDirectoryIfMissing True) `mapM_` [ outputPackagePath
+ , contentsDir
+ , packagesDir ]
+
+ mapM_ (buildOne subOptions) packagesToFetch
+
+ -- if the user specified an extra packages directory, copy the extra
+ -- packages to the output package directory and return a list of the
+ -- filenames
+ extraPackages <-
+ maybe (return [])
+ (\x -> do
+ files <- globPackages x
+ mapM_ (copyTo outputPackagePath) files
+ return (takeFileName `map` files))
+ (extraPkgDir opts)
+
+ writeInstallerScript (contentsDir </> "distribution.dist") $
+ installerScript pkgTitle
+ Nothing -- FIXME: populate these
+ Nothing
+ (Just pkgDescription)
+ Nothing
+ Nothing
+ (extraPackages ++ packageFileNames)
+
+ where
+ --------------------------------------------------------------------
+ -- variables
+ --------------------------------------------------------------------
+
+ -- package metadata
+ unPackageName (PackageName s) = s
+
+ pkgDescription = synopsis pkgDesc
+ pkgTitle = unPackageName . packageName $ pkgDesc
+ pkgVersionString = showVersion . packageVersion $ pkgDesc
+ pkgBaseName = subRegex (mkRegex "[[:space:]]+") pkgTitle "_"
+
+ --------------------------------------------------------------------
+ computedPackageName = (pkgBaseName ++ "-" ++ pkgVersionString ++ ".mpkg")
+
+ deps = executableDeps opts ++ buildDepends pkgDesc
+
+ --------------------------------------------------------------------
+ packagesToFetch :: [(String, String)]
+ packagesToFetch = depToString `map` deps
+ where
+ depToString (Dependency (PackageName nm) (ThisVersion v)) =
+ (nm, showVersion v)
+ depToString _ = error "impossible"
+
+
+ --------------------------------------------------------------------
+ packageFileNames :: [String]
+ packageFileNames = map (\(n,v) -> n ++ "-" ++ v ++ ".pkg")
+ packagesToFetch
+
+
+ --------------------------------------------------------------------
+ cabalFetch (pkgName,pkgVersion) = do
+ -- FIXME: change this when cabal fetch takes an -o argument
+ home <- getEnv "HOME"
+
+ let pkgbase = pkgName ++ "-" ++ pkgVersion
+ let pkg = pkgbase ++ ".tar.gz"
+ let pkgloc = home </> ".cabal/packages/hackage.haskell.org/"
+ </> pkgName </> pkgVersion </> pkg
+
+ runCmd "cabal" ["fetch", pkgbase]
+ fe <- doesFileExist pkgloc
+ if fe then do
+ runCmd "cp" [pkgloc, pkg]
+ runCmd "tar" ["--strip-components=1", "-xvzf", pkg]
+
+ else
+ die $ "couldn't find file " ++ pkg
+
+
+ --------------------------------------------------------------------
+ buildOne opts (pkgName,pkgVersion) = do
+ putStrLn $ "\n" ++ (replicate 72 '-')
+ putStrLn $ "Making " ++ pkgName ++ "-" ++ pkgVersion
+ putStrLn $ replicate 72 '-'
+ hFlush stdout
+
+ bracket
+ (liftM2 (,) getTempDirectory getCurrentDirectory)
+ (\(x,y) -> cleanupTempDirectory x >> setCurrentDirectory y)
+ (\(!td,_) -> do
+ setCurrentDirectory td
+ putStrLn $ "changed to " ++ td
+ hFlush stdout
+
+ let workdir = td </> "work"
+ createDirectoryIfMissing True workdir
+ cabalFetch (pkgName,pkgVersion)
+ runMakePackage opts workdir
+ )
+
+ --------------------------------------------------------------------
+
+
+
+
+
+
+------------------------------------------------------------------------
+-- | globs a directory for .pkg and .mpkg files
+globPackages :: FilePath -> IO [FilePath]
+globPackages dir = namesMatching `mapM` ((dir </>) `map` ["*.pkg", "*.mpkg"])
+ >>= return . concat
+
+
+------------------------------------------------------------------------
+-- | copy a file
+copyTo :: FilePath -> FilePath -> IO ()
+copyTo dest file = do
+ isDir <- doesDirectoryExist dest
+ let out = if isDir then dest </> takeFileName file else dest
+ B.readFile file >>= B.writeFile out
+
+
+
+------------------------------------------------------------------------
+-- | The program driver. Given the command-line options and a temp
+-- directory path, searches the current working directory for a .cabal
+-- file and builds an OSX metapackage based on its dependencies.
+------------------------------------------------------------------------
+runMakeMetaPkg :: Options -> FilePath -> IO ()
+runMakeMetaPkg opts tmpdir = do
+ cabalFile <- findPackageDesc "."
+ pkgDesc <- flattenPackageDescription `liftM`
+ readPackageDescription Verbosity.normal cabalFile
+
+ makeMacMetaPkg opts tmpdir pkgDesc
+
+
+
+makeAndCanonicalize fp = createDirectoryIfMissing True fp >> canonicalizePath fp
View
47 Program/MakePackage.hs
@@ -1,6 +1,6 @@
-- | This module contains routines for making mac .pkg files.
------------------------------------------------------------------------
-module Program.MakePackage ( makeMacPkg ) where
+module Program.MakePackage ( runMakePackage ) where
import Control.Monad
@@ -12,12 +12,14 @@ import Data.Version
import Distribution.Package
import Distribution.PackageDescription
+import Distribution.PackageDescription.Configuration
+import Distribution.PackageDescription.Parse
import Distribution.Simple.Utils hiding (intercalate)
+import Distribution.Verbosity as Verbosity
import System.Directory
import System.FilePath
import System.IO
-import System.Posix.User (getEffectiveUserName)
import Text.Regex
@@ -30,6 +32,22 @@ import Program.Util
------------------------------------------------------------------------
+-- | The program driver. Given the command-line options and a temp
+-- directory path, searches the current working directory for a .cabal
+-- file and builds an OSX package file based on its contents.
+------------------------------------------------------------------------
+runMakePackage :: Options -- ^ command-line options
+ -> FilePath -- ^ temp directory path
+ -> IO ()
+runMakePackage opts tmpdir = do
+ cabalFile <- findPackageDesc "."
+ pkgDesc <- flattenPackageDescription `liftM`
+ readPackageDescription Verbosity.normal cabalFile
+
+ makeMacPkg opts tmpdir pkgDesc
+
+
+------------------------------------------------------------------------
-- "the guts"
------------------------------------------------------------------------
@@ -91,19 +109,12 @@ makeMacPkg opts tmpdir pkgDesc = do
-- helper I/O actions
--------------------------------------------------------------------
- --------------------------------------------------------------------
- -- checks that we're root and bails if not
- checkRootPrivileges :: IO ()
- checkRootPrivileges = do
- whoiam <- getEffectiveUserName
- when (whoiam /= "root") $ die "must be root to run cabal2macpkg"
-
--------------------------------------------------------------------
-- creates necessary directories inside the work area
createDirectories =
- createDirectory `mapM_` [stagingDir, scriptsDir, resourceDir,
- contentsDir]
+ (createDirectoryIfMissing True) `mapM_` [stagingDir, scriptsDir,
+ resourceDir, contentsDir]
--------------------------------------------------------------------
@@ -121,11 +132,15 @@ makeMacPkg opts tmpdir pkgDesc = do
--------------------------------------------------------------------
-- FIXME: make this stuff relocatable
makePostFlightScriptFile src dest = do
- contents <- readFile src
- let output = "#!/bin/sh\n\
- \echo '" ++ contents ++
- "' | /usr/bin/env ghc-pkg --global update -"
- writeFile dest output
+ fe <- doesFileExist src
+ if not fe then
+ return ()
+ else do
+ contents <- readFile src
+ let output = "#!/bin/sh\n\
+ \echo '" ++ contents ++
+ "' | /usr/bin/env ghc-pkg --global update -"
+ writeFile dest output
--------------------------------------------------------------------
View
166 Program/Options.hs
@@ -1,8 +1,7 @@
-- | Datatypes for handling cabal2macpkg command-line options
-module Program.Options
-(
- Options(..)
+module Program.Options (
+ Options(..)
, getOptions
, optionFlags
, usage
@@ -13,13 +12,21 @@ import Control.Monad
import Data.Char
import Data.Function
import Data.List
+import Data.List.Split
import Data.Maybe
import Data.Monoid
+import Data.Version
+
+import Distribution.Package
+import Distribution.Text
+import Distribution.Version
import System.Environment (getArgs)
import System.Exit
import System.IO
+import Text.ParserCombinators.ReadP
+
import qualified System.Console.GetOpt as GetOpt
@@ -36,62 +43,82 @@ import qualified System.Console.GetOpt as GetOpt
-- will build an Options object where the fields of @a@ are overridden
-- by the non-'Nothing' fields of @b@
data Options = Options {
- installPrefix :: Maybe String -- ^ the installation prefix
- -- for the generated library
+ installPrefix :: Maybe String -- ^ the installation prefix for the
+ -- generated library
+
+ , packageMakerPath :: Maybe String -- ^ path to the OSX packagemaker
+ -- binary (we'll choose a sane
+ -- default here)
- , packageMakerPath :: Maybe String -- ^ path to the OSX
- -- packagemaker binary (we'll
- -- choose a sane default
- -- here)
+ , showUsage :: Bool -- ^ if true, show the usage message,
+ -- either because the user requested
+ -- it or because of an error parsing
+ -- the command line arguments
- , showUsage :: Bool -- ^ if true, show the usage
- -- message, either because
- -- the user requested it or
- -- because of an error
- -- parsing the command line
- -- arguments
+ , packageOutputDir :: Maybe String -- ^ output dir for generated .pkg
+ -- file
- , packageOutputDir :: Maybe String -- ^ output dir for generated
- -- .pkg file
+ , packageOutputFile :: Maybe String -- ^ output filename for generated
+ -- .pkg file -- if specified
+ -- overrides packageOutputDir
- , packageOutputFile :: Maybe String -- ^ output filename for
- -- generated .pkg file -- if
- -- specified overrides
- -- packageOutputDir
+ , areBuildingMetaPackage :: Bool -- ^ are we building a metapackage?
+ , executableDeps :: [Dependency] -- ^ executable .cabal packages that
+ -- we want to include in the
+ -- metapackage
+
+ , extraPkgDir :: Maybe FilePath -- ^ if this is specified, we look
+ -- for .pkg and .mpkg files in the
+ -- directory, and plop them into the
+ -- .mpkg file we generate
} deriving (Eq, Show)
defaultOptions :: Options
-defaultOptions = Options { installPrefix = Just "/"
- , showUsage = False
- , packageMakerPath = Just "/Developer/usr/bin/packagemaker"
- , packageOutputDir = Nothing
- , packageOutputFile = Nothing
- }
+defaultOptions = Options {
+ installPrefix = Just "/"
+ , showUsage = False
+ , packageMakerPath = Just "/Developer/usr/bin/packagemaker"
+ , packageOutputDir = Nothing
+ , packageOutputFile = Nothing
+ , areBuildingMetaPackage = False
+ , executableDeps = []
+ , extraPkgDir = Nothing
+ }
+
instance Monoid Options where
- mempty = Options { installPrefix = Nothing
- , showUsage = False
- , packageMakerPath = Nothing
- , packageOutputDir = Nothing
- , packageOutputFile = Nothing
- }
+ mempty = Options {
+ installPrefix = Nothing
+ , showUsage = False
+ , packageMakerPath = Nothing
+ , packageOutputDir = Nothing
+ , packageOutputFile = Nothing
+ , areBuildingMetaPackage = False
+ , executableDeps = []
+ , extraPkgDir = Nothing
+ }
a `mappend` b =
Options {
- installPrefix = override installPrefix
- , packageMakerPath = override packageMakerPath
- , packageOutputDir = override packageOutputDir
- , packageOutputFile = override packageOutputFile
- , showUsage = showUsage a || showUsage b
+ installPrefix = override installPrefix
+ , packageMakerPath = override packageMakerPath
+ , packageOutputDir = override packageOutputDir
+ , packageOutputFile = override packageOutputFile
+ , showUsage = showUsage a || showUsage b
+ , areBuildingMetaPackage = areBuildingMetaPackage a
+ || areBuildingMetaPackage b
+ , executableDeps = addUp executableDeps
+ , extraPkgDir = override extraPkgDir
}
where
-- monoid append using "Last" behaviour
(*+*) :: Maybe a -> Maybe a -> Maybe a
(*+*) = (getLast .) . (mappend `on` Last)
override f = f a *+* f b
+ addUp f = f a `mappend` f b
------------------------------------------------------------------------
@@ -104,12 +131,30 @@ optionFlags = [ GetOpt.Option
"prints usage statement"
, GetOpt.Option
+ "m"
+ ["meta"]
+ (GetOpt.NoArg $ mempty {areBuildingMetaPackage=True})
+ "output install package to the given file"
+
+ , GetOpt.Option
""
["prefix"]
(GetOpt.OptArg mkPrefix "DIR")
"installation prefix directory"
, GetOpt.Option
+ ""
+ ["executable-dependencies"]
+ (GetOpt.OptArg mkDeps "PKG1,...,PKGn")
+ "executable package dependencies (--meta only)"
+
+ , GetOpt.Option
+ ""
+ ["extra-packages-dir"]
+ (GetOpt.OptArg mkExtraPkgs "DIR")
+ "if specified, we copy .mpkg and .pkg files located here into the metapackage (--meta only)"
+
+ , GetOpt.Option
"d"
["outdir"]
(GetOpt.OptArg mkOutputDir "DIR")
@@ -123,9 +168,52 @@ optionFlags = [ GetOpt.Option
]
where
+ mkDeps :: Maybe String -> Options
+ mkDeps Nothing = mempty
+ mkDeps (Just s) = mempty { executableDeps = deps }
+ where
+ ss = splitOn "," s
+
+ deps = mkDep `map` ss
+
+ parseVer :: String -> Maybe Version
+ parseVer v = listToMaybe parses
+ where
+ parses = fst `map` (
+ ((== "") . snd) `filter` (readP_to_S parseVersion) v
+ )
+
+ mkDep :: String -> Dependency
+ mkDep v = case mbDep of
+ Nothing -> error $ "Couldn't parse dependency " ++ v
+ Just x -> x
+ where
+ mbDep = if ok then
+ let nm = vs !! 0
+ ver = vs !! 1
+ mbv = parseVer ver
+ in
+ mbv >>= return . (\x ->
+ Dependency (PackageName nm)
+ (ThisVersion x))
+ else Nothing
+
+ vs' = splitOn "-" v
+
+ fixup [] = []
+ fixup (a:[]) = []
+ fixup xs = [concat (intersperse "-" $ init xs), last xs]
+
+ vs = fixup vs'
+ ok = length vs == 2
+
+
mkPrefix :: Maybe String -> Options
mkPrefix m = mempty { installPrefix = m }
+ mkExtraPkgs :: Maybe String -> Options
+ mkExtraPkgs m = mempty { extraPkgDir = m }
+
mkOutputDir :: Maybe String -> Options
mkOutputDir m = mempty { packageOutputDir = m }
@@ -172,5 +260,3 @@ getOptions = do
if showUsage opts
then usage []
else return opts
-
-
View
14 Program/Util.hs
@@ -1,5 +1,5 @@
-- | Utility functions
-module Program.Util (runCmd, getTempDirectory, cleanupTempDirectory)
+module Program.Util(runCmd, getTempDirectory, cleanupTempDirectory, checkRootPrivileges)
where
@@ -16,10 +16,10 @@ import System.Directory
import System.Exit
import System.FilePath
import System.IO
+import System.Posix.User (getEffectiveUserName)
import System.Process
-
------------------------------------------------------------------------
-- |
-- run a subprocess with the given arguments, ignoring the output. Die
@@ -61,3 +61,13 @@ getTempDirectory =
cleanupTempDirectory :: FilePath
-> IO ()
cleanupTempDirectory = removeDirectoryRecursive
+
+
+------------------------------------------------------------------------
+-- | checks that we're root and bails if not
+checkRootPrivileges :: IO ()
+checkRootPrivileges = do
+ whoiam <- getEffectiveUserName
+ when (whoiam /= "root") $ die "must be root to run cabal2macpkg"
+
+
View
61 TODO.markdown
@@ -1,61 +0,0 @@
-TODO for cabal2macpkg
-=====================
-
-## TODO items (round 1) ##
-
-* add support for relocatable packages -- not sure how to do this, any
- ideas would be appreciated. Manuel wanted this.
-
-
-## TODO items (round 2) ##
-
-* add a "--metapackage" flag (or something similar) that will cause
- cabal2macpkg to make .pkg files of the project's dependencies and
- generate an aggregate .mpkg file
-
-* may need "--exclude"/"--include" flags for this, or some other
- mechanism to stop the recursion. For the haskell platform a
- recursion depth of 1 is probably fine.
-
-
-## status update ##
-
-N.B. this is more for my notetaking benefit than for the reader
-
-Status: getting close. Have decided, for the time being, to use the
-Tiger interface to packagemaker ("backwards-compatibility mode")
-because information is easier to come by on its source formats, and
-the command-line arguments are easier to grok. The downside of this
-approach is that it builds "bundle files" (really directories) instead
-of compressed files like Leopard does. You can also read this as "I
-got impatient with my inability to get the Leopard approach to work".
-
-If I can dig up more information about WTF packagemaker is expecting
-in 10.5 mode, I'll try to abstract the backend to work with either. At
-least one person asked for consideration for 10.4 anyways (although I
-lack such a machine.)
-
-I am really frustrated with the quality of Apple's technical
-documentation in this area: there is little information about the
-command-line tool in the Software Delivery Guide, the manpage doesn't
-describe what's going on nearly well enough, several of the necessary
-file formats seem to be completely undocumented... Not to mention: the
-ad-hoc nature of the entire installation system (what are the package
-receipts for? There are no programs that consume them!), no facility
-for uninstallers (urk!!), the fact that they RUINED property lists by
-going to XML, and this doozy:
-
- "Without proper care when specifying the ownership and access
- permissions of component files, it is possible to render a system
- unusable. Make sure you test all installer packages before
- shipping them to customers."
-
-(Parenthetical: as far as I can tell from crystal-balling the scraps
-of doco. that I did find, this scare quote isn't even true anymore, at
-least unless you pass an explicit option to packagemaker...)
-
-I would **kill** for a guide to a "hello, world!" app done with the
-command-line tools right now. Apple's solution seems to be "use the
-GUI tool!" which is useless to me.
-
-
View
2 cabal2macpkg.cabal
@@ -21,12 +21,14 @@ executable cabal2macpkg
bytestring,
containers,
directory,
+ FileManip,
filepath,
hxt,
pretty,
process == 1.0.1.0,
pureMD5 >= 0.2.1,
regex-compat,
+ split,
unix,
xml

0 comments on commit 881f4d1

Please sign in to comment.