diff options
author | joe <joe@jerkface.net> | 2014-04-11 21:31:43 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2014-04-11 21:31:43 -0400 |
commit | b3d3372abf46ee1ec308c77201c00ab6d8bfeff2 (patch) | |
tree | 1b330e0a648f2795d1feba9b40f5841a075995c0 /KeyRing.hs | |
parent | f05570130f46149650e519594b5fa643d970d73d (diff) |
keyring home globals
Diffstat (limited to 'KeyRing.hs')
-rw-r--r-- | KeyRing.hs | 24 |
1 files changed, 16 insertions, 8 deletions
@@ -11,6 +11,18 @@ import Data.Char | |||
11 | import System.Directory ( getHomeDirectory, doesFileExist ) | 11 | import System.Directory ( getHomeDirectory, doesFileExist ) |
12 | import Control.Arrow ( first, second ) | 12 | import Control.Arrow ( first, second ) |
13 | 13 | ||
14 | data HomeDir = | ||
15 | HomeDir { homevar :: String | ||
16 | , appdir :: String | ||
17 | , optfile_alts :: [String] | ||
18 | } | ||
19 | |||
20 | home = HomeDir | ||
21 | { homevar = "GNUPGHOME" | ||
22 | , appdir = ".gnupg" | ||
23 | , optfile_alts = ["keys.conf","gpg.conf-2","gpg.conf"] | ||
24 | } | ||
25 | |||
14 | data KeyRing | 26 | data KeyRing |
15 | 27 | ||
16 | todo = error "unimplemented" | 28 | todo = 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 | ||
64 | homevar = "GNUPGHOME" | ||
65 | appdir = ".gnupg" | ||
66 | optfile_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 |
70 | lookupEnv var = | 78 | lookupEnv var = |