diff options
Diffstat (limited to 'utils/iserv-proxy')
| -rw-r--r-- | utils/iserv-proxy/Makefile | 15 | ||||
| -rw-r--r-- | utils/iserv-proxy/ghc.mk | 113 | ||||
| -rw-r--r-- | utils/iserv-proxy/iserv-proxy.cabal.in | 82 | ||||
| -rw-r--r-- | utils/iserv-proxy/src/Main.hs | 311 |
4 files changed, 0 insertions, 521 deletions
diff --git a/utils/iserv-proxy/Makefile b/utils/iserv-proxy/Makefile deleted file mode 100644 index 2ce8bf84d4..0000000000 --- a/utils/iserv-proxy/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -# ----------------------------------------------------------------------------- -# -# (c) 2009 The University of Glasgow -# -# This file is part of the GHC build system. -# -# To understand how the build system works and how to modify it, see -# https://gitlab.haskell.org/ghc/ghc/wikis/building/architecture -# https://gitlab.haskell.org/ghc/ghc/wikis/building/modifying -# -# ----------------------------------------------------------------------------- - -dir = iserv-proxy -TOP = ../.. -include $(TOP)/mk/sub-makefile.mk diff --git a/utils/iserv-proxy/ghc.mk b/utils/iserv-proxy/ghc.mk deleted file mode 100644 index 479b72e9b0..0000000000 --- a/utils/iserv-proxy/ghc.mk +++ /dev/null @@ -1,113 +0,0 @@ -# ----------------------------------------------------------------------------- -# -# (c) 2009-2012 The University of Glasgow -# -# This file is part of the GHC build system. -# -# To understand how the build system works and how to modify it, see -# https://gitlab.haskell.org/ghc/ghc/wikis/building/architecture -# https://gitlab.haskell.org/ghc/ghc/wikis/building/modifying -# -# ----------------------------------------------------------------------------- - -utils/iserv-proxy_USES_CABAL = YES -utils/iserv-proxy_PACKAGE = iserv-proxy -utils/iserv-proxy_EXECUTABLE = iserv-proxy - -ifeq "$(GhcDebugged)" "YES" -utils/iserv-proxy_stage2_MORE_HC_OPTS += -debug -utils/iserv-proxy_stage2_p_MORE_HC_OPTS += -debug -utils/iserv-proxy_stage2_dyn_MORE_HC_OPTS += -debug -endif - -ifeq "$(GhcThreaded)" "YES" -utils/iserv-proxy_stage2_MORE_HC_OPTS += -threaded -utils/iserv-proxy_stage2_p_MORE_HC_OPTS += -threaded -utils/iserv-proxy_stage2_dyn_MORE_HC_OPTS += -threaded -endif - -# Add -Wl,--export-dynamic enables GHCi to load dynamic objects that -# refer to the RTS. This is harmless if you don't use it (adds a bit -# of overhead to startup and increases the binary sizes) but if you -# need it there's no alternative. -ifeq "$(TargetElf)" "YES" -ifneq "$(TargetOS_CPP)" "solaris2" -# The Solaris linker does not support --export-dynamic option. It also -# does not need it since it exports all dynamic symbols by default -utils/iserv-proxy_stage2_MORE_HC_OPTS += -optl-Wl,--export-dynamic -utils/iserv-proxy_stage2_p_MORE_HC_OPTS += -optl-Wl,--export-dynamic -utils/iserv-proxy_stage2_dyn_MORE_HC_OPTS += -optl-Wl,--export-dynamic -endif -endif - -# Override the default way, because we want a specific version of this -# program for each way. Note that it's important to do this even for -# the vanilla version, otherwise we get a dynamic executable when -# DYNAMIC_GHC_PROGRAMS=YES. -utils/iserv-proxy_stage2_PROGRAM_WAY = v -utils/iserv-proxy_stage2_p_PROGRAM_WAY = p -utils/iserv-proxy_stage2_dyn_PROGRAM_WAY = dyn - -utils/iserv-proxy_stage2_PROGNAME = ghc-iserv -utils/iserv-proxy_stage2_p_PROGNAME = ghc-iserv-prof -utils/iserv-proxy_stage2_dyn_PROGNAME = ghc-iserv-dyn - -utils/iserv-proxy_stage2_MORE_HC_OPTS += -no-hs-main -utils/iserv-proxy_stage2_p_MORE_HC_OPTS += -no-hs-main -utils/iserv-proxy_stage2_dyn_MORE_HC_OPTS += -no-hs-main - -utils/iserv-proxy_stage2_INSTALL = YES -utils/iserv-proxy_stage2_p_INSTALL = YES -utils/iserv-proxy_stage2_dyn_INSTALL = YES - -# Install in $(libexec), not in $(bindir) -utils/iserv-proxy_stage2_TOPDIR = YES -utils/iserv-proxy_stage2_p_TOPDIR = YES -utils/iserv-proxy_stage2_dyn_TOPDIR = YES - -utils/iserv-proxy_stage2_INSTALL_INPLACE = YES -utils/iserv-proxy_stage2_p_INSTALL_INPLACE = YES -utils/iserv-proxy_stage2_dyn_INSTALL_INPLACE = YES - -ifeq "$(CLEANING)" "YES" - -NEED_iserv = YES -NEED_iserv_p = YES -NEED_iserv_dyn = YES - -else - -ifneq "$(findstring v, $(GhcLibWays))" "" -NEED_iserv = YES -else -NEED_iserv = NO -endif - -ifneq "$(findstring p, $(GhcLibWays))" "" -NEED_iserv_p = YES -else -NEED_iserv_p = NO -endif - -ifneq "$(findstring dyn, $(GhcLibWays))" "" -NEED_iserv_dyn = YES -else -NEED_iserv_dyn = NO -endif -endif - -ifeq "$(NEED_iserv)" "YES" -$(eval $(call build-prog,utils/iserv-proxy,stage2,1)) -endif - -ifeq "$(NEED_iserv_p)" "YES" -$(eval $(call build-prog,utils/iserv-proxy,stage2_p,1)) -endif - -ifeq "$(NEED_iserv_dyn)" "YES" -$(eval $(call build-prog,utils/iserv-proxy,stage2_dyn,1)) -endif - -all_ghc_stage2 : $(iserv-proxy-stage2_INPLACE) -all_ghc_stage2 : $(iserv-proxy-stage2_p_INPLACE) -all_ghc_stage2 : $(iserv-proxy-stage2_dyn_INPLACE) diff --git a/utils/iserv-proxy/iserv-proxy.cabal.in b/utils/iserv-proxy/iserv-proxy.cabal.in deleted file mode 100644 index 7cfdd9ad7f..0000000000 --- a/utils/iserv-proxy/iserv-proxy.cabal.in +++ /dev/null @@ -1,82 +0,0 @@ --- WARNING: iserv-proxy.cabal is automatically generated from iserv-proxy.cabal.in by --- ../../configure. Make sure you are editing iserv-proxy.cabal.in, not --- iserv-proxy.cabal. - -Name: iserv-proxy -Version: @ProjectVersion@ -Copyright: XXX -License: BSD3 --- XXX License-File: LICENSE -Author: XXX -Maintainer: XXX -Synopsis: iserv allows GHC to delegate Template Haskell computations -Description: - GHC can be provided with a path to the iserv binary with - @-pgmi=/path/to/iserv-bin@, and will in combination with - @-fexternal-interpreter@, compile Template Haskell though the - @iserv-bin@ delegate. This is very similar to how ghcjs has been - compiling Template Haskell, by spawning a separate delegate (so - called runner on the javascript vm) and evaluating the splices - there. - . - iserv can also be used in combination with cross compilation. For - this, the @iserv-proxy@ needs to be built on the host, targeting the - host (as it is running on the host). @cabal install -flibrary - -fproxy@ will yield the proxy. - . - Using the cabal for the target @arch-platform-target-cabal install - -flibrary@ will build the required library that contains the ffi - @startSlave@ function, which needs to be invoked on the target - (e.g. in an iOS application) to start the remote iserv slave. - . - calling the GHC cross compiler with @-fexternal-interpreter - -pgmi=$HOME/.cabal/bin/iserv-proxy -opti\<ip address\> -opti\<port\>@ - will cause it to compile Template Haskell via the remote at \<ip address\>. - . - Thus to get cross compilation with Template Haskell follow the - following receipt: - . - * compile the iserv library for your target - . - > iserv $ arch-platform-target-cabal install -flibrary - . - * setup an application for your target that calls the - * startSlave function. This could be either haskell or your - * targets ffi capable language, if needed. - . - > void startSlave(false /* verbose */, 5000 /* port */, - > "/path/to/storagelocation/on/target"); - . - * build the iserv-proxy - . - > iserv $ cabal install -flibrary -fproxy - * Start your iserv-slave app on your target running on say @10.0.0.1:5000@ - * compiler your sources with -fexternal-interpreter and the proxy - . - > project $ arch-platform-target-ghc ModuleContainingTH.hs \ - > -fexternal-interpreter \ - > -pgmi=$HOME/.cabal/bin/iserv-proxy \ - > -opti10.0.0.1 -opti5000 - . - Should something not work as expected, provide @-opti-v@ for verbose - logging of the @iserv-proxy@. - -Category: Development -build-type: Simple -cabal-version: >=1.10 - -Executable iserv-proxy - Default-Language: Haskell2010 - Main-Is: Main.hs - Hs-Source-Dirs: src - Build-Depends: array >= 0.5 && < 0.6, - base >= 4 && < 5, - binary >= 0.7 && < 0.9, - bytestring >= 0.10 && < 0.11, - containers >= 0.5 && < 0.8, - deepseq >= 1.4 && < 1.5, - directory >= 1.3 && < 1.4, - network >= 2.6, - filepath >= 1.4 && < 1.5, - ghci == @ProjectVersionMunged@, - libiserv == @ProjectVersionMunged@ diff --git a/utils/iserv-proxy/src/Main.hs b/utils/iserv-proxy/src/Main.hs deleted file mode 100644 index 46d6c65481..0000000000 --- a/utils/iserv-proxy/src/Main.hs +++ /dev/null @@ -1,311 +0,0 @@ -{-# LANGUAGE CPP, GADTs, OverloadedStrings, LambdaCase #-} - -{- -This is the proxy portion of iserv. - -It acts as local bridge for GHC to call -a remote slave. This all might sound -confusing, so let's try to get some -naming down. - -GHC is the actual Haskell compiler, that -acts as frontend to the code to be compiled. - -iserv is the slave, that GHC delegates compilation -of TH to. As such it needs to be compiled for -and run on the Target. In the special case -where the Host and the Target are the same, -no proxy is needed. GHC and iserv communicate -via pipes. - -iserv-proxy is the proxy instance to iserv. -The following illustration should make this -somewhat clear: - - .----- Host -----. .- Target -. - | GHC <--> proxy<+-----+> iserv | - '----------------' ^ '----------' - ^ | - | '-- communication via sockets - '--- communication via pipes - -For now, we won't support multiple concurrent -invocations of the proxy instance, and that -behavior will be undefined, as this largely -depends on the capability of the iserv on the -target to spawn multiple process. Spawning -multiple threads won't be sufficient, as the -GHC runtime has global state. - -Also the GHC runtime needs to be able to -use the linker on the Target to link archives -and object files. - --} - -module Main (main) where - -import System.IO -import GHCi.Message -import GHCi.Utils -import GHCi.Signals - -import Remote.Message - -import Network.Socket -import Data.IORef -import Control.Monad -import System.Environment -import System.Exit -import Text.Printf -import GHC.Fingerprint (getFileHash) -import System.Directory -import System.FilePath (isAbsolute) - -import Data.Binary -import qualified Data.ByteString as BS - -import Control.Concurrent (threadDelay) -import qualified Control.Exception as E - -trace :: String -> IO () -trace s = getProgName >>= \name -> printf "[%20s] %s\n" name s - -dieWithUsage :: IO a -dieWithUsage = do - prog <- getProgName - die $ prog ++ ": " ++ msg - where -#if defined(WINDOWS) - msg = "usage: iserv <write-handle> <read-handle> <slave ip> <slave port> [-v]" -#else - msg = "usage: iserv <write-fd> <read-fd> <slave ip> <slave port> [-v]" -#endif - -main :: IO () -main = do - hSetBuffering stdin LineBuffering - hSetBuffering stdout LineBuffering - - args <- getArgs - (wfd1, rfd2, host_ip, port, rest) <- - case args of - arg0:arg1:arg2:arg3:rest -> do - let wfd1 = read arg0 - rfd2 = read arg1 - ip = arg2 - port = read arg3 - return (wfd1, rfd2, ip, port, rest) - _ -> dieWithUsage - - verbose <- case rest of - ["-v"] -> return True - [] -> return False - _ -> dieWithUsage - - when verbose $ - printf "GHC iserv starting (in: %d; out: %d)\n" - (fromIntegral rfd2 :: Int) (fromIntegral wfd1 :: Int) - inh <- getGhcHandle rfd2 - outh <- getGhcHandle wfd1 - installSignalHandlers - lo_ref <- newIORef Nothing - let in_pipe = Pipe{pipeRead = inh, pipeWrite = outh, pipeLeftovers = lo_ref} - - when verbose $ - trace ("Trying to connect to " ++ host_ip ++ ":" ++ (show port)) - - out_pipe <- do - let go n = E.try (connectTo verbose host_ip port >>= socketToPipe) >>= \case - Left e | n == 0 -> E.throw (e :: E.SomeException) - | n > 0 -> threadDelay 500000 >> go (n - 1) - Right a -> return a - in go 120 -- wait for up to 60seconds (polling every 0.5s). - - when verbose $ - trace "Starting proxy" - proxy verbose in_pipe out_pipe - --- | A hook, to transform outgoing (proxy -> slave) --- messages prior to sending them to the slave. -hook :: Msg -> IO Msg -hook = return - --- | Forward a single @THMessage@ from the slave --- to ghc, and read back the result from GHC. --- --- @Message@s go from ghc to the slave. --- ghc --- proxy --> slave (@Message@) --- @THMessage@s go from the slave to ghc --- ghc <-- proxy --- slave (@THMessage@) --- -fwdTHMsg :: (Binary a) => Pipe -> THMessage a -> IO a -fwdTHMsg local msg = do - writePipe local (putTHMessage msg) - readPipe local get - --- | Fowarard a @Message@ call and handle @THMessages@. -fwdTHCall :: (Binary a) => Bool -> Pipe -> Pipe -> Message a -> IO a -fwdTHCall verbose local remote msg = do - when verbose $ trace ("fwdTHCall: " ++ show msg) - writePipe remote (putMessage msg) - -- wait for control instructions - when verbose $ trace "waiting for control instructions..." - loopTH - when verbose $ trace "reading remote pipe result" - readPipe remote get - where - loopTH :: IO () - loopTH = do - when verbose $ - trace "fwdTHCall/loopTH: reading remote pipe..." - THMsg msg' <- readPipe remote getTHMessage - when verbose $ - trace ("| TH Msg: ghc <- proxy -- slave: " ++ show msg') - res <- fwdTHMsg local msg' - when verbose $ - trace ("| Resp.: ghc -- proxy -> slave: " ++ show res) - writePipe remote (put res) - case msg' of - RunTHDone -> return () - _ -> loopTH - --- | Forwards a @Message@ call, and handle @SlaveMessage@. --- Similar to @THMessages@, but @SlaveMessage@ are between --- the slave and the proxy, and are not forwarded to ghc. --- These message allow the Slave to query the proxy for --- files. --- --- ghc --- proxy --> slave (@Message@) --- --- proxy <-- slave (@SlaveMessage@) --- -fwdLoadCall :: (Binary a, Show a) => Bool -> Pipe -> Pipe -> Message a -> IO a -fwdLoadCall verbose _ remote msg = do - when verbose $ trace "fwdLoadCall: writing remote pipe" - writePipe remote (putMessage msg) - loopLoad - when verbose $ trace "fwdLoadCall: reading local pipe" - readPipe remote get - where - truncateMsg :: Int -> String -> String - truncateMsg n s | length s > n = take n s ++ "..." - | otherwise = s - reply :: (Binary a, Show a) => a -> IO () - reply m = do - when verbose $ - trace ("| Resp.: proxy -> slave: " - ++ truncateMsg 80 (show m)) - writePipe remote (put m) - loopLoad :: IO () - loopLoad = do - when verbose $ trace "fwdLoadCall: reading remote pipe" - SlaveMsg msg' <- readPipe remote getSlaveMessage - when verbose $ - trace ("| Sl Msg: proxy <- slave: " ++ show msg') - case msg' of - Done -> return () - Missing path -> do - when verbose $ - trace $ "fwdLoadCall: missing path: " ++ path - reply =<< BS.readFile path - loopLoad - Have path remoteHash -> do - localHash <- getFileHash path - reply =<< if localHash == remoteHash - then return Nothing - else Just <$> BS.readFile path - loopLoad - --- | The actual proxy. Conntect local and remote pipe, --- and does some message handling. -proxy :: Bool -> Pipe -> Pipe -> IO () -proxy verbose local remote = loop - where - fwdCall :: (Binary a, Show a) => Message a -> IO a - fwdCall msg = do - when verbose $ trace "proxy/fwdCall: writing remote pipe" - writePipe remote (putMessage msg) - when verbose $ trace "proxy/fwdCall: reading remote pipe" - readPipe remote get - - -- reply to ghc. - reply :: (Show a, Binary a) => a -> IO () - reply msg = do - when verbose $ - trace ("Resp.: ghc <- proxy -- slave: " ++ show msg) - writePipe local (put msg) - - loop = do - (Msg msg) <- readPipe local getMessage - when verbose $ - trace ("Msg: ghc -- proxy -> slave: " ++ show msg) - (Msg msg') <- hook (Msg msg) - -- Note [proxy-communication] - -- - -- The fwdTHCall/fwdLoadCall/fwdCall's have to match up - -- with their endpoints in libiserv:Remote.Slave otherwise - -- you will end up with hung connections. - -- - -- We are intercepting some calls between ghc and iserv - -- and augment the protocol here. Thus these two sides - -- need to line up and know what request/reply to expect. - -- - case msg' of - -- TH might send some message back to ghc. - RunTH{} -> do - resp <- fwdTHCall verbose local remote msg' - reply resp - loop - RunModFinalizers{} -> do - resp <- fwdTHCall verbose local remote msg' - reply resp - loop - -- Load messages might send some messages back to the proxy, to - -- requrest files that are not present on the device. - LoadArchive{} -> do - resp <- fwdLoadCall verbose local remote msg' - reply resp - loop - LoadObj{} -> do - resp <- fwdLoadCall verbose local remote msg' - reply resp - loop - -- On windows we assume that we don't want to copy libraries - -- that are referenced in C:\ these are usually system libraries. - LoadDLL path@('C':':':_) -> do - fwdCall msg' >>= reply >> loop - LoadDLL path | isAbsolute path -> do - resp <- fwdLoadCall verbose local remote msg' - reply resp - loop - Shutdown{} -> fwdCall msg' >> return () - _other -> fwdCall msg' >>= reply >> loop - - -connectTo :: Bool -> String -> PortNumber -> IO Socket -connectTo verbose host port = do - addr <- resolve host (show port) - open addr - where - resolve host port = do - let hints = defaultHints { addrSocketType = Stream } - addr:_ <- getAddrInfo (Just hints) (Just host) (Just port) - return addr - open addr = do - sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) - when verbose $ - trace $ "Created socket for " ++ host ++ ":" ++ show port - connect sock $ addrAddress addr - when verbose $ - trace "connected" - return sock - --- | Turn a socket into an unbuffered pipe. -socketToPipe :: Socket -> IO Pipe -socketToPipe sock = do - hdl <- socketToHandle sock ReadWriteMode - hSetBuffering hdl NoBuffering - - lo_ref <- newIORef Nothing - pure Pipe{ pipeRead = hdl, pipeWrite = hdl, pipeLeftovers = lo_ref } |