-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Prompt.Ssh
-- Description :  An ssh prompt.
-- Copyright   :  (C) 2007 Andrea Rossato
-- License     :  BSD3
--
-- Maintainer  :  andrea.rossato@unibz.it
-- Stability   :  unstable
-- Portability :  unportable
--
-- A ssh prompt for XMonad
--
-----------------------------------------------------------------------------

module XMonad.Prompt.Ssh
    ( -- * Usage
      -- $usage
      sshPrompt,
      Ssh,
    ) where

import XMonad
import XMonad.Prelude
import XMonad.Util.Run
import XMonad.Prompt

import System.Directory
import System.Environment
import Control.Exception as E

econst :: Monad m => a -> IOException -> m a
econst :: forall (m :: * -> *) a. Monad m => a -> IOException -> m a
econst = forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return

-- $usage
-- 1. In your @xmonad.hs@:
--
-- > import XMonad.Prompt
-- > import XMonad.Prompt.Ssh
--
-- 2. In your keybindings add something like:
--
-- >   , ((modm .|. controlMask, xK_s), sshPrompt def)
--
-- Keep in mind, that if you want to use the completion you have to
-- disable the \"HashKnownHosts\" option in your ssh_config
--
-- For detailed instruction on editing the key binding see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.

data Ssh = Ssh

instance XPrompt Ssh where
    showXPrompt :: Ssh -> String
showXPrompt       Ssh
Ssh = String
"SSH to: "
    commandToComplete :: Ssh -> String -> String
commandToComplete Ssh
_ String
c = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
c forall a b. (a, b) -> b
snd (String -> Maybe (String, String)
parseHost String
c)
    nextCompletion :: Ssh -> String -> [String] -> String
nextCompletion Ssh
_t String
c [String]
l = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
next (\(String
u,String
_h) -> String
u forall a. [a] -> [a] -> [a]
++ 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 (forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
c forall a b. (a, b) -> b
snd Maybe (String, String)
hostPared) [String]
l

sshPrompt :: XPConfig -> X ()
sshPrompt :: XPConfig -> X ()
sshPrompt XPConfig
c = do
  [String]
sc <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO [String]
sshComplList
  forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
mkXPrompt Ssh
Ssh XPConfig
c (XPConfig -> [String] -> ComplFunction
mkComplFunFromList XPConfig
c [String]
sc) String -> X ()
ssh

ssh :: String -> X ()
ssh :: String -> X ()
ssh = String -> String -> X ()
runInTerm String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"ssh " forall a. [a] -> [a] -> [a]
++ )

sshComplList :: IO [String]
sshComplList :: IO [String]
sshComplList = forall a. Ord a => [a] -> [a]
uniqSort forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 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 String
"HOME"
  [String]
s1 <- ComplFunction
sshComplListFile forall a b. (a -> b) -> a -> b
$ String
h forall a. [a] -> [a] -> [a]
++ String
"/.ssh/known_hosts"
  [String]
s2 <- ComplFunction
sshComplListConf forall a b. (a -> b) -> a -> b
$ String
h forall a. [a] -> [a] -> [a]
++ String
"/.ssh/config"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String]
s1 forall a. [a] -> [a] -> [a]
++ [String]
s2

sshComplListGlobal :: IO [String]
sshComplListGlobal :: IO [String]
sshComplListGlobal = do
  String
env <- String -> IO String
getEnv String
"SSH_KNOWN_HOSTS" forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` forall (m :: * -> *) a. Monad m => a -> IOException -> m a
econst String
"/nonexistent"
  [Maybe String]
fs <- 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
                        , String
"/usr/local/etc/ssh/ssh_known_hosts"
                        , String
"/usr/local/etc/ssh_known_hosts"
                        , String
"/etc/ssh/ssh_known_hosts"
                        , String
"/etc/ssh_known_hosts"
                        ]
  case forall a. [Maybe a] -> [a]
catMaybes [Maybe String]
fs of
    []    -> forall (m :: * -> *) a. Monad m => a -> m a
return []
    (String
f:[String]
_) -> ComplFunction
sshComplListFile' String
f

sshComplListFile :: String -> IO [String]
sshComplListFile :: ComplFunction
sshComplListFile String
kh = do
  Bool
f <- String -> IO Bool
doesFileExist String
kh
  if Bool
f then ComplFunction
sshComplListFile' String
kh
       else forall (m :: * -> *) a. Monad m => a -> m a
return []

sshComplListFile' :: String -> IO [String]
sshComplListFile' :: ComplFunction
sshComplListFile' String
kh = do
  String
l <- String -> IO String
readFile String
kh
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (String -> String
getWithPort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
',') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words)
         forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
nonComment
         forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
l

sshComplListConf :: String -> IO [String]
sshComplListConf :: ComplFunction
sshComplListConf String
kh = do
  Bool
f <- String -> IO Bool
doesFileExist String
kh
  if Bool
f then ComplFunction
sshComplListConf' String
kh
       else forall (m :: * -> *) a. Monad m => a -> m a
return []

sshComplListConf' :: String -> IO [String]
sshComplListConf' :: ComplFunction
sshComplListConf' String
kh = do
  String
l <- String -> IO String
readFile String
kh
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> Int -> a
!!Int
1)
         forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter [String] -> Bool
isHost
         forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> [String]
words
         forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
l
 where
   isHost :: [String] -> Bool
isHost [String]
ws = forall a. Int -> [a] -> [a]
take Int
1 [String]
ws forall a. Eq a => a -> a -> Bool
== [String
"Host"] Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ws forall a. Ord a => a -> a -> Bool
> Int
1

fileExists :: String -> IO (Maybe String)
fileExists :: String -> IO (Maybe String)
fileExists String
kh = do
  Bool
f <- String -> IO Bool
doesFileExist String
kh
  if Bool
f then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just String
kh
       else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

nonComment :: String -> Bool
nonComment :: String -> Bool
nonComment []      = Bool
False
nonComment (Char
'#':String
_) = Bool
False
nonComment (Char
'|':String
_) = Bool
False -- hashed, undecodeable
nonComment String
_       = Bool
True

getWithPort :: String -> String
getWithPort :: String -> String
getWithPort (Char
'[':String
str) = String
host forall a. [a] -> [a] -> [a]
++ String
" -p " forall a. [a] -> [a] -> [a]
++ String
port
    where (String
host,String
p) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
==Char
']') String
str
          port :: String
port = case String
p of
                   Char
']':Char
':':String
x -> String
x
                   String
_         -> String
"22"
getWithPort  String
str = String
str

parseHost :: String -> Maybe (String, String)
parseHost :: String -> Maybe (String, String)
parseHost String
a = forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Char
'@' String
a  forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Int
c-> forall a. a -> Maybe a
Just ( forall a. Int -> [a] -> [a]
take Int
c String
a, forall a. Int -> [a] -> [a]
drop (Int
cforall a. Num a => a -> a -> a
+Int
1) String
a ) )