summaryrefslogtreecommitdiff
path: root/kiki.hs
diff options
context:
space:
mode:
Diffstat (limited to 'kiki.hs')
-rw-r--r--kiki.hs52
1 files changed, 44 insertions, 8 deletions
diff --git a/kiki.hs b/kiki.hs
index 2d926a8..316da90 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -29,8 +29,14 @@ import System.Environment
29import System.Exit 29import System.Exit
30import System.IO (hPutStrLn,stderr) 30import System.IO (hPutStrLn,stderr)
31import qualified Codec.Binary.Base64 as Base64 31import qualified Codec.Binary.Base64 as Base64
32import qualified Crypto.Hash.RIPEMD160 as RIPEMD160 32#if !defined(VERSION_cryptonite)
33-- import qualified Crypto.Hash.RIPEMD160 as RIPEMD160
33import qualified Crypto.Hash.SHA256 as SHA256 34import qualified Crypto.Hash.SHA256 as SHA256
35#else
36import Crypto.Hash.Algorithms (RIPEMD160(..))
37import Crypto.Hash
38import Data.ByteArray (convert)
39#endif
34import qualified Data.ByteString as S 40import qualified Data.ByteString as S
35import qualified Data.ByteString.Lazy as L 41import qualified Data.ByteString.Lazy as L
36import qualified Data.ByteString.Lazy.Char8 as Char8 42import qualified Data.ByteString.Lazy.Char8 as Char8
@@ -38,6 +44,7 @@ import qualified Data.Map as Map
38import Control.Arrow (first,second) 44import Control.Arrow (first,second)
39import Data.Time.Clock.POSIX ( posixSecondsToUTCTime ) 45import Data.Time.Clock.POSIX ( posixSecondsToUTCTime )
40import Data.Monoid ( (<>) ) 46import Data.Monoid ( (<>) )
47import Data.Binary.Put
41 48
42import Data.OpenPGP.Util (verify,fingerprint) 49import Data.OpenPGP.Util (verify,fingerprint)
43import ScanningParser 50import ScanningParser
@@ -50,6 +57,7 @@ import qualified CryptoCoins
50import ProcessUtils 57import ProcessUtils
51import qualified SSHKey as SSH 58import qualified SSHKey as SSH
52import Text.Printf 59import Text.Printf
60import 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
282show_pem keyspec wkgrip db = either warn putStrLn $ show_pem' keyspec wkgrip db 290show_dns keyspec wkgrip db = either warn putStrLn $ show_pem' keyspec wkgrip db dnsPresentationFromPacket
283 291
284show_pem' keyspec wkgrip db = do 292show_pem keyspec wkgrip db = either warn putStrLn $ show_pem' keyspec wkgrip db pemFromPacket
293
294show_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
290pemFromPacket k = do 300pemFromPacket 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
307dnsPresentationFromPacket 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
297show_ssh keyspec wkgrip db = either warn putStrLn $ show_ssh' keyspec wkgrip db 316show_ssh keyspec wkgrip db = either warn putStrLn $ show_ssh' keyspec wkgrip db
298 317
299show_ssh' keyspec wkgrip db = do 318show_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
427whoseKey :: RSAPublicKey -> KeyDB -> [KeyData] 454whoseKey :: RSAPublicKey -> KeyDB -> [KeyData]
428whoseKey rsakey db = filter matchkey (Map.elems db) 455whoseKey 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