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

   95:- setting(directory, callable, data(storage),
   96           'The directory for storing files.').   97
   98:- http_handler(swish('p/'),
   99                web_storage,
  100                [ id(web_storage), prefix ]).  101:- http_handler(swish('source_list'),
  102                source_list,
  103                [ id(source_list) ]).  104:- http_handler(swish('source_modified'),
  105                source_modified,
  106                [ id(source_modified) ]).  107
  108:- listen(http(pre_server_start),
  109          open_gittystore(_)).  110
  111:- dynamic  storage_dir/1.  112:- volatile storage_dir/1.  113
  114open_gittystore(Dir0) :-
  115    storage_dir(Dir),
  116    !,
  117    Dir = Dir0.
  118open_gittystore(Dir) :-
  119    with_mutex(web_storage, open_gittystore_guarded(Dir0)),
  120    Dir = Dir0.
  121
  122open_gittystore_guarded(Dir) :-
  123    storage_dir(Dir),
  124    !.
  125open_gittystore_guarded(Dir) :-
  126    setting(directory, Spec),
  127    absolute_file_name(Spec, Dir,
  128                       [ file_type(directory),
  129                         access(write),
  130                         file_errors(fail)
  131                       ]),
  132    !,
  133    gitty_open_options(Options),
  134    gitty_open(Dir, Options),
  135    asserta(storage_dir(Dir)).
  136open_gittystore_guarded(Dir) :-
  137    setting(directory, Spec),
  138    absolute_file_name(Spec, Dir,
  139                       [ solutions(all)
  140                       ]),
  141    \+ exists_directory(Dir),
  142    create_store(Dir),
  143    !,
  144    gitty_open_options(Options),
  145    gitty_open(Dir, Options),
  146    asserta(storage_dir(Dir)).
  147
  148create_store(Dir) :-
  149    exists_directory('storage/ref'),
  150    !,
  151    print_message(informational, moved_old_store(storage, Dir)),
  152    rename_file(storage, Dir).
  153create_store(Dir) :-
  154    catch(make_directory(Dir),
  155          error(permission_error(create, directory, Dir), _),
  156          fail),
  157    !.
  158
  159gitty_open_options(Options) :-
  160    swish_config(redis, DB),
  161    !,
  162    (   swish_config(redis_prefix, Prefix)
  163    ->  Options = [ redis(DB),
  164                    redis_prefix(Prefix)
  165                  ]
  166    ;   Options = [ redis(DB)
  167                  ]
  168    ).
  169gitty_open_options([]).
 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.
  179web_storage(Request) :-
  180    memberchk(method(options), Request),
  181    !,
  182    cors_enable(Request,
  183                [ methods([get,post,put,delete])
  184                ]),
  185    format('~n').
  186web_storage(Request) :-
  187    cors_enable(Request,
  188                [ methods([get,post,put,delete])
  189                ]),
  190    authenticate(Request, Auth),
  191    option(method(Method), Request),
  192    open_gittystore(_),
  193    storage(Method, Request, [identity(Auth)]).
  194
  195:- multifile
  196    swish_config:authenticate/2,
  197    swish_config:chat_count_about/2,
  198    swish_config:user_profile/2.            % +Request, -Profile
  199
  200storage(get, Request, Options) :-
  201    http_parameters(Request,
  202                    [ format(Fmt,  [ oneof([swish,raw,json,history,diff]),
  203                                     default(swish),
  204                                     description('How to render')
  205                                   ]),
  206                      depth(Depth, [ default(5),
  207                                     integer,
  208                                     description('History depth')
  209                                   ]),
  210                      to(RelTo,    [ optional(true),
  211                                     description('Diff relative to')
  212                                   ])
  213                    ]),
  214    (   Fmt == history
  215    ->  (   nonvar(RelTo)
  216        ->  Format = history(Depth, RelTo)
  217        ;   Format = history(Depth)
  218        )
  219    ;   Fmt == diff
  220    ->  Format = diff(RelTo)
  221    ;   Format = Fmt
  222    ),
  223    storage_get(Request, Format, Options).
  224
  225storage(post, Request, Options) :-
  226    http_read_json_dict(Request, Dict),
  227    option(data(Data), Dict, ""),
  228    option(type(Type), Dict, pl),
  229    storage_dir(Dir),
  230    meta_data(Dir, Dict, _, Meta, Options),
  231    (   atom_string(Base, Dict.get(meta).get(name))
  232    ->  file_name_extension(Base, Type, File),
  233        (   authorized(gitty(create(File,named,Meta)), Options),
  234            catch(gitty_create(Dir, File, Data, Meta, Commit),
  235                  error(gitty(file_exists(File)),_),
  236                  fail)
  237        ->  true
  238        ;   Error = json{error:file_exists,
  239                         file:File}
  240        )
  241    ;   (   repeat,
  242            random_filename(Base),
  243            file_name_extension(Base, Type, File),
  244            authorized(gitty(create(File,random,Meta)), Options),
  245            catch(gitty_create(Dir, File, Data, Meta, Commit),
  246                  error(gitty(file_exists(File)),_),
  247                  fail)
  248        ->  true
  249        )
  250    ),
  251    (   var(Error)
  252    ->  debug(storage, 'Created: ~p', [Commit]),
  253        storage_url(File, URL),
  254
  255        broadcast(swish(created(File, Commit))),
  256        follow(Commit, Dict),
  257        reply_json_dict(json{url:URL,
  258                             file:File,
  259                             meta:Commit.put(symbolic, "HEAD")
  260                            })
  261    ;   reply_json_dict(Error)
  262    ).
  263storage(put, Request, Options) :-
  264    http_read_json_dict(Request, Dict),
  265    storage_dir(Dir),
  266    request_file(Request, Dir, File),
  267    (   Dict.get(update) == "meta-data"
  268    ->  gitty_data(Dir, File, Data, _OldMeta)
  269    ;   writeable(File)
  270    ->  option(data(Data), Dict, "")
  271    ;   option(path(Path), Request),
  272        throw(http_reply(forbidden(Path)))
  273    ),
  274    meta_data(Dir, Dict, PrevMeta, Meta, Options),
  275    storage_url(File, URL),
  276    authorized(gitty(update(File,PrevMeta,Meta)), Options),
  277    catch(gitty_update(Dir, File, Data, Meta, Commit),
  278          Error,
  279          true),
  280    (   var(Error)
  281    ->  debug(storage, 'Updated: ~p', [Commit]),
  282        collect_messages_as_json(
  283            broadcast(swish(updated(File, Commit))),
  284            Messages),
  285        debug(gitty(load), 'Messages: ~p', [Messages]),
  286        follow(Commit, Dict),
  287        reply_json_dict(json{ url:URL,
  288                              file:File,
  289                              meta:Commit.put(symbolic, "HEAD"),
  290                              messages:Messages
  291                            })
  292    ;   update_error(Error, Dir, Data, File, URL)
  293    ).
  294storage(delete, Request, Options) :-
  295    storage_dir(Dir),
  296    meta_data(Dir, _{}, PrevMeta, Meta, Options),
  297    request_file(Request, Dir, File),
  298    authorized(gitty(delete(File,PrevMeta)), Options),
  299    gitty_update(Dir, File, "", Meta, Commit),
  300    broadcast(swish(deleted(File, Commit))),
  301    reply_json_dict(true).
  302
  303writeable(File) :-
  304    \+ file_name_extension(_, lnk, File).
 update_error(+Error, +Storage, +Data, +File, +URL)
If error signals an edit conflict, prepare an HTTP 409 Conflict page
  311update_error(error(gitty(commit_version(_, Head, Previous)), _),
  312             Dir, Data, File, URL) :-
  313    !,
  314    gitty_diff(Dir, Previous, Head, OtherEdit),
  315    gitty_diff(Dir, Previous, data(Data), MyEdits),
  316    Status0 = json{url:URL,
  317                   file:File,
  318                   error:edit_conflict,
  319                   edit:_{server:OtherEdit,
  320                          me:MyEdits}
  321                  },
  322    (   OtherDiff = OtherEdit.get(data)
  323    ->  PatchOptions = [status(_), stderr(_)],
  324        patch(Data, OtherDiff, Merged, PatchOptions),
  325        Status1 = Status0.put(merged, Merged),
  326        foldl(patch_status, PatchOptions, Status1, Status)
  327    ;   Status = Status0
  328    ),
  329    reply_json_dict(Status, [ status(409) ]).
  330update_error(Error, _Dir, _Data, _File, _URL) :-
  331    throw(Error).
  332
  333patch_status(status(exit(0)), Dict, Dict) :- !.
  334patch_status(status(exit(Status)), Dict, Dict.put(patch_status, Status)) :- !.
  335patch_status(status(killed(Signal)), Dict, Dict.put(patch_killed, Signal)) :- !.
  336patch_status(stderr(""), Dict, Dict) :- !.
  337patch_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.
  344follow(Commit, Dict) :-
  345    Dict.get(meta).get(follow) == true,
  346    _{name:File, profile_id:ProfileID} :< Commit,
  347    !,
  348    atom_concat('gitty:', File, DocID),
  349    broadcast(swish(follow(DocID, ProfileID, [update,chat]))).
  350follow(_, _).
 request_file(+Request, +GittyDir, -File) is det
Extract the gitty file referenced from the HTTP Request.
Errors
- HTTP 404 exception
  358request_file(Request, Dir, File) :-
  359    option(path_info(File), Request),
  360    (   gitty_file(Dir, File, _Hash)
  361    ->  true
  362    ;   http_404([], Request)
  363    ).
  364
  365storage_url(File, HREF) :-
  366    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).
  379meta_data(Dict, Meta, Options) :-
  380    option(identity(Auth), Options),
  381    (   _ = Auth.get(identity)
  382    ->  HasIdentity = true
  383    ;   HasIdentity = false
  384    ),
  385    filter_auth(Auth, Auth1),
  386    (   filter_meta(Dict.get(meta), HasIdentity, Meta1)
  387    ->  Meta = meta{}.put(Auth1).put(Meta1)
  388    ;   Meta = meta{}.put(Auth1)
  389    ).
  390
  391meta_data(Store, Dict, PrevMeta, Meta, Options) :-
  392    meta_data(Dict, Meta1, Options),
  393    (   atom_string(Previous, Dict.get(previous)),
  394        is_gitty_hash(Previous),
  395        gitty_commit(Store, Previous, PrevMeta)
  396    ->  Meta = Meta1.put(previous, Previous)
  397    ;   Meta = Meta1
  398    ).
  399
  400filter_meta(Dict0, HasID, Dict) :-
  401    dict_pairs(Dict0, Tag, Pairs0),
  402    filter_pairs(Pairs0, HasID, Pairs),
  403    dict_pairs(Dict, Tag, Pairs).
  404
  405filter_pairs([], _, []).
  406filter_pairs([K-V0|T0], HasID, [K-V|T]) :-
  407    meta_allowed(K, HasID, Type),
  408    filter_type(Type, V0, V),
  409    !,
  410    filter_pairs(T0, HasID, T).
  411filter_pairs([_|T0], HasID, T) :-
  412    filter_pairs(T0, HasID, T).
  413
  414meta_allowed(public,         _,     boolean).
  415meta_allowed(example,        _,     boolean).
  416meta_allowed(author,         _,     string).
  417meta_allowed(avatar,         false, string).
  418meta_allowed(email,          _,     string).
  419meta_allowed(title,          _,     string).
  420meta_allowed(tags,           _,     list(string)).
  421meta_allowed(description,    _,     string).
  422meta_allowed(commit_message, _,     string).
  423meta_allowed(modify,         _,     list(atom)).
  424
  425filter_type(Type, V, V) :-
  426    is_of_type(Type, V),
  427    !.
  428filter_type(list(Type), V0, V) :-
  429    is_list(V0),
  430    maplist(filter_type(Type), V0, V).
  431filter_type(atom, V0, V) :-
  432    atomic(V0),
  433    atom_string(V, V0).
  434
  435filter_auth(Auth0, Auth) :-
  436    auth_template(Auth),
  437    Auth :< Auth0,
  438    !.
  439filter_auth(Auth, Auth).
  440
  441auth_template(_{identity:_, profile_id:_}).
  442auth_template(_{profile_id:_}).
  443auth_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.
  464storage_get(Request, swish, Options) :-
  465    swish_reply_config(Request, Options),
  466    !.
  467storage_get(Request, Format, Options) :-
  468    storage_dir(Dir),
  469    request_file_or_hash(Request, Dir, FileOrHash, Type),
  470    Obj =.. [Type,FileOrHash],
  471    authorized(gitty(download(Obj, Format)), Options),
  472    storage_get(Format, Dir, Type, FileOrHash, Request),
  473    broadcast(swish(download(Dir, FileOrHash, Format))).
  474
  475storage_get(swish, Dir, Type, FileOrHash, Request) :-
  476    gitty_data_or_default(Dir, Type, FileOrHash, Code, Meta),
  477    chat_count(Meta, Count),
  478    swish_show([ code(Code),
  479                 file(FileOrHash),
  480                 st_type(gitty),
  481                 meta(Meta),
  482                 chat_count(Count)
  483               ],
  484               Request).
  485storage_get(raw, Dir, Type, FileOrHash, _Request) :-
  486    gitty_data_or_default(Dir, Type, FileOrHash, Code, Meta),
  487    file_mime_type(Meta.name, MIME),
  488    format('Content-type: ~w~n~n', [MIME]),
  489    format('~s', [Code]).
  490storage_get(json, Dir, Type, FileOrHash, _Request) :-
  491    gitty_data_or_default(Dir, Type, FileOrHash, Code, Meta),
  492    chat_count(Meta, Count),
  493    JSON0 = json{data:Code, meta:Meta, chats:_{total:Count}},
  494    (   open_hook(json, JSON0, JSON)
  495    ->  true
  496    ;   JSON = JSON0
  497    ),
  498    reply_json_dict(JSON).
  499storage_get(history(Depth, Includes), Dir, _, File, _Request) :-
  500    gitty_history(Dir, File, History, [depth(Depth),includes(Includes)]),
  501    reply_json_dict(History).
  502storage_get(history(Depth), Dir, _, File, _Request) :-
  503    gitty_history(Dir, File, History, [depth(Depth)]),
  504    reply_json_dict(History).
  505storage_get(diff(RelTo), Dir, _, File, _Request) :-
  506    gitty_diff(Dir, RelTo, File, Diff),
  507    reply_json_dict(Diff).
  508
  509request_file_or_hash(Request, Dir, FileOrHash, Type) :-
  510    option(path_info(FileOrHash), Request),
  511    (   gitty_file(Dir, FileOrHash, _Hash)
  512    ->  Type = file
  513    ;   is_gitty_hash(FileOrHash)
  514    ->  Type = hash
  515    ;   gitty_default_file(FileOrHash, _)
  516    ->  Type = default
  517    ;   http_404([], Request)
  518    ).
 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.
  525gitty_data_or_default(_, default, File, Code,
  526                      meta{name:File,
  527                           modify:[login,owner],
  528                           default:true,
  529                           chat:"large"
  530                          }) :-
  531    !,
  532    gitty_default_file(File, Path),
  533    read_file_to_string(Path, Code, []).
  534gitty_data_or_default(Dir, _, FileOrHash, Code, Meta) :-
  535    gitty_data(Dir, FileOrHash, Code, Meta),
  536    !.
  537
  538gitty_default_file(File, Path) :-
  539    file_name_extension(Base, Ext, File),
  540    memberchk(Ext, [pl,swinb]),
  541    forall(sub_atom(Base, _, 1, _, C),
  542           char_type(C, csym)),
  543    absolute_file_name(config(gitty/File), Path,
  544                       [ access(read),
  545                         file_errors(fail)
  546                       ]).
 chat_count(+Meta, -ChatCount) is det
True when ChatCount is the number of chat messages available about Meta.
  554chat_count(Meta, Chats) :-
  555    atom_concat('gitty:', Meta.get(name), DocID),
  556    swish_config:chat_count_about(DocID, Chats),
  557    !.
  558chat_count(_, 0).
 random_filename(-Name) is det
Return a random file name from plain nice ASCII characters.
  565random_filename(Name) :-
  566    length(Chars, 8),
  567    maplist(random_char, Chars),
  568    atom_chars(Name, Chars).
  569
  570from('abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ').
  571
  572random_char(Char) :-
  573    from(From),
  574    atom_length(From, Len),
  575    Max is Len - 1,
  576    random_between(0, Max, I),
  577    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.
  585:- multifile open_hook/3.  586
  587swish_show(Options0, Request) :-
  588    open_hook(swish, Options0, Options),
  589    !,
  590    swish_reply(Options, Request).
  591swish_show(Options, Request) :-
  592    swish_reply(Options, Request).
  593
  594
  595                 /*******************************
  596                 *          INTERFACE           *
  597                 *******************************/
 storage_file(?File) is nondet
 storage_file_extension(?File, ?Extension) is nondet
 storage_file_extension_head(?File, ?Extension, -Head) is nondet
 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.
  610storage_file(File) :-
  611    storage_file_extension(File, _).
  612
  613storage_file_extension(File, Ext) :-
  614    storage_file_extension_head(File, Ext, _).
  615
  616storage_file_extension_head(File, Ext, Head) :-
  617    open_gittystore(Dir),
  618    gitty_file(Dir, File, Ext, Head).
  619
  620storage_file(File, Data, Meta) :-
  621    open_gittystore(Dir),
  622    (   var(File)
  623    ->  gitty_file(Dir, File, Head),
  624        gitty_data(Dir, Head, Data, Meta)
  625    ;   gitty_data(Dir, File, Data, Meta)
  626    ).
  627
  628storage_meta_data(File, Meta) :-
  629    open_gittystore(Dir),
  630    (   var(File)
  631    ->  gitty_file(Dir, File, _Head)
  632    ;   true
  633    ),
  634    gitty_commit(Dir, File, Meta).
 storage_commit(+Hash, -Meta) is semidet
Load the commit data for Hash. This version does not tell us whether Hash is the HEAD or not.
  641storage_commit(Hash, Meta) :-
  642    open_gittystore(Dir),
  643    gitty_plain_commit(Dir, Hash, Meta).
 storage_meta_property(+Meta, -Property)
True when Meta has Property. Defined properties are:
peer(Atom)
Peer address that last saved the file -
  653storage_meta_property(Meta, Property) :-
  654    current_meta_property(Property, How),
  655    meta_property(Property, How, Meta).
  656
  657meta_property(Property, dict, Identity) :-
  658    Property =.. [Name,Value],
  659    Value = Identity.get(Name).
  660meta_property(modify(Modify), _, Meta) :-
  661    (   Modify0 = Meta.get(modify)
  662    ->  Modify = Modify0
  663    ;   Modify = [any,login,owner]
  664    ).
  665
  666current_meta_property(peer(_Atom),       dict).
  667current_meta_property(public(_Bool),     dict).
  668current_meta_property(time(_Seconds),    dict).
  669current_meta_property(author(_String),   dict).
  670current_meta_property(identity(_String), dict).
  671current_meta_property(avatar(_String),   dict).
  672current_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.
  680storage_store_term(Term, Hash) :-
  681    open_gittystore(Dir),
  682    with_output_to(string(S), write_canonical(Term)),
  683    gitty_save(Dir, S, term, Hash).
  684
  685storage_load_term(Hash, Term) :-
  686    open_gittystore(Dir),
  687    gitty_load(Dir, Hash, Data, term),
  688    term_string(Term, Data).
  689
  690
  691                 /*******************************
  692                 * LOAD GITTY FILES PERMANENTLY *
  693                 *******************************/
 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.
  704use_gitty_file(File) :-
  705    use_gitty_file(File, []).
  706
  707use_gitty_file(M:Spec, Options) :-
  708    ensure_extension(Spec, pl, File),
  709    setup_watch(M:File, Options),
  710    storage_file(File, Data, Meta),
  711    atom_concat('swish://', File, URL),
  712    setup_call_cleanup(
  713        open_string(Data, In),
  714        load_files(M:URL,
  715                   [ stream(In),
  716                     modified(Meta.time),
  717                     if(changed)
  718                   | Options
  719                   ]),
  720        close(In)).
  721
  722ensure_extension(File, Ext, File) :-
  723    file_name_extension(_, Ext, File),
  724    !.
  725ensure_extension(Base, Ext, File) :-
  726    file_name_extension(Base, Ext, File).
  727
  728
  729:- dynamic
  730    watching/3.                                 % File, Module, Options
  731
  732setup_watch(M:File, Options) :-
  733    option(watch(true), Options, true),
  734    !,
  735    (   watching(File, M, Options)
  736    ->  true
  737    ;   retractall(watching(File, M, _)),
  738        assertz(watching(File, M, Options))
  739    ).
  740setup_watch(M:File, _Options) :-
  741    retractall(watching(File, M, _)).
  742
  743
  744                 /*******************************
  745                 *      AUTOMATIC RELOAD        *
  746                 *******************************/
  747
  748:- initialization
  749    listen(swish(updated(File, Commit)),
  750       run_watchdog(File, Commit)).  751
  752run_watchdog(File, _Commit) :-
  753    debug(gitty(reload), 'File ~p was saved', [File]),
  754    forall(watching(File, Module, Options),
  755           use_gitty_file(Module:File, Options)).
  756
  757
  758                 /*******************************
  759                 *            MESSAGES          *
  760                 *******************************/
 collect_messages_as_json(+Goal, -Messages)
Run Goal, collecting messages as produced by print_message/2 in Messages as JSON terms.
  767:- meta_predicate
  768    collect_messages_as_json(0, -).  769
  770:- thread_local
  771    messages/1.  772
  773collect_messages_as_json(Goal, Messages) :-
  774    retractall(messages(_)),
  775    setup_call_cleanup(
  776        asserta((user:thread_message_hook(Term,Kind,Lines) :-
  777                    collect_message(Term,Kind,Lines)),
  778                Ref),
  779        Goal,
  780        erase(Ref)),
  781    findall(Msg, retract(messages(Msg)), Messages).
  782
  783collect_message(Term, Kind, Lines) :-
  784    message_to_json(Term, Kind, Lines, JSON),
  785    assertz(messages(JSON)).
  786
  787message_to_json(Term, Kind, Lines, JSON) :-
  788    message_to_string(Term, String),
  789    JSON0 = json{type: message,
  790                 kind: Kind,
  791                 data: [String]},
  792    add_html_message(Kind, Lines, JSON0, JSON1),
  793    (   source_location(File, Line)
  794    ->  JSON2 = JSON1.put(location, json{file:File, line:Line})
  795    ;   JSON2 = JSON1
  796    ),
  797    (   message_details(Term, JSON2, JSON)
  798    ->  true
  799    ;   JSON = JSON2
  800    ).
  801
  802message_details(error(syntax_error(_What),
  803                      file(File,Line,Offset,_CharPos)),
  804                JSON0, JSON) :-
  805    JSON = JSON0.put(location, json{file:File, line:Line, ch:Offset})
  806                .put(code, syntax_error).
  807message_details(load_file(Step), JSON0, JSON) :-
  808    functor(Step, Code, _),
  809    JSON = JSON0.put(code, Code).
  810
  811% Added in SWI-Prolog 7.7.21
  812:- if(current_predicate(message_lines_to_html/3)).  813add_html_message(Kind, Lines, JSON0, JSON) :-
  814    atom_concat('msg-', Kind, Class),
  815    message_lines_to_html(Lines, [Class], HTML),
  816    JSON = JSON0.put(html, HTML).
  817:- else.  818add_html_message(_, _, JSON, JSON).
  819:- endif.  820
  821                 /*******************************
  822                 *          MAINTENANCE         *
  823                 *******************************/
 storage_fsck
Enumerate and check the consistency of the entire store.
  829storage_fsck :-
  830    open_gittystore(Dir),
  831    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.
  840:- multifile
  841    gitty_driver_files:repack_objects/2,
  842    gitty_driver_files:unpack_packs/1.  843
  844storage_repack :-
  845    storage_repack([]).
  846storage_repack(Options) :-
  847    open_gittystore(Dir),
  848    (   gitty_driver(Dir, files)
  849    ->  gitty_driver_files:repack_objects(Dir, Options)
  850    ;   print_message(informational, gitty(norepack(driver)))
  851    ).
 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.
  859storage_unpack :-
  860    open_gittystore(Dir),
  861    (   gitty_driver(Dir, files)
  862    ->  gitty_driver_files:unpack_packs(Dir)
  863    ;   print_message(informational, gitty(nounpack(driver)))
  864    ).
  865
  866
  867                 /*******************************
  868                 *       SEARCH SUPPORT         *
  869                 *******************************/
  870
  871:- multifile
  872    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.
  887swish_search:typeahead(file, Query, FileInfo, _Options) :-
  888    open_gittystore(Dir),
  889    gitty_file(Dir, File, Head),
  890    gitty_plain_commit(Dir, Head, Meta),
  891    Meta.get(public) == true,
  892    (   sub_atom(File, 0, _, _, Query) % find only public
  893    ->  true
  894    ;   meta_match_query(Query, Meta)
  895    ->  true
  896    ),
  897    FileInfo = Meta.put(_{type:"store", file:File}).
  898
  899meta_match_query(Query, Meta) :-
  900    member(Tag, Meta.get(tags)),
  901    sub_atom(Tag, 0, _, _, Query).
  902meta_match_query(Query, Meta) :-
  903    sub_atom(Meta.get(author), 0, _, _, Query).
  904meta_match_query(Query, Meta) :-
  905    Title = Meta.get(title),
  906    sub_atom_icasechk(Title, Start, Query),
  907    (   Start =:= 0
  908    ->  true
  909    ;   Before is Start-1,
  910        sub_atom(Title, Before, 1, _, C),
  911        \+ char_type(C, csym)
  912    ).
  913
  914swish_search:typeahead(store_content, Query, FileInfo, Options) :-
  915    limit(25, search_store_content(Query, FileInfo, Options)).
  916
  917search_store_content(Query, FileInfo, Options) :-
  918    open_gittystore(Dir),
  919    gitty_file(Dir, File, Head),
  920    gitty_data(Dir, Head, Data, Meta),
  921    Meta.get(public) == true,
  922    limit(5, search_file(File, Meta, Data, Query, FileInfo, Options)).
  923
  924search_file(File, Meta, Data, Query, FileInfo, Options) :-
  925    split_string(Data, "\n", "\r", Lines),
  926    nth1(LineNo, Lines, Line),
  927    match(Line, Query, Options),
  928    FileInfo = Meta.put(_{type:"store", file:File,
  929                          line:LineNo, text:Line, query:Query
  930                         }).
  931
  932
  933                 /*******************************
  934                 *         SOURCE LIST          *
  935                 *******************************/
 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?
  973source_list(Request) :-
  974	memberchk(method(options), Request),
  975	!,
  976	cors_enable(Request,
  977		    [ methods([get,post])
  978		    ]),
  979	format('~n').
  980source_list(Request) :-
  981    cors_enable,
  982    authenticate(Request, Auth),
  983    http_parameters(Request,
  984                    [ q(Q, [optional(true)]),
  985                      o(Order, [ oneof([time,name,author,type]),
  986                                 default(time)
  987                               ]),
  988                      offset(Offset, [integer, default(0)]),
  989                      limit(Limit, [integer, default(10)]),
  990                      display_name(DisplayName, [optional(true), string]),
  991                      avatar(Avatar, [optional(true), string])
  992                    ]),
  993    bound(Auth.put(_{display_name:DisplayName, avatar:Avatar}), AuthEx),
  994    order(Order, Field, Cmp),
  995    last_modified(Modified),
  996    statistics(cputime, CPU0),
  997    findall(Source, source(Q, AuthEx, Source), AllSources),
  998    statistics(cputime, CPU1),
  999    length(AllSources, Count),
 1000    CPU is CPU1 - CPU0,
 1001    sort(Field, Cmp, AllSources, Ordered),
 1002    list_offset_limit(Ordered, Offset, Limit, Sources),
 1003    reply_json_dict(json{total:Count, offset:Offset,
 1004                         cpu:CPU, modified:Modified,
 1005                         matches:Sources}).
 1006
 1007list_offset_limit(List0, Offset, Limit, List) :-
 1008    list_offset(List0, Offset, List1),
 1009    list_limit(List1, Limit, List).
 1010
 1011list_offset([_|T0], Offset, T) :-
 1012    succ(O1, Offset),
 1013    !,
 1014    list_offset(T0, O1, T).
 1015list_offset(List, _, List).
 1016
 1017list_limit([H|T0], Limit, [H|T]) :-
 1018    succ(L1, Limit),
 1019    !,
 1020    list_limit(T0, L1, T).
 1021list_limit(_, _, []).
 1022
 1023order(type,  ext,   @=<) :- !.
 1024order(time,  time,  @>=) :- !.
 1025order(Field, Field, @=<).
 1026
 1027source(Q, Auth, Source) :-
 1028    parse_query(Q, Query),
 1029    source_q(Query, Auth, Source).
 1030
 1031source_q([user("me")], Auth, _Source) :-
 1032    \+ _ = Auth.get(avatar),
 1033    \+ user_property(Auth, identity(_Id)),
 1034    !,
 1035    fail.
 1036source_q(Query, Auth, Source) :-
 1037    type_constraint(Query, Query1, Type),
 1038    partition(content_query, Query1,
 1039              ContentConstraints, MetaConstraints),
 1040    storage_file_extension_head(File, Type, Head),
 1041    source_data(File, Head, Meta, Source),
 1042    visible(Meta, Auth, MetaConstraints),
 1043    maplist(matches_meta(Source, Auth), MetaConstraints),
 1044    matches_content(ContentConstraints, Head).
 1045
 1046content_query(string(_)).
 1047content_query(regex(_)).
 1048
 1049source_data(File, Head, Meta, Source) :-
 1050    storage_commit(Head, Meta),
 1051    file_name_extension(_, Type, File),
 1052    Info = _{time:_, tags:_, author:_, avatar:_, name:_},
 1053    Info >:< Meta,
 1054    bound(Info, Info2),
 1055    Source = Info2.put(_{type:st_gitty, ext:Type}).
 1056
 1057bound(Dict0, Dict) :-
 1058    dict_pairs(Dict0, Tag, Pairs0),
 1059    include(bound, Pairs0, Pairs),
 1060    dict_pairs(Dict, Tag, Pairs).
 1061
 1062bound(_-V) :- nonvar(V).
 visible(+FileMeta, +Auth, +MetaConstraints) is semidet
 1066visible(Meta, Auth, Constraints) :-
 1067    memberchk(user("me"), Constraints),
 1068    !,
 1069    owns(Auth, Meta, user(_)).
 1070visible(Meta, _Auth, _Constraints) :-
 1071    Meta.get(public) == true,
 1072    !.
 1073visible(Meta, Auth, _Constraints) :-
 1074    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.
 1085owns(Auth, Meta, user(me)) :-
 1086    storage_meta_property(Meta, identity(Id)),
 1087    !,
 1088    user_property(Auth, identity(Id)).
 1089owns(_Auth, Meta, _) :-                         % demand strong ownership for
 1090    \+ Meta.get(public) == true,           % non-public files.
 1091    !,
 1092    fail.
 1093owns(Auth, Meta, user(avatar)) :-
 1094    storage_meta_property(Meta, avatar(Id)),
 1095    user_property(Auth, avatar(Id)),
 1096    !.
 1097owns(Auth, Meta, user(nickname)) :-
 1098    Auth.get(display_name) == Meta.get(author),
 1099    !.
 1100owns(Auth, Meta, host(How)) :-          % trust same host and local host
 1101    Peer = Auth.get(peer),
 1102    (   Peer == Meta.get(peer)
 1103    ->  How = same
 1104    ;   sub_atom(Meta.get(peer), 0, _, _, '127.0.0.')
 1105    ->  How = local
 1106    ).
 matches_meta(+Source, +Auth, +Query) is semidet
True when Source matches the meta-data requirements
 1112matches_meta(Dict, _, tag(Tag)) :-
 1113    !,
 1114    (   Tag == ""
 1115    ->  Dict.get(tags) \== []
 1116    ;   member(Tagged, Dict.get(tags)),
 1117        match_meta(Tag, Tagged)
 1118    ->  true
 1119    ).
 1120matches_meta(Dict, _, name(Name)) :-
 1121    !,
 1122    match_meta(Name, Dict.get(name)).
 1123matches_meta(Dict, _, user(Name)) :-
 1124    (   Name \== "me"
 1125    ->  match_meta(Name, Dict.get(author))
 1126    ;   true                % handled in visible/3
 1127    ).
 1128
 1129match_meta(regex(RE), Value) :-
 1130    !,
 1131    re_match(RE, Value).
 1132match_meta(String, Value) :-
 1133    sub_atom_icasechk(Value, _, String).
 1134
 1135matches_content([], _) :- !.
 1136matches_content(Constraints, Hash) :-
 1137    storage_file(Hash, Data, _Meta),
 1138    maplist(match_content(Data), Constraints).
 1139
 1140match_content(Data, string(S)) :-
 1141    sub_atom_icasechk(Data, _, S),
 1142    !.
 1143match_content(Data, regex(RE)) :-
 1144    re_match(RE, Data).
 type_constraint(+Query0, -Query, -Type) is det
Extract the type constraints from the query as we can handle that efficiently.
 1151type_constraint(Query0, Query, Type) :-
 1152    partition(is_type, Query0, Types, Query),
 1153    (   Types == []
 1154    ->  true
 1155    ;   Types = [type(Type)]
 1156    ->  true
 1157    ;   maplist(arg(1), Types, List),
 1158        freeze(Type, memberchk(Type, List))
 1159    ).
 1160
 1161is_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?
 1170parse_query(Q, Query) :-
 1171    var(Q),
 1172    !,
 1173    Query = [].
 1174parse_query(Q, Query) :-
 1175    string_codes(Q, Codes),
 1176    phrase(query(Query), Codes).
 1177
 1178query([H|T]) -->
 1179    blanks,
 1180    query1(H),
 1181    !,
 1182    query(T).
 1183query([]) -->
 1184    blanks.
 1185
 1186query1(Q) -->
 1187    tag(Tag, Value),
 1188    !,
 1189    {Q =.. [Tag,Value]}.
 1190query1(Q) -->
 1191    "\"", string(Codes), "\"",
 1192    !,
 1193    { string_codes(String, Codes),
 1194      Q = string(String)
 1195    }.
 1196query1(Q) -->
 1197    "/", string(Codes), "/", re_flags(Flags),
 1198    !,
 1199    { string_codes(String, Codes),
 1200      re_compile(String, RE, Flags),
 1201      Q = regex(RE)
 1202    }.
 1203query1(Q) -->
 1204    next_word(String),
 1205    { String \== "",
 1206      re_compile(String, RE,
 1207                 [ extended(true),
 1208                   caseless(true)
 1209                 ]),
 1210      Q = regex(RE)
 1211    }.
 1212
 1213re_flags([H|T]) -->
 1214    re_flag(H),
 1215    !,
 1216    re_flags(T).
 1217re_flags([]) -->
 1218    blank.
 1219re_flags([]) -->
 1220    eos.
 1221
 1222re_flag(caseless(true))  --> "i".
 1223re_flag(extended(true))  --> "x".
 1224re_flag(multiline(true)) --> "m".
 1225re_flag(dotall(true))    --> "s".
 1226
 1227next_word(String) -->
 1228    blanks, nonblank(H), string(Codes), ( blank ; eos ),
 1229    !,
 1230    { string_codes(String, [H|Codes]) }.
 1231
 1232tag(name, Value) --> "name:", tag_value(Value, _).
 1233tag(tag,  Value) --> "tag:",  tag_value(Value, _).
 1234tag(user, Value) --> "user:", tag_value(Value, _).
 1235tag(type, Value) --> "type:", tag_value(String, string(_)), { atom_string(Value, String) }.
 1236
 1237tag_value(String, string(quoted)) -->
 1238    blanks, "\"", !, string(Codes), "\"",
 1239    !,
 1240    { string_codes(String, Codes) }.
 1241tag_value(Q, regex) -->
 1242    blanks, "/", string(Codes), "/", re_flags(Flags),
 1243    !,
 1244    {   Codes == []
 1245    ->  Q = ""
 1246    ;   string_codes(String, Codes),
 1247        re_compile(String, RE, Flags),
 1248        Q = regex(RE)
 1249    }.
 1250tag_value(String, string(nonquoted)) -->
 1251    nonblank(H),
 1252    !,
 1253    string(Codes),
 1254    ( blank ; eos ),
 1255    !,
 1256    { string_codes(String, [H|Codes]) }.
 1257tag_value("", empty) -->
 1258    "".
 1259
 1260                 /*******************************
 1261                 *        TRACK CHANGES         *
 1262                 *******************************/
 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.

 1273source_modified(Request) :-
 1274    memberchk(method(options), Request),
 1275    !,
 1276    cors_enable(Request,
 1277                [ methods([get])
 1278                ]),
 1279    format('~n').
 1280source_modified(Request) :-
 1281    cors_enable,
 1282    authenticate(Request, _Auth),
 1283    last_modified(Time),
 1284    reply_json_dict(json{modified:Time}).
 1285
 1286:- dynamic gitty_last_modified/1. 1287
 1288update_last_modified(_,_) :-
 1289    with_mutex(gitty_last_modified,
 1290               update_last_modified_sync).
 1291
 1292update_last_modified_sync :-
 1293    get_time(Now),
 1294    retractall(gitty_last_modified(_)),
 1295    asserta(gitty_last_modified(Now)).
 1296
 1297last_modified(Time) :-
 1298    debugging(swish(sourcelist)),          % disable caching
 1299    !,
 1300    get_time(Now),
 1301    Time is Now + 60.
 1302last_modified(Time) :-
 1303    with_mutex(gitty_last_modified,
 1304               last_modified_sync(Time)).
 1305
 1306last_modified_sync(Time) :-
 1307    (   gitty_last_modified(Time)
 1308    ->  true
 1309    ;   statistics(process_epoch, Time)
 1310    ).
 1311
 1312:- unlisten(swish(_)),
 1313   listen(swish(Event), notify_event(Event)). 1314
 1315% events on gitty files
 1316notify_event(updated(File, Commit)) :-
 1317    atom_concat('gitty:', File, DocID),
 1318    update_last_modified(Commit, DocID).
 1319notify_event(deleted(File, Commit)) :-
 1320    atom_concat('gitty:', File, DocID),
 1321    update_last_modified(Commit, DocID).
 1322notify_event(created(File, Commit)) :-
 1323    atom_concat('gitty:', File, DocID),
 1324    update_last_modified(Commit, DocID).
 1325
 1326
 1327                 /*******************************
 1328                 *            MESSAGES          *
 1329                 *******************************/
 1330
 1331:- multifile prolog:message//1. 1332
 1333prolog:message(moved_old_store(Old, New)) -->
 1334    [ 'Moving SWISH file store from ~p to ~p'-[Old, New] ]