From: Enrico Tassi Date: Fri, 1 Jul 2005 10:03:11 +0000 (+0000) Subject: uri_of_string now checks the uri is well formed X-Git-Tag: PRE_GETTER_STORAGE~75 X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=c7d38c2afdf1319a34f3faa4696faace06dbd490;p=helm.git uri_of_string now checks the uri is well formed --- diff --git a/helm/ocaml/urimanager/uriManager.ml b/helm/ocaml/urimanager/uriManager.ml index b8da7d91e..296701af5 100644 --- a/helm/ocaml/urimanager/uriManager.ml +++ b/helm/ocaml/urimanager/uriManager.ml @@ -77,16 +77,57 @@ module MapStringsToUri = Map.Make(OrderedStrings);; *) let set_of_uri = ref MapStringsToUri.empty;; +exception IllFormedUri of string;; + +let _dottypes = ".types" +let _types = "types",5 +let _ann = "ann",3 +let _dotann = ".ann" +let _var = "var",3 +let _dotbody = ".body" +let _con = "con",3 +let _xpointer = "#xpointer(1/" +let _con3 = "con" +let _var3 = "var" +let _ind3 = "ind" +let _ann3 = "ann" +let _types5 = "types" +let _xpointer8 = "xpointer" +let _cic5 = "cic:/" + +let is_malformed suri = + try + if String.sub suri 0 5 <> _cic5 then true + else + let len = String.length suri - 5 in + let last5 = String.sub suri len 5 in + let last3 = String.sub last5 2 3 in + if last3 = _con3 || last3 = _var3 || last3 = _ind3 || + last3 = _ann3 || last5 = _types5 || last5 = _dotbody then + false + else + try + let index = String.rindex suri '#' + 1 in + let xptr = String.sub suri index 8 in + if xptr = _xpointer8 then + false + else + true + with Not_found -> true + with Invalid_argument _ -> true + (* hash conses an uri *) let uri_of_string suri = try MapStringsToUri.find suri !set_of_uri with Not_found -> - let new_uri = suri, fresh_id () in - set_of_uri := MapStringsToUri.add suri new_uri !set_of_uri; - new_uri + if is_malformed suri then + raise (IllFormedUri suri) + else + let new_uri = suri, fresh_id () in + set_of_uri := MapStringsToUri.add suri new_uri !set_of_uri; + new_uri -exception IllFormedUri of string;; let strip_xpointer ((uri,_) as olduri) = try @@ -115,14 +156,6 @@ let has_suffix uri (pat,n) = with Not_found -> assert false -let _dottypes = ".types" -let _types = "types",5 -let _ann = "ann",3 -let _dotann = ".ann" -let _var = "var",3 -let _dotbody = ".body" -let _con = "con",3 -let _xpointer = "#xpointer(1/" let cicuri_of_uri (uri, _) = uri_of_string (clear_suffix uri ~pat2:_types _ann)