diff options
Diffstat (limited to 'accounts/gkleen@sif/xmonad/lib/XMonad/Prompt')
3 files changed, 442 insertions, 0 deletions
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 @@ | |||
1 | module XMonad.Prompt.MyPass | ||
2 | ( | ||
3 | -- * Usages | ||
4 | -- $usages | ||
5 | mkPassPrompt | ||
6 | ) where | ||
7 | |||
8 | import Control.Monad (liftM) | ||
9 | import XMonad.Core | ||
10 | import XMonad.Prompt ( XPrompt | ||
11 | , showXPrompt | ||
12 | , commandToComplete | ||
13 | , nextCompletion | ||
14 | , getNextCompletion | ||
15 | , XPConfig | ||
16 | , mkXPrompt | ||
17 | , searchPredicate) | ||
18 | import System.Directory (getHomeDirectory) | ||
19 | import System.FilePath (takeExtension, dropExtension, combine) | ||
20 | import System.Posix.Env (getEnv) | ||
21 | import XMonad.Util.Run (runProcessWithInput) | ||
22 | |||
23 | -- $usages | ||
24 | -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: | ||
25 | -- | ||
26 | -- > import XMonad.Prompt.Pass | ||
27 | -- | ||
28 | -- Then add a keybinding for 'passPrompt', 'passGeneratePrompt' or 'passRemovePrompt': | ||
29 | -- | ||
30 | -- > , ((modMask x , xK_p) , passPrompt xpconfig) | ||
31 | -- > , ((modMask x .|. controlMask, xK_p) , passGeneratePrompt xpconfig) | ||
32 | -- > , ((modMask x .|. controlMask .|. shiftMask, xK_p), passRemovePrompt xpconfig) | ||
33 | -- | ||
34 | -- For detailed instructions on: | ||
35 | -- | ||
36 | -- - editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings". | ||
37 | -- | ||
38 | -- - how to setup the password storage, see <http://git.zx2c4.com/password-store/about/> | ||
39 | -- | ||
40 | |||
41 | type Predicate = String -> String -> Bool | ||
42 | |||
43 | getPassCompl :: [String] -> Predicate -> String -> IO [String] | ||
44 | getPassCompl compls p s | ||
45 | | length s <= minL | ||
46 | , all ((> minL) . length) compls = return [] | ||
47 | | otherwise = do return $ filter (p s) compls | ||
48 | where | ||
49 | minL = 3 | ||
50 | |||
51 | type PromptLabel = String | ||
52 | |||
53 | data Pass = Pass PromptLabel | ||
54 | |||
55 | instance XPrompt Pass where | ||
56 | showXPrompt (Pass prompt) = prompt ++ ": " | ||
57 | commandToComplete _ c = c | ||
58 | nextCompletion _ = getNextCompletion | ||
59 | |||
60 | -- | Default password store folder in $HOME/.password-store | ||
61 | -- | ||
62 | passwordStoreFolderDefault :: String -> String | ||
63 | passwordStoreFolderDefault home = combine home ".password-store" | ||
64 | |||
65 | -- | Compute the password store's location. | ||
66 | -- Use the PASSWORD_STORE_DIR environment variable to set the password store. | ||
67 | -- If empty, return the password store located in user's home. | ||
68 | -- | ||
69 | passwordStoreFolder :: IO String | ||
70 | passwordStoreFolder = | ||
71 | getEnv "PASSWORD_STORE_DIR" >>= computePasswordStoreDir | ||
72 | where computePasswordStoreDir Nothing = liftM passwordStoreFolderDefault getHomeDirectory | ||
73 | computePasswordStoreDir (Just storeDir) = return storeDir | ||
74 | |||
75 | -- | A pass prompt factory | ||
76 | -- | ||
77 | mkPassPrompt :: PromptLabel -> (String -> X ()) -> XPConfig -> X () | ||
78 | mkPassPrompt promptLabel passwordFunction xpconfig = do | ||
79 | passwords <- io (passwordStoreFolder >>= getPasswords) | ||
80 | mkXPrompt (Pass promptLabel) xpconfig (getPassCompl passwords $ searchPredicate xpconfig) passwordFunction | ||
81 | |||
82 | -- | Retrieve the list of passwords from the password storage 'passwordStoreDir | ||
83 | getPasswords :: FilePath -> IO [String] | ||
84 | getPasswords passwordStoreDir = do | ||
85 | files <- runProcessWithInput "find" [ | ||
86 | passwordStoreDir, | ||
87 | "-type", "f", | ||
88 | "-name", "*.gpg", | ||
89 | "-printf", "%P\n"] [] | ||
90 | return $ map removeGpgExtension $ lines files | ||
91 | |||
92 | removeGpgExtension :: String -> String | ||
93 | removeGpgExtension file | takeExtension file == ".gpg" = dropExtension file | ||
94 | | 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 @@ | |||
1 | module XMonad.Prompt.MyShell | ||
2 | ( Shell (..) | ||
3 | , shellPrompt | ||
4 | , prompt | ||
5 | , safePrompt | ||
6 | , unsafePrompt | ||
7 | , getCommands | ||
8 | , getShellCompl | ||
9 | , split | ||
10 | ) where | ||
11 | |||
12 | import Codec.Binary.UTF8.String (encodeString) | ||
13 | import Control.Exception as E | ||
14 | import Control.Monad (forM) | ||
15 | import Data.List (isPrefixOf) | ||
16 | import System.Directory (doesDirectoryExist, getDirectoryContents) | ||
17 | import System.Environment (getEnv) | ||
18 | import System.Posix.Files (getFileStatus, isDirectory) | ||
19 | |||
20 | import XMonad hiding (config) | ||
21 | import XMonad.Prompt | ||
22 | import XMonad.Util.Run | ||
23 | |||
24 | econst :: Monad m => a -> IOException -> m a | ||
25 | econst = const . return | ||
26 | |||
27 | data Shell = Shell String | ||
28 | |||
29 | instance XPrompt Shell where | ||
30 | showXPrompt (Shell q) = q | ||
31 | completionToCommand _ = escape | ||
32 | |||
33 | shellPrompt :: String -> XPConfig -> X () | ||
34 | shellPrompt q c = do | ||
35 | cmds <- io getCommands | ||
36 | mkXPrompt (Shell q) c (getShellCompl cmds) spawn | ||
37 | |||
38 | {- $spawns | ||
39 | See safe and unsafeSpawn in "XMonad.Util.Run". | ||
40 | prompt is an alias for safePrompt; | ||
41 | safePrompt and unsafePrompt work on the same principles, but will use | ||
42 | XPrompt to interactively query the user for input; the appearance is | ||
43 | set by passing an XPConfig as the second argument. The first argument | ||
44 | is the program to be run with the interactive input. | ||
45 | You would use these like this: | ||
46 | |||
47 | > , ((modm, xK_b), safePrompt "firefox" greenXPConfig) | ||
48 | > , ((modm .|. shiftMask, xK_c), prompt ("xterm" ++ " -e") greenXPConfig) | ||
49 | |||
50 | Note that you want to use safePrompt for Firefox input, as Firefox | ||
51 | wants URLs, and unsafePrompt for the XTerm example because this allows | ||
52 | you to easily start a terminal executing an arbitrary command, like | ||
53 | 'top'. -} | ||
54 | |||
55 | prompt, unsafePrompt, safePrompt :: String -> FilePath -> XPConfig -> X () | ||
56 | prompt = unsafePrompt | ||
57 | safePrompt q c config = mkXPrompt (Shell q) config (getShellCompl [c]) run | ||
58 | where run = safeSpawn c . return | ||
59 | unsafePrompt q c config = mkXPrompt (Shell q) config (getShellCompl [c]) run | ||
60 | where run a = unsafeSpawn $ c ++ " " ++ a | ||
61 | |||
62 | getShellCompl :: [String] -> String -> IO [String] | ||
63 | getShellCompl cmds s | s == "" || last s == ' ' = return [] | ||
64 | | otherwise = do | ||
65 | f <- fmap lines $ runProcessWithInput "bash" [] ("compgen -A file -- " | ||
66 | ++ s ++ "\n") | ||
67 | files <- case f of | ||
68 | [x] -> do fs <- getFileStatus (encodeString x) | ||
69 | if isDirectory fs then return [x ++ "/"] | ||
70 | else return [x] | ||
71 | _ -> return f | ||
72 | return . uniqSort $ files ++ commandCompletionFunction cmds s | ||
73 | |||
74 | commandCompletionFunction :: [String] -> String -> [String] | ||
75 | commandCompletionFunction cmds str | '/' `elem` str = [] | ||
76 | | otherwise = filter (isPrefixOf str) cmds | ||
77 | |||
78 | getCommands :: IO [String] | ||
79 | getCommands = do | ||
80 | p <- getEnv "PATH" `E.catch` econst [] | ||
81 | let ds = filter (/= "") $ split ':' p | ||
82 | es <- forM ds $ \d -> do | ||
83 | exists <- doesDirectoryExist d | ||
84 | if exists | ||
85 | then getDirectoryContents d | ||
86 | else return [] | ||
87 | return . uniqSort . filter ((/= '.') . head) . concat $ es | ||
88 | |||
89 | split :: Eq a => a -> [a] -> [[a]] | ||
90 | split _ [] = [] | ||
91 | split e l = | ||
92 | f : split e (rest ls) | ||
93 | where | ||
94 | (f,ls) = span (/=e) l | ||
95 | rest s | s == [] = [] | ||
96 | | otherwise = tail s | ||
97 | |||
98 | escape :: String -> String | ||
99 | escape [] = "" | ||
100 | escape (x:xs) | ||
101 | | isSpecialChar x = '\\' : x : escape xs | ||
102 | | otherwise = x : escape xs | ||
103 | |||
104 | isSpecialChar :: Char -> Bool | ||
105 | 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 @@ | |||
1 | module XMonad.Prompt.MySsh | ||
2 | ( -- * Usage | ||
3 | -- $usage | ||
4 | sshPrompt, | ||
5 | Ssh, | ||
6 | Override (..), | ||
7 | mkOverride, | ||
8 | Conn (..), | ||
9 | moshCmd, | ||
10 | moshCmd', | ||
11 | sshCmd, | ||
12 | inTmux, | ||
13 | withEnv | ||
14 | ) where | ||
15 | |||
16 | import XMonad | ||
17 | import XMonad.Util.Run | ||
18 | import XMonad.Prompt | ||
19 | |||
20 | import System.Directory | ||
21 | import System.Environment | ||
22 | import qualified Control.Exception as E | ||
23 | |||
24 | import Control.Monad | ||
25 | import Data.Maybe | ||
26 | |||
27 | import Text.Parsec.String | ||
28 | import Text.Parsec | ||
29 | import Data.Char (isSpace) | ||
30 | |||
31 | econst :: Monad m => a -> E.IOException -> m a | ||
32 | econst = const . return | ||
33 | |||
34 | -- $usage | ||
35 | -- 1. In your @~\/.xmonad\/xmonad.hs@: | ||
36 | -- | ||
37 | -- > import XMonad.Prompt | ||
38 | -- > import XMonad.Prompt.Ssh | ||
39 | -- | ||
40 | -- 2. In your keybindings add something like: | ||
41 | -- | ||
42 | -- > , ((modm .|. controlMask, xK_s), sshPrompt defaultXPConfig) | ||
43 | -- | ||
44 | -- Keep in mind, that if you want to use the completion you have to | ||
45 | -- disable the "HashKnownHosts" option in your ssh_config | ||
46 | -- | ||
47 | -- For detailed instruction on editing the key binding see | ||
48 | -- "XMonad.Doc.Extending#Editing_key_bindings". | ||
49 | |||
50 | data Override = Override | ||
51 | { oUser :: Maybe String | ||
52 | , oHost :: String | ||
53 | , oPort :: Maybe Int | ||
54 | , oCommand :: Conn -> String | ||
55 | } | ||
56 | |||
57 | mkOverride = Override { oUser = Nothing, oHost = "", oPort = Nothing, oCommand = sshCmd } | ||
58 | sshCmd c = concat | ||
59 | [ "ssh -t " | ||
60 | , if isJust $ cUser c then (fromJust $ cUser c) ++ "@" else "" | ||
61 | , cHost c | ||
62 | , if isJust $ cPort c then " -p " ++ (show $ fromJust $ cPort c) else "" | ||
63 | , " -- " | ||
64 | , cCommand c | ||
65 | ] | ||
66 | moshCmd c = concat | ||
67 | [ "mosh " | ||
68 | , if isJust $ cUser c then (fromJust $ cUser c) ++ "@" else "" | ||
69 | , cHost c | ||
70 | , if isJust $ cPort c then " --ssh=\"ssh -p " ++ (show $ fromJust $ cPort c) ++ "\"" else "" | ||
71 | , " -- " | ||
72 | , cCommand c | ||
73 | ] | ||
74 | moshCmd' p c = concat | ||
75 | [ "mosh " | ||
76 | , "--server=" ++ p ++ " " | ||
77 | , if isJust $ cUser c then (fromJust $ cUser c) ++ "@" else "" | ||
78 | , cHost c | ||
79 | , if isJust $ cPort c then " --ssh=\"ssh -p " ++ (show $ fromJust $ cPort c) ++ "\"" else "" | ||
80 | , " -- " | ||
81 | , cCommand c | ||
82 | ] | ||
83 | inTmux c | ||
84 | | null $ cCommand c = c { cCommand = "tmux new-session" } | ||
85 | | otherwise = c { cCommand = "tmux new-session \"" ++ (cCommand c) ++ "\"" } | ||
86 | withEnv :: [(String, String)] -> Conn -> Conn | ||
87 | withEnv envs c = c { cCommand = "env" ++ (concat $ map (\(n, v) -> ' ' : (n ++ "=" ++ v)) envs) ++ " " ++ (cCommand c) } | ||
88 | |||
89 | data Conn = Conn | ||
90 | { cUser :: Maybe String | ||
91 | , cHost :: String | ||
92 | , cPort :: Maybe Int | ||
93 | , cCommand :: String | ||
94 | } deriving (Eq, Show, Read) | ||
95 | |||
96 | data Ssh = Ssh | ||
97 | |||
98 | instance XPrompt Ssh where | ||
99 | showXPrompt Ssh = "SSH to: " | ||
100 | commandToComplete _ c = c | ||
101 | nextCompletion _ = getNextCompletion | ||
102 | |||
103 | toConn :: String -> Maybe Conn | ||
104 | toConn = toConn' . parse connParser "(unknown)" | ||
105 | toConn' :: Either ParseError Conn -> Maybe Conn | ||
106 | toConn' (Left _) = Nothing | ||
107 | toConn' (Right a) = Just a | ||
108 | |||
109 | connParser :: Parser Conn | ||
110 | connParser = do | ||
111 | spaces | ||
112 | user' <- optionMaybe $ try $ do | ||
113 | str <- many1 $ satisfy (\c -> (not $ isSpace c) && (c /= '@')) | ||
114 | char '@' | ||
115 | return str | ||
116 | host' <- many1 $ satisfy (not . isSpace) | ||
117 | port' <- optionMaybe $ try $ do | ||
118 | space | ||
119 | string "-p" | ||
120 | spaces | ||
121 | int <- many1 digit | ||
122 | (space >> return ()) <|> eof | ||
123 | return $ (read int :: Int) | ||
124 | spaces | ||
125 | command' <- many anyChar | ||
126 | eof | ||
127 | return $ Conn | ||
128 | { cHost = host' | ||
129 | , cUser = user' | ||
130 | , cPort = port' | ||
131 | , cCommand = command' | ||
132 | } | ||
133 | |||
134 | sshPrompt :: [Override] -> XPConfig -> X () | ||
135 | sshPrompt o c = do | ||
136 | sc <- io sshComplList | ||
137 | mkXPrompt Ssh c (mkComplFunFromList sc) $ ssh o | ||
138 | |||
139 | ssh :: [Override] -> String -> X () | ||
140 | ssh overrides str = do | ||
141 | let cmd = applyOverrides overrides str | ||
142 | liftIO $ putStr "SSH Command: " | ||
143 | liftIO $ putStrLn cmd | ||
144 | runInTerm "" cmd | ||
145 | |||
146 | applyOverrides :: [Override] -> String -> String | ||
147 | applyOverrides [] str = "ssh " ++ str | ||
148 | applyOverrides (o:os) str = case (applyOverride o str) of | ||
149 | Just str -> str | ||
150 | Nothing -> applyOverrides os str | ||
151 | |||
152 | applyOverride :: Override -> String -> Maybe String | ||
153 | applyOverride o str = let | ||
154 | conn = toConn str | ||
155 | in | ||
156 | if isNothing conn then Nothing else | ||
157 | case (fromJust conn) `matches` o of | ||
158 | True -> Just $ (oCommand o) (fromJust conn) | ||
159 | False -> Nothing | ||
160 | |||
161 | matches :: Conn -> Override -> Bool | ||
162 | a `matches` b = and | ||
163 | [ justBool (cUser a) (oUser b) (==) | ||
164 | , (cHost a) == (oHost b) | ||
165 | , justBool (cPort a) (oPort b) (==) | ||
166 | ] | ||
167 | |||
168 | justBool :: Eq a => Maybe a -> Maybe a -> (a -> a -> Bool) -> Bool | ||
169 | justBool Nothing _ _ = True | ||
170 | justBool _ Nothing _ = True | ||
171 | justBool (Just a) (Just b) match = a `match` b | ||
172 | |||
173 | sshComplList :: IO [String] | ||
174 | sshComplList = uniqSort `fmap` liftM2 (++) sshComplListLocal sshComplListGlobal | ||
175 | |||
176 | sshComplListLocal :: IO [String] | ||
177 | sshComplListLocal = do | ||
178 | h <- getEnv "HOME" | ||
179 | s1 <- sshComplListFile $ h ++ "/.ssh/known_hosts" | ||
180 | s2 <- sshComplListConf $ h ++ "/.ssh/config" | ||
181 | return $ s1 ++ s2 | ||
182 | |||
183 | sshComplListGlobal :: IO [String] | ||
184 | sshComplListGlobal = do | ||
185 | env <- getEnv "SSH_KNOWN_HOSTS" `E.catch` econst "/nonexistent" | ||
186 | fs <- mapM fileExists [ env | ||
187 | , "/usr/local/etc/ssh/ssh_known_hosts" | ||
188 | , "/usr/local/etc/ssh_known_hosts" | ||
189 | , "/etc/ssh/ssh_known_hosts" | ||
190 | , "/etc/ssh_known_hosts" | ||
191 | ] | ||
192 | case catMaybes fs of | ||
193 | [] -> return [] | ||
194 | (f:_) -> sshComplListFile' f | ||
195 | |||
196 | sshComplListFile :: String -> IO [String] | ||
197 | sshComplListFile kh = do | ||
198 | f <- doesFileExist kh | ||
199 | if f then sshComplListFile' kh | ||
200 | else return [] | ||
201 | |||
202 | sshComplListFile' :: String -> IO [String] | ||
203 | sshComplListFile' kh = do | ||
204 | l <- readFile kh | ||
205 | return $ map (getWithPort . takeWhile (/= ',') . concat . take 1 . words) | ||
206 | $ filter nonComment | ||
207 | $ lines l | ||
208 | |||
209 | sshComplListConf :: String -> IO [String] | ||
210 | sshComplListConf kh = do | ||
211 | f <- doesFileExist kh | ||
212 | if f then sshComplListConf' kh | ||
213 | else return [] | ||
214 | |||
215 | sshComplListConf' :: String -> IO [String] | ||
216 | sshComplListConf' kh = do | ||
217 | l <- readFile kh | ||
218 | return $ map (!!1) | ||
219 | $ filter isHost | ||
220 | $ map words | ||
221 | $ lines l | ||
222 | where | ||
223 | isHost ws = take 1 ws == ["Host"] && length ws > 1 | ||
224 | |||
225 | fileExists :: String -> IO (Maybe String) | ||
226 | fileExists kh = do | ||
227 | f <- doesFileExist kh | ||
228 | if f then return $ Just kh | ||
229 | else return Nothing | ||
230 | |||
231 | nonComment :: String -> Bool | ||
232 | nonComment [] = False | ||
233 | nonComment ('#':_) = False | ||
234 | nonComment ('|':_) = False -- hashed, undecodeable | ||
235 | nonComment _ = True | ||
236 | |||
237 | getWithPort :: String -> String | ||
238 | getWithPort ('[':str) = host ++ " -p " ++ port | ||
239 | where (host,p) = break (==']') str | ||
240 | port = case p of | ||
241 | ']':':':x -> x | ||
242 | _ -> "22" | ||
243 | getWithPort str = str | ||