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-2017, VU University Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(web_storage,
   36	  [ storage_file/1,			% ?File
   37	    storage_file/3,			% +File, -Data, -Meta
   38	    storage_meta_data/2,		% +File, -Meta
   39	    storage_meta_property/2	        % +Meta, ?Property
   40	  ]).   41:- use_module(library(http/http_dispatch)).   42:- use_module(library(http/http_parameters)).   43:- use_module(library(http/http_json)).   44:- use_module(library(http/mimetype)).   45:- use_module(library(lists)).   46:- use_module(library(settings)).   47:- use_module(library(random)).   48:- use_module(library(apply)).   49:- use_module(library(option)).   50:- use_module(library(debug)).   51:- use_module(library(broadcast)).   52:- use_module(library(readutil)).   53:- use_module(library(solution_sequences)).   54
   55:- use_module(page).   56:- use_module(gitty).   57:- use_module(patch).   58:- use_module(config).   59:- use_module(search).   60:- use_module(authenticate).   61:- use_module(pep).

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. */

   71:- setting(directory, callable, data(storage),
   72	   'The directory for storing files.').   73
   74:- http_handler(swish('p/'), web_storage, [ id(web_storage), prefix ]).   75
   76:- initialization open_gittystore.		% TBD: make this lazy?
   77
   78:- dynamic  storage_dir/1.   79:- volatile storage_dir/1.   80
   81open_gittystore :-
   82	storage_dir(_), !.
   83open_gittystore :-
   84	setting(directory, Spec),
   85	absolute_file_name(Spec, Dir,
   86			   [ file_type(directory),
   87			     access(write),
   88			     file_errors(fail)
   89			   ]), !,
   90	gitty_open(Dir, []),
   91	asserta(storage_dir(Dir)).
   92open_gittystore :-
   93	setting(directory, Spec),
   94	absolute_file_name(Spec, Dir,
   95			   [ solutions(all)
   96			   ]),
   97	\+ exists_directory(Dir),
   98	create_store(Dir), !,
   99	gitty_open(Dir, []),
  100	asserta(storage_dir(Dir)).
  101
  102create_store(Dir) :-
  103	exists_directory('storage/ref'), !,
  104	print_message(informational, moved_old_store(storage, Dir)),
  105	rename_file(storage, Dir).
  106create_store(Dir) :-
  107	catch(make_directory(Dir),
  108	      error(permission_error(create, directory, Dir), _),
  109	      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.
  119web_storage(Request) :-
  120	authenticate(Request, Auth),
  121	option(method(Method), Request),
  122	storage(Method, Request, [identity(Auth)]).
  123
  124:- multifile
  125	swish_config:authenticate/2,
  126	swish_config:chat_count_about/2,
  127	swish_config:user_profile/2.		% +Request, -Profile
  128
  129storage(get, Request, Options) :-
  130	http_parameters(Request,
  131			[ format(Fmt,  [ oneof([swish,raw,json,history,diff]),
  132					 default(swish),
  133					 description('How to render')
  134				       ]),
  135			  depth(Depth, [ default(5),
  136					 integer,
  137					 description('History depth')
  138				       ]),
  139			  to(RelTo,    [ optional(true),
  140					 description('Diff relative to')
  141				       ])
  142			]),
  143	(   Fmt == history
  144	->  (   nonvar(RelTo)
  145	    ->	Format = history(Depth, RelTo)
  146	    ;	Format = history(Depth)
  147	    )
  148	;   Fmt == diff
  149	->  Format = diff(RelTo)
  150	;   Format = Fmt
  151	),
  152	storage_get(Request, Format, Options).
  153
  154storage(post, Request, Options) :-
  155	http_read_json_dict(Request, Dict),
  156	option(data(Data), Dict, ""),
  157	option(type(Type), Dict, pl),
  158	storage_dir(Dir),
  159	meta_data(Dir, Dict, _, Meta, Options),
  160	(   atom_string(Base, Dict.get(meta).get(name))
  161	->  file_name_extension(Base, Type, File),
  162	    (	authorized(gitty(create(File,named,Meta)), Options),
  163		catch(gitty_create(Dir, File, Data, Meta, Commit),
  164		      error(gitty(file_exists(File)),_),
  165		      fail)
  166	    ->	true
  167	    ;	Error = json{error:file_exists,
  168			     file:File}
  169	    )
  170	;   (   repeat,
  171	        random_filename(Base),
  172		file_name_extension(Base, Type, File),
  173		authorized(gitty(create(File,random,Meta)), Options),
  174		catch(gitty_create(Dir, File, Data, Meta, Commit),
  175		      error(gitty(file_exists(File)),_),
  176		      fail)
  177	    ->  true
  178	    )
  179	),
  180	(   var(Error)
  181	->  debug(storage, 'Created: ~p', [Commit]),
  182	    storage_url(File, URL),
  183
  184	    broadcast(swish(created(File, Commit))),
  185	    follow(Commit, Dict),
  186	    reply_json_dict(json{url:URL,
  187				 file:File,
  188				 meta:Commit.put(symbolic, "HEAD")
  189				})
  190	;   reply_json_dict(Error)
  191	).
  192storage(put, Request, Options) :-
  193	http_read_json_dict(Request, Dict),
  194	storage_dir(Dir),
  195	request_file(Request, Dir, File),
  196	(   Dict.get(update) == "meta-data"
  197	->  gitty_data(Dir, File, Data, _OldMeta)
  198	;   option(data(Data), Dict, "")
  199	),
  200	meta_data(Dir, Dict, PrevMeta, Meta, Options),
  201	storage_url(File, URL),
  202	authorized(gitty(update(File,PrevMeta,Meta)), Options),
  203	catch(gitty_update(Dir, File, Data, Meta, Commit),
  204	      Error,
  205	      true),
  206	(   var(Error)
  207	->  debug(storage, 'Updated: ~p', [Commit]),
  208	    broadcast(swish(updated(File, Commit))),
  209	    follow(Commit, Dict),
  210	    reply_json_dict(json{ url:URL,
  211				  file:File,
  212				  meta:Commit.put(symbolic, "HEAD")
  213				})
  214	;   update_error(Error, Dir, Data, File, URL)
  215	).
  216storage(delete, Request, Options) :-
  217	storage_dir(Dir),
  218	meta_data(Dir, _{}, PrevMeta, Meta, Options),
  219	request_file(Request, Dir, File),
  220	authorized(gitty(delete(File,PrevMeta)), Options),
  221	gitty_update(Dir, File, "", Meta, Commit),
  222	broadcast(swish(deleted(File, Commit))),
  223	reply_json_dict(true).
 update_error(+Error, +Storage, +Data, +File, +URL)
If error signals an edit conflict, prepare an HTTP 409 Conflict page
  230update_error(error(gitty(commit_version(_, Head, Previous)), _),
  231	     Dir, Data, File, URL) :- !,
  232	gitty_diff(Dir, Previous, Head, OtherEdit),
  233	gitty_diff(Dir, Previous, data(Data), MyEdits),
  234	Status0 = json{url:URL,
  235		       file:File,
  236		       error:edit_conflict,
  237		       edit:_{server:OtherEdit,
  238			      me:MyEdits}
  239		      },
  240	(   OtherDiff = OtherEdit.get(data)
  241	->  PatchOptions = [status(_), stderr(_)],
  242	    patch(Data, OtherDiff, Merged, PatchOptions),
  243	    Status1 = Status0.put(merged, Merged),
  244	    foldl(patch_status, PatchOptions, Status1, Status)
  245	;   Status = Status0
  246	),
  247	reply_json_dict(Status, [ status(409) ]).
  248update_error(Error, _Dir, _Data, _File, _URL) :-
  249	throw(Error).
  250
  251patch_status(status(exit(0)), Dict, Dict) :- !.
  252patch_status(status(exit(Status)), Dict, Dict.put(patch_status, Status)) :- !.
  253patch_status(status(killed(Signal)), Dict, Dict.put(patch_killed, Signal)) :- !.
  254patch_status(stderr(""), Dict, Dict) :- !.
  255patch_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.
  262follow(Commit, Dict) :-
  263	Dict.get(meta).get(follow) == true,
  264	_{name:File, profile_id:ProfileID} :< Commit, !,
  265	atom_concat('gitty:', File, DocID),
  266	broadcast(swish(follow(DocID, ProfileID, [update,chat]))).
  267follow(_, _).
 request_file(+Request, +GittyDir, -File) is det
Extract the gitty file referenced from the HTTP Request.
Errors
- HTTP 404 exception
  275request_file(Request, Dir, File) :-
  276	option(path_info(File), Request),
  277	(   gitty_file(Dir, File, _Hash)
  278	->  true
  279	;   http_404([], Request)
  280	).
  281
  282storage_url(File, HREF) :-
  283	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).
  296meta_data(Dict, Meta, Options) :-
  297	option(identity(Auth), Options),
  298	(   _ = Auth.get(identity)
  299	->  HasIdentity = true
  300	;   HasIdentity = false
  301	),
  302	filter_auth(Auth, Auth1),
  303	(   filter_meta(Dict.get(meta), HasIdentity, Meta1)
  304	->  Meta = meta{}.put(Auth1).put(Meta1)
  305	;   Meta = meta{}.put(Auth1)
  306	).
  307
  308meta_data(Store, Dict, PrevMeta, Meta, Options) :-
  309	meta_data(Dict, Meta1, Options),
  310	(   atom_string(Previous, Dict.get(previous)),
  311	    is_gitty_hash(Previous),
  312	    gitty_commit(Store, Previous, PrevMeta)
  313	->  Meta = Meta1.put(previous, Previous)
  314	;   Meta = Meta1
  315	).
  316
  317filter_meta(Dict0, HasID, Dict) :-
  318	dict_pairs(Dict0, Tag, Pairs0),
  319	filter_pairs(Pairs0, HasID, Pairs),
  320	dict_pairs(Dict, Tag, Pairs).
  321
  322filter_pairs([], _, []).
  323filter_pairs([K-V0|T0], HasID, [K-V|T]) :-
  324	meta_allowed(K, HasID, Type),
  325	filter_type(Type, V0, V), !,
  326	filter_pairs(T0, HasID, T).
  327filter_pairs([_|T0], HasID, T) :-
  328	filter_pairs(T0, HasID, T).
  329
  330meta_allowed(public,	     _,	    boolean).
  331meta_allowed(example,	     _,	    boolean).
  332meta_allowed(author,	     _,	    string).
  333meta_allowed(avatar,	     false, string).
  334meta_allowed(email,	     _,	    string).
  335meta_allowed(title,	     _,	    string).
  336meta_allowed(tags,	     _,	    list(string)).
  337meta_allowed(description,    _,	    string).
  338meta_allowed(commit_message, _,	    string).
  339meta_allowed(modify,	     _,	    list(atom)).
  340
  341filter_type(Type, V, V) :-
  342	is_of_type(Type, V), !.
  343filter_type(list(Type), V0, V) :-
  344	is_list(V0),
  345	maplist(filter_type(Type), V0, V).
  346filter_type(atom, V0, V) :-
  347	atomic(V0),
  348	atom_string(V, V0).
  349
  350filter_auth(Auth0, Auth) :-
  351	auth_template(Auth),
  352	Auth :< Auth0, !.
  353filter_auth(Auth, Auth).
  354
  355auth_template(_{identity:_, profile_id:_}).
  356auth_template(_{profile_id:_}).
  357auth_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.
  378storage_get(Request, swish, Options) :-
  379	swish_reply_config(Request, Options), !.
  380storage_get(Request, Format, Options) :-
  381	storage_dir(Dir),
  382	request_file_or_hash(Request, Dir, FileOrHash, Type),
  383	Obj =.. [Type,FileOrHash],
  384	authorized(gitty(download(Obj, Format)), Options),
  385	storage_get(Format, Dir, Type, FileOrHash, Request),
  386	broadcast(swish(download(Dir, FileOrHash, Format))).
  387
  388storage_get(swish, Dir, Type, FileOrHash, Request) :-
  389	gitty_data_or_default(Dir, Type, FileOrHash, Code, Meta),
  390	chat_count(Meta, Count),
  391	swish_reply([ code(Code),
  392		      file(FileOrHash),
  393		      st_type(gitty),
  394		      meta(Meta),
  395		      chat_count(Count)
  396		    ],
  397		    Request).
  398storage_get(raw, Dir, Type, FileOrHash, _Request) :-
  399	gitty_data_or_default(Dir, Type, FileOrHash, Code, Meta),
  400	file_mime_type(Meta.name, MIME),
  401	format('Content-type: ~w~n~n', [MIME]),
  402	format('~s', [Code]).
  403storage_get(json, Dir, Type, FileOrHash, _Request) :-
  404	gitty_data_or_default(Dir, Type, FileOrHash, Code, Meta),
  405	chat_count(Meta, Count),
  406	reply_json_dict(json{data:Code, meta:Meta, chats:_{count:Count}}).
  407storage_get(history(Depth, Includes), Dir, _, File, _Request) :-
  408	gitty_history(Dir, File, History, [depth(Depth),includes(Includes)]),
  409	reply_json_dict(History).
  410storage_get(history(Depth), Dir, _, File, _Request) :-
  411	gitty_history(Dir, File, History, [depth(Depth)]),
  412	reply_json_dict(History).
  413storage_get(diff(RelTo), Dir, _, File, _Request) :-
  414	gitty_diff(Dir, RelTo, File, Diff),
  415	reply_json_dict(Diff).
  416
  417request_file_or_hash(Request, Dir, FileOrHash, Type) :-
  418	option(path_info(FileOrHash), Request),
  419	(   gitty_file(Dir, FileOrHash, _Hash)
  420	->  Type = file
  421	;   is_gitty_hash(FileOrHash)
  422	->  Type = hash
  423	;   gitty_default_file(FileOrHash, _)
  424	->  Type = default
  425	;   http_404([], Request)
  426	).
 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.
  433gitty_data_or_default(_, default, File, Code,
  434		      meta{name:File,
  435			   modify:[login,owner],
  436			   default:true,
  437			   chat:"large"
  438			  }) :- !,
  439	gitty_default_file(File, Path),
  440	read_file_to_string(Path, Code, []).
  441gitty_data_or_default(Dir, _, FileOrHash, Code, Meta) :-
  442	gitty_data(Dir, FileOrHash, Code, Meta), !.
  443
  444gitty_default_file(File, Path) :-
  445	file_name_extension(Base, Ext, File),
  446	memberchk(Ext, [pl,swinb]),
  447	forall(sub_atom(Base, _, 1, _, C),
  448	       char_type(C, csym)),
  449	absolute_file_name(config(gitty/File), Path,
  450			   [ access(read),
  451			     file_errors(fail)
  452			   ]).
 chat_count(+Meta, -ChatCount) is det
True when ChatCount is the number of chat messages available about Meta.
  460chat_count(Meta, Chats) :-
  461	atom_concat('gitty:', Meta.get(name), DocID),
  462	swish_config:chat_count_about(DocID, Chats), !.
  463chat_count(_, 0).
 random_filename(-Name) is det
Return a random file name from plain nice ASCII characters.
  470random_filename(Name) :-
  471	length(Chars, 8),
  472	maplist(random_char, Chars),
  473	atom_chars(Name, Chars).
  474
  475from('abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ').
  476
  477random_char(Char) :-
  478	from(From),
  479	atom_length(From, Len),
  480	Max is Len - 1,
  481	random_between(0, Max, I),
  482	sub_atom(From, I, 1, _, Char).
  483
  484
  485		 /*******************************
  486		 *	    INTERFACE		*
  487		 *******************************/
 storage_file(?File) is semidet
 storage_file(+File, -Data, -Meta) is semidet
 storage_meta_data(+File, -Meta) is semidet
True if File is known in the store.
Arguments:
Data- is a string holding the content of the file
Meta- is a dict holding the meta data about the file.
  498storage_file(File) :-
  499	storage_dir(Dir),
  500	gitty_file(Dir, File, _Head).
  501
  502storage_file(File, Data, Meta) :-
  503	storage_dir(Dir),
  504	gitty_data(Dir, File, Data, Meta).
  505
  506storage_meta_data(File, Meta) :-
  507	storage_dir(Dir),
  508	(   var(File)
  509	->  gitty_file(Dir, File, _Head)
  510	;   true
  511	),
  512	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 -
  522storage_meta_property(Meta, Property) :-
  523	current_meta_property(Property, How),
  524	meta_property(Property, How, Meta).
  525
  526meta_property(Property, dict, Identity) :-
  527	Property =.. [Name,Value],
  528	Value = Identity.get(Name).
  529meta_property(modify(Modify), _, Meta) :-
  530	(   Modify0 = Meta.get(modify)
  531	->  Modify = Modify0
  532	;   Modify = [any,login,owner]
  533	).
  534
  535current_meta_property(peer(_Atom),     dict).
  536current_meta_property(public(_Bool),   dict).
  537current_meta_property(time(_Seconds),  dict).
  538current_meta_property(author(_String), dict).
  539current_meta_property(avatar(_String), dict).
  540current_meta_property(modify(_List),   derived).
  541
  542
  543		 /*******************************
  544		 *	 SEARCH SUPPORT		*
  545		 *******************************/
  546
  547:- multifile
  548	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.
  563swish_search:typeahead(file, Query, FileInfo, _Options) :-
  564	storage_dir(Dir),
  565	gitty_file(Dir, File, Head),
  566	gitty_commit(Dir, Head, Meta),
  567	Meta.get(public) == true,
  568	(   sub_atom(File, 0, _, _, Query) % find only public
  569	->  true
  570	;   meta_match_query(Query, Meta)
  571	->  true
  572	),
  573	FileInfo = Meta.put(_{type:"store", file:File}).
  574
  575meta_match_query(Query, Meta) :-
  576	member(Tag, Meta.get(tags)),
  577	sub_atom(Tag, 0, _, _, Query).
  578meta_match_query(Query, Meta) :-
  579	sub_atom(Meta.get(author), 0, _, _, Query).
  580meta_match_query(Query, Meta) :-
  581	Title = Meta.get(title),
  582	sub_atom_icasechk(Title, Start, Query),
  583	(   Start =:= 0
  584	->  true
  585	;   Before is Start-1,
  586	    sub_atom(Title, Before, 1, _, C),
  587	    \+ char_type(C, csym)
  588	).
  589
  590swish_search:typeahead(store_content, Query, FileInfo, Options) :-
  591	limit(25, search_store_content(Query, FileInfo, Options)).
  592
  593search_store_content(Query, FileInfo, Options) :-
  594	storage_dir(Dir),
  595	gitty_file(Dir, File, Head),
  596	gitty_data(Dir, Head, Data, Meta),
  597	Meta.get(public) == true,
  598	limit(5, search_file(File, Meta, Data, Query, FileInfo, Options)).
  599
  600search_file(File, Meta, Data, Query, FileInfo, Options) :-
  601	split_string(Data, "\n", "\r", Lines),
  602	nth1(LineNo, Lines, Line),
  603	match(Line, Query, Options),
  604	FileInfo = Meta.put(_{type:"store", file:File,
  605			      line:LineNo, text:Line, query:Query
  606			     }).
  607
  608		 /*******************************
  609		 *	      MESSAGES		*
  610		 *******************************/
  611
  612:- multifile prolog:message//1.  613
  614prolog:message(moved_old_store(Old, New)) -->
  615	[ 'Moving SWISH file store from ~p to ~p'-[Old, New] ]