diff options
author | Andrew Cady <d@jerkface.net> | 2019-07-03 15:24:53 -0400 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2019-07-03 15:24:53 -0400 |
commit | a6099f2263f3ac7688244b1406ea2891d429d41c (patch) | |
tree | f74d701415cb9c3d3b566aff19af937283acb3be /lib | |
parent | c54050cd56d4f1181ce31636b1a176b953604903 (diff) |
add type sigs
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Kiki.hs | 16 |
1 files changed, 12 insertions, 4 deletions
diff --git a/lib/Kiki.hs b/lib/Kiki.hs index 5070389..d2da996 100644 --- a/lib/Kiki.hs +++ b/lib/Kiki.hs | |||
@@ -6,8 +6,6 @@ module Kiki | |||
6 | ) where | 6 | ) where |
7 | 7 | ||
8 | import Control.Applicative | 8 | import Control.Applicative |
9 | import Control.Arrow | ||
10 | import Control.Concurrent | ||
11 | import Control.Exception | 9 | import Control.Exception |
12 | import Control.Monad | 10 | import Control.Monad |
13 | import Data.ASN1.BinaryEncoding | 11 | import Data.ASN1.BinaryEncoding |
@@ -18,7 +16,6 @@ import Data.Bool | |||
18 | import Data.Char | 16 | import Data.Char |
19 | import Data.List | 17 | import Data.List |
20 | import Data.Maybe | 18 | import Data.Maybe |
21 | import Data.Monoid | ||
22 | import Data.OpenPGP | 19 | import Data.OpenPGP |
23 | import Data.OpenPGP.Util | 20 | import Data.OpenPGP.Util |
24 | import Data.Ord | 21 | import Data.Ord |
@@ -32,7 +29,6 @@ import System.Posix.Files | |||
32 | import System.Posix.Types (FileMode) | 29 | import System.Posix.Types (FileMode) |
33 | import System.Posix.IO as Posix (createPipe) | 30 | import System.Posix.IO as Posix (createPipe) |
34 | import System.Posix.User | 31 | import System.Posix.User |
35 | import System.Process | ||
36 | #if defined(VERSION_memory) | 32 | #if defined(VERSION_memory) |
37 | import Data.ByteArray.Encoding | 33 | import Data.ByteArray.Encoding |
38 | import qualified Data.ByteString.Char8 as S8 | 34 | import qualified Data.ByteString.Char8 as S8 |
@@ -55,11 +51,13 @@ withAgent :: [PassphraseSpec] -> [PassphraseSpec] | |||
55 | withAgent [] = [PassphraseAgent] | 51 | withAgent [] = [PassphraseAgent] |
56 | withAgent ps = ps | 52 | withAgent ps = ps |
57 | 53 | ||
54 | ciphername :: SymmetricAlgorithm -> String | ||
58 | ciphername Unencrypted = "-" | 55 | ciphername Unencrypted = "-" |
59 | ciphername TripleDES = "3des" | 56 | ciphername TripleDES = "3des" |
60 | ciphername (SymmetricAlgorithm w8) = "cipher-"++show w8 | 57 | ciphername (SymmetricAlgorithm w8) = "cipher-"++show w8 |
61 | ciphername c = map toLower $ show c | 58 | ciphername c = map toLower $ show c |
62 | 59 | ||
60 | cipherFromString :: String -> SymmetricAlgorithm | ||
63 | cipherFromString "clear" = Unencrypted | 61 | cipherFromString "clear" = Unencrypted |
64 | cipherFromString "unencrypted" = Unencrypted | 62 | cipherFromString "unencrypted" = Unencrypted |
65 | cipherFromString s = | 63 | cipherFromString s = |
@@ -572,6 +570,7 @@ strongswanForContact addr oname rightip = Char8.unlines | |||
572 | -- rightid=fdcc:76c8:cb34:74e6:2aa3:cb39:abc8:d403 | 570 | -- rightid=fdcc:76c8:cb34:74e6:2aa3:cb39:abc8:d403 |
573 | -- rightrsasigkey=hiotuxliwisbp6mi.onion.pem | 571 | -- rightrsasigkey=hiotuxliwisbp6mi.onion.pem |
574 | 572 | ||
573 | showA :: SockAddr -> String | ||
575 | showA addr = if null bracket then pre else drop 1 pre | 574 | showA addr = if null bracket then pre else drop 1 pre |
576 | where (pre,bracket) = break (==']') (show addr) | 575 | where (pre,bracket) = break (==']') (show addr) |
577 | 576 | ||
@@ -582,6 +581,7 @@ sortOn f = | |||
582 | map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x)) | 581 | map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x)) |
583 | #endif | 582 | #endif |
584 | 583 | ||
584 | pemFromPacket :: Monad m => Packet -> m String | ||
585 | pemFromPacket k = do | 585 | pemFromPacket k = do |
586 | let rsa = pkcs8 . fromJust $ rsaKeyFromPacket k | 586 | let rsa = pkcs8 . fromJust $ rsaKeyFromPacket k |
587 | der = encodeASN1 DER (toASN1 rsa []) | 587 | der = encodeASN1 DER (toASN1 rsa []) |
@@ -593,18 +593,23 @@ pemFromPacket k = do | |||
593 | return $ | 593 | return $ |
594 | writePEM "PUBLIC KEY" qq -- ("TODO "++show keyspec) | 594 | writePEM "PUBLIC KEY" qq -- ("TODO "++show keyspec) |
595 | 595 | ||
596 | show_pem :: String -> String -> KeyDB -> IO () | ||
596 | show_pem keyspec wkgrip db = either warn putStrLn $ show_pem' keyspec wkgrip db pemFromPacket | 597 | show_pem keyspec wkgrip db = either warn putStrLn $ show_pem' keyspec wkgrip db pemFromPacket |
597 | 598 | ||
599 | show_pem' :: String -> String -> KeyDB -> (Packet -> Either String b) -> Either String b | ||
598 | show_pem' keyspec wkgrip db keyfmt = do | 600 | show_pem' keyspec wkgrip db keyfmt = do |
599 | let s = parseSpec wkgrip keyspec | 601 | let s = parseSpec wkgrip keyspec |
600 | flip (maybe . Left $ keyspec ++ ": not found") | 602 | flip (maybe . Left $ keyspec ++ ": not found") |
601 | (selectPublicKey s db) | 603 | (selectPublicKey s db) |
602 | keyfmt | 604 | keyfmt |
603 | 605 | ||
606 | warn :: String -> IO () | ||
604 | warn str = hPutStrLn stderr str | 607 | warn str = hPutStrLn stderr str |
605 | 608 | ||
609 | show_ssh :: String -> String -> KeyDB -> IO () | ||
606 | show_ssh keyspec wkgrip db = either warn putStrLn $ show_ssh' keyspec wkgrip db | 610 | show_ssh keyspec wkgrip db = either warn putStrLn $ show_ssh' keyspec wkgrip db |
607 | 611 | ||
612 | show_ssh' :: String -> String -> KeyDB -> Either String String | ||
608 | show_ssh' keyspec wkgrip db = do | 613 | show_ssh' keyspec wkgrip db = do |
609 | let s = parseSpec wkgrip keyspec | 614 | let s = parseSpec wkgrip keyspec |
610 | flip (maybe . Left $ keyspec ++ ": not found") | 615 | flip (maybe . Left $ keyspec ++ ": not found") |
@@ -613,6 +618,7 @@ show_ssh' keyspec wkgrip db = do | |||
613 | 618 | ||
614 | -- | | 619 | -- | |
615 | -- interpolate %var patterns in a string. | 620 | -- interpolate %var patterns in a string. |
621 | interp :: Map.Map String String -> String -> String | ||
616 | interp vars raw = es >>= interp1 | 622 | interp vars raw = es >>= interp1 |
617 | where | 623 | where |
618 | gs = groupBy (\_ c -> c/='%') raw | 624 | gs = groupBy (\_ c -> c/='%') raw |
@@ -625,8 +631,10 @@ interp vars raw = es >>= interp1 | |||
625 | where (key,rest) = break (==')') str | 631 | where (key,rest) = break (==')') str |
626 | interp1 plain = plain | 632 | interp1 plain = plain |
627 | 633 | ||
634 | sshblobFromPacket :: Packet -> String | ||
628 | sshblobFromPacket k = Char8.unpack $ fromJust $ sshblobFromPacketL k | 635 | sshblobFromPacket k = Char8.unpack $ fromJust $ sshblobFromPacketL k |
629 | 636 | ||
637 | sshblobFromPacketL :: Packet -> Maybe Char8.ByteString | ||
630 | sshblobFromPacketL k = do | 638 | sshblobFromPacketL k = do |
631 | RSAKey (MPI n) (MPI e) <- rsaKeyFromPacket k | 639 | RSAKey (MPI n) (MPI e) <- rsaKeyFromPacket k |
632 | return $ SSH.keyblob (n,e) | 640 | return $ SSH.keyblob (n,e) |