1 files changed, 142 insertions, 0 deletions
diff --git a/lib/Pass.hs b/lib/Pass.hs
new file mode 100644
index 0000000..f29df27
--- /dev/null
+++ b/lib/Pass.hs
@@ -0,0 +1,142 @@
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Pass
+-- Copyright   :  (c) 2014 Igor Babuschkin, Antoine R. Dumont, Alexander Sulfrian
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Antoine R. Dumont <eniotna.t@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- This module provides 3 <XMonad.Prompt> to ease passwords manipulation (generate, read):
+--
+-- - one to lookup passwords in the password-storage (located on user's home @$HOME\/.password-store@).
+--
+-- - one to generate a password for a given password label that the user inputs.
+--
+-- - one to delete a stored password for a given password label that the user inputs.
+--
+-- All those prompts benefit from the completion system provided by the module <XMonad.Prompt>.
+--
+--
+-- Source:
+--
+-- - The password storage implementation is <http://git.zx2c4.com/password-store the password-store cli>.
+--
+-- - Inspired from <http://babushk.in/posts/combining-xmonad-and-pass.html>
+--
+-----------------------------------------------------------------------------
+
+module Pass ( -- * Usages
+              -- $usages
+              passPrompt
+            , passGeneratePrompt
+            ) where
+
+import XMonad (X, io, xfork)
+import XMonad.Prompt ( XPrompt
+                     , showXPrompt
+                     , commandToComplete
+                     , nextCompletion
+                     , getNextCompletion
+                     , XPConfig
+                     , mkXPrompt
+                     , mkComplFunFromList)
+import XMonad.Util.Run (safeSpawn, runProcessWithInput)
+import System.Directory (getHomeDirectory)
+import Data.List (isSuffixOf)
+
+-- $usages
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Prompt.Pass
+--
+-- Then add a keybinding for 'passPrompt' or 'passGeneratePrompt':
+--
+-- >   , ((modMask x , xK_p)                              , passPrompt xpconfig)
+-- >   , ((modMask x .|. controlMask, xK_p)               , passGeneratePrompt xpconfig)
+--
+-- For detailed instructions on:
+--
+-- - editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings".
+--
+-- - how to setup the password storage, see <http://git.zx2c4.com/password-store/about/>
+--
+
+type PromptLabel = String
+
+data Pass = Pass PromptLabel
+
+instance XPrompt Pass where
+  showXPrompt       (Pass prompt) = prompt ++ ": "
+  commandToComplete _ c           = c
+  nextCompletion      _           = getNextCompletion
+
+-- | A pass prompt factory.
+--
+mkPassPrompt :: PromptLabel -> (String -> X ()) -> XPConfig -> X ()
+mkPassPrompt promptLabel passwordFunction xpconfig =
+  io getPasswords >>=
+  \ passwords -> mkXPrompt (Pass promptLabel) xpconfig (mkComplFunFromList passwords) passwordFunction
+
+-- | A prompt to retrieve a password from a given entry.
+--
+passPrompt :: XPConfig -> X ()
+passPrompt = mkPassPrompt "Select password" selectPassword
+
+-- | A prompt to generate a password for a given entry.
+-- This can be used to override an already stored entry.
+-- (Beware that no confirmation is asked)
+--
+passGeneratePrompt :: XPConfig -> X ()
+passGeneratePrompt = mkPassPrompt "Generate password" generatePassword
+
+-- | Select a password.
+--
+selectPassword :: String -> X ()
+selectPassword passLabel = io $ do
+  xfork $ typePassword passLabel
+  return ()
+
+typePassword :: String -> IO ()
+typePassword passLabel = do
+  pass <- runProcessWithInput "pass" ["show", passLabel] []
+  runProcessWithInput "xdotool" ["-"] $ getTypeCommand pass
+  runProcessWithInput "dzen2"
+    ["-p", "1", "-fn", ":Bold",
+     "-w", "280", "-h", "50",
+     "-y", "900", "-x", "700",
+     "-bg", "darkred", "-fg", "white"]
+    "Done\n"
+  return ()
+
+getTypeCommand :: String -> String
+getTypeCommand content = "type --clearmodifiers '" ++ getPass content ++ "'"
+  where
+    getPass = escapeString . head . lines
+    escapeString = concat . map escapeChar
+    escapeChar c
+      | (c == '\'') = "'\n\"'\"\n'"
+      | otherwise = [c]
+
+-- | Generate a 30 characters password for a given entry.
+-- If the entry already exists, it is updated with a new password.
+--
+generatePassword :: String -> X ()
+generatePassword passLabel = safeSpawn "pass" ["generate", "--force", passLabel, "30"]
+
+-- | Retrieve the list of passwords from the default password storage in $HOME/.password-store
+--
+getPasswords :: IO [String]
+getPasswords = do
+  home <- getHomeDirectory
+  files <- runProcessWithInput "find" [home ++ "/.password-store","-type", "f", "-name", "*.gpg", "-printf", "%P\n"] []
+  return $ map removeGpgExtension $ lines files
+
+removeGpgExtension :: String -> String
+removeGpgExtension file =
+  if isSuffixOf ".gpg" file then
+    reverse $ drop 4 $ reverse file
+  else
+    file