Home Contents Index Summary Previous Next

11.9 Playing WEB (HTTP) server

Web presentation has attractive features. It is well accepted, standardised (if you stick to the basics) and network-transparent. Many people think you need a web-server like Apache with some sort of server-scripting (CGI) to realise a server. This is not true. Any application capable of elementary TCP/IP communication can easily act as a web-server.

Using XPCE for this task may be attractive for a number of reasons.

We start with a small demo, illustrating frames and text.

Figure 28 : Mozilla showing XPCE generated figure


:- module(my_httpd,
          [ go/1
          ]).
:- use_module(library(pce)).
:- use_module(library('http/httpd')).
:- use_module(library('http/html_write')).
:- use_module(library('draw/importpl')).

%       Create server at Port

go(Port) :-
        new(_, my_httpd(Port)).

:- pce_begin_class(my_httpd, httpd, "Demo Web server").

->request is sent after the super-class has received a complete request header. We get the `path' and have a Prolog predicate generating the replies.


request(HTTPD, Request:sheet) :->
        "A request came in."::
        get(Request, path, Path),
        reply(Path, HTTPD).

:- discontiguous
        reply/2.

->reply_html takes <Module>:<DCGRuleSet> to formulate a reply. This uses the html_write library, converting a complex Prolog term into a formatted HTML document. The complex term can invoke additional DCG rulesets, providing nicely structured content-generation.


reply('/', HTTPD) :- !,
        send(HTTPD, reply_html, my_httpd:frames).

frames -->
        html(html([ head(title('Demo')),
                    frameset([cols('25%,75%')],
                             [ frame([ src('/index'),
                                       name(index)
                                     ]),
                               frame([ src('/blank'),
                                       name(body)
                                     ])
                             ])
                  ])).


reply('/blank', HTTPD) :-
        send(HTTPD, reply_html, my_httpd:blank).

blank -->
        page(title('Blank'),
             []).

reply('/index', HTTPD) :-
        send(HTTPD, reply_html, my_httpd:index).

index -->
        page(title('Index'),
             [ a([ href('/text'), target(body) ],
                 [ 'Show text' ]),
               br([]),
               a([ href('/picture'), target(body) ],
                 [ 'Show picture' ])
             ]).

reply('/text', HTTPD) :-
        send(HTTPD, reply_html, my_httpd:text).

text -->
        page(title('Text'),
             [ p(['Just showing a little text'])
             ]).

Reply a graphical object. The server translates the graphical to a GIF or JPEG bitmap and provides the proper HTTP reply header. You can also embed graphicals into the HTML structures used above.

The drawing itself is exported from the demo program PceDraw and turned into an XPCE graphical using the support library draw/importpl.


reply('/picture', HTTPD) :-
        make_picture(Gr),
        send(HTTPD, reply, Gr, 'image/gif').

make_picture(Dev) :-
        new(Dev, device),
        drawing(xpcenetscape, Drawing),
        realise_drawing(Dev, Drawing).

%       Drawing imported from PceDraw

drawing(xpcenetscape,
        [ compound(new(A, figure),
                   drawing([ display(box(137, 74)+radius(17),
                                     point(0, 0)),
                             display(text('XPCE', center, normal),
                                     point(52, 30))
                           ]),
                   point(163, 183)),
          compound(new(B, figure),
                   drawing([ display(box(137, 74)+radius(17),
                                     point(0, 0)),
                             display(text('Netscape', center, normal),
                                     point(42, 30))
                           ]),
                   point(350, 183)),
          connect(connection(A,
                             B,
                             handle(w, h/2, link, east),
                             handle(0, h/2, link, west)) +
                    arrows(both))
        ]).

:- pce_end_class(my_httpd).

11.9.1 Class httpd

The library library(http/httpd) defines the class httpd. This subclass of socket deals with most of the HTTP protocol details, breaking down HTTP requests and encapsulating responses with the proper headers. The class itself is an abstract class, a subclass needs to be created and some of the virtual methods needs to be refined to arrive at a useful application.

httpd ->initialise: Port:[int]
Create a server and bind it to Port. If Port is omitted a free port is chosen. With a specified port, 8080 is a commonly used alternative to the standard 80 used by web-servers. If you have a web-server running on the same machine you may can generate a page on your website redirecting a page to this server. The URI of this server is http://<host>/<Port>.

httpd ->accepted:
This is sent after a connection has been accepted. The system implementation logs the new connection if debugging is enabled. You can refine or redefine this method, asking for the `socket<-peer_name' and sending ->free to the socket if you want to restrict access.

httpd ->request: Data:sheet
This is sent from ->input after a complete request-header is received. ->input decodes the header-fields, places them in Data and then calls ->request. The attribute-names in the sheet are downcase versions of the case-insensitive request fields of the HTTP header. In addition, the following fields are defined:

Fields that are always present
requestGET, POST, etc. I.e. the first word of the request-header. In most cases this will be GET.
pathThe `path' part of the request. This is normally used to decide on the response. If the path contains a ? (question mark) this and the remaining data are removed and decoded to the `form' attribute.
formIf the request is a GET request with form-data, the form attribute contains another sheet holding the decoded form-data. Otherwise <-form holds @nil.
http_versionVersion of the HTTP protocol used by the client. Normally 1.0 or 1.1.
Other fields
userIf authorisation data is present, this contains the user-name. If this field is present, the password field is present too.
passwordContains the decoded password supplied by the user.

After decoding the request, the user should compose a response and use ->reply or ->reply_html to return the response to the client.

httpd ->reply:
Send a reply. This method or ->reply_html is normally activated at the end of the user's ->request implementation. Data is one of:

Type is the mimi-type returned and tells the browser what to do with the data. This should correspond with the content of Data. For example, you can return a PNG picture from a file using


        send(HTTPD, reply, file('pict.png'), 'image/png'),

Status is used to tell the client in a formal way how the request was processed. The default is 200 OK. See the methods below for returning other values.

Header is a sheet holding additional name-value pairs. If present, they are simply added to the end of the reply-header. For example if you want to prevent the browser caching the result you can use


        send(HTTPD, reply, ...,
             sheet(attribute('Cache-Control', 'no-cache'))),

httpd ->reply_html:
Uses the library(http/html_write) library to translate Term into HTML text using DCG rules and then invokes ->reply using the Type text/html. Status and Header are passed unmodified to ->reply.

In addition to the principal methods above, a number of methods are defined for dealing with abnormal replies such as denying permission, etc.

httpd ->forbidden: What:[name]
Replies with a 403 Forbidden message. What may be provided to indicate what is forbidden. Default is the path from the current <-request.

httpd ->authorization_required:
Challenges the user to provide a name and password. The only method provided is Basic. Realm tells the user for which service permission is requested. On all subsequence contacts from this client to this server the ->request data contains the user and password fields. The demo implementation of ->request in httpd contains the following example code:


request(S, Header:sheet) :->
        "Process a request.  The argument is the header"::
        (   get(Header, path, '/no')
        ->  send(S, forbidden, '/no')
        ;   get(Header, path, '/maybe')
        ->  (   get(Header, value, user, jan),
                get(Header, value, password, test)
            ->  send(S, reply, 'You hacked me')
            ;   send(S, authorization_required)
            )
        ;   send(S, reply, 'Nice try')
        ).

httpd ->not_found: What:[char_array]
Reply with a 404 Not Found message, using the request-path as default for What.

httpd ->moved: Where:char_array
Reply with a 301 Moved Permanently. Normally the client will retry the request using the URL returned in Where.

httpd ->server_error: What:[char_array]
Reply with a 500 Internal Server using `What as additional information to the user. This is the default reply if ->request fails or raised an exception.

11.9.2 The ``http/html_write'' library

Producing output for the web in the form of an HTML document is a requirement for many Prolog programs. Just using format/2 is satisfactory as it leads to poorly readable programs generating poor HTML. This library is based on using DCG rules.

The library(pl/html_write) is intended to structure the generation of HTML from a program. It is an extensible library, providing a DCG framework for generation of legal HTML under (Prolog) program control. It is especially useful for the generation of structured pages (tables) from Prolog data structures.

The normal way to use this library is through the DCG html/1. This grammar-rule provides the central translation from a structured term with embedded calls to additional translation rules to a list of atoms that can then be printed using print_html/[1,2].

html(:Spec)
The DCG rule html/1 is the main predicate of this library. It translates the specification for an HTML page into a list of atoms that can be written to a stream using print_html/[1,2]. The expansion rules of this predicate may be extended by defining the multifile DCG html_write:expand/1. Spec is either a single specification or a list of single specifications. Using nested lists is not allowed to avoid ambiguity caused by the atom

page(:HeadContent, :BodyContent)
The DCG rule page/2 generated a complete page, including the SGML DOCTYPE declaration. HeadContent are elements to be placed in the head element and BodyContent are elements to be placed in the body element.

To achieve common style (background, page header and footer), it is possible to define DCG rules head/1 and/or body/1. The page/1 rule checks for the definition of these DCG rules in the module it is called from as well as in the user module. If no definition is found, it creates a head with only the HeadContent (note that the title is obligatory) and a body with bgcolor set to white and the provided BodyContent.

Note that further customisation is easily achieved using html/1 directly as page/2 is (besides handling the hooks) defined as:


page(Head, Body) -->
        html([ \['<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 4.0//EN">\n'],
               html([ head(Head),
                      body(bgcolor(white), Body)
                    ])
             ]).

page(:Contents)
This version of the page/[1,2] only gives you the SGML DOCTYPE and the HTML element. Contents is used to generate both the head and body of the page.

html_begin(+Begin)
Just open the given element. Begin is either an atom or a compound term, In the latter case the arguments are used as arguments to the begin-tag. Some examples:


        html_begin(table)
        html_begin(table(border(2), align(center)))

This predicate provides an alternative to using the \Command syntax in the html/1 specification. The following two fragments are the same. The preferred solution depends on your preferences as well as whether the specification is generated or entered by the programmer.


table(Rows) -->
        html(table([border(1), align(center), width('80%')],
                   [ \table_header,
                     \table_rows(Rows)
                   ])).

% or

table(Rows) -->
        html_begin(table(border(1), align(center), width('80%'))),
        table_header,
        table_rows,
        html_end(table).

html_end(+End)
nd an element. See html_begin/1 for details.

11.9.2.1 Emitting HTML documents

The html/1 grammar rules translates a specification into a list of atoms and layout instructions. Currently the layout instructions are terms of the format nl(N), requesting at least N newlines. Multiple consequtive nl(1) terms are combined to an atom containing the maximum of the requested number of newline characters.

To simplify handing the data to a client or storing it into a file, the following predicates are available from this library:

print_html(+List)
Print the token list to the Prolog current output stream.

print_html(+Stream, +List)
Print the token list to the specified output stream

html_print_length(+List, -Length)
When calling html_print/[1,2] on List, Length characters will be produced. Knowing the length is needed to provide the Content-length field of an HTTP reply-header.

11.9.2.2 Adding rules for html/1

In some cases it is practical to extend the translations imposed by html/1. When using XPCE for example, it is comfortable to be able defining default translation to HTML for objects. We also used this technique to define translation rules for the output of the SWI-Prolog library(sgml) package.

The html/1 rule first calls the multifile ruleset html_write:expand/1. The other predicates contain commonly rules for defining new rules.

html_write:expand(+Spec)
Hook to add additional translationrules for html/1.

html_quoted(+Atom)
Emit the text in Atom, inserting entity-references for the SGML special characters <&>.

html_quoted_attribute(+Atom)
Emit the text in Atom suitable for use as an SGML attribute, inserting entity-references for the SGML special characters <&>'".

11.9.2.3 Generating layout

Though not strictly necessary, the library attempts to generate reasonable layout in SGML output. It does this only by inserting newlines before and after tags. It does this on the basis of the multifile predicate html_write:layout/3

html_write:layout(+Tag, -Open, -Close)
Specify the layout conventions for the element Tag, which is a lowercase atom. Open is a term Pre-Post. It defines that the element should have at least Pre newline characters before and Post after the tag. The Close specification is similar, but in addition allows for the atom -, requesting the output generator to omit the close-tag altogether or empty, telling the library that the element has declared empty content. In this case the close-tag is not emitted either, but in addition html/1 interprets Arg in Tag(Arg) as a list of attributes rather than the content.

A tag that does not appear in this table is emitted without additional layout. See also print_html/[1,2]. Please consult the library source for examples.

11.9.2.4 Examples

In the following example we will generate a table of Prolog predicates we find from the SWI-Prolog help system based on a keyword. The primary database is defined by the predicate predicate/5 We will make hyperlinks for the predicates pointing to their documentation.


html_apropos(Kwd) :-
        findall(Pred, apropos_predicate(Kwd, Pred), Matches),
        phrase(apropos_page(Kwd, Matches), Tokens),
        print_html(Tokens).

%       emit page with title, header and table of matches

apropos_page(Kwd, Matches) -->
        page([ title(['Predicates for ', Kwd])
             ],
             [ h2(align(center),
                  ['Predicates for ', Kwd]),
               table([ align(center),
                       border(1),
                       width('80%')
                     ],
                     [ tr([ th('Predicate'),
                            th('Summary')
                          ])
                     | \apropos_rows(Matches)
                     ])
             ]).

%       emit the rows for the body of the table.

apropos_rows([]) -->
        [].
apropos_rows([pred(Name, Arity, Summary)|T]) -->
        html([ tr([ td(\predref(Name/Arity)),
                    td(em(Summary))
                  ])
             ]),
        apropos_rows(T).

%       predref(Name/Arity)
%
%       Emit Name/Arity as a hyperlink to
%
%               /cgi-bin/plman?name=Name&arity=Arity
%
%       we must do form-encoding for the name as it may contain illegal
%       characters.  www_form_encode/2 is defined in library(url).

predref(Name/Arity) -->
        { www_form_encode(Name, Encoded),
          sformat(Href, '/cgi-bin/plman?name=~w&arity=~w',
                  [Encoded, Arity])
        },
        html(a(href(Href), [Name, /, Arity])).

%       Find predicates from a keyword. '$apropos_match' is an internal
%       undocumented predicate.

apropos_predicate(Pattern, pred(Name, Arity, Summary)) :-
        predicate(Name, Arity, Summary, _, _),
        (   '$apropos_match'(Pattern, Name)
        ->  true
        ;   '$apropos_match'(Pattern, Summary)
        ).

11.9.2.5 Final remarks

This library is the result of various attempts to reach at a more satisfactory and Prolog-minded way to produce HTML text from a program. We have been using Prolog for the generation of web pages in a number of projects. Just using format/2 never was a real option, generating error-prone HTML from clumsy syntax. We started with a layour on top of format, keeping track of the current nesting and thus always capable of properly closing the environment.

DCG based translation however naturally exploits Prologs term-rewriting primitives. If generation fails for whatever reason it is easy to produce an alternative document (for example holding an error message).

The approach presented in this library has been used in combination with library(http/httpd) in three projects: viewing RDF in a browser, selecting fragments from an analysed document and presenting parts of the XPCE documentation using a browser. It has proven to be able to deal with generating pages quickly and comfortably.

In a future version we will probably define a goal_expansion/2 to do compile-time optimisation of the library. Quotation of known text and invokation of sub-rules using the \RuleSet and <Module>:<RuleSet> operators are costly operations in the analysis that can be done at compile-time.