From 4a3d2a8ddaf4e546df360656bc54b2947bdb890b Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sun, 3 Jan 2021 00:55:29 +0100 Subject: gkleen@sif: import --- .../gkleen@sif/xmonad/lib/XMonad/Prompt/MyPass.hs | 94 ++++++++ .../gkleen@sif/xmonad/lib/XMonad/Prompt/MyShell.hs | 105 +++++++++ .../gkleen@sif/xmonad/lib/XMonad/Prompt/MySsh.hs | 243 +++++++++++++++++++++ 3 files changed, 442 insertions(+) create mode 100644 accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyPass.hs create mode 100644 accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyShell.hs create mode 100644 accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MySsh.hs (limited to 'accounts/gkleen@sif/xmonad/lib/XMonad/Prompt') diff --git a/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyPass.hs b/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyPass.hs new file mode 100644 index 00000000..1caefae5 --- /dev/null +++ b/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyPass.hs @@ -0,0 +1,94 @@ +module XMonad.Prompt.MyPass + ( + -- * Usages + -- $usages + mkPassPrompt + ) where + +import Control.Monad (liftM) +import XMonad.Core +import XMonad.Prompt ( XPrompt + , showXPrompt + , commandToComplete + , nextCompletion + , getNextCompletion + , XPConfig + , mkXPrompt + , searchPredicate) +import System.Directory (getHomeDirectory) +import System.FilePath (takeExtension, dropExtension, combine) +import System.Posix.Env (getEnv) +import XMonad.Util.Run (runProcessWithInput) + +-- $usages +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Prompt.Pass +-- +-- Then add a keybinding for 'passPrompt', 'passGeneratePrompt' or 'passRemovePrompt': +-- +-- > , ((modMask x , xK_p) , passPrompt xpconfig) +-- > , ((modMask x .|. controlMask, xK_p) , passGeneratePrompt xpconfig) +-- > , ((modMask x .|. controlMask .|. shiftMask, xK_p), passRemovePrompt xpconfig) +-- +-- For detailed instructions on: +-- +-- - editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings". +-- +-- - how to setup the password storage, see +-- + +type Predicate = String -> String -> Bool + +getPassCompl :: [String] -> Predicate -> String -> IO [String] +getPassCompl compls p s + | length s <= minL + , all ((> minL) . length) compls = return [] + | otherwise = do return $ filter (p s) compls + where + minL = 3 + +type PromptLabel = String + +data Pass = Pass PromptLabel + +instance XPrompt Pass where + showXPrompt (Pass prompt) = prompt ++ ": " + commandToComplete _ c = c + nextCompletion _ = getNextCompletion + +-- | Default password store folder in $HOME/.password-store +-- +passwordStoreFolderDefault :: String -> String +passwordStoreFolderDefault home = combine home ".password-store" + +-- | Compute the password store's location. +-- Use the PASSWORD_STORE_DIR environment variable to set the password store. +-- If empty, return the password store located in user's home. +-- +passwordStoreFolder :: IO String +passwordStoreFolder = + getEnv "PASSWORD_STORE_DIR" >>= computePasswordStoreDir + where computePasswordStoreDir Nothing = liftM passwordStoreFolderDefault getHomeDirectory + computePasswordStoreDir (Just storeDir) = return storeDir + +-- | A pass prompt factory +-- +mkPassPrompt :: PromptLabel -> (String -> X ()) -> XPConfig -> X () +mkPassPrompt promptLabel passwordFunction xpconfig = do + passwords <- io (passwordStoreFolder >>= getPasswords) + mkXPrompt (Pass promptLabel) xpconfig (getPassCompl passwords $ searchPredicate xpconfig) passwordFunction + +-- | Retrieve the list of passwords from the password storage 'passwordStoreDir +getPasswords :: FilePath -> IO [String] +getPasswords passwordStoreDir = do + files <- runProcessWithInput "find" [ + passwordStoreDir, + "-type", "f", + "-name", "*.gpg", + "-printf", "%P\n"] [] + return $ map removeGpgExtension $ lines files + +removeGpgExtension :: String -> String +removeGpgExtension file | takeExtension file == ".gpg" = dropExtension file + | otherwise = file diff --git a/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyShell.hs b/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyShell.hs new file mode 100644 index 00000000..c268f87d --- /dev/null +++ b/accounts/gkleen@sif/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/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MySsh.hs b/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MySsh.hs new file mode 100644 index 00000000..c85d0f92 --- /dev/null +++ b/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MySsh.hs @@ -0,0 +1,243 @@ +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 + | null $ cCommand c = c { cCommand = "tmux new-session" } + | otherwise = 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 -- cgit v1.2.3