diff options
author | Ben Gamari <ben@smart-cactus.org> | 2018-02-20 00:26:45 -0500 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2018-02-20 13:15:40 -0500 |
commit | abfe10487d2dba49bf511297f14575f9089cc5b1 (patch) | |
tree | 7416a6fcd2091f9d92fc6740af07d5e37ee9e03d /utils/iserv-proxy | |
parent | f4336593a390e6317ac2852d8defb54bfa633d3e (diff) | |
download | haskell-abfe10487d2dba49bf511297f14575f9089cc5b1.tar.gz |
Revert "Move `iserv` into `utils` and change package name
See Phab:D4377 for the rationale. We will try this again.
This reverts commit 7c173b9043f7a9a5da46c5b0cc5fc3b38d1a7019.
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 | 78 | ||||
-rw-r--r-- | utils/iserv-proxy/src/Main.hs | 262 |
4 files changed, 0 insertions, 468 deletions
diff --git a/utils/iserv-proxy/Makefile b/utils/iserv-proxy/Makefile deleted file mode 100644 index f160978c19..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 -# http://ghc.haskell.org/trac/ghc/wiki/Building/Architecture -# http://ghc.haskell.org/trac/ghc/wiki/Building/Modifying -# -# ----------------------------------------------------------------------------- - -dir = iserv -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 b90a96a1fa..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 -# http://ghc.haskell.org/trac/ghc/wiki/Building/Architecture -# http://ghc.haskell.org/trac/ghc/wiki/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 b/utils/iserv-proxy/iserv-proxy.cabal deleted file mode 100644 index 1d1a2d499f..0000000000 --- a/utils/iserv-proxy/iserv-proxy.cabal +++ /dev/null @@ -1,78 +0,0 @@ -Name: iserv-proxy -Version: 8.5 -Copyright: XXX -License: BSD3 --- XXX License-File: LICENSE -Author: XXX -Maintainer: XXX -Synopsis: iserv allows GHC to delegate Tempalte 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.6, - deepseq >= 1.4 && < 1.5, - ghci == 8.5, - directory >= 1.3 && < 1.4, - network >= 2.6, - filepath >= 1.4 && < 1.5, - libiserv == 8.5 diff --git a/utils/iserv-proxy/src/Main.hs b/utils/iserv-proxy/src/Main.hs deleted file mode 100644 index c91b2d08c6..0000000000 --- a/utils/iserv-proxy/src/Main.hs +++ /dev/null @@ -1,262 +0,0 @@ -{-# LANGUAGE CPP, GADTs, OverloadedStrings #-} - -{- -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 - -dieWithUsage :: IO a -dieWithUsage = do - prog <- getProgName - die $ prog ++ ": " ++ msg - where -#if defined(WINDOWS) - msg = "usage: iserv <write-handle> <read-handle> <slave ip> [-v]" -#else - msg = "usage: iserv <write-fd> <read-fd> <slave ip> [-v]" -#endif - -main :: IO () -main = do - 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 $ - putStrLn ("Trying to connect to " ++ host_ip ++ ":" ++ (show port)) - out_pipe <- connectTo host_ip port >>= socketToPipe - - putStrLn "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 - writePipe remote (putMessage msg) - -- wait for control instructions - loopTH - readPipe remote get - where - loopTH :: IO () - loopTH = do - THMsg msg' <- readPipe remote getTHMessage - when verbose $ - putStrLn ("| TH Msg: ghc <- proxy -- slave: " ++ show msg') - res <- fwdTHMsg local msg' - when verbose $ - putStrLn ("| 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 - writePipe remote (putMessage msg) - loopLoad - 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 $ - putStrLn ("| Resp.: proxy -> slave: " - ++ truncateMsg 80 (show m)) - writePipe remote (put m) - loopLoad :: IO () - loopLoad = do - SlaveMsg msg' <- readPipe remote getSlaveMessage - when verbose $ - putStrLn ("| Sl Msg: proxy <- slave: " ++ show msg') - case msg' of - Done -> return () - Missing path -> do - 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 - writePipe remote (putMessage msg) - readPipe remote get - - -- reply to ghc. - reply :: (Show a, Binary a) => a -> IO () - reply msg = do - when verbose $ - putStrLn ("Resp.: ghc <- proxy -- slave: " ++ show msg) - writePipe local (put msg) - - loop = do - (Msg msg) <- readPipe local getMessage - when verbose $ - putStrLn ("Msg: ghc -- proxy -> slave: " ++ show msg) - (Msg msg') <- hook (Msg msg) - 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 - LoadDLL path | isAbsolute path -> do - resp <- fwdLoadCall verbose local remote msg' - reply resp - loop - Shutdown{} -> fwdCall msg' >> return () - _other -> fwdCall msg' >>= reply >> loop - - -connectTo :: String -> PortNumber -> IO Socket -connectTo host port = do - let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_NUMERICSERV] - , addrSocketType = Stream } - addr:_ <- getAddrInfo (Just hints) (Just host) (Just (show port)) - sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) - putStrLn $ "Created socket for " ++ host ++ ":" ++ show port - connect sock (addrAddress addr) - putStrLn "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 } |