1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
{-# 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 HomeDir =
HomeDir { homevar :: String
, appdir :: String
, optfile_alts :: [String]
}
home = HomeDir
{ homevar = "GNUPGHOME"
, appdir = ".gnupg"
, optfile_alts = ["keys.conf","gpg.conf-2","gpg.conf"]
}
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 home) >>=
\d -> return $ d >>= guard . (/="") >> d
homed <- flip fmap getHomeDirectory $
\d -> fmap (const d) $ guard (d/="")
let homegnupg = (++('/':(appdir home))) <$> homed
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 home)
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
#if MIN_VERSION_base(4,6,0)
#else
lookupEnv var =
handleIO_ (return Nothing) $ fmap Just (getEnv var)
#endif
|
