module XMonad.Prompt.Ssh
(
sshPrompt,
Ssh,
) where
import XMonad
import XMonad.Util.Run
import XMonad.Prompt
import System.Directory
import System.Environment
import Control.Exception as E
import Control.Monad
import Data.Maybe
import Data.List(elemIndex)
econst :: Monad m => a -> IOException -> m a
econst :: a -> IOException -> m a
econst = m a -> IOException -> m a
forall a b. a -> b -> a
const (m a -> IOException -> m a)
-> (a -> m a) -> a -> IOException -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
data Ssh = Ssh
instance XPrompt Ssh where
showXPrompt :: Ssh -> String
showXPrompt Ssh = "SSH to: "
commandToComplete :: Ssh -> String -> String
commandToComplete _ c :: String
c = String
-> ((String, String) -> String) -> Maybe (String, String) -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
c (\(_u :: String
_u,h :: String
h) -> String
h) (String -> Maybe (String, String)
parseHost String
c)
nextCompletion :: Ssh -> String -> [String] -> String
nextCompletion _t :: Ssh
_t c :: String
c l :: [String]
l = String
-> ((String, String) -> String) -> Maybe (String, String) -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
next (\(u :: String
u,_h :: String
_h) -> String
u String -> String -> String
forall a. [a] -> [a] -> [a]
++ "@" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
next) Maybe (String, String)
hostPared
where
hostPared :: Maybe (String, String)
hostPared = String -> Maybe (String, String)
parseHost String
c
next :: String
next = String -> [String] -> String
getNextCompletion (String
-> ((String, String) -> String) -> Maybe (String, String) -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
c (\(_u :: String
_u,h :: String
h) -> String
h) Maybe (String, String)
hostPared) [String]
l
sshPrompt :: XPConfig -> X ()
sshPrompt :: XPConfig -> X ()
sshPrompt c :: XPConfig
c = do
[String]
sc <- IO [String] -> X [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO [String]
sshComplList
Ssh -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
mkXPrompt Ssh
Ssh XPConfig
c ([String] -> ComplFunction
mkComplFunFromList [String]
sc) String -> X ()
ssh
ssh :: String -> X ()
ssh :: String -> X ()
ssh = String -> String -> X ()
runInTerm "" (String -> X ()) -> (String -> String) -> String -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("ssh " String -> String -> String
forall a. [a] -> [a] -> [a]
++ )
sshComplList :: IO [String]
sshComplList :: IO [String]
sshComplList = [String] -> [String]
forall a. Ord a => [a] -> [a]
uniqSort ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ([String] -> [String] -> [String])
-> IO [String] -> IO [String] -> IO [String]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
(++) IO [String]
sshComplListLocal IO [String]
sshComplListGlobal
sshComplListLocal :: IO [String]
sshComplListLocal :: IO [String]
sshComplListLocal = do
String
h <- String -> IO String
getEnv "HOME"
[String]
s1 <- ComplFunction
sshComplListFile ComplFunction -> ComplFunction
forall a b. (a -> b) -> a -> b
$ String
h String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/.ssh/known_hosts"
[String]
s2 <- ComplFunction
sshComplListConf ComplFunction -> ComplFunction
forall a b. (a -> b) -> a -> b
$ String
h String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/.ssh/config"
[String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ [String]
s1 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
s2
sshComplListGlobal :: IO [String]
sshComplListGlobal :: IO [String]
sshComplListGlobal = do
String
env <- String -> IO String
getEnv "SSH_KNOWN_HOSTS" IO String -> (IOException -> IO String) -> IO String
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` String -> IOException -> IO String
forall (m :: * -> *) a. Monad m => a -> IOException -> m a
econst "/nonexistent"
[Maybe String]
fs <- (String -> IO (Maybe String)) -> [String] -> IO [Maybe String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (Maybe String)
fileExists [ String
env
, "/usr/local/etc/ssh/ssh_known_hosts"
, "/usr/local/etc/ssh_known_hosts"
, "/etc/ssh/ssh_known_hosts"
, "/etc/ssh_known_hosts"
]
case [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes [Maybe String]
fs of
[] -> [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []
(f :: String
f:_) -> ComplFunction
sshComplListFile' String
f
sshComplListFile :: String -> IO [String]
sshComplListFile :: ComplFunction
sshComplListFile kh :: String
kh = do
Bool
f <- String -> IO Bool
doesFileExist String
kh
if Bool
f then ComplFunction
sshComplListFile' String
kh
else [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []
sshComplListFile' :: String -> IO [String]
sshComplListFile' :: ComplFunction
sshComplListFile' kh :: String
kh = do
String
l <- String -> IO String
readFile String
kh
[String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
getWithPort (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ',') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take 1 ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words)
([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
nonComment
([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
l
sshComplListConf :: String -> IO [String]
sshComplListConf :: ComplFunction
sshComplListConf kh :: String
kh = do
Bool
f <- String -> IO Bool
doesFileExist String
kh
if Bool
f then ComplFunction
sshComplListConf' String
kh
else [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []
sshComplListConf' :: String -> IO [String]
sshComplListConf' :: ComplFunction
sshComplListConf' kh :: String
kh = do
String
l <- String -> IO String
readFile String
kh
[String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> Int -> String
forall a. [a] -> Int -> a
!!1)
([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ ([String] -> Bool) -> [[String]] -> [[String]]
forall a. (a -> Bool) -> [a] -> [a]
filter [String] -> Bool
isHost
([[String]] -> [[String]]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> a -> b
$ (String -> [String]) -> [String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map String -> [String]
words
([String] -> [[String]]) -> [String] -> [[String]]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
l
where
isHost :: [String] -> Bool
isHost ws :: [String]
ws = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take 1 [String]
ws [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== ["Host"] Bool -> Bool -> Bool
&& [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ws Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1
fileExists :: String -> IO (Maybe String)
fileExists :: String -> IO (Maybe String)
fileExists kh :: String
kh = do
Bool
f <- String -> IO Bool
doesFileExist String
kh
if Bool
f then Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
kh
else Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
nonComment :: String -> Bool
[] = Bool
False
nonComment ('#':_) = Bool
False
nonComment ('|':_) = Bool
False
nonComment _ = Bool
True
getWithPort :: String -> String
getWithPort :: String -> String
getWithPort ('[':str :: String
str) = String
host String -> String -> String
forall a. [a] -> [a] -> [a]
++ " -p " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
port
where (host :: String
host,p :: String
p) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==']') String
str
port :: String
port = case String
p of
']':':':x :: String
x -> String
x
_ -> "22"
getWithPort str :: String
str = String
str
parseHost :: String -> Maybe (String, String)
parseHost :: String -> Maybe (String, String)
parseHost a :: String
a = Char -> String -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex '@' String
a Maybe Int
-> (Int -> Maybe (String, String)) -> Maybe (String, String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\c :: Int
c-> (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just ( (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
c String
a), (Int -> String -> String
forall a. Int -> [a] -> [a]
drop (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) String
a) ) )