Codec for "Cleartext Signatures"

4 files changed, 56 insertions, 5 deletions

diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs
index 0376abc..b0033a8 100644
--- a/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs
+++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs
@@ -10,7 +10,8 @@ module Codec.Encryption.OpenPGP.ASCIIArmor.Decode (
 ) where
 
 import Codec.Encryption.OpenPGP.ASCIIArmor.Types
-import Control.Applicative (many, (<|>), (<$>), Alternative, (*>))
+import Codec.Encryption.OpenPGP.ASCIIArmor.Utils
+import Control.Applicative (many, (<|>), (<$>), Alternative, (<*), (<*>), (*>), optional)
 import Data.Attoparsec.ByteString (Parser, many1, string, inClass, notInClass, satisfy, word8, (<?>), parse, IResult(..))
 import Data.Attoparsec.ByteString.Char8 (isDigit_w8, anyChar)
 import Data.Attoparsec.Combinator (manyTill)
@@ -37,8 +38,21 @@ parseArmors :: Parser [Armor]
 parseArmors = many parseArmor
 
 parseArmor :: Parser Armor
-parseArmor = do
-    atype <- prefixed beginLine <?> "begin line"
+parseArmor = prefixed (clearsigned <|> armor) <?> "armor"
+
+clearsigned :: Parser Armor
+clearsigned = do
+    string "-----BEGIN PGP SIGNED MESSAGE-----" <?> "clearsign header"
+    lineEnding <?> "line ending"
+    headers <- armorHeaders <?> "clearsign headers"
+    blankishLine <?> "blank line"
+    cleartext <- dashEscapedCleartext
+    sig <- armor
+    return $ ClearSigned headers cleartext sig
+
+armor :: Parser Armor
+armor = do
+    atype <- beginLine <?> "begin line"
     headers <- armorHeaders <?> "headers"
     blankishLine <?> "blank line"
     payload <- base64Data <?> "base64 data"
@@ -84,7 +98,7 @@ armorHeader = do
         w8sToString = BC8.unpack . B.pack
 
 blankishLine ::  Parser ByteString
-blankishLine = many (satisfy (inClass " \t")) >> lineEnding
+blankishLine = many (satisfy (inClass " \t")) *> lineEnding
 
 endLine :: ArmorType -> Parser ByteString
 endLine atype = do
@@ -138,3 +152,13 @@ d24 = do
 
 prefixed :: Parser a -> Parser a
 prefixed end = end <|> anyChar *> prefixed end
+
+dashEscapedCleartext :: Parser ByteString
+dashEscapedCleartext = do
+    ls <- many1 ((deLine <|> unescapedLine) <* lineEnding)
+    return $ crlfUnlines ls
+    where
+        deLine :: Parser ByteString
+        deLine = B.pack <$> (string "- " *> many (satisfy (notInClass "\n\r")))
+        unescapedLine :: Parser ByteString
+        unescapedLine = maybe B.empty B.pack <$> optional ((:) <$> satisfy (notInClass "-\n\r") <*> many (satisfy (notInClass "\n\r")))
diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs
index 28bb3e6..00d9dd3 100644
--- a/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs
+++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs
@@ -22,6 +22,7 @@ encode = B.concat . map armor
 
 armor :: Armor -> ByteString
 armor (Armor atype ahs bs) = beginLine atype `B.append` armorHeaders ahs `B.append` blankLine `B.append` armorData bs `B.append` armorChecksum bs `B.append` endLine atype
+armor (ClearSigned chs ctxt csig) = BC8.pack "-----BEGIN PGP SIGNED MESSAGE-----\n" `B.append` armorHeaders chs `B.append` blankLine `B.append` dashEscape ctxt `B.append` armor csig
 
 blankLine :: ByteString
 blankLine = BC8.singleton '\n'
@@ -57,3 +58,12 @@ wordWrap lw bs
 
 armorChecksum :: ByteString -> ByteString
 armorChecksum = BC8.cons '=' . armorData . B.tail . runPut . putWord32be . crc24
+
+dashEscape :: ByteString -> ByteString
+dashEscape = BC8.unlines . map escapeLine . BC8.lines
+    where
+        escapeLine :: ByteString -> ByteString
+        escapeLine l
+            | BC8.singleton '-' `B.isPrefixOf` l = BC8.pack "- " `B.append` l
+            | BC8.pack "From " `B.isPrefixOf` l = BC8.pack "- " `B.append` l
+            | otherwise = l
diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs
index 46416c1..88a03ce 100644
--- a/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs
+++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs
@@ -11,7 +11,7 @@ module Codec.Encryption.OpenPGP.ASCIIArmor.Types (
 import Data.ByteString (ByteString)
 
 data Armor = Armor ArmorType [(String, String)] ByteString
-   | ClearSigned [(String, String)] String Armor
+   | ClearSigned [(String, String)] ByteString Armor
     deriving (Show, Eq)
 
 data ArmorType = ArmorMessage
diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Utils.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Utils.hs
new file mode 100644
index 0000000..014c8aa
--- /dev/null
+++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Utils.hs
@@ -0,0 +1,17 @@
+-- ASCIIArmor/Utils.hs: OpenPGP (RFC4880) ASCII armor implementation
+-- Copyright Ⓒ 2012  Clint Adams
+-- This software is released under the terms of the ISC license.
+-- (See the LICENSE file).
+
+module Codec.Encryption.OpenPGP.ASCIIArmor.Utils (
+   crlfUnlines
+) where
+
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as BC8
+import Data.List (intersperse)
+
+crlfUnlines :: [ByteString] -> ByteString
+crlfUnlines [] = B.empty
+crlfUnlines ss = B.concat $ intersperse (BC8.pack "\r\n") ss