kibi-swipl-linux-x64-gnu 1.0.0

package/lib/swipl/library/ext/http/http/http_dyn_workers.pl

@@ -0,0 +1,214 @@
+/*  Part of SWISH
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@cs.vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (C): 2018, VU University Amsterdam
+			 CWI Amsterdam
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
+
+:- module(http_dyn_workers,
+          [
+          ]).
+:- use_module(library(http/thread_httpd)).
+:- use_module(library(debug)).
+:- use_module(library(settings)).
+:- use_module(library(aggregate)).
+
+:- setting(http:max_workers, integer, 100,
+           "Maximum number of workers to create").
+:- setting(http:worker_idle_limit, number, 10,
+           "Terminate a dynamic worker when idle for this time").
+:- setting(http:max_load, number, 10,
+           "Maximum load average caused by HTTP workers").
+
+/** <module> Dynamically schedule HTTP workers.
+
+Most   code   doesn't   need  to   use  this   directly;  instead   use
+library(http/http_server),  which  combines   this  library  with   the
+typical HTTP libraries that most servers need.
+
+This module defines  hooks  into  the   HTTP  framework  to  dynamically
+schedule worker threads. Dynamic scheduling relieves   us from finding a
+good value for the size of the HTTP worker pool.
+
+The decision to add a worker follows these rules:
+
+  - If the load average caused by the worker threads exceeds
+    http:max_load, no worker is added.
+  - Wait for some time, depending on how close we are to the
+    http:max_workers limit.
+    - If the worker is still needed, add it.
+
+The policy depends on three settings:
+
+  - http:max_workers
+    The maximum number of workers that will be created.  Default is
+    100.
+  - http:worker_idle_limit
+    The number of seconds a dynamic worker waits for a new job.  If
+    no job arrives in time it terminates.  Default is 10 seconds.
+  - http:max_load
+    Max load average created by __the HTTP server__, i.e. the amount
+    of CPU time consumed per second.  Default is 10.
+*/
+
+%!  http:schedule_workers(+Dict)
+%
+%   Called if there  is  no  immediately   free  worker  to  handle  the
+%   incoming  request.  The  request  is    forwarded   to  the  thread
+%   =|__http_scheduler|= as the hook is called in time critical code.
+
+:- multifile
+    http:schedule_workers/1.
+
+http:schedule_workers(Dict) :-
+    get_time(Now),
+    catch(thread_send_message('__http_scheduler', no_workers(Now, Dict)),
+          error(existence_error(message_queue, _), _),
+          fail),
+    !.
+http:schedule_workers(Dict) :-
+    create_scheduler,
+    http:schedule_workers(Dict).
+
+create_scheduler :-
+    catch(thread_create(http_scheduler, _,
+                        [ alias('__http_scheduler'),
+                          inherit_from(main),
+                          debug(false),
+                          detached(true)
+                        ]),
+          error(_,_),
+          fail).
+
+http_scheduler :-
+    get_time(Now),
+    http_scheduler(_{ waiting:0,
+                      time:Now
+                    }).
+
+http_scheduler(State) :-
+    (   thread_self(Me),
+        thread_get_message(Me, Task, [timeout(10)])
+    ->  true
+    ;   Task = update_load_avg
+    ),
+    (   catch(reschedule(Task, State, State1),
+              Error,
+              ( print_message(warning, Error),
+                fail))
+    ->  !,
+        http_scheduler(State1)
+    ;   http_scheduler(State)
+    ).
+
+%!  reschedule(+Message, +State0, -State) is semidet.
+
+reschedule(no_workers(Reported, Dict), State0, State) :-
+    update_load_avg(Dict, State0, State, Load),
+    setting(http:max_load, MaxLoad),
+    (   Load > MaxLoad
+    ->  debug(http(scheduler), 'Load ~1f > ~1f; not adding workers',
+              [ Load, MaxLoad ])
+    ;   aggregate_all(count, http_current_worker(Dict.port, _), Workers),
+        setting(http:max_workers, MaxWorkers),
+        (   Workers >= MaxWorkers
+        ->  debug(http(scheduler),
+                  'Reached max workers (~D); not adding workers',
+                  [ MaxWorkers ])
+        ;   Wait is 0.001*(MaxWorkers/max(1, MaxWorkers-Workers)),
+            get_time(Now),
+            Sleep is max(0.001, Wait + Reported-Now),
+            debug(http(scheduler),
+                  'Waiting: ~w; active: ~w; sleep: ~3f; load: ~1f',
+                  [Dict.waiting, Workers, Sleep, Load]),
+            sleep(Sleep),
+            accept_queue(Dict, Queue),
+            message_queue_property(Queue, size(Newsize)),
+            (   Newsize == 0
+            ->  debug(http(scheduler), 'Drained', [])
+            ;   debug(http(scheduler), 'Size is ~w: adding worker', [Newsize]),
+                setting(http:worker_idle_limit, MaxIdle),
+                http_add_worker(Dict.port,
+                                [ max_idle_time(MaxIdle)
+                                ])
+            )
+        )
+    ).
+reschedule(update_load_avg, State0, State) :-
+    update_load_avg(_{}, State0, State, _).
+
+update_load_avg(_Dict, State, State, Load) :-
+    _{stamp:Last, load:Load} :< State.get(load),
+    get_time(Now),
+    Now - Last < 10.
+update_load_avg(Dict, State0, State, Load) :-
+    server_port(Dict, State0, State1, Port),
+    !,
+    aggregate_all(sum(CPU), worker_cpu(Port, CPU), CPU1),
+    get_time(Now),
+    (   LoadDict = State1.get(load),
+        _{stamp:Last, cpu:LastCPU} :< LoadDict
+    ->  Load0 is (CPU1-LastCPU)/(Now-Last),
+        smooth_load(LoadDict, Load0, Load),
+        State = State1.put(load, _{stamp:Now, cpu:CPU1, load:Load})
+    ;   State = State1.put(load, _{stamp:Now, cpu:CPU1}),
+        Load = 0
+    ).
+update_load_avg(_, _, _, 0).
+
+worker_cpu(Port, CPU) :-
+    http_current_worker(Port, Thread),
+    catch(thread_statistics(Thread, cputime, CPU), _, fail).
+
+server_port(_Dict, State, State, Port) :-
+    Port = State.get(port),
+    !.
+server_port(Dict, State0, State, Port) :-
+    Port = Dict.get(port),
+    State = State0.put(port, Port).
+
+smooth_load(LoadDict, Load0, Load) :-
+    OldLoad = LoadDict.get(load),
+    !,
+    Load is (5*OldLoad+Load0)/6.
+smooth_load(_, Load, Load).
+
+%!  accept_queue(+Dict, -Queue)
+%
+%   As of 7.7.16, `queue` is a member   of  the provided dict. For older
+%   versions we need a hack.
+
+accept_queue(Dict, Queue) :-
+    Queue = Dict.get(queue),
+    !.
+accept_queue(Dict, Queue) :-
+    thread_httpd:current_server(Dict.port, _, _, Queue, _, _),
+    !.

package/lib/swipl/library/ext/http/http/http_error.pl

@@ -0,0 +1,126 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2006-2023, University of Amsterdam
+                              VU University Amsterdam
+                              SWI-Prolog Solutions b.v.
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
+
+:- module(http_error,
+          [
+          ]).
+:- use_module(library(prolog_stack), []).
+:- use_module(library(settings)).
+:- use_module(library(broadcast)).
+:- use_module(library(debug)).
+
+/** <module> Decorate uncaught HTTP exceptions with stack-trace
+
+This module decorates uncaught exceptions of the   user code with a full
+stack-trace and sends error reports to the Prolog console. The behaviour
+can be controlled by
+
+  - nodebug(http(error))
+    After disabling the http(error) debug channel, errors are only sent
+    to the client.  See nodebug/1 and debug/1.
+  - set_setting(http:client_backtrace, false)
+    Stop sending stack traces to the client. Note that sending the stack
+    trace to the client simplifies debugging, it also provides clues to
+    hackers on how to compromise your site. The more information you
+    give them, the easier it is to break into your server!  See
+    set_setting/2 and set_setting_default/2.
+  - assert(http_error:suppress_code(Code)) makes this library become
+    silent for replies with a matching HTTP status code.   This may be
+    used to suppress >400 replies that are "normal" in the application.
+*/
+
+:- setting(http:client_backtrace, boolean, true,
+           'Make backtrace visible to the client').
+
+
+                 /*******************************
+                 *     LOG ERRORS TO STDERR     *
+                 *******************************/
+
+:- debug(http(error)).
+
+:- listen(http(Message),
+          http_listen(Message)).
+
+:- dynamic
+    saved_request/2,
+    suppress_code/1.
+
+http_listen(_) :-
+    \+ debugging(http(error)),
+    !.
+http_listen(request_start(Id, Request)) :-
+    !,
+    asserta(saved_request(Id, Request)).
+http_listen(request_finished(Id, Code, Status, _CPU, _Bytes)) :-
+    retract(saved_request(Id, Request)),
+    !,
+    Code >= 400,
+    \+ suppress_code(Code),
+    memberchk(path(Path), Request),
+    memberchk(method(Method), Request),
+    upcase_atom(Method, UMethod),
+    reply_status(Status, Reply),
+    debug(http(error),
+          '~w ~w: [~w] ~w', [UMethod, Path, Code, Reply]).
+
+reply_status(Status, Reply) :-
+    map_exception(Status, Reply),
+    !.
+reply_status(Status, Message) :-
+    Status = error(_,_),
+    !,
+    message_to_string(Status, Message).
+reply_status(Status, Status).
+
+map_exception(http_reply(bytes(ContentType,Bytes),_), bytes(ContentType,L)) :-
+    string_length(Bytes, L).        % also does lists
+map_exception(http_reply(Reply), Reply).
+map_exception(http_reply(Reply, _), Reply).
+map_exception(error(existence_error(http_location, Location), _Stack),
+              error(404, Location)).
+
+
+                 /*******************************
+                 *     DECORATE STACK TRACES    *
+                 *******************************/
+
+:- dynamic prolog_stack:stack_guard/1.
+:- multifile prolog_stack:stack_guard/1.
+
+prolog_stack:stack_guard(httpd_wrapper:wrapper/5).
+prolog_stack:stack_guard(httpd_wrapper:handler_with_output_to/5).
+

package/lib/swipl/library/ext/http/http/http_exception.pl

@@ -0,0 +1,225 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2009-2017, University of Amsterdam
+                              VU University Amsterdam
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
+
+:- module(http_exception,
+          [ map_exception_to_http_status/4,     % +Exception, -Reply,
+                                                % -HdrExtra, -Context
+            in_or_exclude_backtrace/2           % +Error, -CleanedError
+          ]).
+:- use_module(library(settings), [current_setting/1, setting/2]).
+
+/** <module> Map Prolog exceptions to HTTP errors
+
+This module maps exceptions from various parts  of the HTTP libraries as
+well as exceptions from user  handler   predicates  into meaningful HTTP
+error codes such as 4XX and 5XX  codes. For example, existence errors on
+http locations are mapped to 404 while out-of-stack is mapped to 503.
+
+This library provides two hooks:
+
+  - http:map_exception_to_http_status_hook/4 can be used to map
+    additional exceptions to any HTTP status code.
+  - http:bad_request_error/2 can be extended to map exceptions into 400
+    bad request responses.
+
+@see    http_header.pl, http_wrapper.pl
+*/
+
+:- multifile
+    http:bad_request_error/2,                 % Formal, Context
+    http:map_exception_to_http_status_hook/4. % Exception, Reply, HdrExtra, Ctx
+
+%!  map_exception_to_http_status(+Exception, -Reply, -HdrExtra, -Context)
+%
+%   Map certain exceptions to HTTP  status codes. The http(not_modified)
+%   provides backward compatibility to http_reply(not_modified).
+
+map_exception_to_http_status(Exception, Reply, HdrExtra, Context) :-
+    http:map_exception_to_http_status_hook(Exception, Reply, HdrExtra, Context),
+    !.
+map_exception_to_http_status(http(not_modified),
+              not_modified,
+              [connection('Keep-Alive')],
+              []) :- !.
+map_exception_to_http_status(http_reply(Reply),
+              Reply,
+              [connection(Close)],
+              []) :-
+    !,
+    keep_alive(Reply, Close).
+map_exception_to_http_status(http_reply(Reply, HdrExtra0),
+              Reply,
+              HdrExtra,
+              Context) :-
+    !,
+    map_exception_to_http_status(http_reply(Reply, HdrExtra0, []),
+                                 Reply,
+                                 HdrExtra,
+                                 Context).
+
+map_exception_to_http_status(http_reply(Reply, HdrExtra0, Context),
+              Reply,
+              HdrExtra,
+              Context):-
+    !,
+    (   memberchk(connection(_), HdrExtra0)
+    ->  HdrExtra = HdrExtra0
+    ;   HdrExtra = [connection(Close)|HdrExtra0],
+        keep_alive(Reply, Close)
+    ).
+map_exception_to_http_status(error(existence_error(http_location, Location), _),
+              not_found(Location),
+              [connection(close)],
+              []) :- !.
+map_exception_to_http_status(error(permission_error(http_method, Method, Location), _),
+              method_not_allowed(Method, Location),
+              [connection(close)],
+              []) :- !.
+map_exception_to_http_status(error(permission_error(_, http_location, Location), _),
+              forbidden(Location),
+              [connection(close)],
+              []) :- !.
+map_exception_to_http_status(error(threads_in_pool(_Pool), _),
+              busy,
+              [connection(close)],
+              []) :- !.
+map_exception_to_http_status(E,
+              resource_error(E),
+              [connection(close)],
+              []) :-
+    is_resource_error(E),
+    !.
+map_exception_to_http_status(E,
+              bad_request(E2),
+              [connection(close)],
+              []) :-
+    bad_request_exception(E),
+    !,
+    discard_stack_trace(E, E2).
+map_exception_to_http_status(E,
+              server_error(E),
+              [connection(close)],
+              []).
+
+is_resource_error(error(resource_error(_), _)).
+
+bad_request_exception(error(Error, Context)) :-
+    nonvar(Error),
+    bad_request_error(Error, ContextGeneral),
+    (   var(ContextGeneral)
+    ->  true
+    ;   Context = context(_Stack, ContextInstance)
+    ->  subsumes_term(ContextGeneral, ContextInstance)
+    ),
+    !.
+
+bad_request_error(Error, Context) :-
+    http:bad_request_error(Error, Context).
+bad_request_error(Error, Context) :-
+    default_bad_request_error(Error, Context).
+
+default_bad_request_error(domain_error(http_request, _), _).
+default_bad_request_error(existence_error(http_parameter, _), _).
+default_bad_request_error(type_error(_, _), http_parameter(_)).
+default_bad_request_error(syntax_error(http_request_line(_)), _).
+default_bad_request_error(syntax_error(http_request(_)), _).
+default_bad_request_error(syntax_error(_), in_http_request).
+
+discard_stack_trace(error(Formal, context(_,Msg)),
+                    error(Formal, context(_,Msg))).
+
+%!  in_or_exclude_backtrace(+ErrorIn, -ErrorOut)
+%
+%   Remove  the  stacktrace  from  the   exception,  unless  setting
+%   `http:client_backtrace` is `true`.
+
+in_or_exclude_backtrace(Error, Error) :-
+    current_setting(http:client_backtrace),
+    setting(http:client_backtrace, true),
+    !.
+in_or_exclude_backtrace(Error0, Error) :-
+    discard_stack_trace(Error0, Error),
+    !.
+in_or_exclude_backtrace(Exception, Exception).
+
+
+%!  http:bad_request_error(+Formal, -ContextTemplate) is semidet.
+%
+%   If  an  exception  of  the   term  error(Formal,  context(Stack,
+%   Context)) is caught and  subsumes_term(ContextTemplate, Context)
+%   is true, translate the exception into  an HTTP 400 exception. If
+%   the exception contains a stack-trace, this  is stripped from the
+%   response.
+%
+%   The idea behind this hook  is   that  applications can raise 400
+%   responses by
+%
+%     - Throwing a specific (error) exception and adding a rule
+%       to this predicate to interpret this as 400.
+%     - Define rules for prolog:error_message//1 to formulate
+%       an appropriate message.
+
+
+%!  keep_alive(+Reply) is semidet.
+%!  keep_alive(+Reply, -Connection) is det.
+%
+%   If true for Reply, the default is to keep the connection open.
+
+keep_alive(Reply, Connection) :-
+    (   keep_alive(Reply)
+    ->  Connection = 'Keep-Alive'
+    ;   Connection = close
+    ).
+
+keep_alive(not_modified).
+keep_alive(bytes(_Type, _Bytes)).
+keep_alive(file(_Type, _File)).
+keep_alive(tmp_file(_Type, _File)).
+keep_alive(stream(_In, _Len)).
+keep_alive(cgi_stream(_In, _Len)).
+keep_alive(switching_protocols(_Goal, _)).
+
+
+                 /*******************************
+                 *          IDE SUPPORT         *
+                 *******************************/
+
+% See library('trace/exceptions')
+
+:- multifile
+    prolog:general_exception/2.
+
+prolog:general_exception(http_reply(_), http_reply(_)).
+prolog:general_exception(http_reply(_,_), http_reply(_,_)).