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