kibi-swipl-linux-x64-gnu 1.0.0

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

@@ -0,0 +1,177 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2010-2011, 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.
+*/
+
+:- asserta(file_search_path(library, '..')).
+
+:- use_module(library(uri)).
+:- use_module(library(http/http_openid)).
+:- use_module(library(http/http_host)).
+:- use_module(library(http/http_dispatch)).
+:- use_module(library(http/http_path)).
+:- use_module(library(http/thread_httpd)).
+:- use_module(library(http/html_write)).
+:- use_module(library(http/http_error)).
+
+http:location(openid, root(openid), []).
+
+:- multifile
+    http_openid:openid_hook/1.
+
+http_openid:openid_hook(trusted(_OpenID, Server)) :-
+    debug(openid(test), 'Trusting server ~q', [Server]).
+
+
+%!  server
+%
+%   Create demo server  and  client.   After  starting  the  server,
+%   contact http://localhost:8000/
+
+server :-
+    debug(openid(_)),
+    Port = 8000,
+    http_server(http_dispatch,
+                [ port(Port)
+                ]).
+
+
+assoc :-
+    openid_associate('http://localhost:8000/openid/server', Handle, Assoc),
+    writeln(Handle-Assoc).
+
+%!  secret(+Request) is det.
+%
+%   Example of a handler that requires an  OpenID login. If the user
+%   is not logged it, it will be  redirected to the login page, from
+%   there to the OpenID server and back here. All this is completely
+%   transparent to us.
+
+:- http_handler(root('secret'), secret, []).
+
+secret(Request) :-
+    openid_user(Request, User, []),
+    reply_html_page(title('Secret'),
+                    [ 'You\'ve reached the secret page as user ', %'
+                      a(href(User), User)
+                    ]).
+
+%!  root(+Request).
+%!  allow(+Request).
+%
+%   Shows an indirect login.
+
+:- http_handler(root(.),             root,                              []).
+:- http_handler(root('test/verify'), openid_verify([return_to(allow)]), []).
+:- http_handler(root('test/allow'),  allow,                             []).
+
+root(_Request) :-
+    reply_html_page(title('Demo OpenID consumer'),
+                    [ h1('OpenID consumer'),
+                      form([ name(login),
+                             action('/test/verify'),
+                             method('GET')
+                           ],
+                           [ div([ 'OpenID: ',
+                                   input([ name(openid_url),
+                                           size(40),
+                                           value('http://localhost:8000/user/bob') % test
+                                         ]),
+                                   input([type(submit), value('Verify!')])
+                                 ])
+                           ]),
+                      p([ 'Or go directly to the ', a(href=secret, 'secret page') ])
+                    ]).
+
+
+allow(Request) :-
+    openid_user(Request, OpenID, []),
+    openid_server(_OpenIDLogin, OpenID, Server),
+    reply_html_page(title('Success'),
+                    [ h1('OpenID login succeeded'),
+                      p([ 'The OpenID server ',
+                          a(href(Server),Server),
+                          ' verified you as ',
+                          a(href(OpenID), OpenID)
+                        ])
+                    ]).
+
+
+                 /*******************************
+                 *         OpenID SERVER        *
+                 *******************************/
+
+:- http_handler(root('user/'),  user_page,         [prefix]).
+:- http_handler(openid(server), openid_server([]), []).
+:- http_handler(openid(grant),  openid_grant, []).
+
+:- multifile
+    http_openid:openid_hook/1.
+
+http_openid:openid_hook(grant(_Request, Options)) :-
+    debug(openid(test), 'Granting access to ~p', [Options]).
+
+%!  user_page(+Request) is det.
+%
+%   Generate a page for user as /user/<user>.
+
+user_page(Request) :-
+    http_current_host(Request, Host, Port,
+                      [ global(true)
+                      ]),
+    http_location_by_id(openid_server, ServerLocation),
+    uri_authority_data(host, AComp, Host),
+    uri_authority_data(port, AComp, Port),
+    uri_authority_components(Authority, AComp),
+    uri_data(scheme, Components, http),
+    uri_data(authority, Components, Authority),
+    uri_data(path, Components, ServerLocation),
+    uri_components(OpenIDServer, Components),
+    memberchk(path_info(User), Request),
+    reply_html_page([ link([ rel('openid.server'),
+                             href(OpenIDServer)
+                           ]),
+                      title('OpenID page of ~w'-[User])
+                    ],
+                    h1('OpenID page of ~w'-[User])).
+
+
+                 /*******************************
+                 *              DEBUG           *
+                 *******************************/
+
+:- http_handler(root(.), print_request, [prefix]).
+
+print_request(Request) :-
+    format('Content-type: text/plain~n~n'),
+    pp(Request).

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

@@ -0,0 +1,20 @@
+:- use_module(library(http/thread_httpd)).
+:- use_module(library(http/http_parameters)).
+:- use_module(library(http/http_dispatch)).
+:- use_module(library(http/http_error)).
+:- use_module(library(http/html_write)).
+:- use_module(library(http/http_pwp)).
+
+:- prolog_load_context(directory, Dir),
+   asserta(user:file_search_path(http_demo, Dir)).
+
+user:file_search_path(pwp_demo, http_demo(pwp)).
+
+:- http_handler(root(.),
+                pwp_handler([path_alias(pwp_demo), view(true)]),
+                [prefix]).
+
+server(Port) :-
+    http_server(http_dispatch, [port(Port)]).
+
+

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

@@ -0,0 +1,56 @@
+:- module(demo_http_rest,
+          [ server/1                            % +Port
+          ]).
+:- use_module(library(http/thread_httpd)).
+:- use_module(library(http/http_dispatch)).
+
+server(Port) :-
+    http_server(http_dispatch,
+                [ port(Port)
+                ]).
+
+/** <module> Demonstrate dispatching using wildcarts
+
+This example demonstrates dispatching events   using wildcarts, normally
+used for REST APIs. To run this  test,   start  the server and use e.g.,
+`curl` as:
+
+```
+curl http://localhost:5000/user/jan
+curl http://localhost:5000/user/default
+curl http://localhost:5000/user/jan/parents
+```
+
+Note that the predicate http_link_to_id/3 can   generate URLs that refer
+to these handlers. For example:
+
+    ?- http_link_to_id(parents('Bob'), [], URL).
+    URL = '/user/Bob/parents'.
+
+The library(http/html_write) can generate also   generate links to these
+handlers, for example:
+
+    ...,
+    html(a(href(#(user('Bob'))), 'Bob'))
+
+produces
+
+    <a href="/user/Bob">Bob</a>
+*/
+
+:- http_handler(root(user/User),         user(M, User), [method(M)]).
+:- http_handler(root(user/default),      default_user,  []).
+:- http_handler(root(user/User/parents), parents(User), []).
+
+user(Method, User, _Request) :-
+    format('Content-type: text/plain~n~n'),
+    format('Run method ~p on user ~p~n', [Method, User]).
+
+default_user(_Request) :-
+    format('Content-type: text/plain~n~n'),
+    format('Send a default user~n', []).
+
+parents(User, _Request) :-
+    format('Content-type: text/plain~n~n'),
+    format('Asked for parents for ~p~n', [User]).
+

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

@@ -0,0 +1,52 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2002, 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.
+*/
+
+:- load_files([ demo_body,
+                library('http/thread_httpd')
+              ],
+              [ silent(true)
+              ]).
+
+server :-
+    server(3000, []).
+
+server(Port, Options) :-
+    http_server(reply,
+                [ port(Port),
+                  timeout(20)
+                | Options
+                ]).
+
+tm :-
+    prolog_ide(thread_monitor).

package/lib/swipl/doc/packages/examples/http/linux-init-script

@@ -0,0 +1,126 @@
+#!/bin/sh
+### BEGIN INIT INFO
+# Provides:          swi-httpd
+# Required-Start:    $local_fs $remote_fs $network $syslog $named
+# Required-Stop:     $local_fs $remote_fs $network $syslog $named
+# Default-Start:     2 3 4 5
+# Default-Stop:      0 1 6
+# X-Interactive:     true
+# Short-Description: Start/stop SWI-Prolog web server
+### END INIT INFO
+
+# Installation
+#
+#   0. On Redhat/CentOS: yum install redhat-lsb
+#   1. Copy this file to /etc/init.d/<server>
+#   2. Edit the Configuration section below
+#   3. Run
+#	 % update-rc.d <server> defaults
+#	 % /etc/init.d/<server> start
+
+# Configuration section
+#
+SWIPL=/usr/bin/swipl
+DIR=/srv/swipl-httpd
+SCRIPT=daemon.pl
+USER=www-data
+PORT=80
+DAEMONARGS=
+
+# Uncomment to only listen for connections from localhost
+# DAEMONARGS="$DAEMONARGS --ip=localhost"
+
+HTTPID=swipl-httpd-$PORT
+PIDFILE=/var/run/$HTTPID.pid
+SYSLOG=$HTTPID
+
+# End of normal configuration
+
+. /lib/lsb/init-functions
+test -f /etc/default/rcS && . /etc/default/rcS
+
+DAEMONARGS="$DAEMONARGS --port=$PORT --user=$USER --fork"
+if [ ! -z "$SYSLOG" ]; then DAEMONARGS="$DAEMONARGS --syslog=$SYSLOG"; fi
+if [ ! -z "$PIDFILE" ]; then DAEMONARGS="$DAEMONARGS --pidfile=$PIDFILE"; fi
+
+pidofserver()
+{ if [ -f "$PIDFILE" ]; then
+    cat "$PIDFILE"
+  else
+    ps aux | grep "[0-9] *$SWIPL.*--port=$PORT" 2>/dev/null | awk '{print $2}'
+  fi
+}
+
+running()
+{ if [ -z "$1" ]; then return 1; fi
+
+  if kill -0 $1 2> /dev/null; then
+    return 0
+  else
+    return 1
+  fi
+}
+
+waitserver()
+{ i=0;
+
+  while running $1; do
+    if [ $i = '60' ]; then
+      return 1;
+    else
+      if [ $i = '0' ]; then
+        echo -n " ... waiting "
+      else
+        echo -n "."
+      fi
+      i=$(($i+1))
+      sleep 1
+    fi
+  done
+}
+
+case $1 in
+  start)
+    MESSAGE="Starting web server $HTTPID"
+    if (cd $DIR && $SWIPL -q -s $SCRIPT -- $DAEMONARGS); then
+      log_success_msg $MESSAGE
+    else
+      log_failure_msg $MESSAGE
+    fi
+  ;;
+  stop)
+    MESSAGE="Stopping web server $HTTPID"
+    PID=$(pidofserver)
+    kill $PID
+    if waitserver $PID; then
+      log_success_msg $MESSAGE
+    else
+      kill -9 $PID
+      if waitserver $PID; then
+        log_success_msg $MESSAGE
+      else
+        log_failure_msg $MESSAGE
+      fi
+    fi
+  ;;
+  restart)
+    $0 stop && $0 start
+  ;;
+  status)
+    PID=$(pidofserver)
+    if running "$PID"; then
+      echo "SWI-Prolog HTTP server is running (pid $PID)."
+      exit 0
+    else
+      echo "SWI-Prolog HTTP server is NOT running."
+      if [ -e $PIDFILE ]; then
+        exit 1
+      else
+        exit 3
+      fi
+    fi
+  ;;
+  *)
+  log_success_msg "Usage: /etc/init.d/swipl-httpd {start|stop|restart|status}"
+  exit 1
+esac

package/lib/swipl/doc/packages/examples/http/pwp/context.pwp

@@ -0,0 +1,23 @@
+<?xml version="1.0"?>
+<!DOCTYPE html>
+
+<html xmlns:pwp="http://www.cs.otago.ac.nz/staffpriv/ok/pwp.pl">
+
+<head>
+  <title>Context variables for PWP scripts</title>
+</head>
+<body>
+  <p>This PWP demo lists the context-parameters that are passed into
+     the script.
+  </p>
+  <ul>
+    <li pwp:ask="member(Name=Value, CONTEXT)">
+      <span class=name pwp:use="Name"/>
+      =
+      <span class=value pwp:use="writeq(Value)"/>
+    </li>
+  </ul>
+</body>
+
+</html>
+

package/lib/swipl/doc/packages/examples/http/pwp/index.pwp

@@ -0,0 +1,25 @@
+<?xml version="1.0"?>
+<!DOCTYPE html>
+
+<html xmlns:pwp="http://www.cs.otago.ac.nz/staffpriv/ok/pwp.pl">
+
+<head>
+  <title>Index for PWP demos</title>
+</head>
+<body pwp:ask="atom_concat(SCRIPT_DIRECTORY, /, Prefix),
+	       atom_concat(Prefix, '*.pwp', Pattern),
+	       expand_file_name(Pattern, Paths),
+	       maplist(atom_concat(Prefix), Files, Paths)">
+
+<h1>PWP scripts in this directory</h1>
+
+  <ul>
+    <li pwp:ask="member(F, Files), F \== 'index.pwp'">
+	<a pwp:use="F" pwp:att="$" href="$(F)$"/>
+	<a pwp:att="$" href="$(F)$?view=source">source</a>
+    </li>
+  </ul>
+</body>
+
+</html>
+

package/lib/swipl/doc/packages/examples/http/pwp/pwp1.pwp

@@ -0,0 +1,12 @@
+<?xml version="1.0"?>
+
+<html
+  xmlns:pwp="http://www.cs.otago.ac.nz/staffpriv/ok/pwp.pl"
+  pwp:ask = "ensure_loaded(pwp(pwpdb)), once(msg(Greeting))">
+  <head>
+    <title pwp:use="Greeting"/>
+  </head>
+  <body>
+    <p><span pwp:use="Greeting" pwp:tag='-'/></p>
+  </body>
+</html>

package/lib/swipl/doc/packages/examples/http/pwp/pwp2.pwp

@@ -0,0 +1,10 @@
+<?xml version="1.0"?>
+
+<html
+  xmlns:pwp="http://www.cs.otago.ac.nz/staffpriv/ok/pwp.pl">
+  <head><title>Example 2</title></head>
+  <body pwp:ask="Hello = 'Hello world', A = 20, B = 22">
+    <h1 pwp:use="Hello"/>
+    <p>The answer is <span pwp:tag='-' pwp:use="C" pwp:ask="C is A+B"/>.</p>
+  </body>
+</html>

package/lib/swipl/doc/packages/examples/http/pwp/pwp3.pwp

@@ -0,0 +1,25 @@
+<?xml version="1.0"?>
+
+<html
+  xmlns:pwp="http://www.cs.otago.ac.nz/staffpriv/ok/pwp.pl"
+  pwp:ask='ensure_loaded(pwp(pwpdb))'>
+  <head>
+    <title>Phone list for Full-Time staff.</title>
+  </head>
+  <body>
+    <h1>Phone list for Full-Time staff.</h1>
+    <table
+      pwp:ask = "setof(FullName-Phone,
+		       N^O^E^(
+			 status(N, full_time),
+			 staff(N, FullName, O, Phone, E)
+		       ),
+		       Staff_List)">
+      <tr><th>Name</th><th>Phone</th></tr>
+      <tr pwp:ask="member(FullName-Phone, Staff_List)">
+	<td pwp:use="FullName"/>
+	<td pwp:use="Phone"/>
+      </tr>
+    </table>
+  </body>
+</html>

package/lib/swipl/doc/packages/examples/http/pwp/pwp4.pwp

@@ -0,0 +1,23 @@
+<?xml version="1.0"?>
+
+<html
+  xmlns:pwp="http://www.cs.otago.ac.nz/staffpriv/ok/pwp.pl"
+  pwp:ask='ensure_loaded(pwp(pwpdb))'>
+  <head>
+    <title>Phone list for Full-Time staff.</title>
+  </head>
+  <body>
+    <h1>Phone list for Full-Time staff.</h1>
+    <table
+      pwp:ask = "setof(FullName-E_Mail,
+		       N^O^P^staff(N, FullName, O, P, E_Mail),
+		       Staff_List)">
+      <tr><th>Name</th><th>Address</th></tr>
+      <tr pwp:ask="member(FullName-E_Mail, Staff_List)">
+	<td pwp:use="FullName"/>
+	<td><a pwp:use="E_Mail"
+	       pwp:att='$' href="mailto:$(E_Mail)$"/></td>
+      </tr>
+    </table>
+  </body>
+</html>

package/lib/swipl/doc/packages/examples/http/pwp/pwp5.pwp

@@ -0,0 +1,11 @@
+<?xml version="1.0"?>
+
+<html
+  xmlns:pwp="http://www.cs.otago.ac.nz/staffpriv/ok/pwp.pl">
+  <head><title>$SHELL</title></head>
+  <body>
+    <p pwp:ask="getenv('SHELL', Shell)"
+    >The default shell is <span pwp:tag="-" pwp:use="Shell"/>.</p>
+    <p pwp:ask="\+getenv('SHELL',_)">There is no default shell.</p>
+  </body>
+</html>

package/lib/swipl/doc/packages/examples/http/pwp/pwp6.pwp

@@ -0,0 +1,3 @@
+<?xml version="1.0"?>
+
+<a>b</a>

package/lib/swipl/doc/packages/examples/http/pwp/pwp7.pwp

@@ -0,0 +1,3 @@
+<?xml version="1.0"?>
+
+<a><b pwp:use='27' pwp:tag='-'/></a>

package/lib/swipl/doc/packages/examples/http/pwp/pwp8.pwp

@@ -0,0 +1,3 @@
+<?xml version="1.0"?>
+
+<a pwp:ask="B=20,C=22"><b pwp:use="B"/><c pwp:use="C"/></a>

package/lib/swipl/doc/packages/examples/http/pwp/pwpdb.pl

@@ -0,0 +1,12 @@
+%  This is a tiny data base for testing PWP.
+
+msg('Hello, World!').
+
+status(tom,   full_time).
+status(dick,  part_time).
+status(harry, full_time).
+
+staff(tom,   'Tom Cat',    1-21, 'x1234', 'tom@jerry.example.org').
+staff(dick,  'Dick Tater', 2-50, 'x9999', 'boss@hq.example.org').
+staff(harry, 'Harry Ett',  3-14, 'x7654', 'h.ett@kit.example.org').
+

package/lib/swipl/doc/packages/examples/http/systemd-script.service

@@ -0,0 +1,18 @@
+# demo - SWI-Prolog demo server
+#
+# The SWI-Prolog demo server
+
+[Unit]
+Description=SWI-Prolog demo server
+
+[Service]
+UMask=022
+Environment=LANG=en_US.utf8
+Restart=on-failure
+StartLimitInterval=60
+StartLimitBurst=5
+WorkingDirectory=/home/swipl/src/demo
+ExecStart=/usr/bin/swipl daemon.pl --no-fork --port=80 --user=www-data
+
+[Install]
+WantedBy=multi-user.target

package/lib/swipl/doc/packages/examples/http/upstart-script.conf

@@ -0,0 +1,20 @@
+# demo - SWI-Prolog demo server
+#
+# The SWI-Prolog demo server
+
+description     "SWI-Prolog demo server"
+
+start on runlevel [2345]
+stop on runlevel [!2345]
+
+respawn
+respawn limit 5 60
+umask 022
+
+console log
+chdir /home/swipl/src/demo
+
+script
+  export LANG=en_US.utf8
+  /usr/bin/swipl daemon.pl --no-fork --port=80 --user=www-data --pidfile=/var/run/demo.pid --workers=16 --syslog=demo
+end script

package/lib/swipl/doc/packages/examples/plunit/read.pl

@@ -0,0 +1,17 @@
+:- use_module(plunit).
+
+:- begin_tests(read).
+
+create_file(Tmp) :-
+    tmp_file(plunit, Tmp),
+    open(Tmp, write, Out),
+    write(Out, 'hello(World).\n'),
+    close(Out).
+
+test(read, [ setup(create_file(Tmp)),
+             cleanup(delete_file(Tmp))
+           ]) :-
+    read_file_to_terms(Tmp, Terms, []),
+    Terms =@= [hello(_)].
+
+:- end_tests(read).