kibi-swipl-linux-x64-gnu 1.0.0

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

@@ -0,0 +1,139 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        jan@swi-prolog.org
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2024, 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(htmx,
+          [ reply_htmx/1,               % +HTML
+            reply_htmx/2,               % +HTML, +Request
+            htmx_oob//2                 % ++Id, :HTML
+          ]).
+:- use_module(library(http/html_write)).
+
+/** <module> Support htmx.org
+
+Quoted from htmx.org:
+
+> [htmx](https://htmx.org) gives you access to AJAX, CSS Transitions,
+> WebSockets and Server Sent Events directly in HTML, using attributes,
+> so you can build modern user interfaces with the simplicity and power
+> of hypertext
+
+The idea behind htmx is to allow   adding attributes to any HTML element
+that cause an HTTP request. The  HTTP   response  is typically a (short)
+HTML fragment that extends or replaces  an   element  on  the page. This
+allows us to program a most functionality interactive seen in modern web
+applications using the powerful  SWI-Prolog   HTML  generation framework
+rather than having to write a  JSON backend and  accompanying JavaScript
+frontend that runs in the browser.
+
+Below is a minimalistic, yet fully functional application that  replaces
+a button after a click in two ways, using either a direct hx-swap our an
+out-of-band hx-swap command.
+
+```
+:- use_module(library(http/http_server)).
+:- use_module(library(http/htmx)).
+:- use_module(library(main)).
+
+:- initialization(main, main).
+
+main(_Argv) :-
+    http_server([port(8080)]),
+    thread_get_message(quit).
+
+http:location(htmx, root(htmx), []).
+
+:- http_handler(root(.), home, []).
+
+home(_Request) :-
+    reply_html_page(
+        [ title('HTMX demo'),
+          script(src('https://unpkg.com/htmx.org'), [])
+        ],
+        [ button([ id(button1),
+                   'hx-post'('/htmx/clicked1'),
+                   'hx-swap'('outerHTML')
+                 ],
+                 'Click me (1)'),
+          button([ id(button2),
+                   'hx-post'('/htmx/clicked2')
+                 ],
+                 'Click me (2)')
+        ]).
+
+:- http_handler(htmx(clicked1), reply_htmx(\clicked1), []).
+:- http_handler(htmx(clicked2), reply_htmx(\clicked2), []).
+
+clicked1 -->
+    html('Thanks for clicking me! (1)').
+
+clicked2 -->
+    htmx_oob(button2, html('Thanks for clicking me! (2)')).
+```
+
+HTMX requires no  dedicated  support  from   the  server.  This  library
+provides reply_htmx/1,2 to reply with a  single HTML element rather than
+an entire page.  Future  versions  of   this  library  may  provide some
+additional utility predicates.
+*/
+
+:- html_meta
+    reply_htmx(html),
+    reply_htmx(html, +),
+    htmx_oob(+, html, ?, ?).
+
+%!  reply_htmx(+HTML) is det.
+%!  reply_htmx(+HTML, +Request) is det.
+%
+%   Reply a plain HTML element as  opposed   to  a complete HTML page as
+%   created using reply_html_page/2,3. While reply_htmx/1  is to be used
+%   in a normal HTTP handler  (route),   reply_htmx/2  may be registered
+%   directly in the http_handler/3 declaration to deal with simple cases
+%   where we do not need the `Request` data.
+
+reply_htmx(HTML) :-
+    phrase(html(HTML), Tokens),
+    format('Content-type: text/html~n~n', []),
+    print_html(Tokens).
+
+reply_htmx(HTML, _Request) :-
+    reply_htmx(HTML).
+
+%!  htmx_oob(++Target, :HTML)// is det.
+%
+%   Emit an htmx out-of-band element.  HTML is used to swap the
+%   content of the DOM element with id Target.
+
+htmx_oob(Target, HTML) -->
+    html(div([id(Target), 'hx-swap-oob'(true)],
+             HTML)).

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

@@ -0,0 +1,364 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2007-2015, 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(authenticate,
+          [ http_authenticate/3,        % +Check, +Header, -User
+            http_authorization_data/2,  % +AuthorizationText, -Data
+            http_current_user/3,        % +File, ?User, ?Fields
+
+            http_read_passwd_file/2,    % +File, -Data
+            http_write_passwd_file/2    % +File, +Data
+          ]).
+:- use_module(library(base64)).
+:- use_module(library(dcg/basics)).
+:- use_module(library(readutil)).
+:- use_module(library(lists)).
+:- use_module(library(crypt)).
+:- use_module(library(debug)).
+:- use_module(library(error)).
+:- use_module(library(apply)).
+
+/**     <module> Authenticate HTTP connections using 401 headers
+
+This module provides the basics  to   validate  an  HTTP =Authorization=
+header. User and password  information  are   read  from  a  Unix/Apache
+compatible password file.
+
+This  library  provides,  in  addition    to  the  HTTP  authentication,
+predicates to read and write password files.
+*/
+
+%!  http_authenticate(+Type, +Request, -Fields)
+%
+%   True if Request contains the   information to continue according
+%   to Type. Type identifies the required authentication technique:
+%
+%           * basic(+PasswordFile)
+%           Use HTTP =Basic= authentication and verify the password
+%           from PasswordFile. PasswordFile is a file holding
+%           usernames and passwords in a format compatible to
+%           Unix and Apache. Each line is record with =|:|=
+%           separated fields. The first field is the username and
+%           the second the password _hash_.  Password hashes are
+%           validated using crypt/2.
+%
+%   Successful authorization is  cached  for   60  seconds  to avoid
+%   overhead of decoding and lookup of the user and password data.
+%
+%   http_authenticate/3 just validates the  header. If authorization
+%   is not provided the browser must   be challenged, in response to
+%   which it normally opens a   user-password dialogue. Example code
+%   realising this is below. The exception   causes the HTTP wrapper
+%   code to generate an HTTP 401 reply.
+%
+%   ==
+%   (   http_authenticate(basic(passwd), Request, Fields)
+%   ->  true
+%   ;   throw(http_reply(authorise(basic, Realm)))
+%   ).
+%   ==
+%
+%   @param  Fields is a list of fields from the password-file entry.
+%           The first element is the user.  The hash is skipped.
+%   @tbd    Should we also cache failures to reduce the risk of
+%           DoS attacks?
+
+http_authenticate(basic(File), Request, [User|Fields]) :-
+    memberchk(authorization(Text), Request),
+    debug(http_authenticate, 'Authorization: ~w', [Text]),
+    (   cached_authenticated(Text, File, User, Fields)
+    ->  true
+    ;   http_authorization_data(Text, basic(User, Password)),
+        debug(http_authenticate,
+              'User: ~w, Password: ~s', [User, Password]),
+        validate(File, User, Password, Fields),
+        get_time(Now),
+        assert(authenticated(Text, File, User, Now, Fields)),
+        debug(http_authenticate, 'Authenticated ~w~n', [User])
+    ).
+
+%!  http_authorization_data(+AuthorizeText, ?Data) is semidet.
+%
+%   Decode the HTTP =Authorization= header.  Data is a term
+%
+%       Method(User, Password)
+%
+%   where Method is the (downcased)  authorization method (typically
+%   =basic=), User is an atom holding the  user name and Password is
+%   a list of codes holding the password
+
+http_authorization_data(Text, Data) :-
+    (   nonvar(Data)
+    ->  functor(Data, Method, 2)    % make authorization//2 fail early
+    ;   true
+    ),
+    atom_codes(Text, Codes),
+    phrase(authorization(Method, Cookie), Codes),
+    phrase(base64(UserPwd), Cookie),
+    phrase(ident(UserCodes, Password), UserPwd),
+    !,
+    atom_codes(User, UserCodes),
+    Data =.. [Method, User, Password].
+
+authorization(Method, Cookie) -->
+    nonblanks(MethodChars),
+    { atom_codes(Method0, MethodChars),
+      downcase_atom(Method0, Method)
+    },
+    blanks,
+    nonblanks(Cookie),
+    blanks.
+
+ident(User, Password) -->
+    string(User),
+    ":",
+    string(Password).
+
+%!  cached_authenticated(+Authorization, +File, -User, -RestFields)
+%
+%   Validate using the cache. If the entry   is not in the cache, we
+%   also remove all outdated entries from the cache.
+
+:- dynamic
+    authenticated/5.        % Authorization, File, User, Time, RestFields
+
+cached_authenticated(Authorization, File, User, Fields) :-
+    authenticated(Authorization, File, User, Time, Fields),
+    get_time(Now),
+    Now-Time =< 60,
+    !.              % 60-second timeout
+cached_authenticated(_, _, _, _) :-
+    get_time(Now),
+    (   clause(authenticated(_, _, _, Time, _), true, Ref),
+        Now-Time > 60,
+        erase(Ref),
+        fail
+    ).
+
+
+%!  validate(+File, +User, +Passwd, -Fields)
+%
+%   True if User and Passwd combination   appears in File. File uses
+%   the same format as .htaccess files  from Apache or Unix password
+%   files. I.e. it consists  of  one   line  per  entry  with fields
+%   separated by =|:|=. The  first  field   is  the  User field, The
+%   second contains the Passwd in DES   or MD5 encrypted format. See
+%   crypt/2 for details.
+
+validate(File, User, Password, Fields) :-
+    update_passwd(File, Path),
+    passwd(User, Path, Hash, Fields),
+    crypt(Password, Hash).
+
+%!  http_current_user(+File, ?User, ?Fields) is nondet.
+%
+%   True when User is present in the htpasswd file File and Fields
+%   provides the additional fields.
+%
+%   @arg    Fields are the fields from the password file File,
+%           converted using name/2, which means that numeric values
+%           are passed as numbers and other fields as atoms.  The
+%           password hash is the first element of Fields and is
+%           a string.
+
+http_current_user(File, User, Fields) :-
+    update_passwd(File, Path),
+    passwd(User, Path, Hash, Fields0),
+    Fields = [Hash|Fields0].
+
+%!  update_passwd(+File, -Path) is det.
+%
+%   Update passwd/3 to reflect the correct  passwords for File. Path
+%   is the absolute path for File.
+
+:- dynamic
+    passwd/4,                       % User, File, Encrypted, Fields
+    last_modified/2.                % File, Stamp
+
+update_passwd(File, Path) :-
+    absolute_file_name(File, Path, [access(read)]),
+    time_file(Path, Stamp),
+    (   last_modified(Path, Stamp)
+    ->  true
+    ;   with_mutex(http_passwd, reload_passwd_file(Path, Stamp))
+    ).
+
+reload_passwd_file(Path, Stamp) :-
+    last_modified(Path, Stamp),
+    !.  % another thread did the work
+reload_passwd_file(Path, Stamp) :-
+    http_read_passwd_file(Path, Data),
+    retractall(last_modified(Path, _)),
+    retractall(passwd(_, Path, _, _)),
+    forall(member(passwd(User, Hash, Fields), Data),
+           assertz(passwd(User, Path, Hash, Fields))),
+    assert(last_modified(Path, Stamp)).
+
+%!  http_read_passwd_file(+Path, -Data) is det.
+%
+%   Read a password file. Data is  a   list  of  terms of the format
+%   below, where User is an atom  identifying   the  user, Hash is a
+%   string containing the salted password   hash  and Fields contain
+%   additional fields. The string value of   each field is converted
+%   using name/2 to either a number or an atom.
+%
+%     ==
+%     passwd(User, Hash, Fields)
+%     ==
+
+http_read_passwd_file(Path, Data) :-
+    setup_call_cleanup(
+        open(Path, read, Fd),
+        ( read_line_to_codes(Fd, Line),
+          read_passwd_file(Line, Fd, Path, Data)
+        ),
+        close(Fd)).
+
+read_passwd_file(end_of_file, _, _, []) :- !.
+read_passwd_file(Line, Fd, Path, Data) :-
+    (   phrase(password_line(User, Hash, Fields), Line, _)
+    ->  Data = [passwd(User, Hash, Fields)|Tail]
+    ;   Tail = Data                 % TBD: warning
+    ),
+    read_line_to_codes(Fd, Line2),
+    read_passwd_file(Line2, Fd, Path, Tail).
+
+
+password_line(User, Hash, Fields) -->
+    string(UserCodes),
+    ":",
+    string(HashCodes),
+    peek_eof,
+    !,
+    fields(Fields),
+    { atom_codes(User, UserCodes),
+      string_codes(Hash, HashCodes)
+    }.
+
+fields([Field|Fields]) -->
+    field(Field),
+    !,
+    fields(Fields).
+fields([]) --> [].
+
+field(Value) -->
+    ":",
+    !,
+    string(Codes),
+    peek_eof,
+    !,
+    { name(Value, Codes)
+    }.
+
+peek_eof, ":" --> ":".
+peek_eof --> eos.
+
+
+%!  http_write_passwd_file(+File, +Data:list) is det.
+%
+%   Write password data Data to File. Data   is a list of entries as
+%   below. See http_read_passwd_file/2 for details.
+%
+%     ==
+%     passwd(User, Hash, Fields)
+%     ==
+%
+%   @tbd    Write to a new file and atomically replace the old one.
+
+http_write_passwd_file(File, Data) :-
+    must_be(list, Data),
+    maplist(valid_data, Data),
+    setup_call_cleanup(
+        open(File, write, Out, [encoding(utf8)]),
+        maplist(write_data(Out), Data),
+        close(Out)),
+    retractall(last_modified(File, _)). % flush cache
+
+valid_data(passwd(User, Hash, Fields)) :-
+    !,
+    valid_field(User),
+    valid_field(Hash),
+    must_be(list, Fields),
+    maplist(valid_field, Fields).
+valid_data(Data) :-
+    type_error(passwd_entry, Data).
+
+valid_field(Field) :-
+    must_be(atomic, Field),
+    (   number(Field)
+    ->  true
+    ;   sub_string(Field, _, _, _, ":")
+    ->  representation_error(passwd_field)
+    ;   true
+    ).
+
+write_data(Out, passwd(User, Hash, Fields)) :-
+    atomics_to_string([User, Hash|Fields], ":", String),
+    format(Out, '~s~n', [String]).
+
+
+                 /*******************************
+                 *   PLUGIN FOR HTTP_DISPATCH   *
+                 *******************************/
+
+:- multifile
+    http:authenticate/3.
+
+%!  http:authenticate(+AuthData, +Request, -Fields)
+%
+%   Plugin  for  library(http_dispatch)  to    perform   basic  HTTP
+%   authentication.
+%
+%   This predicate throws http_reply(authorise(basic, Realm)).
+%
+%   @arg    AuthData must be a term basic(File, Realm)
+%   @arg    Request is the HTTP request
+%   @arg    Fields describes the authenticated user with the option
+%           user(User) and with the option user_details(Fields) if
+%           the password file contains additional fields after the
+%           user and password.
+
+http:authenticate(basic(File, Realm), Request,
+                  [ user(User)
+                  | Details
+                  ]) :-
+    (   http_authenticate(basic(File), Request, [User|Fields])
+    ->  (   Fields == []
+        ->  Details = []
+        ;   Details = [user_details(Fields)]
+        )
+    ;   throw(http_reply(authorise(basic, Realm)))
+    ).
+