View source with raw comments or as raw
    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(:, +).

Store files on behalve of web clients

The file store needs to deal with versioning and meta-data. This is achieved using gitty.pl, a git-like content-base store that lacks git's notion of a tree. I.e., all files are considered individual and have their own version. */

   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), !.
 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.
  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).
 update_error(+Error, +Storage, +Data, +File, +URL)
If error signals an edit conflict, prepare an HTTP 409 Conflict page
  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)) :- !.
 follow(+Commit, +SaveDict) is det
Broadcast follow(DocID, ProfileID, [update,chat]) if the user wishes to follow the file associated with Commit.
  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(_, _).
 request_file(+Request, +GittyDir, -File) is det
Extract the gitty file referenced from the HTTP Request.
Errors
- HTTP 404 exception
  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).
 meta_data(+Dict, -Meta, +Options) is det
 meta_data(+Store, +Dict, -PrevMeta, -Meta, +Options) is det
Gather meta-data from the Request (user, peer, identity) and provided meta-data. Illegal and unknown values are ignored.

The meta_data/5 version is used to add information about a fork.

Arguments:
Dict- represents the JSON document posted and contains the content (data) and meta data (meta).
  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:_}).
 storage_get(+Request, +Format, +Options) is det
HTTP handler that returns information a given gitty file.
Arguments:
Format- is one of
swish
Serve file embedded in a SWISH application
raw
Serve the raw file
json
Return a JSON object with the keys data and meta
history(Depth, IncludeHASH)
Return a JSON description with the change log
diff(RelTo)
Reply with diff relative to RelTo. Default is the previous commit.
  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	).
 gitty_data_or_default(+Dir, +Type, +FileOrHash, -Code, -Meta)
Read a file from the gitty store. I the file is not present, a default may be provided gitty/File in the config directory.
  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			   ]).
 chat_count(+Meta, -ChatCount) is det
True when ChatCount is the number of chat messages available about Meta.
  512chat_count(Meta, Chats) :-
  513	atom_concat('gitty:', Meta.get(name), DocID),
  514	swish_config:chat_count_about(DocID, Chats), !.
  515chat_count(_, 0).
 random_filename(-Name) is det
Return a random file name from plain nice ASCII characters.
  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).
 swish_show(+Options, +Request)
Hande a document. First calls the hook open_hook/2 to rewrite the document. This is used for e.g., permahashes.
  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		 *******************************/
 storage_file(?File) is nondet
! storage_file_extension(?File, ?Extension) is nondet. % storage_file(+File, -Data, -Meta) is semidet. % storage_meta_data(+File, -Meta) is semidet.
True if File is known in the store.

@arg Data is a string holding the content of the file
@arg Meta is a dict holding the meta data about the file.
  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).
 storage_meta_property(+Meta, -Property)
True when Meta has Property. Defined properties are:
peer(Atom)
Peer address that last saved the file -
  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).
 storage_store_term(+Term, -Hash) is det
 storage_load_term(+Hash, -Term) is det
Add/retrieve terms from the gitty store. This is used to create permanent links to arbitrary objects.
  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		 *******************************/
 use_gitty_file(+File) is det
 use_gitty_file(+File, +Options) is det
Load a file from the Gitty store. Options are passed to load_files/2. Additional options are:
watch(+Boolean)
If true (default), reload the file if the user saves it.
  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		 *******************************/
 collect_messages_as_json(+Goal, -Messages)
Run Goal, collecting messages as produced by print_message/2 in Messages as JSON terms.
  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		 *******************************/
 storage_fsck
Enumerate and check the consistency of the entire store.
  772storage_fsck :-
  773	open_gittystore(Dir),
  774	gitty_fsck(Dir).
 storage_repack is det
 storage_repack(+Options) is det
Repack the storage directory. Currently only supports the files driver. For database drivers this is supposed to be handled by the database.
  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	).
 storage_unpack
Unpack all packed objects of the store. Currently only supports the files driver. For database drivers this is supposed to be handled by the database.
  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
 swish_search:typeahead(+Set, +Query, -Match, +Options) is nondet
Find files using typeahead from the SWISH search box. This version defines the following sets:
To be done
- caching?
- We should only demand public on public servers.
  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		 *******************************/
 source_list(+Request)
List source files. Request parameters:
q(Query)
Query is a string for which the following sub strings are treated special:
"..."
A quoted string is taken as a string search $ /.../[xim]* Regular expression search
tag:Tag
Must have tag containing
type:Type
Limit to one of pl, swinb or lnk
user:User
Must have user containing. If User is me must be owned by current user
name:Name
Must have name containing
o(Order)
Order by time (default), name, author or type
offset(+Offset)
limit(+Limit)
display_name
avatar
Weak identity parameters used to identify own documents that are also weakly identified.

Reply is a JSON object containing count (total matches), cpu (CPU time) and matches (list of matching sources)

To be done
- Search the content when searching a .lnk file?
- Speedup expensive searches. Cache? Use external DB?
  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).
 visible(+FileMeta, +Auth, +MetaConstraints) is semidet
  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, _).
 owns(+Auth, +Meta, ?How) is semidet
True if the file represented by Meta is owned by the user identified as Auth. If this is a strong identity we must give a strong answer.
To be done
- Weaker identity on the basis of author, avatar properties and/or IP properties.
 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	).
 matches_meta(+Source, +Auth, +Query) is semidet
True when Source matches the meta-data requirements
 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).
 type_constraint(+Query0, -Query, -Type) is det
Extract the type constraints from the query as we can handle that efficiently.
 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(_)).
 parse_query(+String, -Query) is det
Parse a query, resulting in a list of Name(Value) pairs. Name is one of tag, user, type, string or regex.
To be done
- : Should we allow for logical combinations?
 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		 *******************************/
 source_modified(+Request)
Reply with the last modification time of the source repo. If there is no modification we use the time the server was started.

This is a poor men's solution to keep the client cache consistent. Need to think about a better way to cache searches client and/or server side.

 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] ]