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, VU University Amsterdam
    7
    8    This program is free software; you can redistribute it and/or
    9    modify it under the terms of the GNU General Public License
   10    as published by the Free Software Foundation; either version 2
   11    of the License, or (at your option) any later version.
   12
   13    This program is distributed in the hope that it will be useful,
   14    but WITHOUT ANY WARRANTY; without even the implied warranty of
   15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   16    GNU General Public License for more details.
   17
   18    You should have received a copy of the GNU General Public
   19    License along with this library; if not, write to the Free Software
   20    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   21
   22    As a special exception, if you link this library with other files,
   23    compiled with a Free Software compiler, to produce an executable, this
   24    library does not by itself cause the resulting executable to be covered
   25    by the GNU General Public License. This exception does not however
   26    invalidate any other reasons why the executable file might be covered by
   27    the GNU General Public License.
   28*/
   29
   30:- module(plweb,
   31	  [ server/0,
   32	    server/1
   33	  ]).   34
   35:- use_module(library(pldoc)).   36:- use_module(library(doc_http)).   37:- use_module(library(pldoc/doc_wiki)).   38:- use_module(library(pldoc/doc_man)).   39:- use_module(library(http/thread_httpd)).   40:- use_module(library(http/http_dispatch)).   41:- use_module(library(http/http_path)).   42:- use_module(library(http/html_write)).   43:- use_module(library(http/html_head)).   44:- use_module(library(http/mimetype)).   45:- use_module(library(http/http_error)).   46:- use_module(library(http/http_parameters)).   47:- use_module(library(settings)).   48:- use_module(library(error)).   49:- use_module(library(debug)).   50:- use_module(library(apply)).   51:- use_module(library(readutil)).   52:- use_module(library(lists)).   53:- use_module(library(occurs)).   54:- use_module(library(pairs)).   55:- use_module(library(option)).   56:- use_module(library(xpath)).   57:- use_module(library(sgml)).   58:- use_module(library(thread_pool)).   59:- use_module(library(http/http_dirindex)).   60:- use_module(library(debug)).   61:- use_module(library(http/http_files)).   62
   63:- use_module(parms).   64:- use_module(page).   65:- use_module(download).   66:- use_module(wiki).   67:- use_module(http_cgi).   68:- use_module(gitweb).   69:- use_module(update).   70:- use_module(autocomplete).   71:- use_module(customise).   72:- use_module(tests).   73:- use_module(pack_info).   74
   75:- http_handler(root(.), serve_page(document_root),
   76		[prefix, priority(10), spawn(wiki)]).   77:- http_handler(root('favicon.ico'), favicon,
   78		[priority(10)]).   79:- http_handler(root('apple-touch-icon.png'), touch_icon, []).   80:- http_handler(root(man), manual_file,
   81		[prefix, priority(10), spawn(wiki)]).   82:- http_handler(root('.well-known/'),
   83		http_reply_from_files('.well-known', []), [prefix]).   84
   85:- create_prolog_flag(wiki_edit, true, []).

Server for PlDoc wiki pages and SWI-Prolog website

To be done
- Turn directory listing into a library. */
   92		 /*******************************
   93		 *            SERVER		*
   94		 *******************************/
   95
   96server :-
   97	server([]).
   98
   99server(Options) :-
  100	with_mutex(plweb_init, server_init),
  101	doc_enable(true),
  102	setting(http:port, Port),
  103	setting(http:workers, Workers),
  104	merge_options(Options,
  105		      [ port(Port),
  106			workers(Workers)
  107		      ], HTTPOptions),
  108	http_server(http_dispatch, HTTPOptions),
  109	debug(plweb, 'Server was started at port ~d.', [Port]).
  110
  111:- if(\+current_predicate(doc_enable/1)).  112doc_enable(_).
  113:- endif.  114
  115:- dynamic
  116	server_init_done/0.  117
  118server_init :-
  119	server_init_done, !.
  120server_init :-
  121	asserta(server_init_done),
  122	load_settings('plweb.conf'),
  123	catch(make_directory_path(log), E,
  124	      print_message(warning, E)),
  125	update_pack_metadata_in_background,
  126	thread_create(index_wiki_pages, _,
  127		      [ alias('__index_wiki_pages'),
  128			detached(true)
  129		      ]),
  130	db_sync_thread.
  131
  132
  133:- multifile
  134	http_unix_daemon:http_server_hook/1.  135
  136http_unix_daemon:http_server_hook(Options) :-
  137	server(Options).
 favicon(+Request)
Serve /favicon.ico.
  143favicon(Request) :-
  144	http_reply_file(icons('favicon.ico'), [], Request).
 touch_icon(+Request)
Serve /apple-touch-icon.png.
  150touch_icon(Request) :-
  151	http_reply_file(icons('apple-touch-icon.png'), [], Request).
  152
  153
  154		 /*******************************
  155		 *	      SERVICES		*
  156		 *******************************/
 serve_page(+Alias, +Request)
HTTP handler for files below document-root.
  162serve_page(Alias, Request) :-
  163	memberchk(path_info(Relative), Request),
  164	Spec =.. [ Alias, Relative ],
  165	http_safe_file(Spec, []),
  166	find_file(Relative, File), !,
  167	serve_file(File, Request).
  168serve_page(Alias, Request) :-
  169	\+ memberchk(path_info(_), Request), !,
  170	serve_page(Alias, [path_info('index.html'),style(wiki(home))|Request]).
  171serve_page(_, Request) :-
  172	memberchk(path(Path), Request),
  173	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
  185find_file(Relative, File) :-
  186	file_name_extension(Base, html, Relative),
  187	source_extension(Ext),
  188	file_name_extension(Base, Ext, SrcFile),
  189	absolute_file_name(document_root(SrcFile),
  190			   File,
  191			   [ access(read),
  192			     file_errors(fail)
  193			   ]), !.
  194find_file(Relative, File) :-
  195	absolute_file_name(document_root(Relative),
  196			   File,
  197			   [ access(read),
  198			     file_errors(fail)
  199			   ]).
  200find_file(Relative, File) :-
  201	absolute_file_name(document_root(Relative),
  202			   File,
  203			   [ access(read),
  204			     file_errors(fail),
  205			     file_type(directory)
  206			   ]).
  207
  208source_extension(hom).				% homepage embedded html
  209source_extension(txt).				% Markdown
  210source_extension(md).				% Markdown
  211source_extension(frg).				% embedded html
 serve_file(+File, +Request) is det
 serve_file(+Extension, +File, +Request) is det
Serve the requested file.
  219serve_file(File, Request) :-
  220	file_name_extension(_, Ext, File),
  221	debug(plweb, 'Serving ~q; ext=~q', [File, Ext]),
  222	serve_file(Ext, File, Request).
  223
  224serve_file('',  Dir, Request) :-
  225	exists_directory(Dir), !,
  226	(   sub_atom(Dir, _, _, 0, /),
  227	    serve_index_file(Dir, Request)
  228	->  true
  229	;   http_reply_dirindex(Dir, [unsafe(true)], Request)
  230	).
  231serve_file(txt, File, Request) :-
  232	serve_file(md, File, Request).
  233serve_file(md, File, Request) :-
  234	http_parameters(Request,
  235			[ format(Format, [ oneof([raw,html]),
  236					   default(html)
  237					 ])
  238			]),
  239	Format == html, !,
  240	serve_wiki_file(File, Request).
  241serve_file(hom, File, Request) :-
  242	serve_embedded_hom_file(File, Request).
  243serve_file(frg, File, Request) :-
  244	serve_embedded_html_file(File, Request).
  245serve_file(_Ext, File, Request) :-	% serve plain files
  246	http_reply_file(File, [unsafe(true)], Request).
 serve_index_file(+Dir, +Request) is semidet
Serve index.txt or index.html, etc. if it exists.
  252serve_index_file(Dir, Request) :-
  253        setting(http:index_files, Indices),
  254        member(Index, Indices),
  255	ensure_slash(Dir, DirSlash),
  256	atom_concat(DirSlash, Index, File),
  257        access_file(File, read), !,
  258        serve_file(File, Request).
  259
  260ensure_slash(Dir, Dir) :-
  261	sub_atom(Dir, _, _, 0, /), !.
  262ensure_slash(Dir0, Dir) :-
  263	atom_concat(Dir0, /, Dir).
 serve_wiki_file(+File, +Request) is det
Serve a file containing wiki text.
  269serve_wiki_file(File, Request) :-
  270	read_file_to_codes(File, String, []),
  271	setup_call_cleanup(
  272	    b_setval(pldoc_file, File),
  273	    serve_wiki(String, File, Request),
  274	    nb_delete(pldoc_file)).
 serve_wiki(+String, +File, +Request) is det
Emit page from wiki content in String.
  281serve_wiki(String, File, Request) :-
  282	wiki_codes_to_dom(String, [], DOM0),
  283	extract_title(DOM0, Title, DOM),
  284	setup_call_cleanup(
  285	    b_setval(pldoc_options, [prefer(manual)]),
  286	    serve_wiki_page(Request, File, Title, DOM),
  287	    nb_delete(pldoc_options)).
  288
  289serve_wiki_page(Request, File, Title, DOM) :-
  290	wiki_path(Request, File, WikiPath),
  291	title_text(Title, TitleString),
  292	reply_html_page(
  293	    wiki(WikiPath, Title),
  294	    [ title(TitleString)
  295	    ],
  296	    DOM).
 title_text(+Title, -Text:atom) is det
Turn the title, represented as an argument to html//1 into a plain string. Turns it into HTML, then parses the HTML and finally extracts the string. First clause avoids this for the common normal case.
  305title_text(Title, Text) :-
  306	maplist(atomic, Title), !,
  307	atomics_to_string(Title, Text).
  308title_text(Title, Text) :-
  309	phrase(html(Title), Tokens),
  310	with_output_to(string(HTML), print_html(Tokens)),
  311	setup_call_cleanup(
  312	    open_string(HTML, In),
  313	    load_html(In, DOM, []),
  314	    close(In)),
  315	xpath(element(div, [], DOM), /('*'(text)), Text).
 wiki_path(+Request, +File, -WikiPath) is det
WikiPath is the canonical path to describe the wiki page File.
  321wiki_path(Request, File, WikiPath) :-
  322	memberchk(request_uri(Location), Request),
  323	atom_concat(/, WikiPath0, Location),
  324	normalize_extension(WikiPath0, File, WikiPath).
  325
  326normalize_extension(Path, File, Path) :-
  327	file_name_extension(_, Ext, File),
  328	file_name_extension(_, Ext, Path), !.
  329normalize_extension(Path0, File, Path) :-
  330	source_extension(Ext),
  331	file_name_extension(_, Ext, File),
  332	file_name_extension(Base, html, Path0), !,
  333	file_name_extension(Base, Ext, Path).
  334normalize_extension(Dir, _, Index) :-
  335	sub_atom(Dir, _, _, 0, /), !,
  336	atom_concat(Dir, 'index.txt', Index).
  337normalize_extension(Path, _, Path).
 extract_title(+DOM0, -Title, -DOM) is det
Extract the title from a wiki page. The title is considered to be the first h<N> element.
  345extract_title([H|T], Title, T) :-
  346	title(H, Title), !.
  347extract_title(DOM, 'SWI-Prolog', DOM).
  348
  349title(h1(_Attrs, Title), Title).
  350title(h2(_Attrs, Title), Title).
  351title(h3(_Attrs, Title), Title).
  352title(h4(_Attrs, Title), Title).
 prolog:doc_directory(+Dir) is semidet
Enable editing of wiki documents from the www directory.
  358:- multifile
  359	prolog:doc_directory/1.  360
  361prolog:doc_directory(Dir) :-
  362	absolute_file_name(document_root(.),
  363			   Root,
  364			   [ file_type(directory),
  365			     access(read)
  366			   ]),
  367	sub_atom(Dir, 0, _, _, Root).
 manual_file(+Request) is det
HTTP handler for /man/file.{html,gif}
  373manual_file(Request) :-
  374	memberchk(path_info(Relative), Request),
  375	atom_concat('doc/Manual', Relative, Man),
  376	(   file_name_extension(_, html, Man)
  377	->  absolute_file_name(swi(Man),
  378			       ManFile,
  379			       [ access(read),
  380				 file_errors(fail)
  381			       ]), !,
  382	    reply_html_page(title('SWI-Prolog manual'),
  383			    \man_page(section(_,_,_,ManFile), []))
  384	;   !,
  385	    http_reply_file(swi(Man), [], Request)
  386	).
  387manual_file(Request) :-
  388	memberchk(path(Path), Request),
  389	existence_error(http_location, Path).
  390
  391
  392		 /*******************************
  393		 *	  EMBEDDED HTML		*
  394		 *******************************/
 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
  402serve_embedded_html_file(File, Request) :-
  403	serve_embedded_html_file(wiki, File, Request).
  404
  405serve_embedded_hom_file(File, Request) :-
  406	serve_embedded_html_file(homepage, File, Request).
  407
  408serve_embedded_html_file(Style, File, _Request) :-
  409	load_html(File, DOM, []),
  410	xpath_chk(DOM, //body(self), element(_,_,Body)),
  411	xpath_chk(DOM, //head(self), element(_,_,Head)),
  412	reply_html_page(Style, Head, Body).
  413
  414
  415		 /*******************************
  416		 *     THREAD POOL HANDLING	*
  417		 *******************************/
  418
  419:- multifile
  420	http:create_pool/1.  421
  422http:create_pool(Name) :-
  423	thread_pool(Name, Size, Options),
  424	thread_pool_create(Name, Size, Options).
  425
  426thread_pool(wiki,     100, []).
  427thread_pool(download, 200, []).
  428thread_pool(cgi,       50, []).
  429thread_pool(complete,  20, [])