1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2006-2015, University of Amsterdam 7 VU University Amsterdam 8 All rights reserved. 9 10 Redistribution and use in source and binary forms, with or without 11 modification, are permitted provided that the following conditions 12 are met: 13 14 1. Redistributions of source code must retain the above copyright 15 notice, this list of conditions and the following disclaimer. 16 17 2. Redistributions in binary form must reproduce the above copyright 18 notice, this list of conditions and the following disclaimer in 19 the documentation and/or other materials provided with the 20 distribution. 21 22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 POSSIBILITY OF SUCH DAMAGE. 34*/ 35 36:- module(http_parameters, 37 [ http_parameters/2, % +Request, -Params 38 http_parameters/3, % +Request, -Params, +TypeG 39 40 http_convert_parameter/4, % +Options, +FieldName, +ValIn, -ValOut 41 http_convert_parameters/2, % +Data, +Params 42 http_convert_parameters/3 % +Data, +Params, :DeclGoal 43 ]). 44:- use_module(http_client). 45:- use_module(http_multipart_plugin). 46:- use_module(http_hook). 47:- use_module(library(debug)). 48:- use_module(library(option)). 49:- use_module(library(error)). 50:- use_module(library(broadcast)). 51 52:- predicate_options(http_parameters/3, 3, 53 [ form_data(-list), 54 attribute_declarations(callable) 55 ]).
79:- meta_predicate
80 http_parameters(, , ),
81 http_convert_parameters(, , ).call(Goal, A, Declarations).The attribute_declarations hook allows sharing the declaration of attribute-properties between many http_parameters/3 calls. In this form, the requested attribute takes only one argument and the options are acquired by calling the hook. For example:
...,
http_parameters(Request,
[ sex(Sex)
],
[ attribute_declarations(http_param)
]),
...
http_param(sex, [ oneof(male, female),
description('Sex of the person')
]).
117http_parameters(Request, Params) :- 118 http_parameters(Request, Params, []). 119 120http_parameters(Request, Params, Options) :- 121 must_be(list, Params), 122 meta_options(is_meta, Options, QOptions), 123 option(attribute_declarations(DeclGoal), QOptions, -), 124 http_parms(Request, Params, DeclGoal, Form), 125 ( memberchk(form_data(RForm), QOptions) 126 -> RForm = Form 127 ; true 128 ). 129 130is_meta(attribute_declarations). 131 132 133http_parms(Request, Params, DeclGoal, Data) :- 134 memberchk(method(post), Request), 135 memberchk(content_type(Content), Request), 136 form_data_content_type(Content), 137 !, 138 debug(post_request, 'POST Request: ~p', [Request]), 139 posted_form(Request, Data), 140 fill_parameters(Params, Data, DeclGoal). 141http_parms(Request, Params, DeclGoal, Search) :- 142 ( memberchk(search(Search), Request) 143 -> true 144 ; Search = [] 145 ), 146 fill_parameters(Params, Search, DeclGoal). 147 148:- multifile 149 form_data_content_type/1. 150 151form_data_content_type('application/x-www-form-urlencoded') :- !. 152form_data_content_type(ContentType) :- 153 sub_atom(ContentType, 0, _, _, 'application/x-www-form-urlencoded;').
160posted_form(Request, _Data) :- 161 nb_current(http_post_data, read), 162 !, 163 option(request_uri(URI), Request), 164 throw(error(permission_error('re-read', 'POST data', URI), 165 context(_, 'Attempt to re-read POST data'))). 166posted_form(Request, Data) :- 167 http_read_data(Request, Data, []), 168 nb_setval(http_post_data, read), 169 debug(post, 'POST Data: ~p', [Data]). 170 171wipe_posted_data :- 172 debug(post, 'Wiping posted data', []), 173 nb_delete(http_post_data). 174 175:- listen(http(request_finished(_Id, _Code, _Status, _CPU, _Bytes)), 176 wipe_posted_data).
183fill_parameters([], _, _). 184fill_parameters([H|T], FormData, DeclGoal) :- 185 fill_parameter(H, FormData, DeclGoal), 186 fill_parameters(T, FormData, DeclGoal). 187 188fill_parameter(H, _, _) :- 189 var(H), 190 !, 191 instantiation_error(H). 192fill_parameter(group(Members, _Options), FormData, DeclGoal) :- 193 is_list(Members), 194 !, 195 fill_parameters(Members, FormData, DeclGoal). 196fill_parameter(H, FormData, _) :- 197 H =.. [Name,Value,Options], 198 !, 199 fill_param(Name, Value, Options, FormData). 200fill_parameter(H, FormData, DeclGoal) :- 201 H =.. [Name,Value], 202 ( DeclGoal \== (-), 203 call(DeclGoal, Name, Options) 204 -> true 205 ; throw(error(existence_error(attribute_declaration, Name), _)) 206 ), 207 fill_param(Name, Value, Options, FormData). 208 209fill_param(Name, Values, Options, FormData) :- 210 memberchk(zero_or_more, Options), 211 !, 212 fill_param_list(FormData, Name, Values, Options). 213fill_param(Name, Values, Options, FormData) :- 214 memberchk(list(Type), Options), 215 !, 216 fill_param_list(FormData, Name, Values, [Type|Options]). 217fill_param(Name, Value, Options, FormData) :- 218 ( memberchk(Name=Value0, FormData), 219 Value0 \== '' % Not sure 220 -> http_convert_parameter(Options, Name, Value0, Value) 221 ; memberchk(default(Value), Options) 222 -> true 223 ; memberchk(optional(true), Options) 224 -> true 225 ; throw(error(existence_error(http_parameter, Name), _)) 226 ). 227 228 229fill_param_list([], _, [], _). 230fill_param_list([Name=Value0|Form], Name, [Value|VT], Options) :- 231 !, 232 http_convert_parameter(Options, Name, Value0, Value), 233 fill_param_list(Form, Name, VT, Options). 234fill_param_list([_|Form], Name, VT, Options) :- 235 fill_param_list(Form, Name, VT, Options).
http_parameters(Request, Params) :-
http_read_data(Request, Data, []),
http_convert_parameters(Data, Params).
251http_convert_parameters(Data, ParamDecls) :- 252 fill_parameters(ParamDecls, Data, -). 253http_convert_parameters(Data, ParamDecls, DeclGoal) :- 254 fill_parameters(ParamDecls, Data, DeclGoal).
267http_convert_parameter([], _, Value, Value). 268http_convert_parameter([H|T], Field, Value0, Value) :- 269 ( check_type_no_error(H, Value0, Value1) 270 -> http_convert_parameter(T, Field, Value1, Value) 271 ; throw(error(type_error(H, Value0), 272 context(_, http_parameter(Field)))) 273 ). 274 275check_type_no_error(Type, In, Out) :- 276 http:convert_parameter(Type, In, Out), 277 !. 278check_type_no_error(Type, In, Out) :- 279 check_type3(Type, In, Out).
285check_type3((T1;T2), In, Out) :- 286 !, 287 ( check_type_no_error(T1, In, Out) 288 -> true 289 ; check_type_no_error(T2, In, Out) 290 ). 291check_type3(string, Atom, String) :- 292 !, 293 to_string(Atom, String). 294check_type3(number, Atom, Number) :- 295 !, 296 to_number(Atom, Number). 297check_type3(integer, Atom, Integer) :- 298 !, 299 to_number(Atom, Integer), 300 integer(Integer). 301check_type3(nonneg, Atom, Integer) :- 302 !, 303 to_number(Atom, Integer), 304 integer(Integer), 305 Integer >= 0. 306check_type3(float, Atom, Float) :- 307 !, 308 to_number(Atom, Number), 309 Float is float(Number). 310check_type3(between(Low, High), Atom, Value) :- 311 !, 312 to_number(Atom, Number), 313 ( (float(Low) ; float(High)) 314 -> Value is float(Number) 315 ; Value = Number 316 ), 317 is_of_type(between(Low, High), Value). 318check_type3(boolean, Atom, Bool) :- 319 !, 320 truth(Atom, Bool). 321check_type3(Type, Atom, Atom) :- 322 check_type2(Type, Atom). 323 324to_number(In, Number) :- 325 number(In), !, Number = In. 326to_number(In, Number) :- 327 atom(In), 328 atom_number(In, Number). 329 330to_string(In, String) :- string(In), !, String = In. 331to_string(In, String) :- atom(In), !, atom_string(In, String). 332to_string(In, String) :- number(In), !, number_string(In, String).
338check_type2(oneof(Set), Value) :- 339 !, 340 memberchk(Value, Set). 341check_type2(length > N, Value) :- 342 !, 343 atom_length(Value, Len), 344 Len > N. 345check_type2(length >= N, Value) :- 346 !, 347 atom_length(Value, Len), 348 Len >= N. 349check_type2(length < N, Value) :- 350 !, 351 atom_length(Value, Len), 352 Len < N. 353check_type2(length =< N, Value) :- 354 !, 355 atom_length(Value, Len), 356 Len =< N. 357check_type2(_, _).
364truth(true, true). 365truth('TRUE', true). 366truth(yes, true). 367truth('YES', true). 368truth(on, true). 369truth('ON', true). % IE7 370truth('1', true). 371 372truth(false, false). 373truth('FALSE', false). 374truth(no, false). 375truth('NO', false). 376truth(off, false). 377truth('OFF', false). 378truth('0', false). 379 380 381 /******************************* 382 * XREF SUPPORT * 383 *******************************/ 384 385:- multifile 386 prolog:called_by/2, 387 emacs_prolog_colours:goal_colours/2. 388 389prologcalled_by(http_parameters(_,_,Options), [G+2]) :- 390 option(attribute_declarations(G), Options, _), 391 callable(G), 392 !. 393 394emacs_prolog_colours:goal_colours(http_parameters(_,_,Options), 395 built_in-[classify, classify, Colours]) :- 396 option_list_colours(Options, Colours). 397 398option_list_colours(Var, error) :- 399 var(Var), 400 !. 401option_list_colours([], classify) :- !. 402option_list_colours(Term, list-Elements) :- 403 Term = [_|_], 404 !, 405 option_list_colours_2(Term, Elements). 406option_list_colours(_, error). 407 408option_list_colours_2(Var, classify) :- 409 var(Var). 410option_list_colours_2([], []). 411option_list_colours_2([H0|T0], [H|T]) :- 412 option_colours(H0, H), 413 option_list_colours_2(T0, T). 414 415option_colours(Var, classify) :- 416 var(Var), 417 !. 418option_colours(_=_, built_in-[classify,classify]) :- !. 419option_colours(attribute_declarations(_), % DCG = is a hack! 420 option(attribute_declarations)-[dcg]) :- !. 421option_colours(Term, option(Name)-[classify]) :- 422 compound(Term), 423 Term =.. [Name,_Value], 424 !. 425option_colours(_, error). 426 427 /******************************* 428 * MESSAGES * 429 *******************************/ 430 431:- multifile prolog:error_message//1. 432:- multifile prolog:message//1. 433 434prologerror_message(existence_error(http_parameter, Name)) --> 435 [ 'Missing value for parameter "~w".'-[Name] ]. 436prologmessage(error(type_error(Type, Term), context(_, http_parameter(Param)))) --> 437 { atom(Param) }, 438 [ 'Parameter "~w" must be '-[Param] ], 439 param_type(Type), 440 ['. Found "~w".'-[Term] ]. 441 442param_type(length>N) --> 443 !, 444 ['longer than ~D characters'-[N]]. 445param_type(length>=N) --> 446 !, 447 ['at least ~D characters'-[N]]. 448param_type(length<N) --> 449 !, 450 ['shorter than ~D characters'-[N]]. 451param_type(length=<N) --> 452 !, 453 ['at most ~D characters'-[N]]. 454param_type(between(Low,High)) --> 455 !, 456 ( {float(Low);float(High)} 457 -> ['a number between ~w and ~w'-[Low,High]] 458 ; ['an integer between ~w and ~w'-[Low,High]] 459 ). 460param_type(oneof([Only])) --> 461 !, 462 ['"~w"'-[Only]]. 463param_type(oneof(List)) --> 464 !, 465 ['one of '-[]], oneof(List). 466param_type(T) --> 467 ['of type ~p'-[T]]. 468 469 470oneof([]) --> []. 471oneof([H|T]) --> 472 ['"~w"'-[H]], 473 ( {T == []} 474 -> [] 475 ; {T = [Last]} 476 -> [' or "~w"'-[Last] ] 477 ; [', '-[]], 478 oneof(T) 479 )
Extract parameters (GET and POST) from HTTP requests
This module is used to extract the value of GET or POST parameters from an HTTP request. The typical usage is e.g.,
:- http_handler('/register_user', register_user, []). register_user(Request) :- http_parameters(Request, [ name(Name, []), sex(Sex, [oneof([male,female])]), birth_year(BY, [between(1850,10000)]) ]), register_user(Name, Sex, BY), html_reply_page(title('New user added'), ...).http_dispatch.pldispatches requests to predicates. */