Started rework

1 files changed, 72 insertions, 0 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
new file mode 100644
index 0000000..4058585
--- /dev/null
+++ b/KeyRing.hs
@@ -0,0 +1,72 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE TupleSections #-}
+module KeyRing where
+
+import System.Environment
+import Control.Monad
+import Control.Applicative
+import Data.Maybe
+import Data.Char
+import System.Directory ( getHomeDirectory, doesFileExist )
+import Control.Arrow    ( first, second )
+
+data KeyRing
+
+todo = error "unimplemented"
+
+loadKeys :: (Maybe FilePath) -> IO KeyRing
+loadKeys = todo
+
+parseOptionFile fname = do
+    xs <- fmap lines (readFile fname)
+    let ys = filter notComment xs
+        notComment ('#':_) = False
+        notComment cs      = not (all isSpace cs)
+    return ys
+
+getHomeDir protohome = do
+        homedir <- envhomedir protohome
+        flip (maybe (error "Could not determine home directory."))
+             homedir $ \homedir -> do
+        -- putStrLn $ "homedir = " ++show homedir
+        let secring = homedir ++ "/" ++ "secring.gpg"
+            pubring = homedir ++ "/" ++ "pubring.gpg"
+        -- putStrLn $ "secring = " ++ show secring
+        workingkey <- getWorkingKey homedir
+        return (homedir,secring,pubring,workingkey)
+ where
+    envhomedir opt = do
+        gnupghome <- lookupEnv homevar >>=
+                  \d -> return $ d >>= guard . (/="") >> d
+        home <- flip fmap getHomeDirectory $
+                  \d -> fmap (const d) $ guard (d/="")
+        let homegnupg = (++('/':appdir)) <$> home
+        let val = (opt `mplus` gnupghome `mplus` homegnupg)
+        return $ val
+    
+    -- TODO: rename this to getGrip
+    getWorkingKey homedir = do
+        let o = Nothing
+            h = Just homedir
+        ofile <- fmap listToMaybe . flip (maybe (return [])) h $ \h ->
+                let optfiles = map (second ((h++"/")++))
+                                   (maybe optfile_alts' (:[]) o')
+                    optfile_alts' = zip (False:repeat True) optfile_alts
+                    o' = fmap (False,) o
+                in filterM (doesFileExist . snd) optfiles
+        args <- flip (maybe $ return []) ofile $
+            \(forgive,fname) -> parseOptionFile fname
+        let config = map (topair . words) args
+                        where topair (x:xs) = (x,xs)
+        return $ lookup "default-key" config >>= listToMaybe
+
+homevar = "GNUPGHOME"
+appdir  = ".gnupg"
+optfile_alts = ["keys.conf","gpg.conf-2","gpg.conf"]
+
+#if MIN_VERSION_base(4,6,0)
+#else
+lookupEnv var =
+    handleIO_ (return Nothing) $ fmap Just (getEnv var)
+#endif