summaryrefslogtreecommitdiff
path: root/utils/iserv-proxy
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2018-02-20 00:26:45 -0500
committerBen Gamari <ben@smart-cactus.org>2018-02-20 13:15:40 -0500
commitabfe10487d2dba49bf511297f14575f9089cc5b1 (patch)
tree7416a6fcd2091f9d92fc6740af07d5e37ee9e03d /utils/iserv-proxy
parentf4336593a390e6317ac2852d8defb54bfa633d3e (diff)
downloadhaskell-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/Makefile15
-rw-r--r--utils/iserv-proxy/ghc.mk113
-rw-r--r--utils/iserv-proxy/iserv-proxy.cabal78
-rw-r--r--utils/iserv-proxy/src/Main.hs262
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 }