summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--KeyRing.hs60
-rw-r--r--kiki.hs7
2 files changed, 42 insertions, 25 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index c05e9e7..cdfcd34 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -36,9 +36,13 @@ home = HomeDir
36 36
37data InputFile = HomeSec | HomePub | ArgFile FilePath | FileDesc Int 37data InputFile = HomeSec | HomePub | ArgFile FilePath | FileDesc Int
38 38
39data FileType = KeyRingFile | PEMFile | WalletFile 39type UsageTag = String
40type Initializer = String
41type PassWordFile = InputFile
40 42
41data RefType = ConstRef | MutableRef 43data FileType = KeyRingFile PassWordFile | PEMFile UsageTag | WalletFile
44
45data RefType = ConstRef | MutableRef (Maybe Initializer)
42 46
43 47
44data KeyRingRuntime = KeyRingRuntime 48data KeyRingRuntime = KeyRingRuntime
@@ -53,9 +57,22 @@ data KeyRingAction a = KeyRingAction a | RunTimeAction (KeyRingRuntime -> a)
53 57
54data KeyRingData = KeyRingData 58data KeyRingData = KeyRingData
55 { kFiles :: Map.Map InputFile (RefType,FileType) 59 { kFiles :: Map.Map InputFile (RefType,FileType)
60 , kImports :: Map.Map String (KeyData -> Bool)
56 , homeSpec :: Maybe String 61 , homeSpec :: Maybe String
57 } 62 }
58 63
64filesToLock k secring pubring = do
65 (f,(rtyp,ftyp)) <- Map.toList (kFiles k)
66 case rtyp of
67 ConstRef -> []
68 MutableRef {} -> resolve f
69 where
70 resolve HomeSec = return secring
71 resolve HomePub = return pubring
72 resolve (ArgFile f) = return f
73 resolve _ = []
74
75
59-- kret :: a -> KeyRingData a 76-- kret :: a -> KeyRingData a
60-- kret x = KeyRingData Map.empty Nothing (KeyRingAction x) 77-- kret x = KeyRingData Map.empty Nothing (KeyRingAction x)
61 78
@@ -85,21 +102,10 @@ data KikiResult a = KikiResult
85 , kikiReport :: [ (FilePath, KikiReportAction) ] 102 , kikiReport :: [ (FilePath, KikiReportAction) ]
86 } 103 }
87 104
88{- 105runKeyRing :: KeyRingData -> (KeyRingRuntime -> a) -> IO (KikiResult a)
89empty = KeyRingData { filesToLock = [] 106runKeyRing keyring op = do
90 , homeSpec = Nothing
91 , kaction = \KeyRingRuntime {} -> return ()
92 , keyringFiles = []
93 , walletFiles = []
94 }
95
96runKeyRing :: KeyRingData a -> IO (KikiResult a)
97runKeyRing keyring = do
98 (homedir,secring,pubring,grip0) <- getHomeDir (homeSpec keyring) 107 (homedir,secring,pubring,grip0) <- getHomeDir (homeSpec keyring)
99 let tolocks = map resolve (filesToLock keyring) 108 let tolocks = filesToLock keyring secring pubring
100 where resolve (ArgFile f) = f
101 resolve HomePub = pubring
102 resolve HomeSec = secring
103 lks <- forM tolocks $ \f -> do 109 lks <- forM tolocks $ \f -> do
104 lk <- dotlock_create f 0 110 lk <- dotlock_create f 0
105 v <- flip (maybe $ return Nothing) lk $ \lk -> do 111 v <- flip (maybe $ return Nothing) lk $ \lk -> do
@@ -109,23 +115,27 @@ runKeyRing keyring = do
109 return (v,f) 115 return (v,f)
110 let (lked, map snd -> failed) = partition (isJust . fst) lks 116 let (lked, map snd -> failed) = partition (isJust . fst) lks
111 ret = if null failed then KikiSuccess () else FailedToLock failed 117 ret = if null failed then KikiSuccess () else FailedToLock failed
112
113 ret <- case functorToEither ret of 118 ret <- case functorToEither ret of
114 Right {} -> do 119 Right {} -> do
115 a <- kaction keyring KeyRingRuntime 120 report <- todo -- build db
121
122 a <- return $ op KeyRingRuntime
116 { rtPubring = pubring 123 { rtPubring = pubring
117 , rtSecring = secring 124 , rtSecring = secring
118 , rtRings = secring:pubring:keyringFiles keyring 125 , rtRings = [] -- todo secring:pubring:keyringFiles keyring
119 , rtWallets = walletFiles keyring 126 , rtWallets = [] -- todo walletFiles keyring
120 , rtGrip = grip0 127 , rtGrip = grip0
121 } 128 }
122 return (KikiSuccess a) 129 report <- todo report -- write files
123 Left err -> return err 130
131 return $ KikiResult (KikiSuccess a) report
132 Left err -> return $ KikiResult err []
124 133
125 forM_ lked $ \(Just lk, fname) -> do dotlock_release lk 134 forM_ lked $ \(Just lk, fname) -> do dotlock_release lk
126 dotlock_destroy lk 135 dotlock_destroy lk -- todo: verify we want this
127 return KikiResult { kikiCondition = ret, kikiReport = [] } 136
128-} 137 return ret
138
129 139
130parseOptionFile fname = do 140parseOptionFile fname = do
131 xs <- fmap lines (readFile fname) 141 xs <- fmap lines (readFile fname)
diff --git a/kiki.hs b/kiki.hs
index cabb721..365562b 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -1950,6 +1950,13 @@ has_good_sig wk (KeyData k sigs uids subs) = any goodsig $ Map.toList uids
1950 pre_ov <- signatures (Message [packet k, UserIDPacket uidstr, sig0]) 1950 pre_ov <- signatures (Message [packet k, UserIDPacket uidstr, sig0])
1951 signatures_over $ verify (Message [wk]) pre_ov 1951 signatures_over $ verify (Message [wk]) pre_ov
1952 1952
1953markForImport
1954 :: Ord d =>
1955 Map.Map String a
1956 -> Maybe String
1957 -> [Char]
1958 -> Map.Map d KeyData
1959 -> IO (Map.Map d KeyData)
1953markForImport margs grip pubring db = maybe (return db) import_db $ wantToImport 1960markForImport margs grip pubring db = maybe (return db) import_db $ wantToImport
1954 where wantToImport = mplus import_f importifauth_f 1961 where wantToImport = mplus import_f importifauth_f
1955 where 1962 where