View source with raw comments or as raw
    1:- encoding(utf8).
    2/*  Part of SWI-Prolog
    3
    4    Author:        Torbjörn Lager and Jan Wielemaker
    5    E-mail:        J.Wielemaker@vu.nl
    6    WWW:           http://www.swi-prolog.org
    7    Copyright (C): 2014-2016, Torbjörn Lager,
    8                              VU University Amsterdam
    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(pengines,
   38          [ pengine_create/1,                   % +Options
   39            pengine_ask/3,                      % +Pengine, :Query, +Options
   40            pengine_next/2,                     % +Pengine. +Options
   41            pengine_stop/2,                     % +Pengine. +Options
   42            pengine_event/2,                    % -Event, +Options
   43            pengine_input/2,                    % +Prompt, -Term
   44            pengine_output/1,                   % +Term
   45            pengine_respond/3,                  % +Pengine, +Input, +Options
   46            pengine_debug/2,                    % +Format, +Args
   47            pengine_self/1,                     % -Pengine
   48            pengine_pull_response/2,            % +Pengine, +Options
   49            pengine_destroy/1,                  % +Pengine
   50            pengine_destroy/2,                  % +Pengine, +Options
   51            pengine_abort/1,                    % +Pengine
   52            pengine_application/1,              % +Application
   53            current_pengine_application/1,      % ?Application
   54            pengine_property/2,                 % ?Pengine, ?Property
   55            pengine_user/1,                     % -User
   56            pengine_event_loop/2,               % :Closure, +Options
   57            pengine_rpc/2,                      % +Server, :Goal
   58            pengine_rpc/3                       % +Server, :Goal, +Options
   59          ]).

Pengines: Web Logic Programming Made Easy

The library(pengines) provides an infrastructure for creating Prolog engines in a (remote) pengine server and accessing these engines either from Prolog or JavaScript.

author
- Torbjörn Lager and Jan Wielemaker */
   70:- use_module(library(http/http_dispatch)).   71:- use_module(library(http/http_parameters)).   72:- use_module(library(http/http_client)).   73:- use_module(library(http/http_json)).   74:- use_module(library(http/http_open)).   75:- use_module(library(http/http_stream)).   76:- use_module(library(http/http_wrapper)).   77:- use_module(library(http/http_cors)).   78:- use_module(library(thread_pool)).   79:- use_module(library(broadcast)).   80:- use_module(library(uri)).   81:- use_module(library(filesex)).   82:- use_module(library(time)).   83:- use_module(library(lists)).   84:- use_module(library(charsio)).   85:- use_module(library(apply)).   86:- use_module(library(aggregate)).   87:- use_module(library(option)).   88:- use_module(library(settings)).   89:- use_module(library(debug)).   90:- use_module(library(error)).   91:- use_module(library(sandbox)).   92:- use_module(library(modules)).   93:- use_module(library(term_to_json)).   94:- if(exists_source(library(uuid))).   95:- use_module(library(uuid)).   96:- endif.   97
   98
   99:- meta_predicate
  100    pengine_create(:),
  101    pengine_rpc(+, +, :),
  102    pengine_event_loop(1, +).  103
  104:- multifile
  105    write_result/3,                 % +Format, +Event, +Dict
  106    event_to_json/3,                % +Event, -JSON, +Format
  107    prepare_module/3,               % +Module, +Application, +Options
  108    prepare_goal/3,                 % +GoalIn, -GoalOut, +Options
  109    authentication_hook/3,          % +Request, +Application, -User
  110    not_sandboxed/2.                % +User, +App
  111
  112:- predicate_options(pengine_create/1, 1,
  113                     [ id(-atom),
  114                       alias(atom),
  115                       application(atom),
  116                       destroy(boolean),
  117                       server(atom),
  118                       ask(compound),
  119                       template(compound),
  120                       chunk(integer),
  121                       bindings(list),
  122                       src_list(list),
  123                       src_text(any),           % text
  124                       src_url(atom),
  125                       src_predicates(list)
  126                     ]).  127:- predicate_options(pengine_ask/3, 3,
  128                     [ template(any),
  129                       chunk(integer),
  130                       bindings(list)
  131                     ]).  132:- predicate_options(pengine_next/2, 2,
  133                     [ chunk(integer),
  134                       pass_to(pengine_send/3, 3)
  135                     ]).  136:- predicate_options(pengine_stop/2, 2,
  137                     [ pass_to(pengine_send/3, 3)
  138                     ]).  139:- predicate_options(pengine_respond/3, 2,
  140                     [ pass_to(pengine_send/3, 3)
  141                     ]).  142:- predicate_options(pengine_rpc/3, 3,
  143                     [ chunk(integer),
  144                       pass_to(pengine_create/1, 1)
  145                     ]).  146:- predicate_options(pengine_send/3, 3,
  147                     [ delay(number)
  148                     ]).  149:- predicate_options(pengine_event/2, 2,
  150                     [ pass_to(thread_get_message/3, 3)
  151                     ]).  152:- predicate_options(pengine_pull_response/2, 2,
  153                     [ pass_to(http_open/3, 3)
  154                     ]).  155:- predicate_options(pengine_event_loop/2, 2,
  156                     []).                       % not yet implemented
  157
  158% :- debug(pengine(transition)).
  159:- debug(pengine(debug)).               % handle pengine_debug in pengine_rpc/3.
  160
  161goal_expansion(random_delay, Expanded) :-
  162    (   debugging(pengine(delay))
  163    ->  Expanded = do_random_delay
  164    ;   Expanded = true
  165    ).
  166
  167do_random_delay :-
  168    Delay is random(20)/1000,
  169    sleep(Delay).
  170
  171:- meta_predicate                       % internal meta predicates
  172    solve(+, ?, 0, +),
  173    findnsols_no_empty(+, ?, 0, -),
  174    pengine_event_loop(+, 1, +).
 pengine_create(:Options) is det
Creates a new pengine. Valid options are:
id(-ID)
ID gets instantiated to the id of the created pengine. ID is atomic.
alias(+Name)
The pengine is named Name (an atom). A slave pengine (child) can subsequently be referred to by this name.
application(+Application)
Application in which the pengine runs. See pengine_application/1.
server(+URL)
The pengine will run in (and in the Prolog context of) the pengine server located at URL.
src_list(+List_of_clauses)
Inject a list of Prolog clauses into the pengine.
src_text(+Atom_or_string)
Inject the clauses specified by a source text into the pengine.
src_url(+URL)
Inject the clauses specified in the file located at URL into the pengine.
src_predicates(+List)
Send the local predicates denoted by List to the remote pengine. List is a list of predicate indicators.

Remaining options are passed to http_open/3 (meaningful only for non-local pengines) and thread_create/3. Note that for thread_create/3 only options changing the stack-sizes can be used. In particular, do not pass the detached or alias options..

Successful creation of a pengine will return an event term of the following form:

create(ID, Term)
ID is the id of the pengine that was created. Term is not used at the moment.

An error will be returned if the pengine could not be created:

error(ID, Term)
ID is invalid, since no pengine was created. Term is the exception's error term. */
  229pengine_create(M:Options0) :-
  230    translate_local_sources(Options0, Options, M),
  231    (   select_option(server(BaseURL), Options, RestOptions)
  232    ->  remote_pengine_create(BaseURL, RestOptions)
  233    ;   local_pengine_create(Options)
  234    ).
 translate_local_sources(+OptionsIn, -Options, +Module) is det
Translate the src_predicates and src_list options into src_text. We need to do that anyway for remote pengines. For local pengines, we could avoid this step, but there is very little point in transferring source to a local pengine anyway as local pengines can access any Prolog predicate that you make visible to the application.

Multiple sources are concatenated to end up with a single src_text option.

  248translate_local_sources(OptionsIn, Options, Module) :-
  249    translate_local_sources(OptionsIn, Sources, Options2, Module),
  250    (   Sources == []
  251    ->  Options = Options2
  252    ;   Sources = [Source]
  253    ->  Options = [src_text(Source)|Options2]
  254    ;   atomics_to_string(Sources, Source)
  255    ->  Options = [src_text(Source)|Options2]
  256    ).
  257
  258translate_local_sources([], [], [], _).
  259translate_local_sources([H0|T], [S0|S], Options, M) :-
  260    nonvar(H0),
  261    translate_local_source(H0, S0, M),
  262    !,
  263    translate_local_sources(T, S, Options, M).
  264translate_local_sources([H|T0], S, [H|T], M) :-
  265    translate_local_sources(T0, S, T, M).
  266
  267translate_local_source(src_predicates(PIs), Source, M) :-
  268    must_be(list, PIs),
  269    with_output_to(string(Source),
  270                   maplist(listing(M), PIs)).
  271translate_local_source(src_list(Terms), Source, _) :-
  272    must_be(list, Terms),
  273    with_output_to(string(Source),
  274                   forall(member(Term, Terms),
  275                          format('~k .~n', [Term]))).
  276translate_local_source(src_text(Source), Source, _).
  277
  278listing(M, PI) :-
  279    listing(M:PI).
 pengine_send(+NameOrID, +Term) is det
Same as pengine_send(NameOrID, Term, []). */
  286pengine_send(Target, Event) :-
  287    pengine_send(Target, Event, []).
 pengine_send(+NameOrID, +Term, +Options) is det
Succeeds immediately and places Term in the queue of the pengine NameOrID. Options is a list of options:
delay(+Time)
The actual sending is delayed by Time seconds. Time is an integer or a float.

Any remaining options are passed to http_open/3. */

  302pengine_send(Target, Event, Options) :-
  303    must_be(atom, Target),
  304    pengine_send2(Target, Event, Options).
  305
  306pengine_send2(self, Event, Options) :-
  307    !,
  308    thread_self(Queue),
  309    delay_message(queue(Queue), Event, Options).
  310pengine_send2(Name, Event, Options) :-
  311    child(Name, Target),
  312    !,
  313    delay_message(pengine(Target), Event, Options).
  314pengine_send2(Target, Event, Options) :-
  315    delay_message(pengine(Target), Event, Options).
  316
  317delay_message(Target, Event, Options) :-
  318    option(delay(Delay), Options),
  319    !,
  320    alarm(Delay,
  321          send_message(Target, Event, Options),
  322          _AlarmID,
  323          [remove(true)]).
  324delay_message(Target, Event, Options) :-
  325    random_delay,
  326    send_message(Target, Event, Options).
  327
  328send_message(queue(Queue), Event, _) :-
  329    thread_send_message(Queue, pengine_request(Event)).
  330send_message(pengine(Pengine), Event, Options) :-
  331    (   pengine_remote(Pengine, Server)
  332    ->  remote_pengine_send(Server, Pengine, Event, Options)
  333    ;   pengine_thread(Pengine, Thread)
  334    ->  thread_send_message(Thread, pengine_request(Event))
  335    ;   existence_error(pengine, Pengine)
  336    ).
 pengine_request(-Request) is det
To be used by a pengine to wait for the next request. Such messages are placed in the queue by pengine_send/2.
  343pengine_request(Request) :-
  344    pengine_self(Self),
  345    get_pengine_application(Self, Application),
  346    setting(Application:idle_limit, IdleLimit),
  347    thread_self(Me),
  348    (   thread_get_message(Me, pengine_request(Request), [timeout(IdleLimit)])
  349    ->  true
  350    ;   Request = destroy
  351    ).
 pengine_reply(+Event) is det
 pengine_reply(+Queue, +Event) is det
Reply Event to the parent of the current Pengine or the given Queue. Such events are read by the other side with pengine_event/1.

If the message cannot be sent within the idle_limit setting of the pengine, abort the pengine.

  364pengine_reply(Event) :-
  365    pengine_parent(Queue),
  366    pengine_reply(Queue, Event).
  367
  368pengine_reply(_Queue, _Event0) :-
  369    nb_current(pengine_idle_limit_exceeded, true),
  370    !.
  371pengine_reply(Queue, Event0) :-
  372    arg(1, Event0, ID),
  373    wrap_first_answer(ID, Event0, Event),
  374    random_delay,
  375    debug(pengine(event), 'Reply to ~p: ~p', [Queue, Event]),
  376    (   pengine_self(ID)
  377    ->  get_pengine_application(ID, Application),
  378        setting(Application:idle_limit, IdleLimit),
  379        debug(pengine(reply), 'Sending ~p, timout: ~q', [Event, IdleLimit]),
  380        (   thread_send_message(Queue, pengine_event(ID, Event),
  381                                [ timeout(IdleLimit)
  382                                ])
  383        ->  true
  384        ;   thread_self(Me),
  385            debug(pengine(reply), 'pengine_reply: timeout for ~q (thread ~q)',
  386                  [ID, Me]),
  387            nb_setval(pengine_idle_limit_exceeded, true),
  388            thread_detach(Me),
  389            abort
  390        )
  391    ;   thread_send_message(Queue, pengine_event(ID, Event))
  392    ).
  393
  394wrap_first_answer(ID, Event0, CreateEvent) :-
  395    wrap_first_answer_in_create_event(CreateEvent, [answer(Event0)]),
  396    arg(1, CreateEvent, ID),
  397    !,
  398    retract(wrap_first_answer_in_create_event(CreateEvent, [answer(Event0)])).
  399wrap_first_answer(_ID, Event, Event).
  400
  401
  402empty_queue :-
  403    pengine_parent(Queue),
  404    empty_queue(Queue, 0, Discarded),
  405    debug(pengine(abort), 'Abort: discarded ~D messages', [Discarded]).
  406
  407empty_queue(Queue, C0, C) :-
  408    thread_get_message(Queue, _Term, [timeout(0)]),
  409    !,
  410    C1 is C0+1,
  411    empty_queue(Queue, C1, C).
  412empty_queue(_, C, C).
 pengine_ask(+NameOrID, @Query, +Options) is det
Asks pengine NameOrID a query Query.

Options is a list of options:

template(+Template)
Template is a variable (or a term containing variables) shared with the query. By default, the template is identical to the query.
chunk(+Integer)
Retrieve solutions in chunks of Integer rather than one by one. 1 means no chunking (default). Other integers indicate the maximum number of solutions to retrieve in one chunk.
bindings(+Bindings)
Sets the global variable '$variable_names' to a list of Name = Var terms, providing access to the actual variable names.

Any remaining options are passed to pengine_send/3.

Note that the predicate pengine_ask/3 is deterministic, even for queries that have more than one solution. Also, the variables in Query will not be bound. Instead, results will be returned in the form of event terms.

success(ID, Terms, Projection, Time, More)
ID is the id of the pengine that succeeded in solving the query. Terms is a list holding instantiations of Template. Projection is a list of variable names that should be displayed. Time is the CPU time used to produce the results and finally, More is either true or false, indicating whether we can expect the pengine to be able to return more solutions or not, would we call pengine_next/2.
failure(ID)
ID is the id of the pengine that failed for lack of a solutions.
error(ID, Term)
ID is the id of the pengine throwing the exception. Term is the exception's error term.
output(ID, Term)
ID is the id of a pengine running the query that called pengine_output/1. Term is the term that was passed in the first argument of pengine_output/1 when it was called.
prompt(ID, Term)
ID is the id of the pengine that called pengine_input/2 and Term is the prompt.

Defined in terms of pengine_send/3, like so:

pengine_ask(ID, Query, Options) :-
    partition(pengine_ask_option, Options, AskOptions, SendOptions),
    pengine_send(ID, ask(Query, AskOptions), SendOptions).

*/

  477pengine_ask(ID, Query, Options) :-
  478    partition(pengine_ask_option, Options, AskOptions, SendOptions),
  479    pengine_send(ID, ask(Query, AskOptions), SendOptions).
  480
  481
  482pengine_ask_option(template(_)).
  483pengine_ask_option(chunk(_)).
  484pengine_ask_option(bindings(_)).
  485pengine_ask_option(breakpoints(_)).
 pengine_next(+NameOrID, +Options) is det
Asks pengine NameOrID for the next solution to a query started by pengine_ask/3. Defined options are:
chunk(+Count)
Modify the chunk-size to Count before asking the next set of solutions.

Remaining options are passed to pengine_send/3. The result of re-executing the current goal is returned to the caller's message queue in the form of event terms.

success(ID, Terms, Projection, Time, More)
See pengine_ask/3.
failure(ID)
ID is the id of the pengine that failed for lack of more solutions.
error(ID, Term)
ID is the id of the pengine throwing the exception. Term is the exception's error term.
output(ID, Term)
ID is the id of a pengine running the query that called pengine_output/1. Term is the term that was passed in the first argument of pengine_output/1 when it was called.
prompt(ID, Term)
ID is the id of the pengine that called pengine_input/2 and Term is the prompt.

Defined in terms of pengine_send/3, as follows:

pengine_next(ID, Options) :-
    pengine_send(ID, next, Options).

*/

  529pengine_next(ID, Options) :-
  530    select_option(chunk(Count), Options, Options1),
  531    !,
  532    pengine_send(ID, next(Count), Options1).
  533pengine_next(ID, Options) :-
  534    pengine_send(ID, next, Options).
 pengine_stop(+NameOrID, +Options) is det
Tells pengine NameOrID to stop looking for more solutions to a query started by pengine_ask/3. Options are passed to pengine_send/3.

Defined in terms of pengine_send/3, like so:

pengine_stop(ID, Options) :-
    pengine_send(ID, stop, Options).

*/

  550pengine_stop(ID, Options) :- pengine_send(ID, stop, Options).
 pengine_abort(+NameOrID) is det
Aborts the running query. The pengine goes back to state `2', waiting for new queries.
See also
- pengine_destroy/1. */
  561pengine_abort(Name) :-
  562    (   child(Name, Pengine)
  563    ->  true
  564    ;   Pengine = Name
  565    ),
  566    (   pengine_remote(Pengine, Server)
  567    ->  remote_pengine_abort(Server, Pengine, [])
  568    ;   pengine_thread(Pengine, Thread),
  569        debug(pengine(abort), 'Signalling thread ~p', [Thread]),
  570        catch(thread_signal(Thread, throw(abort_query)), _, true)
  571    ).
 pengine_destroy(+NameOrID) is det
 pengine_destroy(+NameOrID, +Options) is det
Destroys the pengine NameOrID. With the option force(true), the pengine is killed using abort/0 and pengine_destroy/2 succeeds. */
  581pengine_destroy(ID) :-
  582    pengine_destroy(ID, []).
  583
  584pengine_destroy(Name, Options) :-
  585    (   child(Name, ID)
  586    ->  true
  587    ;   ID = Name
  588    ),
  589    option(force(true), Options),
  590    !,
  591    (   pengine_thread(ID, Thread)
  592    ->  catch(thread_signal(Thread, abort),
  593              error(existence_error(thread, _), _), true)
  594    ;   true
  595    ).
  596pengine_destroy(ID, _) :-
  597    catch(pengine_send(ID, destroy),
  598          error(existence_error(pengine, ID), _),
  599          retractall(child(_,ID))).
  600
  601
  602/*================= pengines administration =======================
  603*/
 current_pengine(?Id, ?Parent, ?Location)
Dynamic predicate that registers our known pengines. Id is an atomic unique datatype. Parent is the id of our parent pengine. Location is one of
  614:- dynamic
  615    current_pengine/6,              % Id, ParentId, Thread, URL, App, Destroy
  616    pengine_queue/4,                % Id, Queue, TimeOut, Time
  617    output_queue/3,                 % Id, Queue, Time
  618    pengine_user/2,                 % Id, User
  619    pengine_data/2.                 % Id, Data
  620:- volatile
  621    current_pengine/6,
  622    pengine_queue/4,
  623    output_queue/3,
  624    pengine_user/2,
  625    pengine_data/2.  626
  627:- thread_local
  628    child/2.                        % ?Name, ?Child
 pengine_register_local(+Id, +Thread, +Queue, +URL, +App, +Destroy) is det
 pengine_register_remote(+Id, +URL, +Queue, +App, +Destroy) is det
 pengine_unregister(+Id) is det
  634pengine_register_local(Id, Thread, Queue, URL, Application, Destroy) :-
  635    asserta(current_pengine(Id, Queue, Thread, URL, Application, Destroy)).
  636
  637pengine_register_remote(Id, URL, Application, Destroy) :-
  638    thread_self(Queue),
  639    asserta(current_pengine(Id, Queue, 0, URL, Application, Destroy)).
 pengine_unregister(+Id)
Called by the pengine thread destruction. If we are a remote pengine thread, our URL equals http and the queue is the message queue used to send events to the HTTP workers.
  647pengine_unregister(Id) :-
  648    thread_self(Me),
  649    (   current_pengine(Id, Queue, Me, http, _, _)
  650    ->  with_mutex(pengine, sync_destroy_queue_from_pengine(Id, Queue))
  651    ;   true
  652    ),
  653    retractall(current_pengine(Id, _, Me, _, _, _)),
  654    retractall(pengine_user(Id, _)),
  655    retractall(pengine_data(Id, _)).
  656
  657pengine_unregister_remote(Id) :-
  658    retractall(current_pengine(Id, _Parent, 0, _, _, _)).
 pengine_self(-Id) is det
True if the current thread is a pengine with Id.
  664pengine_self(Id) :-
  665    thread_self(Thread),
  666    current_pengine(Id, _Parent, Thread, _URL, _Application, _Destroy).
  667
  668pengine_parent(Parent) :-
  669    nb_getval(pengine_parent, Parent).
  670
  671pengine_thread(Pengine, Thread) :-
  672    current_pengine(Pengine, _Parent, Thread, _URL, _Application, _Destroy),
  673    Thread \== 0,
  674    !.
  675
  676pengine_remote(Pengine, URL) :-
  677    current_pengine(Pengine, _Parent, 0, URL, _Application, _Destroy).
  678
  679get_pengine_application(Pengine, Application) :-
  680    current_pengine(Pengine, _Parent, _, _URL, Application, _Destroy),
  681    !.
  682
  683get_pengine_module(Pengine, Pengine).
  684
  685:- if(current_predicate(uuid/2)).  686pengine_uuid(Id) :-
  687    uuid(Id, [version(4)]).             % Version 4 is random.
  688:- else.  689:- use_module(library(random)).  690pengine_uuid(Id) :-
  691    Max is 1<<128,
  692    random_between(0, Max, Num),
  693    atom_number(Id, Num).
  694:- endif.
 pengine_application(+Application) is det
Directive that must be used to declare a pengine application module. The module may not be associated to any file. The default application is pengine_sandbox. The example below creates a new application address_book and imports the API defined in the module file adress_book_api.pl into the application.
:- pengine_application(address_book).
:- use_module(address_book:adress_book_api).

*/

  710pengine_application(Application) :-
  711    throw(error(context_error(nodirective,
  712                             pengine_application(Application)), _)).
  713
  714:- multifile
  715    system:term_expansion/2,
  716    current_application/1.
 current_pengine_application(?Application) is nondet
True when Application is a currently defined application.
See also
- pengine_application/1
  724current_pengine_application(Application) :-
  725    current_application(Application).
  726
  727
  728% Default settings for all applications
  729
  730:- setting(thread_pool_size, integer, 100,
  731           'Maximum number of pengines this application can run.').  732:- setting(thread_pool_stacks, list(compound), [],
  733           'Maximum stack sizes for pengines this application can run.').  734:- setting(slave_limit, integer, 3,
  735           'Maximum number of slave pengines a master pengine can create.').  736:- setting(time_limit, number, 300,
  737           'Maximum time to wait for output').  738:- setting(idle_limit, number, 300,
  739           'Pengine auto-destroys when idle for this time').  740:- setting(safe_goal_limit, number, 10,
  741           'Maximum time to try proving safity of the goal').  742:- setting(program_space, integer, 100_000_000,
  743           'Maximum memory used by predicates').  744:- setting(allow_from, list(atom), [*],
  745           'IP addresses from which remotes are allowed to connect').  746:- setting(deny_from, list(atom), [],
  747           'IP addresses from which remotes are NOT allowed to connect').  748:- setting(debug_info, boolean, false,
  749           'Keep information to support source-level debugging').  750
  751
  752system:term_expansion((:- pengine_application(Application)), Expanded) :-
  753    must_be(atom, Application),
  754    (   module_property(Application, file(_))
  755    ->  permission_error(create, pengine_application, Application)
  756    ;   true
  757    ),
  758    expand_term((:- setting(Application:thread_pool_size, integer,
  759                            setting(pengines:thread_pool_size),
  760                            'Maximum number of pengines this \c
  761                            application can run.')),
  762                ThreadPoolSizeSetting),
  763    expand_term((:- setting(Application:thread_pool_stacks, list(compound),
  764                            setting(pengines:thread_pool_stacks),
  765                            'Maximum stack sizes for pengines \c
  766                            this application can run.')),
  767                ThreadPoolStacksSetting),
  768    expand_term((:- setting(Application:slave_limit, integer,
  769                            setting(pengines:slave_limit),
  770                            'Maximum number of local slave pengines \c
  771                            a master pengine can create.')),
  772                SlaveLimitSetting),
  773    expand_term((:- setting(Application:time_limit, number,
  774                            setting(pengines:time_limit),
  775                            'Maximum time to wait for output')),
  776                TimeLimitSetting),
  777    expand_term((:- setting(Application:idle_limit, number,
  778                            setting(pengines:idle_limit),
  779                            'Pengine auto-destroys when idle for this time')),
  780                IdleLimitSetting),
  781    expand_term((:- setting(Application:safe_goal_limit, number,
  782                            setting(pengines:safe_goal_limit),
  783                            'Maximum time to try proving safity of the goal')),
  784                SafeGoalLimitSetting),
  785    expand_term((:- setting(Application:program_space, integer,
  786                            setting(pengines:program_space),
  787                            'Maximum memory used by predicates')),
  788                ProgramSpaceSetting),
  789    expand_term((:- setting(Application:allow_from, list(atom),
  790                            setting(pengines:allow_from),
  791                            'IP addresses from which remotes are allowed \c
  792                            to connect')),
  793                AllowFromSetting),
  794    expand_term((:- setting(Application:deny_from, list(atom),
  795                            setting(pengines:deny_from),
  796                            'IP addresses from which remotes are NOT \c
  797                            allowed to connect')),
  798                DenyFromSetting),
  799    expand_term((:- setting(Application:debug_info, boolean,
  800                            setting(pengines:debug_info),
  801                            'Keep information to support source-level \c
  802                            debugging')),
  803                DebugInfoSetting),
  804    flatten([ pengines:current_application(Application),
  805              ThreadPoolSizeSetting,
  806              ThreadPoolStacksSetting,
  807              SlaveLimitSetting,
  808              TimeLimitSetting,
  809              IdleLimitSetting,
  810              SafeGoalLimitSetting,
  811              ProgramSpaceSetting,
  812              AllowFromSetting,
  813              DenyFromSetting,
  814              DebugInfoSetting
  815            ], Expanded).
  816
  817% Register default application
  818
  819:- pengine_application(pengine_sandbox).
 pengine_property(?Pengine, ?Property) is nondet
True when Property is a property of the given Pengine. Enumerates all pengines that are known to the calling Prolog process. Defined properties are:
self(ID)
Identifier of the pengine. This is the same as the first argument, and can be used to enumerate all known pengines.
alias(Name)
Name is the alias name of the pengine, as provided through the alias option when creating the pengine.
thread(Thread)
If the pengine is a local pengine, Thread is the Prolog thread identifier of the pengine.
remote(Server)
If the pengine is remote, the URL of the server.
application(Application)
Pengine runs the given application
module(Module)
Temporary module used for running the Pengine.
destroy(Destroy)
Destroy is true if the pengines is destroyed automatically after completing the query.
parent(Queue)
Message queue to which the (local) pengine reports.
source(?SourceID, ?Source)
Source is the source code with the given SourceID. May be present if the setting debug_info is present. */
  854pengine_property(Id, Prop) :-
  855    nonvar(Id), nonvar(Prop),
  856    pengine_property2(Id, Prop),
  857    !.
  858pengine_property(Id, Prop) :-
  859    pengine_property2(Id, Prop).
  860
  861pengine_property2(Id, self(Id)) :-
  862    current_pengine(Id, _Parent, _Thread, _URL, _Application, _Destroy).
  863pengine_property2(Id, module(Id)) :-
  864    current_pengine(Id, _Parent, _Thread, _URL, _Application, _Destroy).
  865pengine_property2(Id, alias(Alias)) :-
  866    child(Alias, Id),
  867    Alias \== Id.
  868pengine_property2(Id, thread(Thread)) :-
  869    current_pengine(Id, _Parent, Thread, _URL, _Application, _Destroy),
  870    Thread \== 0.
  871pengine_property2(Id, remote(Server)) :-
  872    current_pengine(Id, _Parent, 0, Server, _Application, _Destroy).
  873pengine_property2(Id, application(Application)) :-
  874    current_pengine(Id, _Parent, _Thread, _Server, Application, _Destroy).
  875pengine_property2(Id, destroy(Destroy)) :-
  876    current_pengine(Id, _Parent, _Thread, _Server, _Application, Destroy).
  877pengine_property2(Id, parent(Parent)) :-
  878    current_pengine(Id, Parent, _Thread, _URL, _Application, _Destroy).
  879pengine_property2(Id, source(SourceID, Source)) :-
  880    pengine_data(Id, source(SourceID, Source)).
 pengine_output(+Term) is det
Sends Term to the parent pengine or thread. */
  887pengine_output(Term) :-
  888    pengine_self(Me),
  889    pengine_reply(output(Me, Term)).
 pengine_debug(+Format, +Args) is det
Create a message using format/3 from Format and Args and send this to the client. The default JavaScript client will call console.log(Message) if there is a console. The predicate pengine_rpc/3 calls debug(pengine(debug), '~w', [Message]). The debug topic pengine(debug) is enabled by default.
See also
- debug/1 and nodebug/1 for controlling the pengine(debug) topic
- format/2 for format specifications */
  904pengine_debug(Format, Args) :-
  905    pengine_parent(Queue),
  906    pengine_self(Self),
  907    catch(safe_goal(format(atom(_), Format, Args)), E, true),
  908    (   var(E)
  909    ->  format(atom(Message), Format, Args)
  910    ;   message_to_string(E, Message)
  911    ),
  912    pengine_reply(Queue, debug(Self, Message)).
  913
  914
  915/*================= Local pengine =======================
  916*/
 local_pengine_create(+Options)
Creates a local Pengine, which is a thread running pengine_main/2. It maintains two predicates:
  927local_pengine_create(Options) :-
  928    thread_self(Self),
  929    option(application(Application), Options, pengine_sandbox),
  930    create(Self, Child, Options, local, Application),
  931    option(alias(Name), Options, Child),
  932    assert(child(Name, Child)).
 thread_pool:create_pool(+Application) is det
On demand creation of a thread pool for a pengine application.
  939thread_pool:create_pool(Application) :-
  940    current_application(Application),
  941    setting(Application:thread_pool_size, Size),
  942    setting(Application:thread_pool_stacks, Stacks),
  943    thread_pool_create(Application, Size, Stacks).
 create(+Queue, -Child, +Options, +URL, +Application) is det
Create a new pengine thread.
Arguments:
Queue- is the queue (or thread handle) to report to
Child- is the identifier of the created pengine.
URL- is one of local or http
  953create(Queue, Child, Options, local, Application) :-
  954    !,
  955    pengine_child_id(Child),
  956    create0(Queue, Child, Options, local, Application).
  957create(Queue, Child, Options, URL, Application) :-
  958    pengine_child_id(Child),
  959    catch(create0(Queue, Child, Options, URL, Application),
  960          Error,
  961          create_error(Queue, Child, Error)).
  962
  963pengine_child_id(Child) :-
  964    (   nonvar(Child)
  965    ->  true
  966    ;   pengine_uuid(Child)
  967    ).
  968
  969create_error(Queue, Child, Error) :-
  970    pengine_reply(Queue, error(Child, Error)).
  971
  972create0(Queue, Child, Options, URL, Application) :-
  973    (  current_application(Application)
  974    -> true
  975    ;  existence_error(pengine_application, Application)
  976    ),
  977    (   URL \== http                    % pengine is _not_ a child of the
  978                                        % HTTP server thread
  979    ->  aggregate_all(count, child(_,_), Count),
  980        setting(Application:slave_limit, Max),
  981        (   Count >= Max
  982        ->  throw(error(resource_error(max_pengines), _))
  983        ;   true
  984        )
  985    ;   true
  986    ),
  987    partition(pengine_create_option, Options, PengineOptions, RestOptions),
  988    thread_create_in_pool(
  989        Application,
  990        pengine_main(Queue, PengineOptions, Application), ChildThread,
  991        [ at_exit(pengine_done)
  992        | RestOptions
  993        ]),
  994    option(destroy(Destroy), PengineOptions, true),
  995    pengine_register_local(Child, ChildThread, Queue, URL, Application, Destroy),
  996    thread_send_message(ChildThread, pengine_registered(Child)),
  997    (   option(id(Id), Options)
  998    ->  Id = Child
  999    ;   true
 1000    ).
 1001
 1002pengine_create_option(src_text(_)).
 1003pengine_create_option(src_url(_)).
 1004pengine_create_option(application(_)).
 1005pengine_create_option(destroy(_)).
 1006pengine_create_option(ask(_)).
 1007pengine_create_option(template(_)).
 1008pengine_create_option(bindings(_)).
 1009pengine_create_option(chunk(_)).
 1010pengine_create_option(alias(_)).
 1011pengine_create_option(user(_)).
 pengine_done is det
Called from the pengine thread at_exit option. Destroys child pengines using pengine_destroy/1.
 1019:- public
 1020    pengine_done/0. 1021
 1022pengine_done :-
 1023    thread_self(Me),
 1024    (   thread_property(Me, status(exception('$aborted')))
 1025    ->  pengine_self(Pengine),
 1026        pengine_reply(destroy(Pengine, abort(Pengine))),
 1027        thread_detach(Me)
 1028    ;   true
 1029    ),
 1030    forall(child(_Name, Child),
 1031           pengine_destroy(Child)),
 1032    pengine_self(Id),
 1033    pengine_unregister(Id).
 pengine_main(+Parent, +Options, +Application)
Run a pengine main loop. First acknowledges its creation and run pengine_main_loop/1.
 1041:- thread_local wrap_first_answer_in_create_event/2. 1042
 1043:- meta_predicate
 1044    pengine_prepare_source(:, +). 1045
 1046pengine_main(Parent, Options, Application) :-
 1047    fix_streams,
 1048    thread_get_message(pengine_registered(Self)),
 1049    nb_setval(pengine_parent, Parent),
 1050    pengine_register_user(Options),
 1051    catch(in_temporary_module(
 1052              Self,
 1053              pengine_prepare_source(Application, Options),
 1054              pengine_create_and_loop(Self, Application, Options)),
 1055          prepare_source_failed,
 1056          pengine_terminate(Self)).
 1057
 1058pengine_create_and_loop(Self, Application, Options) :-
 1059    setting(Application:slave_limit, SlaveLimit),
 1060    CreateEvent = create(Self, [slave_limit(SlaveLimit)|Extra]),
 1061    (   option(ask(Query), Options)
 1062    ->  asserta(wrap_first_answer_in_create_event(CreateEvent, Extra)),
 1063        option(template(Template), Options, Query),
 1064        option(chunk(Chunk), Options, 1),
 1065        option(bindings(Bindings), Options, []),
 1066        pengine_ask(Self, Query,
 1067                    [ template(Template),
 1068                      chunk(Chunk),
 1069                      bindings(Bindings)
 1070                    ])
 1071    ;   Extra = [],
 1072        pengine_reply(CreateEvent)
 1073    ),
 1074    pengine_main_loop(Self).
 fix_streams is det
If we are a pengine that is created from a web server thread, the current output points to a CGI stream.
 1082fix_streams :-
 1083    fix_stream(current_output).
 1084
 1085fix_stream(Name) :-
 1086    is_cgi_stream(Name),
 1087    !,
 1088    debug(pengine(stream), '~w is a CGI stream!', [Name]),
 1089    set_stream(user_output, alias(Name)).
 1090fix_stream(_).
 pengine_prepare_source(:Application, +Options) is det
Load the source into the pengine's module.
throws
- prepare_source_failed if it failed to prepare the sources.
 1099pengine_prepare_source(Module:Application, Options) :-
 1100    setting(Application:program_space, SpaceLimit),
 1101    set_module(Module:program_space(SpaceLimit)),
 1102    delete_import_module(Module, user),
 1103    add_import_module(Module, Application, start),
 1104    catch(prep_module(Module, Application, Options), Error, true),
 1105    (   var(Error)
 1106    ->  true
 1107    ;   send_error(Error),
 1108        throw(prepare_source_failed)
 1109    ).
 1110
 1111prep_module(Module, Application, Options) :-
 1112    maplist(copy_flag(Module, Application), [var_prefix]),
 1113    forall(prepare_module(Module, Application, Options), true),
 1114    setup_call_cleanup(
 1115        '$set_source_module'(OldModule, Module),
 1116        maplist(process_create_option(Module), Options),
 1117        '$set_source_module'(OldModule)).
 1118
 1119copy_flag(Module, Application, Flag) :-
 1120    current_prolog_flag(Application:Flag, Value),
 1121    !,
 1122    set_prolog_flag(Module:Flag, Value).
 1123copy_flag(_, _, _).
 1124
 1125process_create_option(Application, src_text(Text)) :-
 1126    !,
 1127    pengine_src_text(Text, Application).
 1128process_create_option(Application, src_url(URL)) :-
 1129    !,
 1130    pengine_src_url(URL, Application).
 1131process_create_option(_, _).
 prepare_module(+Module, +Application, +Options) is semidet
Hook, called to initialize the temporary private module that provides the working context of a pengine. This hook is executed by the pengine's thread. Preparing the source consists of three steps:
  1. Add Application as (first) default import module for Module
  2. Call this hook
  3. Compile the source provided by the the src_text and src_url options
Arguments:
Module- is a new temporary module (see in_temporary_module/3) that may be (further) prepared by this hook.
Application- (also a module) associated to the pengine.
Options- is passed from the environment and should (currently) be ignored.
 1154pengine_main_loop(ID) :-
 1155    catch(guarded_main_loop(ID), abort_query, pengine_aborted(ID)).
 1156
 1157pengine_aborted(ID) :-
 1158    thread_self(Self),
 1159    debug(pengine(abort), 'Aborting ~p (thread ~p)', [ID, Self]),
 1160    empty_queue,
 1161    destroy_or_continue(abort(ID)).
 guarded_main_loop(+Pengine) is det
Executes state `2' of the pengine, where it waits for two events:
destroy
Terminate the pengine
ask(:Goal, +Options)
Solve Goal.
 1174guarded_main_loop(ID) :-
 1175    pengine_request(Request),
 1176    (   Request = destroy
 1177    ->  debug(pengine(transition), '~q: 2 = ~q => 1', [ID, destroy]),
 1178        pengine_terminate(ID)
 1179    ;   Request = ask(Goal, Options)
 1180    ->  debug(pengine(transition), '~q: 2 = ~q => 3', [ID, ask(Goal)]),
 1181        ask(ID, Goal, Options)
 1182    ;   debug(pengine(transition), '~q: 2 = ~q => 2', [ID, protocol_error]),
 1183        pengine_reply(error(ID, error(protocol_error, _))),
 1184        guarded_main_loop(ID)
 1185    ).
 1186
 1187
 1188pengine_terminate(ID) :-
 1189    pengine_reply(destroy(ID)),
 1190    thread_self(Me),            % Make the thread silently disappear
 1191    thread_detach(Me).
 solve(+Chunk, +Template, :Goal, +ID) is det
Solve Goal. Note that because we can ask for a new goal in state `6', we must provide for an ancesteral cut (prolog_cut_to/1). We need to be sure to have a choice point before we can call prolog_current_choice/1. This is the reason why this predicate has two clauses.
 1202solve(Chunk, Template, Goal, ID) :-
 1203    prolog_current_choice(Choice),
 1204    State = count(Chunk),
 1205    statistics(cputime, Epoch),
 1206    Time = time(Epoch),
 1207    nb_current('$variable_names', Bindings),
 1208    (   call_cleanup(catch(findnsols_no_empty(State, Template,
 1209                                              set_projection(Goal, Bindings),
 1210                                              Result),
 1211                           Error, true),
 1212                     Det = true),
 1213        arg(1, Time, T0),
 1214        statistics(cputime, T1),
 1215        CPUTime is T1-T0,
 1216        (   var(Error)
 1217        ->  projection(Projection),
 1218            (   var(Det)
 1219            ->  pengine_reply(success(ID, Result, Projection,
 1220                                      CPUTime, true)),
 1221                more_solutions(ID, Choice, State, Time)
 1222            ;   !,                      % commit
 1223                destroy_or_continue(success(ID, Result, Projection,
 1224                                            CPUTime, false))
 1225            )
 1226        ;   !,                          % commit
 1227            (   Error == abort_query
 1228            ->  throw(Error)
 1229            ;   destroy_or_continue(error(ID, Error))
 1230            )
 1231        )
 1232    ;   !,                              % commit
 1233        arg(1, Time, T0),
 1234        statistics(cputime, T1),
 1235        CPUTime is T1-T0,
 1236        destroy_or_continue(failure(ID, CPUTime))
 1237    ).
 1238solve(_, _, _, _).                      % leave a choice point
 set_projection(:Goal, +Bindings)
findnsols/4 copies its goal and template to avoid instantiation thereof when it stops after finding N solutions. Using this helper we can a renamed version of Bindings that we can set.
 1246set_projection(Goal, Bindings) :-
 1247    b_setval('$variable_names', Bindings),
 1248    call(Goal).
 1249
 1250projection(Projection) :-
 1251    nb_current('$variable_names', Bindings),
 1252    !,
 1253    maplist(var_name, Bindings, Projection).
 1254projection([]).
 1255
 1256
 1257findnsols_no_empty(N, Template, Goal, List) :-
 1258    findnsols(N, Template, Goal, List),
 1259    List \== [].
 1260
 1261destroy_or_continue(Event) :-
 1262    arg(1, Event, ID),
 1263    (   pengine_property(ID, destroy(true))
 1264    ->  thread_self(Me),
 1265        thread_detach(Me),
 1266        pengine_reply(destroy(ID, Event))
 1267    ;   pengine_reply(Event),
 1268        garbage_collect,                % minimise our footprint
 1269        trim_stacks,
 1270        guarded_main_loop(ID)
 1271    ).
 more_solutions(+Pengine, +Choice, +State, +Time)
Called after a solution was found while there can be more. This is state `6' of the state machine. It processes these events:
stop
Go back via state `7' to state `2' (guarded_main_loop/1)
next
Fail. This causes solve/3 to backtrack on the goal asked, providing at most the current chunk solutions.
next(Count)
As next, but sets the new chunk-size to Count.
ask(Goal, Options)
Ask another goal. Note that we must commit the choice point of the previous goal asked for.
 1289more_solutions(ID, Choice, State, Time) :-
 1290    pengine_request(Event),
 1291    more_solutions(Event, ID, Choice, State, Time).
 1292
 1293more_solutions(stop, ID, _Choice, _State, _Time) :-
 1294    !,
 1295    debug(pengine(transition), '~q: 6 = ~q => 7', [ID, stop]),
 1296    destroy_or_continue(stop(ID)).
 1297more_solutions(next, ID, _Choice, _State, Time) :-
 1298    !,
 1299    debug(pengine(transition), '~q: 6 = ~q => 3', [ID, next]),
 1300    statistics(cputime, T0),
 1301    nb_setarg(1, Time, T0),
 1302    fail.
 1303more_solutions(next(Count), ID, _Choice, State, Time) :-
 1304    Count > 0,
 1305    !,
 1306    debug(pengine(transition), '~q: 6 = ~q => 3', [ID, next(Count)]),
 1307    nb_setarg(1, State, Count),
 1308    statistics(cputime, T0),
 1309    nb_setarg(1, Time, T0),
 1310    fail.
 1311more_solutions(ask(Goal, Options), ID, Choice, _State, _Time) :-
 1312    !,
 1313    debug(pengine(transition), '~q: 6 = ~q => 3', [ID, ask(Goal)]),
 1314    prolog_cut_to(Choice),
 1315    ask(ID, Goal, Options).
 1316more_solutions(destroy, ID, _Choice, _State, _Time) :-
 1317    !,
 1318    debug(pengine(transition), '~q: 6 = ~q => 1', [ID, destroy]),
 1319    pengine_terminate(ID).
 1320more_solutions(Event, ID, Choice, State, Time) :-
 1321    debug(pengine(transition), '~q: 6 = ~q => 6', [ID, protocol_error(Event)]),
 1322    pengine_reply(error(ID, error(protocol_error, _))),
 1323    more_solutions(ID, Choice, State, Time).
 ask(+Pengine, :Goal, +Options)
Migrate from state `2' to `3'. This predicate validates that it is safe to call Goal using safe_goal/1 and then calls solve/3 to prove the goal. It takes care of the chunk(N) option.
 1331ask(ID, Goal, Options) :-
 1332    catch(prepare_goal(ID, Goal, Goal1, Options), Error, true),
 1333    !,
 1334    (   var(Error)
 1335    ->  option(template(Template), Options, Goal),
 1336        option(chunk(N), Options, 1),
 1337        solve(N, Template, Goal1, ID)
 1338    ;   pengine_reply(error(ID, Error)),
 1339        guarded_main_loop(ID)
 1340    ).
 prepare_goal(+Pengine, +GoalIn, -GoalOut, +Options) is det
Prepare GoalIn for execution in Pengine. This implies we must perform goal expansion and, if the system is sandboxed, check the sandbox.

Note that expand_goal(Module:GoalIn, GoalOut) is what we'd like to write, but this does not work correctly if the user wishes to expand X:Y while interpreting X not as the module in which to run Y. This happens in the CQL package. Possibly we should disallow this reinterpretation?

 1354prepare_goal(ID, Goal0, Module:Goal, Options) :-
 1355    option(bindings(Bindings), Options, []),
 1356    b_setval('$variable_names', Bindings),
 1357    (   prepare_goal(Goal0, Goal1, Options)
 1358    ->  true
 1359    ;   Goal1 = Goal0
 1360    ),
 1361    get_pengine_module(ID, Module),
 1362    setup_call_cleanup(
 1363        '$set_source_module'(Old, Module),
 1364        expand_goal(Goal1, Goal),
 1365        '$set_source_module'(_, Old)),
 1366    (   pengine_not_sandboxed(ID)
 1367    ->  true
 1368    ;   get_pengine_application(ID, App),
 1369        setting(App:safe_goal_limit, Limit),
 1370        catch(call_with_time_limit(
 1371                  Limit,
 1372                  safe_goal(Module:Goal)), E, true)
 1373    ->  (   var(E)
 1374        ->  true
 1375        ;   E = time_limit_exceeded
 1376        ->  throw(error(sandbox(time_limit_exceeded, Limit),_))
 1377        ;   throw(E)
 1378        )
 1379    ).
 prepare_goal(+Goal0, -Goal1, +Options) is semidet
Pre-preparation hook for running Goal0. The hook runs in the context of the pengine. Goal is the raw goal given to ask. The returned Goal1 is subject to goal expansion (expand_goal/2) and sandbox validation (safe_goal/1) prior to execution. If this goal fails, Goal0 is used for further processing.
Arguments:
Options- provides the options as given to ask
 pengine_not_sandboxed(+Pengine) is semidet
True when pengine does not operate in sandboxed mode. This implies a user must be registered by authentication_hook/3 and the hook pengines:not_sandboxed(User, Application) must succeed.
 1399pengine_not_sandboxed(ID) :-
 1400    pengine_user(ID, User),
 1401    pengine_property(ID, application(App)),
 1402    not_sandboxed(User, App),
 1403    !.
 not_sandboxed(+User, +Application) is semidet
This hook is called to see whether the Pengine must be executed in a protected environment. It is only called after authentication_hook/3 has confirmed the authentity of the current user. If this hook succeeds, both loading the code and executing the query is executed without enforcing sandbox security. Typically, one should:
  1. Provide a safe user authentication hook.
  2. Enable HTTPS in the server or put it behind an HTTPS proxy and ensure that the network between the proxy and the pengine server can be trusted.
 pengine_pull_response(+Pengine, +Options) is det
Pulls a response (an event term) from the slave Pengine if Pengine is a remote process, else does nothing at all. */
 1425pengine_pull_response(Pengine, Options) :-
 1426    pengine_remote(Pengine, Server),
 1427    !,
 1428    remote_pengine_pull_response(Server, Pengine, Options).
 1429pengine_pull_response(_ID, _Options).
 pengine_input(+Prompt, -Term) is det
Sends Prompt to the parent pengine and waits for input. Note that Prompt may be any term, compound as well as atomic. */
 1438pengine_input(Prompt, Term) :-
 1439    pengine_self(Self),
 1440    pengine_parent(Parent),
 1441    pengine_reply(Parent, prompt(Self, Prompt)),
 1442    pengine_request(Request),
 1443    (   Request = input(Input)
 1444    ->  Term = Input
 1445    ;   Request == destroy
 1446    ->  abort
 1447    ;   throw(error(protocol_error,_))
 1448    ).
 pengine_respond(+Pengine, +Input, +Options) is det
Sends a response in the form of the term Input to a slave pengine that has prompted its master for input.

Defined in terms of pengine_send/3, as follows:

pengine_respond(Pengine, Input, Options) :-
    pengine_send(Pengine, input(Input), Options).

*/

 1465pengine_respond(Pengine, Input, Options) :-
 1466    pengine_send(Pengine, input(Input), Options).
 send_error(+Error) is det
Send an error to my parent. Remove non-readable blobs from the error term first using replace_blobs/2. If the error contains a stack-trace, this is resolved to a string before sending.
 1475send_error(error(Formal, context(prolog_stack(Frames), Message))) :-
 1476    is_list(Frames),
 1477    !,
 1478    with_output_to(string(Stack),
 1479                   print_prolog_backtrace(current_output, Frames)),
 1480    pengine_self(Self),
 1481    replace_blobs(Formal, Formal1),
 1482    replace_blobs(Message, Message1),
 1483    pengine_reply(error(Self, error(Formal1,
 1484                                    context(prolog_stack(Stack), Message1)))).
 1485send_error(Error) :-
 1486    pengine_self(Self),
 1487    replace_blobs(Error, Error1),
 1488    pengine_reply(error(Self, Error1)).
 replace_blobs(Term0, Term) is det
Copy Term0 to Term, replacing non-text blobs. This is required for error messages that may hold streams and other handles to non-readable objects.
 1496replace_blobs(Blob, Atom) :-
 1497    blob(Blob, Type), Type \== text,
 1498    !,
 1499    format(atom(Atom), '~p', [Blob]).
 1500replace_blobs(Term0, Term) :-
 1501    compound(Term0),
 1502    !,
 1503    compound_name_arguments(Term0, Name, Args0),
 1504    maplist(replace_blobs, Args0, Args),
 1505    compound_name_arguments(Term, Name, Args).
 1506replace_blobs(Term, Term).
 1507
 1508
 1509/*================= Remote pengines =======================
 1510*/
 1511
 1512
 1513remote_pengine_create(BaseURL, Options) :-
 1514    partition(pengine_create_option, Options, PengineOptions0, RestOptions),
 1515        (       option(ask(Query), PengineOptions0),
 1516                \+ option(template(_Template), PengineOptions0)
 1517        ->      PengineOptions = [template(Query)|PengineOptions0]
 1518        ;       PengineOptions = PengineOptions0
 1519        ),
 1520    options_to_dict(PengineOptions, PostData),
 1521    remote_post_rec(BaseURL, create, PostData, Reply, RestOptions),
 1522    arg(1, Reply, ID),
 1523    (   option(id(ID2), Options)
 1524    ->  ID = ID2
 1525    ;   true
 1526    ),
 1527    option(alias(Name), Options, ID),
 1528    assert(child(Name, ID)),
 1529    (   (   functor(Reply, create, _)   % actually created
 1530        ;   functor(Reply, output, _)   % compiler messages
 1531        )
 1532    ->  option(application(Application), PengineOptions, pengine_sandbox),
 1533        option(destroy(Destroy), PengineOptions, true),
 1534        pengine_register_remote(ID, BaseURL, Application, Destroy)
 1535    ;   true
 1536    ),
 1537    thread_self(Queue),
 1538    pengine_reply(Queue, Reply).
 1539
 1540options_to_dict(Options, Dict) :-
 1541    select_option(ask(Ask), Options, Options1),
 1542    select_option(template(Template), Options1, Options2),
 1543    !,
 1544    no_numbered_var_in(Ask+Template),
 1545    findall(AskString-TemplateString,
 1546            ask_template_to_strings(Ask, Template, AskString, TemplateString),
 1547            [ AskString-TemplateString ]),
 1548    options_to_dict(Options2, Dict0),
 1549    Dict = Dict0.put(_{ask:AskString,template:TemplateString}).
 1550options_to_dict(Options, Dict) :-
 1551    maplist(prolog_option, Options, Options1),
 1552    dict_create(Dict, _, Options1).
 1553
 1554no_numbered_var_in(Term) :-
 1555    sub_term(Sub, Term),
 1556    subsumes_term('$VAR'(_), Sub),
 1557    !,
 1558    domain_error(numbered_vars_free_term, Term).
 1559no_numbered_var_in(_).
 1560
 1561ask_template_to_strings(Ask, Template, AskString, TemplateString) :-
 1562    numbervars(Ask+Template, 0, _),
 1563    WOpts = [ numbervars(true), ignore_ops(true), quoted(true) ],
 1564    format(string(AskTemplate), '~W\n~W', [ Ask, WOpts,
 1565                                            Template, WOpts
 1566                                          ]),
 1567    split_string(AskTemplate, "\n", "", [AskString, TemplateString]).
 1568
 1569prolog_option(Option0, Option) :-
 1570    create_option_type(Option0, term),
 1571    !,
 1572    Option0 =.. [Name,Value],
 1573    format(string(String), '~k', [Value]),
 1574    Option =.. [Name,String].
 1575prolog_option(Option, Option).
 1576
 1577create_option_type(ask(_),         term).
 1578create_option_type(template(_),    term).
 1579create_option_type(application(_), atom).
 1580
 1581remote_pengine_send(BaseURL, ID, Event, Options) :-
 1582    remote_send_rec(BaseURL, send, ID, [event=Event], Reply, Options),
 1583    thread_self(Queue),
 1584    pengine_reply(Queue, Reply).
 1585
 1586remote_pengine_pull_response(BaseURL, ID, Options) :-
 1587    remote_send_rec(BaseURL, pull_response, ID, [], Reply, Options),
 1588    thread_self(Queue),
 1589    pengine_reply(Queue, Reply).
 1590
 1591remote_pengine_abort(BaseURL, ID, Options) :-
 1592    remote_send_rec(BaseURL, abort, ID, [], Reply, Options),
 1593    thread_self(Queue),
 1594    pengine_reply(Queue, Reply).
 remote_send_rec(+Server, +Action, +ID, +Params, -Reply, +Options)
Issue a GET request on Server and unify Reply with the replied term.
 1601remote_send_rec(Server, Action, ID, [event=Event], Reply, Options) :-
 1602    !,
 1603    server_url(Server, Action, [id=ID], URL),
 1604    http_open(URL, Stream,              % putting this in setup_call_cleanup/3
 1605              [ post(prolog(Event))     % makes it impossible to interrupt.
 1606              | Options
 1607              ]),
 1608    call_cleanup(
 1609        read_prolog_reply(Stream, Reply),
 1610        close(Stream)).
 1611remote_send_rec(Server, Action, ID, Params, Reply, Options) :-
 1612    server_url(Server, Action, [id=ID|Params], URL),
 1613    http_open(URL, Stream, Options),
 1614    call_cleanup(
 1615        read_prolog_reply(Stream, Reply),
 1616        close(Stream)).
 1617
 1618remote_post_rec(Server, Action, Data, Reply, Options) :-
 1619    server_url(Server, Action, [], URL),
 1620    probe(Action, URL),
 1621    http_open(URL, Stream,
 1622              [ post(json(Data))
 1623              | Options
 1624              ]),
 1625    call_cleanup(
 1626        read_prolog_reply(Stream, Reply),
 1627        close(Stream)).
 probe(+Action, +URL) is det
Probe the target. This is a good idea before posting a large document and be faced with an authentication challenge. Possibly we should make this an option for simpler scenarios.
 1635probe(create, URL) :-
 1636    !,
 1637    http_open(URL, Stream, [method(options)]),
 1638    close(Stream).
 1639probe(_, _).
 1640
 1641read_prolog_reply(In, Reply) :-
 1642    set_stream(In, encoding(utf8)),
 1643    read(In, Reply0),
 1644    rebind_cycles(Reply0, Reply).
 1645
 1646rebind_cycles(@(Reply, Bindings), Reply) :-
 1647    is_list(Bindings),
 1648    !,
 1649    maplist(bind, Bindings).
 1650rebind_cycles(Reply, Reply).
 1651
 1652bind(Var = Value) :-
 1653    Var = Value.
 1654
 1655server_url(Server, Action, Params, URL) :-
 1656    uri_components(Server, Components0),
 1657    uri_query_components(Query, Params),
 1658    uri_data(path, Components0, Path0),
 1659    atom_concat('pengine/', Action, PAction),
 1660    directory_file_path(Path0, PAction, Path),
 1661    uri_data(path, Components0, Path, Components),
 1662    uri_data(search, Components, Query),
 1663    uri_components(URL, Components).
 pengine_event(?EventTerm) is det
 pengine_event(?EventTerm, +Options) is det
Examines the pengine's event queue and if necessary blocks execution until a term that unifies to Term arrives in the queue. After a term from the queue has been unified to Term, the term is deleted from the queue.

Valid options are:

timeout(+Time)
Time is a float or integer and specifies the maximum time to wait in seconds. If no event has arrived before the time is up EventTerm is bound to the atom timeout.
listen(+Id)
Only listen to events from the pengine identified by Id. */
 1684pengine_event(Event) :-
 1685    pengine_event(Event, []).
 1686
 1687pengine_event(Event, Options) :-
 1688    thread_self(Self),
 1689    option(listen(Id), Options, _),
 1690    (   thread_get_message(Self, pengine_event(Id, Event), Options)
 1691    ->  true
 1692    ;   Event = timeout
 1693    ),
 1694    update_remote_destroy(Event).
 1695
 1696update_remote_destroy(Event) :-
 1697    destroy_event(Event),
 1698    arg(1, Event, Id),
 1699    pengine_remote(Id, _Server),
 1700    !,
 1701    pengine_unregister_remote(Id).
 1702update_remote_destroy(_).
 1703
 1704destroy_event(destroy(_)).
 1705destroy_event(destroy(_,_)).
 1706destroy_event(create(_,Features)) :-
 1707    memberchk(answer(Answer), Features),
 1708    !,
 1709    nonvar(Answer),
 1710    destroy_event(Answer).
 pengine_event_loop(:Closure, +Options) is det
Starts an event loop accepting event terms sent to the current pengine or thread. For each such event E, calls ignore(call(Closure, E)). A closure thus acts as a handler for the event. Some events are also treated specially:
create(ID, Term)
The ID is placed in a list of active pengines.
destroy(ID)
The ID is removed from the list of active pengines. When the last pengine ID is removed, the loop terminates.
output(ID, Term)
The predicate pengine_pull_response/2 is called.

Valid options are:

autoforward(+To)
Forwards received event terms to slaves. To is either all, all_but_sender or a Prolog list of NameOrIDs. [not yet implemented]

*/

 1739pengine_event_loop(Closure, Options) :-
 1740    child(_,_),
 1741    !,
 1742    pengine_event(Event),
 1743    (   option(autoforward(all), Options) % TODO: Implement all_but_sender and list of IDs
 1744    ->  forall(child(_,ID), pengine_send(ID, Event))
 1745    ;   true
 1746    ),
 1747    pengine_event_loop(Event, Closure, Options).
 1748pengine_event_loop(_, _).
 1749
 1750:- meta_predicate
 1751    pengine_process_event(+, 1, -, +). 1752
 1753pengine_event_loop(Event, Closure, Options) :-
 1754    pengine_process_event(Event, Closure, Continue, Options),
 1755    (   Continue == true
 1756    ->  pengine_event_loop(Closure, Options)
 1757    ;   true
 1758    ).
 1759
 1760pengine_process_event(create(ID, T), Closure, Continue, Options) :-
 1761    debug(pengine(transition), '~q: 1 = /~q => 2', [ID, create(T)]),
 1762    (   select(answer(First), T, T1)
 1763    ->  ignore(call(Closure, create(ID, T1))),
 1764        pengine_process_event(First, Closure, Continue, Options)
 1765    ;   ignore(call(Closure, create(ID, T))),
 1766        Continue = true
 1767    ).
 1768pengine_process_event(output(ID, Msg), Closure, true, _Options) :-
 1769    debug(pengine(transition), '~q: 3 = /~q => 4', [ID, output(Msg)]),
 1770    ignore(call(Closure, output(ID, Msg))),
 1771    pengine_pull_response(ID, []).
 1772pengine_process_event(debug(ID, Msg), Closure, true, _Options) :-
 1773    debug(pengine(transition), '~q: 3 = /~q => 4', [ID, debug(Msg)]),
 1774    ignore(call(Closure, debug(ID, Msg))),
 1775    pengine_pull_response(ID, []).
 1776pengine_process_event(prompt(ID, Term), Closure, true, _Options) :-
 1777    debug(pengine(transition), '~q: 3 = /~q => 5', [ID, prompt(Term)]),
 1778    ignore(call(Closure, prompt(ID, Term))).
 1779pengine_process_event(success(ID, Sol, _Proj, _Time, More), Closure, true, _) :-
 1780    debug(pengine(transition), '~q: 3 = /~q => 6/2', [ID, success(Sol, More)]),
 1781    ignore(call(Closure, success(ID, Sol, More))).
 1782pengine_process_event(failure(ID, _Time), Closure, true, _Options) :-
 1783    debug(pengine(transition), '~q: 3 = /~q => 2', [ID, failure]),
 1784    ignore(call(Closure, failure(ID))).
 1785pengine_process_event(error(ID, Error), Closure, Continue, _Options) :-
 1786    debug(pengine(transition), '~q: 3 = /~q => 2', [ID, error(Error)]),
 1787    (   call(Closure, error(ID, Error))
 1788    ->  Continue = true
 1789    ;   forall(child(_,Child), pengine_destroy(Child)),
 1790        throw(Error)
 1791    ).
 1792pengine_process_event(stop(ID), Closure, true, _Options) :-
 1793    debug(pengine(transition), '~q: 7 = /~q => 2', [ID, stop]),
 1794    ignore(call(Closure, stop(ID))).
 1795pengine_process_event(destroy(ID, Event), Closure, Continue, Options) :-
 1796    pengine_process_event(Event, Closure, _, Options),
 1797    pengine_process_event(destroy(ID), Closure, Continue, Options).
 1798pengine_process_event(destroy(ID), Closure, true, _Options) :-
 1799    retractall(child(_,ID)),
 1800    debug(pengine(transition), '~q: 1 = /~q => 0', [ID, destroy]),
 1801    ignore(call(Closure, destroy(ID))).
 pengine_rpc(+URL, +Query) is nondet
 pengine_rpc(+URL, +Query, +Options) is nondet
Semantically equivalent to the sequence below, except that the query is executed in (and in the Prolog context of) the pengine server referred to by URL, rather than locally.
  copy_term(Query, Copy),
  call(Copy),                 % executed on server at URL
  Query = Copy.

Valid options are:

chunk(+Integer)
Can be used to reduce the number of network roundtrips being made. See pengine_ask/3.
timeout(+Time)
Wait at most Time seconds for the next event from the server. The default is defined by the setting pengines:time_limit.

Remaining options (except the server option) are passed to pengine_create/1. */

 1830pengine_rpc(URL, Query) :-
 1831    pengine_rpc(URL, Query, []).
 1832
 1833pengine_rpc(URL, Query, M:Options0) :-
 1834    translate_local_sources(Options0, Options1, M),
 1835    (  option(timeout(_), Options1)
 1836    -> Options = Options1
 1837    ;  setting(time_limit, Limit),
 1838       Options = [timeout(Limit)|Options1]
 1839    ),
 1840    term_variables(Query, Vars),
 1841    Template =.. [v|Vars],
 1842    State = destroy(true),              % modified by process_event/4
 1843    setup_call_catcher_cleanup(
 1844        pengine_create([ ask(Query),
 1845                         template(Template),
 1846                         server(URL),
 1847                         id(Id)
 1848                       | Options
 1849                       ]),
 1850        wait_event(Template, State, [listen(Id)|Options]),
 1851        Why,
 1852        pengine_destroy_and_wait(State, Id, Why)).
 1853
 1854pengine_destroy_and_wait(destroy(true), Id, Why) :-
 1855    !,
 1856    debug(pengine(rpc), 'Destroying RPC because of ~p', [Why]),
 1857    pengine_destroy(Id),
 1858    wait_destroy(Id, 10).
 1859pengine_destroy_and_wait(_, _, Why) :-
 1860    debug(pengine(rpc), 'Not destroying RPC (~p)', [Why]).
 1861
 1862wait_destroy(Id, _) :-
 1863    \+ child(_, Id),
 1864    !.
 1865wait_destroy(Id, N) :-
 1866    pengine_event(Event, [listen(Id),timeout(10)]),
 1867    !,
 1868    (   destroy_event(Event)
 1869    ->  retractall(child(_,Id))
 1870    ;   succ(N1, N)
 1871    ->  wait_destroy(Id, N1)
 1872    ;   debug(pengine(rpc), 'RPC did not answer to destroy ~p', [Id]),
 1873        pengine_unregister_remote(Id),
 1874        retractall(child(_,Id))
 1875    ).
 1876
 1877wait_event(Template, State, Options) :-
 1878    pengine_event(Event, Options),
 1879    debug(pengine(event), 'Received ~p', [Event]),
 1880    process_event(Event, Template, State, Options).
 1881
 1882process_event(create(_ID, Features), Template, State, Options) :-
 1883    memberchk(answer(First), Features),
 1884    process_event(First, Template, State, Options).
 1885process_event(error(_ID, Error), _Template, _, _Options) :-
 1886    throw(Error).
 1887process_event(failure(_ID, _Time), _Template, _, _Options) :-
 1888    fail.
 1889process_event(prompt(ID, Prompt), Template, State, Options) :-
 1890    pengine_rpc_prompt(ID, Prompt, Reply),
 1891    pengine_send(ID, input(Reply)),
 1892    wait_event(Template, State, Options).
 1893process_event(output(ID, Term), Template, State, Options) :-
 1894    pengine_rpc_output(ID, Term),
 1895    pengine_pull_response(ID, Options),
 1896    wait_event(Template, State, Options).
 1897process_event(debug(ID, Message), Template, State, Options) :-
 1898    debug(pengine(debug), '~w', [Message]),
 1899    pengine_pull_response(ID, Options),
 1900    wait_event(Template, State, Options).
 1901process_event(success(_ID, Solutions, _Proj, _Time, false),
 1902              Template, _, _Options) :-
 1903    !,
 1904    member(Template, Solutions).
 1905process_event(success(ID, Solutions, _Proj, _Time, true),
 1906              Template, State, Options) :-
 1907    (   member(Template, Solutions)
 1908    ;   pengine_next(ID, Options),
 1909        wait_event(Template, State, Options)
 1910    ).
 1911process_event(destroy(ID, Event), Template, State, Options) :-
 1912    !,
 1913    retractall(child(_,ID)),
 1914    nb_setarg(1, State, false),
 1915    debug(pengine(destroy), 'State: ~p~n', [State]),
 1916    process_event(Event, Template, State, Options).
 1917% compatibility with older versions of the protocol.
 1918process_event(success(ID, Solutions, Time, More),
 1919              Template, State, Options) :-
 1920    process_event(success(ID, Solutions, _Proj, Time, More),
 1921                  Template, State, Options).
 1922
 1923
 1924pengine_rpc_prompt(ID, Prompt, Term) :-
 1925    prompt(ID, Prompt, Term0),
 1926    !,
 1927    Term = Term0.
 1928pengine_rpc_prompt(_ID, Prompt, Term) :-
 1929    setup_call_cleanup(
 1930        prompt(Old, Prompt),
 1931        read(Term),
 1932        prompt(_, Old)).
 1933
 1934pengine_rpc_output(ID, Term) :-
 1935    output(ID, Term),
 1936    !.
 1937pengine_rpc_output(_ID, Term) :-
 1938    print(Term).
 prompt(+ID, +Prompt, -Term) is semidet
Hook to handle pengine_input/2 from the remote pengine. If the hooks fails, pengine_rpc/3 calls read/1 using the current prompt.
 1945:- multifile prompt/3.
 output(+ID, +Term) is semidet
Hook to handle pengine_output/1 from the remote pengine. If the hook fails, it calls print/1 on Term.
 1952:- multifile output/2. 1953
 1954
 1955/*================= HTTP handlers =======================
 1956*/
 1957
 1958%   Declare  HTTP  locations  we  serve  and   how.  Note  that  we  use
 1959%   time_limit(inifinite) because pengines have their  own timeout. Also
 1960%   note that we use spawn. This  is   needed  because we can easily get
 1961%   many clients waiting for  some  action   on  a  pengine to complete.
 1962%   Without spawning, we would quickly exhaust   the  worker pool of the
 1963%   HTTP server.
 1964%
 1965%   FIXME: probably we should wait for a   short time for the pengine on
 1966%   the default worker thread. Only if  that   time  has expired, we can
 1967%   call http_spawn/2 to continue waiting on   a  new thread. That would
 1968%   improve the performance and reduce the usage of threads.
 1969
 1970:- http_handler(root(pengine),               http_404([]),
 1971                [ id(pengines) ]). 1972:- http_handler(root(pengine/create),        http_pengine_create,
 1973                [ time_limit(infinite), spawn([]) ]). 1974:- http_handler(root(pengine/send),          http_pengine_send,
 1975                [ time_limit(infinite), spawn([]) ]). 1976:- http_handler(root(pengine/pull_response), http_pengine_pull_response,
 1977                [ time_limit(infinite), spawn([]) ]). 1978:- http_handler(root(pengine/abort),         http_pengine_abort,         []). 1979:- http_handler(root(pengine/ping),          http_pengine_ping,          []). 1980:- http_handler(root(pengine/destroy_all),   http_pengine_destroy_all,   []). 1981
 1982:- http_handler(root(pengine/'pengines.js'),
 1983                http_reply_file(library('http/web/js/pengines.js'), []), []). 1984:- http_handler(root(pengine/'plterm.css'),
 1985                http_reply_file(library('http/web/css/plterm.css'), []), []).
 http_pengine_create(+Request)
HTTP POST handler for =/pengine/create=. This API accepts the pengine creation parameters both as application/json and as www-form-encoded. Accepted parameters:
ParameterDefaultComment
formatprologOutput format
applicationpengine_sandboxPengine application
chunk1Chunk-size for results
solutionschunkedIf all, emit all results
ask-The query
template-Output template
src_text""Program
src_url-Program to download
disposition-Download location

Note that solutions=all internally uses chunking to obtain the results from the pengine, but the results are combined in a single HTTP reply. This is currently only implemented by the CSV backend that is part of SWISH for downloading unbounded result sets with limited memory resources.

 2012http_pengine_create(Request) :-
 2013    reply_options(Request, [post]),
 2014    !.
 2015http_pengine_create(Request) :-
 2016    memberchk(content_type(CT), Request),
 2017    sub_atom(CT, 0, _, _, 'application/json'),
 2018    !,
 2019    http_read_json_dict(Request, Dict),
 2020    dict_atom_option(format, Dict, Format, prolog),
 2021    dict_atom_option(application, Dict, Application, pengine_sandbox),
 2022    http_pengine_create(Request, Application, Format, Dict).
 2023http_pengine_create(Request) :-
 2024    Optional = [optional(true)],
 2025    OptString = [string|Optional],
 2026    Form = [ format(Format, [default(prolog)]),
 2027             application(Application, [default(pengine_sandbox)]),
 2028             chunk(_, [integer, default(1)]),
 2029             solutions(_, [oneof([all,chunked]), default(chunked)]),
 2030             ask(_, OptString),
 2031             template(_, OptString),
 2032             src_text(_, OptString),
 2033             disposition(_, OptString),
 2034             src_url(_, Optional)
 2035           ],
 2036    http_parameters(Request, Form),
 2037    form_dict(Form, Dict),
 2038    http_pengine_create(Request, Application, Format, Dict).
 2039
 2040dict_atom_option(Key, Dict, Atom, Default) :-
 2041    (   get_dict(Key, Dict, String)
 2042    ->  atom_string(Atom, String)
 2043    ;   Atom = Default
 2044    ).
 2045
 2046form_dict(Form, Dict) :-
 2047    form_values(Form, Pairs),
 2048    dict_pairs(Dict, _, Pairs).
 2049
 2050form_values([], []).
 2051form_values([H|T], Pairs) :-
 2052    arg(1, H, Value),
 2053    nonvar(Value),
 2054    !,
 2055    functor(H, Name, _),
 2056    Pairs = [Name-Value|PairsT],
 2057    form_values(T, PairsT).
 2058form_values([_|T], Pairs) :-
 2059    form_values(T, Pairs).
 http_pengine_create(+Request, +Application, +Format, +OptionsDict)
 2064http_pengine_create(Request, Application, Format, Dict) :-
 2065    current_application(Application),
 2066    !,
 2067    allowed(Request, Application),
 2068    authenticate(Request, Application, UserOptions),
 2069    dict_to_options(Dict, Application, CreateOptions0),
 2070    append(UserOptions, CreateOptions0, CreateOptions),
 2071    pengine_uuid(Pengine),
 2072    message_queue_create(Queue, [max_size(25)]),
 2073    setting(Application:time_limit, TimeLimit),
 2074    get_time(Now),
 2075    asserta(pengine_queue(Pengine, Queue, TimeLimit, Now)),
 2076    broadcast(pengine(create(Pengine, Application, CreateOptions))),
 2077    create(Queue, Pengine, CreateOptions, http, Application),
 2078    create_wait_and_output_result(Pengine, Queue, Format,
 2079                                  TimeLimit, Dict),
 2080    gc_abandoned_queues.
 2081http_pengine_create(_Request, Application, Format, _Dict) :-
 2082    Error = existence_error(pengine_application, Application),
 2083    pengine_uuid(ID),
 2084    output_result(Format, error(ID, error(Error, _))).
 2085
 2086
 2087dict_to_options(Dict, Application, CreateOptions) :-
 2088    dict_pairs(Dict, _, Pairs),
 2089    pairs_create_options(Pairs, Application, CreateOptions).
 2090
 2091pairs_create_options([], _, []) :- !.
 2092pairs_create_options(T0, App, CreateOpts) :-
 2093    selectchk(ask-Ask, T0, T1),
 2094    selectchk(template-Template, T1, T2),
 2095    !,
 2096    CreateOpts = [ ask(Ask1), template(Template1), bindings(Bindings) | T ],
 2097    format(string(AskTemplate), 't((~s),(~s))', [Ask, Template]),
 2098    term_string(t(Ask1,Template1), AskTemplate,
 2099                [ variable_names(Bindings),
 2100                  module(App)
 2101                ]),
 2102    pairs_create_options(T2, App, T).
 2103pairs_create_options([ask-String|T0], App,
 2104                     [ask(Ask),template(Template),bindings(Bindings1)|T]) :-
 2105    !,
 2106    term_string(Ask, String,
 2107                [ variable_names(Bindings),
 2108                  module(App)
 2109                ]),
 2110    exclude(anon, Bindings, Bindings1),
 2111    dict_create(Template, json, Bindings1),
 2112    pairs_create_options(T0, App, T).
 2113pairs_create_options([N-V0|T0], App, [Opt|T]) :-
 2114    Opt =.. [N,V],
 2115    pengine_create_option(Opt), N \== user,
 2116    !,
 2117    (   create_option_type(Opt, Type)
 2118    ->  (   Type == term
 2119        ->  atom_to_term(V0, V, _)
 2120        ;   Type == atom
 2121        ->  atom_string(V, V0)
 2122        ;   assertion(false)
 2123        )
 2124    ;   V = V0
 2125    ),
 2126    pairs_create_options(T0, App, T).
 2127pairs_create_options([_|T0], App, T) :-
 2128    pairs_create_options(T0, App, T).
 wait_and_output_result(+Pengine, +Queue, +Format, +TimeLimit) is det
Wait for the Pengine's Queue and if there is a message, send it to the requester using output_result/1. If Pengine does not answer within the time specified by the setting time_limit, Pengine is aborted and the result is error(time_limit_exceeded, _).
 2140wait_and_output_result(Pengine, Queue, Format, TimeLimit) :-
 2141    (   catch(thread_get_message(Queue, pengine_event(_, Event),
 2142                                 [ timeout(TimeLimit)
 2143                                 ]),
 2144              Error, true)
 2145    ->  (   var(Error)
 2146        ->  debug(pengine(wait), 'Got ~q from ~q', [Event, Queue]),
 2147            ignore(destroy_queue_from_http(Pengine, Event, Queue)),
 2148            output_result(Format, Event)
 2149        ;   output_result(Format, died(Pengine))
 2150        )
 2151    ;   time_limit_exceeded(Pengine, Format)
 2152    ).
 create_wait_and_output_result(+Pengine, +Queue, +Format, +TimeLimit, +Dict) is det
Intercepts the `solutions=all' case used for downloading results. Dict may contain a disposition key to denote the download location.
 2161create_wait_and_output_result(Pengine, Queue, Format, TimeLimit, Dict) :-
 2162    get_dict(solutions, Dict, all),
 2163    !,
 2164    between(1, infinite, Page),
 2165    (   catch(thread_get_message(Queue, pengine_event(_, Event),
 2166                                 [ timeout(TimeLimit)
 2167                                 ]),
 2168              Error, true)
 2169    ->  (   var(Error)
 2170        ->  debug(pengine(wait), 'Page ~D: got ~q from ~q', [Page, Event, Queue]),
 2171            (   destroy_queue_from_http(Pengine, Event, Queue)
 2172            ->  !, output_result(Format, page(Page, Event))
 2173            ;   is_more_event(Event)
 2174            ->  pengine_thread(Pengine, Thread),
 2175                thread_send_message(Thread, pengine_request(next)),
 2176                output_result(Format, page(Page, Event), Dict),
 2177                fail
 2178            ;   !, output_result(Format, page(Page, Event), Dict)
 2179            )
 2180        ;   !, output_result(Format, died(Pengine))
 2181        )
 2182    ;   !, time_limit_exceeded(Pengine, Format)
 2183    ),
 2184    !.
 2185create_wait_and_output_result(Pengine, Queue, Format, TimeLimit, _Dict) :-
 2186    wait_and_output_result(Pengine, Queue, Format, TimeLimit).
 2187
 2188is_more_event(success(_Id, _Answers, _Projection, _Time, true)).
 2189is_more_event(create(_, Options)) :-
 2190    memberchk(answer(Event), Options),
 2191    is_more_event(Event).
 time_limit_exceeded(+Pengine, +Format)
The Pengine did not reply within its time limit. Send a reply to the client in the requested format and interrupt the Pengine.
bug
- Ideally, if the Pengine has destroy set to false, we should get the Pengine back to its main loop. Unfortunately we only have normal exceptions that may be caught by the Pengine and abort which cannot be caught and thus destroys the Pengine.
 2205time_limit_exceeded(Pengine, Format) :-
 2206    call_cleanup(
 2207        pengine_destroy(Pengine, [force(true)]),
 2208        output_result(Format,
 2209                      destroy(Pengine,
 2210                              error(Pengine, time_limit_exceeded)))).
 destroy_queue_from_http(+Pengine, +Event, +Queue) is semidet
Consider destroying the output queue for Pengine after sending Event back to the HTTP client. We can destroy the queue if
To be done
- If the client did not request all output, the queue will not be destroyed. We need some timeout and GC for that.
 2225destroy_queue_from_http(ID, _, Queue) :-
 2226    output_queue(ID, Queue, _),
 2227    !,
 2228    destroy_queue_if_empty(Queue).
 2229destroy_queue_from_http(ID, Event, Queue) :-
 2230    debug(pengine(destroy), 'DESTROY? ~p', [Event]),
 2231    is_destroy_event(Event),
 2232    !,
 2233    message_queue_property(Queue, size(Waiting)),
 2234    debug(pengine(destroy), 'Destroy ~p (waiting ~D)', [Queue, Waiting]),
 2235    with_mutex(pengine, sync_destroy_queue_from_http(ID, Queue)).
 2236
 2237is_destroy_event(destroy(_)).
 2238is_destroy_event(destroy(_,_)).
 2239is_destroy_event(create(_, Options)) :-
 2240    memberchk(answer(Event), Options),
 2241    is_destroy_event(Event).
 2242
 2243destroy_queue_if_empty(Queue) :-
 2244    thread_peek_message(Queue, _),
 2245    !.
 2246destroy_queue_if_empty(Queue) :-
 2247    retractall(output_queue(_, Queue, _)),
 2248    message_queue_destroy(Queue).
 gc_abandoned_queues
Check whether there are queues that have been abadoned. This happens if the stream contains output events and not all of them are read by the client.
 2256:- dynamic
 2257    last_gc/1. 2258
 2259gc_abandoned_queues :-
 2260    consider_queue_gc,
 2261    !,
 2262    get_time(Now),
 2263    (   output_queue(_, Queue, Time),
 2264        Now-Time > 15*60,
 2265        retract(output_queue(_, Queue, Time)),
 2266        message_queue_destroy(Queue),
 2267        fail
 2268    ;   retractall(last_gc(_)),
 2269        asserta(last_gc(Now))
 2270    ).
 2271gc_abandoned_queues.
 2272
 2273consider_queue_gc :-
 2274    predicate_property(output_queue(_,_,_), number_of_clauses(N)),
 2275    N > 100,
 2276    (   last_gc(Time),
 2277        get_time(Now),
 2278        Now-Time > 5*60
 2279    ->  true
 2280    ;   \+ last_gc(_)
 2281    ).
 sync_destroy_queue_from_http(+Pengine, +Queue) is det
 sync_delay_destroy_queue(+Pengine, +Queue) is det
Handle destruction of the message queue connecting the HTTP side to the pengine. We cannot delete the queue when the pengine dies because the queue may contain output events. Termination of the pengine and finishing the HTTP exchange may happen in both orders. This means we need handle this using synchronization.
sync_destroy_queue_from_pengine(+Pengine, +Queue)
Called (indirectly) from pengine_done/1 if the pengine's thread dies.
sync_destroy_queue_from_http(+Pengine, +Queue)
Called from destroy_queue/3, from wait_and_output_result/4, i.e., from the HTTP side.
 2299:- dynamic output_queue_destroyed/1. 2300
 2301sync_destroy_queue_from_http(ID, Queue) :-
 2302    (   output_queue(ID, Queue, _)
 2303    ->  destroy_queue_if_empty(Queue)
 2304    ;   thread_peek_message(Queue, pengine_event(_, output(_,_)))
 2305    ->  debug(pengine(destroy), 'Delay destruction of ~p because of output',
 2306              [Queue]),
 2307        get_time(Now),
 2308        asserta(output_queue(ID, Queue, Now))
 2309    ;   message_queue_destroy(Queue),
 2310        asserta(output_queue_destroyed(Queue))
 2311    ).
 sync_destroy_queue_from_pengine(+Pengine, +Queue)
Called from pengine_unregister/1 when the pengine thread terminates. It is called while the mutex pengine held.
 2318sync_destroy_queue_from_pengine(ID, Queue) :-
 2319    (   retract(output_queue_destroyed(Queue))
 2320    ->  true
 2321    ;   get_time(Now),
 2322        asserta(output_queue(ID, Queue, Now))
 2323    ),
 2324    retractall(pengine_queue(ID, Queue, _, _)).
 2325
 2326
 2327http_pengine_send(Request) :-
 2328    reply_options(Request, [get,post]),
 2329    !.
 2330http_pengine_send(Request) :-
 2331    http_parameters(Request,
 2332                    [ id(ID, [ type(atom) ]),
 2333                      event(EventString, [optional(true)]),
 2334                      format(Format, [default(prolog)])
 2335                    ]),
 2336    get_pengine_module(ID, Module),
 2337    (   current_module(Module)          % avoid re-creating the module
 2338    ->  catch(( read_event(Request, EventString, Module, Event0, Bindings),
 2339                fix_bindings(Format, Event0, Bindings, Event1)
 2340              ),
 2341              Error,
 2342              true),
 2343        (   var(Error)
 2344        ->  debug(pengine(event), 'HTTP send: ~p', [Event1]),
 2345            (   pengine_thread(ID, Thread)
 2346            ->  pengine_queue(ID, Queue, TimeLimit, _),
 2347                random_delay,
 2348                broadcast(pengine(send(ID, Event1))),
 2349                thread_send_message(Thread, pengine_request(Event1)),
 2350                wait_and_output_result(ID, Queue, Format, TimeLimit)
 2351            ;   atom(ID)
 2352            ->  pengine_died(Format, ID)
 2353            ;   http_404([], Request)
 2354            )
 2355        ;   output_result(Format, error(ID, Error))
 2356        )
 2357    ;   debug(pengine(event), 'Pengine module ~q vanished', [Module]),
 2358        discard_post_data(Request),
 2359        pengine_died(Format, ID)
 2360    ).
 2361
 2362pengine_died(Format, Pengine) :-
 2363    output_result(Format, error(Pengine,
 2364                                error(existence_error(pengine, Pengine),_))).
 read_event(+Request, +EventString, +Module, -Event, -Bindings)
Read the sent event. The event is a Prolog term that is either in the event parameter or as a posted document.
 2372read_event(_Request, EventString, Module, Event, Bindings) :-
 2373    nonvar(EventString),
 2374    !,
 2375    term_string(Event, EventString,
 2376                [ variable_names(Bindings),
 2377                  module(Module)
 2378                ]).
 2379read_event(Request, _EventString, Module, Event, Bindings) :-
 2380    option(method(post), Request),
 2381    http_read_data(Request,     Event,
 2382                   [ content_type('application/x-prolog'),
 2383                     module(Module),
 2384                     variable_names(Bindings)
 2385                   ]).
 discard_post_data(+Request) is det
If this is a POST request, discard the posted data.
 2391discard_post_data(Request) :-
 2392    option(method(post), Request),
 2393    !,
 2394    setup_call_cleanup(
 2395        open_null_stream(NULL),
 2396        http_read_data(Request, _, [to(stream(NULL))]),
 2397        close(NULL)).
 2398discard_post_data(_).
 fix_bindings(+Format, +EventIn, +Bindings, -Event) is det
Generate the template for json(-s) Format from the variables in the asked Goal. Variables starting with an underscore, followed by an capital letter are ignored from the template.
 2406fix_bindings(Format,
 2407             ask(Goal, Options0), Bindings,
 2408             ask(Goal, NewOptions)) :-
 2409    json_lang(Format),
 2410    !,
 2411    exclude(anon, Bindings, NamedBindings),
 2412    template(NamedBindings, Template, Options0, Options1),
 2413    select_option(chunk(Paging), Options1, Options2, 1),
 2414    NewOptions = [ template(Template),
 2415                   chunk(Paging),
 2416                   bindings(NamedBindings)
 2417                 | Options2
 2418                 ].
 2419fix_bindings(_, Command, _, Command).
 2420
 2421template(_, Template, Options0, Options) :-
 2422    select_option(template(Template), Options0, Options),
 2423    !.
 2424template(Bindings, Template, Options, Options) :-
 2425    dict_create(Template, json, Bindings).
 2426
 2427anon(Name=_) :-
 2428    sub_atom(Name, 0, _, _, '_'),
 2429    sub_atom(Name, 1, 1, _, Next),
 2430    char_type(Next, prolog_var_start).
 2431
 2432var_name(Name=_, Name).
 json_lang(+Format) is semidet
True if Format is a JSON variation.
 2439json_lang(json) :- !.
 2440json_lang(Format) :-
 2441    sub_atom(Format, 0, _, _, 'json-').
 http_pengine_pull_response(+Request)
HTTP handler for /pengine/pull_response. Pulls possible pending messages from the pengine.
 2448http_pengine_pull_response(Request) :-
 2449    reply_options(Request, [get]),
 2450    !.
 2451http_pengine_pull_response(Request) :-
 2452    http_parameters(Request,
 2453            [   id(ID, []),
 2454                format(Format, [default(prolog)])
 2455            ]),
 2456    (   (   pengine_queue(ID, Queue, TimeLimit, _)
 2457        ->  true
 2458        ;   output_queue(ID, Queue, _),
 2459            TimeLimit = 0
 2460        )
 2461    ->  wait_and_output_result(ID, Queue, Format, TimeLimit)
 2462    ;   http_404([], Request)
 2463    ).
 http_pengine_abort(+Request)
HTTP handler for /pengine/abort. Note that abort may be sent at any time and the reply may be handled by a pull_response. In that case, our pengine has already died before we get to wait_and_output_result/4.
 2472http_pengine_abort(Request) :-
 2473    reply_options(Request, [get]),
 2474    !.
 2475http_pengine_abort(Request) :-
 2476    http_parameters(Request,
 2477            [   id(ID, []),
 2478                format(Format, [default(prolog)])
 2479            ]),
 2480    (   pengine_thread(ID, _Thread),
 2481        pengine_queue(ID, Queue, TimeLimit, _)
 2482    ->  broadcast(pengine(abort(ID))),
 2483        abort_pending_output(ID),
 2484        pengine_abort(ID),
 2485        wait_and_output_result(ID, Queue, Format, TimeLimit)
 2486    ;   http_404([], Request)
 2487    ).
 2488
 2489http_pengine_destroy_all(Request) :-
 2490    reply_options(Request, [get]),
 2491    !.
 2492http_pengine_destroy_all(Request) :-
 2493    http_parameters(Request,
 2494                    [ ids(IDsAtom, [])
 2495                    ]),
 2496    atomic_list_concat(IDs, ',', IDsAtom),
 2497    forall(member(ID, IDs),
 2498           pengine_destroy(ID, [force(true)])),
 2499    reply_json("ok").
 http_pengine_ping(+Request)
HTTP handler for /pengine/ping. If the requested Pengine is alive and event status(Pengine, Stats) is created, where Stats is the return of thread_statistics/2.
 2507http_pengine_ping(Request) :-
 2508    reply_options(Request, [get]),
 2509    !.
 2510http_pengine_ping(Request) :-
 2511    http_parameters(Request,
 2512                    [ id(Pengine, []),
 2513                      format(Format, [default(prolog)])
 2514                    ]),
 2515    (   pengine_thread(Pengine, Thread),
 2516        catch(thread_statistics(Thread, Stats), _, fail)
 2517    ->  output_result(Format, ping(Pengine, Stats))
 2518    ;   output_result(Format, died(Pengine))
 2519    ).
 output_result(+Format, +EventTerm) is det
 output_result(+Format, +EventTerm, +OptionsDict) is det
Formulate an HTTP response from a pengine event term. Format is one of prolog, json or json-s.
 2528:- dynamic
 2529    pengine_replying/2.             % +Pengine, +Thread
 2530
 2531output_result(Format, Event) :-
 2532    arg(1, Event, Pengine),
 2533    thread_self(Thread),
 2534    setup_call_cleanup(
 2535        asserta(pengine_replying(Pengine, Thread), Ref),
 2536        catch(output_result(Format, Event, _{}),
 2537              pengine_abort_output,
 2538              true),
 2539        erase(Ref)).
 2540
 2541output_result(prolog, Event, _) :-
 2542    !,
 2543    format('Content-type: text/x-prolog; charset=UTF-8~n~n'),
 2544    write_term(Event,
 2545               [ quoted(true),
 2546                 ignore_ops(true),
 2547                 fullstop(true),
 2548                 blobs(portray),
 2549                 portray_goal(portray_blob),
 2550                 nl(true)
 2551               ]).
 2552output_result(Lang, Event, Dict) :-
 2553    write_result(Lang, Event, Dict),
 2554    !.
 2555output_result(Lang, Event, _) :-
 2556    json_lang(Lang),
 2557    !,
 2558    (   event_term_to_json_data(Event, JSON, Lang)
 2559    ->  cors_enable,
 2560        disable_client_cache,
 2561        reply_json(JSON)
 2562    ;   assertion(event_term_to_json_data(Event, _, Lang))
 2563    ).
 2564output_result(Lang, _Event, _) :-    % FIXME: allow for non-JSON format
 2565    domain_error(pengine_format, Lang).
 portray_blob(+Blob, +Options) is det
Portray non-text blobs that may appear in output terms. Not really sure about that. Basically such terms need to be avoided as they are meaningless outside the process. The generated error is hard to debug though, so now we send them as '$BLOB'(Type). Future versions may include more info, depending on Type.
 2575:- public portray_blob/2.               % called from write-term
 2576portray_blob(Blob, _Options) :-
 2577    blob(Blob, Type),
 2578    writeq('$BLOB'(Type)).
 abort_pending_output(+Pengine) is det
If we get an abort, it is possible that output is being produced for the client. This predicate aborts these threads.
 2585abort_pending_output(Pengine) :-
 2586    forall(pengine_replying(Pengine, Thread),
 2587           abort_output_thread(Thread)).
 2588
 2589abort_output_thread(Thread) :-
 2590    catch(thread_signal(Thread, throw(pengine_abort_output)),
 2591          error(existence_error(thread, _), _),
 2592          true).
 write_result(+Lang, +Event, +Dict) is semidet
Hook that allows for different output formats. The core Pengines library supports prolog and various JSON dialects. The hook event_to_json/3 can be used to refine the JSON dialects. This hook must be used if a completely different output format is desired.
 disable_client_cache
Make sure the client will not cache our page.
See also
- http://stackoverflow.com/questions/49547/making-sure-a-web-page-is-not-cached-across-all-browsers
 2608disable_client_cache :-
 2609    format('Cache-Control: no-cache, no-store, must-revalidate\r\n\c
 2610            Pragma: no-cache\r\n\c
 2611            Expires: 0\r\n').
 2612
 2613event_term_to_json_data(Event, JSON, Lang) :-
 2614    event_to_json(Event, JSON, Lang),
 2615    !.
 2616event_term_to_json_data(success(ID, Bindings0, Projection, Time, More),
 2617                        json{event:success, id:ID, time:Time,
 2618                             data:Bindings, more:More, projection:Projection},
 2619                        json) :-
 2620    !,
 2621    term_to_json(Bindings0, Bindings).
 2622event_term_to_json_data(destroy(ID, Event),
 2623                        json{event:destroy, id:ID, data:JSON},
 2624                        Style) :-
 2625    !,
 2626    event_term_to_json_data(Event, JSON, Style).
 2627event_term_to_json_data(create(ID, Features0), JSON, Style) :-
 2628    !,
 2629    (   select(answer(First0), Features0, Features1)
 2630    ->  event_term_to_json_data(First0, First, Style),
 2631        Features = [answer(First)|Features1]
 2632    ;   Features = Features0
 2633    ),
 2634    dict_create(JSON, json, [event(create), id(ID)|Features]).
 2635event_term_to_json_data(destroy(ID, Event),
 2636                        json{event:destroy, id:ID, data:JSON}, Style) :-
 2637    !,
 2638    event_term_to_json_data(Event, JSON, Style).
 2639event_term_to_json_data(error(ID, ErrorTerm), Error, _Style) :-
 2640    !,
 2641    Error0 = json{event:error, id:ID, data:Message},
 2642    add_error_details(ErrorTerm, Error0, Error),
 2643    message_to_string(ErrorTerm, Message).
 2644event_term_to_json_data(failure(ID, Time),
 2645                        json{event:failure, id:ID, time:Time}, _) :-
 2646    !.
 2647event_term_to_json_data(EventTerm, json{event:F, id:ID}, _) :-
 2648    functor(EventTerm, F, 1),
 2649    !,
 2650    arg(1, EventTerm, ID).
 2651event_term_to_json_data(EventTerm, json{event:F, id:ID, data:JSON}, _) :-
 2652    functor(EventTerm, F, 2),
 2653    arg(1, EventTerm, ID),
 2654    arg(2, EventTerm, Data),
 2655    term_to_json(Data, JSON).
 2656
 2657:- public add_error_details/3.
 add_error_details(+Error, +JSON0, -JSON)
Add format error code and location information to an error. Also used by pengines_io.pl.
 2664add_error_details(Error, JSON0, JSON) :-
 2665    add_error_code(Error, JSON0, JSON1),
 2666    add_error_location(Error, JSON1, JSON).
 add_error_code(+Error, +JSON0, -JSON) is det
Add a code field to JSON0 of Error is an ISO error term. The error code is the functor name of the formal part of the error, e.g., syntax_error, type_error, etc. Some errors carry more information:
existence_error(Type, Obj)
{arg1:Type, arg2:Obj}, where Obj is stringified of it is not atomic.
 2679add_error_code(error(existence_error(Type, Obj), _), Error0, Error) :-
 2680    atom(Type),
 2681    !,
 2682    to_atomic(Obj, Value),
 2683    Error = Error0.put(_{code:existence_error, arg1:Type, arg2:Value}).
 2684add_error_code(error(Formal, _), Error0, Error) :-
 2685    callable(Formal),
 2686    !,
 2687    functor(Formal, Code, _),
 2688    Error = Error0.put(code, Code).
 2689add_error_code(_, Error, Error).
 2690
 2691% What to do with large integers?
 2692to_atomic(Obj, Atomic) :- atom(Obj),   !, Atomic = Obj.
 2693to_atomic(Obj, Atomic) :- number(Obj), !, Atomic = Obj.
 2694to_atomic(Obj, Atomic) :- string(Obj), !, Atomic = Obj.
 2695to_atomic(Obj, Atomic) :- term_string(Obj, Atomic).
 add_error_location(+Error, +JSON0, -JSON) is det
Add a location property if the error can be associated with a source location. The location is an object with properties file and line and, if available, the character location in the line.
 2704add_error_location(error(_, file(Path, Line, -1, _CharNo)), Term0, Term) :-
 2705    atom(Path), integer(Line),
 2706    !,
 2707    Term = Term0.put(_{location:_{file:Path, line:Line}}).
 2708add_error_location(error(_, file(Path, Line, Ch, _CharNo)), Term0, Term) :-
 2709    atom(Path), integer(Line), integer(Ch),
 2710    !,
 2711    Term = Term0.put(_{location:_{file:Path, line:Line, ch:Ch}}).
 2712add_error_location(_, Term, Term).
 event_to_json(+Event, -JSONTerm, +Lang) is semidet
Hook that translates a Pengine event structure into a term suitable for reply_json/1, according to the language specification Lang. This can be used to massage general Prolog terms, notably associated with success(ID, Bindings, Projection, Time, More) and output(ID, Term) into a format suitable for processing at the client side.
 2723%:- multifile pengines:event_to_json/3.
 2724
 2725
 2726                 /*******************************
 2727                 *        ACCESS CONTROL        *
 2728                 *******************************/
 allowed(+Request, +Application) is det
Check whether the peer is allowed to connect. Returns a forbidden header if contact is not allowed.
 2735allowed(Request, Application) :-
 2736    setting(Application:allow_from, Allow),
 2737    match_peer(Request, Allow),
 2738    setting(Application:deny_from, Deny),
 2739    \+ match_peer(Request, Deny),
 2740    !.
 2741allowed(Request, _Application) :-
 2742    memberchk(request_uri(Here), Request),
 2743    throw(http_reply(forbidden(Here))).
 2744
 2745match_peer(_, Allowed) :-
 2746    memberchk(*, Allowed),
 2747    !.
 2748match_peer(_, []) :- !, fail.
 2749match_peer(Request, Allowed) :-
 2750    http_peer(Request, Peer),
 2751    debug(pengine(allow), 'Peer: ~q, Allow: ~q', [Peer, Allowed]),
 2752    (   memberchk(Peer, Allowed)
 2753    ->  true
 2754    ;   member(Pattern, Allowed),
 2755        match_peer_pattern(Pattern, Peer)
 2756    ).
 2757
 2758match_peer_pattern(Pattern, Peer) :-
 2759    ip_term(Pattern, IP),
 2760    ip_term(Peer, IP),
 2761    !.
 2762
 2763ip_term(Peer, Pattern) :-
 2764    split_string(Peer, ".", "", PartStrings),
 2765    ip_pattern(PartStrings, Pattern).
 2766
 2767ip_pattern([], []).
 2768ip_pattern([*], _) :- !.
 2769ip_pattern([S|T0], [N|T]) :-
 2770    number_string(N, S),
 2771    ip_pattern(T0, T).
 authenticate(+Request, +Application, -UserOptions:list) is det
Call authentication_hook/3, returning either [user(User)], [] or an exception.
 2779authenticate(Request, Application, UserOptions) :-
 2780    authentication_hook(Request, Application, User),
 2781    !,
 2782    must_be(ground, User),
 2783    UserOptions = [user(User)].
 2784authenticate(_, _, []).
 authentication_hook(+Request, +Application, -User) is semidet
This hook is called from the =/pengine/create= HTTP handler to discover whether the server is accessed by an authorized user. It can react in three ways:
See also
- http_authenticate/3 can be used to implement this hook using default HTTP authentication data.
 2806pengine_register_user(Options) :-
 2807    option(user(User), Options),
 2808    !,
 2809    pengine_self(Me),
 2810    asserta(pengine_user(Me, User)).
 2811pengine_register_user(_).
 pengine_user(-User) is semidet
True when the pengine was create by an HTTP request that authorized User.
See also
- authentication_hook/3 can be used to extract authorization from the HTTP header.
 2822pengine_user(User) :-
 2823    pengine_self(Me),
 2824    pengine_user(Me, User).
 reply_options(+Request, +Methods) is semidet
Reply the HTTP OPTIONS request
 2830reply_options(Request, Allowed) :-
 2831    option(method(options), Request),
 2832    !,
 2833    cors_enable(Request,
 2834                [ methods(Allowed)
 2835                ]),
 2836    format('Content-type: text/plain\r\n'),
 2837    format('~n').                   % empty body
 2838
 2839
 2840                 /*******************************
 2841                 *        COMPILE SOURCE        *
 2842                 *******************************/
 pengine_src_text(+SrcText, +Module) is det
Asserts the clauses defined in SrcText in the private database of the current Pengine. This predicate processes the `src_text' option of pengine_create/1. */
 2851pengine_src_text(Src, Module) :-
 2852    pengine_self(Self),
 2853    format(atom(ID), 'pengine://~w/src', [Self]),
 2854    extra_load_options(Self, Options),
 2855    setup_call_cleanup(
 2856        open_chars_stream(Src, Stream),
 2857        load_files(Module:ID,
 2858                   [ stream(Stream),
 2859                     module(Module),
 2860                     silent(true)
 2861                   | Options
 2862                   ]),
 2863        close(Stream)),
 2864    keep_source(Self, ID, Src).
 2865
 2866system:'#file'(File, _Line) :-
 2867    prolog_load_context(stream, Stream),
 2868    set_stream(Stream, file_name(File)),
 2869    set_stream(Stream, record_position(false)),
 2870    set_stream(Stream, record_position(true)).
 pengine_src_url(+URL, +Module) is det
Asserts the clauses defined in URL in the private database of the current Pengine. This predicate processes the `src_url' option of pengine_create/1.
To be done
- : make a sensible guess at the encoding.
 2880pengine_src_url(URL, Module) :-
 2881    pengine_self(Self),
 2882    uri_encoded(path, URL, Path),
 2883    format(atom(ID), 'pengine://~w/url/~w', [Self, Path]),
 2884    extra_load_options(Self, Options),
 2885    (   get_pengine_application(Self, Application),
 2886        setting(Application:debug_info, false)
 2887    ->  setup_call_cleanup(
 2888            http_open(URL, Stream, []),
 2889            ( set_stream(Stream, encoding(utf8)),
 2890              load_files(Module:ID,
 2891                         [ stream(Stream),
 2892                           module(Module)
 2893                         | Options
 2894                         ])
 2895            ),
 2896            close(Stream))
 2897    ;   setup_call_cleanup(
 2898            http_open(URL, TempStream, []),
 2899            ( set_stream(TempStream, encoding(utf8)),
 2900              read_string(TempStream, _, Src)
 2901            ),
 2902            close(TempStream)),
 2903        setup_call_cleanup(
 2904            open_chars_stream(Src, Stream),
 2905            load_files(Module:ID,
 2906                       [ stream(Stream),
 2907                         module(Module)
 2908                       | Options
 2909                       ]),
 2910            close(Stream)),
 2911        keep_source(Self, ID, Src)
 2912    ).
 2913
 2914
 2915extra_load_options(Pengine, Options) :-
 2916    pengine_not_sandboxed(Pengine),
 2917    !,
 2918    Options = [].
 2919extra_load_options(_, [sandboxed(true)]).
 2920
 2921
 2922keep_source(Pengine, ID, SrcText) :-
 2923    get_pengine_application(Pengine, Application),
 2924    setting(Application:debug_info, true),
 2925    !,
 2926    to_string(SrcText, SrcString),
 2927    assertz(pengine_data(Pengine, source(ID, SrcString))).
 2928keep_source(_, _, _).
 2929
 2930to_string(String, String) :-
 2931    string(String),
 2932    !.
 2933to_string(Atom, String) :-
 2934    atom_string(Atom, String),
 2935    !.
 2936
 2937
 2938                 /*******************************
 2939                 *            MESSAGES          *
 2940                 *******************************/
 2941
 2942prolog:error_message(sandbox(time_limit_exceeded, Limit)) -->
 2943    [ 'Could not prove safety of your goal within ~f seconds.'-[Limit], nl,
 2944      'This is normally caused by an insufficiently instantiated'-[], nl,
 2945      'meta-call (e.g., call(Var)) for which it is too expensive to'-[], nl,
 2946      'find all possible instantations of Var.'-[]
 2947    ]