seppo/bin/seppo_bin.ml

(*
 *    _  _   ____                         _  
 *  _| || |_/ ___|  ___ _ __  _ __   ___ | | 
 * |_  ..  _\___ \ / _ \ '_ \| '_ \ / _ \| | 
 * |_      _|___) |  __/ |_) | |_) | (_) |_| 
 *   |_||_| |____/ \___| .__/| .__/ \___/(_) 
 *                     |_|   |_|             
 *
 * Personal Social Web.
 *
 * Copyright (C) The #Seppo contributors. All rights reserved.
 *
 * This program is free software: you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program.  If not, see <http://www.gnu.org/licenses/>.
 *)


module C = Cgi
open Seppo_lib
open Astring

(**
   Being a CGI[1] means #Seppo is a binary executable reading from stdin
   writing to stdout in the first place. The Webserver puts incoming HTTP Header
   variables into the environment.

   Serving dynamic content via CGI can be as simple as putting the executable
   into the web directory of e.g. an Apache webserver and entering the according
   http url into your browser.

   Besides that, seppo.cgi has housekeeping commands for the commandline.

   [1] RFC3875 The Common Gateway Interface https://www.rfc-editor.org/rfc/rfc3875.html
*)
let () =
  Mirage_crypto_rng_unix.use_default ();
  let uuid = () |> (() |> Random.State.make_self_init |> Uuidm.v4_gen) in
  let resp_err ec ?(hdrs = [Http.H.ct_plain]) status msg =
    (try Logr.err (fun m -> m "%a %s %s" Uuidm.pp uuid  ec msg);
     with _ -> ());
    Cgi.Response.flush uuid stdout (status, hdrs, fun oc ->
        let s = status |> Cohttp.Code.string_of_status in
        Printf.eprintf "FATAL: %s\r\nsee %s\r\n%s\r\n" s ec msg;
        Printf.fprintf oc "Status: %s\r\n\r\n%s\r\n%s" s ec msg ) in
  (try match Cgi.Request.(from_env () |> consolidate |> proxy) with
     | Error "Not Found." ->
       (* some CLI commands are fine without logging. At least -h and -V have to. *)
       Sys.argv
       |> Array.to_list
       |> Shell.exec
     | Error msg ->
       resp_err E.e1036 `Internal_server_error msg
     | Ok req ->
       req.script_name
       |> Cgi.cd_cgi_bin_twin_path
       |> Unix.chdir;
       match Shell.log_dir |> File.mkdir_p 0o770 with
       | Error msg -> resp_err E.e1035 `Internal_server_error msg
       | Ok log_dir ->
         assert (log_dir |> St.is_suffix ~affix:"/");
         let tnow = Ptime_clock.now () in
         Logr.open_out Shell.log_file;
         let r = req
                 |> C.handle uuid tnow stdin
                 |> Cgi.Response.flush uuid stdout in
         close_in stdin;
         (* closing kills the cgi: close_out stdout; *)
         flush stderr;
         (* L.close_out (); *)
         r
   with
   | Unix.(Unix_error(ENOENT, "chdir", dir)) -> resp_err E.e1037 `Internal_server_error ("cd: The directory '" ^ dir ^ "' does not exist")
   | Sys_error msg -> resp_err E.e1034 `Internal_server_error msg
   | e -> resp_err E.e1005 `Internal_server_error (Printexc.to_string e) )
  |> exit