From fd98d82477140a33fca1f7b5057c3c014f75dbbe Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Sat, 5 Feb 2022 15:10:37 +0100 Subject: server: reorganise the code Signed-off-by: Alban Gruin --- src/server.ml | 70 ++++++++++++++++++++++++++++++----------------------------- 1 file changed, 36 insertions(+), 34 deletions(-) diff --git a/src/server.ml b/src/server.ml index dc931aa..bedc9a0 100644 --- a/src/server.ml +++ b/src/server.ml @@ -1,5 +1,5 @@ (* - * Copyright (C) 2020, 2021 Alban Gruin + * Copyright (C) 2020 -- 2022 Alban Gruin * * ucs is free software: you can redistribute it and/or modify * it under the terms of the GNU Affero General Public License as published @@ -34,6 +34,39 @@ let kind_to_res_type = function | Group -> "103" | Module -> "100" +let kind_to_url = function + | Group -> "g" + | Module -> "m" + +let skip_if predicate fn value = + if predicate then + value + else + fn value + +let get_tz () = + Lwt_unix.file_exists "/etc/timezone" >>= fun exists -> + if exists then + Lwt_io.(open_file ~mode:Input "/etc/timezone") >>= fun file -> + Lwt.finalize + (fun () -> + Lwt_io.read file >|= + String.trim) + (fun () -> Lwt_io.close file) + else + Lwt.return "" + +let log uri = + let datetime = + Printer.Calendar.sprint "%Y-%m-%d %H:%M:%S" @@ Calendar.now () in + Lwt_io.printlf "[%s] %s" datetime (Uri.path_and_query uri) + +let respond ?(mime="text/html; charset=utf-8") ?(status=`OK) body = + let headers = Header.init_with "Content-Type" mime in + Server.respond_string ~status ~body ~headers () + +let bad_request = Server.respond_string ~status:`Bad_request ~body:"Bad request\n" + let fetch celcat_url group kind = let current_date = Date.today () in let lower_date = format_date @@ Date.rem current_date a_month and @@ -49,35 +82,7 @@ let fetch celcat_url group kind = >>= fun (_resp, body) -> Cohttp_lwt.Body.to_string body -let log uri = - let datetime = - Printer.Calendar.sprint "%Y-%m-%d %H:%M:%S" @@ Calendar.now () in - Lwt_io.printlf "[%s] %s" datetime (Uri.path_and_query uri) - -let respond ?(mime="text/html; charset=utf-8") ?(status=`OK) body = - let headers = Header.init_with "Content-Type" mime in - Server.respond_string ~status ~body ~headers () - -let bad_request = Server.respond_string ~status:`Bad_request ~body:"Bad request\n" - -let get_tz () = - Lwt_unix.file_exists "/etc/timezone" >>= fun exists -> - if exists then - Lwt_io.(open_file ~mode:Input "/etc/timezone") >>= fun file -> - Lwt.finalize - (fun () -> - Lwt_io.read file >|= - String.trim) - (fun () -> Lwt_io.close file) - else - Lwt.return "" - let fetch_and_respond ?(groups=[]) tzname celcat_url file kind = - let skip_if predicate fn value = - if predicate then - value - else - fn value in let id = String.(sub file 0 (length file - 4)) in fetch celcat_url id kind >>= fun body -> Course.decode body @@ -85,12 +90,7 @@ let fetch_and_respond ?(groups=[]) tzname celcat_url file kind = |> Ics.to_string tzname |> respond ~mime:"text/calendar; charset=utf-8" -let check_ics = Astring.String.is_suffix ~affix:".ics" - let get_link ?(args=[]) base_url kind id = - let kind_to_url = function - | Group -> "g" - | Module -> "m" in let args = if args = [] then "" else "?" ^ Uri.encoded_of_query args in @@ -121,6 +121,8 @@ let get_module_link base_url body = | _, _ -> bad_request () +let check_ics = Astring.String.is_suffix ~affix:".ics" + let serve base_url celcat_url mode stop = get_tz () >>= fun tzname -> let callback _conn req body = -- cgit v1.2.1