never executed always true always false
    1 module GHC.Linker.MacOS
    2    ( runInjectRPaths
    3    , getUnitFrameworkOpts
    4    , getFrameworkOpts
    5    , loadFramework
    6    )
    7 where
    8 
    9 import GHC.Prelude
   10 import GHC.Platform
   11 
   12 import GHC.Driver.Session
   13 
   14 import GHC.Unit.Types
   15 import GHC.Unit.State
   16 import GHC.Unit.Env
   17 
   18 import GHC.SysTools.Tasks
   19 
   20 import GHC.Runtime.Interpreter
   21 
   22 import GHC.Utils.Exception
   23 import GHC.Utils.Logger
   24 
   25 import Data.List (isPrefixOf, nub, sort, intersperse, intercalate)
   26 import Data.Char
   27 import Data.Maybe
   28 import Control.Monad (join, forM, filterM, void)
   29 import System.Directory (doesFileExist, getHomeDirectory)
   30 import System.FilePath ((</>), (<.>))
   31 import Text.ParserCombinators.ReadP as Parser
   32 
   33 -- | On macOS we rely on the linkers @-dead_strip_dylibs@ flag to remove unused
   34 -- libraries from the dynamic library.  We do this to reduce the number of load
   35 -- commands that end up in the dylib, and has been limited to 32K (32768) since
   36 -- macOS Sierra (10.14).
   37 --
   38 -- @-dead_strip_dylibs@ does not dead strip @-rpath@ entries, as such passing
   39 -- @-l@ and @-rpath@ to the linker will result in the unnecesasry libraries not
   40 -- being included in the load commands, however the @-rpath@ entries are all
   41 -- forced to be included.  This can lead to 100s of @-rpath@ entries being
   42 -- included when only a handful of libraries end up being truly linked.
   43 --
   44 -- Thus after building the library, we run a fixup phase where we inject the
   45 -- @-rpath@ for each found library (in the given library search paths) into the
   46 -- dynamic library through @-add_rpath@.
   47 --
   48 -- See Note [Dynamic linking on macOS]
   49 runInjectRPaths :: Logger -> DynFlags -> [FilePath] -> FilePath -> IO ()
   50 -- Make sure to honour -fno-use-rpaths if set on darwin as well see #20004
   51 runInjectRPaths _ dflags _ _ | not (gopt Opt_RPath dflags) = return ()
   52 runInjectRPaths logger dflags lib_paths dylib = do
   53   info <- lines <$> askOtool logger dflags Nothing [Option "-L", Option dylib]
   54   -- filter the output for only the libraries. And then drop the @rpath prefix.
   55   let libs = fmap (drop 7) $ filter (isPrefixOf "@rpath") $ fmap (head.words) $ info
   56   -- find any pre-existing LC_PATH items
   57   info <- lines <$> askOtool logger dflags Nothing [Option "-l", Option dylib]
   58   let paths = mapMaybe get_rpath info
   59       lib_paths' = [ p | p <- lib_paths, not (p `elem` paths) ]
   60   -- only find those rpaths, that aren't already in the library.
   61   rpaths <- nub . sort . join <$> forM libs (\f -> filterM (\l -> doesFileExist (l </> f)) lib_paths')
   62   -- inject the rpaths
   63   case rpaths of
   64     [] -> return ()
   65     _  -> runInstallNameTool logger dflags $ map Option $ "-add_rpath":(intersperse "-add_rpath" rpaths) ++ [dylib]
   66 
   67 get_rpath :: String -> Maybe FilePath
   68 get_rpath l = case readP_to_S rpath_parser l of
   69                 [(rpath, "")] -> Just rpath
   70                 _ -> Nothing
   71 
   72 
   73 rpath_parser :: ReadP FilePath
   74 rpath_parser = do
   75   skipSpaces
   76   void $ string "path"
   77   void $ many1 (satisfy isSpace)
   78   rpath <- many get
   79   void $ many1 (satisfy isSpace)
   80   void $ string "(offset "
   81   void $ munch1 isDigit
   82   void $ Parser.char ')'
   83   skipSpaces
   84   return rpath
   85 
   86 
   87 getUnitFrameworkOpts :: UnitEnv -> [UnitId] -> IO [String]
   88 getUnitFrameworkOpts unit_env dep_packages
   89   | platformUsesFrameworks (ue_platform unit_env) = do
   90         ps <- mayThrowUnitErr (preloadUnitsInfo' unit_env dep_packages)
   91         let pkg_framework_path_opts = map ("-F" ++) (collectFrameworksDirs ps)
   92             pkg_framework_opts      = concat [ ["-framework", fw]
   93                                              | fw <- collectFrameworks ps
   94                                              ]
   95         return (pkg_framework_path_opts ++ pkg_framework_opts)
   96 
   97   | otherwise = return []
   98 
   99 getFrameworkOpts :: DynFlags -> Platform -> [String]
  100 getFrameworkOpts dflags platform
  101   | platformUsesFrameworks platform = framework_path_opts ++ framework_opts
  102   | otherwise = []
  103   where
  104     framework_paths     = frameworkPaths dflags
  105     framework_path_opts = map ("-F" ++) framework_paths
  106 
  107     frameworks     = cmdlineFrameworks dflags
  108     -- reverse because they're added in reverse order from the cmd line:
  109     framework_opts = concat [ ["-framework", fw]
  110                             | fw <- reverse frameworks ]
  111 
  112 
  113 {-
  114 Note [macOS Big Sur dynamic libraries]
  115 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  116 
  117 macOS Big Sur makes the following change to how frameworks are shipped
  118 with the OS:
  119 
  120 > New in macOS Big Sur 11 beta, the system ships with a built-in
  121 > dynamic linker cache of all system-provided libraries.  As part of
  122 > this change, copies of dynamic libraries are no longer present on
  123 > the filesystem.  Code that attempts to check for dynamic library
  124 > presence by looking for a file at a path or enumerating a directory
  125 > will fail.  Instead, check for library presence by attempting to
  126 > dlopen() the path, which will correctly check for the library in the
  127 > cache. (62986286)
  128 
  129 (https://developer.apple.com/documentation/macos-release-notes/macos-big-sur-11-beta-release-notes/)
  130 
  131 Therefore, the previous method of checking whether a library exists
  132 before attempting to load it makes GHC.Linker.MacOS.loadFramework
  133 fail to find frameworks installed at /System/Library/Frameworks.
  134 Instead, any attempt to load a framework at runtime, such as by
  135 passing -framework OpenGL to runghc or running code loading such a
  136 framework with GHCi, fails with a 'not found' message.
  137 
  138 GHC.Linker.MacOS.loadFramework now opportunistically loads the
  139 framework libraries without checking for their existence first,
  140 failing only if all attempts to load a given framework from any of the
  141 various possible locations fail.  See also #18446, which this change
  142 addresses.
  143 -}
  144 
  145 -- Darwin / MacOS X only: load a framework
  146 -- a framework is a dynamic library packaged inside a directory of the same
  147 -- name. They are searched for in different paths than normal libraries.
  148 loadFramework :: Interp -> [FilePath] -> FilePath -> IO (Maybe String)
  149 loadFramework interp extraPaths rootname
  150    = do { either_dir <- tryIO getHomeDirectory
  151         ; let homeFrameworkPath = case either_dir of
  152                                   Left _ -> []
  153                                   Right dir -> [dir </> "Library/Frameworks"]
  154               ps = extraPaths ++ homeFrameworkPath ++ defaultFrameworkPaths
  155         ; errs <- findLoadDLL ps []
  156         ; return $ fmap (intercalate ", ") errs
  157         }
  158    where
  159      fwk_file = rootname <.> "framework" </> rootname
  160 
  161      -- sorry for the hardcoded paths, I hope they won't change anytime soon:
  162      defaultFrameworkPaths = ["/Library/Frameworks", "/System/Library/Frameworks"]
  163 
  164      -- Try to call loadDLL for each candidate path.
  165      --
  166      -- See Note [macOS Big Sur dynamic libraries]
  167      findLoadDLL [] errs =
  168        -- Tried all our known library paths, but dlopen()
  169        -- has no built-in paths for frameworks: give up
  170        return $ Just errs
  171      findLoadDLL (p:ps) errs =
  172        do { dll <- loadDLL interp (p </> fwk_file)
  173           ; case dll of
  174               Nothing  -> return Nothing
  175               Just err -> findLoadDLL ps ((p ++ ": " ++ err):errs)
  176           }