View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@cs.vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2009-2024, VU University Amsterdam
    7			      SWI-Prolog Solutions b.v.
    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(plweb,
   32	  [ server/0,
   33	    server/1
   34	  ]).   35
   36:- use_module(library(pldoc)).   37:- use_module(library(doc_http)).   38:- use_module(library(pldoc/doc_wiki)).   39:- use_module(library(pldoc/doc_man)).   40:- use_module(library(http/thread_httpd)).   41:- use_module(library(http/http_dispatch)).   42:- use_module(library(http/http_path)).   43:- use_module(library(http/html_write)).   44:- use_module(library(http/html_head)).   45:- use_module(library(http/mimetype)).   46:- use_module(library(http/http_error)).   47:- use_module(library(http/http_parameters)).   48:- use_module(library(settings)).   49:- use_module(library(error)).   50:- use_module(library(debug)).   51:- use_module(library(apply)).   52:- use_module(library(readutil)).   53:- use_module(library(lists)).   54:- use_module(library(occurs)).   55:- use_module(library(pairs)).   56:- use_module(library(option)).   57:- use_module(library(xpath)).   58:- use_module(library(sgml)).   59:- use_module(library(thread_pool)).   60:- use_module(library(http/http_dirindex)).   61:- use_module(library(debug)).   62:- use_module(library(http/http_files)).   63:- use_module(library(http/http_dyn_workers)).   64
   65:- use_module(parms).   66:- use_module(page).   67:- use_module(download).   68:- use_module(wiki).   69:- use_module(http_cgi).   70:- use_module(gitweb).   71:- use_module(update).   72:- use_module(autocomplete).   73:- use_module(customise).   74:- use_module(tests).   75:- use_module(pack_info).   76
   77:- http_handler(root(.), serve_page(document_root),
   78		[prefix, priority(10), spawn(wiki)]).   79:- http_handler(root('favicon.ico'), favicon,
   80		[priority(10)]).   81:- http_handler(root('apple-touch-icon.png'), touch_icon, []).   82:- http_handler(root(man), manual_file,
   83		[prefix, priority(10), spawn(wiki)]).   84:- http_handler(root('.well-known/'),
   85		http_reply_from_files('.well-known', []), [prefix]).   86
   87:- create_prolog_flag(wiki_edit, true, []).

Server for PlDoc wiki pages and SWI-Prolog website

To be done
- Turn directory listing into a library. */
   94		 /*******************************
   95		 *            SERVER		*
   96		 *******************************/
   97
   98server :-
   99	server([]).
  100
  101server(Options) :-
  102	with_mutex(plweb_init, server_init),
  103	doc_enable(true),
  104	setting(http:port, Port),
  105	setting(http:workers, Workers),
  106	merge_options(Options,
  107		      [ port(Port),
  108			workers(Workers)
  109		      ], HTTPOptions),
  110	http_server(http_dispatch, HTTPOptions),
  111	debug(plweb, 'Server was started at port ~d.', [Port]).
  112
  113:- if(\+current_predicate(doc_enable/1)).  114doc_enable(_).
  115:- endif.  116
  117:- dynamic
  118	server_init_done/0.  119
  120server_init :-
  121	server_init_done, !.
  122server_init :-
  123	asserta(server_init_done),
  124	load_settings(private('plweb.conf')),
  125	make_log_dir(Dir),
  126	print_message(informational, plweb(log_dir(Dir))),
  127	update_pack_metadata_in_background,
  128	thread_create(index_wiki_pages, _,
  129		      [ alias('__index_wiki_pages'),
  130			detached(true)
  131		      ]),
  132	db_sync_thread.
 make_log_dir(-Dir) is det
Ensure the log directory exists
  138make_log_dir(Dir) :-
  139	absolute_file_name(data(log), Dir,
  140			   [ file_type(directory),
  141			     access(write),
  142			     file_errors(fail)
  143			   ]),
  144	!.
  145make_log_dir(Path) :-
  146	absolute_file_name(data(log), Path,
  147			   [ solutions(all),
  148			     file_errors(fail)
  149			   ]),
  150	catch(make_directory(Path), _, fail),
  151	!.
  152
  153:- multifile
  154	http_unix_daemon:http_server_hook/1.  155
  156http_unix_daemon:http_server_hook(Options) :-
  157	server(Options).
 favicon(+Request)
Serve /favicon.ico.
  163favicon(Request) :-
  164	http_reply_file(icons('favicon.ico'), [], Request).
 touch_icon(+Request)
Serve /apple-touch-icon.png.
  170touch_icon(Request) :-
  171	http_reply_file(icons('apple-touch-icon.png'), [], Request).
  172
  173
  174		 /*******************************
  175		 *	      SERVICES		*
  176		 *******************************/
 serve_page(+Alias, +Request)
HTTP handler for files below document-root.
  182serve_page(Alias, Request) :-
  183	memberchk(path_info(Relative), Request),
  184	Spec =.. [ Alias, Relative ],
  185	http_safe_file(Spec, []),
  186	find_file(Relative, File), !,
  187	serve_file(File, Request).
  188serve_page(Alias, Request) :-
  189	\+ memberchk(path_info(_), Request), !,
  190	serve_page(Alias, [path_info('index.html'),style(wiki(home))|Request]).
  191serve_page(_, Request) :-
  192	memberchk(path(Path), Request),
  193	existence_error(http_location, Path).
 find_file(+Relative, -File) is det
Translate Relative into a File in the document-root tree. If the given extension is .html, also look for .txt files that can be translated into HTML. .frg files embed the contents of the body in the normal 1 col layout format. .hom files embed the contents of the body in the home page format. Usually the home page fill will have nothing in it
  205find_file(Relative, File) :-
  206	file_name_extension(Base, html, Relative),
  207	source_extension(Ext),
  208	file_name_extension(Base, Ext, SrcFile),
  209	absolute_file_name(document_root(SrcFile),
  210			   File,
  211			   [ access(read),
  212			     file_errors(fail)
  213			   ]), !.
  214find_file(Relative, File) :-
  215	absolute_file_name(document_root(Relative),
  216			   File,
  217			   [ access(read),
  218			     file_errors(fail)
  219			   ]).
  220find_file(Relative, File) :-
  221	absolute_file_name(document_root(Relative),
  222			   File,
  223			   [ access(read),
  224			     file_errors(fail),
  225			     file_type(directory)
  226			   ]).
  227
  228source_extension(hom).				% homepage embedded html
  229source_extension(txt).				% Markdown
  230source_extension(md).				% Markdown
  231source_extension(frg).				% embedded html
 serve_file(+File, +Request) is det
 serve_file(+Extension, +File, +Request) is det
Serve the requested file.
  239serve_file(File, Request) :-
  240	file_name_extension(_, Ext, File),
  241	debug(plweb, 'Serving ~q; ext=~q', [File, Ext]),
  242	serve_file(Ext, File, Request).
  243
  244serve_file('',  Dir, Request) :-
  245	exists_directory(Dir), !,
  246	(   sub_atom(Dir, _, _, 0, /),
  247	    serve_index_file(Dir, Request)
  248	->  true
  249	;   http_reply_dirindex(Dir, [unsafe(true)], Request)
  250	).
  251serve_file(txt, File, Request) :-
  252	serve_file(md, File, Request).
  253serve_file(md, File, Request) :-
  254	http_parameters(Request,
  255			[ format(Format, [ oneof([raw,html]),
  256					   default(html)
  257					 ])
  258			]),
  259	Format == html, !,
  260	serve_wiki_file(File, Request).
  261serve_file(hom, File, Request) :-
  262	serve_embedded_hom_file(File, Request).
  263serve_file(frg, File, Request) :-
  264	serve_embedded_html_file(File, Request).
  265serve_file(_Ext, File, Request) :-	% serve plain files
  266	http_reply_file(File, [unsafe(true)], Request).
 serve_index_file(+Dir, +Request) is semidet
Serve index.txt or index.html, etc. if it exists.
  272serve_index_file(Dir, Request) :-
  273        setting(http:index_files, Indices),
  274        member(Index, Indices),
  275	ensure_slash(Dir, DirSlash),
  276	atom_concat(DirSlash, Index, File),
  277        access_file(File, read), !,
  278        serve_file(File, Request).
  279
  280ensure_slash(Dir, Dir) :-
  281	sub_atom(Dir, _, _, 0, /), !.
  282ensure_slash(Dir0, Dir) :-
  283	atom_concat(Dir0, /, Dir).
 serve_wiki_file(+File, +Request) is det
Serve a file containing wiki text.
  289serve_wiki_file(File, Request) :-
  290	read_file_to_codes(File, String, []),
  291	setup_call_cleanup(
  292	    b_setval(pldoc_file, File),
  293	    serve_wiki(String, File, Request),
  294	    nb_delete(pldoc_file)).
 serve_wiki(+String, +File, +Request) is det
Emit page from wiki content in String.
  301serve_wiki(String, File, Request) :-
  302	wiki_codes_to_dom(String, [], DOM0),
  303	extract_title(DOM0, Title, DOM),
  304	setup_call_cleanup(
  305	    b_setval(pldoc_options, [prefer(manual)]),
  306	    serve_wiki_page(Request, File, Title, DOM),
  307	    nb_delete(pldoc_options)).
  308
  309serve_wiki_page(Request, File, Title, DOM) :-
  310	wiki_path(Request, File, WikiPath),
  311	title_text(Title, TitleString),
  312	reply_html_page(
  313	    wiki(WikiPath, Title),
  314	    [ title(TitleString)
  315	    ],
  316	    DOM).
 wiki_path(+Request, +File, -WikiPath) is det
WikiPath is the canonical path to describe the wiki page File.
  322wiki_path(Request, File, WikiPath) :-
  323	memberchk(request_uri(Location), Request),
  324	atom_concat(/, WikiPath0, Location),
  325	normalize_extension(WikiPath0, File, WikiPath).
  326
  327normalize_extension(Path, File, Path) :-
  328	file_name_extension(_, Ext, File),
  329	file_name_extension(_, Ext, Path), !.
  330normalize_extension(Path0, File, Path) :-
  331	source_extension(Ext),
  332	file_name_extension(_, Ext, File),
  333	file_name_extension(Base, html, Path0), !,
  334	file_name_extension(Base, Ext, Path).
  335normalize_extension(Dir, _, Index) :-
  336	sub_atom(Dir, _, _, 0, /), !,
  337	atom_concat(Dir, 'index.txt', Index).
  338normalize_extension(Path, _, Path).
 prolog:doc_directory(+Dir) is semidet
Enable editing of wiki documents from the www directory.
  344:- multifile
  345	prolog:doc_directory/1.  346
  347prolog:doc_directory(Dir) :-
  348	absolute_file_name(document_root(.),
  349			   Root,
  350			   [ file_type(directory),
  351			     access(read)
  352			   ]),
  353	sub_atom(Dir, 0, _, _, Root).
 manual_file(+Request) is det
HTTP handler for /man/file.{html,gif}
  359manual_file(Request) :-
  360	memberchk(path_info(Relative), Request),
  361	atom_concat('doc/Manual', Relative, Man),
  362	(   file_name_extension(_, html, Man)
  363	->  absolute_file_name(swi(Man),
  364			       ManFile,
  365			       [ access(read),
  366				 file_errors(fail)
  367			       ]), !,
  368	    reply_html_page(title('SWI-Prolog manual'),
  369			    \man_page(section(_,_,_,ManFile), []))
  370	;   !,
  371	    http_reply_file(swi(Man), [], Request)
  372	).
  373manual_file(Request) :-
  374	memberchk(path(Path), Request),
  375	existence_error(http_location, Path).
  376
  377
  378		 /*******************************
  379		 *	  EMBEDDED HTML		*
  380		 *******************************/
 serve_embedded_html_file(+File, +Request) is det
Serve a .frg file, which is displayed as an embedded HTML file in the 1 col content format, or a .hom file, which is displayed as an embedded HTML file in the home page format
  388serve_embedded_html_file(File, Request) :-
  389	serve_embedded_html_file(wiki, File, Request).
  390
  391serve_embedded_hom_file(File, Request) :-
  392	serve_embedded_html_file(homepage, File, Request).
  393
  394serve_embedded_html_file(Style, File, _Request) :-
  395	load_html(File, DOM, []),
  396	xpath_chk(DOM, //body(self), element(_,_,Body)),
  397	xpath_chk(DOM, //head(self), element(_,_,Head)),
  398	reply_html_page(Style, Head, Body).
  399
  400
  401		 /*******************************
  402		 *     THREAD POOL HANDLING	*
  403		 *******************************/
  404
  405:- multifile
  406	http:create_pool/1.  407
  408http:create_pool(Name) :-
  409	thread_pool(Name, Size, Options),
  410	thread_pool_create(Name, Size, Options).
  411
  412thread_pool(wiki,     100, []).
  413thread_pool(download, 200, []).
  414thread_pool(cgi,       50, []).
  415thread_pool(complete,  20, [])