diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,1 @@ +BSD3 diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/macosx-make-standalone.cabal b/macosx-make-standalone.cabal new file mode 100644 --- /dev/null +++ b/macosx-make-standalone.cabal @@ -0,0 +1,40 @@ +Name: macosx-make-standalone +Version: 0.1 +Synopsis: Make a macosx app standalone deployable +Description: Make a macosx app standalone by bundling all dylibs into it. +License: BSD3 +license-file: LICENSE +Author: Atze Dijkstra +Maintainer: atze@uu.nl +Homepage: https://github.com/atzedijkstra/macosx-make-standalone +Bug-Reports: https://github.com/atzedijkstra/macosx-make-standalone/issues +Copyright: 2012 Utrecht University +Category: Development +Build-type: Simple +Cabal-version: >=1.6 +source-repository head + type: git + location: git://github.com/atzedijkstra/macosx-make-standalone.git + + +Executable macosx-make-standalone + HS-Source-Dirs: src + Main-is: MakeStandalone.hs + GHC-Options: + Extensions: ScopedTypeVariables, TemplateHaskell, DeriveDataTypeable + Build-depends: + base >= 4 && < 5, + data-lens >= 2 && < 3, + data-lens-template >= 2 && < 3, + mtl >= 2 && < 3, + containers >= 0.4 && < 0.5, + transformers >= 0.3 && < 0.4, + directory >= 1 && < 2, + filepath >= 1 && < 2, + process >= 1 && < 2, + unix >= 2 && < 3, + deepseq >= 1 && < 2, + graph-visit >= 0.1.0.1 && < 0.2 + + Other-modules: + Opts, State, LibDepGraph, Plan, Cmds diff --git a/src/Cmds.hs b/src/Cmds.hs new file mode 100644 --- /dev/null +++ b/src/Cmds.hs @@ -0,0 +1,142 @@ +module Cmds + ( OToolOutput + + , libNm + , libUses + + , cmdOTool + , cmdCP + , cmdChmod + , cmdMkdir + , cmdInstallNameToolId + , cmdInstallNameToolChange + ) where + +------------------------------------------------------------------------- +-- Imports +------------------------------------------------------------------------- + +import Data.Lens.Common +import Data.Lens.Template +import Data.Lens.Strict +import Data.Typeable +import Data.List + +import Control.DeepSeq + +import Control.Monad +-- import Control.Monad.State.Strict +import Control.Monad.Trans +-- import Control.Monad.Error.Class + +import qualified Control.Exception as CE + +-- import System.Console.GetOpt +-- import System.Environment +import System.IO +-- import System.Exit +import System.FilePath +-- import System.Directory +-- import System.Cmd +import System.Process +-- import System.Posix.Process + +import Opts +import State + +------------------------------------------------------------------------- +-- Cmd run +------------------------------------------------------------------------- + +showCmdSpec (ShellCommand s) = s +showCmdSpec (RawCommand f as) = concat $ intersperse " " (f:as) + +cmdRunPlain :: Opts -> CreateProcess -> IO () +cmdRunPlain opts p = do + when (opts ^. optVerbose) (putStrLn (showCmdSpec $ cmdspec p)) + (_, _, _, phandle) <-createProcess p + waitForProcess phandle + return () + +cmdRunOutputPipe :: Opts -> CreateProcess -> IO Handle +cmdRunOutputPipe opts p = do + when (opts ^. optVerbose) (putStrLn (showCmdSpec $ cmdspec p)) + (_, Just hout, _, phandle) <- createProcess (p {std_out = CreatePipe}) + waitForProcess phandle + return hout + +cmdRun :: String -> String -> [FilePath] -> StRun () +cmdRun c m fs = do + opts <- access opts + liftIO $ cmdRunPlain opts $ proc c (m : fs) + +------------------------------------------------------------------------- +-- otool +------------------------------------------------------------------------- + +data OToolOutput = OToolOutput + { _libNm :: !FilePath + , _libUses :: ![FilePath] + } + deriving (Show,Typeable) + +instance NFData OToolOutput where + rnf (OToolOutput n u) = rnf n `seq` rnf u + +makeLens ''OToolOutput + +parseOToolOutput :: String -> OToolOutput +parseOToolOutput s = OToolOutput (takeWhile (/= ':') $ head lib) (map head uses) + where (lib:uses) = filter (not . null) $ map words $ lines s + +otoolOutputFilterOutUnwanted :: Opts -> OToolOutput -> OToolOutput +otoolOutputFilterOutUnwanted opts = libUses ^%= filter (\f -> okExt f && okLoc f) + where okExt f = takeExtension f `elem` opts ^. optIncludeExtensions + okLoc f = not $ any (`isPrefixOf` f) $ opts ^. optExcludePrefixes + +cmdOTool :: FilePath -> StRun OToolOutput +cmdOTool f = do + opts <- access opts + liftIO $ do + hout <- cmdRunOutputPipe opts $ proc "otool" ["-L", f] + o <- fmap (otoolOutputFilterOutUnwanted opts . parseOToolOutput) $ hGetContents hout + o `deepseq` hClose hout + return o + +------------------------------------------------------------------------- +-- cp +------------------------------------------------------------------------- + +cmdCP :: String -> FilePath -> FilePath -> StRun () +cmdCP o fFr fTo = cmdRun "cp" o [fFr, fTo] + +------------------------------------------------------------------------- +-- chmod +------------------------------------------------------------------------- + +cmdChmod :: String -> FilePath -> StRun () +cmdChmod o f = cmdRun "chmod" o [f] + +------------------------------------------------------------------------- +-- mkdir +------------------------------------------------------------------------- + +cmdMkdir :: String -> FilePath -> StRun () +cmdMkdir o f = cmdRun "mkdir" o [f] + +------------------------------------------------------------------------- +-- install_name_tool +------------------------------------------------------------------------- + +cmdInstallNameToolChange :: FilePath -> FilePath -> FilePath -> StRun () +cmdInstallNameToolChange fIn fFr fTo = cmdRun "install_name_tool" "-change" [fFr, fTo, fIn] + +cmdInstallNameToolId :: FilePath -> FilePath -> StRun () +cmdInstallNameToolId fIn fTo = cmdRun "install_name_tool" "-id" [fTo, fIn] + +{- + install_name_tool -id @executable_path/../libs/libwx_osx_cocoau_xrc-2.9.4.0.0.dylib ./Dazzle.app/Contents/libs/libwx_osx_cocoau_xrc-2.9.4.0.0.dylib + +* Fixing dependencies on ./Dazzle.app/Contents/libs/libwx_osx_cocoau_xrc-2.9.4.0.0.dylib + install_name_tool -change /Volumes/Work/.cabal/lib/wxc-0.90.0.4/ghc-7.4.1/libwxc.dylib @executable_path/../libs/libwxc.dylib ./Dazzle.app/Contents/libs/libwx_osx_cocoau_xrc-2.9.4.0.0.dylib +-} diff --git a/src/LibDepGraph.hs b/src/LibDepGraph.hs new file mode 100644 --- /dev/null +++ b/src/LibDepGraph.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE TemplateHaskell, DeriveDataTypeable #-} + +module LibDepGraph + ( LibDepGraph + , initLibDepGraph + + , ldepRoot + , ldepGraph + , ldepSymLinks + + , ldepResolveSymlink + ) + where + +------------------------------------------------------------------------- +-- Imports +------------------------------------------------------------------------- + +import Data.Lens.Common +import Data.Lens.Template +-- import Data.Graph.GraphVisit +import qualified Data.Map as Map +import Data.Typeable +-- import qualified Data.Set as Set + +-- import Control.Monad +-- import Control.Monad.State.Strict +-- import Control.Monad.Trans +-- import Control.Monad.Error.Class + +-- import qualified Control.Exception as CE + +-- import System.Console.GetOpt +-- import System.Environment +-- import System.IO +-- import System.Exit +-- import System.FilePath +-- import System.Directory +-- import System.Cmd +-- import System.Process +-- import System.Posix.Process + +-- import Opts +-- import State +import Cmds (OToolOutput) + +------------------------------------------------------------------------- +-- Library dependency graph +------------------------------------------------------------------------- + +data LibDepGraph = LibDepGraph + { _ldepRoot :: FilePath + , _ldepGraph :: Map.Map FilePath OToolOutput + , _ldepSymLinks :: Map.Map FilePath FilePath + } + deriving (Show,Typeable) + +initLibDepGraph :: FilePath -> LibDepGraph +initLibDepGraph f = LibDepGraph f Map.empty Map.empty + +makeLens ''LibDepGraph + +------------------------------------------------------------------------- +-- Resolve symlink via LibDepGraph +------------------------------------------------------------------------- + +-- | Resolve symlink via LibDepGraph +ldepResolveSymlink :: LibDepGraph -> FilePath -> FilePath +ldepResolveSymlink ldep fnm = maybe fnm (ldepResolveSymlink ldep) $ Map.lookup fnm $ ldep ^. ldepSymLinks diff --git a/src/MakeStandalone.hs b/src/MakeStandalone.hs new file mode 100644 --- /dev/null +++ b/src/MakeStandalone.hs @@ -0,0 +1,185 @@ +module Main where + +------------------------------------------------------------------------- +-- Imports +------------------------------------------------------------------------- + +import Data.Lens.Common +import Data.Graph.GraphVisit +import qualified Data.Map as Map +import qualified Data.Set as Set +import qualified Data.Sequence as Seq + +import Control.Monad +import Control.Monad.State.Strict +import Control.Monad.Trans +import Control.Monad.Error.Class + +import qualified Control.Exception as CE + +import System.Console.GetOpt +import System.Environment +import System.IO +import System.Exit +import System.FilePath +import System.Directory +import System.Cmd +import System.Process +import System.Posix.Process +import System.Posix.Files + +import Opts +import State +import Cmds +import LibDepGraph +import Plan + +------------------------------------------------------------------------- +-- Main +------------------------------------------------------------------------- + +main :: IO () +main = do + args <- getArgs + progName <- getProgName + + let optsInit = optProgName ^= progName $ defaultOpts + oo@(o,n,errs) = getOpt Permute cmdLineOpts args + opts = foldr ($) optsInit o + + case (errs, opts ^. optImmediateCommands, n) of + (es@(_:_),_ ,_ ) -> forM_ es (hPutStr stderr) + (_ ,os@(_:_),_ ) -> forM_ os (handleImmediateCommand opts) + (_ ,_ ,[fnm]) -> doIt opts fnm + _ -> do handleImmediateCommand opts ImmediateCommand_Help + exitFailure + +doIt :: Opts -> FilePath -> IO () +doIt opts fnmApp = do + pid <- getProcessID + tmpdir <- getTemporaryDirectory + let st = initSt opts (RunEnv tmpdir pid fnm) + flip evalStateT st $ + catchError (do { thework ; cleanup }) + handleerr + where + fnm = fpathOfExec opts fnmApp + thework = do + ldep <- otoolGraphVisit2LibDepGraph fnm + when (opts ^. optDebug) (liftIO $ putStrLn (show ldep)) + let plan = seqToList $ ldepGraph2Plan opts fnmApp ldep + when (opts ^. optDebug) (liftIO $ forM_ plan (putStrLn . show)) + forM_ plan planCmdExec + return () + -- f <- srFreshTmpName + -- liftIO $ putStrLn f + cleanup = srRmFilesToRm + handleerr (e :: CE.IOException) = do + liftIO $ hPutStrLn stderr (show fnm ++ ": " ++ show e) + cleanup + +------------------------------------------------------------------------- +-- Immediate command handling +------------------------------------------------------------------------- + +-- | Handle an immediate command +handleImmediateCommand :: Opts -> ImmediateCommand -> IO () +handleImmediateCommand opts ImmediateCommand_Help = putStrLn (usageInfo ("Usage: " ++ opts ^. optProgName ++ " [options] \n\noptions:") cmdLineOpts) + +------------------------------------------------------------------------- +-- Graph walk over the results provided by otool, gathering the library dependency graph +------------------------------------------------------------------------- + +otoolGraphVisit2LibDepGraph :: FilePath -> StRun LibDepGraph +otoolGraphVisit2LibDepGraph f = fmap fst $ graphVisitM visit (Set.singleton f) () (initLibDepGraph f) + where visit t _ fnm = do + o <- cmdOTool fnm + (fnm', links) <- liftIO $ symlinkResolve fnm + return + ( ldepSymLinks ^%= Map.union (Map.fromList [ (l,fnm') | l <- links ]) + $ ldepGraph ^%= Map.insert fnm' o + $ t + , Set.fromList $ o ^. libUses + ) + +------------------------------------------------------------------------- +-- Graph walk over the library dependency graph, constructing the modification plan +------------------------------------------------------------------------- + +-- ldepGraphVisit2Plan :: LibDepGraph -> StRun Plan + +------------------------------------------------------------------------- +-- Compute the modification plan +------------------------------------------------------------------------- + +ldepGraph2Plan :: Opts -> FilePath -> LibDepGraph -> Plan +ldepGraph2Plan opts fnmApp ldep = + Seq.fromList + [ PlanCmd_CP o n | (n,((o:_),_)) <- Map.toList filesToCopy ] + Seq.>< + foldr (Seq.><) Seq.empty + [ Seq.fromList $ PlanCmd_IntlRename n ri : mkModfRef filesToCopy n o + | (n,((o:_),ri)) <- Map.toList filesToCopy + ] + Seq.>< + foldr (Seq.><) Seq.empty + [ Seq.fromList $ mkModfRef filesToCopy o o + | (_,((o:_),_)) <- Map.toList filesRoot + ] + where + filesToCopy = mkFilesToCopyMp (Set.delete (ldep ^. ldepRoot) $ Map.keysSet $ ldep ^. ldepGraph) + filesRoot = Map.fromList [ (o,([o],o)) | o <- [ldep ^. ldepRoot] ] + mkFilesToCopyMp fs = Map.fromListWith (\(l1,r1) (l2,_) -> (l1++l2,r1)) + [ (n, ([l],r)) + | l <- Set.toList fs + , let (n,r) = fpathOfNewLib opts fnmApp l + ] + mkFilesToCopyMpRev fMp = Map.fromList [ (o,r) | (n,(os,r)) <- Map.toList fMp, o <- os ] + mkModfRef fMp n o = + [ PlanCmd_ModfRef n u rr + | u <- maybe [] (^. libUses) $ Map.lookup o $ ldep ^. ldepGraph + , let u2 = ldepResolveSymlink ldep u + rr = Map.findWithDefault u2 u2 fMpRev + ] + where fMpRev = mkFilesToCopyMpRev fMp + +------------------------------------------------------------------------- +-- File name manipulation +------------------------------------------------------------------------- + +-- | Given app bundle name, return the location of the executable +fpathOfExec :: Opts -> FilePath -> FilePath +fpathOfExec opts fnm = fnm opts ^. optInAppLocOfExec f + where (df,e) = splitExtension fnm + (d,f) = splitFileName df + +-- | Given app bundle name, return the location of the new lib loc plus new name as it is to be used for referring to +fpathOfNewLib :: Opts -> FilePath -> FilePath -> (FilePath,FilePath) +fpathOfNewLib opts fnmApp fnmLib = + ( fnmApp opts ^. optInAppCpLocOfLibDest fl + , opts ^. optInAppRenameLocOfLibDest fl + ) + where + (_,fl) = splitFileName fnmLib + +-- | Normalise path, on top of normal normalise also remove ".." +fpathNormalise :: FilePath -> FilePath +fpathNormalise fnm = joinPath $ reverse $ n [] $ splitDirectories $ normalise fnm + where n (_:acc) ("..":f) = n acc f + n acc (x :f) = n (x:acc) f + n acc [] = acc + +------------------------------------------------------------------------- +-- Symbolic link resolution +------------------------------------------------------------------------- + +-- | Possibly resolve symbolic link, returning the actual filename + symlinks to it +symlinkResolve :: FilePath -> IO (FilePath, [FilePath]) +symlinkResolve fnm = do + stat <- getSymbolicLinkStatus fnm + -- putStrLn $ fnm ++ ": " ++ show (isSymbolicLink stat) + if isSymbolicLink stat + then do fnmLinkedTo <- fmap (fpathNormalise . (takeDirectory fnm )) $ readSymbolicLink fnm + (fnm',links) <- symlinkResolve fnmLinkedTo + return (fnm', fnm : links) + else return (fnm, []) diff --git a/src/Opts.hs b/src/Opts.hs new file mode 100644 --- /dev/null +++ b/src/Opts.hs @@ -0,0 +1,93 @@ +module Opts + ( ImmediateCommand(..) + + , Opts + + , optImmediateCommands + , optVerbose + , optDebug + , optProgName + , optExcludePrefixes + , optIncludeExtensions + , optInAppLocOfExec + , optInAppCpLocOfLibDest + , optInAppRenameLocOfLibDest + + + , defaultOpts + , cmdLineOpts + ) where + +------------------------------------------------------------------------- +-- Imports +------------------------------------------------------------------------- + +import Prelude hiding ((.)) +import Control.Category + +import Data.Lens.Common +import Data.Lens.Template +import Data.Typeable + +import System.Console.GetOpt + +------------------------------------------------------------------------- +-- Immediate commands +------------------------------------------------------------------------- + +-- | Immediate command, that is, being done before actually doing the work of the program +data ImmediateCommand + = ImmediateCommand_Help + +------------------------------------------------------------------------- +-- Options +------------------------------------------------------------------------- + +-- | Options +data Opts + = Opts + { _optVerbose :: Bool -- ^ be verbose + , _optDebug :: Bool -- ^ dump debug info + , _optImmediateCommands :: [ImmediateCommand] -- ^ e.g. help + , _optProgName :: String -- ^ the name of this program + , _optExcludePrefixes :: [FilePath] -- ^ prefixes of locations which may not be copied + , _optIncludeExtensions :: [String] -- ^ extensions which must be copied (if outside) + , _optInAppLocOfExec :: FilePath -- ^ relative location of executable in app bundle + , _optInAppCpLocOfLibDest :: FilePath -- ^ relative location of where copied libraries should end up in app bundle + , _optInAppRenameLocOfLibDest :: FilePath -- ^ relative location of where to renaming should be done in app bundle + } + deriving (Typeable) + +-- dylibbundler -od -b -x ./Dazzle.app/Contents/MacOS/Dazzle -d ./Dazzle.app/Contents/libs/ -p @executable_path/../libs/ + +makeLens ''Opts + +defaultOpts + = Opts + { _optVerbose = False + , _optDebug = False + , _optImmediateCommands = [] + , _optProgName = "??" + , _optExcludePrefixes = [ "/usr/lib" + , "/System/Library/Frameworks" + ] + , _optIncludeExtensions = [ ".dylib" + ] + , _optInAppLocOfExec = "Contents/MacOS" + , _optInAppCpLocOfLibDest = "Contents/lib" + , _optInAppRenameLocOfLibDest = "@executable_path/../lib" + } + +------------------------------------------------------------------------- +-- Cmdline opts +------------------------------------------------------------------------- + +cmdLineOpts + = [ Option "" ["help"] (NoArg $ optImmediateCommands ^%= ([ImmediateCommand_Help] ++)) + "output this help" + , Option "v" ["verbose"] (NoArg $ optVerbose ^= True) + "be verbose" + , Option "d" ["debug"] (NoArg $ (optVerbose ^= True) . (optDebug ^= True)) + "dump debug info" + ] + diff --git a/src/Plan.hs b/src/Plan.hs new file mode 100644 --- /dev/null +++ b/src/Plan.hs @@ -0,0 +1,91 @@ +module Plan + ( PlanCmd(..) + , Plan + + , planCmdExec + + , seqToList + ) + where + +------------------------------------------------------------------------- +-- Imports +------------------------------------------------------------------------- + +import Data.Lens.Common +import Data.Lens.Template +-- import Data.Graph.GraphVisit +-- import qualified Data.Map as Map +import Data.Sequence +import Data.Typeable +-- import qualified Data.Set as Set + +-- import Control.Monad +-- import Control.Monad.State.Strict +-- import Control.Monad.Trans +-- import Control.Monad.Error.Class + +-- import qualified Control.Exception as CE + +-- import System.Console.GetOpt +-- import System.Environment +-- import System.IO +-- import System.Exit +import System.FilePath +-- import System.Directory +-- import System.Cmd +-- import System.Process +-- import System.Posix.Process + +import Opts +import State +import Cmds + +------------------------------------------------------------------------- +-- Execution plan for modification commands +------------------------------------------------------------------------- + +data PlanCmd + = PlanCmd_CP -- ^ Copy file + { _pcFrom :: FilePath + , _pcTo :: FilePath + } + | PlanCmd_ModfRef -- ^ Modify ref in file + { _pcInFile :: FilePath + , _pcFrom :: FilePath + , _pcTo :: FilePath + } + | PlanCmd_IntlRename -- ^ Modify internal name in file + { _pcInFile :: FilePath + , _pcTo :: FilePath + } + deriving (Show,Typeable) + +makeLens ''PlanCmd + +type Plan = Seq PlanCmd + +------------------------------------------------------------------------- +-- Actual execution +------------------------------------------------------------------------- + +planCmdExec :: PlanCmd -> StRun () +planCmdExec pcmd = case pcmd of + PlanCmd_CP fFr fTo -> do + cmdMkdir "-p" $ takeDirectory fTo + cmdCP "-f" fFr fTo + cmdChmod "+w" fTo + PlanCmd_ModfRef fIn fFr fTo -> do + cmdInstallNameToolChange fIn fFr fTo + PlanCmd_IntlRename fIn fTo -> do + cmdInstallNameToolId fIn fTo + +------------------------------------------------------------------------- +-- Seq extension +------------------------------------------------------------------------- + +seqToList :: Seq a -> [a] +seqToList s = case viewl s of + EmptyL -> [] + hd :< tl -> hd : seqToList tl + diff --git a/src/State.hs b/src/State.hs new file mode 100644 --- /dev/null +++ b/src/State.hs @@ -0,0 +1,103 @@ +module State + ( ImmediateCommand(..) + + , RunEnv(RunEnv) + + , State + , initSt + + , opts + , pid + + , StRun + + , srRmFilesToRm + , srFreshTmpName + , srRegisterFileForRm + ) where + +------------------------------------------------------------------------- +-- Imports +------------------------------------------------------------------------- + +import Data.Lens.Common +import Data.Lens.Template +import Data.Lens.Strict +import Data.Typeable +-- import qualified Data.Set as Set + +import Control.Monad.State.Strict +import qualified Control.Exception as CE + +import System.Posix.Types +import System.FilePath +import System.IO +-- import System.IO.Temp +import System.Directory + +import Opts + +------------------------------------------------------------------------- +-- Bits of info about runtime env +------------------------------------------------------------------------- + +data RunEnv = RunEnv + { _tmpdir :: FilePath + , _pid :: ProcessID + , _argFile :: FilePath + } + deriving Typeable + +makeLens ''RunEnv + +------------------------------------------------------------------------- +-- State +------------------------------------------------------------------------- + +data St = St + { _opts :: Opts + , _runEnv :: RunEnv + , _uniq :: Int + , _filesToRm :: [FilePath] + } + deriving Typeable + +initSt :: Opts -> RunEnv -> St +initSt o e = St o e 0 [] + +makeLens ''St + +------------------------------------------------------------------------- +-- St monad +------------------------------------------------------------------------- + +type StRun a = StateT St IO a + +-- | get a fresh uniq nr +srFreshUniq :: StRun Int +srFreshUniq = do + i <- access uniq + uniq += 1 + return i + +-- | register file for removal +srRegisterFileForRm :: FilePath -> StRun [FilePath] +srRegisterFileForRm f = filesToRm %= ([f]++) + +-- | remove all files registered for removal +srRmFilesToRm :: StRun () +srRmFilesToRm = do + files <- filesToRm %%= (\f -> (f,[])) + liftIO $ forM_ files rm + where rm f = CE.catch (removeFile f) + (\(e :: CE.SomeException) -> hPutStrLn stderr (show f ++ ": " ++ show e)) + +-- | get a fresh tmp filename +srFreshTmpName :: StRun FilePath +srFreshTmpName = do + i <- srFreshUniq + e <- access runEnv + let t = e ^. tmpdir takeBaseName (e ^. argFile) ++ "-" ++ show (e ^. pid) ++ "-" ++ show i + srRegisterFileForRm t + return t +