From e0a24d8248c2c6c8e1fbc482542945a33310e390 Mon Sep 17 00:00:00 2001
From: Michael Orlitzky <michael@orlitzky.com>
Date: Tue, 7 Jul 2015 19:02:03 -0400
Subject: [PATCH] Add length (max 255) checking for domains.

---
 doc/TODO      |  1 -
 src/Domain.hs | 33 ++++++++++++++++++++++++++++++++-
 2 files changed, 32 insertions(+), 2 deletions(-)

diff --git a/doc/TODO b/doc/TODO
index 8493092..0e56c5f 100644
--- a/doc/TODO
+++ b/doc/TODO
@@ -1,2 +1 @@
 1. Add no-equal-brothers restriction for subdomains (RFC1034).
-2. Add 255 max check for domains.
diff --git a/src/Domain.hs b/src/Domain.hs
index 446a8a6..f19b111 100644
--- a/src/Domain.hs
+++ b/src/Domain.hs
@@ -5,6 +5,13 @@
 --
 --     <https://tools.ietf.org/html/rfc1035#section-2.3.1>
 --
+--   We basically work with strings and characters everywhere, even
+--   though this isn't really correct. The length specifications in
+--   the RFCs are all in terms of octets, so really a ByteString.Char8
+--   would be more appropriate. With strings, for example, we could
+--   have a unicode mumbo jumbo character that takes up two bytes
+--   (octets).
+--
 module Domain (
   UserDomain,
   user_domain )
@@ -567,10 +574,34 @@ instance Pretty Domain where
 --   >>> parseTest domain "."
 --   DomainRoot
 --
+--   Anything over 255 characters is an error, so the root will be
+--   parsed:
+--
+--   >>> let big_label = replicate 63 'x'
+--   >>> let big_subdomain = concat $ replicate 5 (big_label ++ ".")
+--   >>> parseTest domain big_subdomain
+--   DomainRoot
+--
+--   But exactly 255 is allowed:
+--
+--   >>> import Data.List ( intercalate )
+--   >>> let big_label = replicate 63 'x'
+--   >>> let big_subdomain = intercalate "." (replicate 4 big_label)
+--   >>> let (Right r) = parse domain "" big_subdomain
+--   >>> length (pretty_show r)
+--   255
+--
 domain :: Parser Domain
 domain = try parse_subdomain <|> parse_empty
   where
-    parse_subdomain = fmap DomainName subdomain
+    parse_subdomain :: Parser Domain
+    parse_subdomain = do
+      s <- subdomain
+      if (length $ pretty_show s) <= 255
+      then return $ DomainName s
+      else fail "subdomains can be at most 255 characters"
+
+    parse_empty :: Parser Domain
     parse_empty = string "" >> return DomainRoot
 
 
-- 
2.44.2