summaryrefslogtreecommitdiff
path: root/KeyRing.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2014-04-11 21:31:43 -0400
committerjoe <joe@jerkface.net>2014-04-11 21:31:43 -0400
commitb3d3372abf46ee1ec308c77201c00ab6d8bfeff2 (patch)
tree1b330e0a648f2795d1feba9b40f5841a075995c0 /KeyRing.hs
parentf05570130f46149650e519594b5fa643d970d73d (diff)
keyring home globals
Diffstat (limited to 'KeyRing.hs')
-rw-r--r--KeyRing.hs24
1 files changed, 16 insertions, 8 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index 4058585..089b25a 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -11,6 +11,18 @@ import Data.Char
11import System.Directory ( getHomeDirectory, doesFileExist ) 11import System.Directory ( getHomeDirectory, doesFileExist )
12import Control.Arrow ( first, second ) 12import Control.Arrow ( first, second )
13 13
14data HomeDir =
15 HomeDir { homevar :: String
16 , appdir :: String
17 , optfile_alts :: [String]
18 }
19
20home = HomeDir
21 { homevar = "GNUPGHOME"
22 , appdir = ".gnupg"
23 , optfile_alts = ["keys.conf","gpg.conf-2","gpg.conf"]
24 }
25
14data KeyRing 26data KeyRing
15 27
16todo = error "unimplemented" 28todo = error "unimplemented"
@@ -37,11 +49,11 @@ getHomeDir protohome = do
37 return (homedir,secring,pubring,workingkey) 49 return (homedir,secring,pubring,workingkey)
38 where 50 where
39 envhomedir opt = do 51 envhomedir opt = do
40 gnupghome <- lookupEnv homevar >>= 52 gnupghome <- lookupEnv (homevar home) >>=
41 \d -> return $ d >>= guard . (/="") >> d 53 \d -> return $ d >>= guard . (/="") >> d
42 home <- flip fmap getHomeDirectory $ 54 homed <- flip fmap getHomeDirectory $
43 \d -> fmap (const d) $ guard (d/="") 55 \d -> fmap (const d) $ guard (d/="")
44 let homegnupg = (++('/':appdir)) <$> home 56 let homegnupg = (++('/':(appdir home))) <$> homed
45 let val = (opt `mplus` gnupghome `mplus` homegnupg) 57 let val = (opt `mplus` gnupghome `mplus` homegnupg)
46 return $ val 58 return $ val
47 59
@@ -52,7 +64,7 @@ getHomeDir protohome = do
52 ofile <- fmap listToMaybe . flip (maybe (return [])) h $ \h -> 64 ofile <- fmap listToMaybe . flip (maybe (return [])) h $ \h ->
53 let optfiles = map (second ((h++"/")++)) 65 let optfiles = map (second ((h++"/")++))
54 (maybe optfile_alts' (:[]) o') 66 (maybe optfile_alts' (:[]) o')
55 optfile_alts' = zip (False:repeat True) optfile_alts 67 optfile_alts' = zip (False:repeat True) (optfile_alts home)
56 o' = fmap (False,) o 68 o' = fmap (False,) o
57 in filterM (doesFileExist . snd) optfiles 69 in filterM (doesFileExist . snd) optfiles
58 args <- flip (maybe $ return []) ofile $ 70 args <- flip (maybe $ return []) ofile $
@@ -61,10 +73,6 @@ getHomeDir protohome = do
61 where topair (x:xs) = (x,xs) 73 where topair (x:xs) = (x,xs)
62 return $ lookup "default-key" config >>= listToMaybe 74 return $ lookup "default-key" config >>= listToMaybe
63 75
64homevar = "GNUPGHOME"
65appdir = ".gnupg"
66optfile_alts = ["keys.conf","gpg.conf-2","gpg.conf"]
67
68#if MIN_VERSION_base(4,6,0) 76#if MIN_VERSION_base(4,6,0)
69#else 77#else
70lookupEnv var = 78lookupEnv var =