ssh-tunnel (empty) → 1.0.0.0

raw patch · 5 files changed

+279/−0 lines, 5 filesdep +basedep +foldldep +http-clientsetup-changed

Dependencies added: base, foldl, http-client, managed, text, transformers, turtle, uuid

Files

LICENSE +30/−0
README.md +29/−0
Setup.hs +2/−0
src/Control/SSH/Tunnel.hs +181/−0
ssh-tunnel.cabal +37/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Anton Gushcha (c) 2016-2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Anton Gushcha nor the names of other-2017+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,29 @@+ssh-tunnel+==========++Small library that allows to create SSH tunnel (SOCKS proxy) from Haskell and proxy+[http-client](http://hackage.haskell.org/package/http-client).++Tunnel is created with:+```+ssh -f -N -M -S <master-socket> -i <pemfile> -L <localport>:127.0.0.1:<remoteport> <user>@<host>+```++Note: that the tunnel is created in background (-f) without a shell on remote host (-N)+and (-M -S <master-socket>) defines special socket that is used to terminate the tunnel.++How to use in your code:+```haskell+import Control.Monad.Managed+import Control.SSH.Tunnel+import Network.HTTP.Client+import Network.HTTP.Client.TLS++with (openSshTunnel config tlsManagerSettings) $ \settings -> do+ manager <- newManager settings+ -- do things with manager+ -- as soon you live the scope, tunnel will be down+```++Also, you can find `addFingerprints` function useful for adding fingerprints to+known hosts on first connect.

+ Setup.hs view

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

+ src/Control/SSH/Tunnel.hs view

@@ -0,0 +1,181 @@+{-# LANGUAGE RecordWildCards #-}+module Control.SSH.Tunnel(+    SshTunnelConfig(..)+  , openSshTunnel+  , addFingerprints+  , SshTunnel+  , makeSshTunnel+  , makeSshTunnelSimple+  , closeSshTunnel+  , saveSshTunnel+  , loadSshTunnel+  ) where++import Control.Concurrent+import Control.Monad.IO.Class+import Control.Monad.Managed+import Data.Monoid+import Data.Text (Text, pack, unpack)+import Data.UUID as UUID+import Data.UUID.V4 as UUID+import GHC.Generics+import Network.HTTP.Client as C+import Turtle+import Prelude hiding (FilePath)++import qualified Control.Foldl as L+import qualified Data.Text as T+import qualified Data.Text.IO as T++-- | Configuration of SSH tunnel+data SshTunnelConfig = SshTunnelConfig {+  sshTunnelKey        :: Text -- ^ Path to ssh pem file+, sshTunnelPort       :: Int -- ^ Port that is used for local ssh proxy+, sshTunnelRemotePort :: Int -- ^ Port that is used on remote machine for vpn manager+, sshTunnelRemoteUser :: Text -- ^ Name of SSH user for tunneling+, sshTunnelRemoteNode :: Text -- ^ Host of SSH tunnel+, sshTunnelTempFolder :: Text -- ^ Place where we can place our temp files+} deriving (Generic, Show, Read)+++-- | Open SSH tunnel and return settings for connection manager+--+-- Tunnel is created with:+-- @+-- ssh -f -N -M -S <master-socket> -i <pemfile> -L <localport>:127.0.0.1:<remoteport> <user>@<host>+-- @+--+-- Note: that the tunnel is created in background (-f) without a shell on remote host (-N)+-- and (-M -S <master-socket>) defines special socket that is used to terminate the tunnel.+--+-- How to use in your code:+-- @+-- import Control.Monad.Managed+-- import Control.SSH.Tunnel+-- import Network.HTTP.Client+-- import Network.HTTP.Client.TLS+--+-- with (openSshTunnel config tlsManagerSettings) $ \settings -> do+--   manager <- newManager settings+--   -- do things with manager+--   -- as soon you live the scope, tunnel will be down+-- @+openSshTunnel :: MonadManaged m => SshTunnelConfig -- ^ Configuration of connection+  -> ManagerSettings -- ^ Your manager settings that would be extended with proxy information+  -> m ManagerSettings -- ^ Extended client manager settings, tunnel termination action is handled by 'MonadManaged'+openSshTunnel cfg settings = fmap fst $ openSshTunnel' cfg settings++-- | Internal version that also returns path to master socket+openSshTunnel' :: MonadManaged m => SshTunnelConfig -- ^ Configuration of connection+  -> ManagerSettings -- ^ Your manager settings that would be extended with proxy information+  -> m (ManagerSettings, Text) -- ^ Extended client manager settings, tunnel termination action is handled by 'MonadManaged'+openSshTunnel' cfg mngSettings = using $ do+  -- open ssh tunnel+  masterSocketName <- genTempName (sshTunnelTempFolder cfg) "ssh_tunnel_master"+  isExists <- testfile $ Turtle.fromText masterSocketName+  when isExists $ rm $ Turtle.fromText masterSocketName+  res <- liftIO $ shell (sshCommand masterSocketName) empty+  case res of +    ExitSuccess -> return ()+    excode -> fail $ "Failed to open SSH tunnel: " <> show excode++  -- configure proxy manager+  let proxySettings = useProxy $ C.Proxy "127.0.0.1" (sshTunnelPort cfg)+  let mngSettings' = managerSetProxy proxySettings mngSettings++  managed $ \k -> do+    r <- k (mngSettings', masterSocketName)+    ExitSuccess <- shell (closeTunnelCmd masterSocketName) empty+    return r+  where+    -- We open ssh in detached mode with master socket to be able to close the tunnel+    sshCommand :: Text -> Text+    sshCommand masterSocketName = "ssh -f -N -M "+      <> "-S \"" <> masterSocketName <> "\" "+      <> "-i \"" <> sshTunnelKey cfg <> "\" "+      <> "-L "+      <> showl (sshTunnelPort cfg) <> ":127.0.0.1:" <> showl (sshTunnelRemotePort cfg) <> " "+      <> sshTunnelRemoteUser cfg <> "@" <> sshTunnelRemoteNode cfg++-- Send exit command over master socket+closeTunnelCmd :: Text -> Text+closeTunnelCmd masterSocketName = "ssh "+  <> "-S \"" <> masterSocketName <> "\" "+  <> " -O exit 127.0.0.1"++-- | Generation of temporary name for a file+genTempName :: MonadIO m => Text -> Text -> m Text+genTempName folder template = do+  uuid <- liftIO UUID.nextRandom+  return $ folder <> "/" <> template <> "-" <> UUID.toText uuid++-- | Handy way to print into text+showl :: Show a => a -> Text+showl = pack . show++-- | SSH tunnel ID that can be used to send commands to it+data SshTunnel = SshTunnel {+  sshTunnelCloseMutex :: MVar ()+, sshTunnelSocketName :: Text+}++-- | Make a SSH tunnel, same as 'openSshTunnel', but handles all 'Managed' monad+-- stuff internally. As soon as 'SshTunnel' value is garbage collected, internal+-- ssh tunnel will be closed. Also you can use 'closeSshTunnel' to manually free+-- resources.+makeSshTunnel :: MonadIO m => SshTunnelConfig -- ^ Configuration of connection+  -> ManagerSettings -- ^ Your manager settings that would be extended with proxy information+  -> m (ManagerSettings, SshTunnel)  -- ^ Extended client manager settings and id that can be used to shut down the tunnel+makeSshTunnel cfg settings = do+  mvar <- liftIO newEmptyMVar+  settVar <- liftIO newEmptyMVar+  _ <- liftIO . forkIO $ with (openSshTunnel' cfg settings) $ \tunnelArgs -> do+    putMVar settVar tunnelArgs+    takeMVar mvar+  (settings', socketName) <- liftIO $ takeMVar settVar+  return (settings', SshTunnel mvar socketName)++-- | Helper, when you don't need manager in 'makeSshTunnelSimple'+makeSshTunnelSimple :: MonadIO m => SshTunnelConfig -> m SshTunnel+makeSshTunnelSimple cfg = fmap snd $ makeSshTunnel cfg defaultManagerSettings++-- | Closes given ssh tunnel, see 'makeSshTunnel'+closeSshTunnel :: MonadIO m => SshTunnel -> m ()+closeSshTunnel = liftIO . flip putMVar () . sshTunnelCloseMutex++-- | Write down info about tunnel into file to be able to close it from other+-- haskell program.+saveSshTunnel :: MonadIO m => FilePath -> SshTunnel -> m ()+saveSshTunnel path SshTunnel{..} = do+  path' <- case Turtle.toText path of+    Left e -> fail $ "saveSshTunnel: cannot convert path to Text " ++ show e+    Right path' -> return $ unpack path'+  liftIO $ T.writeFile path' sshTunnelSocketName++-- | Read saved tunnel from file that was written by 'saveSshTunnel'+loadSshTunnel :: MonadIO m => FilePath -> m SshTunnel+loadSshTunnel path = liftIO $ do+  path' <- case Turtle.toText path of+    Left e -> fail $ "saveSshTunnel: cannot convert path to Text " ++ show e+    Right path' -> return $ unpack path'+  name <- T.readFile path'+  mvar <- liftIO newEmptyMVar+  _ <- liftIO . forkIO $ do+    takeMVar mvar+    ExitSuccess <- shell (closeTunnelCmd name) empty+    return ()+  return $ SshTunnel mvar name++-- | Read remote server fingerprints that can be added to known_hosts+getFingerprints :: MonadIO m => SshTunnelConfig -> m (ExitCode, Text)+getFingerprints SshTunnelConfig{..} = shellStrict ("ssh-keyscan -t rsa " <> sshTunnelRemoteNode) empty++-- | Add server fingerprints to given path+addFingerprints :: MonadIO m => SshTunnelConfig -> FilePath -> m ()+addFingerprints cfg path = liftIO $ do +  (res, fingers) <- getFingerprints cfg +  case res of +    ExitSuccess -> return ()+    _ -> fail $ "Failed to read fingerprints: " <> show res+  cnt <- readTextFile path +  writeTextFile path $ cnt <> fingers

+ ssh-tunnel.cabal view

@@ -0,0 +1,37 @@+name:                ssh-tunnel+version:             1.0.0.0+synopsis:            Proxy http-client via ssh tunnel.+description:         Please see README.md+homepage:            https://github.com/githubuser/ssh-tunnel#readme+license:             BSD3+license-file:        LICENSE+author:                Anton Gushcha <ncrashed@gmail.com>+                     , Anatoliy Nardid <nazgul17@gmail.com>+maintainer:          ncrashed@gmail.com+copyright:           2016-2017 Anton Gushcha+category:            Web+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:+    Control.SSH.Tunnel+  build-depends:+      base            >= 4.7    && < 5+    , foldl           >= 1.1    && < 1.3+    , http-client     >= 0.4    && < 0.6+    , managed         >= 1.0    && < 1.1+    , text            >= 1.2    && < 1.3+    , transformers    >= 0.4    && < 0.6+    , turtle          >= 1.2    && < 1.4+    , uuid            >= 1.3    && < 1.4+  default-language:    Haskell2010+  default-extensions:+    DeriveGeneric+    OverloadedStrings++source-repository head+  type:     git+  location: https://github.com/Teaspot-Studio/ssh-tunnel