diff --git a/README b/README --- a/README +++ b/README @@ -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). diff --git a/on-demand-ssh-tunnel.cabal b/on-demand-ssh-tunnel.cabal --- a/on-demand-ssh-tunnel.cabal +++ b/on-demand-ssh-tunnel.cabal @@ -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 diff --git a/on-demand-ssh-tunnel.hs b/on-demand-ssh-tunnel.hs --- a/on-demand-ssh-tunnel.hs +++ b/on-demand-ssh-tunnel.hs @@ -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 () diff --git a/src/Network/OnDemandSSHTunnel.hs b/src/Network/OnDemandSSHTunnel.hs new file mode 100644 --- /dev/null +++ b/src/Network/OnDemandSSHTunnel.hs @@ -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)) +