swish/commit

Added copied files

diff --git a/lib/swish/authenticate.pl b/lib/swish/authenticate.pl
new file mode 100644
index 0000000..4daef32
--- /dev/null
+++ b/lib/swish/authenticate.pl
@@ -0,0 +1,92 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@cs.vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (C): 2014, 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(swish_authenticate,
+	  [ swish_add_user/3		% +User, +Passwd, +Fields
+	  ]).
+:- use_module(library(pengines), []).
+:- use_module(library(lists)).
+:- use_module(library(crypt)).
+:- use_module(library(http/http_authenticate)).
+
+/** <module> SWISH login management
+
+This module provides basic login and  password management facilities for
+SWISH.  You can create an authenticated SWISH server by
+
+  1. Loading this library
+  2. Add one or more users to the passwd file using swish_add_user/3
+
+     ==
+     ?- swish_add_user("Bob", "Bob's secret", []).
+     ==
+
+As a result, trying to create the  first pengine (e.g., using _|Run!|_),
+the server will challenge the user.  The   logged  in  user is available
+through pengine_user/1.
+*/
+
+:- dynamic
+	password_file_cache/1.
+
+password_file(File) :-
+	password_file_cache(File), !.
+password_file(File) :-
+	absolute_file_name(swish(passwd), File, [access(read)]),
+	asserta(password_file_cache(File)).
+
+pengines:authentication_hook(Request, _Application, User) :-
+	password_file(File),
+	http_authenticate(basic(File), Request, [User|_Fields]), !.
+pengines:authentication_hook(_Request, _Application, _User) :-
+	throw(http_reply(authorise(basic('SWISH user')))).
+
+%%	swish_add_user(+User, +Passwd, +Fields) is det.
+%
+%	Add a new user to the SWISH password file.
+
+swish_add_user(User, Passwd, Fields) :-
+	phrase("$1$", E, _),		% use Unix MD5 hashes
+	crypt(Passwd, E),
+	string_codes(Hash, E),
+
+	Entry = passwd(User, Hash, Fields),
+
+	absolute_file_name(swish(passwd), File,
+			   [access(write)]),
+	(   exists_file(File)
+	->  http_read_passwd_file(File, Data)
+	;   Data = []
+	),
+	(   selectchk(passwd(User, _, _), Data, Entry, NewData)
+	->  true
+	;   append(Data, [Entry], NewData)
+	),
+	http_write_passwd_file(File, NewData).
+
diff --git a/lib/swish/examples.pl b/lib/swish/examples.pl
new file mode 100644
index 0000000..2d7536a
--- /dev/null
+++ b/lib/swish/examples.pl
@@ -0,0 +1,77 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@cs.vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (C): 2014, 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(swish_examples, []).
+:- use_module(library(http/http_dispatch)).
+:- use_module(library(http/http_server_files)).
+:- use_module(library(http/http_json)).
+:- use_module(library(http/json)).
+:- use_module(library(filesex)).
+:- use_module(library(apply)).
+:- use_module(library(lists)).
+
+/** <module> Serve example files
+*/
+
+user:file_search_path(swish_examples, swish(examples)).
+
+:- http_handler(swish(example),
+		serve_files_in_directory(swish_examples),
+		[prefix, id(swish_example)]).
+:- http_handler(swish(list_examples),
+		list_examples, [id(swish_examples)]).
+
+
+%%	list_examples(+Request)
+%
+%	Get a list of registered example code. Examples are described in
+%	a file swish_examples('index.json').
+
+list_examples(_Request) :-
+	http_link_to_id(swish_example, [], HREF),
+	findall(Index,
+		absolute_file_name(swish_examples('index.json'), Index,
+				   [ access(read), file_errors(fail) ]),
+		Indexes),
+	maplist(index_json(HREF), Indexes, JSON),
+	append(JSON, AllExamples),
+	reply_json(AllExamples).
+
+index_json(HREF, File, JSON) :-
+	read_file_to_json(File, JSON0),
+	maplist(add_href(HREF), JSON0, JSON).
+
+read_file_to_json(File, JSON) :-
+	setup_call_cleanup(
+	    open(File, read, In, [encoding(utf8)]),
+	    json_read_dict(In, JSON),
+	    close(In)).
+
+add_href(HREF0, Dict, Dict.put(href, HREF)) :-
+	directory_file_path(HREF0, Dict.file, HREF).
diff --git a/lib/swish/help.pl b/lib/swish/help.pl
new file mode 100644
index 0000000..1a9888f
--- /dev/null
+++ b/lib/swish/help.pl
@@ -0,0 +1,41 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@cs.vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (C): 2014, 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(swish_help, []).
+:- use_module(library(http/http_dispatch)).
+:- use_module(library(http/http_server_files)).
+
+/** <module> SWISH help system
+
+@tbd	Server SWI-Prolog Markdown files.
+*/
+
+:- http_handler(swish(help), serve_files_in_directory(swish_help), [id(help),prefix]).
+
+user:file_search_path(swish_help, swish(web/help)).
diff --git a/lib/swish/page.pl b/lib/swish/page.pl
new file mode 100644
index 0000000..a9f6824
--- /dev/null
+++ b/lib/swish/page.pl
@@ -0,0 +1,290 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@cs.vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (C): 2014, 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(swish_page,
+	  [ swish_page//1,			% +Options
+
+	    swish_navbar//1,			% +Options
+	    swish_content//1,			% +Options
+
+	    swish_resources//0,
+	    swish_js//0,
+	    swish_css//0
+	  ]).
+:- use_module(library(http/http_open)).
+:- use_module(library(http/http_dispatch)).
+:- use_module(library(http/http_parameters)).
+:- use_module(library(http/html_write)).
+:- use_module(library(http/http_path)).
+:- use_module(library(debug)).
+:- use_module(library(time)).
+:- use_module(library(option)).
+
+/** <module> Provide the SWISH application as Prolog HTML component
+
+This library provides the SWISH page  and   its  elements as Prolog HTML
+grammer rules. This allows for server-side   generated  pages to include
+swish or parts of swish easily into a page.
+*/
+
+:- http_handler(swish('index.html'), swish, [id(swish)]).
+
+%%	swish(+Request)
+%
+%	HTTP handler to reply the  default   SWISH  page.  Processes the
+%	following parameters:
+%
+%	  - code(Code)
+%	  Use Code as initial code. Code is either an HTTP url or
+%	  concrete source code.
+%	  - background(Code)
+%	  Similar to Code, but not displayed in the editor.
+%	  - examples(Code)
+%	  Provide examples. Each example starts with ?- at the beginning
+%	  of a line.
+%	  - q(Query)
+%	  Use Query as the initial query.
+
+swish(Request) :-
+	Params = [ code(_,	 [optional(true)]),
+		   background(_, [optional(true)]),
+		   examples(_,   [optional(true)]),
+		   q(_,          [optional(true)])
+		 ],
+	http_parameters(Request, Params),
+	params_options(Params, Options),
+	reply_html_page(swish(main),
+			title('SWISH -- SWI-Prolog for SHaring'),
+			\swish_page(Options)).
+
+params_options([], []).
+params_options([H0|T0], [H|T]) :-
+	arg(1, H0, Value), nonvar(Value), !,
+	functor(H0, Name, _),
+	H =.. [Name,Value],
+	params_options(T0, T).
+params_options([_|T0], T) :-
+	params_options(T0, T).
+
+
+%%	swish_page(+Options)//
+%
+%	Generate the entire SWISH default page.
+
+swish_page(Options) -->
+	swish_navbar(Options),
+	swish_content(Options).
+
+%%	swish_navbar(+Options)//
+%
+%	Generate the swish navigation bar.
+
+swish_navbar(_Options) -->
+	swish_resources,
+	html(header(class([navbar, 'navbar-default']),
+		    div(class([container, 'pull-left']),
+			[ div(class('navbar-header'),
+			      \swish_logos),
+			  nav(id(navbar), [])
+			]))).
+
+swish_logos -->
+	pengine_logo,
+	swish_logo.
+
+pengine_logo -->
+	html(a([href(/), class('pengine-logo')], &(nbsp))).
+swish_logo -->
+	html(a([href(/), class('swish-logo')], &(nbsp))).
+
+%%	swish_content(+Options)//
+%
+%	Generate the SWISH editor, Prolog output  area and query editor.
+%	Options processed:
+%
+%	  - source(HREF)
+%	  Load initial source from HREF
+
+swish_content(Options) -->
+	swish_resources,
+	html(div([id(content), class([container, swish])],
+		 [ div([class([tile, horizontal]), 'data-split'('60%')],
+		       [ div(class('prolog-editor'), \source(Options)),
+			 div([class([tile, vertical]), 'data-split'('70%')],
+			     [ div(class('prolog-runners'), []),
+			       div(class('prolog-query'), \query(Options))
+			     ])
+		       ]),
+		   \background(Options),
+		   \examples(Options)
+		 ])).
+
+source(Options) -->
+	{ option(code(Spec), Options), !,
+	  download_source(Spec, Source, Options)
+	},
+	html(textarea([ class([source,prolog]),
+			style('display:none')
+		      ],
+		      Source)).
+source(_) --> [].
+
+
+background(Options) -->
+	{ option(background(Spec), Options), !,
+	  download_source(Spec, Source, Options)
+	},
+	html(textarea([ class([source,prolog,background]),
+			style('display:none')
+		      ],
+		      Source)).
+background(_) --> [].
+
+
+examples(Options) -->
+	{ option(examples(Examples), Options), !
+	},
+	html(textarea([ class([examples,prolog]),
+			style('display:none')
+		      ],
+		      Examples)).
+examples(_) --> [].
+
+
+query(Options) -->
+	{ option(q(Query), Options)
+	}, !,
+	html(textarea([ class([query,prolog]),
+			style('display:none')
+		      ],
+		      Query)).
+query(_) --> [].
+
+
+%%	download_source(+HREF, -Source, Options) is det.
+%
+%	Download source from a URL.  Options processed:
+%
+%	  - timeout(+Seconds)
+%	    Max time to wait for reading the source.  Default
+%	    is 10 seconds.
+%	  - max_length(+Chars)
+%	    Maximum lenght of the content.  Default is 1 million.
+%	  - encoding(+Encoding)
+%	    Encoding used to interpret the text.  Default is UTF-8.
+%
+%	@bug: Should try to interpret the encoding from the HTTP
+%	      header.
+
+download_source(HREF, Source, Options) :-
+	uri_is_global(HREF), !,
+	option(timeout(TMO), Options, 10),
+	option(max_length(MaxLen), Options, 1_000_000),
+	catch(call_with_time_limit(
+		  TMO,
+		  setup_call_cleanup(
+		      http_open(HREF, In, []),
+		      read_source(In, MaxLen, Source, Options),
+		      close(In))),
+	      E, load_error(E, Source)).
+download_source(Source0, Source, Options) :-
+	option(max_length(MaxLen), Options, 1_000_000),
+	string_length(Source0, Len),
+	(   Len =< MaxLen
+	->  Source = Source0
+	;   format(string(Source),
+		   '%ERROR: Content too long (max ~D)~n', [MaxLen])
+	).
+
+read_source(In, MaxLen, Source, Options) :-
+	option(encoding(Enc), Options, utf8),
+	set_stream(In, encoding(Enc)),
+	ReadMax is MaxLen + 1,
+	read_string(In, ReadMax, Source0),
+	string_length(Source0, Len),
+	(   Len =< MaxLen
+	->  Source = Source0
+	;   format(string(Source),
+		   '%ERROR: Content too long (max ~D)~n', [MaxLen])
+	).
+
+load_error(E, Source) :-
+	message_to_string(E, String),
+	format(string(Source), '%ERROR: ~s~n', [String]).
+
+
+		 /*******************************
+		 *	     RESOURCES		*
+		 *******************************/
+
+%%	swish_resources//
+%
+%	Include  SWISH  CSS  and   JavaScript.    This   does   not  use
+%	html_require//1  because  we  need  to   include  the  JS  using
+%	RequireJS, which requires a non-standard script element.
+
+swish_resources -->
+	swish_css,
+	swish_js.
+
+swish_js  --> html_post(head, \include_swish_js).
+swish_css --> html_post(head, \include_swish_css).
+
+include_swish_js -->
+	{ swish_resource(js, JS),
+	  swish_resource(rjs, RJS),
+	  http_absolute_location(swish(js/JS), SwishJS, [])
+	},
+	html(script([ src(RJS),
+		      'data-main'(SwishJS)
+		    ], [])).
+
+include_swish_css -->
+	{ swish_resource(css, CSS),
+	  http_absolute_location(swish(css/CSS), SwishCSS, [])
+	},
+	html(link([ rel(stylesheet),
+		    href(SwishCSS)
+		  ])).
+
+swish_resource(Type, ID) :-
+	alt(Type, ID, File),
+	(   File == (-)
+	;   absolute_file_name(File, _P, [file_errors(fail), access(read)])
+	), !.
+
+alt(js,  'swish-min',     swish_web('js/swish-min.js')) :-
+	\+ debugging(nominified).
+alt(js,  'swish',         swish_web('js/swish.js')).
+alt(css, 'swish-min.css', swish_web('css/swish-min.css')) :-
+	\+ debugging(nominified).
+alt(css, 'swish.css',     swish_web('css/swish.css')).
+alt(rjs, 'js/require.js', swish_web('js/require.js')) :-
+	\+ debugging(nominified).
+alt(rjs, 'bower_components/requirejs/require.js', -).
diff --git a/lib/swish/storage.pl b/lib/swish/storage.pl
new file mode 100644
index 0000000..3a8ef5d
--- /dev/null
+++ b/lib/swish/storage.pl
@@ -0,0 +1,125 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@cs.vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (C): 2014, 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(web_storage, []).
+:- use_module(library(http/http_dispatch)).
+:- use_module(library(http/http_parameters)).
+:- use_module(library(http/http_json)).
+:- use_module(library(http/http_path)).
+:- use_module(library(http/http_client)).
+:- use_module(library(settings)).
+:- use_module(library(random)).
+:- use_module(library(apply)).
+:- use_module(library(option)).
+:- use_module(library(filesex)).
+
+/** <module> Store files on behalve of web clients
+
+*/
+
+:- setting(directory, atom, storage, 'The directory for storing files.').
+
+user:file_search_path(web_storage, Dir) :-
+	setting(directory, Dir).
+user:file_search_path(web_storage, swish_examples(.)).
+
+:- http_handler(root(storage), web_storage, [ id(web_storage), prefix ]).
+
+%%	web_storage(+Request) is det.
+%
+%	Restfull HTTP handler to store data on behalf of the client in a
+%	hard-to-guess location. Returns a JSON  object that provides the
+%	URL for the data and the plain   file name. Understands the HTTP
+%	methods =GET=, =POST=, =PUT= and =DELETE=.
+
+web_storage(Request) :-
+	option(method(Method), Request),
+	storage(Method, Request).
+
+storage(get, Request) :-
+	request_file(Request, _File, Path),
+	http_reply_file(Path, [unsafe(true)], Request).
+storage(post, Request) :-
+	http_parameters(Request,
+			[   data(Data, [default(''),
+					description('Data to be saved')]),
+			    type(Type, [default(pl)])
+			]),
+	setting(directory, Dir),
+	make_directory_path(Dir),
+	random_filename(Base),
+	file_name_extension(Base, Type, File),
+	directory_file_path(Dir, File, RelPath),
+	storage_url(File, URL),
+	save_string(RelPath, Data),
+	reply_json_dict(json{url:URL, file:File}).
+storage(put, Request) :-
+	http_read_data(Request, Form, []),
+	option(data(Data), Form, ''),
+	request_file(Request, File, Path),
+	storage_url(File, URL),
+	save_string(Path, Data),
+	reply_json_dict(json{url:URL, file:File}).
+storage(delete, Request) :-
+	request_file(Request, _File, Path),
+	delete_file(Path),
+	reply_json_dict(true).
+
+request_file(Request, File, Path) :-
+	option(path_info(PathInfo), Request),
+	atom_concat(/, File, PathInfo),
+	http_safe_file(File, []),
+	absolute_file_name(web_storage(File), Path, [access(read)]).
+
+storage_url(File, HREF) :-
+	http_absolute_uri(root(storage/File), HREF).
+
+save_string(File, Data) :-
+	setup_call_cleanup(
+	    open(File, write, S, [encoding(utf8)]),
+	    write(S, Data),
+	    close(S)).
+
+%%	random_filename(-Name) is det.
+%
+%	Return a random file name from plain nice ASCII characters.
+
+random_filename(Name) :-
+	length(Chars, 8),
+	maplist(random_char, Chars),
+	atom_chars(Name, Chars).
+
+from('abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ').
+
+random_char(Char) :-
+	from(From),
+	atom_length(From, Len),
+	Max is Len - 1,
+	random_between(0, Max, I),
+	sub_atom(From, I, 1, _, Char).