module GHC.Linker.Windows
( maybeCreateManifest
)
where
import GHC.Prelude
import GHC.SysTools
import GHC.Driver.Session
import GHC.Utils.TmpFs
import GHC.Utils.Logger
import System.FilePath
import System.Directory
maybeCreateManifest
:: Logger
-> TmpFs
-> DynFlags
-> FilePath
-> IO [FilePath]
maybeCreateManifest :: Logger -> TmpFs -> DynFlags -> FilePath -> IO [FilePath]
maybeCreateManifest Logger
logger TmpFs
tmpfs DynFlags
dflags FilePath
exe_filename = do
let manifest_filename :: FilePath
manifest_filename = FilePath
exe_filename FilePath -> FilePath -> FilePath
<.> FilePath
"manifest"
manifest :: FilePath
manifest =
FilePath
"<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\n\
\ <assembly xmlns=\"urn:schemas-microsoft-com:asm.v1\" manifestVersion=\"1.0\">\n\
\ <assemblyIdentity version=\"1.0.0.0\"\n\
\ processorArchitecture=\"X86\"\n\
\ name=\"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
dropExtension FilePath
exe_filename FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\"\n\
\ type=\"win32\"/>\n\n\
\ <trustInfo xmlns=\"urn:schemas-microsoft-com:asm.v3\">\n\
\ <security>\n\
\ <requestedPrivileges>\n\
\ <requestedExecutionLevel level=\"asInvoker\" uiAccess=\"false\"/>\n\
\ </requestedPrivileges>\n\
\ </security>\n\
\ </trustInfo>\n\
\</assembly>\n"
FilePath -> FilePath -> IO ()
writeFile FilePath
manifest_filename FilePath
manifest
if Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_EmbedManifest DynFlags
dflags)
then [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else do
FilePath
rc_filename <- Logger
-> TmpFs -> DynFlags -> TempFileLifetime -> FilePath -> IO FilePath
newTempName Logger
logger TmpFs
tmpfs DynFlags
dflags TempFileLifetime
TFL_CurrentModule FilePath
"rc"
FilePath
rc_obj_filename <-
Logger
-> TmpFs -> DynFlags -> TempFileLifetime -> FilePath -> IO FilePath
newTempName Logger
logger TmpFs
tmpfs DynFlags
dflags TempFileLifetime
TFL_GhcSession (DynFlags -> FilePath
objectSuf DynFlags
dflags)
FilePath -> FilePath -> IO ()
writeFile FilePath
rc_filename (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"1 24 MOVEABLE PURE " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
manifest_filename FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n"
Logger -> DynFlags -> [Option] -> IO ()
runWindres Logger
logger DynFlags
dflags ([Option] -> IO ()) -> [Option] -> IO ()
forall a b. (a -> b) -> a -> b
$ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option ([FilePath] -> [Option]) -> [FilePath] -> [Option]
forall a b. (a -> b) -> a -> b
$
[FilePath
"--input="FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
rc_filename,
FilePath
"--output="FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
rc_obj_filename,
FilePath
"--output-format=coff"]
FilePath -> IO ()
removeFile FilePath
manifest_filename
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
rc_obj_filename]