This commit is contained in:
Swrup 2022-02-27 19:58:32 +01:00
parent bff747b4ca
commit 048f77098b
5 changed files with 24 additions and 21 deletions

View file

@ -42,14 +42,6 @@ let open_registration =
let () = Dream.log "open_registration: %b" open_registration let () = Dream.log "open_registration: %b" open_registration
let hostname =
match Scfg.Query.get_dir "hostname" config with
| None -> failwith "no `hostname` in configuration file"
| Some hostname ->
Result.fold ~error:failwith ~ok:Fun.id (Scfg.Query.get_param 0 hostname)
let () = Dream.log "hostname: %s" hostname
let port = let port =
match Scfg.Query.get_dir "port" config with match Scfg.Query.get_dir "port" config with
| None -> 8080 | None -> 8080
@ -66,6 +58,14 @@ let port =
let () = Dream.log "port: %d" port let () = Dream.log "port: %d" port
let hostname =
match Scfg.Query.get_dir "hostname" config with
| None -> Format.sprintf "localhost:%d" port
| Some hostname ->
Result.fold ~error:failwith ~ok:Fun.id (Scfg.Query.get_param 0 hostname)
let () = Dream.log "hostname: %s" hostname
let log = let log =
match Scfg.Query.get_dir "log" config with match Scfg.Query.get_dir "log" config with
| None -> true | None -> true

View file

@ -271,11 +271,15 @@ let parse_comment comment =
let pp_word fmt w = let pp_word fmt w =
let trim_w = String.trim w in let trim_w = String.trim w in
(* '>' is '>' after html_escape *) (* '>' is '>' after html_escape *)
if String.starts_with ~prefix:{|>>|} trim_w then if String.length trim_w >= 8 then
let sub_w = String.sub trim_w 8 (String.length trim_w - 8) in let sub_w = String.sub trim_w 8 (String.length trim_w - 8) in
if Option.is_some (Uuidm.of_string sub_w) then ( if
String.starts_with ~prefix:{|>>|} trim_w
&& Option.is_some (Uuidm.of_string sub_w)
then begin
citations := sub_w :: !citations; citations := sub_w :: !citations;
Format.fprintf fmt {|<a href="#%s">%s</a>|} sub_w w ) Format.fprintf fmt {|<a href="#%s">%s</a>|} sub_w w
end
else Format.pp_print_string fmt w else Format.pp_print_string fmt w
else Format.pp_print_string fmt w else Format.pp_print_string fmt w
in in
@ -290,10 +294,7 @@ let parse_comment comment =
Format.fprintf fmt {|<span class="quote">%a</span>|} Format.fprintf fmt {|<span class="quote">%a</span>|}
(Format.pp_print_list ~pp_sep:Format.pp_print_space pp_word) (Format.pp_print_list ~pp_sep:Format.pp_print_space pp_word)
words words
else else Format.pp_print_list ~pp_sep:Format.pp_print_space pp_word fmt words
Format.fprintf fmt "%a"
(Format.pp_print_list ~pp_sep:Format.pp_print_space pp_word)
words
in in
let comment = String.trim comment in let comment = String.trim comment in
@ -370,7 +371,7 @@ let build_reply ~comment ?image ~tags ?parent_id nick =
let tag_list = let tag_list =
List.map String.lowercase_ascii List.map String.lowercase_ascii
@@ List.sort_uniq String.compare @@ List.sort_uniq String.compare
@@ List.filter (fun s -> not (String.equal "" s)) @@ List.filter (( <> ) "")
@@ List.map String.trim @@ List.map String.trim
@@ Str.split (Str.regexp ",+") tags @@ Str.split (Str.regexp ",+") tags
in in
@ -467,7 +468,7 @@ let try_delete_post ~nick id =
else Error "You can only delete your posts" else Error "You can only delete your posts"
let report ~nick ~reason id = let report ~nick ~reason id =
if not (post_exist id) then Error "This post doesn't exists" if not (post_exist id) then Error "This post exists not"
else if String.length reason > 2000 then Error "Your reason is too long.." else if String.length reason > 2000 then Error "Your reason is too long.."
else else
let reason = Dream.html_escape reason in let reason = Dream.html_escape reason in

View file

@ -10,7 +10,7 @@ let insert_quote post_id _event =
let new_content = let new_content =
if String.ends_with ~suffix:"\n" content || String.length content = 0 if String.ends_with ~suffix:"\n" content || String.length content = 0
then Format.sprintf "%s>>%s " content post_id then Format.sprintf "%s>>%s " content post_id
else Format.sprintf "%s\n>>%s " content post_id else Format.sprintf "%s@\n>>%s " content post_id
in in
ignore @@ Jv.set textarea "value" (Jv.of_string new_content) ) ignore @@ Jv.set textarea "value" (Jv.of_string new_content) )
Jv.(find global "reply-comment") Jv.(find global "reply-comment")

View file

@ -291,8 +291,7 @@ let babillard_post request =
let thread_feed_get request = let thread_feed_get request =
let thread_id = Dream.param request "thread_id" in let thread_id = Dream.param request "thread_id" in
if Babillard.thread_exist thread_id then if Babillard.thread_exist thread_id then
let feed = Pp_babillard.feed thread_id in match Pp_babillard.feed thread_id with
match feed with
| Error e -> render_unsafe e request | Error e -> render_unsafe e request
| Ok feed -> | Ok feed ->
Dream.respond ~headers:[ ("Content-Type", "application/atom+xml") ] feed Dream.respond ~headers:[ ("Content-Type", "application/atom+xml") ] feed

View file

@ -301,7 +301,10 @@ let feed thread_id =
let^ ids = Db.collect_list Q.get_thread_posts thread_id in let^ ids = Db.collect_list Q.get_thread_posts thread_id in
let* posts = get_posts ids in let* posts = get_posts ids in
let posts = List.sort (fun a b -> compare b.date a.date) posts in let posts = List.sort (fun a b -> compare b.date a.date) posts in
let last_update = (List.nth posts 0).date in let* last_update =
match posts with op :: _ -> Ok op.date | _ -> Error "empty thread"
in
let entries fmt () = let entries fmt () =
(Format.pp_print_list ~pp_sep:Format.pp_print_space pp_feed_entry) fmt posts (Format.pp_print_list ~pp_sep:Format.pp_print_space pp_feed_entry) fmt posts
in in