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, [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
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
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
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
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 200
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), 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
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
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
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
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 convlist(version_hash_info(Pack, Options),
364 VersionHashes, Infos),
365 maplist(arg(2), Infos, RequiresLists),
366 append(RequiresLists, Requires0),
367 sort(Requires0, Requires),
368 maplist(arg(1), Infos, VersionInfo)
369 },
370 [ Pack-VersionInfo ],
371 include_pack_requirements(Requires, Options).
372
373seen(Pack, [Pack-_|_]) => true.
374seen(Pack, [_|T]) => seen(Pack, T).
375seen(_, _) => fail.
376
377version_hash_info(Pack, Options, Version-Hashes, info(Version-Info, Requires)) :-
378 maplist(hash_info(Pack, Options), Hashes, Info, Requires0),
379 append(Requires0, Requires1),
380 sort(Requires1, Requires).
381
382hash_info(Pack, _Options, Hash, Dict, Requires) :-
383 sha1_url(Hash, URL),
384 sha1_is_git(Hash, IsGit),
385 sha1_downloads(Hash, Count),
386 findall(Req, sha1_requires(Hash, Req), Requires),
387 findall(Prv, sha1_provides(Hash, Prv), Provides),
388 findall(Prv, sha1_conflicts(Hash, Prv), Conflicts),
389 Dict = #{ pack: Pack,
390 hash: Hash,
391 url: URL,
392 git: IsGit,
393 requires: Requires,
394 provides: Provides,
395 conflicts: Conflicts,
396 downloads: Count
397 }.
398
399include_pack_requirements([], _) --> !.
400include_pack_requirements([ReqToken|T], Options) -->
401 { findall(Unseen, resolves(ReqToken, Unseen), DepPacks)
402 },
403 pack_versions(DepPacks, Options),
404 include_pack_requirements(T, Options).
405
406resolves(ReqToken, Pack) :-
407 ( sha1_pack(Hash, Token),
408 sha1_version(Hash, Version),
409 PrvToken = @(Token,Version)
410 ; sha1_provides(Hash, PrvToken)
411 ),
412 satisfies(PrvToken, ReqToken),
413 sha1_pack(Hash, Pack).
414
415satisfies(Token, Token) => true.
416satisfies(@(Token,_), Token) => true.
417satisfies(@(Token,PrvVersion), Req), cmp(Req, Token, Cmp, ReqVersion) =>
418 atomic_list_concat(PrvVersion, PrvVersionAtom),
419 atomic_list_concat(ReqVersion, ReqVersionAtom),
420 cmp_versions(Cmp, PrvVersionAtom, ReqVersionAtom).
421satisfies(_,_) => fail.
422
423cmp(Token < Version, Token, <, Version).
424cmp(Token =< Version, Token, =<, Version).
425cmp(Token = Version, Token, =, Version).
426cmp(Token == Version, Token, ==, Version).
427cmp(Token >= Version, Token, >=, Version).
428cmp(Token > Version, Token, >, Version).
429
435
436search_packs(Search, Packs) :-
437 setof(Pack, matching_pack(Search, Pack), Names), !,
438 maplist(pack_search_result, Names, Packs).
439
440matching_pack(Search, Pack) :-
441 sha1_pack(SHA1, Pack),
442 ( sub_atom_icasechk(Pack, _, Search)
443 -> true
444 ; sha1_title(SHA1, Title),
445 sub_atom_icasechk(Title, _, Search)
446 ).
447
448pack_search_result(Pack, pack(Pack, p, Title, VersionA, URLs)) :-
449 pack_latest_version(Pack, SHA1, Version, _Older),
450 sha1_title(SHA1, Title),
451 atom_version(VersionA, Version),
452 findall(URL, sha1_url(SHA1, URL), URLs).
453
454
455 458
459:- multifile error:has_type/2. 460
461error:has_type(dependency, Value) :-
462 is_dependency(Value, _Token, _Version).
463
464is_dependency(Token, Token, *) :-
465 atom(Token).
466is_dependency(Term, Token, VersionCmp) :-
467 Term =.. [Op,Token,Version],
468 cmp(Op, _),
469 version_data(Version, _),
470 VersionCmp =.. [Op,Version].
471
472cmp(<, @<).
473cmp(=<, @=<).
474cmp(==, ==).
475cmp(=, =).
476cmp(>=, @>=).
477cmp(>, @>).
478
479version_data(Version, version(Data)) :-
480 atomic_list_concat(Parts, '.', Version),
481 maplist(atom_number, Parts, Data).
482
483:- persistent
484 sha1_pack(sha1:atom, pack:atom),
485 sha1_file(sha1:atom, file:atom),
486 sha1_requires(sha1:atom, token:dependency),
487 sha1_provides(sha1:atom, token:dependency),
488 sha1_conflicts(sha1:atom, token:dependency),
489 sha1_info(sha1:atom, info:list),
490 sha1_url(sha1:atom, url:atom),
491 sha1_download(sha1:atom, peer:atom),
492 pack_allowed_url(pack:atom, isgit:boolean, pattern:atom). 493
494:- initialization
495 absolute_file_name(data('packs.db'), File,
496 [ access(write) ]),
497 db_attach(File, [sync(close)]),
498 populate_pack_url_patterns. 499
503
504delete_pack(PackName) :-
505 must_be(atom, PackName),
506 pack(PackName), !,
507 clean_pack_info(PackName),
508 pack_unmirror(PackName),
509 forall(sha1_pack(Hash, PackName),
510 delete_hash(Hash)),
511 retractall_pack_allowed_url(PackName,_,_).
512delete_pack(PackName) :-
513 existence_error(pack, PackName).
514
518
519delete_hash(Hash) :-
520 retractall_sha1_pack(Hash, _),
521 retractall_sha1_file(Hash, _),
522 retractall_sha1_requires(Hash, _),
523 retractall_sha1_provides(Hash, _),
524 retractall_sha1_conflicts(Hash, _),
525 retractall_sha1_info(Hash, _),
526 retractall_sha1_url(Hash, _),
527 retractall_sha1_download(Hash, _).
528
534
535:- det(save_request/3). 536save_request(Peer, download(URL, Hash, Metadata), Result) =>
537 Result = Pack-Action,
538 memberchk(name(Pack), Metadata),
539 with_mutex(pack, save_request(URL, Hash, Metadata, Peer, Action)).
540
541save_request(URL, Hash, Metadata, Peer, Result) :-
542 ( Error = error(Formal,_),
543 catch(save_request_(URL, Hash, Metadata, Peer, Res0),
544 Error,
545 true)
546 -> ( var(Formal)
547 -> Result = Res0
548 ; Result = throw(Error)
549 )
550 ; Result = false
551 ).
552
553save_request_(URL, SHA1, Info, Peer, Result) :-
554 sha1_download(SHA1, Peer),
555 sha1_pack(SHA1, Peer), !, 556 info_is_git(Info, IsGIT),
557 register_url(SHA1, IsGIT, URL, Result). 558save_request_(URL, SHA1, Info, Peer, Result) :-
559 memberchk(name(Pack), Info),
560 info_is_git(Info, IsGIT),
561 ( accept_url(URL, Pack, IsGIT)
562 -> register_url(SHA1, IsGIT, URL, Result0),
563 register_pack(SHA1, Pack),
564 register_info(SHA1, Info)
565 ; permission_error(register, pack(Pack), URL)
566 ),
567 assert_sha1_download(SHA1, Peer),
568 ( Result0 == no_change
569 -> Result = download
570 ; Result = Result0
571 ).
572
573info_is_git(Info, IsGIT) :-
574 memberchk(git(IsGIT), Info), !.
575info_is_git(_, false).
576
581
582accept_url(URL, Pack, IsGIT) :-
583 ( pack_allowed_url(Pack, _, Pattern)
584 *-> wildcard_match(Pattern, URL), !
585 ; admissible_url(URL)
586 -> url_pattern(URL, IsGIT, Pattern),
587 assert_pack_allowed_url(Pack, IsGIT, Pattern)
588 ).
589
590admissible_url(URL) :-
591 uri_components(URL, Components),
592 uri_data(scheme, Components, Scheme),
593 uri_data(authority, Components, Authority),
594 uri_authority_components(Authority, AuthComponents),
595 uri_authority_data(host, AuthComponents, Host),
596 uri_authority_data(port, AuthComponents, Port),
597 \+ nonadmissible_host(Host),
598 admissible_scheme(Scheme, Port).
599
600nonadmissible_host(localhost).
601nonadmissible_host(IP) :-
602 split_string(IP, ".", "", Parts),
603 maplist(number_string, _, Parts).
604
605admissible_scheme(http, 80).
606admissible_scheme(https, 443).
607
608url_pattern(URL, true, URL) :- !.
609url_pattern(URL, false, Pattern) :-
610 site_pattern(URL, Pattern), !.
611url_pattern(URL, false, Pattern) :-
612 ( atom_concat('http://', Rest, URL)
613 -> atom_concat('http{,s}://', Rest, URL2)
614 ; URL2 = URL
615 ),
616 file_directory_name(URL2, Dir),
617 atom_concat(Dir, '/*', Pattern).
618
619site_pattern(URL, Pattern) :-
620 sub_atom(URL, 0, _, _, 'https://gitlab.com/'),
621 git_user_project_pattern(URL, Pattern).
622site_pattern(URL, Pattern) :-
623 sub_atom(URL, 0, _, _, 'https://github.com/'),
624 git_user_project_pattern(URL, Pattern).
625
626git_user_project_pattern(URL, Pattern) :-
627 uri_components(URL, Components),
628 uri_data(path, Components, Path0),
629 split_string(Path0, "/", "/", [User,Project|_]),
630 atomic_list_concat([/, User, /, Project, /, *], Path),
631 uri_data(path, Components, Path, Components1),
632 uri_components(Pattern, Components1).
633
634populate_pack_url_patterns :-
635 forall(pack(Pack),
636 populate_pack_url_pattern(Pack)).
637
638populate_pack_url_pattern(Pack) :-
639 pack_allowed_url(Pack, _, _), !.
640populate_pack_url_pattern(Pack) :-
641 findall(URL-IsGIT,
642 ( sha1_pack(SHA1, Pack),
643 sha1_info(SHA1, Info),
644 ( memberchk(git(IsGIT), Info)
645 -> true
646 ; IsGIT = false
647 ),
648 sha1_url(SHA1, URL)
649 ),
650 URLS),
651 last(URLS, URL-IsGIT),
652 url_pattern(URL, IsGIT, Pattern),
653 assert_pack_allowed_url(Pack, IsGIT, Pattern), !.
654populate_pack_url_pattern(Pack) :-
655 print_message(error, pack(pattern_failed(Pack))).
656
660
661set_allowed_url(Request) :-
662 site_user_logged_in(User),
663 site_user_property(User, granted(admin)), !,
664 http_parameters(Request,
665 [ p(Pack, []),
666 url(Pattern, []),
667 git(IsGit, [boolean, optional(true)])
668 ], []),
669 call_showing_messages(set_allowed_url(Pack, IsGit, Pattern), []).
670set_allowed_url(Request) :-
671 memberchk(path(Path), Request),
672 throw(http_reply(forbidden(Path))).
673
674set_allowed_url(Pack, _IsGit, _Pattern) :-
675 \+ sha1_pack(_, Pack),
676 !,
677 existence_error(pack, Pack).
678set_allowed_url(Pack, IsGit, Pattern) :-
679 ( var(IsGit)
680 -> ( sub_atom(Pattern, _, _, _, *)
681 -> IsGit = false
682 ; IsGit = true
683 )
684 ; true
685 ),
686 retractall_pack_allowed_url(Pack, _, _),
687 assert_pack_allowed_url(Pack, IsGit, Pattern).
688
690
691register_pack(SHA1, Pack) :-
692 ( sha1_pack(SHA1, Pack)
693 -> true
694 ; assert_sha1_pack(SHA1, Pack)
695 ).
696
697register_info(SHA1, Info0) :-
698 sort(Info0, Info),
699 ( sha1_info(SHA1, _Info)
700 -> true
701 ; assert_sha1_info(SHA1, Info),
702 forall(member(requires(Token), Info),
703 register_requires(SHA1, Token)),
704 forall(member(provides(Token), Info),
705 register_provides(SHA1, Token)),
706 forall(member(conflicts(Token), Info),
707 register_conflicts(SHA1, Token))
708 ).
709
710register_requires(SHA1, Token) :-
711 ( sha1_requires(SHA1, Token)
712 -> true
713 ; assert_sha1_requires(SHA1, Token)
714 ).
715
716register_provides(SHA1, Token) :-
717 ( sha1_provides(SHA1, Token)
718 -> true
719 ; assert_sha1_provides(SHA1, Token)
720 ).
721
722register_conflicts(SHA1, Token) :-
723 ( sha1_conflicts(SHA1, Token)
724 -> true
725 ; assert_sha1_conflicts(SHA1, Token)
726 ).
727
731
732:- debug(pack(changed)). 733
734register_url(SHA1, IsGIT, URL, Result) :-
735 ( sha1_url(SHA1, URL)
736 -> Result = no_change
737 ; sha1_url(SHA2, URL),
738 \+ ( IsGIT == true,
739 hash_git_url(SHA2, URL)
740 ),
741 ( debug(pack(changed), '~p seems changed', [URL]),
742 is_github_release(URL)
743 -> debug(pack(changed), 'From github: ~p', [URL]),
744 retractall_sha1_url(SHA1, URL),
745 fail
746 ; true
747 )
748 -> Result = throw(pack(modified_hash(SHA1-URL, SHA2-[URL])))
749 ; IsGIT == true
750 -> assert_sha1_url(SHA1, URL),
751 Result = git(URL)
752 ; prolog_pack:pack_url_file(URL, File),
753 register_file(SHA1, File, URL),
754 assert_sha1_url(SHA1, URL),
755 Result = file(URL)
756 ).
757
762
763is_github_release(URL) :-
764 uri_components(URL, Components),
765 uri_data(scheme, Components, Scheme), Scheme == https,
766 uri_data(authority, Components, Auth), Auth == 'github.com',
767 uri_data(path, Components, Path), atomic(Path),
768 split_string(Path, "/", "", ["", _User, _Repo, "archive", Zip]),
769 file_name_extension(_, Ext, Zip),
770 github_archive_extension(Ext).
771
772github_archive_extension(tgz).
773github_archive_extension(zip).
774
775register_file(SHA1, File, URL) :-
776 ( sha1_file(SHA1, File)
777 -> true
778 ; sha1_file(SHA2, File),
779 sha1_urls(SHA2, URLs),
780 ( maplist(is_github_release, [URL|URLs])
781 -> retractall_sha1_file(SHA1, File),
782 fail
783 ; true
784 )
785 -> throw(pack(modified_hash(SHA1-URL, SHA2-URLs)))
786 ; assert_sha1_file(SHA1, File)
787 ).
788
792
793hash_git_url(SHA1, GitURL) :-
794 sha1_info(SHA1, Info),
795 memberchk(git(true), Info), !,
796 sha1_url(SHA1, GitURL).
797
801
802hash_file_url(SHA1, FileURL) :-
803 sha1_info(SHA1, Info),
804 \+ memberchk(git(true), Info), !,
805 sha1_url(SHA1, FileURL).
806
810
811pack_url_hash(URL, Hash) :-
812 sha1_url(Hash, URL).
813
817
818pack(Pack) :-
819 findall(Pack, sha1_pack(_,Pack), Packs),
820 sort(Packs, Sorted),
821 member(Pack, Sorted).
822
823
824 827
831
832pack_list(Request) :-
833 memberchk(path_info(SlashPack), Request),
834 atom_concat(/, Pack, SlashPack),
835 format(atom(Title), '"~w" pack for SWI-Prolog', [Pack]),
836 reply_html_page(pack(list),
837 title(Title),
838 [ \pack_listing(Pack, _Author, _Sort)
839 ]).
840pack_list(Request) :-
841 http_parameters(Request,
842 [ p(Pack, [optional(true)]),
843 author(Author, [optional(true)]),
844 sort(Sort, [ oneof([name,downloads,rating]),
845 optional(true),
846 default(name)
847 ])
848 ]),
849 ( ground(Pack)
850 -> format(atom(Title), '"~w" pack for SWI-Prolog', [Pack])
851 ; Title = 'SWI-Prolog packages'
852 ),
853 reply_html_page(pack(list),
854 title(Title),
855 [ \pack_listing(Pack, Author, Sort)
856 ]).
857
858pack_listing(Pack, _Author, _Sort) -->
859 { ground(Pack) }, !,
860 html([ h1(class(wiki), 'Package "~w"'-[Pack]),
861 \html_requires(css('pack.css')),
862 \pack_info(Pack)
863 ]).
864pack_listing(_Pack, Author, SortBy) -->
865 { ( nonvar(Author)
866 -> Filter = [author(Author)]
867 ; Filter = []
868 ),
869 ( setof(Pack, current_pack(Filter, Pack), Packs)
870 -> true
871 ; Packs = []
872 ),
873 sort_packs(SortBy, Packs, Sorted)
874 },
875 html({|html||
876<p>
877Below is a list of known packages. Please be aware that packages are
878<b>not moderated</b>. Installing a pack does not execute code in the
879pack, but simply loading a library from the pack may execute arbitrary
880code. More information about packages is available <a
881href="/howto/Pack.html">here</a>. You can search for packages from
882the Prolog command line using pack_list/1. This contacts the pack
883server for packs that match by name or title. A leading <b>i</b>
884indicates that the pack is already installed, while <b>p</b> merely
885indicates that it is known by the server.
886</p>
887
888<pre class="code">
889?- pack_list(graph).
890p callgraph@0.3.4 - Predicate call graph visualisation
891i graphml@0.1.0 - Write GraphML files
892i gvterm@1.1 - Show Prolog terms using graphviz
893p musicbrainz@0.6.3 - Musicbrainz client library
894p sindice@0.0.3 - Access to Sindice semantic web search engine
895</pre>
896
897<p>
898After finding the right pack, the pack and its dependencies can be installed
899using the pack_install/1 as illustrated below.
900</p>
901
902<pre class="code">
903?- pack_install(hello).
904</pre>
905
906<p>
907Clicking the package shows details and allows you to rate and comment
908the pack.
909</p>
910 |}),
911 pack_table(Sorted, [sort_by(SortBy)]),
912 html_receive(rating_scripts).
913
917
918pack_table(Packs, Options) -->
919 { option(sort_by(SortBy), Options, -),
920 length(Packs, PackCount),
921 maplist(pack_downloads, Packs, Totals),
922 sum_list(Totals, Total)
923 },
924 html_requires(css('pack.css')),
925 html(table(class(packlist),
926 [ tr([ \pack_header(name, SortBy,
927 'Pack', ['tot: ~D'-[PackCount]]),
928 \pack_header(version, SortBy,
929 'Version', '(#older)'),
930 \pack_header(downloads, SortBy,
931 'Downloads', ['tot: ~D'-[Total],
932 br([]), '(#latest)']),
933 \pack_header(rating, SortBy,
934 'Rating', ['(#votes/', br([]),
935 '#comments)']),
936 \pack_header(title, SortBy,
937 'Title', [])
938 ])
939 | \pack_rows(Packs)
940 ])).
941
942
943pack_rows([]) --> [].
944pack_rows([H|T]) --> pack_row(H), pack_rows(T).
945
946pack_row(Pack) -->
947 { pack_name(Pack, Name),
948 http_link_to_id(pack_list, [p(Name)], HREF)
949 },
950 html(tr([ td(a(href(HREF),Name)),
951 td(class('pack-version'), \pack_version(Pack)),
952 td(class('pack-downloads'), \pack_downloads(Pack)),
953 td(class('pack-rating'), \pack_rating(Pack)),
954 td(class('pack-title'), \pack_title(Pack))
955 ])).
956
(Name, -, Title, Subtitle) --> !,
958 html(th(id(Name), [Title, \subtitle(Subtitle)])).
959pack_header(Name, SortBy, Title, Subtitle) -->
960 { Name \== SortBy,
961 sortable(Name), !,
962 http_link_to_id(pack_list, [sort(Name)], HREF)
963 },
964 html(th(id(Name), [ a([class(resort),href(HREF)], Title),
965 \subtitle(Subtitle)
966 ])).
967pack_header(Name, Name, Title, Subtitle) -->
968 html(th(id(Name), [i(class(sorted), Title), \subtitle(Subtitle)])).
969pack_header(Name, _, Title, Subtitle) -->
970 html(th(id(Name), [Title, \subtitle(Subtitle)])).
971
972subtitle([]) --> [].
973subtitle(Subtitle) --> html(div(class(sth), Subtitle)).
974
975
976sortable(name).
977sortable(downloads).
978sortable(rating).
979
980pack_version(Pack) -->
981 { pack_version(Pack, Version),
982 pack_older_versions(Pack, Older),
983 atom_version(Atom, Version)
984 },
985 ( { Older =\= 0 }
986 -> html([Atom, span(class(annot), '~D'-[Older])])
987 ; html(Atom)
988 ).
989
990pack_downloads(Pack) -->
991 { pack_downloads(Pack, Total),
992 pack_download_latest(Pack, DownLoadLatest)
993 },
994 ( { Total =:= DownLoadLatest }
995 -> html('~D'-[Total])
996 ; html(['~D'-[Total], span(class(annot), '~D'-[DownLoadLatest])])
997 ).
998
999pack_rating(Pack) -->
1000 { pack_rating(Pack, Rating),
1001 pack_votes(Pack, Votes),
1002 pack_comments(Pack, CommentCount),
1003 pack_name(Pack, Name),
1004 http_link_to_id(pack_rating, [], OnRating)
1005 },
1006 show_pack_rating(Name, Rating, Votes, CommentCount,
1007 [ on_rating(OnRating)
1008 ]).
1009
1010pack_title(Pack) -->
1011 { pack_hash(Pack, SHA1),
1012 sha1_title(SHA1, Title)
1013 },
1014 html(Title).
1015
1016:- record
1017 pack(name:atom, 1018 hash:atom, 1019 version:list(integer), 1020 older_versions:integer, 1021 downloads:integer, 1022 download_latest:integer, 1023 rating:number, 1024 votes:integer, 1025 comments:integer). 1026
1034
1035current_pack(Filters,
1036 pack(Pack, SHA1,
1037 Version, OlderVersionCount,
1038 Downloads, DLLatest,
1039 Rating, Votes, CommentCount)) :-
1040 setof(Pack, H^sha1_pack(H,Pack), Packs),
1041 member(Pack, Packs),
1042 pack_latest_version(Pack, SHA1, Version, OlderVersionCount),
1043 maplist(pack_filter(SHA1), Filters),
1044 pack_downloads(Pack, SHA1, Downloads, DLLatest),
1045 pack_rating_votes(Pack, Rating, Votes),
1046 pack_comment_count(Pack, CommentCount).
1047
1048pack_filter(SHA1, author(Author)) :-
1049 sha1_info(SHA1, Info),
1050 member(author(Name, Contact), Info),
1051 once(author_match(Author, Name, Contact)).
1052
1053author_match(Author, Author, _). 1054author_match(Author, _, Author). 1055author_match(UUID, Name, Contact) :- 1056 ( site_user_property(UUID, name(Name))
1057 ; site_user_property(UUID, email(Contact))
1058 ; site_user_property(UUID, home_url(Contact))
1059 ).
1060
1061
1063
1064sort_packs(By, Packs, Sorted) :-
1065 map_list_to_pairs(pack_data(By), Packs, Keyed),
1066 keysort(Keyed, KeySorted),
1067 pairs_values(KeySorted, Sorted0),
1068 reverse_sort(By, Sorted0, Sorted).
1069
1070reverse_sort(name, Packs, Packs) :- !.
1071reverse_sort(_, Packs, RevPacks) :-
1072 reverse(Packs, RevPacks).
1073
1074
1075pack_downloads(Pack, SHA1, Total, DownLoadLatest) :-
1076 setof(Hash, sha1_pack(Hash, Pack), Hashes),
1077 map_list_to_pairs(sha1_downloads, Hashes, Pairs),
1078 memberchk(DownLoadLatest-SHA1, Pairs),
1079 pairs_keys(Pairs, Counts),
1080 sum_list(Counts, Total).
1081
1086
1087pack_latest_version(Pack, SHA1, Version, Older) :-
1088 setof(SHA1, sha1_pack(SHA1, Pack), Hashes),
1089 map_list_to_pairs(sha1_version, Hashes, Versions),
1090 keysort(Versions, Sorted),
1091 length(Sorted, Count),
1092 Older is Count - 1,
1093 last(Sorted, Version-SHA1).
1094
1095
1096 1099
1106
1107pack_info(Pack) -->
1108 { \+ pack(Pack) }, !,
1109 html(p(class(warning),
1110 'Sorry, I know nothing about a pack named "~w"'-[Pack])).
1111pack_info(Pack) -->
1112 pack_info_table(Pack),
1113 pack_reviews(Pack),
1114 pack_file_table(Pack),
1115 ( pack_readme(Pack) -> [] ; [] ),
1116 ( pack_file_hierarchy(Pack)
1117 -> []
1118 ; html(p(class(warning), 'Failed to process pack'))
1119 ).
1120
1124
1125pack_info_table(Pack) -->
1126 { pack_latest_version(Pack, SHA1, Version, _Older),
1127 atom_version(VersionA, Version),
1128 sha1_title(SHA1, Title),
1129 sha1_info(SHA1, Info)
1130 },
1131 html(table(class(pack),
1132 [ \property('Title', span(class(title), Title)),
1133 \property('Rating', \show_pack_rating(Pack)),
1134 \property('Latest version', VersionA),
1135 \property('SHA1 sum', \hash(SHA1)),
1136 \info(author(_,_), Info),
1137 \info(maintainer(_,_), Info),
1138 \info(packager(_,_), Info),
1139 \info(home(_), Info),
1140 \info(download(_), Info),
1141 \info(requires(_), Info),
1142 \info(provides(_), Info),
1143 \info(conflicts(_), Info)
1144 ])).
1145
1146property(Label, Value) -->
1147 html(tr([th([Label, :]), td(Value)])).
1148
1149info(Term, Info) -->
1150 { findall(Term, member(Term, Info), [T0|More]), !
1151 },
1152 html(tr([th([\label(T0), :]), td(\value(T0))])),
1153 extra_values(More).
1154info(_, _) --> [].
1155
([]) --> [].
1157extra_values([H|T]) -->
1158 html(tr([th([]), td(\value(H))])),
1159 extra_values(T).
1160
1161label(Term) -->
1162 { prolog_pack:pack_level_info(_, Term, LabelFmt, _),
1163 ( LabelFmt = Label-_
1164 -> true
1165 ; Label = LabelFmt
1166 )
1167 },
1168 html(Label).
1169
1170value(Term) -->
1171 { name_address(Term, Name, Address) }, !,
1172 html([span(class(name), Name), ' ']),
1173 address(Address).
1174value(Term) -->
1175 { url(Term, Label, URL) },
1176 html(a(href(URL), Label)).
1177value(Term) -->
1178 { prolog_pack:pack_level_info(_, Term, LabelFmt, _),
1179 ( LabelFmt = _-Fmt
1180 -> true
1181 ; Fmt = '~w'
1182 ),
1183 Term =.. [_|Values]
1184 },
1185 html(Fmt-Values).
1186
1187address(Address) -->
1188 { sub_atom(Address, _, _, _, @) }, !,
1189 html(['<', Address, '>']).
1190address(URL) -->
1191 html(a(href(URL), URL)).
1192
1193name_address(author( Name, Address), Name, Address).
1194name_address(maintainer(Name, Address), Name, Address).
1195name_address(packager( Name, Address), Name, Address).
1196
1197url(home(URL), URL, URL).
1198url(download(Pattern), Pattern, URL) :-
1199 ( wildcard_pattern(Pattern)
1200 -> file_directory_name(Pattern, Dir),
1201 ensure_slash(Dir, URL)
1202 ; URL = Pattern
1203 ).
1204
1205wildcard_pattern(URL) :- sub_atom(URL, _, _, _, *).
1206wildcard_pattern(URL) :- sub_atom(URL, _, _, _, ?).
1207
1208ensure_slash(Dir, DirS) :-
1209 ( sub_atom(Dir, _, _, 0, /)
1210 -> DirS = Dir
1211 ; atom_concat(Dir, /, DirS)
1212 ).
1213
1218
1219pack_file_table(Pack) -->
1220 { setof(Version-Hash, pack_version_hash(Pack, Hash, Version), Pairs),
1221 group_pairs_by_key(Pairs, Grouped)
1222 },
1223 html(h2(class(wiki), 'Details by download location')),
1224 html(table(class(pack_file_table),
1225 [ tr([th('Version'), th('SHA1'), th('#Downloads'), th('URL')])
1226 | \pack_file_rows(Grouped)
1227 ])).
1228
1229pack_file_rows([]) --> [].
1230pack_file_rows([H|T]) --> pack_file_row(H), pack_file_rows(T).
1231
1232pack_file_row(Version-[H0|Hashes]) -->
1233 { sha1_downloads(H0, Count),
1234 sha1_urls(H0, [URL|URLs])
1235 },
1236 html(tr([ td(\version(Version)),
1237 td(\hash(H0)),
1238 \count(Count),
1239 td(\download_url(URL))
1240 ])),
1241 alt_urls(URLs),
1242 alt_hashes(Hashes),
1243 !.
1244pack_file_row(_) -->
1245 [].
1246
1247alt_urls([]) --> [].
1248alt_urls([H|T]) --> alt_url(H), alt_urls(T).
1249
1250alt_url(H) -->
1251 html(tr([td(''), td(''), td(''), td(\download_url(H))])).
1252
1253alt_hashes([]) --> [].
1254alt_hashes([H|T]) --> alt_hash(H), alt_hashes(T).
1255
1256alt_hash(H) -->
1257 { sha1_downloads(H, Count),
1258 sha1_urls(H, [URL|URLs])
1259 },
1260 html(tr([td(''), td(\hash(H)), \count(Count), td(\download_url(URL))])),
1261 alt_urls(URLs).
1262
1263hash(H) --> html(span(class(hash), H)).
1264download_url(URL) --> html(a(href(URL), URL)).
1265count(N) --> html(td(class(count), N)).
1266version(V) --> { atom_version(Atom, V) },
1267 html(Atom).
1268
1269pack_version_hash(Pack, Hash, Version) :-
1270 sha1_pack(Hash, Pack),
1271 sha1_version(Hash, Version).
1272
1273
1277
1278pack_file_details(Request) :-
1279 memberchk(path_info(SlashPackAndFile), Request),
1280 \+ sub_atom(SlashPackAndFile, _, _, _, '/../'), !,
1281 http_parameters(Request,
1282 [ public_only(Public),
1283 show(Show)
1284 ],
1285 [ attribute_declarations(pldoc_http:param)
1286 ]),
1287 atom_concat(/, PackAndFile, SlashPackAndFile),
1288 sub_atom(PackAndFile, B, _, A, /), !,
1289 sub_atom(PackAndFile, 0, B, _, Pack),
1290 sub_atom(PackAndFile, _, A, 0, File),
1291 pack_file_details(Pack, File,
1292 [ public_only(Public),
1293 show(Show)
1294 ]).
1295
1296
1297 1300
1306
1307atom_version(Atom, version(Parts)) :-
1308 ( atom(Atom)
1309 -> split_string(Atom, ".", "", Parts0),
1310 maplist(valid_version_part, Parts0, Parts)
1311 ; atomic_list_concat(Parts, '.', Atom)
1312 ).
1313
1314valid_version_part(String, Num) :-
1315 number_string(Num, String),
1316 !.
1317valid_version_part("*", _)