forked from ermine/sulci
-
Notifications
You must be signed in to change notification settings - Fork 0
/
muc_log.ml
242 lines (224 loc) · 7.61 KB
/
muc_log.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
(*
* (c) 2004-2012 Anastasia Gornostaeva
*)
open Unix
open Pcre
open JID
open Hooks
open Muc
open Plugin_scheduler
open XMPPClient
module LogMap = Map.Make(GroupID)
type context = {
basedir : string;
mutable logmap : out_channel LogMap.t
}
let open_log ctx (room, server) =
let tm = localtime (gettimeofday ()) in
let year = tm.tm_year + 1900 in
let month = tm.tm_mon + 1 in
let day = tm.tm_mday in
let p1 = Filename.concat ctx.basedir (room ^ "@" ^ server) in
let () = if not (Sys.file_exists p1) then mkdir p1 0o755 in
let p2 = Printf.sprintf "%s/%i" p1 year in
let () = if not (Sys.file_exists p2) then mkdir p2 0o755 in
let p3 = Printf.sprintf "%s/%0.2i" p2 month in
let () = if not (Sys.file_exists p3) then mkdir p3 0o755 in
let file = Printf.sprintf "%s/%0.2i.html" p3 day in
if not (Sys.file_exists file) then
let out_log = open_out_gen [Open_creat; Open_append] 0o644 file in
output_string out_log
(Printf.sprintf
"<html><head>
<meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\" />
<meta name='all' content='nofollow' />
<title>%s@%s - %0.2d/%0.2d/%d</title></head>\n
<body><h1>%s@%s - %0.2d/%0.2d/%d</h1>\n"
room server day month year room server day month year);
flush out_log;
out_log
else
open_out_gen [Open_append] 0o644 file
let close_log ctx room =
let lf = LogMap.find room ctx.logmap in
output_string lf "</body>\n</html>";
flush lf;
close_out lf;
ctx.logmap <- LogMap.remove room ctx.logmap
let rotate_logs ctx () =
log#info "MUC Log: Rotating chatlogs";
ctx.logmap <-
LogMap.mapi (fun room lf ->
let old = lf in
let newlog = open_log ctx room in
output_string old "</body>\n</html>";
flush old;
close_out old;
newlog) ctx.logmap
let add_chatlog ctx jid =
let room = jid.lnode, jid.ldomain in
let out_log = open_log ctx room in
ctx.logmap <- LogMap.add room out_log ctx.logmap;
out_log
(*
let rex = regexp ~flags:[`CASELESS;]
"((https?|ftp)://.*(?![?!,.]*(\\s|$))[^\\s])|((www|ftp)[a-z0-9.-]*\\.[a-z]{2,}.*(?![?!,.]*(\\s|$))[^\\s])"
let html_url text =
try
substitute ~rex
~subst:(fun url ->
if pmatch ~pat:".+//:" url then
Printf.sprintf "<a href='%s'>%s</a>" url url
else if pmatch ~pat:"^www" url then
Printf.sprintf "<a href='http://%s'>%s</a>" url url
else if pmatch ~pat:"^ftp" url then
Printf.sprintf "<a href='ftp://%s'>%s</a>" url url
else
Printf.sprintf "<a href='%s'>%s</a>" url url
)
text
with Not_found -> text
*)
open Find_url
let html_url text =
find_url make_hyperlink text
let make_message author body =
let text =
Pcre.substitute_substrings ~pat:"\n( *)"
~subst:(fun s ->
try
let sub = Pcre.get_substring s 1 in
let len = String.length sub in
let buf = Buffer.create (len * 6) in
for i = 1 to len do
Buffer.add_string buf " "
done;
"<br>\n" ^ Buffer.contents buf
with _ -> "<br>"
) body
in
Printf.sprintf "<%s> %s" author (html_url text)
let write ctx jid_room text =
let out_log =
try
LogMap.find (jid_room.lnode, jid_room.ldomain) ctx.logmap
with Not_found ->
add_chatlog ctx jid_room
in
let curtime =
Strftime.strftime ~tm:(localtime (gettimeofday ())) "%H:%M" in
output_string out_log
(Printf.sprintf
"[%s] %s<br>\n"
curtime text);
flush out_log
let muc_log_message ctx from env stanza =
match stanza.content.subject with
| None -> (
match stanza.content.body with
| None -> ()
| Some body ->
if from.lresource <> "" then
if body <> "" then
write ctx from (
if body = "/me" then
Printf.sprintf "* %s" from.resource
else if String.length body > 3 &&
String.sub body 0 4 = "/me " then
Printf.sprintf "* %s %s" from.resource
(html_url (Common.string_after body 4))
else
make_message from.resource body)
else
()
)
| Some subject ->
if from.lresource <> "" then
write ctx from
(Lang.get_msg env.env_lang "muc_log_set_subject"
[from.resource; html_url subject])
else
write ctx from
(Lang.get_msg env.env_lang "muc_log_subject" [html_url subject])
let muc_log_event ctx muc_context xmpp env jid_from = function
| MUC_join ->
write ctx jid_from
("-- " ^ (Lang.get_msg env.env_lang "muc_log_join"
[jid_from.resource]))
| MUC_leave reason ->
write ctx jid_from
("-- " ^
match reason with
| None ->
Lang.get_msg env.env_lang "muc_log_leave"
[jid_from.resource]
| Some v ->
Lang.get_msg env.env_lang "muc_log_leave_reason"
[jid_from.resource; html_url v]
)
| MUC_kick reason ->
write ctx jid_from
("-- " ^
match reason with
| None ->
Lang.get_msg env.env_lang "muc_log_kick"
[jid_from.resource]
| Some v ->
Lang.get_msg env.env_lang "muc_log_kick_reason"
[jid_from.resource; html_url v]
)
| MUC_ban reason ->
write ctx jid_from
("-- " ^
match reason with
| None ->
Lang.get_msg env.env_lang "muc_log_ban"
[jid_from.resource]
| Some v ->
Lang.get_msg env.env_lang "muc_log_ban_reason"
[jid_from.resource; html_url v]
)
| MUC_members_only reason ->
write ctx jid_from
("-- " ^
match reason with
| None ->
Lang.get_msg env.env_lang "muc_log_unmember"
[jid_from.resource]
| Some v ->
Lang.get_msg env.env_lang "muc_log_unmember_reason"
[jid_from.resource; html_url v]
)
| MUC_nick (newnick, reason) ->
write ctx jid_from
("-- " ^
(Lang.get_msg env.env_lang
"muc_log_change_nick" [jid_from.resource; newnick]))
| _ ->
()
let process_message ctx muc_context xmpp env stanza hooks =
match stanza.jid_from with
| None -> do_hook xmpp env stanza hooks
| Some from ->
if is_joined muc_context from &&
stanza.content.message_type = Some Groupchat then
muc_log_message ctx from env stanza;
do_hook xmpp env stanza hooks
let plugin opts =
let basedir = get_value opts "dir" "chatlogs" "chatlogs" in
if not (Sys.file_exists basedir) then
raise (Plugin.Error (Printf.sprintf "%s does not exist" basedir));
Muc.add_for_muc_context
(fun muc_context xmpp ->
let ctx = {
basedir = basedir;
logmap = LogMap.empty
} in
let _ = Scheduler.add_task timerQ (rotate_logs ctx)
(get_next_time 0 0 ()) (get_next_time 0 0); in
Muc.add_muc_event_handler muc_context (muc_log_event ctx);
Hooks.add_message_hook xmpp 11 "muc_log"
(process_message ctx muc_context)
)
let () =
Plugin.add_plugin "muc_log" plugin