helm/interface/pxpUriResolver.ml

   1 (* Copyright (C) 2000, HELM Team.
   2  *
   3  * This file is part of HELM, an Hypertextual, Electronic
   4  * Library of Mathematics, developed at the Computer Science
   5  * Department, University of Bologna, Italy.
   6  *
   7  * HELM is free software; you can redistribute it and/or
   8  * modify it under the terms of the GNU General Public License
   9  * as published by the Free Software Foundation; either version 2
  10  * of the License, or (at your option) any later version.
  11  *
  12  * HELM is distributed in the hope that it will be useful,
  13  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15  * GNU General Public License for more details.
  16  *
  17  * You should have received a copy of the GNU General Public License
  18  * along with HELM; if not, write to the Free Software
  19  * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
  20  * MA  02111-1307, USA.
  21  *
  22  * For details, see the HELM World-Wide-Web page,
  23  * http://cs.unibo.it/helm/.
  24  *)
  25
  26 (******************************************************************************)
  27 (*                                                                            *)
  28 (*                               PROJECT HELM                                 *)
  29 (*                                                                            *)
  30 (*                Claudio Sacerdoti Coen <sacerdot@cs.unibo.it>               *)
  31 (*                                 11/10/2000                                 *)
  32 (*                                                                            *)
  33 (*                                                                            *)
  34 (******************************************************************************)
  35
  36 let resolve =
  37  function
  38     "http://localhost:8081/getdtd?uri=cic.dtd" ->
  39      Configuration.dtd_dir ^ "/cic.dtd"
  40   | "http://localhost:8081/getdtd?uri=maththeory.dtd" ->
  41      Configuration.dtd_dir ^ "/maththeory.dtd"
  42   | "http://localhost:8081/getdtd?uri=annotations.dtd" ->
  43      Configuration.dtd_dir ^ "/annotations.dtd"
  44   | s  -> s
  45 ;;
  46
  47 let url_syntax =
  48     let enable_if =
  49       function
  50           `Not_recognized  -> Neturl.Url_part_not_recognized
  51         | `Allowed         -> Neturl.Url_part_allowed
  52         | `Required        -> Neturl.Url_part_required
  53     in
  54     { Neturl.null_url_syntax with
  55         Neturl.url_enable_scheme = enable_if `Allowed;
  56         Neturl.url_enable_host   = enable_if `Allowed;
  57         Neturl.url_enable_path   = Neturl.Url_part_required;
  58         Neturl.url_accepts_8bits = true;
  59     }
  60 ;;
  61
  62 let file_url_of_id xid =
  63   let file_url_of_sysname sysname =
  64     (* By convention, we can assume that sysname is a URL conforming
  65      * to RFC 1738 with the exception that it may contain non-ASCII
  66      * UTF-8 characters.
  67      *)
  68     try
  69      Neturl.url_of_string url_syntax sysname
  70         (* may raise Malformed_URL *)
  71     with
  72      Neturl.Malformed_URL -> raise Pxp_reader.Not_competent
  73   in
  74   let url =
  75     match xid with
  76        Pxp_types.Anonymous          -> raise Pxp_reader.Not_competent
  77      | Pxp_types.Public (_,sysname) ->
  78         let sysname = resolve sysname in
  79          if sysname <> "" then file_url_of_sysname sysname
  80                           else raise Pxp_reader.Not_competent
  81      | Pxp_types.System sysname     ->
  82         let sysname = resolve sysname in
  83          file_url_of_sysname sysname
  84   in
  85   let scheme =
  86     try Neturl.url_scheme url with Not_found -> "file" in
  87   let host =
  88     try Neturl.url_host url with Not_found -> "" in
  89
  90   if scheme <> "file" then raise Pxp_reader.Not_competent;
  91   if host <> "" && host <> "localhost" then raise Pxp_reader.Not_competent;
  92
  93   url
  94 ;;
  95
  96 let from_file ?system_encoding utf8_filename =
  97
  98   let r =
  99     new Pxp_reader.resolve_as_file
 100       ?system_encoding:system_encoding
 101       ~url_of_id:file_url_of_id
 102       ()
 103   in
 104
 105   let utf8_abs_filename =
 106     if utf8_filename <> "" && utf8_filename.[0] = '/' then
 107       utf8_filename
 108     else
 109       Sys.getcwd() ^ "/" ^ utf8_filename
 110   in
 111
 112   let syntax = { Neturl.ip_url_syntax with Neturl.url_accepts_8bits = true } in
 113   let url = Neturl.make_url
 114               ~scheme:"file"
 115               ~host:"localhost"
 116               ~path:(Neturl.split_path utf8_abs_filename)
 117               syntax
 118   in
 119
 120   let xid = Pxp_types.System (Neturl.string_of_url url) in
 121
 122
 123   Pxp_yacc.ExtID(xid, r)
 124 ;;
 125
 126