1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker and Matt Lilley 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2016, CWI Amsterdam 7 All rights reserved. 8 9 Redistribution and use in source and binary forms, with or without 10 modification, are permitted provided that the following conditions 11 are met: 12 13 1. Redistributions of source code must retain the above copyright 14 notice, this list of conditions and the following disclaimer. 15 16 2. Redistributions in binary form must reproduce the above copyright 17 notice, this list of conditions and the following disclaimer in 18 the documentation and/or other materials provided with the 19 distribution. 20 21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 POSSIBILITY OF SUCH DAMAGE. 33*/ 34 35:- module(c14n2, 36 [ xml_write_canonical/3 % +Stream, +Term, +Options 37 ]). 38:- autoload(library(apply),[partition/4,maplist/3]). 39:- autoload(library(dicts),[dict_keys/2]). 40:- autoload(library(error),[instantiation_error/1,must_be/2]). 41:- autoload(library(lists),[member/2,append/2,select/3]). 42:- autoload(library(option),[option/3]). 43:- autoload(library(ordsets),[ord_subtract/3]). 44:- autoload(library(sgml_write),[xml_write/3]).

C14n2 canonical XML documents

C14n2 specifies a canonical XML document. This library writes such a document from an XML DOM as returned by the XML (or SGML) parser. The process takes two steps:

Normalise the DOM
Call xml_write/3 with appropriate flags

64xml_write_canonical(Stream, DOM, Options) :- 65 option(method(Method), Options, 'http://www.w3.org/TR/2001/REC-xml-c14n-20010315'), 66 xml_canonical_dom(DOM, CDOM, xml{in_ns:ns{}, out_ns:ns{}, is_root:true, method:Method}), 67 xml_write(Stream, CDOM, 68 [ header(false), 69 layout(false), 70 net(false) 71 ]). 72 73xml_canonical_dom(Var, _, _) :- 74 var(Var), 75 !, 76 instantiation_error(Var). 77xml_canonical_dom(DOM, CDOM, Options) :- 78 is_list(DOM), 79 !, 80 xml_canonical_list(DOM, CDOM, Options). 81xml_canonical_dom(element( Name, Attrs, Content), 82 element(CName, CAttrs, CContent), 83 Options) :- 84 !, 85 InNS0 = Options.in_ns, 86 OutNS0 = Options.out_ns, 87 Method = Options.method, 88 % We must include namespaces which appear in attributes in this element, too, if using xml-exc-c14n 89 % This means we need to know what they are 90 findall(NS, (member(Attr, Attrs), Attr = (NS:_=_), NS \== xmlns), NamespacesInAttrs), 91 take_ns(Attrs, Method, NamespacesInAttrs, Name, Attrs1, InNS0, InNS), 92 partition(has_ns, Attrs1, AttrsWithNS0, AttrsSans0), 93 sort(1, @<, AttrsWithNS0, AttrsWithNS1), 94 sort(1, @<, AttrsSans0, AttrsSans), 95 put_elemns(Name, CName, InNS, OutNS0, OutNS1, KillDefault), 96 put_ns_attrs(AttrsWithNS1, AttrsWithNS, InNS, OutNS1, OutNS), 97 ns_attrs(OutNS0, OutNS, NSAttrs), 98 ( Options.is_root == true -> 99 ( select(xmlns=DefaultNamespace, NSAttrs, NSAttrs0) 100 % If there is a default namespace, it must come first, and I dont think sort/4 can sort on two keys at once 101 -> findall(xmlns:NS=URI, member(xmlns:NS=URI, Attrs), RootNSAttrs, NSAttrs0), 102 sort(2, @=<, RootNSAttrs, RootNSAttrs0), 103 RootNSAttrs1 = [xmlns=DefaultNamespace|RootNSAttrs0] 104 ; Method == 'http://www.w3.org/2001/10/xml-exc-c14n#' 105 -> RootNSAttrs1 = NSAttrs 106 ; findall(xmlns:NS=URI, member(xmlns:NS=URI, Attrs), RootNSAttrs, NSAttrs), 107 sort(1, @<, RootNSAttrs, RootNSAttrs1) 108 ), 109 append([KillDefault, RootNSAttrs1, AttrsSans, AttrsWithNS], CAttrs) 110 ; append([KillDefault, NSAttrs, AttrsSans, AttrsWithNS], CAttrs) 111 ), 112 must_be(list, Content), 113 xml_canonical_list(Content, CContent, 114 Options.put(_{in_ns:InNS, out_ns:OutNS, is_root:false})). 115xml_canonical_dom(CDATA, CDATA, _) :- 116 atomic(CDATA). 117 118has_ns(_NS:_Name=_Value). 119 120xml_canonical_list([], [], _). 121xml_canonical_list([H0|T0], [H|T], Options) :- 122 xml_canonical_dom(H0, H, Options), 123 xml_canonical_list(T0, T, Options). 124 125take_ns([], _, _, _, [], NSList, NSList). 126take_ns([H|T0], Method, NamespacesInAttrs, Name, T, NSList0, NSList) :- 127 xml_ns(H, NS, URL), 128 !, 129 ( include_ns(Name, Method, NamespacesInAttrs, NS, URL) 130 -> take_ns(T0, Method, NamespacesInAttrs, Name, T, NSList0.put(NS, URL), NSList) 131 ; take_ns(T0, Method, NamespacesInAttrs, Name, T, NSList0, NSList) 132 ). 133take_ns([H|T0], Method, NamespacesInAttrs, Name, [H|T], NSList0, NSList) :- 134 take_ns(T0, Method, NamespacesInAttrs, Name, T, NSList0, NSList). 135 136include_ns(ns(Prefix, URI):_, 'http://www.w3.org/2001/10/xml-exc-c14n#', _, Prefix, URI):- !. 137include_ns(_, 'http://www.w3.org/2001/10/xml-exc-c14n#', NamespacesInAttrs, _Prefix, URI):- 138 memberchk(URI, NamespacesInAttrs). 139include_ns(_, 'http://www.w3.org/TR/2001/REC-xml-c14n-20010315', _, _, _):- !. 140 141 142put_ns_attrs([], [], _, OutNS, OutNS). 143put_ns_attrs([Name=Value|T0], [CName=Value|T], InNS, OutNS0, OutNS) :- 144 put_ns(Name, CName, InNS, OutNS0, OutNS1), 145 put_ns_attrs(T0, T, InNS, OutNS1, OutNS). 146 147put_elemns(Name, Name, _InNS, OutNS0, OutNS1, [xmlns='']) :- 148 atom(Name), 149 dict_pairs(OutNS0, _, Pairs), 150 memberchk(URL-'', Pairs), 151 !, 152 del_dict(URL, OutNS0, '', OutNS1). 153put_elemns(Name, CName, InNS, OutNS0, OutNS, []) :- 154 put_ns(Name, CName, InNS, OutNS0, OutNS). 155 156put_ns(ns('', xml):Name, xml:Name, _InNS, OutNS, OutNS) :- 157 !. 158put_ns(ns(NS, URL):Name, CName, _InNS, OutNS, OutNS) :- 159 get_dict(URL, OutNS, NS), 160 !, 161 make_cname(NS:Name, CName). 162put_ns(ns(NS, URL):Name, CName, _InNS, OutNS0, OutNS) :- 163 !, 164 make_cname(NS:Name, CName), 165 OutNS = OutNS0.put(URL, NS). 166put_ns(URL:Name, CName, _InNS, OutNS, OutNS) :- 167 get_dict(URL, OutNS, NS), 168 !, 169 make_cname(NS:Name, CName). 170put_ns(URL:Name, CName, InNS, OutNS0, OutNS) :- 171 dict_pairs(InNS, _, Pairs), 172 memberchk(NS-URL, Pairs), 173 !, 174 make_cname(NS:Name, CName), 175 OutNS = OutNS0.put(URL, NS). 176put_ns(Name, Name, _, OutNS, OutNS). 177 178ns_attrs(OutNS, OutNS, []) :- !. 179ns_attrs(OutNS0, OutNS, NSAttrs) :- 180 !, 181 dict_pairs(OutNS, _, Pairs), 182 dict_pairs(OutNS0, _, Pairs0), 183 ord_subtract(Pairs, Pairs0, NewPairs), 184 maplist(ns_attr(OutNS), NewPairs, NSAttrs0), 185 sort(NSAttrs0, NSAttrs). 186 187ns_attr(Dict, URL-_, NSAttr) :- 188 ns_simplify(xmlns:Dict.URL=URL, NSAttr). 189 190ns_simplify(xmlns:''=URL, xmlns=URL) :- !. 191ns_simplify(xmlns:NS=URL, XMLNS=URL) :- 192 make_cname(xmlns:NS, XMLNS). 193 194xml_ns(ns('', xmlns):NS=URL, NS, URL) :- !. 195xml_ns(xmlns=URL, '', URL) :- !. 196xml_ns(xmlns:NS=URL, NS, URL) :- !. 197xml_ns(Name=URL, NS, URL) :- 198 atom(Name), 199 atom_concat('xmlns:', NS, Name). 200 201make_cname('':Name, Name) :- !. 202make_cname(NS:Name, CName) :- 203 atomic_list_concat([NS,Name], :, CName)