1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        jan@swi-prolog.org
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2013-2024, VU University Amsterdam
    7                              SWI-Prolog Solutions b.v.
    8
    9    This program is free software; you can redistribute it and/or
   10    modify it under the terms of the GNU General Public License
   11    as published by the Free Software Foundation; either version 2
   12    of the License, or (at your option) any later version.
   13
   14    This program is distributed in the hope that it will be useful,
   15    but WITHOUT ANY WARRANTY; without even the implied warranty of
   16    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   17    GNU General Public License for more details.
   18
   19    You should have received a copy of the GNU General Public
   20    License along with this library; if not, write to the Free Software
   21    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   22
   23    As a special exception, if you link this library with other files,
   24    compiled with a Free Software compiler, to produce an executable, this
   25    library does not by itself cause the resulting executable to be covered
   26    by the GNU General Public License. This exception does not however
   27    invalidate any other reasons why the executable file might be covered by
   28    the GNU General Public License.
   29*/
   30
   31:- module(pack,
   32          [ pack/1,                     % ?Pack
   33            pack_version_hashes/2,      % +Pack, -VersionHashesPairs
   34            hash_git_url/2,             % +Hash, -URL
   35            hash_file_url/2,            % +Hash, -URL
   36            pack_url_hash/2,            % +URL, -SHA1
   37
   38            current_pack/2,             % +Filter, -Pack
   39            sort_packs/3,               % +By, +Packs, -Sorted
   40            pack_table//2               % +Packs, +Options
   41          ]).   42:- use_module(library(http/http_dispatch)).   43:- use_module(library(http/http_parameters)).   44:- use_module(library(http/http_client)).   45:- use_module(library(http/http_log)).   46:- use_module(library(http/http_wrapper)).   47:- use_module(library(http/html_write)).   48:- use_module(library(http/html_head)).   49:- use_module(library(persistency)).   50:- use_module(library(lists)).   51:- use_module(library(aggregate)).   52:- use_module(library(option)).   53:- use_module(library(record)).   54:- use_module(library(pairs)).   55:- use_module(library(error)).   56:- use_module(library(apply)).   57:- use_module(library(uri)).   58:- use_module(library(debug)).   59:- use_module(library(prolog_versions)).   60
   61:- use_module(pack_info).   62:- use_module(pack_mirror).   63:- use_module(review).   64:- use_module(messages).   65:- use_module(openid).   66:- use_module(proxy).   67:- use_module(parms).   68
   69:- http_handler(root(pack/query),        pack_query,        []).   70:- http_handler(root(pack/list),         pack_list,         [prefix]).   71:- http_handler(root(pack/file_details), pack_file_details,
   72                [prefix, time_limit(20)]).   73:- http_handler(root(pack/delete),       pack_delete,       []).   74:- http_handler(root(pack/pattern),      set_allowed_url,   []).   75
   76%!  pack_query(+Request)
   77%
   78%   Handle package query requests from remote installers.  Content
   79%   is of type application/x-prolog.   Reply is also a Prolog term.
   80
   81pack_query(Request) :-
   82    proxy_master(Request),
   83    !.
   84pack_query(Request) :-
   85    memberchk(content_type(ContentType), Request),
   86    content_x_prolog(ContentType, ReplyType),
   87    !,
   88    http_peer(Request, Peer),
   89    http_read_data(Request, Query,
   90                   [ content_type('application/x-prolog')
   91                   ]),
   92    http_log('pack_query(~q, ~q).~n', [Query, Peer]),
   93    format('Cache-Control: private~n'),
   94    (   catch(pack_query(Query, Peer, Reply), E, true)
   95    ->  format('Content-type: ~w; charset=UTF-8~n~n', [ReplyType]),
   96        (   var(E)
   97        ->  format('~q.~n', [true(Reply)]),
   98            http_log('pack_query_done(ok, ~q).~n', [Peer])
   99        ;   format('~q.~n', [exception(E)]),
  100            message_to_string(E, String),
  101            http_log('pack_query_done(error(~q), ~q).~n', [String, Peer])
  102        )
  103    ;   format('Content-type: ~w; charset=UTF-8~n~n', [ReplyType]),
  104        format('false.~n'),
  105        http_log('pack_query_done(failed, ~q).~n', [Peer])
  106    ).
  107
  108content_x_prolog(ContentType, 'text/x-prolog') :-
  109    sub_atom(ContentType, 0, _, _, 'text/x-prolog'),
  110    !.
  111content_x_prolog(ContentType, 'application/x-prolog') :-
  112    sub_atom(ContentType, 0, _, _, 'application/x-prolog').
  113
  114%!  proxy_master(Request)
  115%
  116%   Proxy the request to the master to make sure the central package
  117%   database remains synchronised.
  118
  119proxy_master(Request) :-
  120    option(host(Host), Request),
  121    server(Role, Host),
  122    Role \== master,
  123    server(master, Master),
  124    Master \== Host,
  125    !,
  126    http_peer(Request, Peer),
  127    format(string(To), 'https://~w', [Master]),
  128    proxy(To, Request,
  129          [ request_headers([ 'X-Forwarded-For' = Peer,
  130                              'X-Real-IP' = Peer,
  131                              'Cache-Control' = 'no-cache'
  132                            ])
  133          ]).
  134
  135
  136%!  pack_query(+Query, +Peer, -Reply) is det.
  137%
  138%   Implements  the  various  queries    from   the  pack_install/1.
  139%   Currently defined Query values are:
  140%
  141%     * install(+URL, +SHA1, +Info)
  142%     User tries to install from URL an object with the indicated
  143%     hash and Info.
  144%     * downloaded(+Data)
  145%     Register download for indicated Data
  146%     * locate(+Pack)
  147%     Query download locations for Pack.
  148%     * versions(+Packs, +Options)
  149%     Query download and versions for a set of packs and all
  150%     (recursive) dependencies.
  151%     * search(+Keyword)
  152%     Find packs that match Keyword.
  153%     * info(+Packs)
  154%     Return a list of meta-data terms for the latest version of
  155%     Packs.  Unknown packs are omitted from the result list.
  156
  157pack_query(install(URL0, SHA10, Info), Peer, Reply) =>
  158    to_atom(URL0, URL),
  159    to_atom(SHA10, SHA1),
  160    save_request(Peer, download(URL, SHA1, Info), Result),
  161    (   Result = throw(Error)
  162    ->  throw(Error)
  163    ;   findall(ReplyInfo, install_info(URL, SHA1, ReplyInfo), Reply)
  164    ).
  165pack_query(downloaded(Data), Peer, Reply) =>
  166    maplist(save_request(Peer), Data, Reply).
  167pack_query(locate(Pack), _, Reply) =>
  168    pack_version_urls_v1(Pack, Reply).
  169pack_query(versions(Pack, Options), _, Reply) =>
  170    pack_versions(Pack, Reply, Options).
  171pack_query(search(Word), _, Reply) =>
  172    search_packs(Word, Reply).
  173pack_query(info(Packs), _, Hits) =>
  174    convlist(pack_search_result, Packs, Hits).
  175
  176to_atom(Atom, Atom) :-
  177    atom(Atom),
  178    !.
  179to_atom(String, Atom) :-
  180    atom_string(Atom, String).
  181
  182%!  pack_admin(+Pack)//
  183%
  184%   Display pack admin options
  185
  186pack_admin(Pack) -->
  187    { admin_user },
  188    !,
  189    html(div(class('pack-admin'),
  190             [ div(class('delete-pack'), \delete_button(Pack)),
  191               div(style('clear:right'), \pattern_input(Pack))
  192             ])).
  193pack_admin(_) -->
  194    [].
  195
  196delete_button(Pack) -->
  197    { http_link_to_id(pack_delete, [], HREF)
  198    },
  199    html(form([ action(HREF),
  200                class('delete-pack')
  201              ],
  202              [ input([ type(hidden), name(p), value(Pack)]),
  203                button([type(submit)], 'Delete pack'),
  204                &(nbsp)
  205              ])).
  206
  207pattern_input(Pack) -->
  208    { http_link_to_id(set_allowed_url, [], HREF),
  209      (   pack_allowed_url(Pack, IsGit, Pattern)
  210      ->  true
  211      ;   pack_version_hashes(Pack, VersionHashes),
  212          member(_-Hashes, VersionHashes),
  213          member(Hash, Hashes),
  214          sha1_url(Hash, URL)
  215      ->  url_pattern(URL, IsGit, Pattern)
  216      ;   Pattern = "",
  217          IsGit = false
  218      )
  219    },
  220    html(form([ action(HREF),
  221                class('pack-set-url-pattern')
  222              ],
  223              [ input([ type(hidden), name(p), value(Pack)]),
  224                label(for(url), 'URL pattern'),
  225                input([ class('url-pattern'), name(url), value(Pattern)]),
  226                input([ type(checkbox), name(git), value(IsGit)]),
  227                label(for(git), 'Is GIT'),
  228                button([type(submit)],
  229                       'Update URL pattern'),
  230                &(nbsp)
  231              ])).
  232
  233
  234admin_user :-
  235    current_prolog_flag(admin, true),
  236    !.
  237admin_user :-
  238    site_user_logged_in(User),
  239    site_user_property(User, granted(admin)).
  240
  241%!  pack_delete(+Request)
  242%
  243%   HTTP handler to delete a pack
  244
  245pack_delete(Request) :-
  246    admin_user,
  247    http_parameters(Request,
  248                    [ p(Pack, [optional(true)]),
  249                      h(Hash, [optional(true)])
  250                    ], []),
  251    (   nonvar(Pack)
  252    ->  call_showing_messages(delete_pack(Pack), [])
  253    ;   nonvar(Hash)
  254    ->  call_showing_messages(delete_hash(Hash), [])
  255    ).
  256pack_delete(Request) :-
  257    memberchk(path(Path), Request),
  258    throw(http_reply(forbidden(Path))).
  259
  260                 /*******************************
  261                 *      COMPUTATIONAL LOGIC     *
  262                 *******************************/
  263
  264%!  install_info(+URL, +SHA1, -Info) is nondet.
  265%
  266%   Info is relevant information  for  the   client  who  whishes to
  267%   install URL, which has the given   SHA1 hash. Currently provided
  268%   info is:
  269%
  270%     - alt_hash(Downloads, URLs, Hash)
  271%       Another file with the same (base) name was registered that
  272%       has a different hash.  This file was downloaded Downloads
  273%       times, resides on the given URLs (a list) and has the given
  274%       Hash.
  275%     - downloads(Downloads)
  276%       This hash was downloaded Downloads times from a unique IP
  277%       address
  278%     - dependency(Token, Pack, Version, URLs, SubSeps)
  279%       The requirement Token can be provided by Pack@Version, which
  280%       may be downloaded from the given URLs (a list).  Pack has
  281%       install info as specified by SubSeps (recursive
  282%       dependencies)
  283
  284install_info(URL, SHA1, Info) :-
  285    install_info(URL, SHA1, Info, []).
  286
  287install_info(_, SHA1, _, Seen) :-
  288    memberchk(SHA1, Seen), !, fail.
  289install_info(URL, SHA1, alt_hash(Downloads, URLs, Hash), _) :-
  290    prolog_pack:pack_url_file(URL, File),
  291    sha1_file(Hash, File),
  292    Hash \== SHA1,
  293    \+ is_github_release(URL),
  294    sha1_downloads(Hash, Downloads),
  295    sha1_urls(Hash, URLs).
  296install_info(_, SHA1, downloads(Count), _) :-
  297    sha1_downloads(SHA1, Count).
  298install_info(_, SHA1, dependency(Token, Pack, Version, URLs, SubDeps), Seen) :-
  299    sha1_requires(SHA1, Token),
  300    \+ is_prolog_token(Token),      % not in this version
  301    (   (   sha1_pack(_Hash, Token),
  302            Pack = Token
  303        ;   sha1_provides(Hash, Token),
  304            sha1_pack(Hash, Pack),
  305            Pack \== Token
  306        ),
  307        pack_latest_version(Pack, Hash1, _VersionTerm, _Older),
  308        sha1_info(Hash1, Info),
  309        memberchk(version(Version), Info),
  310        findall(URL, sha1_url(Hash1, URL), URLs),
  311        URLs \== []
  312    ->  findall(SubDep, install_info(-, Hash1, SubDep, [SHA1|Seen]), SubDeps)
  313    ;   Pack = (-), Version = (-), URLs = []
  314    ).
  315
  316%!  is_prolog_token(+Token) is semidet.
  317%
  318%   @tbd: share with library(pack_install).
  319
  320is_prolog_token(Token), cmp(Token, prolog, _Cmp, _Version) => true.
  321is_prolog_token(prolog:_Feature) => true.
  322is_prolog_token(_) => fail.
  323
  324sha1_downloads(Hash, Count) :-
  325    aggregate_all(count, sha1_download(Hash, _), Count).
  326
  327sha1_urls(Hash, URLs) :-
  328    findall(URL, sha1_url(Hash, URL), URLs).
  329
  330sha1_version(Hash, Version) :-
  331    sha1_info(Hash, Info),
  332    memberchk(version(Atom), Info),
  333    atom_version(Atom, Version).
  334
  335sha1_title(Hash, Title) :-
  336    sha1_info(Hash, Info),
  337    (   memberchk(title(Title), Info)
  338    ->  true
  339    ;   Title = '<no title>'
  340    ).
  341
  342sha1_is_git(Hash, Boolean) :-
  343    sha1_info(Hash, Info),
  344    (   memberchk(git(true), Info)
  345    ->  Boolean = true
  346    ;   Boolean = false
  347    ).
  348
  349
  350%!  pack_version_hashes(+Pack, -VersionHashesPairs) is semidet.
  351%
  352%   True when HashesByVersion is  an   ordered  list Version-Hashes,
  353%   latest version first.
  354
  355pack_version_hashes(Pack, VersionAHashesPairs) :-
  356    findall(SHA1, sha1_pack(SHA1, Pack), Hashes),
  357    map_list_to_pairs(sha1_version, Hashes, VersionHashPairs),
  358    keysort(VersionHashPairs, Sorted),
  359    group_pairs_by_key(Sorted, VersionHashesPairs),
  360    reverse(VersionHashesPairs, RevPairs),
  361    maplist(atomic_version_hashes, RevPairs, VersionAHashesPairs).
  362
  363atomic_version_hashes(Version-Hashes, VersionA-Hashes) :-
  364    atom_version(VersionA, Version).
  365
  366%!  pack_version_urls_v1(+Pack, -Locations) is det.
  367%
  368%   True when Locations is a set of Version-list(URL) pairs used for
  369%   installing Pack.
  370%
  371%   @arg    Locations is a list Version-URLs, sorted latest version
  372%           first.
  373%   @see    pack_version_urls_v2/3
  374
  375pack_version_urls_v1(Pack, VersionURLs) :-
  376    pack_version_hashes(Pack, VersionHashes),
  377    maplist(version_hashes_urls, VersionHashes, VersionURLs).
  378
  379version_hashes_urls(Version-Hashes, Version-URLs) :-
  380    maplist(sha1_url, Hashes, URLs0),
  381    sort(URLs0, URLs).
  382
  383%!  pack_versions(+Packs, -PackVersions, +Options) is det.
  384%
  385%   Given a single or multiple  packs,   return  information  on all
  386%   these packs as well as  their   dependencies.  PackVersions is a
  387%   list   of   `Pack-Versions`.   `Versions`   is     a   list   of
  388%   `Version-InfoList`. `InfoList` is a list of dicts, each holding
  389%
  390%      - info.pack
  391%        Pack name
  392%      - info.hash
  393%        Hash of the version.   This is either a GIT hash or the
  394%        sha1 of the archive file.
  395%      - info.provides
  396%        List of provided tokens.  Each provide is either a simple
  397%        token or a term @(Token,Version).
  398%      - info.requires
  399%        List of required tokens.  Each requirement is either a
  400%        simple token or a term `Token cmp Version`, where _cmp_
  401%        is one of `<`, `=<`, `=`, `>=` or `>`.
  402%      - info.conflicts
  403%        Similar to `info.requires`, declaring conflicts
  404%      - info.url
  405%        URL for downloading the archive or URL of the git repo.
  406%      - info.git
  407%        Boolean expressing wether the URL is a git repo or
  408%        archive.
  409%      - info.downloads
  410%        Download count.
  411
  412pack_versions(Packs, Deps, Options) :-
  413    phrase(pack_versions(Packs, [seen(Deps)|Options]), Deps).
  414
  415pack_versions([], _) --> !.
  416pack_versions([H|T], Options) -->
  417    pack_versions(H, Options),
  418    pack_versions(T, Options).
  419pack_versions(Pack, Options) -->
  420    { option(seen(Deps), Options),
  421      seen(Pack, Deps)
  422    },
  423    !.
  424pack_versions(Pack, Options) -->
  425    { pack_version_hashes(Pack, VersionHashes),
  426      convlist(version_hash_info(Pack, Options),
  427               VersionHashes, Infos),
  428      maplist(arg(2), Infos, RequiresLists),
  429      append(RequiresLists, Requires0),
  430      sort(Requires0, Requires),
  431      maplist(arg(1), Infos, VersionInfo)
  432    },
  433    [ Pack-VersionInfo ],
  434    include_pack_requirements(Requires, Options).
  435
  436seen(Pack, [Pack-_|_]) => true.
  437seen(Pack, [_|T]) => seen(Pack, T).
  438seen(_, _) => fail.
  439
  440version_hash_info(Pack, Options, Version-Hashes, info(Version-Info, Requires)) :-
  441    maplist(hash_info(Pack, Options), Hashes, Info, Requires0),
  442    append(Requires0, Requires1),
  443    sort(Requires1, Requires).
  444
  445hash_info(Pack, _Options, Hash, Dict, Requires) :-
  446    sha1_url(Hash, URL),
  447    sha1_is_git(Hash, IsGit),
  448    sha1_downloads(Hash, Count),
  449    findall(Req, sha1_requires(Hash, Req), Requires),
  450    findall(Prv, sha1_provides(Hash, Prv), Provides),
  451    findall(Prv, sha1_conflicts(Hash, Prv), Conflicts),
  452    Dict = #{ pack: Pack,
  453              hash: Hash,
  454              url: URL,
  455              git: IsGit,
  456              requires: Requires,
  457              provides: Provides,
  458              conflicts: Conflicts,
  459              downloads: Count
  460            }.
  461
  462include_pack_requirements([], _) --> !.
  463include_pack_requirements([ReqToken|T], Options) -->
  464    { findall(Unseen, resolves(ReqToken, Unseen), DepPacks)
  465    },
  466    pack_versions(DepPacks, Options),
  467    include_pack_requirements(T, Options).
  468
  469resolves(ReqToken, Pack) :-
  470    (   sha1_pack(Hash, Token),
  471        sha1_version(Hash, Version),
  472        PrvToken = @(Token,Version)
  473    ;   sha1_provides(Hash, PrvToken)
  474    ),
  475    satisfies(PrvToken, ReqToken),
  476    sha1_pack(Hash, Pack).
  477
  478satisfies(Token, Token) => true.
  479satisfies(@(Token,_), Token) => true.
  480satisfies(@(Token,PrvVersion), Req), cmp(Req, Token, Cmp, ReqVersion) =>
  481    atomic_list_concat(PrvVersion, PrvVersionAtom),
  482    atomic_list_concat(ReqVersion, ReqVersionAtom),
  483    cmp_versions(Cmp, PrvVersionAtom, ReqVersionAtom).
  484satisfies(_,_) => fail.
  485
  486cmp(Token  < Version, Token, <,  Version).
  487cmp(Token =< Version, Token, =<, Version).
  488cmp(Token =  Version, Token, =,  Version).
  489cmp(Token == Version, Token, ==, Version).
  490cmp(Token >= Version, Token, >=, Version).
  491cmp(Token >  Version, Token, >,  Version).
  492
  493%!  search_packs(+Search, -Packs) is det.
  494%
  495%   Search packs by keyword, returning a list
  496%
  497%           pack(Pack, Status, Version, Title, URLs).
  498
  499search_packs(Search, Packs) :-
  500    setof(Pack, matching_pack(Search, Pack), Names),
  501    !,
  502    maplist(pack_search_result, Names, Packs).
  503
  504matching_pack(Search, Pack) :-
  505    sha1_pack(SHA1, Pack),
  506    (   sub_atom_icasechk(Pack, _, Search)
  507    ->  true
  508    ;   sha1_title(SHA1, Title),
  509        sub_atom_icasechk(Title, _, Search)
  510    ).
  511
  512pack_search_result(Pack, pack(Pack, p, Title, VersionA, URLs)) :-
  513    pack_latest_version(Pack, SHA1, Version, _Older),
  514    sha1_title(SHA1, Title),
  515    atom_version(VersionA, Version),
  516    findall(URL, sha1_url(SHA1, URL), URLs).
  517
  518
  519                 /*******************************
  520                 *           DATABASE           *
  521                 *******************************/
  522
  523:- multifile error:has_type/2.  524
  525error:has_type(dependency, Value) :-
  526    is_dependency(Value, _Token, _Version).
  527
  528is_dependency(Token, Token, *) :-
  529    atom(Token).
  530is_dependency(Term, Token, VersionCmp) :-
  531    Term =.. [Op,Token,Version],
  532    cmp(Op, _),
  533    version_data(Version, _),
  534    VersionCmp =.. [Op,Version].
  535
  536cmp(<,  @<).
  537cmp(=<, @=<).
  538cmp(==, ==).
  539cmp(=,  =).
  540cmp(>=, @>=).
  541cmp(>,  @>).
  542
  543version_data(Version, version(Data)) :-
  544    atomic_list_concat(Parts, '.', Version),
  545    maplist(atom_number, Parts, Data).
  546
  547:- persistent
  548    sha1_pack(sha1:atom, pack:atom),
  549    sha1_file(sha1:atom, file:atom),
  550    sha1_requires(sha1:atom, token:dependency),
  551    sha1_provides(sha1:atom, token:dependency),
  552    sha1_conflicts(sha1:atom, token:dependency),
  553    sha1_info(sha1:atom, info:list),
  554    sha1_url(sha1:atom, url:atom),
  555    sha1_download(sha1:atom, peer:atom),
  556    pack_allowed_url(pack:atom, isgit:boolean, pattern:atom).  557
  558:- initialization
  559    absolute_file_name(data('packs.db'), File,
  560                       [ access(write) ]),
  561    db_attach(File, [sync(close)]),
  562    populate_pack_url_patterns.  563
  564%!  delete_pack(+PackName) is det.
  565%
  566%   Remove a pack from the database.
  567
  568delete_pack(PackName) :-
  569    must_be(atom, PackName),
  570    pack(PackName),
  571    !,
  572    clean_pack_info(PackName),
  573    pack_unmirror(PackName),
  574    forall(sha1_pack(Hash, PackName),
  575           delete_hash(Hash)),
  576    retractall_pack_allowed_url(PackName,_,_),
  577    print_message(informational, delete_pack(PackName)).
  578delete_pack(PackName) :-
  579    existence_error(pack, PackName).
  580
  581%!  delete_hash(Hash) is det.
  582%
  583%   Remove Hash from the database
  584
  585delete_hash(Hash) :-
  586    retractall_sha1_pack(Hash, _),
  587    retractall_sha1_file(Hash, _),
  588    retractall_sha1_requires(Hash, _),
  589    retractall_sha1_provides(Hash, _),
  590    retractall_sha1_conflicts(Hash, _),
  591    retractall_sha1_info(Hash, _),
  592    retractall_sha1_url(Hash, _),
  593    retractall_sha1_download(Hash, _),
  594    print_message(informational, delete_hash(Hash)).
  595
  596%!  save_request(+Peer, +Data, -Result)
  597%
  598%   Update the database with the given   information. We only update
  599%   if the request is new, which means   the  same SHA1 has not been
  600%   downloaded from the same Peer.
  601
  602:- det(save_request/3).  603save_request(Peer, download(URL, Hash, Metadata), Result) =>
  604    Result = Pack-Action,
  605    memberchk(name(Pack), Metadata),
  606    with_mutex(pack, save_request(URL, Hash, Metadata, Peer, Action)).
  607
  608save_request(URL, Hash, Metadata, Peer, Result) :-
  609    (   Error = error(Formal,_),
  610        catch(save_request_(URL, Hash, Metadata, Peer, Res0),
  611              Error,
  612              true)
  613    ->  (   var(Formal)
  614        ->  Result = Res0
  615        ;   Result = throw(Error)
  616        )
  617    ;   Result = false
  618    ).
  619
  620save_request_(URL, SHA1, Info, Peer, Result) :-
  621    sha1_download(SHA1, Peer),
  622    sha1_pack(SHA1, Peer),                 % already downloaded from here
  623    !,
  624    info_is_git(Info, IsGIT),
  625    register_url(SHA1, IsGIT, URL, Result). % but maybe from a different URL
  626save_request_(URL, SHA1, Info, Peer, Result) :-
  627    memberchk(name(Pack), Info),
  628    info_is_git(Info, IsGIT),
  629    (   accept_url(URL, Pack, IsGIT)
  630    ->  register_url(SHA1, IsGIT, URL, Result0),
  631        register_pack(SHA1, Pack),
  632        register_info(SHA1, Info)
  633    ;   permission_error(register, pack(Pack), URL)
  634    ),
  635    assert_sha1_download(SHA1, Peer),
  636    (   Result0 == no_change
  637    ->  Result = download
  638    ;   Result = Result0
  639    ).
  640
  641info_is_git(Info, IsGIT) :-
  642    memberchk(git(IsGIT), Info),
  643    !.
  644info_is_git(_, false).
  645
  646%!  accept_url(+URL, +Pack, +IsGit) is det.
  647%
  648%   True when URL is an aceptable URL for Pack.  We only
  649%   register this on the first submission of a pack.
  650
  651accept_url(URL, Pack, IsGIT) :-
  652    (   pack_allowed_url(Pack, _, Pattern)
  653    *-> wildcard_match(Pattern, URL), !
  654    ;   admissible_url(URL)
  655    ->  url_pattern(URL, IsGIT, Pattern),
  656        assert_pack_allowed_url(Pack, IsGIT, Pattern)
  657    ).
  658
  659admissible_url(URL) :-
  660    uri_components(URL, Components),
  661    uri_data(scheme, Components, Scheme),
  662    uri_data(authority, Components, Authority),
  663    uri_authority_components(Authority, AuthComponents),
  664    uri_authority_data(host, AuthComponents, Host),
  665    uri_authority_data(port, AuthComponents, Port),
  666    \+ nonadmissible_host(Host),
  667    admissible_scheme(Scheme, Port).
  668
  669nonadmissible_host(localhost).
  670nonadmissible_host(IP) :-
  671    split_string(IP, ".", "", Parts),
  672    maplist(number_string, _, Parts).
  673
  674admissible_scheme(http, 80).
  675admissible_scheme(https, 443).
  676
  677url_pattern(URL, true, URL) :- !.
  678url_pattern(URL, false, Pattern) :-
  679    site_pattern(URL, Pattern),
  680    !.
  681url_pattern(URL, false, Pattern) :-
  682    (   atom_concat('http://', Rest, URL)
  683    ->  atom_concat('http{,s}://', Rest, URL2)
  684    ;   URL2 = URL
  685    ),
  686    file_directory_name(URL2, Dir),
  687    atom_concat(Dir, '/*', Pattern).
  688
  689site_pattern(URL, Pattern) :-
  690    sub_atom(URL, 0, _, _, 'https://gitlab.com/'),
  691    git_user_project_pattern(URL, Pattern).
  692site_pattern(URL, Pattern) :-
  693    sub_atom(URL, 0, _, _, 'https://github.com/'),
  694    git_user_project_pattern(URL, Pattern).
  695
  696git_user_project_pattern(URL, Pattern) :-
  697    uri_components(URL, Components),
  698    uri_data(path, Components, Path0),
  699    split_string(Path0, "/", "/", [User,Project|_]),
  700    atomic_list_concat([/, User, /, Project, /, *], Path),
  701    uri_data(path, Components, Path, Components1),
  702    uri_components(Pattern, Components1).
  703
  704populate_pack_url_patterns :-
  705    forall(pack(Pack),
  706           populate_pack_url_pattern(Pack)).
  707
  708populate_pack_url_pattern(Pack) :-
  709    pack_allowed_url(Pack, _, _),
  710    !.
  711populate_pack_url_pattern(Pack) :-
  712    findall(URL-IsGIT,
  713            ( sha1_pack(SHA1, Pack),
  714              sha1_info(SHA1, Info),
  715              (   memberchk(git(IsGIT), Info)
  716              ->  true
  717              ;   IsGIT = false
  718              ),
  719              sha1_url(SHA1, URL)
  720            ),
  721            URLS),
  722    last(URLS, URL-IsGIT),
  723    url_pattern(URL, IsGIT, Pattern),
  724    assert_pack_allowed_url(Pack, IsGIT, Pattern),
  725    !.
  726populate_pack_url_pattern(Pack) :-
  727    print_message(error, pack(pattern_failed(Pack))).
  728
  729%!  set_allowed_url(+Request)
  730%
  731%   Set the URL pattern for a pack.
  732
  733set_allowed_url(Request) :-
  734    admin_user,
  735    http_parameters(Request,
  736                    [ p(Pack, []),
  737                      url(Pattern, []),
  738                      git(IsGit, [boolean, optional(true)])
  739                    ], []),
  740    call_showing_messages(set_allowed_url(Pack, IsGit, Pattern), []).
  741set_allowed_url(Request) :-
  742    memberchk(path(Path), Request),
  743    throw(http_reply(forbidden(Path))).
  744
  745set_allowed_url(Pack, _IsGit, _Pattern) :-
  746    \+ sha1_pack(_, Pack),
  747    !,
  748    existence_error(pack, Pack).
  749set_allowed_url(Pack, IsGit, Pattern) :-
  750    (   var(IsGit)
  751    ->  (   sub_atom(Pattern, _, _, _, *)
  752        ->  IsGit = false
  753        ;   IsGit = true
  754        )
  755    ;   true
  756    ),
  757    retractall_pack_allowed_url(Pack, _, _),
  758    assert_pack_allowed_url(Pack, IsGit, Pattern).
  759
  760%!  register_pack(+SHA1, +Pack) is det.
  761
  762register_pack(SHA1, Pack) :-
  763    (   sha1_pack(SHA1, Pack)
  764    ->  true
  765    ;   assert_sha1_pack(SHA1, Pack)
  766    ).
  767
  768register_info(SHA1, Info0) :-
  769    sort(Info0, Info),
  770    (   sha1_info(SHA1, _Info)
  771    ->  true
  772    ;   assert_sha1_info(SHA1, Info),
  773        forall(member(requires(Token), Info),
  774               register_requires(SHA1, Token)),
  775        forall(member(provides(Token), Info),
  776               register_provides(SHA1, Token)),
  777        forall(member(conflicts(Token), Info),
  778               register_conflicts(SHA1, Token))
  779    ).
  780
  781register_requires(SHA1, Token) :-
  782    (   sha1_requires(SHA1, Token)
  783    ->  true
  784    ;   assert_sha1_requires(SHA1, Token)
  785    ).
  786
  787register_provides(SHA1, Token) :-
  788    (   sha1_provides(SHA1, Token)
  789    ->  true
  790    ;   assert_sha1_provides(SHA1, Token)
  791    ).
  792
  793register_conflicts(SHA1, Token) :-
  794    (   sha1_conflicts(SHA1, Token)
  795    ->  true
  796    ;   assert_sha1_conflicts(SHA1, Token)
  797    ).
  798
  799%!  register_url(+SHA1, +IsGIT, +URL) is det.
  800%
  801%   Register we have that data loaded from URL has signature SHA1.
  802
  803:- debug(pack(changed)).  804
  805register_url(SHA1, IsGIT, URL, Result) :-
  806    (   sha1_url(SHA1, URL)
  807    ->  Result = no_change
  808    ;   sha1_url(SHA2, URL),
  809        \+ ( IsGIT == true,
  810             hash_git_url(SHA2, URL)
  811           ),
  812        (   debug(pack(changed), '~p seems changed', [URL]),
  813            is_github_release(URL)
  814        ->  debug(pack(changed), 'From github: ~p', [URL]),
  815            retractall_sha1_url(SHA1, URL),
  816            fail
  817        ;   true
  818        )
  819    ->  Result = throw(pack(modified_hash(SHA1-URL, SHA2-[URL])))
  820    ;   IsGIT == true
  821    ->  assert_sha1_url(SHA1, URL),
  822        Result = git(URL)
  823    ;   prolog_pack:pack_url_file(URL, File),
  824        register_file(SHA1, File, URL),
  825        assert_sha1_url(SHA1, URL),
  826        Result = file(URL)
  827    ).
  828
  829%!  is_github_release(+URL) is semidet.
  830%
  831%   True when URL reflects a  GitHub   release  pack download. These
  832%   have the unpeleasant habbit to change exact content.
  833
  834is_github_release(URL) :-
  835    uri_components(URL, Components),
  836    uri_data(scheme, Components, Scheme), Scheme == https,
  837    uri_data(authority, Components, Auth), Auth == 'github.com',
  838    uri_data(path, Components, Path), atomic(Path),
  839    split_string(Path, "/", "", ["", _User, _Repo, "archive", Zip]),
  840    file_name_extension(_, Ext, Zip),
  841    github_archive_extension(Ext).
  842
  843github_archive_extension(tgz).
  844github_archive_extension(zip).
  845
  846register_file(SHA1, File, URL) :-
  847    (   sha1_file(SHA1, File)
  848    ->  true
  849    ;   sha1_file(SHA2, File),
  850        sha1_urls(SHA2, URLs),
  851        (   maplist(is_github_release, [URL|URLs])
  852        ->  retractall_sha1_file(SHA1, File),
  853            fail
  854        ;   true
  855        )
  856    ->  throw(pack(modified_hash(SHA1-URL, SHA2-URLs)))
  857    ;   assert_sha1_file(SHA1, File)
  858    ).
  859
  860%!  hash_git_url(+SHA1, -GitURL) is semidet.
  861%
  862%   True when SHA1 was installed using GIT from GitURL.
  863
  864hash_git_url(SHA1, GitURL) :-
  865    sha1_info(SHA1, Info),
  866    memberchk(git(true), Info),
  867    !,
  868    sha1_url(SHA1, GitURL).
  869
  870%!  hash_file_url(+SHA1, -FileURL) is nondet.
  871%
  872%   True when SHA1 was installed using GIT from GitURL.
  873
  874hash_file_url(SHA1, FileURL) :-
  875    sha1_info(SHA1, Info),
  876    \+ memberchk(git(true), Info),
  877    !,
  878    sha1_url(SHA1, FileURL).
  879
  880%!  pack_url_hash(?URL, ?Hash) is nondet.
  881%
  882%   True when Hash is the registered hash for URL.
  883
  884pack_url_hash(URL, Hash) :-
  885    sha1_url(Hash, URL).
  886
  887%!  pack(?Pack) is nondet.
  888%
  889%   True when Pack is a currently known pack.
  890
  891pack(Pack) :-
  892    findall(Pack, sha1_pack(_,Pack), Packs),
  893    sort(Packs, Sorted),
  894    member(Pack, Sorted).
  895
  896
  897                 /*******************************
  898                 *           USER API           *
  899                 *******************************/
  900
  901%!  pack_list(+Request)
  902%
  903%   List available packages.
  904
  905pack_list(Request) :-
  906    memberchk(path_info(SlashPack), Request),
  907    atom_concat(/, Pack, SlashPack),
  908    format(atom(Title), '"~w" pack for SWI-Prolog', [Pack]),
  909    reply_html_page(pack(list),
  910                    title(Title),
  911                    [ \pack_listing(Pack, _Author, _Sort)
  912                    ]).
  913pack_list(Request) :-
  914    http_parameters(Request,
  915                    [ p(Pack, [optional(true)]),
  916                      author(Author, [optional(true)]),
  917                      sort(Sort, [ oneof([name,downloads,rating]),
  918                                   optional(true),
  919                                   default(name)
  920                                 ])
  921                    ]),
  922    (  ground(Pack)
  923    -> format(atom(Title), '"~w" pack for SWI-Prolog', [Pack])
  924    ;  Title = 'SWI-Prolog packages'
  925    ),
  926    reply_html_page(pack(list),
  927                    title(Title),
  928                    [ \pack_listing(Pack, Author, Sort)
  929                    ]).
  930
  931pack_listing(Pack, _Author, _Sort) -->
  932    { ground(Pack) },
  933    !,
  934    html([ h1(class(wiki), 'Package "~w"'-[Pack]),
  935           \html_requires(css('pack.css')),
  936           \pack_info(Pack)
  937         ]).
  938pack_listing(_Pack, Author, SortBy) -->
  939    { (   nonvar(Author)
  940      ->  Filter = [author(Author)]
  941      ;   Filter = []
  942      ),
  943      (   setof(Pack, current_pack(Filter, Pack), Packs)
  944      ->  true
  945      ;   Packs = []
  946      ),
  947      sort_packs(SortBy, Packs, Sorted)
  948    },
  949    html({|html||
  950<p>
  951Below is a list of known packages. Please be aware that packages are
  952<b>not moderated</b>. Installing a pack does not execute code in the
  953pack, but simply loading a library from the pack may execute arbitrary
  954code. More information about packages is available <a
  955href="/howto/Pack.html">here</a>.   You can search for packages from
  956the Prolog command line using pack_list/1.  This contacts the pack
  957server for packs that match by name or title.  A leading <b>i</b>
  958indicates that the pack is already installed, while <b>p</b> merely
  959indicates that it is known by the server.
  960</p>
  961
  962<pre class="code">
  963?- pack_list(graph).
  964p callgraph@0.3.4           - Predicate call graph visualisation
  965i graphml@0.1.0             - Write GraphML files
  966i gvterm@1.1                - Show Prolog terms using graphviz
  967p musicbrainz@0.6.3         - Musicbrainz client library
  968p sindice@0.0.3             - Access to Sindice semantic web search engine
  969</pre>
  970
  971<p>
  972After finding the right pack, the pack and its dependencies can be installed
  973using the pack_install/1 as illustrated below.
  974</p>
  975
  976<pre class="code">
  977?- pack_install(hello).
  978</pre>
  979
  980<p>
  981Clicking the package shows details and allows you to rate and comment
  982the pack.
  983</p>
  984             |}),
  985    pack_table(Sorted, [sort_by(SortBy)]),
  986    html_receive(rating_scripts).
  987
  988%!  pack_table(+Packs, +Options)// is det.
  989%
  990%   Show a table of packs.
  991
  992pack_table(Packs, Options) -->
  993    { option(sort_by(SortBy), Options, -),
  994      length(Packs, PackCount),
  995      maplist(pack_downloads, Packs, Totals),
  996      sum_list(Totals, Total)
  997    },
  998    html_requires(css('pack.css')),
  999    html(table(class(packlist),
 1000               [ tr([ \pack_header(name,  SortBy,
 1001                                   'Pack', ['tot: ~D'-[PackCount]]),
 1002                      \pack_header(version, SortBy,
 1003                                   'Version', '(#older)'),
 1004                      \pack_header(downloads, SortBy,
 1005                                   'Downloads', ['tot: ~D'-[Total],
 1006                                                 br([]), '(#latest)']),
 1007                      \pack_header(rating, SortBy,
 1008                                   'Rating', ['(#votes/', br([]),
 1009                                              '#comments)']),
 1010                      \pack_header(title, SortBy,
 1011                                   'Title', [])
 1012                    ])
 1013               | \pack_rows(Packs)
 1014               ])).
 1015
 1016
 1017pack_rows([]) --> [].
 1018pack_rows([H|T]) --> pack_row(H), pack_rows(T).
 1019
 1020pack_row(Pack) -->
 1021    { pack_name(Pack, Name),
 1022      http_link_to_id(pack_list, [p(Name)], HREF)
 1023    },
 1024    html(tr([ td(a(href(HREF),Name)),
 1025              td(class('pack-version'),   \pack_version(Pack)),
 1026              td(class('pack-downloads'), \pack_downloads(Pack)),
 1027              td(class('pack-rating'),    \pack_rating(Pack)),
 1028              td(class('pack-title'),     \pack_title(Pack))
 1029            ])).
 1030
 1031pack_header(Name, -, Title, Subtitle) -->
 1032    !,
 1033    html(th(id(Name), [Title, \subtitle(Subtitle)])).
 1034pack_header(Name, SortBy, Title, Subtitle) -->
 1035    { Name \== SortBy,
 1036      sortable(Name),
 1037      !,
 1038      http_link_to_id(pack_list, [sort(Name)], HREF)
 1039    },
 1040    html(th(id(Name), [ a([class(resort),href(HREF)], Title),
 1041                        \subtitle(Subtitle)
 1042                      ])).
 1043pack_header(Name, Name, Title, Subtitle) -->
 1044    html(th(id(Name), [i(class(sorted), Title), \subtitle(Subtitle)])).
 1045pack_header(Name, _, Title, Subtitle) -->
 1046    html(th(id(Name), [Title, \subtitle(Subtitle)])).
 1047
 1048subtitle([]) --> [].
 1049subtitle(Subtitle) --> html(div(class(sth), Subtitle)).
 1050
 1051
 1052sortable(name).
 1053sortable(downloads).
 1054sortable(rating).
 1055
 1056pack_version(Pack) -->
 1057    { pack_version(Pack, Version),
 1058      pack_older_versions(Pack, Older),
 1059      atom_version(Atom, Version)
 1060    },
 1061    (   { Older =\= 0 }
 1062    ->  html([Atom, span(class(annot), '~D'-[Older])])
 1063    ;   html(Atom)
 1064    ).
 1065
 1066pack_downloads(Pack) -->
 1067    { pack_downloads(Pack, Total),
 1068      pack_download_latest(Pack, DownLoadLatest)
 1069    },
 1070    (   { Total =:= DownLoadLatest }
 1071    ->  html('~D'-[Total])
 1072    ;   html(['~D'-[Total], span(class(annot), '~D'-[DownLoadLatest])])
 1073    ).
 1074
 1075pack_rating(Pack) -->
 1076    { pack_rating(Pack, Rating),
 1077      pack_votes(Pack, Votes),
 1078      pack_comments(Pack, CommentCount),
 1079      pack_name(Pack, Name),
 1080      http_link_to_id(pack_rating, [], OnRating)
 1081    },
 1082    show_pack_rating(Name, Rating, Votes, CommentCount,
 1083                     [ on_rating(OnRating)
 1084                     ]).
 1085
 1086pack_title(Pack) -->
 1087    { pack_hash(Pack, SHA1),
 1088      sha1_title(SHA1, Title)
 1089    },
 1090    html(Title).
 1091
 1092:- record
 1093    pack(name:atom,                         % Name of the pack
 1094         hash:atom,                         % SHA1 of latest version
 1095         version:list(integer),             % Latest Version
 1096         older_versions:integer,            % # older versions
 1097         downloads:integer,                 % Total downloads
 1098         download_latest:integer,           % # downloads latest version
 1099         rating:number,                     % Average rating
 1100         votes:integer,                     % Vote count
 1101         comments:integer).                 % Comment count
 1102
 1103%!  current_pack(+Filter:list, -Pack) is nondet.
 1104%
 1105%   True when Pack is a pack that satisfies Filter. Filter is a list
 1106%   of filter expressions. Currently defined filters are:
 1107%
 1108%     * author(+Author)
 1109%     Pack is claimed by this author.
 1110
 1111current_pack(Filters,
 1112             pack(Pack, SHA1,
 1113                  Version, OlderVersionCount,
 1114                  Downloads, DLLatest,
 1115                  Rating, Votes, CommentCount)) :-
 1116    setof(Pack, H^sha1_pack(H,Pack), Packs),
 1117    member(Pack, Packs),
 1118    pack_latest_version(Pack, SHA1, Version, OlderVersionCount),
 1119    maplist(pack_filter(SHA1), Filters),
 1120    pack_downloads(Pack, SHA1, Downloads, DLLatest),
 1121    pack_rating_votes(Pack, Rating, Votes),
 1122    pack_comment_count(Pack, CommentCount).
 1123
 1124pack_filter(SHA1, author(Author)) :-
 1125    sha1_info(SHA1, Info),
 1126    member(author(Name, Contact), Info),
 1127    once(author_match(Author, Name, Contact)).
 1128
 1129author_match(Author, Author, _).                % Specified author
 1130author_match(Author, _, Author).                % Specified contact
 1131author_match(UUID, Name, Contact) :-            % Specified UUID
 1132    (   site_user_property(UUID, name(Name))
 1133    ;   site_user_property(UUID, email(Contact))
 1134    ;   site_user_property(UUID, home_url(Contact))
 1135    ).
 1136
 1137
 1138%!  sort_packs(+Field, +Packs, -Sorted)
 1139
 1140sort_packs(By, Packs, Sorted) :-
 1141    map_list_to_pairs(pack_data(By), Packs, Keyed),
 1142    keysort(Keyed, KeySorted),
 1143    pairs_values(KeySorted, Sorted0),
 1144    reverse_sort(By, Sorted0, Sorted).
 1145
 1146reverse_sort(name, Packs, Packs) :- !.
 1147reverse_sort(_, Packs, RevPacks) :-
 1148    reverse(Packs, RevPacks).
 1149
 1150
 1151pack_downloads(Pack, SHA1, Total, DownLoadLatest) :-
 1152    setof(Hash, sha1_pack(Hash, Pack), Hashes),
 1153    map_list_to_pairs(sha1_downloads, Hashes, Pairs),
 1154    memberchk(DownLoadLatest-SHA1, Pairs),
 1155    pairs_keys(Pairs, Counts),
 1156    sum_list(Counts, Total).
 1157
 1158%!  pack_latest_version(+Pack, -SHA1, -Version, -OlderCount)
 1159%
 1160%   True when SHA1 is the  latest  version   of  Pack  at  the given
 1161%   Version and there are OlderCount older versions.
 1162
 1163pack_latest_version(Pack, SHA1, Version, Older) :-
 1164    setof(SHA1, sha1_pack(SHA1, Pack), Hashes),
 1165    map_list_to_pairs(sha1_version, Hashes, Versions),
 1166    keysort(Versions, Sorted),
 1167    length(Sorted, Count),
 1168    Older is Count - 1,
 1169    last(Sorted, Version-SHA1).
 1170
 1171
 1172                 /*******************************
 1173                 *        DETAILED INFO         *
 1174                 *******************************/
 1175
 1176%!  pack_info(+Pack)//
 1177%
 1178%   Provided detailed information about a package.
 1179%
 1180%   @tbd    provide many more details
 1181%   @tbd    Show dependency for requirements/provides
 1182
 1183pack_info(Pack) -->
 1184    { \+ pack(Pack) },
 1185    !,
 1186    html(p(class(warning),
 1187           'Sorry, I know nothing about a pack named "~w"'-[Pack])).
 1188pack_info(Pack) -->
 1189    pack_admin(Pack),
 1190    pack_info_table(Pack),
 1191    pack_reviews(Pack),
 1192    pack_file_table(Pack),
 1193    ( pack_readme(Pack) -> [] ; [] ),
 1194    (   pack_file_hierarchy(Pack)
 1195    ->  []
 1196    ;   html(p(class(warning), 'Failed to process pack'))
 1197    ).
 1198
 1199%!  pack_info_table(+Pack)// is det.
 1200%
 1201%   Provide basic information on the package
 1202
 1203pack_info_table(Pack) -->
 1204    { pack_latest_version(Pack, SHA1, Version, _Older),
 1205      atom_version(VersionA, Version),
 1206      sha1_title(SHA1, Title),
 1207      sha1_info(SHA1, Info)
 1208    },
 1209    html(table(class(pack),
 1210               [ \property('Title', span(class(title), Title)),
 1211                 \property('Rating', \show_pack_rating(Pack)),
 1212                 \property('Latest version', VersionA),
 1213                 \property('SHA1 sum', \hash(SHA1)),
 1214                 \info(author(_,_), Info),
 1215                 \info(maintainer(_,_), Info),
 1216                 \info(packager(_,_), Info),
 1217                 \info(home(_), Info),
 1218                 \info(download(_), Info),
 1219                 \info(requires(_), Info),
 1220                 \info(provides(_), Info),
 1221                 \info(conflicts(_), Info)
 1222               ])).
 1223
 1224property(Label, Value) -->
 1225    html(tr([th([Label, :]), td(Value)])).
 1226
 1227info(Term, Info) -->
 1228    { findall(Term, member(Term, Info), [T0|More]), !
 1229    },
 1230    html(tr([th([\label(T0), :]), td(\value(T0))])),
 1231    extra_values(More).
 1232info(_, _) --> [].
 1233
 1234extra_values([]) --> [].
 1235extra_values([H|T]) -->
 1236    html(tr([th([]), td(\value(H))])),
 1237    extra_values(T).
 1238
 1239label(Term) -->
 1240    { prolog_pack:pack_level_info(_, Term, LabelFmt, _),
 1241      (   LabelFmt = Label-_
 1242      ->  true
 1243      ;   Label = LabelFmt
 1244      )
 1245    },
 1246    html(Label).
 1247
 1248value(Term) -->
 1249    { name_address(Term, Name, Address) },
 1250    !,
 1251    html([span(class(name), Name), ' ']),
 1252    address(Address).
 1253value(Term) -->
 1254    { url(Term, Label, URL) },
 1255    html(a(href(URL), Label)).
 1256value(Term) -->
 1257    { prolog_pack:pack_level_info(_, Term, LabelFmt, _),
 1258      (   LabelFmt = _-Fmt
 1259      ->  true
 1260      ;   Fmt = '~w'
 1261      ),
 1262      Term =.. [_|Values]
 1263    },
 1264    html(Fmt-Values).
 1265
 1266address(Address) -->
 1267    { sub_atom(Address, _, _, _, @) },
 1268    !,
 1269    html(['<', Address, '>']).
 1270address(URL) -->
 1271    html(a(href(URL), URL)).
 1272
 1273name_address(author(    Name, Address), Name, Address).
 1274name_address(maintainer(Name, Address), Name, Address).
 1275name_address(packager(  Name, Address), Name, Address).
 1276
 1277url(home(URL), URL, URL).
 1278url(download(Pattern), Pattern, URL) :-
 1279    (   wildcard_pattern(Pattern)
 1280    ->  file_directory_name(Pattern, Dir),
 1281        ensure_slash(Dir, URL)
 1282    ;   URL = Pattern
 1283    ).
 1284
 1285wildcard_pattern(URL) :- sub_atom(URL, _, _, _, *).
 1286wildcard_pattern(URL) :- sub_atom(URL, _, _, _, ?).
 1287
 1288ensure_slash(Dir, DirS) :-
 1289    (   sub_atom(Dir, _, _, 0, /)
 1290    ->  DirS = Dir
 1291    ;   atom_concat(Dir, /, DirS)
 1292    ).
 1293
 1294%!  pack_file_table(+Pack)// is det.
 1295%
 1296%   Provide a table with the files, sorted by version, providing
 1297%   statistics on downloads.
 1298
 1299pack_file_table(Pack) -->
 1300    { findall(Version-Hash, pack_version_hash(Pack, Hash, Version), Pairs0),
 1301      sort(1, @>=, Pairs0, Pairs),
 1302      group_pairs_by_key(Pairs, Grouped)
 1303    },
 1304    html(h2(class(wiki), 'Details by download location')),
 1305    html(table(class(pack_file_table),
 1306               [ tr([th('Version'), th('SHA1'), th('#Downloads'), th('URL')])
 1307               | \pack_file_rows(Grouped)
 1308               ])).
 1309
 1310pack_file_rows([]) --> [].
 1311pack_file_rows([H|T]) --> pack_file_row(H), pack_file_rows(T).
 1312
 1313pack_file_row(Version-[H0|Hashes]) -->
 1314    { sha1_downloads(H0, Count),
 1315      sha1_urls(H0, [URL|URLs])
 1316    },
 1317    html(tr([ td(\version(Version)),
 1318              td(style('white-space: nowrap'), \hash(H0)),
 1319              \count(Count),
 1320              td(\download_url(URL))
 1321            ])),
 1322    alt_urls(URLs),
 1323    alt_hashes(Hashes),
 1324    !.
 1325pack_file_row(_) -->
 1326    [].
 1327
 1328alt_urls([]) --> [].
 1329alt_urls([H|T]) --> alt_url(H), alt_urls(T).
 1330
 1331alt_url(H) -->
 1332    html(tr([td(''), td(''), td(''), td(\download_url(H))])).
 1333
 1334alt_hashes([]) --> [].
 1335alt_hashes([H|T]) --> alt_hash(H), alt_hashes(T).
 1336
 1337alt_hash(H) -->
 1338    { sha1_downloads(H, Count),
 1339      sha1_urls(H, [URL|URLs])
 1340    },
 1341    html(tr([td(''), td(\hash(H)), \count(Count), td(\download_url(URL))])),
 1342    alt_urls(URLs).
 1343
 1344hash(H)           --> html(span(class(hash), H)), del_hash_link(H).
 1345download_url(URL) --> html(a(href(URL), URL)).
 1346count(N)          --> html(td(class(count), N)).
 1347version(V)        --> { atom_version(Atom, V) },
 1348    html(Atom).
 1349
 1350del_hash_link(Hash) -->
 1351    { admin_user,
 1352      !,
 1353      http_link_to_id(pack_delete, [h=Hash], HREF)
 1354    },
 1355    !,
 1356    html(a([class('delete-hash'), href(HREF)], '\U0001F5D1')).
 1357del_hash_link(_) -->
 1358    [].
 1359
 1360pack_version_hash(Pack, Hash, Version) :-
 1361    sha1_pack(Hash, Pack),
 1362    sha1_version(Hash, Version).
 1363
 1364%!  pack_file_details(+Request)
 1365%
 1366%   HTTP handler to provide details on a file in a pack
 1367
 1368pack_file_details(Request) :-
 1369    memberchk(path_info(SlashPackAndFile), Request),
 1370    \+ sub_atom(SlashPackAndFile, _, _, _, '/../'),
 1371    !,
 1372    http_parameters(Request,
 1373                    [ public_only(Public),
 1374                      show(Show)
 1375                    ],
 1376                    [ attribute_declarations(pldoc_http:param)
 1377                    ]),
 1378    atom_concat(/, PackAndFile, SlashPackAndFile),
 1379    sub_atom(PackAndFile, B, _, A, /),
 1380    !,
 1381    sub_atom(PackAndFile, 0, B, _, Pack),
 1382    sub_atom(PackAndFile, _, A, 0, File),
 1383    pack_file_details(Pack, File,
 1384                      [ public_only(Public),
 1385                        show(Show)
 1386                      ]).
 1387
 1388
 1389                 /*******************************
 1390                 *        DB MAINTENANCE        *
 1391                 *******************************/
 1392
 1393%!  atom_version(?Atom, ?Version)
 1394%
 1395%   Translate   between   atomic   version   representation   and   term
 1396%   representation.  The  term  representation  is  a  list  of  version
 1397%   components as integers and can be compared using `@>`
 1398
 1399atom_version(Atom, version(Parts)) :-
 1400    (   atom(Atom)
 1401    ->  split_string(Atom, ".", "", Parts0),
 1402        maplist(valid_version_part, Parts0, Parts)
 1403    ;   atomic_list_concat(Parts, '.', Atom)
 1404    ).
 1405
 1406valid_version_part(String, Num) :-
 1407    number_string(Num, String),
 1408    !.
 1409valid_version_part("*", _).
 1410
 1411                 /*******************************
 1412                 *          MESSAGES            *
 1413                 *******************************/
 1414
 1415:- multifile prolog:message//1. 1416
 1417prolog:message(delete_pack(Pack)) -->
 1418    [ 'Deleted pack ~p'-[Pack] ].
 1419prolog:message(delete_hash(Hash)) -->
 1420    [ 'Deleted hash ~p'-[Hash] ]