Xml: process external entities in DOCTYPE declaration

See http://www.w3.org/TR/2006/REC-xml11-20060816/#sec-external-ent for the required syntax. Based on initial patch by Adam Bottchen. Fixes hercules-team#142
lutter · Nov 11, 2016 · 85a40eb · 85a40eb
1 parent 15bf258
commit 85a40eb
Show file tree

Hide file tree

Showing 2 changed files with 87 additions and 3 deletions.
diff --git a/lenses/tests/test_xml.aug b/lenses/tests/test_xml.aug
@@ -826,3 +826,80 @@ test Xml.lns get "<a password=\"my\!pass\" />" =
 
 test Xml.lns put ""
 after set "/a" "#empty" = "<a/>\n"
+
+(* Issue #142 *)
+test Xml.entity_def get
+  "<!ENTITY open-hatch SYSTEM \"http://examplecom/OpenHatch.xml\">" =
+  { "!ENTITY" = "open-hatch"
+    { "SYSTEM"
+      { "#systemliteral" = "http://examplecom/OpenHatch.xml" }
+    } }
+
+test Xml.entity_def get
+  "<!ENTITY open-hatch PUBLIC \"-//Textuality//TEXT Standard open-hatch boilerplate//EN\" \"http://www.textuality.com/boilerplate/OpenHatch.xml\">" =
+  { "!ENTITY" = "open-hatch"
+    { "PUBLIC"
+      { "#pubidliteral" =
+          "-//Textuality//TEXT Standard open-hatch boilerplate//EN" }
+      { "#systemliteral" =
+          "http://www.textuality.com/boilerplate/OpenHatch.xml" } } }
+
+let dt_with_entities =
+"<!DOCTYPE server-xml [
+  <!ENTITY sys-ent SYSTEM \"sys-file.xml\">
+  <!ENTITY pub-ent PUBLIC \"-//something public//TEXT\"
+                          \"pub-file.xml\">
+ ]>"
+
+test Xml.doctype get dt_with_entities =
+  { "!DOCTYPE" = "server-xml"
+    { "!ENTITY" = "sys-ent"
+      { "SYSTEM"
+        { "#systemliteral" = "sys-file.xml" }
+      }
+    }
+    { "!ENTITY" = "pub-ent"
+      { "PUBLIC"
+        { "#pubidliteral" = "-//something public//TEXT" }
+        { "#systemliteral" = "pub-file.xml" }
+      }
+    }
+  }
+
+test Xml.doctype put dt_with_entities after
+    rm "/\!DOCTYPE/\!ENTITY[2]";
+    set "/\!DOCTYPE/\!ENTITY[. = \"sys-ent\"]/SYSTEM/#systemliteral"
+        "other-file.xml"
+  =
+"<!DOCTYPE server-xml [
+  <!ENTITY sys-ent SYSTEM \"other-file.xml\">
+  ]>"
+
+test Xml.lns get (dt_with_entities . "<body></body>") =
+  { "!DOCTYPE" = "server-xml"
+    { "!ENTITY" = "sys-ent"
+      { "SYSTEM"
+        { "#systemliteral" = "sys-file.xml" }
+      }
+    }
+    { "!ENTITY" = "pub-ent"
+      { "PUBLIC"
+        { "#pubidliteral" = "-//something public//TEXT" }
+        { "#systemliteral" = "pub-file.xml" }
+      }
+    }
+  }
+  { "body" }
+
+test Xml.lns put "<?xml version=\"1.0\"?>
+<body>
+</body>"
+    after
+    insa "!DOCTYPE" "#declaration";
+    set "\\!DOCTYPE" "Server";
+    set "\\!DOCTYPE/\\!ENTITY" "resourcesFile";
+    set "\\!DOCTYPE/\\!ENTITY/SYSTEM/#systemliteral" "data.xml"
+  =
+"<?xml version=\"1.0\"?><!DOCTYPE Server[
+<!ENTITY resourcesFile SYSTEM \"data.xml\">]>
+<body>\n</body>"
diff --git a/lenses/xml.aug b/lenses/xml.aug
@@ -78,9 +78,16 @@ let att_def       = counter "att_id" .
 
 let att_list_def = decl_def /!ATTLIST/ att_def
 
-let entity_def    = decl_def /!ENTITY/ ([sep_spc . label "#decl" . sto_dquote ])
-
-let decl_def_item = elem_def | entity_def | att_list_def | notation_def
+let entity_def   =
+  let literal (lbl:string) = [ sep_spc . label lbl . sto_dquote ] in
+  decl_def /!ENTITY/
+    ( literal "#decl"
+    | [ sep_spc . key /SYSTEM/ . literal "#systemliteral" ]
+    | [ sep_spc . key /PUBLIC/ . literal "#pubidliteral"
+                               . literal "#systemliteral" ] )
+
+let decl_def_item = elem_def | entity_def
+                  | att_list_def | notation_def
 
 let decl_outer    = sep_osp . del /\[[ \n\t\r]*/ "[\n" .
                     (decl_def_item . sep_osp )* . dels "]"