1% ----------------------------------------------------------------------
2% BEGIN LICENSE BLOCK
3% Version: CMPL 1.1
4%
5% The contents of this file are subject to the Cisco-style Mozilla Public
6% License Version 1.1 (the "License"); you may not use this file except
7% in compliance with the License.  You may obtain a copy of the License
8% at www.eclipse-clp.org/license.
9%
10% Software distributed under the License is distributed on an "AS IS"
11% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
12% the License for the specific language governing rights and limitations
13% under the License.
14%
15% The Original Code is  The ECLiPSe Constraint Logic Programming System.
16% The Initial Developer of the Original Code is  Cisco Systems, Inc.
17% Portions created by the Initial Developer are
18% Copyright (C) 1991-2006 Cisco Systems, Inc.  All Rights Reserved.
19%
20% Contributor(s): ECRC GmbH
21% Contributor(s): IC-Parc, Imperal College London
22%
23% END LICENSE BLOCK
24%
25% System:	ECLiPSe Constraint Logic Programming System
26% Version:	$Id: http_server.pl,v 1.2 2009/07/16 09:11:24 jschimpf Exp $
27% ----------------------------------------------------------------------
28
29/*
30    RPC using HTTP/1.0 (request status line) and
31    MIME-Version:1.0 (request general header)
32
33    SERVER
34
35    http document used is HTTP/1.0 from the Network Working Group
36    - internet draft - expiring in june, 19 1995.
37*/
38
39:- module(http_server).
40
41:- comment(categories, ["Interfacing"]).
42:- comment(summary, "HTTP server library").
43:- comment(author, "Ph. Bonnet, S. Bressan and M. Meier, ECRC Munich").
44:- comment(copyright, "Cisco Systems, Inc").
45:- comment(date, "$Date: 2009/07/16 09:11:24 $").
46
47:- export
48        http_server/1,
49        http_server/2.
50
51
52
53:- use_module(http_grammar).
54
55
56/*
57http_server(+Port)
58    - creation of a socket, bind it to current Host and Port and listen
59    - loop
60*/
61
62http_server(Port):-
63        http_server(Port, 1).
64
65http_server(Port, Pending):-
66	setval(port, Port),
67	socket(internet, stream, Soc),
68	bind(Soc, _/Port),
69	listen(Soc, Pending),
70	loop(Soc).
71
72
73/*
74loop:
75    - accept a connection on the socket
76    - reception of a request
77    - decoding of the request (method + url + http param init)
78    - call of the server function
79    - encoding of the response (depending on server function)
80    - send the response on the socket
81*/
82loop(Soc):-
83	accept(Soc, _, S),
84        (block(process(S), Tag,
85               (Tag==13 ->DontClose=true;true)
86              ) ->
87            true
88        ;
89            true
90        ),
91        (var(DontClose)->
92            close(S)
93        ;
94            true
95        ),
96	loop(Soc).
97loop(Soc):-
98	loop(Soc).
99
100
101process(S):-
102	request_recp(S, Method, URL, ReqHttpParams, ObjectBody),
103	call(http_method(Method, URL, ObjectBody,
104	  Output, Status, RespHttpParams))@http_method,
105	analyse_para(ReqHttpParams, RespHttpParams, HttpParams),
106	respons_enco(Output, Status, HttpParams, Response),
107	respons_send(S, Response).
108
109
110/*
111The request reception reads from the socket stream a full request sent by
112the client. Only http full requests are recognised (http document p. 15).
113
114The request is returned as the Method, the URL and a set of parameters
115defined in the header, plus the object body
116
117The header is constituted of lindes separated by \r \n.
118The header is separated from the object body by a \r \n.
119The length of the object body is a parameter in the header
120*/
121request_recp(S, Method, Url, HttpParams, ObjectBody):-
122	read_parse_Header(S, Method, Url, HttpParams),
123	(member(contentLength(BL), HttpParams) ->
124	    read_Object(S, BL, ObjectBody)
125	;
126	    true
127	).
128
129
130read_parse_Header(Stream, Method, Url, HttpParams):-
131	read_SL(Stream, SL),
132	parse_SL(SL, Method, Url),
133	read_Params(Stream, Params),
134	parse_Params(Params, HttpParams).
135
136/*
137status line
138*/
139read_SL(S, Line):-
140	read_string(S, "\r\n", _, Line),
141	read_string(S, "\r\n", L, _), L==0.
142
143parse_SL(Line, Method, Url):-
144	open(string(Line), read, S),
145	read_string(S, " ", _, Method),
146	read_string(S, " ", _, Url),
147	close(S).
148
149/*
150general header*
151request header*
152object header*
153*/
154read_Params(S, List):-
155	read_Params(S, [], List).
156
157read_Params(S, L0, L):-
158	read_string(S, "\r\n", Length, Elem),
159	Length \== 0, !,
160	read_string(S, "\r\n", LLength, _),
161	LLength == 0,
162	append(L0, [Elem], L1),
163	read_Params(S, L1, L).
164read_Params(S, L, L):-
165	read_string(S, "\r\n", Length, _),
166	Length == 0.
167
168
169/*
170parsing using the DCG grammar
171*/
172
173parse_Params([], []).
174parse_Params([H|T], [P|TT]):-
175	append_strings(H, "\n", HH),
176	open(string(HH), read, S),
177	token_to_list(S, L),
178	close(S),
179	phrase(header(P), L, _), !,
180	parse_Params(T, TT).
181
182
183/*
184read the object according to the object length that is contained
185in the header.
186
187*/
188read_Object(S, BL, ObjectBody):-
189	read_string(S, "", BL, ObjectBody).
190
191
192/*
193analyse of the Url
194*/
195analyse_Url(Url, Path):-
196	open(string(Url), read, S),
197	read_string(S, "//", _, _),
198	read_string(S, "/", _, _),
199	read_string(S, "", Path, _),
200	close(S).
201
202
203
204
205/*
206rpc call:
207executes the method on the object and return:
208- the output of the method (possibly empty)
209- a status code for the response status line
210- a list of http parameters (in particular the length of the object body).
211
212
213http_rpcInterface(Method, Url, ObjectBody, Output, 200, [contentLength(CL)]):-
214	concat_string(["Vous avez demande la methode ",
215	     Method, "sur l'objet ", Url], Output),
216	string_length(Output, CL).
217
218*/
219/*
220http paramter analysis:
221compatibility between response and request parameters.
222constitution of the list of parameters for the response
223*/
224
225analyse_para(_, HttpParams, HttpParams).
226
227
228/*
229response encoding:
230- response status
231- response header
232- object body
233*/
234
235respons_enco(Output, Status, HttpParams, Response):-
236	resp_SL(Status, SL),
237	resp_Header(HttpParams, Header),
238	concat_string([SL, Header, "\n" ], H),
239	concat_strings(H, Output, Response).
240
241resp_SL(Status, SL):-
242	integer_atom(Status, S), atom_string(S, SC),
243	substring(SC, 0, 1, _, RP),
244	concat_string(["HTTP/1.0 ", SC, " ", RP, "\n"], SL).
245
246resp_Header(HttpParams, Header):-
247	resp_Header(HttpParams, "", Header).
248
249resp_Header([], S, S).
250resp_Header([H|T], S0, S):-
251	once(phrase(header(H), L, _)),
252	open(string(""), write, St),
253	list_to_token(L, St),
254	get_stream_info(St, name, S1),
255	close(St),
256	concat_string([S0, S1, "\n"], S2),
257	resp_Header(T, S2, S).
258
259/*
260response sending
261*/
262
263respons_send(Stream, String):-
264	open(string(String), read, StreamString),
265	sub_respons_send(Stream, StreamString),
266	close(StreamString).
267
268
269sub_respons_send(Stream, StreamString):-
270	read_string(StreamString, "", 250, String),!,
271	write(Stream, String), flush(Stream),
272        sub_respons_send(Stream, StreamString).
273sub_respons_send(_, _).
274
275
276%----------------------------------------------------------------------
277
278:- comment(http_server/1, [ template:"http_server(+Port)",
279    summary:"Start an http server",
280    args:["Method":"An integer port number"],
281    desc:html("
282    The server does:
283    <UL>
284    <LI> creation of a socket, bind it to current Host and given Port and listen
285    <LI> accept a connection on the socket
286    <LI> reception of a request
287    <LI> decoding of the request (method + url + http param init)
288    <LI> call the predicate http_method in module http_method
289    <LI> encoding of the response (depending on server function)
290    <LI> send the response on the socket
291    </UL>
292    NOTE:  The predicate http_server/1 requires that a module http_method
293    is defined that contains a predicate http_method/6.  This predicate is
294    used by the programmer to customize the server.  For instance the
295    method GET can be simply implemented.  The programmer can define its
296    own methods.
297    <P>
298    A simple example of server is the implementation of the method
299    GET.  A module is created that contains the predicate
300    http_method/6 that implements the method GET:  a read on the file
301    identified by its URL.  The file is returned if it is found,
302    otherwise an error parameter is returned.
303    <P>
304    This simple program can be used to test HTML pages.  Viewers such
305    as Netscape provide a view code option that signalizes syntax
306    errors in the HTML code.  This simple program can be used as a
307    light weight testing tool, possibly launched from the directory
308    where the HTML page resides.
309    "),
310    eg:"
311    [eclipse 1]: [user].
312
313    /********************************************************************
314     *  test (server)
315     *******************************************************************/
316
317    :- module(http_method).
318
319    :- set_error_handler(170, fail/0).
320    :- set_error_handler(171, fail/0).
321
322    /*
323    http_method(+Method, +Url, +ObjectBody, -Output, -StatusCode, -Parameter)
324    executes the method on the object and returns:
325    - the output of the method (possibly empty)
326    - a status code for the response status line
327    - a list of http parameters (in particular the length of the object body).
328
329    */
330
331
332    http_method(\"GET\", Url, _, Contents, 200, [contentLength(CL)]):-
333	    append_strings(\"/\", FileName, Url),
334	    getContents(FileName, Contents), !,
335	    string_length(Contents, CL).
336    http_method(\"GET\", _, _, \"\", 404, []).
337
338
339    getContents(Url, Contents):-
340	    open(Url, read, S),
341	    read_string(S, \"\", _, Contents),
342	    close(S).
343
344    ^D
345
346    yes.
347
348    [eclipse 2]: use_module(http).
349    http_grammar.pl compiled traceable 25048 bytes in 0.27 seconds
350    http_client.pl compiled traceable 6052 bytes in 0.28 seconds
351    http_server.pl compiled traceable 5564 bytes in 0.03 seconds
352    http.pl    compiled traceable 0 bytes in 0.35 seconds
353
354    yes.
355    [eclipse 3]: use_module(http_method).
356
357    yes.
358    [eclipse 4]: http_server(8000).
359    "]).
360
361:- comment(http_server/2, [ template:"http_server(+Port,+Pending)",
362    summary:"Start an http server with allows the specified number of pending connections",
363    args:["Method":"An integer port number",
364          "Pending":"The number of simultaneous connections to queue up before rejecting"],
365    desc:html("<CODE>http_server/1</CODE> corresponds to a pending queue size of 1.")]).
366