on-demand-ssh-tunnel (empty) → 0.1.0.3

raw patch · 5 files changed

+132/−0 lines, 5 filesdep +basedep +bytestringdep +networksetup-changed

Dependencies added: base, bytestring, network, process, random

Files

• LICENSE +22/−0
• README +11/−0
• Setup.hs +2/−0
• on-demand-ssh-tunnel.cabal +22/−0
• on-demand-ssh-tunnel.hs +75/−0

@@ -0,0 +1,22 @@+The MIT License (MIT)++Copyright (c) 2014 Predrag Radovic++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.+

@@ -0,0 +1,11 @@+Example usage:++    $ on-demand-ssh-tunnel 20110 110 -p2222 user@ssh-server ++When something connects to 127.0.0.1:20110 on-demand-ssh-tunnel will+start ssh subprocess++    ssh -v -L random-tunnel-port:127.0.0.1:110 -n -p2222 user@ssh-server++to tunnel communication to POP3 server accessible on port 110 (on+server).

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,22 @@+name:                on-demand-ssh-tunnel+version:             0.1.0.3+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+license:             MIT+license-file:        LICENSE+author:              Predrag Radovic+maintainer:          predrg@gmail.com+copyright:           (c) 2014 Predrag Radovic+category:            Network+build-type:          Simple+extra-source-files:  README+cabal-version:       >=1.10++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:      +  default-language:    Haskell2010

@@ -0,0 +1,75 @@+{-# LANGUAGE ScopedTypeVariables #-}++import System.Environment+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++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))+