Skip to content
Browse files

Reorganize some stuff, change approach, complain about Apple

  • Loading branch information...
1 parent 057f37d commit ebd2c9207a34feef31d40718850f16d57d956364 @gregorycollins committed Mar 10, 2009
Showing with 305 additions and 121 deletions.
  1. +213 −0 Distribution/OSX/Info.hs
  2. +41 −114 Main.hs
  3. +48 −5 TODO.markdown
  4. +3 −2 cabal2macpkg.cabal
View
213 Distribution/OSX/Info.hs
@@ -0,0 +1,213 @@
+module Distribution.OSX.Info (
+ InfoPlist(..)
+ , DescriptionPlist(..)
+ , AuthorizationAction(..)
+ , mkInfoPlist
+ , mkDescriptionPlist
+) where
+
+
+import Data.Function
+import Data.Maybe
+import Data.Monoid
+
+-- need this for XML character escaping
+import Text.XML.Light.Output (showCData)
+import Text.XML.Light.Types (CData(..), CDataKind(..))
+
+
+------------------------------------------------------------------------
+data AuthorizationAction = NoAuthorization
+ | AdminAuthorization
+ | RootAuthorization
+ deriving (Show)
+
+-- note: not all fields are described here, only the ones I thought
+-- you'd want to change (sorry, I'm lazy)
+
+-- N.B. also we don't currently contain any fields that are valid for
+-- metapackages
+data InfoPlist = InfoPlist {
+ plist_infoString :: Maybe String
+ , plist_identifier :: Maybe String
+ , plist_bundleName :: Maybe String
+ , plist_shortVersionString :: Maybe String
+ , plist_authorizationAction :: Maybe AuthorizationAction
+ , plist_defaultLocation :: Maybe String
+ , plist_followLinks :: Maybe Bool
+ , plist_isRequired :: Maybe Bool
+ , plist_isRelocatable :: Maybe Bool
+ , plist_rootVolumeOnly :: Maybe Bool
+}
+
+
+data DescriptionPlist = DescriptionPlist {
+ dplist_title :: Maybe String
+ , dplist_version :: Maybe String
+}
+
+
+{-
+instance Monoid InfoPlist where
+ mempty = InfoPlist {
+ plist_infoString = Nothing
+ , plist_identifier = Nothing
+ , plist_bundleName = Nothing
+ , plist_shortVersionString = Nothing
+ , plist_authorizationAction = Nothing
+ , plist_defaultLocation = Nothing
+ , plist_followLinks = Nothing
+ , plist_isRequired = Nothing
+ , plist_isRelocatable = Nothing
+ , plist_rootVolumeOnly = Nothing
+ }
+
+
+ a `mappend` b = InfoPlist {
+ plist_infoString = o plist_infoString
+ , plist_identifier = o plist_identifier
+ , plist_bundleName = o plist_bundleName
+ , plist_shortVersionString = o plist_shortVersionString
+ , plist_authorizationAction = o plist_authorizationAction
+ , plist_defaultLocation = o plist_defaultLocation
+ , plist_followLinks = o plist_followLinks
+ , plist_isRequired = o plist_isRequired
+ , plist_isRelocatable = o plist_isRelocatable
+ , plist_rootVolumeOnly = o plist_rootVolumeOnly
+ }
+ where
+ -- monoid append using "Last" behaviour
+ (*+*) :: Maybe a -> Maybe a -> Maybe a
+ (*+*) = (getLast .) . (mappend `on` Last)
+
+ o f = f a *+* f b
+-}
+
+emptyPlist :: InfoPlist
+emptyPlist = InfoPlist {
+ plist_infoString = Nothing
+ , plist_identifier = Nothing
+ , plist_bundleName = Nothing
+ , plist_shortVersionString = Nothing
+ , plist_authorizationAction = Nothing
+ , plist_defaultLocation = Nothing
+ , plist_followLinks = Nothing
+ , plist_isRequired = Nothing
+ , plist_isRelocatable = Nothing
+ , plist_rootVolumeOnly = Nothing
+ }
+
+
+emptyDescPlist = DescriptionPlist {
+ dplist_title = Nothing
+ , dplist_version = Nothing
+ }
+
+
+instance Show InfoPlist where
+ show pkg = header ++ concat fields ++ footer
+ where
+ header = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n\
+ \<!DOCTYPE plist PUBLIC \"-//Apple Computer//DTD PLIST 1.0//EN\"\n\
+ \ \"http://www.apple.com/DTDs/PropertyList-1.0.dtd\">\n\
+ \<plist version=\"1.0\">\n\
+ \<dict>\n"
+
+ footer = "</dict>\n</plist>\n"
+
+ fields = [ str "CFBundleGetInfoString" plist_infoString
+ , str "CFBundleIdentifier" plist_identifier
+ , str "CFBundleName" plist_bundleName
+ , str "CFBundleShortVersionString" plist_shortVersionString
+ , str "IFPkgFlagAuthorizationAction" $ (show `fmap`) . plist_authorizationAction
+ , str "IFPkgFlagDefaultLocation" plist_defaultLocation
+ , bool "IFPkgFlagFollowLinks" plist_followLinks
+ , bool "IFPkgFlagIsRequired" plist_isRequired
+ , bool "IFPkgFlagRelocatable" plist_isRelocatable
+ , bool "IFPkgFlagRootVolumeOnly" plist_rootVolumeOnly
+ ]
+
+ key hdr = "\t<key>" ++ hdr ++ "</key>\n"
+
+ str :: String -> (InfoPlist -> Maybe String) -> String
+ str hdr f = maybe ""
+ (\v -> key hdr ++ "\t<string>" ++ esc v
+ ++ "</string>\n")
+ (f pkg)
+
+ bool :: String -> (InfoPlist -> Maybe Bool) -> String
+ bool hdr f = maybe ""
+ (\v -> key hdr ++ "\t" ++ val v ++ "\n")
+ (f pkg)
+ where
+ val b = if b then "<true/>" else "<false/>"
+
+
+
+
+instance Show DescriptionPlist where
+ show pkg = header ++ concat fields ++ footer
+ where
+ header = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n\
+ \<!DOCTYPE plist PUBLIC \"-//Apple Computer//DTD PLIST 1.0//EN\"\n\
+ \ \"http://www.apple.com/DTDs/PropertyList-1.0.dtd\">\n\
+ \<plist version=\"1.0\">\n\
+ \<dict>\n"
+
+ footer = "</dict>\n</plist>\n"
+
+ fields = [ str "IFPkgDescriptionTitle" dplist_title
+ , str "IFPkgDescriptionVersion" dplist_version ]
+
+ key hdr = "\t<key>" ++ hdr ++ "</key>\n"
+
+ str :: String -> (DescriptionPlist -> Maybe String) -> String
+ str hdr f = maybe ""
+ (\v -> key hdr ++ "\t<string>" ++ esc v
+ ++ "</string>\n")
+ (f pkg)
+
+ bool :: String -> (DescriptionPlist -> Maybe Bool) -> String
+ bool hdr f = maybe ""
+ (\v -> key hdr ++ "\t" ++ val v ++ "\n")
+ (f pkg)
+ where
+ val b = if b then "<true/>" else "<false/>"
+
+
+------------------------------------------------------------------------
+mkInfoPlist :: String -- ^ package identifier
+ -> String -- ^ package version
+ -> String -- ^ package description
+ -> String -- ^ installation prefix
+ -> InfoPlist
+mkInfoPlist identifier version descr prefix =
+ emptyPlist {
+ plist_identifier = Just ("org.haskell.libraries."
+ ++ identifier)
+ , plist_bundleName = Just ("Haskell Library " ++ identifier)
+ , plist_infoString = Just (identifier ++ ": " ++ descr)
+ , plist_shortVersionString = Just version
+ , plist_defaultLocation = Just prefix
+ , plist_isRelocatable = Just False
+ , plist_rootVolumeOnly = Just True
+ }
+
+
+------------------------------------------------------------------------
+mkDescriptionPlist :: String -> String -> DescriptionPlist
+mkDescriptionPlist title version =
+ emptyDescPlist {
+ dplist_title = Just title
+ , dplist_version = Just version
+ }
+
+
+
+esc :: String -> String
+esc x = showCData (CData { cdVerbatim = CDataText
+ , cdData = x
+ , cdLine = Nothing })
+
+
+
View
155 Main.hs
@@ -21,6 +21,7 @@
-- A consequence of this quick n' dirty approach is that in order to
-- build the installer for a cabal package, you need to have already
-- installed all of its dependencies on the build machine.
+------------------------------------------------------------------------
module Main (
-- * Program entry point
@@ -33,12 +34,6 @@ module Main (
, optionFlags
, usage
- -- * Macintosh @PackageInfo@ files
- , KVPs
- , PackageInfo(..)
- , packageInfoDefaults
- , packageInfoFields
-
-- * The \"heavy lifting\"
, makeMacPkg
@@ -49,25 +44,20 @@ module Main (
) where
-import Control.Concurrent
import Control.Exception
import Control.Monad
import Data.Char
+import Data.Function
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Version
-import Debug.Trace
-
import Distribution.Package
import Distribution.PackageDescription
import Distribution.PackageDescription.Configuration
import Distribution.PackageDescription.Parse
-import Distribution.Simple.Build
-import Distribution.Simple.Configure
-import Distribution.Simple.Setup
import Distribution.Simple.Utils hiding (intercalate)
import Distribution.Verbosity as Verbosity
@@ -81,22 +71,25 @@ import System.Process
import Text.Regex
-import qualified Data.ByteString.Lazy as B
-import qualified Data.Map as Map
import qualified System.Console.GetOpt as GetOpt
------------------------------------------------------------------------
+-- local imports
+import Distribution.OSX.Info
+
+
+------------------------------------------------------------------------
-- | Program entry point. Parses command line options, creates a
-- scratch directory, runs the package building process, and cleans up
-- after itself.
------------------------------------------------------------------------
main :: IO ()
main = do
- options <- getOptions
+ opts <- getOptions
bracket getTempDirectory
cleanupTempDirectory
- (runMain options)
+ (runMain opts)
@@ -108,12 +101,12 @@ main = do
runMain :: Options -- ^ command-line options
-> FilePath -- ^ temp directory path
-> IO ()
-runMain options tmpdir = do
+runMain opts tmpdir = do
cabalFile <- findPackageDesc "."
pkgDesc <- flattenPackageDescription `liftM`
readPackageDescription Verbosity.normal cabalFile
- makeMacPkg options tmpdir pkgDesc
+ makeMacPkg opts tmpdir pkgDesc
@@ -145,6 +138,7 @@ data Options = Options {
} deriving (Eq, Show)
+defaultOptions :: Options
defaultOptions = Options { installPrefix = Just "/usr/local"
, showUsage = False
, packageMakerPath = Just "/Developer/usr/bin/packagemaker"
@@ -163,7 +157,10 @@ instance Monoid Options where
, showUsage = showUsage a || showUsage b
}
where
- a *+* b = getLast $ Last a `mappend` Last b
+ -- monoid append using "Last" behaviour
+ (*+*) :: Maybe a -> Maybe a -> Maybe a
+ (*+*) = (getLast .) . (mappend `on` Last)
+
override f = f a *+* f b
@@ -218,7 +215,7 @@ getOptions = do
args <- getArgs
opts <-
case GetOpt.getOpt GetOpt.RequireOrder optionFlags args of
- (o,n,[]) -> return $ defaultOptions `mappend` mconcat o
+ (o,_,[]) -> return $ defaultOptions `mappend` mconcat o
(_,_,errs) -> usage errs
if showUsage opts
@@ -230,79 +227,6 @@ getOptions = do
------------------------------------------------------------------------
-
-------------------------------------------------------------------------
--- types & functions for mac packageinfo files
-------------------------------------------------------------------------
-
-type KVPs = Map.Map String String
-
--- | a @PackageInfo@ file is just a key-value pair mapping. We'll wrap
--- it in a newtype so we can define a custom 'Show' instance
-newtype PackageInfo = PackageInfo KVPs
-
-
--- | The 'packageInfoFields' variable stores a list of the available
--- fields for package .info files. Currently not in use, it's mostly
--- for reference. I stole this stuff from some python code,
--- documentation for the various Mac file formats is difficult to find
-packageInfoFields :: [String]
-packageInfoFields = [
- "Title"
- , "Version"
- , "Description"
- , "DefaultLocation"
- , "DeleteWarning"
- , "NeedsAuthorization"
- , "DisableStop"
- , "UseUserMask"
- , "Application"
- , "Relocatable"
- , "Required"
- , "InstallOnly"
- , "RequiresReboot"
- , "RootVolumeOnly"
- , "LongFilenames"
- , "LibrarySubdirectory"
- , "AllowBackRev"
- , "OverwritePermissions"
- , "InstallFat"]
-
-
--- | defaults for the packageinfo file
-packageInfoDefaults :: KVPs
-packageInfoDefaults = Map.fromList [
- ("Title" , "" )
- , ("Version" , "" )
- , ("Description" , "" )
- , ("DefaultLocation" , "/" )
- , ("DeleteWarning" , "" )
- , ("NeedsAuthorization" , "YES" )
- , ("DisableStop" , "NO" )
- , ("UseUserMask" , "YES" )
- , ("Application" , "NO" )
- , ("Relocatable" , "NO" )
- , ("Required" , "NO" )
- , ("InstallOnly" , "NO" )
- , ("RequiresReboot" , "NO" )
- , ("RootVolumeOnly" , "YES" )
- , ("InstallFat" , "NO" )
- , ("LongFilenames" , "YES" )
- , ("LibrarySubdirectory" , "Standard")
- , ("AllowBackRev" , "YES" )
- , ("OverwritePermissions" , "NO" )
- ]
-
-
-instance Show PackageInfo where
- show (PackageInfo pkg) = e `concatMap` alist
- where
- alist = Map.toAscList pkg
- e (k,v) = k ++ " " ++ v ++ "\n"
-
-
-
-
------------------------------------------------------------------------
-- "the guts"
------------------------------------------------------------------------
@@ -314,7 +238,7 @@ makeMacPkg :: Options -- ^ command-line options
-> FilePath -- ^ path to temp directory
-> PackageDescription -- ^ a parsed .cabal file
-> IO ()
-makeMacPkg options tmpdir pkgDesc = do
+makeMacPkg opts tmpdir pkgDesc = do
-- some portions of package building process require root
-- privileges
@@ -333,8 +257,8 @@ makeMacPkg options tmpdir pkgDesc = do
-- the correct username & permissions
setRootPrivileges
- -- make .info file
- mkInfoFile
+ -- make .info files
+ mkInfoFiles
where
--------------------------------------------------------------------
@@ -344,22 +268,25 @@ makeMacPkg options tmpdir pkgDesc = do
-- package metadata
pkgDescription = synopsis pkgDesc
pkgTitle = unPackageName . packageName $ pkgDesc
- pkgVersion = showVersion . packageVersion $ pkgDesc
+ pkgVersionString = showVersion . packageVersion $ pkgDesc
pkgBaseName = subRegex (mkRegex "[[:space:]]+") pkgTitle "_"
- pkgDestinationFile = tmpdir </> "FIXME.pkg"
+ pkgDestinationFile = tmpdir </> (pkgBaseName ++ "-" ++ pkgVersionString
+ ++ ".pkg")
-- directories
cabalBuildDir = tmpdir </> "dist"
contentsDir = stagingDir </> "Contents"
resourceDir = tmpdir </> "Resources"
+ scriptsDir = tmpdir </> "Scripts"
stagingDir = tmpdir </> "stage"
-- config options
- packageMakerCmd = fromJust $ packageMakerPath options
- prefix = fromJust $ installPrefix options
+ packageMakerCmd = fromJust $ packageMakerPath opts
+ prefix = fromJust $ installPrefix opts
-- output files
- infoPath = tmpdir </> (pkgTitle ++ ".info")
+ infoPath = tmpdir </> "Info.plist"
+ descInfoPath = resourceDir </> "Description.plist"
postflightScriptFile = resourceDir </> "postflight"
@@ -378,13 +305,14 @@ makeMacPkg options tmpdir pkgDesc = do
--------------------------------------------------------------------
-- creates necessary directories inside the work area
createDirectories =
- createDirectory `mapM_` [stagingDir, resourceDir, contentsDir]
+ createDirectory `mapM_` [stagingDir, scriptsDir, resourceDir,
+ contentsDir]
--------------------------------------------------------------------
-- uses cabal to build the package into the work area
buildPackageContents = do
- runSetup "configure" ["--global", "--prefix=" ++ prefix]
+ runSetup "configure" ["--global", "--prefix=/testme"]
runSetup "build" []
runSetup "haddock" []
runSetup "copy" ["--destdir=" ++ contentsDir]
@@ -397,18 +325,17 @@ makeMacPkg options tmpdir pkgDesc = do
--------------------------------------------------------------------
-- populate the package .info file in the resource directory
- mkInfoFile :: IO ()
- mkInfoFile =
+ mkInfoFiles :: IO ()
+ mkInfoFiles = do
writeFile infoPath (show pinfo)
+ writeFile descInfoPath (show dpinfo)
where
- defaults = packageInfoDefaults
- overrides = Map.fromList [
- ("Title", pkgTitle)
- , ("Version", pkgVersion)
- , ("Description", pkgDescription)
- ]
+ pinfo = mkInfoPlist pkgBaseName
+ pkgVersionString
+ pkgDescription
+ prefix
- pinfo = PackageInfo $ Map.union overrides defaults
+ dpinfo = mkDescriptionPlist pkgBaseName pkgVersionString
-- TODO: make sure files are owned by root and have correct
@@ -426,8 +353,8 @@ makeMacPkg options tmpdir pkgDesc = do
-- i.e. "configure"/"build"/etc
-> [String] -- ^ additional arguments
-> IO ()
- runSetup cmd opts =
- runCmd "runghc" $ ["Setup", cmd] ++ mkOpts opts
+ runSetup cmd args =
+ runCmd "runghc" $ ["Setup", cmd] ++ mkOpts args
where
mkOpts s = s ++ ["--builddir=" ++ cabalBuildDir]
View
53 TODO.markdown
@@ -1,21 +1,64 @@
TODO for cabal2macpkg
=====================
-(in rough order)
+### 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.
+
round 1
-------
-* parse the .cabal files to get important info about the package
- (name, version, etc)
-
* get the staging area in the right format for the OSX installer tool
and run it
+* If I want relocatable packages, which Manuel wanted, I've become
+ convinced that I need to move away from `cabal register
+ --gen-script` to `cabal register --gen-pkg-config` and write my own
+ postflight script. This will mean an extra step here (boilerplate
+ shell script, rewriting the target path to `$4` or whatever the
+ correct argument is). Note to self: use "env" to locate ghc-pkg?
+
* add --output=[FILE] and an --outputdir=[DIR] to control where the
generated .pkg files go
-* code cleanup (warnings, imports, formatting, etc)
+* code cleanup (warnings, imports, formatting, etc) *(a pre-release
+ activity)*
round 2
View
5 cabal2macpkg.cabal
@@ -18,13 +18,14 @@ executable cabal2macpkg
build-depends:
base >= 3,
pretty,
- process,
+ process == 1.0.1.0,
directory,
containers,
bytestring,
Cabal >= 1.6,
pureMD5 >= 0.2.1,
filepath,
regex-compat,
- unix
+ unix,
+ xml

0 comments on commit ebd2c92

Please sign in to comment.
Something went wrong with that request. Please try again.