avoid writing in read only baseuris

[helm.git] / helm / ocaml / grafite_engine / grafiteEngine.ml

diff --git a/helm/ocaml/grafite_engine/grafiteEngine.ml b/helm/ocaml/grafite_engine/grafiteEngine.ml
index 26d7712d39fc1e104b75dc8d4ad49215e339fff7..c0a453c932e0eae3dee583458e3d07f76bc6d9d8 100644 (file)
--- a/helm/ocaml/grafite_engine/grafiteEngine.ml
+++ b/helm/ocaml/grafite_engine/grafiteEngine.ml
@@ -25,11 +25,14 @@
 
 (* $Id$ *)
 
+open Printf
+
 exception Drop
 exception IncludedFileNotCompiled of string (* file name *)
 exception Macro of
  GrafiteAst.loc *
   (Cic.context -> GrafiteTypes.status * Cic.term GrafiteAst.macro)
+exception ReadOnlyUri of string
 
 type options = { 
   do_heavy_checks: bool ; 
@@ -544,7 +547,6 @@ let rec eval_command = {ec_go = fun ~disambiguate_command opts status cmd ->
      GrafiteTypes.add_moo_content [cmd] status,[]
   | GrafiteAst.Include (loc, baseuri) ->
      let moopath = LibraryMisc.obj_file_of_baseuri ~basedir ~baseuri in
-     let metadatapath= LibraryMisc.metadata_file_of_baseuri ~basedir ~baseuri in
      if not (Sys.file_exists moopath) then
        raise (IncludedFileNotCompiled moopath);
      let status = eval_from_moo.efm_go status moopath in
@@ -555,11 +557,15 @@ let rec eval_command = {ec_go = fun ~disambiguate_command opts status cmd ->
           let v = Http_getter_misc.strip_trailing_slash value in
           try
             ignore (String.index v ' ');
-            raise (GrafiteTypes.Command_error "baseuri can't contain spaces")
+            GrafiteTypes.command_error "baseuri can't contain spaces"
           with Not_found -> v
         in
+        if Http_getter_storage.is_read_only value then begin
+          HLog.error (sprintf "uri %s belongs to a read-only repository" value);
+          raise (ReadOnlyUri value)
+        end;
         if not (GrafiteMisc.is_empty value) && opts.clean_baseuri then begin
-          HLog.warn ("baseuri " ^ value ^ " is not empty");
+          HLog.message ("baseuri " ^ value ^ " is not empty");
           HLog.message ("cleaning baseuri " ^ value);
           LibraryClean.clean_baseuris ~basedir [value];
         end;
@@ -637,9 +643,6 @@ let rec eval_command = {ec_go = fun ~disambiguate_command opts status cmd ->
                   "\nPlease use a variant."));
            end;
          assert (metasenv = metasenv');
-         let goalno =
-           match metasenv' with (goalno,_,_)::_ -> goalno | _ -> assert false 
-         in
          let initial_proof = (Some uri, metasenv, bo, ty) in
          let initial_stack = Continuationals.Stack.of_metasenv metasenv in
          { status with GrafiteTypes.proof_status =