summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJames Crayne <jim.crayne@gmail.com>2016-04-26 22:39:42 -0400
committerJames Crayne <jim.crayne@gmail.com>2016-04-26 22:39:42 -0400
commit148aa3b272d79dea81d0737ad87cd3fa3e420801 (patch)
treef41b5a1344e593c597f2a878fe25402e01e6723d
parente2a94707d97fbc949ee16524bb948615e77ad773 (diff)
type signatures to help debugging builds
-rw-r--r--kiki.cabal1
-rw-r--r--kiki.hs12
-rw-r--r--lib/KeyRing.hs1
3 files changed, 13 insertions, 1 deletions
diff --git a/kiki.cabal b/kiki.cabal
index 37c8264..6723ba4 100644
--- a/kiki.cabal
+++ b/kiki.cabal
@@ -43,6 +43,7 @@ Executable kiki
43 time, 43 time,
44 unix, 44 unix,
45 openpgp-util, 45 openpgp-util,
46 network,
46 kiki 47 kiki
47 other-modules: DNSKey 48 other-modules: DNSKey
48 if !flag(cryptonite) 49 if !flag(cryptonite)
diff --git a/kiki.hs b/kiki.hs
index 8ca6e5d..2a4dde2 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -68,6 +68,7 @@ import qualified DNSKey as DNS
68import Data.Time.Clock.POSIX ( posixSecondsToUTCTime ) 68import Data.Time.Clock.POSIX ( posixSecondsToUTCTime )
69import Kiki 69import Kiki
70import Debug.Trace 70import Debug.Trace
71import Network.Socket (SockAddr)
71 72
72-- {-# ANN module ("HLint: ignore Eta reduce"::String) #-} 73-- {-# ANN module ("HLint: ignore Eta reduce"::String) #-}
73-- {-# ANN module ("HLint: ignore Use camelCase"::String) #-} 74-- {-# ANN module ("HLint: ignore Use camelCase"::String) #-}
@@ -1503,6 +1504,13 @@ kiki "tar" args = do
1503 ["-A":_] -> putStrLn "unimplemented." -- import tar file? 1504 ["-A":_] -> putStrLn "unimplemented." -- import tar file?
1504 _ -> kiki "tar" ["--help"] 1505 _ -> kiki "tar" ["--help"]
1505 1506
1507
1508tarContent :: KeyRingRuntime
1509 -> Maybe String
1510 -> ([Char8.ByteString] -> SockAddr -> Packet -> [Packet] -> t )
1511 -> ([(KeyRing.KeyKey, Packet, [Packet])] -> t)
1512 -> (Packet -> t)
1513 -> [(String, t)]
1506tarContent rt spec pubpem knownhosts secpem = ipsecs ++ sshs ++ secrets "root" 1514tarContent rt spec pubpem knownhosts secpem = ipsecs ++ sshs ++ secrets "root"
1507 where 1515 where
1508 ipsecs = do 1516 ipsecs = do
@@ -1580,6 +1588,7 @@ tarC (sargs,margs) = do
1580 L.putStr tarbs 1588 L.putStr tarbs
1581 err -> putStrLn $ errorString err 1589 err -> putStrLn $ errorString err
1582 where 1590 where
1591 build_ipsec :: Num n => b -> c -> Packet -> d -> (n, Either a Char8.ByteString)
1583 build_ipsec ns addr ipsec sigs 1592 build_ipsec ns addr ipsec sigs
1584 = ( fromIntegral $ timestamp ipsec 1593 = ( fromIntegral $ timestamp ipsec
1585 , Right $ Char8.pack $ fromJust $ pemFromPacket ipsec) 1594 , Right $ Char8.pack $ fromJust $ pemFromPacket ipsec)
@@ -1590,9 +1599,11 @@ tarC (sargs,margs) = do
1590 ns = onames ++ others 1599 ns = onames ++ others
1591 (_,(onames,others)) = getHostnames $ rtKeyDB rt Map.! kk 1600 (_,(onames,others)) = getHostnames $ rtKeyDB rt Map.! kk
1592 1601
1602 build_secret :: Num t => KeyRingRuntime -> Packet -> (t, Either (IO (Maybe Char8.ByteString)) b)
1593 build_secret rt k = ( fromIntegral $ timestamp k 1603 build_secret rt k = ( fromIntegral $ timestamp k
1594 , Left $ fmap Char8.pack . (>>= secretPemFromPacket) <$> decrypt rt k ) 1604 , Left $ fmap Char8.pack . (>>= secretPemFromPacket) <$> decrypt rt k )
1595 1605
1606 mktar :: FilePath -> Tar.EpochTime -> L.ByteString -> Either String Tar.Entry
1596 mktar n epoch_time_int64 bs = do 1607 mktar n epoch_time_int64 bs = do
1597 torpath <- Tar.toTarPath False n 1608 torpath <- Tar.toTarPath False n
1598 Right $ (Tar.fileEntry torpath bs) { Tar.entryTime = epoch_time_int64 } 1609 Right $ (Tar.fileEntry torpath bs) { Tar.entryTime = epoch_time_int64 }
@@ -1606,7 +1617,6 @@ tarC (sargs,margs) = do
1606 _ -> do 1617 _ -> do
1607 hPutStrLn stderr $ "Failed to decrypt "++fingerprint k++"." 1618 hPutStrLn stderr $ "Failed to decrypt "++fingerprint k++"."
1608 return Nothing 1619 return Nothing
1609
1610-- | 1620-- |
1611-- 1621--
1612-- no leading hyphen, returns Right (input string). 1622-- no leading hyphen, returns Right (input string).
diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs
index 21d7c3e..fbd23fe 100644
--- a/lib/KeyRing.hs
+++ b/lib/KeyRing.hs
@@ -102,6 +102,7 @@ module KeyRing
102 , getSubkeys 102 , getSubkeys
103 , writeKeyToFile 103 , writeKeyToFile
104 , resolveForReport 104 , resolveForReport
105 , KeyKey -- needed for Type sigs
105 ) where 106 ) where
106 107
107import System.Environment 108import System.Environment