1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@cs.vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2013-2018, VU University Amsterdam
    7
    8    This program is free software; you can redistribute it and/or
    9    modify it under the terms of the GNU General Public License
   10    as published by the Free Software Foundation; either version 2
   11    of the License, or (at your option) any later version.
   12
   13    This program is distributed in the hope that it will be useful,
   14    but WITHOUT ANY WARRANTY; without even the implied warranty of
   15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   16    GNU General Public License for more details.
   17
   18    You should have received a copy of the GNU General Public
   19    License along with this library; if not, write to the Free Software
   20    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   21
   22    As a special exception, if you link this library with other files,
   23    compiled with a Free Software compiler, to produce an executable, this
   24    library does not by itself cause the resulting executable to be covered
   25    by the GNU General Public License. This exception does not however
   26    invalidate any other reasons why the executable file might be covered by
   27    the GNU General Public License.
   28*/
   29
   30:- module(pack,
   31	  [ pack/1,			% ?Pack
   32	    pack_version_hashes/2,	% +Pack, -VersionHashesPairs
   33	    pack_version_urls/2,	% +Pack, -VersionUrlPairs
   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
   60:- use_module(pack_info).   61:- use_module(pack_mirror).   62:- use_module(review).   63:- use_module(messages).   64:- use_module(openid).   65:- use_module(proxy).   66:- use_module(parms).   67
   68:- http_handler(root(pack/query),	 pack_query,	    []).   69:- http_handler(root(pack/list),	 pack_list,	    []).   70:- http_handler(root(pack/file_details), pack_file_details,
   71		[prefix, time_limit(20)]).   72:- http_handler(root(pack/delete),       pack_delete,       []).   73:- http_handler(root(pack/pattern),	 set_allowed_url,   []).   74
   75%%	pack_query(+Request)
   76%
   77%	Handle package query requests from remote installers.  Content
   78%	is of type application/x-prolog.   Reply is also a Prolog term.
   79
   80pack_query(Request) :-
   81	proxy_master(Request), !.
   82pack_query(Request) :-
   83	memberchk(content_type(ContentType), Request),
   84	content_x_prolog(ContentType, ReplyType), !,
   85	http_peer(Request, Peer),
   86	http_read_data(Request, Query,
   87		       [ content_type('application/x-prolog')
   88		       ]),
   89	http_log('pack_query(~q, ~q).~n', [Query, Peer]),
   90	format('Cache-Control: private~n'),
   91	(   catch(pack_query(Query, Peer, Reply), E, true)
   92	->  format('Content-type: ~w; charset=UTF-8~n~n', [ReplyType]),
   93	    (   var(E)
   94	    ->	format('~q.~n', [true(Reply)]),
   95		http_log('pack_query_done(ok, ~q).~n', [Peer])
   96	    ;	format('~q.~n', [exception(E)]),
   97		message_to_string(E, String),
   98		http_log('pack_query_done(error(~q), ~q).~n', [String, Peer])
   99	    )
  100	;   format('Content-type: ~w; charset=UTF-8~n~n', [ReplyType]),
  101	    format('false.~n'),
  102	    http_log('pack_query_done(failed, ~q).~n', [Peer])
  103	).
  104
  105content_x_prolog(ContentType, 'text/x-prolog') :-
  106	sub_atom(ContentType, 0, _, _, 'text/x-prolog'), !.
  107content_x_prolog(ContentType, 'application/x-prolog') :-
  108	sub_atom(ContentType, 0, _, _, 'application/x-prolog').
  109
  110%%	proxy_master(Request)
  111%
  112%	Proxy the request to the master to make sure the central package
  113%	database remains synchronised.
  114
  115proxy_master(Request) :-
  116	option(host(Host), Request),
  117	server(Role, Host),
  118	Role \== master,
  119	server(master, Master),
  120	Master \== Host, !,
  121	http_peer(Request, Peer),
  122	format(string(To), 'http://~w', [Master]),
  123	proxy(To, Request,
  124	      [ request_headers([ 'X-Forwarded-For' = Peer,
  125				  'X-Real-IP' = Peer,
  126				  'Cache-Control' = 'no-cache'
  127				])
  128	      ]).
  129
  130
  131%%	pack_query(+Query, +Peer, -Reply)
  132%
  133%	Implements  the  various  queries    from   the  pack_install/1.
  134%	Currently defined Query values are:
  135%
  136%	  * install(+URL, +SHA1, +Info)
  137%	  User tries to install from URL an object with the indicated
  138%	  hash and Info.
  139%	  * locate(+Pack)
  140%	  Query download locations for Pack.  Same as
  141%	  locate(archive, Pack).
  142%	  * search(+Keyword)
  143%	  Find packs that match Keyword.
  144
  145pack_query(install(URL0, SHA10, Info), Peer, Reply) :-
  146	to_atom(URL0, URL),
  147	to_atom(SHA10, SHA1),
  148	with_mutex(pack, save_request(URL, SHA1, Info, Peer)),
  149	findall(ReplyInfo, install_info(URL, SHA1, ReplyInfo, []), Reply).
  150pack_query(locate(Pack), _, Reply) :-
  151	pack_version_urls(Pack, Reply).
  152pack_query(search(Word), _, Reply) :-
  153	search_packs(Word, Reply).
  154
  155to_atom(Atom, Atom) :-
  156	atom(Atom), !.
  157to_atom(String, Atom) :-
  158	atom_string(Atom, String).
  159
  160%%	pack_delete(+Request)
  161%
  162%	HTTP handler to delete a pack
  163
  164pack_delete(Request) :-
  165	site_user_logged_in(User),
  166	site_user_property(User, granted(admin)), !,
  167	http_parameters(Request,
  168			[ p(Pack, [optional(true)]),
  169			  h(Hash, [optional(true)])
  170			], []),
  171	(   nonvar(Pack)
  172	->  call_showing_messages(delete_pack(Pack), [])
  173	;   nonvar(Hash)
  174	->  call_showing_messages(delete_hash(Hash), [])
  175	).
  176pack_delete(Request) :-
  177	memberchk(path(Path), Request),
  178	throw(http_reply(forbidden(Path))).
  179
  180		 /*******************************
  181		 *	COMPUTATIONAL LOGIC	*
  182		 *******************************/
  183
  184%%	install_info(+URL, +SHA1, -Info, +Seen) is nondet.
  185%
  186%	Info is relevant information  for  the   client  who  whishes to
  187%	install URL, which has the given   SHA1 hash. Currently provided
  188%	info is:
  189%
  190%	  - alt_hash(Downloads, URLs, Hash)
  191%	    Another file with the same (base) name was registered that
  192%	    has a different hash.  This file was downloaded Downloads
  193%	    times, resides on the given URLs (a list) and has the given
  194%	    Hash.
  195%	  - downloads(Downloads)
  196%	    This hash was downloaded Downloads times from a unique IP
  197%	    address
  198%	  - dependency(Token, Pack, Version, URLs, SubSeps)
  199%	    The requirement Token can be provided by Pack@Version, which
  200%	    may be downloaded from the given URLs (a list).  Pack has
  201%	    install info as specified by SubSeps (recursive
  202%	    dependencies)
  203
  204install_info(_, SHA1, _, Seen) :-
  205	memberchk(SHA1, Seen), !, fail.
  206install_info(URL, SHA1, alt_hash(Downloads, URLs, Hash), _) :-
  207	pack_url_file(URL, File),
  208	sha1_file(Hash, File),
  209	Hash \== SHA1,
  210	\+ is_github_release(URL),
  211	sha1_downloads(Hash, Downloads),
  212	sha1_urls(Hash, URLs).
  213install_info(_, SHA1, downloads(Count), _) :-
  214	sha1_downloads(SHA1, Count).
  215install_info(_, SHA1, dependency(Token, Pack, Version, URLs, SubDeps), Seen) :-
  216	sha1_requires(SHA1, Token),
  217	(   (   sha1_pack(_Hash, Token),
  218		Pack = Token
  219	    ;	sha1_provides(Hash, Token),
  220		sha1_pack(Hash, Pack),
  221		Pack \== Token
  222	    ),
  223	    pack_latest_version(Pack, Hash1, _VersionTerm, _Older),
  224	    sha1_info(Hash1, Info),
  225	    memberchk(version(Version), Info),
  226	    findall(URL, sha1_url(Hash1, URL), URLs),
  227	    URLs \== []
  228	->  findall(SubDep, install_info(-, Hash1, SubDep, [SHA1|Seen]), SubDeps)
  229	;   Pack = (-), Version = (-), URLs = []
  230	).
  231
  232sha1_downloads(Hash, Count) :-
  233	aggregate_all(count, sha1_download(Hash, _), Count).
  234
  235sha1_urls(Hash, URLs) :-
  236	findall(URL, sha1_url(Hash, URL), URLs).
  237
  238sha1_version(Hash, Version) :-
  239	sha1_info(Hash, Info),
  240	memberchk(version(Atom), Info),
  241	prolog_pack:atom_version(Atom, Version).
  242
  243sha1_title(Hash, Title) :-
  244	sha1_info(Hash, Info),
  245	(   memberchk(title(Title), Info)
  246	->  true
  247	;   Title = '<no title>'
  248	).
  249
  250%%	pack_version_hashes(+Pack, -VersionHashesPairs) is semidet.
  251%
  252%	True when HashesByVersion is  an   ordered  list Version-Hashes,
  253%	latest version first.
  254
  255pack_version_hashes(Pack, VersionAHashesPairs) :-
  256	setof(SHA1, sha1_pack(SHA1, Pack), Hashes),
  257	map_list_to_pairs(sha1_version, Hashes, VersionHashPairs),
  258	keysort(VersionHashPairs, Sorted),
  259	group_pairs_by_key(Sorted, VersionHashesPairs),
  260	reverse(VersionHashesPairs, RevPairs),
  261	maplist(atomic_version_hashes, RevPairs, VersionAHashesPairs).
  262
  263atomic_version_hashes(Version-Hashes, VersionA-Hashes) :-
  264	prolog_pack:atom_version(VersionA, Version).
  265
  266%%	pack_version_urls(+Pack, -Locations) is nondet.
  267%
  268%	True when Locations is a set of Version-list(URL) pairs used for
  269%	installing Pack.
  270%
  271%	@param	Locations is a list Version-URLs, sorted latest version
  272%		first.
  273%	@tbd	Handle versions with multiple hashes!
  274
  275pack_version_urls(Pack, VersionURLs) :-
  276	pack_version_hashes(Pack, VersionHashes),
  277	maplist(version_hashes_urls, VersionHashes, VersionURLs).
  278
  279version_hashes_urls(Version-Hashes, Version-URLs) :-
  280	maplist(sha1_url, Hashes, URLs0),
  281	sort(URLs0, URLs).
  282
  283
  284%%	search_packs(+Search, -Packs) is det.
  285%
  286%	Search packs by keyword, returning a list
  287%
  288%		pack(Pack, Status, Version, Title, URLs).
  289
  290search_packs(Search, Packs) :-
  291	setof(Pack, matching_pack(Search, Pack), Names), !,
  292	maplist(pack_search_result, Names, Packs).
  293
  294matching_pack(Search, Pack) :-
  295	sha1_pack(SHA1, Pack),
  296	(   '$apropos_match'(Search, Pack)
  297	->  true
  298	;   sha1_title(SHA1, Title),
  299	    '$apropos_match'(Search, Title)
  300	).
  301
  302pack_search_result(Pack, pack(Pack, p, Title, VersionA, URLs)) :-
  303	pack_latest_version(Pack, SHA1, Version, _Older),
  304	sha1_title(SHA1, Title),
  305	prolog_pack:atom_version(VersionA, Version),
  306	findall(URL, sha1_url(SHA1, URL), URLs).
  307
  308
  309		 /*******************************
  310		 *	     DATABASE		*
  311		 *******************************/
  312
  313:- multifile error:has_type/2.  314
  315error:has_type(dependency, Value) :-
  316    is_dependency(Value, _Token, _Version).
  317
  318is_dependency(Token, Token, *) :-
  319    atom(Token).
  320is_dependency(Term, Token, VersionCmp) :-
  321    Term =.. [Op,Token,Version],
  322    cmp(Op, _),
  323    version_data(Version, _),
  324    VersionCmp =.. [Op,Version].
  325
  326cmp(<,  @<).
  327cmp(=<, @=<).
  328cmp(==, ==).
  329cmp(>=, @>=).
  330cmp(>,  @>).
  331
  332version_data(Version, version(Data)) :-
  333    atomic_list_concat(Parts, '.', Version),
  334    maplist(atom_number, Parts, Data).
  335
  336:- persistent
  337	sha1_pack(sha1:atom, pack:atom),
  338	sha1_file(sha1:atom, file:atom),
  339	sha1_requires(sha1:atom, token:dependency),
  340	sha1_provides(sha1:atom, token:dependency),
  341	sha1_info(sha1:atom, info:list),
  342	sha1_url(sha1:atom, url:atom),
  343	sha1_download(sha1:atom, peer:atom),
  344	pack_allowed_url(pack:atom, isgit:boolean, pattern:atom).  345
  346:- initialization
  347	db_attach('packs.db', [sync(close)]),
  348	populate_pack_url_patterns.  349
  350%%	delete_pack(+PackName) is det.
  351%
  352%	Remove a pack from the database.
  353
  354delete_pack(PackName) :-
  355	must_be(atom, PackName),
  356	pack(PackName), !,
  357	clean_pack_info(PackName),
  358	pack_unmirror(PackName),
  359	forall(sha1_pack(Hash, PackName),
  360	       delete_hash(Hash)),
  361	retractall_pack_allowed_url(PackName,_,_).
  362delete_pack(PackName) :-
  363	existence_error(pack, PackName).
  364
  365%%	delete_hash(Hash) is det.
  366%
  367%	Remove Hash from the database
  368
  369delete_hash(Hash) :-
  370	retractall_sha1_pack(Hash, _),
  371	retractall_sha1_file(Hash, _),
  372	retractall_sha1_requires(Hash, _),
  373	retractall_sha1_provides(Hash, _),
  374	retractall_sha1_info(Hash, _),
  375	retractall_sha1_url(Hash, _),
  376	retractall_sha1_download(Hash, _).
  377
  378%%	save_request(+URL, +SHA1, +Info, +Peer)
  379%
  380%	Update the database with the given   information. We only update
  381%	if the request is new, which means   the  same SHA1 has not been
  382%	downloaded from the same Peer.
  383
  384save_request(URL, SHA1, Info, Peer) :-
  385	sha1_download(SHA1, Peer),
  386	sha1_pack(SHA1, Peer), !,		% already downloaded from here
  387	info_is_git(Info, IsGIT),
  388	register_url(SHA1, IsGIT, URL).		% but maybe from a different URL
  389save_request(URL, SHA1, Info, Peer) :-
  390	memberchk(name(Pack), Info),
  391	info_is_git(Info, IsGIT),
  392	(   accept_url(URL, Pack, IsGIT)
  393	->  register_url(SHA1, IsGIT, URL),
  394	    register_pack(SHA1, Pack),
  395	    register_info(SHA1, Info)
  396	;   permission_error(register, pack(Pack), URL)
  397	),
  398	assert_sha1_download(SHA1, Peer).
  399
  400info_is_git(Info, IsGIT) :-
  401	memberchk(git(IsGIT), Info), !.
  402info_is_git(_, false).
  403
  404%!	accept_url(+URL, +Pack, +IsGit) is det.
  405%
  406%	True when URL is an aceptable URL for Pack.  We only
  407%	register this on the first submission of a pack.
  408
  409accept_url(URL, Pack, IsGIT) :-
  410	(   pack_allowed_url(Pack, _, Pattern)
  411	*-> wildcard_match(Pattern, URL), !
  412	;   admissible_url(URL)
  413	->  url_pattern(URL, IsGIT, Pattern),
  414	    assert_pack_allowed_url(Pack, IsGIT, Pattern)
  415	).
  416
  417admissible_url(URL) :-
  418	uri_components(URL, Components),
  419	uri_data(scheme, Components, Scheme),
  420	uri_data(authority, Components, Authority),
  421	uri_authority_components(Authority, AuthComponents),
  422	uri_authority_data(host, AuthComponents, Host),
  423	uri_authority_data(port, AuthComponents, Port),
  424	\+ nonadmissible_host(Host),
  425	admissible_scheme(Scheme, Port).
  426
  427nonadmissible_host(localhost).
  428nonadmissible_host(IP) :-
  429	split_string(IP, ".", "", Parts),
  430	maplist(number_string, _, Parts).
  431
  432admissible_scheme(http, 80).
  433admissible_scheme(https, 443).
  434
  435url_pattern(URL, true, URL) :- !.
  436url_pattern(URL, false, Pattern) :-
  437	site_pattern(URL, Pattern), !.
  438url_pattern(URL, false, Pattern) :-
  439	(   atom_concat('http://', Rest, URL)
  440	->  atom_concat('http{,s}://', Rest, URL2)
  441	;   URL2 = URL
  442	),
  443	file_directory_name(URL2, Dir),
  444	atom_concat(Dir, '/*', Pattern).
  445
  446site_pattern(URL, Pattern) :-
  447	sub_atom(URL, 0, _, _, 'https://gitlab.com/'),
  448	git_user_project_pattern(URL, Pattern).
  449site_pattern(URL, Pattern) :-
  450	sub_atom(URL, 0, _, _, 'https://github.com/'),
  451	git_user_project_pattern(URL, Pattern).
  452
  453git_user_project_pattern(URL, Pattern) :-
  454	uri_components(URL, Components),
  455	uri_data(path, Components, Path0),
  456	split_string(Path0, "/", "/", [User,Project|_]),
  457	atomic_list_concat([/, User, /, Project, /, *], Path),
  458	uri_data(path, Components, Path, Components1),
  459	uri_components(Pattern, Components1).
  460
  461populate_pack_url_patterns :-
  462	forall(pack(Pack),
  463	       populate_pack_url_pattern(Pack)).
  464
  465populate_pack_url_pattern(Pack) :-
  466	pack_allowed_url(Pack, _, _), !.
  467populate_pack_url_pattern(Pack) :-
  468	findall(URL-IsGIT,
  469		( sha1_pack(SHA1, Pack),
  470		  sha1_info(SHA1, Info),
  471		  (   memberchk(git(IsGIT), Info)
  472		  ->  true
  473		  ;   IsGIT = false
  474		  ),
  475		  sha1_url(SHA1, URL)
  476		),
  477		URLS),
  478	last(URLS, URL-IsGIT),
  479	url_pattern(URL, IsGIT, Pattern),
  480	assert_pack_allowed_url(Pack, IsGIT, Pattern), !.
  481populate_pack_url_pattern(Pack) :-
  482	print_message(error, pack(pattern_failed(Pack))).
  483
  484%!	set_allowed_url(+Request)
  485%
  486%	Set the URL pattern for a pack.
  487
  488set_allowed_url(Request) :-
  489	site_user_logged_in(User),
  490	site_user_property(User, granted(admin)), !,
  491	http_parameters(Request,
  492			[ p(Pack, []),
  493			  url(Pattern, []),
  494			  git(IsGit, [boolean, optional(true)])
  495			], []),
  496	call_showing_messages(set_allowed_url(Pack, IsGit, Pattern), []).
  497set_allowed_url(Request) :-
  498	memberchk(path(Path), Request),
  499	throw(http_reply(forbidden(Path))).
  500
  501set_allowed_url(Pack, _IsGit, _Pattern) :-
  502	\+ sha1_pack(_, Pack),
  503	!,
  504	existence_error(pack, Pack).
  505set_allowed_url(Pack, IsGit, Pattern) :-
  506	(   var(IsGit)
  507	->  (   sub_atom(Pattern, _, _, _, *)
  508	    ->	IsGit = false
  509	    ;	IsGit = true
  510	    )
  511	;   true
  512	),
  513	retractall_pack_allowed_url(Pack, _, _),
  514	assert_pack_allowed_url(Pack, IsGit, Pattern).
  515
  516%!	register_pack(+SHA1, +Pack) is det.
  517
  518register_pack(SHA1, Pack) :-
  519	(   sha1_pack(SHA1, Pack)
  520	->  true
  521	;   assert_sha1_pack(SHA1, Pack)
  522	).
  523
  524register_info(SHA1, Info0) :-
  525	sort(Info0, Info),
  526	(   sha1_info(SHA1, _Info)
  527	->  true
  528	;   assert_sha1_info(SHA1, Info),
  529	    forall(member(requires(Token), Info),
  530		   register_requires(SHA1, Token)),
  531	    forall(member(provides(Token), Info),
  532		   register_provides(SHA1, Token))
  533	).
  534
  535register_requires(SHA1, Token) :-
  536	(   sha1_requires(SHA1, Token)
  537	->  true
  538	;   assert_sha1_requires(SHA1, Token)
  539	).
  540
  541register_provides(SHA1, Token) :-
  542	(   sha1_provides(SHA1, Token)
  543	->  true
  544	;   assert_sha1_provides(SHA1, Token)
  545	).
  546
  547%!	register_url(+SHA1, +IsGIT, +URL) is det.
  548%
  549%	Register we have that data loaded from URL has signature SHA1.
  550
  551:- debug(pack(changed)).  552
  553register_url(SHA1, IsGIT, URL) :-
  554	(   sha1_url(SHA1, URL)
  555	->  true
  556	;   sha1_url(SHA2, URL),
  557	    \+ ( IsGIT == true,
  558		 hash_git_url(SHA2, URL)
  559	       ),
  560	    (	debug(pack(changed), '~p seems changed', [URL]),
  561		is_github_release(URL)
  562	    ->	debug(pack(changed), 'From github: ~p', [URL]),
  563		retractall_sha1_url(SHA1, URL),
  564		fail
  565	    ;	true
  566	    )
  567	->  throw(pack(modified_hash(SHA1-URL, SHA2-[URL])))
  568	;   IsGIT == true
  569	->  assert_sha1_url(SHA1, URL)
  570	;   pack_url_file(URL, File),
  571	    register_file(SHA1, File, URL),
  572	    assert_sha1_url(SHA1, URL)
  573	).
  574
  575%!	is_github_release(+URL) is semidet.
  576%
  577%	True when URL reflects a  GitHub   release  pack download. These
  578%	have the unpeleasant habbit to change exact content.
  579
  580is_github_release(URL) :-
  581	uri_components(URL, Components),
  582	uri_data(scheme, Components, Scheme), Scheme == https,
  583	uri_data(authority, Components, Auth), Auth == 'github.com',
  584	uri_data(path, Components, Path), atomic(Path),
  585	split_string(Path, "/", "", ["", _User, _Repo, "archive", Zip]),
  586	file_name_extension(_, Ext, Zip),
  587	github_archive_extension(Ext).
  588
  589github_archive_extension(tgz).
  590github_archive_extension(zip).
  591
  592register_file(SHA1, File, URL) :-
  593	(   sha1_file(SHA1, File)
  594	->  true
  595	;   sha1_file(SHA2, File),
  596	    sha1_urls(SHA2, URLs),
  597	    (	maplist(is_github_release, [URL|URLs])
  598	    ->	retractall_sha1_file(SHA1, File),
  599		fail
  600	    ;	true
  601	    )
  602	->  throw(pack(modified_hash(SHA1-URL, SHA2-URLs)))
  603	;   assert_sha1_file(SHA1, File)
  604	).
  605
  606%%	hash_git_url(+SHA1, -GitURL) is semidet.
  607%
  608%	True when SHA1 was installed using GIT from GitURL.
  609
  610hash_git_url(SHA1, GitURL) :-
  611	sha1_info(SHA1, Info),
  612	memberchk(git(true), Info), !,
  613	sha1_url(SHA1, GitURL).
  614
  615%%	hash_file_url(+SHA1, -FileURL) is nondet.
  616%
  617%	True when SHA1 was installed using GIT from GitURL.
  618
  619hash_file_url(SHA1, FileURL) :-
  620	sha1_info(SHA1, Info),
  621	\+ memberchk(git(true), Info), !,
  622	sha1_url(SHA1, FileURL).
  623
  624%%	pack_url_hash(?URL, ?Hash) is nondet.
  625%
  626%	True when Hash is the registered hash for URL.
  627
  628pack_url_hash(URL, Hash) :-
  629	sha1_url(Hash, URL).
  630
  631%%	pack(?Pack) is nondet.
  632%
  633%	True when Pack is a currently known pack.
  634
  635pack(Pack) :-
  636	findall(Pack, sha1_pack(_,Pack), Packs),
  637	sort(Packs, Sorted),
  638	member(Pack, Sorted).
  639
  640
  641		 /*******************************
  642		 *	     USER API		*
  643		 *******************************/
  644
  645%%	pack_list(+Request)
  646%
  647%	List available packages.
  648
  649pack_list(Request) :-
  650	http_parameters(Request,
  651			[ p(Pack, [optional(true)]),
  652			  author(Author, [optional(true)]),
  653			  sort(Sort, [ oneof([name,downloads,rating]),
  654				       optional(true),
  655				       default(name)
  656				     ])
  657			]),
  658        (  ground(Pack)
  659        -> format(atom(Title), '"~w" pack for SWI-Prolog', [Pack])
  660        ;  Title = 'SWI-Prolog packages'
  661        ),
  662	reply_html_page(pack(list),
  663			title(Title),
  664			[ \pack_listing(Pack, Author, Sort)
  665			]).
  666
  667pack_listing(Pack, _Author, _Sort) -->
  668	{ ground(Pack) }, !,
  669	html([ h1(class(wiki), 'Package "~w"'-[Pack]),
  670	       \html_requires(css('pack.css')),
  671	       \pack_info(Pack)
  672	     ]).
  673pack_listing(_Pack, Author, SortBy) -->
  674	{ (   nonvar(Author)
  675	  ->  Filter = [author(Author)]
  676	  ;   Filter = []
  677	  ),
  678	  (   setof(Pack, current_pack(Filter, Pack), Packs)
  679	  ->  true
  680	  ;   Packs = []
  681	  ),
  682	  sort_packs(SortBy, Packs, Sorted)
  683	},
  684	html({|html||
  685<p>
  686Below is a list of known packages. Please be aware that packages are
  687<b>not moderated</b>. Installing a pack does not execute code in the
  688pack, but simply loading a library from the pack may execute arbitrary
  689code. More information about packages is available <a
  690href="/howto/Pack.html">here</a>.   You can search for packages from
  691the Prolog command line using pack_list/1.  This contacts the pack
  692server for packs that match by name or title.  A leading <b>i</b>
  693indicates that the pack is already installed, while <b>p</b> merely
  694indicates that it is known by the server.
  695</p>
  696
  697<pre class="code">
  698?- pack_list(graph).
  699p callgraph@0.3.4           - Predicate call graph visualisation
  700i graphml@0.1.0             - Write GraphML files
  701i gvterm@1.1                - Show Prolog terms using graphviz
  702p musicbrainz@0.6.3         - Musicbrainz client library
  703p sindice@0.0.3             - Access to Sindice semantic web search engine
  704</pre>
  705
  706<p>
  707After finding the right pack, the pack and its dependencies can be installed
  708using the pack_install/1 as illustrated below.
  709</p>
  710
  711<pre class="code">
  712?- pack_install(hello).
  713</pre>
  714
  715<p>
  716Clicking the package shows details and allows you to rate and comment
  717the pack.
  718</p>
  719	     |}),
  720	pack_table(Sorted, [sort_by(SortBy)]),
  721	html_receive(rating_scripts).
  722
  723%%	pack_table(+Packs, +Options)// is det.
  724%
  725%	Show a table of packs.
  726
  727pack_table(Packs, Options) -->
  728	{ option(sort_by(SortBy), Options, -),
  729	  length(Packs, PackCount),
  730	  maplist(pack_downloads, Packs, Totals),
  731	  sum_list(Totals, Total)
  732	},
  733	html_requires(css('pack.css')),
  734	html(table(class(packlist),
  735		   [ tr([ \pack_header(name,  SortBy,
  736				       'Pack', ['tot: ~D'-[PackCount]]),
  737			  \pack_header(version, SortBy,
  738				       'Version', '(#older)'),
  739			  \pack_header(downloads, SortBy,
  740				       'Downloads', ['tot: ~D'-[Total],
  741						     br([]), '(#latest)']),
  742			  \pack_header(rating, SortBy,
  743				       'Rating', ['(#votes/', br([]),
  744						  '#comments)']),
  745			  \pack_header(title, SortBy,
  746				       'Title', [])
  747			])
  748		   | \pack_rows(Packs)
  749		   ])).
  750
  751
  752pack_rows([]) --> [].
  753pack_rows([H|T]) --> pack_row(H), pack_rows(T).
  754
  755pack_row(Pack) -->
  756	{ pack_name(Pack, Name),
  757	  http_link_to_id(pack_list, [p(Name)], HREF)
  758	},
  759	html(tr([ td(a(href(HREF),Name)),
  760		  td(class('pack-version'),   \pack_version(Pack)),
  761		  td(class('pack-downloads'), \pack_downloads(Pack)),
  762		  td(class('pack-rating'),    \pack_rating(Pack)),
  763		  td(class('pack-title'),     \pack_title(Pack))
  764		])).
  765
  766pack_header(Name, -, Title, Subtitle) --> !,
  767	html(th(id(Name), [Title, \subtitle(Subtitle)])).
  768pack_header(Name, SortBy, Title, Subtitle) -->
  769	{ Name \== SortBy,
  770	  sortable(Name), !,
  771	  http_link_to_id(pack_list, [sort(Name)], HREF)
  772	},
  773	html(th(id(Name), [ a([class(resort),href(HREF)], Title),
  774			    \subtitle(Subtitle)
  775			  ])).
  776pack_header(Name, Name, Title, Subtitle) -->
  777	html(th(id(Name), [i(class(sorted), Title), \subtitle(Subtitle)])).
  778pack_header(Name, _, Title, Subtitle) -->
  779	html(th(id(Name), [Title, \subtitle(Subtitle)])).
  780
  781subtitle([]) --> [].
  782subtitle(Subtitle) --> html(div(class(sth), Subtitle)).
  783
  784
  785sortable(name).
  786sortable(downloads).
  787sortable(rating).
  788
  789pack_version(Pack) -->
  790	{ pack_version(Pack, Version),
  791	  pack_older_versions(Pack, Older),
  792	  prolog_pack:atom_version(Atom, Version)
  793	},
  794	(   { Older =\= 0 }
  795	->  html([Atom, span(class(annot), '~D'-[Older])])
  796	;   html(Atom)
  797	).
  798
  799pack_downloads(Pack) -->
  800	{ pack_downloads(Pack, Total),
  801	  pack_download_latest(Pack, DownLoadLatest)
  802	},
  803	(   { Total =:= DownLoadLatest }
  804	->  html('~D'-[Total])
  805	;   html(['~D'-[Total], span(class(annot), '~D'-[DownLoadLatest])])
  806	).
  807
  808pack_rating(Pack) -->
  809	{ pack_rating(Pack, Rating),
  810	  pack_votes(Pack, Votes),
  811	  pack_comments(Pack, CommentCount),
  812	  pack_name(Pack, Name),
  813	  http_link_to_id(pack_rating, [], OnRating)
  814	},
  815	show_pack_rating(Name, Rating, Votes, CommentCount,
  816			 [ on_rating(OnRating)
  817			 ]).
  818
  819pack_title(Pack) -->
  820	{ pack_hash(Pack, SHA1),
  821	  sha1_title(SHA1, Title)
  822	},
  823	html(Title).
  824
  825:- record
  826	pack(name:atom,				% Name of the pack
  827	     hash:atom,				% SHA1 of latest version
  828	     version:list(integer),		% Latest Version
  829	     older_versions:integer,		% # older versions
  830	     downloads:integer,			% Total downloads
  831	     download_latest:integer,		% # downloads latest version
  832	     rating:number,			% Average rating
  833	     votes:integer,			% Vote count
  834	     comments:integer).			% Comment count
  835
  836%%	current_pack(+Filter:list, -Pack) is nondet.
  837%
  838%	True when Pack is a pack that satisfies Filter. Filter is a list
  839%	of filter expressions. Currently defined filters are:
  840%
  841%	  * author(+Author)
  842%	  Pack is claimed by this author.
  843
  844current_pack(Filters,
  845	     pack(Pack, SHA1,
  846		  Version, OlderVersionCount,
  847		  Downloads, DLLatest,
  848		  Rating, Votes, CommentCount)) :-
  849	setof(Pack, H^sha1_pack(H,Pack), Packs),
  850	member(Pack, Packs),
  851	pack_latest_version(Pack, SHA1, Version, OlderVersionCount),
  852	maplist(pack_filter(SHA1), Filters),
  853	pack_downloads(Pack, SHA1, Downloads, DLLatest),
  854	pack_rating_votes(Pack, Rating, Votes),
  855	pack_comment_count(Pack, CommentCount).
  856
  857pack_filter(SHA1, author(Author)) :-
  858	sha1_info(SHA1, Info),
  859	member(author(Name, Contact), Info),
  860	once(author_match(Author, Name, Contact)).
  861
  862author_match(Author, Author, _).		% Specified author
  863author_match(Author, _, Author).		% Specified contact
  864author_match(UUID, Name, Contact) :-		% Specified UUID
  865	(   site_user_property(UUID, name(Name))
  866	;   site_user_property(UUID, email(Contact))
  867	;   site_user_property(UUID, home_url(Contact))
  868	).
  869
  870
  871%%	sort_packs(+Field, +Packs, -Sorted)
  872
  873sort_packs(By, Packs, Sorted) :-
  874	map_list_to_pairs(pack_data(By), Packs, Keyed),
  875	keysort(Keyed, KeySorted),
  876	pairs_values(KeySorted, Sorted0),
  877	reverse_sort(By, Sorted0, Sorted).
  878
  879reverse_sort(name, Packs, Packs) :- !.
  880reverse_sort(_, Packs, RevPacks) :-
  881	reverse(Packs, RevPacks).
  882
  883
  884pack_downloads(Pack, SHA1, Total, DownLoadLatest) :-
  885	setof(Hash, sha1_pack(Hash, Pack), Hashes),
  886	map_list_to_pairs(sha1_downloads, Hashes, Pairs),
  887	memberchk(DownLoadLatest-SHA1, Pairs),
  888	pairs_keys(Pairs, Counts),
  889	sum_list(Counts, Total).
  890
  891%%	pack_latest_version(+Pack, -SHA1, -Version, -OlderCount)
  892%
  893%	True when SHA1 is the  latest  version   of  Pack  at  the given
  894%	Version and there are OlderCount older versions.
  895
  896pack_latest_version(Pack, SHA1, Version, Older) :-
  897	setof(SHA1, sha1_pack(SHA1, Pack), Hashes),
  898	map_list_to_pairs(sha1_version, Hashes, Versions),
  899	keysort(Versions, Sorted),
  900	length(Sorted, Count),
  901	Older is Count - 1,
  902	last(Sorted, Version-SHA1).
  903
  904
  905		 /*******************************
  906		 *	  DETAILED INFO		*
  907		 *******************************/
  908
  909%%	pack_info(+Pack)//
  910%
  911%	Provided detailed information about a package.
  912%
  913%	@tbd	provide many more details
  914%	@tbd	Show dependency for requirements/provides
  915
  916pack_info(Pack) -->
  917	{ \+ pack(Pack) }, !,
  918	html(p(class(warning),
  919	       'Sorry, I know nothing about a pack named "~w"'-[Pack])).
  920pack_info(Pack) -->
  921	pack_info_table(Pack),
  922	pack_reviews(Pack),
  923	pack_file_table(Pack),
  924	( pack_readme(Pack) -> [] ; [] ),
  925	(   pack_file_hierarchy(Pack)
  926	->  []
  927	;   html(p(class(warning), 'Failed to process pack'))
  928	).
  929
  930%%	pack_info_table(+Pack)// is det.
  931%
  932%	Provide basic information on the package
  933
  934pack_info_table(Pack) -->
  935	{ pack_latest_version(Pack, SHA1, Version, _Older),
  936	  prolog_pack:atom_version(VersionA, Version),
  937	  sha1_title(SHA1, Title),
  938	  sha1_info(SHA1, Info)
  939	},
  940	html(table(class(pack),
  941		   [ \property('Title', span(class(title), Title)),
  942		     \property('Rating', \show_pack_rating(Pack)),
  943		     \property('Latest version', VersionA),
  944		     \property('SHA1 sum', \hash(SHA1)),
  945		     \info(author(_,_), Info),
  946		     \info(maintainer(_,_), Info),
  947		     \info(packager(_,_), Info),
  948		     \info(home(_), Info),
  949		     \info(download(_), Info),
  950		     \info(requires(_), Info),
  951		     \info(provides(_), Info),
  952		     \info(conflicts(_), Info)
  953		   ])).
  954
  955property(Label, Value) -->
  956	html(tr([th([Label, :]), td(Value)])).
  957
  958info(Term, Info) -->
  959	{ findall(Term, member(Term, Info), [T0|More]), !
  960	},
  961	html(tr([th([\label(T0), :]), td(\value(T0))])),
  962	extra_values(More).
  963info(_, _) --> [].
  964
  965extra_values([]) --> [].
  966extra_values([H|T]) -->
  967	html(tr([th([]), td(\value(H))])),
  968	extra_values(T).
  969
  970label(Term) -->
  971	{ prolog_pack:pack_level_info(_, Term, LabelFmt, _),
  972	  (   LabelFmt = Label-_
  973	  ->  true
  974	  ;   Label = LabelFmt
  975	  )
  976	},
  977	html(Label).
  978
  979value(Term) -->
  980	{ name_address(Term, Name, Address) }, !,
  981	html([span(class(name), Name), ' ']),
  982	address(Address).
  983value(Term) -->
  984	{ url(Term, Label, URL) },
  985	html(a(href(URL), Label)).
  986value(Term) -->
  987	{ prolog_pack:pack_level_info(_, Term, LabelFmt, _),
  988	  (   LabelFmt = _-Fmt
  989	  ->  true
  990	  ;   Fmt = '~w'
  991	  ),
  992	  Term =.. [_|Values]
  993	},
  994	html(Fmt-Values).
  995
  996address(Address) -->
  997	{ sub_atom(Address, _, _, _, @) }, !,
  998	html(['<', Address, '>']).
  999address(URL) -->
 1000	html(a(href(URL), URL)).
 1001
 1002name_address(author(    Name, Address), Name, Address).
 1003name_address(maintainer(Name, Address), Name, Address).
 1004name_address(packager(  Name, Address), Name, Address).
 1005
 1006url(home(URL), URL, URL).
 1007url(download(Pattern), Pattern, URL) :-
 1008	(   wildcard_pattern(Pattern)
 1009	->  file_directory_name(Pattern, Dir),
 1010	    ensure_slash(Dir, URL)
 1011	;   URL = Pattern
 1012	).
 1013
 1014wildcard_pattern(URL) :- sub_atom(URL, _, _, _, *).
 1015wildcard_pattern(URL) :- sub_atom(URL, _, _, _, ?).
 1016
 1017ensure_slash(Dir, DirS) :-
 1018	(   sub_atom(Dir, _, _, 0, /)
 1019	->  DirS = Dir
 1020	;   atom_concat(Dir, /, DirS)
 1021	).
 1022
 1023%%	pack_file_table(+Pack)// is det.
 1024%
 1025%	Provide a table with the files, sorted by version, providing
 1026%	statistics on downloads.
 1027
 1028pack_file_table(Pack) -->
 1029	{ setof(Version-Hash, pack_version_hash(Pack, Hash, Version), Pairs),
 1030	  group_pairs_by_key(Pairs, Grouped)
 1031	},
 1032	html(h2(class(wiki), 'Details by download location')),
 1033	html(table(class(pack_file_table),
 1034		   [ tr([th('Version'), th('SHA1'), th('#Downloads'), th('URL')])
 1035		   | \pack_file_rows(Grouped)
 1036		   ])).
 1037
 1038pack_file_rows([]) --> [].
 1039pack_file_rows([H|T]) --> pack_file_row(H), pack_file_rows(T).
 1040
 1041pack_file_row(Version-[H0|Hashes]) -->
 1042	{ sha1_downloads(H0, Count),
 1043	  sha1_urls(H0, [URL|URLs])
 1044	},
 1045	html(tr([ td(\version(Version)),
 1046		  td(\hash(H0)),
 1047		  \count(Count),
 1048		  td(\download_url(URL))
 1049		])),
 1050	alt_urls(URLs),
 1051	alt_hashes(Hashes).
 1052
 1053alt_urls([]) --> [].
 1054alt_urls([H|T]) --> alt_url(H), alt_urls(T).
 1055
 1056alt_url(H) -->
 1057	html(tr([td(''), td(''), td(''), td(\download_url(H))])).
 1058
 1059alt_hashes([]) --> [].
 1060alt_hashes([H|T]) --> alt_hash(H), alt_hashes(T).
 1061
 1062alt_hash(H) -->
 1063	{ sha1_downloads(H, Count),
 1064	  sha1_urls(H, [URL|URLs])
 1065	},
 1066	html(tr([td(''), td(\hash(H)), \count(Count), td(\download_url(URL))])),
 1067	alt_urls(URLs).
 1068
 1069hash(H)		  --> html(span(class(hash), H)).
 1070download_url(URL) --> html(a(href(URL), URL)).
 1071count(N)          --> html(td(class(count), N)).
 1072version(V)        --> { prolog_pack:atom_version(Atom, V) },
 1073		      html(Atom).
 1074
 1075pack_version_hash(Pack, Hash, Version) :-
 1076	sha1_pack(Hash, Pack),
 1077	sha1_version(Hash, Version).
 1078
 1079
 1080%%	pack_file_details(+Request)
 1081%
 1082%	HTTP handler to provide details on a file in a pack
 1083
 1084pack_file_details(Request) :-
 1085	memberchk(path_info(SlashPackAndFile), Request),
 1086	\+ sub_atom(SlashPackAndFile, _, _, _, '/../'), !,
 1087	http_parameters(Request,
 1088			[ public_only(Public),
 1089			  show(Show)
 1090			],
 1091			[ attribute_declarations(pldoc_http:param)
 1092			]),
 1093	atom_concat(/, PackAndFile, SlashPackAndFile),
 1094	sub_atom(PackAndFile, B, _, A, /), !,
 1095	sub_atom(PackAndFile, 0, B, _, Pack),
 1096	sub_atom(PackAndFile, _, A, 0, File),
 1097	pack_file_details(Pack, File,
 1098			  [ public_only(Public),
 1099			    show(Show)
 1100			  ]).
 1101
 1102
 1103		 /*******************************
 1104		 *	  DB MAINTENANCE	*
 1105		 *******************************/
 1106
 1107update_github_files :-
 1108	forall(( sha1_file(SHA1, File),
 1109		 file_name_extension(Tag, Ext, File),
 1110		 prolog_pack:github_archive_extension(Ext),
 1111		 prolog_pack:tag_version(Tag, Version),
 1112		 prolog_pack:atom_version(VersionA, Version)
 1113	       ),
 1114	       ( sha1_pack(SHA1, Pack),
 1115		 format(atom(NewFile), '~w-~w.~w', [Pack, VersionA, Ext]),
 1116		 retract_sha1_file(SHA1, File),
 1117		 assert_sha1_file(SHA1, NewFile)
 1118	       ))