Permalink
Browse files

initial code

  • Loading branch information...
1 parent bdaac3b commit d2f1735318fd1039ee0531d1669c3aebfd9cb3b3 @atzedijkstra committed Oct 5, 2012
Showing with 671 additions and 0 deletions.
  1. +32 −0 macosx-make-standalone.cabal
  2. +112 −0 src/Cmds.hs
  3. +69 −0 src/LibDepGraph.hs
  4. +177 −0 src/MakeStandalone.hs
  5. +85 −0 src/Opts.hs
  6. +87 −0 src/Plan.hs
  7. +103 −0 src/State.hs
  8. +6 −0 test
@@ -0,0 +1,32 @@
+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
+Author: Atze Dijkstra
+Maintainer: atze@uu.nl
+Homepage: https://github.com/atzedijkstra
+Bug-Reports: https://github.com/atzedijkstra/issues
+Copyright: 2012 Utrecht University
+Category: Development
+Build-type: Simple
+Cabal-version: >=1.6
+
+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,
+ directory,
+ filepath,
+ process,
+ unix,
+ deepseq,
+ graph-visit >= 0.1.0.1 && < 0.2
View
@@ -0,0 +1,112 @@
+module Cmds
+ ( OToolOutput
+
+ , libNm
+ , libUses
+
+ , cmdOTool
+ , cmdCP
+ , cmdChmod
+ ) 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))
+ createProcess p
+ return ()
+
+cmdRunOutputPipe :: Opts -> CreateProcess -> IO Handle
+cmdRunOutputPipe opts p = do
+ when (opts ^. optVerbose) (putStrLn (showCmdSpec $ cmdspec p))
+ (_, Just hout, _, _) <- createProcess (p {std_out = CreatePipe})
+ return hout
+
+-------------------------------------------------------------------------
+-- 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 = do
+ opts <- access opts
+ liftIO $ cmdRunPlain opts $ proc "cp" [o, fFr, fTo]
+
+-------------------------------------------------------------------------
+-- chmod
+-------------------------------------------------------------------------
+
+cmdChmod :: String -> FilePath -> StRun ()
+cmdChmod m f = do
+ opts <- access opts
+ liftIO $ cmdRunPlain opts $ proc "chmod" [m, f]
View
@@ -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
View
@@ -0,0 +1,177 @@
+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 ^. optVerbose) (liftIO $ putStrLn (show ldep))
+ let plan = ldepGraph2Plan opts fnmApp ldep
+ when (opts ^. optVerbose) (liftIO $ forM_ (seqToList plan) (putStrLn . show))
+ 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] <mac app>\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 o ri
+ : [ PlanCmd_ModfRef n u rr
+ | u <- maybe [] (^. libUses) $ Map.lookup o $ ldep ^. ldepGraph
+ , let u2 = ldepResolveSymlink ldep u
+ rr = Map.findWithDefault u2 u2 filesToCopyRev
+ ]
+ | (n,((o:_),ri)) <- Map.toList filesToCopy
+ ]
+ where
+ filesToCopy = Map.fromListWith (\(l1,r1) (l2,_) -> (l1++l2,r1))
+ [ (n, ([l'],r))
+ | l <- Set.toList $ Set.delete (ldep ^. ldepRoot) $ Map.keysSet $ ldep ^. ldepGraph
+ , let l' = l -- ldepResolveSymlink ldep l
+ (n,r) = fpathOfNewLib opts fnmApp l'
+ ]
+ filesToCopyRev = Map.fromList [ (o,r) | (n,(os,r)) <- Map.toList filesToCopy, o <- os ]
+
+-------------------------------------------------------------------------
+-- 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, [])
Oops, something went wrong.

0 comments on commit d2f1735

Please sign in to comment.