summaryrefslogtreecommitdiff
path: root/kiki.hs
diff options
context:
space:
mode:
Diffstat (limited to 'kiki.hs')
-rw-r--r--kiki.hs36
1 files changed, 35 insertions, 1 deletions
diff --git a/kiki.hs b/kiki.hs
index fa22451..63c9f02 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -24,6 +24,7 @@ import Data.List
24import Data.Maybe 24import Data.Maybe
25import Data.OpenPGP 25import Data.OpenPGP
26import Data.Ord 26import Data.Ord
27import Data.String
27import Data.Text.Encoding 28import Data.Text.Encoding
28import System.Posix.User 29import System.Posix.User
29import System.Posix.Files 30import System.Posix.Files
@@ -105,7 +106,7 @@ import FunctorToMaybe
105 isCertificationSig :: SignatureOver -> Bool 106 isCertificationSig :: SignatureOver -> Bool
106 isSubkeySignature :: SignatureOver -> Bool 107 isSubkeySignature :: SignatureOver -> Bool
107 kiki :: forall a. 108 kiki :: forall a.
108 (Eq a, Data.String.IsString a) => 109 (Eq a, IsString a) =>
109 a -> [[Char]] -> IO () 110 a -> [[Char]] -> IO ()
110 kiki_sync_help :: IO () 111 kiki_sync_help :: IO ()
111 listKeys :: [Packet] -> [Char] 112 listKeys :: [Packet] -> [Char]
@@ -137,15 +138,18 @@ import FunctorToMaybe
137 -} 138 -}
138 139
139 140
141isCertificationSig :: SignatureOver -> Bool
140isCertificationSig (CertificationSignature {}) = True 142isCertificationSig (CertificationSignature {}) = True
141isCertificationSig _ = True 143isCertificationSig _ = True
142 144
145fpmatch :: Maybe [Char] -> Packet -> Bool
143fpmatch grip key = 146fpmatch grip key =
144 (==) Nothing 147 (==) Nothing
145 (fmap (backend (fingerprint key)) grip >>= guard . not) 148 (fmap (backend (fingerprint key)) grip >>= guard . not)
146 where 149 where
147 backend xs ys = and $ zipWith (==) (reverse xs) (reverse ys) 150 backend xs ys = and $ zipWith (==) (reverse xs) (reverse ys)
148 151
152listKeys :: [Packet] -> [Char]
149listKeys pkts = listKeysFiltered [] pkts 153listKeys pkts = listKeysFiltered [] pkts
150 154
151-- | listKeysFiltered 155-- | listKeysFiltered
@@ -154,6 +158,7 @@ listKeys pkts = listKeysFiltered [] pkts
154-- Build the display output 158-- Build the display output
155-- Operates in List Monad... 159-- Operates in List Monad...
156-- returns all output as a single string 160-- returns all output as a single string
161listKeysFiltered :: Foldable t => t [Char] -> [Packet] -> [Char]
157listKeysFiltered grips pkts = do 162listKeysFiltered grips pkts = do
158 let masterkeys = filter (\k -> isKey k && not (is_subkey k)) pkts 163 let masterkeys = filter (\k -> isKey k && not (is_subkey k)) pkts
159 (certs,bs) = getBindings pkts 164 (certs,bs) = getBindings pkts
@@ -273,6 +278,8 @@ toLast f [x] = [f x]
273toLast f (x:xs) = x : toLast f xs 278toLast f (x:xs) = x : toLast f xs
274 279
275-- partitionStaticArguments :: Ord a => [(a, Int)] -> [a] -> ([[a]], [a]) 280-- partitionStaticArguments :: Ord a => [(a, Int)] -> [a] -> ([[a]], [a])
281partitionStaticArguments :: [([Char], Int)]
282 -> [[Char]] -> ([[[Char]]], [[Char]])
276partitionStaticArguments specs args = psa args 283partitionStaticArguments specs args = psa args
277 where 284 where
278 smap = Map.fromList specs 285 smap = Map.fromList specs
@@ -285,6 +292,8 @@ partitionStaticArguments specs args = psa args
285 Nothing -> second (a:) $ psa as 292 Nothing -> second (a:) $ psa as
286 Just n -> first ((a:take n as):) $ psa (drop n as) 293 Just n -> first ((a:take n as):) $ psa (drop n as)
287 294
295show_wk :: FilePath
296 -> Maybe [Char] -> Map.Map KeyKey KeyData -> IO ()
288show_wk secring_file grip db = do 297show_wk secring_file grip db = do
289 -- printf "show_wk(%s,%s,%s)\n" (show secring_file) (show grip) (show db) 298 -- printf "show_wk(%s,%s,%s)\n" (show secring_file) (show grip) (show db)
290 let sec_db = Map.filter gripmatch db 299 let sec_db = Map.filter gripmatch db
@@ -294,6 +303,7 @@ show_wk secring_file grip db = do
294 Message sec = flattenKeys False sec_db 303 Message sec = flattenKeys False sec_db
295 putStrLn $ listKeysFiltered (maybeToList grip) sec 304 putStrLn $ listKeysFiltered (maybeToList grip) sec
296 305
306debug_dump :: FilePath -> p -> Map.Map KeyKey KeyData -> IO ()
297debug_dump secring_file grip db = do 307debug_dump secring_file grip db = do
298 let sec_db = Map.filter gripmatch db 308 let sec_db = Map.filter gripmatch db
299 gripmatch (KeyData p _ _ _) = 309 gripmatch (KeyData p _ _ _) =
@@ -302,14 +312,18 @@ debug_dump secring_file grip db = do
302 Message sec = flattenKeys False sec_db 312 Message sec = flattenKeys False sec_db
303 mapM_ print sec 313 mapM_ print sec
304 314
315show_all :: KeyDB -> IO ()
305show_all db = do 316show_all db = do
306 let Message packets = flattenKeys True db 317 let Message packets = flattenKeys True db
307 putStrLn $ listKeys packets 318 putStrLn $ listKeys packets
308 319
320show_packets :: (Eq a, IsString a) =>
321 [a] -> KeyDB -> IO ()
309show_packets puborsec db = do 322show_packets puborsec db = do
310 let Message packets = flattenKeys (case puborsec of { "sec":_ -> False; _ -> True }) db 323 let Message packets = flattenKeys (case puborsec of { "sec":_ -> False; _ -> True }) db
311 forM_ packets $ putStrLn . showPacket 324 forM_ packets $ putStrLn . showPacket
312 325
326show_whose_key :: Maybe RSAPublicKey -> KeyDB -> IO ()
313show_whose_key input_key db = 327show_whose_key input_key db =
314 flip (maybe $ return ()) input_key $ \input_key -> do 328 flip (maybe $ return ()) input_key $ \input_key -> do
315 let ks = whoseKey input_key db 329 let ks = whoseKey input_key db
@@ -320,8 +334,10 @@ show_whose_key input_key db =
320 (_:_) -> error "ambiguous" 334 (_:_) -> error "ambiguous"
321 [] -> return () 335 [] -> return ()
322 336
337show_dns :: [Char] -> String -> KeyDB -> IO ()
323show_dns keyspec wkgrip db = either warn putStrLn $ show_pem' keyspec wkgrip db dnsPresentationFromPacket 338show_dns keyspec wkgrip db = either warn putStrLn $ show_pem' keyspec wkgrip db dnsPresentationFromPacket
324 339
340dnsPresentationFromPacket :: Monad m => Packet -> m String
325dnsPresentationFromPacket k = do 341dnsPresentationFromPacket k = do
326 let RSAKey (MPI n) (MPI e) = fromJust $ rsaKeyFromPacket k 342 let RSAKey (MPI n) (MPI e) = fromJust $ rsaKeyFromPacket k
327 dnskey = DNS.RSA n e 343 dnskey = DNS.RSA n e
@@ -345,6 +361,7 @@ dnsPresentationFromPacket k = do
345 ,qq 361 ,qq
346 ] 362 ]
347 363
364show_id :: String -> p -> Map.Map KeyKey KeyData -> IO ()
348show_id keyspec wkgrip db = do 365show_id keyspec wkgrip db = do
349 let s = parseSpec "" keyspec 366 let s = parseSpec "" keyspec
350 let ps = do 367 let ps = do
@@ -354,6 +371,7 @@ show_id keyspec wkgrip db = do
354 -- putStrLn $ "show key " ++ show s 371 -- putStrLn $ "show key " ++ show s
355 putStrLn $ listKeys ps 372 putStrLn $ listKeys ps
356 373
374show_wip :: [Char] -> String -> KeyDB -> IO ()
357show_wip keyspec wkgrip db = do 375show_wip keyspec wkgrip db = do
358 let s = parseSpec wkgrip keyspec 376 let s = parseSpec wkgrip keyspec
359 flip (maybe $ void (warn (keyspec ++ ": not found"))) 377 flip (maybe $ void (warn (keyspec ++ ": not found")))
@@ -362,6 +380,7 @@ show_wip keyspec wkgrip db = do
362 let nwb = maybe 0x80 CryptoCoins.secretByteFromName $ snd s 380 let nwb = maybe 0x80 CryptoCoins.secretByteFromName $ snd s
363 putStrLn $ walletImportFormat nwb k 381 putStrLn $ walletImportFormat nwb k
364 382
383show_torhash :: FilePath -> p -> IO ()
365show_torhash pubkey _ = do 384show_torhash pubkey _ = do
366 bs <- Char8.readFile pubkey 385 bs <- Char8.readFile pubkey
367 let parsekey f dta = do 386 let parsekey f dta = do
@@ -386,6 +405,7 @@ show_torhash pubkey _ = do
386 keys = catMaybes $ scanAndParse (pkcs1 <> pkcs8 <> cert) $ Char8.lines bs 405 keys = catMaybes $ scanAndParse (pkcs1 <> pkcs8 <> cert) $ Char8.lines bs
387 mapM_ (putStrLn . addy . torhash) keys 406 mapM_ (putStrLn . addy . torhash) keys
388 407
408show_cert :: [Char] -> String -> KeyDB -> IO ()
389show_cert keyspec wkgrip db = do 409show_cert keyspec wkgrip db = do
390 let s = parseSpec wkgrip keyspec 410 let s = parseSpec wkgrip keyspec
391 case selectPublicKeyAndSigs s db of 411 case selectPublicKeyAndSigs s db of
@@ -452,6 +472,8 @@ show_cert certfile _ = do
452 return () 472 return ()
453-} 473-}
454 474
475cannonical_eckey :: (Integral b1, Integral b2) =>
476 b1 -> b2 -> [Word8]
455cannonical_eckey x y = 0x4:pad32(numToBytes x) ++ pad32(numToBytes y) :: [Word8] 477cannonical_eckey x y = 0x4:pad32(numToBytes x) ++ pad32(numToBytes y) :: [Word8]
456 where 478 where
457 numToBytes n = reverse $ unfoldr getbyte n 479 numToBytes n = reverse $ unfoldr getbyte n
@@ -465,6 +487,7 @@ cannonical_eckey x y = 0x4:pad32(numToBytes x) ++ pad32(numToBytes y) :: [Word8]
465 zlen = 32 - length xs 487 zlen = 32 - length xs
466 488
467 489
490bitcoinAddress :: Word8 -> Packet -> String
468bitcoinAddress network_id k = address 491bitcoinAddress network_id k = address
469 where 492 where
470 Just (MPI x) = lookup 'x' (key k) 493 Just (MPI x) = lookup 'x' (key k)
@@ -780,6 +803,8 @@ documentHomeDir =
780 ," exactly the same functionality." 803 ," exactly the same functionality."
781 ] 804 ]
782 805
806documentPassphraseFDFlag :: IsString a =>
807 p1 -> p2 -> Bool -> [a]
783documentPassphraseFDFlag bExport bImport bSecret = 808documentPassphraseFDFlag bExport bImport bSecret =
784 if bSecret then 809 if bSecret then
785 [" --passphrase-fd FD" 810 [" --passphrase-fd FD"
@@ -790,6 +815,8 @@ documentPassphraseFDFlag bExport bImport bSecret =
790 ,""] 815 ,""]
791 else [] 816 else []
792 817
818documentImportFlag :: IsString a =>
819 p1 -> Bool -> p2 -> [a]
793documentImportFlag bExport bImport bSecret = 820documentImportFlag bExport bImport bSecret =
794 if bImport then 821 if bImport then
795 [" --import Add master keys to pubring.gpg. Without this option, only UID" 822 [" --import Add master keys to pubring.gpg. Without this option, only UID"
@@ -797,6 +824,8 @@ documentImportFlag bExport bImport bSecret =
797 ,""] 824 ,""]
798 else [] 825 else []
799 826
827documentImportIfAuthenticFlag :: IsString a =>
828 p1 -> Bool -> p2 -> [a]
800documentImportIfAuthenticFlag bExport bImport bSecret = 829documentImportIfAuthenticFlag bExport bImport bSecret =
801 if bImport then 830 if bImport then
802 [" --import-if-authentic" 831 [" --import-if-authentic"
@@ -806,6 +835,8 @@ documentImportIfAuthenticFlag bExport bImport bSecret =
806 ,""] 835 ,""]
807 else [] 836 else []
808 837
838documentAutoSignFlag :: IsString a =>
839 p1 -> p2 -> p3 -> [a]
809documentAutoSignFlag bExport bImport bSecret = 840documentAutoSignFlag bExport bImport bSecret =
810 [" --autosign Sign all cross-certified tor-style UIDs." 841 [" --autosign Sign all cross-certified tor-style UIDs."
811 ," A tor-style UID is of the form:" 842 ," A tor-style UID is of the form:"
@@ -1029,6 +1060,8 @@ processArgs sargspec polyVariadicArgs defaultPoly args_raw = (sargs,margs)
1029 else error . unlines $ [ "unrecognized option "++k 1060 else error . unlines $ [ "unrecognized option "++k
1030 , "Use --help for usage." ] 1061 , "Use --help for usage." ]
1031 1062
1063parseCommonArgs :: (Ord k, IsString k) =>
1064 Map.Map k [[Char]] -> CommonArgsParsed
1032parseCommonArgs margs = CommonArgsParsed { cap_homespec = homespec, cap_passfd = passfd } 1065parseCommonArgs margs = CommonArgsParsed { cap_homespec = homespec, cap_passfd = passfd }
1033 where 1066 where
1034 passphrase_fd = concat <$> Map.lookup "--passphrase-fd" margs 1067 passphrase_fd = concat <$> Map.lookup "--passphrase-fd" margs
@@ -1776,6 +1809,7 @@ commands =
1776 , ( "tar", "import or export system key files in tar format" ) 1809 , ( "tar", "import or export system key files in tar format" )
1777 ] 1810 ]
1778 1811
1812main :: IO ()
1779main = do 1813main = do
1780 dotlock_init 1814 dotlock_init
1781 args_raw <- getArgs 1815 args_raw <- getArgs