diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/KeyRing.hs | 27 | ||||
-rw-r--r-- | lib/KeyRing/BuildKeyDB.hs | 31 |
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 | |||
112 | #endif | 112 | #endif |
113 | import Network.Socket -- (SockAddr) | 113 | import Network.Socket -- (SockAddr) |
114 | import qualified Data.ByteString.Lazy.Char8 as Char8 | 114 | import qualified Data.ByteString.Lazy.Char8 as Char8 |
115 | import Compat | 115 | import qualified Codec.Encryption.OpenPGP.ASCIIArmor as ASCIIArmor |
116 | import Codec.Encryption.OpenPGP.ASCIIArmor.Types | ||
116 | 117 | ||
118 | import Compat | ||
117 | import TimeUtil | 119 | import TimeUtil |
118 | import PEM | 120 | import PEM |
119 | import ScanningParser | 121 | import 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 | ||
749 | mkarmor :: Access -> L.ByteString -> [Armor] | ||
750 | mkarmor 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 | |||
747 | writeRingKeys :: KeyRingOperation -> KeyRingRuntime -> Map.Map InputFile Message | 757 | writeRingKeys :: 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 | |||
17 | import qualified Codec.Binary.Base32 as Base32 | 17 | import qualified Codec.Binary.Base32 as Base32 |
18 | import qualified Codec.Binary.Base64 as Base64 | 18 | import qualified Codec.Binary.Base64 as Base64 |
19 | #endif | 19 | #endif |
20 | import qualified Codec.Encryption.OpenPGP.ASCIIArmor as ASCIIArmor | ||
21 | import Codec.Encryption.OpenPGP.ASCIIArmor.Types | ||
20 | import Control.Applicative (liftA2) | 22 | import Control.Applicative (liftA2) |
21 | import Control.Arrow (first, second) | 23 | import Control.Arrow (first, second) |
22 | import Control.Exception (catch) | 24 | import Control.Exception (catch) |
@@ -299,22 +301,29 @@ isring :: FileType -> Bool | |||
299 | isring (PGPPackets {}) = True | 301 | isring (PGPPackets {}) = True |
300 | isring _ = False | 302 | isring _ = False |
301 | 303 | ||
302 | readPacketsFromFile :: InputFileContext -> InputFile -> IO (PacketsCodec, Message) | 304 | decodePacketList :: L.ByteString -> [Packet] |
303 | readPacketsFromFile ctx fname = do | 305 | decodePacketList 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 | |||
313 | decodeOrFail bs = Right (L.empty,1,decode bs) | ||
316 | #endif | 314 | #endif |
317 | 315 | ||
316 | |||
317 | readPacketsFromFile :: InputFileContext -> InputFile -> IO (PacketsCodec, Message) | ||
318 | readPacketsFromFile 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 | |||
318 | readPacketsFromWallet :: | 327 | readPacketsFromWallet :: |
319 | Maybe Packet | 328 | Maybe Packet |
320 | -> InputFile | 329 | -> InputFile |