kibi-swipl-linux-x64-gnu 1.0.0

package/lib/swipl/doc/packages/examples/http/demo_client.pl

@@ -0,0 +1,165 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2002-2011, University of 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.
+*/
+
+:- use_module(library('http/http_client')).
+:- use_module(library(debug)).
+:- use_module(library('http/http_sgml_plugin')).
+
+
+%       stress(+Times, +Threads, +URLOrAlias)
+%
+%       Typical use: stress(1000, 3, 1): run the test 1000 times with
+%       3 client threads on the /xml test from demo_body.pl and verify
+%       the parsed result.
+
+stress(Times, Parallel, Alias) :-
+    answer(Alias, URL, _),
+    !,
+    stress(Times, Parallel, URL).
+stress(Times, Parallel, URL) :-
+    (   pool(pool, _)
+    ->  delete_pool(pool)
+    ;   true
+    ),
+    create_pool(pool, Parallel),
+    stress(Times, URL),
+    wait_done(Times),
+    delete_pool(pool).
+
+wait_done(0) :- !.
+wait_done(N) :-
+    thread_get_message(done, Result),
+    put(Result), flush,
+    N1 is N - 1,
+    wait_done(N1).
+
+stress(0, _) :- !.
+stress(N, URL) :-
+    thread_send_message(pool, stress_url(URL)),
+    NN is N - 1,
+    stress(NN, URL).
+
+stress_url(URL) :-
+    thread_self(Me),
+    atom_number(N, Me),
+    (   catch(http_get(URL, X, [connection(close)]), E, true)
+    ->  (   var(E)
+        ->  (   answer(_, URL, Correct)
+            ->  (   X == Correct
+                ->  thread_send_message(done, N)
+                ;   thread_send_message(done, !)
+                )
+            ;   thread_send_message(done, ?)
+            )
+        ;   print_message(error, E),
+            thread_send_message(done, 'E')
+        )
+    ;   thread_send_message(done, -)
+    ).
+
+:- dynamic
+    pool/2.                         % name, threads
+
+create_pool(Name, N) :-
+    message_queue_create(Name),
+    findall(Id, (between(1, N, _),
+                 thread_create(worker(Name), Id, [])), Threads),
+    assert(pool(Name, Threads)).
+
+
+delete_pool(Name) :-
+    pool(Name, Threads),
+    forall(member(_, Threads), thread_send_message(Name, thread_exit(ok))),
+    forall(member(Id, Threads), thread_join(Id, _)),
+    message_queue_destroy(Name),
+    retract(pool(Name, Threads)).
+
+
+
+
+
+worker(Queue) :-
+    repeat,
+      thread_get_message(Queue, Goal),
+      (   catch(Goal, E, true)
+      ->  (   var(E)
+          ->  true
+          ;   print_message(error, E)
+          )
+      ;   print_message(error, goal_failed(Goal))
+      ),
+    fail.
+
+
+                 /*******************************
+                 *        CORRECT ANSWERS       *
+                 *******************************/
+
+
+answer(1, 'http://localhost:3000/xml',
+       [ element(message,
+          [],
+          [ '\n  ',
+            element(head,
+                    [],
+                    [ '\n  ',
+                      element(from,
+                              [],
+                              [ 'Jan Wielemaker'
+                              ]),
+                      '\n  ',
+                      element(to,
+                              [],
+                              [ 'Prolog users'
+                              ]),
+                      '\n  ',
+                      element(subject,
+                              [],
+                              [ 'The SWI-Prolog web-server'
+                              ]),
+                      '\n  '
+                    ]),
+            '\n  ',
+            element(body,
+                    [],
+                    [ '\n',
+                      element(p,
+                              [],
+                              [ '\nThis is the first demo of the web-server serving an XML message\n'
+                              ]),
+                      '\n  '
+                    ]),
+            '\n'
+          ])
+       ]).

package/lib/swipl/doc/packages/examples/http/demo_daemon.pl

@@ -0,0 +1,38 @@
+/*  Part of SWI-Prolog
+
+    Author:  Jan Wielemaker
+    E-mail:  J.Wielemaker@vu.nl
+    WWW:     http://www.swi-prolog
+    Copying: This example is in the public domain
+*/
+
+:- module(http_daemon, []).
+:- use_module(library(http/http_unix_daemon)).
+:- use_module(library(http/http_server)).
+
+:- http_handler(/, hello, []).
+
+/** <module> Demo running SWI-Prolog HTTP services as a Unix daemon process
+
+The first example runs this service as   a  normal user. The server does
+not produce any output. It is detached from the controlling terminal and
+thus remains running if you logout.   You can use library(http/http_log)
+to enable logging of the HTTP requests.
+
+    swipl demo_daemon.pl --port=5000
+
+The second example runs this server on a priviledged user on the default
+port 80, avoiding the need for  a   proxy  server. In addition, it sends
+errors, warnings and debug (see debug/3) messages to syslog deamon. Note
+that the =|-q|= suppresses informational messages such as loading Prolog
+files.
+
+    sudo swipl demo_daemon.pl -- --syslog=swi-demo --user=www-data
+
+@see library(http/http_unix_daemon) for more options to http_daemon/0.
+*/
+
+
+hello(_Request) :-
+    reply_html_page(title('Hello'),
+                    p('Hello from SWI-Prolog!')).

package/lib/swipl/doc/packages/examples/http/demo_files.pl

@@ -0,0 +1,50 @@
+:- use_module(library(http/thread_httpd)).
+:- use_module(library(http/html_write)).
+:- use_module(library(http/http_dispatch)).
+:- use_module(library(http/http_dirindex)).
+
+:- http_handler(root(.), serve_files, [prefix]).
+
+%!  server(+Port, +DirSpec) is det.
+%
+%   Start  the  server  at  port  Port,  serving  directories  below
+%   DirSpec. DirSpec may contain ~ and $var.
+%
+%   This simple example defines  a   complete  web-server for static
+%   pages. Note that more specific  handlers   than  the  bave (i.e.
+%   using a longer path) have  priority   over  this handler and can
+%   thus be used to add dynamic parts to your server.
+
+server(Port, DirSpec) :-
+    expand_file_name(DirSpec, [Dir]),
+    assert(user:file_search_path(document_root, Dir)),
+    http_server(http_dispatch, [port(Port)]).
+
+%!  serve_files(Request)
+%
+%   Server a file or directory  according   to  the path_info field,
+%   which contains the path *after* the http-location matched by the
+%   handler. If the  handler  is   matched  *exactly*,  path_info is
+%   missing.
+%
+%   http_safe_file/1 checks the path for attempts to escape from the
+%   hierarchy defined by the =document_root= alias. We find the path
+%   before calling one of the two reply functions because we want to
+%   know whether we are dealing with a   directory  or a file. After
+%   that, the path is absolute  and   we  must  pass unsafe(true) to
+%   avoid the path-checker in the reply-functions complaining.
+
+serve_files(Request) :-
+    (   memberchk(path_info(PathInfo), Request)
+    ->  true
+    ;   PathInfo = './'
+    ),
+    http_safe_file(document_root(PathInfo), []),
+    absolute_file_name(document_root(PathInfo), Path,
+                       [ access(read)] ),
+    (   exists_directory(Path)
+    ->  http_reply_dirindex(Path, [unsafe(true)], Request)
+    ;   http_reply_file(Path, [unsafe(true)], Request)
+    ).
+
+

package/lib/swipl/doc/packages/examples/http/demo_hello.pl

@@ -0,0 +1,15 @@
+:- use_module(library(http/http_server)).
+
+:- initialization
+    http_server([port(8080)]).
+
+:- http_handler(root(.),
+		http_redirect(moved, location_by_id(home_page)),
+		[]).
+:- http_handler(root(home), home_page, []).
+
+home_page(_Request) :-
+    reply_html_page(
+	title('Demo server'),
+	[ h1('Hello world!')
+	]).

package/lib/swipl/doc/packages/examples/http/demo_login.pl

@@ -0,0 +1,280 @@
+:- module(http_login_demo,
+          [ server/1                            % +Port
+          ]).
+:- use_module(library(http/thread_httpd)).
+:- use_module(library(http/http_dispatch)).
+:- use_module(library(http/http_parameters)).
+:- use_module(library(http/http_session)).
+:- use_module(library(http/html_write)).
+
+/** <module> Login demo
+
+This module provides  a  demonstration  on   how  to  use  HTTP  request
+filtering to realise login using an login page and cookies.
+*/
+
+%!  server(+Port)
+%
+%   Start the server at http://localhost:Port
+
+server(Port) :-
+    http_set_session_options(
+        [ create(noauto)
+        ]),
+    http_server(http_dispatch,
+                [ port(Port)
+                ]).
+
+% handle declarations. All pretty standard, except  the secret page that
+% is protected using role(trusted). This  is   used  by the RBAC request
+% rewrite rule.
+
+:- http_handler(root(.),        http_redirect(moved, location_by_id(home)),
+                []).
+:- http_handler(root(home),     home,
+                []).
+:- http_handler(root(secret),   secret,
+                [role(trusted)]).
+:- http_handler(root(login),    login,
+                []).
+:- http_handler(root(do_login), do_login,
+                [ method(post) ]).
+:- http_handler(root(logout),   logout,
+                []).
+
+%!  home(+Request)
+%
+%   Send the home page.  This  uses   the  user(User)  attribute  of the
+%   request added by the `user` request rewrite   rule to make some page
+%   elements depending on the login state.
+
+home(Request) :-
+    reply_html_page(
+        title('Login demo'),
+        [ h1('Login demo'),
+          \logged_in(Request),
+          ul([ \login_or_logout(Request),
+               li(a(href(location_by_id(secret)), 'Secret page'))
+             ])
+        ]).
+
+logged_in(Request) -->
+    { memberchk(user(User), Request) },
+    !,
+    html(p('You are logged in as ~p'-[User])).
+logged_in(_Request) -->
+    html(p('You are not logged in')).
+
+login_or_logout(Request) -->
+    { memberchk(user(_User), Request) },
+    !,
+    html(li(a(href(location_by_id(logout)), 'Logout'))).
+login_or_logout(_Request) -->
+    html(li(a(href(location_by_id(login)),  'Login'))).
+
+%!  secret(+Request)
+%
+%   The protected page.  The handler is not special.
+
+secret(_Request) :-
+    reply_html_page(
+        title('Secret page'),
+        [ h1('Psss ...'),
+          p('Prolog is a secret weapon!')
+        ]).
+
+%!  login(+Request)
+%
+%   The login page. This is a completely   trivial page providing a form
+%   to enter name and password. It takes two optional parameters:
+%
+%     - reason(String)
+%       The reason why the login page was opened.  Deals with
+%       reopening due to wrong password and opening due to trying
+%       to access a protected page.
+%     - return_to(URL)
+%       After successfull login, return to the given page.  Default
+%       is the referer.  This is a little dubious as this may not
+%       be present.  In that case it might be better to return to
+%       a dedicated welcome page.
+
+login(Request) :-
+    http_parameters(
+        Request,
+        [ reason(Message, [optional(true)]),
+          return_to(Here, [optional(true)])
+        ]),
+    (   var(Here)
+    ->  memberchk(referer(Here), Request)
+    ;   true
+    ),
+    reply_html_page(
+        title('Login'),
+        [ \login_title(Message),
+          form([ action(location_by_id(do_login)),
+                 method(post)
+               ],
+               [ input([ type(hidden), name(return_to), value(Here) ]),
+                 table([ tr([ th('Name'),
+                              td(input([name(name)]))
+                            ]),
+                         tr([ th('Password'),
+                              td(input([name(passwd), type(password)]))
+                            ]),
+                         tr([ td([ colspan(2),
+                                   align(right)
+                                 ],
+                                 input([type(submit), value('Login')]))
+                            ])
+                       ])
+               ])
+        ]).
+
+login_title(Message) -->
+    { var(Message) },
+    !,
+    html(h1('Login')).
+login_title(Message) -->
+    html([ h1('Login'),
+           p(class(message), Message)
+         ]).
+
+%!  do_login(+Request)
+%
+%   Handle the form data from the _login page_.  Does one of these:
+%
+%     - If login is ok, open a session, assert the user is logged on and
+%       redirect to `return_to`
+%     - Otherwise, go back to the login page, indicating the login
+%       failed.
+
+do_login(Request) :-
+    http_parameters(
+        Request,
+        [ name(Name, []),
+          passwd(Passwd, []),
+          return_to(Return, [])
+        ]),
+    (   valid_passwd(Name, Passwd)
+    ->  http_open_session(_SessionId, []),
+        http_session_assert(user(Name)),
+        http_redirect(see_other, Return, Request)
+    ;   http_link_to_id(login,
+                        [ reason('Login failed'),
+                          return_to(Return)
+                        ], HREF),
+        http_redirect(see_other, HREF, Request)
+    ).
+
+%!  logout(+Request)
+%
+%   Logout handler.  Clears the login state and returns to the origin.
+%
+
+logout(Request) :-
+    http_parameters(
+        Request,
+        [ return_to(Return, [])
+        ]),
+    (   var(Return)
+    ->  memberchk(referer(Return), Request)
+    ;   true
+    ),
+    http_session_retractall(user(_User)),
+    http_redirect(see_other, Return, Request).
+
+		 /*******************************
+		 *            USER DATA		*
+		 *******************************/
+
+
+%!  valid_passwd(+User, +Passwd) is semidet.
+%
+%   True if Passwd is the correct password for User.
+
+valid_passwd(User, Passwd) :-
+    user(User, password(Passwd)).
+
+%!  user(?User, ?Property) is nondet.
+%
+%   True when Property is a property of user. In a real application this
+%   should of course be  a  proper   persistent  database  and passwords
+%   should be properly hashed.
+
+user(jan, password(geheim)).
+user(jan, role(trusted)).
+
+user(bob, password(secret)).
+
+
+		 /*******************************
+		 *            EXPAND		*
+		 *******************************/
+
+:- http_request_expansion(user, 100).
+:- http_request_expansion(rbac, 200).
+
+%!  user(+Request0, -Request, +Options) is semidet.
+%
+%   HTTP request rewriter that figures out whether someone is logged in.
+%   using this technique we can use   different  techniques to establish
+%   the logged in status.
+
+user(Request0, Request, _Options) :-
+    http_in_session(_),
+    http_session_data(user(User)),
+    Request = [user(User)|Request0].
+
+%!  rbac(+Request0, -Request, +Options) is semidet.
+%
+%   Establish whether the user  may  proceed   if  the  handler  options
+%   contain a term role(Role).  Acts as follows:
+%
+%     1. If the user is logged in
+%        - If the user has the desired role, succeed.
+%        - Otherwise indicate the user is not authorized.  The
+%          3rd argument of the `http_reply` exception provides
+%          arbitrary context for the error page.
+%     2. Otherwise redirect to the login page
+
+rbac(Request, Request, Options) :-
+    memberchk(role(Role), Options),
+    (   memberchk(user(User), Request)
+    ->  (   user(User, role(Role))
+        ->  true
+        ;   memberchk(path(Path), Request),
+            throw(http_reply(forbidden(Path), [], [no_role(User, Role)]))
+        )
+    ;   memberchk(request_uri(Return), Request),
+        http_link_to_id(login,
+                        [ reason('The requested location requires login'),
+                          return_to(Return)
+                        ], HREF),
+        http_redirect(see_other, HREF, Request)
+    ).
+
+
+		 /*******************************
+		 *            ERROR		*
+		 *******************************/
+
+:- multifile
+    http:status_page/3.
+
+%!  http:status_page(+Term, +Context, -HTML)
+%
+%   Provide a custom error page for the forbidden action.
+
+http:status_page(forbidden(Path), Context, HTML) :-
+    phrase(page([ title('Access denied')
+                ],
+                [ h1('Access denied'),
+                  p(['You do not have sufficient privileges to access ',
+                     Path]),
+                  \forbidden_reason(Context)
+                ]),
+           HTML).
+
+forbidden_reason(Context) -->
+    { memberchk(no_role(User, Role), Context) },
+    html(p('The user ~p does not have role ~p'-[User,Role])).