1/*  Part of SWISH
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2014-2018, VU University Amsterdam
    7			      CWI, Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(web_storage,
   37	  [ storage_file/1,			% ?File
   38	    storage_file_extension/2,		% ?File, ?Extension
   39	    storage_file/3,			% +File, -Data, -Meta
   40	    storage_meta_data/2,		% +File, -Meta
   41	    storage_meta_property/2,	        % +Meta, ?Property
   42
   43	    storage_fsck/0,
   44	    storage_repack/0,
   45	    storage_repack/1,			% +Options
   46	    storage_unpack/0,
   47
   48	    storage_store_term/2,		% +Term, -Hash
   49	    storage_load_term/2,		% +Hash, -Term
   50
   51	    use_gitty_file/1,			% +File
   52	    use_gitty_file/2			% +File, +Options
   53	  ]).   54:- use_module(library(http/http_dispatch)).   55:- use_module(library(http/http_parameters)).   56:- use_module(library(http/http_json)).   57:- use_module(library(http/mimetype)).   58:- use_module(library(lists)).   59:- use_module(library(settings)).   60:- use_module(library(random)).   61:- use_module(library(apply)).   62:- use_module(library(option)).   63:- use_module(library(debug)).   64:- use_module(library(broadcast)).   65:- use_module(library(readutil)).   66:- use_module(library(solution_sequences)).   67:- use_module(library(dcg/basics)).   68:- use_module(library(pcre)).   69:- use_module(library(pengines_io)).   70
   71:- use_module(page).   72:- use_module(gitty).   73:- use_module(patch).   74:- use_module(config).   75:- use_module(search).   76:- use_module(authenticate).   77:- use_module(pep).   78
   79:- meta_predicate
   80	use_gitty_file(:),
   81	use_gitty_file(:, +).   82
   83/** <module> Store files on behalve of web clients
   84
   85The file store needs to deal  with   versioning  and  meta-data. This is
   86achieved using gitty.pl, a git-like content-base  store that lacks git's
   87notion of a _tree_. I.e., all files   are considered individual and have
   88their own version.
   89*/
   90
   91:- setting(directory, callable, data(storage),
   92	   'The directory for storing files.').   93
   94:- http_handler(swish('p/'),
   95		web_storage,
   96		[ id(web_storage), prefix ]).   97:- http_handler(swish('source_list'),
   98		source_list,
   99		[ id(source_list) ]).  100:- http_handler(swish('source_modified'),
  101		source_modified,
  102		[ id(source_modified) ]).  103
  104:- listen(http(pre_server_start),
  105	  open_gittystore(_)).  106
  107:- dynamic  storage_dir/1.  108:- volatile storage_dir/1.  109
  110open_gittystore(Dir0) :-
  111	storage_dir(Dir), !,
  112	Dir = Dir0.
  113open_gittystore(Dir) :-
  114	with_mutex(web_storage, open_gittystore_guarded(Dir0)),
  115	Dir = Dir0.
  116
  117open_gittystore_guarded(Dir) :-
  118	storage_dir(Dir), !.
  119open_gittystore_guarded(Dir) :-
  120	setting(directory, Spec),
  121	absolute_file_name(Spec, Dir,
  122			   [ file_type(directory),
  123			     access(write),
  124			     file_errors(fail)
  125			   ]), !,
  126	gitty_open(Dir, []),
  127	asserta(storage_dir(Dir)).
  128open_gittystore_guarded(Dir) :-
  129	setting(directory, Spec),
  130	absolute_file_name(Spec, Dir,
  131			   [ solutions(all)
  132			   ]),
  133	\+ exists_directory(Dir),
  134	create_store(Dir), !,
  135	gitty_open(Dir, []),
  136	asserta(storage_dir(Dir)).
  137
  138create_store(Dir) :-
  139	exists_directory('storage/ref'), !,
  140	print_message(informational, moved_old_store(storage, Dir)),
  141	rename_file(storage, Dir).
  142create_store(Dir) :-
  143	catch(make_directory(Dir),
  144	      error(permission_error(create, directory, Dir), _),
  145	      fail), !.
  146
  147
  148%%	web_storage(+Request) is det.
  149%
  150%	Restfull HTTP handler to store data on behalf of the client in a
  151%	hard-to-guess location. Returns a JSON  object that provides the
  152%	URL for the data and the plain   file name. Understands the HTTP
  153%	methods =GET=, =POST=, =PUT= and =DELETE=.
  154
  155web_storage(Request) :-
  156	authenticate(Request, Auth),
  157	option(method(Method), Request),
  158	open_gittystore(_),
  159	storage(Method, Request, [identity(Auth)]).
  160
  161:- multifile
  162	swish_config:authenticate/2,
  163	swish_config:chat_count_about/2,
  164	swish_config:user_profile/2.		% +Request, -Profile
  165
  166storage(get, Request, Options) :-
  167	http_parameters(Request,
  168			[ format(Fmt,  [ oneof([swish,raw,json,history,diff]),
  169					 default(swish),
  170					 description('How to render')
  171				       ]),
  172			  depth(Depth, [ default(5),
  173					 integer,
  174					 description('History depth')
  175				       ]),
  176			  to(RelTo,    [ optional(true),
  177					 description('Diff relative to')
  178				       ])
  179			]),
  180	(   Fmt == history
  181	->  (   nonvar(RelTo)
  182	    ->	Format = history(Depth, RelTo)
  183	    ;	Format = history(Depth)
  184	    )
  185	;   Fmt == diff
  186	->  Format = diff(RelTo)
  187	;   Format = Fmt
  188	),
  189	storage_get(Request, Format, Options).
  190
  191storage(post, Request, Options) :-
  192	http_read_json_dict(Request, Dict),
  193	option(data(Data), Dict, ""),
  194	option(type(Type), Dict, pl),
  195	storage_dir(Dir),
  196	meta_data(Dir, Dict, _, Meta, Options),
  197	(   atom_string(Base, Dict.get(meta).get(name))
  198	->  file_name_extension(Base, Type, File),
  199	    (	authorized(gitty(create(File,named,Meta)), Options),
  200		catch(gitty_create(Dir, File, Data, Meta, Commit),
  201		      error(gitty(file_exists(File)),_),
  202		      fail)
  203	    ->	true
  204	    ;	Error = json{error:file_exists,
  205			     file:File}
  206	    )
  207	;   (   repeat,
  208	        random_filename(Base),
  209		file_name_extension(Base, Type, File),
  210		authorized(gitty(create(File,random,Meta)), Options),
  211		catch(gitty_create(Dir, File, Data, Meta, Commit),
  212		      error(gitty(file_exists(File)),_),
  213		      fail)
  214	    ->  true
  215	    )
  216	),
  217	(   var(Error)
  218	->  debug(storage, 'Created: ~p', [Commit]),
  219	    storage_url(File, URL),
  220
  221	    broadcast(swish(created(File, Commit))),
  222	    follow(Commit, Dict),
  223	    reply_json_dict(json{url:URL,
  224				 file:File,
  225				 meta:Commit.put(symbolic, "HEAD")
  226				})
  227	;   reply_json_dict(Error)
  228	).
  229storage(put, Request, Options) :-
  230	http_read_json_dict(Request, Dict),
  231	storage_dir(Dir),
  232	request_file(Request, Dir, File),
  233	(   Dict.get(update) == "meta-data"
  234	->  gitty_data(Dir, File, Data, _OldMeta)
  235	;   writeable(File)
  236	->  option(data(Data), Dict, "")
  237	;   option(path(Path), Request),
  238	    throw(http_reply(forbidden(Path)))
  239	),
  240	meta_data(Dir, Dict, PrevMeta, Meta, Options),
  241	storage_url(File, URL),
  242	authorized(gitty(update(File,PrevMeta,Meta)), Options),
  243	catch(gitty_update(Dir, File, Data, Meta, Commit),
  244	      Error,
  245	      true),
  246	(   var(Error)
  247	->  debug(storage, 'Updated: ~p', [Commit]),
  248	    collect_messages_as_json(
  249		broadcast(swish(updated(File, Commit))),
  250		Messages),
  251	    debug(gitty(load), 'Messages: ~p', [Messages]),
  252	    follow(Commit, Dict),
  253	    reply_json_dict(json{ url:URL,
  254				  file:File,
  255				  meta:Commit.put(symbolic, "HEAD"),
  256				  messages:Messages
  257				})
  258	;   update_error(Error, Dir, Data, File, URL)
  259	).
  260storage(delete, Request, Options) :-
  261	storage_dir(Dir),
  262	meta_data(Dir, _{}, PrevMeta, Meta, Options),
  263	request_file(Request, Dir, File),
  264	authorized(gitty(delete(File,PrevMeta)), Options),
  265	gitty_update(Dir, File, "", Meta, Commit),
  266	broadcast(swish(deleted(File, Commit))),
  267	reply_json_dict(true).
  268
  269writeable(File) :-
  270	\+ file_name_extension(_, lnk, File).
  271
  272%%	update_error(+Error, +Storage, +Data, +File, +URL)
  273%
  274%	If error signals an edit conflict, prepare an HTTP =|409
  275%	Conflict|= page
  276
  277update_error(error(gitty(commit_version(_, Head, Previous)), _),
  278	     Dir, Data, File, URL) :- !,
  279	gitty_diff(Dir, Previous, Head, OtherEdit),
  280	gitty_diff(Dir, Previous, data(Data), MyEdits),
  281	Status0 = json{url:URL,
  282		       file:File,
  283		       error:edit_conflict,
  284		       edit:_{server:OtherEdit,
  285			      me:MyEdits}
  286		      },
  287	(   OtherDiff = OtherEdit.get(data)
  288	->  PatchOptions = [status(_), stderr(_)],
  289	    patch(Data, OtherDiff, Merged, PatchOptions),
  290	    Status1 = Status0.put(merged, Merged),
  291	    foldl(patch_status, PatchOptions, Status1, Status)
  292	;   Status = Status0
  293	),
  294	reply_json_dict(Status, [ status(409) ]).
  295update_error(Error, _Dir, _Data, _File, _URL) :-
  296	throw(Error).
  297
  298patch_status(status(exit(0)), Dict, Dict) :- !.
  299patch_status(status(exit(Status)), Dict, Dict.put(patch_status, Status)) :- !.
  300patch_status(status(killed(Signal)), Dict, Dict.put(patch_killed, Signal)) :- !.
  301patch_status(stderr(""), Dict, Dict) :- !.
  302patch_status(stderr(Errors), Dict, Dict.put(patch_errors, Errors)) :- !.
  303
  304%!	follow(+Commit, +SaveDict) is det.
  305%
  306%	Broadcast follow(DocID, ProfileID, [update,chat])   if  the user
  307%	wishes to follow the file associated with Commit.
  308
  309follow(Commit, Dict) :-
  310	Dict.get(meta).get(follow) == true,
  311	_{name:File, profile_id:ProfileID} :< Commit, !,
  312	atom_concat('gitty:', File, DocID),
  313	broadcast(swish(follow(DocID, ProfileID, [update,chat]))).
  314follow(_, _).
  315
  316%!	request_file(+Request, +GittyDir, -File) is det.
  317%
  318%	Extract the gitty file referenced from the HTTP Request.
  319%
  320%	@error HTTP 404 exception
  321
  322request_file(Request, Dir, File) :-
  323	option(path_info(File), Request),
  324	(   gitty_file(Dir, File, _Hash)
  325	->  true
  326	;   http_404([], Request)
  327	).
  328
  329storage_url(File, HREF) :-
  330	http_link_to_id(web_storage, path_postfix(File), HREF).
  331
  332%%	meta_data(+Dict, -Meta, +Options) is det.
  333%%	meta_data(+Store, +Dict, -PrevMeta, -Meta, +Options) is det.
  334%
  335%	Gather meta-data from the  Request   (user,  peer, identity) and
  336%	provided meta-data. Illegal and unknown values are ignored.
  337%
  338%	The meta_data/5 version is used to add information about a fork.
  339%
  340%	@param Dict represents the JSON document posted and contains the
  341%	content (`data`) and meta data (`meta`).
  342
  343meta_data(Dict, Meta, Options) :-
  344	option(identity(Auth), Options),
  345	(   _ = Auth.get(identity)
  346	->  HasIdentity = true
  347	;   HasIdentity = false
  348	),
  349	filter_auth(Auth, Auth1),
  350	(   filter_meta(Dict.get(meta), HasIdentity, Meta1)
  351	->  Meta = meta{}.put(Auth1).put(Meta1)
  352	;   Meta = meta{}.put(Auth1)
  353	).
  354
  355meta_data(Store, Dict, PrevMeta, Meta, Options) :-
  356	meta_data(Dict, Meta1, Options),
  357	(   atom_string(Previous, Dict.get(previous)),
  358	    is_gitty_hash(Previous),
  359	    gitty_commit(Store, Previous, PrevMeta)
  360	->  Meta = Meta1.put(previous, Previous)
  361	;   Meta = Meta1
  362	).
  363
  364filter_meta(Dict0, HasID, Dict) :-
  365	dict_pairs(Dict0, Tag, Pairs0),
  366	filter_pairs(Pairs0, HasID, Pairs),
  367	dict_pairs(Dict, Tag, Pairs).
  368
  369filter_pairs([], _, []).
  370filter_pairs([K-V0|T0], HasID, [K-V|T]) :-
  371	meta_allowed(K, HasID, Type),
  372	filter_type(Type, V0, V), !,
  373	filter_pairs(T0, HasID, T).
  374filter_pairs([_|T0], HasID, T) :-
  375	filter_pairs(T0, HasID, T).
  376
  377meta_allowed(public,	     _,	    boolean).
  378meta_allowed(example,	     _,	    boolean).
  379meta_allowed(author,	     _,	    string).
  380meta_allowed(avatar,	     false, string).
  381meta_allowed(email,	     _,	    string).
  382meta_allowed(title,	     _,	    string).
  383meta_allowed(tags,	     _,	    list(string)).
  384meta_allowed(description,    _,	    string).
  385meta_allowed(commit_message, _,	    string).
  386meta_allowed(modify,	     _,	    list(atom)).
  387
  388filter_type(Type, V, V) :-
  389	is_of_type(Type, V), !.
  390filter_type(list(Type), V0, V) :-
  391	is_list(V0),
  392	maplist(filter_type(Type), V0, V).
  393filter_type(atom, V0, V) :-
  394	atomic(V0),
  395	atom_string(V, V0).
  396
  397filter_auth(Auth0, Auth) :-
  398	auth_template(Auth),
  399	Auth :< Auth0, !.
  400filter_auth(Auth, Auth).
  401
  402auth_template(_{identity:_, profile_id:_}).
  403auth_template(_{profile_id:_}).
  404auth_template(_{identity:_}).
  405
  406
  407%%	storage_get(+Request, +Format, +Options) is det.
  408%
  409%	HTTP handler that returns information a given gitty file.
  410%
  411%	@arg Format is one of
  412%
  413%	     - swish
  414%	     Serve file embedded in a SWISH application
  415%	     - raw
  416%	     Serve the raw file
  417%	     - json
  418%	     Return a JSON object with the keys `data` and `meta`
  419%	     - history(Depth, IncludeHASH)
  420%	     Return a JSON description with the change log
  421%	     - diff(RelTo)
  422%	     Reply with diff relative to RelTo.  Default is the
  423%	     previous commit.
  424
  425storage_get(Request, swish, Options) :-
  426	swish_reply_config(Request, Options), !.
  427storage_get(Request, Format, Options) :-
  428	storage_dir(Dir),
  429	request_file_or_hash(Request, Dir, FileOrHash, Type),
  430	Obj =.. [Type,FileOrHash],
  431	authorized(gitty(download(Obj, Format)), Options),
  432	storage_get(Format, Dir, Type, FileOrHash, Request),
  433	broadcast(swish(download(Dir, FileOrHash, Format))).
  434
  435storage_get(swish, Dir, Type, FileOrHash, Request) :-
  436	gitty_data_or_default(Dir, Type, FileOrHash, Code, Meta),
  437	chat_count(Meta, Count),
  438	swish_show([ code(Code),
  439		     file(FileOrHash),
  440		     st_type(gitty),
  441		     meta(Meta),
  442		     chat_count(Count)
  443		   ],
  444		   Request).
  445storage_get(raw, Dir, Type, FileOrHash, _Request) :-
  446	gitty_data_or_default(Dir, Type, FileOrHash, Code, Meta),
  447	file_mime_type(Meta.name, MIME),
  448	format('Content-type: ~w~n~n', [MIME]),
  449	format('~s', [Code]).
  450storage_get(json, Dir, Type, FileOrHash, _Request) :-
  451	gitty_data_or_default(Dir, Type, FileOrHash, Code, Meta),
  452	chat_count(Meta, Count),
  453	JSON0 = json{data:Code, meta:Meta, chats:_{total:Count}},
  454	(   open_hook(json, JSON0, JSON)
  455	->  true
  456	;   JSON = JSON0
  457	),
  458	reply_json_dict(JSON).
  459storage_get(history(Depth, Includes), Dir, _, File, _Request) :-
  460	gitty_history(Dir, File, History, [depth(Depth),includes(Includes)]),
  461	reply_json_dict(History).
  462storage_get(history(Depth), Dir, _, File, _Request) :-
  463	gitty_history(Dir, File, History, [depth(Depth)]),
  464	reply_json_dict(History).
  465storage_get(diff(RelTo), Dir, _, File, _Request) :-
  466	gitty_diff(Dir, RelTo, File, Diff),
  467	reply_json_dict(Diff).
  468
  469request_file_or_hash(Request, Dir, FileOrHash, Type) :-
  470	option(path_info(FileOrHash), Request),
  471	(   gitty_file(Dir, FileOrHash, _Hash)
  472	->  Type = file
  473	;   is_gitty_hash(FileOrHash)
  474	->  Type = hash
  475	;   gitty_default_file(FileOrHash, _)
  476	->  Type = default
  477	;   http_404([], Request)
  478	).
  479
  480%!	gitty_data_or_default(+Dir, +Type, +FileOrHash, -Code, -Meta)
  481%
  482%	Read a file from the gitty store. I   the file is not present, a
  483%	default may be provided =gitty/File= in the config directory.
  484
  485gitty_data_or_default(_, default, File, Code,
  486		      meta{name:File,
  487			   modify:[login,owner],
  488			   default:true,
  489			   chat:"large"
  490			  }) :- !,
  491	gitty_default_file(File, Path),
  492	read_file_to_string(Path, Code, []).
  493gitty_data_or_default(Dir, _, FileOrHash, Code, Meta) :-
  494	gitty_data(Dir, FileOrHash, Code, Meta), !.
  495
  496gitty_default_file(File, Path) :-
  497	file_name_extension(Base, Ext, File),
  498	memberchk(Ext, [pl,swinb]),
  499	forall(sub_atom(Base, _, 1, _, C),
  500	       char_type(C, csym)),
  501	absolute_file_name(config(gitty/File), Path,
  502			   [ access(read),
  503			     file_errors(fail)
  504			   ]).
  505
  506
  507%!	chat_count(+Meta, -ChatCount) is det.
  508%
  509%	True when ChatCount is the number of chat messages available
  510%	about Meta.
  511
  512chat_count(Meta, Chats) :-
  513	atom_concat('gitty:', Meta.get(name), DocID),
  514	swish_config:chat_count_about(DocID, Chats), !.
  515chat_count(_, 0).
  516
  517
  518%%	random_filename(-Name) is det.
  519%
  520%	Return a random file name from plain nice ASCII characters.
  521
  522random_filename(Name) :-
  523	length(Chars, 8),
  524	maplist(random_char, Chars),
  525	atom_chars(Name, Chars).
  526
  527from('abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ').
  528
  529random_char(Char) :-
  530	from(From),
  531	atom_length(From, Len),
  532	Max is Len - 1,
  533	random_between(0, Max, I),
  534	sub_atom(From, I, 1, _, Char).
  535
  536
  537%!	swish_show(+Options, +Request)
  538%
  539%	Hande a document. First calls the   hook  open_hook/2 to rewrite
  540%	the document. This is used for e.g., permahashes.
  541
  542:- multifile open_hook/3.  543
  544swish_show(Options0, Request) :-
  545	open_hook(swish, Options0, Options), !,
  546	swish_reply(Options, Request).
  547swish_show(Options, Request) :-
  548	swish_reply(Options, Request).
  549
  550
  551		 /*******************************
  552		 *	    INTERFACE		*
  553		 *******************************/
  554
  555%%	storage_file(?File) is nondet.
  556%!	storage_file_extension(?File, ?Extension) is nondet.
  557%%	storage_file(+File, -Data, -Meta) is semidet.
  558%%	storage_meta_data(+File, -Meta) is semidet.
  559%
  560%	True if File is known in the store.
  561%
  562%	@arg Data is a string holding the content of the file
  563%	@arg Meta is a dict holding the meta data about the file.
  564
  565storage_file(File) :-
  566	storage_file_extension(File, _).
  567
  568storage_file_extension(File, Ext) :-
  569	open_gittystore(Dir),
  570	gitty_file(Dir, File, Ext, _Head).
  571
  572storage_file(File, Data, Meta) :-
  573	open_gittystore(Dir),
  574	(   var(File)
  575	->  gitty_file(Dir, File, _Head)
  576	;   true
  577	),
  578	gitty_data(Dir, File, Data, Meta).
  579
  580storage_meta_data(File, Meta) :-
  581	open_gittystore(Dir),
  582	(   var(File)
  583	->  gitty_file(Dir, File, _Head)
  584	;   true
  585	),
  586	gitty_commit(Dir, File, Meta).
  587
  588%!	storage_meta_property(+Meta, -Property)
  589%
  590%	True when Meta has Property. Defined properties are:
  591%
  592%	  - peer(Atom)
  593%	  Peer address that last saved the file
  594%	  -
  595
  596storage_meta_property(Meta, Property) :-
  597	current_meta_property(Property, How),
  598	meta_property(Property, How, Meta).
  599
  600meta_property(Property, dict, Identity) :-
  601	Property =.. [Name,Value],
  602	Value = Identity.get(Name).
  603meta_property(modify(Modify), _, Meta) :-
  604	(   Modify0 = Meta.get(modify)
  605	->  Modify = Modify0
  606	;   Modify = [any,login,owner]
  607	).
  608
  609current_meta_property(peer(_Atom),	 dict).
  610current_meta_property(public(_Bool),	 dict).
  611current_meta_property(time(_Seconds),	 dict).
  612current_meta_property(author(_String),	 dict).
  613current_meta_property(identity(_String), dict).
  614current_meta_property(avatar(_String),	 dict).
  615current_meta_property(modify(_List),	 derived).
  616
  617%!	storage_store_term(+Term, -Hash) is det.
  618%!	storage_load_term(+Hash, -Term) is det.
  619%
  620%	Add/retrieve terms from the gitty store.  This is used to create
  621%	permanent links to arbitrary objects.
  622
  623storage_store_term(Term, Hash) :-
  624	open_gittystore(Dir),
  625	with_output_to(string(S), write_canonical(Term)),
  626	gitty_save(Dir, S, term, Hash).
  627
  628storage_load_term(Hash, Term) :-
  629	open_gittystore(Dir),
  630	gitty_load(Dir, Hash, Data, term),
  631	term_string(Term, Data).
  632
  633
  634		 /*******************************
  635		 * LOAD GITTY FILES PERMANENTLY *
  636		 *******************************/
  637
  638%!  use_gitty_file(+File) is det.
  639%!  use_gitty_file(+File, +Options) is det.
  640%
  641%   Load  a  file  from  the  Gitty    store.   Options  are  passed  to
  642%   load_files/2. Additional options are:
  643%
  644%     - watch(+Boolean)
  645%       If `true` (default), reload the file if the user saves it.
  646
  647use_gitty_file(File) :-
  648    use_gitty_file(File, []).
  649
  650use_gitty_file(M:Spec, Options) :-
  651    ensure_extension(Spec, pl, File),
  652    setup_watch(M:File, Options),
  653    storage_file(File, Data, Meta),
  654    atom_concat('swish://', File, URL),
  655    setup_call_cleanup(
  656        open_string(Data, In),
  657        load_files(M:URL,
  658                   [ stream(In),
  659                     modified(Meta.time),
  660                     if(changed)
  661                   | Options
  662                   ]),
  663        close(In)).
  664
  665ensure_extension(File, Ext, File) :-
  666    file_name_extension(_, Ext, File),
  667    !.
  668ensure_extension(Base, Ext, File) :-
  669    file_name_extension(Base, Ext, File).
  670
  671
  672:- dynamic
  673    watching/3.                                 % File, Module, Options
  674
  675setup_watch(M:File, Options) :-
  676    option(watch(true), Options, true),
  677    !,
  678    (   watching(File, M, Options)
  679    ->  true
  680    ;   retractall(watching(File, M, _)),
  681        assertz(watching(File, M, Options))
  682    ).
  683setup_watch(M:File, _Options) :-
  684    retractall(watching(File, M, _)).
  685
  686
  687		 /*******************************
  688		 *      AUTOMATIC RELOAD	*
  689		 *******************************/
  690
  691:- initialization
  692    listen(swish(updated(File, Commit)),
  693           run_watchdog(File, Commit)).  694
  695run_watchdog(File, _Commit) :-
  696    debug(gitty(reload), 'File ~p was saved', [File]),
  697    forall(watching(File, Module, Options),
  698           use_gitty_file(Module:File, Options)).
  699
  700
  701		 /*******************************
  702		 *	      MESSAGES		*
  703		 *******************************/
  704
  705%!	collect_messages_as_json(+Goal, -Messages)
  706%
  707%	Run Goal, collecting messages as  produced by print_message/2 in
  708%	Messages as JSON terms.
  709
  710:- meta_predicate
  711	collect_messages_as_json(0, -).  712
  713:- thread_local
  714	messages/1.  715
  716collect_messages_as_json(Goal, Messages) :-
  717	retractall(messages(_)),
  718	setup_call_cleanup(
  719	    asserta((user:thread_message_hook(Term,Kind,Lines) :-
  720		        collect_message(Term,Kind,Lines)),
  721		    Ref),
  722	    Goal,
  723	    erase(Ref)),
  724	findall(Msg, retract(messages(Msg)), Messages).
  725
  726collect_message(Term, Kind, Lines) :-
  727	message_to_json(Term, Kind, Lines, JSON),
  728	assertz(messages(JSON)).
  729
  730message_to_json(Term, Kind, Lines, JSON) :-
  731	message_to_string(Term, String),
  732	JSON0 = json{type: message,
  733		     kind: Kind,
  734		     data: [String]},
  735	add_html_message(Kind, Lines, JSON0, JSON1),
  736	(   source_location(File, Line)
  737	->  JSON2 = JSON1.put(location, json{file:File, line:Line})
  738	;   JSON2 = JSON1
  739	),
  740	(   message_details(Term, JSON2, JSON)
  741	->  true
  742	;   JSON = JSON2
  743	).
  744
  745message_details(error(syntax_error(_What),
  746                      file(File,Line,Offset,_CharPos)),
  747                JSON0, JSON) :-
  748	JSON = JSON0.put(location, json{file:File, line:Line, ch:Offset})
  749		    .put(code, syntax_error).
  750message_details(load_file(Step), JSON0, JSON) :-
  751	functor(Step, Code, _),
  752	JSON = JSON0.put(code, Code).
  753
  754% Added in SWI-Prolog 7.7.21
  755:- if(current_predicate(message_lines_to_html/3)).  756add_html_message(Kind, Lines, JSON0, JSON) :-
  757	atom_concat('msg-', Kind, Class),
  758	message_lines_to_html(Lines, [Class], HTML),
  759	JSON = JSON0.put(html, HTML).
  760:- else.  761add_html_message(_, _, JSON, JSON).
  762:- endif.  763
  764		 /*******************************
  765		 *	    MAINTENANCE		*
  766		 *******************************/
  767
  768%!	storage_fsck
  769%
  770%	Enumerate and check the consistency of the entire store.
  771
  772storage_fsck :-
  773	open_gittystore(Dir),
  774	gitty_fsck(Dir).
  775
  776%!	storage_repack is det.
  777%!	storage_repack(+Options) is det.
  778%
  779%	Repack  the  storage  directory.  Currently  only  supports  the
  780%	`files` driver. For database drivers  this   is  supposed  to be
  781%	handled by the database.
  782
  783:- multifile
  784	gitty_driver_files:repack_objects/2,
  785	gitty_driver_files:unpack_packs/1.  786
  787storage_repack :-
  788	storage_repack([]).
  789storage_repack(Options) :-
  790	open_gittystore(Dir),
  791	(   gitty_driver(Dir, files)
  792	->  gitty_driver_files:repack_objects(Dir, Options)
  793	;   print_message(informational, gitty(norepack(driver)))
  794	).
  795
  796%!	storage_unpack
  797%
  798%	Unpack all packed objects of the  store. Currently only supports
  799%	the `files` driver. For database drivers  this is supposed to be
  800%	handled by the database.
  801
  802storage_unpack :-
  803	open_gittystore(Dir),
  804	(   gitty_driver(Dir, files)
  805	->  gitty_driver_files:unpack_packs(Dir)
  806	;   print_message(informational, gitty(nounpack(driver)))
  807	).
  808
  809
  810		 /*******************************
  811		 *	 SEARCH SUPPORT		*
  812		 *******************************/
  813
  814:- multifile
  815	swish_search:typeahead/4.	% +Set, +Query, -Match, +Options
  816
  817%%	swish_search:typeahead(+Set, +Query, -Match, +Options) is nondet.
  818%
  819%	Find files using typeahead  from  the   SWISH  search  box. This
  820%	version defines the following sets:
  821%
  822%	  - file: Search the store for matching file names, matching tag
  823%	    or title.
  824%	  - store_content: Search the content of the store for matching
  825%	    lines.
  826%
  827%	@tbd caching?
  828%	@tbd We should only demand public on public servers.
  829
  830swish_search:typeahead(file, Query, FileInfo, _Options) :-
  831	open_gittystore(Dir),
  832	gitty_file(Dir, File, Head),
  833	gitty_commit(Dir, Head, Meta),
  834	Meta.get(public) == true,
  835	(   sub_atom(File, 0, _, _, Query) % find only public
  836	->  true
  837	;   meta_match_query(Query, Meta)
  838	->  true
  839	),
  840	FileInfo = Meta.put(_{type:"store", file:File}).
  841
  842meta_match_query(Query, Meta) :-
  843	member(Tag, Meta.get(tags)),
  844	sub_atom(Tag, 0, _, _, Query).
  845meta_match_query(Query, Meta) :-
  846	sub_atom(Meta.get(author), 0, _, _, Query).
  847meta_match_query(Query, Meta) :-
  848	Title = Meta.get(title),
  849	sub_atom_icasechk(Title, Start, Query),
  850	(   Start =:= 0
  851	->  true
  852	;   Before is Start-1,
  853	    sub_atom(Title, Before, 1, _, C),
  854	    \+ char_type(C, csym)
  855	).
  856
  857swish_search:typeahead(store_content, Query, FileInfo, Options) :-
  858	limit(25, search_store_content(Query, FileInfo, Options)).
  859
  860search_store_content(Query, FileInfo, Options) :-
  861	open_gittystore(Dir),
  862	gitty_file(Dir, File, Head),
  863	gitty_data(Dir, Head, Data, Meta),
  864	Meta.get(public) == true,
  865	limit(5, search_file(File, Meta, Data, Query, FileInfo, Options)).
  866
  867search_file(File, Meta, Data, Query, FileInfo, Options) :-
  868	split_string(Data, "\n", "\r", Lines),
  869	nth1(LineNo, Lines, Line),
  870	match(Line, Query, Options),
  871	FileInfo = Meta.put(_{type:"store", file:File,
  872			      line:LineNo, text:Line, query:Query
  873			     }).
  874
  875
  876		 /*******************************
  877		 *	   SOURCE LIST		*
  878		 *******************************/
  879
  880%%	source_list(+Request)
  881%
  882%	List source files.  Request parameters:
  883%
  884%	  - q(Query)
  885%	    Query is a string for which the following sub strings
  886%	    are treated special:
  887%	    $ "..." :
  888%	    A quoted string is taken as a string search
  889%	    $ /.../[xim]*
  890%	    Regular expression search
  891%	    $ tag:Tag :
  892%	    Must have tag containing
  893%	    $ type:Type :
  894%	    Limit to one of `pl`, `swinb` or `lnk`
  895%	    $ user:User :
  896%	    Must have user containing.  If User is `me` must be
  897%	    owned by current user
  898%	    $ name:Name :
  899%	    Must have name containing
  900%	  - o(Order)
  901%	    Order by `time` (default), `name`, `author` or `type`
  902%	  - offset(+Offset)
  903%	  - limit(+Limit)
  904%	  - display_name
  905%	  - avatar
  906%	    Weak identity parameters used to identify _own_ documents
  907%	    that are also weakly identified.
  908%
  909%	Reply is a JSON object containing `count` (total matches),
  910%	`cpu` (CPU time) and `matches` (list of matching sources)
  911%
  912%	@tbd Search the content when searching a .lnk file?
  913%	@tbd Speedup expensive searches.  Cache?  Use external DB?
  914
  915source_list(Request) :-
  916	authenticate(Request, Auth),
  917	http_parameters(Request,
  918			[ q(Q, [optional(true)]),
  919			  o(Order, [ oneof([time,name,author,type]),
  920				     default(time)
  921				   ]),
  922			  offset(Offset, [integer, default(0)]),
  923			  limit(Limit, [integer, default(10)]),
  924			  display_name(DisplayName, [optional(true), string]),
  925			  avatar(Avatar, [optional(true), string])
  926			]),
  927	bound(Auth.put(_{display_name:DisplayName, avatar:Avatar}), AuthEx),
  928	order(Order, Field, Cmp),
  929	last_modified(Modified),
  930	statistics(cputime, CPU0),
  931	findall(Source, source(Q, AuthEx, Source), AllSources),
  932	statistics(cputime, CPU1),
  933	length(AllSources, Count),
  934	CPU is CPU1 - CPU0,
  935	sort(Field, Cmp, AllSources, Ordered),
  936	list_offset_limit(Ordered, Offset, Limit, Sources),
  937	reply_json_dict(json{total:Count, offset:Offset,
  938			     cpu:CPU, modified:Modified,
  939			     matches:Sources}).
  940
  941list_offset_limit(List0, Offset, Limit, List) :-
  942	list_offset(List0, Offset, List1),
  943	list_limit(List1, Limit, List).
  944
  945list_offset([_|T0], Offset, T) :-
  946	succ(O1, Offset), !,
  947	list_offset(T0, O1, T).
  948list_offset(List, _, List).
  949
  950list_limit([H|T0], Limit, [H|T]) :-
  951	succ(L1, Limit), !,
  952	list_limit(T0, L1, T).
  953list_limit(_, _, []).
  954
  955order(type,  ext,   @=<) :- !.
  956order(time,  time,  @>=) :- !.
  957order(Field, Field, @=<).
  958
  959source(Q, Auth, Source) :-
  960	parse_query(Q, Query),
  961	source_q(Query, Auth, Source).
  962
  963source_q([user("me")], Auth, _Source) :-
  964	\+ _ = Auth.get(avatar),
  965	\+ user_property(Auth, identity(_Id)), !,
  966	fail.
  967source_q(Query, Auth, Source) :-
  968	type_constraint(Query, Query1, Type),
  969	partition(content_query, Query1,
  970		  ContentConstraints, MetaConstraints),
  971	storage_file_extension(File, Type),
  972	source_data(File, Meta, Source),
  973	visible(Meta, Auth, MetaConstraints),
  974	maplist(matches_meta(Source, Auth), MetaConstraints),
  975	matches_content(ContentConstraints, File).
  976
  977content_query(string(_)).
  978content_query(regex(_)).
  979
  980source_data(File, Meta, Source) :-
  981	storage_meta_data(File, Meta),
  982	file_name_extension(_, Type, File),
  983	Info = _{time:_, tags:_, author:_, avatar:_, name:_},
  984	Info >:< Meta,
  985	bound(Info, Info2),
  986	Source = Info2.put(_{type:st_gitty, ext:Type}).
  987
  988bound(Dict0, Dict) :-
  989	dict_pairs(Dict0, Tag, Pairs0),
  990	include(bound, Pairs0, Pairs),
  991	dict_pairs(Dict, Tag, Pairs).
  992
  993bound(_-V) :- nonvar(V).
  994
  995%!	visible(+FileMeta, +Auth, +MetaConstraints) is semidet.
  996
  997visible(Meta, Auth, Constraints) :-
  998	memberchk(user("me"), Constraints),
  999	!,
 1000	owns(Auth, Meta, user(_)).
 1001visible(Meta, _Auth, _Constraints) :-
 1002	Meta.get(public) == true, !.
 1003visible(Meta, Auth, _Constraints) :-
 1004	owns(Auth, Meta, _).
 1005
 1006%!	owns(+Auth, +Meta, ?How) is semidet.
 1007%
 1008%	True if the file represented  by  Meta   is  owned  by  the user
 1009%	identified as Auth. If this is a  strong identity we must give a
 1010%	strong answer.
 1011%
 1012%	@tbd Weaker identity on the basis of author, avatar
 1013%	properties and/or IP properties.
 1014
 1015owns(Auth, Meta, user(me)) :-
 1016	storage_meta_property(Meta, identity(Id)), !,
 1017	user_property(Auth, identity(Id)).
 1018owns(Auth, Meta, user(avatar)) :-
 1019	storage_meta_property(Meta, avatar(Id)),
 1020	user_property(Auth, avatar(Id)), !.
 1021owns(Auth, Meta, user(nickname)) :-
 1022	Auth.get(display_name) == Meta.get(author), !.
 1023owns(Auth, Meta, host(How)) :-		% trust same host and local host
 1024	Peer = Auth.get(peer),
 1025	(   Peer == Meta.get(peer)
 1026	->  How = same
 1027	;   sub_atom(Meta.get(peer), 0, _, _, '127.0.0.')
 1028	->  How = local
 1029	).
 1030
 1031%!	matches_meta(+Source, +Auth, +Query) is semidet.
 1032%
 1033%	True when Source matches the meta-data requirements
 1034
 1035matches_meta(Dict, _, tag(Tag)) :- !,
 1036	(   Tag == ""
 1037	->  Dict.get(tags) \== []
 1038	;   member(Tagged, Dict.get(tags)),
 1039	    match_meta(Tag, Tagged)
 1040	->  true
 1041	).
 1042matches_meta(Dict, _, name(Name)) :- !,
 1043	match_meta(Name, Dict.get(name)).
 1044matches_meta(Dict, _, user(Name)) :-
 1045	(   Name \== "me"
 1046	->  match_meta(Name, Dict.get(author))
 1047	;   true		% handled in visible/3
 1048	).
 1049
 1050match_meta(regex(RE), Value) :- !,
 1051	re_match(RE, Value).
 1052match_meta(String, Value) :-
 1053	sub_atom_icasechk(Value, _, String).
 1054
 1055matches_content([], _) :- !.
 1056matches_content(Constraints, File) :-
 1057	storage_file(File, Data, _Meta),
 1058	maplist(match_content(Data), Constraints).
 1059
 1060match_content(Data, string(S)) :-
 1061	sub_atom_icasechk(Data, _, S), !.
 1062match_content(Data, regex(RE)) :-
 1063	re_match(RE, Data).
 1064
 1065%!	type_constraint(+Query0, -Query, -Type) is det.
 1066%
 1067%	Extract the type constraints from  the   query  as we can handle
 1068%	that efficiently.
 1069
 1070type_constraint(Query0, Query, Type) :-
 1071	partition(is_type, Query0, Types, Query),
 1072	(   Types == []
 1073	->  true
 1074	;   Types = [type(Type)]
 1075	->  true
 1076	;   maplist(arg(1), Types, List),
 1077	    freeze(Type, memberchk(Type, List))
 1078	).
 1079
 1080is_type(type(_)).
 1081
 1082%!	parse_query(+String, -Query) is det.
 1083%
 1084%	Parse a query, resulting in a list of Name(Value) pairs. Name is
 1085%	one of `tag`, `user`, `type`, `string` or `regex`.
 1086%
 1087%	@tbd: Should we allow for logical combinations?
 1088
 1089parse_query(Q, Query) :-
 1090	var(Q), !,
 1091	Query = [].
 1092parse_query(Q, Query) :-
 1093	string_codes(Q, Codes),
 1094	phrase(query(Query), Codes).
 1095
 1096query([H|T]) -->
 1097	blanks,
 1098	query1(H), !,
 1099	query(T).
 1100query([]) -->
 1101	blanks.
 1102
 1103query1(Q) -->
 1104	tag(Tag, Value), !,
 1105	{Q =.. [Tag,Value]}.
 1106query1(Q) -->
 1107	"\"", string(Codes), "\"", !,
 1108	{ string_codes(String, Codes),
 1109	  Q = string(String)
 1110	}.
 1111query1(Q) -->
 1112	"/", string(Codes), "/", re_flags(Flags), !,
 1113	{ string_codes(String, Codes),
 1114	  re_compile(String, RE, Flags),
 1115	  Q = regex(RE)
 1116	}.
 1117query1(Q) -->
 1118	next_word(String),
 1119	{ String \== "",
 1120	  re_compile(String, RE,
 1121		     [ extended(true),
 1122		       caseless(true)
 1123		     ]),
 1124	  Q = regex(RE)
 1125	}.
 1126
 1127re_flags([H|T]) -->
 1128	re_flag(H), !,
 1129	re_flags(T).
 1130re_flags([]) -->
 1131	blank.
 1132re_flags([]) -->
 1133	eos.
 1134
 1135re_flag(caseless(true))  --> "i".
 1136re_flag(extended(true))  --> "x".
 1137re_flag(multiline(true)) --> "m".
 1138re_flag(dotall(true))    --> "s".
 1139
 1140next_word(String) -->
 1141	blanks, nonblank(H), string(Codes), ( blank ; eos ), !,
 1142	{ string_codes(String, [H|Codes]) }.
 1143
 1144tag(name, Value) --> "name:", tag_value(Value, _).
 1145tag(tag,  Value) --> "tag:",  tag_value(Value, _).
 1146tag(user, Value) --> "user:", tag_value(Value, _).
 1147tag(type, Value) --> "type:", tag_value(String, string(_)), { atom_string(Value, String) }.
 1148
 1149tag_value(String, string(quoted)) -->
 1150	blanks, "\"", !, string(Codes), "\"", !,
 1151	{ string_codes(String, Codes) }.
 1152tag_value(Q, regex) -->
 1153	blanks, "/", string(Codes), "/", re_flags(Flags), !,
 1154	{   Codes == []
 1155	->  Q = ""
 1156	;   string_codes(String, Codes),
 1157	    re_compile(String, RE, Flags),
 1158	    Q = regex(RE)
 1159	}.
 1160tag_value(String, string(nonquoted)) -->
 1161	nonblank(H), !,
 1162	string(Codes),
 1163	( blank ; eos ), !,
 1164	{ string_codes(String, [H|Codes]) }.
 1165tag_value("", empty) -->
 1166	"".
 1167
 1168		 /*******************************
 1169		 *	  TRACK CHANGES		*
 1170		 *******************************/
 1171
 1172%!	source_modified(+Request)
 1173%
 1174%	Reply with the last modification  time   of  the source repo. If
 1175%	there is no modification we use the time the server was started.
 1176%
 1177%	This  is  a  poor  men's  solution  to  keep  the  client  cache
 1178%	consistent. Need to think about a   better way to cache searches
 1179%	client and/or server side.
 1180
 1181source_modified(Request) :-
 1182	authenticate(Request, _Auth),
 1183	last_modified(Time),
 1184	reply_json_dict(json{modified:Time}).
 1185
 1186:- dynamic gitty_last_modified/1. 1187
 1188update_last_modified(_,_) :-
 1189	with_mutex(gitty_last_modified,
 1190		   update_last_modified_sync).
 1191
 1192update_last_modified_sync :-
 1193	get_time(Now),
 1194	retractall(gitty_last_modified(_)),
 1195	asserta(gitty_last_modified(Now)).
 1196
 1197last_modified(Time) :-
 1198	debugging(swish(sourcelist)), !,	% disable caching
 1199	get_time(Now),
 1200	Time is Now + 60.
 1201last_modified(Time) :-
 1202	with_mutex(gitty_last_modified,
 1203		   last_modified_sync(Time)).
 1204
 1205last_modified_sync(Time) :-
 1206	(   gitty_last_modified(Time)
 1207	->  true
 1208	;   statistics(process_epoch, Time)
 1209	).
 1210
 1211:- unlisten(swish(_)),
 1212   listen(swish(Event), notify_event(Event)). 1213
 1214% events on gitty files
 1215notify_event(updated(File, Commit)) :-
 1216    atom_concat('gitty:', File, DocID),
 1217    update_last_modified(Commit, DocID).
 1218notify_event(deleted(File, Commit)) :-
 1219    atom_concat('gitty:', File, DocID),
 1220    update_last_modified(Commit, DocID).
 1221notify_event(created(File, Commit)) :-
 1222    atom_concat('gitty:', File, DocID),
 1223    update_last_modified(Commit, DocID).
 1224
 1225
 1226		 /*******************************
 1227		 *	      MESSAGES		*
 1228		 *******************************/
 1229
 1230:- multifile prolog:message//1. 1231
 1232prolog:message(moved_old_store(Old, New)) -->
 1233	[ 'Moving SWISH file store from ~p to ~p'-[Old, New] ]