mkdir_corpus_cgi.ml 1.94 KB
Newer Older
Idir Lankri's avatar
Idir Lankri committed
1
(**************************************************************************)
2
(*                                                                        *)
Idir Lankri's avatar
Idir Lankri committed
3 4 5 6 7 8 9
(*                     The Sanskrit Heritage Platform                     *)
(*                                                                        *)
(*                              Idir Lankri                               *)
(*                                                                        *)
(* ©2017 Institut National de Recherche en Informatique et en Automatique *)
(**************************************************************************)

10 11
(* CGI script [mkdir_corpus] for creating a new corpus subdirectory.  *)

12 13
open Web;

14 15 16 17 18
value main =
  let query = Cgi.query_string () in
  let env = Cgi.create_env query in
  let dirname = Cgi.decoded_get Mkdir_corpus_params.dirname "" env in
  let parent_dir = Cgi.decoded_get Mkdir_corpus_params.parent_dir "" env in
19 20 21
  let permission =
    Cgi.decoded_get Mkdir_corpus_params.permission "" env
    |> Web_corpus.permission_of_string
22
  in
23
  let error_page = error_page "Corpus Manager" in
24
  match permission with
25
  [ Web_corpus.Manager ->
26 27 28
    try
      do
      { Web_corpus.mkdir (Filename.concat parent_dir dirname)
29
      ; Corpus_manager.mk_page parent_dir permission
30 31
      }
    with
32 33
    [ Web_corpus.Section_already_exists abbrev ->
      error_page "Already existing section " abbrev
34 35 36 37 38 39
    | Unix.Unix_error (err, func, arg) ->
      let submsg =
        Printf.sprintf "'%s' failed on '%s': %s"
          func arg (Unix.error_message err)
      in
      error_page Control.sys_err_mess submsg
40 41
    | _ ->
      abort Html.default_language Control.fatal_err_mess "Unexpected anomaly"
42
    ]
43
  | Web_corpus.Reader | Web_corpus.Annotator ->
44 45 46
    let expected_permission = Web_corpus.(string_of_permission Manager) in
    let current_permission = Web_corpus.string_of_permission permission in
    invalid_corpus_permission_page expected_permission current_permission
47
  ]
48
;