1:- module( spuds, [
    2					spuds/1,
    3					spuds_pid/1,
    4					spuds_stop/0,
    5					spuds_stop_pid/1,
    6					spuds_start/0,
    7					spuds_restart/0,
    8					spuds_version/2,
    9					spuds_profile_file/1
   10				] ).   11					
   12:- use_module( library(debug) ).

persistent, user code inclusive, doc server for linux

This library is largely obsolete, however examples/spudlike.pl is actively maintained.

This library creates, uses and manages a persistent documentation server on a single port. In addition to serving all Prolog library code as per doc_server/1, spuds/1 also serves installed packs and all user code declared as such, on the same server.

spuds is available as a SWI-Prolog pack, and can be installed the usual way.

        pack_install( spuds ).

Since 0:1:0 spuds supports http_daemon/0. It also provides a swipl-spuds bash shell file (pack(spuds/server/'swipl-spuds')), to be placed in the /etc/init.d/ directory. This is a direct copy from the SWI file. It follows well after standard scripts for servers starting/stopping. And can be used when you want all documents to be available as an independent server.

Pack files from swi(pack/.../prolog/...) are loaded via use_module(File,[]]).User documentation files are also loaded via use_module if their first term is a module declaration, otherwise their comments are loaded by xref_source(Abs,[comments(store),silent(Silent)]) use_module/2 has the side-effect of loading the code on to the server. If we were to load module files by xref/2, the downside would be that as far as we understand SWI will not serve the module page correctly (particularly missing the top comments that describe module files).

Currently to ask for help users need to call spuds(Topic) although ideally one can use help_hook/1 in which case normal route via help/1 should be possible.

When looking for help pages, the library tries to locate a running spuds server. If one is not found, it starts one. The behaviour of this server can be controlled via a set of predefined terms/clauses in a user profile file. spuds/1 also starts a new web browser window pointing to the spuds server on the requested topic.

The default profile location is $HOME/.pl/spuds_profile_<Hostname>.pl or $HOME/.pl/spuds_profile.pl . An alternative location can be provided via (user:)spuds_profile/1.

In you profile you can add:

Docs for each prolog_source_file are loaded to the spuds server by means of: use_module( File, [] ) if the File in question is a module file or xref_source(File,[comments(store),silent(true)]) otherwise.

Documentation for each prolog file within each prolog_source_directory is also loaded similarly. Note you need library(os_sub) for this to work. This is available as a pack install as per usual via

        pack_install( os_sub ).

Within each source directory (Dir above) files are considered to be Prolog source if there is no barring success of the call file_is_blocked_prolog_source/1 and either file has extension 'pl' or the call file_is_prolog_source/1 succeeds. These calls are performed with the absolute location of the file as argument.

The server only works under linux. Compatibility patches to other platforms are very welcome. For MacOs there should be a trivial change on the ps flags, if that, that should be sufficient. For other systems we need

To pick changes to the user code base up and even those on Swi (say after you installed a new version) the server needs to be restarted. This can be done via spuds_restart/0.

One scenario for starting the server as a debian server, including at start time, copy spuds/server/swipl-spuds into /etc/init.d/ then follow the instrunctions in the file. Usually you want to make a clean place where from the server runs. So for instance create /srv/www/html/spuds/ and copy into it spuds/server/spuds_daemon.pl (along with spuds_docs.pl from same place). On you window manager you can then have a launcher that points to:

        $PREFIX/swipl -f none -g "use_module(library(www_browser)), www_open_url('http://localhost:4004/index.html'), sleep(1), halt(0)"

spuds stands for, Spuds Persistent User-code-inclusive Documentation Server

author
- Nicos Angelopoulos
version
- 0:1:5
See also
- http://stoics.org.uk/~nicos/sware/spuds
- pack(spuds)
- pack(spuds/profiles)
license
- Perl Artistic
To be done
- support for other oses (MacOs should be a matter of using the correct ps flags).
- add seconds delay option

*/

  134spuds_srv_basename( spudsd ).
  135
  136:- use_module( library(http/http_client) ). 	% http_get/3.
 spuds_version(-Version, -Date)
Version and release Date (date(Y,M,D) term).
  141spuds_version( 1:2:0, date(2022,12,29) ).
 spuds_pid(-Pid)
Process id of any running spud server(s). Non-deterministic. There should ever only be one process maximum, if all is working properly.
  148spuds_pid( Pid ) :-
  149	spuds_pid( Pid, info ).
  150
  151spuds_pid( Pid, _ ) :-
  152	spuds_srv_basename( Bname ),
  153	atomic_list_concat( ['spuds/server/',Bname,'.pl'], Search ),
  154	ps_swipl_rows_with( Search, SdocRows ),
  155	member( Row, SdocRows ),
  156	arg( 2, Row, Pid ),
  157	!.
  158spuds_pid( Pid, Empty ) :-
  159	var( Pid ),
  160	spuds_pid_empty( Empty ).
  161
  162spuds_pid_empty( info ) :-
  163	print_message( informational, spuds(no_srv) ),
  164	fail.
  165% spuds_pid_empty( quiet ) :- fail
 spuds_stop
Kill the spuds server. True iff a single server can be found. If there are mulitple servers funning use spuds_stop_pid/1 to force a quit.
  173spuds_stop :-
  174	spuds_stop_empty( info ).
  175
  176spuds_stop_empty( OnEmpty ) :-
  177	findall( Pid, spuds_pid(Pid,quiet), Pids ),
  178	spuds_stop_singletton( Pids, OnEmpty ).
 spuds_stop_pid(Pid)
Kill the spuds server with process id, Pid. The predicate checks in the output of ps linux command to verify that the process id matches to a spuds server.
  186spuds_stop_pid( Pid ) :-
  187	spuds_srv_basename( Bname ),
  188	atomic_list_concat( ['spuds/server/',Bname,'.pl'], Search ),
  189	ps_swipl_rows_with( Search, SdocRows ),
  190	% row_is_unique( SdocRows, Pattern, Row ),
  191	member( Row, SdocRows ),
  192	arg( 2, Row, Pid ),
  193	kill( Pid, '-HUP' ),
  194	!.
  195spuds_stop_pid( Pid ) :-
  196	print_message( error, error(spuds(no_spuds_pid(Pid))) ).
 spuds_restart
Restart the spuds server. It does not complain if one cannot be found. No browser tabs/windows are open.
  203spuds_restart :-
  204	spuds_stop_empty( quiet ),
  205	spuds_start_server.
 spuds_start
Start the spuds server. It prints an error and aborts if one is already running.
  211spuds_start :-
  212	spuds_pid( Pid, quiet ),
  213	!,
  214	throw( error(spuds(srv_exists(Pid))) ).
  215spuds_start :-
  216	spuds_start_server,
  217	print_message( informational, spuds(spuds_splash) ).
 spuds(Topic)
Open a new web browser tab (www_open_url/1) on spuds server for query Topic. If there is no spuds server running, start one. This is run in the background and will persist beyond the limits of the current session. The spuds server can be managed with spuds_stop/0, spuds_pid/1 and spuds_restart/0 from any Prolog session.
  227spuds( Topic ) :-
  228	Host = localhost,
  229	spuds_def( port, Port ), 
  230	ensure_server_is_running( Host, Port ), 
  231	help_at( Host, Port, Topic ).
  232
  233/* ideally we want :
  234
  235:- multifile( prolog:help_hook/1 ).
  236
  237prolog:help_hook( Topic ) :-
  238	write( topic(Topic) ), nl,
  239	% http://localhost:46027/search?for=help&in=all&match=summary
  240	fail.
  241	
  242*/
  243
  244% auxiliary predicates.
  245
  246spuds_stop_singletton( [], OnEmpty ) :-
  247	spuds_stop_at_empty( OnEmpty ).
  248spuds_stop_singletton( [Pid], _ ) :-
  249	!,
  250	spuds_stop_pid( Pid ).
  251% spuds_stop_singletton( [] ) :-   % already get a message from spuds_id/1.
  252spuds_stop_singletton( [P,I|Ds], _ ) :-
  253	print_message( informational, spuds(too_many_srvs_to_stop([P,I|Ds])) ),
  254	fail.
  255
  256spuds_stop_at_empty( info ) :-
  257	print_message( informational, spuds(no_srv) ).
  258spuds_stop_at_empty( quiet ).
  259
  260help_at( Host, Port, Topic ) :-
  261	term_to_atom( Topic, Atopic) ,
  262	atomic_list_concat( ['http://',Host,':',Port,'/search?in=all&match=summary&for=',Atopic], Url ), 
  263	www_open_url( Url ),
  264	print_message( informational,spuds(www_browser(look_at(Url))) ).
  265
  266ensure_server_is_running( Host, Port ) :-
  267	atomic_list_concat( ['http://',Host,':',Port], Url ), 
  268	catch( http_get(Url,_Reply,[]), _, fail ),
  269	!.
  270ensure_server_is_running( _Host, Port ) :-
  271	spuds_start_server( Port ).
  272
  273spuds_start_server :-
  274	spuds_def( port, Port ),
  275	spuds_start_server( Port ).
  276
  277spuds_start_server( _Port ) :-
  278	spuds_profile_file( ProFile ),
  279	absolute_file_name( pack(spuds), SpudsD ),
  280	directory_file_path( SpudsD, server, SrvD ),
  281	spuds_srv_basename( Bname ),
  282	directory_file_path( SrvD, Bname, SwiDoc ),
  283	process_create( path(chmod), ['u+x',SwiDoc], [] ),
  284	spuds_log_file( Logfile ),
  285	atomic_list_concat( [SwiDoc,ProFile,Logfile,'&'], ' ', BgScript ),
  286	% atom_concat( SwiDoc, ' &', BgScript ),
  287	shell( BgScript ),
  288	sleep( 3 ).
  289
  290ps_swipl_rows_with( Pattern, Matched ) :-
  291	ps_rows( Rows ),
  292	findall( Row,  ( member(Row,Rows), 
  293	                   once( (   arg(_I,Row,ArgI),
  294				              sub_atom(ArgI,_Beg,_Len,_Aft,Pattern)
  295				          ) ),
  296						arg( 9, Row, '-q' ),
  297						arg( 10, Row, '-f' ),
  298						arg( 8,Row,swipl)
  299				),
  300				  	Matched ).
  301
  302ps_rows( Rows ) :-
  303	tmp_file_stream( text, File, Stream ),
  304     close( Stream ),
  305	process_create( path(ps), ['--columns','200','-Af'],  [stdout(pipe(Pipe))] ),
  306	open( File, write, Out ),
  307	copy_stream_data( Pipe, Out ),
  308	close( Out ),
  309	close( Pipe ),
  310	read_ps_lines( File, Rows ).
  311
  312read_ps_lines( File, CsvRows ) :-
  313	ReadOpts = [separator(0' ),strip(true),match_arity(false)],
  314	csv_read_file( File, [_Hdr|CsvRows], ReadOpts ).
  315
  316row_is_unique( [Row], _Pattern, Row ) :- !.
  317row_is_unique( Matched, Pattern, _Row ) :-
  318	length( Matched, Len ),
  319	print_message( error, spuds(multiple_lines_found_for(Pattern,Len)) ), 
  320	% foreach( member(R,Matched), (write(R),nl) ),
  321	abort.
  322
  323kill( Pid, Signal ) :-
  324	print_message( informational, spuds(killing(Pid,Signal)) ),
  325	process_create( path(kill), [Signal,Pid], [] ),
  326	sleep( 1 ).
 spuds_profile_file(-ProFile)
Locates user's Profile file.

*/

  333spuds_profile_file( ProFile ) :-
  334	current_predicate( user:spuds_profile/1 ),
  335	user:spuds_profile( ProFile ),
  336	!.
  337spuds_profile_file( ProFile ) :-
  338	File = '$HOME/.pl/spuds_profile.pl',
  339     expand_file_name( File, [Default] ),
  340	file_name_extension( Stem, pl, Default ),
  341	spuds_profile_stem( Stem, ProFile ).
  342
  343spuds_profile_stem( Stem, Profile ) :-
  344	gethostname( GotHost ),
  345	atomic_list_concat( [Host|_], '.', GotHost ),
  346	atomic_list_concat( [Stem,Host], '_', ProStem ),
  347	file_name_extension( ProStem, pl, Profile ),
  348	exists_file( Profile ),
  349	!.
  350spuds_profile_stem( Stem, Profile ) :-
  351	file_name_extension( Stem, pl, Profile ).
  352	% exists_file( Profile ). % fixme: add warning here if file does not exist
  353
  354spuds_def( Key, Value ) :-
  355	spuds_profile_file( ProFile ),
  356     exists_file( ProFile ),
  357	% fixme: make sure we don't get garbage
  358	ensure_loaded( ProFile ),
  359	doc_server_default( Key, Value ),
  360     !.
  361spuds_def( Key, Value ) :-
  362	sys_doc_server_default( Key, Value ).
  363	
  364sys_doc_server_default( port, 4001 ).
  365
  366% spuds_log_file( Log ).
  367%
  368%  Just a placeholder for now. 
  369%  As far as i know we store nothing important there.
  370%  In future we can inspect http:logfile to allow for user input that way.
  371%
  372spuds_log_file( '/tmp/spuds_log.txt' ).
  373
  374:- multifile prolog:message/3.  375
  376prolog:message( error(Message) ) -->
  377	{print_message(error,Message)},
  378	{abort}.
  379
  380prolog:message(spuds(Message)) -->
  381	message(Message).
  382
  383message( killing(Pid,Signal) ) -->
  384	['Sending to process: ~w, signal: ~w' - [Pid,Signal] ].
  385message( multiple_lines_found_for(Pattern,Len) ) -->
  386	['Multiple lines (n=~d) for pattern: ~w.' - [Len,Pattern] ].
  387message(www_browser(look_at(Port))) -->
  388	[ 'Started browser on page ~w'-[Port] ].
  389message( too_many_srvs_to_kill(These) ) -->
  390	[ 'Too many spuds servers around :~w...'-[These], nl,
  391	  'Refusing to kill.' ].
  392message( no_srv ) -->
  393	[ 'Cannot verify any running spuds servers via ps.' - [] ].
  394message( srv_exists(Pid) ) -->
  395	['Cannot start server, as one already exists (pid=~d).' - [Pid] ].
  396message( no_spuds_pid(Pid) ) -->
  397	[ 'Cannot verify spuds server with pid:~w...'-[Pid], nl,
  398	  'Refusing to kill.' ].
  399message( spuds_splash ) -->
  400	[ 'Use, spuds(Topic), to start help topics from any Prolog session.' ]