From c85d5a0dc8e97e56222f5f7ea1cc2744d4066ec9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 11 Feb 2025 12:12:27 -0400 Subject: [PATCH] OsPath conversion of linuxstandalone builder Sponsored-by: Joshua Antonishen --- Build/LinuxMkLibs.hs | 86 ++++++++++++++-------------- Build/Standalone.hs | 123 ++++++++++++++++++++--------------------- Utility/LinuxMkLibs.hs | 49 ++++++++-------- 3 files changed, 128 insertions(+), 130 deletions(-) diff --git a/Build/LinuxMkLibs.hs b/Build/LinuxMkLibs.hs index fad73c4c76..d5854dd774 100644 --- a/Build/LinuxMkLibs.hs +++ b/Build/LinuxMkLibs.hs @@ -5,10 +5,11 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Build.LinuxMkLibs (mklibs) where import Data.Maybe -import System.FilePath import Control.Monad import Data.List import System.Posix.Files @@ -18,6 +19,7 @@ import qualified System.Info import Prelude import Utility.LinuxMkLibs +import Utility.OsPath import Utility.Directory import Utility.Process import Utility.Monad @@ -25,18 +27,18 @@ import Utility.Path import Utility.Path.AbsRel import Utility.FileMode import Utility.CopyFile -import Utility.FileSystemEncoding import Utility.SystemDirectory +import qualified Utility.OsString as OS -mklibs :: FilePath -> a -> IO Bool +mklibs :: OsPath -> a -> IO Bool mklibs top _installedbins = do - fs <- dirContentsRecursive (toRawFilePath top) - exes <- filterM checkExe (map fromRawFilePath fs) + fs <- dirContentsRecursive top + exes <- filterM checkExe fs libs <- runLdd exes glibclibs <- glibcLibs let libs' = nub $ libs ++ glibclibs - let (linkers, otherlibs) = partition ("ld-linux" `isInfixOf`) libs' + let (linkers, otherlibs) = partition (literalOsPath "ld-linux" `OS.isInfixOf`) libs' libdirs <- nub . catMaybes <$> mapM (installLib installFile top) otherlibs libdirs' <- consolidateUsrLib top libdirs @@ -45,8 +47,10 @@ mklibs top _installedbins = do -- Various files used by runshell to set up env vars used by the -- linker shims. - writeFile (top "libdirs") (unlines libdirs') - writeFile (top "gconvdir") (fromRawFilePath $ parentDir $ toRawFilePath $ Prelude.head gconvlibs) + writeFile (fromOsPath (top literalOsPath "libdirs")) + (unlines (map fromOsPath libdirs')) + writeFile (fromOsPath (top literalOsPath "gconvdir")) + (fromOsPath (parentDir $ Prelude.head gconvlibs)) mapM_ (installLib installFile top) linkers let linker = Prelude.head linkers @@ -60,9 +64,9 @@ mklibs top _installedbins = do -- fails, a minor optimisation will not happen, but there will be -- no bad results. hwcaplibdir d = not $ or - [ "lib" == takeFileName d + [ literalOsPath "lib" == takeFileName d -- eg, "lib/x86_64-linux-gnu" - , "-linux-" `isInfixOf` takeFileName d + , literalOsPath "-linux-" `OS.isInfixOf` takeFileName d ] {- If there are two libdirs that are the same except one is in @@ -71,17 +75,17 @@ mklibs top _installedbins = do - needs to look in, and so reduces the number of failed stats - and improves startup time. -} -consolidateUsrLib :: FilePath -> [FilePath] -> IO [FilePath] +consolidateUsrLib :: OsPath -> [OsPath] -> IO [OsPath] consolidateUsrLib top libdirs = go [] libdirs where go c [] = return c - go c (x:rest) = case filter (\d -> ("/usr" ++ d) == x) libdirs of + go c (x:rest) = case filter (\d -> (literalOsPath "/usr" <> d) == x) libdirs of (d:_) -> do fs <- getDirectoryContents (inTop top x) forM_ fs $ \f -> do let src = inTop top (x f) let dst = inTop top (d f) - unless (dirCruft (toRawFilePath f)) $ + unless (f `elem` dirCruft) $ unlessM (doesDirectoryExist src) $ renameFile src dst symlinkHwCapDirs top d @@ -96,17 +100,17 @@ consolidateUsrLib top libdirs = go [] libdirs - to the libdir. This way, the linker will find a library the first place - it happens to look for it. -} -symlinkHwCapDirs :: FilePath -> FilePath -> IO () +symlinkHwCapDirs :: OsPath -> OsPath -> IO () symlinkHwCapDirs top libdir = forM_ hwcapdirs $ \d -> - unlessM (doesDirectoryExist (top ++ libdir d)) $ do - createDirectoryIfMissing True (top ++ libdir takeDirectory d) + unlessM (doesDirectoryExist (top <> libdir d)) $ do + createDirectoryIfMissing True (top <> libdir takeDirectory d) link <- relPathDirToFile - (toRawFilePath (top ++ takeDirectory (libdir d))) - (toRawFilePath (top ++ libdir)) - let link' = case fromRawFilePath link of + (top <> takeDirectory (libdir d)) + (top <> libdir) + let link' = case fromOsPath link of "" -> "." l -> l - createSymbolicLink link' (top ++ libdir d) + createSymbolicLink link' (fromOsPath (top <> libdir d)) where hwcapdirs = case System.Info.arch of "x86_64" -> @@ -145,50 +149,48 @@ symlinkHwCapDirs top libdir = forM_ hwcapdirs $ \d -> - The linker is symlinked to a file with the same basename as the binary, - since that looks better in ps than "ld-linux.so". -} -installLinkerShim :: FilePath -> FilePath -> FilePath -> IO () +installLinkerShim :: OsPath -> OsPath -> OsPath -> IO () installLinkerShim top linker exe = do createDirectoryIfMissing True (top shimdir) createDirectoryIfMissing True (top exedir) - ifM (isSymbolicLink <$> getSymbolicLinkStatus exe) + ifM (isSymbolicLink <$> getSymbolicLinkStatus (fromOsPath exe)) ( do - sl <- readSymbolicLink exe - removeWhenExistsWith removeLink exe - removeWhenExistsWith removeLink exedest + sl <- toOsPath <$> readSymbolicLink (fromOsPath exe) + removeWhenExistsWith removeFile exe + removeWhenExistsWith removeFile exedest -- Assume that for a symlink, the destination -- will also be shimmed. - let sl' = ".." takeFileName sl takeFileName sl - createSymbolicLink sl' exedest + let sl' = literalOsPath ".." takeFileName sl takeFileName sl + createSymbolicLink (fromOsPath sl') (fromOsPath exedest) , renameFile exe exedest ) - link <- relPathDirToFile - (toRawFilePath (top exedir)) - (toRawFilePath (top ++ linker)) + link <- relPathDirToFile (top exedir) (top <> linker) unlessM (doesFileExist (top exelink)) $ - createSymbolicLink (fromRawFilePath link) (top exelink) - writeFile exe $ unlines + createSymbolicLink (fromOsPath link) (fromOsPath (top exelink)) + writeFile (fromOsPath exe) $ unlines [ "#!/bin/sh" - , "exec \"$GIT_ANNEX_DIR/" ++ exelink ++ "\" --library-path \"$GIT_ANNEX_LD_LIBRARY_PATH\" \"$GIT_ANNEX_DIR/shimmed/" ++ base ++ "/" ++ base ++ "\" \"$@\"" + , "exec \"$GIT_ANNEX_DIR/" ++ fromOsPath exelink ++ "\" --library-path \"$GIT_ANNEX_LD_LIBRARY_PATH\" \"$GIT_ANNEX_DIR/shimmed/" ++ fromOsPath base ++ "/" ++ fromOsPath base ++ "\" \"$@\"" ] - modifyFileMode (toRawFilePath exe) $ addModes executeModes + modifyFileMode exe $ addModes executeModes where base = takeFileName exe - shimdir = "shimmed" base - exedir = "exe" + shimdir = literalOsPath "shimmed" base + exedir = literalOsPath "exe" exedest = top shimdir base exelink = exedir base -installFile :: FilePath -> FilePath -> IO () +installFile :: OsPath -> OsPath -> IO () installFile top f = do createDirectoryIfMissing True destdir void $ copyFileExternal CopyTimeStamps f destdir where - destdir = inTop top $ fromRawFilePath $ parentDir $ toRawFilePath f + destdir = inTop top $ parentDir f -checkExe :: FilePath -> IO Bool +checkExe :: OsPath -> IO Bool checkExe f - | ".so" `isSuffixOf` f = return False - | otherwise = ifM (isExecutable . fileMode <$> getFileStatus f) - ( checkFileExe <$> readProcess "file" ["-L", f] + | literalOsPath ".so" `OS.isSuffixOf` f = return False + | otherwise = ifM (isExecutable . fileMode <$> getFileStatus (fromOsPath f)) + ( checkFileExe <$> readProcess "file" ["-L", fromOsPath f] , return False ) diff --git a/Build/Standalone.hs b/Build/Standalone.hs index 36a4d5a002..2c0c8d1b55 100644 --- a/Build/Standalone.hs +++ b/Build/Standalone.hs @@ -7,12 +7,12 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} module Main where import System.Environment (getArgs) import Control.Monad.IfElse -import System.FilePath import System.Posix.Files import Control.Monad import qualified Data.ByteString.Lazy as L @@ -20,11 +20,11 @@ import qualified Data.Map as M import Utility.SafeCommand import Utility.Process +import Utility.OsPath import Utility.Path import Utility.Path.AbsRel import Utility.Directory import Utility.Env -import Utility.FileSystemEncoding import Utility.SystemDirectory import Build.BundledPrograms #ifdef darwin_HOST_OS @@ -37,48 +37,46 @@ import Build.LinuxMkLibs (mklibs) import Utility.FileMode #endif -progDir :: FilePath -> FilePath +progDir :: OsPath -> OsPath #ifdef darwin_HOST_OS progDir topdir = topdir #else -progDir topdir = topdir "bin" +progDir topdir = topdir literalOsPath "bin" #endif -extraProgDir :: FilePath -> FilePath +extraProgDir :: OsPath -> OsPath extraProgDir topdir = topdir "extra" -installProg :: FilePath -> FilePath -> IO (FilePath, FilePath) -installProg dir prog = searchPath prog >>= go +installProg :: OsPath -> OsPath -> IO (OsPath, OsPath) +installProg dir prog = searchPath (fromOsPath prog) >>= go where - go Nothing = error $ "cannot find " ++ prog ++ " in PATH" + go Nothing = error $ "cannot find " ++ fromOsPath prog ++ " in PATH" go (Just f) = do let dest = dir takeFileName f - unlessM (boolSystem "install" [File f, File dest]) $ - error $ "install failed for " ++ prog + unlessM (boolSystem "install" [File (fromOsPath f), File (fromOsPath dest)]) $ + error $ "install failed for " ++ fromOsPath prog return (dest, f) -installBundledPrograms :: FilePath -> IO (M.Map FilePath FilePath) +installBundledPrograms :: OsPath -> IO (M.Map OsPath OsPath) installBundledPrograms topdir = M.fromList . concat <$> mapM go - [ (progDir topdir, preferredBundledPrograms) - , (extraProgDir topdir, extraBundledPrograms) + [ (progDir topdir, map toOsPath preferredBundledPrograms) + , (extraProgDir topdir, map toOsPath extraBundledPrograms) ] where go (dir, progs) = do createDirectoryIfMissing True dir forM progs $ installProg dir -installGitLibs :: FilePath -> IO () +installGitLibs :: OsPath -> IO () installGitLibs topdir = do -- install git-core programs; these are run by the git command createDirectoryIfMissing True gitcoredestdir execpath <- getgitpath "exec-path" - cfs <- dirContents (toRawFilePath execpath) + cfs <- dirContents execpath forM_ cfs $ \f -> do - let f' = fromRawFilePath f - destf <- ((gitcoredestdir ) . fromRawFilePath) - <$> relPathDirToFile - (toRawFilePath execpath) - f + let f' = fromOsPath f + destf <- (gitcoredestdir ) + <$> relPathDirToFile execpath f createDirectoryIfMissing True (takeDirectory destf) issymlink <- isSymbolicLink <$> getSymbolicLinkStatus f' if issymlink @@ -93,99 +91,98 @@ installGitLibs topdir = do -- Other git-core files symlink to a file -- beside them in the directory. Those -- links can be copied as-is. - linktarget <- readSymbolicLink f' + linktarget <- toOsPath <$> readSymbolicLink f' if takeFileName linktarget == linktarget - then cp f' destf + then cp f destf else do let linktarget' = progDir topdir takeFileName linktarget unlessM (doesFileExist linktarget') $ do createDirectoryIfMissing True (takeDirectory linktarget') - L.readFile f' >>= L.writeFile linktarget' - removeWhenExistsWith removeLink destf + L.readFile f' >>= L.writeFile (fromOsPath linktarget') + removeWhenExistsWith removeFile destf rellinktarget <- relPathDirToFile - (toRawFilePath (takeDirectory destf)) - (toRawFilePath linktarget') - createSymbolicLink (fromRawFilePath rellinktarget) destf - else cp f' destf + (takeDirectory destf) + (linktarget') + createSymbolicLink (fromOsPath rellinktarget) (fromOsPath destf) + else cp f destf -- install git's template files -- git does not have an option to get the path of these, -- but they're architecture independent files, so are located -- next to the --man-path, in eg /usr/share/git-core manpath <- getgitpath "man-path" - let templatepath = manpath ".." "git-core" "templates" - tfs <- dirContents (toRawFilePath templatepath) + let templatepath = manpath literalOsPath ".." literalOsPath "git-core" literalOsPath "templates" + tfs <- dirContents templatepath forM_ tfs $ \f -> do - destf <- ((templatedestdir ) . fromRawFilePath) - <$> relPathDirToFile - (toRawFilePath templatepath) - f + destf <- (templatedestdir ) + <$> relPathDirToFile templatepath f createDirectoryIfMissing True (takeDirectory destf) - cp (fromRawFilePath f) destf + cp f destf where - gitcoredestdir = topdir "git-core" - templatedestdir = topdir "templates" + gitcoredestdir = topdir literalOsPath "git-core" + templatedestdir = topdir literalOsPath "templates" getgitpath v = do let opt = "--" ++ v ls <- lines <$> readProcess "git" [opt] case ls of [] -> error $ "git " ++ opt ++ "did not output a location" - (p:_) -> return p + (p:_) -> return (toOsPath p) -cp :: FilePath -> FilePath -> IO () +cp :: OsPath -> OsPath -> IO () cp src dest = do - removeWhenExistsWith removeLink dest - unlessM (boolSystem "cp" [Param "-a", File src, File dest]) $ + removeWhenExistsWith removeFile dest + unlessM (boolSystem "cp" [Param "-a", File (fromOsPath src), File (fromOsPath dest)]) $ error "cp failed" -installMagic :: FilePath -> IO () +installMagic :: OsPath -> IO () #ifdef darwin_HOST_OS installMagic topdir = getEnv "OSX_MAGIC_FILE" >>= \case Nothing -> hPutStrLn stderr "OSX_MAGIC_FILE not set; not including it" Just f -> do - let mdir = topdir "magic" + let mdir = topdir literalOsPath "magic" createDirectoryIfMissing True mdir - unlessM (boolSystem "cp" [File f, File (mdir "magic.mgc")]) $ + unlessM (boolSystem "cp" [File f, File (fromOsPath (mdir literalOsPath "magic.mgc"))]) $ error "cp failed" #else installMagic topdir = do - let mdir = topdir "magic" + let mdir = topdir literalOsPath "magic" createDirectoryIfMissing True mdir - unlessM (boolSystem "cp" [File "/usr/share/file/magic.mgc", File (mdir "magic.mgc")]) $ + unlessM (boolSystem "cp" [File "/usr/share/file/magic.mgc", File (fromOsPath (mdir literalOsPath "magic.mgc"))]) $ error "cp failed" #endif -installLocales :: FilePath -> IO () +installLocales :: OsPath -> IO () #ifdef darwin_HOST_OS installLocales _ = return () #else -installLocales topdir = cp "/usr/share/i18n" (topdir "i18n") +installLocales topdir = + cp (literalOsPath "/usr/share/i18n") (topdir "i18n") #endif -installSkel :: FilePath -> FilePath -> IO () +installSkel :: OsPath -> OsPath -> IO () #ifdef darwin_HOST_OS installSkel _topdir basedir = do whenM (doesDirectoryExist basedir) $ removeDirectoryRecursive basedir createDirectoryIfMissing True (takeDirectory basedir) - unlessM (boolSystem "cp" [Param "-R", File "standalone/osx/git-annex.app", File basedir]) $ + unlessM (boolSystem "cp" [Param "-R", File "standalone/osx/git-annex.app", File (fromOsPath basedir)]) $ error "cp failed" #else installSkel topdir _basedir = do whenM (doesDirectoryExist topdir) $ removeDirectoryRecursive topdir createDirectoryIfMissing True (takeDirectory topdir) - unlessM (boolSystem "cp" [Param "-R", File "standalone/linux/skel", File topdir]) $ + unlessM (boolSystem "cp" [Param "-R", File "standalone/linux/skel", File (fromOsPath topdir)]) $ error "cp failed" #endif -installSkelRest :: FilePath -> FilePath -> Bool -> IO () +installSkelRest :: OsPath -> OsPath -> Bool -> IO () #ifdef darwin_HOST_OS installSkelRest _topdir basedir _hwcaplibs = do plist <- lines <$> readFile "standalone/osx/Info.plist.template" version <- getVersion - writeFile (basedir "Contents" "Info.plist") + writeFile (fromOsPath (basedir literalOsPath "Contents" literalOsPath "Info.plist")) (unlines (map (expandversion version) plist)) where expandversion v l = replace "GIT_ANNEX_VERSION" v l @@ -195,10 +192,10 @@ installSkelRest topdir _basedir hwcaplibs = do -- GIT_ANNEX_PACKAGE_INSTALL can be set by a distributor and -- runshell will be modified gapi <- getEnv "GIT_ANNEX_PACKAGE_INSTALL" - writeFile (topdir "runshell") + writeFile (fromOsPath (topdir literalOsPath "runshell")) (unlines (map (expandrunshell gapi) runshell)) modifyFileMode - (toRawFilePath (topdir "runshell")) + (topdir literalOsPath "runshell") (addModes executeModes) where expandrunshell (Just gapi) l@"GIT_ANNEX_PACKAGE_INSTALL=" = l ++ gapi @@ -211,25 +208,25 @@ installSkelRest topdir _basedir hwcaplibs = do expandrunshell _ l = l #endif -installGitAnnex :: FilePath -> IO () +installGitAnnex :: OsPath -> IO () #ifdef darwin_HOST_OS installGitAnnex topdir = go topdir #else -installGitAnnex topdir = go (topdir "bin") +installGitAnnex topdir = go (topdir literalOsPath "bin") #endif where go bindir = do createDirectoryIfMissing True bindir - unlessM (boolSystem "cp" [File "git-annex", File bindir]) $ + unlessM (boolSystem "cp" [File "git-annex", File (fromOsPath bindir)]) $ error "cp failed" - unlessM (boolSystem "strip" [File (bindir "git-annex")]) $ + unlessM (boolSystem "strip" [File (fromOsPath (bindir literalOsPath "git-annex"))]) $ error "strip failed" - createSymbolicLink "git-annex" (bindir "git-annex-shell") - createSymbolicLink "git-annex" (bindir "git-remote-tor-annex") - createSymbolicLink "git-annex" (bindir "git-remote-annex") + createSymbolicLink "git-annex" (fromOsPath (bindir literalOsPath "git-annex-shell")) + createSymbolicLink "git-annex" (fromOsPath (bindir literalOsPath "git-remote-tor-annex")) + createSymbolicLink "git-annex" (fromOsPath (bindir literalOsPath "git-remote-annex")) main :: IO () -main = getArgs >>= go +main = getArgs >>= go . map toOsPath where go (topdir:basedir:[]) = do installSkel topdir basedir diff --git a/Utility/LinuxMkLibs.hs b/Utility/LinuxMkLibs.hs index 54c786b8de..cce5ca99bf 100644 --- a/Utility/LinuxMkLibs.hs +++ b/Utility/LinuxMkLibs.hs @@ -24,7 +24,6 @@ import Utility.Monad import Utility.Path import Utility.Path.AbsRel import Utility.Split -import Utility.FileSystemEncoding import Utility.Env import Utility.Exception import Utility.OsPath @@ -39,42 +38,42 @@ import Prelude {- Installs a library. If the library is a symlink to another file, - install the file it links to, and update the symlink to be relative. -} -installLib :: (FilePath -> FilePath -> IO ()) -> FilePath -> FilePath -> IO (Maybe FilePath) -installLib installfile top lib = ifM (doesFileExist (toOsPath lib)) +installLib :: (OsPath -> OsPath -> IO ()) -> OsPath -> OsPath -> IO (Maybe OsPath) +installLib installfile top lib = ifM (doesFileExist lib) ( do installfile top lib checksymlink lib - return $ Just $ fromOsPath $ parentDir $ toOsPath lib + return $ Just $ parentDir lib , return Nothing ) where - checksymlink f = whenM (isSymbolicLink <$> getSymbolicLinkStatus (inTop top f)) $ do - l <- readSymbolicLink (inTop top f) - let absl = absPathFrom - (parentDir (toOsPath f)) - (toOsPath l) - target <- relPathDirToFile (takeDirectory (toOsPath f)) absl - installfile top (fromOsPath absl) - removeWhenExistsWith removeLink (toRawFilePath (top ++ f)) - createSymbolicLink (fromOsPath target) (inTop top f) - checksymlink (fromOsPath absl) + checksymlink f = whenM (isSymbolicLink <$> getSymbolicLinkStatus (fromOsPath (inTop top f))) $ do + l <- readSymbolicLink (fromOsPath (inTop top f)) + let absl = absPathFrom (parentDir f) (toOsPath l) + target <- relPathDirToFile (takeDirectory f) absl + installfile top absl + removeWhenExistsWith removeFile (inTop top f) + createSymbolicLink (fromOsPath target) (fromOsPath (inTop top f)) + checksymlink absl -- Note that f is not relative, so cannot use -inTop :: FilePath -> FilePath -> RawFilePath -inTop top f = toRawFilePath $ top ++ f +inTop :: OsPath -> OsPath -> OsPath +inTop top f = top <> f {- Parse ldd output, getting all the libraries that the input files - link to. Note that some of the libraries may not exist - (eg, linux-vdso.so) -} -parseLdd :: String -> [FilePath] -parseLdd = mapMaybe (getlib . dropWhile isSpace) . lines +parseLdd :: String -> [OsPath] +parseLdd = map toOsPath + . mapMaybe (getlib . dropWhile isSpace) + . lines where getlib l = headMaybe . words =<< lastMaybe (split " => " l) -runLdd :: [String] -> IO [FilePath] +runLdd :: [OsPath] -> IO [OsPath] runLdd exes = concat <$> mapM go exes where - go exe = tryNonAsync (readProcess "ldd" [exe]) >>= \case + go exe = tryNonAsync (readProcess "ldd" [fromOsPath exe]) >>= \case Right o -> return (parseLdd o) -- ldd for some reason segfaults when run in an arm64 -- chroot on an amd64 host, on a binary produced by ghc. @@ -82,21 +81,21 @@ runLdd exes = concat <$> mapM go exes Left _e -> do environ <- getEnvironment let environ' =("LD_TRACE_LOADED_OBJECTS","1"):environ - parseLdd <$> readProcessEnv exe [] (Just environ') + parseLdd <$> readProcessEnv (fromOsPath exe) [] (Just environ') {- Get all glibc libs, and also libgcc_s - - XXX Debian specific. -} -glibcLibs :: IO [FilePath] +glibcLibs :: IO [OsPath] glibcLibs = do ls <- lines <$> readProcess "sh" ["-c", "dpkg -L libc6:$(dpkg --print-architecture) | egrep '\\.so' | grep -v /gconv/ | grep -v ld.so.conf | grep -v sotruss-lib"] ls2 <- lines <$> readProcess "sh" ["-c", "(dpkg -L libgcc-s1:$(dpkg --print-architecture 2>/dev/null) || dpkg -L libgcc1:$(dpkg --print-architecture)) | egrep '\\.so'"] - return (ls++ls2) + return (map toOsPath (ls++ls2)) {- Get gblibc's gconv libs, which are handled specially.. -} -gconvLibs :: IO [FilePath] -gconvLibs = lines <$> readProcess "sh" +gconvLibs :: IO [OsPath] +gconvLibs = map toOsPath . lines <$> readProcess "sh" ["-c", "dpkg -L libc6:$(dpkg --print-architecture) | grep /gconv/"]