30
31:- module(pack,
32 [ pack/1, 33 pack_version_hashes/2, 34 hash_git_url/2, 35 hash_file_url/2, 36 pack_url_hash/2, 37
38 current_pack/2, 39 sort_packs/3, 40 pack_table//2 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, []). 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, []).
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').
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 ]).
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).
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
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), 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 ).
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 ).
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).
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).
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).
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 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.
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).
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, _).
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), !, 554 info_is_git(Info, IsGIT),
555 register_url(SHA1, IsGIT, URL, Result). 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).
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))).
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).
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 ).
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 ).
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 ).
791hash_git_url(SHA1, GitURL) :-
792 sha1_info(SHA1, Info),
793 memberchk(git(true), Info), !,
794 sha1_url(SHA1, GitURL).
800hash_file_url(SHA1, FileURL) :-
801 sha1_info(SHA1, Info),
802 \+ memberchk(git(true), Info), !,
803 sha1_url(SHA1, FileURL).
809pack_url_hash(URL, Hash) :-
810 sha1_url(Hash, URL).
816pack(Pack) :-
817 findall(Pack, sha1_pack(_,Pack), Packs),
818 sort(Packs, Sorted),
819 member(Pack, Sorted).
820
821
822
830pack_list(Request) :-
831 http_parameters(Request,
832 [ p(Pack, [optional(true)]),
833 author(Author, [optional(true)]),
834 sort(Sort, [ oneof([name,downloads,rating]),
835 optional(true),
836 default(name)
837 ])
838 ]),
839 ( ground(Pack)
840 -> format(atom(Title), '"~w" pack for SWI-Prolog', [Pack])
841 ; Title = 'SWI-Prolog packages'
842 ),
843 reply_html_page(pack(list),
844 title(Title),
845 [ \pack_listing(Pack, Author, Sort)
846 ]).
847
848pack_listing(Pack, _Author, _Sort) -->
849 { ground(Pack) }, !,
850 html([ h1(class(wiki), 'Package "~w"'-[Pack]),
851 \html_requires(css('pack.css')),
852 \pack_info(Pack)
853 ]).
854pack_listing(_Pack, Author, SortBy) -->
855 { ( nonvar(Author)
856 -> Filter = [author(Author)]
857 ; Filter = []
858 ),
859 ( setof(Pack, current_pack(Filter, Pack), Packs)
860 -> true
861 ; Packs = []
862 ),
863 sort_packs(SortBy, Packs, Sorted)
864 },
865 html({|html||
866<p>
867Below is a list of known packages. Please be aware that packages are
868<b>not moderated</b>. Installing a pack does not execute code in the
869pack, but simply loading a library from the pack may execute arbitrary
870code. More information about packages is available <a
871href="/howto/Pack.html">here</a>. You can search for packages from
872the Prolog command line using pack_list/1. This contacts the pack
873server for packs that match by name or title. A leading <b>i</b>
874indicates that the pack is already installed, while <b>p</b> merely
875indicates that it is known by the server.
876</p>
877
878<pre class="code">
879?- pack_list(graph).
880p callgraph@0.3.4 - Predicate call graph visualisation
881i graphml@0.1.0 - Write GraphML files
882i gvterm@1.1 - Show Prolog terms using graphviz
883p musicbrainz@0.6.3 - Musicbrainz client library
884p sindice@0.0.3 - Access to Sindice semantic web search engine
885</pre>
886
887<p>
888After finding the right pack, the pack and its dependencies can be installed
889using the pack_install/1 as illustrated below.
890</p>
891
892<pre class="code">
893?- pack_install(hello).
894</pre>
895
896<p>
897Clicking the package shows details and allows you to rate and comment
898the pack.
899</p>
900 |}),
901 pack_table(Sorted, [sort_by(SortBy)]),
902 html_receive(rating_scripts).
908pack_table(Packs, Options) -->
909 { option(sort_by(SortBy), Options, -),
910 length(Packs, PackCount),
911 maplist(pack_downloads, Packs, Totals),
912 sum_list(Totals, Total)
913 },
914 html_requires(css('pack.css')),
915 html(table(class(packlist),
916 [ tr([ \pack_header(name, SortBy,
917 'Pack', ['tot: ~D'-[PackCount]]),
918 \pack_header(version, SortBy,
919 'Version', '(#older)'),
920 \pack_header(downloads, SortBy,
921 'Downloads', ['tot: ~D'-[Total],
922 br([]), '(#latest)']),
923 \pack_header(rating, SortBy,
924 'Rating', ['(#votes/', br([]),
925 '#comments)']),
926 \pack_header(title, SortBy,
927 'Title', [])
928 ])
929 | \pack_rows(Packs)
930 ])).
931
932
933pack_rows([]) --> [].
934pack_rows([H|T]) --> pack_row(H), pack_rows(T).
935
936pack_row(Pack) -->
937 { pack_name(Pack, Name),
938 http_link_to_id(pack_list, [p(Name)], HREF)
939 },
940 html(tr([ td(a(href(HREF),Name)),
941 td(class('pack-version'), \pack_version(Pack)),
942 td(class('pack-downloads'), \pack_downloads(Pack)),
943 td(class('pack-rating'), \pack_rating(Pack)),
944 td(class('pack-title'), \pack_title(Pack))
945 ])).
946
(Name, -, Title, Subtitle) --> !,
948 html(th(id(Name), [Title, \subtitle(Subtitle)])).
949pack_header(Name, SortBy, Title, Subtitle) -->
950 { Name \== SortBy,
951 sortable(Name), !,
952 http_link_to_id(pack_list, [sort(Name)], HREF)
953 },
954 html(th(id(Name), [ a([class(resort),href(HREF)], Title),
955 \subtitle(Subtitle)
956 ])).
957pack_header(Name, Name, Title, Subtitle) -->
958 html(th(id(Name), [i(class(sorted), Title), \subtitle(Subtitle)])).
959pack_header(Name, _, Title, Subtitle) -->
960 html(th(id(Name), [Title, \subtitle(Subtitle)])).
961
962subtitle([]) --> [].
963subtitle(Subtitle) --> html(div(class(sth), Subtitle)).
964
965
966sortable(name).
967sortable(downloads).
968sortable(rating).
969
970pack_version(Pack) -->
971 { pack_version(Pack, Version),
972 pack_older_versions(Pack, Older),
973 atom_version(Atom, Version)
974 },
975 ( { Older =\= 0 }
976 -> html([Atom, span(class(annot), '~D'-[Older])])
977 ; html(Atom)
978 ).
979
980pack_downloads(Pack) -->
981 { pack_downloads(Pack, Total),
982 pack_download_latest(Pack, DownLoadLatest)
983 },
984 ( { Total =:= DownLoadLatest }
985 -> html('~D'-[Total])
986 ; html(['~D'-[Total], span(class(annot), '~D'-[DownLoadLatest])])
987 ).
988
989pack_rating(Pack) -->
990 { pack_rating(Pack, Rating),
991 pack_votes(Pack, Votes),
992 pack_comments(Pack, CommentCount),
993 pack_name(Pack, Name),
994 http_link_to_id(pack_rating, [], OnRating)
995 },
996 show_pack_rating(Name, Rating, Votes, CommentCount,
997 [ on_rating(OnRating)
998 ]).
999
1000pack_title(Pack) -->
1001 { pack_hash(Pack, SHA1),
1002 sha1_title(SHA1, Title)
1003 },
1004 html(Title).
1005
1006:- record
1007 pack(name:atom, 1008 hash:atom, 1009 version:list(integer), 1010 older_versions:integer, 1011 downloads:integer, 1012 download_latest:integer, 1013 rating:number, 1014 votes:integer, 1015 comments:integer).
1025current_pack(Filters,
1026 pack(Pack, SHA1,
1027 Version, OlderVersionCount,
1028 Downloads, DLLatest,
1029 Rating, Votes, CommentCount)) :-
1030 setof(Pack, H^sha1_pack(H,Pack), Packs),
1031 member(Pack, Packs),
1032 pack_latest_version(Pack, SHA1, Version, OlderVersionCount),
1033 maplist(pack_filter(SHA1), Filters),
1034 pack_downloads(Pack, SHA1, Downloads, DLLatest),
1035 pack_rating_votes(Pack, Rating, Votes),
1036 pack_comment_count(Pack, CommentCount).
1037
1038pack_filter(SHA1, author(Author)) :-
1039 sha1_info(SHA1, Info),
1040 member(author(Name, Contact), Info),
1041 once(author_match(Author, Name, Contact)).
1042
1043author_match(Author, Author, _). 1044author_match(Author, _, Author). 1045author_match(UUID, Name, Contact) :- 1046 ( site_user_property(UUID, name(Name))
1047 ; site_user_property(UUID, email(Contact))
1048 ; site_user_property(UUID, home_url(Contact))
1049 ).
1054sort_packs(By, Packs, Sorted) :-
1055 map_list_to_pairs(pack_data(By), Packs, Keyed),
1056 keysort(Keyed, KeySorted),
1057 pairs_values(KeySorted, Sorted0),
1058 reverse_sort(By, Sorted0, Sorted).
1059
1060reverse_sort(name, Packs, Packs) :- !.
1061reverse_sort(_, Packs, RevPacks) :-
1062 reverse(Packs, RevPacks).
1063
1064
1065pack_downloads(Pack, SHA1, Total, DownLoadLatest) :-
1066 setof(Hash, sha1_pack(Hash, Pack), Hashes),
1067 map_list_to_pairs(sha1_downloads, Hashes, Pairs),
1068 memberchk(DownLoadLatest-SHA1, Pairs),
1069 pairs_keys(Pairs, Counts),
1070 sum_list(Counts, Total).
1077pack_latest_version(Pack, SHA1, Version, Older) :-
1078 setof(SHA1, sha1_pack(SHA1, Pack), Hashes),
1079 map_list_to_pairs(sha1_version, Hashes, Versions),
1080 keysort(Versions, Sorted),
1081 length(Sorted, Count),
1082 Older is Count - 1,
1083 last(Sorted, Version-SHA1).
1084
1085
1086
1097pack_info(Pack) -->
1098 { \+ pack(Pack) }, !,
1099 html(p(class(warning),
1100 'Sorry, I know nothing about a pack named "~w"'-[Pack])).
1101pack_info(Pack) -->
1102 pack_info_table(Pack),
1103 pack_reviews(Pack),
1104 pack_file_table(Pack),
1105 ( pack_readme(Pack) -> [] ; [] ),
1106 ( pack_file_hierarchy(Pack)
1107 -> []
1108 ; html(p(class(warning), 'Failed to process pack'))
1109 ).
1115pack_info_table(Pack) -->
1116 { pack_latest_version(Pack, SHA1, Version, _Older),
1117 atom_version(VersionA, Version),
1118 sha1_title(SHA1, Title),
1119 sha1_info(SHA1, Info)
1120 },
1121 html(table(class(pack),
1122 [ \property('Title', span(class(title), Title)),
1123 \property('Rating', \show_pack_rating(Pack)),
1124 \property('Latest version', VersionA),
1125 \property('SHA1 sum', \hash(SHA1)),
1126 \info(author(_,_), Info),
1127 \info(maintainer(_,_), Info),
1128 \info(packager(_,_), Info),
1129 \info(home(_), Info),
1130 \info(download(_), Info),
1131 \info(requires(_), Info),
1132 \info(provides(_), Info),
1133 \info(conflicts(_), Info)
1134 ])).
1135
1136property(Label, Value) -->
1137 html(tr([th([Label, :]), td(Value)])).
1138
1139info(Term, Info) -->
1140 { findall(Term, member(Term, Info), [T0|More]), !
1141 },
1142 html(tr([th([\label(T0), :]), td(\value(T0))])),
1143 extra_values(More).
1144info(_, _) --> [].
1145
([]) --> [].
1147extra_values([H|T]) -->
1148 html(tr([th([]), td(\value(H))])),
1149 extra_values(T).
1150
1151label(Term) -->
1152 { prolog_pack:pack_level_info(_, Term, LabelFmt, _),
1153 ( LabelFmt = Label-_
1154 -> true
1155 ; Label = LabelFmt
1156 )
1157 },
1158 html(Label).
1159
1160value(Term) -->
1161 { name_address(Term, Name, Address) }, !,
1162 html([span(class(name), Name), ' ']),
1163 address(Address).
1164value(Term) -->
1165 { url(Term, Label, URL) },
1166 html(a(href(URL), Label)).
1167value(Term) -->
1168 { prolog_pack:pack_level_info(_, Term, LabelFmt, _),
1169 ( LabelFmt = _-Fmt
1170 -> true
1171 ; Fmt = '~w'
1172 ),
1173 Term =.. [_|Values]
1174 },
1175 html(Fmt-Values).
1176
1177address(Address) -->
1178 { sub_atom(Address, _, _, _, @) }, !,
1179 html(['<', Address, '>']).
1180address(URL) -->
1181 html(a(href(URL), URL)).
1182
1183name_address(author( Name, Address), Name, Address).
1184name_address(maintainer(Name, Address), Name, Address).
1185name_address(packager( Name, Address), Name, Address).
1186
1187url(home(URL), URL, URL).
1188url(download(Pattern), Pattern, URL) :-
1189 ( wildcard_pattern(Pattern)
1190 -> file_directory_name(Pattern, Dir),
1191 ensure_slash(Dir, URL)
1192 ; URL = Pattern
1193 ).
1194
1195wildcard_pattern(URL) :- sub_atom(URL, _, _, _, *).
1196wildcard_pattern(URL) :- sub_atom(URL, _, _, _, ?).
1197
1198ensure_slash(Dir, DirS) :-
1199 ( sub_atom(Dir, _, _, 0, /)
1200 -> DirS = Dir
1201 ; atom_concat(Dir, /, DirS)
1202 ).
1209pack_file_table(Pack) -->
1210 { setof(Version-Hash, pack_version_hash(Pack, Hash, Version), Pairs),
1211 group_pairs_by_key(Pairs, Grouped)
1212 },
1213 html(h2(class(wiki), 'Details by download location')),
1214 html(table(class(pack_file_table),
1215 [ tr([th('Version'), th('SHA1'), th('#Downloads'), th('URL')])
1216 | \pack_file_rows(Grouped)
1217 ])).
1218
1219pack_file_rows([]) --> [].
1220pack_file_rows([H|T]) --> pack_file_row(H), pack_file_rows(T).
1221
1222pack_file_row(Version-[H0|Hashes]) -->
1223 { sha1_downloads(H0, Count),
1224 sha1_urls(H0, [URL|URLs])
1225 },
1226 html(tr([ td(\version(Version)),
1227 td(\hash(H0)),
1228 \count(Count),
1229 td(\download_url(URL))
1230 ])),
1231 alt_urls(URLs),
1232 alt_hashes(Hashes).
1233
1234alt_urls([]) --> [].
1235alt_urls([H|T]) --> alt_url(H), alt_urls(T).
1236
1237alt_url(H) -->
1238 html(tr([td(''), td(''), td(''), td(\download_url(H))])).
1239
1240alt_hashes([]) --> [].
1241alt_hashes([H|T]) --> alt_hash(H), alt_hashes(T).
1242
1243alt_hash(H) -->
1244 { sha1_downloads(H, Count),
1245 sha1_urls(H, [URL|URLs])
1246 },
1247 html(tr([td(''), td(\hash(H)), \count(Count), td(\download_url(URL))])),
1248 alt_urls(URLs).
1249
1250hash(H) --> html(span(class(hash), H)).
1251download_url(URL) --> html(a(href(URL), URL)).
1252count(N) --> html(td(class(count), N)).
1253version(V) --> { atom_version(Atom, V) },
1254 html(Atom).
1255
1256pack_version_hash(Pack, Hash, Version) :-
1257 sha1_pack(Hash, Pack),
1258 sha1_version(Hash, Version).
1265pack_file_details(Request) :-
1266 memberchk(path_info(SlashPackAndFile), Request),
1267 \+ sub_atom(SlashPackAndFile, _, _, _, '/../'), !,
1268 http_parameters(Request,
1269 [ public_only(Public),
1270 show(Show)
1271 ],
1272 [ attribute_declarations(pldoc_http:param)
1273 ]),
1274 atom_concat(/, PackAndFile, SlashPackAndFile),
1275 sub_atom(PackAndFile, B, _, A, /), !,
1276 sub_atom(PackAndFile, 0, B, _, Pack),
1277 sub_atom(PackAndFile, _, A, 0, File),
1278 pack_file_details(Pack, File,
1279 [ public_only(Public),
1280 show(Show)
1281 ]).
1282
1283
1284
1294atom_version(Atom, version(Parts)) :-
1295 ( atom(Atom)
1296 -> split_string(Atom, ".", "", Parts0),
1297 maplist(valid_version_part, Parts0, Parts)
1298 ; atomic_list_concat(Parts, '.', Atom)
1299 ).
1300
1301valid_version_part(String, Num) :-
1302 number_string(Num, String),
1303 !.
1304valid_version_part("*", _)