diff options
author | Joe Crayne <joe@jerkface.net> | 2019-07-13 21:18:22 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-07-13 21:18:22 -0400 |
commit | 3f29bdc88a068ec3eab91a8bac12757e3a106ceb (patch) | |
tree | 09507dcfed5524694a2280fd11fb607023f7ce8b /kiki.hs | |
parent | cc6775a52107f5425d668a4831f475d05dc113b5 (diff) |
Finished encapsulation of KeyDB.
Diffstat (limited to 'kiki.hs')
-rw-r--r-- | kiki.hs | 40 |
1 files changed, 19 insertions, 21 deletions
@@ -225,38 +225,37 @@ show_wk :: FilePath | |||
225 | -> Maybe [Char] -> KeyDB -> IO () | 225 | -> Maybe [Char] -> KeyDB -> IO () |
226 | show_wk secring_file grip db = do | 226 | show_wk secring_file grip db = do |
227 | -- printf "show_wk(%s,%s,%s)\n" (show secring_file) (show grip) (show db) | 227 | -- printf "show_wk(%s,%s,%s)\n" (show secring_file) (show grip) (show db) |
228 | let sec_db = Map.filter gripmatch (byKeyKey db) | 228 | let gripmatch (KeyData p _ _ _) = |
229 | gripmatch (KeyData p _ _ _) = | ||
230 | Map.member secring_file (locations p) | 229 | Map.member secring_file (locations p) |
231 | || Map.member "&secret" (locations p) | 230 | || Map.member "&secret" (locations p) |
232 | Message sec = flattenKeys False sec_db | 231 | Message sec = flattenFiltered False gripmatch db |
233 | putStrLn $ listKeysFiltered (maybeToList grip) sec | 232 | putStrLn $ listKeysFiltered (maybeToList grip) sec |
234 | 233 | ||
235 | debug_dump :: FilePath -> p -> KeyDB -> IO () | 234 | debug_dump :: FilePath -> p -> KeyDB -> IO () |
236 | debug_dump secring_file grip db = do | 235 | debug_dump secring_file grip db = do |
237 | let sec_db = Map.filter gripmatch (byKeyKey db) | 236 | let gripmatch (KeyData p _ _ _) = |
238 | gripmatch (KeyData p _ _ _) = | ||
239 | Map.member secring_file (locations p) | 237 | Map.member secring_file (locations p) |
240 | || Map.member "&secret" (locations p) | 238 | || Map.member "&secret" (locations p) |
241 | Message sec = flattenKeys False sec_db | 239 | Message sec = flattenFiltered False gripmatch db |
242 | mapM_ print sec | 240 | mapM_ print sec |
243 | 241 | ||
244 | show_all :: KeyDB -> IO () | 242 | show_all :: KeyDB -> IO () |
245 | show_all db = do | 243 | show_all db = do |
246 | let Message packets = flattenKeys True (byKeyKey db) | 244 | let Message packets = flattenFiltered True (const True) db |
247 | putStrLn $ listKeys packets | 245 | putStrLn $ listKeys packets |
248 | 246 | ||
249 | show_packets :: (Eq a, IsString a) => | 247 | show_packets :: (Eq a, IsString a) => |
250 | [a] -> KeyDB -> IO () | 248 | [a] -> KeyDB -> IO () |
251 | show_packets puborsec db = do | 249 | show_packets puborsec db = do |
252 | let Message packets = flattenKeys (case puborsec of { "sec":_ -> False; _ -> True }) | 250 | let Message packets = flattenFiltered (case puborsec of { "sec":_ -> False; _ -> True }) |
253 | (byKeyKey db) | 251 | (const True) |
252 | db | ||
254 | forM_ packets $ putStrLn . showPacket | 253 | forM_ packets $ putStrLn . showPacket |
255 | 254 | ||
256 | show_whose_key :: Maybe RSAPublicKey -> KeyDB -> IO () | 255 | show_whose_key :: Maybe RSAPublicKey -> KeyDB -> IO () |
257 | show_whose_key input_key db = | 256 | show_whose_key input_key db = |
258 | flip (maybe $ return ()) input_key $ \input_key -> do | 257 | flip (maybe $ return ()) input_key $ \input_key -> do |
259 | let ks = whoseKey input_key (byKeyKey db) | 258 | let ks = whoseKey input_key db |
260 | case ks of | 259 | case ks of |
261 | [KeyData k _ uids _] -> do | 260 | [KeyData k _ uids _] -> do |
262 | putStrLn $ fingerprint (packet k) | 261 | putStrLn $ fingerprint (packet k) |
@@ -291,7 +290,7 @@ show_id :: String -> p -> KeyDB -> IO () | |||
291 | show_id keyspec wkgrip db = do | 290 | show_id keyspec wkgrip db = do |
292 | let s = parseSpec "" keyspec | 291 | let s = parseSpec "" keyspec |
293 | let ps = do | 292 | let ps = do |
294 | (_,k) <- filterMatches (fst s) (Map.toList $ byKeyKey db) | 293 | (_,k) <- filterMatches (fst s) (kkData db) |
295 | mp <- flattenTop "" True k | 294 | mp <- flattenTop "" True k |
296 | return $ packet mp | 295 | return $ packet mp |
297 | -- putStrLn $ "show key " ++ show s | 296 | -- putStrLn $ "show key " ++ show s |
@@ -416,8 +415,8 @@ bitcoinAddress network_id k = address | |||
416 | ripemd160 x = convert (Crypto.Hash.hash x :: Digest RIPEMD160) :: S.ByteString | 415 | ripemd160 x = convert (Crypto.Hash.hash x :: Digest RIPEMD160) :: S.ByteString |
417 | address = base58_encode hsh | 416 | address = base58_encode hsh |
418 | 417 | ||
419 | whoseKey :: RSAPublicKey -> Map.Map KeyKey KeyData -> [KeyData] | 418 | whoseKey :: RSAPublicKey -> KeyDB -> [KeyData] |
420 | whoseKey rsakey db = filter matchkey (Map.elems db) | 419 | whoseKey rsakey db = filter matchkey (keyData db) |
421 | where | 420 | where |
422 | matchkey (KeyData k _ _ subs) = | 421 | matchkey (KeyData k _ _ subs) = |
423 | any (ismatch k) $ Map.elems subs | 422 | any (ismatch k) $ Map.elems subs |
@@ -1656,7 +1655,7 @@ tarContent rt spec pubpem knownhosts secpem = ipsecs ++ sshs ++ secrets "root" | |||
1656 | where | 1655 | where |
1657 | ipsecs = do | 1656 | ipsecs = do |
1658 | (kk,ipsec,sigs) <- selectPublicKeyAndSigs (KeyUidMatch "",Just "ipsec") (rtKeyDB rt) | 1657 | (kk,ipsec,sigs) <- selectPublicKeyAndSigs (KeyUidMatch "",Just "ipsec") (rtKeyDB rt) |
1659 | let kd = (byKeyKey (rtKeyDB rt) Map.! kk) | 1658 | let kd = fromJust $ lookupKeyData kk (rtKeyDB rt) |
1660 | Hostnames addr onames ns _ = getHostnames kd | 1659 | Hostnames addr onames ns _ = getHostnames kd |
1661 | oname <- onames | 1660 | oname <- onames |
1662 | return ("etc/ipsec.d/certs/" ++ Char8.unpack oname ++ ".pem", pubpem ns addr ipsec sigs) | 1661 | return ("etc/ipsec.d/certs/" ++ Char8.unpack oname ++ ".pem", pubpem ns addr ipsec sigs) |
@@ -1668,15 +1667,14 @@ tarContent rt spec pubpem knownhosts secpem = ipsecs ++ sshs ++ secrets "root" | |||
1668 | secrets_kd = case fst . parseSpec "" <$> (++"/") <$> spec of | 1667 | secrets_kd = case fst . parseSpec "" <$> (++"/") <$> spec of |
1669 | _ | spec == Just "-" || spec == Just "" | 1668 | _ | spec == Just "-" || spec == Just "" |
1670 | -> maybeToList (rtWorkingKey rt) | 1669 | -> maybeToList (rtWorkingKey rt) |
1671 | >>= return . (Map.!) (byKeyKey $ rtKeyDB rt) . keykey | 1670 | >>= return . fromJust . (`lookupKeyData` rtKeyDB rt) . keykey |
1672 | Just topspec | 1671 | Just topspec |
1673 | -> map snd $ filterMatches topspec $ Map.toList $ byKeyKey $ rtKeyDB rt | 1672 | -> map snd $ filterMatches topspec $ kkData $ rtKeyDB rt |
1674 | w -> [] | 1673 | w -> [] |
1675 | 1674 | ||
1676 | lookupSecret tag kd = maybeToList $ selectSecretKey (KeyGrip "",Just tag) m | 1675 | lookupSecret tag kd = take 1 $ snd $ (\(y:ys) -> seek_key (KeyTag y tag) ys) |
1677 | where | 1676 | $ snd $ seek_key (KeyGrip "") |
1678 | m = KeyDB { byKeyKey = Map.singleton (keykey $ keyPacket kd) kd | 1677 | $ map packet $ flattenTop "" False kd |
1679 | } | ||
1680 | 1678 | ||
1681 | dir :: FilePath -> FilePath | 1679 | dir :: FilePath -> FilePath |
1682 | dir d = d -- TODO: prepend prefix path? | 1680 | dir d = d -- TODO: prepend prefix path? |
@@ -1746,7 +1744,7 @@ tarC (sargs,margs) = do | |||
1746 | knownhost (kk,hostkey,sigs) = Char8.intercalate "," ns <> " " <> Char8.pack (sshblobFromPacket hostkey) | 1744 | knownhost (kk,hostkey,sigs) = Char8.intercalate "," ns <> " " <> Char8.pack (sshblobFromPacket hostkey) |
1747 | where | 1745 | where |
1748 | ns = onames ++ others | 1746 | ns = onames ++ others |
1749 | Hostnames _ onames others _ = getHostnames $ byKeyKey (rtKeyDB rt) Map.! kk | 1747 | Hostnames _ onames others _ = getHostnames $ fromJust $ lookupKeyData kk (rtKeyDB rt) |
1750 | 1748 | ||
1751 | build_secret :: Num t => KeyRingRuntime -> Packet -> (t, Either (IO (Maybe Char8.ByteString)) b) | 1749 | build_secret :: Num t => KeyRingRuntime -> Packet -> (t, Either (IO (Maybe Char8.ByteString)) b) |
1752 | build_secret rt k = ( fromIntegral $ timestamp k | 1750 | build_secret rt k = ( fromIntegral $ timestamp k |