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:- multifile
   53    http:convert_parameter/3.   54
   55:- predicate_options(http_parameters/3, 3,
   56                     [ form_data(-list),
   57                       attribute_declarations(callable)
   58                     ]).   59
   60/** <module> Extract parameters (GET and POST) from HTTP requests
   61
   62Most   code   doesn't   need  to   use  this   directly;  instead   use
   63library(http/http_server),  which  combines   this  library  with   the
   64typical HTTP libraries that most servers need.
   65
   66This module is used to extract the value  of GET or POST parameters from
   67an HTTP request. The typical usage is e.g.,
   68
   69    ==
   70    :- http_handler('/register_user', register_user, []).
   71
   72    register_user(Request) :-
   73        http_parameters(Request,
   74                        [ name(Name, []),
   75                          sex(Sex, [oneof([male,female])]),
   76                          birth_year(BY, [between(1850,10000)])
   77                        ]),
   78        register_user(Name, Sex, BY),
   79        html_reply_page(title('New user added'),
   80                        ...).
   81    ==
   82
   83@see http_dispatch.pl dispatches requests to predicates.
   84*/
   85
   86:- meta_predicate
   87    http_parameters(+, ?, :),
   88    http_convert_parameters(+, ?, 2).   89
   90%!  http_parameters(+Request, ?Parms) is det.
   91%!  http_parameters(+Request, ?Parms, :Options) is det.
   92%
   93%   Get HTTP GET  or  POST   form-data,  applying  type  validation,
   94%   default values, etc.  Provided options are:
   95%
   96%           * attribute_declarations(:Goal)
   97%           Causes the declarations for an attributed named A to be
   98%           fetched using call(Goal, A, Declarations).
   99%
  100%           * form_data(-Data)
  101%           Return the data read from the GET por POST request as a
  102%           list Name = Value.  All data, including name/value pairs
  103%           used for Parms, is unified with Data.
  104%
  105%   The attribute_declarations hook allows   sharing the declaration
  106%   of attribute-properties between many http_parameters/3 calls. In
  107%   this form, the requested attribute takes   only one argument and
  108%   the options are acquired by calling the hook. For example:
  109%
  110%       ==
  111%           ...,
  112%           http_parameters(Request,
  113%                           [ sex(Sex)
  114%                           ],
  115%                           [ attribute_declarations(http_param)
  116%                           ]),
  117%           ...
  118%
  119%       http_param(sex, [ oneof(male, female),
  120%                         description('Sex of the person')
  121%                       ]).
  122%       ==
  123%
  124%   @bug If both request parameters  (?name=value&...)   and  a POST are
  125%   present the parameters are extracted   from  the request parameters.
  126%   Still, as it is valid to have   request parameters in a POST request
  127%   this predicate should not process POST   requests.  We will keep the
  128%   current behaviour as the it is not common for a request to have both
  129%   request   parameters   and    a    POST     data    of    the   type
  130%   =|application/x-www-form-urlencoded|=.
  131%
  132%   In the unlikely event this  poses  a   problem  the  request  may be
  133%   specified as [method(get)|Request].
  134
  135http_parameters(Request, Params) :-
  136    http_parameters(Request, Params, []).
  137
  138http_parameters(Request, Params, Options) :-
  139    must_be(list, Params),
  140    meta_options(is_meta, Options, QOptions),
  141    option(attribute_declarations(DeclGoal), QOptions, no_decl_goal),
  142    http_parms(Request, Params, DeclGoal, Form),
  143    (   memberchk(form_data(RForm), QOptions)
  144    ->  RForm = Form
  145    ;   true
  146    ).
  147
  148is_meta(attribute_declarations).
  149
  150
  151http_parms(Request, Params, DeclGoal, Search) :-
  152    memberchk(search(Search), Request),
  153    !,
  154    fill_parameters(Params, Search, DeclGoal).
  155http_parms(Request, Params, DeclGoal, Data) :-
  156    memberchk(method(Method), Request),
  157    Method == post,
  158    memberchk(content_type(Content), Request),
  159    form_data_content_type(Content),
  160    !,
  161    debug(post_request, 'POST Request: ~p', [Request]),
  162    posted_form(Request, Data),
  163    fill_parameters(Params, Data, DeclGoal).
  164http_parms(_Request, Params, DeclGoal, []) :-
  165    fill_parameters(Params, [], DeclGoal).
  166
  167:- multifile
  168    form_data_content_type/1.  169
  170form_data_content_type('application/x-www-form-urlencoded') :- !.
  171form_data_content_type(ContentType) :-
  172    sub_atom(ContentType, 0, _, _, 'application/x-www-form-urlencoded;').
  173
  174%!  posted_form(+Request, -Data) is det.
  175%
  176%   True when Data is list  of   Name=Value  pairs  representing the
  177%   posted data.
  178
  179posted_form(Request, _Data) :-
  180    nb_current(http_post_data, read),
  181    !,
  182    option(request_uri(URI), Request),
  183    throw(error(permission_error('re-read', 'POST data', URI),
  184                context(_, 'Attempt to re-read POST data'))).
  185posted_form(Request, Data) :-
  186    http_read_data(Request, Data, []),
  187    nb_setval(http_post_data, read),
  188    debug(post, 'POST Data: ~p', [Data]).
  189
  190wipe_posted_data :-
  191    debug(post, 'Wiping posted data', []),
  192    nb_delete(http_post_data).
  193
  194:- listen(http(request_finished(_Id, _Code, _Status, _CPU, _Bytes)),
  195          wipe_posted_data).  196
  197
  198%!  fill_parameters(+ParamDecls, +FormData, +DeclGoal)
  199%
  200%   Fill values from the parameter list
  201
  202:- meta_predicate fill_parameters(+, +, 2).  203
  204fill_parameters([], _, _).
  205fill_parameters([H|T], FormData, DeclGoal) :-
  206    fill_parameter(H, FormData, DeclGoal),
  207    fill_parameters(T, FormData, DeclGoal).
  208
  209fill_parameter(H, _, _) :-
  210    var(H),
  211    !,
  212    instantiation_error(H).
  213fill_parameter(group(Members, _Options), FormData, DeclGoal) :-
  214    is_list(Members),
  215    !,
  216    fill_parameters(Members, FormData, DeclGoal).
  217fill_parameter(H, FormData, _) :-
  218    H =.. [Name,Value,Options],
  219    !,
  220    fill_param(Name, Value, Options, FormData).
  221fill_parameter(H, FormData, DeclGoal) :-
  222    H =.. [Name,Value],
  223    (   DeclGoal \== (-),
  224        call(DeclGoal, Name, Options)
  225    ->  true
  226    ;   throw(error(existence_error(attribute_declaration, Name), _))
  227    ),
  228    fill_param(Name, Value, Options, FormData).
  229
  230fill_param(Name, Values, Options, FormData) :-
  231    memberchk(zero_or_more, Options),
  232    !,
  233    fill_param_list(FormData, Name, Values, Options).
  234fill_param(Name, Values, Options, FormData) :-
  235    memberchk(list(Type), Options),
  236    !,
  237    fill_param_list(FormData, Name, Values, [Type|Options]).
  238fill_param(Name, Value, Options, FormData) :-
  239    (   memberchk(Name=Value0, FormData),
  240        Value0 \== ''               % Not sure
  241    ->  http_convert_parameter(Options, Name, Value0, Value)
  242    ;   memberchk(default(Value), Options)
  243    ->  true
  244    ;   memberchk(optional(true), Options)
  245    ->  true
  246    ;   throw(error(existence_error(http_parameter, Name), _))
  247    ).
  248
  249
  250fill_param_list([], _, [], _).
  251fill_param_list([Name=Value0|Form], Name, [Value|VT], Options) :-
  252    !,
  253    http_convert_parameter(Options, Name, Value0, Value),
  254    fill_param_list(Form, Name, VT, Options).
  255fill_param_list([_|Form], Name, VT, Options) :-
  256    fill_param_list(Form, Name, VT, Options).
  257
  258
  259%!  http_convert_parameters(+Data, ?Params) is det.
  260%!  http_convert_parameters(+Data, ?Params, :AttrDecl) is det.
  261%
  262%   Implements the parameter  translation   of  http_parameters/2 or
  263%   http_parameters/3. I.e., http_parameters/2 for   a  POST request
  264%   can be implemented as:
  265%
  266%     ==
  267%     http_parameters(Request, Params) :-
  268%         http_read_data(Request, Data, []),
  269%         http_convert_parameters(Data, Params).
  270%     ==
  271
  272http_convert_parameters(Data, ParamDecls) :-
  273    fill_parameters(ParamDecls, Data, no_decl_goal).
  274http_convert_parameters(Data, ParamDecls, DeclGoal) :-
  275    fill_parameters(ParamDecls, Data, DeclGoal).
  276
  277no_decl_goal(_,_) :- fail.
  278
  279%!  http_convert_parameter(+Options, +FieldName, +ValueIn, -ValueOut) is det.
  280%
  281%   Conversion of an HTTP form value. First tries the multifile hook
  282%   http:convert_parameter/3 and next the built-in checks.
  283%
  284%   @param Option           List as provided with the parameter
  285%   @param FieldName        Name of the HTTP field (for better message)
  286%   @param ValueIn          Atom value as received from HTTP layer
  287%   @param ValueOut         Possibly converted final value
  288%   @error type_error(Type, Value)
  289
  290http_convert_parameter([], _, Value, Value).
  291http_convert_parameter([H|T], Field, Value0, Value) :-
  292    (   check_type_no_error(H, Value0, Value1)
  293    ->  catch(http_convert_parameter(T, Field, Value1, Value),
  294              error(Formal, _),
  295              throw(error(Formal, context(_, http_parameter(Field)))))
  296    ;   throw(error(type_error(H, Value0),
  297                    context(_, http_parameter(Field))))
  298    ).
  299
  300check_type_no_error(Type, In, Out) :-
  301    http:convert_parameter(Type, In, Out),
  302    !.
  303check_type_no_error(Type, In, Out) :-
  304    check_type3(Type, In, Out).
  305
  306%!  check_type3(+Type, +ValueIn, -ValueOut) is semidet.
  307%
  308%   HTTP parameter type-check for types that need converting.
  309
  310check_type3((T1;T2), In, Out) :-
  311    !,
  312    (   check_type_no_error(T1, In, Out)
  313    ->  true
  314    ;   check_type_no_error(T2, In, Out)
  315    ).
  316check_type3(string, Atom, String) :-
  317    !,
  318    to_string(Atom, String).
  319check_type3(number, Atom, Number) :-
  320    !,
  321    to_number(Atom, Number).
  322check_type3(integer, Atom, Integer) :-
  323    !,
  324    to_number(Atom, Integer),
  325    integer(Integer).
  326check_type3(nonneg, Atom, Integer) :-
  327    !,
  328    to_number(Atom, Integer),
  329    integer(Integer),
  330    Integer >= 0.
  331check_type3(float, Atom, Float) :-
  332    !,
  333    to_number(Atom, Number),
  334    Float is float(Number).
  335check_type3(between(Low, High), Atom, Value) :-
  336    !,
  337    to_number(Atom, Number),
  338    (   (float(Low) ; float(High))
  339    ->  Value is float(Number)
  340    ;   Value = Number
  341    ),
  342    is_of_type(between(Low, High), Value).
  343check_type3(boolean, Atom, Bool) :-
  344    !,
  345    truth(Atom, Bool).
  346check_type3(Type, Atom, Atom) :-
  347    check_type2(Type, Atom).
  348
  349to_number(In, Number) :-
  350    number(In), !, Number = In.
  351to_number(In, Number) :-
  352    atom(In),
  353    atom_number(In, Number).
  354
  355to_string(In, String) :- string(In), !, String = In.
  356to_string(In, String) :- atom(In),   !, atom_string(In, String).
  357to_string(In, String) :- number(In), !, number_string(In, String).
  358
  359%!  check_type2(+Type, +ValueIn) is semidet.
  360%
  361%   HTTP parameter type-check for types that need no conversion.
  362
  363check_type2(oneof(Set), Value) :-
  364    !,
  365    memberchk(Value, Set).
  366check_type2(length > N, Value) :-
  367    !,
  368    atom_length(Value, Len),
  369    Len > N.
  370check_type2(length >= N, Value) :-
  371    !,
  372    atom_length(Value, Len),
  373    Len >= N.
  374check_type2(length < N, Value) :-
  375    !,
  376    atom_length(Value, Len),
  377    Len < N.
  378check_type2(length =< N, Value) :-
  379    !,
  380    atom_length(Value, Len),
  381    Len =< N.
  382check_type2(_, _).
  383
  384%!  truth(+In, -Boolean) is semidet.
  385%
  386%   Translate some commonly used textual   representations  for true
  387%   and false into their canonical representation.
  388
  389truth(true,    true).
  390truth('TRUE',  true).
  391truth(yes,     true).
  392truth('YES',   true).
  393truth(on,      true).
  394truth('ON',    true).                   % IE7
  395truth('1',     true).
  396
  397truth(false,   false).
  398truth('FALSE', false).
  399truth(no,      false).
  400truth('NO',    false).
  401truth(off,     false).
  402truth('OFF',   false).
  403truth('0',     false).
  404
  405
  406                 /*******************************
  407                 *         XREF SUPPORT         *
  408                 *******************************/
  409
  410:- multifile
  411    prolog:called_by/2,
  412    emacs_prolog_colours:goal_colours/2.  413
  414prolog:called_by(http_parameters(_,_,Options), [G+2]) :-
  415    option(attribute_declarations(G), Options, _),
  416    callable(G),
  417    !.
  418
  419emacs_prolog_colours:goal_colours(http_parameters(_,_,Options),
  420                                  built_in-[classify, classify, Colours]) :-
  421    option_list_colours(Options, Colours).
  422
  423option_list_colours(Var, error) :-
  424    var(Var),
  425    !.
  426option_list_colours([], classify) :- !.
  427option_list_colours(Term, list-Elements) :-
  428    Term = [_|_],
  429    !,
  430    option_list_colours_2(Term, Elements).
  431option_list_colours(_, error).
  432
  433option_list_colours_2(Var, classify) :-
  434    var(Var).
  435option_list_colours_2([], []).
  436option_list_colours_2([H0|T0], [H|T]) :-
  437    option_colours(H0, H),
  438    option_list_colours_2(T0, T).
  439
  440option_colours(Var,  classify) :-
  441    var(Var),
  442    !.
  443option_colours(_=_,  built_in-[classify,classify]) :- !.
  444option_colours(attribute_declarations(_),               % DCG = is a hack!
  445               option(attribute_declarations)-[dcg]) :- !.
  446option_colours(Term, option(Name)-[classify]) :-
  447    compound(Term),
  448    Term =.. [Name,_Value],
  449    !.
  450option_colours(_, error).
  451
  452                 /*******************************
  453                 *            MESSAGES          *
  454                 *******************************/
  455
  456:- multifile prolog:error_message//1.  457:- multifile prolog:message//1.  458
  459prolog:error_message(existence_error(http_parameter, Name)) -->
  460    [ 'Missing value for parameter "~w".'-[Name] ].
  461prolog:message(error(type_error(Type, Term), context(_, http_parameter(Param)))) -->
  462    { atom(Param) },
  463    [ 'Parameter "~w" must be '-[Param] ],
  464    param_type(Type),
  465    ['.  Found "~w".'-[Term] ].
  466
  467param_type(length>N) -->
  468    !,
  469    ['longer than ~D characters'-[N]].
  470param_type(length>=N) -->
  471    !,
  472    ['at least ~D characters'-[N]].
  473param_type(length<N) -->
  474    !,
  475    ['shorter than ~D characters'-[N]].
  476param_type(length=<N) -->
  477    !,
  478    ['at most ~D characters'-[N]].
  479param_type(between(Low,High)) -->
  480    !,
  481    (   {float(Low);float(High)}
  482    ->  ['a number between ~w and ~w'-[Low,High]]
  483    ;   ['an integer between ~w and ~w'-[Low,High]]
  484    ).
  485param_type(oneof([Only])) -->
  486    !,
  487    ['"~w"'-[Only]].
  488param_type(oneof(List)) -->
  489    !,
  490    ['one of '-[]], oneof(List).
  491param_type(T) -->
  492    ['of type ~p'-[T]].
  493
  494
  495oneof([]) --> [].
  496oneof([H|T]) -->
  497    ['"~w"'-[H]],
  498    (   {T == []}
  499    ->  []
  500    ;   {T = [Last]}
  501    ->  [' or "~w"'-[Last] ]
  502    ;   [', '-[]],
  503        oneof(T)
  504    )