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