vado (empty) → 0.0.1
raw patch · 7 files changed
+457/−0 lines, 7 filesdep +QuickCheckdep +attoparsecdep +basesetup-changed
Dependencies added: QuickCheck, attoparsec, base, directory, filepath, process, text
Files
- LICENSE +21/−0
- Setup.lhs +6/−0
- src/Main.hs +54/−0
- src/System/Process/Vado.hs +199/−0
- src/Test.hs +44/−0
- src/Vamount.hs +79/−0
- vado.cabal +54/−0
+ LICENSE view
@@ -0,0 +1,21 @@+Copyright (c) 2013 Hamish Mackenzie++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.+
+ Setup.lhs view
@@ -0,0 +1,6 @@+#!/usr/bin/runhaskell +> module Main where+> import Distribution.Simple+> main :: IO ()+> main = defaultMain+
+ src/Main.hs view
@@ -0,0 +1,54 @@+-----------------------------------------------------------------------------+--+-- Module : Main+-- Copyright : Hamish Mackenzie+-- License : MIT+--+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+-- Stability : Experimental+-- Portability : Unknown+--+-- | Lets you quickly run ssh on a machine that you have an sshfs connection+-- to. It works out the username, host and the directory on the host based+-- on the current directory and the output of 'mount'+--+-----------------------------------------------------------------------------++module Main (+ main+) where++import System.IO (hPutStrLn, stderr)+import System.Directory (getCurrentDirectory)+import System.Environment (getArgs)+import Data.List (isPrefixOf)+import System.Exit (exitWith, ExitCode(..))+import System.Process (rawSystem)+import System.Process.Vado (getMountPoint, vado, readSettings, defMountSettings)++-- | Main function for vado+main = do+ args <- getArgs+ case span ("-" `isPrefixOf`) args of+ (sshopts,cmd:rest) -> do+ currentDir <- getCurrentDirectory+ mbMountPoint <- getMountPoint currentDir+ ms <- readSettings+ case mbMountPoint of+ Left mp -> vado mp ms currentDir sshopts cmd rest+ >>= rawSystem "ssh" >>= exitWith+ Right err -> hPutStrLn stderr err >> (exitWith $ ExitFailure 1)+ _ -> do+ defSettings <- defMountSettings+ hPutStrLn stderr $+ "Usage vado [ssh options] command [args]\n\n"++ ++ "The command will be run in the directoy on the remote\n"+ ++ "machine that corrisponds to the current directory locally.\n\n"++ ++ "The ssh options must start with a dash '-'.\n"+ ++ "You can specify port and key location settings\n"+ ++ "in the ~/.vadosettings file.\nExample contents:\n"+ ++ show [defSettings]+ exitWith $ ExitFailure 1+
+ src/System/Process/Vado.hs view
@@ -0,0 +1,199 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP #-}+-----------------------------------------------------------------------------+--+-- Module : System.Process.Vado+-- Copyright : Hamish Mackenzie+-- License : MIT+--+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+-- Stability : Experimental+-- Portability : Unknown+--+-- | Lets you quickly run ssh on a machine that you have an sshfs connection+-- to. It works out the username, host and the directory on the host based+-- on the current directory and the output of 'mount'+--+-----------------------------------------------------------------------------++module System.Process.Vado (+ MountPoint(..)+ , parseMountPoint+ , getMountPoint+ , MountSettings(..)+ , readSettings+ , defMountSettings+ , vado+ , vamount+) where++import Prelude hiding (null)+import Control.Applicative ((<$>), (<*), (*>), (<|>))+import Data.Text (pack, unpack, Text, null)+import Data.List (isPrefixOf, find)+import Data.Monoid (mconcat, mappend)+import Data.Attoparsec.Text (parseOnly, string, Parser, IResult(..), option)+import qualified Data.Attoparsec.Text as P (takeWhile1)+import Data.Text.IO (hPutStrLn)+import System.FilePath (addTrailingPathSeparator, makeRelative, (</>))+import Data.Maybe (mapMaybe, fromMaybe)+#if MIN_VERSION_base(4,6,0)+import Text.Read (readMaybe)+#else+import Text.Read (reads)+#endif+import System.Exit (ExitCode)+import System.Process (readProcess)+import System.Directory (getHomeDirectory, getCurrentDirectory, doesFileExist)++#if !MIN_VERSION_base(4,6,0)+-- | Parse a string using the 'Read' instance.+-- Succeeds if there is exactly one valid result.+readMaybe :: Read a => String -> Maybe a+readMaybe s = case reads s of+ [(x, "")] -> Just x+ _ -> Nothing+#endif++-- | Remote file system mount point+data MountPoint = MountPoint {+ remoteUser :: Text -- ^ Account used on remote machine+ , remoteHost :: Text -- ^ Host name or address of the remote machine+ , remoteDir :: FilePath -- ^ Directory on remote machine+ , localDir :: FilePath -- ^ Where it is mounted on this machine+ } deriving (Ord, Eq)++instance Show MountPoint where+ show MountPoint {..} = unpack (mconcat [remoteUser, "@", remoteHost, ":"])+ ++ remoteDir ++ " on " ++ localDir ++ " "++-- | Mount point settings+data MountSettings = MountSettings {+ sshfsUser :: Text+ , sshfsHost :: Text+ , sshfsPort :: Int+ , idFile :: FilePath+ } deriving (Show, Read)++-- | Default mount settings for vagrant+defMountSettings :: IO MountSettings+defMountSettings = do+ homeDir <- getHomeDirectory+ return MountSettings {+ sshfsUser = "vagrant"+ , sshfsHost = "127.0.0.1"+ , sshfsPort = 2222+ , idFile = homeDir </> ".vagrant.d/insecure_private_key"+ }+++-- | Parser for a line of output from the 'mount' command+mountPointParser :: Parser MountPoint+mountPointParser = do+ remoteUser <- option "" (P.takeWhile1 (/= '@') <* string "@")+ remoteHost <- (string "[" *> P.takeWhile1 (/= ']') <* string "]") <|> P.takeWhile1 (/= ':')+ string ":"+ remoteDir <- unpack <$> P.takeWhile1 (/= ' ')+ string " on "+ localDir <- unpack <$> P.takeWhile1 (/= ' ')+ return MountPoint{..}++-- | Parses a line looking for a remote mount point+parseMountPoint :: String -- ^ line of output fromt he 'mount' command+ -> Maybe MountPoint+parseMountPoint = done . parseOnly mountPointParser . pack+ where+ done (Right x) = Just x+ done _ = Nothing++-- | Run 'mount' and look up the mount point relating to the+-- directory in the output+getMountPoint :: FilePath -- ^ Local directory to find the mount point+ -> IO (Either MountPoint String) -- ^ Details of the mount point or an error string+getMountPoint dir = do+ let dir' = addTrailingPathSeparator dir+ -- Run 'mount' and find the remote mount points+ mountPoints <- mapMaybe parseMountPoint . lines <$>+ readProcess "mount" [] ""+ -- Find mount point that matches the current directory+ case filter ((`isPrefixOf` dir')+ . addTrailingPathSeparator+ . localDir) mountPoints of+ [mp] -> return $ Left mp+ _ -> return . Right $ "Mount point not found for the current directory ("+ ++ dir ++ ")\n\n"+ ++ case mountPoints of+ [] -> "No remote mount points found in output of 'mount'"+ _ -> "The following remote mount points were not suitable\n"+ ++ concatMap (\mp -> " " ++ show mp ++ "\n") mountPoints+++-- | Read a list of predefined mount points from the+-- ~/.vadosettings files+readSettings :: IO [MountSettings]+readSettings = do+ homeDir <- getHomeDirectory+ settings :: Maybe [MountSettings] <- do+ let settingsFile = homeDir </> ".vadosettings"+ exists <- doesFileExist settingsFile+ if exists+ then readMaybe <$> readFile settingsFile+ else return Nothing+ defaultSettings <- defMountSettings+ return $ fromMaybe [defaultSettings] settings++-- | Get a list of arguments to pass to ssh to run command on a remote machine+-- in the directory that is mounted locally+vado :: MountPoint -- ^ Mount point found using 'getMountPoint'+ -> [MountSettings] -- ^ SSH settings from the '.vadosettings' files+ -> FilePath -- ^ Local directory you want the command to run in.+ -- Normally this will be the same directory+ -- you passed to 'getMountPoint'.+ -- The vado will run the command in the remote+ -- directory that maps to this one.+ -> [String] -- ^ Options to pass to ssh. If the mount point is 'vagrant@127.0.0.1'+ -- then the most common vagrant connection options+ -- ('-p2222' and '-i~/.vagrant.d/insecure_private_key')+ -- are included automatically+ -> FilePath -- ^ Command to run+ -> [String] -- ^ Arguments to pass to the command+ -> IO [String] -- ^ Full list of arguments that should be passed to ssh+vado MountPoint{..} settings cwd sshopts cmd args = do+ homeDir <- getHomeDirectory+ -- Work out where the current directory is on the remote machine+ let destinationDir = remoteDir </> makeRelative localDir cwd+ -- Run ssh with+ return $+ [unpack $ (if null remoteUser then "" else remoteUser `mappend` "@")+ `mappend` remoteHost]+ ++ case find (\MountSettings{..} ->+ remoteUser == sshfsUser+ && remoteHost == sshfsHost) settings of+ Just MountSettings{..} ->+ [ "-p" ++ show sshfsPort+ , "-i" ++ idFile ]+ Nothing -> []+ ++ sshopts+ ++ ["cd", translate destinationDir, "&&", cmd]+ ++ args+ where+ translate str = '\'' : foldr escape "'" str+ where escape '\'' = showString "'\\''"+ escape c = showChar c++-- | Get a list of arguments to pass to sshfs to+-- mount a remote filesystem in the given directory+vamount :: MountSettings -- ^ Mount settings to use+ -> FilePath -- ^ Remote directory to mount+ -> FilePath -- ^ Local directory (where to mount)+ -> [String] -- ^ Other options to pass to sshfs+ -> [String] -- ^ Resulting list of arguments+vamount MountSettings{..} remoteDir localDir opts =+ [ unpack $ mconcat+ [ sshfsUser, "@", sshfsHost+ , ":", pack remoteDir]+ , localDir+ , "-p" ++ show sshfsPort+ , "-oIdentityFile=" ++ idFile ] ++ opts
+ src/Test.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RecordWildCards #-}+-----------------------------------------------------------------------------+--+-- Module : Main (for tests)+-- Copyright : Hamish Mackenzie+-- License : BSD+--+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+-- Stability : Experimental+-- Portability : Unknown+--+-- |+--+-----------------------------------------------------------------------------++module Main (+ main+) where++import Control.Monad (unless)+import Control.Applicative ((<$>))+import System.Exit (exitFailure)+import Test.QuickCheck (Arbitrary(..), elements, listOf1)+import Test.QuickCheck.All (quickCheckAll)+import Data.Text (pack)+import System.Process.Vado (MountPoint(..), parseMountPoint)++instance Arbitrary MountPoint where+ arbitrary = do+ let nameChars = ['A'..'Z'] ++ ['a' .. 'z'] ++ ['0'..'1'] ++ "_."+ remoteUser <- pack <$> listOf1 (elements nameChars)+ remoteHost <- pack <$> listOf1 (elements nameChars)+ remoteDir <- listOf1 (elements $ '/':nameChars)+ localDir <- listOf1 (elements $ '/':nameChars)+ return MountPoint{..}++prop_MountPointParses mp = parseMountPoint (show mp) == Just mp++-- | Entry point for unit tests.+main = do+ allPass <- $quickCheckAll -- Run QuickCheck on all prop_ functions+ unless allPass exitFailure+
+ src/Vamount.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE CPP #-}+-----------------------------------------------------------------------------+--+-- Module : Main+-- Copyright : Hamish Mackenzie & Dan Frumin+-- License : MIT+--+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+-- Stability : Experimental+-- Portability : Unknown+--+-- | Lets you quickly mount sshfs file systems based on .vadosettings files,+-- for future use with 'vado'+--+-----------------------------------------------------------------------------++module Main (+ main+) where++import Control.Monad (when)+import System.IO (hPutStrLn, stderr)+import System.Directory (getCurrentDirectory)+import System.Environment (getArgs)+import Data.List (isPrefixOf)+import Data.Maybe (fromMaybe)+import System.Exit (exitWith, ExitCode(..))+import System.Process (rawSystem)+import System.Process.Vado (getMountPoint, vado,+ readSettings, defMountSettings, vamount)+#if MIN_VERSION_base(4,6,0)+import Text.Read (readMaybe)+#else+import Text.Read (reads)+#endif++#if !MIN_VERSION_base(4,6,0)+-- | Parse a string using the 'Read' instance.+-- Succeeds if there is exactly one valid result.+readMaybe :: Read a => String -> Maybe a+readMaybe s = case reads s of+ [(x, "")] -> Just x+ _ -> Nothing+#endif ++-- | Main function for vamount+main = do+ args <- getArgs+ case span ("-" `isPrefixOf`) args of+ (sshfsopts,path:rest) -> do+ currentDir <- getCurrentDirectory+ ms <- readSettings+ defSettings <- defMountSettings+ let profileNum + | null rest = 0+ | otherwise = fromMaybe 0 (readMaybe (head rest))+ when (length ms < profileNum || profileNum < 0) printUsage+ let profile = if profileNum == 0+ then defSettings+ else ms !! (profileNum - 1)+ rawSystem "sshfs" (vamount profile path currentDir sshfsopts)+ >>= exitWith+ _ -> printUsage+ +printUsage :: IO ()+printUsage = do+ defSettings <- defMountSettings+ hPutStrLn stderr $+ "Usage vamount [ssh options] remote_path [profile #]\n\n"+ ++ "The remote_path from the remote server specified\n"+ ++ "in the ~/.vadosettings file under number [profile #]\n"+ ++ "will be mounted in the current directory using sshfs\n\n"+ ++ "The ssh options must start with a dash '-'.\n"+ ++ "The profile number count starts from 1.\n"+ ++ "If the [profile #] is absent or is 0 then \n"+ ++ "the default configuration will be used:\n"+ ++ show [defSettings]+ exitWith $ ExitFailure 1+
+ vado.cabal view
@@ -0,0 +1,54 @@+name: vado+version: 0.0.1+cabal-version: >=1.8+build-type: Simple+license: MIT+license-file: LICENSE+maintainer: Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+homepage: https://github.com/hamishmack/vado+package-url: https://github.com/hamishmack/vado+synopsis: Runs commands on remote machines using ssh+description: Lets you quickly run ssh on a machine that you have an sshfs connection to.+ It works out the username, host and the directory on the host based on the current directory and the output of 'mount'.+category: Development+author: Hamish Mackenzie++Source-Repository head+ type: git+ location: https://github.com/hamishmack/vado.git++library+ build-depends: base >=4.0.0.0 && <4.8, attoparsec >=0.10.4.0 && <0.12,+ directory >=1.1.0.0 && <1.3, filepath >=1.2.0.0 && <1.4,+ process >=1.0.1.5 && <1.3, text >=0.11.3.1 && <1.2+ exposed-modules: System.Process.Vado+ exposed: True+ buildable: True+ hs-source-dirs: src++executable vado+ build-depends: base >=4.0.0.0 && <4.8, attoparsec >=0.10.4.0 && <0.12,+ directory >=1.1.0.0 && <1.3, filepath >=1.2.0.0 && <1.4,+ process >=1.0.1.5 && <1.3, text >=0.11.3.1 && <1.2+ main-is: Main.hs+ buildable: True+ hs-source-dirs: src+ other-modules: System.Process.Vado++executable vamount+ build-depends: base >=4.0.0.0 && <4.8, attoparsec >=0.10.4.0 && <0.12,+ directory >=1.1.0.0 && <1.3, filepath >=1.2.0.0 && <1.4,+ process >=1.0.1.5 && <1.3, text >=0.11.3.1 && <1.2+ main-is: Vamount.hs+ buildable: True+ hs-source-dirs: src+ other-modules: System.Process.Vado+ +test-suite test-vado+ build-depends: base >=4.0.0.0 && <4.8, QuickCheck -any, attoparsec >=0.10.4.0 && <0.12,+ directory >=1.1.0.0 && <1.3, filepath >=1.2.0.0 && <1.4,+ process >=1.0.1.5 && <1.3, text >=0.11.3.1 && <1.2+ type: exitcode-stdio-1.0+ main-is: Test.hs+ buildable: True+ hs-source-dirs: src