ASCII-armor support. New dependency: openpgp-asciiarmor.

2 files changed, 39 insertions, 19 deletions

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
 #endif
 import Network.Socket -- (SockAddr)
 import qualified Data.ByteString.Lazy.Char8 as Char8
-import Compat
+import qualified Codec.Encryption.OpenPGP.ASCIIArmor as ASCIIArmor
+import Codec.Encryption.OpenPGP.ASCIIArmor.Types
 
+import Compat
 import TimeUtil
 import PEM
 import ScanningParser
@@ -744,6 +746,14 @@ isauth rt keydata = dont_have keydata && maybe False (`has_good_sig` keydata) wk
                             guard $ matchSpec (KeyGrip fp) elm
                             return $ keyPacket elm
 
+mkarmor :: Access -> L.ByteString -> [Armor]
+mkarmor access bs = [Armor typ [] bs]
+ where
+     typ = case access of
+            Pub        -> ArmorPublicKeyBlock
+            Sec        -> ArmorPrivateKeyBlock
+            AutoAccess -> ArmorPrivateKeyBlock -- I don't know, so don't make it look sharable.
+
 writeRingKeys :: KeyRingOperation -> KeyRingRuntime -> Map.Map InputFile Message
                     -> [(FilePath,KikiReportAction)]
                 {-
@@ -810,17 +820,18 @@ writeRingKeys krd rt {- db wk secring pubring -} unspilled report_manips = do
             go (ws,report) ((f,stream),(new_packets,x)) = (ws++writes, report++(items <$> new_packets))
               where
                 mutable = isMutable stream
-                encoding = case typ stream of PGPPackets e -> e
-                                              _            -> BinaryPackets
-                writes | mutable   = [(encoding,f,x)]
+                writes | mutable   = [(stream,f,x)]
                        | otherwise = []
                 items c = ( concat $ resolveInputFile ctx f
                           , bool MissingPacket NewPacket mutable $ showPacket (packet c)
                           )
-    forM_ towrites $ \(encoding,f,xs) -> case encoding of
-        BinaryPackets -> writeInputFileL ctx f $ encode $ Message $ map packet xs
-        AsciiArmor    -> hPutStrLn stderr $ "Not writing " ++ show (resolveInputFile ctx f)
-                                            ++ " because ascii-armor is not implemented. (TODO)"
+    forM_ towrites $ \(stream,f,xs) -> do
+        let encoding = case typ stream of PGPPackets e -> e
+                                          _            -> BinaryPackets
+            enc = case encoding of
+                BinaryPackets -> id
+                AsciiArmor    -> ASCIIArmor.encodeLazy . mkarmor (access stream)
+        writeInputFileL ctx f $ enc $ encode $ Message $ map packet xs
     return $ KikiSuccess report
 
 
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
 import qualified Codec.Binary.Base32 as Base32
 import qualified Codec.Binary.Base64 as Base64
 #endif
+import qualified Codec.Encryption.OpenPGP.ASCIIArmor as ASCIIArmor
+import           Codec.Encryption.OpenPGP.ASCIIArmor.Types
 import           Control.Applicative        (liftA2)
 import           Control.Arrow              (first, second)
 import           Control.Exception          (catch)
@@ -299,22 +301,29 @@ isring :: FileType -> Bool
 isring (PGPPackets {}) = True
 isring _               = False
 
-readPacketsFromFile :: InputFileContext -> InputFile -> IO (PacketsCodec, Message)
-readPacketsFromFile ctx fname = do
-    -- warn $ fname ++ ": reading..."
-    input <- readInputFileL ctx fname
-    return $ (,) BinaryPackets $
+decodePacketList :: L.ByteString -> [Packet]
+decodePacketList some =
 #if MIN_VERSION_binary(0,7,0)
-        Message $ flip fix input $ \again some ->
           case decodeOrFail some of
-            Right (more,_,msg ) -> msg : again more
-            Left  (_,_,_)    ->
-                -- TODO: try ascii armor
-              []
+            Right (more,_,msg ) -> msg : decodePacketList more
+            Left  (_,_,_)       -> []
 #else
-        decode input
+          either (const []) (\(Message xs) -> xs) $ decode input
+
+decodeOrFail bs = Right (L.empty,1,decode bs)
 #endif
 
+
+readPacketsFromFile :: InputFileContext -> InputFile -> IO (PacketsCodec, Message)
+readPacketsFromFile ctx fname = do
+    -- warn $ fname ++ ": reading..."
+    input <- readInputFileL ctx fname
+    return $ case decodeOrFail input of
+      Right (more,_,pkt) -> (,) BinaryPackets $ Message $ pkt : decodePacketList more
+      Left  (_,_,_)      -> case ASCIIArmor.decodeLazy input of
+          Right (Armor pubOrSec headers bs:_) -> (,) AsciiArmor $ Message $ decodePacketList bs
+          Left  errmsg                        -> (,) DetectAscii $ Message []
+
 readPacketsFromWallet ::
     Maybe Packet
     -> InputFile