Commit 8744e30b authored by tulcod's avatar tulcod Committed by GitHub
Browse files

Implement foreign library versioning

This adds support for building foreign libraries with a given ABI version on Linux. This is enables foreign libraries to specify ABI compatibility information. This is important since ABI compatibility differs from package release versions.

Two new fields are added: lib-version-info and lib-version-linux. The former accept versions Libtool-style, the latter sets SONAME versions directly. In both cases, appropriate symlinks are installed.

Libtool accepts ABI version data via the -version-info flag, which takes current[:revision[:age]] data. This is then parsed into a major.minor.build version number. We copy this approach so that library versioning may be generalised to other operating systems than Linux.
parent 3033776a
......@@ -207,6 +207,12 @@ foreignLibFieldDescrs =
, listField "options"
disp parse
foreignLibOptions (\x flib -> flib { foreignLibOptions = x })
, simpleField "lib-version-info"
(maybe mempty disp) (fmap Just parse)
foreignLibVersionInfo (\x flib -> flib { foreignLibVersionInfo = x })
, simpleField "lib-version-linux"
(maybe mempty disp) (fmap Just parse)
foreignLibVersionLinux (\x flib -> flib { foreignLibVersionLinux = x })
, listField "mod-def-file"
showFilePath parseFilePathQ
foreignLibModDefFile (\x flib -> flib { foreignLibModDefFile = x })
......
......@@ -209,6 +209,12 @@ foreignLibFieldDescrs =
, listField "options"
disp parsec
foreignLibOptions (\x flib -> flib { foreignLibOptions = x })
, simpleField "lib-version-info"
(maybe mempty disp) (Just <$> parsec)
foreignLibVersionInfo (\x flib -> flib { foreignLibVersionInfo = x })
, simpleField "lib-version-linux"
(maybe mempty disp) (Just <$> parsec)
foreignLibVersionLinux (\x flib -> flib { foreignLibVersionLinux = x })
, listField "mod-def-file"
showFilePath parsecFilePath
foreignLibModDefFile (\x flib -> flib { foreignLibModDefFile = x })
......
......@@ -50,6 +50,7 @@ import Distribution.Types.ModuleReexport
import Distribution.Types.SourceRepo
(RepoKind, RepoType, classifyRepoKind, classifyRepoType)
import Distribution.Types.TestType (TestType (..))
import Distribution.Types.ForeignLib (LibVersionInfo, mkLibVersionInfo)
import Distribution.Types.ForeignLibType (ForeignLibType (..))
import Distribution.Types.ForeignLibOption (ForeignLibOption (..))
import Distribution.Types.ModuleRenaming
......@@ -220,6 +221,18 @@ instance Parsec VersionRange where
("^>=", majorBoundVersion),
("==", thisVersion) ]
instance Parsec LibVersionInfo where
parsec = do
c <- P.integral
(r, a) <- P.option (0,0) $ do
_ <- P.char ':'
r <- P.integral
a <- P.option 0 $ do
_ <- P.char ':'
P.integral
return (r,a)
return $ mkLibVersionInfo (c,r,a)
instance Parsec Language where
parsec = classifyLanguage <$> P.munch1 isAlphaNum
......
......@@ -1897,6 +1897,9 @@ checkForeignLibSupported comp platform flib = go (compilerFlavor comp)
| not (null (foreignLibModDefFile flib)) = unsupported [
"Module definition file not supported on OSX"
]
| not (null (foreignLibVersionInfo flib)) = unsupported [
"Foreign library versioning not currently supported on OSX"
]
| otherwise =
Nothing
goGhcOsx _ = unsupported [
......@@ -1911,6 +1914,10 @@ checkForeignLibSupported comp platform flib = go (compilerFlavor comp)
| not (null (foreignLibModDefFile flib)) = unsupported [
"Module definition file not supported on Linux"
]
| not (null (foreignLibVersionInfo flib))
&& not (null (foreignLibVersionLinux flib)) = unsupported [
"You must not specify both lib-version-info and lib-version-linux"
]
| otherwise =
Nothing
goGhcLinux _ = unsupported [
......@@ -1925,6 +1932,10 @@ checkForeignLibSupported comp platform flib = go (compilerFlavor comp)
, " options: standalone\n"
, "in your foreign-library stanza."
]
| not (null (foreignLibVersionInfo flib)) = unsupported [
"Foreign library versioning not currently supported on Windows.\n"
, "You can specify module definition files in the mod-def-file field."
]
| otherwise =
Nothing
goGhcWindows _ = unsupported [
......
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
......@@ -105,11 +106,14 @@ import Language.Haskell.Extension
import qualified Data.Map as Map
import System.Directory
( doesFileExist, getAppUserDataDirectory, createDirectoryIfMissing
, canonicalizePath, removeFile )
, canonicalizePath, removeFile, renameFile )
import System.FilePath ( (</>), (<.>), takeExtension
, takeDirectory, replaceExtension
,isRelative )
import qualified System.Info
#ifndef mingw32_HOST_OS
import System.Posix (createSymbolicLink)
#endif /* mingw32_HOST_OS */
-- -----------------------------------------------------------------------------
-- Configuring
......@@ -871,9 +875,10 @@ exeTargetName exe = unUnqualComponentName (exeName exe) `withExt` exeExtension
-- than the target OS (but this is wrong elsewhere in Cabal as well).
flibTargetName :: LocalBuildInfo -> ForeignLib -> String
flibTargetName lbi flib =
case (platformOS (hostPlatform lbi), foreignLibType flib) of
case (os, foreignLibType flib) of
(Windows, ForeignLibNativeShared) -> nm <.> "dll"
(Windows, ForeignLibNativeStatic) -> nm <.> "lib"
(Linux, ForeignLibNativeShared) -> "lib" ++ nm <.> versionedExt
(_other, ForeignLibNativeShared) -> "lib" ++ nm <.> dllExtension
(_other, ForeignLibNativeStatic) -> "lib" ++ nm <.> staticLibExtension
(_any, ForeignLibTypeUnknown) -> cabalBug "unknown foreign lib type"
......@@ -881,8 +886,51 @@ flibTargetName lbi flib =
nm :: String
nm = unUnqualComponentName $ foreignLibName flib
platformOS :: Platform -> OS
platformOS (Platform _arch os) = os
os :: OS
os = let (Platform _ os') = hostPlatform lbi
in os'
-- If a foreign lib foo has lib-version-info 5:1:2 or
-- lib-version-linux 3.2.1, it should be built as libfoo.so.3.2.1
-- Libtool's version-info data is translated into library versions in a
-- nontrivial way: so refer to libtool documentation.
versionedExt :: String
versionedExt =
let nums = foreignLibVersion flib os
in foldl (<.>) "so" (map show nums)
-- | Name for the library when building.
--
-- If the `lib-version-info` field or the `lib-version-linux` field of
-- a foreign library target is set, we need to incorporate that
-- version into the SONAME field.
--
-- If a foreign library foo has lib-version-info 5:1:2, it should be
-- built as libfoo.so.3.2.1. We want it to get soname libfoo.so.3.
-- However, GHC does not allow overriding soname by setting linker
-- options, as it sets a soname of its own (namely the output
-- filename), after the user-supplied linker options. Hence, we have
-- to compile the library with the soname as its filename. We rename
-- the compiled binary afterwards.
--
-- This method allows to adjust the name of the library at build time
-- such that the correct soname can be set.
flibBuildName :: LocalBuildInfo -> ForeignLib -> String
flibBuildName lbi flib
-- On linux, if a foreign-library has version data, the first digit is used
-- to produce the SONAME.
| (os, foreignLibType flib) ==
(Linux, ForeignLibNativeShared)
= let nums = foreignLibVersion flib os
in "lib" ++ nm <.> foldl (<.>) "so" (map show (take 1 nums))
| otherwise = flibTargetName lbi flib
where
os :: OS
os = let (Platform _ os') = hostPlatform lbi
in os'
nm :: String
nm = unUnqualComponentName $ foreignLibName flib
gbuildIsRepl :: GBuildMode -> Bool
gbuildIsRepl (GBuildExe _) = False
......@@ -1163,8 +1211,13 @@ gbuild verbosity numJobs _pkg_descr lbi bm clbi = do
cabalBug "static libraries not yet implemented"
ForeignLibTypeUnknown ->
cabalBug "unknown foreign lib type"
-- We build under a (potentially) different filename to set a
-- soname on supported platforms. See also the note for
-- @flibBuildName@.
info verbosity "Linking..."
runGhcProg linkOpts { ghcOptOutputFile = toFlag (targetDir </> targetName) }
let buildName = flibBuildName lbi flib
runGhcProg linkOpts { ghcOptOutputFile = toFlag (targetDir </> buildName) }
renameFile (targetDir </> buildName) (targetDir </> targetName)
{-
Note [RPATH]
......@@ -1457,8 +1510,26 @@ installFLib verbosity lbi targetDir builtDir _pkg flib =
createDirectoryIfMissingVerbose verbosity True targetDir
-- TODO: Should we strip? (stripLibs lbi)
if isShared
then do installExecutableFile verbosity src dst
else do installOrdinaryFile verbosity src dst
then installExecutableFile verbosity src dst
else installOrdinaryFile verbosity src dst
-- Now install appropriate symlinks if library is versioned
let (Platform _ os) = hostPlatform lbi
when (not (null (foreignLibVersion flib os))) $ do
when (os /= Linux) $ die
-- It should be impossible to get here.
"Can't install foreign-library symlink on non-Linux OS"
#ifndef mingw32_HOST_OS
-- createSymbolicLink file1 file2 creates a symbolic link
-- named file2 which points to the file file1.
-- Note that we do want a symlink to name rather than dst, because
-- the symlink will be relative to the directory it's created in.
createSymbolicLink name (dstDir </> flibBuildName lbi flib)
createSymbolicLink name (dstDir </> "lib" ++ nm <.> "so")
where
nm :: String
nm = unUnqualComponentName $ foreignLibName flib
#endif /* mingw32_HOST_OS */
-- |Install for ghc, .hi, .a and, if --with-ghci given, .o
installLib :: Verbosity
......
......@@ -6,18 +6,33 @@ module Distribution.Types.ForeignLib(
emptyForeignLib,
foreignLibModules,
foreignLibIsShared,
foreignLibVersion,
LibVersionInfo,
mkLibVersionInfo,
libVersionInfoCRA,
libVersionNumber,
libVersionNumberShow,
libVersionMajor
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.ModuleName
import Distribution.Version
import Distribution.System
import Distribution.Text
import qualified Distribution.Compat.ReadP as Parse
import Distribution.Types.BuildInfo
import Distribution.Types.ForeignLibType
import Distribution.Types.ForeignLibOption
import Distribution.Types.UnqualComponentName
import qualified Text.PrettyPrint as Disp
import qualified Text.Read as Read
-- | A foreign library stanza is like a library stanza, except that
-- the built code is intended for consumption by a non-Haskell client.
data ForeignLib = ForeignLib {
......@@ -30,6 +45,12 @@ data ForeignLib = ForeignLib {
, foreignLibOptions :: [ForeignLibOption]
-- | Build information for this foreign library.
, foreignLibBuildInfo :: BuildInfo
-- | Libtool-style version-info data to compute library version.
-- Refer to the libtool documentation on the
-- current:revision:age versioning scheme.
, foreignLibVersionInfo :: Maybe LibVersionInfo
-- | Linux library version
, foreignLibVersionLinux :: Maybe Version
-- | (Windows-specific) module definition files
--
......@@ -39,15 +60,82 @@ data ForeignLib = ForeignLib {
}
deriving (Generic, Show, Read, Eq, Typeable, Data)
data LibVersionInfo = LibVersionInfo Int Int Int deriving (Data, Eq, Generic, Typeable)
instance Ord LibVersionInfo where
LibVersionInfo c r _ `compare` LibVersionInfo c' r' _ =
case c `compare` c' of
EQ -> r `compare` r'
e -> e
instance Show LibVersionInfo where
showsPrec d (LibVersionInfo c r a) = showParen (d > 10)
$ showString "mkLibVersionInfo "
. showsPrec 11 (c,r,a)
instance Read LibVersionInfo where
readPrec = Read.parens $ do
Read.Ident "mkLibVersionInfo" <- Read.lexP
t <- Read.step Read.readPrec
return (mkLibVersionInfo t)
instance Binary LibVersionInfo
instance Text LibVersionInfo where
disp (LibVersionInfo c r a)
= Disp.hcat $ Disp.punctuate (Disp.char ':') $ map Disp.int [c,r,a]
parse = do
c <- parseNat
(r, a) <- Parse.option (0,0) $ do
_ <- Parse.char ':'
r <- parseNat
a <- Parse.option 0 (Parse.char ':' >> parseNat)
return (r, a)
return $ mkLibVersionInfo (c,r,a)
where
parseNat = read `fmap` Parse.munch1 isDigit
-- | Construct 'LibVersionInfo' from @(current, revision, age)@
-- numbers.
--
-- For instance, @mkLibVersionInfo (3,0,0)@ constructs a
-- 'LibVersionInfo' representing the version-info @3:0:0@.
--
-- All version components must be non-negative.
mkLibVersionInfo :: (Int, Int, Int) -> LibVersionInfo
mkLibVersionInfo (c,r,a) = LibVersionInfo c r a
-- | From a given 'LibVersionInfo', extract the @(current, revision,
-- age)@ numbers.
libVersionInfoCRA :: LibVersionInfo -> (Int, Int, Int)
libVersionInfoCRA (LibVersionInfo c r a) = (c,r,a)
-- | Given a version-info field, produce a @major.minor.build@ version
libVersionNumber :: LibVersionInfo -> (Int, Int, Int)
libVersionNumber (LibVersionInfo c r a) = (c-a , a , r)
-- | Given a version-info field, return @"major.minor.build"@ as a
-- 'String'
libVersionNumberShow :: LibVersionInfo -> String
libVersionNumberShow v =
let (major, minor, build) = libVersionNumber v
in show major ++ "." ++ show minor ++ "." ++ show build
-- | Return the @major@ version of a version-info field.
libVersionMajor :: LibVersionInfo -> Int
libVersionMajor (LibVersionInfo c _ a) = c-a
instance Binary ForeignLib
instance Semigroup ForeignLib where
a <> b = ForeignLib {
foreignLibName = combine' foreignLibName
, foreignLibType = combine foreignLibType
, foreignLibOptions = combine foreignLibOptions
, foreignLibBuildInfo = combine foreignLibBuildInfo
, foreignLibModDefFile = combine foreignLibModDefFile
foreignLibName = combine' foreignLibName
, foreignLibType = combine foreignLibType
, foreignLibOptions = combine foreignLibOptions
, foreignLibBuildInfo = combine foreignLibBuildInfo
, foreignLibVersionInfo = combine'' foreignLibVersionInfo
, foreignLibVersionLinux = combine'' foreignLibVersionLinux
, foreignLibModDefFile = combine foreignLibModDefFile
}
where combine field = field a `mappend` field b
combine' field = case ( unUnqualComponentName $ field a
......@@ -56,14 +144,17 @@ instance Semigroup ForeignLib where
(_, "") -> field a
(x, y) -> error $ "Ambiguous values for executable field: '"
++ x ++ "' and '" ++ y ++ "'"
combine'' field = field b
instance Monoid ForeignLib where
mempty = ForeignLib {
foreignLibName = mempty
, foreignLibType = ForeignLibTypeUnknown
, foreignLibOptions = []
, foreignLibBuildInfo = mempty
, foreignLibModDefFile = []
foreignLibName = mempty
, foreignLibType = ForeignLibTypeUnknown
, foreignLibOptions = []
, foreignLibBuildInfo = mempty
, foreignLibVersionInfo = Nothing
, foreignLibVersionLinux = Nothing
, foreignLibModDefFile = []
}
mappend = (<>)
......@@ -78,3 +169,20 @@ foreignLibModules = otherModules . foreignLibBuildInfo
-- | Is the foreign library shared?
foreignLibIsShared :: ForeignLib -> Bool
foreignLibIsShared = foreignLibTypeIsShared . foreignLibType
-- | Get a version number for a foreign library.
-- If we're on Linux, and a Linux version is specified, use that.
-- If we're on Linux, and libtool-style version-info is specified, translate
-- that field into appropriate version numbers.
-- Otherwise, this feature is unsupported so we don't return any version data.
foreignLibVersion :: ForeignLib -> OS -> [Int]
foreignLibVersion flib Linux =
case foreignLibVersionLinux flib of
Just v -> versionNumbers v
Nothing ->
case foreignLibVersionInfo flib of
Just v' ->
let (major, minor, build) = libVersionNumber v'
in [major, minor, build]
Nothing -> []
foreignLibVersion _ _ = []
......@@ -1451,6 +1451,7 @@ A typical stanza for a foreign library looks like
foreign-library myforeignlib
type: native-shared
lib-version-info: 6:3:2
if os(Windows)
options: standalone
......@@ -1488,6 +1489,48 @@ A typical stanza for a foreign library looks like
`GHC <https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/win32-dlls.html>`_
manual for some details and some further pointers.
.. pkg-field:: lib-version-info: current:revision:age
This field is currently only used on Linux.
This field specifies a Libtool-style version-info field that sets
an appropriate ABI version for the foreign library. Note that the
three numbers specified in this field do not directly specify the
actual ABI version: ``6:3:2`` results in library version ``4.2.3``.
With this field set, the SONAME of the library is set, and symlinks
are installed.
How you should bump this field on an ABI change depends on the
breakage you introduce:
- Programs using the previous version may use the new version as
drop-in replacement, and programs using the new version can also
work with the previous one. In other words, no recompiling nor
relinking is needed. In this case, bump ``revision`` only, don't
touch current nor age.
- Programs using the previous version may use the new version as
drop-in replacement, but programs using the new version may use
APIs not present in the previous one. In other words, a program
linking against the new version may fail with "unresolved
symbols" if linking against the old version at runtime: set
revision to 0, bump current and age.
- Programs may need to be changed, recompiled, and relinked in
order to use the new version. Bump current, set revision and age
to 0.
Also refer to the Libtool documentation on the version-info field.
.. pkg-field:: lib-version-linux: version
This field is only used on Linux.
Specifies the library ABI version directly for foreign libraries
built on Linux: so specifying ``4.2.3`` causes a library
``libfoo.so.4.2.3`` to be built with SONAME ``libfoo.so.4``, and
appropriate symlinks ``libfoo.so.4`` and ``libfoo.so`` to be
installed.
Note that typically foreign libraries should export a way to initialize
and shutdown the Haskell runtime. In the example above, this is done by
the ``csrc/MyForeignLibWrapper.c`` file, which might look something like
......
......@@ -24,3 +24,17 @@ foreign-library myforeignlib
hs-source-dirs: src
c-sources: csrc/MyForeignLibWrapper.c
default-language: Haskell2010
foreign-library versionedlib
type: native-shared
if !os(linux)
buildable: False
lib-version-info: 9:3:4
other-modules: MyForeignLib.Hello
MyForeignLib.SomeBindings
build-depends: base, my-foreign-lib
hs-source-dirs: src
c-sources: csrc/MyForeignLibWrapper.c
default-language: Haskell2010
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}
import Control.Exception
import Control.Monad.IO.Class
import System.Environment
import System.FilePath
import System.IO.Error
#ifndef mingw32_HOST_OS
import System.Posix (readSymbolicLink)
#endif /* mingw32_HOST_OS */
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Program.Db
......@@ -45,6 +49,30 @@ main = setupAndCabalTest $ do
assertOutputContains "5678" result
assertOutputContains "189" result
-- If we're on Linux, we should have built a library with a
-- version. We will now check that it was installed correctly.
#ifndef mingw32_HOST_OS
case hostPlatform lbi of
Platform _ Linux -> do
let libraryName = "libversionedlib.so.5.4.3"
libdir = flibdir installDirs
objdumpProgram = simpleProgram "objdump"
(objdump, _) <- liftIO $ requireProgram normal objdumpProgram (withPrograms lbi)
path1 <- liftIO $ readSymbolicLink $ libdir </> "libversionedlib.so"
path2 <- liftIO $ readSymbolicLink $ libdir </> "libversionedlib.so.5"
assertEqual "Symbolic link 'libversionedlib.so' incorrect"
path1 libraryName
assertEqual "Symbolic link 'libversionedlib.so.5' incorrect"
path2 libraryName
objInfo <- runM (programPath objdump) [
"-x"
, libdir </> libraryName
]
assertBool "SONAME of 'libversionedlib.so.5.4.3' incorrect" $
elem "libversionedlib.so.5" $ words $ resultOutput objInfo
_ -> return ()
#endif /* mingw32_HOST_OS */
getEnv' :: String -> IO String
getEnv' = handle handler . getEnv
where
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment