summaryrefslogtreecommitdiff
path: root/KeyRing.hs
diff options
context:
space:
mode:
Diffstat (limited to 'KeyRing.hs')
-rw-r--r--KeyRing.hs72
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 @@
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE EmptyDataDecls #-}
3{-# LANGUAGE TupleSections #-}
4module KeyRing where
5
6import System.Environment
7import Control.Monad
8import Control.Applicative
9import Data.Maybe
10import Data.Char
11import System.Directory ( getHomeDirectory, doesFileExist )
12import Control.Arrow ( first, second )
13
14data KeyRing
15
16todo = error "unimplemented"
17
18loadKeys :: (Maybe FilePath) -> IO KeyRing
19loadKeys = todo
20
21parseOptionFile fname = do
22 xs <- fmap lines (readFile fname)
23 let ys = filter notComment xs
24 notComment ('#':_) = False
25 notComment cs = not (all isSpace cs)
26 return ys
27
28getHomeDir protohome = do
29 homedir <- envhomedir protohome
30 flip (maybe (error "Could not determine home directory."))
31 homedir $ \homedir -> do
32 -- putStrLn $ "homedir = " ++show homedir
33 let secring = homedir ++ "/" ++ "secring.gpg"
34 pubring = homedir ++ "/" ++ "pubring.gpg"
35 -- putStrLn $ "secring = " ++ show secring
36 workingkey <- getWorkingKey homedir
37 return (homedir,secring,pubring,workingkey)
38 where
39 envhomedir opt = do
40 gnupghome <- lookupEnv homevar >>=
41 \d -> return $ d >>= guard . (/="") >> d
42 home <- flip fmap getHomeDirectory $
43 \d -> fmap (const d) $ guard (d/="")
44 let homegnupg = (++('/':appdir)) <$> home
45 let val = (opt `mplus` gnupghome `mplus` homegnupg)
46 return $ val
47
48 -- TODO: rename this to getGrip
49 getWorkingKey homedir = do
50 let o = Nothing
51 h = Just homedir
52 ofile <- fmap listToMaybe . flip (maybe (return [])) h $ \h ->
53 let optfiles = map (second ((h++"/")++))
54 (maybe optfile_alts' (:[]) o')
55 optfile_alts' = zip (False:repeat True) optfile_alts
56 o' = fmap (False,) o
57 in filterM (doesFileExist . snd) optfiles
58 args <- flip (maybe $ return []) ofile $
59 \(forgive,fname) -> parseOptionFile fname
60 let config = map (topair . words) args
61 where topair (x:xs) = (x,xs)
62 return $ lookup "default-key" config >>= listToMaybe
63
64homevar = "GNUPGHOME"
65appdir = ".gnupg"
66optfile_alts = ["keys.conf","gpg.conf-2","gpg.conf"]
67
68#if MIN_VERSION_base(4,6,0)
69#else
70lookupEnv var =
71 handleIO_ (return Nothing) $ fmap Just (getEnv var)
72#endif