35
36:- module(server_statistics,
37 [ rdf_call_statistics_table//0,
38 http_session_table//0,
39 http_server_statistics//0,
40 http_server_pool_table//0
41 ]). 42:- use_module(library(option)). 43:- use_module(library(pairs)). 44:- use_module(library(semweb/rdf_db)). 45:- use_module(library(http/http_session)). 46:- use_module(library(http/thread_httpd)). 47:- use_module(library(http/html_write)). 48:- use_module(library(http/html_head)). 49:- use_module(user(user_db)). 50:- use_module(components(basics)).
61rdf_call_statistics_table -->
62 { rdf_call_stats(Lookup),
63 ( Lookup = [rdf(_,_,_)-_|_]
64 -> Cols = 3
65 ; Cols = 4
66 )
67 },
68 html(table([ class(block)
69 ],
70 [ tr([ th(colspan(Cols), 'Indexed (SOPG)'),
71 th('Calls')
72 ]),
73 \lookup_statistics(Lookup, 1)
74 ])).
75
76rdf_call_stats(Lookup) :-
77 findall(Index-Count,
78 rdf_statistics(lookup(Index, Count)),
79 Lookup).
80
81lookup_statistics([], _) -->
82 [].
83lookup_statistics([H|T], Row) -->
84 odd_even_row(Row, Next, \lookup_row(H)),
85 lookup_statistics(T, Next).
86
87lookup_row(rdf(S,P,O)-Count) -->
88 html([ \i(S), \i(P), \i(O), \nc(human, Count)]).
89lookup_row(rdf(S,P,O,G)-Count) -->
90 html([\i(S), \i(P), \i(O), \i(G), \nc(human, Count)]).
91
92
93i(I) -->
94 html(td(class(instantiated), I)).
101http_session_table -->
102 { findall(S, session(S), Sessions0),
103 sort(Sessions0, Sessions),
104 Sessions \== [], !
105 },
106 html([ table([ class(block)
107 ],
108 [ tr([th('User'), th('Real Name'),
109 th('On since'), th('Idle'), th('From')])
110 | \sessions(Sessions, 1)
111 ])
112 ]).
113http_session_table -->
114 html(p('No users logged in')).
120session(s(Idle, User, SessionID, Peer)) :-
121 http_current_session(SessionID, peer(Peer)),
122 http_current_session(SessionID, idle(Idle)),
123 ( user_property(User, session(SessionID))
124 -> true
125 ; User = (-)
126 ).
127
128sessions([], _) --> [].
129sessions([H|T], Row) -->
130 odd_even_row(Row, Next, \session(H)),
131 sessions(T, Next).
132
133session(s(Idle, -, _SessionID, Peer)) -->
134 html([td(-), td(-), td(-), td(\idle(Idle)), td(\ip(Peer))]).
135session(s(Idle, User, _SessionID, Peer)) -->
136 { ( user_property(User, realname(RealName))
137 -> true
138 ; RealName = '?'
139 ),
140 ( user_property(User, connection(OnSince, _Idle))
141 -> true
142 ; OnSince = 0
143 )
144 },
145 html([td(User), td(RealName), td(\date(OnSince)), td(\idle(Idle)), td(\ip(Peer))]).
146
147idle(Time) -->
148 { Secs is round(Time),
149 Min is Secs // 60,
150 Sec is Secs mod 60
151 },
152 html('~`0t~d~2|:~`0t~d~5|'-[Min, Sec]).
153
154date(Date) -->
155 { format_time(string(S), '%+', Date)
156 },
157 html(S).
158
159ip(ip(A,B,C,D)) -->
160 !,
161 html('~d.~d.~d.~d'-[A,B,C,D]).
162ip(IP) -->
163 html('~w'-[IP]).
170http_server_statistics -->
171 { findall(Port-ID, http_current_worker(Port, ID), Workers),
172 group_pairs_by_key(Workers, Servers)
173 },
174 html([ table([ class(block)
175 ],
176 [ \servers_stats(Servers)
177 ])
178 ]).
179
180servers_stats([]) --> [].
181servers_stats([H|T]) -->
182 server_stats(H), servers_stats(T).
183
184:- if(catch(statistics(process_cputime, _),_,fail)). 185cputime(CPU) :- statistics(process_cputime, CPU).
186:- else. 187cputime(CPU) :- statistics(cputime, CPU).
188:- endif. 189
190server_stats(Port-Workers) -->
191 { length(Workers, NWorkers),
192 http_server_property(Port, start_time(StartTime)),
193 format_time(string(ST), '%+', StartTime),
194 cputime(CPU)
195 },
196 html([ \server_stat('Port:', Port, odd),
197 \server_stat('Started:', ST, even),
198 \server_stat('Total CPU usage:', [\n('~2f',CPU), ' seconds'], odd),
199 \request_statistics,
200 \server_stat('# worker threads:', NWorkers, odd),
201 tr(th(colspan(6), 'Statistics by worker')),
202 tr([ th(rowspan(2), 'Thread'),
203 th(rowspan(2), 'CPU'),
204 th(colspan(3), 'Stack usage')
205 ]),
206 tr([ th('Local'),
207 th('Global'),
208 th('Trail')
209 ]),
210 \http_workers(Workers, odd)
211 ]).
212
213server_stat(Name, Value, OE) -->
214 html(tr(class(OE),
215 [ th([class(p_name), colspan(3)], Name),
216 td([class(value), colspan(3)], Value)
217 ])).
218
219
220:- if(source_exports(library(http/http_stream), cgi_statistics/1)). 221:- use_module(library(http/http_stream)). 222request_statistics -->
223 { cgi_statistics(requests(Count)),
224 cgi_statistics(bytes_sent(Sent))
225 },
226 server_stat('Requests processed:', \n(human, Count), odd),
227 server_stat('Bytes sent:', \n(human, Sent), even).
228:- else. 229request_statistics --> [].
230:- endif. 231
232
233http_workers([], _) -->
234 [].
235http_workers([H|T], OE) -->
236 { odd_even(OE, OE2) },
237 http_worker(H, OE),
238 http_workers(T, OE2).
239
240http_worker(H, OE) -->
241 { thread_statistics(H, localused, LU),
242 thread_statistics(H, globalused, GU),
243 thread_statistics(H, trailused, TU),
244 thread_statistics(H, cputime, CPU)
245 },
246 html([ tr(class(OE),
247 [ td(H),
248 \nc('~3f', CPU),
249 \nc(human, LU),
250 \nc(human, GU),
251 \nc(human, TU)
252 ])
253 ]).
254
255odd_even(even, odd).
256odd_even(odd, even).
257
258
259
267http_server_pool_table -->
268 { findall(Pool, current_thread_pool(Pool), Pools),
269 sort(Pools, Sorted)
270 },
271 html(table([ id('http-server-pool'),
272 class(block)
273 ],
274 [ tr([th('Name'), th('Running'), th('Size'), th('Waiting'), th('Backlog')])
275 | \server_pools(Sorted, 1)
276 ])).
277
278server_pools([], _) --> [].
279server_pools([H|T], Row) -->
280 odd_even_row(Row, Next, \server_pool(H)),
281 server_pools(T, Next).
282
283server_pool(Pool) -->
284 { findall(P, thread_pool_property(Pool, P), List),
285 memberchk(size(Size), List),
286 memberchk(running(Running), List),
287 memberchk(backlog(Waiting), List),
288 memberchk(options(Options), List),
289 option(backlog(MaxBackLog), Options, infinite)
290 },
291 html([ th(class(p_name), Pool),
292 \nc(human, Running),
293 \nc(human, Size),
294 \nc(human, Waiting),
295 \nc(human, MaxBackLog)
296 ])
Server statistics components
*/