View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2010-2015, University of Amsterdam,
    7			      VU University Amsterdam.
    8
    9    This program is free software; you can redistribute it and/or
   10    modify it under the terms of the GNU General Public License
   11    as published by the Free Software Foundation; either version 2
   12    of the License, or (at your option) any later version.
   13
   14    This program is distributed in the hope that it will be useful,
   15    but WITHOUT ANY WARRANTY; without even the implied warranty of
   16    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   17    GNU General Public License for more details.
   18
   19    You should have received a copy of the GNU General Public
   20    License along with this library; if not, write to the Free Software
   21    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   22
   23    As a special exception, if you link this library with other files,
   24    compiled with a Free Software compiler, to produce an executable, this
   25    library does not by itself cause the resulting executable to be covered
   26    by the GNU General Public License. This exception does not however
   27    invalidate any other reasons why the executable file might be covered by
   28    the GNU General Public License.
   29*/
   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, ?, ?).

Server statistics components

*/

   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			]).
 http_session_table//
HTML component that writes a table of currently logged on users.
   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')).
 session(-Session:s(Idle,User,SessionID,Peer)) is nondet
Enumerate all current HTTP sessions.
   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]).
 http_server_statistics//
HTML component showing statistics on the HTTP server
  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		 /*******************************
  221		 *	      POOLS		*
  222		 *******************************/
 http_server_pool_table//
Display table with statistics on thread-pools.
  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		 /*******************************
  261		 *	       BASICS		*
  262		 *******************************/
 n(+Format, +Value)//
HTML component to emit a number.
See also
- nc//2 for details.
  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	).
 nc(+Format, +Value)// is det
 nc(+Format, +Value, +Options)// is det
Numeric cell. The value is formatted using Format and right-aligned in a table cell (td).
Arguments:
Format- is a (numeric) format as described by format/2 or the constant human. Human formatting applies to integers and prints then in abreviated (K,M,T) form, e.g., 4.5M for 4.5 million.
Options- is passed as attributed to the td element. Default alignment is right.
  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	).
 odd_even_row(+Row, -Next, :Content)//
Create odd/even alternating table rows from a DCG.
  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)).
 list_file_streams(+Request)
Print a table of open streams that have an associated file name.
  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	).
 stream_details(+Request)
Print details on stream. Requires user to be logged on with admin right because streams may reveal sensitive information.
  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))).
  429
  430:- if(exists_source(library(http/http_server_health))).  431:- use_module(library(http/http_server_health)).  432:- else.
 server_health(+Request)
HTTP handler that replies with the overall health of the server
  438server_health(_Request) :-
  439	get_server_health(Health),
  440	reply_json(Health).
  441
  442get_server_health(Health) :-
  443	findall(Key-Value, health(Key, Value), Pairs),
  444	dict_pairs(Health, health, Pairs).
  445
  446health(up, true).
  447health(uptime, Time) :-
  448	get_time(Now),
  449	(   http_server_property(_, start_time(StartTime))
  450	->  Time is round(Now - StartTime)
  451	).
  452health(requests, RequestCount) :-
  453	cgi_statistics(requests(RequestCount)).
  454health(bytes_sent, BytesSent) :-
  455	cgi_statistics(bytes_sent(BytesSent)).
  456health(open_files, Streams) :-
  457	aggregate_all(count, N, stream_property(_, file_no(N)), Streams).
  458health(loadavg, LoadAVG) :-
  459	catch(setup_call_cleanup(
  460		  open('/proc/loadavg', read, In),
  461		  read_string(In, _, String),
  462		  close(In)),
  463	      _, fail),
  464	split_string(String, " ", " ", [One,Five,Fifteen|_]),
  465	maplist(number_string, LoadAVG, [One,Five,Fifteen]).
  466health(dir_scan_time, Time) :-
  467	get_time(T0),
  468	expand_file_name(*, _),
  469	get_time(T),
  470	Time is T - T0.
  471:- if(current_predicate(malloc_property/1)).  472health(heap, json{inuse:InUse, size:Size}) :-
  473	malloc_property('generic.current_allocated_bytes'(InUse)),
  474	malloc_property('generic.heap_size'(Size)).
  475:- endif.  476:- endif. % exists_source(library(http/http_server_health))
  477
  478start_debugger(_Request) :-
  479	site_user_logged_in(User),
  480	site_user_property(User, granted(admin)), !,
  481	call_showing_messages(
  482	    prolog_server(4242, []),
  483	    [ head(title('SWI-Prolog -- Starting debugger'))])