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