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, []).

   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).

 wiki_path(+Request, +File, -WikiPath) is det

WikiPath is the canonical path to describe the wiki page File.

  302wiki_path(Request, File, WikiPath) :-
  303	memberchk(request_uri(Location), Request),
  304	atom_concat(/, WikiPath0, Location),
  305	normalize_extension(WikiPath0, File, WikiPath).
  306
  307normalize_extension(Path, File, Path) :-
  308	file_name_extension(_, Ext, File),
  309	file_name_extension(_, Ext, Path), !.
  310normalize_extension(Path0, File, Path) :-
  311	source_extension(Ext),
  312	file_name_extension(_, Ext, File),
  313	file_name_extension(Base, html, Path0), !,
  314	file_name_extension(Base, Ext, Path).
  315normalize_extension(Dir, _, Index) :-
  316	sub_atom(Dir, _, _, 0, /), !,
  317	atom_concat(Dir, 'index.txt', Index).
  318normalize_extension(Path, _, Path).

 prolog:doc_directory(+Dir) is semidet

Enable editing of wiki documents from the www directory.

  324:- multifile
  325	prolog:doc_directory/1.  326
  327prolog:doc_directory(Dir) :-
  328	absolute_file_name(document_root(.),
  329			   Root,
  330			   [ file_type(directory),
  331			     access(read)
  332			   ]),
  333	sub_atom(Dir, 0, _, _, Root).

 manual_file(+Request) is det

HTTP handler for /man/file.{html,gif}

  339manual_file(Request) :-
  340	memberchk(path_info(Relative), Request),
  341	atom_concat('doc/Manual', Relative, Man),
  342	(   file_name_extension(_, html, Man)
  343	->  absolute_file_name(swi(Man),
  344			       ManFile,
  345			       [ access(read),
  346				 file_errors(fail)
  347			       ]), !,
  348	    reply_html_page(title('SWI-Prolog manual'),
  349			    \man_page(section(_,_,_,ManFile), []))
  350	;   !,
  351	    http_reply_file(swi(Man), [], Request)
  352	).
  353manual_file(Request) :-
  354	memberchk(path(Path), Request),
  355	existence_error(http_location, Path).
  356
  357
  358		 /*******************************
  359		 *	  EMBEDDED HTML		*
  360		 *******************************/

 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

  368serve_embedded_html_file(File, Request) :-
  369	serve_embedded_html_file(wiki, File, Request).
  370
  371serve_embedded_hom_file(File, Request) :-
  372	serve_embedded_html_file(homepage, File, Request).
  373
  374serve_embedded_html_file(Style, File, _Request) :-
  375	load_html(File, DOM, []),
  376	xpath_chk(DOM, //body(self), element(_,_,Body)),
  377	xpath_chk(DOM, //head(self), element(_,_,Head)),
  378	reply_html_page(Style, Head, Body).
  379
  380
  381		 /*******************************
  382		 *     THREAD POOL HANDLING	*
  383		 *******************************/
  384
  385:- multifile
  386	http:create_pool/1.  387
  388http:create_pool(Name) :-
  389	thread_pool(Name, Size, Options),
  390	thread_pool_create(Name, Size, Options).
  391
  392thread_pool(wiki,     100, []).
  393thread_pool(download, 200, []).
  394thread_pool(cgi,       50, []).
  395thread_pool(complete,  20, [])