View source with formatted comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2012-2021, VU University Amsterdam
    7                              CWI, Amsterdam
    8                              SWI-Prolog Solutions b.v.
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(prolog_pack,
   38          [ pack_list_installed/0,
   39            pack_info/1,                % +Name
   40            pack_list/1,                % +Keyword
   41            pack_search/1,              % +Keyword
   42            pack_install/1,             % +Name
   43            pack_install/2,             % +Name, +Options
   44            pack_upgrade/1,             % +Name
   45            pack_rebuild/1,             % +Name
   46            pack_rebuild/0,             % All packages
   47            pack_remove/1,              % +Name
   48            pack_property/2,            % ?Name, ?Property
   49            pack_attach/2,              % +Dir, +Options
   50
   51            pack_url_file/2             % +URL, -File
   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), []).   % plugin for POST support
   66:- use_module(library(prolog_config)).   67:- use_module(library(debug), [assertion/1]).   68:- use_module(library(pairs), [group_pairs_by_key/2]).   69% Stuff we may not have and may not need
   70:- autoload(library(git)).   71:- autoload(library(sgml)).   72:- autoload(library(sha)).   73:- autoload(library(build/tools)).   74
   75/** <module> A package manager for Prolog
   76
   77The library(prolog_pack) provides the SWI-Prolog   package manager. This
   78library lets you inspect installed   packages,  install packages, remove
   79packages, etc. It is complemented by   the  built-in attach_packs/0 that
   80makes installed packages available as libraries.
   81
   82@see    Installed packages can be inspected using =|?- doc_browser.|=
   83@tbd    Version logic
   84@tbd    Find and resolve conflicts
   85@tbd    Upgrade git packages
   86@tbd    Validate git packages
   87@tbd    Test packages: run tests from directory `test'.
   88*/
   89
   90:- multifile
   91    environment/2.                          % Name, Value
   92
   93:- dynamic
   94    pack_requires/2,                        % Pack, Requirement
   95    pack_provides_db/2.                     % Pack, Provided
   96
   97
   98                 /*******************************
   99                 *          CONSTANTS           *
  100                 *******************************/
  101
  102:- setting(server, atom, 'https://www.swi-prolog.org/pack/',
  103           'Server to exchange pack information').  104
  105
  106                 /*******************************
  107                 *         PACKAGE INFO         *
  108                 *******************************/
  109
  110%!  current_pack(?Pack) is nondet.
  111%!  current_pack(?Pack, ?Dir) is nondet.
  112%
  113%   True if Pack is a currently installed pack.
  114
  115current_pack(Pack) :-
  116    current_pack(Pack, _).
  117
  118current_pack(Pack, Dir) :-
  119    '$pack':pack(Pack, Dir).
  120
  121%!  pack_list_installed is det.
  122%
  123%   List currently installed  packages.   Unlike  pack_list/1,  only
  124%   locally installed packages are displayed   and  no connection is
  125%   made to the internet.
  126%
  127%   @see Use pack_list/1 to find packages.
  128
  129pack_list_installed :-
  130    findall(Pack, current_pack(Pack), Packages0),
  131    Packages0 \== [],
  132    !,
  133    sort(Packages0, Packages),
  134    length(Packages, Count),
  135    format('Installed packages (~D):~n~n', [Count]),
  136    maplist(pack_info(list), Packages),
  137    validate_dependencies.
  138pack_list_installed :-
  139    print_message(informational, pack(no_packages_installed)).
  140
  141%!  pack_info(+Pack)
  142%
  143%   Print more detailed information about Pack.
  144
  145pack_info(Name) :-
  146    pack_info(info, Name).
  147
  148pack_info(Level, Name) :-
  149    must_be(atom, Name),
  150    findall(Info, pack_info(Name, Level, Info), Infos0),
  151    (   Infos0 == []
  152    ->  print_message(warning, pack(no_pack_installed(Name))),
  153        fail
  154    ;   true
  155    ),
  156    update_dependency_db(Name, Infos0),
  157    findall(Def,  pack_default(Level, Infos, Def), Defs),
  158    append(Infos0, Defs, Infos1),
  159    sort(Infos1, Infos),
  160    show_info(Name, Infos, [info(Level)]).
  161
  162
  163show_info(_Name, _Properties, Options) :-
  164    option(silent(true), Options),
  165    !.
  166show_info(Name, Properties, Options) :-
  167    option(info(list), Options),
  168    !,
  169    memberchk(title(Title), Properties),
  170    memberchk(version(Version), Properties),
  171    format('i ~w@~w ~28|- ~w~n', [Name, Version, Title]).
  172show_info(Name, Properties, _) :-
  173    !,
  174    print_property_value('Package'-'~w', [Name]),
  175    findall(Term, pack_level_info(info, Term, _, _), Terms),
  176    maplist(print_property(Properties), Terms).
  177
  178print_property(_, nl) :-
  179    !,
  180    format('~n').
  181print_property(Properties, Term) :-
  182    findall(Term, member(Term, Properties), Terms),
  183    Terms \== [],
  184    !,
  185    pack_level_info(_, Term, LabelFmt, _Def),
  186    (   LabelFmt = Label-FmtElem
  187    ->  true
  188    ;   Label = LabelFmt,
  189        FmtElem = '~w'
  190    ),
  191    multi_valued(Terms, FmtElem, FmtList, Values),
  192    atomic_list_concat(FmtList, ', ', Fmt),
  193    print_property_value(Label-Fmt, Values).
  194print_property(_, _).
  195
  196multi_valued([H], LabelFmt, [LabelFmt], Values) :-
  197    !,
  198    H =.. [_|Values].
  199multi_valued([H|T], LabelFmt, [LabelFmt|LT], Values) :-
  200    H =.. [_|VH],
  201    append(VH, MoreValues, Values),
  202    multi_valued(T, LabelFmt, LT, MoreValues).
  203
  204
  205pvalue_column(24).
  206print_property_value(Prop-Fmt, Values) :-
  207    !,
  208    pvalue_column(C),
  209    atomic_list_concat(['~w:~t~*|', Fmt, '~n'], Format),
  210    format(Format, [Prop,C|Values]).
  211
  212pack_info(Name, Level, Info) :-
  213    '$pack':pack(Name, BaseDir),
  214    (   Info = directory(BaseDir)
  215    ;   pack_info_term(BaseDir, Info)
  216    ),
  217    pack_level_info(Level, Info, _Format, _Default).
  218
  219:- public pack_level_info/4.                    % used by web-server
  220
  221pack_level_info(_,    title(_),         'Title',                   '<no title>').
  222pack_level_info(_,    version(_),       'Installed version',       '<unknown>').
  223pack_level_info(info, directory(_),     'Installed in directory',  -).
  224pack_level_info(info, author(_, _),     'Author'-'~w <~w>',        -).
  225pack_level_info(info, maintainer(_, _), 'Maintainer'-'~w <~w>',    -).
  226pack_level_info(info, packager(_, _),   'Packager'-'~w <~w>',      -).
  227pack_level_info(info, home(_),          'Home page',               -).
  228pack_level_info(info, download(_),      'Download URL',            -).
  229pack_level_info(_,    provides(_),      'Provides',                -).
  230pack_level_info(_,    requires(_),      'Requires',                -).
  231pack_level_info(_,    conflicts(_),     'Conflicts with',          -).
  232pack_level_info(_,    replaces(_),      'Replaces packages',       -).
  233pack_level_info(info, library(_),	'Provided libraries',      -).
  234
  235pack_default(Level, Infos, Def) :-
  236    pack_level_info(Level, ITerm, _Format, Def),
  237    Def \== (-),
  238    \+ memberchk(ITerm, Infos).
  239
  240%!  pack_info_term(+PackDir, ?Info) is nondet.
  241%
  242%   True when Info is meta-data for the package PackName.
  243
  244pack_info_term(BaseDir, Info) :-
  245    directory_file_path(BaseDir, 'pack.pl', InfoFile),
  246    catch(
  247        setup_call_cleanup(
  248            open(InfoFile, read, In),
  249            term_in_stream(In, Info),
  250            close(In)),
  251        error(existence_error(source_sink, InfoFile), _),
  252        ( print_message(error, pack(no_meta_data(BaseDir))),
  253          fail
  254        )).
  255pack_info_term(BaseDir, library(Lib)) :-
  256    atom_concat(BaseDir, '/prolog/', LibDir),
  257    atom_concat(LibDir, '*.pl', Pattern),
  258    expand_file_name(Pattern, Files),
  259    maplist(atom_concat(LibDir), Plain, Files),
  260    convlist(base_name, Plain, Libs),
  261    member(Lib, Libs).
  262
  263base_name(File, Base) :-
  264    file_name_extension(Base, pl, File).
  265
  266term_in_stream(In, Term) :-
  267    repeat,
  268        read_term(In, Term0, []),
  269        (   Term0 == end_of_file
  270        ->  !, fail
  271        ;   Term = Term0,
  272            valid_info_term(Term0)
  273        ).
  274
  275valid_info_term(Term) :-
  276    Term =.. [Name|Args],
  277    same_length(Args, Types),
  278    Decl =.. [Name|Types],
  279    (   pack_info_term(Decl)
  280    ->  maplist(valid_info_arg, Types, Args)
  281    ;   print_message(warning, pack(invalid_info(Term))),
  282        fail
  283    ).
  284
  285valid_info_arg(Type, Arg) :-
  286    must_be(Type, Arg).
  287
  288%!  pack_info_term(?Term) is nondet.
  289%
  290%   True when Term describes name and   arguments of a valid package
  291%   info term.
  292
  293pack_info_term(name(atom)).                     % Synopsis
  294pack_info_term(title(atom)).
  295pack_info_term(keywords(list(atom))).
  296pack_info_term(description(list(atom))).
  297pack_info_term(version(version)).
  298pack_info_term(author(atom, email_or_url_or_empty)).     % Persons
  299pack_info_term(maintainer(atom, email_or_url)).
  300pack_info_term(packager(atom, email_or_url)).
  301pack_info_term(home(atom)).                     % Home page
  302pack_info_term(download(atom)).                 % Source
  303pack_info_term(provides(atom)).                 % Dependencies
  304pack_info_term(requires(dependency)).
  305pack_info_term(conflicts(dependency)).          % Conflicts with package
  306pack_info_term(replaces(atom)).                 % Replaces another package
  307pack_info_term(autoload(boolean)).              % Default installation options
  308
  309:- multifile
  310    error:has_type/2.  311
  312error:has_type(version, Version) :-
  313    atom(Version),
  314    version_data(Version, _Data).
  315error:has_type(email_or_url, Address) :-
  316    atom(Address),
  317    (   sub_atom(Address, _, _, _, @)
  318    ->  true
  319    ;   uri_is_global(Address)
  320    ).
  321error:has_type(email_or_url_or_empty, Address) :-
  322    (   Address == ''
  323    ->  true
  324    ;   error:has_type(email_or_url, Address)
  325    ).
  326error:has_type(dependency, Value) :-
  327    is_dependency(Value, _Token, _Version).
  328
  329version_data(Version, version(Data)) :-
  330    atomic_list_concat(Parts, '.', Version),
  331    maplist(atom_number, Parts, Data).
  332
  333is_dependency(Token, Token, *) :-
  334    atom(Token).
  335is_dependency(Term, Token, VersionCmp) :-
  336    Term =.. [Op,Token,Version],
  337    cmp(Op, _),
  338    version_data(Version, _),
  339    VersionCmp =.. [Op,Version].
  340
  341cmp(<,  @<).
  342cmp(=<, @=<).
  343cmp(==, ==).
  344cmp(>=, @>=).
  345cmp(>,  @>).
  346
  347
  348                 /*******************************
  349                 *            SEARCH            *
  350                 *******************************/
  351
  352%!  pack_search(+Query) is det.
  353%!  pack_list(+Query) is det.
  354%
  355%   Query package server and installed packages and display results.
  356%   Query is matches case-insensitively against   the name and title
  357%   of known and installed packages. For   each  matching package, a
  358%   single line is displayed that provides:
  359%
  360%     - Installation status
  361%       - *p*: package, not installed
  362%       - *i*: installed package; up-to-date with public version
  363%       - *U*: installed package; can be upgraded
  364%       - *A*: installed package; newer than publically available
  365%       - *l*: installed package; not on server
  366%     - Name@Version
  367%     - Name@Version(ServerVersion)
  368%     - Title
  369%
  370%   Hint: =|?- pack_list('').|= lists all packages.
  371%
  372%   The predicates pack_list/1 and pack_search/1  are synonyms. Both
  373%   contact the package server at  http://www.swi-prolog.org to find
  374%   available packages.
  375%
  376%   @see    pack_list_installed/0 to list installed packages without
  377%           contacting the server.
  378
  379pack_list(Query) :-
  380    pack_search(Query).
  381
  382pack_search(Query) :-
  383    query_pack_server(search(Query), Result, []),
  384    (   Result == false
  385    ->  (   local_search(Query, Packs),
  386            Packs \== []
  387        ->  forall(member(pack(Pack, Stat, Title, Version, _), Packs),
  388                   format('~w ~w@~w ~28|- ~w~n',
  389                          [Stat, Pack, Version, Title]))
  390        ;   print_message(warning, pack(search_no_matches(Query)))
  391        )
  392    ;   Result = true(Hits),
  393        local_search(Query, Local),
  394        append(Hits, Local, All),
  395        sort(All, Sorted),
  396        list_hits(Sorted)
  397    ).
  398
  399list_hits([]).
  400list_hits([ pack(Pack, i, Title, Version, _),
  401            pack(Pack, p, Title, Version, _)
  402          | More
  403          ]) :-
  404    !,
  405    format('i ~w@~w ~28|- ~w~n', [Pack, Version, Title]),
  406    list_hits(More).
  407list_hits([ pack(Pack, i, Title, VersionI, _),
  408            pack(Pack, p, _,     VersionS, _)
  409          | More
  410          ]) :-
  411    !,
  412    version_data(VersionI, VDI),
  413    version_data(VersionS, VDS),
  414    (   VDI @< VDS
  415    ->  Tag = ('U')
  416    ;   Tag = ('A')
  417    ),
  418    format('~w ~w@~w(~w) ~28|- ~w~n', [Tag, Pack, VersionI, VersionS, Title]),
  419    list_hits(More).
  420list_hits([ pack(Pack, i, Title, VersionI, _)
  421          | More
  422          ]) :-
  423    !,
  424    format('l ~w@~w ~28|- ~w~n', [Pack, VersionI, Title]),
  425    list_hits(More).
  426list_hits([pack(Pack, Stat, Title, Version, _)|More]) :-
  427    format('~w ~w@~w ~28|- ~w~n', [Stat, Pack, Version, Title]),
  428    list_hits(More).
  429
  430
  431local_search(Query, Packs) :-
  432    findall(Pack, matching_installed_pack(Query, Pack), Packs).
  433
  434matching_installed_pack(Query, pack(Pack, i, Title, Version, URL)) :-
  435    current_pack(Pack),
  436    findall(Term,
  437            ( pack_info(Pack, _, Term),
  438              search_info(Term)
  439            ), Info),
  440    (   sub_atom_icasechk(Pack, _, Query)
  441    ->  true
  442    ;   memberchk(title(Title), Info),
  443        sub_atom_icasechk(Title, _, Query)
  444    ),
  445    option(title(Title), Info, '<no title>'),
  446    option(version(Version), Info, '<no version>'),
  447    option(download(URL), Info, '<no download url>').
  448
  449search_info(title(_)).
  450search_info(version(_)).
  451search_info(download(_)).
  452
  453
  454                 /*******************************
  455                 *            INSTALL           *
  456                 *******************************/
  457
  458%!  pack_install(+Spec:atom) is det.
  459%
  460%   Install a package.  Spec is one of
  461%
  462%     * Archive file name
  463%     * HTTP URL of an archive file name.  This URL may contain a
  464%       star (*) for the version.  In this case pack_install asks
  465%       for the directory content and selects the latest version.
  466%     * GIT URL (not well supported yet)
  467%     * A local directory name given as =|file://|= URL or `'.'`
  468%     * A package name.  This queries the package repository
  469%       at http://www.swi-prolog.org
  470%
  471%   After resolving the type of package,   pack_install/2 is used to
  472%   do the actual installation.
  473
  474pack_install(Spec) :-
  475    pack_default_options(Spec, Pack, [], Options),
  476    pack_install(Pack, [pack(Pack)|Options]).
  477
  478%!  pack_default_options(+Spec, -Pack, +OptionsIn, -Options) is det.
  479%
  480%   Establish  the  pack  name  (Pack)  and    install  options  from  a
  481%   specification and options (OptionsIn) provided by the user.
  482
  483pack_default_options(_Spec, Pack, OptsIn, Options) :-
  484    option(already_installed(pack(Pack,_Version)), OptsIn),
  485    !,
  486    Options = OptsIn.
  487pack_default_options(_Spec, Pack, OptsIn, Options) :-
  488    option(url(URL), OptsIn),
  489    !,
  490    (   option(git(_), OptsIn)
  491    ->  Options = OptsIn
  492    ;   git_url(URL, Pack)
  493    ->  Options = [git(true)|OptsIn]
  494    ;   Options = OptsIn
  495    ),
  496    (   nonvar(Pack)
  497    ->  true
  498    ;   option(pack(Pack), Options)
  499    ->  true
  500    ;   pack_version_file(Pack, _Version, URL)
  501    ).
  502pack_default_options(Archive, Pack, _, Options) :-      % Install from archive
  503    must_be(atom, Archive),
  504    \+ uri_is_global(Archive),
  505    expand_file_name(Archive, [File]),
  506    exists_file(File),
  507    !,
  508    pack_version_file(Pack, Version, File),
  509    uri_file_name(FileURL, File),
  510    Options = [url(FileURL), version(Version)].
  511pack_default_options(URL, Pack, _, Options) :-
  512    git_url(URL, Pack),
  513    !,
  514    Options = [git(true), url(URL)].
  515pack_default_options(FileURL, Pack, _, Options) :-      % Install from directory
  516    uri_file_name(FileURL, Dir),
  517    exists_directory(Dir),
  518    pack_info_term(Dir, name(Pack)),
  519    !,
  520    (   pack_info_term(Dir, version(Version))
  521    ->  uri_file_name(DirURL, Dir),
  522        Options = [url(DirURL), version(Version)]
  523    ;   throw(error(existence_error(key, version, Dir),_))
  524    ).
  525pack_default_options('.', Pack, _, Options) :-          % Install from CWD
  526    pack_info_term('.', name(Pack)),
  527    !,
  528    working_directory(Dir, Dir),
  529    (   pack_info_term(Dir, version(Version))
  530    ->  uri_file_name(DirURL, Dir),
  531        Options = [url(DirURL), version(Version) | Options1],
  532        (   current_prolog_flag(windows, true)
  533        ->  Options1 = []
  534        ;   Options1 = [link(true), rebuild(make)]
  535        )
  536    ;   throw(error(existence_error(key, version, Dir),_))
  537    ).
  538pack_default_options(URL, Pack, _, Options) :-          % Install from URL
  539    pack_version_file(Pack, Version, URL),
  540    download_url(URL),
  541    !,
  542    available_download_versions(URL, [URLVersion-LatestURL|_]),
  543    Options = [url(LatestURL)|VersionOptions],
  544    version_options(Version, URLVersion, VersionOptions).
  545pack_default_options(Pack, Pack, OptsIn, Options) :-    % Install from name
  546    \+ uri_is_global(Pack),                             % ignore URLs
  547    query_pack_server(locate(Pack), Reply, OptsIn),
  548    (   Reply = true(Results)
  549    ->  pack_select_candidate(Pack, Results, OptsIn, Options)
  550    ;   print_message(warning, pack(no_match(Pack))),
  551        fail
  552    ).
  553
  554version_options(Version, Version, [version(Version)]) :- !.
  555version_options(Version, _, [version(Version)]) :-
  556    Version = version(List),
  557    maplist(integer, List),
  558    !.
  559version_options(_, _, []).
  560
  561%!  pack_select_candidate(+Pack, +AvailableVersions, +OptionsIn, -Options)
  562%
  563%   Select from available packages.
  564
  565pack_select_candidate(Pack, [Version-_|_], Options,
  566                      [already_installed(pack(Pack, Installed))|Options]) :-
  567    current_pack(Pack),
  568    pack_info(Pack, _, version(InstalledAtom)),
  569    atom_version(InstalledAtom, Installed),
  570    Installed @>= Version,
  571    !.
  572pack_select_candidate(Pack, Available, Options, OptsOut) :-
  573    option(url(URL), Options),
  574    memberchk(_Version-URLs, Available),
  575    memberchk(URL, URLs),
  576    !,
  577    (   git_url(URL, Pack)
  578    ->  Extra = [git(true)]
  579    ;   Extra = []
  580    ),
  581    OptsOut = [url(URL), inquiry(true) | Extra].
  582pack_select_candidate(Pack, [Version-[URL]|_], Options,
  583                      [url(URL), git(true), inquiry(true)]) :-
  584    git_url(URL, Pack),
  585    !,
  586    confirm(install_from(Pack, Version, git(URL)), yes, Options).
  587pack_select_candidate(Pack, [Version-[URL]|More], Options,
  588                      [url(URL), inquiry(true)]) :-
  589    (   More == []
  590    ->  !
  591    ;   true
  592    ),
  593    confirm(install_from(Pack, Version, URL), yes, Options),
  594    !.
  595pack_select_candidate(Pack, [Version-URLs|_], Options,
  596                      [url(URL), inquiry(true)|Rest]) :-
  597    maplist(url_menu_item, URLs, Tagged),
  598    append(Tagged, [cancel=cancel], Menu),
  599    Menu = [Default=_|_],
  600    menu(pack(select_install_from(Pack, Version)),
  601         Menu, Default, Choice, Options),
  602    (   Choice == cancel
  603    ->  fail
  604    ;   Choice = git(URL)
  605    ->  Rest = [git(true)]
  606    ;   Choice = URL,
  607        Rest = []
  608    ).
  609
  610url_menu_item(URL, git(URL)=install_from(git(URL))) :-
  611    git_url(URL, _),
  612    !.
  613url_menu_item(URL, URL=install_from(URL)).
  614
  615
  616%!  pack_install(+Name, +Options) is det.
  617%
  618%   Install package Name.  Processes  the   options  below.  Default
  619%   options as would be used by  pack_install/1 are used to complete
  620%   the provided Options.
  621%
  622%     * url(+URL)
  623%     Source for downloading the package
  624%     * package_directory(+Dir)
  625%     Directory into which to install the package
  626%     * interactive(+Boolean)
  627%     Use default answer without asking the user if there
  628%     is a default action.
  629%     * silent(+Boolean)
  630%     If `true` (default false), suppress informational progress
  631%     messages.
  632%     * upgrade(+Boolean)
  633%     If `true` (default `false`), upgrade package if it is already
  634%     installed.
  635%     * rebuild(Condition)
  636%     Rebuild the foreign components.  Condition is one of
  637%     `if_absent` (default, do nothing if the directory with foreign
  638%     resources exists), `make` (run `make`) or `true` (run `make
  639%     distclean` followed by the default configure and build steps).
  640%     * git(+Boolean)
  641%     If `true` (default `false` unless `URL` ends with =.git=),
  642%     assume the URL is a GIT repository.
  643%     * link(+Boolean)
  644%     Can be used if the installation source is a local directory
  645%     and the file system supports symbolic links.  In this case
  646%     the system adds the current directory to the pack registration
  647%     using a symbolic link and performs the local installation steps.
  648%
  649%   Non-interactive installation can be established using the option
  650%   interactive(false). It is adviced to   install from a particular
  651%   _trusted_ URL instead of the  plain   pack  name  for unattented
  652%   operation.
  653
  654pack_install(Spec, Options) :-
  655    pack_default_options(Spec, Pack, Options, DefOptions),
  656    (   option(already_installed(Installed), DefOptions)
  657    ->  print_message(informational, pack(already_installed(Installed)))
  658    ;   merge_options(Options, DefOptions, PackOptions),
  659        update_dependency_db,
  660        pack_install_dir(PackDir, PackOptions),
  661        pack_install(Pack, PackDir, PackOptions)
  662    ).
  663
  664pack_install_dir(PackDir, Options) :-
  665    option(package_directory(PackDir), Options),
  666    !.
  667pack_install_dir(PackDir, _Options) :-          % TBD: global/user?
  668    absolute_file_name(pack(.), PackDir,
  669                       [ file_type(directory),
  670                         access(write),
  671                         file_errors(fail)
  672                       ]),
  673    !.
  674pack_install_dir(PackDir, Options) :-           % TBD: global/user?
  675    pack_create_install_dir(PackDir, Options).
  676
  677pack_create_install_dir(PackDir, Options) :-
  678    findall(Candidate = create_dir(Candidate),
  679            ( absolute_file_name(pack(.), Candidate, [solutions(all)]),
  680              \+ exists_file(Candidate),
  681              \+ exists_directory(Candidate),
  682              file_directory_name(Candidate, Super),
  683              (   exists_directory(Super)
  684              ->  access_file(Super, write)
  685              ;   true
  686              )
  687            ),
  688            Candidates0),
  689    list_to_set(Candidates0, Candidates),   % keep order
  690    pack_create_install_dir(Candidates, PackDir, Options).
  691
  692pack_create_install_dir(Candidates, PackDir, Options) :-
  693    Candidates = [Default=_|_],
  694    !,
  695    append(Candidates, [cancel=cancel], Menu),
  696    menu(pack(create_pack_dir), Menu, Default, Selected, Options),
  697    Selected \== cancel,
  698    (   catch(make_directory_path(Selected), E,
  699              (print_message(warning, E), fail))
  700    ->  PackDir = Selected
  701    ;   delete(Candidates, PackDir=create_dir(PackDir), Remaining),
  702        pack_create_install_dir(Remaining, PackDir, Options)
  703    ).
  704pack_create_install_dir(_, _, _) :-
  705    print_message(error, pack(cannot_create_dir(pack(.)))),
  706    fail.
  707
  708
  709%!  pack_install(+Pack, +PackDir, +Options)
  710%
  711%   Install package Pack into PackDir.  Options:
  712%
  713%     - url(URL)
  714%     Install from the given URL, URL is either a file://, a git URL
  715%     or a download URL.
  716%     - upgrade(Boolean)
  717%     If Pack is already installed and Boolean is `true`, update the
  718%     package to the latest version.  If Boolean is `false` print
  719%     an error and fail.
  720
  721pack_install(Name, _, Options) :-
  722    current_pack(Name, Dir),
  723    option(upgrade(false), Options, false),
  724    \+ pack_is_in_local_dir(Name, Dir, Options),
  725    print_message(error, pack(already_installed(Name))),
  726    pack_info(Name),
  727    print_message(information, pack(remove_with(Name))),
  728    !,
  729    fail.
  730pack_install(Name, PackDir, Options) :-
  731    option(url(URL), Options),
  732    uri_file_name(URL, Source),
  733    !,
  734    pack_install_from_local(Source, PackDir, Name, Options).
  735pack_install(Name, PackDir, Options) :-
  736    option(url(URL), Options),
  737    uri_components(URL, Components),
  738    uri_data(scheme, Components, Scheme),
  739    pack_install_from_url(Scheme, URL, PackDir, Name, Options).
  740
  741%!  pack_install_from_local(+Source, +PackTopDir, +Name, +Options)
  742%
  743%   Install a package from a local media.
  744%
  745%   @tbd    Provide an option to install directories using a
  746%           link (or file-links).
  747
  748pack_install_from_local(Source, PackTopDir, Name, Options) :-
  749    exists_directory(Source),
  750    !,
  751    directory_file_path(PackTopDir, Name, PackDir),
  752    (   option(link(true), Options)
  753    ->  (   same_file(Source, PackDir)
  754        ->  true
  755        ;   atom_concat(PackTopDir, '/', PackTopDirS),
  756            relative_file_name(Source, PackTopDirS, RelPath),
  757            link_file(RelPath, PackDir, symbolic),
  758            assertion(same_file(Source, PackDir))
  759        )
  760    ;   prepare_pack_dir(PackDir, Options),
  761        copy_directory(Source, PackDir)
  762    ),
  763    pack_post_install(Name, PackDir, Options).
  764pack_install_from_local(Source, PackTopDir, Name, Options) :-
  765    exists_file(Source),
  766    directory_file_path(PackTopDir, Name, PackDir),
  767    prepare_pack_dir(PackDir, Options),
  768    pack_unpack(Source, PackDir, Name, Options),
  769    pack_post_install(Name, PackDir, Options).
  770
  771pack_is_in_local_dir(_Pack, PackDir, Options) :-
  772    option(url(DirURL), Options),
  773    uri_file_name(DirURL, Dir),
  774    same_file(PackDir, Dir).
  775
  776
  777%!  pack_unpack(+SourceFile, +PackDir, +Pack, +Options)
  778%
  779%   Unpack an archive to the given package dir.
  780
  781:- if(exists_source(library(archive))).  782pack_unpack(Source, PackDir, Pack, Options) :-
  783    ensure_loaded_archive,
  784    pack_archive_info(Source, Pack, _Info, StripOptions),
  785    prepare_pack_dir(PackDir, Options),
  786    archive_extract(Source, PackDir,
  787                    [ exclude(['._*'])          % MacOS resource forks
  788                    | StripOptions
  789                    ]).
  790:- else.  791pack_unpack(_,_,_,_) :-
  792    existence_error(library, archive).
  793:- endif.  794
  795                 /*******************************
  796                 *             INFO             *
  797                 *******************************/
  798
  799%!  pack_archive_info(+Archive, +Pack, -Info, -Strip)
  800%
  801%   True when Archive archives Pack. Info  is unified with the terms
  802%   from pack.pl in the  pack  and   Strip  is  the strip-option for
  803%   archive_extract/3.
  804%
  805%   Requires library(archive), which is lazily loaded when needed.
  806%
  807%   @error  existence_error(pack_file, 'pack.pl') if the archive
  808%           doesn't contain pack.pl
  809%   @error  Syntax errors if pack.pl cannot be parsed.
  810
  811:- if(exists_source(library(archive))).  812ensure_loaded_archive :-
  813    current_predicate(archive_open/3),
  814    !.
  815ensure_loaded_archive :-
  816    use_module(library(archive)).
  817
  818pack_archive_info(Archive, Pack, [archive_size(Bytes)|Info], Strip) :-
  819    ensure_loaded_archive,
  820    size_file(Archive, Bytes),
  821    setup_call_cleanup(
  822        archive_open(Archive, Handle, []),
  823        (   repeat,
  824            (   archive_next_header(Handle, InfoFile)
  825            ->  true
  826            ;   !, fail
  827            )
  828        ),
  829        archive_close(Handle)),
  830    file_base_name(InfoFile, 'pack.pl'),
  831    atom_concat(Prefix, 'pack.pl', InfoFile),
  832    strip_option(Prefix, Pack, Strip),
  833    setup_call_cleanup(
  834        archive_open_entry(Handle, Stream),
  835        read_stream_to_terms(Stream, Info),
  836        close(Stream)),
  837    !,
  838    must_be(ground, Info),
  839    maplist(valid_info_term, Info).
  840:- else.  841pack_archive_info(_, _, _, _) :-
  842    existence_error(library, archive).
  843:- endif.  844pack_archive_info(_, _, _, _) :-
  845    existence_error(pack_file, 'pack.pl').
  846
  847strip_option('', _, []) :- !.
  848strip_option('./', _, []) :- !.
  849strip_option(Prefix, Pack, [remove_prefix(Prefix)]) :-
  850    atom_concat(PrefixDir, /, Prefix),
  851    file_base_name(PrefixDir, Base),
  852    (   Base == Pack
  853    ->  true
  854    ;   pack_version_file(Pack, _, Base)
  855    ->  true
  856    ;   \+ sub_atom(PrefixDir, _, _, _, /)
  857    ).
  858
  859read_stream_to_terms(Stream, Terms) :-
  860    read(Stream, Term0),
  861    read_stream_to_terms(Term0, Stream, Terms).
  862
  863read_stream_to_terms(end_of_file, _, []) :- !.
  864read_stream_to_terms(Term0, Stream, [Term0|Terms]) :-
  865    read(Stream, Term1),
  866    read_stream_to_terms(Term1, Stream, Terms).
  867
  868
  869%!  pack_git_info(+GitDir, -Hash, -Info) is det.
  870%
  871%   Retrieve info from a cloned git   repository  that is compatible
  872%   with pack_archive_info/4.
  873
  874pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :-
  875    exists_directory(GitDir),
  876    !,
  877    git_ls_tree(Entries, [directory(GitDir)]),
  878    git_hash(Hash, [directory(GitDir)]),
  879    maplist(arg(4), Entries, Sizes),
  880    sum_list(Sizes, Bytes),
  881    directory_file_path(GitDir, 'pack.pl', InfoFile),
  882    read_file_to_terms(InfoFile, Info, [encoding(utf8)]),
  883    must_be(ground, Info),
  884    maplist(valid_info_term, Info).
  885
  886%!  download_file_sanity_check(+Archive, +Pack, +Info) is semidet.
  887%
  888%   Perform basic sanity checks on DownloadFile
  889
  890download_file_sanity_check(Archive, Pack, Info) :-
  891    info_field(name(Name), Info),
  892    info_field(version(VersionAtom), Info),
  893    atom_version(VersionAtom, Version),
  894    pack_version_file(PackA, VersionA, Archive),
  895    must_match([Pack, PackA, Name], name),
  896    must_match([Version, VersionA], version).
  897
  898info_field(Field, Info) :-
  899    memberchk(Field, Info),
  900    ground(Field),
  901    !.
  902info_field(Field, _Info) :-
  903    functor(Field, FieldName, _),
  904    print_message(error, pack(missing(FieldName))),
  905    fail.
  906
  907must_match(Values, _Field) :-
  908    sort(Values, [_]),
  909    !.
  910must_match(Values, Field) :-
  911    print_message(error, pack(conflict(Field, Values))),
  912    fail.
  913
  914
  915                 /*******************************
  916                 *         INSTALLATION         *
  917                 *******************************/
  918
  919%!  prepare_pack_dir(+Dir, +Options)
  920%
  921%   Prepare for installing the package into  Dir. This
  922%
  923%     - If the directory exist and is empty, done.
  924%     - Else if the directory exists, remove the directory and recreate
  925%       it. Note that if the directory is a symlink this just deletes
  926%       the link.
  927%     - Else create the directory.
  928
  929prepare_pack_dir(Dir, Options) :-
  930    exists_directory(Dir),
  931    !,
  932    (   empty_directory(Dir)
  933    ->  true
  934    ;   (   option(upgrade(true), Options)
  935        ;   confirm(remove_existing_pack(Dir), yes, Options)
  936        )
  937    ->  delete_directory_and_contents(Dir),
  938        make_directory(Dir)
  939    ).
  940prepare_pack_dir(Dir, _) :-
  941    make_directory(Dir).
  942
  943%!  empty_directory(+Directory) is semidet.
  944%
  945%   True if Directory is empty (holds no files or sub-directories).
  946
  947empty_directory(Dir) :-
  948    \+ ( directory_files(Dir, Entries),
  949         member(Entry, Entries),
  950         \+ special(Entry)
  951       ).
  952
  953special(.).
  954special(..).
  955
  956
  957%!  pack_install_from_url(+Scheme, +URL, +PackDir, +Pack, +Options)
  958%
  959%   Install a package from a remote source. For git repositories, we
  960%   simply clone. Archives are  downloaded.   We  currently  use the
  961%   built-in HTTP client. For complete  coverage, we should consider
  962%   using an external (e.g., curl) if available.
  963
  964pack_install_from_url(_, URL, PackTopDir, Pack, Options) :-
  965    option(git(true), Options),
  966    !,
  967    directory_file_path(PackTopDir, Pack, PackDir),
  968    prepare_pack_dir(PackDir, Options),
  969    run_process(path(git), [clone, URL, PackDir], []),
  970    pack_git_info(PackDir, Hash, Info),
  971    pack_inquiry(URL, git(Hash), Info, Options),
  972    show_info(Pack, Info, Options),
  973    confirm(git_post_install(PackDir, Pack), yes, Options),
  974    pack_post_install(Pack, PackDir, Options).
  975pack_install_from_url(Scheme, URL, PackTopDir, Pack, Options) :-
  976    download_scheme(Scheme),
  977    directory_file_path(PackTopDir, Pack, PackDir),
  978    prepare_pack_dir(PackDir, Options),
  979    pack_download_dir(PackTopDir, DownLoadDir),
  980    download_file(URL, Pack, DownloadBase, Options),
  981    directory_file_path(DownLoadDir, DownloadBase, DownloadFile),
  982    setup_call_cleanup(
  983        http_open(URL, In,
  984                  [ cert_verify_hook(ssl_verify)
  985                  ]),
  986        setup_call_cleanup(
  987            open(DownloadFile, write, Out, [type(binary)]),
  988            copy_stream_data(In, Out),
  989            close(Out)),
  990        close(In)),
  991    pack_archive_info(DownloadFile, Pack, Info, _),
  992    download_file_sanity_check(DownloadFile, Pack, Info),
  993    pack_inquiry(URL, DownloadFile, Info, Options),
  994    show_info(Pack, Info, Options),
  995    confirm(install_downloaded(DownloadFile), yes, Options),
  996    pack_install_from_local(DownloadFile, PackTopDir, Pack, Options).
  997
  998%!  download_file(+URL, +Pack, -File, +Options) is det.
  999
 1000download_file(URL, Pack, File, Options) :-
 1001    option(version(Version), Options),
 1002    !,
 1003    atom_version(VersionA, Version),
 1004    file_name_extension(_, Ext, URL),
 1005    format(atom(File), '~w-~w.~w', [Pack, VersionA, Ext]).
 1006download_file(URL, Pack, File, _) :-
 1007    file_base_name(URL,Basename),
 1008    no_int_file_name_extension(Tag,Ext,Basename),
 1009    tag_version(Tag,Version),
 1010    !,
 1011    atom_version(VersionA,Version),
 1012    format(atom(File0), '~w-~w', [Pack, VersionA]),
 1013    file_name_extension(File0, Ext, File).
 1014download_file(URL, _, File, _) :-
 1015    file_base_name(URL, File).
 1016
 1017%!  pack_url_file(+URL, -File) is det.
 1018%
 1019%   True if File is a unique id for the referenced pack and version.
 1020%   Normally, that is simply the  base   name,  but  GitHub archives
 1021%   destroy this picture. Needed by the pack manager.
 1022
 1023pack_url_file(URL, FileID) :-
 1024    github_release_url(URL, Pack, Version),
 1025    !,
 1026    download_file(URL, Pack, FileID, [version(Version)]).
 1027pack_url_file(URL, FileID) :-
 1028    file_base_name(URL, FileID).
 1029
 1030
 1031:- public ssl_verify/5. 1032
 1033%!  ssl_verify(+SSL, +ProblemCert, +AllCerts, +FirstCert, +Error)
 1034%
 1035%   Currently we accept  all  certificates.   We  organise  our  own
 1036%   security using SHA1 signatures, so  we   do  not  care about the
 1037%   source of the data.
 1038
 1039ssl_verify(_SSL,
 1040           _ProblemCertificate, _AllCertificates, _FirstCertificate,
 1041           _Error).
 1042
 1043pack_download_dir(PackTopDir, DownLoadDir) :-
 1044    directory_file_path(PackTopDir, 'Downloads', DownLoadDir),
 1045    (   exists_directory(DownLoadDir)
 1046    ->  true
 1047    ;   make_directory(DownLoadDir)
 1048    ),
 1049    (   access_file(DownLoadDir, write)
 1050    ->  true
 1051    ;   permission_error(write, directory, DownLoadDir)
 1052    ).
 1053
 1054%!  download_url(+URL) is det.
 1055%
 1056%   True if URL looks like a URL we can download from.
 1057
 1058download_url(URL) :-
 1059    atom(URL),
 1060    uri_components(URL, Components),
 1061    uri_data(scheme, Components, Scheme),
 1062    download_scheme(Scheme).
 1063
 1064download_scheme(http).
 1065download_scheme(https) :-
 1066    catch(use_module(library(http/http_ssl_plugin)),
 1067          E, (print_message(warning, E), fail)).
 1068
 1069%!  pack_post_install(+Pack, +PackDir, +Options) is det.
 1070%
 1071%   Process post installation work.  Steps:
 1072%
 1073%     - Create foreign resources
 1074%     - Register directory as autoload library
 1075%     - Attach the package
 1076
 1077pack_post_install(Pack, PackDir, Options) :-
 1078    post_install_foreign(Pack, PackDir, Options),
 1079    post_install_autoload(PackDir, Options),
 1080    '$pack_attach'(PackDir).
 1081
 1082%!  pack_rebuild(+Pack) is det.
 1083%
 1084%   Rebuilt possible foreign components of Pack.
 1085
 1086pack_rebuild(Pack) :-
 1087    current_pack(Pack, PackDir),
 1088    !,
 1089    post_install_foreign(Pack, PackDir, [rebuild(true)]).
 1090pack_rebuild(Pack) :-
 1091    existence_error(pack, Pack).
 1092
 1093%!  pack_rebuild is det.
 1094%
 1095%   Rebuild foreign components of all packages.
 1096
 1097pack_rebuild :-
 1098    forall(current_pack(Pack),
 1099           ( print_message(informational, pack(rebuild(Pack))),
 1100             pack_rebuild(Pack)
 1101           )).
 1102
 1103
 1104%!  post_install_foreign(+Pack, +PackDir, +Options) is det.
 1105%
 1106%   Install foreign parts of the package.
 1107
 1108post_install_foreign(Pack, PackDir, Options) :-
 1109    is_foreign_pack(PackDir, _),
 1110    !,
 1111    option(rebuild(Rebuild), Options, if_absent),
 1112    (   Rebuild == if_absent,
 1113        foreign_present(PackDir)
 1114    ->  print_message(informational, pack(kept_foreign(Pack)))
 1115    ;   BuildSteps0 = [[dependencies], [configure], build, [test], install],
 1116        (   Rebuild == true
 1117        ->  BuildSteps = [distclean|BuildSteps0]
 1118        ;   BuildSteps = BuildSteps0
 1119        ),
 1120        build_steps(BuildSteps, PackDir, Options)
 1121    ).
 1122post_install_foreign(_, _, _).
 1123
 1124
 1125%!  foreign_present(+PackDir) is semidet.
 1126%
 1127%   True if we find one or more modules  in the pack `lib` directory for
 1128%   the current architecture. Does not check   that these can be loaded,
 1129%   nor whether all required modules are present.
 1130
 1131foreign_present(PackDir) :-
 1132    current_prolog_flag(arch, Arch),
 1133    atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
 1134    exists_directory(ForeignBaseDir),
 1135    !,
 1136    atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
 1137    exists_directory(ForeignDir),
 1138    current_prolog_flag(shared_object_extension, Ext),
 1139    atomic_list_concat([ForeignDir, '/*.', Ext], Pattern),
 1140    expand_file_name(Pattern, Files),
 1141    Files \== [].
 1142
 1143%!  is_foreign_pack(+PackDir, -Type) is nondet.
 1144%
 1145%   True when PackDir contains  files  that   indicate  the  need  for a
 1146%   specific class of build tools indicated by Type.
 1147
 1148is_foreign_pack(PackDir, Type) :-
 1149    foreign_file(File, Type),
 1150    directory_file_path(PackDir, File, Path),
 1151    exists_file(Path).
 1152
 1153foreign_file('CMakeLists.txt', cmake).
 1154foreign_file('configure',      configure).
 1155foreign_file('configure.in',   autoconf).
 1156foreign_file('configure.ac',   autoconf).
 1157foreign_file('Makefile.am',    automake).
 1158foreign_file('Makefile',       make).
 1159foreign_file('makefile',       make).
 1160foreign_file('conanfile.txt',  conan).
 1161foreign_file('conanfile.py',   conan).
 1162
 1163
 1164                 /*******************************
 1165                 *           AUTOLOAD           *
 1166                 *******************************/
 1167
 1168%!  post_install_autoload(+PackDir, +Options)
 1169%
 1170%   Create an autoload index if the package demands such.
 1171
 1172post_install_autoload(PackDir, Options) :-
 1173    option(autoload(true), Options, true),
 1174    pack_info_term(PackDir, autoload(true)),
 1175    !,
 1176    directory_file_path(PackDir, prolog, PrologLibDir),
 1177    make_library_index(PrologLibDir).
 1178post_install_autoload(_, _).
 1179
 1180
 1181                 /*******************************
 1182                 *            UPGRADE           *
 1183                 *******************************/
 1184
 1185%!  pack_upgrade(+Pack) is semidet.
 1186%
 1187%   Try to upgrade the package Pack.
 1188%
 1189%   @tbd    Update dependencies when updating a pack from git?
 1190
 1191pack_upgrade(Pack) :-
 1192    pack_info(Pack, _, directory(Dir)),
 1193    directory_file_path(Dir, '.git', GitDir),
 1194    exists_directory(GitDir),
 1195    !,
 1196    print_message(informational, pack(git_fetch(Dir))),
 1197    git([fetch], [ directory(Dir) ]),
 1198    git_describe(V0, [ directory(Dir) ]),
 1199    git_describe(V1, [ directory(Dir), commit('origin/master') ]),
 1200    (   V0 == V1
 1201    ->  print_message(informational, pack(up_to_date(Pack)))
 1202    ;   confirm(upgrade(Pack, V0, V1), yes, []),
 1203        git([merge, 'origin/master'], [ directory(Dir) ]),
 1204        pack_rebuild(Pack)
 1205    ).
 1206pack_upgrade(Pack) :-
 1207    once(pack_info(Pack, _, version(VersionAtom))),
 1208    atom_version(VersionAtom, Version),
 1209    pack_info(Pack, _, download(URL)),
 1210    (   wildcard_pattern(URL)
 1211    ->  true
 1212    ;   github_url(URL, _User, _Repo)
 1213    ),
 1214    !,
 1215    available_download_versions(URL, [Latest-LatestURL|_Versions]),
 1216    (   Latest @> Version
 1217    ->  confirm(upgrade(Pack, Version, Latest), yes, []),
 1218        pack_install(Pack,
 1219                     [ url(LatestURL),
 1220                       upgrade(true),
 1221                       pack(Pack)
 1222                     ])
 1223    ;   print_message(informational, pack(up_to_date(Pack)))
 1224    ).
 1225pack_upgrade(Pack) :-
 1226    print_message(warning, pack(no_upgrade_info(Pack))).
 1227
 1228
 1229                 /*******************************
 1230                 *            REMOVE            *
 1231                 *******************************/
 1232
 1233%!  pack_remove(+Name) is det.
 1234%
 1235%   Remove the indicated package.
 1236
 1237pack_remove(Pack) :-
 1238    update_dependency_db,
 1239    (   setof(Dep, pack_depends_on(Dep, Pack), Deps)
 1240    ->  confirm_remove(Pack, Deps, Delete),
 1241        forall(member(P, Delete), pack_remove_forced(P))
 1242    ;   pack_remove_forced(Pack)
 1243    ).
 1244
 1245pack_remove_forced(Pack) :-
 1246    catch('$pack_detach'(Pack, BaseDir),
 1247          error(existence_error(pack, Pack), _),
 1248          fail),
 1249    !,
 1250    print_message(informational, pack(remove(BaseDir))),
 1251    delete_directory_and_contents(BaseDir).
 1252pack_remove_forced(Pack) :-
 1253    directory_file_path(Pack, 'pack.pl', PackFile),
 1254    absolute_file_name(pack(PackFile), PackPath,
 1255                       [ access(read),
 1256                         file_errors(fail)
 1257                       ]),
 1258    !,
 1259    file_directory_name(PackPath, BaseDir),
 1260    delete_directory_and_contents(BaseDir).
 1261pack_remove_forced(Pack) :-
 1262    print_message(informational, error(existence_error(pack, Pack),_)).
 1263
 1264confirm_remove(Pack, Deps, Delete) :-
 1265    print_message(warning, pack(depends(Pack, Deps))),
 1266    menu(pack(resolve_remove),
 1267         [ [Pack]      = remove_only(Pack),
 1268           [Pack|Deps] = remove_deps(Pack, Deps),
 1269           []          = cancel
 1270         ], [], Delete, []),
 1271    Delete \== [].
 1272
 1273
 1274                 /*******************************
 1275                 *           PROPERTIES         *
 1276                 *******************************/
 1277
 1278%!  pack_property(?Pack, ?Property) is nondet.
 1279%
 1280%   True when Property  is  a  property   of  an  installed  Pack.  This
 1281%   interface is intended for programs that   wish  to interact with the
 1282%   package manager. Defined properties are:
 1283%
 1284%     - directory(Directory)
 1285%     Directory into which the package is installed
 1286%     - version(Version)
 1287%     Installed version
 1288%     - title(Title)
 1289%     Full title of the package
 1290%     - author(Author)
 1291%     Registered author
 1292%     - download(URL)
 1293%     Official download URL
 1294%     - readme(File)
 1295%     Package README file (if present)
 1296%     - todo(File)
 1297%     Package TODO file (if present)
 1298
 1299pack_property(Pack, Property) :-
 1300    findall(Pack-Property, pack_property_(Pack, Property), List),
 1301    member(Pack-Property, List).            % make det if applicable
 1302
 1303pack_property_(Pack, Property) :-
 1304    pack_info(Pack, _, Property).
 1305pack_property_(Pack, Property) :-
 1306    \+ \+ info_file(Property, _),
 1307    '$pack':pack(Pack, BaseDir),
 1308    access_file(BaseDir, read),
 1309    directory_files(BaseDir, Files),
 1310    member(File, Files),
 1311    info_file(Property, Pattern),
 1312    downcase_atom(File, Pattern),
 1313    directory_file_path(BaseDir, File, InfoFile),
 1314    arg(1, Property, InfoFile).
 1315
 1316info_file(readme(_), 'readme.txt').
 1317info_file(readme(_), 'readme').
 1318info_file(todo(_),   'todo.txt').
 1319info_file(todo(_),   'todo').
 1320
 1321
 1322                 /*******************************
 1323                 *             GIT              *
 1324                 *******************************/
 1325
 1326%!  git_url(+URL, -Pack) is semidet.
 1327%
 1328%   True if URL describes a git url for Pack
 1329
 1330git_url(URL, Pack) :-
 1331    uri_components(URL, Components),
 1332    uri_data(scheme, Components, Scheme),
 1333    uri_data(path, Components, Path),
 1334    (   Scheme == git
 1335    ->  true
 1336    ;   git_download_scheme(Scheme),
 1337        file_name_extension(_, git, Path)
 1338    ),
 1339    file_base_name(Path, PackExt),
 1340    (   file_name_extension(Pack, git, PackExt)
 1341    ->  true
 1342    ;   Pack = PackExt
 1343    ),
 1344    (   safe_pack_name(Pack)
 1345    ->  true
 1346    ;   domain_error(pack_name, Pack)
 1347    ).
 1348
 1349git_download_scheme(http).
 1350git_download_scheme(https).
 1351
 1352%!  safe_pack_name(+Name:atom) is semidet.
 1353%
 1354%   Verifies that Name is a valid   pack  name. This avoids trickery
 1355%   with pack file names to make shell commands behave unexpectly.
 1356
 1357safe_pack_name(Name) :-
 1358    atom_length(Name, Len),
 1359    Len >= 3,                               % demand at least three length
 1360    atom_codes(Name, Codes),
 1361    maplist(safe_pack_char, Codes),
 1362    !.
 1363
 1364safe_pack_char(C) :- between(0'a, 0'z, C), !.
 1365safe_pack_char(C) :- between(0'A, 0'Z, C), !.
 1366safe_pack_char(C) :- between(0'0, 0'9, C), !.
 1367safe_pack_char(0'_).
 1368
 1369
 1370                 /*******************************
 1371                 *         VERSION LOGIC        *
 1372                 *******************************/
 1373
 1374%!  pack_version_file(-Pack, -Version, +File) is semidet.
 1375%
 1376%   True if File is the  name  of  a   file  or  URL  of a file that
 1377%   contains Pack at Version. File must   have  an extension and the
 1378%   basename  must  be  of   the    form   <pack>-<n>{.<m>}*.  E.g.,
 1379%   =|mypack-1.5|=.
 1380
 1381pack_version_file(Pack, Version, GitHubRelease) :-
 1382    atomic(GitHubRelease),
 1383    github_release_url(GitHubRelease, Pack, Version),
 1384    !.
 1385pack_version_file(Pack, Version, Path) :-
 1386    atomic(Path),
 1387    file_base_name(Path, File),
 1388    no_int_file_name_extension(Base, _Ext, File),
 1389    atom_codes(Base, Codes),
 1390    (   phrase(pack_version(Pack, Version), Codes),
 1391        safe_pack_name(Pack)
 1392    ->  true
 1393    ).
 1394
 1395no_int_file_name_extension(Base, Ext, File) :-
 1396    file_name_extension(Base0, Ext0, File),
 1397    \+ atom_number(Ext0, _),
 1398    !,
 1399    Base = Base0,
 1400    Ext = Ext0.
 1401no_int_file_name_extension(File, '', File).
 1402
 1403
 1404
 1405%!  github_release_url(+URL, -Pack, -Version) is semidet.
 1406%
 1407%   True when URL is the URL of a GitHub release.  Such releases are
 1408%   accessible as
 1409%
 1410%     ==
 1411%     https:/github.com/<owner>/<pack>/archive/[vV]?<version>.zip'
 1412%     ==
 1413
 1414github_release_url(URL, Pack, Version) :-
 1415    uri_components(URL, Components),
 1416    uri_data(authority, Components, 'github.com'),
 1417    uri_data(scheme, Components, Scheme),
 1418    download_scheme(Scheme),
 1419    uri_data(path, Components, Path),
 1420    atomic_list_concat(['',_Project,Pack,archive,File], /, Path),
 1421    file_name_extension(Tag, Ext, File),
 1422    github_archive_extension(Ext),
 1423    tag_version(Tag, Version),
 1424    !.
 1425
 1426github_archive_extension(tgz).
 1427github_archive_extension(zip).
 1428
 1429tag_version(Tag, Version) :-
 1430    version_tag_prefix(Prefix),
 1431    atom_concat(Prefix, AtomVersion, Tag),
 1432    atom_version(AtomVersion, Version).
 1433
 1434version_tag_prefix(v).
 1435version_tag_prefix('V').
 1436version_tag_prefix('').
 1437
 1438
 1439:- public
 1440    atom_version/2. 1441
 1442%!  atom_version(?Atom, ?Version)
 1443%
 1444%   Translate   between   atomic   version   representation   and   term
 1445%   representation.  The  term  representation  is  a  list  of  version
 1446%   components as integers and can be compared using `@>`
 1447
 1448atom_version(Atom, version(Parts)) :-
 1449    (   atom(Atom)
 1450    ->  atom_codes(Atom, Codes),
 1451        phrase(version(Parts), Codes)
 1452    ;   atomic_list_concat(Parts, '.', Atom)
 1453    ).
 1454
 1455pack_version(Pack, version(Parts)) -->
 1456    string(Codes), "-",
 1457    version(Parts),
 1458    !,
 1459    { atom_codes(Pack, Codes)
 1460    }.
 1461
 1462version([_|T]) -->
 1463    "*",
 1464    !,
 1465    (   "."
 1466    ->  version(T)
 1467    ;   []
 1468    ).
 1469version([H|T]) -->
 1470    integer(H),
 1471    (   "."
 1472    ->  version(T)
 1473    ;   { T = [] }
 1474    ).
 1475
 1476                 /*******************************
 1477                 *       QUERY CENTRAL DB       *
 1478                 *******************************/
 1479
 1480%!  pack_inquiry(+URL, +DownloadFile, +Info, +Options) is semidet.
 1481%
 1482%   Query the status of a package  with   the  central repository. To do
 1483%   this, we POST a Prolog document  containing   the  URL, info and the
 1484%   SHA1 hash to http://www.swi-prolog.org/pack/eval. The server replies
 1485%   using a list of Prolog terms, described  below. The only member that
 1486%   is always included is downloads (with default value 0).
 1487%
 1488%     - alt_hash(Count, URLs, Hash)
 1489%       A file with the same base-name, but a different hash was
 1490%       found at URLs and downloaded Count times.
 1491%     - downloads(Count)
 1492%       Number of times a file with this hash was downloaded.
 1493%     - rating(VoteCount, Rating)
 1494%       User rating (1..5), provided based on VoteCount votes.
 1495%     - dependency(Token, Pack, Version, URLs, SubDeps)
 1496%       Required tokens can be provided by the given provides.
 1497
 1498pack_inquiry(_, _, _, Options) :-
 1499    option(inquiry(false), Options),
 1500    !.
 1501pack_inquiry(URL, DownloadFile, Info, Options) :-
 1502    setting(server, ServerBase),
 1503    ServerBase \== '',
 1504    atom_concat(ServerBase, query, Server),
 1505    (   option(inquiry(true), Options)
 1506    ->  true
 1507    ;   confirm(inquiry(Server), yes, Options)
 1508    ),
 1509    !,
 1510    (   DownloadFile = git(SHA1)
 1511    ->  true
 1512    ;   file_sha1(DownloadFile, SHA1)
 1513    ),
 1514    query_pack_server(install(URL, SHA1, Info), Reply, Options),
 1515    inquiry_result(Reply, URL, Options).
 1516pack_inquiry(_, _, _, _).
 1517
 1518
 1519%!  query_pack_server(+Query, -Result, +Options)
 1520%
 1521%   Send a Prolog query  to  the   package  server  and  process its
 1522%   results.
 1523
 1524query_pack_server(Query, Result, Options) :-
 1525    setting(server, ServerBase),
 1526    ServerBase \== '',
 1527    atom_concat(ServerBase, query, Server),
 1528    format(codes(Data), '~q.~n', Query),
 1529    info_level(Informational, Options),
 1530    print_message(Informational, pack(contacting_server(Server))),
 1531    setup_call_cleanup(
 1532        http_open(Server, In,
 1533                  [ post(codes(application/'x-prolog', Data)),
 1534                    header(content_type, ContentType)
 1535                  ]),
 1536        read_reply(ContentType, In, Result),
 1537        close(In)),
 1538    message_severity(Result, Level, Informational),
 1539    print_message(Level, pack(server_reply(Result))).
 1540
 1541read_reply(ContentType, In, Result) :-
 1542    sub_atom(ContentType, 0, _, _, 'application/x-prolog'),
 1543    !,
 1544    set_stream(In, encoding(utf8)),
 1545    read(In, Result).
 1546read_reply(ContentType, In, _Result) :-
 1547    read_string(In, 500, String),
 1548    print_message(error, pack(no_prolog_response(ContentType, String))),
 1549    fail.
 1550
 1551info_level(Level, Options) :-
 1552    option(silent(true), Options),
 1553    !,
 1554    Level = silent.
 1555info_level(informational, _).
 1556
 1557message_severity(true(_), Informational, Informational).
 1558message_severity(false, warning, _).
 1559message_severity(exception(_), error, _).
 1560
 1561
 1562%!  inquiry_result(+Reply, +File, +Options) is semidet.
 1563%
 1564%   Analyse the results  of  the  inquiry   and  decide  whether  to
 1565%   continue or not.
 1566
 1567inquiry_result(Reply, File, Options) :-
 1568    findall(Eval, eval_inquiry(Reply, File, Eval, Options), Evaluation),
 1569    \+ member(cancel, Evaluation),
 1570    select_option(git(_), Options, Options1, _),
 1571    forall(member(install_dependencies(Resolution), Evaluation),
 1572           maplist(install_dependency(Options1), Resolution)).
 1573
 1574eval_inquiry(true(Reply), URL, Eval, _) :-
 1575    include(alt_hash, Reply, Alts),
 1576    Alts \== [],
 1577    print_message(warning, pack(alt_hashes(URL, Alts))),
 1578    (   memberchk(downloads(Count), Reply),
 1579        (   git_url(URL, _)
 1580        ->  Default = yes,
 1581            Eval = with_git_commits_in_same_version
 1582        ;   Default = no,
 1583            Eval = with_alt_hashes
 1584        ),
 1585        confirm(continue_with_alt_hashes(Count, URL), Default, [])
 1586    ->  true
 1587    ;   !,                          % Stop other rules
 1588        Eval = cancel
 1589    ).
 1590eval_inquiry(true(Reply), _, Eval, Options) :-
 1591    include(dependency, Reply, Deps),
 1592    Deps \== [],
 1593    select_dependency_resolution(Deps, Eval, Options),
 1594    (   Eval == cancel
 1595    ->  !
 1596    ;   true
 1597    ).
 1598eval_inquiry(true(Reply), URL, true, Options) :-
 1599    file_base_name(URL, File),
 1600    info_level(Informational, Options),
 1601    print_message(Informational, pack(inquiry_ok(Reply, File))).
 1602eval_inquiry(exception(pack(modified_hash(_SHA1-URL, _SHA2-[URL]))),
 1603             URL, Eval, Options) :-
 1604    (   confirm(continue_with_modified_hash(URL), no, Options)
 1605    ->  Eval = true
 1606    ;   Eval = cancel
 1607    ).
 1608
 1609alt_hash(alt_hash(_,_,_)).
 1610dependency(dependency(_,_,_,_,_)).
 1611
 1612
 1613%!  select_dependency_resolution(+Deps, -Eval, +Options)
 1614%
 1615%   Select a resolution.
 1616%
 1617%   @tbd    Exploit backtracking over resolve_dependencies/2.
 1618
 1619select_dependency_resolution(Deps, Eval, Options) :-
 1620    resolve_dependencies(Deps, Resolution),
 1621    exclude(local_dep, Resolution, ToBeDone),
 1622    (   ToBeDone == []
 1623    ->  !, Eval = true
 1624    ;   print_message(warning, pack(install_dependencies(Resolution))),
 1625        (   memberchk(_-unresolved, Resolution)
 1626        ->  Default = cancel
 1627        ;   Default = install_deps
 1628        ),
 1629        menu(pack(resolve_deps),
 1630             [ install_deps    = install_deps,
 1631               install_no_deps = install_no_deps,
 1632               cancel          = cancel
 1633             ], Default, Choice, Options),
 1634        (   Choice == cancel
 1635        ->  !, Eval = cancel
 1636        ;   Choice == install_no_deps
 1637        ->  !, Eval = install_no_deps
 1638        ;   !, Eval = install_dependencies(Resolution)
 1639        )
 1640    ).
 1641
 1642local_dep(_-resolved(_)).
 1643
 1644
 1645%!  install_dependency(+Options, +TokenResolution)
 1646%
 1647%   Install dependencies for the given resolution.
 1648%
 1649%   @tbd: Query URI to use
 1650
 1651install_dependency(Options,
 1652                   _Token-resolve(Pack, VersionAtom, [_URL|_], SubResolve)) :-
 1653    atom_version(VersionAtom, Version),
 1654    current_pack(Pack),
 1655    pack_info(Pack, _, version(InstalledAtom)),
 1656    atom_version(InstalledAtom, Installed),
 1657    Installed == Version,               % already installed
 1658    !,
 1659    maplist(install_dependency(Options), SubResolve).
 1660install_dependency(Options,
 1661                   _Token-resolve(Pack, VersionAtom, [URL|_], SubResolve)) :-
 1662    !,
 1663    atom_version(VersionAtom, Version),
 1664    merge_options([ url(URL),
 1665                    version(Version),
 1666                    interactive(false),
 1667                    inquiry(false),
 1668                    info(list),
 1669                    pack(Pack)
 1670                  ], Options, InstallOptions),
 1671    pack_install(Pack, InstallOptions),
 1672    maplist(install_dependency(Options), SubResolve).
 1673install_dependency(_, _-_).
 1674
 1675
 1676                 /*******************************
 1677                 *        WILDCARD URIs         *
 1678                 *******************************/
 1679
 1680%!  available_download_versions(+URL, -Versions) is det.
 1681%
 1682%   Deal with wildcard URLs, returning a  list of Version-URL pairs,
 1683%   sorted by version.
 1684%
 1685%   @tbd    Deal with protocols other than HTTP
 1686
 1687available_download_versions(URL, Versions) :-
 1688    wildcard_pattern(URL),
 1689    github_url(URL, User, Repo),
 1690    !,
 1691    findall(Version-VersionURL,
 1692            github_version(User, Repo, Version, VersionURL),
 1693            Versions).
 1694available_download_versions(URL, Versions) :-
 1695    wildcard_pattern(URL),
 1696    !,
 1697    file_directory_name(URL, DirURL0),
 1698    ensure_slash(DirURL0, DirURL),
 1699    print_message(informational, pack(query_versions(DirURL))),
 1700    setup_call_cleanup(
 1701        http_open(DirURL, In, []),
 1702        load_html(stream(In), DOM,
 1703                  [ syntax_errors(quiet)
 1704                  ]),
 1705        close(In)),
 1706    findall(MatchingURL,
 1707            absolute_matching_href(DOM, URL, MatchingURL),
 1708            MatchingURLs),
 1709    (   MatchingURLs == []
 1710    ->  print_message(warning, pack(no_matching_urls(URL)))
 1711    ;   true
 1712    ),
 1713    versioned_urls(MatchingURLs, VersionedURLs),
 1714    keysort(VersionedURLs, SortedVersions),
 1715    reverse(SortedVersions, Versions),
 1716    print_message(informational, pack(found_versions(Versions))).
 1717available_download_versions(URL, [Version-URL]) :-
 1718    (   pack_version_file(_Pack, Version0, URL)
 1719    ->  Version = Version0
 1720    ;   Version = unknown
 1721    ).
 1722
 1723%!  github_url(+URL, -User, -Repo) is semidet.
 1724%
 1725%   True when URL refers to a github repository.
 1726
 1727github_url(URL, User, Repo) :-
 1728    uri_components(URL, uri_components(https,'github.com',Path,_,_)),
 1729    atomic_list_concat(['',User,Repo|_], /, Path).
 1730
 1731
 1732%!  github_version(+User, +Repo, -Version, -VersionURI) is nondet.
 1733%
 1734%   True when Version is a release version and VersionURI is the
 1735%   download location for the zip file.
 1736
 1737github_version(User, Repo, Version, VersionURI) :-
 1738    atomic_list_concat(['',repos,User,Repo,tags], /, Path1),
 1739    uri_components(ApiUri, uri_components(https,'api.github.com',Path1,_,_)),
 1740    setup_call_cleanup(
 1741      http_open(ApiUri, In,
 1742                [ request_header('Accept'='application/vnd.github.v3+json')
 1743                ]),
 1744      json_read_dict(In, Dicts),
 1745      close(In)),
 1746    member(Dict, Dicts),
 1747    atom_string(Tag, Dict.name),
 1748    tag_version(Tag, Version),
 1749    atom_string(VersionURI, Dict.zipball_url).
 1750
 1751wildcard_pattern(URL) :- sub_atom(URL, _, _, _, *).
 1752wildcard_pattern(URL) :- sub_atom(URL, _, _, _, ?).
 1753
 1754ensure_slash(Dir, DirS) :-
 1755    (   sub_atom(Dir, _, _, 0, /)
 1756    ->  DirS = Dir
 1757    ;   atom_concat(Dir, /, DirS)
 1758    ).
 1759
 1760absolute_matching_href(DOM, Pattern, Match) :-
 1761    xpath(DOM, //a(@href), HREF),
 1762    uri_normalized(HREF, Pattern, Match),
 1763    wildcard_match(Pattern, Match).
 1764
 1765versioned_urls([], []).
 1766versioned_urls([H|T0], List) :-
 1767    file_base_name(H, File),
 1768    (   pack_version_file(_Pack, Version, File)
 1769    ->  List = [Version-H|T]
 1770    ;   List = T
 1771    ),
 1772    versioned_urls(T0, T).
 1773
 1774
 1775                 /*******************************
 1776                 *          DEPENDENCIES        *
 1777                 *******************************/
 1778
 1779%!  update_dependency_db
 1780%
 1781%   Reload dependency declarations between packages.
 1782
 1783update_dependency_db :-
 1784    retractall(pack_requires(_,_)),
 1785    retractall(pack_provides_db(_,_)),
 1786    forall(current_pack(Pack),
 1787           (   findall(Info, pack_info(Pack, dependency, Info), Infos),
 1788               update_dependency_db(Pack, Infos)
 1789           )).
 1790
 1791update_dependency_db(Name, Info) :-
 1792    retractall(pack_requires(Name, _)),
 1793    retractall(pack_provides_db(Name, _)),
 1794    maplist(assert_dep(Name), Info).
 1795
 1796assert_dep(Pack, provides(Token)) :-
 1797    !,
 1798    assertz(pack_provides_db(Pack, Token)).
 1799assert_dep(Pack, requires(Token)) :-
 1800    !,
 1801    assertz(pack_requires(Pack, Token)).
 1802assert_dep(_, _).
 1803
 1804%!  validate_dependencies is det.
 1805%
 1806%   Validate all dependencies, reporting on failures
 1807
 1808validate_dependencies :-
 1809    unsatisfied_dependencies(Unsatisfied),
 1810    !,
 1811    print_message(warning, pack(unsatisfied(Unsatisfied))).
 1812validate_dependencies.
 1813
 1814
 1815unsatisfied_dependencies(Unsatisfied) :-
 1816    findall(Req-Pack, pack_requires(Pack, Req), Reqs0),
 1817    keysort(Reqs0, Reqs1),
 1818    group_pairs_by_key(Reqs1, GroupedReqs),
 1819    exclude(satisfied_dependency, GroupedReqs, Unsatisfied),
 1820    Unsatisfied \== [].
 1821
 1822satisfied_dependency(Needed-_By) :-
 1823    pack_provides(_, Needed),
 1824    !.
 1825satisfied_dependency(Needed-_By) :-
 1826    compound(Needed),
 1827    Needed =.. [Op, Pack, ReqVersion],
 1828    (   pack_provides(Pack, Pack)
 1829    ->  pack_info(Pack, _, version(PackVersion)),
 1830        version_data(PackVersion, PackData)
 1831    ;   Pack == prolog
 1832    ->  current_prolog_flag(version_data, swi(Major,Minor,Patch,_)),
 1833        PackData = [Major,Minor,Patch]
 1834    ),
 1835    version_data(ReqVersion, ReqData),
 1836    cmp(Op, Cmp),
 1837    call(Cmp, PackData, ReqData).
 1838
 1839%!  pack_provides(?Package, ?Token) is multi.
 1840%
 1841%   True if Pack provides Token.  A package always provides itself.
 1842
 1843pack_provides(Pack, Pack) :-
 1844    current_pack(Pack).
 1845pack_provides(Pack, Token) :-
 1846    pack_provides_db(Pack, Token).
 1847
 1848%!  pack_depends_on(?Pack, ?Dependency) is nondet.
 1849%
 1850%   True if Pack requires Dependency, direct or indirect.
 1851
 1852pack_depends_on(Pack, Dependency) :-
 1853    (   atom(Pack)
 1854    ->  pack_depends_on_fwd(Pack, Dependency, [Pack])
 1855    ;   pack_depends_on_bwd(Pack, Dependency, [Dependency])
 1856    ).
 1857
 1858pack_depends_on_fwd(Pack, Dependency, Visited) :-
 1859    pack_depends_on_1(Pack, Dep1),
 1860    \+ memberchk(Dep1, Visited),
 1861    (   Dependency = Dep1
 1862    ;   pack_depends_on_fwd(Dep1, Dependency, [Dep1|Visited])
 1863    ).
 1864
 1865pack_depends_on_bwd(Pack, Dependency, Visited) :-
 1866    pack_depends_on_1(Dep1, Dependency),
 1867    \+ memberchk(Dep1, Visited),
 1868    (   Pack = Dep1
 1869    ;   pack_depends_on_bwd(Pack, Dep1, [Dep1|Visited])
 1870    ).
 1871
 1872pack_depends_on_1(Pack, Dependency) :-
 1873    atom(Dependency),
 1874    !,
 1875    pack_provides(Dependency, Token),
 1876    pack_requires(Pack, Token).
 1877pack_depends_on_1(Pack, Dependency) :-
 1878    pack_requires(Pack, Token),
 1879    pack_provides(Dependency, Token).
 1880
 1881
 1882%!  resolve_dependencies(+Dependencies, -Resolution) is multi.
 1883%
 1884%   Resolve dependencies as reported by the remote package server.
 1885%
 1886%   @param  Dependencies is a list of
 1887%           dependency(Token, Pack, Version, URLs, SubDeps)
 1888%   @param  Resolution is a list of items
 1889%           - Token-resolved(Pack)
 1890%           - Token-resolve(Pack, Version, URLs, SubResolve)
 1891%           - Token-unresolved
 1892%   @tbd    Watch out for conflicts
 1893%   @tbd    If there are different packs that resolve a token,
 1894%           make an intelligent choice instead of using the first
 1895
 1896resolve_dependencies(Dependencies, Resolution) :-
 1897    maplist(dependency_pair, Dependencies, Pairs0),
 1898    keysort(Pairs0, Pairs1),
 1899    group_pairs_by_key(Pairs1, ByToken),
 1900    maplist(resolve_dep, ByToken, Resolution).
 1901
 1902dependency_pair(dependency(Token, Pack, Version, URLs, SubDeps),
 1903                Token-(Pack-pack(Version,URLs, SubDeps))).
 1904
 1905resolve_dep(Token-Pairs, Token-Resolution) :-
 1906    (   resolve_dep2(Token-Pairs, Resolution)
 1907    *-> true
 1908    ;   Resolution = unresolved
 1909    ).
 1910
 1911resolve_dep2(Token-_, resolved(Pack)) :-
 1912    pack_provides(Pack, Token).
 1913resolve_dep2(_-Pairs, resolve(Pack, VersionAtom, URLs, SubResolves)) :-
 1914    keysort(Pairs, Sorted),
 1915    group_pairs_by_key(Sorted, ByPack),
 1916    member(Pack-Versions, ByPack),
 1917    Pack \== (-),
 1918    maplist(version_pack, Versions, VersionData),
 1919    sort(VersionData, ByVersion),
 1920    reverse(ByVersion, ByVersionLatest),
 1921    member(pack(Version,URLs,SubDeps), ByVersionLatest),
 1922    atom_version(VersionAtom, Version),
 1923    include(dependency, SubDeps, Deps),
 1924    resolve_dependencies(Deps, SubResolves).
 1925
 1926version_pack(pack(VersionAtom,URLs,SubDeps),
 1927             pack(Version,URLs,SubDeps)) :-
 1928    atom_version(VersionAtom, Version).
 1929
 1930
 1931
 1932%!  pack_attach(+Dir, +Options) is det.
 1933%
 1934%   Attach a single package in Dir.  The Dir is expected to contain
 1935%   the file `pack.pl` and a `prolog` directory.  Options processed:
 1936%
 1937%     - duplicate(+Action)
 1938%     What to do if the same package is already installed in a different
 1939%     directory.  Action is one of
 1940%       - warning
 1941%       Warn and ignore the package
 1942%       - keep
 1943%       Silently ignore the package
 1944%       - replace
 1945%       Unregister the existing and insert the new package
 1946%     - search(+Where)
 1947%     Determines the order of searching package library directories.
 1948%     Default is `last`, alternative is `first`.
 1949%
 1950%   @see attach_packs/2 to attach multiple packs from a directory.
 1951
 1952pack_attach(Dir, Options) :-
 1953    '$pack_attach'(Dir, Options).
 1954
 1955
 1956                 /*******************************
 1957                 *        USER INTERACTION      *
 1958                 *******************************/
 1959
 1960:- multifile prolog:message//1. 1961
 1962%!  menu(Question, +Alternatives, +Default, -Selection, +Options)
 1963
 1964menu(_Question, _Alternatives, Default, Selection, Options) :-
 1965    option(interactive(false), Options),
 1966    !,
 1967    Selection = Default.
 1968menu(Question, Alternatives, Default, Selection, _) :-
 1969    length(Alternatives, N),
 1970    between(1, 5, _),
 1971       print_message(query, Question),
 1972       print_menu(Alternatives, Default, 1),
 1973       print_message(query, pack(menu(select))),
 1974       read_selection(N, Choice),
 1975    !,
 1976    (   Choice == default
 1977    ->  Selection = Default
 1978    ;   nth1(Choice, Alternatives, Selection=_)
 1979    ->  true
 1980    ).
 1981
 1982print_menu([], _, _).
 1983print_menu([Value=Label|T], Default, I) :-
 1984    (   Value == Default
 1985    ->  print_message(query, pack(menu(default_item(I, Label))))
 1986    ;   print_message(query, pack(menu(item(I, Label))))
 1987    ),
 1988    I2 is I + 1,
 1989    print_menu(T, Default, I2).
 1990
 1991read_selection(Max, Choice) :-
 1992    get_single_char(Code),
 1993    (   answered_default(Code)
 1994    ->  Choice = default
 1995    ;   code_type(Code, digit(Choice)),
 1996        between(1, Max, Choice)
 1997    ->  true
 1998    ;   print_message(warning, pack(menu(reply(1,Max)))),
 1999        fail
 2000    ).
 2001
 2002%!  confirm(+Question, +Default, +Options) is semidet.
 2003%
 2004%   Ask for confirmation.
 2005%
 2006%   @param Default is one of =yes=, =no= or =none=.
 2007
 2008confirm(_Question, Default, Options) :-
 2009    Default \== none,
 2010    option(interactive(false), Options, true),
 2011    !,
 2012    Default == yes.
 2013confirm(Question, Default, _) :-
 2014    between(1, 5, _),
 2015       print_message(query, pack(confirm(Question, Default))),
 2016       read_yes_no(YesNo, Default),
 2017    !,
 2018    format(user_error, '~N', []),
 2019    YesNo == yes.
 2020
 2021read_yes_no(YesNo, Default) :-
 2022    get_single_char(Code),
 2023    code_yes_no(Code, Default, YesNo),
 2024    !.
 2025
 2026code_yes_no(0'y, _, yes).
 2027code_yes_no(0'Y, _, yes).
 2028code_yes_no(0'n, _, no).
 2029code_yes_no(0'N, _, no).
 2030code_yes_no(_, none, _) :- !, fail.
 2031code_yes_no(C, Default, Default) :-
 2032    answered_default(C).
 2033
 2034answered_default(0'\r).
 2035answered_default(0'\n).
 2036answered_default(0'\s).
 2037
 2038
 2039                 /*******************************
 2040                 *            MESSAGES          *
 2041                 *******************************/
 2042
 2043:- multifile prolog:message//1. 2044
 2045prolog:message(pack(Message)) -->
 2046    message(Message).
 2047
 2048:- discontiguous
 2049    message//1,
 2050    label//1. 2051
 2052message(invalid_info(Term)) -->
 2053    [ 'Invalid package description: ~q'-[Term] ].
 2054message(directory_exists(Dir)) -->
 2055    [ 'Package target directory exists and is not empty:', nl,
 2056      '\t~q'-[Dir]
 2057    ].
 2058message(already_installed(pack(Pack, Version))) -->
 2059    { atom_version(AVersion, Version) },
 2060    [ 'Pack `~w'' is already installed @~w'-[Pack, AVersion] ].
 2061message(already_installed(Pack)) -->
 2062    [ 'Pack `~w'' is already installed. Package info:'-[Pack] ].
 2063message(invalid_name(File)) -->
 2064    [ '~w: A package archive must be named <pack>-<version>.<ext>'-[File] ],
 2065    no_tar_gz(File).
 2066
 2067no_tar_gz(File) -->
 2068    { sub_atom(File, _, _, 0, '.tar.gz') },
 2069    !,
 2070    [ nl,
 2071      'Package archive files must have a single extension.  E.g., \'.tgz\''-[]
 2072    ].
 2073no_tar_gz(_) --> [].
 2074
 2075message(kept_foreign(Pack)) -->
 2076    [ 'Found foreign libraries for target platform.'-[], nl,
 2077      'Use ?- pack_rebuild(~q). to rebuild from sources'-[Pack]
 2078    ].
 2079message(no_pack_installed(Pack)) -->
 2080    [ 'No pack ~q installed.  Use ?- pack_list(Pattern) to search'-[Pack] ].
 2081message(no_packages_installed) -->
 2082    { setting(server, ServerBase) },
 2083    [ 'There are no extra packages installed.', nl,
 2084      'Please visit ~wlist.'-[ServerBase]
 2085    ].
 2086message(remove_with(Pack)) -->
 2087    [ 'The package can be removed using: ?- ~q.'-[pack_remove(Pack)]
 2088    ].
 2089message(unsatisfied(Packs)) -->
 2090    [ 'The following dependencies are not satisfied:', nl ],
 2091    unsatisfied(Packs).
 2092message(depends(Pack, Deps)) -->
 2093    [ 'The following packages depend on `~w\':'-[Pack], nl ],
 2094    pack_list(Deps).
 2095message(remove(PackDir)) -->
 2096    [ 'Removing ~q and contents'-[PackDir] ].
 2097message(remove_existing_pack(PackDir)) -->
 2098    [ 'Remove old installation in ~q'-[PackDir] ].
 2099message(install_from(Pack, Version, git(URL))) -->
 2100    [ 'Install ~w@~w from GIT at ~w'-[Pack, Version, URL] ].
 2101message(install_from(Pack, Version, URL)) -->
 2102    [ 'Install ~w@~w from ~w'-[Pack, Version, URL] ].
 2103message(select_install_from(Pack, Version)) -->
 2104    [ 'Select download location for ~w@~w'-[Pack, Version] ].
 2105message(install_downloaded(File)) -->
 2106    { file_base_name(File, Base),
 2107      size_file(File, Size) },
 2108    [ 'Install "~w" (~D bytes)'-[Base, Size] ].
 2109message(git_post_install(PackDir, Pack)) -->
 2110    (   { is_foreign_pack(PackDir, _) }
 2111    ->  [ 'Run post installation scripts for pack "~w"'-[Pack] ]
 2112    ;   [ 'Activate pack "~w"'-[Pack] ]
 2113    ).
 2114message(no_meta_data(BaseDir)) -->
 2115    [ 'Cannot find pack.pl inside directory ~q.  Not a package?'-[BaseDir] ].
 2116message(inquiry(Server)) -->
 2117    [ 'Verify package status (anonymously)', nl,
 2118      '\tat "~w"'-[Server]
 2119    ].
 2120message(search_no_matches(Name)) -->
 2121    [ 'Search for "~w", returned no matching packages'-[Name] ].
 2122message(rebuild(Pack)) -->
 2123    [ 'Checking pack "~w" for rebuild ...'-[Pack] ].
 2124message(upgrade(Pack, From, To)) -->
 2125    [ 'Upgrade "~w" from '-[Pack] ],
 2126    msg_version(From), [' to '-[]], msg_version(To).
 2127message(up_to_date(Pack)) -->
 2128    [ 'Package "~w" is up-to-date'-[Pack] ].
 2129message(query_versions(URL)) -->
 2130    [ 'Querying "~w" to find new versions ...'-[URL] ].
 2131message(no_matching_urls(URL)) -->
 2132    [ 'Could not find any matching URL: ~q'-[URL] ].
 2133message(found_versions([Latest-_URL|More])) -->
 2134    { length(More, Len),
 2135      atom_version(VLatest, Latest)
 2136    },
 2137    [ '    Latest version: ~w (~D older)'-[VLatest, Len] ].
 2138message(process_output(Codes)) -->
 2139    { split_lines(Codes, Lines) },
 2140    process_lines(Lines).
 2141message(contacting_server(Server)) -->
 2142    [ 'Contacting server at ~w ...'-[Server], flush ].
 2143message(server_reply(true(_))) -->
 2144    [ at_same_line, ' ok'-[] ].
 2145message(server_reply(false)) -->
 2146    [ at_same_line, ' done'-[] ].
 2147message(server_reply(exception(E))) -->
 2148    [ 'Server reported the following error:'-[], nl ],
 2149    '$messages':translate_message(E).
 2150message(cannot_create_dir(Alias)) -->
 2151    { findall(PackDir,
 2152              absolute_file_name(Alias, PackDir, [solutions(all)]),
 2153              PackDirs0),
 2154      sort(PackDirs0, PackDirs)
 2155    },
 2156    [ 'Cannot find a place to create a package directory.'-[],
 2157      'Considered:'-[]
 2158    ],
 2159    candidate_dirs(PackDirs).
 2160message(no_match(Name)) -->
 2161    [ 'No registered pack matches "~w"'-[Name] ].
 2162message(conflict(version, [PackV, FileV])) -->
 2163    ['Version mismatch: pack.pl: '-[]], msg_version(PackV),
 2164    [', file claims version '-[]], msg_version(FileV).
 2165message(conflict(name, [PackInfo, FileInfo])) -->
 2166    ['Pack ~w mismatch: pack.pl: ~p'-[PackInfo]],
 2167    [', file claims ~w: ~p'-[FileInfo]].
 2168message(no_prolog_response(ContentType, String)) -->
 2169    [ 'Expected Prolog response.  Got content of type ~p'-[ContentType], nl,
 2170      '~s'-[String]
 2171    ].
 2172message(pack(no_upgrade_info(Pack))) -->
 2173    [ '~w: pack meta-data does not provide an upgradable URL'-[Pack] ].
 2174
 2175candidate_dirs([]) --> [].
 2176candidate_dirs([H|T]) --> [ nl, '    ~w'-[H] ], candidate_dirs(T).
 2177
 2178                                                % Questions
 2179message(resolve_remove) -->
 2180    [ nl, 'Please select an action:', nl, nl ].
 2181message(create_pack_dir) -->
 2182    [ nl, 'Create directory for packages', nl ].
 2183message(menu(item(I, Label))) -->
 2184    [ '~t(~d)~6|   '-[I] ],
 2185    label(Label).
 2186message(menu(default_item(I, Label))) -->
 2187    [ '~t(~d)~6| * '-[I] ],
 2188    label(Label).
 2189message(menu(select)) -->
 2190    [ nl, 'Your choice? ', flush ].
 2191message(confirm(Question, Default)) -->
 2192    message(Question),
 2193    confirm_default(Default),
 2194    [ flush ].
 2195message(menu(reply(Min,Max))) -->
 2196    (  { Max =:= Min+1 }
 2197    -> [ 'Please enter ~w or ~w'-[Min,Max] ]
 2198    ;  [ 'Please enter a number between ~w and ~w'-[Min,Max] ]
 2199    ).
 2200
 2201% Alternate hashes for found for the same file
 2202
 2203message(alt_hashes(URL, _Alts)) -->
 2204    { git_url(URL, _)
 2205    },
 2206    !,
 2207    [ 'GIT repository was updated without updating version' ].
 2208message(alt_hashes(URL, Alts)) -->
 2209    { file_base_name(URL, File)
 2210    },
 2211    [ 'Found multiple versions of "~w".'-[File], nl,
 2212      'This could indicate a compromised or corrupted file', nl
 2213    ],
 2214    alt_hashes(Alts).
 2215message(continue_with_alt_hashes(Count, URL)) -->
 2216    [ 'Continue installation from "~w" (downloaded ~D times)'-[URL, Count] ].
 2217message(continue_with_modified_hash(_URL)) -->
 2218    [ 'Pack may be compromised.  Continue anyway'
 2219    ].
 2220message(modified_hash(_SHA1-URL, _SHA2-[URL])) -->
 2221    [ 'Content of ~q has changed.'-[URL]
 2222    ].
 2223
 2224alt_hashes([]) --> [].
 2225alt_hashes([H|T]) --> alt_hash(H), ( {T == []} -> [] ; [nl], alt_hashes(T) ).
 2226
 2227alt_hash(alt_hash(Count, URLs, Hash)) -->
 2228    [ '~t~d~8| ~w'-[Count, Hash] ],
 2229    alt_urls(URLs).
 2230
 2231alt_urls([]) --> [].
 2232alt_urls([H|T]) -->
 2233    [ nl, '    ~w'-[H] ],
 2234    alt_urls(T).
 2235
 2236% Installation dependencies gathered from inquiry server.
 2237
 2238message(install_dependencies(Resolution)) -->
 2239    [ 'Package depends on the following:' ],
 2240    msg_res_tokens(Resolution, 1).
 2241
 2242msg_res_tokens([], _) --> [].
 2243msg_res_tokens([H|T], L) --> msg_res_token(H, L), msg_res_tokens(T, L).
 2244
 2245msg_res_token(Token-unresolved, L) -->
 2246    res_indent(L),
 2247    [ '"~w" cannot be satisfied'-[Token] ].
 2248msg_res_token(Token-resolve(Pack, Version, [URL|_], SubResolves), L) -->
 2249    !,
 2250    res_indent(L),
 2251    [ '"~w", provided by ~w@~w from ~w'-[Token, Pack, Version, URL] ],
 2252    { L2 is L+1 },
 2253    msg_res_tokens(SubResolves, L2).
 2254msg_res_token(Token-resolved(Pack), L) -->
 2255    !,
 2256    res_indent(L),
 2257    [ '"~w", provided by installed pack ~w'-[Token,Pack] ].
 2258
 2259res_indent(L) -->
 2260    { I is L*2 },
 2261    [ nl, '~*c'-[I,0'\s] ].
 2262
 2263message(resolve_deps) -->
 2264    [ nl, 'What do you wish to do' ].
 2265label(install_deps) -->
 2266    [ 'Install proposed dependencies' ].
 2267label(install_no_deps) -->
 2268    [ 'Only install requested package' ].
 2269
 2270
 2271message(git_fetch(Dir)) -->
 2272    [ 'Running "git fetch" in ~q'-[Dir] ].
 2273
 2274% inquiry is blank
 2275
 2276message(inquiry_ok(Reply, File)) -->
 2277    { memberchk(downloads(Count), Reply),
 2278      memberchk(rating(VoteCount, Rating), Reply),
 2279      !,
 2280      length(Stars, Rating),
 2281      maplist(=(0'*), Stars)
 2282    },
 2283    [ '"~w" was downloaded ~D times.  Package rated ~s (~D votes)'-
 2284      [ File, Count, Stars, VoteCount ]
 2285    ].
 2286message(inquiry_ok(Reply, File)) -->
 2287    { memberchk(downloads(Count), Reply)
 2288    },
 2289    [ '"~w" was downloaded ~D times'-[ File, Count ] ].
 2290
 2291                                                % support predicates
 2292unsatisfied([]) --> [].
 2293unsatisfied([Needed-[By]|T]) -->
 2294    [ '  - "~w" is needed by package "~w"'-[Needed, By], nl ],
 2295    unsatisfied(T).
 2296unsatisfied([Needed-By|T]) -->
 2297    [ '  - "~w" is needed by the following packages:'-[Needed], nl ],
 2298    pack_list(By),
 2299    unsatisfied(T).
 2300
 2301pack_list([]) --> [].
 2302pack_list([H|T]) -->
 2303    [ '    - Package "~w"'-[H], nl ],
 2304    pack_list(T).
 2305
 2306process_lines([]) --> [].
 2307process_lines([H|T]) -->
 2308    [ '~s'-[H] ],
 2309    (   {T==[]}
 2310    ->  []
 2311    ;   [nl], process_lines(T)
 2312    ).
 2313
 2314split_lines([], []) :- !.
 2315split_lines(All, [Line1|More]) :-
 2316    append(Line1, [0'\n|Rest], All),
 2317    !,
 2318    split_lines(Rest, More).
 2319split_lines(Line, [Line]).
 2320
 2321label(remove_only(Pack)) -->
 2322    [ 'Only remove package ~w (break dependencies)'-[Pack] ].
 2323label(remove_deps(Pack, Deps)) -->
 2324    { length(Deps, Count) },
 2325    [ 'Remove package ~w and ~D dependencies'-[Pack, Count] ].
 2326label(create_dir(Dir)) -->
 2327    [ '~w'-[Dir] ].
 2328label(install_from(git(URL))) -->
 2329    !,
 2330    [ 'GIT repository at ~w'-[URL] ].
 2331label(install_from(URL)) -->
 2332    [ '~w'-[URL] ].
 2333label(cancel) -->
 2334    [ 'Cancel' ].
 2335
 2336confirm_default(yes) -->
 2337    [ ' Y/n? ' ].
 2338confirm_default(no) -->
 2339    [ ' y/N? ' ].
 2340confirm_default(none) -->
 2341    [ ' y/n? ' ].
 2342
 2343msg_version(Version) -->
 2344    { atom(Version) },
 2345    !,
 2346    [ '~w'-[Version] ].
 2347msg_version(VersionData) -->
 2348    !,
 2349    { atom_version(Atom, VersionData) },
 2350    [ '~w'-[Atom] ]