diff options
Diffstat (limited to 'kiki.hs')
-rw-r--r-- | kiki.hs | 52 |
1 files changed, 44 insertions, 8 deletions
@@ -29,8 +29,14 @@ import System.Environment | |||
29 | import System.Exit | 29 | import System.Exit |
30 | import System.IO (hPutStrLn,stderr) | 30 | import System.IO (hPutStrLn,stderr) |
31 | import qualified Codec.Binary.Base64 as Base64 | 31 | import qualified Codec.Binary.Base64 as Base64 |
32 | import qualified Crypto.Hash.RIPEMD160 as RIPEMD160 | 32 | #if !defined(VERSION_cryptonite) |
33 | -- import qualified Crypto.Hash.RIPEMD160 as RIPEMD160 | ||
33 | import qualified Crypto.Hash.SHA256 as SHA256 | 34 | import qualified Crypto.Hash.SHA256 as SHA256 |
35 | #else | ||
36 | import Crypto.Hash.Algorithms (RIPEMD160(..)) | ||
37 | import Crypto.Hash | ||
38 | import Data.ByteArray (convert) | ||
39 | #endif | ||
34 | import qualified Data.ByteString as S | 40 | import qualified Data.ByteString as S |
35 | import qualified Data.ByteString.Lazy as L | 41 | import qualified Data.ByteString.Lazy as L |
36 | import qualified Data.ByteString.Lazy.Char8 as Char8 | 42 | import qualified Data.ByteString.Lazy.Char8 as Char8 |
@@ -38,6 +44,7 @@ import qualified Data.Map as Map | |||
38 | import Control.Arrow (first,second) | 44 | import Control.Arrow (first,second) |
39 | import Data.Time.Clock.POSIX ( posixSecondsToUTCTime ) | 45 | import Data.Time.Clock.POSIX ( posixSecondsToUTCTime ) |
40 | import Data.Monoid ( (<>) ) | 46 | import Data.Monoid ( (<>) ) |
47 | import Data.Binary.Put | ||
41 | 48 | ||
42 | import Data.OpenPGP.Util (verify,fingerprint) | 49 | import Data.OpenPGP.Util (verify,fingerprint) |
43 | import ScanningParser | 50 | import ScanningParser |
@@ -50,6 +57,7 @@ import qualified CryptoCoins | |||
50 | import ProcessUtils | 57 | import ProcessUtils |
51 | import qualified SSHKey as SSH | 58 | import qualified SSHKey as SSH |
52 | import Text.Printf | 59 | import Text.Printf |
60 | import qualified DNSKey as DNS | ||
53 | 61 | ||
54 | -- {-# ANN module ("HLint: ignore Eta reduce"::String) #-} | 62 | -- {-# ANN module ("HLint: ignore Eta reduce"::String) #-} |
55 | -- {-# ANN module ("HLint: ignore Use camelCase"::String) #-} | 63 | -- {-# ANN module ("HLint: ignore Use camelCase"::String) #-} |
@@ -279,13 +287,15 @@ show_whose_key input_key db = | |||
279 | (_:_) -> error "ambiguous" | 287 | (_:_) -> error "ambiguous" |
280 | [] -> return () | 288 | [] -> return () |
281 | 289 | ||
282 | show_pem keyspec wkgrip db = either warn putStrLn $ show_pem' keyspec wkgrip db | 290 | show_dns keyspec wkgrip db = either warn putStrLn $ show_pem' keyspec wkgrip db dnsPresentationFromPacket |
283 | 291 | ||
284 | show_pem' keyspec wkgrip db = do | 292 | show_pem keyspec wkgrip db = either warn putStrLn $ show_pem' keyspec wkgrip db pemFromPacket |
293 | |||
294 | show_pem' keyspec wkgrip db keyfmt = do | ||
285 | let s = parseSpec wkgrip keyspec | 295 | let s = parseSpec wkgrip keyspec |
286 | flip (maybe . Left $ keyspec ++ ": not found") | 296 | flip (maybe . Left $ keyspec ++ ": not found") |
287 | (selectPublicKey s db) | 297 | (selectPublicKey s db) |
288 | pemFromPacket | 298 | keyfmt |
289 | 299 | ||
290 | pemFromPacket k = do | 300 | pemFromPacket k = do |
291 | let rsa = pkcs8 . fromJust $ rsaKeyFromPacket k | 301 | let rsa = pkcs8 . fromJust $ rsaKeyFromPacket k |
@@ -294,6 +304,15 @@ pemFromPacket k = do | |||
294 | return $ | 304 | return $ |
295 | writePEM "PUBLIC KEY" qq -- ("TODO "++show keyspec) | 305 | writePEM "PUBLIC KEY" qq -- ("TODO "++show keyspec) |
296 | 306 | ||
307 | dnsPresentationFromPacket k = do | ||
308 | let RSAKey (MPI n) (MPI e) = fromJust $ rsaKeyFromPacket k | ||
309 | dnskey = DNS.RSA n e | ||
310 | bin = runPut (DNS.putRSA dnskey) | ||
311 | qq = Base64.encode (L.unpack bin) | ||
312 | return $ | ||
313 | writePEM "FIXME PUBLIC KEY" qq -- ("TODO "++show keyspec) | ||
314 | |||
315 | |||
297 | show_ssh keyspec wkgrip db = either warn putStrLn $ show_ssh' keyspec wkgrip db | 316 | show_ssh keyspec wkgrip db = either warn putStrLn $ show_ssh' keyspec wkgrip db |
298 | 317 | ||
299 | show_ssh' keyspec wkgrip db = do | 318 | show_ssh' keyspec wkgrip db = do |
@@ -331,6 +350,8 @@ show_torhash pubkey _ = do | |||
331 | asn1 <- either (const Nothing) (Just) e | 350 | asn1 <- either (const Nothing) (Just) e |
332 | k <- either (const Nothing) (Just . fst) (fromASN1 asn1) | 351 | k <- either (const Nothing) (Just . fst) (fromASN1 asn1) |
333 | return $ f (packetFromPublicRSAKey undefined) k | 352 | return $ f (packetFromPublicRSAKey undefined) k |
353 | |||
354 | addy :: String -> String | ||
334 | addy hsh = take 16 hsh ++ ".onion " ++ hsh | 355 | addy hsh = take 16 hsh ++ ".onion " ++ hsh |
335 | pkcs1 = fmap ( parsekey (\f (RSAKey n e) -> f n e) . pemBlob ) | 356 | pkcs1 = fmap ( parsekey (\f (RSAKey n e) -> f n e) . pemBlob ) |
336 | $ pemParser (Just "RSA PUBLIC KEY") | 357 | $ pemParser (Just "RSA PUBLIC KEY") |
@@ -421,8 +442,14 @@ bitcoinAddress network_id k = address | |||
421 | Just (MPI x) = lookup 'x' (key k) | 442 | Just (MPI x) = lookup 'x' (key k) |
422 | Just (MPI y) = lookup 'y' (key k) | 443 | Just (MPI y) = lookup 'y' (key k) |
423 | pub = cannonical_eckey x y | 444 | pub = cannonical_eckey x y |
424 | hash = S.cons network_id . RIPEMD160.hash . SHA256.hash . S.pack $ pub | 445 | #if !defined(VERSION_cryptonite) |
425 | address = base58_encode hash | 446 | hsh = S.cons network_id . RIPEMD160.hash . SHA256.hash . S.pack $ pub |
447 | #else | ||
448 | hsh = S.cons network_id . ripemd160 . sha256 . S.pack $ pub | ||
449 | sha256 x = convert (Crypto.Hash.hash x :: Digest SHA256) :: S.ByteString | ||
450 | ripemd160 x = convert (Crypto.Hash.hash x :: Digest RIPEMD160) :: S.ByteString | ||
451 | #endif | ||
452 | address = base58_encode hsh | ||
426 | 453 | ||
427 | whoseKey :: RSAPublicKey -> KeyDB -> [KeyData] | 454 | whoseKey :: RSAPublicKey -> KeyDB -> [KeyData] |
428 | whoseKey rsakey db = filter matchkey (Map.elems db) | 455 | whoseKey rsakey db = filter matchkey (Map.elems db) |
@@ -484,6 +511,11 @@ kiki_usage bExport bImport bSecret cmd = putStr $ | |||
484 | ," Shows the fingerprint and UIDs of the key that owns the one that" | 511 | ," Shows the fingerprint and UIDs of the key that owns the one that" |
485 | ," is input on stdin in ssh-rsa format." | 512 | ," is input on stdin in ssh-rsa format." |
486 | ,"" | 513 | ,"" |
514 | ," --dns SPEC" | ||
515 | ," Outputs the DNSKEY presentation format (RFC3110) of the public key" | ||
516 | ," corresponding to SPEC." | ||
517 | ," (See 'kiki help spec' for more information.)" | ||
518 | ,"" | ||
487 | ," --pem SPEC" | 519 | ," --pem SPEC" |
488 | ," Outputs the PKCS #8 public key corresponding to SPEC." | 520 | ," Outputs the PKCS #8 public key corresponding to SPEC." |
489 | ," (See 'kiki help spec' for more information.)" | 521 | ," (See 'kiki help spec' for more information.)" |
@@ -1130,6 +1162,7 @@ kiki "show" args = do | |||
1130 | , ("--whose-key",0) | 1162 | , ("--whose-key",0) |
1131 | , ("--key",1) | 1163 | , ("--key",1) |
1132 | , ("--pem",1) | 1164 | , ("--pem",1) |
1165 | , ("--dns",1) | ||
1133 | , ("--ssh",1) | 1166 | , ("--ssh",1) |
1134 | , ("--wip",1) | 1167 | , ("--wip",1) |
1135 | , ("--cert",1) | 1168 | , ("--cert",1) |
@@ -1180,6 +1213,7 @@ kiki "show" args = do | |||
1180 | ,("--whose-key", const $ show_whose_key input_key) | 1213 | ,("--whose-key", const $ show_whose_key input_key) |
1181 | ,("--key",\[x] -> show_id x $ fromMaybe "" grip) | 1214 | ,("--key",\[x] -> show_id x $ fromMaybe "" grip) |
1182 | ,("--pem",\[x] -> show_pem x $ fromMaybe "" grip) | 1215 | ,("--pem",\[x] -> show_pem x $ fromMaybe "" grip) |
1216 | ,("--dns",\[x] -> show_dns x $ fromMaybe "" grip) | ||
1183 | ,("--ssh",\[x] -> show_ssh x $ fromMaybe "" grip) | 1217 | ,("--ssh",\[x] -> show_ssh x $ fromMaybe "" grip) |
1184 | ,("--wip",\[x] -> show_wip x $ fromMaybe "" grip) | 1218 | ,("--wip",\[x] -> show_wip x $ fromMaybe "" grip) |
1185 | ,("--cert",\[x] -> show_cert x $ fromMaybe "" grip) | 1219 | ,("--cert",\[x] -> show_cert x $ fromMaybe "" grip) |
@@ -1253,6 +1287,7 @@ kiki "merge" args = do | |||
1253 | w:xs -> w:map (drop 1) xs | 1287 | w:xs -> w:map (drop 1) xs |
1254 | [] -> [] | 1288 | [] -> [] |
1255 | (goods,bads) = partition acceptable ws | 1289 | (goods,bads) = partition acceptable ws |
1290 | acceptable :: String -> Bool | ||
1256 | acceptable "spill" = True | 1291 | acceptable "spill" = True |
1257 | acceptable "fill" = True | 1292 | acceptable "fill" = True |
1258 | acceptable "sync" = True | 1293 | acceptable "sync" = True |
@@ -1496,7 +1531,7 @@ kiki "init-key" args = do | |||
1496 | goti <- doesFileExist (ipsecpathpub) | 1531 | goti <- doesFileExist (ipsecpathpub) |
1497 | when (not goti) $ do | 1532 | when (not goti) $ do |
1498 | either warn (writeFile $ ipsecpathpub) | 1533 | either warn (writeFile $ ipsecpathpub) |
1499 | $ show_pem' "strongswan" grip (rtKeyDB rt) | 1534 | $ show_pem' "strongswan" grip (rtKeyDB rt) pemFromPacket |
1500 | else return () | 1535 | else return () |
1501 | 1536 | ||
1502 | 1537 | ||
@@ -1585,7 +1620,8 @@ interp vars raw = es >>= interp1 | |||
1585 | where | 1620 | where |
1586 | gs = groupBy (\_ c -> c/='%') raw | 1621 | gs = groupBy (\_ c -> c/='%') raw |
1587 | es = dropWhile null $ gobbleEscapes ("":gs) | 1622 | es = dropWhile null $ gobbleEscapes ("":gs) |
1588 | where gobbleEscapes (a:"%":b:bs) = (a++b) : gobbleEscapes bs | 1623 | where gobbleEscapes :: [String] -> [String] |
1624 | gobbleEscapes (a:"%":b:bs) = (a++b) : gobbleEscapes bs | ||
1589 | gobbleEscapes (g:gs) = g : gobbleEscapes gs | 1625 | gobbleEscapes (g:gs) = g : gobbleEscapes gs |
1590 | gobbleEscapes [] = [] | 1626 | gobbleEscapes [] = [] |
1591 | interp1 ('%':'(':str) = fromMaybe "" (Map.lookup key vars) ++ drop 1 rest | 1627 | interp1 ('%':'(':str) = fromMaybe "" (Map.lookup key vars) ++ drop 1 rest |