36
37:- module(prolog_pack,
38 [ pack_list_installed/0,
39 pack_info/1, 40 pack_list/1, 41 pack_search/1, 42 pack_install/1, 43 pack_install/2, 44 pack_upgrade/1, 45 pack_rebuild/1, 46 pack_rebuild/0, 47 pack_remove/1, 48 pack_property/2, 49 pack_attach/2, 50
51 pack_url_file/2 52 ]). 53:- use_module(library(apply)). 54:- use_module(library(error)). 55:- use_module(library(option)). 56:- use_module(library(readutil)). 57:- use_module(library(lists)). 58:- use_module(library(filesex)). 59:- use_module(library(xpath)). 60:- use_module(library(settings)). 61:- use_module(library(uri)). 62:- use_module(library(dcg/basics)). 63:- use_module(library(http/http_open)). 64:- use_module(library(http/json)). 65:- use_module(library(http/http_client), []). 66:- use_module(library(prolog_config)). 67:- use_module(library(debug), [assertion/1]). 68:- use_module(library(pairs), [group_pairs_by_key/2]). 70:- autoload(library(git)). 71:- autoload(library(sgml)). 72:- autoload(library(sha)). 73:- autoload(library(build/tools)). 74
109
110:- multifile
111 environment/2. 112
113:- dynamic
114 pack_requires/2, 115 pack_provides_db/2. 116
117
118 121
122:- setting(server, atom, 'https://www.swi-prolog.org/pack/',
123 'Server to exchange pack information'). 124
125
126 129
134
135current_pack(Pack) :-
136 current_pack(Pack, _).
137
138current_pack(Pack, Dir) :-
139 '$pack':pack(Pack, Dir).
140
148
149pack_list_installed :-
150 findall(Pack, current_pack(Pack), Packages0),
151 Packages0 \== [],
152 !,
153 sort(Packages0, Packages),
154 length(Packages, Count),
155 format('Installed packages (~D):~n~n', [Count]),
156 maplist(pack_info(list), Packages),
157 validate_dependencies.
158pack_list_installed :-
159 print_message(informational, pack(no_packages_installed)).
160
164
165pack_info(Name) :-
166 pack_info(info, Name).
167
168pack_info(Level, Name) :-
169 must_be(atom, Name),
170 findall(Info, pack_info(Name, Level, Info), Infos0),
171 ( Infos0 == []
172 -> print_message(warning, pack(no_pack_installed(Name))),
173 fail
174 ; true
175 ),
176 update_dependency_db(Name, Infos0),
177 findall(Def, pack_default(Level, Infos, Def), Defs),
178 append(Infos0, Defs, Infos1),
179 sort(Infos1, Infos),
180 show_info(Name, Infos, [info(Level)]).
181
182
183show_info(_Name, _Properties, Options) :-
184 option(silent(true), Options),
185 !.
186show_info(Name, Properties, Options) :-
187 option(info(list), Options),
188 !,
189 memberchk(title(Title), Properties),
190 memberchk(version(Version), Properties),
191 format('i ~w@~w ~28|- ~w~n', [Name, Version, Title]).
192show_info(Name, Properties, _) :-
193 !,
194 print_property_value('Package'-'~w', [Name]),
195 findall(Term, pack_level_info(info, Term, _, _), Terms),
196 maplist(print_property(Properties), Terms).
197
198print_property(_, nl) :-
199 !,
200 format('~n').
201print_property(Properties, Term) :-
202 findall(Term, member(Term, Properties), Terms),
203 Terms \== [],
204 !,
205 pack_level_info(_, Term, LabelFmt, _Def),
206 ( LabelFmt = Label-FmtElem
207 -> true
208 ; Label = LabelFmt,
209 FmtElem = '~w'
210 ),
211 multi_valued(Terms, FmtElem, FmtList, Values),
212 atomic_list_concat(FmtList, ', ', Fmt),
213 print_property_value(Label-Fmt, Values).
214print_property(_, _).
215
216multi_valued([H], LabelFmt, [LabelFmt], Values) :-
217 !,
218 H =.. [_|Values].
219multi_valued([H|T], LabelFmt, [LabelFmt|LT], Values) :-
220 H =.. [_|VH],
221 append(VH, MoreValues, Values),
222 multi_valued(T, LabelFmt, LT, MoreValues).
223
224
225pvalue_column(24).
226print_property_value(Prop-Fmt, Values) :-
227 !,
228 pvalue_column(C),
229 atomic_list_concat(['~w:~t~*|', Fmt, '~n'], Format),
230 format(Format, [Prop,C|Values]).
231
232pack_info(Name, Level, Info) :-
233 '$pack':pack(Name, BaseDir),
234 ( Info = directory(BaseDir)
235 ; pack_info_term(BaseDir, Info)
236 ),
237 pack_level_info(Level, Info, _Format, _Default).
238
239:- public pack_level_info/4. 240
241pack_level_info(_, title(_), 'Title', '<no title>').
242pack_level_info(_, version(_), 'Installed version', '<unknown>').
243pack_level_info(info, directory(_), 'Installed in directory', -).
244pack_level_info(info, author(_, _), 'Author'-'~w <~w>', -).
245pack_level_info(info, maintainer(_, _), 'Maintainer'-'~w <~w>', -).
246pack_level_info(info, packager(_, _), 'Packager'-'~w <~w>', -).
247pack_level_info(info, home(_), 'Home page', -).
248pack_level_info(info, download(_), 'Download URL', -).
249pack_level_info(_, provides(_), 'Provides', -).
250pack_level_info(_, requires(_), 'Requires', -).
251pack_level_info(_, conflicts(_), 'Conflicts with', -).
252pack_level_info(_, replaces(_), 'Replaces packages', -).
253pack_level_info(info, library(_), 'Provided libraries', -).
254
255pack_default(Level, Infos, Def) :-
256 pack_level_info(Level, ITerm, _Format, Def),
257 Def \== (-),
258 \+ memberchk(ITerm, Infos).
259
263
264pack_info_term(BaseDir, Info) :-
265 directory_file_path(BaseDir, 'pack.pl', InfoFile),
266 catch(
267 setup_call_cleanup(
268 open(InfoFile, read, In),
269 term_in_stream(In, Info),
270 close(In)),
271 error(existence_error(source_sink, InfoFile), _),
272 ( print_message(error, pack(no_meta_data(BaseDir))),
273 fail
274 )).
275pack_info_term(BaseDir, library(Lib)) :-
276 atom_concat(BaseDir, '/prolog/', LibDir),
277 atom_concat(LibDir, '*.pl', Pattern),
278 expand_file_name(Pattern, Files),
279 maplist(atom_concat(LibDir), Plain, Files),
280 convlist(base_name, Plain, Libs),
281 member(Lib, Libs).
282
283base_name(File, Base) :-
284 file_name_extension(Base, pl, File).
285
286term_in_stream(In, Term) :-
287 repeat,
288 read_term(In, Term0, []),
289 ( Term0 == end_of_file
290 -> !, fail
291 ; Term = Term0,
292 valid_info_term(Term0)
293 ).
294
295valid_info_term(Term) :-
296 Term =.. [Name|Args],
297 same_length(Args, Types),
298 Decl =.. [Name|Types],
299 ( pack_info_term(Decl)
300 -> maplist(valid_info_arg, Types, Args)
301 ; print_message(warning, pack(invalid_info(Term))),
302 fail
303 ).
304
305valid_info_arg(Type, Arg) :-
306 must_be(Type, Arg).
307
312
313pack_info_term(name(atom)). 314pack_info_term(title(atom)).
315pack_info_term(keywords(list(atom))).
316pack_info_term(description(list(atom))).
317pack_info_term(version(version)).
318pack_info_term(author(atom, email_or_url_or_empty)). 319pack_info_term(maintainer(atom, email_or_url)).
320pack_info_term(packager(atom, email_or_url)).
321pack_info_term(pack_version(nonneg)). 322pack_info_term(home(atom)). 323pack_info_term(download(atom)). 324pack_info_term(provides(atom)). 325pack_info_term(requires(dependency)).
326pack_info_term(conflicts(dependency)). 327pack_info_term(replaces(atom)). 328pack_info_term(autoload(boolean)). 329
330:- multifile
331 error:has_type/2. 332
333error:has_type(version, Version) :-
334 atom(Version),
335 version_data(Version, _Data).
336error:has_type(email_or_url, Address) :-
337 atom(Address),
338 ( sub_atom(Address, _, _, _, @)
339 -> true
340 ; uri_is_global(Address)
341 ).
342error:has_type(email_or_url_or_empty, Address) :-
343 ( Address == ''
344 -> true
345 ; error:has_type(email_or_url, Address)
346 ).
347error:has_type(dependency, Value) :-
348 is_dependency(Value, _Token, _Version).
349
350version_data(Version, version(Data)) :-
351 atomic_list_concat(Parts, '.', Version),
352 maplist(atom_number, Parts, Data).
353
354is_dependency(Token, Token, *) :-
355 atom(Token).
356is_dependency(Term, Token, VersionCmp) :-
357 Term =.. [Op,Token,Version],
358 cmp(Op, _),
359 version_data(Version, _),
360 VersionCmp =.. [Op,Version].
361
362cmp(<, @<).
363cmp(=<, @=<).
364cmp(==, ==).
365cmp(>=, @>=).
366cmp(>, @>).
367
368
369 372
399
400pack_list(Query) :-
401 pack_search(Query).
402
403pack_search(Query) :-
404 query_pack_server(search(Query), Result, []),
405 ( Result == false
406 -> ( local_search(Query, Packs),
407 Packs \== []
408 -> forall(member(pack(Pack, Stat, Title, Version, _), Packs),
409 format('~w ~w@~w ~28|- ~w~n',
410 [Stat, Pack, Version, Title]))
411 ; print_message(warning, pack(search_no_matches(Query)))
412 )
413 ; Result = true(Hits),
414 local_search(Query, Local),
415 append(Hits, Local, All),
416 sort(All, Sorted),
417 list_hits(Sorted)
418 ).
419
420list_hits([]).
421list_hits([ pack(Pack, i, Title, Version, _),
422 pack(Pack, p, Title, Version, _)
423 | More
424 ]) :-
425 !,
426 format('i ~w@~w ~28|- ~w~n', [Pack, Version, Title]),
427 list_hits(More).
428list_hits([ pack(Pack, i, Title, VersionI, _),
429 pack(Pack, p, _, VersionS, _)
430 | More
431 ]) :-
432 !,
433 version_data(VersionI, VDI),
434 version_data(VersionS, VDS),
435 ( VDI @< VDS
436 -> Tag = ('U')
437 ; Tag = ('A')
438 ),
439 format('~w ~w@~w(~w) ~28|- ~w~n', [Tag, Pack, VersionI, VersionS, Title]),
440 list_hits(More).
441list_hits([ pack(Pack, i, Title, VersionI, _)
442 | More
443 ]) :-
444 !,
445 format('l ~w@~w ~28|- ~w~n', [Pack, VersionI, Title]),
446 list_hits(More).
447list_hits([pack(Pack, Stat, Title, Version, _)|More]) :-
448 format('~w ~w@~w ~28|- ~w~n', [Stat, Pack, Version, Title]),
449 list_hits(More).
450
451
452local_search(Query, Packs) :-
453 findall(Pack, matching_installed_pack(Query, Pack), Packs).
454
455matching_installed_pack(Query, pack(Pack, i, Title, Version, URL)) :-
456 current_pack(Pack),
457 findall(Term,
458 ( pack_info(Pack, _, Term),
459 search_info(Term)
460 ), Info),
461 ( sub_atom_icasechk(Pack, _, Query)
462 -> true
463 ; memberchk(title(Title), Info),
464 sub_atom_icasechk(Title, _, Query)
465 ),
466 option(title(Title), Info, '<no title>'),
467 option(version(Version), Info, '<no version>'),
468 option(download(URL), Info, '<no download url>').
469
470search_info(title(_)).
471search_info(version(_)).
472search_info(download(_)).
473
474
475 478
497
498pack_install(Spec) :-
499 pack_default_options(Spec, Pack, [], Options),
500 pack_install(Pack, [pack(Pack)|Options]).
501
506
507pack_default_options(_Spec, Pack, OptsIn, Options) :-
508 option(already_installed(pack(Pack,_Version)), OptsIn),
509 !,
510 Options = OptsIn.
511pack_default_options(_Spec, Pack, OptsIn, Options) :-
512 option(url(URL), OptsIn),
513 !,
514 ( option(git(_), OptsIn)
515 -> Options = OptsIn
516 ; git_url(URL, Pack)
517 -> Options = [git(true)|OptsIn]
518 ; Options = OptsIn
519 ),
520 ( nonvar(Pack)
521 -> true
522 ; option(pack(Pack), Options)
523 -> true
524 ; pack_version_file(Pack, _Version, URL)
525 ).
526pack_default_options(Archive, Pack, _, Options) :- 527 must_be(atom, Archive),
528 \+ uri_is_global(Archive),
529 expand_file_name(Archive, [File]),
530 exists_file(File),
531 !,
532 pack_version_file(Pack, Version, File),
533 uri_file_name(FileURL, File),
534 Options = [url(FileURL), version(Version)].
535pack_default_options(URL, Pack, _, Options) :-
536 git_url(URL, Pack),
537 !,
538 Options = [git(true), url(URL)].
539pack_default_options(FileURL, Pack, _, Options) :- 540 uri_file_name(FileURL, Dir),
541 exists_directory(Dir),
542 pack_info_term(Dir, name(Pack)),
543 !,
544 ( pack_info_term(Dir, version(Version))
545 -> uri_file_name(DirURL, Dir),
546 Options = [url(DirURL), version(Version)]
547 ; throw(error(existence_error(key, version, Dir),_))
548 ).
549pack_default_options('.', Pack, _, Options) :- 550 pack_info_term('.', name(Pack)),
551 !,
552 working_directory(Dir, Dir),
553 ( pack_info_term(Dir, version(Version))
554 -> uri_file_name(DirURL, Dir),
555 Options = [url(DirURL), version(Version) | Options1],
556 ( current_prolog_flag(windows, true)
557 -> Options1 = []
558 ; Options1 = [link(true), rebuild(make)]
559 )
560 ; throw(error(existence_error(key, version, Dir),_))
561 ).
562pack_default_options(URL, Pack, _, Options) :- 563 pack_version_file(Pack, Version, URL),
564 download_url(URL),
565 !,
566 available_download_versions(URL, [URLVersion-LatestURL|_]),
567 Options = [url(LatestURL)|VersionOptions],
568 version_options(Version, URLVersion, VersionOptions).
569pack_default_options(Pack, Pack, OptsIn, Options) :- 570 \+ uri_is_global(Pack), 571 query_pack_server(locate(Pack), Reply, OptsIn),
572 ( Reply = true(Results)
573 -> pack_select_candidate(Pack, Results, OptsIn, Options)
574 ; print_message(warning, pack(no_match(Pack))),
575 fail
576 ).
577
578version_options(Version, Version, [version(Version)]) :- !.
579version_options(Version, _, [version(Version)]) :-
580 Version = version(List),
581 maplist(integer, List),
582 !.
583version_options(_, _, []).
584
588
589pack_select_candidate(Pack, [AtomVersion-_|_], Options,
590 [already_installed(pack(Pack, Installed))|Options]) :-
591 current_pack(Pack),
592 pack_info(Pack, _, version(InstalledAtom)),
593 atom_version(InstalledAtom, Installed),
594 atom_version(AtomVersion, Version),
595 Installed @>= Version,
596 !.
597pack_select_candidate(Pack, Available, Options, OptsOut) :-
598 option(url(URL), Options),
599 memberchk(_Version-URLs, Available),
600 memberchk(URL, URLs),
601 !,
602 ( git_url(URL, Pack)
603 -> Extra = [git(true)]
604 ; Extra = []
605 ),
606 OptsOut = [url(URL), inquiry(true) | Extra].
607pack_select_candidate(Pack, [Version-[URL]|_], Options,
608 [url(URL), git(true), inquiry(true)]) :-
609 git_url(URL, Pack),
610 !,
611 confirm(install_from(Pack, Version, git(URL)), yes, Options).
612pack_select_candidate(Pack, [Version-[URL]|More], Options,
613 [url(URL), inquiry(true) | Upgrade]) :-
614 ( More == []
615 -> !
616 ; true
617 ),
618 confirm(install_from(Pack, Version, URL), yes, Options),
619 !,
620 add_upgrade(Pack, Upgrade).
621pack_select_candidate(Pack, [Version-URLs|_], Options,
622 [url(URL), inquiry(true)|Rest]) :-
623 maplist(url_menu_item, URLs, Tagged),
624 append(Tagged, [cancel=cancel], Menu),
625 Menu = [Default=_|_],
626 menu(pack(select_install_from(Pack, Version)),
627 Menu, Default, Choice, Options),
628 ( Choice == cancel
629 -> fail
630 ; Choice = git(URL)
631 -> Rest = [git(true)|Upgrade]
632 ; Choice = URL,
633 Rest = Upgrade
634 ),
635 add_upgrade(Pack, Upgrade).
636
637add_upgrade(Pack, Options) :-
638 current_pack(Pack),
639 !,
640 Options = [upgrade(true)].
641add_upgrade(_, []).
642
(URL, git(URL)=install_from(git(URL))) :-
644 git_url(URL, _),
645 !.
646url_menu_item(URL, URL=install_from(URL)).
647
648
696
697pack_install(Spec, Options) :-
698 pack_default_options(Spec, Pack, Options, DefOptions),
699 ( option(already_installed(Installed), DefOptions)
700 -> print_message(informational, pack(already_installed(Installed)))
701 ; merge_options(Options, DefOptions, PackOptions),
702 update_dependency_db,
703 pack_install_dir(PackDir, PackOptions),
704 pack_install(Pack, PackDir, PackOptions)
705 ).
706
707pack_install_dir(PackDir, Options) :-
708 option(package_directory(PackDir), Options),
709 !.
710pack_install_dir(PackDir, Options) :-
711 base_alias(Alias, Options),
712 absolute_file_name(Alias, PackDir,
713 [ file_type(directory),
714 access(write),
715 file_errors(fail)
716 ]),
717 !.
718pack_install_dir(PackDir, Options) :-
719 pack_create_install_dir(PackDir, Options).
720
721base_alias(Alias, Options) :-
722 option(global(true), Options),
723 !,
724 Alias = common_app_data(pack).
725base_alias(Alias, Options) :-
726 option(global(false), Options),
727 !,
728 Alias = user_app_data(pack).
729base_alias(Alias, _Options) :-
730 Alias = pack('.').
731
732pack_create_install_dir(PackDir, Options) :-
733 base_alias(Alias, Options),
734 findall(Candidate = create_dir(Candidate),
735 ( absolute_file_name(Alias, Candidate, [solutions(all)]),
736 \+ exists_file(Candidate),
737 \+ exists_directory(Candidate),
738 file_directory_name(Candidate, Super),
739 ( exists_directory(Super)
740 -> access_file(Super, write)
741 ; true
742 )
743 ),
744 Candidates0),
745 list_to_set(Candidates0, Candidates), 746 pack_create_install_dir(Candidates, PackDir, Options).
747
748pack_create_install_dir(Candidates, PackDir, Options) :-
749 Candidates = [Default=_|_],
750 !,
751 append(Candidates, [cancel=cancel], Menu),
752 menu(pack(create_pack_dir), Menu, Default, Selected, Options),
753 Selected \== cancel,
754 ( catch(make_directory_path(Selected), E,
755 (print_message(warning, E), fail))
756 -> PackDir = Selected
757 ; delete(Candidates, PackDir=create_dir(PackDir), Remaining),
758 pack_create_install_dir(Remaining, PackDir, Options)
759 ).
760pack_create_install_dir(_, _, _) :-
761 print_message(error, pack(cannot_create_dir(pack(.)))),
762 fail.
763
764
776
777pack_install(Name, _, Options) :-
778 current_pack(Name, Dir),
779 option(upgrade(false), Options, false),
780 \+ pack_is_in_local_dir(Name, Dir, Options),
781 print_message(error, pack(already_installed(Name))),
782 pack_info(Name),
783 print_message(information, pack(remove_with(Name))),
784 !,
785 fail.
786pack_install(Name, PackDir, Options) :-
787 option(url(URL), Options),
788 uri_file_name(URL, Source),
789 !,
790 pack_install_from_local(Source, PackDir, Name, Options).
791pack_install(Name, PackDir, Options) :-
792 option(url(URL), Options),
793 uri_components(URL, Components),
794 uri_data(scheme, Components, Scheme),
795 pack_install_from_url(Scheme, URL, PackDir, Name, Options).
796
803
804pack_install_from_local(Source, PackTopDir, Name, Options) :-
805 exists_directory(Source),
806 !,
807 directory_file_path(PackTopDir, Name, PackDir),
808 ( option(link(true), Options)
809 -> ( same_file(Source, PackDir)
810 -> true
811 ; atom_concat(PackTopDir, '/', PackTopDirS),
812 relative_file_name(Source, PackTopDirS, RelPath),
813 link_file(RelPath, PackDir, symbolic),
814 assertion(same_file(Source, PackDir))
815 )
816 ; prepare_pack_dir(PackDir, Options),
817 copy_directory(Source, PackDir)
818 ),
819 pack_post_install(Name, PackDir, Options).
820pack_install_from_local(Source, PackTopDir, Name, Options) :-
821 exists_file(Source),
822 directory_file_path(PackTopDir, Name, PackDir),
823 prepare_pack_dir(PackDir, Options),
824 pack_unpack(Source, PackDir, Name, Options),
825 pack_post_install(Name, PackDir, Options).
826
827pack_is_in_local_dir(_Pack, PackDir, Options) :-
828 option(url(DirURL), Options),
829 uri_file_name(DirURL, Dir),
830 same_file(PackDir, Dir).
831
832
836
837:- if(exists_source(library(archive))). 838pack_unpack(Source, PackDir, Pack, Options) :-
839 ensure_loaded_archive,
840 pack_archive_info(Source, Pack, _Info, StripOptions),
841 prepare_pack_dir(PackDir, Options),
842 archive_extract(Source, PackDir,
843 [ exclude(['._*']) 844 | StripOptions
845 ]).
846:- else. 847pack_unpack(_,_,_,_) :-
848 existence_error(library, archive).
849:- endif. 850
851 854
866
867:- if(exists_source(library(archive))). 868ensure_loaded_archive :-
869 current_predicate(archive_open/3),
870 !.
871ensure_loaded_archive :-
872 use_module(library(archive)).
873
874pack_archive_info(Archive, Pack, [archive_size(Bytes)|Info], Strip) :-
875 ensure_loaded_archive,
876 size_file(Archive, Bytes),
877 setup_call_cleanup(
878 archive_open(Archive, Handle, []),
879 ( repeat,
880 ( archive_next_header(Handle, InfoFile)
881 -> true
882 ; !, fail
883 )
884 ),
885 archive_close(Handle)),
886 file_base_name(InfoFile, 'pack.pl'),
887 atom_concat(Prefix, 'pack.pl', InfoFile),
888 strip_option(Prefix, Pack, Strip),
889 setup_call_cleanup(
890 archive_open_entry(Handle, Stream),
891 read_stream_to_terms(Stream, Info),
892 close(Stream)),
893 !,
894 must_be(ground, Info),
895 maplist(valid_info_term, Info).
896:- else. 897pack_archive_info(_, _, _, _) :-
898 existence_error(library, archive).
899:- endif. 900pack_archive_info(_, _, _, _) :-
901 existence_error(pack_file, 'pack.pl').
902
903strip_option('', _, []) :- !.
904strip_option('./', _, []) :- !.
905strip_option(Prefix, Pack, [remove_prefix(Prefix)]) :-
906 atom_concat(PrefixDir, /, Prefix),
907 file_base_name(PrefixDir, Base),
908 ( Base == Pack
909 -> true
910 ; pack_version_file(Pack, _, Base)
911 -> true
912 ; \+ sub_atom(PrefixDir, _, _, _, /)
913 ).
914
915read_stream_to_terms(Stream, Terms) :-
916 read(Stream, Term0),
917 read_stream_to_terms(Term0, Stream, Terms).
918
919read_stream_to_terms(end_of_file, _, []) :- !.
920read_stream_to_terms(Term0, Stream, [Term0|Terms]) :-
921 read(Stream, Term1),
922 read_stream_to_terms(Term1, Stream, Terms).
923
924
929
930pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :-
931 exists_directory(GitDir),
932 !,
933 git_ls_tree(Entries, [directory(GitDir)]),
934 git_hash(Hash, [directory(GitDir)]),
935 maplist(arg(4), Entries, Sizes),
936 sum_list(Sizes, Bytes),
937 directory_file_path(GitDir, 'pack.pl', InfoFile),
938 read_file_to_terms(InfoFile, Info, [encoding(utf8)]),
939 must_be(ground, Info),
940 maplist(valid_info_term, Info).
941
945
946download_file_sanity_check(Archive, Pack, Info) :-
947 info_field(name(Name), Info),
948 info_field(version(VersionAtom), Info),
949 atom_version(VersionAtom, Version),
950 pack_version_file(PackA, VersionA, Archive),
951 must_match([Pack, PackA, Name], name),
952 must_match([Version, VersionA], version).
953
954info_field(Field, Info) :-
955 memberchk(Field, Info),
956 ground(Field),
957 !.
958info_field(Field, _Info) :-
959 functor(Field, FieldName, _),
960 print_message(error, pack(missing(FieldName))),
961 fail.
962
963must_match(Values, _Field) :-
964 sort(Values, [_]),
965 !.
966must_match(Values, Field) :-
967 print_message(error, pack(conflict(Field, Values))),
968 fail.
969
970
971 974
984
985prepare_pack_dir(Dir, Options) :-
986 exists_directory(Dir),
987 !,
988 ( empty_directory(Dir)
989 -> true
990 ; ( option(upgrade(true), Options)
991 ; confirm(remove_existing_pack(Dir), yes, Options)
992 )
993 -> delete_directory_and_contents(Dir),
994 make_directory(Dir)
995 ).
996prepare_pack_dir(Dir, _) :-
997 make_directory(Dir).
998
1002
1003empty_directory(Dir) :-
1004 \+ ( directory_files(Dir, Entries),
1005 member(Entry, Entries),
1006 \+ special(Entry)
1007 ).
1008
1009special(.).
1010special(..).
1011
1012
1019
1020pack_install_from_url(_, URL, PackTopDir, Pack, Options) :-
1021 option(git(true), Options),
1022 !,
1023 directory_file_path(PackTopDir, Pack, PackDir),
1024 prepare_pack_dir(PackDir, Options),
1025 run_process(path(git), [clone, URL, PackDir], []),
1026 pack_git_info(PackDir, Hash, Info),
1027 pack_inquiry(URL, git(Hash), Info, Options),
1028 show_info(Pack, Info, Options),
1029 confirm(git_post_install(PackDir, Pack), yes, Options),
1030 pack_post_install(Pack, PackDir, Options).
1031pack_install_from_url(Scheme, URL, PackTopDir, Pack, Options) :-
1032 download_scheme(Scheme),
1033 directory_file_path(PackTopDir, Pack, PackDir),
1034 prepare_pack_dir(PackDir, Options),
1035 pack_download_dir(PackTopDir, DownLoadDir),
1036 download_file(URL, Pack, DownloadBase, Options),
1037 directory_file_path(DownLoadDir, DownloadBase, DownloadFile),
1038 setup_call_cleanup(
1039 http_open(URL, In,
1040 [ cert_verify_hook(ssl_verify)
1041 ]),
1042 setup_call_cleanup(
1043 open(DownloadFile, write, Out, [type(binary)]),
1044 copy_stream_data(In, Out),
1045 close(Out)),
1046 close(In)),
1047 pack_archive_info(DownloadFile, Pack, Info, _),
1048 download_file_sanity_check(DownloadFile, Pack, Info),
1049 pack_inquiry(URL, DownloadFile, Info, Options),
1050 show_info(Pack, Info, Options),
1051 confirm(install_downloaded(DownloadFile), yes, Options),
1052 pack_install_from_local(DownloadFile, PackTopDir, Pack, Options).
1053
1055
1056download_file(URL, Pack, File, Options) :-
1057 option(version(Version), Options),
1058 !,
1059 atom_version(VersionA, Version),
1060 file_name_extension(_, Ext, URL),
1061 format(atom(File), '~w-~w.~w', [Pack, VersionA, Ext]).
1062download_file(URL, Pack, File, _) :-
1063 file_base_name(URL,Basename),
1064 no_int_file_name_extension(Tag,Ext,Basename),
1065 tag_version(Tag,Version),
1066 !,
1067 atom_version(VersionA,Version),
1068 format(atom(File0), '~w-~w', [Pack, VersionA]),
1069 file_name_extension(File0, Ext, File).
1070download_file(URL, _, File, _) :-
1071 file_base_name(URL, File).
1072
1078
1079pack_url_file(URL, FileID) :-
1080 github_release_url(URL, Pack, Version),
1081 !,
1082 download_file(URL, Pack, FileID, [version(Version)]).
1083pack_url_file(URL, FileID) :-
1084 file_base_name(URL, FileID).
1085
1086
1087:- public ssl_verify/5. 1088
1094
1095ssl_verify(_SSL,
1096 _ProblemCertificate, _AllCertificates, _FirstCertificate,
1097 _Error).
1098
1099pack_download_dir(PackTopDir, DownLoadDir) :-
1100 directory_file_path(PackTopDir, 'Downloads', DownLoadDir),
1101 ( exists_directory(DownLoadDir)
1102 -> true
1103 ; make_directory(DownLoadDir)
1104 ),
1105 ( access_file(DownLoadDir, write)
1106 -> true
1107 ; permission_error(write, directory, DownLoadDir)
1108 ).
1109
1113
1114download_url(URL) :-
1115 atom(URL),
1116 uri_components(URL, Components),
1117 uri_data(scheme, Components, Scheme),
1118 download_scheme(Scheme).
1119
1120download_scheme(http).
1121download_scheme(https) :-
1122 catch(use_module(library(http/http_ssl_plugin)),
1123 E, (print_message(warning, E), fail)).
1124
1132
1133pack_post_install(Pack, PackDir, Options) :-
1134 post_install_foreign(Pack, PackDir, Options),
1135 post_install_autoload(PackDir, Options),
1136 '$pack_attach'(PackDir).
1137
1141
1142pack_rebuild(Pack) :-
1143 current_pack(Pack, PackDir),
1144 !,
1145 post_install_foreign(Pack, PackDir, [rebuild(true)]).
1146pack_rebuild(Pack) :-
1147 unattached_pacth(Pack, PackDir),
1148 !,
1149 post_install_foreign(Pack, PackDir, [rebuild(true)]).
1150pack_rebuild(Pack) :-
1151 existence_error(pack, Pack).
1152
1153unattached_pacth(Pack, BaseDir) :-
1154 directory_file_path(Pack, 'pack.pl', PackFile),
1155 absolute_file_name(pack(PackFile), PackPath,
1156 [ access(read),
1157 file_errors(fail)
1158 ]),
1159 file_directory_name(PackPath, BaseDir).
1160
1164
1165pack_rebuild :-
1166 forall(current_pack(Pack),
1167 ( print_message(informational, pack(rebuild(Pack))),
1168 pack_rebuild(Pack)
1169 )).
1170
1171
1175
1176post_install_foreign(Pack, PackDir, Options) :-
1177 is_foreign_pack(PackDir, _),
1178 !,
1179 ( pack_info_term(PackDir, pack_version(Version))
1180 -> true
1181 ; Version = 1
1182 ),
1183 option(rebuild(Rebuild), Options, if_absent),
1184 ( Rebuild == if_absent,
1185 foreign_present(PackDir)
1186 -> print_message(informational, pack(kept_foreign(Pack)))
1187 ; BuildSteps0 = [[dependencies], [configure], build, [test], install],
1188 ( Rebuild == true
1189 -> BuildSteps1 = [distclean|BuildSteps0]
1190 ; BuildSteps1 = BuildSteps0
1191 ),
1192 ( option(test(false), Options)
1193 -> delete(BuildSteps1, [test], BuildSteps)
1194 ; BuildSteps = BuildSteps1
1195 ),
1196 build_steps(BuildSteps, PackDir, [pack_version(Version)|Options])
1197 ).
1198post_install_foreign(_, _, _).
1199
1200
1206
1207foreign_present(PackDir) :-
1208 current_prolog_flag(arch, Arch),
1209 atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
1210 exists_directory(ForeignBaseDir),
1211 !,
1212 atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
1213 exists_directory(ForeignDir),
1214 current_prolog_flag(shared_object_extension, Ext),
1215 atomic_list_concat([ForeignDir, '/*.', Ext], Pattern),
1216 expand_file_name(Pattern, Files),
1217 Files \== [].
1218
1223
1224is_foreign_pack(PackDir, Type) :-
1225 foreign_file(File, Type),
1226 directory_file_path(PackDir, File, Path),
1227 exists_file(Path).
1228
1229foreign_file('CMakeLists.txt', cmake).
1230foreign_file('configure', configure).
1231foreign_file('configure.in', autoconf).
1232foreign_file('configure.ac', autoconf).
1233foreign_file('Makefile.am', automake).
1234foreign_file('Makefile', make).
1235foreign_file('makefile', make).
1236foreign_file('conanfile.txt', conan).
1237foreign_file('conanfile.py', conan).
1238
1239
1240 1243
1247
1248post_install_autoload(PackDir, Options) :-
1249 option(autoload(true), Options, true),
1250 pack_info_term(PackDir, autoload(true)),
1251 !,
1252 directory_file_path(PackDir, prolog, PrologLibDir),
1253 make_library_index(PrologLibDir).
1254post_install_autoload(_, _).
1255
1256
1257 1260
1266
1267pack_upgrade(Pack) :-
1268 pack_info(Pack, _, directory(Dir)),
1269 directory_file_path(Dir, '.git', GitDir),
1270 exists_directory(GitDir),
1271 !,
1272 print_message(informational, pack(git_fetch(Dir))),
1273 git([fetch], [ directory(Dir) ]),
1274 git_describe(V0, [ directory(Dir) ]),
1275 git_describe(V1, [ directory(Dir), commit('origin/master') ]),
1276 ( V0 == V1
1277 -> print_message(informational, pack(up_to_date(Pack)))
1278 ; confirm(upgrade(Pack, V0, V1), yes, []),
1279 git([merge, 'origin/master'], [ directory(Dir) ]),
1280 pack_rebuild(Pack)
1281 ).
1282pack_upgrade(Pack) :-
1283 once(pack_info(Pack, _, version(VersionAtom))),
1284 atom_version(VersionAtom, Version),
1285 pack_info(Pack, _, download(URL)),
1286 ( wildcard_pattern(URL)
1287 -> true
1288 ; github_url(URL, _User, _Repo)
1289 ),
1290 !,
1291 available_download_versions(URL, [Latest-LatestURL|_Versions]),
1292 ( Latest @> Version
1293 -> confirm(upgrade(Pack, Version, Latest), yes, []),
1294 pack_install(Pack,
1295 [ url(LatestURL),
1296 upgrade(true),
1297 pack(Pack)
1298 ])
1299 ; print_message(informational, pack(up_to_date(Pack)))
1300 ).
1301pack_upgrade(Pack) :-
1302 print_message(warning, pack(no_upgrade_info(Pack))).
1303
1304
1305 1308
1312
1313pack_remove(Pack) :-
1314 update_dependency_db,
1315 ( setof(Dep, pack_depends_on(Dep, Pack), Deps)
1316 -> confirm_remove(Pack, Deps, Delete),
1317 forall(member(P, Delete), pack_remove_forced(P))
1318 ; pack_remove_forced(Pack)
1319 ).
1320
1321pack_remove_forced(Pack) :-
1322 catch('$pack_detach'(Pack, BaseDir),
1323 error(existence_error(pack, Pack), _),
1324 fail),
1325 !,
1326 print_message(informational, pack(remove(BaseDir))),
1327 delete_directory_and_contents(BaseDir).
1328pack_remove_forced(Pack) :-
1329 unattached_pacth(Pack, BaseDir),
1330 !,
1331 delete_directory_and_contents(BaseDir).
1332pack_remove_forced(Pack) :-
1333 print_message(informational, error(existence_error(pack, Pack),_)).
1334
1335confirm_remove(Pack, Deps, Delete) :-
1336 print_message(warning, pack(depends(Pack, Deps))),
1337 menu(pack(resolve_remove),
1338 [ [Pack] = remove_only(Pack),
1339 [Pack|Deps] = remove_deps(Pack, Deps),
1340 [] = cancel
1341 ], [], Delete, []),
1342 Delete \== [].
1343
1344
1345 1348
1369
1370pack_property(Pack, Property) :-
1371 findall(Pack-Property, pack_property_(Pack, Property), List),
1372 member(Pack-Property, List). 1373
1374pack_property_(Pack, Property) :-
1375 pack_info(Pack, _, Property).
1376pack_property_(Pack, Property) :-
1377 \+ \+ info_file(Property, _),
1378 '$pack':pack(Pack, BaseDir),
1379 access_file(BaseDir, read),
1380 directory_files(BaseDir, Files),
1381 member(File, Files),
1382 info_file(Property, Pattern),
1383 downcase_atom(File, Pattern),
1384 directory_file_path(BaseDir, File, InfoFile),
1385 arg(1, Property, InfoFile).
1386
1387info_file(readme(_), 'readme.txt').
1388info_file(readme(_), 'readme').
1389info_file(todo(_), 'todo.txt').
1390info_file(todo(_), 'todo').
1391
1392
1393 1396
1400
1401git_url(URL, Pack) :-
1402 uri_components(URL, Components),
1403 uri_data(scheme, Components, Scheme),
1404 nonvar(Scheme), 1405 uri_data(path, Components, Path),
1406 ( Scheme == git
1407 -> true
1408 ; git_download_scheme(Scheme),
1409 file_name_extension(_, git, Path)
1410 ; git_download_scheme(Scheme),
1411 catch(git_ls_remote(URL, _, [refs(['HEAD']), error(_)]), _, fail)
1412 -> true
1413 ),
1414 file_base_name(Path, PackExt),
1415 ( file_name_extension(Pack, git, PackExt)
1416 -> true
1417 ; Pack = PackExt
1418 ),
1419 ( safe_pack_name(Pack)
1420 -> true
1421 ; domain_error(pack_name, Pack)
1422 ).
1423
1424git_download_scheme(http).
1425git_download_scheme(https).
1426
1431
1432safe_pack_name(Name) :-
1433 atom_length(Name, Len),
1434 Len >= 3, 1435 atom_codes(Name, Codes),
1436 maplist(safe_pack_char, Codes),
1437 !.
1438
1439safe_pack_char(C) :- between(0'a, 0'z, C), !.
1440safe_pack_char(C) :- between(0'A, 0'Z, C), !.
1441safe_pack_char(C) :- between(0'0, 0'9, C), !.
1442safe_pack_char(0'_).
1443
1444
1445 1448
1455
1456pack_version_file(Pack, Version, GitHubRelease) :-
1457 atomic(GitHubRelease),
1458 github_release_url(GitHubRelease, Pack, Version),
1459 !.
1460pack_version_file(Pack, Version, Path) :-
1461 atomic(Path),
1462 file_base_name(Path, File),
1463 no_int_file_name_extension(Base, _Ext, File),
1464 atom_codes(Base, Codes),
1465 ( phrase(pack_version(Pack, Version), Codes),
1466 safe_pack_name(Pack)
1467 -> true
1468 ).
1469
1470no_int_file_name_extension(Base, Ext, File) :-
1471 file_name_extension(Base0, Ext0, File),
1472 \+ atom_number(Ext0, _),
1473 !,
1474 Base = Base0,
1475 Ext = Ext0.
1476no_int_file_name_extension(File, '', File).
1477
1478
1479
1488
1489github_release_url(URL, Pack, Version) :-
1490 uri_components(URL, Components),
1491 uri_data(authority, Components, 'github.com'),
1492 uri_data(scheme, Components, Scheme),
1493 download_scheme(Scheme),
1494 uri_data(path, Components, Path),
1495 github_archive_path(Archive,Pack,File),
1496 atomic_list_concat(Archive, /, Path),
1497 file_name_extension(Tag, Ext, File),
1498 github_archive_extension(Ext),
1499 tag_version(Tag, Version),
1500 !.
1501
1502github_archive_path(['',_User,Pack,archive,File],Pack,File).
1503github_archive_path(['',_User,Pack,archive,refs,tags,File],Pack,File).
1504
1505github_archive_extension(tgz).
1506github_archive_extension(zip).
1507
1508tag_version(Tag, Version) :-
1509 version_tag_prefix(Prefix),
1510 atom_concat(Prefix, AtomVersion, Tag),
1511 atom_version(AtomVersion, Version).
1512
1513version_tag_prefix(v).
1514version_tag_prefix('V').
1515version_tag_prefix('').
1516
1517
1518:- public
1519 atom_version/2. 1520
1526
1527atom_version(Atom, version(Parts)) :-
1528 ( atom(Atom)
1529 -> atom_codes(Atom, Codes),
1530 phrase(version(Parts), Codes)
1531 ; atomic_list_concat(Parts, '.', Atom)
1532 ).
1533
1534pack_version(Pack, version(Parts)) -->
1535 string(Codes), "-",
1536 version(Parts),
1537 !,
1538 { atom_codes(Pack, Codes)
1539 }.
1540
1541version([_|T]) -->
1542 "*",
1543 !,
1544 ( "."
1545 -> version(T)
1546 ; []
1547 ).
1548version([H|T]) -->
1549 integer(H),
1550 ( "."
1551 -> version(T)
1552 ; { T = [] }
1553 ).
1554
1555 1558
1576
1577pack_inquiry(_, _, _, Options) :-
1578 option(inquiry(false), Options),
1579 !.
1580pack_inquiry(URL, DownloadFile, Info, Options) :-
1581 setting(server, ServerBase),
1582 ServerBase \== '',
1583 atom_concat(ServerBase, query, Server),
1584 ( option(inquiry(true), Options)
1585 -> true
1586 ; confirm(inquiry(Server), yes, Options)
1587 ),
1588 !,
1589 ( DownloadFile = git(SHA1)
1590 -> true
1591 ; file_sha1(DownloadFile, SHA1)
1592 ),
1593 query_pack_server(install(URL, SHA1, Info), Reply, Options),
1594 inquiry_result(Reply, URL, Options).
1595pack_inquiry(_, _, _, _).
1596
1597
1602
1603query_pack_server(Query, Result, Options) :-
1604 setting(server, ServerBase),
1605 ServerBase \== '',
1606 atom_concat(ServerBase, query, Server),
1607 format(codes(Data), '~q.~n', Query),
1608 info_level(Informational, Options),
1609 print_message(Informational, pack(contacting_server(Server))),
1610 setup_call_cleanup(
1611 http_open(Server, In,
1612 [ post(codes(application/'x-prolog', Data)),
1613 header(content_type, ContentType)
1614 ]),
1615 read_reply(ContentType, In, Result),
1616 close(In)),
1617 message_severity(Result, Level, Informational),
1618 print_message(Level, pack(server_reply(Result))).
1619
1620read_reply(ContentType, In, Result) :-
1621 sub_atom(ContentType, 0, _, _, 'application/x-prolog'),
1622 !,
1623 set_stream(In, encoding(utf8)),
1624 read(In, Result).
1625read_reply(ContentType, In, _Result) :-
1626 read_string(In, 500, String),
1627 print_message(error, pack(no_prolog_response(ContentType, String))),
1628 fail.
1629
1630info_level(Level, Options) :-
1631 option(silent(true), Options),
1632 !,
1633 Level = silent.
1634info_level(informational, _).
1635
1636message_severity(true(_), Informational, Informational).
1637message_severity(false, warning, _).
1638message_severity(exception(_), error, _).
1639
1640
1645
1646inquiry_result(Reply, File, Options) :-
1647 findall(Eval, eval_inquiry(Reply, File, Eval, Options), Evaluation),
1648 \+ member(cancel, Evaluation),
1649 select_option(git(_), Options, Options1, _),
1650 forall(member(install_dependencies(Resolution), Evaluation),
1651 maplist(install_dependency(Options1), Resolution)).
1652
1653eval_inquiry(true(Reply), URL, Eval, _) :-
1654 include(alt_hash, Reply, Alts),
1655 Alts \== [],
1656 print_message(warning, pack(alt_hashes(URL, Alts))),
1657 ( memberchk(downloads(Count), Reply),
1658 ( git_url(URL, _)
1659 -> Default = yes,
1660 Eval = with_git_commits_in_same_version
1661 ; Default = no,
1662 Eval = with_alt_hashes
1663 ),
1664 confirm(continue_with_alt_hashes(Count, URL), Default, [])
1665 -> true
1666 ; !, 1667 Eval = cancel
1668 ).
1669eval_inquiry(true(Reply), _, Eval, Options) :-
1670 include(dependency, Reply, Deps),
1671 Deps \== [],
1672 select_dependency_resolution(Deps, Eval, Options),
1673 ( Eval == cancel
1674 -> !
1675 ; true
1676 ).
1677eval_inquiry(true(Reply), URL, true, Options) :-
1678 file_base_name(URL, File),
1679 info_level(Informational, Options),
1680 print_message(Informational, pack(inquiry_ok(Reply, File))).
1681eval_inquiry(exception(pack(modified_hash(_SHA1-URL, _SHA2-[URL]))),
1682 URL, Eval, Options) :-
1683 ( confirm(continue_with_modified_hash(URL), no, Options)
1684 -> Eval = true
1685 ; Eval = cancel
1686 ).
1687
1688alt_hash(alt_hash(_,_,_)).
1689dependency(dependency(_,_,_,_,_)).
1690
1691
1697
1698select_dependency_resolution(Deps, Eval, Options) :-
1699 resolve_dependencies(Deps, Resolution),
1700 exclude(local_dep, Resolution, ToBeDone),
1701 ( ToBeDone == []
1702 -> !, Eval = true
1703 ; print_message(warning, pack(install_dependencies(Resolution))),
1704 ( memberchk(_-unresolved, Resolution)
1705 -> Default = cancel
1706 ; Default = install_deps
1707 ),
1708 menu(pack(resolve_deps),
1709 [ install_deps = install_deps,
1710 install_no_deps = install_no_deps,
1711 cancel = cancel
1712 ], Default, Choice, Options),
1713 ( Choice == cancel
1714 -> !, Eval = cancel
1715 ; Choice == install_no_deps
1716 -> !, Eval = install_no_deps
1717 ; !, Eval = install_dependencies(Resolution)
1718 )
1719 ).
1720
1721local_dep(_-resolved(_)).
1722
1723
1729
1730install_dependency(Options,
1731 _Token-resolve(Pack, VersionAtom, [_URL|_], SubResolve)) :-
1732 atom_version(VersionAtom, Version),
1733 current_pack(Pack),
1734 pack_info(Pack, _, version(InstalledAtom)),
1735 atom_version(InstalledAtom, Installed),
1736 Installed == Version, 1737 !,
1738 maplist(install_dependency(Options), SubResolve).
1739install_dependency(Options,
1740 _Token-resolve(Pack, VersionAtom, [URL|_], SubResolve)) :-
1741 !,
1742 atom_version(VersionAtom, Version),
1743 merge_options([ url(URL),
1744 version(Version),
1745 interactive(false),
1746 inquiry(false),
1747 info(list),
1748 pack(Pack)
1749 ], Options, InstallOptions),
1750 pack_install(Pack, InstallOptions),
1751 maplist(install_dependency(Options), SubResolve).
1752install_dependency(_, _-_).
1753
1754
1755 1758
1765
1766available_download_versions(URL, Versions) :-
1767 wildcard_pattern(URL),
1768 github_url(URL, User, Repo),
1769 !,
1770 findall(Version-VersionURL,
1771 github_version(User, Repo, Version, VersionURL),
1772 Versions).
1773available_download_versions(URL, Versions) :-
1774 wildcard_pattern(URL),
1775 !,
1776 file_directory_name(URL, DirURL0),
1777 ensure_slash(DirURL0, DirURL),
1778 print_message(informational, pack(query_versions(DirURL))),
1779 setup_call_cleanup(
1780 http_open(DirURL, In, []),
1781 load_html(stream(In), DOM,
1782 [ syntax_errors(quiet)
1783 ]),
1784 close(In)),
1785 findall(MatchingURL,
1786 absolute_matching_href(DOM, URL, MatchingURL),
1787 MatchingURLs),
1788 ( MatchingURLs == []
1789 -> print_message(warning, pack(no_matching_urls(URL)))
1790 ; true
1791 ),
1792 versioned_urls(MatchingURLs, VersionedURLs),
1793 keysort(VersionedURLs, SortedVersions),
1794 reverse(SortedVersions, Versions),
1795 print_message(informational, pack(found_versions(Versions))).
1796available_download_versions(URL, [Version-URL]) :-
1797 ( pack_version_file(_Pack, Version0, URL)
1798 -> Version = Version0
1799 ; Version = unknown
1800 ).
1801
1805
1806github_url(URL, User, Repo) :-
1807 uri_components(URL, uri_components(https,'github.com',Path,_,_)),
1808 atomic_list_concat(['',User,Repo|_], /, Path).
1809
1810
1815
1816github_version(User, Repo, Version, VersionURI) :-
1817 atomic_list_concat(['',repos,User,Repo,tags], /, Path1),
1818 uri_components(ApiUri, uri_components(https,'api.github.com',Path1,_,_)),
1819 setup_call_cleanup(
1820 http_open(ApiUri, In,
1821 [ request_header('Accept'='application/vnd.github.v3+json')
1822 ]),
1823 json_read_dict(In, Dicts),
1824 close(In)),
1825 member(Dict, Dicts),
1826 atom_string(Tag, Dict.name),
1827 tag_version(Tag, Version),
1828 atom_string(VersionURI, Dict.zipball_url).
1829
1830wildcard_pattern(URL) :- sub_atom(URL, _, _, _, *).
1831wildcard_pattern(URL) :- sub_atom(URL, _, _, _, ?).
1832
1833ensure_slash(Dir, DirS) :-
1834 ( sub_atom(Dir, _, _, 0, /)
1835 -> DirS = Dir
1836 ; atom_concat(Dir, /, DirS)
1837 ).
1838
1839absolute_matching_href(DOM, Pattern, Match) :-
1840 xpath(DOM, //a(@href), HREF),
1841 uri_normalized(HREF, Pattern, Match),
1842 wildcard_match(Pattern, Match).
1843
1844versioned_urls([], []).
1845versioned_urls([H|T0], List) :-
1846 file_base_name(H, File),
1847 ( pack_version_file(_Pack, Version, File)
1848 -> List = [Version-H|T]
1849 ; List = T
1850 ),
1851 versioned_urls(T0, T).
1852
1853
1854 1857
1861
1862update_dependency_db :-
1863 retractall(pack_requires(_,_)),
1864 retractall(pack_provides_db(_,_)),
1865 forall(current_pack(Pack),
1866 ( findall(Info, pack_info(Pack, dependency, Info), Infos),
1867 update_dependency_db(Pack, Infos)
1868 )).
1869
1870update_dependency_db(Name, Info) :-
1871 retractall(pack_requires(Name, _)),
1872 retractall(pack_provides_db(Name, _)),
1873 maplist(assert_dep(Name), Info).
1874
1875assert_dep(Pack, provides(Token)) :-
1876 !,
1877 assertz(pack_provides_db(Pack, Token)).
1878assert_dep(Pack, requires(Token)) :-
1879 !,
1880 assertz(pack_requires(Pack, Token)).
1881assert_dep(_, _).
1882
1886
1887validate_dependencies :-
1888 unsatisfied_dependencies(Unsatisfied),
1889 !,
1890 print_message(warning, pack(unsatisfied(Unsatisfied))).
1891validate_dependencies.
1892
1893
1894unsatisfied_dependencies(Unsatisfied) :-
1895 findall(Req-Pack, pack_requires(Pack, Req), Reqs0),
1896 keysort(Reqs0, Reqs1),
1897 group_pairs_by_key(Reqs1, GroupedReqs),
1898 exclude(satisfied_dependency, GroupedReqs, Unsatisfied),
1899 Unsatisfied \== [].
1900
1901satisfied_dependency(Needed-_By) :-
1902 pack_provides(_, Needed),
1903 !.
1904satisfied_dependency(Needed-_By) :-
1905 compound(Needed),
1906 Needed =.. [Op, Pack, ReqVersion],
1907 ( pack_provides(Pack, Pack)
1908 -> pack_info(Pack, _, version(PackVersion)),
1909 version_data(PackVersion, PackData)
1910 ; Pack == prolog
1911 -> current_prolog_flag(version_data, swi(Major,Minor,Patch,_)),
1912 PackData = [Major,Minor,Patch]
1913 ),
1914 version_data(ReqVersion, ReqData),
1915 cmp(Op, Cmp),
1916 call(Cmp, PackData, ReqData).
1917
1921
1922pack_provides(Pack, Pack) :-
1923 current_pack(Pack).
1924pack_provides(Pack, Token) :-
1925 pack_provides_db(Pack, Token).
1926
1930
1931pack_depends_on(Pack, Dependency) :-
1932 ( atom(Pack)
1933 -> pack_depends_on_fwd(Pack, Dependency, [Pack])
1934 ; pack_depends_on_bwd(Pack, Dependency, [Dependency])
1935 ).
1936
1937pack_depends_on_fwd(Pack, Dependency, Visited) :-
1938 pack_depends_on_1(Pack, Dep1),
1939 \+ memberchk(Dep1, Visited),
1940 ( Dependency = Dep1
1941 ; pack_depends_on_fwd(Dep1, Dependency, [Dep1|Visited])
1942 ).
1943
1944pack_depends_on_bwd(Pack, Dependency, Visited) :-
1945 pack_depends_on_1(Dep1, Dependency),
1946 \+ memberchk(Dep1, Visited),
1947 ( Pack = Dep1
1948 ; pack_depends_on_bwd(Pack, Dep1, [Dep1|Visited])
1949 ).
1950
1951pack_depends_on_1(Pack, Dependency) :-
1952 atom(Dependency),
1953 !,
1954 pack_provides(Dependency, Token),
1955 pack_requires(Pack, Token).
1956pack_depends_on_1(Pack, Dependency) :-
1957 pack_requires(Pack, Token),
1958 pack_provides(Dependency, Token).
1959
1960
1974
1975resolve_dependencies(Dependencies, Resolution) :-
1976 maplist(dependency_pair, Dependencies, Pairs0),
1977 keysort(Pairs0, Pairs1),
1978 group_pairs_by_key(Pairs1, ByToken),
1979 maplist(resolve_dep, ByToken, Resolution).
1980
1981dependency_pair(dependency(Token, Pack, Version, URLs, SubDeps),
1982 Token-(Pack-pack(Version,URLs, SubDeps))).
1983
1984resolve_dep(Token-Pairs, Token-Resolution) :-
1985 ( resolve_dep2(Token-Pairs, Resolution)
1986 *-> true
1987 ; Resolution = unresolved
1988 ).
1989
1990resolve_dep2(Token-_, resolved(Pack)) :-
1991 pack_provides(Pack, Token).
1992resolve_dep2(_-Pairs, resolve(Pack, VersionAtom, URLs, SubResolves)) :-
1993 keysort(Pairs, Sorted),
1994 group_pairs_by_key(Sorted, ByPack),
1995 member(Pack-Versions, ByPack),
1996 Pack \== (-),
1997 maplist(version_pack, Versions, VersionData),
1998 sort(VersionData, ByVersion),
1999 reverse(ByVersion, ByVersionLatest),
2000 member(pack(Version,URLs,SubDeps), ByVersionLatest),
2001 atom_version(VersionAtom, Version),
2002 include(dependency, SubDeps, Deps),
2003 resolve_dependencies(Deps, SubResolves).
2004
2005version_pack(pack(VersionAtom,URLs,SubDeps),
2006 pack(Version,URLs,SubDeps)) :-
2007 atom_version(VersionAtom, Version).
2008
2009
2010
2030
2031pack_attach(Dir, Options) :-
2032 '$pack_attach'(Dir, Options).
2033
2034
2035 2038
2039:- multifile prolog:message//1. 2040
2042
(_Question, _Alternatives, Default, Selection, Options) :-
2044 option(interactive(false), Options),
2045 !,
2046 Selection = Default.
2047menu(Question, Alternatives, Default, Selection, _) :-
2048 length(Alternatives, N),
2049 between(1, 5, _),
2050 print_message(query, Question),
2051 print_menu(Alternatives, Default, 1),
2052 print_message(query, pack(menu(select))),
2053 read_selection(N, Choice),
2054 !,
2055 ( Choice == default
2056 -> Selection = Default
2057 ; nth1(Choice, Alternatives, Selection=_)
2058 -> true
2059 ).
2060
([], _, _).
2062print_menu([Value=Label|T], Default, I) :-
2063 ( Value == Default
2064 -> print_message(query, pack(menu(default_item(I, Label))))
2065 ; print_message(query, pack(menu(item(I, Label))))
2066 ),
2067 I2 is I + 1,
2068 print_menu(T, Default, I2).
2069
2070read_selection(Max, Choice) :-
2071 get_single_char(Code),
2072 ( answered_default(Code)
2073 -> Choice = default
2074 ; code_type(Code, digit(Choice)),
2075 between(1, Max, Choice)
2076 -> true
2077 ; print_message(warning, pack(menu(reply(1,Max)))),
2078 fail
2079 ).
2080
2086
2087confirm(_Question, Default, Options) :-
2088 Default \== none,
2089 option(interactive(false), Options, true),
2090 !,
2091 Default == yes.
2092confirm(Question, Default, _) :-
2093 between(1, 5, _),
2094 print_message(query, pack(confirm(Question, Default))),
2095 read_yes_no(YesNo, Default),
2096 !,
2097 format(user_error, '~N', []),
2098 YesNo == yes.
2099
2100read_yes_no(YesNo, Default) :-
2101 get_single_char(Code),
2102 code_yes_no(Code, Default, YesNo),
2103 !.
2104
2105code_yes_no(0'y, _, yes).
2106code_yes_no(0'Y, _, yes).
2107code_yes_no(0'n, _, no).
2108code_yes_no(0'N, _, no).
2109code_yes_no(_, none, _) :- !, fail.
2110code_yes_no(C, Default, Default) :-
2111 answered_default(C).
2112
2113answered_default(0'\r).
2114answered_default(0'\n).
2115answered_default(0'\s).
2116
2117
2118 2121
2122:- multifile prolog:message//1. 2123
2124prolog:message(pack(Message)) -->
2125 message(Message).
2126
2127:- discontiguous
2128 message//1,
2129 label//1. 2130
2131message(invalid_info(Term)) -->
2132 [ 'Invalid package description: ~q'-[Term] ].
2133message(directory_exists(Dir)) -->
2134 [ 'Package target directory exists and is not empty:', nl,
2135 '\t~q'-[Dir]
2136 ].
2137message(already_installed(pack(Pack, Version))) -->
2138 { atom_version(AVersion, Version) },
2139 [ 'Pack `~w'' is already installed @~w'-[Pack, AVersion] ].
2140message(already_installed(Pack)) -->
2141 [ 'Pack `~w'' is already installed. Package info:'-[Pack] ].
2142message(invalid_name(File)) -->
2143 [ '~w: A package archive must be named <pack>-<version>.<ext>'-[File] ],
2144 no_tar_gz(File).
2145
2146no_tar_gz(File) -->
2147 { sub_atom(File, _, _, 0, '.tar.gz') },
2148 !,
2149 [ nl,
2150 'Package archive files must have a single extension. E.g., \'.tgz\''-[]
2151 ].
2152no_tar_gz(_) --> [].
2153
2154message(kept_foreign(Pack)) -->
2155 [ 'Found foreign libraries for target platform.'-[], nl,
2156 'Use ?- pack_rebuild(~q). to rebuild from sources'-[Pack]
2157 ].
2158message(no_pack_installed(Pack)) -->
2159 [ 'No pack ~q installed. Use ?- pack_list(Pattern) to search'-[Pack] ].
2160message(no_packages_installed) -->
2161 { setting(server, ServerBase) },
2162 [ 'There are no extra packages installed.', nl,
2163 'Please visit ~wlist.'-[ServerBase]
2164 ].
2165message(remove_with(Pack)) -->
2166 [ 'The package can be removed using: ?- ~q.'-[pack_remove(Pack)]
2167 ].
2168message(unsatisfied(Packs)) -->
2169 [ 'The following dependencies are not satisfied:', nl ],
2170 unsatisfied(Packs).
2171message(depends(Pack, Deps)) -->
2172 [ 'The following packages depend on `~w\':'-[Pack], nl ],
2173 pack_list(Deps).
2174message(remove(PackDir)) -->
2175 [ 'Removing ~q and contents'-[PackDir] ].
2176message(remove_existing_pack(PackDir)) -->
2177 [ 'Remove old installation in ~q'-[PackDir] ].
2178message(install_from(Pack, Version, git(URL))) -->
2179 [ 'Install ~w@~w from GIT at ~w'-[Pack, Version, URL] ].
2180message(install_from(Pack, Version, URL)) -->
2181 [ 'Install ~w@~w from ~w'-[Pack, Version, URL] ].
2182message(select_install_from(Pack, Version)) -->
2183 [ 'Select download location for ~w@~w'-[Pack, Version] ].
2184message(install_downloaded(File)) -->
2185 { file_base_name(File, Base),
2186 size_file(File, Size) },
2187 [ 'Install "~w" (~D bytes)'-[Base, Size] ].
2188message(git_post_install(PackDir, Pack)) -->
2189 ( { is_foreign_pack(PackDir, _) }
2190 -> [ 'Run post installation scripts for pack "~w"'-[Pack] ]
2191 ; [ 'Activate pack "~w"'-[Pack] ]
2192 ).
2193message(no_meta_data(BaseDir)) -->
2194 [ 'Cannot find pack.pl inside directory ~q. Not a package?'-[BaseDir] ].
2195message(inquiry(Server)) -->
2196 [ 'Verify package status (anonymously)', nl,
2197 '\tat "~w"'-[Server]
2198 ].
2199message(search_no_matches(Name)) -->
2200 [ 'Search for "~w", returned no matching packages'-[Name] ].
2201message(rebuild(Pack)) -->
2202 [ 'Checking pack "~w" for rebuild ...'-[Pack] ].
2203message(upgrade(Pack, From, To)) -->
2204 [ 'Upgrade "~w" from '-[Pack] ],
2205 msg_version(From), [' to '-[]], msg_version(To).
2206message(up_to_date(Pack)) -->
2207 [ 'Package "~w" is up-to-date'-[Pack] ].
2208message(query_versions(URL)) -->
2209 [ 'Querying "~w" to find new versions ...'-[URL] ].
2210message(no_matching_urls(URL)) -->
2211 [ 'Could not find any matching URL: ~q'-[URL] ].
2212message(found_versions([Latest-_URL|More])) -->
2213 { length(More, Len),
2214 atom_version(VLatest, Latest)
2215 },
2216 [ ' Latest version: ~w (~D older)'-[VLatest, Len] ].
2217message(process_output(Codes)) -->
2218 { split_lines(Codes, Lines) },
2219 process_lines(Lines).
2220message(contacting_server(Server)) -->
2221 [ 'Contacting server at ~w ...'-[Server], flush ].
2222message(server_reply(true(_))) -->
2223 [ at_same_line, ' ok'-[] ].
2224message(server_reply(false)) -->
2225 [ at_same_line, ' done'-[] ].
2226message(server_reply(exception(E))) -->
2227 [ 'Server reported the following error:'-[], nl ],
2228 '$messages':translate_message(E).
2229message(cannot_create_dir(Alias)) -->
2230 { findall(PackDir,
2231 absolute_file_name(Alias, PackDir, [solutions(all)]),
2232 PackDirs0),
2233 sort(PackDirs0, PackDirs)
2234 },
2235 [ 'Cannot find a place to create a package directory.'-[],
2236 'Considered:'-[]
2237 ],
2238 candidate_dirs(PackDirs).
2239message(no_match(Name)) -->
2240 [ 'No registered pack matches "~w"'-[Name] ].
2241message(conflict(version, [PackV, FileV])) -->
2242 ['Version mismatch: pack.pl: '-[]], msg_version(PackV),
2243 [', file claims version '-[]], msg_version(FileV).
2244message(conflict(name, [PackInfo, FileInfo])) -->
2245 ['Pack ~w mismatch: pack.pl: ~p'-[PackInfo]],
2246 [', file claims ~w: ~p'-[FileInfo]].
2247message(no_prolog_response(ContentType, String)) -->
2248 [ 'Expected Prolog response. Got content of type ~p'-[ContentType], nl,
2249 '~s'-[String]
2250 ].
2251message(pack(no_upgrade_info(Pack))) -->
2252 [ '~w: pack meta-data does not provide an upgradable URL'-[Pack] ].
2253
2254candidate_dirs([]) --> [].
2255candidate_dirs([H|T]) --> [ nl, ' ~w'-[H] ], candidate_dirs(T).
2256
2257 2258message(resolve_remove) -->
2259 [ nl, 'Please select an action:', nl, nl ].
2260message(create_pack_dir) -->
2261 [ nl, 'Create directory for packages', nl ].
2262message(menu(item(I, Label))) -->
2263 [ '~t(~d)~6| '-[I] ],
2264 label(Label).
2265message(menu(default_item(I, Label))) -->
2266 [ '~t(~d)~6| * '-[I] ],
2267 label(Label).
2268message(menu(select)) -->
2269 [ nl, 'Your choice? ', flush ].
2270message(confirm(Question, Default)) -->
2271 message(Question),
2272 confirm_default(Default),
2273 [ flush ].
2274message(menu(reply(Min,Max))) -->
2275 ( { Max =:= Min+1 }
2276 -> [ 'Please enter ~w or ~w'-[Min,Max] ]
2277 ; [ 'Please enter a number between ~w and ~w'-[Min,Max] ]
2278 ).
2279
2281
2282message(alt_hashes(URL, _Alts)) -->
2283 { git_url(URL, _)
2284 },
2285 !,
2286 [ 'GIT repository was updated without updating version' ].
2287message(alt_hashes(URL, Alts)) -->
2288 { file_base_name(URL, File)
2289 },
2290 [ 'Found multiple versions of "~w".'-[File], nl,
2291 'This could indicate a compromised or corrupted file', nl
2292 ],
2293 alt_hashes(Alts).
2294message(continue_with_alt_hashes(Count, URL)) -->
2295 [ 'Continue installation from "~w" (downloaded ~D times)'-[URL, Count] ].
2296message(continue_with_modified_hash(_URL)) -->
2297 [ 'Pack may be compromised. Continue anyway'
2298 ].
2299message(modified_hash(_SHA1-URL, _SHA2-[URL])) -->
2300 [ 'Content of ~q has changed.'-[URL]
2301 ].
2302
2303alt_hashes([]) --> [].
2304alt_hashes([H|T]) --> alt_hash(H), ( {T == []} -> [] ; [nl], alt_hashes(T) ).
2305
2306alt_hash(alt_hash(Count, URLs, Hash)) -->
2307 [ '~t~d~8| ~w'-[Count, Hash] ],
2308 alt_urls(URLs).
2309
2310alt_urls([]) --> [].
2311alt_urls([H|T]) -->
2312 [ nl, ' ~w'-[H] ],
2313 alt_urls(T).
2314
2316
2317message(install_dependencies(Resolution)) -->
2318 [ 'Package depends on the following:' ],
2319 msg_res_tokens(Resolution, 1).
2320
2321msg_res_tokens([], _) --> [].
2322msg_res_tokens([H|T], L) --> msg_res_token(H, L), msg_res_tokens(T, L).
2323
2324msg_res_token(Token-unresolved, L) -->
2325 res_indent(L),
2326 [ '"~w" cannot be satisfied'-[Token] ].
2327msg_res_token(Token-resolve(Pack, Version, [URL|_], SubResolves), L) -->
2328 !,
2329 res_indent(L),
2330 [ '"~w", provided by ~w@~w from ~w'-[Token, Pack, Version, URL] ],
2331 { L2 is L+1 },
2332 msg_res_tokens(SubResolves, L2).
2333msg_res_token(Token-resolved(Pack), L) -->
2334 !,
2335 res_indent(L),
2336 [ '"~w", provided by installed pack ~w'-[Token,Pack] ].
2337
2338res_indent(L) -->
2339 { I is L*2 },
2340 [ nl, '~*c'-[I,0'\s] ].
2341
2342message(resolve_deps) -->
2343 [ nl, 'What do you wish to do' ].
2344label(install_deps) -->
2345 [ 'Install proposed dependencies' ].
2346label(install_no_deps) -->
2347 [ 'Only install requested package' ].
2348
2349
2350message(git_fetch(Dir)) -->
2351 [ 'Running "git fetch" in ~q'-[Dir] ].
2352
2354
2355message(inquiry_ok(Reply, File)) -->
2356 { memberchk(downloads(Count), Reply),
2357 memberchk(rating(VoteCount, Rating), Reply),
2358 !,
2359 length(Stars, Rating),
2360 maplist(=(0'*), Stars)
2361 },
2362 [ '"~w" was downloaded ~D times. Package rated ~s (~D votes)'-
2363 [ File, Count, Stars, VoteCount ]
2364 ].
2365message(inquiry_ok(Reply, File)) -->
2366 { memberchk(downloads(Count), Reply)
2367 },
2368 [ '"~w" was downloaded ~D times'-[ File, Count ] ].
2369
2370 2371unsatisfied([]) --> [].
2372unsatisfied([Needed-[By]|T]) -->
2373 [ ' - "~w" is needed by package "~w"'-[Needed, By], nl ],
2374 unsatisfied(T).
2375unsatisfied([Needed-By|T]) -->
2376 [ ' - "~w" is needed by the following packages:'-[Needed], nl ],
2377 pack_list(By),
2378 unsatisfied(T).
2379
2380pack_list([]) --> [].
2381pack_list([H|T]) -->
2382 [ ' - Package "~w"'-[H], nl ],
2383 pack_list(T).
2384
2385process_lines([]) --> [].
2386process_lines([H|T]) -->
2387 [ '~s'-[H] ],
2388 ( {T==[]}
2389 -> []
2390 ; [nl], process_lines(T)
2391 ).
2392
2393split_lines([], []) :- !.
2394split_lines(All, [Line1|More]) :-
2395 append(Line1, [0'\n|Rest], All),
2396 !,
2397 split_lines(Rest, More).
2398split_lines(Line, [Line]).
2399
2400label(remove_only(Pack)) -->
2401 [ 'Only remove package ~w (break dependencies)'-[Pack] ].
2402label(remove_deps(Pack, Deps)) -->
2403 { length(Deps, Count) },
2404 [ 'Remove package ~w and ~D dependencies'-[Pack, Count] ].
2405label(create_dir(Dir)) -->
2406 [ '~w'-[Dir] ].
2407label(install_from(git(URL))) -->
2408 !,
2409 [ 'GIT repository at ~w'-[URL] ].
2410label(install_from(URL)) -->
2411 [ '~w'-[URL] ].
2412label(cancel) -->
2413 [ 'Cancel' ].
2414
2415confirm_default(yes) -->
2416 [ ' Y/n? ' ].
2417confirm_default(no) -->
2418 [ ' y/N? ' ].
2419confirm_default(none) -->
2420 [ ' y/n? ' ].
2421
2422msg_version(Version) -->
2423 { atom(Version) },
2424 !,
2425 [ '~w'-[Version] ].
2426msg_version(VersionData) -->
2427 !,
2428 { atom_version(Atom, VersionData) },
2429 [ '~w'-[Atom] ]