diff -u xml-light-2.2/debian/changelog xml-light-2.2/debian/changelog --- xml-light-2.2/debian/changelog +++ xml-light-2.2/debian/changelog @@ -1,3 +1,12 @@ +xml-light (2.2-12ubuntu0.1) precise-security; urgency=low + + * SECURITY-UPDATE: Fix to prevent hash collision attack (LP: #1186860) + - debian/patches/05_CVE_2012_3514.dpatch: dtd.ml: Use Map(String) instead + of Hash for DTD proof. Based on upstream patch. + - CVE-2012-3514 + + -- Christian Kuersteiner Mon, 03 Jun 2013 11:53:02 +0700 + xml-light (2.2-12build5) precise; urgency=low * Rebuild with ocamlopt on armhf. diff -u xml-light-2.2/debian/control xml-light-2.2/debian/control --- xml-light-2.2/debian/control +++ xml-light-2.2/debian/control @@ -1,7 +1,8 @@ Source: xml-light Section: ocaml Priority: optional -Maintainer: Debian OCaml Maintainers +Maintainer: Ubuntu Developers +XSBC-Original-Maintainer: Debian OCaml Maintainers Uploaders: Sylvain Le Gall , Mehdi Dogguy diff -u xml-light-2.2/debian/patches/00list xml-light-2.2/debian/patches/00list --- xml-light-2.2/debian/patches/00list +++ xml-light-2.2/debian/patches/00list @@ -4,0 +5 @@ +05_CVE_2012_3514.dpatch only in patch2: unchanged: --- xml-light-2.2.orig/debian/patches/05_CVE_2012_3514.dpatch +++ xml-light-2.2/debian/patches/05_CVE_2012_3514.dpatch @@ -0,0 +1,163 @@ +#! /bin/sh /usr/share/dpatch/dpatch-run +## Description: use Map(String) instead of Hash for DTD proof +## (prevent hash collision attack). Omitted parts from upstream patch which +## are non-existing in this version. +## Origin: backport, https://code.google.com/p/ocamllibs/source/detail?r=234 +## Author: ckuerste@gmx.ch +## Ubuntu-Bug: https://bugs.launchpad.net/ubuntu/+source/xml-light/+bug/1186860 + +@DPATCH@ +diff -urNad '--exclude=CVS' '--exclude=.svn' '--exclude=.git' '--exclude=.arch' '--exclude=.hg' '--exclude=_darcs' '--exclude=.bzr' xml-light-2.2~/dtd.ml xml-light-2.2/dtd.ml +--- xml-light-2.2~/dtd.ml 2005-02-18 16:01:54.000000000 +0700 ++++ xml-light-2.2/dtd.ml 2013-06-01 23:14:31.946376292 +0700 +@@ -93,16 +93,18 @@ + + type dtd = dtd_item list + +-type ('a,'b) hash = ('a,'b) Hashtbl.t ++module StringMap = Map.Make(String) ++ ++type 'a map = 'a StringMap.t ref + + type checked = { +- c_elements : (string,dtd_element_type) hash; +- c_attribs : (string,(string,(dtd_attr_type * dtd_attr_default)) hash) hash; ++ c_elements : dtd_element_type map; ++ c_attribs : (dtd_attr_type * dtd_attr_default) map map; + } + + type dtd_state = { +- elements : (string,dtd_element_type) hash; +- attribs : (string,(string,(dtd_attr_type * dtd_attr_default)) hash) hash; ++ elements : dtd_element_type map; ++ attribs : (dtd_attr_type * dtd_attr_default) map map; + mutable current : dtd_element_type; + mutable curtag : string; + state : (string * dtd_element_type) Stack.t; +@@ -113,7 +115,21 @@ + let _raises e = + file_not_found := e + +-let empty_hash = Hashtbl.create 0 ++let create_map() = ref StringMap.empty ++ ++let empty_map = create_map() ++ ++let find_map m k = StringMap.find k (!m) ++ ++let set_map m k v = m := StringMap.add k v (!m) ++ ++let unset_map m k = m := StringMap.remove k (!m) ++ ++let iter_map f m = StringMap.iter f (!m) ++ ++let fold_map f m = StringMap.fold f (!m) ++ ++let mem_map m k = StringMap.mem k (!m) + + let pos source = + let line, lstart, min, max = Xml_lexer.pos source in +@@ -158,45 +174,45 @@ + raise e + + let check dtd = +- let attribs = Hashtbl.create 0 in +- let hdone = Hashtbl.create 0 in +- let htodo = Hashtbl.create 0 in ++ let attribs = create_map () in ++ let hdone = create_map () in ++ let htodo = create_map () in + let ftodo tag from = + try +- ignore(Hashtbl.find hdone tag); ++ ignore(find_map hdone tag); + with + Not_found -> + try +- match Hashtbl.find htodo tag with +- | None -> Hashtbl.replace htodo tag from ++ match find_map htodo tag with ++ | None -> set_map htodo tag from + | Some _ -> () + with + Not_found -> +- Hashtbl.add htodo tag from ++ set_map htodo tag from + in + let fdone tag edata = + try +- ignore(Hashtbl.find hdone tag); ++ ignore(find_map hdone tag); + raise (Check_error (ElementDefinedTwice tag)); + with + Not_found -> +- Hashtbl.remove htodo tag; +- Hashtbl.add hdone tag edata ++ unset_map htodo tag; ++ set_map hdone tag edata + in + let fattrib tag aname adata = + let h = (try +- Hashtbl.find attribs tag ++ find_map attribs tag + with + Not_found -> +- let h = Hashtbl.create 1 in +- Hashtbl.add attribs tag h; ++ let h = create_map () in ++ set_map attribs tag h; + h) in + try +- ignore(Hashtbl.find h aname); ++ ignore(find_map h aname); + raise (Check_error (AttributeDefinedTwice (tag,aname))); + with + Not_found -> +- Hashtbl.add h aname adata ++ set_map h aname adata + in + let check_item = function + | DTDAttribute (tag,aname,atype,adef) -> +@@ -229,7 +245,7 @@ + check_type etype + in + List.iter check_item dtd; +- Hashtbl.iter (fun t from -> ++ iter_map (fun t from -> + match from with + | None -> raise (Check_error (ElementNotDeclared t)) + | Some tag -> raise (Check_error (ElementReferenced (t,tag))) +@@ -248,7 +264,7 @@ + curtag = "_root"; + } in + try +- ignore(Hashtbl.find d.elements (String.uppercase root)); ++ ignore(find_map d.elements (String.uppercase root)); + d + with + Not_found -> raise (Check_error (ElementNotDeclared root)) +@@ -365,7 +381,7 @@ + + let check_attrib ahash (aname,_) = + try +- ignore(Hashtbl.find ahash aname); ++ ignore(find_map ahash aname); + with + Not_found -> raise (Prove_error (UnexpectedAttribute aname)) + +@@ -378,12 +394,12 @@ + let uattr = List.map (fun (aname,aval) -> String.uppercase aname , aval) attr in + prove_child dtd (Some utag); + Stack.push (dtd.curtag,dtd.current) dtd.state; +- let elt = (try Hashtbl.find dtd.elements utag with Not_found -> raise (Prove_error (UnexpectedTag tag))) in +- let ahash = (try Hashtbl.find dtd.attribs utag with Not_found -> empty_hash) in ++ let elt = (try find_map dtd.elements utag with Not_found -> raise (Prove_error (UnexpectedTag tag))) in ++ let ahash = (try find_map dtd.attribs utag with Not_found -> empty_map) in + dtd.curtag <- tag; + dtd.current <- elt; + List.iter (check_attrib ahash) uattr; +- let attr = Hashtbl.fold (prove_attrib dtd uattr) ahash [] in ++ let attr = fold_map (prove_attrib dtd uattr) ahash [] in + let childs = ref (List.map (do_prove dtd) childs) in + (match dtd.current with + | DTDAny