on-demand-ssh-tunnel 0.1.0.3 → 0.1.0.4
raw patch · 4 files changed
+119/−79 lines, 4 filesdep +GenericPrettydep +on-demand-ssh-tunneldep ~base
Dependencies added: GenericPretty, on-demand-ssh-tunnel
Dependency ranges changed: base
Files
- README +4/−5
- on-demand-ssh-tunnel.cabal +9/−6
- on-demand-ssh-tunnel.hs +11/−68
- src/Network/OnDemandSSHTunnel.hs +95/−0
README view
@@ -1,11 +1,10 @@ Example usage: - $ on-demand-ssh-tunnel 20110 110 -p2222 user@ssh-server + $ on-demand-ssh-tunnel '[ SSHTunnel 59000 5900 ["user@host1", "while true; do date; sleep 60; done"] ]' -When something connects to 127.0.0.1:20110 on-demand-ssh-tunnel will+When something connects to 127.0.0.1:59000 on-demand-ssh-tunnel will start ssh subprocess - ssh -v -L random-tunnel-port:127.0.0.1:110 -n -p2222 user@ssh-server+ ssh -v -Lrandom-tunnel-port:127.0.0.1:5900 -n user@host1 -to tunnel communication to POP3 server accessible on port 110 (on-server).+to tunnel communication to VNC server accessible on port 5900 (on host1).
on-demand-ssh-tunnel.cabal view
@@ -1,5 +1,5 @@ name: on-demand-ssh-tunnel-version: 0.1.0.3+version: 0.1.0.4 synopsis: Program that sends traffic through SSH tunnels on-demand description: Program that sends traffic through SSH tunnels on-demand homepage: https://github.com/crackleware/on-demand-ssh-tunnel@@ -7,16 +7,19 @@ license-file: LICENSE author: Predrag Radovic maintainer: predrg@gmail.com-copyright: (c) 2014 Predrag Radovic+copyright: (c) 2015 Predrag Radovic category: Network build-type: Simple extra-source-files: README cabal-version: >=1.10 +library+ hs-source-dirs: src+ exposed-modules: Network.OnDemandSSHTunnel+ build-depends: base <5, network, bytestring, random, process, GenericPretty+ default-language: Haskell2010+ executable on-demand-ssh-tunnel main-is: on-demand-ssh-tunnel.hs- -- other-modules: - -- other-extensions: - build-depends: base >=4.5 && <4.6, network, bytestring, random, process- -- hs-source-dirs: + build-depends: base <5, network, bytestring, random, process, GenericPretty, on-demand-ssh-tunnel default-language: Haskell2010
on-demand-ssh-tunnel.hs view
@@ -1,75 +1,18 @@-{-# LANGUAGE ScopedTypeVariables #-}- import System.Environment-import System.Process import Control.Monad+import Control.Applicative import Control.Concurrent-import Control.Exception-import qualified Control.Exception as CE-import Network.Socket-import System.Random import System.IO-import qualified Data.ByteString as BS-import Text.Printf (printf)-import System.Mem +import Network.OnDemandSSHTunnel+ main :: IO () main = do- listenPort' : targetPort' : sshArgs <- getArgs- let listenPort = read listenPort' :: Int- targetPort = read targetPort' :: Int- sock <- socket AF_INET Stream defaultProtocol- setSocketOption sock ReuseAddr 1- addr <- inet_addr "127.0.0.1"- bindSocket sock $ SockAddrInet (fromIntegral listenPort) addr- listen sock 5- putStrLn $ "listening for connections on port " ++ show listenPort- forever $ do- (conn, connaddr) <- accept sock- hConn <- socketToHandle conn ReadWriteMode- putStrLn $ "connection accepted: " ++ show connaddr- forkIO $ do- tunnelPort :: Int <- randomRIO (50000, 55000)- handleConnection hConn tunnelPort targetPort sshArgs--handleConnection :: Handle -> Int -> Int -> [String] -> IO ()-handleConnection hConn tunnelPort targetPort sshArgs = do- (_, _, _, p) <- createProcess (proc "ssh" $ ["-v"] ++ [- "-L" ++ show tunnelPort ++ ":127.0.0.1:" ++ show targetPort, "-n"] ++- sshArgs)- finally forwardToTunnel $ do- putStrLn "terminating ssh"- terminateProcess p- _ <- waitForProcess p- putStrLn "ssh exited"- performGC -- a good moment to finalize handles- - where forwardToTunnel = do- hTunn <- tryTunnelConnection tunnelPort 15- _ <- forkIO $ forward "hTunn->hConn" hTunn hConn- forward "hConn->hTunn" hConn hTunn- - forward desc h1 h2 =- forever $ do- bs <- BS.hGetSome h1 4096- putStrLn $ printf "%s %d bytes" desc (BS.length bs)- if BS.null bs then- error "no more data to tunnel"- else do- BS.hPut h2 bs- hFlush h2--tryTunnelConnection :: Int -> Int -> IO Handle-tryTunnelConnection _ 0 = error "can't connect to tunnel"-tryTunnelConnection port attempts = do- threadDelay (1*1000*1000)- tunn <- socket AF_INET Stream defaultProtocol- addr <- inet_addr "127.0.0.1"- CE.catch (do connect tunn $ SockAddrInet (fromIntegral port) addr- hTunn <- socketToHandle tunn ReadWriteMode- putStrLn "got hTunn" - return hTunn)- (\(_::SomeException) -> do- sClose tunn- tryTunnelConnection port (attempts-1))-+ tuns <- unwords <$> getArgs+ let cfg = Config $ read tuns+ putStrLn $ "cfg:\n" ++ prettyConfig cfg+ hFlush stdout+ setupConfiguration cfg+ putStrLn "enter to exit..."+ _ <- getLine+ return ()
+ src/Network/OnDemandSSHTunnel.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveGeneric #-}++module Network.OnDemandSSHTunnel (+ SSHTunnel(..),+ Config(..),+ prettyConfig,+ setupConfiguration,+ setupOnDemandTunnel,+) where++import System.Process+import Control.Monad+import Control.Concurrent+import Control.Exception+import qualified Control.Exception as CE+import Network.Socket+import System.Random+import System.IO+import qualified Data.ByteString as BS+import Text.Printf (printf)+import System.Mem++import Text.PrettyPrint.GenericPretty++data SSHTunnel = SSHTunnel Int Int [String] deriving (Show, Read, Generic)+newtype Config = Config [SSHTunnel] deriving (Show, Read, Generic)++instance Out SSHTunnel+instance Out Config++prettyConfig :: Config -> String+prettyConfig cfg = pretty cfg++setupConfiguration :: Config -> IO ()+setupConfiguration (Config tuns) =+ forM_ tuns $ forkIO . setupOnDemandTunnel++setupOnDemandTunnel :: SSHTunnel -> IO ()+setupOnDemandTunnel (SSHTunnel listenPort targetPort sshArgs) = do+ sock <- socket AF_INET Stream defaultProtocol+ setSocketOption sock ReuseAddr 1+ addr <- inet_addr "127.0.0.1"+ bindSocket sock $ SockAddrInet (fromIntegral listenPort) addr+ listen sock 5+ putStrLn $ "listening for connections on port " ++ show listenPort+ forever $ do+ (conn, connaddr) <- accept sock+ hConn <- socketToHandle conn ReadWriteMode+ putStrLn $ "connection accepted: " ++ show connaddr+ forkIO $ do+ tunnelPort :: Int <- randomRIO (50000, 55000)+ handleConnection hConn tunnelPort targetPort sshArgs++handleConnection :: Handle -> Int -> Int -> [String] -> IO ()+handleConnection hConn tunnelPort targetPort sshArgs = do+ (_, _, _, p) <- createProcess (proc "ssh" $ ["-v"] ++ [+ "-L" ++ show tunnelPort ++ ":127.0.0.1:" ++ show targetPort, "-n"] +++ sshArgs)+ finally forwardToTunnel $ do+ putStrLn "terminating ssh"+ terminateProcess p+ _ <- waitForProcess p+ putStrLn "ssh exited"+ performGC -- a good moment to finalize handles++ where forwardToTunnel = do+ hTunn <- tryTunnelConnection tunnelPort 15+ _ <- forkIO $ forward "hTunn->hConn" hTunn hConn+ forward "hConn->hTunn" hConn hTunn++ forward desc h1 h2 =+ forever $ do+ bs <- BS.hGetSome h1 4096+ putStrLn $ printf "%s %d bytes" desc (BS.length bs)+ if BS.null bs then+ error "no more data to tunnel"+ else do+ BS.hPut h2 bs+ hFlush h2++tryTunnelConnection :: Int -> Int -> IO Handle+tryTunnelConnection _ 0 = error "can't connect to tunnel"+tryTunnelConnection port attempts = do+ threadDelay (1*1000*1000)+ tunn <- socket AF_INET Stream defaultProtocol+ addr <- inet_addr "127.0.0.1"+ CE.catch (do connect tunn $ SockAddrInet (fromIntegral port) addr+ hTunn <- socketToHandle tunn ReadWriteMode+ putStrLn "got hTunn"+ return hTunn)+ (\(_::SomeException) -> do+ sClose tunn+ tryTunnelConnection port (attempts-1))+