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, no_decl_goal), 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).
183:- meta_predicate fill_parameters(, , ). 184 185fill_parameters([], _, _). 186fill_parameters([H|T], FormData, DeclGoal) :- 187 fill_parameter(H, FormData, DeclGoal), 188 fill_parameters(T, FormData, DeclGoal). 189 190fill_parameter(H, _, _) :- 191 var(H), 192 !, 193 instantiation_error(H). 194fill_parameter(group(Members, _Options), FormData, DeclGoal) :- 195 is_list(Members), 196 !, 197 fill_parameters(Members, FormData, DeclGoal). 198fill_parameter(H, FormData, _) :- 199 H =.. [Name,Value,Options], 200 !, 201 fill_param(Name, Value, Options, FormData). 202fill_parameter(H, FormData, DeclGoal) :- 203 H =.. [Name,Value], 204 ( DeclGoal \== (-), 205 call(DeclGoal, Name, Options) 206 -> true 207 ; throw(error(existence_error(attribute_declaration, Name), _)) 208 ), 209 fill_param(Name, Value, Options, FormData). 210 211fill_param(Name, Values, Options, FormData) :- 212 memberchk(zero_or_more, Options), 213 !, 214 fill_param_list(FormData, Name, Values, Options). 215fill_param(Name, Values, Options, FormData) :- 216 memberchk(list(Type), Options), 217 !, 218 fill_param_list(FormData, Name, Values, [Type|Options]). 219fill_param(Name, Value, Options, FormData) :- 220 ( memberchk(Name=Value0, FormData), 221 Value0 \== '' % Not sure 222 -> http_convert_parameter(Options, Name, Value0, Value) 223 ; memberchk(default(Value), Options) 224 -> true 225 ; memberchk(optional(true), Options) 226 -> true 227 ; throw(error(existence_error(http_parameter, Name), _)) 228 ). 229 230 231fill_param_list([], _, [], _). 232fill_param_list([Name=Value0|Form], Name, [Value|VT], Options) :- 233 !, 234 http_convert_parameter(Options, Name, Value0, Value), 235 fill_param_list(Form, Name, VT, Options). 236fill_param_list([_|Form], Name, VT, Options) :- 237 fill_param_list(Form, Name, VT, Options).
http_parameters(Request, Params) :-
http_read_data(Request, Data, []),
http_convert_parameters(Data, Params).
253http_convert_parameters(Data, ParamDecls) :- 254 fill_parameters(ParamDecls, Data, no_decl_goal). 255http_convert_parameters(Data, ParamDecls, DeclGoal) :- 256 fill_parameters(ParamDecls, Data, DeclGoal). 257 258no_decl_goal(_,_) :- fail.
271http_convert_parameter([], _, Value, Value). 272http_convert_parameter([H|T], Field, Value0, Value) :- 273 ( check_type_no_error(H, Value0, Value1) 274 -> http_convert_parameter(T, Field, Value1, Value) 275 ; throw(error(type_error(H, Value0), 276 context(_, http_parameter(Field)))) 277 ). 278 279check_type_no_error(Type, In, Out) :- 280 http:convert_parameter(Type, In, Out), 281 !. 282check_type_no_error(Type, In, Out) :- 283 check_type3(Type, In, Out).
289check_type3((T1;T2), In, Out) :- 290 !, 291 ( check_type_no_error(T1, In, Out) 292 -> true 293 ; check_type_no_error(T2, In, Out) 294 ). 295check_type3(string, Atom, String) :- 296 !, 297 to_string(Atom, String). 298check_type3(number, Atom, Number) :- 299 !, 300 to_number(Atom, Number). 301check_type3(integer, Atom, Integer) :- 302 !, 303 to_number(Atom, Integer), 304 integer(Integer). 305check_type3(nonneg, Atom, Integer) :- 306 !, 307 to_number(Atom, Integer), 308 integer(Integer), 309 Integer >= 0. 310check_type3(float, Atom, Float) :- 311 !, 312 to_number(Atom, Number), 313 Float is float(Number). 314check_type3(between(Low, High), Atom, Value) :- 315 !, 316 to_number(Atom, Number), 317 ( (float(Low) ; float(High)) 318 -> Value is float(Number) 319 ; Value = Number 320 ), 321 is_of_type(between(Low, High), Value). 322check_type3(boolean, Atom, Bool) :- 323 !, 324 truth(Atom, Bool). 325check_type3(Type, Atom, Atom) :- 326 check_type2(Type, Atom). 327 328to_number(In, Number) :- 329 number(In), !, Number = In. 330to_number(In, Number) :- 331 atom(In), 332 atom_number(In, Number). 333 334to_string(In, String) :- string(In), !, String = In. 335to_string(In, String) :- atom(In), !, atom_string(In, String). 336to_string(In, String) :- number(In), !, number_string(In, String).
342check_type2(oneof(Set), Value) :- 343 !, 344 memberchk(Value, Set). 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(length =< N, Value) :- 358 !, 359 atom_length(Value, Len), 360 Len =< N. 361check_type2(_, _).
368truth(true, true). 369truth('TRUE', true). 370truth(yes, true). 371truth('YES', true). 372truth(on, true). 373truth('ON', true). % IE7 374truth('1', true). 375 376truth(false, false). 377truth('FALSE', false). 378truth(no, false). 379truth('NO', false). 380truth(off, false). 381truth('OFF', false). 382truth('0', false). 383 384 385 /******************************* 386 * XREF SUPPORT * 387 *******************************/ 388 389:- multifile 390 prolog:called_by/2, 391 emacs_prolog_colours:goal_colours/2. 392 393prologcalled_by(http_parameters(_,_,Options), [G+2]) :- 394 option(attribute_declarations(G), Options, _), 395 callable(G), 396 !. 397 398emacs_prolog_colours:goal_colours(http_parameters(_,_,Options), 399 built_in-[classify, classify, Colours]) :- 400 option_list_colours(Options, Colours). 401 402option_list_colours(Var, error) :- 403 var(Var), 404 !. 405option_list_colours([], classify) :- !. 406option_list_colours(Term, list-Elements) :- 407 Term = [_|_], 408 !, 409 option_list_colours_2(Term, Elements). 410option_list_colours(_, error). 411 412option_list_colours_2(Var, classify) :- 413 var(Var). 414option_list_colours_2([], []). 415option_list_colours_2([H0|T0], [H|T]) :- 416 option_colours(H0, H), 417 option_list_colours_2(T0, T). 418 419option_colours(Var, classify) :- 420 var(Var), 421 !. 422option_colours(_=_, built_in-[classify,classify]) :- !. 423option_colours(attribute_declarations(_), % DCG = is a hack! 424 option(attribute_declarations)-[dcg]) :- !. 425option_colours(Term, option(Name)-[classify]) :- 426 compound(Term), 427 Term =.. [Name,_Value], 428 !. 429option_colours(_, error). 430 431 /******************************* 432 * MESSAGES * 433 *******************************/ 434 435:- multifile prolog:error_message//1. 436:- multifile prolog:message//1. 437 438prologerror_message(existence_error(http_parameter, Name)) --> 439 [ 'Missing value for parameter "~w".'-[Name] ]. 440prologmessage(error(type_error(Type, Term), context(_, http_parameter(Param)))) --> 441 { atom(Param) }, 442 [ 'Parameter "~w" must be '-[Param] ], 443 param_type(Type), 444 ['. Found "~w".'-[Term] ]. 445 446param_type(length>N) --> 447 !, 448 ['longer than ~D characters'-[N]]. 449param_type(length>=N) --> 450 !, 451 ['at least ~D characters'-[N]]. 452param_type(length<N) --> 453 !, 454 ['shorter than ~D characters'-[N]]. 455param_type(length=<N) --> 456 !, 457 ['at most ~D characters'-[N]]. 458param_type(between(Low,High)) --> 459 !, 460 ( {float(Low);float(High)} 461 -> ['a number between ~w and ~w'-[Low,High]] 462 ; ['an integer between ~w and ~w'-[Low,High]] 463 ). 464param_type(oneof([Only])) --> 465 !, 466 ['"~w"'-[Only]]. 467param_type(oneof(List)) --> 468 !, 469 ['one of '-[]], oneof(List). 470param_type(T) --> 471 ['of type ~p'-[T]]. 472 473 474oneof([]) --> []. 475oneof([H|T]) --> 476 ['"~w"'-[H]], 477 ( {T == []} 478 -> [] 479 ; {T = [Last]} 480 -> [' or "~w"'-[Last] ] 481 ; [', '-[]], 482 oneof(T) 483 )
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. */