30
31:- module(server_stats,
32 [ http_session_table//0,
33 http_server_statistics//0,
34 http_server_pool_table//0
35 ]). 36:- use_module(library(option)). 37:- use_module(library(pairs)). 38:- use_module(library(http/http_session)). 39:- use_module(library(http/http_dispatch)). 40:- use_module(library(http/http_stream)). 41:- use_module(library(http/http_parameters)). 42:- use_module(library(http/thread_httpd)). 43:- use_module(library(http/html_write)). 44:- use_module(library(http/html_head)). 45:- use_module(library(http/http_json)). 46:- use_module(openid). 47:- use_module(messages). 48
49:- html_meta
50 odd_even_row(+, -, html, ?, ?).
56:- http_handler(root(stats), server_stats, []). 57:- http_handler(root(health), server_health, []). 58:- http_handler(root(stats/streams), list_file_streams, []). 59:- http_handler(root(stats/stream), stream_details, []). 60:- http_handler(root(admin/debug), start_debugger, []). 61
62server_stats(_Request) :-
63 reply_html_page(title('SWI-Prolog server statistics'),
64 [ \html_requires(css('stats.css')),
65 h1(class(wiki), 'SWI-Prolog HTTP server statistics'),
66 \http_server_statistics,
67 h2(class(wiki), 'Pool statistics'),
68 \http_server_pool_table
69 ]).
76http_session_table -->
77 { findall(S, session(S), Sessions0),
78 sort(Sessions0, Sessions),
79 Sessions \== [], !
80 },
81 html([ table([ class(block)
82 ],
83 [ tr([th('User'), th('Real Name'),
84 th('On since'), th('Idle'), th('From')])
85 | \sessions(Sessions, 1)
86 ])
87 ]).
88http_session_table -->
89 html(p('No users logged in')).
95session(s(Idle, User, SessionID, Peer)) :-
96 http_current_session(SessionID, peer(Peer)),
97 http_current_session(SessionID, idle(Idle)),
98 User = (-).
99
100sessions([], _) --> [].
101sessions([H|T], Row) -->
102 odd_even_row(Row, Next, \session(H)),
103 sessions(T, Next).
104
105session(s(Idle, -, _SessionID, Peer)) -->
106 html([td(-), td(-), td(-), td(\idle(Idle)), td(\ip(Peer))]).
107session(s(Idle, User, _SessionID, Peer)) -->
108 { RealName = '?',
109 OnSince = 0
110 },
111 html([td(User), td(RealName), td(\date(OnSince)), td(\idle(Idle)), td(\ip(Peer))]).
112
113idle(Time) -->
114 { Secs is round(Time),
115 Min is Secs // 60,
116 Sec is Secs mod 60
117 },
118 html('~`0t~d~2|:~`0t~d~5|'-[Min, Sec]).
119
120date(Date) -->
121 { format_time(string(S), '%+', Date)
122 },
123 html(S).
124
125ip(ip(A,B,C,D)) --> !,
126 html('~d.~d.~d.~d'-[A,B,C,D]).
127ip(IP) -->
128 html('~w'-[IP]).
135http_server_statistics -->
136 { findall(Port-ID, http_current_worker(Port, ID), Workers),
137 group_pairs_by_key(Workers, Servers)
138 },
139 html([ table([ class(block)
140 ],
141 [ \servers_stats(Servers)
142 ])
143 ]).
144
145servers_stats([]) --> [].
146servers_stats([H|T]) -->
147 server_stats(H), servers_stats(T).
148
149:- if(catch(statistics(process_cputime, _),_,fail)). 150cputime(CPU) :- statistics(process_cputime, CPU).
151:- else. 152cputime(CPU) :- statistics(cputime, CPU).
153:- endif. 154
155server_stats(Port-Workers) -->
156 { length(Workers, NWorkers),
157 http_server_property(Port, start_time(StartTime)),
158 format_time(string(ST), '%+', StartTime),
159 cputime(CPU)
160 },
161 html([ \server_stat('Port:', Port, odd),
162 \server_stat('Started:', ST, even),
163 \server_stat('Total CPU usage:', [\n('~2f',CPU), ' seconds'], odd),
164 \request_statistics,
165 \server_stat('# worker threads:', NWorkers, even),
166 tr(th(colspan(6), 'Statistics by worker')),
167 tr([ th('Thread'),
168 th('CPU'),
169 th('Local'),
170 th('Global'),
171 th('Trail'),
172 th('Limit')
173 ]),
174 \http_workers(Workers, odd)
175 ]).
176
177server_stat(Name, Value, OE) -->
178 html(tr(class(OE),
179 [ th([class(p_name), colspan(4)], Name),
180 td([class(value), colspan(4)], Value)
181 ])).
182
183
184request_statistics -->
185 { cgi_statistics(requests(Count)),
186 cgi_statistics(bytes_sent(Sent))
187 },
188 server_stat('Requests processed:', \n(human, Count), even),
189 server_stat('Bytes sent:', \n(human, Sent), odd).
190
191
192http_workers([], _) -->
193 [].
194http_workers([H|T], OE) -->
195 { odd_even(OE, OE2) },
196 http_worker(H, OE),
197 http_workers(T, OE2).
198
199http_worker(H, OE) -->
200 { current_prolog_flag(stack_limit, SL),
201 thread_statistics(H, localused, LU),
202 thread_statistics(H, globalused, GU),
203 thread_statistics(H, trailused, TU),
204 thread_statistics(H, cputime, CPU)
205 },
206 html([ tr(class(OE),
207 [ td(H),
208 \nc('~3f', CPU),
209 \nc(human, LU),
210 \nc(human, GU),
211 \nc(human, TU),
212 \nc(human, SL)
213 ])
214 ]).
215
216odd_even(even, odd).
217odd_even(odd, even).
218
219
220
228http_server_pool_table -->
229 { findall(Pool, current_thread_pool(Pool), Pools),
230 sort(Pools, Sorted)
231 },
232 html(table([ id('http-server-pool'),
233 class(block)
234 ],
235 [ tr([th('Name'), th('Running'), th('Size'), th('Waiting'), th('Backlog')])
236 | \server_pools(Sorted, 1)
237 ])).
238
239server_pools([], _) --> [].
240server_pools([H|T], Row) -->
241 odd_even_row(Row, Next, \server_pool(H)),
242 server_pools(T, Next).
243
244server_pool(Pool) -->
245 { findall(P, thread_pool_property(Pool, P), List),
246 memberchk(size(Size), List),
247 memberchk(running(Running), List),
248 memberchk(backlog(Waiting), List),
249 memberchk(options(Options), List),
250 option(backlog(MaxBackLog), Options, infinite)
251 },
252 html([ th(class(p_name), Pool),
253 \nc(human, Running),
254 \nc(human, Size),
255 \nc(human, Waiting),
256 \nc(human, MaxBackLog)
257 ]).
258
259
260
270n(Fmt, Value) -->
271 { number_html(Fmt, Value, HTML) },
272 html(HTML).
273
274number_html(human, Value, HTML) :-
275 integer(Value), !,
276 human_count(Value, HTML).
277number_html(Fmt, Value, HTML) :-
278 number(Value), !,
279 HTML = Fmt-[Value].
280number_html(_, Value, '~p'-[Value]).
281
282
283human_count(Number, HTML) :-
284 Number < 1024, !,
285 HTML = '~d'-[Number].
286human_count(Number, HTML) :-
287 Number < 1024*1024, !,
288 KB is Number/1024,
289 digits(KB, N),
290 HTML = '~*fK'-[N, KB].
291human_count(Number, HTML) :-
292 Number < 1024*1024*1024, !,
293 MB is Number/(1024*1024),
294 digits(MB, N),
295 HTML = '~*fM'-[N, MB].
296human_count(Number, HTML) :-
297 TB is Number/(1024*1024*1024),
298 digits(TB, N),
299 HTML = '~*fG'-[N, TB].
300
301digits(Count, N) :-
302 ( Count < 100
303 -> N = 1
304 ; N = 0
305 ).
321nc(Fmt, Value) -->
322 nc(Fmt, Value, []).
323
324nc(Fmt, Value, Options) -->
325 { class(Value, Class),
326 merge_options(Options,
327 [ align(right),
328 class(Class)
329 ], Opts),
330 number_html(Fmt, Value, HTML)
331 },
332 html(td(Opts, HTML)).
333
334class(Value, Class) :-
335 ( integer(Value)
336 -> Class = int
337 ; float(Value)
338 -> Class = float
339 ; Class = value
340 ).
346odd_even_row(Row, Next, Content) -->
347 { ( Row mod 2 =:= 0
348 -> Class = even
349 ; Class = odd
350 ),
351 Next is Row+1
352 },
353 html(tr(class(Class), Content)).
359list_file_streams(_Request) :-
360 findall(S, stream_property(S, type(_)), Streams),
361 reply_html_page(
362 title('Server open streams'),
363 [ \html_requires(css('stats.css')),
364 h1(class(wiki), 'Server open streams'),
365 table(class(block),
366 [ tr([ th('No'),
367 th('Stream'),
368 th('Handle'),
369 th('I/O'),
370 th('File name')
371 ])
372 | \list_streams(Streams, 1)
373 ])
374 ]).
375
376list_streams([], _) -->
377 [].
378list_streams([H|T], N) -->
379 html(tr([\nc('~d', N)|\stream(H)])),
380 { N2 is N + 1 },
381 list_streams(T, N2).
382
383stream(S) -->
384 { format(atom(Id), '~p', [S]),
385 http_link_to_id(stream_details, [stream(Id)], HREF)
386 },
387 html(td(a(href(HREF), Id))),
388 stream_prop(S, file_no),
389 stream_io(S),
390 stream_prop(S, file_name).
391
392stream_io(S) -->
393 ( { catch((stream_property(S, input),Val=input),
394 _, Val=closed)
395 }
396 -> html(td(Val))
397 ; html(td(output))
398 ).
399
400stream_prop(S, Prop) -->
401 ( { Term =.. [Prop,Val],
402 catch(stream_property(S, Term),_,fail)
403 }
404 -> html(td('~p'-[Val]))
405 ; html(td(-))
406 ).
414stream_details(Request) :-
415 site_user_logged_in(User),
416 site_user_property(User, granted(admin)), !,
417 http_parameters(Request,
418 [ stream(Name, [])
419 ]),
420 with_output_to(string(S), stream_info(Name)),
421 reply_html_page(
422 title('Details for stream'),
423 [ \html_requires(css('stats.css')),
424 pre(S)
425 ]).
426stream_details(Request) :-
427 option(path(Path), Request),
428 throw(http_reply(forbidden(Path))).
435server_health(_Request) :-
436 get_server_health(Health),
437 reply_json(Health).
438
439get_server_health(Health) :-
440 findall(Key-Value, health(Key, Value), Pairs),
441 dict_pairs(Health, health, Pairs).
442
443health(up, true).
444health(uptime, Time) :-
445 get_time(Now),
446 ( http_server_property(_, start_time(StartTime))
447 -> Time is round(Now - StartTime)
448 ).
449health(requests, RequestCount) :-
450 cgi_statistics(requests(RequestCount)).
451health(bytes_sent, BytesSent) :-
452 cgi_statistics(bytes_sent(BytesSent)).
453health(open_files, Streams) :-
454 aggregate_all(count, N, stream_property(_, file_no(N)), Streams).
455health(loadavg, LoadAVG) :-
456 catch(setup_call_cleanup(
457 open('/proc/loadavg', read, In),
458 read_string(In, _, String),
459 close(In)),
460 _, fail),
461 split_string(String, " ", " ", [One,Five,Fifteen|_]),
462 maplist(number_string, LoadAVG, [One,Five,Fifteen]).
463health(dir_scan_time, Time) :-
464 get_time(T0),
465 expand_file_name(*, _),
466 get_time(T),
467 Time is T - T0.
468:- if(current_predicate(malloc_property/1)). 469health(heap, json{inuse:InUse, size:Size}) :-
470 malloc_property('generic.current_allocated_bytes'(InUse)),
471 malloc_property('generic.heap_size'(Size)).
472:- endif. 473
474start_debugger(_Request) :-
475 site_user_logged_in(User),
476 site_user_property(User, granted(admin)), !,
477 call_showing_messages(
478 prolog_server(4242, []),
479 [ head(title('SWI-Prolog -- Starting debugger'))])
Server statistics components
*/