1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        jan@swi-prolog.org
    5    WWW:           https://www.swi-prolog.org
    6    Copyright (c)  2012-2024, 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_list/2,                % +Query, +Options
   42            pack_search/1,              % +Keyword
   43            pack_install/1,             % +Name
   44            pack_install/2,             % +Name, +Options
   45            pack_install_local/3,       % :Spec, +Dir, +Options
   46            pack_upgrade/1,             % +Name
   47            pack_rebuild/1,             % +Name
   48            pack_rebuild/0,             % All packages
   49            pack_remove/1,              % +Name
   50            pack_remove/2,              % +Name, +Options
   51            pack_publish/2,             % +URL, +Options
   52            pack_property/2             % ?Name, ?Property
   53          ]).   54:- use_module(library(apply)).   55:- use_module(library(error)).   56:- use_module(library(option)).   57:- use_module(library(readutil)).   58:- use_module(library(lists)).   59:- use_module(library(filesex)).   60:- use_module(library(xpath)).   61:- use_module(library(settings)).   62:- use_module(library(uri)).   63:- use_module(library(dcg/basics)).   64:- use_module(library(dcg/high_order)).   65:- use_module(library(http/http_open)).   66:- use_module(library(http/json)).   67:- use_module(library(http/http_client), []).   68:- use_module(library(debug), [assertion/1]).   69:- use_module(library(pairs),
   70              [pairs_keys/2, map_list_to_pairs/3, pairs_values/2]).   71:- autoload(library(git)).   72:- autoload(library(sgml)).   73:- autoload(library(sha)).   74:- autoload(library(build/tools)).   75:- autoload(library(ansi_term), [ansi_format/3]).   76:- autoload(library(pprint), [print_term/2]).   77:- autoload(library(prolog_versions), [require_version/3, cmp_versions/3]).   78:- autoload(library(ugraphs), [vertices_edges_to_ugraph/3, ugraph_layers/2]).   79:- autoload(library(process), [process_which/2]).   80:- autoload(library(aggregate), [aggregate_all/3]).   81
   82:- meta_predicate
   83    pack_install_local(2, +, +).   84
   85/** <module> A package manager for Prolog
   86
   87The library(prolog_pack) provides the SWI-Prolog   package manager. This
   88library lets you inspect installed   packages,  install packages, remove
   89packages, etc. This library complemented by the built-in predicates such
   90as attach_packs/2 that makes installed packages available as libraries.
   91
   92The important functionality of this library is encapsulated in the _app_
   93`pack`. For help, run
   94
   95    swipl pack help
   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		 *       LOCAL DECLARATIONS	*
  108		 *******************************/
  109
  110:- op(900, xfx, @).                     % Token@Version
  111
  112:- meta_predicate det_if(0,0).  113
  114                 /*******************************
  115                 *         PACKAGE INFO         *
  116                 *******************************/
  117
  118%!  current_pack(?Pack) is nondet.
  119%!  current_pack(?Pack, ?Dir) is nondet.
  120%
  121%   True if Pack is a currently installed pack.
  122
  123current_pack(Pack) :-
  124    current_pack(Pack, _).
  125
  126current_pack(Pack, Dir) :-
  127    '$pack':pack(Pack, Dir).
  128
  129%!  pack_list_installed is det.
  130%
  131%   List currently installed packages  and   report  possible dependency
  132%   issues.
  133
  134pack_list_installed :-
  135    pack_list('', [installed(true)]),
  136    validate_dependencies.
  137
  138%!  pack_info(+Pack)
  139%
  140%   Print more detailed information about Pack.
  141
  142pack_info(Name) :-
  143    pack_info(info, Name).
  144
  145pack_info(Level, Name) :-
  146    must_be(atom, Name),
  147    findall(Info, pack_info(Name, Level, Info), Infos0),
  148    (   Infos0 == []
  149    ->  print_message(warning, pack(no_pack_installed(Name))),
  150        fail
  151    ;   true
  152    ),
  153    findall(Def,  pack_default(Level, Infos, Def), Defs),
  154    append(Infos0, Defs, Infos1),
  155    sort(Infos1, Infos),
  156    show_info(Name, Infos, [info(Level)]).
  157
  158
  159show_info(_Name, _Properties, Options) :-
  160    option(silent(true), Options),
  161    !.
  162show_info(_Name, _Properties, Options) :-
  163    option(show_info(false), Options),
  164    !.
  165show_info(Name, Properties, Options) :-
  166    option(info(list), Options),
  167    !,
  168    memberchk(title(Title), Properties),
  169    memberchk(version(Version), Properties),
  170    format('i ~w@~w ~28|- ~w~n', [Name, Version, Title]).
  171show_info(Name, Properties, _) :-
  172    !,
  173    print_property_value('Package'-'~w', [Name]),
  174    findall(Term, pack_level_info(info, Term, _, _), Terms),
  175    maplist(print_property(Properties), Terms).
  176
  177print_property(_, nl) :-
  178    !,
  179    format('~n').
  180print_property(Properties, Term) :-
  181    findall(Term, member(Term, Properties), Terms),
  182    Terms \== [],
  183    !,
  184    pack_level_info(_, Term, LabelFmt, _Def),
  185    (   LabelFmt = Label-FmtElem
  186    ->  true
  187    ;   Label = LabelFmt,
  188        FmtElem = '~w'
  189    ),
  190    multi_valued(Terms, FmtElem, FmtList, Values),
  191    atomic_list_concat(FmtList, ', ', Fmt),
  192    print_property_value(Label-Fmt, Values).
  193print_property(_, _).
  194
  195multi_valued([H], LabelFmt, [LabelFmt], Values) :-
  196    !,
  197    H =.. [_|Values].
  198multi_valued([H|T], LabelFmt, [LabelFmt|LT], Values) :-
  199    H =.. [_|VH],
  200    append(VH, MoreValues, Values),
  201    multi_valued(T, LabelFmt, LT, MoreValues).
  202
  203
  204pvalue_column(31).
  205print_property_value(Prop-Fmt, Values) :-
  206    !,
  207    pvalue_column(C),
  208    ansi_format(comment, '% ~w:~t~*|', [Prop, C]),
  209    ansi_format(code, Fmt, Values),
  210    ansi_format([], '~n', []).
  211
  212pack_info(Name, Level, Info) :-
  213    '$pack':pack(Name, BaseDir),
  214    pack_dir_info(BaseDir, Level, Info).
  215
  216pack_dir_info(BaseDir, Level, Info) :-
  217    (   Info = directory(BaseDir)
  218    ;   pack_info_term(BaseDir, Info)
  219    ),
  220    pack_level_info(Level, Info, _Format, _Default).
  221
  222:- public pack_level_info/4.                    % used by web-server
  223
  224pack_level_info(_,    title(_),         'Title',                   '<no title>').
  225pack_level_info(_,    version(_),       'Installed version',       '<unknown>').
  226pack_level_info(info, automatic(_),	'Automatic (dependency only)', -).
  227pack_level_info(info, directory(_),     'Installed in directory',  -).
  228pack_level_info(info, link(_),		'Installed as link to'-'~w', -).
  229pack_level_info(info, built(_,_),	'Built on'-'~w for SWI-Prolog ~w', -).
  230pack_level_info(info, author(_, _),     'Author'-'~w <~w>',        -).
  231pack_level_info(info, maintainer(_, _), 'Maintainer'-'~w <~w>',    -).
  232pack_level_info(info, packager(_, _),   'Packager'-'~w <~w>',      -).
  233pack_level_info(info, home(_),          'Home page',               -).
  234pack_level_info(info, download(_),      'Download URL',            -).
  235pack_level_info(_,    provides(_),      'Provides',                -).
  236pack_level_info(_,    requires(_),      'Requires',                -).
  237pack_level_info(_,    conflicts(_),     'Conflicts with',          -).
  238pack_level_info(_,    replaces(_),      'Replaces packages',       -).
  239pack_level_info(info, library(_),	'Provided libraries',      -).
  240pack_level_info(info, autoload(_),	'Autoload',                -).
  241
  242pack_default(Level, Infos, Def) :-
  243    pack_level_info(Level, ITerm, _Format, Def),
  244    Def \== (-),
  245    \+ memberchk(ITerm, Infos).
  246
  247%!  pack_info_term(+PackDir, ?Info) is nondet.
  248%
  249%   True when Info is meta-data for the package PackName.
  250
  251pack_info_term(BaseDir, Info) :-
  252    directory_file_path(BaseDir, 'pack.pl', InfoFile),
  253    catch(
  254        term_in_file(valid_term(pack_info_term), InfoFile, Info),
  255        error(existence_error(source_sink, InfoFile), _),
  256        ( print_message(error, pack(no_meta_data(BaseDir))),
  257          fail
  258        )).
  259pack_info_term(BaseDir, library(Lib)) :-
  260    atom_concat(BaseDir, '/prolog/', LibDir),
  261    atom_concat(LibDir, '*.pl', Pattern),
  262    expand_file_name(Pattern, Files),
  263    maplist(atom_concat(LibDir), Plain, Files),
  264    convlist(base_name, Plain, Libs),
  265    member(Lib, Libs),
  266    Lib \== 'INDEX'.
  267pack_info_term(BaseDir, autoload(true)) :-
  268    atom_concat(BaseDir, '/prolog/INDEX.pl', IndexFile),
  269    exists_file(IndexFile).
  270pack_info_term(BaseDir, automatic(Boolean)) :-
  271    once(pack_status_dir(BaseDir, automatic(Boolean))).
  272pack_info_term(BaseDir, built(Arch, Prolog)) :-
  273    pack_status_dir(BaseDir, built(Arch, Prolog, _How)).
  274pack_info_term(BaseDir, link(Dest)) :-
  275    read_link(BaseDir, _, Dest).
  276
  277base_name(File, Base) :-
  278    file_name_extension(Base, pl, File).
  279
  280%!  term_in_file(:Valid, +File, -Term) is nondet.
  281%
  282%   True when Term appears in file and call(Valid, Term) is true.
  283
  284:- meta_predicate
  285    term_in_file(1, +, -).  286
  287term_in_file(Valid, File, Term) :-
  288    exists_file(File),
  289    setup_call_cleanup(
  290        open(File, read, In, [encoding(utf8)]),
  291        term_in_stream(Valid, In, Term),
  292        close(In)).
  293
  294term_in_stream(Valid, In, Term) :-
  295    repeat,
  296        read_term(In, Term0, []),
  297        (   Term0 == end_of_file
  298        ->  !, fail
  299        ;   Term = Term0,
  300            call(Valid, Term0)
  301        ).
  302
  303:- meta_predicate
  304    valid_term(1,+).  305
  306valid_term(Type, Term) :-
  307    Term =.. [Name|Args],
  308    same_length(Args, Types),
  309    Decl =.. [Name|Types],
  310    (   call(Type, Decl)
  311    ->  maplist(valid_info_arg, Types, Args)
  312    ;   print_message(warning, pack(invalid_term(Type, Term))),
  313        fail
  314    ).
  315
  316valid_info_arg(Type, Arg) :-
  317    must_be(Type, Arg).
  318
  319%!  pack_info_term(?Term) is nondet.
  320%
  321%   True when Term describes name and   arguments of a valid package
  322%   info term.
  323
  324pack_info_term(name(atom)).                     % Synopsis
  325pack_info_term(title(atom)).
  326pack_info_term(keywords(list(atom))).
  327pack_info_term(description(list(atom))).
  328pack_info_term(version(version)).
  329pack_info_term(author(atom, email_or_url_or_empty)).     % Persons
  330pack_info_term(maintainer(atom, email_or_url)).
  331pack_info_term(packager(atom, email_or_url)).
  332pack_info_term(pack_version(nonneg)).           % Package convention version
  333pack_info_term(home(atom)).                     % Home page
  334pack_info_term(download(atom)).                 % Source
  335pack_info_term(provides(atom)).                 % Dependencies
  336pack_info_term(requires(dependency)).
  337pack_info_term(conflicts(dependency)).          % Conflicts with package
  338pack_info_term(replaces(atom)).                 % Replaces another package
  339pack_info_term(autoload(boolean)).              % Default installation options
  340
  341:- multifile
  342    error:has_type/2.  343
  344error:has_type(version, Version) :-
  345    atom(Version),
  346    is_version(Version).
  347error:has_type(email_or_url, Address) :-
  348    atom(Address),
  349    (   sub_atom(Address, _, _, _, @)
  350    ->  true
  351    ;   uri_is_global(Address)
  352    ).
  353error:has_type(email_or_url_or_empty, Address) :-
  354    (   Address == ''
  355    ->  true
  356    ;   error:has_type(email_or_url, Address)
  357    ).
  358error:has_type(dependency, Value) :-
  359    is_dependency(Value).
  360
  361is_version(Version) :-
  362    split_string(Version, ".", "", Parts),
  363    maplist(number_string, _, Parts).
  364
  365is_dependency(Var) :-
  366    var(Var),
  367    !,
  368    fail.
  369is_dependency(Token) :-
  370    atom(Token),
  371    !.
  372is_dependency(Term) :-
  373    compound(Term),
  374    compound_name_arguments(Term, Op, [Token,Version]),
  375    atom(Token),
  376    cmp(Op, _),
  377    is_version(Version),
  378    !.
  379is_dependency(PrologToken) :-
  380    is_prolog_token(PrologToken).
  381
  382cmp(<,  @<).
  383cmp(=<, @=<).
  384cmp(==, ==).
  385cmp(>=, @>=).
  386cmp(>,  @>).
  387
  388
  389                 /*******************************
  390                 *            SEARCH            *
  391                 *******************************/
  392
  393%!  pack_list(+Query) is det.
  394%!  pack_list(+Query, +Options) is det.
  395%!  pack_search(+Query) is det.
  396%
  397%   Query package server and  installed   packages  and display results.
  398%   Query is matches case-insensitively against the   name  and title of
  399%   known and installed packages. For each   matching  package, a single
  400%   line is displayed that provides:
  401%
  402%     - Installation status
  403%       - __p__: package, not installed
  404%       - __i__: installed package; up-to-date with public version
  405%       - __a__: as __i__, but installed only as dependency
  406%       - __U__: installed package; can be upgraded
  407%       - __A__: installed package; newer than publically available
  408%       - __l__: installed package; not on server
  409%     - Name@Version
  410%     - Name@Version(ServerVersion)
  411%     - Title
  412%
  413%   Options processed:
  414%
  415%     - installed(true)
  416%       Only list packages that are locally installed.  Contacts the
  417%       server to compare our local version to the latest available
  418%       version.
  419%     - outdated(true)
  420%       Only list packages that need to be updated.  This option
  421%       implies installed(true).
  422%     - server(Server|false)
  423%       If `false`, do not contact the server. This implies
  424%       installed(true).  Otherwise, use the given pack server.
  425%
  426%   Hint: ``?- pack_list('').`` lists all known packages.
  427%
  428%   The predicates pack_list/1 and  pack_search/1   are  synonyms.  Both
  429%   contact the package server  at   https://www.swi-prolog.org  to find
  430%   available packages. Contacting the server can   be avoided using the
  431%   server(false) option.
  432
  433pack_list(Query) :-
  434    pack_list(Query, []).
  435
  436pack_search(Query) :-
  437    pack_list(Query, []).
  438
  439pack_list(Query, Options) :-
  440    (   option(installed(true), Options)
  441    ;   option(outdated(true), Options)
  442    ;   option(server(false), Options)
  443    ),
  444    !,
  445    local_search(Query, Local),
  446    maplist(arg(1), Local, Packs),
  447    (   option(server(false), Options)
  448    ->  Hits = []
  449    ;   query_pack_server(info(Packs), true(Hits), Options)
  450    ),
  451    list_hits(Hits, Local, Options).
  452pack_list(Query, Options) :-
  453    query_pack_server(search(Query), Result, Options),
  454    (   Result == false
  455    ->  (   local_search(Query, Packs),
  456            Packs \== []
  457        ->  forall(member(pack(Pack, Stat, Title, Version, _), Packs),
  458                   format('~w ~w@~w ~28|- ~w~n',
  459                          [Stat, Pack, Version, Title]))
  460        ;   print_message(warning, pack(search_no_matches(Query)))
  461        )
  462    ;   Result = true(Hits), % Hits = list(pack(Name, p, Title, Version, URL))
  463        local_search(Query, Local),
  464        list_hits(Hits, Local, [])
  465    ).
  466
  467list_hits(Hits, Local, Options) :-
  468    append(Hits, Local, All),
  469    sort(All, Sorted),
  470    join_status(Sorted, Packs0),
  471    include(filtered(Options), Packs0, Packs),
  472    maplist(list_hit(Options), Packs).
  473
  474filtered(Options, pack(_,Tag,_,_,_)) :-
  475    option(outdated(true), Options),
  476    !,
  477    Tag == 'U'.
  478filtered(_, _).
  479
  480list_hit(_Options, pack(Pack, Tag, Title, Version, _URL)) =>
  481    list_tag(Tag),
  482    ansi_format(code, '~w', [Pack]),
  483    format('@'),
  484    list_version(Tag, Version),
  485    format('~35|- ', []),
  486    ansi_format(comment, '~w~n', [Title]).
  487
  488list_tag(Tag) :-
  489    tag_color(Tag, Color),
  490    ansi_format(Color, '~w ', [Tag]).
  491
  492list_version(Tag, VersionI-VersionS) =>
  493    tag_color(Tag, Color),
  494    ansi_format(Color, '~w', [VersionI]),
  495    ansi_format(bold, '(~w)', [VersionS]).
  496list_version(_Tag, Version) =>
  497    ansi_format([], '~w', [Version]).
  498
  499tag_color('U', warning) :- !.
  500tag_color('A', comment) :- !.
  501tag_color(_, []).
  502
  503%!  join_status(+PacksIn, -PacksOut) is det.
  504%
  505%   Combine local and remote information to   assess  the status of each
  506%   package. PacksOut is a list of  pack(Name, Status, Version, URL). If
  507%   the     versions     do      not       match,      `Version`      is
  508%   `VersionInstalled-VersionRemote` and similar for thee URL.
  509
  510join_status([], []).
  511join_status([ pack(Pack, i, Title, Version, URL),
  512              pack(Pack, p, Title, Version, _)
  513            | T0
  514            ],
  515            [ pack(Pack, Tag, Title, Version, URL)
  516            | T
  517            ]) :-
  518    !,
  519    (   pack_status(Pack, automatic(true))
  520    ->  Tag = a
  521    ;   Tag = i
  522    ),
  523    join_status(T0, T).
  524join_status([ pack(Pack, i, Title, VersionI, URLI),
  525              pack(Pack, p, _,     VersionS, URLS)
  526            | T0
  527            ],
  528            [ pack(Pack, Tag, Title, VersionI-VersionS, URLI-URLS)
  529            | T
  530            ]) :-
  531    !,
  532    version_sort_key(VersionI, VDI),
  533    version_sort_key(VersionS, VDS),
  534    (   VDI @< VDS
  535    ->  Tag = 'U'
  536    ;   Tag = 'A'
  537    ),
  538    join_status(T0, T).
  539join_status([ pack(Pack, i, Title, VersionI, URL)
  540            | T0
  541            ],
  542            [ pack(Pack, l, Title, VersionI, URL)
  543            | T
  544            ]) :-
  545    !,
  546    join_status(T0, T).
  547join_status([H|T0], [H|T]) :-
  548    join_status(T0, T).
  549
  550%!  local_search(+Query, -Packs:list(atom)) is det.
  551%
  552%   Search locally installed packs.
  553
  554local_search(Query, Packs) :-
  555    findall(Pack, matching_installed_pack(Query, Pack), Packs).
  556
  557matching_installed_pack(Query, pack(Pack, i, Title, Version, URL)) :-
  558    current_pack(Pack),
  559    findall(Term,
  560            ( pack_info(Pack, _, Term),
  561              search_info(Term)
  562            ), Info),
  563    (   sub_atom_icasechk(Pack, _, Query)
  564    ->  true
  565    ;   memberchk(title(Title), Info),
  566        sub_atom_icasechk(Title, _, Query)
  567    ),
  568    option(title(Title), Info, '<no title>'),
  569    option(version(Version), Info, '<no version>'),
  570    option(download(URL), Info, '<no download url>').
  571
  572search_info(title(_)).
  573search_info(version(_)).
  574search_info(download(_)).
  575
  576
  577                 /*******************************
  578                 *            INSTALL           *
  579                 *******************************/
  580
  581%!  pack_install(+Spec:atom) is det.
  582%!  pack_install(+SpecOrList, +Options) is det.
  583%
  584%   Install one or more packs from   SpecOrList.  SpecOrList is a single
  585%   specification or a list of specifications. A specification is one of
  586%
  587%     * A pack name.  This queries the pack repository
  588%       at https://www.swi-prolog.org
  589%     * Archive file name
  590%     * A http(s) URL of an archive file name.  This URL may contain a
  591%       star (*) for the version.  In this case pack_install/1 asks
  592%       for the directory content and selects the latest version.
  593%     * An https GIT URL
  594%     * A local directory name given as ``file://`` URL
  595%     * `'.'`, in which case a relative symlink is created to the
  596%       current directory (all other options for Spec make a copy
  597%       of the files).  Installation using a symlink is normally
  598%       used during development of a pack.
  599%
  600%   Processes the options below. Default  options   as  would be used by
  601%   pack_install/1 are used to complete the  provided Options. Note that
  602%   pack_install/2 can be used through the   SWI-Prolog command line app
  603%   `pack` as below. Most of the options of this predicate are available
  604%   as command line options.
  605%
  606%      swipl pack install <name>
  607%
  608%   Options:
  609%
  610%     * url(+URL)
  611%       Source for downloading the package
  612%     * pack_directory(+Dir)
  613%       Directory into which to install the package.
  614%     * global(+Boolean)
  615%       If `true`, install in the XDG common application data path,
  616%       making the pack accessible to everyone. If `false`, install in
  617%       the XDG user application data path, making the pack accessible
  618%       for the current user only. If the option is absent, use the
  619%       first existing and writable directory. If that doesn't exist
  620%       find locations where it can be created and prompt the user to do
  621%       so.
  622%     * insecure(+Boolean)
  623%       When `true` (default `false`), do not perform any checks on SSL
  624%       certificates when downloading using `https`.
  625%     * interactive(+Boolean)
  626%       Use default answer without asking the user if there
  627%       is a default action.
  628%     * silent(+Boolean)
  629%       If `true` (default false), suppress informational progress
  630%       messages.
  631%     * upgrade(+Boolean)
  632%       If `true` (default `false`), upgrade package if it is already
  633%       installed.
  634%     * rebuild(Condition)
  635%       Rebuild the foreign components.  Condition is one of
  636%       `if_absent` (default, do nothing if the directory with foreign
  637%       resources exists), `make` (run `make`) or `true` (run `make
  638%       distclean` followed by the default configure and build steps).
  639%     * test(Boolean)
  640%       If `true` (default), run the pack tests.
  641%     * git(+Boolean)
  642%       If `true` (default `false` unless `URL` ends with ``.git``),
  643%       assume the URL is a GIT repository.
  644%     * link(+Boolean)
  645%       Can be used if the installation source is a local directory
  646%       and the file system supports symbolic links.  In this case
  647%       the system adds the current directory to the pack registration
  648%       using a symbolic link and performs the local installation steps.
  649%     * version(+Version)
  650%       Demand the pack to satisfy some version requirement.  Version
  651%       is as defined by require_version/3.  For example `'1.5'` is the
  652%       same as `>=('1.5')`.
  653%     * branch(+Branch)
  654%       When installing from a git repository, clone this branch.
  655%     * commit(+Commit)
  656%       When installing from a git repository, checkout this commit.
  657%       Commit is either a hash, a tag, a branch or `'HEAD'`.
  658%     * build_type(+Type)
  659%       When building using CMake, use ``-DCMAKE_BUILD_TYPE=Type``.
  660%       Default is the build type of Prolog or ``Release``.
  661%     * register(+Boolean)
  662%       If `true` (default), register packages as downloaded after
  663%       performing the download.  This contacts the server with the
  664%       meta-data of each pack that was downloaded.  The server will
  665%       either register the location as a new version or increment
  666%       the download count.  The server stores the IP address of the
  667%       client.  Subsequent downloads of the same version from the
  668%       same IP address are ignored.
  669%     * server(+URL)
  670%       Pack server to contact. Default is the setting
  671%       `prolog_pack:server`, by default set to
  672%       ``https://www.swi-prolog.org/pack/``
  673%
  674%   Non-interactive installation can be established using the option
  675%   interactive(false). It is adviced to   install from a particular
  676%   _trusted_ URL instead of the  plain   pack  name  for unattented
  677%   operation.
  678
  679pack_install(Spec) :-
  680    pack_default_options(Spec, Pack, [], Options),
  681    pack_install(Pack, [pack(Pack)|Options]).
  682
  683pack_install(Specs, Options) :-
  684    is_list(Specs),
  685    !,
  686    maplist(pack_options(Options), Specs, Pairs),
  687    pack_install_dir(PackTopDir, Options),
  688    pack_install_set(Pairs, PackTopDir, Options).
  689pack_install(Spec, Options) :-
  690    pack_default_options(Spec, Pack, Options, DefOptions),
  691    (   option(already_installed(Installed), DefOptions)
  692    ->  print_message(informational, pack(already_installed(Installed)))
  693    ;   merge_options(Options, DefOptions, PackOptions),
  694        pack_install_dir(PackTopDir, PackOptions),
  695        pack_install_set([Pack-PackOptions], PackTopDir, Options)
  696    ).
  697
  698pack_options(Options, Spec, Pack-PackOptions) :-
  699    pack_default_options(Spec, Pack, Options, DefOptions),
  700    merge_options(Options, DefOptions, PackOptions).
  701
  702%!  pack_default_options(+Spec, -Pack, +OptionsIn, -Options) is det.
  703%
  704%   Establish  the  pack  name  (Pack)  and    install  options  from  a
  705%   specification and options (OptionsIn) provided by the user.  Cases:
  706%
  707%     1. Already installed.  We must pass that as pack_default_options/4
  708%        is called twice from pack_install/2.
  709%     2. Install from a URL due to a url(URL) option. Determine whether
  710%        the URL is a GIT repository, get the version and pack from the
  711%        URL.
  712%     3. Install a local archive file. Extract the pack and version from
  713%        the archive name.
  714%     4. Install from a git URL.  Determines the pack, sets git(true)
  715%        and adds the URL as option.
  716%     5. Install from a directory. Get the info from the `packs.pl`
  717%        file.
  718%     6. Install from `'.'`.  Create a symlink to make the current dir
  719%        accessible as a pack.
  720%     7. Install from a non-git URL
  721%        Determine pack and version.
  722%     8. Pack name.  Query the server to find candidate packs and
  723%        select an adequate pack.
  724
  725
  726pack_default_options(_Spec, Pack, OptsIn, Options) :-   % (1)
  727    option(already_installed(pack(Pack,_Version)), OptsIn),
  728    !,
  729    Options = OptsIn.
  730pack_default_options(_Spec, Pack, OptsIn, Options) :-   % (2)
  731    option(url(URL), OptsIn),
  732    !,
  733    (   option(git(_), OptsIn)
  734    ->  Options = OptsIn
  735    ;   git_url(URL, Pack)
  736    ->  Options = [git(true)|OptsIn]
  737    ;   Options = OptsIn
  738    ),
  739    (   nonvar(Pack)
  740    ->  true
  741    ;   option(pack(Pack), Options)
  742    ->  true
  743    ;   pack_version_file(Pack, _Version, URL)
  744    ).
  745pack_default_options(Archive, Pack, OptsIn, Options) :- % (3)
  746    must_be(atom, Archive),
  747    \+ uri_is_global(Archive),
  748    expand_file_name(Archive, [File]),
  749    exists_file(File),
  750    !,
  751    (   pack_version_file(Pack, Version, File)
  752    ->  uri_file_name(FileURL, File),
  753        merge_options([url(FileURL), version(Version)], OptsIn, Options)
  754    ;   domain_error(pack_file_name, Archive)
  755    ).
  756pack_default_options(URL, Pack, OptsIn, Options) :-     % (4)
  757    git_url(URL, Pack),
  758    !,
  759    merge_options([git(true), url(URL)], OptsIn, Options).
  760pack_default_options(FileURL, Pack, _, Options) :-      % (5)
  761    uri_file_name(FileURL, Dir),
  762    exists_directory(Dir),
  763    pack_info_term(Dir, name(Pack)),
  764    !,
  765    (   pack_info_term(Dir, version(Version))
  766    ->  uri_file_name(DirURL, Dir),
  767        Options = [url(DirURL), version(Version)]
  768    ;   throw(error(existence_error(key, version, Dir),_))
  769    ).
  770pack_default_options('.', Pack, OptsIn, Options) :-     % (6)
  771    pack_info_term('.', name(Pack)),
  772    !,
  773    working_directory(Dir, Dir),
  774    (   pack_info_term(Dir, version(Version))
  775    ->  uri_file_name(DirURL, Dir),
  776        NewOptions = [url(DirURL), version(Version) | Options1],
  777        (   current_prolog_flag(windows, true)
  778        ->  Options1 = []
  779        ;   Options1 = [link(true), rebuild(make)]
  780        ),
  781        merge_options(NewOptions, OptsIn, Options)
  782    ;   throw(error(existence_error(key, version, Dir),_))
  783    ).
  784pack_default_options(URL, Pack, OptsIn, Options) :-      % (7)
  785    pack_version_file(Pack, Version, URL),
  786    download_url(URL),
  787    !,
  788    available_download_versions(URL, Available, Options),
  789    Available = [URLVersion-LatestURL|_],
  790    NewOptions = [url(LatestURL)|VersionOptions],
  791    version_options(Version, URLVersion, Available, VersionOptions),
  792    merge_options(NewOptions, OptsIn, Options).
  793pack_default_options(Pack, Pack, Options, Options) :-    % (8)
  794    \+ uri_is_global(Pack).
  795
  796version_options(Version, Version, _, [version(Version)]) :- !.
  797version_options(Version, _, Available, [versions(Available)]) :-
  798    sub_atom(Version, _, _, _, *),
  799    !.
  800version_options(_, _, _, []).
  801
  802%!  pack_install_dir(-PackDir, +Options) is det.
  803%
  804%   Determine the directory below which to  install new packs. This find
  805%   or creates a writeable directory.  Options:
  806%
  807%     - pack_directory(+PackDir)
  808%       Use PackDir. PackDir is created if it does not exist.
  809%     - global(+Boolean)
  810%       If `true`, find a writeable global directory based on the
  811%       file search path `common_app_data`.  If `false`, find a
  812%       user-specific writeable directory based on `user_app_data`
  813%     - If neither of the above is given, use the search path
  814%       `pack`.
  815%
  816%   If no writeable directory is found, generate possible location where
  817%   this directory can be created and  ask   the  user  to create one of
  818%   them.
  819
  820pack_install_dir(PackDir, Options) :-
  821    option(pack_directory(PackDir), Options),
  822    ensure_directory(PackDir),
  823    !.
  824pack_install_dir(PackDir, Options) :-
  825    base_alias(Alias, Options),
  826    absolute_file_name(Alias, PackDir,
  827                       [ file_type(directory),
  828                         access(write),
  829                         file_errors(fail)
  830                       ]),
  831    !.
  832pack_install_dir(PackDir, Options) :-
  833    pack_create_install_dir(PackDir, Options).
  834
  835base_alias(Alias, Options) :-
  836    option(global(true), Options),
  837    !,
  838    Alias = common_app_data(pack).
  839base_alias(Alias, Options) :-
  840    option(global(false), Options),
  841    !,
  842    Alias = user_app_data(pack).
  843base_alias(Alias, _Options) :-
  844    Alias = pack('.').
  845
  846pack_create_install_dir(PackDir, Options) :-
  847    base_alias(Alias, Options),
  848    findall(Candidate = create_dir(Candidate),
  849            ( absolute_file_name(Alias, Candidate, [solutions(all)]),
  850              \+ exists_file(Candidate),
  851              \+ exists_directory(Candidate),
  852              file_directory_name(Candidate, Super),
  853              (   exists_directory(Super)
  854              ->  access_file(Super, write)
  855              ;   true
  856              )
  857            ),
  858            Candidates0),
  859    list_to_set(Candidates0, Candidates),   % keep order
  860    pack_create_install_dir(Candidates, PackDir, Options).
  861
  862pack_create_install_dir(Candidates, PackDir, Options) :-
  863    Candidates = [Default=_|_],
  864    !,
  865    append(Candidates, [cancel=cancel], Menu),
  866    menu(pack(create_pack_dir), Menu, Default, Selected, Options),
  867    Selected \== cancel,
  868    (   catch(make_directory_path(Selected), E,
  869              (print_message(warning, E), fail))
  870    ->  PackDir = Selected
  871    ;   delete(Candidates, PackDir=create_dir(PackDir), Remaining),
  872        pack_create_install_dir(Remaining, PackDir, Options)
  873    ).
  874pack_create_install_dir(_, _, _) :-
  875    print_message(error, pack(cannot_create_dir(pack(.)))),
  876    fail.
  877
  878%!  pack_unpack_from_local(+Source, +PackTopDir, +Name, -PackDir, +Options)
  879%
  880%   Unpack a package from a  local  media.   If  Source  is a directory,
  881%   either copy or link the directory. Else,   Source must be an archive
  882%   file. Options:
  883%
  884%      - link(+Boolean)
  885%        If the source is a directory, link or copy the directory?
  886%      - upgrade(true)
  887%        If the target is already there, wipe it and make a clean
  888%        install.
  889
  890pack_unpack_from_local(Source0, PackTopDir, Name, PackDir, Options) :-
  891    exists_directory(Source0),
  892    remove_slash(Source0, Source),
  893    !,
  894    directory_file_path(PackTopDir, Name, PackDir),
  895    (   option(link(true), Options)
  896    ->  (   same_file(Source, PackDir)
  897        ->  true
  898        ;   remove_existing_pack(PackDir, Options),
  899            atom_concat(PackTopDir, '/', PackTopDirS),
  900            relative_file_name(Source, PackTopDirS, RelPath),
  901            link_file(RelPath, PackDir, symbolic),
  902            assertion(same_file(Source, PackDir))
  903        )
  904    ;   \+ option(git(false), Options),
  905        is_git_directory(Source)
  906    ->  remove_existing_pack(PackDir, Options),
  907        run_process(path(git), [clone, Source, PackDir], [])
  908    ;   prepare_pack_dir(PackDir, Options),
  909        copy_directory(Source, PackDir)
  910    ).
  911pack_unpack_from_local(Source, PackTopDir, Name, PackDir, Options) :-
  912    exists_file(Source),
  913    directory_file_path(PackTopDir, Name, PackDir),
  914    prepare_pack_dir(PackDir, Options),
  915    pack_unpack(Source, PackDir, Name, Options).
  916
  917%!  pack_unpack(+SourceFile, +PackDir, +Pack, +Options)
  918%
  919%   Unpack an archive to the given package dir.
  920%
  921%   @tbd If library(archive) is  not  provided   we  could  check  for a
  922%   suitable external program such as `tar` or `unzip`.
  923
  924:- if(exists_source(library(archive))).  925pack_unpack(Source, PackDir, Pack, Options) :-
  926    ensure_loaded_archive,
  927    pack_archive_info(Source, Pack, _Info, StripOptions),
  928    prepare_pack_dir(PackDir, Options),
  929    archive_extract(Source, PackDir,
  930                    [ exclude(['._*'])          % MacOS resource forks
  931                    | StripOptions
  932                    ]).
  933:- else.  934pack_unpack(_,_,_,_) :-
  935    existence_error(library, archive).
  936:- endif.  937
  938%!  pack_install_local(:Spec, +Dir, +Options) is det.
  939%
  940%   Install a number of packages in   a  local directory. This predicate
  941%   supports installing packages local  to   an  application rather than
  942%   globally.
  943
  944pack_install_local(M:Gen, Dir, Options) :-
  945    findall(Pack-PackOptions, call(M:Gen, Pack, PackOptions), Pairs),
  946    pack_install_set(Pairs, Dir, Options).
  947
  948pack_install_set(Pairs, Dir, Options) :-
  949    must_be(list(pair), Pairs),
  950    ensure_directory(Dir),
  951    partition(known_media, Pairs, Local, Remote),
  952    maplist(pack_options_to_versions, Local, LocalVersions),
  953    (   Remote == []
  954    ->  AllVersions = LocalVersions
  955    ;   pairs_keys(Remote, Packs),
  956        prolog_description(Properties),
  957        query_pack_server(versions(Packs, Properties), Result, Options),
  958        (   Result = true(RemoteVersions)
  959        ->  append(LocalVersions, RemoteVersions, AllVersions)
  960        ;   print_message(error, pack(query_failed(Result))),
  961            fail
  962        )
  963    ),
  964    local_packs(Dir, Existing),
  965    pack_resolve(Pairs, Existing, AllVersions, Plan0, Options),
  966    !,                                      % for now, only first plan
  967    maplist(hsts_info(Options), Plan0, Plan),
  968    Options1 = [pack_directory(Dir)|Options],
  969    download_plan(Pairs, Plan, PlanB, Options1),
  970    register_downloads(PlanB, Options),
  971    maplist(update_automatic, PlanB),
  972    build_plan(PlanB, Built, Options1),
  973    publish_download(PlanB, Options),
  974    work_done(Pairs, Plan, PlanB, Built, Options).
  975
  976hsts_info(Options, Info0, Info) :-
  977    hsts(Info0.get(url), URL, Options),
  978    !,
  979    Info = Info0.put(url, URL).
  980hsts_info(_Options, Info, Info).
  981
  982%!  known_media(+Pair) is semidet.
  983%
  984%   True when the options specify installation   from  a known media. If
  985%   that applies to all packs, there is no  need to query the server. We
  986%   first  download  and  unpack  the  known  media,  then  examine  the
  987%   requirements and, if necessary, go to the server to resolve these.
  988
  989known_media(_-Options) :-
  990    option(url(_), Options).
  991
  992%!  pack_resolve(+Pairs, +Existing, +Versions, -Plan, +Options) is det.
  993%
  994%   Generate an installation plan. Pairs is a list of Pack-Options pairs
  995%   that  specifies  the  desired  packages.  Existing   is  a  list  of
  996%   pack(Pack, i, Title, Version, URL) terms that represents the already
  997%   installed packages. Versions  is  obtained   from  the  server.  See
  998%   `pack.pl` from the web server for  details. On success, this results
  999%   in a Plan to satisfies  the  requirements.   The  plan  is a list of
 1000%   packages to install with  their  location.   The  steps  satisfy the
 1001%   partial  ordering  of  dependencies,  such   that  dependencies  are
 1002%   installed before the dependents.  Options:
 1003%
 1004%     - upgrade(true)
 1005%       When specified, we try to install the latest version of all
 1006%       the packages.  Otherwise, we try to minimise the installation.
 1007
 1008pack_resolve(Pairs, Existing, Versions, Plan, Options) :-
 1009    insert_existing(Existing, Versions, AllVersions, Options),
 1010    phrase(select_version(Pairs, AllVersions,
 1011                          [ plan(PlanA),           % access to plan
 1012                            dependency_for([])     % dependencies
 1013                          | Options
 1014                          ]),
 1015           PlanA),
 1016    mark_installed(PlanA, Existing, Plan).
 1017
 1018%!  insert_existing(+Existing, +Available, -Candidates, +Options) is det.
 1019%
 1020%   Combine the already existing packages  with   the  ones  reported as
 1021%   available by the server to a list of Candidates, where the candidate
 1022%   of  each  package  is   ordered    according   by  preference.  When
 1023%   upgrade(true) is specified, the existing is   merged into the set of
 1024%   Available versions. Otherwise Existing is prepended to Available, so
 1025%   it is selected as first.
 1026
 1027:- det(insert_existing/4). 1028insert_existing(Existing, [], Versions, _Options) =>
 1029    maplist(existing_to_versions, Existing, Versions).
 1030insert_existing(Existing, [Pack-Versions|T0], AllPackVersions, Options),
 1031    select(Installed, Existing, Existing2),
 1032    Installed.pack == Pack =>
 1033    can_upgrade(Installed, Versions, Installed2),
 1034    insert_existing_(Installed2, Versions, AllVersions, Options),
 1035    AllPackVersions = [Pack-AllVersions|T],
 1036    insert_existing(Existing2, T0, T, Options).
 1037insert_existing(Existing, [H|T0], AllVersions, Options) =>
 1038    AllVersions = [H|T],
 1039    insert_existing(Existing, T0, T, Options).
 1040
 1041existing_to_versions(Installed, Pack-[Version-[Installed]]) :-
 1042    Pack = Installed.pack,
 1043    Version = Installed.version.
 1044
 1045insert_existing_(Installed, Versions, AllVersions, Options) :-
 1046    option(upgrade(true), Options),
 1047    !,
 1048    insert_existing_(Installed, Versions, AllVersions).
 1049insert_existing_(Installed, Versions, AllVersions, _) :-
 1050    AllVersions = [Installed.version-[Installed]|Versions].
 1051
 1052insert_existing_(Installed, [H|T0], [H|T]) :-
 1053    H = V0-_Infos,
 1054    cmp_versions(>, V0, Installed.version),
 1055    !,
 1056    insert_existing_(Installed, T0, T).
 1057insert_existing_(Installed, [H0|T], [H|T]) :-
 1058    H0 = V0-Infos,
 1059    V0 == Installed.version,
 1060    !,
 1061    H = V0-[Installed|Infos].
 1062insert_existing_(Installed, Versions, All) :-
 1063    All =  [Installed.version-[Installed]|Versions].
 1064
 1065%!  can_upgrade(+Installed, +Versions, -Installed2) is det.
 1066%
 1067%   Add a `latest_version` key to Installed if its version is older than
 1068%   the latest available version.
 1069
 1070can_upgrade(Info, [Version-_|_], Info2) :-
 1071    cmp_versions(>, Version, Info.version),
 1072    !,
 1073    Info2 = Info.put(latest_version, Version).
 1074can_upgrade(Info, _, Info).
 1075
 1076%!  mark_installed(+PlanA, +Existing, -Plan) is det.
 1077%
 1078%   Mark  already  up-to-date  packs  from  the   plan  and  add  a  key
 1079%   `upgrade:true` to elements of PlanA  in   Existing  that are not the
 1080%   same.
 1081
 1082mark_installed([], _, []).
 1083mark_installed([Info|T], Existing, Plan) :-
 1084    (   member(Installed, Existing),
 1085        Installed.pack == Info.pack
 1086    ->  (   (   Installed.git == true
 1087            ->  Info.git == true,
 1088                Installed.hash == Info.hash
 1089            ;   Version = Info.get(version)
 1090            ->  Installed.version == Version
 1091            )
 1092        ->  Plan = [Info.put(keep, true)|PlanT]    % up-to-date
 1093        ;   Plan = [Info.put(upgrade, Installed)|PlanT] % needs upgrade
 1094        )
 1095    ;   Plan = [Info|PlanT]                        % new install
 1096    ),
 1097    mark_installed(T, Existing, PlanT).
 1098
 1099%!  select_version(+PackAndOptions, +Available, +Options)// is nondet.
 1100%
 1101%   True when the output is a list of   pack info dicts that satisfy the
 1102%   installation requirements of PackAndOptions from  the packs known to
 1103%   be Available.
 1104
 1105select_version([], _, _) -->
 1106    [].
 1107select_version([Pack-PackOptions|More], Versions, Options) -->
 1108    { memberchk(Pack-PackVersions, Versions),
 1109      member(Version-Infos, PackVersions),
 1110      compatible_version(Pack, Version, PackOptions),
 1111      member(Info, Infos),
 1112      pack_options_compatible_with_info(Info, PackOptions),
 1113      pack_satisfies(Pack, Version, Info, Info2, PackOptions),
 1114      all_downloads(PackVersions, Downloads)
 1115    },
 1116    add_to_plan(Info2.put(_{version: Version, all_downloads:Downloads}),
 1117                Versions, Options),
 1118    select_version(More, Versions, Options).
 1119select_version([Pack-_PackOptions|_More], _Versions, _Options) -->
 1120    { existence_error(pack, Pack) }.               % or warn and continue?
 1121
 1122all_downloads(PackVersions, AllDownloads) :-
 1123    aggregate_all(sum(Downloads),
 1124                  ( member(_Version-Infos, PackVersions),
 1125                    member(Info, Infos),
 1126                    get_dict(downloads, Info, Downloads)
 1127                  ),
 1128                  AllDownloads).
 1129
 1130add_requirements([], _, _) -->
 1131    [].
 1132add_requirements([H|T], Versions, Options) -->
 1133    { is_prolog_token(H),
 1134      !,
 1135      prolog_satisfies(H)
 1136    },
 1137    add_requirements(T, Versions, Options).
 1138add_requirements([H|T], Versions, Options) -->
 1139    { member(Pack-PackVersions, Versions),
 1140      member(Version-Infos, PackVersions),
 1141      member(Info, Infos),
 1142      (   Provides = @(Pack,Version)
 1143      ;   member(Provides, Info.get(provides))
 1144      ),
 1145      satisfies_req(Provides, H),
 1146      all_downloads(PackVersions, Downloads)
 1147    },
 1148    add_to_plan(Info.put(_{version: Version, all_downloads:Downloads}),
 1149                Versions, Options),
 1150    add_requirements(T, Versions, Options).
 1151
 1152%!  add_to_plan(+Info, +Versions, +Options) is semidet.
 1153%
 1154%   Add Info to the plan. If an Info   about the same pack is already in
 1155%   the plan, but this is a different version  of the pack, we must fail
 1156%   as we cannot install two different versions of a pack.
 1157
 1158add_to_plan(Info, _Versions, Options) -->
 1159    { option(plan(Plan), Options),
 1160      member_nonvar(Planned, Plan),
 1161      Planned.pack == Info.pack,
 1162      !,
 1163      same_version(Planned, Info)                  % same pack, different version
 1164    }.
 1165add_to_plan(Info, _Versions, _Options) -->
 1166    { member(Conflict, Info.get(conflicts)),
 1167      is_prolog_token(Conflict),
 1168      prolog_satisfies(Conflict),
 1169      !,
 1170      fail                                         % incompatible with this Prolog
 1171    }.
 1172add_to_plan(Info, _Versions, Options) -->
 1173    { option(plan(Plan), Options),
 1174      member_nonvar(Planned, Plan),
 1175      info_conflicts(Info, Planned),               % Conflicts with a planned pack
 1176      !,
 1177      fail
 1178    }.
 1179add_to_plan(Info, Versions, Options) -->
 1180    { select_option(dependency_for(Dep0), Options, Options1),
 1181      Options2 = [dependency_for([Info.pack|Dep0])|Options1],
 1182      (   Dep0 = [DepFor|_]
 1183      ->  add_dependency_for(DepFor, Info, Info1)
 1184      ;   Info1 = Info
 1185      )
 1186    },
 1187    [Info1],
 1188    add_requirements(Info.get(requires,[]), Versions, Options2).
 1189
 1190add_dependency_for(Pack, Info, Info) :-
 1191    Old = Info.get(dependency_for),
 1192    !,
 1193    b_set_dict(dependency_for, Info, [Pack|Old]).
 1194add_dependency_for(Pack, Info0, Info) :-
 1195    Info = Info0.put(dependency_for, [Pack]).
 1196
 1197same_version(Info, Info) :-
 1198    !.
 1199same_version(Planned, Info) :-
 1200    Hash = Planned.get(hash),
 1201    Hash \== (-),
 1202    !,
 1203    Hash == Info.get(hash).
 1204same_version(Planned, Info) :-
 1205    Planned.get(version) == Info.get(version).
 1206
 1207%!  info_conflicts(+Info1, +Info2) is semidet.
 1208%
 1209%   True if Info2 is in conflict with Info2. The relation is symetric.
 1210
 1211info_conflicts(Info, Planned) :-
 1212    info_conflicts_(Info, Planned),
 1213    !.
 1214info_conflicts(Info, Planned) :-
 1215    info_conflicts_(Planned, Info),
 1216    !.
 1217
 1218info_conflicts_(Info, Planned) :-
 1219    member(Conflict, Info.get(conflicts)),
 1220    \+ is_prolog_token(Conflict),
 1221    info_provides(Planned, Provides),
 1222    satisfies_req(Provides, Conflict),
 1223    !.
 1224
 1225info_provides(Info, Provides) :-
 1226    (   Provides = Info.pack@Info.version
 1227    ;   member(Provides, Info.get(provides))
 1228    ).
 1229
 1230%!  pack_satisfies(+Pack, +Version, +Info0, -Info, +Options) is semidet.
 1231%
 1232%   True if Pack@Version  with  Info   satisfies  the  pack installation
 1233%   options provided by Options.
 1234
 1235pack_satisfies(_Pack, _Version, Info0, Info, Options) :-
 1236    option(commit('HEAD'), Options),
 1237    !,
 1238    Info0.get(git) == true,
 1239    Info = Info0.put(commit, 'HEAD').
 1240pack_satisfies(_Pack, _Version, Info, Info, Options) :-
 1241    option(commit(Commit), Options),
 1242    !,
 1243    Commit == Info.get(hash).
 1244pack_satisfies(Pack, Version, Info, Info, Options) :-
 1245    option(version(ReqVersion), Options),
 1246    !,
 1247    satisfies_version(Pack, Version, ReqVersion).
 1248pack_satisfies(_Pack, _Version, Info, Info, _Options).
 1249
 1250%!  satisfies_version(+Pack, +PackVersion, +RequiredVersion) is semidet.
 1251
 1252satisfies_version(Pack, Version, ReqVersion) :-
 1253    catch(require_version(pack(Pack), Version, ReqVersion),
 1254          error(version_error(pack(Pack), Version, ReqVersion),_),
 1255          fail).
 1256
 1257%!  satisfies_req(+Provides, +Required) is semidet.
 1258%
 1259%   Check a token requirements.
 1260
 1261satisfies_req(Token, Token) => true.
 1262satisfies_req(@(Token,_), Token) => true.
 1263satisfies_req(@(Token,PrvVersion), Req), cmp(Req, Token, Cmp, ReqVersion) =>
 1264	cmp_versions(Cmp, PrvVersion, ReqVersion).
 1265satisfies_req(_,_) => fail.
 1266
 1267cmp(Token  < Version, Token, <,	 Version).
 1268cmp(Token =< Version, Token, =<, Version).
 1269cmp(Token =  Version, Token, =,	 Version).
 1270cmp(Token == Version, Token, ==, Version).
 1271cmp(Token >= Version, Token, >=, Version).
 1272cmp(Token >  Version, Token, >,	 Version).
 1273
 1274%!  pack_options_to_versions(+PackOptionsPair, -Versions) is det.
 1275%
 1276%   Create an available  package  term  from   Pack  and  Options  if it
 1277%   contains a url(URL) option. This allows installing packages that are
 1278%   not known to the server. In most cases, the URL will be a git URL or
 1279%   the URL to download an archive. It can  also be a ``file://`` url to
 1280%   install from a local archive.
 1281%
 1282%   The   first   clause   deals    with     a    wildcard    URL.   See
 1283%   pack_default_options/4, case (7).
 1284
 1285:- det(pack_options_to_versions/2). 1286pack_options_to_versions(Pack-PackOptions, Pack-Versions) :-
 1287    option(versions(Available), PackOptions), !,
 1288    maplist(version_url_info(Pack, PackOptions), Available, Versions).
 1289pack_options_to_versions(Pack-PackOptions, Pack-[Version-[Info]]) :-
 1290    option(url(URL), PackOptions),
 1291    findall(Prop, option_info_prop(PackOptions, Prop), Pairs),
 1292    dict_create(Info, #,
 1293                [ pack-Pack,
 1294                  url-URL
 1295                | Pairs
 1296                ]),
 1297    Version = Info.get(version, '0.0.0').
 1298
 1299version_url_info(Pack, PackOptions, Version-URL, Version-[Info]) :-
 1300    findall(Prop,
 1301            ( option_info_prop(PackOptions, Prop),
 1302              Prop \= version-_
 1303            ),
 1304            Pairs),
 1305    dict_create(Info, #,
 1306                [ pack-Pack,
 1307                  url-URL,
 1308                  version-Version
 1309                | Pairs
 1310                ]).
 1311
 1312option_info_prop(PackOptions, Prop-Value) :-
 1313    option_info(Prop),
 1314    Opt =.. [Prop,Value],
 1315    option(Opt, PackOptions).
 1316
 1317option_info(git).
 1318option_info(hash).
 1319option_info(version).
 1320option_info(branch).
 1321option_info(link).
 1322
 1323%!  compatible_version(+Pack, +Version, +Options) is semidet.
 1324%
 1325%   Fails if Options demands a  version   and  Version is not compatible
 1326%   with Version.
 1327
 1328compatible_version(Pack, Version, PackOptions) :-
 1329    option(version(ReqVersion), PackOptions),
 1330    !,
 1331    satisfies_version(Pack, Version, ReqVersion).
 1332compatible_version(_, _, _).
 1333
 1334%!  pack_options_compatible_with_info(+Info, +PackOptions) is semidet.
 1335%
 1336%   Ignore information from the server  that   is  incompatible with the
 1337%   request.
 1338
 1339pack_options_compatible_with_info(Info, PackOptions) :-
 1340    findall(Prop, option_info_prop(PackOptions, Prop), Pairs),
 1341    dict_create(Dict, _, Pairs),
 1342    Dict >:< Info.
 1343
 1344%!  download_plan(+Targets, +Plan, +Options) is semidet.
 1345%
 1346%   Download or update all packages from Plan. We   need to do this as a
 1347%   first  step  because  we  may    not  have  (up-to-date)  dependency
 1348%   information about all packs. For example, a pack may be installed at
 1349%   the git HEAD revision that is not yet   know to the server or it may
 1350%   be installed from a url that is not known at all at the server.
 1351
 1352download_plan(_Targets, Plan, Plan, _Options) :-
 1353    exclude(installed, Plan, []),
 1354    !.
 1355download_plan(Targets, Plan0, Plan, Options) :-
 1356    confirm(download_plan(Plan0), yes, Options),
 1357    maplist(download_from_info(Options), Plan0, Plan1),
 1358    plan_unsatisfied_dependencies(Plan1, Deps),
 1359    (   Deps == []
 1360    ->  Plan = Plan1
 1361    ;   print_message(informational, pack(new_dependencies(Deps))),
 1362        prolog_description(Properties),
 1363        query_pack_server(versions(Deps, Properties), Result, []),
 1364        (   Result = true(Versions)
 1365        ->  pack_resolve(Targets, Plan1, Versions, Plan2, Options),
 1366            !,
 1367            download_plan(Targets, Plan2, Plan, Options)
 1368        ;   print_message(error, pack(query_failed(Result))),
 1369            fail
 1370        )
 1371    ).
 1372
 1373%!  plan_unsatisfied_dependencies(+Plan, -Deps) is det.
 1374%
 1375%   True when Deps is a list of dependency   tokens  in Plan that is not
 1376%   satisfied.
 1377
 1378plan_unsatisfied_dependencies(Plan, Deps) :-
 1379    phrase(plan_unsatisfied_dependencies(Plan, Plan), Deps).
 1380
 1381plan_unsatisfied_dependencies([], _) -->
 1382    [].
 1383plan_unsatisfied_dependencies([Info|Infos], Plan) -->
 1384    { Deps = Info.get(requires) },
 1385    plan_unsatisfied_requirements(Deps, Plan),
 1386    plan_unsatisfied_dependencies(Infos, Plan).
 1387
 1388plan_unsatisfied_requirements([], _) -->
 1389    [].
 1390plan_unsatisfied_requirements([H|T], Plan) -->
 1391    { is_prolog_token(H),           % Can this fail?
 1392      prolog_satisfies(H)
 1393    },
 1394    !,
 1395    plan_unsatisfied_requirements(T, Plan).
 1396plan_unsatisfied_requirements([H|T], Plan) -->
 1397    { member(Info, Plan),
 1398      (   (   Version = Info.get(version)
 1399          ->  Provides = @(Info.get(pack), Version)
 1400          ;   Provides = Info.get(pack)
 1401          )
 1402      ;   member(Provides, Info.get(provides))
 1403      ),
 1404      satisfies_req(Provides, H)
 1405    }, !,
 1406    plan_unsatisfied_requirements(T, Plan).
 1407plan_unsatisfied_requirements([H|T], Plan) -->
 1408    [H],
 1409    plan_unsatisfied_requirements(T, Plan).
 1410
 1411
 1412%!  build_plan(+Plan, -Built, +Options) is det.
 1413%
 1414%   Run post installation steps.  We   build  dependencies  before their
 1415%   dependents, so we first do a topological  sort on the packs based on
 1416%   the pack dependencies.
 1417
 1418build_plan(Plan, Ordered, Options) :-
 1419    maplist(decide_autoload_pack(Options), Plan, Plan1),
 1420    partition(needs_rebuild_from_info(Options), Plan1, ToBuild, NoBuild),
 1421    maplist(attach_from_info(Options), NoBuild),
 1422    (   ToBuild == []
 1423    ->  post_install_autoload(NoBuild),
 1424        Ordered = []
 1425    ;   order_builds(ToBuild, Ordered),
 1426        confirm(build_plan(Ordered), yes, Options),
 1427        maplist(exec_plan_rebuild_step(Options), Ordered)
 1428    ).
 1429
 1430%!  needs_rebuild_from_info(+Options, +Info) is semidet.
 1431%
 1432%   True when we need to rebuilt the pack.
 1433
 1434needs_rebuild_from_info(Options, Info) :-
 1435    PackDir = Info.installed,
 1436    is_foreign_pack(PackDir, _),
 1437    \+ is_built(PackDir, Options).
 1438
 1439%!  is_built(+PackDir, +Options) is semidet.
 1440%
 1441%   True if the pack in PackDir has been built.
 1442%
 1443%   @tbd We now verify it was built by   the exact same version. That is
 1444%   normally an overkill.
 1445
 1446is_built(PackDir, _Options) :-
 1447    current_prolog_flag(arch, Arch),
 1448    prolog_version_dotted(Version), % Major.Minor.Patch
 1449    pack_status_dir(PackDir, built(Arch, Version, _)).
 1450
 1451%!  order_builds(+ToBuild, -Ordered) is det.
 1452%
 1453%   Order the build  processes  by   building  dependencies  before  the
 1454%   packages that rely on them as they may need them during the build.
 1455
 1456order_builds(ToBuild, Ordered) :-
 1457    findall(Pack-Dependent, dep_edge(ToBuild, Pack, Dependent), Edges),
 1458    maplist(get_dict(pack), ToBuild, Packs),
 1459    vertices_edges_to_ugraph(Packs, Edges, Graph),
 1460    ugraph_layers(Graph, Layers),
 1461    append(Layers, PackNames),
 1462    maplist(pack_info_from_name(ToBuild), PackNames, Ordered).
 1463
 1464%!  dep_edge(+Infos, -Pack, -Dependent) is nondet.
 1465%
 1466%   True when Pack needs to be installed   as a dependency of Dependent.
 1467%   Both Pack and Dependent are pack _names_. I.e., this implies that we
 1468%   must build Pack _before_ Dependent.
 1469
 1470dep_edge(Infos, Pack, Dependent) :-
 1471    member(Info, Infos),
 1472    Pack = Info.pack,
 1473    member(Dependent, Info.get(dependency_for)),
 1474    (   member(DepInfo, Infos),
 1475        DepInfo.pack == Dependent
 1476    ->  true
 1477    ).
 1478
 1479:- det(pack_info_from_name/3). 1480pack_info_from_name(Infos, Pack, Info) :-
 1481    member(Info, Infos),
 1482    Info.pack == Pack,
 1483    !.
 1484
 1485%!  exec_plan_rebuild_step(+Options, +Info) is det.
 1486%
 1487%   Execute the rebuild steps for the given Info.
 1488
 1489exec_plan_rebuild_step(Options, Info) :-
 1490    print_message(informational, pack(build(Info.pack, Info.installed))),
 1491    pack_post_install(Info, Options),
 1492    attach_from_info(Options, Info).
 1493
 1494%!  attach_from_info(+Options, +Info) is det.
 1495%
 1496%   Make the package visible.
 1497
 1498attach_from_info(_Options, Info) :-
 1499    Info.get(keep) == true,
 1500    !.
 1501attach_from_info(Options, Info) :-
 1502    (   option(pack_directory(_Parent), Options)
 1503    ->  pack_attach(Info.installed, [duplicate(replace)])
 1504    ;   pack_attach(Info.installed, [])
 1505    ).
 1506
 1507%!  download_from_info(+Options, +Info0, -Info) is det.
 1508%
 1509%   Download a package guided by Info. Note   that this does __not__ run
 1510%   any scripts. This implies that dependencies do not matter and we can
 1511%   proceed in any order. This is important  because we may use packages
 1512%   at their git HEAD, which implies  that requirements may be different
 1513%   from what is in the Info terms.
 1514
 1515download_from_info(Options, Info0, Info), option(dryrun(true), Options) =>
 1516    print_term(Info0, [nl(true)]),
 1517    Info = Info0.
 1518download_from_info(_Options, Info0, Info), installed(Info0) =>
 1519    Info = Info0.
 1520download_from_info(_Options, Info0, Info),
 1521    _{upgrade:OldInfo, git:true} :< Info0,
 1522    is_git_directory(OldInfo.installed) =>
 1523    PackDir = OldInfo.installed,
 1524    git_checkout_version(PackDir, [commit(Info0.hash)]),
 1525    reload_info(PackDir, Info0, Info).
 1526download_from_info(Options, Info0, Info),
 1527    _{upgrade:OldInfo} :< Info0 =>
 1528    PackDir = OldInfo.installed,
 1529    detach_pack(OldInfo.pack, PackDir),
 1530    delete_directory_and_contents(PackDir),
 1531    del_dict(upgrade, Info0, _, Info1),
 1532    download_from_info(Options, Info1, Info).
 1533download_from_info(Options, Info0, Info),
 1534    _{url:URL, git:true} :< Info0, \+ have_git =>
 1535    git_archive_url(URL, Archive, Options),
 1536    download_from_info([git_url(URL)|Options],
 1537                       Info0.put(_{ url:Archive,
 1538                                    git:false,
 1539                                    git_url:URL
 1540                                  }),
 1541                       Info1),
 1542                                % restore the hash to register the download.
 1543    (   Info1.get(version) == Info0.get(version),
 1544        Hash = Info0.get(hash)
 1545    ->  Info = Info1.put(hash, Hash)
 1546    ;   Info = Info1
 1547    ).
 1548download_from_info(Options, Info0, Info),
 1549    _{url:URL} :< Info0 =>
 1550    select_option(pack_directory(Dir), Options, Options1),
 1551    select_option(version(_), Options1, Options2, _),
 1552    download_info_extra(Info0, InstallOptions, Options2),
 1553    pack_download_from_url(URL, Dir, Info0.pack,
 1554                           [ interactive(false),
 1555                             pack_dir(PackDir)
 1556                           | InstallOptions
 1557                           ]),
 1558    reload_info(PackDir, Info0, Info).
 1559
 1560download_info_extra(Info, [git(true),commit(Hash)|Options], Options) :-
 1561    Info.get(git) == true,
 1562    !,
 1563    Hash = Info.get(commit, 'HEAD').
 1564download_info_extra(Info, [link(true)|Options], Options) :-
 1565    Info.get(link) == true,
 1566    !.
 1567download_info_extra(_, Options, Options).
 1568
 1569installed(Info) :-
 1570    _ = Info.get(installed).
 1571
 1572detach_pack(Pack, PackDir) :-
 1573    (   current_pack(Pack, PackDir)
 1574    ->  '$pack_detach'(Pack, PackDir)
 1575    ;   true
 1576    ).
 1577
 1578%!  reload_info(+PackDir, +Info0, -Info) is det.
 1579%
 1580%   Update the requires and provides metadata. Info0 is what we got from
 1581%   the server, but the package may be   different  as we may have asked
 1582%   for the git HEAD or the package URL   may not have been known by the
 1583%   server at all.
 1584
 1585reload_info(_PackDir, Info, Info) :-
 1586    _ = Info.get(installed),	% we read it from the package
 1587    !.
 1588reload_info(PackDir, Info0, Info) :-
 1589    local_pack_info(PackDir, Info1),
 1590    Info = Info0.put(installed, PackDir)
 1591                .put(downloaded, Info0.url)
 1592                .put(Info1).
 1593
 1594%!  work_done(+Targets, +Plan, +PlanB, +Built, +Options) is det.
 1595%
 1596%   Targets has successfully been installed  and   the  packs Built have
 1597%   successfully ran their build scripts.
 1598
 1599work_done(_, _, _, _, Options),
 1600    option(silent(true), Options) =>
 1601    true.
 1602work_done(Targets, Plan, Plan, [], _Options) =>
 1603    convlist(can_upgrade_target(Plan), Targets, CanUpgrade),
 1604    (   CanUpgrade == []
 1605    ->  pairs_keys(Targets, Packs),
 1606        print_message(informational, pack(up_to_date(Packs)))
 1607    ;   print_message(informational, pack(installed_can_upgrade(CanUpgrade)))
 1608    ).
 1609work_done(_, _, _, _, _) =>
 1610    true.
 1611
 1612can_upgrade_target(Plan, Pack-_, Info) =>
 1613    member(Info, Plan),
 1614    Info.pack == Pack,
 1615    !,
 1616    _ = Info.get(latest_version).
 1617
 1618%!  local_packs(+Dir, -Packs) is det.
 1619%
 1620%   True when Packs  is  a  list   with  information  for  all installed
 1621%   packages.
 1622
 1623local_packs(Dir, Packs) :-
 1624    findall(Pack, pack_in_subdir(Dir, Pack), Packs).
 1625
 1626pack_in_subdir(Dir, Info) :-
 1627    directory_member(Dir, PackDir,
 1628                     [ file_type(directory),
 1629                       hidden(false)
 1630                     ]),
 1631    local_pack_info(PackDir, Info).
 1632
 1633local_pack_info(PackDir,
 1634                #{ pack: Pack,
 1635                   version: Version,
 1636                   title: Title,
 1637                   hash: Hash,
 1638                   url: URL,
 1639                   git: IsGit,
 1640                   requires: Requires,
 1641                   provides: Provides,
 1642                   conflicts: Conflicts,
 1643                   installed: PackDir
 1644                 }) :-
 1645    directory_file_path(PackDir, 'pack.pl', MetaFile),
 1646    exists_file(MetaFile),
 1647    file_base_name(PackDir, DirName),
 1648    findall(Term, pack_dir_info(PackDir, _, Term), Info),
 1649    option(pack(Pack), Info, DirName),
 1650    option(title(Title), Info, '<no title>'),
 1651    option(version(Version), Info, '<no version>'),
 1652    option(download(URL), Info, '<no download url>'),
 1653    findall(Req, member(requires(Req), Info), Requires),
 1654    findall(Prv, member(provides(Prv), Info), Provides),
 1655    findall(Cfl, member(conflicts(Cfl), Info), Conflicts),
 1656    (   have_git,
 1657        is_git_directory(PackDir)
 1658    ->  git_hash(Hash, [directory(PackDir)]),
 1659        IsGit = true
 1660    ;   Hash = '-',
 1661        IsGit = false
 1662    ).
 1663
 1664
 1665		 /*******************************
 1666		 *        PROLOG VERSIONS	*
 1667		 *******************************/
 1668
 1669%!  prolog_description(-Description) is det.
 1670%
 1671%   Provide a description of the running Prolog system. Version terms:
 1672%
 1673%     - prolog(Dialect, Version)
 1674%
 1675%   @tbd:   establish   a   language    for     features.    Sync   with
 1676%   library(prolog_versions)
 1677
 1678prolog_description([prolog(swi(Version))]) :-
 1679    prolog_version(Version).
 1680
 1681prolog_version(Version) :-
 1682    current_prolog_flag(version_git, Version),
 1683    !.
 1684prolog_version(Version) :-
 1685    prolog_version_dotted(Version).
 1686
 1687prolog_version_dotted(Version) :-
 1688    current_prolog_flag(version_data, swi(Major, Minor, Patch, _)),
 1689    VNumbers = [Major, Minor, Patch],
 1690    atomic_list_concat(VNumbers, '.', Version).
 1691
 1692%!  is_prolog_token(+Token) is semidet.
 1693%
 1694%   True when Token describes a property of the target Prolog
 1695%   system.
 1696
 1697is_prolog_token(Token), cmp(Token, prolog, _Cmp, _Version) => true.
 1698is_prolog_token(prolog:Feature), atom(Feature) => true.
 1699is_prolog_token(prolog:Feature), flag_value_feature(Feature, _Flag, _Value) =>
 1700    true.
 1701is_prolog_token(_) => fail.
 1702
 1703%!  prolog_satisfies(+Token) is semidet.
 1704%
 1705%   True when the  running  Prolog   system  satisfies  token. Processes
 1706%   requires(Token) terms for
 1707%
 1708%     - prolog Cmp Version
 1709%       Demand a Prolog version (range).
 1710%     - prolog:Flag
 1711%     - prolog:Flag(Value)
 1712%     - prolog:library(Lib)
 1713%
 1714%   @see require_prolog_version/2.
 1715
 1716prolog_satisfies(Token), cmp(Token, prolog, Cmp, ReqVersion) =>
 1717    prolog_version(CurrentVersion),
 1718    cmp_versions(Cmp, CurrentVersion, ReqVersion).
 1719prolog_satisfies(prolog:library(Lib)), atom(Lib) =>
 1720    exists_source(library(Lib)).
 1721prolog_satisfies(prolog:Feature), atom(Feature) =>
 1722    current_prolog_flag(Feature, true).
 1723prolog_satisfies(prolog:Feature), flag_value_feature(Feature, Flag, Value) =>
 1724    current_prolog_flag(Flag, Value).
 1725
 1726flag_value_feature(Feature, Flag, Value) :-
 1727    compound(Feature),
 1728    compound_name_arguments(Feature, Flag, [Value]),
 1729    atom(Flag).
 1730
 1731
 1732                 /*******************************
 1733                 *             INFO             *
 1734                 *******************************/
 1735
 1736%!  pack_archive_info(+Archive, +Pack, -Info, -Strip)
 1737%
 1738%   True when Archive archives Pack. Info  is unified with the terms
 1739%   from pack.pl in the  pack  and   Strip  is  the strip-option for
 1740%   archive_extract/3.
 1741%
 1742%   Requires library(archive), which is lazily loaded when needed.
 1743%
 1744%   @error  existence_error(pack_file, 'pack.pl') if the archive
 1745%           doesn't contain pack.pl
 1746%   @error  Syntax errors if pack.pl cannot be parsed.
 1747
 1748:- if(exists_source(library(archive))). 1749ensure_loaded_archive :-
 1750    current_predicate(archive_open/3),
 1751    !.
 1752ensure_loaded_archive :-
 1753    use_module(library(archive)).
 1754
 1755pack_archive_info(Archive, Pack, [archive_size(Bytes)|Info], Strip) :-
 1756    ensure_loaded_archive,
 1757    size_file(Archive, Bytes),
 1758    setup_call_cleanup(
 1759        archive_open(Archive, Handle, []),
 1760        (   repeat,
 1761            (   archive_next_header(Handle, InfoFile)
 1762            ->  true
 1763            ;   !, fail
 1764            )
 1765        ),
 1766        archive_close(Handle)),
 1767    file_base_name(InfoFile, 'pack.pl'),
 1768    atom_concat(Prefix, 'pack.pl', InfoFile),
 1769    strip_option(Prefix, Pack, Strip),
 1770    setup_call_cleanup(
 1771        archive_open_entry(Handle, Stream),
 1772        read_stream_to_terms(Stream, Info),
 1773        close(Stream)),
 1774    !,
 1775    must_be(ground, Info),
 1776    maplist(valid_term(pack_info_term), Info).
 1777:- else. 1778pack_archive_info(_, _, _, _) :-
 1779    existence_error(library, archive).
 1780:- endif. 1781pack_archive_info(_, _, _, _) :-
 1782    existence_error(pack_file, 'pack.pl').
 1783
 1784strip_option('', _, []) :- !.
 1785strip_option('./', _, []) :- !.
 1786strip_option(Prefix, Pack, [remove_prefix(Prefix)]) :-
 1787    atom_concat(PrefixDir, /, Prefix),
 1788    file_base_name(PrefixDir, Base),
 1789    (   Base == Pack
 1790    ->  true
 1791    ;   pack_version_file(Pack, _, Base)
 1792    ->  true
 1793    ;   \+ sub_atom(PrefixDir, _, _, _, /)
 1794    ).
 1795
 1796read_stream_to_terms(Stream, Terms) :-
 1797    read(Stream, Term0),
 1798    read_stream_to_terms(Term0, Stream, Terms).
 1799
 1800read_stream_to_terms(end_of_file, _, []) :- !.
 1801read_stream_to_terms(Term0, Stream, [Term0|Terms]) :-
 1802    read(Stream, Term1),
 1803    read_stream_to_terms(Term1, Stream, Terms).
 1804
 1805
 1806%!  pack_git_info(+GitDir, -Hash, -Info) is det.
 1807%
 1808%   Retrieve info from a cloned git   repository  that is compatible
 1809%   with pack_archive_info/4.
 1810
 1811pack_git_info(GitDir, Hash, [git(true), installed_size(Bytes)|Info]) :-
 1812    exists_directory(GitDir),
 1813    !,
 1814    git_ls_tree(Entries, [directory(GitDir)]),
 1815    git_hash(Hash, [directory(GitDir)]),
 1816    maplist(arg(4), Entries, Sizes),
 1817    sum_list(Sizes, Bytes),
 1818    dir_metadata(GitDir, Info).
 1819
 1820dir_metadata(GitDir, Info) :-
 1821    directory_file_path(GitDir, 'pack.pl', InfoFile),
 1822    read_file_to_terms(InfoFile, Info, [encoding(utf8)]),
 1823    maplist(valid_term(pack_info_term), Info).
 1824
 1825%!  download_file_sanity_check(+Archive, +Pack, +Info) is semidet.
 1826%
 1827%   Perform basic sanity checks on DownloadFile
 1828
 1829download_file_sanity_check(Archive, Pack, Info) :-
 1830    info_field(name(PackName), Info),
 1831    info_field(version(PackVersion), Info),
 1832    pack_version_file(PackFile, FileVersion, Archive),
 1833    must_match([Pack, PackName, PackFile], name),
 1834    must_match([PackVersion, FileVersion], version).
 1835
 1836info_field(Field, Info) :-
 1837    memberchk(Field, Info),
 1838    ground(Field),
 1839    !.
 1840info_field(Field, _Info) :-
 1841    functor(Field, FieldName, _),
 1842    print_message(error, pack(missing(FieldName))),
 1843    fail.
 1844
 1845must_match(Values, _Field) :-
 1846    sort(Values, [_]),
 1847    !.
 1848must_match(Values, Field) :-
 1849    print_message(error, pack(conflict(Field, Values))),
 1850    fail.
 1851
 1852
 1853                 /*******************************
 1854                 *         INSTALLATION         *
 1855                 *******************************/
 1856
 1857%!  prepare_pack_dir(+Dir, +Options)
 1858%
 1859%   Prepare for installing the package into  Dir. This
 1860%
 1861%     - If the directory exist and is empty, done.
 1862%     - Else if the directory exists, remove the directory and recreate
 1863%       it. Note that if the directory is a symlink this just deletes
 1864%       the link.
 1865%     - Else if some entry (file, link, ...) exists, delete it and
 1866%       create a new directory.
 1867%     - Else create the directory.
 1868
 1869prepare_pack_dir(Dir, Options) :-
 1870    exists_directory(Dir),
 1871    !,
 1872    (   empty_directory(Dir)
 1873    ->  true
 1874    ;   remove_existing_pack(Dir, Options)
 1875    ->  make_directory(Dir)
 1876    ).
 1877prepare_pack_dir(Dir, _) :-
 1878    (   read_link(Dir, _, _)
 1879    ;   access_file(Dir, exist)
 1880    ),
 1881    !,
 1882    delete_file(Dir),
 1883    make_directory(Dir).
 1884prepare_pack_dir(Dir, _) :-
 1885    make_directory(Dir).
 1886
 1887%!  empty_directory(+Directory) is semidet.
 1888%
 1889%   True if Directory is empty (holds no files or sub-directories).
 1890
 1891empty_directory(Dir) :-
 1892    \+ ( directory_files(Dir, Entries),
 1893         member(Entry, Entries),
 1894         \+ special(Entry)
 1895       ).
 1896
 1897special(.).
 1898special(..).
 1899
 1900%!  remove_existing_pack(+PackDir, +Options) is semidet.
 1901%
 1902%   Remove  a  possible  existing   pack    directory   if   the  option
 1903%   upgrade(true) is present. This is used to remove an old installation
 1904%   before unpacking a new archive, copy or   link  a directory with the
 1905%   new contents.
 1906
 1907remove_existing_pack(PackDir, Options) :-
 1908    exists_directory(PackDir),
 1909    !,
 1910    (   (   option(upgrade(true), Options)
 1911        ;   confirm(remove_existing_pack(PackDir), yes, Options)
 1912        )
 1913    ->  delete_directory_and_contents(PackDir)
 1914    ;   print_message(error, pack(directory_exists(PackDir))),
 1915        fail
 1916    ).
 1917remove_existing_pack(_, _).
 1918
 1919%!  pack_download_from_url(+URL, +PackDir, +Pack, +Options)
 1920%
 1921%   Download a package from a remote   source.  For git repositories, we
 1922%   simply clone. Archives are downloaded. Options:
 1923%
 1924%     - git(true)
 1925%       Assume URL refers to a git repository.
 1926%     - pack_dir(-Dir)
 1927%       Dir is unified with the location where the pack is installed.
 1928%
 1929%   @tbd We currently  use  the  built-in   HTTP  client.  For  complete
 1930%   coverage, we should consider using  an   external  (e.g., `curl`) if
 1931%   available.
 1932
 1933pack_download_from_url(URL, PackTopDir, Pack, Options) :-
 1934    option(git(true), Options),
 1935    !,
 1936    directory_file_path(PackTopDir, Pack, PackDir),
 1937    prepare_pack_dir(PackDir, Options),
 1938    (   option(branch(Branch), Options)
 1939    ->  Extra = ['--branch', Branch]
 1940    ;   Extra = []
 1941    ),
 1942    run_process(path(git), [clone, URL, PackDir|Extra], []),
 1943    git_checkout_version(PackDir, [update(false)|Options]),
 1944    option(pack_dir(PackDir), Options, _).
 1945pack_download_from_url(URL0, PackTopDir, Pack, Options) :-
 1946    download_url(URL0),
 1947    !,
 1948    hsts(URL0, URL, Options),
 1949    directory_file_path(PackTopDir, Pack, PackDir),
 1950    prepare_pack_dir(PackDir, Options),
 1951    pack_download_dir(PackTopDir, DownLoadDir),
 1952    download_file(URL, Pack, DownloadBase, Options),
 1953    directory_file_path(DownLoadDir, DownloadBase, DownloadFile),
 1954    (   option(insecure(true), Options, false)
 1955    ->  TLSOptions = [cert_verify_hook(ssl_verify)]
 1956    ;   TLSOptions = []
 1957    ),
 1958    print_message(informational, pack(download(begin, Pack, URL, DownloadFile))),
 1959    setup_call_cleanup(
 1960        http_open(URL, In, TLSOptions),
 1961        setup_call_cleanup(
 1962            open(DownloadFile, write, Out, [type(binary)]),
 1963            copy_stream_data(In, Out),
 1964            close(Out)),
 1965        close(In)),
 1966    print_message(informational, pack(download(end, Pack, URL, DownloadFile))),
 1967    pack_archive_info(DownloadFile, Pack, Info, _),
 1968    (   option(git_url(GitURL), Options)
 1969    ->  Origin = GitURL                 % implicit download from git.
 1970    ;   download_file_sanity_check(DownloadFile, Pack, Info),
 1971        Origin = URL
 1972    ),
 1973    pack_unpack_from_local(DownloadFile, PackTopDir, Pack, PackDir, Options),
 1974    pack_assert(PackDir, archive(DownloadFile, Origin)),
 1975    option(pack_dir(PackDir), Options, _).
 1976pack_download_from_url(URL, PackTopDir, Pack, Options) :-
 1977    local_uri_file_name(URL, File),
 1978    !,
 1979    pack_unpack_from_local(File, PackTopDir, Pack, PackDir, Options),
 1980    pack_assert(PackDir, archive(File, URL)),
 1981    option(pack_dir(PackDir), Options, _).
 1982pack_download_from_url(URL, _PackTopDir, _Pack, _Options) :-
 1983    domain_error(url, URL).
 1984
 1985%!  git_checkout_version(+PackDir, +Options) is det.
 1986%
 1987%   Given a checked out version of a repository, put the repo at the
 1988%   desired version.  Options:
 1989%
 1990%     - commit(+Commit)
 1991%       Target commit or `'HEAD'`.  If `'HEAD'`, get the HEAD of the
 1992%       explicit (option branch(Branch)), current or default branch. If
 1993%       the commit is a hash and it is the tip of a branch, checkout
 1994%       this branch. Else simply checkout the hash.
 1995%     - branch(+Branch)
 1996%       Used with commit('HEAD').
 1997%     - version(+Version)
 1998%       Checkout a tag.  If there is a tag matching Version use that,
 1999%       otherwise try to find a tag that ends with Version and demand
 2000%       the prefix to be letters, optionally followed by a dash or
 2001%       underscore.  Examples: 2.1, V2.1, v_2.1.
 2002%     - update(true)
 2003%       If none of the above is given update the repo.  If it is on
 2004%       a branch, _pull_.  Else, put it on the default branch and
 2005%       pull.
 2006
 2007git_checkout_version(PackDir, Options) :-
 2008    option(commit('HEAD'), Options),
 2009    option(branch(Branch), Options),
 2010    !,
 2011    git_ensure_on_branch(PackDir, Branch),
 2012    run_process(path(git), ['-C', PackDir, pull], []).
 2013git_checkout_version(PackDir, Options) :-
 2014    option(commit('HEAD'), Options),
 2015    git_current_branch(_, [directory(PackDir)]),
 2016    !,
 2017    run_process(path(git), ['-C', PackDir, pull], []).
 2018git_checkout_version(PackDir, Options) :-
 2019    option(commit('HEAD'), Options),
 2020    !,
 2021    git_default_branch(Branch, [directory(PackDir)]),
 2022    git_ensure_on_branch(PackDir, Branch),
 2023    run_process(path(git), ['-C', PackDir, pull], []).
 2024git_checkout_version(PackDir, Options) :-
 2025    option(commit(Hash), Options),
 2026    run_process(path(git), ['-C', PackDir, fetch], []),
 2027    git_branches(Branches, [contains(Hash), directory(PackDir)]),
 2028    git_process_output(['-C', PackDir, 'rev-parse' | Branches],
 2029                       read_lines_to_atoms(Commits),
 2030                       []),
 2031    nth1(I, Commits, Hash),
 2032    nth1(I, Branches, Branch),
 2033    !,
 2034    git_ensure_on_branch(PackDir, Branch).
 2035git_checkout_version(PackDir, Options) :-
 2036    option(commit(Hash), Options),
 2037    !,
 2038    run_process(path(git), ['-C', PackDir, checkout, '--quiet', Hash], []).
 2039git_checkout_version(PackDir, Options) :-
 2040    option(version(Version), Options),
 2041    !,
 2042    git_tags(Tags, [directory(PackDir)]),
 2043    (   memberchk(Version, Tags)
 2044    ->  Tag = Version
 2045    ;   member(Tag, Tags),
 2046        sub_atom(Tag, B, _, 0, Version),
 2047        sub_atom(Tag, 0, B, _, Prefix),
 2048        version_prefix(Prefix)
 2049    ->  true
 2050    ;   existence_error(version_tag, Version)
 2051    ),
 2052    run_process(path(git), ['-C', PackDir, checkout, Tag], []).
 2053git_checkout_version(_PackDir, Options) :-
 2054    option(fresh(true), Options),
 2055    !.
 2056git_checkout_version(PackDir, _Options) :-
 2057    git_current_branch(_, [directory(PackDir)]),
 2058    !,
 2059    run_process(path(git), ['-C', PackDir, pull], []).
 2060git_checkout_version(PackDir, _Options) :-
 2061    git_default_branch(Branch, [directory(PackDir)]),
 2062    git_ensure_on_branch(PackDir, Branch),
 2063    run_process(path(git), ['-C', PackDir, pull], []).
 2064
 2065%!  git_ensure_on_branch(+PackDir, +Branch) is det.
 2066%
 2067%   Ensure PackDir is on Branch.
 2068
 2069git_ensure_on_branch(PackDir, Branch) :-
 2070    git_current_branch(Branch, [directory(PackDir)]),
 2071    !.
 2072git_ensure_on_branch(PackDir, Branch) :-
 2073    run_process(path(git), ['-C', PackDir, checkout, Branch], []).
 2074
 2075read_lines_to_atoms(Atoms, In) :-
 2076    read_line_to_string(In, Line),
 2077    (   Line == end_of_file
 2078    ->  Atoms = []
 2079    ;   atom_string(Atom, Line),
 2080        Atoms = [Atom|T],
 2081        read_lines_to_atoms(T, In)
 2082    ).
 2083
 2084version_prefix(Prefix) :-
 2085    atom_codes(Prefix, Codes),
 2086    phrase(version_prefix, Codes).
 2087
 2088version_prefix -->
 2089    [C],
 2090    { code_type(C, alpha) },
 2091    !,
 2092    version_prefix.
 2093version_prefix -->
 2094    "-".
 2095version_prefix -->
 2096    "_".
 2097version_prefix -->
 2098    "".
 2099
 2100%!  download_file(+URL, +Pack, -File, +Options) is det.
 2101%
 2102%   Determine the file into which  to   download  URL. The second clause
 2103%   deals with GitHub downloads from a release tag.
 2104
 2105download_file(URL, Pack, File, Options) :-
 2106    option(version(Version), Options),
 2107    !,
 2108    file_name_extension(_, Ext, URL),
 2109    format(atom(File), '~w-~w.~w', [Pack, Version, Ext]).
 2110download_file(URL, Pack, File, _) :-
 2111    file_base_name(URL,Basename),
 2112    no_int_file_name_extension(Tag,Ext,Basename),
 2113    tag_version(Tag,Version),
 2114    !,
 2115    format(atom(File0), '~w-~w', [Pack, Version]),
 2116    file_name_extension(File0, Ext, File).
 2117download_file(URL, _, File, _) :-
 2118    file_base_name(URL, File).
 2119
 2120%!  pack_url_file(+URL, -File) is det.
 2121%
 2122%   True if File is a unique  id   for  the referenced pack and version.
 2123%   Normally, that is simply the base  name, but GitHub archives destroy
 2124%   this picture. Needed by the pack manager in the web server.
 2125
 2126:- public pack_url_file/2. 2127pack_url_file(URL, FileID) :-
 2128    github_release_url(URL, Pack, Version),
 2129    !,
 2130    download_file(URL, Pack, FileID, [version(Version)]).
 2131pack_url_file(URL, FileID) :-
 2132    file_base_name(URL, FileID).
 2133
 2134%   ssl_verify(+SSL, +ProblemCert, +AllCerts, +FirstCert, +Error)
 2135%
 2136%   Used if insecure(true)  is  given   to  pack_install/2.  Accepts any
 2137%   certificate.
 2138
 2139:- public ssl_verify/5. 2140ssl_verify(_SSL,
 2141           _ProblemCertificate, _AllCertificates, _FirstCertificate,
 2142           _Error).
 2143
 2144pack_download_dir(PackTopDir, DownLoadDir) :-
 2145    directory_file_path(PackTopDir, 'Downloads', DownLoadDir),
 2146    (   exists_directory(DownLoadDir)
 2147    ->  true
 2148    ;   make_directory(DownLoadDir)
 2149    ),
 2150    (   access_file(DownLoadDir, write)
 2151    ->  true
 2152    ;   permission_error(write, directory, DownLoadDir)
 2153    ).
 2154
 2155%!  download_url(@URL) is semidet.
 2156%
 2157%   True if URL looks like a URL we   can  download from. Noet that urls
 2158%   like ``ftp://`` are also download  URLs,   but  _we_ cannot download
 2159%   from them.
 2160
 2161download_url(URL) :-
 2162    url_scheme(URL, Scheme),
 2163    download_scheme(Scheme).
 2164
 2165url_scheme(URL, Scheme) :-
 2166    atom(URL),
 2167    uri_components(URL, Components),
 2168    uri_data(scheme, Components, Scheme0),
 2169    atom(Scheme0),
 2170    Scheme = Scheme0.
 2171
 2172download_scheme(http).
 2173download_scheme(https).
 2174
 2175%!  hsts(+URL0, -URL, +Options) is det.
 2176%
 2177%   HSTS (HTTP Strict Transport Security) is   standard by which means a
 2178%   site asks to always use HTTPS. For  SWI-Prolog packages we now force
 2179%   using HTTPS for all  downloads.  This   may  be  overrules using the
 2180%   option insecure(true), which  may  also  be   used  to  disable  TLS
 2181%   certificate  checking.  Note  that  the   pack  integrity  is  still
 2182%   protected by its SHA1 hash.
 2183
 2184hsts(URL0, URL, Options) :-
 2185    option(insecure(true), Options, false),
 2186    !,
 2187    URL = URL0.
 2188hsts(URL0, URL, _Options) :-
 2189    url_scheme(URL0, http),
 2190    !,
 2191    uri_edit(scheme(https), URL0, URL).
 2192hsts(URL, URL, _Options).
 2193
 2194
 2195%!  pack_post_install(+Info, +Options) is det.
 2196%
 2197%   Process post installation work.  Steps:
 2198%
 2199%     - Create foreign resources
 2200%     - Register directory as autoload library
 2201%     - Attach the package
 2202
 2203pack_post_install(Info, Options) :-
 2204    Pack = Info.pack,
 2205    PackDir = Info.installed,
 2206    post_install_foreign(Pack, PackDir, Options),
 2207    post_install_autoload(Info),
 2208    pack_attach(PackDir, [duplicate(warning)]).
 2209
 2210%!  pack_rebuild is det.
 2211%!  pack_rebuild(+Pack) is det.
 2212%
 2213%   Rebuild  possible  foreign  components  of    Pack.   The  predicate
 2214%   pack_rebuild/0 rebuilds all registered packs.
 2215
 2216pack_rebuild :-
 2217    forall(current_pack(Pack),
 2218           ( print_message(informational, pack(rebuild(Pack))),
 2219             pack_rebuild(Pack)
 2220           )).
 2221
 2222pack_rebuild(Pack) :-
 2223    current_pack(Pack, PackDir),
 2224    !,
 2225    post_install_foreign(Pack, PackDir, [rebuild(true)]).
 2226pack_rebuild(Pack) :-
 2227    unattached_pack(Pack, PackDir),
 2228    !,
 2229    post_install_foreign(Pack, PackDir, [rebuild(true)]).
 2230pack_rebuild(Pack) :-
 2231    existence_error(pack, Pack).
 2232
 2233unattached_pack(Pack, BaseDir) :-
 2234    directory_file_path(Pack, 'pack.pl', PackFile),
 2235    absolute_file_name(pack(PackFile), PackPath,
 2236                       [ access(read),
 2237                         file_errors(fail)
 2238                       ]),
 2239    file_directory_name(PackPath, BaseDir).
 2240
 2241
 2242
 2243%!  post_install_foreign(+Pack, +PackDir, +Options) is det.
 2244%
 2245%   Install foreign parts of the package.  Options:
 2246%
 2247%     - rebuild(When)
 2248%       Determine when to rebuild.  Possible values:
 2249%       - if_absent
 2250%         Only rebuild if we have no existing foreign library.  This
 2251%         is the default.
 2252%       - true
 2253%         Always rebuild.
 2254
 2255post_install_foreign(Pack, PackDir, Options) :-
 2256    is_foreign_pack(PackDir, _),
 2257    !,
 2258    (   pack_info_term(PackDir, pack_version(Version))
 2259    ->  true
 2260    ;   Version = 1
 2261    ),
 2262    option(rebuild(Rebuild), Options, if_absent),
 2263    current_prolog_flag(arch, Arch),
 2264    prolog_version_dotted(PrologVersion),
 2265    (   Rebuild == if_absent,
 2266        foreign_present(PackDir, Arch)
 2267    ->  print_message(informational, pack(kept_foreign(Pack, Arch))),
 2268        (   pack_status_dir(PackDir, built(Arch, _, _))
 2269        ->  true
 2270        ;   pack_assert(PackDir, built(Arch, PrologVersion, downloaded))
 2271        )
 2272    ;   BuildSteps0 = [[dependencies], [configure], build, install, [test]],
 2273        (   Rebuild == true
 2274        ->  BuildSteps1 = [distclean|BuildSteps0]
 2275        ;   BuildSteps1 = BuildSteps0
 2276        ),
 2277        (   option(test(false), Options)
 2278        ->  delete(BuildSteps1, [test], BuildSteps2)
 2279        ;   BuildSteps2 = BuildSteps1
 2280        ),
 2281        (   option(clean(true), Options)
 2282        ->  append(BuildSteps2, [[clean]], BuildSteps)
 2283        ;   BuildSteps = BuildSteps2
 2284        ),
 2285        build_steps(BuildSteps, PackDir, [pack_version(Version)|Options]),
 2286        pack_assert(PackDir, built(Arch, PrologVersion, built))
 2287    ).
 2288post_install_foreign(_, _, _).
 2289
 2290
 2291%!  foreign_present(+PackDir, +Arch) is semidet.
 2292%
 2293%   True if we find one or more modules  in the pack `lib` directory for
 2294%   the current architecture.
 2295%
 2296%   @tbd Does not check that  these  can   be  loaded,  nor  whether all
 2297%   required modules are present.
 2298
 2299foreign_present(PackDir, Arch) :-
 2300    atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
 2301    exists_directory(ForeignBaseDir),
 2302    !,
 2303    atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
 2304    exists_directory(ForeignDir),
 2305    current_prolog_flag(shared_object_extension, Ext),
 2306    atomic_list_concat([ForeignDir, '/*.', Ext], Pattern),
 2307    expand_file_name(Pattern, Files),
 2308    Files \== [].
 2309
 2310%!  is_foreign_pack(+PackDir, -Type) is nondet.
 2311%
 2312%   True when PackDir contains  files  that   indicate  the  need  for a
 2313%   specific class of build tools indicated by Type.
 2314
 2315is_foreign_pack(PackDir, Type) :-
 2316    foreign_file(File, Type),
 2317    directory_file_path(PackDir, File, Path),
 2318    exists_file(Path).
 2319
 2320foreign_file('CMakeLists.txt', cmake).
 2321foreign_file('configure',      configure).
 2322foreign_file('configure.in',   autoconf).
 2323foreign_file('configure.ac',   autoconf).
 2324foreign_file('Makefile.am',    automake).
 2325foreign_file('Makefile',       make).
 2326foreign_file('makefile',       make).
 2327foreign_file('conanfile.txt',  conan).
 2328foreign_file('conanfile.py',   conan).
 2329
 2330
 2331                 /*******************************
 2332                 *           AUTOLOAD           *
 2333                 *******************************/
 2334
 2335%!  post_install_autoload(+InfoOrList) is det.
 2336%
 2337%   Create an autoload index if the package demands such.
 2338
 2339post_install_autoload(List), is_list(List) =>
 2340    maplist(post_install_autoload, List).
 2341post_install_autoload(Info),
 2342    _{installed:PackDir, autoload:true} :< Info =>
 2343    directory_file_path(PackDir, prolog, PrologLibDir),
 2344    make_library_index(PrologLibDir).
 2345post_install_autoload(Info) =>
 2346    directory_file_path(Info.installed, 'prolog/INDEX.pl', IndexFile),
 2347    (   exists_file(IndexFile)
 2348    ->  E = error(_,_),
 2349        print_message(warning, pack(delete_autoload_index(Info.pack, IndexFile))),
 2350        catch(delete_file(IndexFile), E,
 2351              print_message(warning, E))
 2352    ;   true
 2353    ).
 2354
 2355%!  decide_autoload_pack(+Options, +Info0, -Info) is det.
 2356%
 2357%   Add autoload:true to Info if the  pack   needs  to be configured for
 2358%   autoloading.
 2359
 2360decide_autoload_pack(Options, Info0, Info) :-
 2361    is_autoload_pack(Info0.pack, Info0.installed, Options),
 2362    !,
 2363    Info = Info0.put(autoload, true).
 2364decide_autoload_pack(_, Info, Info).
 2365
 2366is_autoload_pack(_Pack, _PackDir, Options) :-
 2367    option(autoload(true), Options),
 2368    !.
 2369is_autoload_pack(Pack, PackDir, Options) :-
 2370    pack_info_term(PackDir, autoload(true)),
 2371    confirm(autoload(Pack), no, Options).
 2372
 2373
 2374                 /*******************************
 2375                 *            UPGRADE           *
 2376                 *******************************/
 2377
 2378%!  pack_upgrade(+Pack) is semidet.
 2379%
 2380%   Upgrade Pack.  Shorthand for pack_install(Pack, [upgrade(true)]).
 2381
 2382pack_upgrade(Pack) :-
 2383    pack_install(Pack, [upgrade(true)]).
 2384
 2385
 2386                 /*******************************
 2387                 *            REMOVE            *
 2388                 *******************************/
 2389
 2390%!  pack_remove(+Name) is det.
 2391%!  pack_remove(+Name, +Options) is det.
 2392%
 2393%   Remove the indicated package.  If   packages  depend (indirectly) on
 2394%   this pack, ask to remove these as well.  Options:
 2395%
 2396%     - interactive(false)
 2397%       Do not prompt the user.
 2398%     - dependencies(Boolean)
 2399%       If `true` delete dependencies without asking.
 2400
 2401pack_remove(Pack) :-
 2402    pack_remove(Pack, []).
 2403
 2404pack_remove(Pack, Options) :-
 2405    option(dependencies(false), Options),
 2406    !,
 2407    pack_remove_forced(Pack).
 2408pack_remove(Pack, Options) :-
 2409    (   dependents(Pack, Deps)
 2410    ->  (   option(dependencies(true), Options)
 2411        ->  true
 2412        ;   confirm_remove(Pack, Deps, Delete, Options)
 2413        ),
 2414        forall(member(P, Delete), pack_remove_forced(P))
 2415    ;   pack_remove_forced(Pack)
 2416    ).
 2417
 2418pack_remove_forced(Pack) :-
 2419    catch('$pack_detach'(Pack, BaseDir),
 2420          error(existence_error(pack, Pack), _),
 2421          fail),
 2422    !,
 2423    (   read_link(BaseDir, _, Target)
 2424    ->  What = link(Target)
 2425    ;   What = directory
 2426    ),
 2427    print_message(informational, pack(remove(What, BaseDir))),
 2428    delete_directory_and_contents(BaseDir).
 2429pack_remove_forced(Pack) :-
 2430    unattached_pack(Pack, BaseDir),
 2431    !,
 2432    delete_directory_and_contents(BaseDir).
 2433pack_remove_forced(Pack) :-
 2434    print_message(informational, error(existence_error(pack, Pack),_)).
 2435
 2436confirm_remove(Pack, Deps, Delete, Options) :-
 2437    print_message(warning, pack(depends(Pack, Deps))),
 2438    menu(pack(resolve_remove),
 2439         [ [Pack]      = remove_only(Pack),
 2440           [Pack|Deps] = remove_deps(Pack, Deps),
 2441           []          = cancel
 2442         ], [], Delete, Options),
 2443    Delete \== [].
 2444
 2445
 2446		 /*******************************
 2447		 *           PUBLISH		*
 2448		 *******************************/
 2449
 2450%!  pack_publish(+Spec, +Options) is det.
 2451%
 2452%   Publish a package. There are two ways  typical ways to call this. We
 2453%   recommend developing a pack in a   GIT  repository. In this scenario
 2454%   the pack can be published using
 2455%
 2456%       ?- pack_publish('.', []).
 2457%
 2458%   Alternatively, an archive  file  has  been   uploaded  to  a  public
 2459%   location. In this scenario we can publish the pack using
 2460%
 2461%       ?- pack_publish(URL, [])
 2462%
 2463%   In both scenarios, pack_publish/2  by   default  creates an isolated
 2464%   environment and installs the package  in   this  directory  from the
 2465%   public URL. On success it triggers the   pack server to register the
 2466%   URL as a new pack or a new release of a pack.
 2467%
 2468%   Packs may also be published using the _app_ `pack`, e.g.
 2469%
 2470%       swipl pack publish .
 2471%
 2472%   Options:
 2473%
 2474%     - git(Boolean)
 2475%       If `true`, and Spec is a git managed directory, install using
 2476%       the remote repo.
 2477%     - sign(Boolean)
 2478%       Sign the repository with the current version.  This runs
 2479%       ``git tag -s <tag>``.
 2480%     - force(Boolean)
 2481%       Force the git tag.  This runs ``git tag -f <tag>``.
 2482%     - branch(+Branch)
 2483%       Branch used for releases.  Defined by git_default_branch/2
 2484%       if not specified.
 2485%     - register(+Boolean)
 2486%       If `false` (default `true`), perform the installation, but do
 2487%       not upload to the server. This can be used for testing.
 2488%     - isolated(+Boolean)
 2489%       If `true` (default), install and build all packages in an
 2490%       isolated package directory.  If `false`, use other packages
 2491%       installed for the environment.   The latter may be used to
 2492%       speedup debugging.
 2493%     - pack_directory(+Dir)
 2494%       Install the temporary packages in Dir. If omitted pack_publish/2
 2495%       creates a temporary directory and deletes this directory after
 2496%       completion. An explict target Dir is created if it does not
 2497%       exist and is not deleted on completion.
 2498%     - clean(+Boolean)
 2499%       If `true` (default), clean the destination directory first
 2500
 2501pack_publish(Dir, Options) :-
 2502    \+ download_url(Dir),
 2503    is_git_directory(Dir), !,
 2504    pack_git_info(Dir, _Hash, Metadata),
 2505    prepare_repository(Dir, Metadata, Options),
 2506    (   memberchk(download(URL), Metadata),
 2507        git_url(URL, _)
 2508    ->  true
 2509    ;   option(remote(Remote), Options, origin),
 2510        git_remote_url(Remote, RemoteURL, [directory(Dir)]),
 2511        git_to_https_url(RemoteURL, URL)
 2512    ),
 2513    memberchk(version(Version), Metadata),
 2514    pack_publish_(URL,
 2515                  [ version(Version)
 2516                  | Options
 2517                  ]).
 2518pack_publish(Spec, Options) :-
 2519    pack_publish_(Spec, Options).
 2520
 2521pack_publish_(Spec, Options) :-
 2522    pack_default_options(Spec, Pack, Options, DefOptions),
 2523    option(url(URL), DefOptions),
 2524    valid_publish_url(URL, Options),
 2525    prepare_build_location(Pack, Dir, Clean, Options),
 2526    (   option(register(false), Options)
 2527    ->  InstallOptions = DefOptions
 2528    ;   InstallOptions = [publish(Pack)|DefOptions]
 2529    ),
 2530    call_cleanup(pack_install(Pack,
 2531                              [ pack(Pack)
 2532                              | InstallOptions
 2533                              ]),
 2534                 cleanup_publish(Clean, Dir)).
 2535
 2536cleanup_publish(true, Dir) :-
 2537    !,
 2538    delete_directory_and_contents(Dir).
 2539cleanup_publish(_, _).
 2540
 2541valid_publish_url(URL, Options) :-
 2542    option(register(Register), Options, true),
 2543    (   Register == false
 2544    ->  true
 2545    ;   download_url(URL)
 2546    ->  true
 2547    ;   permission_error(publish, pack, URL)
 2548    ).
 2549
 2550prepare_build_location(Pack, Dir, Clean, Options) :-
 2551    (   option(pack_directory(Dir), Options)
 2552    ->  ensure_directory(Dir),
 2553        (   option(clean(true), Options, true)
 2554        ->  delete_directory_contents(Dir)
 2555        ;   true
 2556        )
 2557    ;   tmp_file(pack, Dir),
 2558        make_directory(Dir),
 2559        Clean = true
 2560    ),
 2561    (   option(isolated(false), Options)
 2562    ->  detach_pack(Pack, _),
 2563        attach_packs(Dir, [search(first)])
 2564    ;   attach_packs(Dir, [replace(true)])
 2565    ).
 2566
 2567
 2568
 2569%!  prepare_repository(+Dir, +Metadata, +Options) is semidet.
 2570%
 2571%   Prepare the git repository. If register(false)  is provided, this is
 2572%   a test run and therefore we do   not  need this. Otherwise we demand
 2573%   the working directory to be clean,  we   tag  the current commit and
 2574%   push the current branch.
 2575
 2576prepare_repository(_Dir, _Metadata, Options) :-
 2577    option(register(false), Options),
 2578    !.
 2579prepare_repository(Dir, Metadata, Options) :-
 2580    git_dir_must_be_clean(Dir),
 2581    git_must_be_on_default_branch(Dir, Options),
 2582    tag_git_dir(Dir, Metadata, Action, Options),
 2583    confirm(git_push, yes, Options),
 2584    run_process(path(git), ['-C', file(Dir), push ], []),
 2585    (   Action = push_tag(Tag)
 2586    ->  run_process(path(git), ['-C', file(Dir), push, origin, Tag ], [])
 2587    ;   true
 2588    ).
 2589
 2590git_dir_must_be_clean(Dir) :-
 2591    git_describe(Description, [directory(Dir)]),
 2592    (   sub_atom(Description, _, _, 0, '-DIRTY')
 2593    ->  print_message(error, pack(git_not_clean(Dir))),
 2594        fail
 2595    ;   true
 2596    ).
 2597
 2598git_must_be_on_default_branch(Dir, Options) :-
 2599    (   option(branch(Default), Options)
 2600    ->  true
 2601    ;   git_default_branch(Default, [directory(Dir)])
 2602    ),
 2603    git_current_branch(Current, [directory(Dir)]),
 2604    (   Default == Current
 2605    ->  true
 2606    ;   print_message(error,
 2607                      pack(git_branch_not_default(Dir, Default, Current))),
 2608        fail
 2609    ).
 2610
 2611
 2612%!  tag_git_dir(+Dir, +Metadata, -Action, +Options) is semidet.
 2613%
 2614%   Add a version tag to the git repository.
 2615%
 2616%   @arg Action is one of push_tag(Tag) or `none`
 2617
 2618tag_git_dir(Dir, Metadata, Action, Options) :-
 2619    memberchk(version(Version), Metadata),
 2620    atom_concat('V', Version, Tag),
 2621    git_tags(Tags, [directory(Dir)]),
 2622    (   memberchk(Tag, Tags)
 2623    ->  git_tag_is_consistent(Dir, Tag, Action, Options)
 2624    ;   format(string(Message), 'Release ~w', [Version]),
 2625        findall(Opt, git_tag_option(Opt, Options), Argv,
 2626                [ '-m', Message, Tag ]),
 2627        confirm(git_tag(Tag), yes, Options),
 2628        run_process(path(git), ['-C', file(Dir), tag | Argv ], []),
 2629        Action = push_tag(Tag)
 2630    ).
 2631
 2632git_tag_option('-s', Options) :- option(sign(true), Options, true).
 2633git_tag_option('-f', Options) :- option(force(true), Options, true).
 2634
 2635git_tag_is_consistent(Dir, Tag, Action, Options) :-
 2636    format(atom(TagRef), 'refs/tags/~w', [Tag]),
 2637    format(atom(CommitRef), 'refs/tags/~w^{}', [Tag]),
 2638    option(remote(Remote), Options, origin),
 2639    git_ls_remote(Dir, LocalTags, [tags(true)]),
 2640    memberchk(CommitHash-CommitRef, LocalTags),
 2641    (   git_hash(CommitHash, [directory(Dir)])
 2642    ->  true
 2643    ;   print_message(error, pack(git_release_tag_not_at_head(Tag))),
 2644        fail
 2645    ),
 2646    memberchk(TagHash-TagRef, LocalTags),
 2647    git_ls_remote(Remote, RemoteTags, [tags(true)]),
 2648    (   memberchk(RemoteCommitHash-CommitRef, RemoteTags),
 2649        memberchk(RemoteTagHash-TagRef, RemoteTags)
 2650    ->  (   RemoteCommitHash == CommitHash,
 2651            RemoteTagHash == TagHash
 2652        ->  Action = none
 2653        ;   print_message(error, pack(git_tag_out_of_sync(Tag))),
 2654            fail
 2655        )
 2656    ;   Action = push_tag(Tag)
 2657    ).
 2658
 2659%!  git_to_https_url(+GitURL, -HTTP_URL) is semidet.
 2660%
 2661%   Get the HTTP(s) URL for a git repository, given a git url.
 2662%   Whether or not this is available and how to translate the
 2663%   one into the other depends in the server software.
 2664
 2665git_to_https_url(URL, URL) :-
 2666    download_url(URL),
 2667    !.
 2668git_to_https_url(GitURL, URL) :-
 2669    atom_concat('git@github.com:', Repo, GitURL),
 2670    !,
 2671    atom_concat('https://github.com/', Repo, URL).
 2672git_to_https_url(GitURL, _) :-
 2673    print_message(error, pack(git_no_https(GitURL))),
 2674    fail.
 2675
 2676
 2677                 /*******************************
 2678                 *           PROPERTIES         *
 2679                 *******************************/
 2680
 2681%!  pack_property(?Pack, ?Property) is nondet.
 2682%
 2683%   True when Property  is  a  property   of  an  installed  Pack.  This
 2684%   interface is intended for programs that   wish  to interact with the
 2685%   package manager. Defined properties are:
 2686%
 2687%     - directory(Directory)
 2688%     Directory into which the package is installed
 2689%     - version(Version)
 2690%     Installed version
 2691%     - title(Title)
 2692%     Full title of the package
 2693%     - author(Author)
 2694%     Registered author
 2695%     - download(URL)
 2696%     Official download URL
 2697%     - readme(File)
 2698%     Package README file (if present)
 2699%     - todo(File)
 2700%     Package TODO file (if present)
 2701
 2702pack_property(Pack, Property) :-
 2703    findall(Pack-Property, pack_property_(Pack, Property), List),
 2704    member(Pack-Property, List).            % make det if applicable
 2705
 2706pack_property_(Pack, Property) :-
 2707    pack_info(Pack, _, Property).
 2708pack_property_(Pack, Property) :-
 2709    \+ \+ info_file(Property, _),
 2710    '$pack':pack(Pack, BaseDir),
 2711    access_file(BaseDir, read),
 2712    directory_files(BaseDir, Files),
 2713    member(File, Files),
 2714    info_file(Property, Pattern),
 2715    downcase_atom(File, Pattern),
 2716    directory_file_path(BaseDir, File, InfoFile),
 2717    arg(1, Property, InfoFile).
 2718
 2719info_file(readme(_), 'readme.txt').
 2720info_file(readme(_), 'readme').
 2721info_file(todo(_),   'todo.txt').
 2722info_file(todo(_),   'todo').
 2723
 2724
 2725                 /*******************************
 2726                 *         VERSION LOGIC        *
 2727                 *******************************/
 2728
 2729%!  pack_version_file(-Pack, -Version:atom, +File) is semidet.
 2730%
 2731%   True if File is the  name  of  a   file  or  URL  of a file that
 2732%   contains Pack at Version. File must   have  an extension and the
 2733%   basename  must  be  of   the    form   <pack>-<n>{.<m>}*.  E.g.,
 2734%   =|mypack-1.5|=.
 2735
 2736pack_version_file(Pack, Version, GitHubRelease) :-
 2737    atomic(GitHubRelease),
 2738    github_release_url(GitHubRelease, Pack, Version),
 2739    !.
 2740pack_version_file(Pack, Version, Path) :-
 2741    atomic(Path),
 2742    file_base_name(Path, File),
 2743    no_int_file_name_extension(Base, _Ext, File),
 2744    atom_codes(Base, Codes),
 2745    (   phrase(pack_version(Pack, Version), Codes),
 2746        safe_pack_name(Pack)
 2747    ->  true
 2748    ).
 2749
 2750no_int_file_name_extension(Base, Ext, File) :-
 2751    file_name_extension(Base0, Ext0, File),
 2752    \+ atom_number(Ext0, _),
 2753    !,
 2754    Base = Base0,
 2755    Ext = Ext0.
 2756no_int_file_name_extension(File, '', File).
 2757
 2758%!  safe_pack_name(+Name:atom) is semidet.
 2759%
 2760%   Verifies that Name is a valid   pack  name. This avoids trickery
 2761%   with pack file names to make shell commands behave unexpectly.
 2762
 2763safe_pack_name(Name) :-
 2764    atom_length(Name, Len),
 2765    Len >= 3,                               % demand at least three length
 2766    atom_codes(Name, Codes),
 2767    maplist(safe_pack_char, Codes),
 2768    !.
 2769
 2770safe_pack_char(C) :- between(0'a, 0'z, C), !.
 2771safe_pack_char(C) :- between(0'A, 0'Z, C), !.
 2772safe_pack_char(C) :- between(0'0, 0'9, C), !.
 2773safe_pack_char(0'_).
 2774
 2775%!  pack_version(-Pack:atom, -Version:atom)// is semidet.
 2776%
 2777%   True when the input statifies <pack>-<version>
 2778
 2779pack_version(Pack, Version) -->
 2780    string(Codes), "-",
 2781    version(Parts),
 2782    !,
 2783    { atom_codes(Pack, Codes),
 2784      atomic_list_concat(Parts, '.', Version)
 2785    }.
 2786
 2787version([H|T]) -->
 2788    version_part(H),
 2789    (   "."
 2790    ->  version(T)
 2791    ;   {T=[]}
 2792    ).
 2793
 2794version_part(*) --> "*", !.
 2795version_part(Int) --> integer(Int).
 2796
 2797
 2798		 /*******************************
 2799		 *           GIT LOGIC		*
 2800		 *******************************/
 2801
 2802have_git :-
 2803    process_which(path(git), _).
 2804
 2805
 2806%!  git_url(+URL, -Pack) is semidet.
 2807%
 2808%   True if URL describes a git url for Pack
 2809
 2810git_url(URL, Pack) :-
 2811    uri_components(URL, Components),
 2812    uri_data(scheme, Components, Scheme),
 2813    nonvar(Scheme),                         % must be full URL
 2814    uri_data(path, Components, Path),
 2815    (   Scheme == git
 2816    ->  true
 2817    ;   git_download_scheme(Scheme),
 2818        file_name_extension(_, git, Path)
 2819    ;   git_download_scheme(Scheme),
 2820        catch(git_ls_remote(URL, _, [refs(['HEAD']), error(_)]), _, fail)
 2821    ->  true
 2822    ),
 2823    file_base_name(Path, PackExt),
 2824    (   file_name_extension(Pack, git, PackExt)
 2825    ->  true
 2826    ;   Pack = PackExt
 2827    ),
 2828    (   safe_pack_name(Pack)
 2829    ->  true
 2830    ;   domain_error(pack_name, Pack)
 2831    ).
 2832
 2833git_download_scheme(http).
 2834git_download_scheme(https).
 2835
 2836%!  github_release_url(+URL, -Pack, -Version:atom) is semidet.
 2837%
 2838%   True when URL is the URL of a GitHub release.  Such releases are
 2839%   accessible as
 2840%
 2841%       https:/github.com/<owner>/<pack>/archive/[vV]?<version>.zip'
 2842
 2843github_release_url(URL, Pack, Version) :-
 2844    uri_components(URL, Components),
 2845    uri_data(authority, Components, 'github.com'),
 2846    uri_data(scheme, Components, Scheme),
 2847    download_scheme(Scheme),
 2848    uri_data(path, Components, Path),
 2849    github_archive_path(Archive,Pack,File),
 2850    atomic_list_concat(Archive, /, Path),
 2851    file_name_extension(Tag, Ext, File),
 2852    github_archive_extension(Ext),
 2853    tag_version(Tag, Version),
 2854    !.
 2855
 2856github_archive_path(['',_User,Pack,archive,File],Pack,File).
 2857github_archive_path(['',_User,Pack,archive,refs,tags,File],Pack,File).
 2858
 2859github_archive_extension(tgz).
 2860github_archive_extension(zip).
 2861
 2862%!  tag_version(+GitTag, -Version) is semidet.
 2863%
 2864%   True when a GIT tag describes version Version.  GitTag must
 2865%   satisfy ``[vV]?int(\.int)*``.
 2866
 2867tag_version(Tag, Version) :-
 2868    version_tag_prefix(Prefix),
 2869    atom_concat(Prefix, Version, Tag),
 2870    is_version(Version).
 2871
 2872version_tag_prefix(v).
 2873version_tag_prefix('V').
 2874version_tag_prefix('').
 2875
 2876
 2877%!  git_archive_url(+URL, -Archive, +Options) is semidet.
 2878%
 2879%   If we do not have git installed, some git services offer downloading
 2880%   the code as  an  archive  using   HTTP.  This  predicate  makes this
 2881%   translation.
 2882
 2883git_archive_url(URL, Archive, Options) :-
 2884    uri_components(URL, Components),
 2885    uri_data(authority, Components, 'github.com'),
 2886    uri_data(path, Components, Path),
 2887    atomic_list_concat(['', User, RepoGit], /, Path),
 2888    $,
 2889    remove_git_ext(RepoGit, Repo),
 2890    git_archive_version(Version, Options),
 2891    atomic_list_concat(['', User, Repo, zip, Version], /, ArchivePath),
 2892    uri_edit([ path(ArchivePath),
 2893               host('codeload.github.com')
 2894             ],
 2895             URL, Archive).
 2896git_archive_url(URL, _, _) :-
 2897    print_message(error, pack(no_git(URL))),
 2898    fail.
 2899
 2900remove_git_ext(RepoGit, Repo) :-
 2901    file_name_extension(Repo, git, RepoGit),
 2902    !.
 2903remove_git_ext(Repo, Repo).
 2904
 2905git_archive_version(Version, Options) :-
 2906    option(commit(Version), Options),
 2907    !.
 2908git_archive_version(Version, Options) :-
 2909    option(branch(Version), Options),
 2910    !.
 2911git_archive_version(Version, Options) :-
 2912    option(version(Version), Options),
 2913    !.
 2914git_archive_version('HEAD', _).
 2915
 2916                 /*******************************
 2917                 *       QUERY CENTRAL DB       *
 2918                 *******************************/
 2919
 2920%!  publish_download(+Infos, +Options) is semidet.
 2921%!  register_downloads(+Infos, +Options) is det.
 2922%
 2923%   Register our downloads with the  pack server. The publish_download/2
 2924%   version is used to  register  a   specific  pack  after successfully
 2925%   installing the pack.  In this scenario, we
 2926%
 2927%     1. call register_downloads/2 with publish(Pack) that must be
 2928%        a no-op.
 2929%     2. build and test the pack
 2930%     3. call publish_download/2, which calls register_downloads/2
 2931%        after replacing publish(Pack) by do_publish(Pack).
 2932
 2933register_downloads(_, Options) :-
 2934    option(register(false), Options),
 2935    !.
 2936register_downloads(_, Options) :-
 2937    option(publish(_), Options),
 2938    !.
 2939register_downloads(Infos, Options) :-
 2940    convlist(download_data, Infos, Data),
 2941    (   Data == []
 2942    ->  true
 2943    ;   query_pack_server(downloaded(Data), Reply, Options),
 2944        (   option(do_publish(Pack), Options)
 2945        ->  (   member(Info, Infos),
 2946                Info.pack == Pack
 2947            ->  true
 2948            ),
 2949            (   Reply = true(Actions),
 2950                memberchk(Pack-Result, Actions)
 2951            ->  (   registered(Result)
 2952                ->  print_message(informational, pack(published(Info, Result)))
 2953                ;   print_message(error, pack(publish_failed(Info, Result))),
 2954                    fail
 2955                )
 2956            ;   print_message(error, pack(publish_failed(Info, false)))
 2957            )
 2958        ;   true
 2959        )
 2960    ).
 2961
 2962registered(git(_URL)).
 2963registered(file(_URL)).
 2964
 2965publish_download(Infos, Options) :-
 2966    select_option(publish(Pack), Options, Options1),
 2967    !,
 2968    register_downloads(Infos, [do_publish(Pack)|Options1]).
 2969publish_download(_Infos, _Options).
 2970
 2971%!  download_data(+Info, -Data) is semidet.
 2972%
 2973%   If we downloaded and installed Info, unify Data with the information
 2974%   that we share with the pack registry. That is a term
 2975%
 2976%       download(URL, Hash, Metadata).
 2977%
 2978%   Where URL is location of the GIT   repository or URL of the download
 2979%   archive. Hash is either the  GIT  commit   hash  or  the SHA1 of the
 2980%   archive file.
 2981
 2982download_data(Info, Data),
 2983    Info.get(git) == true =>                % Git clone
 2984    Data = download(URL, Hash, Metadata),
 2985    URL = Info.get(downloaded),
 2986    pack_git_info(Info.installed, Hash, Metadata).
 2987download_data(Info, Data),
 2988    _{git_url:URL,hash:Hash} :< Info, Hash \== (-) =>
 2989    Data = download(URL, Hash, Metadata),   % Git downloaded as zip
 2990    dir_metadata(Info.installed, Metadata).
 2991download_data(Info, Data) =>                % Archive download.
 2992    Data = download(URL, Hash, Metadata),
 2993    URL = Info.get(downloaded),
 2994    download_url(URL),
 2995    pack_status_dir(Info.installed, archive(Archive, URL)),
 2996    file_sha1(Archive, Hash),
 2997    pack_archive_info(Archive, _Pack, Metadata, _).
 2998
 2999%!  query_pack_server(+Query, -Result, +Options)
 3000%
 3001%   Send a Prolog query  to  the   package  server  and  process its
 3002%   results.
 3003
 3004query_pack_server(Query, Result, Options) :-
 3005    (   option(server(ServerOpt), Options)
 3006    ->  server_url(ServerOpt, ServerBase)
 3007    ;   setting(server, ServerBase),
 3008        ServerBase \== ''
 3009    ),
 3010    atom_concat(ServerBase, query, Server),
 3011    format(codes(Data), '~q.~n', Query),
 3012    info_level(Informational, Options),
 3013    print_message(Informational, pack(contacting_server(Server))),
 3014    setup_call_cleanup(
 3015        http_open(Server, In,
 3016                  [ post(codes(application/'x-prolog', Data)),
 3017                    header(content_type, ContentType)
 3018                  ]),
 3019        read_reply(ContentType, In, Result),
 3020        close(In)),
 3021    message_severity(Result, Level, Informational),
 3022    print_message(Level, pack(server_reply(Result))).
 3023
 3024server_url(URL0, URL) :-
 3025    uri_components(URL0, Components),
 3026    uri_data(scheme, Components, Scheme),
 3027    var(Scheme),
 3028    !,
 3029    atom_concat('https://', URL0, URL1),
 3030    server_url(URL1, URL).
 3031server_url(URL0, URL) :-
 3032    uri_components(URL0, Components),
 3033    uri_data(path, Components, ''),
 3034    !,
 3035    uri_edit([path('/pack/')], URL0, URL).
 3036server_url(URL, URL).
 3037
 3038read_reply(ContentType, In, Result) :-
 3039    sub_atom(ContentType, 0, _, _, 'application/x-prolog'),
 3040    !,
 3041    set_stream(In, encoding(utf8)),
 3042    read(In, Result).
 3043read_reply(ContentType, In, _Result) :-
 3044    read_string(In, 500, String),
 3045    print_message(error, pack(no_prolog_response(ContentType, String))),
 3046    fail.
 3047
 3048info_level(Level, Options) :-
 3049    option(silent(true), Options),
 3050    !,
 3051    Level = silent.
 3052info_level(informational, _).
 3053
 3054message_severity(true(_), Informational, Informational).
 3055message_severity(false, warning, _).
 3056message_severity(exception(_), error, _).
 3057
 3058
 3059                 /*******************************
 3060                 *        WILDCARD URIs         *
 3061                 *******************************/
 3062
 3063%!  available_download_versions(+URL, -Versions:list(atom), +Options) is det.
 3064%
 3065%   Deal with wildcard URLs, returning a  list of Version-URL pairs,
 3066%   sorted by version.
 3067%
 3068%   @tbd    Deal with protocols other than HTTP
 3069
 3070available_download_versions(URL, Versions, _Options) :-
 3071    wildcard_pattern(URL),
 3072    github_url(URL, User, Repo),            % demands https
 3073    !,
 3074    findall(Version-VersionURL,
 3075            github_version(User, Repo, Version, VersionURL),
 3076            Versions).
 3077available_download_versions(URL0, Versions, Options) :-
 3078    wildcard_pattern(URL0),
 3079    !,
 3080    hsts(URL0, URL, Options),
 3081    file_directory_name(URL, DirURL0),
 3082    ensure_slash(DirURL0, DirURL),
 3083    print_message(informational, pack(query_versions(DirURL))),
 3084    setup_call_cleanup(
 3085        http_open(DirURL, In, []),
 3086        load_html(stream(In), DOM,
 3087                  [ syntax_errors(quiet)
 3088                  ]),
 3089        close(In)),
 3090    findall(MatchingURL,
 3091            absolute_matching_href(DOM, URL, MatchingURL),
 3092            MatchingURLs),
 3093    (   MatchingURLs == []
 3094    ->  print_message(warning, pack(no_matching_urls(URL)))
 3095    ;   true
 3096    ),
 3097    versioned_urls(MatchingURLs, VersionedURLs),
 3098    sort_version_pairs(VersionedURLs, Versions),
 3099    print_message(informational, pack(found_versions(Versions))).
 3100available_download_versions(URL, [Version-URL], _Options) :-
 3101    (   pack_version_file(_Pack, Version0, URL)
 3102    ->  Version = Version0
 3103    ;   Version = '0.0.0'
 3104    ).
 3105
 3106%!  sort_version_pairs(+Pairs, -Sorted) is det.
 3107%
 3108%   Sort a list of Version-Data by decreasing version.
 3109
 3110sort_version_pairs(Pairs, Sorted) :-
 3111    map_list_to_pairs(version_pair_sort_key_, Pairs, Keyed),
 3112    sort(1, @>=, Keyed, SortedKeyed),
 3113    pairs_values(SortedKeyed, Sorted).
 3114
 3115version_pair_sort_key_(Version-_Data, Key) :-
 3116    version_sort_key(Version, Key).
 3117
 3118version_sort_key(Version, Key) :-
 3119    split_string(Version, ".", "", Parts),
 3120    maplist(number_string, Key, Parts),
 3121    !.
 3122version_sort_key(Version, _) :-
 3123    domain_error(version, Version).
 3124
 3125%!  github_url(+URL, -User, -Repo) is semidet.
 3126%
 3127%   True when URL refers to a github repository.
 3128
 3129github_url(URL, User, Repo) :-
 3130    uri_components(URL, uri_components(https,'github.com',Path,_,_)),
 3131    atomic_list_concat(['',User,Repo|_], /, Path).
 3132
 3133
 3134%!  github_version(+User, +Repo, -Version, -VersionURI) is nondet.
 3135%
 3136%   True when Version is a release version and VersionURI is the
 3137%   download location for the zip file.
 3138
 3139github_version(User, Repo, Version, VersionURI) :-
 3140    atomic_list_concat(['',repos,User,Repo,tags], /, Path1),
 3141    uri_components(ApiUri, uri_components(https,'api.github.com',Path1,_,_)),
 3142    setup_call_cleanup(
 3143      http_open(ApiUri, In,
 3144                [ request_header('Accept'='application/vnd.github.v3+json')
 3145                ]),
 3146      json_read_dict(In, Dicts),
 3147      close(In)),
 3148    member(Dict, Dicts),
 3149    atom_string(Tag, Dict.name),
 3150    tag_version(Tag, Version),
 3151    atom_string(VersionURI, Dict.zipball_url).
 3152
 3153wildcard_pattern(URL) :- sub_atom(URL, _, _, _, *).
 3154wildcard_pattern(URL) :- sub_atom(URL, _, _, _, ?).
 3155
 3156ensure_slash(Dir, DirS) :-
 3157    (   sub_atom(Dir, _, _, 0, /)
 3158    ->  DirS = Dir
 3159    ;   atom_concat(Dir, /, DirS)
 3160    ).
 3161
 3162remove_slash(Dir0, Dir) :-
 3163    Dir0 \== '/',
 3164    atom_concat(Dir1, /, Dir0),
 3165    !,
 3166    remove_slash(Dir1, Dir).
 3167remove_slash(Dir, Dir).
 3168
 3169absolute_matching_href(DOM, Pattern, Match) :-
 3170    xpath(DOM, //a(@href), HREF),
 3171    uri_normalized(HREF, Pattern, Match),
 3172    wildcard_match(Pattern, Match).
 3173
 3174versioned_urls([], []).
 3175versioned_urls([H|T0], List) :-
 3176    file_base_name(H, File),
 3177    (   pack_version_file(_Pack, Version, File)
 3178    ->  List = [Version-H|T]
 3179    ;   List = T
 3180    ),
 3181    versioned_urls(T0, T).
 3182
 3183
 3184                 /*******************************
 3185                 *          DEPENDENCIES        *
 3186                 *******************************/
 3187
 3188%!  pack_provides(?Pack, -Provides) is multi.
 3189%!  pack_requires(?Pack, -Requires) is nondet.
 3190%!  pack_conflicts(?Pack, -Conflicts) is nondet.
 3191%
 3192%   Provide logical access to pack dependency relations.
 3193
 3194pack_provides(Pack, Pack@Version) :-
 3195    current_pack(Pack),
 3196    once(pack_info(Pack, version, version(Version))).
 3197pack_provides(Pack, Provides) :-
 3198    findall(Prv, pack_info(Pack, dependency, provides(Prv)), PrvList),
 3199    member(Provides, PrvList).
 3200
 3201pack_requires(Pack, Requires) :-
 3202    current_pack(Pack),
 3203    findall(Req, pack_info(Pack, dependency, requires(Req)), ReqList),
 3204    member(Requires, ReqList).
 3205
 3206pack_conflicts(Pack, Conflicts) :-
 3207    current_pack(Pack),
 3208    findall(Cfl, pack_info(Pack, dependency, conflicts(Cfl)), CflList),
 3209    member(Conflicts, CflList).
 3210
 3211%!  pack_depends_on(?Pack, ?Dependency) is nondet.
 3212%
 3213%   True when Pack depends on pack   Dependency. This predicate does not
 3214%   deal with transitive dependency.
 3215
 3216pack_depends_on(Pack, Dependency) :-
 3217    ground(Pack),
 3218    !,
 3219    pack_requires(Pack, Requires),
 3220    \+ is_prolog_token(Requires),
 3221    pack_provides(Dependency, Provides),
 3222    satisfies_req(Provides, Requires).
 3223pack_depends_on(Pack, Dependency) :-
 3224    ground(Dependency),
 3225    !,
 3226    pack_provides(Dependency, Provides),
 3227    pack_requires(Pack, Requires),
 3228    satisfies_req(Provides, Requires).
 3229pack_depends_on(Pack, Dependency) :-
 3230    current_pack(Pack),
 3231    pack_depends_on(Pack, Dependency).
 3232
 3233%!  dependents(+Pack, -Dependents) is semidet.
 3234%
 3235%   True when Dependents is a list of  packs that (indirectly) depend on
 3236%   Pack.
 3237
 3238dependents(Pack, Deps) :-
 3239    setof(Dep, dependent(Pack, Dep, []), Deps).
 3240
 3241dependent(Pack, Dep, Seen) :-
 3242    pack_depends_on(Dep0, Pack),
 3243    \+ memberchk(Dep0, Seen),
 3244    (   Dep = Dep0
 3245    ;   dependent(Dep0, Dep, [Dep0|Seen])
 3246    ).
 3247
 3248%!  validate_dependencies is det.
 3249%
 3250%   Validate all dependencies, reporting on failures
 3251
 3252validate_dependencies :-
 3253    setof(Issue, pack_dependency_issue(_, Issue), Issues),
 3254    !,
 3255    print_message(warning, pack(dependency_issues(Issues))).
 3256validate_dependencies.
 3257
 3258%!  pack_dependency_issue(?Pack, -Issue) is nondet.
 3259%
 3260%   True when Issue is a dependency issue   regarding Pack. Issue is one
 3261%   of
 3262%
 3263%     - unsatisfied(Pack, Requires)
 3264%       The requirement Requires of Pack is not fulfilled.
 3265%     - conflicts(Pack, Conflict)
 3266%       Pack conflicts with Conflict.
 3267
 3268pack_dependency_issue(Pack, Issue) :-
 3269    current_pack(Pack),
 3270    pack_dependency_issue_(Pack, Issue).
 3271
 3272pack_dependency_issue_(Pack, unsatisfied(Pack, Requires)) :-
 3273    pack_requires(Pack, Requires),
 3274    (   is_prolog_token(Requires)
 3275    ->  \+ prolog_satisfies(Requires)
 3276    ;   \+ ( pack_provides(_, Provides),
 3277             satisfies_req(Provides, Requires) )
 3278    ).
 3279pack_dependency_issue_(Pack, conflicts(Pack, Conflicts)) :-
 3280    pack_conflicts(Pack, Conflicts),
 3281    (   is_prolog_token(Conflicts)
 3282    ->  prolog_satisfies(Conflicts)
 3283    ;   pack_provides(_, Provides),
 3284        satisfies_req(Provides, Conflicts)
 3285    ).
 3286
 3287
 3288		 /*******************************
 3289		 *      RECORD PACK FACTS	*
 3290		 *******************************/
 3291
 3292%!  pack_assert(+PackDir, ++Fact) is det.
 3293%
 3294%   Add/update  a  fact  about  packs.  These    facts   are  stored  in
 3295%   PackDir/status.db. Known facts are:
 3296%
 3297%     - built(Arch, Version, How)
 3298%       Pack has been built by SWI-Prolog Version for Arch.  How is one
 3299%       of `built` if we built it or `downloaded` if it was downloaded.
 3300%     - automatic(Boolean)
 3301%       If `true`, pack was installed as dependency.
 3302%     - archive(Archive, URL)
 3303%       Available when the pack was installed by unpacking Archive that
 3304%       was retrieved from URL.
 3305
 3306pack_assert(PackDir, Fact) :-
 3307    must_be(ground, Fact),
 3308    findall(Term, pack_status_dir(PackDir, Term), Facts0),
 3309    update_facts(Facts0, Fact, Facts),
 3310    OpenOptions = [encoding(utf8), lock(exclusive)],
 3311    status_file(PackDir, StatusFile),
 3312    (   Facts == Facts0
 3313    ->  true
 3314    ;   Facts0 \== [],
 3315        append(Facts0, New, Facts)
 3316    ->  setup_call_cleanup(
 3317            open(StatusFile, append, Out, OpenOptions),
 3318            maplist(write_fact(Out), New),
 3319            close(Out))
 3320    ;   setup_call_cleanup(
 3321            open(StatusFile, write, Out, OpenOptions),
 3322            ( write_facts_header(Out),
 3323              maplist(write_fact(Out), Facts)
 3324            ),
 3325            close(Out))
 3326    ).
 3327
 3328update_facts([], Fact, [Fact]) :-
 3329    !.
 3330update_facts([H|T], Fact, [Fact|T]) :-
 3331    general_pack_fact(Fact, GenFact),
 3332    general_pack_fact(H, GenTerm),
 3333    GenFact =@= GenTerm,
 3334    !.
 3335update_facts([H|T0], Fact, [H|T]) :-
 3336    update_facts(T0, Fact, T).
 3337
 3338general_pack_fact(built(Arch, _Version, _How), General) =>
 3339    General = built(Arch, _, _).
 3340general_pack_fact(Term, General), compound(Term) =>
 3341    compound_name_arity(Term, Name, Arity),
 3342    compound_name_arity(General, Name, Arity).
 3343general_pack_fact(Term, General) =>
 3344    General = Term.
 3345
 3346write_facts_header(Out) :-
 3347    format(Out, '% Fact status file.  Managed by package manager.~n', []).
 3348
 3349write_fact(Out, Term) :-
 3350    format(Out, '~q.~n', [Term]).
 3351
 3352%!  pack_status(?Pack, ?Fact).
 3353%!  pack_status_dir(+PackDir, ?Fact)
 3354%
 3355%   True when Fact is true about the package in PackDir.  Facts
 3356%   are asserted a file `status.db`.
 3357
 3358pack_status(Pack, Fact) :-
 3359    current_pack(Pack, PackDir),
 3360    pack_status_dir(PackDir, Fact).
 3361
 3362pack_status_dir(PackDir, Fact) :-
 3363    det_if(ground(Fact), pack_status_(PackDir, Fact)).
 3364
 3365pack_status_(PackDir, Fact) :-
 3366    status_file(PackDir, StatusFile),
 3367    catch(term_in_file(valid_term(pack_status_term), StatusFile, Fact),
 3368          error(existence_error(source_sink, StatusFile), _),
 3369          fail).
 3370
 3371pack_status_term(built(atom, version, oneof([built,downloaded]))).
 3372pack_status_term(automatic(boolean)).
 3373pack_status_term(archive(atom, atom)).
 3374
 3375
 3376%!  update_automatic(+Info) is det.
 3377%
 3378%   Update the _automatic_ status of a package.  If we install it has no
 3379%   automatic status and we install it  as   a  dependency we mark it as
 3380%   _automatic_. Else, we mark  it  as   non-automatic  as  it  has been
 3381%   installed explicitly.
 3382
 3383update_automatic(Info) :-
 3384    _ = Info.get(dependency_for),
 3385    \+ pack_status(Info.installed, automatic(_)),
 3386    !,
 3387    pack_assert(Info.installed, automatic(true)).
 3388update_automatic(Info) :-
 3389    pack_assert(Info.installed, automatic(false)).
 3390
 3391status_file(PackDir, StatusFile) :-
 3392    directory_file_path(PackDir, 'status.db', StatusFile).
 3393
 3394                 /*******************************
 3395                 *        USER INTERACTION      *
 3396                 *******************************/
 3397
 3398:- multifile prolog:message//1. 3399
 3400%!  menu(Question, +Alternatives, +Default, -Selection, +Options)
 3401
 3402menu(_Question, _Alternatives, Default, Selection, Options) :-
 3403    option(interactive(false), Options),
 3404    !,
 3405    Selection = Default.
 3406menu(Question, Alternatives, Default, Selection, _) :-
 3407    length(Alternatives, N),
 3408    between(1, 5, _),
 3409       print_message(query, Question),
 3410       print_menu(Alternatives, Default, 1),
 3411       print_message(query, pack(menu(select))),
 3412       read_selection(N, Choice),
 3413    !,
 3414    (   Choice == default
 3415    ->  Selection = Default
 3416    ;   nth1(Choice, Alternatives, Selection=_)
 3417    ->  true
 3418    ).
 3419
 3420print_menu([], _, _).
 3421print_menu([Value=Label|T], Default, I) :-
 3422    (   Value == Default
 3423    ->  print_message(query, pack(menu(default_item(I, Label))))
 3424    ;   print_message(query, pack(menu(item(I, Label))))
 3425    ),
 3426    I2 is I + 1,
 3427    print_menu(T, Default, I2).
 3428
 3429read_selection(Max, Choice) :-
 3430    get_single_char(Code),
 3431    (   answered_default(Code)
 3432    ->  Choice = default
 3433    ;   code_type(Code, digit(Choice)),
 3434        between(1, Max, Choice)
 3435    ->  true
 3436    ;   print_message(warning, pack(menu(reply(1,Max)))),
 3437        fail
 3438    ).
 3439
 3440%!  confirm(+Question, +Default, +Options) is semidet.
 3441%
 3442%   Ask for confirmation.
 3443%
 3444%   @arg Default is one of `yes`, `no` or `none`.
 3445
 3446confirm(_Question, Default, Options) :-
 3447    Default \== none,
 3448    option(interactive(false), Options, true),
 3449    !,
 3450    Default == yes.
 3451confirm(Question, Default, _) :-
 3452    between(1, 5, _),
 3453       print_message(query, pack(confirm(Question, Default))),
 3454       read_yes_no(YesNo, Default),
 3455    !,
 3456    format(user_error, '~N', []),
 3457    YesNo == yes.
 3458
 3459read_yes_no(YesNo, Default) :-
 3460    get_single_char(Code),
 3461    code_yes_no(Code, Default, YesNo),
 3462    !.
 3463
 3464code_yes_no(0'y, _, yes).
 3465code_yes_no(0'Y, _, yes).
 3466code_yes_no(0'n, _, no).
 3467code_yes_no(0'N, _, no).
 3468code_yes_no(_, none, _) :- !, fail.
 3469code_yes_no(C, Default, Default) :-
 3470    answered_default(C).
 3471
 3472answered_default(0'\r).
 3473answered_default(0'\n).
 3474answered_default(0'\s).
 3475
 3476
 3477                 /*******************************
 3478                 *            MESSAGES          *
 3479                 *******************************/
 3480
 3481:- multifile prolog:message//1. 3482
 3483prolog:message(pack(Message)) -->
 3484    message(Message).
 3485
 3486:- discontiguous
 3487    message//1,
 3488    label//1. 3489
 3490message(invalid_term(pack_info_term, Term)) -->
 3491    [ 'Invalid package meta data: ~q'-[Term] ].
 3492message(invalid_term(pack_status_term, Term)) -->
 3493    [ 'Invalid package status data: ~q'-[Term] ].
 3494message(directory_exists(Dir)) -->
 3495    [ 'Package target directory exists and is not empty:', nl,
 3496      '\t~q'-[Dir]
 3497    ].
 3498message(already_installed(pack(Pack, Version))) -->
 3499    [ 'Pack `~w'' is already installed @~w'-[Pack, Version] ].
 3500message(already_installed(Pack)) -->
 3501    [ 'Pack `~w'' is already installed. Package info:'-[Pack] ].
 3502message(kept_foreign(Pack, Arch)) -->
 3503    [ 'Found foreign libraries for architecture '-[],
 3504      ansi(code, '~q', [Arch]), nl,
 3505      'Use ', ansi(code, '?- pack_rebuild(~q).', [Pack]),
 3506      ' to rebuild from sources'-[]
 3507    ].
 3508message(no_pack_installed(Pack)) -->
 3509    [ 'No pack ~q installed.  Use ?- pack_list(Pattern) to search'-[Pack] ].
 3510message(dependency_issues(Issues)) -->
 3511    [ 'The current set of packs has dependency issues:', nl ],
 3512    dep_issues(Issues).
 3513message(depends(Pack, Deps)) -->
 3514    [ 'The following packs depend on `~w\':'-[Pack], nl ],
 3515    pack_list(Deps).
 3516message(remove(link(To), PackDir)) -->
 3517    [ 'Removing ', url(PackDir), nl, '    as link to ', url(To) ].
 3518message(remove(directory, PackDir)) -->
 3519    [ 'Removing ~q and contents'-[PackDir] ].
 3520message(remove_existing_pack(PackDir)) -->
 3521    [ 'Remove old installation in ~q'-[PackDir] ].
 3522message(delete_autoload_index(Pack, Index)) -->
 3523    [ 'Pack ' ], msg_pack(Pack), [ ': deleting autoload index ', url(Index) ].
 3524message(download_plan(Plan)) -->
 3525    [ ansi(bold, 'Installation plan:', []), nl ],
 3526    install_plan(Plan, Actions),
 3527    install_label(Actions).
 3528message(build_plan(Plan)) -->
 3529    [ ansi(bold, 'The following packs have post install scripts:', []), nl ],
 3530    msg_build_plan(Plan),
 3531    [ nl, ansi(bold, 'Run scripts?', []) ].
 3532message(autoload(Pack)) -->
 3533    [ 'Pack ' ], msg_pack(Pack),
 3534    [ ' prefers to be added as autoload library',
 3535      nl, ansi(bold, 'Allow?', [])
 3536    ].
 3537message(no_meta_data(BaseDir)) -->
 3538    [ 'Cannot find pack.pl inside directory ~q.  Not a package?'-[BaseDir] ].
 3539message(search_no_matches(Name)) -->
 3540    [ 'Search for "~w", returned no matching packages'-[Name] ].
 3541message(rebuild(Pack)) -->
 3542    [ 'Checking pack "~w" for rebuild ...'-[Pack] ].
 3543message(up_to_date([Pack])) -->
 3544    !,
 3545    [ 'Pack ' ], msg_pack(Pack), [' is up-to-date' ].
 3546message(up_to_date(Packs)) -->
 3547    [ 'Packs ' ], sequence(msg_pack, [', '], Packs), [' are up-to-date' ].
 3548message(installed_can_upgrade(List)) -->
 3549    sequence(msg_can_upgrade_target, [nl], List).
 3550message(new_dependencies(Deps)) -->
 3551    [ 'Found new dependencies after downloading (~p).'-[Deps], nl ].
 3552message(query_versions(URL)) -->
 3553    [ 'Querying "~w" to find new versions ...'-[URL] ].
 3554message(no_matching_urls(URL)) -->
 3555    [ 'Could not find any matching URL: ~q'-[URL] ].
 3556message(found_versions([Latest-_URL|More])) -->
 3557    { length(More, Len) },
 3558    [ '    Latest version: ~w (~D older)'-[Latest, Len] ].
 3559message(build(Pack, PackDir)) -->
 3560    [ ansi(bold, 'Building pack ~w in directory ~w', [Pack, PackDir]) ].
 3561message(contacting_server(Server)) -->
 3562    [ 'Contacting server at ~w ...'-[Server], flush ].
 3563message(server_reply(true(_))) -->
 3564    [ at_same_line, ' ok'-[] ].
 3565message(server_reply(false)) -->
 3566    [ at_same_line, ' done'-[] ].
 3567message(server_reply(exception(E))) -->
 3568    [ 'Server reported the following error:'-[], nl ],
 3569    '$messages':translate_message(E).
 3570message(cannot_create_dir(Alias)) -->
 3571    { findall(PackDir,
 3572              absolute_file_name(Alias, PackDir, [solutions(all)]),
 3573              PackDirs0),
 3574      sort(PackDirs0, PackDirs)
 3575    },
 3576    [ 'Cannot find a place to create a package directory.'-[],
 3577      'Considered:'-[]
 3578    ],
 3579    candidate_dirs(PackDirs).
 3580message(conflict(version, [PackV, FileV])) -->
 3581    ['Version mismatch: pack.pl: '-[]], msg_version(PackV),
 3582    [', file claims version '-[]], msg_version(FileV).
 3583message(conflict(name, [PackInfo, FileInfo])) -->
 3584    ['Pack ~w mismatch: pack.pl: ~p'-[PackInfo]],
 3585    [', file claims ~w: ~p'-[FileInfo]].
 3586message(no_prolog_response(ContentType, String)) -->
 3587    [ 'Expected Prolog response.  Got content of type ~p'-[ContentType], nl,
 3588      '~s'-[String]
 3589    ].
 3590message(download(begin, Pack, _URL, _DownloadFile)) -->
 3591    [ 'Downloading ' ], msg_pack(Pack), [ ' ... ', flush ].
 3592message(download(end, _, _, File)) -->
 3593    { size_file(File, Bytes) },
 3594    [ at_same_line, '~D bytes'-[Bytes] ].
 3595message(no_git(URL)) -->
 3596    [ 'Cannot install from git repository ', url(URL), '.', nl,
 3597      'Cannot find git program and do not know how to download the code', nl,
 3598      'from this git service.  Please install git and retry.'
 3599    ].
 3600message(git_no_https(GitURL)) -->
 3601    [ 'Do not know how to get an HTTP(s) URL for ', url(GitURL) ].
 3602message(git_branch_not_default(Dir, Default, Current)) -->
 3603    [ 'GIT current branch on ', url(Dir), ' is not default.', nl,
 3604      '  Current branch: ', ansi(code, '~w', [Current]),
 3605      ' default: ', ansi(code, '~w', [Default])
 3606    ].
 3607message(git_not_clean(Dir)) -->
 3608    [ 'GIT working directory is dirty: ', url(Dir), nl,
 3609      'Your repository must be clean before publishing.'
 3610    ].
 3611message(git_push) -->
 3612    [ 'Push release to GIT origin?' ].
 3613message(git_tag(Tag)) -->
 3614    [ 'Tag repository with release tag ', ansi(code, '~w', [Tag]) ].
 3615message(git_release_tag_not_at_head(Tag)) -->
 3616    [ 'Release tag ', ansi(code, '~w', [Tag]), ' is not at HEAD.', nl,
 3617      'If you want to update the tag, please run ',
 3618      ansi(code, 'git tag -d ~w', [Tag])
 3619    ].
 3620message(git_tag_out_of_sync(Tag)) -->
 3621    [ 'Release tag ', ansi(code, '~w', [Tag]),
 3622      ' differs from this tag at the origin'
 3623    ].
 3624
 3625message(published(Info, At)) -->
 3626    [ 'Published pack ' ], msg_pack(Info), msg_info_version(Info),
 3627    [' to be installed from '],
 3628    msg_published_address(At).
 3629message(publish_failed(Info, Reason)) -->
 3630    [ 'Pack ' ], msg_pack(Info), [ ' at version ~w'-[Info.version] ],
 3631    msg_publish_failed(Reason).
 3632
 3633msg_publish_failed(throw(error(permission_error(register,
 3634                                                pack(_),_URL),_))) -->
 3635    [ ' is already registered with a different URL'].
 3636msg_publish_failed(download) -->
 3637    [' was already published?'].
 3638msg_publish_failed(Status) -->
 3639    [ ' failed for unknown reason (~p)'-[Status] ].
 3640
 3641msg_published_address(git(URL)) -->
 3642    msg_url(URL, _).
 3643msg_published_address(file(URL)) -->
 3644    msg_url(URL, _).
 3645
 3646candidate_dirs([]) --> [].
 3647candidate_dirs([H|T]) --> [ nl, '    ~w'-[H] ], candidate_dirs(T).
 3648                                                % Questions
 3649message(resolve_remove) -->
 3650    [ nl, 'Please select an action:', nl, nl ].
 3651message(create_pack_dir) -->
 3652    [ nl, 'Create directory for packages', nl ].
 3653message(menu(item(I, Label))) -->
 3654    [ '~t(~d)~6|   '-[I] ],
 3655    label(Label).
 3656message(menu(default_item(I, Label))) -->
 3657    [ '~t(~d)~6| * '-[I] ],
 3658    label(Label).
 3659message(menu(select)) -->
 3660    [ nl, 'Your choice? ', flush ].
 3661message(confirm(Question, Default)) -->
 3662    message(Question),
 3663    confirm_default(Default),
 3664    [ flush ].
 3665message(menu(reply(Min,Max))) -->
 3666    (  { Max =:= Min+1 }
 3667    -> [ 'Please enter ~w or ~w'-[Min,Max] ]
 3668    ;  [ 'Please enter a number between ~w and ~w'-[Min,Max] ]
 3669    ).
 3670
 3671                                                % support predicates
 3672dep_issues(Issues) -->
 3673    sequence(dep_issue, [nl], Issues).
 3674
 3675dep_issue(unsatisfied(Pack, Requires)) -->
 3676    [ ' - Pack ' ], msg_pack(Pack), [' requires ~p'-[Requires]].
 3677dep_issue(conflicts(Pack, Conflict)) -->
 3678    [ ' - Pack ' ], msg_pack(Pack), [' conflicts with ~p'-[Conflict]].
 3679
 3680%!  install_plan(+Plan, -Actions)// is det.
 3681%!  install_label(+Actions)// is det.
 3682%
 3683%   Describe the overall installation plan before downloading.
 3684
 3685install_label([link]) -->
 3686    !,
 3687    [ ansi(bold, 'Activate pack?', []) ].
 3688install_label([unpack]) -->
 3689    !,
 3690    [ ansi(bold, 'Unpack archive?', []) ].
 3691install_label(_) -->
 3692    [ ansi(bold, 'Download packs?', []) ].
 3693
 3694
 3695install_plan(Plan, Actions) -->
 3696    install_plan(Plan, Actions, Sec),
 3697    sec_warning(Sec).
 3698
 3699install_plan([], [], _) -->
 3700    [].
 3701install_plan([H|T], [AH|AT], Sec) -->
 3702    install_step(H, AH, Sec), [nl],
 3703    install_plan(T, AT, Sec).
 3704
 3705install_step(Info, keep, _Sec) -->
 3706    { Info.get(keep) == true },
 3707    !,
 3708    [ '  Keep ' ], msg_pack(Info), [ ' at version ~w'-[Info.version] ],
 3709    msg_can_upgrade(Info).
 3710install_step(Info, Action, Sec) -->
 3711    { From = Info.get(upgrade),
 3712      VFrom = From.version,
 3713      VTo = Info.get(version),
 3714      (   cmp_versions(>=, VTo, VFrom)
 3715      ->  Label = ansi(bold,    '  Upgrade ',   [])
 3716      ;   Label = ansi(warning, '  Downgrade ', [])
 3717      )
 3718    },
 3719    [ Label ], msg_pack(Info),
 3720    [ ' from version ~w to ~w'- [From.version, Info.get(version)] ],
 3721    install_from(Info, Action, Sec).
 3722install_step(Info, Action, Sec) -->
 3723    { _From = Info.get(upgrade) },
 3724    [ '  Upgrade '  ], msg_pack(Info),
 3725    install_from(Info, Action, Sec).
 3726install_step(Info, Action, Sec) -->
 3727    { Dep = Info.get(dependency_for) },
 3728    [ '  Install ' ], msg_pack(Info),
 3729    [ ' at version ~w as dependency for '-[Info.version],
 3730      ansi(code, '~w', [Dep])
 3731    ],
 3732    install_from(Info, Action, Sec),
 3733    msg_downloads(Info).
 3734install_step(Info, Action, Sec) -->
 3735    { Info.get(commit) == 'HEAD' },
 3736    !,
 3737    [ '  Install ' ], msg_pack(Info), [ ' at current GIT HEAD'-[] ],
 3738    install_from(Info, Action, Sec),
 3739    msg_downloads(Info).
 3740install_step(Info, link, _Sec) -->
 3741    { Info.get(link) == true,
 3742      uri_file_name(Info.get(url), Dir)
 3743    },
 3744    !,
 3745    [ '  Install ' ], msg_pack(Info), [ ' as symlink to ', url(Dir) ].
 3746install_step(Info, Action, Sec) -->
 3747    [ '  Install ' ], msg_pack(Info), [ ' at version ~w'-[Info.get(version)] ],
 3748    install_from(Info, Action, Sec),
 3749    msg_downloads(Info).
 3750install_step(Info, Action, Sec) -->
 3751    [ '  Install ' ], msg_pack(Info),
 3752    install_from(Info, Action, Sec),
 3753    msg_downloads(Info).
 3754
 3755install_from(Info, download, Sec) -->
 3756    { download_url(Info.url) },
 3757    !,
 3758    [ ' from '  ], msg_url(Info.url, Sec).
 3759install_from(Info, unpack, Sec) -->
 3760    [ ' from '  ], msg_url(Info.url, Sec).
 3761
 3762msg_url(URL, unsafe) -->
 3763    { atomic(URL),
 3764      atom_concat('http://', Rest, URL)
 3765    },
 3766    [ ansi(error, '~w', ['http://']), '~w'-[Rest] ].
 3767msg_url(URL, _) -->
 3768    [ url(URL) ].
 3769
 3770sec_warning(Sec) -->
 3771    { var(Sec) },
 3772    !.
 3773sec_warning(unsafe) -->
 3774    [ ansi(warning, '  WARNING: The installation plan includes downloads \c
 3775                                from insecure HTTP servers.', []), nl
 3776    ].
 3777
 3778msg_downloads(Info) -->
 3779    { Downloads = Info.get(all_downloads),
 3780      Downloads > 0
 3781    },
 3782    [ ansi(comment, ' (downloaded ~D times)', [Downloads]) ],
 3783    !.
 3784msg_downloads(_) -->
 3785    [].
 3786
 3787msg_pack(Pack) -->
 3788    { atom(Pack) },
 3789    !,
 3790    [ ansi(code, '~w', [Pack]) ].
 3791msg_pack(Info) -->
 3792    msg_pack(Info.pack).
 3793
 3794msg_info_version(Info) -->
 3795    [ ansi(code, '@~w', [Info.get(version)]) ],
 3796    !.
 3797msg_info_version(_Info) -->
 3798    [].
 3799
 3800%!  msg_build_plan(+Plan)//
 3801%
 3802%   Describe the build plan before running the build steps.
 3803
 3804msg_build_plan(Plan) -->
 3805    sequence(build_step, [nl], Plan).
 3806
 3807build_step(Info) -->
 3808    [ '  Build ' ], msg_pack(Info), [' in directory ', url(Info.installed) ].
 3809
 3810msg_can_upgrade_target(Info) -->
 3811    [ '  Pack ' ], msg_pack(Info),
 3812    [ ' is installed at version ~w'-[Info.version] ],
 3813    msg_can_upgrade(Info).
 3814
 3815pack_list([]) --> [].
 3816pack_list([H|T]) -->
 3817    [ '    - Pack ' ],  msg_pack(H), [nl],
 3818    pack_list(T).
 3819
 3820label(remove_only(Pack)) -->
 3821    [ 'Only remove package ~w (break dependencies)'-[Pack] ].
 3822label(remove_deps(Pack, Deps)) -->
 3823    { length(Deps, Count) },
 3824    [ 'Remove package ~w and ~D dependencies'-[Pack, Count] ].
 3825label(create_dir(Dir)) -->
 3826    [ '~w'-[Dir] ].
 3827label(install_from(git(URL))) -->
 3828    !,
 3829    [ 'GIT repository at ~w'-[URL] ].
 3830label(install_from(URL)) -->
 3831    [ '~w'-[URL] ].
 3832label(cancel) -->
 3833    [ 'Cancel' ].
 3834
 3835confirm_default(yes) -->
 3836    [ ' Y/n? ' ].
 3837confirm_default(no) -->
 3838    [ ' y/N? ' ].
 3839confirm_default(none) -->
 3840    [ ' y/n? ' ].
 3841
 3842msg_version(Version) -->
 3843    [ '~w'-[Version] ].
 3844
 3845msg_can_upgrade(Info) -->
 3846    { Latest = Info.get(latest_version) },
 3847    [ ansi(warning, ' (can be upgraded to ~w)', [Latest]) ].
 3848msg_can_upgrade(_) -->
 3849    [].
 3850
 3851
 3852		 /*******************************
 3853		 *              MISC		*
 3854		 *******************************/
 3855
 3856local_uri_file_name(URL, FileName) :-
 3857    uri_file_name(URL, FileName),
 3858    !.
 3859local_uri_file_name(URL, FileName) :-
 3860    uri_components(URL, Components),
 3861    uri_data(scheme, Components, File), File == file,
 3862    uri_data(authority, Components, FileNameEnc),
 3863    uri_data(path, Components, ''),
 3864    uri_encoded(path, FileName, FileNameEnc).
 3865
 3866det_if(Cond, Goal) :-
 3867    (   Cond
 3868    ->  Goal,
 3869        !
 3870    ;   Goal
 3871    ).
 3872
 3873member_nonvar(_, Var) :-
 3874    var(Var),
 3875    !,
 3876    fail.
 3877member_nonvar(E, [E|_]).
 3878member_nonvar(E, [_|T]) :-
 3879    member_nonvar(E, T)