Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 145 lines (127 sloc) 4.289 kB
3e9b98a @mfp Added copyright notices and LICENSE.
authored
1 (* Copyright (C) 2009 Mauricio Fernandez <mfp@acm.org> *)
ee91bce @mfp Implemented comments.
authored
2 open ExtString
3 open ExtList
4
5 type comment = {
6 c_id : string;
7 c_author : string;
8 c_date : float;
0ddea57 @mfp Comments: save URL if given to add_comment.
authored
9 c_url : string option;
ee91bce @mfp Implemented comments.
authored
10 c_markup : Simple_markup.paragraph list;
11 }
12
13 type sort_criterion = [`Date]
14
15 module M = Map.Make(String)
16 module S = Set.Make(struct
17 type t = comment
18 let compare a b = compare a.c_id b.c_id
19 end)
20
21 type t = {
22 basedir : string;
23 mutable comments : S.t M.t;
24 mutable last_read : float M.t;
25 refresh_period : float;
26 }
27
28 let compare = function
29 `Date -> (fun x y -> compare x.c_date y.c_date)
30
31 let (/^) = Filename.concat
32
33 let read_comment file =
34 try
777fec4 @mfp Comments, Node: use Simple_markup.parse_lines instead of parse_text.
authored
35 let hs, body_ls = Node.split_headers_body (Std.input_file ~bin:true file) in
ee91bce @mfp Implemented comments.
authored
36 Some {
37 c_id = Filename.basename file;
38 c_author = List.assoc "author" hs;
39 c_date = Netdate.since_epoch (Netdate.parse (List.assoc "date" hs));
0ddea57 @mfp Comments: save URL if given to add_comment.
authored
40 c_url = (try Some (List.assoc "url" hs) with Not_found -> None);
777fec4 @mfp Comments, Node: use Simple_markup.parse_lines instead of parse_text.
authored
41 c_markup = Simple_markup.parse_lines body_ls;
ee91bce @mfp Implemented comments.
authored
42 }
43 with _ -> None
44
0ddea57 @mfp Comments: save URL if given to add_comment.
authored
45 let write_comment c body io =
46 IO.printf io "date: %s\nauthor: %s\n" (Netdate.mk_mail_date c.c_date) c.c_author;
47 begin match c.c_url with
48 None -> IO.printf io "\n"
49 | Some url -> IO.printf io "url: %s\n\n" url
50 end;
51 IO.nwrite io body
52
ee91bce @mfp Implemented comments.
authored
53 let refresh_comments t page =
54 print_endline ("refreshing comments for " ^ page);
55 let list_comments dir =
56 Catalog.dir_filter_map
57 (fun f ->
58 let fname = dir /^ f in
59 match (Unix.stat fname).Unix.st_kind with
60 Unix.S_REG -> Some fname
61 | _ -> None)
62 dir
63 in
64 try
65 let comment_files = list_comments (t.basedir /^ page) in
66 let comments = List.filter_map read_comment comment_files in
67 let s = List.fold_left (fun s c -> S.add c s) S.empty comments in
68 t.comments <- M.add page s t.comments;
69 t.last_read <- M.add page (Unix.gettimeofday ()) t.last_read
70 with _ -> ()
71
72
73 let make ?(refresh_period = 60.) dir =
74 {
75 basedir = dir; comments = M.empty;
76 last_read = M.empty; refresh_period = refresh_period;
77 }
78
79 let find_default default k m = try M.find k m with Not_found -> default
80
81 let get_comments t page =
82 try
83 let last_read = find_default 0. page t.last_read in
84 if Unix.gettimeofday () > last_read +. t.refresh_period then
85 refresh_comments t page;
86 Some (S.elements (M.find page t.comments))
87 with _ -> None
88
89 let is_directory path =
90 try match (Unix.stat path).Unix.st_kind with
91 Unix.S_DIR -> true
92 | _ -> false
93 with _ -> false
94
95 let rec mkdir_p ?(perms = 0o750) path =
96 if path.[0] <> '/' then
97 mkdir_p ~perms (String.concat "/" [Unix.getcwd(); path])
98 else try
99 (* common case first *)
100 Unix.mkdir path perms
101 with Unix.Unix_error _ ->
102 if not (is_directory path) then begin
103 let rec paths p l =
104 if p = "/" then l else paths (Filename.dirname p) (p :: l)
105 in
106 List.iter
107 (fun p ->
108 try
109 Unix.mkdir p perms
110 with Unix.Unix_error _ as e ->
111 if not (is_directory p) then raise e)
112 (paths path [])
113 end
114
987be4c @mfp Comments: don't overwrite old comments when ID clashes.
authored
115 let get_set_elm x s = S.choose (S.diff s (S.diff s (S.singleton x)))
116
0ddea57 @mfp Comments: save URL if given to add_comment.
authored
117 let add_comment t page ~author ?url ?(date = Unix.gettimeofday ()) ~body () =
fb20f08 @mfp Get rid of String.nsplit over tainted data.
authored
118 let author = match String.strip author with
119 "" -> "anonymous"
120 | s -> (try fst (String.split s "\n") with _ -> s) in
ee91bce @mfp Implemented comments.
authored
121 let basename =
0ddea57 @mfp Comments: save URL if given to add_comment.
authored
122 Digest.to_hex (Digest.string (String.concat "\n"
123 [author; Option.default "" url; body])) in
987be4c @mfp Comments: don't overwrite old comments when ID clashes.
authored
124 let page_comments = find_default S.empty page t.comments in
ee91bce @mfp Implemented comments.
authored
125 let c =
126 {
127 c_id = basename;
128 c_author = author;
129 c_date = date;
0ddea57 @mfp Comments: save URL if given to add_comment.
authored
130 c_url = url;
ee91bce @mfp Implemented comments.
authored
131 c_markup = Simple_markup.parse_text body;
987be4c @mfp Comments: don't overwrite old comments when ID clashes.
authored
132 }
ee91bce @mfp Implemented comments.
authored
133 in
987be4c @mfp Comments: don't overwrite old comments when ID clashes.
authored
134 if S.mem c page_comments then
135 get_set_elm c page_comments
136 else
137 let dir = t.basedir /^ page in
138 mkdir_p dir;
139 let fname = dir /^ basename in
140 let io = IO.output_channel (open_out_bin fname) in
141 let comments = M.add page (S.add c page_comments) t.comments in
0ddea57 @mfp Comments: save URL if given to add_comment.
authored
142 Std.finally (fun () -> IO.close_out io) (write_comment c body) io;
987be4c @mfp Comments: don't overwrite old comments when ID clashes.
authored
143 t.comments <- comments;
144 c
Something went wrong with that request. Please try again.