diff options
-rw-r--r-- | KeyRing.hs | 60 | ||||
-rw-r--r-- | kiki.hs | 7 |
2 files changed, 42 insertions, 25 deletions
@@ -36,9 +36,13 @@ home = HomeDir | |||
36 | 36 | ||
37 | data InputFile = HomeSec | HomePub | ArgFile FilePath | FileDesc Int | 37 | data InputFile = HomeSec | HomePub | ArgFile FilePath | FileDesc Int |
38 | 38 | ||
39 | data FileType = KeyRingFile | PEMFile | WalletFile | 39 | type UsageTag = String |
40 | type Initializer = String | ||
41 | type PassWordFile = InputFile | ||
40 | 42 | ||
41 | data RefType = ConstRef | MutableRef | 43 | data FileType = KeyRingFile PassWordFile | PEMFile UsageTag | WalletFile |
44 | |||
45 | data RefType = ConstRef | MutableRef (Maybe Initializer) | ||
42 | 46 | ||
43 | 47 | ||
44 | data KeyRingRuntime = KeyRingRuntime | 48 | data KeyRingRuntime = KeyRingRuntime |
@@ -53,9 +57,22 @@ data KeyRingAction a = KeyRingAction a | RunTimeAction (KeyRingRuntime -> a) | |||
53 | 57 | ||
54 | data KeyRingData = KeyRingData | 58 | data 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 | ||
64 | filesToLock 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 | {- | 105 | runKeyRing :: KeyRingData -> (KeyRingRuntime -> a) -> IO (KikiResult a) |
89 | empty = KeyRingData { filesToLock = [] | 106 | runKeyRing keyring op = do |
90 | , homeSpec = Nothing | ||
91 | , kaction = \KeyRingRuntime {} -> return () | ||
92 | , keyringFiles = [] | ||
93 | , walletFiles = [] | ||
94 | } | ||
95 | |||
96 | runKeyRing :: KeyRingData a -> IO (KikiResult a) | ||
97 | runKeyRing 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 | ||
130 | parseOptionFile fname = do | 140 | parseOptionFile fname = do |
131 | xs <- fmap lines (readFile fname) | 141 | xs <- fmap lines (readFile fname) |
@@ -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 | ||
1953 | markForImport | ||
1954 | :: Ord d => | ||
1955 | Map.Map String a | ||
1956 | -> Maybe String | ||
1957 | -> [Char] | ||
1958 | -> Map.Map d KeyData | ||
1959 | -> IO (Map.Map d KeyData) | ||
1953 | markForImport margs grip pubring db = maybe (return db) import_db $ wantToImport | 1960 | markForImport 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 |