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, []).
81pack_query(Request) :-
82 proxy_master(Request),
83 !.
84pack_query(Request) :-
85 memberchk(content_type(ContentType), Request),
86 content_x_prolog(ContentType, ReplyType),
87 !,
88 http_peer(Request, Peer),
89 http_read_data(Request, Query,
90 [ content_type('application/x-prolog')
91 ]),
92 http_log('pack_query(~q, ~q).~n', [Query, Peer]),
93 format('Cache-Control: private~n'),
94 ( catch(pack_query(Query, Peer, Reply), E, true)
95 -> format('Content-type: ~w; charset=UTF-8~n~n', [ReplyType]),
96 ( var(E)
97 -> format('~q.~n', [true(Reply)]),
98 http_log('pack_query_done(ok, ~q).~n', [Peer])
99 ; format('~q.~n', [exception(E)]),
100 message_to_string(E, String),
101 http_log('pack_query_done(error(~q), ~q).~n', [String, Peer])
102 )
103 ; format('Content-type: ~w; charset=UTF-8~n~n', [ReplyType]),
104 format('false.~n'),
105 http_log('pack_query_done(failed, ~q).~n', [Peer])
106 ).
107
108content_x_prolog(ContentType, 'text/x-prolog') :-
109 sub_atom(ContentType, 0, _, _, 'text/x-prolog'),
110 !.
111content_x_prolog(ContentType, 'application/x-prolog') :-
112 sub_atom(ContentType, 0, _, _, 'application/x-prolog').
119proxy_master(Request) :-
120 option(host(Host), Request),
121 server(Role, Host),
122 Role \== master,
123 server(master, Master),
124 Master \== Host,
125 !,
126 http_peer(Request, Peer),
127 format(string(To), 'https://~w', [Master]),
128 proxy(To, Request,
129 [ request_headers([ 'X-Forwarded-For' = Peer,
130 'X-Real-IP' = Peer,
131 'Cache-Control' = 'no-cache'
132 ])
133 ]).
157pack_query(install(URL0, SHA10, Info), Peer, Reply) =>
158 to_atom(URL0, URL),
159 to_atom(SHA10, SHA1),
160 save_request(Peer, download(URL, SHA1, Info), Result),
161 ( Result = throw(Error)
162 -> throw(Error)
163 ; findall(ReplyInfo, install_info(URL, SHA1, ReplyInfo), Reply)
164 ).
165pack_query(downloaded(Data), Peer, Reply) =>
166 maplist(save_request(Peer), Data, Reply).
167pack_query(locate(Pack), _, Reply) =>
168 pack_version_urls_v1(Pack, Reply).
169pack_query(versions(Pack, Options), _, Reply) =>
170 pack_versions(Pack, Reply, Options).
171pack_query(search(Word), _, Reply) =>
172 search_packs(Word, Reply).
173pack_query(info(Packs), _, Hits) =>
174 convlist(pack_search_result, Packs, Hits).
175
176to_atom(Atom, Atom) :-
177 atom(Atom),
178 !.
179to_atom(String, Atom) :-
180 atom_string(Atom, String).
186pack_admin(Pack) -->
187 { admin_user },
188 !,
189 html(div(class('pack-admin'),
190 [ div(class('delete-pack'), \delete_button(Pack)),
191 div(style('clear:right'), \pattern_input(Pack))
192 ])).
193pack_admin(_) -->
194 [].
195
196delete_button(Pack) -->
197 { http_link_to_id(pack_delete, [], HREF)
198 },
199 html(form([ action(HREF),
200 class('delete-pack')
201 ],
202 [ input([ type(hidden), name(p), value(Pack)]),
203 button([type(submit)], 'Delete pack'),
204 &(nbsp)
205 ])).
206
207pattern_input(Pack) -->
208 { http_link_to_id(set_allowed_url, [], HREF),
209 ( pack_allowed_url(Pack, IsGit, Pattern)
210 -> true
211 ; pack_version_hashes(Pack, VersionHashes),
212 member(_-Hashes, VersionHashes),
213 member(Hash, Hashes),
214 sha1_url(Hash, URL)
215 -> url_pattern(URL, IsGit, Pattern)
216 ; Pattern = "",
217 IsGit = false
218 )
219 },
220 html(form([ action(HREF),
221 class('pack-set-url-pattern')
222 ],
223 [ input([ type(hidden), name(p), value(Pack)]),
224 label(for(url), 'URL pattern'),
225 input([ class('url-pattern'), name(url), value(Pattern)]),
226 input([ type(checkbox), name(git), value(IsGit)]),
227 label(for(git), 'Is GIT'),
228 button([type(submit)],
229 'Update URL pattern'),
230 &(nbsp)
231 ])).
232
233
234admin_user :-
235 current_prolog_flag(admin, true),
236 !.
237admin_user :-
238 site_user_logged_in(User),
239 site_user_property(User, granted(admin)).
245pack_delete(Request) :-
246 admin_user,
247 http_parameters(Request,
248 [ p(Pack, [optional(true)]),
249 h(Hash, [optional(true)])
250 ], []),
251 ( nonvar(Pack)
252 -> call_showing_messages(delete_pack(Pack), [])
253 ; nonvar(Hash)
254 -> call_showing_messages(delete_hash(Hash), [])
255 ).
256pack_delete(Request) :-
257 memberchk(path(Path), Request),
258 throw(http_reply(forbidden(Path))).
259
260
284install_info(URL, SHA1, Info) :-
285 install_info(URL, SHA1, Info, []).
286
287install_info(_, SHA1, _, Seen) :-
288 memberchk(SHA1, Seen), !, fail.
289install_info(URL, SHA1, alt_hash(Downloads, URLs, Hash), _) :-
290 prolog_pack:pack_url_file(URL, File),
291 sha1_file(Hash, File),
292 Hash \== SHA1,
293 \+ is_github_release(URL),
294 sha1_downloads(Hash, Downloads),
295 sha1_urls(Hash, URLs).
296install_info(_, SHA1, downloads(Count), _) :-
297 sha1_downloads(SHA1, Count).
298install_info(_, SHA1, dependency(Token, Pack, Version, URLs, SubDeps), Seen) :-
299 sha1_requires(SHA1, Token),
300 \+ is_prolog_token(Token), 301 ( ( sha1_pack(_Hash, Token),
302 Pack = Token
303 ; sha1_provides(Hash, Token),
304 sha1_pack(Hash, Pack),
305 Pack \== Token
306 ),
307 pack_latest_version(Pack, Hash1, _VersionTerm, _Older),
308 sha1_info(Hash1, Info),
309 memberchk(version(Version), Info),
310 findall(URL, sha1_url(Hash1, URL), URLs),
311 URLs \== []
312 -> findall(SubDep, install_info(-, Hash1, SubDep, [SHA1|Seen]), SubDeps)
313 ; Pack = (-), Version = (-), URLs = []
314 ).
320is_prolog_token(Token), cmp(Token, prolog, _Cmp, _Version) => true.
321is_prolog_token(prolog:_Feature) => true.
322is_prolog_token(_) => fail.
323
324sha1_downloads(Hash, Count) :-
325 aggregate_all(count, sha1_download(Hash, _), Count).
326
327sha1_urls(Hash, URLs) :-
328 findall(URL, sha1_url(Hash, URL), URLs).
329
330sha1_version(Hash, Version) :-
331 sha1_info(Hash, Info),
332 memberchk(version(Atom), Info),
333 atom_version(Atom, Version).
334
335sha1_title(Hash, Title) :-
336 sha1_info(Hash, Info),
337 ( memberchk(title(Title), Info)
338 -> true
339 ; Title = '<no title>'
340 ).
341
342sha1_is_git(Hash, Boolean) :-
343 sha1_info(Hash, Info),
344 ( memberchk(git(true), Info)
345 -> Boolean = true
346 ; Boolean = false
347 ).
355pack_version_hashes(Pack, VersionAHashesPairs) :-
356 findall(SHA1, sha1_pack(SHA1, Pack), Hashes),
357 map_list_to_pairs(sha1_version, Hashes, VersionHashPairs),
358 keysort(VersionHashPairs, Sorted),
359 group_pairs_by_key(Sorted, VersionHashesPairs),
360 reverse(VersionHashesPairs, RevPairs),
361 maplist(atomic_version_hashes, RevPairs, VersionAHashesPairs).
362
363atomic_version_hashes(Version-Hashes, VersionA-Hashes) :-
364 atom_version(VersionA, Version).
375pack_version_urls_v1(Pack, VersionURLs) :-
376 pack_version_hashes(Pack, VersionHashes),
377 maplist(version_hashes_urls, VersionHashes, VersionURLs).
378
379version_hashes_urls(Version-Hashes, Version-URLs) :-
380 maplist(sha1_url, Hashes, URLs0),
381 sort(URLs0, URLs).
412pack_versions(Packs, Deps, Options) :-
413 phrase(pack_versions(Packs, [seen(Deps)|Options]), Deps).
414
415pack_versions([], _) --> !.
416pack_versions([H|T], Options) -->
417 pack_versions(H, Options),
418 pack_versions(T, Options).
419pack_versions(Pack, Options) -->
420 { option(seen(Deps), Options),
421 seen(Pack, Deps)
422 },
423 !.
424pack_versions(Pack, Options) -->
425 { pack_version_hashes(Pack, VersionHashes),
426 convlist(version_hash_info(Pack, Options),
427 VersionHashes, Infos),
428 maplist(arg(2), Infos, RequiresLists),
429 append(RequiresLists, Requires0),
430 sort(Requires0, Requires),
431 maplist(arg(1), Infos, VersionInfo)
432 },
433 [ Pack-VersionInfo ],
434 include_pack_requirements(Requires, Options).
435
436seen(Pack, [Pack-_|_]) => true.
437seen(Pack, [_|T]) => seen(Pack, T).
438seen(_, _) => fail.
439
440version_hash_info(Pack, Options, Version-Hashes, info(Version-Info, Requires)) :-
441 maplist(hash_info(Pack, Options), Hashes, Info, Requires0),
442 append(Requires0, Requires1),
443 sort(Requires1, Requires).
444
445hash_info(Pack, _Options, Hash, Dict, Requires) :-
446 sha1_url(Hash, URL),
447 sha1_is_git(Hash, IsGit),
448 sha1_downloads(Hash, Count),
449 findall(Req, sha1_requires(Hash, Req), Requires),
450 findall(Prv, sha1_provides(Hash, Prv), Provides),
451 findall(Prv, sha1_conflicts(Hash, Prv), Conflicts),
452 Dict = #{ pack: Pack,
453 hash: Hash,
454 url: URL,
455 git: IsGit,
456 requires: Requires,
457 provides: Provides,
458 conflicts: Conflicts,
459 downloads: Count
460 }.
461
462include_pack_requirements([], _) --> !.
463include_pack_requirements([ReqToken|T], Options) -->
464 { findall(Unseen, resolves(ReqToken, Unseen), DepPacks)
465 },
466 pack_versions(DepPacks, Options),
467 include_pack_requirements(T, Options).
468
469resolves(ReqToken, Pack) :-
470 ( sha1_pack(Hash, Token),
471 sha1_version(Hash, Version),
472 PrvToken = @(Token,Version)
473 ; sha1_provides(Hash, PrvToken)
474 ),
475 satisfies(PrvToken, ReqToken),
476 sha1_pack(Hash, Pack).
477
478satisfies(Token, Token) => true.
479satisfies(@(Token,_), Token) => true.
480satisfies(@(Token,PrvVersion), Req), cmp(Req, Token, Cmp, ReqVersion) =>
481 atomic_list_concat(PrvVersion, PrvVersionAtom),
482 atomic_list_concat(ReqVersion, ReqVersionAtom),
483 cmp_versions(Cmp, PrvVersionAtom, ReqVersionAtom).
484satisfies(_,_) => fail.
485
486cmp(Token < Version, Token, <, Version).
487cmp(Token =< Version, Token, =<, Version).
488cmp(Token = Version, Token, =, Version).
489cmp(Token == Version, Token, ==, Version).
490cmp(Token >= Version, Token, >=, Version).
491cmp(Token > Version, Token, >, Version).
499search_packs(Search, Packs) :-
500 setof(Pack, matching_pack(Search, Pack), Names),
501 !,
502 maplist(pack_search_result, Names, Packs).
503
504matching_pack(Search, Pack) :-
505 sha1_pack(SHA1, Pack),
506 ( sub_atom_icasechk(Pack, _, Search)
507 -> true
508 ; sha1_title(SHA1, Title),
509 sub_atom_icasechk(Title, _, Search)
510 ).
511
512pack_search_result(Pack, pack(Pack, p, Title, VersionA, URLs)) :-
513 pack_latest_version(Pack, SHA1, Version, _Older),
514 sha1_title(SHA1, Title),
515 atom_version(VersionA, Version),
516 findall(URL, sha1_url(SHA1, URL), URLs).
517
518
519 522
523:- multifile error:has_type/2. 524
525error:has_type(dependency, Value) :-
526 is_dependency(Value, _Token, _Version).
527
528is_dependency(Token, Token, *) :-
529 atom(Token).
530is_dependency(Term, Token, VersionCmp) :-
531 Term =.. [Op,Token,Version],
532 cmp(Op, _),
533 version_data(Version, _),
534 VersionCmp =.. [Op,Version].
535
536cmp(<, @<).
537cmp(=<, @=<).
538cmp(==, ==).
539cmp(=, =).
540cmp(>=, @>=).
541cmp(>, @>).
542
543version_data(Version, version(Data)) :-
544 atomic_list_concat(Parts, '.', Version),
545 maplist(atom_number, Parts, Data).
546
547:- persistent
548 sha1_pack(sha1:atom, pack:atom),
549 sha1_file(sha1:atom, file:atom),
550 sha1_requires(sha1:atom, token:dependency),
551 sha1_provides(sha1:atom, token:dependency),
552 sha1_conflicts(sha1:atom, token:dependency),
553 sha1_info(sha1:atom, info:list),
554 sha1_url(sha1:atom, url:atom),
555 sha1_download(sha1:atom, peer:atom),
556 pack_allowed_url(pack:atom, isgit:boolean, pattern:atom). 557
558:- initialization
559 absolute_file_name(data('packs.db'), File,
560 [ access(write) ]),
561 db_attach(File, [sync(close)]),
562 populate_pack_url_patterns.
568delete_pack(PackName) :-
569 must_be(atom, PackName),
570 pack(PackName),
571 !,
572 clean_pack_info(PackName),
573 pack_unmirror(PackName),
574 forall(sha1_pack(Hash, PackName),
575 delete_hash(Hash)),
576 retractall_pack_allowed_url(PackName,_,_),
577 print_message(informational, delete_pack(PackName)).
578delete_pack(PackName) :-
579 existence_error(pack, PackName).
585delete_hash(Hash) :-
586 retractall_sha1_pack(Hash, _),
587 retractall_sha1_file(Hash, _),
588 retractall_sha1_requires(Hash, _),
589 retractall_sha1_provides(Hash, _),
590 retractall_sha1_conflicts(Hash, _),
591 retractall_sha1_info(Hash, _),
592 retractall_sha1_url(Hash, _),
593 retractall_sha1_download(Hash, _),
594 print_message(informational, delete_hash(Hash)).
602:- det(save_request/3). 603save_request(Peer, download(URL, Hash, Metadata), Result) =>
604 Result = Pack-Action,
605 memberchk(name(Pack), Metadata),
606 with_mutex(pack, save_request(URL, Hash, Metadata, Peer, Action)).
607
608save_request(URL, Hash, Metadata, Peer, Result) :-
609 ( Error = error(Formal,_),
610 catch(save_request_(URL, Hash, Metadata, Peer, Res0),
611 Error,
612 true)
613 -> ( var(Formal)
614 -> Result = Res0
615 ; Result = throw(Error)
616 )
617 ; Result = false
618 ).
619
620save_request_(URL, SHA1, Info, Peer, Result) :-
621 sha1_download(SHA1, Peer),
622 sha1_pack(SHA1, Peer), 623 !,
624 info_is_git(Info, IsGIT),
625 register_url(SHA1, IsGIT, URL, Result). 626save_request_(URL, SHA1, Info, Peer, Result) :-
627 memberchk(name(Pack), Info),
628 info_is_git(Info, IsGIT),
629 ( accept_url(URL, Pack, IsGIT)
630 -> register_url(SHA1, IsGIT, URL, Result0),
631 register_pack(SHA1, Pack),
632 register_info(SHA1, Info)
633 ; permission_error(register, pack(Pack), URL)
634 ),
635 assert_sha1_download(SHA1, Peer),
636 ( Result0 == no_change
637 -> Result = download
638 ; Result = Result0
639 ).
640
641info_is_git(Info, IsGIT) :-
642 memberchk(git(IsGIT), Info),
643 !.
644info_is_git(_, false).
651accept_url(URL, Pack, IsGIT) :-
652 ( pack_allowed_url(Pack, _, Pattern)
653 *-> wildcard_match(Pattern, URL), !
654 ; admissible_url(URL)
655 -> url_pattern(URL, IsGIT, Pattern),
656 assert_pack_allowed_url(Pack, IsGIT, Pattern)
657 ).
658
659admissible_url(URL) :-
660 uri_components(URL, Components),
661 uri_data(scheme, Components, Scheme),
662 uri_data(authority, Components, Authority),
663 uri_authority_components(Authority, AuthComponents),
664 uri_authority_data(host, AuthComponents, Host),
665 uri_authority_data(port, AuthComponents, Port),
666 \+ nonadmissible_host(Host),
667 admissible_scheme(Scheme, Port).
668
669nonadmissible_host(localhost).
670nonadmissible_host(IP) :-
671 split_string(IP, ".", "", Parts),
672 maplist(number_string, _, Parts).
673
674admissible_scheme(http, 80).
675admissible_scheme(https, 443).
676
677url_pattern(URL, true, URL) :- !.
678url_pattern(URL, false, Pattern) :-
679 site_pattern(URL, Pattern),
680 !.
681url_pattern(URL, false, Pattern) :-
682 ( atom_concat('http://', Rest, URL)
683 -> atom_concat('http{,s}://', Rest, URL2)
684 ; URL2 = URL
685 ),
686 file_directory_name(URL2, Dir),
687 atom_concat(Dir, '/*', Pattern).
688
689site_pattern(URL, Pattern) :-
690 sub_atom(URL, 0, _, _, 'https://gitlab.com/'),
691 git_user_project_pattern(URL, Pattern).
692site_pattern(URL, Pattern) :-
693 sub_atom(URL, 0, _, _, 'https://github.com/'),
694 git_user_project_pattern(URL, Pattern).
695
696git_user_project_pattern(URL, Pattern) :-
697 uri_components(URL, Components),
698 uri_data(path, Components, Path0),
699 split_string(Path0, "/", "/", [User,Project|_]),
700 atomic_list_concat([/, User, /, Project, /, *], Path),
701 uri_data(path, Components, Path, Components1),
702 uri_components(Pattern, Components1).
703
704populate_pack_url_patterns :-
705 forall(pack(Pack),
706 populate_pack_url_pattern(Pack)).
707
708populate_pack_url_pattern(Pack) :-
709 pack_allowed_url(Pack, _, _),
710 !.
711populate_pack_url_pattern(Pack) :-
712 findall(URL-IsGIT,
713 ( sha1_pack(SHA1, Pack),
714 sha1_info(SHA1, Info),
715 ( memberchk(git(IsGIT), Info)
716 -> true
717 ; IsGIT = false
718 ),
719 sha1_url(SHA1, URL)
720 ),
721 URLS),
722 last(URLS, URL-IsGIT),
723 url_pattern(URL, IsGIT, Pattern),
724 assert_pack_allowed_url(Pack, IsGIT, Pattern),
725 !.
726populate_pack_url_pattern(Pack) :-
727 print_message(error, pack(pattern_failed(Pack))).
733set_allowed_url(Request) :-
734 admin_user,
735 http_parameters(Request,
736 [ p(Pack, []),
737 url(Pattern, []),
738 git(IsGit, [boolean, optional(true)])
739 ], []),
740 call_showing_messages(set_allowed_url(Pack, IsGit, Pattern), []).
741set_allowed_url(Request) :-
742 memberchk(path(Path), Request),
743 throw(http_reply(forbidden(Path))).
744
745set_allowed_url(Pack, _IsGit, _Pattern) :-
746 \+ sha1_pack(_, Pack),
747 !,
748 existence_error(pack, Pack).
749set_allowed_url(Pack, IsGit, Pattern) :-
750 ( var(IsGit)
751 -> ( sub_atom(Pattern, _, _, _, *)
752 -> IsGit = false
753 ; IsGit = true
754 )
755 ; true
756 ),
757 retractall_pack_allowed_url(Pack, _, _),
758 assert_pack_allowed_url(Pack, IsGit, Pattern).
762register_pack(SHA1, Pack) :-
763 ( sha1_pack(SHA1, Pack)
764 -> true
765 ; assert_sha1_pack(SHA1, Pack)
766 ).
767
768register_info(SHA1, Info0) :-
769 sort(Info0, Info),
770 ( sha1_info(SHA1, _Info)
771 -> true
772 ; assert_sha1_info(SHA1, Info),
773 forall(member(requires(Token), Info),
774 register_requires(SHA1, Token)),
775 forall(member(provides(Token), Info),
776 register_provides(SHA1, Token)),
777 forall(member(conflicts(Token), Info),
778 register_conflicts(SHA1, Token))
779 ).
780
781register_requires(SHA1, Token) :-
782 ( sha1_requires(SHA1, Token)
783 -> true
784 ; assert_sha1_requires(SHA1, Token)
785 ).
786
787register_provides(SHA1, Token) :-
788 ( sha1_provides(SHA1, Token)
789 -> true
790 ; assert_sha1_provides(SHA1, Token)
791 ).
792
793register_conflicts(SHA1, Token) :-
794 ( sha1_conflicts(SHA1, Token)
795 -> true
796 ; assert_sha1_conflicts(SHA1, Token)
797 ).
803:- debug(pack(changed)). 804
805register_url(SHA1, IsGIT, URL, Result) :-
806 ( sha1_url(SHA1, URL)
807 -> Result = no_change
808 ; sha1_url(SHA2, URL),
809 \+ ( IsGIT == true,
810 hash_git_url(SHA2, URL)
811 ),
812 ( debug(pack(changed), '~p seems changed', [URL]),
813 is_github_release(URL)
814 -> debug(pack(changed), 'From github: ~p', [URL]),
815 retractall_sha1_url(SHA1, URL),
816 fail
817 ; true
818 )
819 -> Result = throw(pack(modified_hash(SHA1-URL, SHA2-[URL])))
820 ; IsGIT == true
821 -> assert_sha1_url(SHA1, URL),
822 Result = git(URL)
823 ; prolog_pack:pack_url_file(URL, File),
824 register_file(SHA1, File, URL),
825 assert_sha1_url(SHA1, URL),
826 Result = file(URL)
827 ).
834is_github_release(URL) :-
835 uri_components(URL, Components),
836 uri_data(scheme, Components, Scheme), Scheme == https,
837 uri_data(authority, Components, Auth), Auth == 'github.com',
838 uri_data(path, Components, Path), atomic(Path),
839 split_string(Path, "/", "", ["", _User, _Repo, "archive", Zip]),
840 file_name_extension(_, Ext, Zip),
841 github_archive_extension(Ext).
842
843github_archive_extension(tgz).
844github_archive_extension(zip).
845
846register_file(SHA1, File, URL) :-
847 ( sha1_file(SHA1, File)
848 -> true
849 ; sha1_file(SHA2, File),
850 sha1_urls(SHA2, URLs),
851 ( maplist(is_github_release, [URL|URLs])
852 -> retractall_sha1_file(SHA1, File),
853 fail
854 ; true
855 )
856 -> throw(pack(modified_hash(SHA1-URL, SHA2-URLs)))
857 ; assert_sha1_file(SHA1, File)
858 ).
864hash_git_url(SHA1, GitURL) :-
865 sha1_info(SHA1, Info),
866 memberchk(git(true), Info),
867 !,
868 sha1_url(SHA1, GitURL).
874hash_file_url(SHA1, FileURL) :-
875 sha1_info(SHA1, Info),
876 \+ memberchk(git(true), Info),
877 !,
878 sha1_url(SHA1, FileURL).
884pack_url_hash(URL, Hash) :-
885 sha1_url(Hash, URL).
891pack(Pack) :-
892 findall(Pack, sha1_pack(_,Pack), Packs),
893 sort(Packs, Sorted),
894 member(Pack, Sorted).
895
896
897
905pack_list(Request) :-
906 memberchk(path_info(SlashPack), Request),
907 atom_concat(/, Pack, SlashPack),
908 format(atom(Title), '"~w" pack for SWI-Prolog', [Pack]),
909 reply_html_page(pack(list),
910 title(Title),
911 [ \pack_listing(Pack, _Author, _Sort)
912 ]).
913pack_list(Request) :-
914 http_parameters(Request,
915 [ p(Pack, [optional(true)]),
916 author(Author, [optional(true)]),
917 sort(Sort, [ oneof([name,downloads,rating]),
918 optional(true),
919 default(name)
920 ])
921 ]),
922 ( ground(Pack)
923 -> format(atom(Title), '"~w" pack for SWI-Prolog', [Pack])
924 ; Title = 'SWI-Prolog packages'
925 ),
926 reply_html_page(pack(list),
927 title(Title),
928 [ \pack_listing(Pack, Author, Sort)
929 ]).
930
931pack_listing(Pack, _Author, _Sort) -->
932 { ground(Pack) },
933 !,
934 html([ h1(class(wiki), 'Package "~w"'-[Pack]),
935 \html_requires(css('pack.css')),
936 \pack_info(Pack)
937 ]).
938pack_listing(_Pack, Author, SortBy) -->
939 { ( nonvar(Author)
940 -> Filter = [author(Author)]
941 ; Filter = []
942 ),
943 ( setof(Pack, current_pack(Filter, Pack), Packs)
944 -> true
945 ; Packs = []
946 ),
947 sort_packs(SortBy, Packs, Sorted)
948 },
949 html({|html||
950<p>
951Below is a list of known packages. Please be aware that packages are
952<b>not moderated</b>. Installing a pack does not execute code in the
953pack, but simply loading a library from the pack may execute arbitrary
954code. More information about packages is available <a
955href="/howto/Pack.html">here</a>. You can search for packages from
956the Prolog command line using pack_list/1. This contacts the pack
957server for packs that match by name or title. A leading <b>i</b>
958indicates that the pack is already installed, while <b>p</b> merely
959indicates that it is known by the server.
960</p>
961
962<pre class="code">
963?- pack_list(graph).
964p callgraph@0.3.4 - Predicate call graph visualisation
965i graphml@0.1.0 - Write GraphML files
966i gvterm@1.1 - Show Prolog terms using graphviz
967p musicbrainz@0.6.3 - Musicbrainz client library
968p sindice@0.0.3 - Access to Sindice semantic web search engine
969</pre>
970
971<p>
972After finding the right pack, the pack and its dependencies can be installed
973using the pack_install/1 as illustrated below.
974</p>
975
976<pre class="code">
977?- pack_install(hello).
978</pre>
979
980<p>
981Clicking the package shows details and allows you to rate and comment
982the pack.
983</p>
984 |}),
985 pack_table(Sorted, [sort_by(SortBy)]),
986 html_receive(rating_scripts).
992pack_table(Packs, Options) -->
993 { option(sort_by(SortBy), Options, -),
994 length(Packs, PackCount),
995 maplist(pack_downloads, Packs, Totals),
996 sum_list(Totals, Total)
997 },
998 html_requires(css('pack.css')),
999 html(table(class(packlist),
1000 [ tr([ \pack_header(name, SortBy,
1001 'Pack', ['tot: ~D'-[PackCount]]),
1002 \pack_header(version, SortBy,
1003 'Version', '(#older)'),
1004 \pack_header(downloads, SortBy,
1005 'Downloads', ['tot: ~D'-[Total],
1006 br([]), '(#latest)']),
1007 \pack_header(rating, SortBy,
1008 'Rating', ['(#votes/', br([]),
1009 '#comments)']),
1010 \pack_header(title, SortBy,
1011 'Title', [])
1012 ])
1013 | \pack_rows(Packs)
1014 ])).
1015
1016
1017pack_rows([]) --> [].
1018pack_rows([H|T]) --> pack_row(H), pack_rows(T).
1019
1020pack_row(Pack) -->
1021 { pack_name(Pack, Name),
1022 http_link_to_id(pack_list, [p(Name)], HREF)
1023 },
1024 html(tr([ td(a(href(HREF),Name)),
1025 td(class('pack-version'), \pack_version(Pack)),
1026 td(class('pack-downloads'), \pack_downloads(Pack)),
1027 td(class('pack-rating'), \pack_rating(Pack)),
1028 td(class('pack-title'), \pack_title(Pack))
1029 ])).
1030
(Name, -, Title, Subtitle) -->
1032 !,
1033 html(th(id(Name), [Title, \subtitle(Subtitle)])).
1034pack_header(Name, SortBy, Title, Subtitle) -->
1035 { Name \== SortBy,
1036 sortable(Name),
1037 !,
1038 http_link_to_id(pack_list, [sort(Name)], HREF)
1039 },
1040 html(th(id(Name), [ a([class(resort),href(HREF)], Title),
1041 \subtitle(Subtitle)
1042 ])).
1043pack_header(Name, Name, Title, Subtitle) -->
1044 html(th(id(Name), [i(class(sorted), Title), \subtitle(Subtitle)])).
1045pack_header(Name, _, Title, Subtitle) -->
1046 html(th(id(Name), [Title, \subtitle(Subtitle)])).
1047
1048subtitle([]) --> [].
1049subtitle(Subtitle) --> html(div(class(sth), Subtitle)).
1050
1051
1052sortable(name).
1053sortable(downloads).
1054sortable(rating).
1055
1056pack_version(Pack) -->
1057 { pack_version(Pack, Version),
1058 pack_older_versions(Pack, Older),
1059 atom_version(Atom, Version)
1060 },
1061 ( { Older =\= 0 }
1062 -> html([Atom, span(class(annot), '~D'-[Older])])
1063 ; html(Atom)
1064 ).
1065
1066pack_downloads(Pack) -->
1067 { pack_downloads(Pack, Total),
1068 pack_download_latest(Pack, DownLoadLatest)
1069 },
1070 ( { Total =:= DownLoadLatest }
1071 -> html('~D'-[Total])
1072 ; html(['~D'-[Total], span(class(annot), '~D'-[DownLoadLatest])])
1073 ).
1074
1075pack_rating(Pack) -->
1076 { pack_rating(Pack, Rating),
1077 pack_votes(Pack, Votes),
1078 pack_comments(Pack, CommentCount),
1079 pack_name(Pack, Name),
1080 http_link_to_id(pack_rating, [], OnRating)
1081 },
1082 show_pack_rating(Name, Rating, Votes, CommentCount,
1083 [ on_rating(OnRating)
1084 ]).
1085
1086pack_title(Pack) -->
1087 { pack_hash(Pack, SHA1),
1088 sha1_title(SHA1, Title)
1089 },
1090 html(Title).
1091
1092:- record
1093 pack(name:atom, 1094 hash:atom, 1095 version:list(integer), 1096 older_versions:integer, 1097 downloads:integer, 1098 download_latest:integer, 1099 rating:number, 1100 votes:integer, 1101 comments:integer).
1111current_pack(Filters,
1112 pack(Pack, SHA1,
1113 Version, OlderVersionCount,
1114 Downloads, DLLatest,
1115 Rating, Votes, CommentCount)) :-
1116 setof(Pack, H^sha1_pack(H,Pack), Packs),
1117 member(Pack, Packs),
1118 pack_latest_version(Pack, SHA1, Version, OlderVersionCount),
1119 maplist(pack_filter(SHA1), Filters),
1120 pack_downloads(Pack, SHA1, Downloads, DLLatest),
1121 pack_rating_votes(Pack, Rating, Votes),
1122 pack_comment_count(Pack, CommentCount).
1123
1124pack_filter(SHA1, author(Author)) :-
1125 sha1_info(SHA1, Info),
1126 member(author(Name, Contact), Info),
1127 once(author_match(Author, Name, Contact)).
1128
1129author_match(Author, Author, _). 1130author_match(Author, _, Author). 1131author_match(UUID, Name, Contact) :- 1132 ( site_user_property(UUID, name(Name))
1133 ; site_user_property(UUID, email(Contact))
1134 ; site_user_property(UUID, home_url(Contact))
1135 ).
1140sort_packs(By, Packs, Sorted) :-
1141 map_list_to_pairs(pack_data(By), Packs, Keyed),
1142 keysort(Keyed, KeySorted),
1143 pairs_values(KeySorted, Sorted0),
1144 reverse_sort(By, Sorted0, Sorted).
1145
1146reverse_sort(name, Packs, Packs) :- !.
1147reverse_sort(_, Packs, RevPacks) :-
1148 reverse(Packs, RevPacks).
1149
1150
1151pack_downloads(Pack, SHA1, Total, DownLoadLatest) :-
1152 setof(Hash, sha1_pack(Hash, Pack), Hashes),
1153 map_list_to_pairs(sha1_downloads, Hashes, Pairs),
1154 memberchk(DownLoadLatest-SHA1, Pairs),
1155 pairs_keys(Pairs, Counts),
1156 sum_list(Counts, Total).
1163pack_latest_version(Pack, SHA1, Version, Older) :-
1164 setof(SHA1, sha1_pack(SHA1, Pack), Hashes),
1165 map_list_to_pairs(sha1_version, Hashes, Versions),
1166 keysort(Versions, Sorted),
1167 length(Sorted, Count),
1168 Older is Count - 1,
1169 last(Sorted, Version-SHA1).
1170
1171
1172
1183pack_info(Pack) -->
1184 { \+ pack(Pack) },
1185 !,
1186 html(p(class(warning),
1187 'Sorry, I know nothing about a pack named "~w"'-[Pack])).
1188pack_info(Pack) -->
1189 pack_admin(Pack),
1190 pack_info_table(Pack),
1191 pack_reviews(Pack),
1192 pack_file_table(Pack),
1193 ( pack_readme(Pack) -> [] ; [] ),
1194 ( pack_file_hierarchy(Pack)
1195 -> []
1196 ; html(p(class(warning), 'Failed to process pack'))
1197 ).
1203pack_info_table(Pack) -->
1204 { pack_latest_version(Pack, SHA1, Version, _Older),
1205 atom_version(VersionA, Version),
1206 sha1_title(SHA1, Title),
1207 sha1_info(SHA1, Info)
1208 },
1209 html(table(class(pack),
1210 [ \property('Title', span(class(title), Title)),
1211 \property('Rating', \show_pack_rating(Pack)),
1212 \property('Latest version', VersionA),
1213 \property('SHA1 sum', \hash(SHA1)),
1214 \info(author(_,_), Info),
1215 \info(maintainer(_,_), Info),
1216 \info(packager(_,_), Info),
1217 \info(home(_), Info),
1218 \info(download(_), Info),
1219 \info(requires(_), Info),
1220 \info(provides(_), Info),
1221 \info(conflicts(_), Info)
1222 ])).
1223
1224property(Label, Value) -->
1225 html(tr([th([Label, :]), td(Value)])).
1226
1227info(Term, Info) -->
1228 { findall(Term, member(Term, Info), [T0|More]), !
1229 },
1230 html(tr([th([\label(T0), :]), td(\value(T0))])),
1231 extra_values(More).
1232info(_, _) --> [].
1233
([]) --> [].
1235extra_values([H|T]) -->
1236 html(tr([th([]), td(\value(H))])),
1237 extra_values(T).
1238
1239label(Term) -->
1240 { prolog_pack:pack_level_info(_, Term, LabelFmt, _),
1241 ( LabelFmt = Label-_
1242 -> true
1243 ; Label = LabelFmt
1244 )
1245 },
1246 html(Label).
1247
1248value(Term) -->
1249 { name_address(Term, Name, Address) },
1250 !,
1251 html([span(class(name), Name), ' ']),
1252 address(Address).
1253value(Term) -->
1254 { url(Term, Label, URL) },
1255 html(a(href(URL), Label)).
1256value(Term) -->
1257 { prolog_pack:pack_level_info(_, Term, LabelFmt, _),
1258 ( LabelFmt = _-Fmt
1259 -> true
1260 ; Fmt = '~w'
1261 ),
1262 Term =.. [_|Values]
1263 },
1264 html(Fmt-Values).
1265
1266address(Address) -->
1267 { sub_atom(Address, _, _, _, @) },
1268 !,
1269 html(['<', Address, '>']).
1270address(URL) -->
1271 html(a(href(URL), URL)).
1272
1273name_address(author( Name, Address), Name, Address).
1274name_address(maintainer(Name, Address), Name, Address).
1275name_address(packager( Name, Address), Name, Address).
1276
1277url(home(URL), URL, URL).
1278url(download(Pattern), Pattern, URL) :-
1279 ( wildcard_pattern(Pattern)
1280 -> file_directory_name(Pattern, Dir),
1281 ensure_slash(Dir, URL)
1282 ; URL = Pattern
1283 ).
1284
1285wildcard_pattern(URL) :- sub_atom(URL, _, _, _, *).
1286wildcard_pattern(URL) :- sub_atom(URL, _, _, _, ?).
1287
1288ensure_slash(Dir, DirS) :-
1289 ( sub_atom(Dir, _, _, 0, /)
1290 -> DirS = Dir
1291 ; atom_concat(Dir, /, DirS)
1292 ).
1299pack_file_table(Pack) -->
1300 { findall(Version-Hash, pack_version_hash(Pack, Hash, Version), Pairs0),
1301 sort(1, @>=, Pairs0, Pairs),
1302 group_pairs_by_key(Pairs, Grouped)
1303 },
1304 html(h2(class(wiki), 'Details by download location')),
1305 html(table(class(pack_file_table),
1306 [ tr([th('Version'), th('SHA1'), th('#Downloads'), th('URL')])
1307 | \pack_file_rows(Grouped)
1308 ])).
1309
1310pack_file_rows([]) --> [].
1311pack_file_rows([H|T]) --> pack_file_row(H), pack_file_rows(T).
1312
1313pack_file_row(Version-[H0|Hashes]) -->
1314 { sha1_downloads(H0, Count),
1315 sha1_urls(H0, [URL|URLs])
1316 },
1317 html(tr([ td(\version(Version)),
1318 td(style('white-space: nowrap'), \hash(H0)),
1319 \count(Count),
1320 td(\download_url(URL))
1321 ])),
1322 alt_urls(URLs),
1323 alt_hashes(Hashes),
1324 !.
1325pack_file_row(_) -->
1326 [].
1327
1328alt_urls([]) --> [].
1329alt_urls([H|T]) --> alt_url(H), alt_urls(T).
1330
1331alt_url(H) -->
1332 html(tr([td(''), td(''), td(''), td(\download_url(H))])).
1333
1334alt_hashes([]) --> [].
1335alt_hashes([H|T]) --> alt_hash(H), alt_hashes(T).
1336
1337alt_hash(H) -->
1338 { sha1_downloads(H, Count),
1339 sha1_urls(H, [URL|URLs])
1340 },
1341 html(tr([td(''), td(\hash(H)), \count(Count), td(\download_url(URL))])),
1342 alt_urls(URLs).
1343
1344hash(H) --> html(span(class(hash), H)), del_hash_link(H).
1345download_url(URL) --> html(a(href(URL), URL)).
1346count(N) --> html(td(class(count), N)).
1347version(V) --> { atom_version(Atom, V) },
1348 html(Atom).
1349
1350del_hash_link(Hash) -->
1351 { admin_user,
1352 !,
1353 http_link_to_id(pack_delete, [h=Hash], HREF)
1354 },
1355 !,
1356 html(a([class('delete-hash'), href(HREF)], '\U0001F5D1')).
1357del_hash_link(_) -->
1358 [].
1359
1360pack_version_hash(Pack, Hash, Version) :-
1361 sha1_pack(Hash, Pack),
1362 sha1_version(Hash, Version).
1368pack_file_details(Request) :-
1369 memberchk(path_info(SlashPackAndFile), Request),
1370 \+ sub_atom(SlashPackAndFile, _, _, _, '/../'),
1371 !,
1372 http_parameters(Request,
1373 [ public_only(Public),
1374 show(Show)
1375 ],
1376 [ attribute_declarations(pldoc_http:param)
1377 ]),
1378 atom_concat(/, PackAndFile, SlashPackAndFile),
1379 sub_atom(PackAndFile, B, _, A, /),
1380 !,
1381 sub_atom(PackAndFile, 0, B, _, Pack),
1382 sub_atom(PackAndFile, _, A, 0, File),
1383 pack_file_details(Pack, File,
1384 [ public_only(Public),
1385 show(Show)
1386 ]).
1387
1388
1389
1399atom_version(Atom, version(Parts)) :-
1400 ( atom(Atom)
1401 -> split_string(Atom, ".", "", Parts0),
1402 maplist(valid_version_part, Parts0, Parts)
1403 ; atomic_list_concat(Parts, '.', Atom)
1404 ).
1405
1406valid_version_part(String, Num) :-
1407 number_string(Num, String),
1408 !.
1409valid_version_part("*", _).
1410
1411 1414
1415:- multifile prolog:message//1. 1416
1417prolog:message(delete_pack(Pack)) -->
1418 [ 'Deleted pack ~p'-[Pack] ].
1419prolog:message(delete_hash(Hash)) -->
1420 [ 'Deleted hash ~p'-[Hash] ]