From 920df251756c5de589f3a012778b714c32aac76b Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 3 Jul 2015 22:49:07 +0200 Subject: Additional xmonad libs --- .xmonad/lib/XMonad/Prompt/MyShell.hs | 105 +++++++++++++++ .xmonad/lib/XMonad/Prompt/MySsh.hs | 241 +++++++++++++++++++++++++++++++++++ .xmonad/xmonad.hs | 24 +++- 3 files changed, 367 insertions(+), 3 deletions(-) create mode 100644 .xmonad/lib/XMonad/Prompt/MyShell.hs create mode 100644 .xmonad/lib/XMonad/Prompt/MySsh.hs (limited to '.xmonad') diff --git a/.xmonad/lib/XMonad/Prompt/MyShell.hs b/.xmonad/lib/XMonad/Prompt/MyShell.hs new file mode 100644 index 0000000..c268f87 --- /dev/null +++ b/.xmonad/lib/XMonad/Prompt/MyShell.hs @@ -0,0 +1,105 @@ +module XMonad.Prompt.MyShell + ( Shell (..) + , shellPrompt + , prompt + , safePrompt + , unsafePrompt + , getCommands + , getShellCompl + , split + ) where + +import Codec.Binary.UTF8.String (encodeString) +import Control.Exception as E +import Control.Monad (forM) +import Data.List (isPrefixOf) +import System.Directory (doesDirectoryExist, getDirectoryContents) +import System.Environment (getEnv) +import System.Posix.Files (getFileStatus, isDirectory) + +import XMonad hiding (config) +import XMonad.Prompt +import XMonad.Util.Run + +econst :: Monad m => a -> IOException -> m a +econst = const . return + +data Shell = Shell String + +instance XPrompt Shell where + showXPrompt (Shell q) = q + completionToCommand _ = escape + +shellPrompt :: String -> XPConfig -> X () +shellPrompt q c = do + cmds <- io getCommands + mkXPrompt (Shell q) c (getShellCompl cmds) spawn + +{- $spawns + See safe and unsafeSpawn in "XMonad.Util.Run". + prompt is an alias for safePrompt; + safePrompt and unsafePrompt work on the same principles, but will use + XPrompt to interactively query the user for input; the appearance is + set by passing an XPConfig as the second argument. The first argument + is the program to be run with the interactive input. + You would use these like this: + + > , ((modm, xK_b), safePrompt "firefox" greenXPConfig) + > , ((modm .|. shiftMask, xK_c), prompt ("xterm" ++ " -e") greenXPConfig) + + Note that you want to use safePrompt for Firefox input, as Firefox + wants URLs, and unsafePrompt for the XTerm example because this allows + you to easily start a terminal executing an arbitrary command, like + 'top'. -} + +prompt, unsafePrompt, safePrompt :: String -> FilePath -> XPConfig -> X () +prompt = unsafePrompt +safePrompt q c config = mkXPrompt (Shell q) config (getShellCompl [c]) run + where run = safeSpawn c . return +unsafePrompt q c config = mkXPrompt (Shell q) config (getShellCompl [c]) run + where run a = unsafeSpawn $ c ++ " " ++ a + +getShellCompl :: [String] -> String -> IO [String] +getShellCompl cmds s | s == "" || last s == ' ' = return [] + | otherwise = do + f <- fmap lines $ runProcessWithInput "bash" [] ("compgen -A file -- " + ++ s ++ "\n") + files <- case f of + [x] -> do fs <- getFileStatus (encodeString x) + if isDirectory fs then return [x ++ "/"] + else return [x] + _ -> return f + return . uniqSort $ files ++ commandCompletionFunction cmds s + +commandCompletionFunction :: [String] -> String -> [String] +commandCompletionFunction cmds str | '/' `elem` str = [] + | otherwise = filter (isPrefixOf str) cmds + +getCommands :: IO [String] +getCommands = do + p <- getEnv "PATH" `E.catch` econst [] + let ds = filter (/= "") $ split ':' p + es <- forM ds $ \d -> do + exists <- doesDirectoryExist d + if exists + then getDirectoryContents d + else return [] + return . uniqSort . filter ((/= '.') . head) . concat $ es + +split :: Eq a => a -> [a] -> [[a]] +split _ [] = [] +split e l = + f : split e (rest ls) + where + (f,ls) = span (/=e) l + rest s | s == [] = [] + | otherwise = tail s + +escape :: String -> String +escape [] = "" +escape (x:xs) + | isSpecialChar x = '\\' : x : escape xs + | otherwise = x : escape xs + +isSpecialChar :: Char -> Bool +isSpecialChar = flip elem " &\\@\"'#?$*()[]{};" diff --git a/.xmonad/lib/XMonad/Prompt/MySsh.hs b/.xmonad/lib/XMonad/Prompt/MySsh.hs new file mode 100644 index 0000000..e6ea042 --- /dev/null +++ b/.xmonad/lib/XMonad/Prompt/MySsh.hs @@ -0,0 +1,241 @@ +module XMonad.Prompt.MySsh + ( -- * Usage + -- $usage + sshPrompt, + Ssh, + Override (..), + mkOverride, + Conn (..), + moshCmd, + moshCmd', + sshCmd, + inTmux, + withEnv + ) where + +import XMonad +import XMonad.Util.Run +import XMonad.Prompt + +import System.Directory +import System.Environment +import qualified Control.Exception as E + +import Control.Monad +import Data.Maybe + +import Text.Parsec.String +import Text.Parsec +import Data.Char (isSpace) + +econst :: Monad m => a -> E.IOException -> m a +econst = const . 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 defaultXPConfig) +-- +-- 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 Override = Override + { oUser :: Maybe String + , oHost :: String + , oPort :: Maybe Int + , oCommand :: Conn -> String + } + +mkOverride = Override { oUser = Nothing, oHost = "", oPort = Nothing, oCommand = sshCmd } +sshCmd c = concat + [ "ssh -t " + , if isJust $ cUser c then (fromJust $ cUser c) ++ "@" else "" + , cHost c + , if isJust $ cPort c then " -p " ++ (show $ fromJust $ cPort c) else "" + , " -- " + , cCommand c + ] +moshCmd c = concat + [ "mosh " + , if isJust $ cUser c then (fromJust $ cUser c) ++ "@" else "" + , cHost c + , if isJust $ cPort c then " --ssh=\"ssh -p " ++ (show $ fromJust $ cPort c) ++ "\"" else "" + , " -- " + , cCommand c + ] +moshCmd' p c = concat + [ "mosh " + , "--server=" ++ p ++ " " + , if isJust $ cUser c then (fromJust $ cUser c) ++ "@" else "" + , cHost c + , if isJust $ cPort c then " --ssh=\"ssh -p " ++ (show $ fromJust $ cPort c) ++ "\"" else "" + , " -- " + , cCommand c + ] +inTmux c = c { cCommand = "tmux new-session \"" ++ (cCommand c) ++ "\"" } +withEnv :: [(String, String)] -> Conn -> Conn +withEnv envs c = c { cCommand = "env" ++ (concat $ map (\(n, v) -> ' ' : (n ++ "=" ++ v)) envs) ++ " " ++ (cCommand c) } + +data Conn = Conn + { cUser :: Maybe String + , cHost :: String + , cPort :: Maybe Int + , cCommand :: String + } deriving (Eq, Show, Read) + +data Ssh = Ssh + +instance XPrompt Ssh where + showXPrompt Ssh = "SSH to: " + commandToComplete _ c = c + nextCompletion _ = getNextCompletion + +toConn :: String -> Maybe Conn +toConn = toConn' . parse connParser "(unknown)" +toConn' :: Either ParseError Conn -> Maybe Conn +toConn' (Left _) = Nothing +toConn' (Right a) = Just a + +connParser :: Parser Conn +connParser = do + spaces + user' <- optionMaybe $ try $ do + str <- many1 $ satisfy (\c -> (not $ isSpace c) && (c /= '@')) + char '@' + return str + host' <- many1 $ satisfy (not . isSpace) + port' <- optionMaybe $ try $ do + space + string "-p" + spaces + int <- many1 digit + (space >> return ()) <|> eof + return $ (read int :: Int) + spaces + command' <- many anyChar + eof + return $ Conn + { cHost = host' + , cUser = user' + , cPort = port' + , cCommand = command' + } + +sshPrompt :: [Override] -> XPConfig -> X () +sshPrompt o c = do + sc <- io sshComplList + mkXPrompt Ssh c (mkComplFunFromList sc) $ ssh o + +ssh :: [Override] -> String -> X () +ssh overrides str = do + let cmd = applyOverrides overrides str + --liftIO $ putStr "SSH Command: " + --liftIO $ putStrLn cmd + runInTerm "" cmd + +applyOverrides :: [Override] -> String -> String +applyOverrides [] str = "ssh " ++ str +applyOverrides (o:os) str = case (applyOverride o str) of + Just str -> str + Nothing -> applyOverrides os str + +applyOverride :: Override -> String -> Maybe String +applyOverride o str = let + conn = toConn str + in + if isNothing conn then Nothing else + case (fromJust conn) `matches` o of + True -> Just $ (oCommand o) (fromJust conn) + False -> Nothing + +matches :: Conn -> Override -> Bool +a `matches` b = and + [ justBool (cUser a) (oUser b) (==) + , (cHost a) == (oHost b) + , justBool (cPort a) (oPort b) (==) + ] + +justBool :: Eq a => Maybe a -> Maybe a -> (a -> a -> Bool) -> Bool +justBool Nothing _ _ = True +justBool _ Nothing _ = True +justBool (Just a) (Just b) match = a `match` b + +sshComplList :: IO [String] +sshComplList = uniqSort `fmap` liftM2 (++) sshComplListLocal sshComplListGlobal + +sshComplListLocal :: IO [String] +sshComplListLocal = do + h <- getEnv "HOME" + s1 <- sshComplListFile $ h ++ "/.ssh/known_hosts" + s2 <- sshComplListConf $ h ++ "/.ssh/config" + return $ s1 ++ s2 + +sshComplListGlobal :: IO [String] +sshComplListGlobal = do + env <- getEnv "SSH_KNOWN_HOSTS" `E.catch` econst "/nonexistent" + fs <- mapM fileExists [ env + , "/usr/local/etc/ssh/ssh_known_hosts" + , "/usr/local/etc/ssh_known_hosts" + , "/etc/ssh/ssh_known_hosts" + , "/etc/ssh_known_hosts" + ] + case catMaybes fs of + [] -> return [] + (f:_) -> sshComplListFile' f + +sshComplListFile :: String -> IO [String] +sshComplListFile kh = do + f <- doesFileExist kh + if f then sshComplListFile' kh + else return [] + +sshComplListFile' :: String -> IO [String] +sshComplListFile' kh = do + l <- readFile kh + return $ map (getWithPort . takeWhile (/= ',') . concat . take 1 . words) + $ filter nonComment + $ lines l + +sshComplListConf :: String -> IO [String] +sshComplListConf kh = do + f <- doesFileExist kh + if f then sshComplListConf' kh + else return [] + +sshComplListConf' :: String -> IO [String] +sshComplListConf' kh = do + l <- readFile kh + return $ map (!!1) + $ filter isHost + $ map words + $ lines l + where + isHost ws = take 1 ws == ["Host"] && length ws > 1 + +fileExists :: String -> IO (Maybe String) +fileExists kh = do + f <- doesFileExist kh + if f then return $ Just kh + else return Nothing + +nonComment :: String -> Bool +nonComment [] = False +nonComment ('#':_) = False +nonComment ('|':_) = False -- hashed, undecodeable +nonComment _ = True + +getWithPort :: String -> String +getWithPort ('[':str) = host ++ " -p " ++ port + where (host,p) = break (==']') str + port = case p of + ']':':':x -> x + _ -> "22" +getWithPort str = str diff --git a/.xmonad/xmonad.hs b/.xmonad/xmonad.hs index cca4df1..f0e443f 100644 --- a/.xmonad/xmonad.hs +++ b/.xmonad/xmonad.hs @@ -40,7 +40,8 @@ import XMonad.Actions.Warp import XMonad.Layout.IM -import XMonad.Prompt.Shell +import XMonad.Prompt.MyShell +import XMonad.Prompt.MySsh wsp :: Int -> WorkspaceId wsp i = case Map.lookup i workspaceNames of @@ -135,6 +136,22 @@ xPConfig = defaultXPConfig { bgColor = "black" , borderColor = "white" } +sshOverrides = map (\h -> mkOverride { oHost = h, oCommand = moshCmd . inTmux } ) + [ + "odin", "odin.asgard.yggdrasil" + , "surtr", "yggdrasil.li", "surtr.yggdrasil.li", "praseodym.org", "surtr.praseodym.org", "surtr.141.li", "141.li" + , "vindler", "vindler.alfheim.yggdrasil" + , "ullr" + ] + ++ + map (\h -> mkOverride { oHost = h, oCommand = moshCmd' "/run/current-system/sw/bin/mosh-server" . withEnv [("TERM", "xterm")] . inTmux} ) + [ "bragi", "bragi.asgard.yggdrasil" + ] + ++ + map (\h -> mkOverride { oHost = h, oCommand = sshCmd . withEnv [("TERM", "xterm")] . inTmux } ) + [ "galois", "galois.praseodym.org" + ] + myKeys' conf = Map.fromList $ -- launch a terminal [ ((modm, xK_Return), spawn $ (XMonad.terminal conf) ++ " -e tmux") @@ -142,8 +159,9 @@ myKeys' conf = Map.fromList $ -- launch dmenu --, ((modm, xK_d ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"") - , ((modm, xK_d ), shellPrompt xPConfig) - , ((modm .|. shiftMask, xK_d ), prompt ("urxvtc" ++ " -e") xPConfig) + , ((modm, xK_d ), shellPrompt "Run: " xPConfig) + , ((modm .|. shiftMask, xK_d ), prompt "Run in Terminal: " ("urxvtc" ++ " -e") xPConfig) + , ((modm, xK_at ), sshPrompt sshOverrides xPConfig) -- close focused window , ((modm .|. shiftMask, xK_q ), kill) -- cgit v1.2.3