keel-dyn (empty) → 0.1.0.0
raw patch · 9 files changed
+729/−0 lines, 9 filesdep +basedep +directorydep +filepath
Dependencies added: base, directory, filepath, keel-dyn, unix
Files
- CHANGELOG.md +5/−0
- LICENSE +21/−0
- README.md +32/−0
- keel-dyn.cabal +60/−0
- src-posix/Keel/Dyn/Platform.hs +96/−0
- src-windows/Keel/Dyn/Platform.hs +171/−0
- src/Keel/Dyn.hs +86/−0
- src/Keel/Dyn/Locate.hs +142/−0
- test/Main.hs +116/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for keel-dyn++## 0.1.0.0 -- 2026-08-18++* First release.
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2026 Zhe Zhang++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,32 @@+# keel-dyn++Load native shared libraries at run time, cross-platform:+`LoadLibraryExW`/`GetProcAddress` on Windows, `dlopen`/`dlsym` elsewhere.++This package is the keystone of the [keel](https://github.com/skymanbp/keel)+project: every native capability (OpenBLAS, ONNX Runtime, ...) is resolved+at run time through it, so no keel package carries a build-time C+dependency and `cabal install` can never fail on a missing native library.++```haskell+import Keel.Dyn++main :: IO ()+main = do+ r <- withLibrary "libcrypto.so.3" $ \lib -> do+ Right fp <- resolveSym lib "OpenSSL_version_num"+ callVersionNum fp -- your own "dynamic" wrapper for the C signature+ print r+```++`Keel.Dyn.Locate` adds the keel search policy on top: an env-var+override, the per-user keel data directory, then the system search+path. On Windows the loader never consults the current directory+(DLL-planting hazard); `PATH` is walked explicitly instead.++Failure is data, not an exception: loading and symbol resolution return+`Either DynError`.++Part of the keel workspace — see the+[project repository](https://github.com/skymanbp/keel) for the other+packages (keel-abi, keel-linalg, keel-onnx, and the keel umbrella).
+ keel-dyn.cabal view
@@ -0,0 +1,60 @@+cabal-version: 3.0+name: keel-dyn+version: 0.1.0.0+synopsis: Load native shared libraries at run time, cross-platform+description:+ Cross-platform runtime loading and symbol resolution for native shared+ libraries: LoadLibraryExW/GetProcAddress on Windows,+ dlopen/dlsym elsewhere.+ .+ This package is the keystone of the keel project: every native+ capability (OpenBLAS, ONNX Runtime, ...) is resolved at run time+ through it, so no keel package ever carries a build-time C dependency+ and @cabal install@ can never fail on a missing native library.+license: MIT+license-file: LICENSE+author: Zhe Zhang+maintainer: Zhe Zhang+category: System, Foreign+build-type: Simple+homepage: https://github.com/skymanbp/keel+bug-reports: https://github.com/skymanbp/keel/issues+extra-doc-files:+ CHANGELOG.md+ README.md+tested-with: GHC ==9.10.3 || ==9.12.4 || ==9.14.1++source-repository head+ type: git+ location: https://github.com/skymanbp/keel++common warnings+ ghc-options: -Wall+ default-language: GHC2021++library+ import: warnings+ exposed-modules:+ Keel.Dyn+ Keel.Dyn.Locate+ other-modules: Keel.Dyn.Platform+ hs-source-dirs: src+ build-depends:+ base >=4.20 && <4.23,+ directory >=1.3 && <1.4,+ filepath >=1.4 && <1.6+ if os(windows)+ hs-source-dirs: src-windows+ else+ hs-source-dirs: src-posix+ build-depends: unix >=2.8 && <2.9++test-suite keel-dyn-test+ import: warnings+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: test+ build-depends:+ base,+ filepath,+ keel-dyn
+ src-posix/Keel/Dyn/Platform.hs view
@@ -0,0 +1,96 @@+-- | POSIX implementation over @dlopen@\/@dlsym@\/@dlclose@ (via the unix+-- package). Search paths follow the platform loader: rpath,+-- @LD_LIBRARY_PATH@ \/ @DYLD_LIBRARY_PATH@, then system defaults.+module Keel.Dyn.Platform+ ( Library+ , libraryPath+ , DynError (..)+ , loadLibrary+ , loadLibraryGlobal+ , closeLibrary+ , withLibrary+ , resolveSym+ , resolveOptional+ , addSearchDir+ ) where++import Control.Exception (Exception, IOException, finally, mask, try)+import Control.Monad (void)+import Foreign.Ptr (FunPtr, castFunPtr)+import qualified System.Posix.DynamicLinker as DL++-- | A loaded shared library. Constructor deliberately not exported.+data Library = Library+ { libDL :: !DL.DL+ , libraryPath :: !FilePath+ -- ^ The path\/name the library was requested as.+ }++-- | Failure modes of loading and symbol resolution.+data DynError+ = LibraryNotFound FilePath String+ -- ^ Library could not be loaded; the 'String' carries OS detail.+ | SymbolNotFound FilePath String+ -- ^ The named symbol is absent from the named library.+ deriving (Eq, Show)++instance Exception DynError++-- | Load a shared library by bare name or path. Search order is documented+-- in "Keel.Dyn". Symbols stay private to the handle (@RTLD_LOCAL@).+loadLibrary :: FilePath -> IO (Either DynError Library)+loadLibrary = loadWith [DL.RTLD_NOW, DL.RTLD_LOCAL]++-- | Like 'loadLibrary' but with @RTLD_GLOBAL@: the library's symbols+-- become visible to everything loaded afterwards. Needed when later+-- loads expect this library's symbols to already be in the process —+-- the canonical case is @libpython@, whose extension modules+-- deliberately leave Python's symbols undefined (manylinux policy).+loadLibraryGlobal :: FilePath -> IO (Either DynError Library)+loadLibraryGlobal = loadWith [DL.RTLD_NOW, DL.RTLD_GLOBAL]++loadWith :: [DL.RTLDFlags] -> FilePath -> IO (Either DynError Library)+loadWith flags path = do+ r <- try (DL.dlopen path flags)+ pure $ case r of+ Left (e :: IOException) -> Left (LibraryNotFound path (show e))+ Right dl -> Right (Library dl path)++-- | Release the OS handle, best-effort: a failed @dlclose@ is ignored —+-- matching the Windows side, there is no recovery, and 'withLibrary'+-- must not let a cleanup failure replace the action's own exception.+-- 'FunPtr's resolved from this 'Library' must not be called afterwards.+closeLibrary :: Library -> IO ()+closeLibrary lib = void (try @IOException (DL.dlclose (libDL lib)))++-- | 'loadLibrary' \/ 'closeLibrary' bracket, async-exception-safe: the+-- window between a successful load and the cleanup registration is+-- masked, so a timeout cannot leak the handle.+withLibrary :: FilePath -> (Library -> IO a) -> IO (Either DynError a)+withLibrary path act = mask $ \restore -> do+ r <- loadLibrary path+ case r of+ Left e -> pure (Left e)+ Right lib -> restore (Right <$> act lib) `finally` closeLibrary lib++-- | Resolve an exported symbol to a 'FunPtr', to be invoked through a+-- @foreign import ccall \"dynamic\"@ wrapper. The result type is the+-- caller's unchecked claim about the C signature.+resolveSym :: Library -> String -> IO (Either DynError (FunPtr a))+resolveSym lib name = do+ r <- try (DL.dlsym (libDL lib) name)+ pure $ case r of+ Left (e :: IOException) ->+ Left (SymbolNotFound (libraryPath lib) (name <> ": " <> show e))+ Right fp -> Right (castFunPtr fp)++-- | 'resolveSym' flattened to 'Maybe', for symbols whose absence is an+-- expected, degradable condition rather than an error.+resolveOptional :: Library -> String -> IO (Maybe (FunPtr a))+resolveOptional lib name = either (const Nothing) Just <$> resolveSym lib name++-- | POSIX loaders take their search path from the environment+-- (@LD_LIBRARY_PATH@\/rpath) before process start; there is no runtime+-- registration equivalent to Windows' AddDllDirectory. Documented no-op.+addSearchDir :: FilePath -> IO Bool+addSearchDir _ = pure False
+ src-windows/Keel/Dyn/Platform.hs view
@@ -0,0 +1,171 @@+-- | Windows implementation: LoadLibraryExW \/ GetProcAddress \/ FreeLibrary.+--+-- All imports come from kernel32, which GHC's mingw toolchain links by+-- default, so this module needs no headers, no import libraries and no+-- build-time configuration.+module Keel.Dyn.Platform+ ( Library+ , libraryPath+ , DynError (..)+ , loadLibrary+ , loadLibraryGlobal+ , closeLibrary+ , withLibrary+ , resolveSym+ , resolveOptional+ , addSearchDir+ ) where++import Control.Concurrent (rtsSupportsBoundThreads, runInBoundThread)+import Control.Exception (Exception, finally, mask)+import Control.Monad (void)+import Data.Bits ((.|.))+import Data.Word (Word32)+import Foreign.C.String (CString, CWString, withCString, withCWString)+import Foreign.C.Types (CInt (..))+import Foreign.Ptr (FunPtr, Ptr, castFunPtr, nullFunPtr, nullPtr)+import System.Environment (lookupEnv)+import System.FilePath (isAbsolute, splitSearchPath, (</>))++type HMODULE = Ptr ()++-- | A loaded shared library. Constructor deliberately not exported.+data Library = Library+ { libHandle :: !HMODULE+ , libraryPath :: !FilePath+ -- ^ The path\/name the library was requested as.+ }++-- | Failure modes of loading and symbol resolution.+data DynError+ = LibraryNotFound FilePath String+ -- ^ Library could not be loaded; the 'String' carries OS detail.+ | SymbolNotFound FilePath String+ -- ^ The named symbol is absent from the named library.+ deriving (Eq, Show)++instance Exception DynError++-- LoadLibrary runs the target's DllMain and pages the image in from+-- disk, and FreeLibrary runs DllMain again — both can block for a long+-- time, so they are imported safe: a slow load stalls only its own+-- thread, not every Haskell thread on the capability (the unix package+-- marks dlopen/dlclose safe for the same reason). GetProcAddress,+-- GetLastError and AddDllDirectory are cheap lookups and stay unsafe.+foreign import ccall safe "LoadLibraryExW"+ c_LoadLibraryExW :: CWString -> Ptr () -> Word32 -> IO HMODULE++foreign import ccall unsafe "GetProcAddress"+ c_GetProcAddress :: HMODULE -> CString -> IO (FunPtr ())++foreign import ccall safe "FreeLibrary"+ c_FreeLibrary :: HMODULE -> IO CInt++foreign import ccall unsafe "GetLastError"+ c_GetLastError :: IO Word32++foreign import ccall unsafe "AddDllDirectory"+ c_AddDllDirectory :: CWString -> IO (Ptr ())++-- LOAD_LIBRARY_SEARCH_DEFAULT_DIRS: application dir + System32 + directories+-- registered through AddDllDirectory. Deliberately excludes CWD (a classic+-- DLL-planting hazard); PATH is only reached via the explicit walk below,+-- which never consults CWD either.+searchDefaultDirs :: Word32+searchDefaultDirs = 0x00001000++-- LOAD_LIBRARY_SEARCH_DLL_LOAD_DIR: also resolve the loaded DLL's own+-- dependencies from the directory the DLL itself lives in. Only legal when+-- the requested path is fully qualified; essential for multi-DLL packages+-- (onnxruntime.dll finds its provider DLLs next to itself).+searchDllLoadDir :: Word32+searchDllLoadDir = 0x00000100++-- | Load a shared library by bare name or path. Search order is documented+-- in "Keel.Dyn". The current directory is never searched: the primary+-- lookup uses the safe default-directories set, and the @PATH@ fallback+-- for bare names walks the @PATH@ entries explicitly instead of handing+-- the name to the legacy loader search (whose order includes CWD).+loadLibrary :: FilePath -> IO (Either DynError Library)+loadLibrary path = inBound $ withCWString path $ \wpath -> do+ let flags+ | isAbsolute path = searchDllLoadDir .|. searchDefaultDirs+ | otherwise = searchDefaultDirs+ hEx <- c_LoadLibraryExW wpath nullPtr flags+ if hEx /= nullPtr+ then pure (Right (Library hEx path))+ else do+ -- read the primary attempt's error before any further calls+ code <- c_GetLastError+ h <- if isAbsolute path then pure nullPtr else tryPath path+ pure $+ if h == nullPtr+ then Left (LibraryNotFound path ("Win32 error " <> show code))+ else Right (Library h path)++-- Walk PATH ourselves: each candidate is loaded by absolute path (with+-- own-directory dependency resolution), relative PATH entries are+-- skipped, and CWD is never consulted.+tryPath :: FilePath -> IO HMODULE+tryPath name = do+ dirs <- maybe [] splitSearchPath <$> lookupEnv "PATH"+ go (filter isAbsolute dirs)+ where+ go [] = pure nullPtr+ go (d : ds) = do+ h <- withCWString (d </> name) $ \w ->+ c_LoadLibraryExW w nullPtr (searchDllLoadDir .|. searchDefaultDirs)+ if h /= nullPtr then pure h else go ds++-- GetLastError is only meaningful on the OS thread that made the failing+-- call, and an unbound Haskell thread may migrate between two foreign+-- calls; a bound thread pins the whole load-and-diagnose sequence to one+-- OS thread. A non-threaded RTS has a single OS thread already.+inBound :: IO a -> IO a+inBound = if rtsSupportsBoundThreads then runInBoundThread else id++-- | On Windows this is identical to 'loadLibrary': PE imports are+-- resolved per-module from the DLL's import table, so there is no+-- POSIX-style global symbol namespace to opt into.+loadLibraryGlobal :: FilePath -> IO (Either DynError Library)+loadLibraryGlobal = loadLibrary++-- | Release the OS handle, best-effort: a failed FreeLibrary is ignored —+-- there is no recovery, and 'withLibrary' must not let a cleanup failure+-- replace the action's own exception. 'FunPtr's resolved from this+-- 'Library' must not be called afterwards.+closeLibrary :: Library -> IO ()+closeLibrary = void . c_FreeLibrary . libHandle++-- | 'loadLibrary' \/ 'closeLibrary' bracket, async-exception-safe: the+-- window between a successful load and the cleanup registration is+-- masked, so a timeout cannot leak the handle.+withLibrary :: FilePath -> (Library -> IO a) -> IO (Either DynError a)+withLibrary path act = mask $ \restore -> do+ r <- loadLibrary path+ case r of+ Left e -> pure (Left e)+ Right lib -> restore (Right <$> act lib) `finally` closeLibrary lib++-- | Resolve an exported symbol to a 'FunPtr', to be invoked through a+-- @foreign import ccall \"dynamic\"@ wrapper. The result type is the+-- caller's unchecked claim about the C signature.+resolveSym :: Library -> String -> IO (Either DynError (FunPtr a))+resolveSym lib name = withCString name $ \cname -> do+ fp <- c_GetProcAddress (libHandle lib) cname+ if fp == nullFunPtr+ then pure (Left (SymbolNotFound (libraryPath lib) name))+ else pure (Right (castFunPtr fp))++-- | 'resolveSym' flattened to 'Maybe', for symbols whose absence is an+-- expected, degradable condition rather than an error.+resolveOptional :: Library -> String -> IO (Maybe (FunPtr a))+resolveOptional lib name = either (const Nothing) Just <$> resolveSym lib name++-- | Register an extra DLL search directory for subsequent 'loadLibrary'+-- calls. The directory must be an absolute path (AddDllDirectory refuses+-- relative ones). Returns 'False' if the OS refused it.+addSearchDir :: FilePath -> IO Bool+addSearchDir dir = withCWString dir $ \wdir -> do+ cookie <- c_AddDllDirectory wdir+ pure (cookie /= nullPtr)
+ src/Keel/Dyn.hs view
@@ -0,0 +1,86 @@+-- | Cross-platform runtime loading of native shared libraries.+--+-- This module is the keystone of keel: every native capability (OpenBLAS,+-- ONNX Runtime, ...) is resolved at run time through it, so no keel package+-- carries a build-time C dependency and @cabal install@ can never fail on a+-- missing native library.+--+-- Search-path behaviour:+--+-- * Windows: 'loadLibrary' first tries @LoadLibraryExW@ with+-- @LOAD_LIBRARY_SEARCH_DEFAULT_DIRS@ (application dir, System32, and any+-- directory registered via 'addSearchDir'; for absolute paths also the+-- library's own directory, so multi-DLL packages find their siblings),+-- then falls back to the legacy @LoadLibraryW@ search (PATH, CWD) so+-- bare names on PATH keep working.+-- * POSIX: @dlopen@ semantics (rpath, @LD_LIBRARY_PATH@\/@DYLD_*@, system+-- default dirs). 'addSearchDir' is a documented no-op returning 'False' —+-- POSIX search paths must be set before process start.+--+-- For the full env-var → data-dir → system policy that capability packages+-- use, see "Keel.Dyn.Locate".+--+-- == Building a capability record+--+-- Resolve each function once at load time into a record of 'FunPtr's,+-- invoked through @foreign import ccall \"dynamic\"@ wrappers. Required+-- symbols use 'requireSym' (throws 'DynError'); symbols that may be absent+-- in older library builds use 'resolveOptional', so a missing symbol+-- degrades that one operation instead of failing the whole library:+--+-- > data BlasOps = BlasOps+-- > { ddot :: FunPtr CblasDdotT -- required+-- > , dgemm :: FunPtr CblasDgemmT -- required+-- > , sbgemm :: Maybe (FunPtr CblasSbgemmT) -- bfloat16: newer builds only+-- > }+-- >+-- > openBlas :: Library -> IO (Capability BlasOps)+-- > openBlas lib = do+-- > ops <- BlasOps+-- > <$> requireSym lib "cblas_ddot"+-- > <*> requireSym lib "cblas_dgemm"+-- > <*> resolveOptional lib "cblas_sbgemm"+-- > version <- queryVersion lib -- e.g. via openblas_get_config+-- > pure (Capability lib version ops)+module Keel.Dyn+ ( -- * Libraries+ Library+ , libraryPath+ , loadLibrary+ , loadLibraryGlobal+ , closeLibrary+ , withLibrary++ -- * Symbols+ , resolveSym+ , resolveOptional+ , requireSym++ -- * Capability records+ , Capability (..)++ -- * Search path+ , addSearchDir++ -- * Errors+ , DynError (..)+ ) where++import Control.Exception (throwIO)+import Foreign.Ptr (FunPtr)++import Keel.Dyn.Platform++-- | Like 'resolveSym' but throws the 'DynError' as an exception. Intended+-- for assembling capability records applicatively (see the module header).+requireSym :: Library -> String -> IO (FunPtr a)+requireSym lib name = resolveSym lib name >>= either throwIO pure++-- | A loaded native capability: the library it came from, a version tag+-- queried from the library itself (shown by @keel doctor@), and a+-- caller-defined record of resolved 'FunPtr's.+data Capability ops = Capability+ { capLibrary :: Library+ , capVersion :: String+ , capOps :: ops+ }
+ src/Keel/Dyn/Locate.hs view
@@ -0,0 +1,142 @@+-- | Locate-and-load policy for native capabilities.+--+-- 'locateLibrary' documents and implements keel's search order:+--+-- 1. __Environment override__ ('specEnvVar'). If the variable is set and+-- non-empty it is authoritative: a file path is loaded exactly as+-- given, a directory is searched for 'specCandidates'. Failure of an+-- explicit override is an error — it deliberately does /not/ fall+-- through to the later stages, because silent fallback past a value+-- the user set by hand is undiagnosable.+-- 2. __Per-user data directory__ ('keelNativeDir'):+-- @~\/.local\/share\/keel\/native\/\<name\>@ per the XDG spec, or+-- @%APPDATA%\\keel\\native\\\<name\>@ on Windows. This is where+-- @keel setup@ installs checksum-pinned libraries. On Windows the+-- directory is also registered via 'addSearchDir' before loading, so+-- the library's transitive DLL dependencies resolve from it. A+-- candidate that exists here but fails to load is an error, not a+-- fallthrough, for the same reason as above.+-- 3. __System search__: each candidate is tried as a bare name through+-- the operating system's default lookup (PATH \/ @ld.so@ cache \/+-- @DYLD_*@ \/ System32).+module Keel.Dyn.Locate+ ( LibrarySpec (..)+ , Located (..)+ , Origin (..)+ , locateLibrary+ , keelNativeDir+ ) where++import Control.Monad (filterM)+import System.Directory+ ( XdgDirectory (XdgData)+ , doesDirectoryExist+ , doesFileExist+ , getXdgDirectory+ )+import System.Environment (lookupEnv)+import System.FilePath ((</>))++import Keel.Dyn.Platform++-- | What to look for and where the user may override it.+data LibrarySpec = LibrarySpec+ { specName :: String+ -- ^ Capability name, e.g. @\"openblas\"@. Names the subdirectory of+ -- the keel data dir and appears in error messages.+ , specEnvVar :: String+ -- ^ Override variable, e.g. @\"KEEL_OPENBLAS\"@. May point at a+ -- library file or at a directory containing one of the candidates.+ , specCandidates :: [FilePath]+ -- ^ Platform-appropriate file names tried in order, e.g.+ -- @[\"libopenblas.dll\"]@ \/ @[\"libopenblas.so.0\", \"libopenblas.so\"]@.+ -- The caller chooses per platform ('System.Info.os').+ }+ deriving (Eq, Show)++-- | Where a successfully located library came from — 'Keel.Doctor' level+-- diagnostics report this verbatim.+data Origin+ = FromEnvFile FilePath+ -- ^ The override variable pointed directly at this file.+ | FromEnvDir FilePath+ -- ^ Loaded from the directory the override variable pointed at.+ | FromDataDir FilePath+ -- ^ Loaded from the per-user keel data directory.+ | FromSystem FilePath+ -- ^ Resolved by the OS default search under this bare name.+ deriving (Eq, Show)++-- | A successfully located and loaded library, tagged with where the+-- search found it.+data Located = Located+ { locLibrary :: Library+ , locOrigin :: Origin+ }++-- | The per-user directory for one capability's native libraries:+-- XDG data dir (Windows: @%APPDATA%@) @\/keel\/native\/\<name\>@.+-- Derived at run time; never assumed to exist.+keelNativeDir :: String -> IO FilePath+keelNativeDir name = getXdgDirectory XdgData ("keel" </> "native" </> name)++-- | Locate and load a native library following the search order in the+-- module header. On success the 'Origin' says which stage matched.+locateLibrary :: LibrarySpec -> IO (Either DynError Located)+locateLibrary spec = do+ mOverride <- lookupEnv (specEnvVar spec)+ case mOverride of+ Just v | not (null v) -> fromEnv spec v+ _ -> do+ dir <- keelNativeDir (specName spec)+ fromDataDir spec dir++-- The override is authoritative: no fallthrough on failure.+fromEnv :: LibrarySpec -> FilePath -> IO (Either DynError Located)+fromEnv spec v = do+ isDir <- doesDirectoryExist v+ if isDir+ then do+ found <- firstExistingIn v (specCandidates spec)+ case found of+ Nothing ->+ pure . Left . LibraryNotFound v $+ specEnvVar spec+ <> " is a directory containing none of "+ <> show (specCandidates spec)+ Just path -> do+ _ <- addSearchDir v+ fmap (\lib -> Located lib (FromEnvDir path)) <$> loadLibrary path+ else fmap (\lib -> Located lib (FromEnvFile v)) <$> loadLibrary v++-- A candidate present in the data dir must load; only absence falls+-- through to the system search.+fromDataDir :: LibrarySpec -> FilePath -> IO (Either DynError Located)+fromDataDir spec dir = do+ found <- firstExistingIn dir (specCandidates spec)+ case found of+ Just path -> do+ _ <- addSearchDir dir+ fmap (\lib -> Located lib (FromDataDir path)) <$> loadLibrary path+ Nothing -> fromSystem spec (specCandidates spec)++fromSystem :: LibrarySpec -> [FilePath] -> IO (Either DynError Located)+fromSystem spec [] =+ pure . Left . LibraryNotFound (specName spec) $+ "none of "+ <> show (specCandidates spec)+ <> " found via "+ <> specEnvVar spec+ <> ", the keel data dir, or the system search path"+fromSystem spec (c : cs) = do+ r <- loadLibrary c+ case r of+ Right lib -> pure (Right (Located lib (FromSystem c)))+ Left _ -> fromSystem spec cs++firstExistingIn :: FilePath -> [FilePath] -> IO (Maybe FilePath)+firstExistingIn dir names = do+ hits <- filterM doesFileExist (map (dir </>) names)+ pure $ case hits of+ (h : _) -> Just h+ [] -> Nothing
+ test/Main.hs view
@@ -0,0 +1,116 @@+-- | Smoke tests: real dlopen/resolve/call round-trip on each OS, the+-- negative paths (missing library, missing symbol), and the+-- "Keel.Dyn.Locate" search-order contract.+module Main (main) where++import Control.Exception (try)+import Control.Monad (unless)+import Data.Word (Word64)+import Foreign.Ptr (FunPtr)+import System.Environment (lookupEnv, setEnv, unsetEnv)+import System.FilePath ((</>))+import System.Info (os)++import Keel.Dyn+import Keel.Dyn.Locate++foreign import ccall "dynamic" mkTick :: FunPtr (IO Word64) -> IO Word64+foreign import ccall "dynamic" mkCos :: FunPtr (Double -> Double) -> Double -> Double++orDie :: Show e => String -> Either e a -> IO a+orDie ctx = either (\e -> fail (ctx <> ": " <> show e)) pure++expect :: Bool -> String -> IO ()+expect ok msg = unless ok (fail msg)++testEnvVar :: String+testEnvVar = "KEEL_DYN_TEST_LIB"++-- The spec name is chosen so its per-user data dir cannot exist, keeping+-- the data-dir stage of locateLibrary an empty pass-through in this test.+mkSpec :: [FilePath] -> LibrarySpec+mkSpec cands = LibrarySpec+ { specName = "keel-dyn-smoke-zzz"+ , specEnvVar = testEnvVar+ , specCandidates = cands+ }++main :: IO ()+main = do+ let (libName, symName) = case os of+ "mingw32" -> ("kernel32.dll", "GetTickCount64")+ "darwin" -> ("/usr/lib/libSystem.B.dylib", "cos")+ _ -> ("libm.so.6", "cos")++ -- 1. positive path: load, resolve (via requireSym), call through the+ -- FunPtr. The resolve happens inside each branch because the FunPtr+ -- type differs per OS.+ lib <- orDie ("load " <> libName) =<< loadLibrary libName+ case os of+ "mingw32" -> do+ fp <- requireSym lib symName+ t <- mkTick fp+ expect (t > 0) "GetTickCount64 returned 0"+ _ -> do+ fp <- requireSym lib symName+ expect (abs (mkCos fp 0 - 1) < 1e-12) "cos 0 /= 1"++ -- 2. negative path: a library that cannot exist+ neg <- loadLibrary "keel-definitely-missing-library-zzz"+ expect (either (const True) (const False) neg) "bogus library loaded"++ -- 3. negative path: a symbol that cannot exist, through both interfaces+ msym <- resolveOptional lib "keel_definitely_missing_symbol_zzz"+ :: IO (Maybe (FunPtr ()))+ expect (maybe True (const False) msym) "bogus symbol resolved"+ thrown <- try (requireSym lib "keel_definitely_missing_symbol_zzz")+ :: IO (Either DynError (FunPtr ()))+ case thrown of+ Left (SymbolNotFound _ _) -> pure ()+ Left e -> fail ("requireSym threw the wrong error: " <> show e)+ Right _ -> fail "requireSym resolved a bogus symbol"++ -- 4. locate: with no override and no data dir, the system-search stage+ -- must find the library under its bare name (absolute on darwin).+ unsetEnv testEnvVar+ l1 <- orDie "locate via system search" =<< locateLibrary (mkSpec [libName])+ expect (locOrigin l1 == FromSystem libName)+ ("wrong origin: " <> show (locOrigin l1))+ closeLibrary (locLibrary l1)++ -- 5. locate: a broken explicit override must FAIL, never fall through+ -- to the system search (where the candidate would have resolved).+ setEnv testEnvVar ("keel-no-such-dir-zzz" </> "keel-no-such-lib-zzz")+ l2 <- locateLibrary (mkSpec [libName])+ expect (either (const True) (const False) l2)+ "broken override fell through to system search"+ unsetEnv testEnvVar++ -- 6. locate: env-file and env-dir overrides. Windows-only because only+ -- there is the system library's absolute location derivable portably+ -- (%SystemRoot%\System32); POSIX paths vary per distro and are covered+ -- by the publish-stage CI matrix instead.+ case os of+ "mingw32" -> do+ mroot <- lookupEnv "SystemRoot"+ case mroot of+ Nothing -> fail "SystemRoot unset; cannot exercise env override"+ Just root -> do+ let sys32 = root </> "System32"+ k32 = sys32 </> "kernel32.dll"+ setEnv testEnvVar k32+ l3 <- orDie "locate via env file" =<< locateLibrary (mkSpec ["kernel32.dll"])+ expect (locOrigin l3 == FromEnvFile k32)+ ("wrong origin: " <> show (locOrigin l3))+ closeLibrary (locLibrary l3)++ setEnv testEnvVar sys32+ l4 <- orDie "locate via env dir" =<< locateLibrary (mkSpec ["kernel32.dll"])+ expect (locOrigin l4 == FromEnvDir k32)+ ("wrong origin: " <> show (locOrigin l4))+ closeLibrary (locLibrary l4)+ unsetEnv testEnvVar+ _ -> pure ()++ closeLibrary lib+ putStrLn "keel-dyn: all smoke tests passed"