Codec for "Cleartext Signatures"

12 files changed, 154 insertions, 7 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
diff --git a/openpgp-asciiarmor.cabal b/openpgp-asciiarmor.cabal
index 9b141c2..afa7010 100644
--- a/openpgp-asciiarmor.cabal
+++ b/openpgp-asciiarmor.cabal
@@ -15,9 +15,15 @@ Extra-source-files: tests/suite.hs
   , tests/data/msg1a.asc
   , tests/data/msg1b.asc
   , tests/data/msg1c.asc
-  , tests/data/msg2.asc
   , tests/data/msg1.gpg
+  , tests/data/msg2.asc
   , tests/data/msg2.pgp
+  , tests/data/msg3
+  , tests/data/msg3.asc
+  , tests/data/msg3.sig
+  , tests/data/msg4
+  , tests/data/msg4.asc
+  , tests/data/msg4.sig
 
 Cabal-version:       >= 1.10
 
@@ -29,6 +35,7 @@ Library
                      , Codec.Encryption.OpenPGP.ASCIIArmor.Types
   Other-Modules: Data.Digest.CRC24
                , Codec.Encryption.OpenPGP.ASCIIArmor.Multipart
+               , Codec.Encryption.OpenPGP.ASCIIArmor.Utils
   Build-depends: attoparsec
                , base                  > 4       && < 5
                , base64-bytestring
diff --git a/tests/data/msg3 b/tests/data/msg3
new file mode 100644
index 0000000..e9d15c8
--- /dev/null
+++ b/tests/data/msg3
@@ -0,0 +1,9 @@
+This is a message that will be clearsigned.
+
+From RFC4880, we know that some of these lines should be
+dash-escaped.
+
+-Lines starting with a minus-hyphen MUST be escaped.
+- Lines starting with "From" SHOULD be escaped.
+
+Other lines MAY be escaped.
diff --git a/tests/data/msg3.asc b/tests/data/msg3.asc
new file mode 100644
index 0000000..6d90d30
--- /dev/null
+++ b/tests/data/msg3.asc
@@ -0,0 +1,29 @@
+-----BEGIN PGP SIGNED MESSAGE-----
+Hash: SHA1
+
+This is a message that will be clearsigned.
+
+- From RFC4880, we know that some of these lines should be
+dash-escaped.
+
+- -Lines starting with a minus-hyphen MUST be escaped.
+- - Lines starting with "From" SHOULD be escaped.
+
+Other lines MAY be escaped.
+-----BEGIN PGP SIGNATURE-----
+Version: OpenPrivacy 0.99
+
+iQIcBAEBAgAGBQJPmXqrAAoJEN/7iwtcb1WCG3AQAJ6TBeX12YDI1f/AdtV46quG
+augJYpYZvBbKESGXue1Nv22a7uH4h8LgWRsaEQxMBUwJvlMJfNkjEMAkXQbkj/Og
+J+78bAGMV1GtC5MuwPr8E+M8Z/uHhbzj3fWuUask0Q057u655YIEdlnY4OcZv9jW
+hT+/2kNcC8aw9+kg0I175XNxwBhRXoRKX6dhyAkRSnz7yuQtGXH7kQJAt7TOxxAb
+dud+u5IJixDPebG+NONPfuW5VB8erByW6UPIy4BQBnaxflSD8qJXxCDMWNzOBlYG
+whKXDmlcVgy3J7ghSh2zcFcZhM30Ng49t6k57HOXR9XnI5dskY45yns2nD4kt58/
+7anmscGGj0S3pzoUuFAdVIEvziYDhISs35CmTmNh4r4LVuh4R+Zurt3mbe8O6amm
+ZOWZzPsEDX/13B/DnL//70jVhTXUBqDj6MeNj5XHXVbIlfmIyeVLOIXiT/+u1FFt
++0ERqwFI152GGJJWlikn5bR6P89Xz+04OeTBdxV1fCGt+hlvN6e5X9K15P16QDiq
+4COHMZyIyHbtQr92BIj0P46WNsNZJDaoegHl6xtbq60eV3W+LRvgHNphjE+mdIp0
+EV5lBqDGupGYpHkPjZBg0pqASs0Xd3P7SwkoVimtH7mXCPrL4K+o6X8IwsfEMCGY
+Ddej4NK0eolGoz/1sKB0
+=ZShm
+-----END PGP SIGNATURE-----
diff --git a/tests/data/msg3.sig b/tests/data/msg3.sig
new file mode 100644
index 0000000..67ceced
--- /dev/null
+++ b/tests/data/msg3.sig
diff --git a/tests/data/msg4 b/tests/data/msg4
new file mode 100644
index 0000000..b69b7b6
--- /dev/null
+++ b/tests/data/msg4
@@ -0,0 +1 @@
+This message is detach-signed.
diff --git a/tests/data/msg4.asc b/tests/data/msg4.asc
new file mode 100644
index 0000000..d1968f4
--- /dev/null
+++ b/tests/data/msg4.asc
@@ -0,0 +1,17 @@
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v1.4.12 (GNU/Linux)
+
+iQIcBAABAgAGBQJPmZE0AAoJEN/7iwtcb1WC6EcQAK+NpDfsgTJgq+5nhZLZQcDC
++b+8K5eDn+Z/btFZz1h2mF3Y+MpJdgG5fvSSHsYRWiGuT8OBK5wm3vSYnSr8BeA5
+JUJDdhasF7LVosb0ToNiWLbtj9D9iiqmCaPW56Y2u3Ktv5Y4nOAWZw31OGv21B1c
+ptYVv2iy1qPGgnHxYgM5ib37hzKlkTEGKFNMpfYqsMBZyXiKuLpVhEWelawMnCPJ
+3b7loOhYvR1Odmolg0dmcFsay7s3uXC/nze+xqTM0Z1HnMxQVW54aixhOoajDO6V
+p7OUUN5g/PBXHvx/gh7gPqgRCazo93rHSgoP//AoEuljrU4W9iNpCEcE5HTdYx0b
+xh10WxWE4VHI8BVt5qhSzPe8BmFRWz+g9CmsJdmhw45W8XxRJMJwoTWzGPcmHTFk
+JTOgJ9/MKcBvYGsBd0wGYq82DbDPdtwGgh5Aa3nz1dxzLCq7qIhOa3VEYKAhCjTx
+UHWnKZrdjSKz8U4D6CECyxlK5UApPc4jWzn3XYCX8s2F84YW7htduE57Yf60bXom
+aefIbDWef1Q4MOUV10h1gyjXtdSiIHvJ0ItvGKmRiXztjhq6+azYN+4RaXzpF5/N
+pqG/DNeTouzMRSzEoLTQ2oBHB8VIbCnP6J2Ck3wPfJZfc6FyCv0gMPQ5pTToll97
+6toTAyOHl3pI/inp7IGj
+=TJqj
+-----END PGP SIGNATURE-----
diff --git a/tests/data/msg4.sig b/tests/data/msg4.sig
new file mode 100644
index 0000000..94483e2
--- /dev/null
+++ b/tests/data/msg4.sig
diff --git a/tests/suite.hs b/tests/suite.hs
index 6fdd816..838a5f3 100644
--- a/tests/suite.hs
+++ b/tests/suite.hs
@@ -5,6 +5,7 @@ import Test.HUnit
 
 import Codec.Encryption.OpenPGP.ASCIIArmor (encode, decode, multipartMerge)
 import Codec.Encryption.OpenPGP.ASCIIArmor.Types
+import Codec.Encryption.OpenPGP.ASCIIArmor.Utils
 
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as B
@@ -35,11 +36,39 @@ testArmorMultipartDecode fp target = do
     where
         getPayload (Armor _ _ pl) = pl
 
+testClearsignedDecodeBody :: FilePath -> FilePath -> Assertion
+testClearsignedDecodeBody fp target = do
+    bs <- B.readFile $ "tests/data/" ++ fp
+    tbs <- B.readFile $ "tests/data/" ++ target
+    case decode bs of
+        Left e -> assertFailure $ "Decode failed (" ++ e ++ ") on " ++ fp
+        Right [a] -> assertEqual ("for " ++ fp) (convertEndings tbs) (getBody a)
+    where
+        getBody (ClearSigned _ txt _) = txt
+        convertEndings = crlfUnlines . BC8.lines
+
+testClearsignedDecodeSig :: FilePath -> FilePath -> Assertion
+testClearsignedDecodeSig fp target = do
+    bs <- B.readFile $ "tests/data/" ++ fp
+    tbs <- B.readFile $ "tests/data/" ++ target
+    case decode bs of
+        Left e -> assertFailure $ "Decode failed (" ++ e ++ ") on " ++ fp
+        Right [a] -> assertEqual ("for " ++ fp) tbs (getSig a)
+    where
+        getSig (ClearSigned _ _ (Armor _ _ sig)) = sig
+
 testArmorEncode :: [FilePath] -> FilePath -> Assertion
 testArmorEncode fps target = do
     bss <- mapM (\fp -> B.readFile $ "tests/data/" ++ fp) fps
     tbs <- B.readFile $ "tests/data/" ++ target
-    assertEqual ("literaldata") (encode (map (\bs -> Armor ArmorMessage [("Version","OpenPrivacy 0.99")] bs) bss)) tbs
+    assertEqual ("literaldata") tbs (encode (map (\bs -> Armor ArmorMessage [("Version","OpenPrivacy 0.99")] bs) bss))
+
+testClearsignedEncode :: FilePath -> FilePath -> FilePath -> Assertion
+testClearsignedEncode ftxt fsig ftarget = do
+    txt <- B.readFile $ "tests/data/" ++ ftxt
+    sig <- B.readFile $ "tests/data/" ++ fsig
+    target <- B.readFile $ "tests/data/" ++ ftarget
+    assertEqual ("clearsigned encode") target (encode [ClearSigned [("Hash","SHA1")] txt (Armor ArmorSignature [("Version","OpenPrivacy 0.99")] sig)])
 
 tests = [
    testGroup "CRC24" [
@@ -51,9 +80,13 @@ tests = [
       testCase "Decode sample armor" (testArmorDecode "msg1.asc" ["msg1.gpg"])
     , testCase "Decode sample armor with cruft" (testArmorDecode "msg1a.asc" ["msg1.gpg"])
     , testCase "Decode multiple sample armors" (testArmorDecode "msg1b.asc" ["msg1.gpg","msg1.gpg","msg1.gpg"])
+    , testCase "Decode detached signature" (testArmorDecode "msg4.asc" ["msg4.sig"])
     , testCase "Decode multi-part armor" (testArmorMultipartDecode "msg2.asc" "msg2.pgp")
+    , testCase "Decode body of clear-signed" (testClearsignedDecodeBody "msg3.asc" "msg3")
+    , testCase "Decode sig of clear-signed" (testClearsignedDecodeSig "msg3.asc" "msg3.sig")
     , testCase "Encode sample armor" (testArmorEncode ["msg1.gpg"] "msg1.asc")
     , testCase "Encode multiple sample armors" (testArmorEncode ["msg1.gpg","msg1.gpg","msg1.gpg"] "msg1c.asc")
+    , testCase "Encode clear-signed sig" (testClearsignedEncode "msg3" "msg3.sig" "msg3.asc")
     ]
  ]