(* HTTPD *)
(* $Id: httpd.ml,v 1.1.1.1 2003/12/24 07:11:11 berke Exp $ *)
(* HTTP server in one module *)

open Unix
open Debug

let info = Log.info;;

let string_of_sockaddr =
  function
  | ADDR_UNIX x -> sf "UNIX(%S)" x
  | ADDR_INET (a, p) -> sf "%s:%d" (string_of_inet_addr a) p

(*** Server *)
module Server =
  struct
    let serve ~process ~port =
      info (sf "Listening on port %d" port);
      Util.wind
        (fun () ->
          let s = socket PF_INET SOCK_STREAM 0 in
          setsockopt s SO_REUSEADDR true;
          bind s (ADDR_INET (inet_addr_any, port));
          listen s 256;
          while true do
            let (t,a) = accept s in
            info (sf "Connection from %s" (string_of_sockaddr a));
            let _ = Thread.create (fun x ->
              try Http.handler process x with x ->
                info (sf "Exception (%s)" (Printexc.to_string x));
                close t) (t,a) in
            ()
          done) ()
        (fun h -> Sys.set_signal Sys.sigpipe h)
        (Sys.signal Sys.sigpipe Sys.Signal_ignore)
  end
(* Serve ***)

(*** Make *)
module Make(Dpkg : Dpkg.DB) =
  struct
    module Process = Process.Make(Dpkg)
    let database = new Publication.magazine;;
    let database_subscription = database#subscribe ();;

    (*** memory *)
    let memory () =
      let (miw,prw,maw) = Gc.counters () in
      (miw +. maw -. prw) /. 1000000.0
    ;;
    (* ***)

    (*** load_database, reload_database *)
    let load_database ?(after = fun _ -> ()) paths =
       try
         let dbfns = Dpkg.find_database_files paths in
         let db' = Dpkg.load ~fast:!Opt.fast ~progress:(fun _ _ -> ()) dbfns in
         info (sf "Total %d packages" (Dpkg.get_count db'));
         database#publish `Everyone db';
         after db'
       with
       | x -> info (sf "Could not load database: %s" (Printexc.to_string x))
    ;;

    let database_paths () =
      let k = "ara_httpd.database.paths" in
      Configfile.to_list
        (Configfile.to_pair Configfile.to_string Configfile.to_string)
        ~k
        (Config.current#get k)
    ;;

    let reload_database () = load_database (database_paths ())
    ;;

    (* ***)

    let main () =
      List.iter (fun (fn,ex) ->
        if fn <> !Opt.config_file or
           (!Opt.user_specified_config_file & fn = !Opt.config_file) or
           (match ex with Sys_error(_) -> false | _ -> true)
        then
          Printf.printf "Error loading config file %S: %s.\n" fn (Printexc.to_string ex))
        (Config.load ());
      load_database (database_paths ());
      Server.serve ~port:!Opt.port
      ~process:(fun rq ->
        let res = ref (Http.Error(Http.Internal_server_error, "Shit")) in
        database_subscription#with_last_issue
          (fun db -> res := Process.process db rq);
        !res)
  end
;;
(* ***)

let _ =
  Arg.parse
    Opt.specs
    (fun f -> Printf.eprintf "Argument %S ignored.\n%!" f)
    (Sys.argv.(0) ^ " [options]");
  Log.set_file !Opt.log_file;
  Log.info "ara-httpd started";
  try
    if !Opt.very_slow then
      let module M = Make(Dpkg.DBFS) in
      M.main ()
    else
      let module M = Make(Dpkg.DBRAM) in
      M.main ()
  with
  | x -> Log.exc x "Exception in outer loop"
;;
