    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Prompt.Ssh
    -- 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.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

    -- $usage
    -- 1. In your @~\/.xmonad\/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
    -- "XMonad.Doc.Extending#Editing_key_bindings".

    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
    nonComment :: String -> Bool
    nonComment []      = Bool
    False
    nonComment ('#':_) = Bool
    False
    nonComment ('|':_) = Bool
    False -- hashed, undecodeable
    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) ) )