swi-prolog-nox 7.2.3-2 / usr / lib / swi-prolog / library / doc_http.pl

/*  Part of SWI-Prolog

    Author:        Jan Wielemaker
    E-mail:        J.Wielemaker@vu.nl
    WWW:           http://www.swi-prolog.org
    Copyright (C): 2006-2015, University of Amsterdam
			      VU University Amsterdam

    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public
    License along with this library; if not, write to the Free Software
    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

    As a special exception, if you link this library with other files,
    compiled with a Free Software compiler, to produce an executable, this
    library does not by itself cause the resulting executable to be covered
    by the GNU General Public License. This exception does not however
    invalidate any other reasons why the executable file might be covered by
    the GNU General Public License.
*/

:- module(pldoc_http,
	  [ doc_server/1,		% ?Port
	    doc_server/2,		% ?Port, +Options
	    doc_browser/0,
	    doc_browser/1		% +What
	  ]).
:- use_module(library(pldoc)).
:- use_module(library(http/thread_httpd)).
:- use_module(library(http/http_parameters)).
:- use_module(library(http/html_write)).
:- use_module(library(http/mimetype)).
:- use_module(library(dcg/basics)).
:- use_module(library(http/http_dispatch)).
:- use_module(library(http/http_hook)).
:- use_module(library(http/http_path)).
:- use_module(library(http/http_wrapper)).
:- use_module(library(uri)).
:- use_module(library(debug)).
:- use_module(library(lists)).
:- use_module(library(url)).
:- use_module(library(socket)).
:- use_module(library(option)).
:- use_module(library(error)).
:- use_module(library(www_browser)).
:- use_module(pldoc(doc_process)).
:- use_module(pldoc(doc_htmlsrc)).
:- use_module(pldoc(doc_html)).
:- use_module(pldoc(doc_index)).
:- use_module(pldoc(doc_search)).
:- use_module(pldoc(doc_man)).
:- use_module(pldoc(doc_wiki)).
:- use_module(pldoc(doc_util)).
:- use_module(pldoc(doc_access)).
:- use_module(pldoc(doc_pack)).

/** <module> Documentation server

The module library(pldoc/http) provides an   embedded HTTP documentation
server that allows for browsing the   documentation  of all files loaded
_after_ library(pldoc) has been loaded.
*/

:- dynamic
	doc_server_port/1.

http:location(pldoc, root(.), []).
http:location(pldoc_man, pldoc(refman), []).
http:location(pldoc_pkg, pldoc(package), []).
http:location(pldoc_resource, Path, []) :-
	http_location_by_id(pldoc_resource, Path).


%%	doc_server(?Port) is det.
%%	doc_server(?Port, +Options) is det.
%
%	Start a documentation server in the  current Prolog process. The
%	server is started in a seperate   thread.  Options are handed to
%	http_server/2.  In  addition,   the    following   options   are
%	recognised:
%
%		* allow(HostOrIP)
%		Allow connections from HostOrIP.  If HostOrIP is an atom
%		it is matched to the hostname.  It if starts with a .,
%		suffix match is done, matching the domain.  Finally it
%		can be a term ip(A,B,C,D). See tcp_host_to_address/2 for
%		details.
%
%		* deny(HostOrIP)
%		See allow(HostOrIP).
%
%		* edit(Bool)
%		Allow editing from localhost connections? Default:
%		=true=.
%
%	The predicate doc_server/1 is defined as below, which provides a
%	good default for development.
%
%	==
%	doc_server(Port) :-
%		doc_server(Port,
%			   [ workers(1),
%			     allow(localhost)
%			   ]).
%	==
%
%	@see	doc_browser/1

doc_server(Port) :-
	doc_server(Port,
		   [ allow(localhost),
		     allow(ip(127,0,0,1)) % Windows ip-->host often fails
		   ]).

doc_server(Port, _) :-
	catch(doc_current_server(Port), _, fail), !.
doc_server(Port, Options) :-
	prepare_editor,
	host_access_options(Options, ServerOptions),
	merge_options(ServerOptions,
		      [ port(Port)
		      ], HTTPOptions),
	http_server(http_dispatch, HTTPOptions),
	assertz(doc_server_port(Port)),
	print_message(informational, pldoc(server_started(Port))).

%%	doc_current_server(-Port) is det.
%
%	TCP/IP port of the documentation server.   Fails if no server is
%	running. Note that in the current   infrastructure we can easily
%	be embedded into another  Prolog  HTTP   server.  If  we are not
%	started from doc_server/2, we  return  the   port  of  a running
%	HTTP server.
%
%	@tbd	Trap destruction of the server.
%	@error	existence_error(http_server, pldoc)

doc_current_server(Port) :-
	(   doc_server_port(P)
	->  Port = P
	;   http_current_server(_:_, P)
	->  Port = P
	;   existence_error(http_server, pldoc)
	).

%%	doc_browser is det.
%%	doc_browser(+What) is semidet.
%
%	Open user's default browser on the documentation server.

doc_browser :-
	doc_browser([]).
doc_browser(Spec) :-
	catch(doc_current_server(Port),
	      error(existence_error(http_server, pldoc), _),
	      doc_server(Port)),
	browser_url(Spec, Request),
	format(string(URL), 'http://localhost:~w~w', [Port, Request]),
	www_open_url(URL).

browser_url([], Root) :- !,
	http_location_by_id(pldoc_root, Root).
browser_url(Name, URL) :-
	atom(Name), !,
	browser_url(Name/_, URL).
browser_url(Name//Arity, URL) :-
	must_be(atom, Name),
	integer(Arity), !,
	PredArity is Arity+2,
	browser_url(Name/PredArity, URL).
browser_url(Name/Arity, URL) :- !,
	must_be(atom, Name),
	(   predicate(Name, Arity, _, _, _)
	->  format(string(S), '~q/~w', [Name, Arity]),
	    http_link_to_id(pldoc_man, [predicate=S], URL)
	;   browser_url(_:Name/Arity, URL)
	).
browser_url(Spec, URL) :- !,
	Spec = M:Name/Arity,
	doc_comment(Spec, _Pos, _Summary, _Comment), !,
	(   var(M)
	->  format(string(S), '~q/~w', [Name, Arity])
	;   format(string(S), '~q:~q/~w', [M, Name, Arity])
	),
	http_link_to_id(doc_object, [object=S], URL).

%%	prepare_editor
%
%	Start XPCE as edit requests comming from the document server can
%	only be handled if XPCE is running.

prepare_editor :-
	current_prolog_flag(editor, pce_emacs), !,
	start_emacs.
prepare_editor.


		 /*******************************
		 *	    USER REPLIES	*
		 *******************************/

:- http_handler(pldoc(.),	   pldoc_root,
		[prefix, authentication(pldoc(read))]).
:- http_handler(pldoc('index.html'), pldoc_index,   []).
:- http_handler(pldoc(file),	   pldoc_file,	   []).
:- http_handler(pldoc(place),	   go_place,	   []).
:- http_handler(pldoc(edit),	   pldoc_edit,
		[authentication(pldoc(edit))]).
:- http_handler(pldoc(doc),	   pldoc_doc,	   [prefix]).
:- http_handler(pldoc(man),	   pldoc_man,	   []).
:- http_handler(pldoc(doc_for),	   pldoc_object,   [id(pldoc_doc_for)]).
:- http_handler(pldoc(search),	   pldoc_search,   []).
:- http_handler(pldoc('res/'),	   pldoc_resource, [prefix]).


%%	pldoc_root(+Request)
%
%	Reply using the index-page  of   the  Prolog  working directory.
%	There are various options for the   start directory. For example
%	we could also use the file or   directory of the file that would
%	be edited using edit/0.

pldoc_root(Request) :-
	http_parameters(Request,
			[ empty(Empty, [ oneof([true,false]),
					 default(false)
				       ])
			]),
	pldoc_root(Request, Empty).

pldoc_root(Request, false) :-
	http_location_by_id(pldoc_root, Root),
	memberchk(path(Path), Request),
	Root \== Path, !,
	existence_error(http_location, Path).
pldoc_root(_Request, false) :-
	working_directory(Dir0, Dir0),
	allowed_directory(Dir0), !,
	ensure_slash_end(Dir0, Dir1),
	doc_file_href(Dir1, Ref0),
	atom_concat(Ref0, 'index.html', Index),
	throw(http_reply(see_other(Index))).
pldoc_root(Request, _) :-
	pldoc_index(Request).


%%	pldoc_index(+Request)
%
%	HTTP handle for /index.html, providing an overall overview
%	of the available documentation.

pldoc_index(_Request) :-
	reply_html_page(pldoc(index),
			title('SWI-Prolog documentation'),
			[ \doc_links('', []),
			   h1('SWI-Prolog documentation'),
			  \man_overview([])
			]).


%%	pldoc_file(+Request)
%
%	Hander for /file?file=File, providing documentation for File.

pldoc_file(Request) :-
	http_parameters(Request,
			[ file(File, [])
			]),
	(   source_file(File)
	->  true
	;   throw(http_reply(forbidden(File)))
	),
	doc_for_file(File, []).

%%	pldoc_edit(+Request)
%
%	HTTP handler that starts the user's   default editor on the host
%	running the server. This  handler  can   only  accessed  if  the
%	browser connection originates from  =localhost=.   The  call can
%	edit files using the =file=  attribute   or  a predicate if both
%	=name= and =arity= is given and optionally =module=.

pldoc_edit(Request) :-
	http:authenticate(pldoc(edit), Request, _),
	http_parameters(Request,
			[ file(File,
			       [ optional(true),
				 description('Name of the file to edit')
			       ]),
			  line(Line,
			       [ optional(true),
				 integer,
				 description('Line in the file')
			       ]),
			  name(Name,
			       [ optional(true),
				 description('Name of a Prolog predicate to edit')
			       ]),
			  arity(Arity,
				[ integer,
				  optional(true),
				  description('Arity of a Prolog predicate to edit')
				]),
			  module(Module,
				 [ optional(true),
				   description('Name of a Prolog module to search for predicate')
				 ])
			]),
	(   atom(File)
	->  allowed_file(File)
	;   true
	),
	(   atom(File), integer(Line)
	->  Edit = file(File, line(Line))
	;   atom(File)
	->  Edit = file(File)
	;   atom(Name), integer(Arity)
	->  (   atom(Module)
	    ->	Edit = (Module:Name/Arity)
	    ;	Edit = (Name/Arity)
	    )
	),
	edit(Edit),
	format('Content-type: text/plain~n~n'),
	format('Started ~q~n', [edit(Edit)]).
pldoc_edit(_Request) :-
	http_location_by_id(pldoc_edit, Location),
	throw(http_reply(forbidden(Location))).


%%	go_place(+Request)
%
%	HTTP handler to handle the places menu.

go_place(Request) :-
	http_parameters(Request,
			[ place(Place, [])
			]),
	places(Place).

places(':packs:') :- !,
	http_link_to_id(pldoc_pack, [], HREF),
	throw(http_reply(moved(HREF))).
places(Dir0) :-
	expand_alias(Dir0, Dir),
	(   allowed_directory(Dir)
	->  format(string(IndexFile), '~w/index.html', [Dir]),
	    doc_file_href(IndexFile, HREF),
	    throw(http_reply(moved(HREF)))
	;   throw(http_reply(forbidden(Dir)))
	).


%%	allowed_directory(+Dir) is semidet.
%
%	True if we are allowed to produce and index for Dir.

allowed_directory(Dir) :-
	source_directory(Dir), !.
allowed_directory(Dir) :-
	working_directory(CWD, CWD),
	same_file(CWD, Dir).
allowed_directory(Dir) :-
	prolog:doc_directory(Dir).


%%	allowed_file(+File) is semidet.
%
%	True if we are allowed to serve   File.  Currently means we have
%	predicates loaded from File or the directory must be allowed.

allowed_file(File) :-
	source_file(_, File), !.
allowed_file(File) :-
	absolute_file_name(File, Canonical),
	file_directory_name(Canonical, Dir),
	allowed_directory(Dir).


%%	pldoc_resource(+Request)
%
%	Handler for /res/File, serving CSS, JS and image files.

pldoc_resource(Request) :-
	http_location_by_id(pldoc_resource, ResRoot),
	memberchk(path(Path), Request),
	atom_concat(ResRoot, File, Path),
	file(File, Local),
	http_reply_file(pldoc(Local), [], Request).

file('pldoc.css',     'pldoc.css').
file('pllisting.css', 'pllisting.css').
file('pldoc.js',      'pldoc.js').
file('edit.png',      'edit.png').
file('editpred.png',  'editpred.png').
file('up.gif',        'up.gif').
file('source.png',    'source.png').
file('public.png',    'public.png').
file('private.png',   'private.png').
file('reload.png',    'reload.png').
file('favicon.ico',   'favicon.ico').
file('h1-bg.png',     'h1-bg.png').
file('h2-bg.png',     'h2-bg.png').
file('pub-bg.png',    'pub-bg.png').
file('priv-bg.png',   'priv-bg.png').
file('multi-bg.png',  'multi-bg.png').


%%	pldoc_doc(+Request)
%
%	Handler for /doc/Path
%
%	Reply documentation of a file. Path is  the absolute path of the
%	file for which to return the  documentation. Extension is either
%	none, the Prolog extension or the HTML extension.
%
%	Note that we reply  with  pldoc.css   if  the  file  basename is
%	pldoc.css to allow for a relative link from any directory.

pldoc_doc(Request) :-
	memberchk(path(ReqPath), Request),
	http_location_by_id(pldoc_doc, Me),
	atom_concat(Me, AbsFile0, ReqPath),
	(   sub_atom(ReqPath, _, _, 0, /)
	->  atom_concat(ReqPath, 'index.html', File),
	    throw(http_reply(moved(File)))
	;   clean_path(AbsFile0, AbsFile1),
	    expand_alias(AbsFile1, AbsFile),
	    is_absolute_file_name(AbsFile)
	->  documentation(AbsFile, Request)
	).

documentation(Path, Request) :-
	file_base_name(Path, Base),
	file(_, Base), !,			% serve pldoc.css, etc.
	http_reply_file(pldoc(Base), [], Request).
documentation(Path, Request) :-
	file_name_extension(_, Ext, Path),
	autolink_extension(Ext, image),
	http_reply_file(Path, [unsafe(true)], Request).
documentation(Path, Request) :-
	Index = '/index.html',
	sub_atom(Path, _, _, 0, Index),
	atom_concat(Dir, Index, Path),
	exists_directory(Dir), !,		% Directory index
	(   allowed_directory(Dir)
	->  edit_options(Request, EditOptions),
	    doc_for_dir(Dir, EditOptions)
	;   throw(http_reply(forbidden(Dir)))
	).
documentation(File, Request) :-
	wiki_file(File, WikiFile), !,
	(   allowed_file(WikiFile)
	->  true
	;   throw(http_reply(forbidden(File)))
	),
	edit_options(Request, Options),
	doc_for_wiki_file(WikiFile, Options).
documentation(Path, Request) :-
	pl_file(Path, File), !,
	(   allowed_file(File)
	->  true
	;   throw(http_reply(forbidden(File)))
	),
	doc_reply_file(File, Request).
documentation(Path, _) :-
	throw(http_reply(not_found(Path))).

:- public
	doc_reply_file/2.

doc_reply_file(File, Request) :-
	http_parameters(Request,
			[ public_only(Public),
			  reload(Reload),
			  show(Show),
			  format_comments(FormatComments)
			],
			[ attribute_declarations(param)
			]),
        (   exists_file(File)
        ->  true
        ;   throw(http_reply(not_found(File)))
        ),
	(   Reload == true,
	    source_file(File)
	->  load_files(File, [if(changed), imports([])])
	;   true
	),
	edit_options(Request, EditOptions),
	(   Show == src
	->  format('Content-type: text/html~n~n', []),
	    source_to_html(File, stream(current_output),
			   [ skin(src_skin(Request, Show, FormatComments)),
			     format_comments(FormatComments)
			   ])
	;   Show == raw
	->  http_reply_file(File,
			    [ unsafe(true), % is already validated
			      mime_type(text/plain)
			    ], Request)
	;   doc_for_file(File,
			 [ public_only(Public),
			   source_link(true)
			 | EditOptions
			 ])
	).


:- public src_skin/5.			% called through source_to_html/3.

src_skin(Request, _Show, FormatComments, header, Out) :-
	memberchk(request_uri(ReqURI), Request),
	negate(FormatComments, AltFormatComments),
	replace_parameters(ReqURI, [show(raw)], RawLink),
	replace_parameters(ReqURI, [format_comments(AltFormatComments)], CmtLink),
	phrase(html(div(class(src_formats),
			[ 'View source with ',
			  a(href(CmtLink), \alt_view(AltFormatComments)),
			  ' or as ',
			  a(href(RawLink), raw)
			])), Tokens),
	print_html(Out, Tokens).

alt_view(true) -->
	html('formatted comments').
alt_view(false) -->
	html('raw comments').

negate(true, false).
negate(false, true).

replace_parameters(ReqURI, Extra, URI) :-
	uri_components(ReqURI, C0),
	uri_data(search, C0, Search0),
	(   var(Search0)
	->  uri_query_components(Search, Extra)
	;   uri_query_components(Search0, Form0),
	    merge_options(Extra, Form0, Form),
	    uri_query_components(Search, Form)
	),
	uri_data(search, C0, Search, C),
	uri_components(URI, C).


%%	edit_options(+Request, -Options) is det.
%
%	Return edit(true) in Options  if  the   connection  is  from the
%	localhost.

edit_options(Request, [edit(true)]) :-
	catch(http:authenticate(pldoc(edit), Request, _), _, fail), !.
edit_options(_, []).


%%	pl_file(+File, -PlFile) is semidet.

pl_file(File, PlFile) :-
	file_name_extension(Base, html, File), !,
	absolute_file_name(Base,
			   PlFile,
			   [ file_errors(fail),
			     file_type(prolog),
			     access(read)
			   ]).
pl_file(File, File).

%%	wiki_file(+File, -TxtFile) is semidet.
%
%	True if TxtFile is an existing file  that must be served as wiki
%	file.

wiki_file(File, TxtFile) :-
	file_name_extension(_, Ext, File),
	wiki_file_extension(Ext), !,
	TxtFile = File.
wiki_file(File, TxtFile) :-
	file_base_name(File, Base),
	autolink_file(Base, wiki), !,
	TxtFile = File.
wiki_file(File, TxtFile) :-
	file_name_extension(Base, html, File),
	wiki_file_extension(Ext),
	file_name_extension(Base, Ext, TxtFile),
	access_file(TxtFile, read).

wiki_file_extension(md).
wiki_file_extension(txt).


%%	clean_path(+AfterDoc, -AbsPath)
%
%	Restore the path, Notably deals Windows issues

clean_path(Path0, Path) :-
	current_prolog_flag(windows, true),
	sub_atom(Path0, 2, _, _, :), !,
	sub_atom(Path0, 1, _, 0, Path).
clean_path(Path, Path).


%%	pldoc_man(+Request)
%
%	Handler for /man, offering one of the parameters:
%
%	    * predicate=PI
%	    providing documentation from the manual on the predicate PI.
%	    * function=PI
%	    providing documentation from the manual on the function PI.
%	    * 'CAPI'=F
%	    providing documentation from the manual on the C-function F.

pldoc_man(Request) :-
	http_parameters(Request,
			[ predicate(PI, [optional(true)]),
			  function(Fun, [optional(true)]),
			  'CAPI'(F,     [optional(true)]),
			  section(Sec,  [optional(true)])
			]),
	(   ground(PI)
	->  split_pi(PI, Obj)
	;   ground(Fun)
	->  atomic_list_concat([Name,ArityAtom], /, Fun),
	    atom_number(ArityAtom, Arity),
	    Obj = f(Name/Arity)
	;   ground(F)
	->  Obj = c(F)
	;   ground(Sec)
	->  atom_concat('sec:', Sec, SecID),
	    Obj = section(SecID)
	),
	man_title(Obj, Title),
	reply_html_page(
	    pldoc(object(Obj)),
	    title(Title),
	    \man_page(Obj, [])).

man_title(f(Obj), Title) :- !,
	format(atom(Title), 'SWI-Prolog -- function ~w', [Obj]).
man_title(c(Obj), Title) :- !,
	format(atom(Title), 'SWI-Prolog -- API-function ~w', [Obj]).
man_title(section(_Id), Title) :- !,
	format(atom(Title), 'SWI-Prolog -- Manual', []).
man_title(Obj, Title) :-
	format(atom(Title), 'SWI-Prolog -- ~w', [Obj]).

split_pi(Atom, Module:PI) :-
	atomic_list_concat([Module, PIAtom], :, Atom), !,
	split_pi2(PIAtom, PI).
split_pi(Atom, PI) :-
	split_pi2(Atom, PI).

split_pi2(Atom, Name//Arity) :-
	sub_atom(Atom, B, _, A, //),
	sub_atom(Atom, _, A, 0, ArityA),
	atom_number(ArityA, Arity), !,
	sub_atom(Atom, 0, B, _, Name).
split_pi2(Atom, Name/Arity) :-
	sub_atom(Atom, B, _, A, /),
	sub_atom(Atom, _, A, 0, ArityA),
	atom_number(ArityA, Arity), !,
	sub_atom(Atom, 0, B, _, Name).
split_pi2(Name, Name/_).


%%	pldoc_object(+Request)
%
%	Handler for /doc_for?object=Term, Provide  documentation for the
%	given term.

pldoc_object(Request) :-
	http_parameters(Request,
			[ object(Atom, []),
			  header(Header, [default(true)])
			]),
	atom_to_term(Atom, Obj, _),
	(   prolog:doc_object_title(Obj, Title)
	->  true
	;   Title = Atom
	),
	edit_options(Request, EditOptions),
	reply_html_page(
	    pldoc(object(Obj)),
	    title(Title),
	    \object_page(Obj, [header(Header)|EditOptions])).


%%	pldoc_search(+Request)
%
%	Search the collected PlDoc comments and Prolog manual.

pldoc_search(Request) :-
	http_parameters(Request,
			[ for(For,
			      [ optional(true),
				description('String to search for')
			      ]),
			  in(In,
			     [ oneof([all,app,man]),
			       default(all),
			       description('Search everying, application only or manual only')
			     ]),
			  match(Match,
				[ oneof([name,summary]),
				  default(summary),
				  description('Match only the name or also the summary')
				]),
			  resultFormat(Format,
				       [ oneof(long,summary),
					 default(summary),
					 description('Return full documentation or summary-lines')
				       ])
			]),
	edit_options(Request, EditOptions),
	format(string(Title), 'Prolog search -- ~w', [For]),
	reply_html_page(pldoc(search(For)),
			title(Title),
			\search_reply(For,
				      [ resultFormat(Format),
					search_in(In),
					search_match(Match)
				      | EditOptions
				      ])).


		 /*******************************
		 *     HTTP PARAMETER TYPES	*
		 *******************************/

:- public
	param/2.			% used in pack documentation server

param(public_only,
      [ boolean,
	default(true),
	description('If true, hide private predicates')
      ]).
param(reload,
      [ boolean,
	default(false),
	description('Reload the file and its documentation')
      ]).
param(show,
      [ oneof([doc,src,raw]),
	default(doc),
	description('How to show the file')
      ]).
param(format_comments,
      [ boolean,
	default(true),
	description('If true, use PlDoc for rendering structured comments')
      ]).


		 /*******************************
		 *	     MESSAGES		*
		 *******************************/

:- multifile
	prolog:message/3.

prolog:message(pldoc(server_started(Port))) -->
	{ http_location_by_id(pldoc_root, Root) },
	[ 'Started Prolog Documentation server at port ~w'-[Port], nl,
	  'You may access the server at http://localhost:~w~w'-[Port, Root]
	].