pack.pl

View source with raw comments or as raw

    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,   []).

pack_query(+Request): Handle package query requests from remote installers. Content is of type application/x-prolog. Reply is also a Prolog term.

   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').

proxy_master(Request): Proxy the request to the master to make sure the central package database remains synchronised.

  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          ]).

pack_query(+Query, +Peer, -Reply) is det

Implements the various queries from the pack_install/1. Currently defined Query values are:

install(+URL, +SHA1, +Info): User tries to install from URL an object with the indicated hash and Info.
downloaded(+Data): Register download for indicated Data
locate(+Pack): Query download locations for Pack.
versions(+Packs, +Options): Query download and versions for a set of packs and all (recursive) dependencies.
search(+Keyword): Find packs that match Keyword.
info(+Packs): Return a list of meta-data terms for the latest version of Packs. Unknown packs are omitted from the result list.

  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).

pack_admin(+Pack)//: Display pack admin options

  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)).

pack_delete(+Request): HTTP handler to delete a pack

  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                 *******************************/

install_info(+URL, +SHA1, -Info) is nondet

Info is relevant information for the client who whishes to install URL, which has the given SHA1 hash. Currently provided info is:

alt_hash(Downloads, URLs, Hash): Another file with the same (base) name was registered that has a different hash. This file was downloaded Downloads times, resides on the given URLs (a list) and has the given Hash.
downloads(Downloads): This hash was downloaded Downloads times from a unique IP address
dependency(Token, Pack, Version, URLs, SubSeps): The requirement Token can be provided by Pack@Version, which may be downloaded from the given URLs (a list). Pack has install info as specified by SubSeps (recursive dependencies)

  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    ).

is_prolog_token(+Token) is semidet

To be done: - : share with library(pack_install).

  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    ).

pack_version_hashes(+Pack, -VersionHashesPairs) is semidet: True when HashesByVersion is an ordered list Version-Hashes, latest version first.

  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).

pack_version_urls_v1(+Pack, -Locations) is det

True when Locations is a set of Version-list(URL) pairs used for installing Pack.

Arguments:

Locations

- is a list Version-URLs, sorted latest version first.

See also

- pack_version_urls_v2/3

  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).

pack_versions(+Packs, -PackVersions, +Options) is det

Given a single or multiple packs, return information on all these packs as well as their dependencies. PackVersions is a list of Pack-Versions. Versions is a list of Version-InfoList. InfoList is a list of dicts, each holding

info.pack: Pack name
info.hash: Hash of the version. This is either a GIT hash or the sha1 of the archive file.
info.provides: List of provided tokens. Each provide is either a simple token or a term @(Token,Version).
info.requires: List of required tokens. Each requirement is either a simple token or a term `Token cmp Version`, where cmp is one of <, =<, =, >= or >.
info.conflicts: Similar to info.requires, declaring conflicts
info.url: URL for downloading the archive or URL of the git repo.
info.git: Boolean expressing wether the URL is a git repo or archive.
info.downloads: Download count.

  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).

search_packs(+Search, -Packs) is det

Search packs by keyword, returning a list

pack(Pack, Status, Version, Title, URLs).

  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.

delete_pack(+PackName) is det: Remove a pack from the database.

  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).

delete_hash(Hash) is det: Remove Hash from the database

  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)).

save_request(+Peer, +Data, -Result): Update the database with the given information. We only update if the request is new, which means the same SHA1 has not been downloaded from the same Peer.

  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).

accept_url(+URL, +Pack, +IsGit) is det: True when URL is an aceptable URL for Pack. We only register this on the first submission of a pack.

  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))).

set_allowed_url(+Request): Set the URL pattern for a pack.

  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).

register_pack(+SHA1, +Pack) is det

  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    ).

register_url(+SHA1, +IsGIT, +URL) is det: Register we have that data loaded from URL has signature SHA1.

  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    ).

is_github_release(+URL) is semidet: True when URL reflects a GitHub release pack download. These have the unpeleasant habbit to change exact content.

  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    ).

hash_git_url(+SHA1, -GitURL) is semidet: True when SHA1 was installed using GIT from GitURL.

  864hash_git_url(SHA1, GitURL) :-
  865    sha1_info(SHA1, Info),
  866    memberchk(git(true), Info),
  867    !,
  868    sha1_url(SHA1, GitURL).

hash_file_url(+SHA1, -FileURL) is nondet: True when SHA1 was installed using GIT from GitURL.

  874hash_file_url(SHA1, FileURL) :-
  875    sha1_info(SHA1, Info),
  876    \+ memberchk(git(true), Info),
  877    !,
  878    sha1_url(SHA1, FileURL).

pack_url_hash(?URL, ?Hash) is nondet: True when Hash is the registered hash for URL.

  884pack_url_hash(URL, Hash) :-
  885    sha1_url(Hash, URL).

pack(?Pack) is nondet: True when Pack is a currently known pack.

  891pack(Pack) :-
  892    findall(Pack, sha1_pack(_,Pack), Packs),
  893    sort(Packs, Sorted),
  894    member(Pack, Sorted).
  895
  896
  897                 /*******************************
  898                 *           USER API           *
  899                 *******************************/

pack_list(+Request): List available packages.

  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).

pack_table(+Packs, +Options)// is det: Show a table of packs.

  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

current_pack(+Filter:list, -Pack) is nondet

True when Pack is a pack that satisfies Filter. Filter is a list of filter expressions. Currently defined filters are:

author(+Author): Pack is claimed by this author.

 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    ).

sort_packs(+Field, +Packs, -Sorted)

 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).

pack_latest_version(+Pack, -SHA1, -Version, -OlderCount): True when SHA1 is the latest version of Pack at the given Version and there are OlderCount older versions.

 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                 *******************************/

pack_info(+Pack)//

Provided detailed information about a package.

To be done: - provide many more details; - Show dependency for requirements/provides

 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    ).

pack_info_table(+Pack)// is det: Provide basic information on the package

 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    ).

pack_file_table(+Pack)// is det: Provide a table with the files, sorted by version, providing statistics on downloads.

 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).

pack_file_details(+Request): HTTP handler to provide details on a file in a pack

 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                 *******************************/

atom_version(?Atom, ?Version): Translate between atomic version representation and term representation. The term representation is a list of version components as integers and can be compared using @>

 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] ]