summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--kiki.cabal1
-rw-r--r--lib/KeyRing.hs27
-rw-r--r--lib/KeyRing/BuildKeyDB.hs31
3 files changed, 40 insertions, 19 deletions
diff --git a/kiki.cabal b/kiki.cabal
index d484bb1..d164441 100644
--- a/kiki.cabal
+++ b/kiki.cabal
@@ -104,6 +104,7 @@ library
104 Transforms, 104 Transforms,
105 Data.OpenPGP.Util 105 Data.OpenPGP.Util
106 Build-Depends: base >=4.6.0.0, 106 Build-Depends: base >=4.6.0.0,
107 openpgp-asciiarmor,
107 asn1-encoding, 108 asn1-encoding,
108 asn1-types, 109 asn1-types,
109 binary, 110 binary,
diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs
index 3a4bdc6..515faf6 100644
--- a/lib/KeyRing.hs
+++ b/lib/KeyRing.hs
@@ -112,8 +112,10 @@ import Debug.Trace
112#endif 112#endif
113import Network.Socket -- (SockAddr) 113import Network.Socket -- (SockAddr)
114import qualified Data.ByteString.Lazy.Char8 as Char8 114import qualified Data.ByteString.Lazy.Char8 as Char8
115import Compat 115import qualified Codec.Encryption.OpenPGP.ASCIIArmor as ASCIIArmor
116import Codec.Encryption.OpenPGP.ASCIIArmor.Types
116 117
118import Compat
117import TimeUtil 119import TimeUtil
118import PEM 120import PEM
119import ScanningParser 121import ScanningParser
@@ -744,6 +746,14 @@ isauth rt keydata = dont_have keydata && maybe False (`has_good_sig` keydata) wk
744 guard $ matchSpec (KeyGrip fp) elm 746 guard $ matchSpec (KeyGrip fp) elm
745 return $ keyPacket elm 747 return $ keyPacket elm
746 748
749mkarmor :: Access -> L.ByteString -> [Armor]
750mkarmor access bs = [Armor typ [] bs]
751 where
752 typ = case access of
753 Pub -> ArmorPublicKeyBlock
754 Sec -> ArmorPrivateKeyBlock
755 AutoAccess -> ArmorPrivateKeyBlock -- I don't know, so don't make it look sharable.
756
747writeRingKeys :: KeyRingOperation -> KeyRingRuntime -> Map.Map InputFile Message 757writeRingKeys :: KeyRingOperation -> KeyRingRuntime -> Map.Map InputFile Message
748 -> [(FilePath,KikiReportAction)] 758 -> [(FilePath,KikiReportAction)]
749 {- 759 {-
@@ -810,17 +820,18 @@ writeRingKeys krd rt {- db wk secring pubring -} unspilled report_manips = do
810 go (ws,report) ((f,stream),(new_packets,x)) = (ws++writes, report++(items <$> new_packets)) 820 go (ws,report) ((f,stream),(new_packets,x)) = (ws++writes, report++(items <$> new_packets))
811 where 821 where
812 mutable = isMutable stream 822 mutable = isMutable stream
813 encoding = case typ stream of PGPPackets e -> e 823 writes | mutable = [(stream,f,x)]
814 _ -> BinaryPackets
815 writes | mutable = [(encoding,f,x)]
816 | otherwise = [] 824 | otherwise = []
817 items c = ( concat $ resolveInputFile ctx f 825 items c = ( concat $ resolveInputFile ctx f
818 , bool MissingPacket NewPacket mutable $ showPacket (packet c) 826 , bool MissingPacket NewPacket mutable $ showPacket (packet c)
819 ) 827 )
820 forM_ towrites $ \(encoding,f,xs) -> case encoding of 828 forM_ towrites $ \(stream,f,xs) -> do
821 BinaryPackets -> writeInputFileL ctx f $ encode $ Message $ map packet xs 829 let encoding = case typ stream of PGPPackets e -> e
822 AsciiArmor -> hPutStrLn stderr $ "Not writing " ++ show (resolveInputFile ctx f) 830 _ -> BinaryPackets
823 ++ " because ascii-armor is not implemented. (TODO)" 831 enc = case encoding of
832 BinaryPackets -> id
833 AsciiArmor -> ASCIIArmor.encodeLazy . mkarmor (access stream)
834 writeInputFileL ctx f $ enc $ encode $ Message $ map packet xs
824 return $ KikiSuccess report 835 return $ KikiSuccess report
825 836
826 837
diff --git a/lib/KeyRing/BuildKeyDB.hs b/lib/KeyRing/BuildKeyDB.hs
index f5b09ca..234d2ef 100644
--- a/lib/KeyRing/BuildKeyDB.hs
+++ b/lib/KeyRing/BuildKeyDB.hs
@@ -17,6 +17,8 @@ import qualified Data.ByteString as S
17import qualified Codec.Binary.Base32 as Base32 17import qualified Codec.Binary.Base32 as Base32
18import qualified Codec.Binary.Base64 as Base64 18import qualified Codec.Binary.Base64 as Base64
19#endif 19#endif
20import qualified Codec.Encryption.OpenPGP.ASCIIArmor as ASCIIArmor
21import Codec.Encryption.OpenPGP.ASCIIArmor.Types
20import Control.Applicative (liftA2) 22import Control.Applicative (liftA2)
21import Control.Arrow (first, second) 23import Control.Arrow (first, second)
22import Control.Exception (catch) 24import Control.Exception (catch)
@@ -299,22 +301,29 @@ isring :: FileType -> Bool
299isring (PGPPackets {}) = True 301isring (PGPPackets {}) = True
300isring _ = False 302isring _ = False
301 303
302readPacketsFromFile :: InputFileContext -> InputFile -> IO (PacketsCodec, Message) 304decodePacketList :: L.ByteString -> [Packet]
303readPacketsFromFile ctx fname = do 305decodePacketList some =
304 -- warn $ fname ++ ": reading..."
305 input <- readInputFileL ctx fname
306 return $ (,) BinaryPackets $
307#if MIN_VERSION_binary(0,7,0) 306#if MIN_VERSION_binary(0,7,0)
308 Message $ flip fix input $ \again some ->
309 case decodeOrFail some of 307 case decodeOrFail some of
310 Right (more,_,msg ) -> msg : again more 308 Right (more,_,msg ) -> msg : decodePacketList more
311 Left (_,_,_) -> 309 Left (_,_,_) -> []
312 -- TODO: try ascii armor
313 []
314#else 310#else
315 decode input 311 either (const []) (\(Message xs) -> xs) $ decode input
312
313decodeOrFail bs = Right (L.empty,1,decode bs)
316#endif 314#endif
317 315
316
317readPacketsFromFile :: InputFileContext -> InputFile -> IO (PacketsCodec, Message)
318readPacketsFromFile ctx fname = do
319 -- warn $ fname ++ ": reading..."
320 input <- readInputFileL ctx fname
321 return $ case decodeOrFail input of
322 Right (more,_,pkt) -> (,) BinaryPackets $ Message $ pkt : decodePacketList more
323 Left (_,_,_) -> case ASCIIArmor.decodeLazy input of
324 Right (Armor pubOrSec headers bs:_) -> (,) AsciiArmor $ Message $ decodePacketList bs
325 Left errmsg -> (,) DetectAscii $ Message []
326
318readPacketsFromWallet :: 327readPacketsFromWallet ::
319 Maybe Packet 328 Maybe Packet
320 -> InputFile 329 -> InputFile