summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndrew Cady <d@jerkface.net>2019-07-16 17:51:31 -0400
committerAndrew Cady <d@jerkface.net>2019-07-16 17:52:10 -0400
commit7a94f5103671011295f818bfcf30280423c44042 (patch)
tree118d6a1d76d74e09e6a2dbef8ef49b8390a116cd
parentf07d60d9c0ff8673a264e984c90bc478987ef873 (diff)
use more Fingerprint WIP
-rw-r--r--kiki.hs6
-rw-r--r--lib/KeyRing/BuildKeyDB.hs4
-rw-r--r--lib/KeyRing/Types.hs13
-rw-r--r--lib/Kiki.hs6
4 files changed, 12 insertions, 17 deletions
diff --git a/kiki.hs b/kiki.hs
index 6b3d36e..9b78e8f 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -16,7 +16,6 @@ import Data.Binary
16import Data.Bits 16import Data.Bits
17import Data.Char 17import Data.Char
18import Data.IORef 18import Data.IORef
19import Data.Int
20import Data.List 19import Data.List
21import Data.Maybe 20import Data.Maybe
22import Data.OpenPGP 21import Data.OpenPGP
@@ -24,15 +23,11 @@ import Data.Ord
24import Data.String 23import Data.String
25import Text.Show.Pretty as PP ( ppShow ) 24import Text.Show.Pretty as PP ( ppShow )
26import Data.Text.Encoding 25import Data.Text.Encoding
27import System.Posix.Files
28import Foreign.C.Types (CTime(..))
29import System.Environment 26import System.Environment
30import System.Exit 27import System.Exit
31import System.IO (hPutStrLn,stderr) 28import System.IO (hPutStrLn,stderr)
32import qualified Data.ByteString.Char8 as S8 29import qualified Data.ByteString.Char8 as S8
33import Data.ByteArray.Encoding 30import Data.ByteArray.Encoding
34import qualified Codec.Archive.Tar as Tar
35import qualified Codec.Archive.Tar.Entry as Tar
36import Crypto.Hash.Algorithms (RIPEMD160(..)) 31import Crypto.Hash.Algorithms (RIPEMD160(..))
37import Crypto.Hash 32import Crypto.Hash
38import Data.ByteArray (convert) 33import Data.ByteArray (convert)
@@ -59,7 +54,6 @@ import qualified DNSKey as DNS
59import Data.Time.Clock.POSIX ( posixSecondsToUTCTime ) 54import Data.Time.Clock.POSIX ( posixSecondsToUTCTime )
60import Kiki 55import Kiki
61import KeyDB 56import KeyDB
62import Network.Socket (SockAddr)
63import FunctorToMaybe 57import FunctorToMaybe
64 58
65-- {-# ANN module ("HLint: ignore Eta reduce"::String) #-} 59-- {-# ANN module ("HLint: ignore Eta reduce"::String) #-}
diff --git a/lib/KeyRing/BuildKeyDB.hs b/lib/KeyRing/BuildKeyDB.hs
index 90f7292..461afa2 100644
--- a/lib/KeyRing/BuildKeyDB.hs
+++ b/lib/KeyRing/BuildKeyDB.hs
@@ -35,7 +35,7 @@ import Data.List
35import qualified Data.Map as Map 35import qualified Data.Map as Map
36import Data.Maybe 36import Data.Maybe
37import Data.OpenPGP 37import Data.OpenPGP
38import Data.OpenPGP.Util (GenerateKeyParams (..), fingerprint, generateKey, pgpSign, verify) 38import Data.OpenPGP.Util (Fingerprint, GenerateKeyParams (..), fingerprint, generateKey, pgpSign, verify)
39 39
40 40
41import Data.Time.Clock (UTCTime) 41import Data.Time.Clock (UTCTime)
@@ -408,7 +408,7 @@ usageFromFilter _ = mzero
408 408
409-- | Parse a key specification. 409-- | Parse a key specification.
410-- The first argument is a grip for the default working key. 410-- The first argument is a grip for the default working key.
411parseSpec :: String -> String -> (KeySpec,Maybe String) 411parseSpec :: Fingerprint -> String -> (KeySpec,Maybe String)
412parseSpec wkgrip spec = 412parseSpec wkgrip spec =
413 if not slashed 413 if not slashed
414 then 414 then
diff --git a/lib/KeyRing/Types.hs b/lib/KeyRing/Types.hs
index 5318b31..1177789 100644
--- a/lib/KeyRing/Types.hs
+++ b/lib/KeyRing/Types.hs
@@ -349,14 +349,15 @@ isTrust _ = False
349-- 349--
350-- matchpr fp = Data.List.Extra.takeEnd (length fp) 350-- matchpr fp = Data.List.Extra.takeEnd (length fp)
351-- 351--
352matchpr :: String -> Packet -> String 352matchpr :: Fingerprint -> Packet -> Bool
353matchpr fp k = reverse $ zipWith const (reverse (show $ fingerprint k)) fp 353matchpr fp k = p == show fp
354 354 where
355 p = reverse $ zipWith const (reverse (show $ fingerprint k)) (show fp)
355 356
356 357
357 358
358data KeySpec = 359data KeySpec =
359 KeyGrip String -- fp: 360 KeyGrip Fingerprint -- fp:
360 | KeyTag Packet String -- fp:????/t: 361 | KeyTag Packet String -- fp:????/t:
361 | KeyUidMatch String -- u: 362 | KeyUidMatch String -- u:
362 deriving Show 363 deriving Show
@@ -427,8 +428,8 @@ seek_key :: KeySpec -> [Packet] -> ([Packet],[Packet])
427seek_key (KeyGrip grip) sec = (pre, subs) 428seek_key (KeyGrip grip) sec = (pre, subs)
428 where 429 where
429 (pre,subs) = break pred sec 430 (pre,subs) = break pred sec
430 pred p@(SecretKeyPacket {}) = matchpr grip p == grip 431 pred p@(SecretKeyPacket {}) = matchpr grip p
431 pred p@(PublicKeyPacket {}) = matchpr grip p == grip 432 pred p@(PublicKeyPacket {}) = matchpr grip p
432 pred _ = False 433 pred _ = False
433 434
434seek_key (KeyTag key tag) ps 435seek_key (KeyTag key tag) ps
diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index 7825c85..9934aaa 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -462,7 +462,7 @@ getSshKnownHosts peer@Peer{kd} = Char8.unlines taggedblobs
462 462
463data MyIdentity = MyIdentity { 463data MyIdentity = MyIdentity {
464 myGpgAddress :: SockAddr, 464 myGpgAddress :: SockAddr,
465 myGpgKeyGrip :: String 465 myGpgKeyGrip :: Fingerprint
466} 466}
467 467
468installIpsecConf :: FileWriter -> MyIdentity -> [Peer] -> IO () 468installIpsecConf :: FileWriter -> MyIdentity -> [Peer] -> IO ()
@@ -495,7 +495,7 @@ getMyIdentity :: KeyRingRuntime -> Maybe MyIdentity
495getMyIdentity rt = do 495getMyIdentity rt = do
496 wk <- rtWorkingKey rt 496 wk <- rtWorkingKey rt
497 wkaddr <- gpgipv6addr . getHostnames <$> lookupKeyData (keykey wk) (rtKeyDB rt) 497 wkaddr <- gpgipv6addr . getHostnames <$> lookupKeyData (keykey wk) (rtKeyDB rt)
498 return $ MyIdentity wkaddr (show $ fingerprint wk) 498 return $ MyIdentity wkaddr (fingerprint wk)
499 499
500refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO () 500refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO ()
501refreshCache rt rootdir = do 501refreshCache rt rootdir = do
@@ -638,7 +638,7 @@ show_sshfp keyspec wkgrip db = do
638show_ssh :: String -> String -> KeyDB -> IO () 638show_ssh :: String -> String -> KeyDB -> IO ()
639show_ssh keyspec wkgrip db = either warn putStrLn $ show_ssh' keyspec wkgrip db 639show_ssh keyspec wkgrip db = either warn putStrLn $ show_ssh' keyspec wkgrip db
640 640
641show_ssh' :: String -> String -> KeyDB -> Either String String 641show_ssh' :: String -> Fingerprint -> KeyDB -> Either String String
642show_ssh' keyspec wkgrip db = do 642show_ssh' keyspec wkgrip db = do
643 let s = parseSpec wkgrip keyspec 643 let s = parseSpec wkgrip keyspec
644 flip (maybe . Left $ keyspec ++ ": not found") 644 flip (maybe . Left $ keyspec ++ ": not found")