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)  2000-2015, University of Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(url,
   36          [ parse_url/2,                % +URL, -Parts | -URL +Parts
   37            parse_url/3,                % +URL|URI, +BaseURL, -Parts
   38                                        % -URL, +BaseURL, +Parts
   39            is_absolute_url/1,          % +URL
   40            global_url/3,               % +Local, +Base, -Global
   41            http_location/2,            % ?Parts, ?Location
   42            www_form_encode/2,          % Value <-> Encoded
   43            parse_url_search/2,         % Form-data <-> Form fields
   44
   45            url_iri/2,                  % ?URL, ?IRI
   46
   47            file_name_to_url/2,         % ?FileName, ?URL
   48
   49            set_url_encoding/2          % ?Old, +New
   50          ]).   51:- use_module(library(lists)).   52:- use_module(library(error)).   53:- use_module(library(utf8)).   54
   55/** <module> Analysing and constructing URL
   56
   57This library deals with the analysis and construction of a URL,
   58Universal Resource Locator. URL is the basis for communicating locations
   59of resources (data) on the web. A URL consists of a protocol identifier
   60(e.g. HTTP, FTP, and a protocol-specific syntax further defining the
   61location. URLs are standardized in RFC-1738.
   62
   63The implementation in this library covers only a small portion of the
   64defined protocols.  Though the initial implementation followed RFC-1738
   65strictly, the current is more relaxed to deal with frequent violations
   66of the standard encountered in practical use.
   67
   68@author Jan Wielemaker
   69@author Lukas Faulstich
   70@deprecated New code should use library(uri), provided by the =clib=
   71            package.
   72*/
   73
   74                 /*******************************
   75                 *            GLOBALISE         *
   76                 *******************************/
   77
   78%!  global_url(+URL, +Base, -Global) is det.
   79%
   80%   Translate a possibly relative URL  into   an  absolute  one.
   81%
   82%   @error syntax_error(illegal_url) if URL is not legal.
   83
   84global_url(URL, BaseURL, Global) :-
   85    (   is_absolute_url(URL),
   86        \+ sub_atom(URL, _, _, _, '%')      % may have escape, use general
   87    ->  Global = URL
   88    ;   sub_atom(URL, 0, _, _, '//')
   89    ->  parse_url(BaseURL, [], Attributes),
   90        memberchk(protocol(Proto), Attributes),
   91        atomic_list_concat([Proto, :, URL], Global)
   92    ;   sub_atom(URL, 0, _, _, #)
   93    ->  (   sub_atom(BaseURL, _, _, 0, #)
   94        ->  sub_atom(URL, 1, _, 0, NoHash),
   95            atom_concat(BaseURL, NoHash, Global)
   96        ;   atom_concat(BaseURL, URL, Global)
   97        )
   98    ;   parse_url(URL, BaseURL, Attributes)
   99    ->  phrase(curl(Attributes), Chars),
  100        atom_codes(Global, Chars)
  101    ;   throw(error(syntax_error(illegal_url), URL))
  102    ).
  103
  104%!  is_absolute_url(+URL)
  105%
  106%   True if URL is an absolute URL. That  is, a URL that starts with
  107%   a protocol identifier.
  108
  109is_absolute_url(URL) :-
  110    sub_atom(URL, 0, _, _, 'http://'),
  111    !.
  112is_absolute_url(URL) :-
  113    sub_atom(URL, 0, _, _, 'https://'),
  114    !.
  115is_absolute_url(URL) :-
  116    sub_atom(URL, 0, _, _, 'ftp://'),
  117    !.
  118is_absolute_url(URL) :-
  119    sub_atom(URL, 0, _, _, 'file://'),
  120    !.
  121is_absolute_url(URL) :-
  122    atom_codes(URL, Codes),
  123    phrase(absolute_url, Codes, _),
  124    !.
  125
  126
  127                 /*******************************
  128                 *        CREATE URL/URI        *
  129                 *******************************/
  130
  131%!  http_location(?Parts, ?Location)
  132%
  133%   Construct or analyze an  HTTP  location.   This  is  similar  to
  134%   parse_url/2, but only deals with the   location  part of an HTTP
  135%   URL. That is, the path, search   and fragment specifiers. In the
  136%   HTTP protocol, the first line of a message is
  137%
  138%       ==
  139%       <Action> <Location> HTTP/<version>
  140%       ==
  141%
  142%   @param Location Atom or list of character codes.
  143
  144http_location(Parts, Location) :-       % Parts --> Location
  145    nonvar(Parts),
  146    !,
  147    phrase(curi(Parts), String),
  148    !,
  149    atom_codes(Location, String).
  150http_location(Parts, Location) :-       % Location --> Parts
  151    atom(Location),
  152    !,
  153    atom_codes(Location, Codes),
  154    phrase(http_location(Parts), Codes).
  155http_location(Parts, Codes) :-          % LocationCodes --> Parts
  156    is_list(Codes),
  157    phrase(http_location(Parts), Codes).
  158
  159
  160curl(A) -->
  161    { memberchk(protocol(Protocol), A)
  162    },
  163    !,
  164    catomic(Protocol),
  165    ":",
  166    curl(Protocol, A).
  167curl(A) -->
  168    curl(http, A).
  169
  170curl(file, A) -->
  171    !,
  172    (   "//"
  173    ->  cpath(A)
  174    ;   cpath(A)
  175    ).
  176curl(_, A) -->
  177    "//",
  178    cuser(A),
  179    chost(A),
  180    cport(A),
  181    cpath(A),
  182    csearch(A),
  183    cfragment(A).
  184
  185curi(A) -->
  186    cpath(A),
  187    csearch(A).
  188
  189cpath(A) -->
  190    (   { memberchk(path(Path), A) }
  191    ->  { atom_codes(Path, Codes) },
  192        www_encode(Codes, [0'/, 0'+, 0':, 0',])
  193    ;   ""
  194    ).
  195
  196cuser(A) -->
  197    (   { memberchk(user(User), A) }
  198    ->  { atom_codes(User, Codes) },
  199        www_encode(Codes, [0':]),
  200        "@"
  201    ;   ""
  202    ).
  203
  204chost(A) -->
  205    (   { memberchk(host(Host), A) }
  206    ->  { atom_codes(Host, Codes) },
  207        www_encode(Codes, [])
  208    ;   ""
  209    ).
  210
  211cport(A) -->
  212    (   { memberchk(port(Port), A), Port \== 80 }
  213    ->  { number_codes(Port, Codes) },
  214        ":",
  215        www_encode(Codes, [])
  216    ;   ""
  217    ).
  218
  219
  220catomic(A, In, Out) :-
  221    atom_codes(A, Codes),
  222    append(Codes, Out, In).
  223
  224%!  csearch(+Attributes)//
  225
  226csearch(A)-->
  227    (   { memberchk(search(Parameters), A) }
  228    ->  csearch(Parameters, [0'?])
  229    ;   []
  230    ).
  231
  232csearch([], _) -->
  233    [].
  234csearch([Parameter|Parameters], Sep) -->
  235    !,
  236    codes(Sep),
  237    cparam(Parameter),
  238    csearch(Parameters, [0'&]).
  239
  240cparam(Name=Value) -->
  241    !,
  242    cname(Name),
  243    "=",
  244    cvalue(Value).
  245cparam(NameValue) -->                   % allow to feed Name(Value)
  246    { compound(NameValue),
  247      !,
  248      NameValue =.. [Name,Value]
  249    },
  250    cname(Name),
  251    "=",
  252    cvalue(Value).
  253cparam(Name)-->
  254    cname(Name).
  255
  256codes([]) --> [].
  257codes([H|T]) --> [H], codes(T).
  258
  259cname(Atom) -->
  260    { atom_codes(Atom, Codes) },
  261    www_encode(Codes, []).
  262
  263%!  cvalue(+Value)// is det.
  264%
  265%   Construct a string from  Value.  Value   is  either  atomic or a
  266%   code-list.
  267
  268cvalue(Value) -->
  269    { atomic(Value),
  270      !,
  271      atom_codes(Value, Codes)
  272    },
  273    www_encode(Codes, []).
  274cvalue(Codes) -->
  275    { must_be(codes, Codes)
  276    },
  277    www_encode(Codes, []).
  278
  279
  280%!  cfragment(+Attributes)//
  281
  282cfragment(A) -->
  283    { memberchk(fragment(Frag), A),
  284      !,
  285      atom_codes(Frag, Codes)
  286    },
  287    "#",
  288    www_encode(Codes, []).
  289cfragment(_) -->
  290    "".
  291
  292
  293                 /*******************************
  294                 *            PARSING           *
  295                 *******************************/
  296
  297%!  parse_url(?URL, ?Attributes) is det.
  298%
  299%   Construct or analyse a URL. URL is an   atom  holding a URL or a
  300%   variable. Attributes is a list of  components. Each component is
  301%   of the format Name(Value). Defined components are:
  302%
  303%       * protocol(Protocol)
  304%       The used protocol. This is, after  the optional =|url:|=, an
  305%       identifier separated from the remainder of  the URL using :.
  306%       parse_url/2 assumes the =http= protocol   if  no protocol is
  307%       specified and the URL can be parsed  as a valid HTTP url. In
  308%       addition to the RFC-1738  specified   protocols,  the =file=
  309%       protocol is supported as well.
  310%
  311%       * host(Host)
  312%       Host-name or IP-address on which   the  resource is located.
  313%       Supported by all network-based protocols.
  314%
  315%       * port(Port)
  316%       Integer port-number to access on   the \arg{Host}. This only
  317%       appears if the port is  explicitly   specified  in  the URL.
  318%       Implicit default ports (e.g., 80 for   HTTP) do _not_ appear
  319%       in the part-list.
  320%
  321%       * path(Path)
  322%       (File-) path addressed by the URL. This is supported for the
  323%       =ftp=, =http= and =file= protocols. If  no path appears, the
  324%       library generates the path =|/|=.
  325%
  326%       * search(ListOfNameValue)
  327%       Search-specification of HTTP URL. This is the part after the
  328%       =|?|=, normally used to transfer data   from HTML forms that
  329%       use the =GET=  protocol.  In  the   URL  it  consists  of  a
  330%       www-form-encoded list of Name=Value pairs. This is mapped to
  331%       a list of Prolog Name=Value  terms   with  decoded names and
  332%       values.
  333%
  334%       * fragment(Fragment)
  335%       Fragment specification of HTTP URL. This   is the part after
  336%       the =|#|= character.
  337%
  338%   The example below illustrates all of this for an HTTP URL.
  339%
  340%       ==
  341%       ?- parse_url('http://www.xyz.org/hello?msg=Hello+World%21#x',
  342%              P).
  343%
  344%       P = [ protocol(http),
  345%             host('www.xyz.org'),
  346%             fragment(x),
  347%             search([ msg = 'Hello World!'
  348%                    ]),
  349%             path('/hello')
  350%           ]
  351%       ==
  352%
  353%   By instantiating the parts-list this predicate   can  be used to
  354%   create a URL.
  355
  356parse_url(URL, Attributes) :-
  357    nonvar(URL),
  358    !,
  359    atom_codes(URL, Codes),
  360    phrase(url(Attributes), Codes).
  361parse_url(URL, Attributes) :-
  362    phrase(curl(Attributes), Codes),
  363    !,
  364    atom_codes(URL, Codes).
  365
  366%!  parse_url(+URL, +BaseURL, -Attributes) is det.
  367%
  368%   Similar to parse_url/2 for relative URLs.  If URL is relative,
  369%   it is resolved using the absolute URL BaseURL.
  370
  371parse_url(URL, BaseURL, Attributes) :-
  372    nonvar(URL),
  373    !,
  374    atom_codes(URL, Codes),
  375    (   phrase(absolute_url, Codes, _)
  376    ->  phrase(url(Attributes), Codes)
  377    ;   (   atomic(BaseURL)
  378        ->  parse_url(BaseURL, BaseA0)
  379        ;   BaseA0 = BaseURL
  380        ),
  381        select(path(BasePath), BaseA0, BaseA1),
  382        delete(BaseA1, search(_), BaseA2),
  383        delete(BaseA2, fragment(_), BaseA3),
  384        phrase(relative_uri(URIA0), Codes),
  385        select(path(LocalPath), URIA0, URIA1),
  386        !,
  387        globalise_path(LocalPath, BasePath, Path),
  388        append(BaseA3, [path(Path)|URIA1], Attributes)
  389    ).
  390parse_url(URL, BaseURL, Attributes) :-
  391    parse_url(BaseURL, BaseAttributes),
  392    memberchk(path(BasePath), BaseAttributes),
  393    (   memberchk(path(LocalPath), Attributes)
  394    ->  globalise_path(LocalPath, BasePath, Path)
  395    ;   Path = BasePath
  396    ),
  397    append([path(Path)|Attributes], BaseAttributes, GlobalAttributes),
  398    phrase(curl(GlobalAttributes), Chars),
  399    atom_codes(URL, Chars).
  400
  401
  402%!  globalise_path(+LocalPath, +RelativeTo, -FullPath) is det.
  403%
  404%   The first clause deals with the  standard URL /... global paths.
  405%   The second with file://drive:path on MS-Windows.   This is a bit
  406%   of a cludge, but unfortunately common practice is -especially on
  407%   Windows- not always following the standard
  408
  409globalise_path(LocalPath, _, LocalPath) :-
  410    sub_atom(LocalPath, 0, _, _, /),
  411    !.
  412globalise_path(LocalPath, _, LocalPath) :-
  413    is_absolute_file_name(LocalPath),
  414    !.
  415globalise_path(Local, Base, Path) :-
  416    base_dir(Base, BaseDir),
  417    make_path(BaseDir, Local, Path).
  418
  419base_dir(BasePath, BaseDir) :-
  420    (   atom_concat(BaseDir, /, BasePath)
  421    ->  true
  422    ;   file_directory_name(BasePath, BaseDir)
  423    ).
  424
  425make_path(Dir, Local, Path) :-
  426    atom_concat('../', L2, Local),
  427    file_directory_name(Dir, Parent),
  428    Parent \== Dir,
  429    !,
  430    make_path(Parent, L2, Path).
  431make_path(/, Local, Path) :-
  432    !,
  433    atom_concat(/, Local, Path).
  434make_path(Dir, Local, Path) :-
  435    atomic_list_concat([Dir, /, Local], Path).
  436
  437
  438%!  absolute_url//
  439%
  440%   True if the input  describes  an   absolute  URL.  This means it
  441%   starts with a URL schema. We demand a   schema  of length > 1 to
  442%   avoid confusion with Windows drive letters.
  443
  444absolute_url -->
  445    lwalpha(_First),
  446    schema_chars(Rest),
  447    { Rest \== [] },
  448    ":",
  449    !.
  450
  451
  452                 /*******************************
  453                 *           SEQUENCES          *
  454                 *******************************/
  455
  456digits(L) -->
  457    digits(L, []).
  458
  459digits([C|T0], T) -->
  460    digit(C),
  461    !,
  462    digits(T0, T).
  463digits(T, T) -->
  464    [].
  465
  466
  467digit(C, [C|T], T) :- code_type(C, digit).
  468
  469                 /*******************************
  470                 *            RFC-3986          *
  471                 *******************************/
  472
  473%!  uri(-Parts)//
  474
  475url([protocol(Schema)|Parts]) -->
  476    schema(Schema),
  477    ":",
  478    !,
  479    hier_part(Schema, Parts, P2),
  480    query(P2, P3),
  481    fragment(P3, []).
  482url([protocol(http)|Parts]) -->         % implicit HTTP
  483    authority(Parts, [path(Path)]),
  484    path_abempty(Path).
  485
  486relative_uri(Parts) -->
  487    relative_part(Parts, P2),
  488    query(P2, P3),
  489    fragment(P3, []).
  490
  491relative_part(Parts, Tail) -->
  492    "//",
  493    !,
  494    authority(Parts, [path(Path)|Tail]),
  495    path_abempty(Path).
  496relative_part([path(Path)|T], T) -->
  497    (   path_absolute(Path)
  498    ;   path_noschema(Path)
  499    ;   path_empty(Path)
  500    ),
  501    !.
  502
  503http_location([path(Path)|P2]) -->
  504    path_abempty(Path),
  505    query(P2, P3),
  506    fragment(P3, []).
  507
  508%!  schema(-Atom)//
  509%
  510%   Schema  is  case-insensitive  and  the    canonical  version  is
  511%   lowercase.
  512%
  513%   ==
  514%   Schema ::= ALPHA *(ALPHA|DIGIT|"+"|"-"|".")
  515%   ==
  516
  517schema(Schema) -->
  518    lwalpha(C0),
  519    schema_chars(Codes),
  520    { atom_codes(Schema, [C0|Codes]) }.
  521
  522schema_chars([H|T]) -->
  523    schema_char(H),
  524    !,
  525    schema_chars(T).
  526schema_chars([]) -->
  527    [].
  528
  529schema_char(H) -->
  530    [C],
  531    { C < 128,
  532      (   code_type(C, alpha)
  533      ->  code_type(H, to_lower(C))
  534      ;   code_type(C, digit)
  535      ->  H = C
  536      ;   schema_extra(C)
  537      ->  H = C
  538      )
  539    }.
  540
  541schema_extra(0'+).
  542schema_extra(0'-).
  543schema_extra(0'.).      % 0'
  544
  545
  546%!  hier_part(+Schema, -Parts, ?Tail)//
  547
  548hier_part(file, [path(Path)|Tail], Tail) -->
  549    !,
  550    "//",
  551    (   win_drive_path(Path)
  552    ;   path_absolute(Path)
  553    ;   path_rootless(Path)
  554    ;   path_empty(Path)
  555    ),
  556    !.
  557hier_part(_, Parts, Tail) -->
  558    "//",
  559    !,
  560    authority(Parts, [path(Path)|Tail]),
  561    path_abempty(Path).
  562hier_part(_, [path(Path)|T], T) -->
  563    (   path_absolute(Path)
  564    ;   path_rootless(Path)
  565    ;   path_empty(Path)
  566    ),
  567    !.
  568
  569authority(Parts, Tail) -->
  570    user_info_chars(UserChars),
  571    "@",
  572    !,
  573    { atom_codes(User, UserChars),
  574      Parts = [user(User),host(Host)|T0]
  575    },
  576    host(Host),
  577    port(T0,Tail).
  578authority([host(Host)|T0], Tail) -->
  579    host(Host),
  580    port(T0, Tail).
  581
  582user_info_chars([H|T]) -->
  583    user_info_char(H),
  584    !,
  585    user_info_chars(T).
  586user_info_chars([]) -->
  587    [].
  588
  589user_info_char(_) --> "@", !, {fail}.
  590user_info_char(C) --> pchar(C).
  591
  592%host(Host) --> ip_literal(Host), !.            % TBD: IP6 addresses
  593host(Host) --> ip4_address(Host), !.
  594host(Host) --> reg_name(Host).
  595
  596ip4_address(Atom) -->
  597    i256_chars(Chars, [0'.|T0]),
  598    i256_chars(T0, [0'.|T1]),
  599    i256_chars(T1, [0'.|T2]),
  600    i256_chars(T2, []),
  601    { atom_codes(Atom, Chars) }.
  602
  603i256_chars(Chars, T) -->
  604    digits(Chars, T),
  605    { \+ \+ ( T = [],
  606              Chars \== [],
  607              number_codes(I, Chars),
  608              I < 256
  609            )
  610    }.
  611
  612reg_name(Host) -->
  613    reg_name_chars(Chars),
  614    { atom_codes(Host, Chars) }.
  615
  616reg_name_chars([H|T]) -->
  617    reg_name_char(H),
  618    !,
  619    reg_name_chars(T).
  620reg_name_chars([]) -->
  621    [].
  622
  623reg_name_char(C) -->
  624    pchar(C),
  625    { C \== 0':,
  626      C \== 0'@
  627    }.
  628
  629port([port(Port)|T], T) -->
  630    ":",
  631    !,
  632    digit(D0),
  633    digits(Ds),
  634    { number_codes(Port, [D0|Ds]) }.
  635port(T, T) -->
  636    [].
  637
  638path_abempty(Path) -->
  639    segments_chars(Chars, []),
  640    {   Chars == []
  641    ->  Path = '/'
  642    ;   atom_codes(Path, Chars)
  643    }.
  644
  645
  646win_drive_path(Path) -->
  647    drive_letter(C0),
  648    ":",
  649    (   "/"
  650    ->  {Codes = [C0, 0':, 0'/|Chars]}
  651    ;   {Codes = [C0, 0':|Chars]}
  652    ),
  653    segment_nz_chars(Chars, T0),
  654    segments_chars(T0, []),
  655    { atom_codes(Path, Codes) }.
  656
  657
  658path_absolute(Path) -->
  659    "/",
  660    segment_nz_chars(Chars, T0),
  661    segments_chars(T0, []),
  662    { atom_codes(Path, [0'/| Chars]) }.
  663
  664path_noschema(Path) -->
  665    segment_nz_nc_chars(Chars, T0),
  666    segments_chars(T0, []),
  667    { atom_codes(Path, Chars) }.
  668
  669path_rootless(Path) -->
  670    segment_nz_chars(Chars, T0),
  671    segments_chars(T0, []),
  672    { atom_codes(Path, Chars) }.
  673
  674path_empty('/') -->
  675    "".
  676
  677segments_chars([0'/|Chars], T) -->      % 0'
  678    "/",
  679    !,
  680    segment_chars(Chars, T0),
  681    segments_chars(T0, T).
  682segments_chars(T, T) -->
  683    [].
  684
  685segment_chars([H|T0], T) -->
  686    pchar(H),
  687    !,
  688    segment_chars(T0, T).
  689segment_chars(T, T) -->
  690    [].
  691
  692segment_nz_chars([H|T0], T) -->
  693    pchar(H),
  694    segment_chars(T0, T).
  695
  696segment_nz_nc_chars([H|T0], T) -->
  697    segment_nz_nc_char(H),
  698    !,
  699    segment_nz_nc_chars(T0, T).
  700segment_nz_nc_chars(T, T) -->
  701    [].
  702
  703segment_nz_nc_char(_) --> ":", !, {fail}.
  704segment_nz_nc_char(C) --> pchar(C).
  705
  706
  707%!  query(-Parts, ?Tail)// is det.
  708%
  709%   Extract &Name=Value, ...
  710
  711query([search(Params)|T], T) -->
  712    "?",
  713    !,
  714    search(Params).
  715query(T,T) -->
  716    [].
  717
  718search([Parameter|Parameters])-->
  719    parameter(Parameter),
  720    !,
  721    (   search_sep
  722    ->  search(Parameters)
  723    ;   { Parameters = [] }
  724    ).
  725search([]) -->
  726    [].
  727
  728parameter(Param)-->
  729    !,
  730    search_chars(NameS),
  731    { atom_codes(Name, NameS)
  732    },
  733    (   "="
  734    ->  search_value_chars(ValueS),
  735        { atom_codes(Value, ValueS),
  736          Param = (Name = Value)
  737        }
  738    ;   { Param = Name
  739        }
  740    ).
  741
  742search_chars([C|T]) -->
  743    search_char(C),
  744    !,
  745    search_chars(T).
  746search_chars([]) -->
  747    [].
  748
  749search_char(_) --> search_sep, !, { fail }.
  750search_char(_) --> "=", !, { fail }.
  751search_char(C) --> fragment_char(C).
  752
  753search_value_chars([C|T]) -->
  754    search_value_char(C),
  755    !,
  756    search_value_chars(T).
  757search_value_chars([]) -->
  758    [].
  759
  760search_value_char(_) --> search_sep, !, { fail }.
  761search_value_char(C) --> fragment_char(C).
  762
  763%!  search_sep// is semidet.
  764%
  765%   Matches a search-parameter separator.  Traditionally, this is the
  766%   &-char, but these days there are `newstyle' ;-char separators.
  767%
  768%   @see http://perldoc.perl.org/CGI.html
  769%   @tbd This should be configurable
  770
  771search_sep --> "&", !.
  772search_sep --> ";".
  773
  774
  775%!  fragment(-Fragment, ?Tail)//
  776%
  777%   Extract the fragment (after the =#=)
  778
  779fragment([fragment(Fragment)|T], T) -->
  780    "#",
  781    !,
  782    fragment_chars(Codes),
  783    { atom_codes(Fragment, Codes) }.
  784fragment(T, T) -->
  785    [].
  786
  787fragment_chars([H|T]) -->
  788    fragment_char(H),
  789    !,
  790    fragment_chars(T).
  791fragment_chars([]) -->
  792    [].
  793
  794
  795%!  fragment_char(-Char)
  796%
  797%   Find a fragment character.
  798
  799fragment_char(C)   --> pchar(C), !.
  800fragment_char(0'/) --> "/", !.
  801fragment_char(0'?) --> "?", !.
  802fragment_char(0'[) --> "[", !.          % Not according RDF3986!
  803fragment_char(0']) --> "]", !.
  804
  805
  806                 /*******************************
  807                 *      CHARACTER CLASSES       *
  808                 *******************************/
  809
  810%!  pchar(-Code)//
  811%
  812%   unreserved|pct_encoded|sub_delim|":"|"@"
  813%
  814%   Performs UTF-8 decoding of percent encoded strings.
  815
  816pchar(0'\s) --> "+", !.
  817pchar(C) -->
  818    [C],
  819    {   unreserved(C)
  820    ;   sub_delim(C)
  821    ;   C == 0':
  822    ;   C == 0'@
  823    },
  824    !.
  825pchar(C) -->
  826    percent_coded(C).
  827
  828%!  lwalpha(-C)//
  829%
  830%   Demand alpha, return as lowercase
  831
  832lwalpha(H) -->
  833    [C],
  834    { C < 128,
  835      code_type(C, alpha),
  836      code_type(H, to_lower(C))
  837    }.
  838
  839drive_letter(C) -->
  840    [C],
  841    { C < 128,
  842      code_type(C, alpha)
  843    }.
  844
  845
  846                 /*******************************
  847                 *      RESERVED CHARACTERS     *
  848                 *******************************/
  849
  850%!  sub_delim(?Code)
  851%
  852%   Sub-delimiters
  853
  854sub_delim(0'!).
  855sub_delim(0'$).
  856sub_delim(0'&).
  857sub_delim(0'').
  858sub_delim(0'().
  859sub_delim(0')).
  860sub_delim(0'*).
  861sub_delim(0'+).
  862sub_delim(0',).
  863sub_delim(0';).
  864sub_delim(0'=).
  865
  866
  867%!  unreserved(+C)
  868%
  869%   Characters that can be represented without percent escaping
  870%   RFC 3986, section 2.3
  871
  872term_expansion(unreserved(map), Clauses) :-
  873    findall(unreserved(C), unreserved_(C), Clauses).
  874
  875unreserved_(C) :-
  876    between(1, 128, C),
  877    code_type(C, alnum).
  878unreserved_(0'-).
  879unreserved_(0'.).
  880unreserved_(0'_).
  881unreserved_(0'~).                       % 0'
  882
  883unreserved(map).                        % Expanded
  884
  885
  886                 /*******************************
  887                 *              FORMS           *
  888                 *******************************/
  889
  890/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  891Encoding/decoding of form-fields  using   the  popular  www-form-encoded
  892encoding used with the HTTP GET.
  893- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  894
  895%!  www_form_encode(+Value, -XWWWFormEncoded) is det.
  896%!  www_form_encode(-Value, +XWWWFormEncoded) is det.
  897%
  898%   En/decode   to/from   application/x-www-form-encoded.   Encoding
  899%   encodes all characters  except  RFC   3986  _unreserved_  (ASCII
  900%   =alnum= (see code_type/2)), and  one   of  "-._~"  using percent
  901%   encoding.  Newline  is  mapped  to  =|%OD%OA|=.  When  decoding,
  902%   newlines appear as a single newline (10) character.
  903%
  904%   Note that a space  is  encoded   as  =|%20|=  instead  of =|+|=.
  905%   Decoding decodes both to a space.
  906%
  907%   @deprecated Use uri_encoded/3 for new code.
  908
  909www_form_encode(Value, Encoded) :-
  910    atomic(Value),
  911    !,
  912    atom_codes(Value, Codes),
  913    phrase(www_encode(Codes, []), EncCodes),
  914    atom_codes(Encoded, EncCodes).
  915www_form_encode(Value, Encoded) :-
  916    atom_codes(Encoded, EncCodes),
  917    phrase(www_decode(Codes), EncCodes),
  918    atom_codes(Value, Codes).
  919
  920%!  www_encode(+Codes, +ExtraUnescaped)//
  921
  922www_encode([0'\r, 0'\n|T], Extra) -->
  923    !,
  924    "%0D%0A",
  925    www_encode(T, Extra).
  926www_encode([0'\n|T], Extra) -->
  927    !,
  928    "%0D%0A",
  929    www_encode(T, Extra).
  930www_encode([H|T], Extra) -->
  931    percent_encode(H, Extra),
  932    www_encode(T, Extra).
  933www_encode([], _) -->
  934    "".
  935
  936percent_encode(C, _Extra) -->
  937    { unreserved(C) },
  938    !,
  939    [C].
  940percent_encode(C, Extra) -->
  941    { memberchk(C, Extra) },
  942    !,
  943    [C].
  944%percent_encode(0' , _) --> !, "+".     % Deprecated: use %20
  945percent_encode(C, _) -->
  946    { C =< 127 },
  947    !,
  948    percent_byte(C).
  949percent_encode(C, _) -->                % Unicode characters
  950    { current_prolog_flag(url_encoding, utf8),
  951      !,
  952      phrase(utf8_codes([C]), Bytes)
  953    },
  954    percent_bytes(Bytes).
  955percent_encode(C, _) -->
  956    { C =< 255 },
  957    !,
  958    percent_byte(C).
  959percent_encode(_C, _) -->
  960    { representation_error(url_character)
  961    }.
  962
  963percent_bytes([]) -->
  964    "".
  965percent_bytes([H|T]) -->
  966    percent_byte(H),
  967    percent_bytes(T).
  968
  969percent_byte(C) -->
  970    [0'%, D1, D2],
  971    {   nonvar(C)
  972    ->  Dv1 is (C>>4 /\ 0xf),
  973        Dv2 is (C /\ 0xf),
  974        code_type(D1, xdigit(Dv1)),
  975        code_type(D2, xdigit(Dv2))
  976    ;   code_type(D1, xdigit(Dv1)),
  977        code_type(D2, xdigit(Dv2)),
  978        C is ((Dv1)<<4) + Dv2
  979    }.
  980
  981percent_coded(C) -->
  982    percent_byte(C0),
  983    !,
  984    (   { C0 == 13                  % %0D%0A --> \n
  985        },
  986        "%0",
  987        ( "A" ; "a" )
  988    ->  { C = 10
  989        }
  990    ;   { C0 >= 0xc0 },             % UTF-8 lead-in
  991        utf8_cont(Cs),
  992        { phrase(utf8_codes([C]), [C0|Cs]) }
  993    ->  []
  994    ;   { C = C0
  995        }
  996    ).
  997
  998%!  www_decode(-Codes)//
  999
 1000www_decode([0' |T]) -->
 1001    "+",
 1002    !,
 1003    www_decode(T).
 1004www_decode([C|T]) -->
 1005    percent_coded(C),
 1006    !,
 1007    www_decode(T).
 1008www_decode([C|T]) -->
 1009    [C],
 1010    !,
 1011    www_decode(T).
 1012www_decode([]) -->
 1013    [].
 1014
 1015utf8_cont([H|T]) -->
 1016    percent_byte(H),
 1017    { between(0x80, 0xbf, H) },
 1018    !,
 1019    utf8_cont(T).
 1020utf8_cont([]) -->
 1021    [].
 1022
 1023
 1024%!  set_url_encoding(?Old, +New) is semidet.
 1025%
 1026%   Query and set the encoding for URLs.  The default is =utf8=.
 1027%   The only other defined value is =iso_latin_1=.
 1028%
 1029%   @tbd    Having a global flag is highly inconvenient, but a
 1030%           work-around for old sites using ISO Latin 1 encoding.
 1031
 1032:- create_prolog_flag(url_encoding, utf8, [type(atom)]). 1033
 1034set_url_encoding(Old, New) :-
 1035    current_prolog_flag(url_encoding, Old),
 1036    (   Old == New
 1037    ->  true
 1038    ;   must_be(oneof([utf8, iso_latin_1]), New),
 1039        set_prolog_flag(url_encoding, New)
 1040    ).
 1041
 1042
 1043                 /*******************************
 1044                 *       IRI PROCESSING         *
 1045                 *******************************/
 1046
 1047%!  url_iri(+Encoded, -Decoded) is det.
 1048%!  url_iri(-Encoded, +Decoded) is det.
 1049%
 1050%   Convert between a URL, encoding in US-ASCII   and an IRI. An IRI
 1051%   is a fully expanded Unicode string.   Unicode  strings are first
 1052%   encoded into UTF-8, after which %-encoding takes place.
 1053
 1054url_iri(Encoded, Decoded) :-
 1055    nonvar(Encoded),
 1056    !,
 1057    (   sub_atom(Encoded, _, _, _, '%')
 1058    ->  atom_codes(Encoded, Codes),
 1059        unescape_precent(Codes, UTF8),
 1060        phrase(utf8_codes(Unicodes), UTF8),
 1061        atom_codes(Decoded, Unicodes)
 1062    ;   Decoded = Encoded
 1063    ).
 1064url_iri(URL, IRI) :-
 1065    atom_codes(IRI, IRICodes),
 1066    atom_codes('/:?#&=', ExtraEscapes),
 1067    phrase(www_encode(IRICodes, ExtraEscapes), UrlCodes),
 1068    atom_codes(URL, UrlCodes).
 1069
 1070
 1071unescape_precent([], []).
 1072unescape_precent([0'%,C1,C2|T0], [H|T]) :-     %'
 1073    !,
 1074    code_type(C1, xdigit(D1)),
 1075    code_type(C2, xdigit(D2)),
 1076    H is D1*16 + D2,
 1077    unescape_precent(T0, T).
 1078unescape_precent([H|T0], [H|T]) :-
 1079    unescape_precent(T0, T).
 1080
 1081
 1082                 /*******************************
 1083                 *           FORM DATA          *
 1084                 *******************************/
 1085
 1086%!  parse_url_search(?Spec, ?Fields:list(Name=Value)) is det.
 1087%
 1088%   Construct or analyze an HTTP   search  specification. This deals
 1089%   with       form       data       using       the       MIME-type
 1090%   =application/x-www-form-urlencoded=  as  used   in    HTTP   GET
 1091%   requests.
 1092
 1093parse_url_search(Spec, Fields) :-
 1094    atomic(Spec),
 1095    !,
 1096    atom_codes(Spec, Codes),
 1097    phrase(search(Fields), Codes).
 1098parse_url_search(Codes, Fields) :-
 1099    is_list(Codes),
 1100    !,
 1101    phrase(search(Fields), Codes).
 1102parse_url_search(Codes, Fields) :-
 1103    must_be(list, Fields),
 1104    phrase(csearch(Fields, []), Codes).
 1105
 1106
 1107                 /*******************************
 1108                 *          FILE URLs           *
 1109                 *******************************/
 1110
 1111%!  file_name_to_url(+File, -URL) is det.
 1112%!  file_name_to_url(-File, +URL) is semidet.
 1113%
 1114%   Translate between a filename and a file:// URL.
 1115%
 1116%   @tbd    Current implementation does not deal with paths that
 1117%           need special encoding.
 1118
 1119file_name_to_url(File, FileURL) :-
 1120    nonvar(File),
 1121    !,
 1122    absolute_file_name(File, Path),
 1123    atom_concat('file://', Path, FileURL),
 1124    !.
 1125file_name_to_url(File, FileURL) :-
 1126    atom_concat('file://', File, FileURL),
 1127    !