1/*  Part of ClioPatria SeRQL and SPARQL server
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2010-2018, University of Amsterdam,
    7                              VU University Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(cpack,
   37          [ cpack_install/1,            % +NameOrURL
   38            cpack_upgrade/0,
   39            cpack_upgrade/1,            % +Name
   40            cpack_remove/1,             % +Name
   41            cpack_remove/2,             % +Name, +Options
   42                                        % For creators
   43            cpack_create/3,             % +Name, +Title, +Options
   44            cpack_configure/1,          % +Name
   45                                        % Further API
   46            cpack_add_dir/2,            % +ConfigEnabled, +Directory
   47            cpack_register/3,           % +Name, +Dir, +Options
   48            current_cpack/1,            % ?Name
   49            cpack_property/2            % ?Name, ?Property
   50          ]).   51:- use_module(library(semweb/rdf_db)).   52:- use_module(library(semweb/rdfs)).   53:- use_module(library(semweb/rdf_library)).   54:- use_module(library(http/http_open)).   55:- use_module(library(uri)).   56:- use_module(library(lists)).   57:- use_module(library(git)).   58:- use_module(library(setup)).   59:- use_module(library(conf_d)).   60:- use_module(library(filesex)).   61:- use_module(library(settings)).   62:- use_module(library(error)).   63:- use_module(library(apply)).   64:- use_module(library(option)).   65
   66/** <module> The ClioPatria package manager
   67
   68*/
   69
   70:- setting(cpack:package_directory, atom, cpack,
   71           'Directory where packages are downloaded').   72:- setting(cpack:server, atom, 'http://cliopatria.swi-prolog.org/',
   73           'Address of the fallback server').   74
   75:- rdf_register_ns(cpack, 'http://cliopatria.swi-prolog.org/schema/cpack#').   76:- rdf_register_ns(foaf,  'http://xmlns.com/foaf/0.1/').   77
   78%!  cpack_install(+Install) is semidet.
   79%
   80%   Install package by name or URL. The URL  of a CPACK can be found
   81%   on  the  web-page  of  the  package.   If  a  *name*  is  given,
   82%   cpack_install/1 queries the configured servers  for the package.
   83%   For example:
   84%
   85%     ==
   86%     ?- cpack_install('EDM').
   87%     % Trying CPACK server at http://cliopatria.swi-prolog.org/cpack/EDM ...
   88%     % Installing package EDM:
   89%     %    EDM -- View Europeana Data Model
   90%     % Initialized empty Git repository in /home/jan/tmp/test/cpack/EDM/.git/
   91%     %     Installing EDM.pl ...
   92%     % /home/jan/tmp/test/config-enabled/010-packs.pl compiled into conf_packs 0.00 sec, 1,480 bytes
   93%     % Added the following config files:
   94%     %     /home/jan/tmp/test/config-enabled/010-packs.pl
   95%     %     /home/jan/tmp/test/config-enabled/EDM.pl
   96%     %   library(count) compiled into count 0.02 sec, 13,280 bytes
   97%     %  skin(EDM) compiled into edm 0.02 sec, 52,984 bytes
   98%     % /home/jan/tmp/test/config-enabled/EDM.pl compiled into conf_EDM 0.02 sec, 56,112 bytes
   99%     true.
  100%     ==
  101%
  102%   @see    http://cliopatria.swi-prolog.org is the central package
  103%           repository.
  104%   @param  Install is either a URL on the server that returns the
  105%           installation parameter (this is shown in the info box
  106%           of the package), or the name of a package or a list of
  107%           package names.
  108
  109cpack_install(URL) :-
  110    \+ is_list(URL),
  111    uri_is_global(URL),
  112    !,
  113    cpack_package_data(URL, Terms),
  114    cpack_install_terms(Terms).
  115cpack_install(Name) :-
  116    pack_data_url(Name, URL),
  117    print_message(informational, cpack(probe(URL))),
  118    catch(cpack_package_data(URL, Terms), E, true),
  119    (   var(E)
  120    ->  !, cpack_install_terms(Terms)
  121    ;   print_message(error, E),
  122        fail
  123    ).
  124
  125%!  pack_data_url(+NameOrNames, -URL) is nondet.
  126%
  127%   URL can be tried  to  obtain   information  about  the requested
  128%   packages.
  129
  130pack_data_url(Name, URL) :-
  131    cpack_load_profile,
  132    (   rdf_has(_, cpack:servers, List),
  133        rdfs_member(Server, List)
  134    ;   setting(cpack:server, Server)
  135    ),
  136    ensure_slash(Server, ServerDir),
  137    pack_data_url(ServerDir, Name, URL).
  138
  139pack_data_url(ServerDir, Names, URL) :-
  140    is_list(Names),
  141    !,
  142    maplist(pack_param, Names, Params),
  143    uri_query_components(Query, Params),
  144    atomic_list_concat([ServerDir, cpack, /?, Query], URL).
  145pack_data_url(ServerDir, Name, URL) :-
  146    atomic_list_concat([ServerDir, cpack, /, Name], URL).
  147
  148pack_param(Name, p(Name)).
  149
  150
  151ensure_slash(Server, ServerDir) :-
  152    (   sub_atom(Server, _, _, 0, /)
  153    ->  ServerDir = Server
  154    ;   atom_concat(Server, /, ServerDir)
  155    ).
  156
  157cpack_package_data(URL, Terms) :-
  158    setup_call_cleanup(http_open(URL, In, []),
  159                       read_stream_to_terms(In, Terms),
  160                       close(In)).
  161
  162read_stream_to_terms(In, Terms) :-
  163    read_term(In, Term0, []),
  164    read_stream_to_terms(Term0, In, Terms).
  165
  166read_stream_to_terms(end_of_file, _, []) :- !.
  167read_stream_to_terms(Term, In, [Term|T]) :-
  168    read_term(In, Term1, []),
  169    read_stream_to_terms(Term1, In, T).
  170
  171
  172%!  cpack_install_terms(+Terms) is det.
  173%
  174%   Install from the server reply.
  175
  176cpack_install_terms(Terms) :-
  177    (   Terms = [cpack(Name, Packages)]
  178    ->  print_message(informational, cpack(requires(Name, Packages))),
  179        maplist(package_status, Packages, Status),
  180        maplist(download_package, Status),
  181        maplist(configure_package, Packages)
  182    ;   Terms = [no_cpack(Name)]
  183    ->  existence_error(cpack, Name)
  184    ;   Terms = [error(Error)]
  185    ->  throw(Error)
  186    ;   domain_error(cpack_reply, Terms)
  187    ).
  188
  189%!  package_status(+CpackTerm, -Status)
  190%
  191%   @param  Status is a term cpack(Package, State), where State is
  192%           one of =no_change=, upgrade(Old, New) or =new=.
  193
  194package_status(cpack(Package, Options),
  195               cpack(Package, Options, Status)) :-
  196    cpack_package_dir(Package, Dir, false),
  197    directory_file_path(Dir, '.git', GitRepo),
  198    (   access_file(GitRepo, read)
  199    ->  option(branch(Branch), Options, master),
  200        atom_concat('origin/', Branch, Commit),
  201        git_describe(OldVersion, [directory(Dir)]),
  202        git([fetch, origin], [ directory(Dir) ]),
  203        git_describe(NewVersion, [directory(Dir),commit(Commit)]),
  204        (   OldVersion == NewVersion
  205        ->  Status = no_change(OldVersion)
  206        ;   Status = upgrade(OldVersion, NewVersion)
  207        )
  208    ;   Status = new
  209    ).
  210
  211download_package(cpack(Package, _, no_change(OldVersion))) :-
  212    !,
  213    print_message(informational, cpack(no_change(Package, OldVersion))).
  214download_package(cpack(Package, Options, upgrade(Old, New))) :-
  215    !,
  216    print_message(informational, cpack(upgrade(Package, Old, New))),
  217    option(branch(Branch), Options, master),
  218    cpack_package_dir(Package, Dir, false),
  219    atom_concat('origin/', Branch, Commit),
  220    git([merge, Commit],
  221        [ directory(Dir)
  222        ]).
  223download_package(cpack(Package, Options, new)) :-
  224    option(pack_repository(Repository), Options),
  225    print_message(informational, cpack(download(Package, Repository))),
  226    cpack_package_dir(Package, Dir, false),
  227    cpack_download(Repository, Dir).
  228
  229configure_package(cpack(Package, Options)) :-
  230    cpack_module_options(Options, ModuleOptions),
  231    cpack_configure(Package, ModuleOptions).
  232
  233cpack_module_options([], []).
  234cpack_module_options([H0|T0], [H|T]) :-
  235    cpack_module_option(H0, H),
  236    !,
  237    cpack_module_options(T0, T).
  238cpack_module_options([_|T0], T) :-
  239    cpack_module_options(T0, T).
  240
  241cpack_module_option(url(URL), home_url(URL)).
  242cpack_module_option(requires(Packages), requires(Packages)).
  243
  244
  245%!  cpack_download(+Repository, +TargetDir)
  246%
  247%   Download Repository to Dir.
  248%
  249%   @tbd    Branches, trust
  250
  251cpack_download(_Package, Dir) :-
  252    directory_file_path(Dir, '.git', GitRepo),
  253    exists_directory(GitRepo),
  254    !,
  255    git([pull],
  256        [ directory(Dir)
  257        ]).                         % Too simplistic
  258cpack_download(git(GitURL, Options), Dir) :-
  259    findall(O, git_clone_option(O, Options), LOL),
  260    append([ [clone, GitURL, Dir]
  261           | LOL
  262           ], GitOptions),
  263    git(GitOptions, []),
  264    setup_push_for_download(Dir).
  265
  266git_clone_option(['-b', Branch], Options) :-
  267    option(branch(Branch), Options).
  268
  269%!  setup_push_for_download(+Dir) is det.
  270%
  271%   If the downloaded repository can be   related to a push-location
  272%   based on the current profile,  we   setup  a  remote for pushing
  273%   changes.  This remote has tehe symbolic name =upload=.
  274%
  275%   @tbd    We can (and should) also verify whether the =upload= and
  276%           downloaded origin are at the same version.
  277
  278setup_push_for_download(Dir) :-
  279    file_base_name(Dir, Name),
  280    default_binding(default, Name, pushrepository(PushURL)),
  281    !,
  282    print_message(informational, cpack(probe_remote(PushURL))),
  283    catch(git(['ls-remote', '--heads', PushURL],
  284              [ output(_),
  285                error(_)
  286              ]),
  287          E, true),
  288    (   var(E)
  289    ->  print_message(informational, cpack(add_remote(upload, PushURL))),
  290        git([ remote, add, upload, PushURL],
  291            [ directory(Dir)
  292            ])
  293    ;   E = error(process_error(git(_), exit(_)), _)
  294    ->  true
  295    ;   print_message(error, E)
  296    ).
  297setup_push_for_download(_).
  298
  299
  300%!  cpack_upgrade
  301%
  302%   Upgrade all packages to the server versions.
  303
  304cpack_upgrade :-
  305    findall(Name, current_cpack(Name), Names),
  306    cpack_install(Names).
  307
  308%!  cpack_upgrade(Package)
  309%
  310%   Upgrade Package.  This is the same as cpack_install(Package).
  311
  312cpack_upgrade(Name) :-
  313    cpack_install(Name).
  314
  315%!  cpack_configure(+Name) is det.
  316%
  317%   Just configure a package.
  318
  319cpack_configure(Name) :-
  320    cpack_configure(Name, []).
  321
  322cpack_configure(Name, Options) :-
  323    cpack_package_dir(Name, Dir, false),
  324    !,
  325    exists_directory(Dir),
  326    (   conf_d_enabled(ConfigEnabled)
  327    ->  cpack_add_dir(ConfigEnabled, Dir, Options)
  328    ;   existence_error(directory, 'config-enabled')
  329    ).
  330cpack_configure(Name, _) :-
  331    existence_error(cpack, Name).
  332
  333
  334%!  cpack_add_dir(+ConfigEnable, +PackageDir)
  335%
  336%   Install package located in directory PackageDir.
  337%
  338%   @tbd    Register version-tracking with register_git_module/3.
  339
  340cpack_add_dir(ConfigEnable, Dir) :-
  341    cpack_add_dir(ConfigEnable, Dir, []).
  342
  343cpack_add_dir(ConfigEnable, Dir, Options) :-
  344    directory_file_path(ConfigEnable, '010-packs.pl', PacksFile),
  345    directory_file_path(Dir, 'config-available', ConfigAvailable),
  346    file_base_name(Dir, Pack),
  347    add_pack_to_search_path(PacksFile, Pack, Dir, Modified, Options),
  348    setup_default_config(ConfigEnable, ConfigAvailable, []),
  349    (   Modified == true            % Update paths first!
  350    ->  load_files(PacksFile, [if(true)])
  351    ;   true
  352    ),
  353    conf_d_reload.
  354
  355
  356%!  add_pack_to_search_path(+PackFile, +Pack, +Dir, -Modified,
  357%!                          +Options) is det.
  358%
  359%   Add a directive as  below  to   PackFile.  If  PackFile  already
  360%   contains a declaration for Pack   with different attributes, the
  361%   file is rewritten using the new attributes.
  362%
  363%     ==
  364%     :- cpack_register(Pack, Dir, Options).
  365%     ==
  366
  367add_pack_to_search_path(PackFile, Pack, Dir, Modified, Options) :-
  368    exists_file(PackFile),
  369    !,
  370    read_file_to_terms(PackFile, Terms, []),
  371    New = (:- cpack_register(Pack, Dir, Options)),
  372    (   memberchk(New, Terms)
  373    ->  Modified = false
  374    ;   Old = (:- cpack_register(Pack, _, _)),
  375        memberchk(Old, Terms)
  376    ->  selectchk(Old, Terms, New, Terms2),
  377        write_pack_register(PackFile, Terms2)
  378    ;   setup_call_cleanup(open(PackFile, append, Out),
  379                           extend_search_path(Out, Pack, Dir, Options),
  380                           close(Out)),
  381        Modified = true
  382    ).
  383add_pack_to_search_path(PackFile, Pack, Dir, true, Options) :-
  384    open(PackFile, write, Out),
  385    write_search_path_header(Out),
  386    extend_search_path(Out, Pack, Dir, Options),
  387    close(Out).
  388
  389write_pack_register(PackFile, Terms) :-
  390    setup_call_cleanup(open(PackFile, write, Out),
  391                       ( write_search_path_header(Out),
  392                         Templ = cpack_register(_, _, _),
  393                         forall(member((:-Templ), Terms),
  394                                format(Out, ':- ~q.~n', [Templ]))
  395                       ),
  396                       close(Out)).
  397
  398
  399write_search_path_header(Out) :-
  400    format(Out, '/* Generated file~n', []),
  401    format(Out, '   This file defines the search-path for added packs~n', []),
  402    format(Out, '*/~n~n', []),
  403    format(Out, ':- module(conf_packs, []).~n~n', []),
  404    format(Out, ':- multifile user:file_search_path/2.~n', []),
  405    format(Out, ':- dynamic user:file_search_path/2.~n', []),
  406    format(Out, ':- multifile cpack:registered_cpack/2.~n~n', []).
  407
  408extend_search_path(Out, Pack, Dir, Options) :-
  409    format(Out, ':- ~q.~n', [cpack_register(Pack, Dir, Options)]).
  410
  411
  412                 /*******************************
  413                 *            REMOVAL           *
  414                 *******************************/
  415
  416%!  cpack_remove(+Pack) is det.
  417%!  cpack_remove(+Pack, +Options) is det.
  418%
  419%   Remove CPACK Pack.  Processed options:
  420%
  421%     * force(Boolean)
  422%     If =true=, omit checking whether removing the package will
  423%     break dependencies.
  424%     * fake(true)
  425%     Print messages indicating what actions will be preformed, but
  426%     do not modify anything.
  427%
  428%   @tbd    Should we also try to unload all loaded files?
  429
  430cpack_remove(Name) :-
  431    cpack_remove(Name, []).
  432
  433cpack_remove(Name, Options) :-
  434    \+ option(force(true), Options),
  435    required_by(Name, Dependents),
  436    !,
  437    throw(error(cpack_error(cannot_remove(Name, Dependents)), _)).
  438cpack_remove(Name, Options) :-
  439    registered_cpack(Name, Dir, _Options),
  440    absolute_file_name(Dir, DirPath,
  441                       [ file_type(directory),
  442                         access(read)
  443                       ]),
  444    cpack_unregister(Name, Options),
  445    remove_config(DirPath, Options),
  446    remove_dir(DirPath, Options).
  447
  448required_by(Name, Dependents) :-
  449    setof(Dep, required_pack(Name, Dep), Dependents).
  450
  451required_pack(Name, Pack) :-
  452    registered_cpack(Pack, _, Options),
  453    (   member(requires(Packs), Options),
  454        member(Name, Packs)
  455    ->  true
  456    ).
  457
  458
  459%!  cpack_unregister(+Pack, +Options) is det.
  460%
  461%   Remove registration of the given  CPACK.   This  is  achieved by
  462%   updating 010-packs.pl and reloading this file.
  463
  464cpack_unregister(Pack, Options) :-
  465    conf_d_enabled(ConfigEnabled),
  466    directory_file_path(ConfigEnabled, '010-packs.pl', PacksFile),
  467    exists_file(PacksFile),
  468    read_file_to_terms(PacksFile, Terms, []),
  469    selectchk((:- cpack_register(Pack,_,_)), Terms, RestTerms),
  470    !,
  471    (   option(fake(true), Options)
  472    ->  print_message(informational, cpack(action(update(PacksFile))))
  473    ;   write_pack_register(PacksFile, RestTerms),
  474        load_files(PacksFile, [if(true)])
  475    ).
  476cpack_unregister(_, _).
  477
  478
  479%!  remove_config(+Dir, +Options)
  480%
  481%   Remove configuration that we loaded  from Dir. Currently deletes
  482%   links and Prolog `link files'.
  483%
  484%   @tbd    Deal with copied config files.  We can base this on
  485%           config.done and maybe on the module name.
  486%   @tbd    Update config.done.
  487
  488remove_config(Dir, Options) :-
  489    conf_d_enabled(ConfigEnabled),
  490    entry_paths(ConfigEnabled, Paths),
  491    maplist(remove_config(Dir, Options), Paths).
  492
  493remove_config(PackDir, Options, File) :-
  494    read_link(File, _, Target),
  495    absolute_file_name(Target, CanonicalTarget),
  496    sub_atom(CanonicalTarget, 0, _, _, PackDir),
  497    !,
  498    action(delete_file(File), Options).
  499remove_config(PackDir, Options, PlFile) :-
  500    file_name_extension(_, pl, PlFile),
  501    setup_call_cleanup(open(PlFile, read, In),
  502                       read(In, Term0),
  503                       close(In)),
  504    Term0 = (:- consult(Rel)),
  505    absolute_file_name(Rel, Target,
  506                       [ relative_to(PlFile) ]),
  507    sub_atom(Target, 0, _, _, PackDir),
  508    !,
  509    action(delete_file(PlFile), Options).
  510remove_config(_, _, _).
  511
  512
  513%!  remove_dir(+Dir, Options)
  514%
  515%   Removes a directory recursively.
  516
  517remove_dir(Link, Options) :-
  518    read_link(Link, _, _),
  519    !,
  520    action(delete_file(Link), Options).
  521remove_dir(Dir, Options) :-
  522    exists_directory(Dir),
  523    !,
  524    entry_paths(Dir, Paths),
  525    forall(member(P, Paths),
  526           remove_dir(P, Options)),
  527    action(delete_directory(Dir), Options).
  528remove_dir(File, Options) :-
  529    action(delete_file(File), Options).
  530
  531entry_paths(Dir, Paths) :-
  532    directory_files(Dir, Entries),
  533    entry_paths(Entries, Dir, Paths).
  534
  535entry_paths([], _, []).
  536entry_paths([H|T0], Dir, T) :-
  537    hidden(H),
  538    !,
  539    entry_paths(T0, Dir, T).
  540entry_paths([H|T0], Dir, [P|T]) :-
  541    directory_file_path(Dir, H, P),
  542    entry_paths(T0, Dir, T).
  543
  544hidden(.).
  545hidden(..).
  546
  547:- meta_predicate
  548    action(0, +).  549
  550action(G, Options) :-
  551    option(fake(true), Options),
  552    !,
  553    print_message(informational, cpack(action(G))).
  554action(G, _) :-
  555    G.
  556
  557                 /*******************************
  558                 *         REGISTRATION         *
  559                 *******************************/
  560
  561%!  cpack_register(+PackName, +Dir, +Options)
  562%
  563%   Attach a CPACK to the search paths
  564
  565cpack_register(PackName, Dir, Options) :-
  566    throw(error(context_error(nodirective,
  567                              cpack_register(PackName, Dir, Options)), _)).
  568
  569
  570user:term_expansion((:-cpack_register(PackName, Dir0, Options)), Clauses) :-
  571    full_dir(Dir0, Dir),
  572    Term =.. [PackName,'.'],
  573    Clauses = [ user:file_search_path(PackName, Dir),
  574                user:file_search_path(cpacks, Term),
  575                cpack:registered_cpack(PackName, Dir, Options)
  576              ].
  577
  578full_dir(Dir, Dir) :-
  579    compound(Dir),
  580    !.
  581full_dir(Dir, Dir) :-
  582    is_absolute_file_name(Dir),
  583    !.
  584full_dir(Dir, AbsDir) :-
  585    prolog_load_context(directory, ConfigEnabled),
  586    file_directory_name(ConfigEnabled, RelTo),
  587    absolute_file_name(Dir, AbsDir,
  588                       [ relative_to(RelTo),
  589                         file_type(directory),
  590                         access(exist)
  591                       ]).
  592
  593
  594
  595:- multifile
  596    registered_cpack/3.  597
  598%!  current_cpack(-Name) is nondet.
  599%
  600%   True when Name is the name of a registered package.
  601
  602current_cpack(Name) :-
  603    registered_cpack(Name, _, _).
  604
  605%!  cpack_property(Name, Property) is nondet.
  606%
  607%   True when Property is a property of the CPACK Name.  Defined
  608%   properties are:
  609%
  610%     * directory(Dir)
  611
  612cpack_property(Name, Property) :-
  613    property_cpack(Property, Name).
  614
  615property_cpack(directory(Dir), Name) :-
  616    registered_cpack(Name, LocalDir, _),
  617    absolute_file_name(LocalDir, Dir).
  618property_cpack(Option, Name) :-
  619    registered_cpack(Name, _, Options),
  620    member(Option, Options).
  621
  622%!  prolog_version:git_module_hook(?Name, ?Directory, ?Options) is
  623%!  nondet.
  624%
  625%   Make packages available for the   version management implemented
  626%   by library(version).
  627
  628:- multifile
  629    prolog_version:git_module_hook/3.  630
  631prolog_version:git_module_hook(Name, Directory, Options) :-
  632    registered_cpack(Name, LocalDir, Options),
  633    absolute_file_name(LocalDir, Directory).
  634
  635
  636                 /*******************************
  637                 *      CREATE NEW PACKAGES     *
  638                 *******************************/
  639
  640%!  cpack_create(+Name, +Title, +Options) is det.
  641%
  642%   Create a new package.  Options include
  643%
  644%     * type(Type)
  645%     Label of a subclass of cpack:Package.  Default is =package=
  646%     * title(Title)
  647%     Title for the package.  Should be a short line.
  648%     * foafname(FoafName)
  649%     foaf:name to put into the default template
  650%     * foafmbox(Email)
  651%     foaf:mbox to put into the default template
  652%
  653%   Default options are  extracted  from   the  cpack:Profile  named
  654%   =default=
  655%
  656%   @tbd    Allow selection profile, auto-loading of profile, etc.
  657
  658cpack_create(Name, Title, Options) :-
  659    cpack_load_schema,
  660    cpack_load_profile,
  661    option(type(Type), Options, package),
  662    option(description(Descr), Options,
  663           'Package description goes here.  You can use markdown.'),
  664    package_class_id(Type, PkgClass),
  665    default_bindings(default, Name, DefaultBindings),
  666    merge_options(Options,
  667                  [ name(Name),
  668                    title(Title),
  669                    pkgclass(PkgClass),
  670                    description(Descr)
  671                  | DefaultBindings
  672                  ], Vars),
  673    cpack_package_dir(Name, Dir, true),
  674    forall(cpack_dir(SubDir, Type),
  675           make_cpack_dir(Dir, SubDir)),
  676    forall(cpack_template(In, Out),
  677           install_template_file(In, Out, Vars)),
  678    git([init], [directory(Dir)]),
  679    git([add, '.'], [directory(Dir)]),
  680    git([commit, '-m', 'Installed template'], [directory(Dir)]),
  681    git([tag, epoch], [directory(Dir)]),
  682    git_setup_push(Dir, Vars).
  683
  684package_class_id(Label, TurtleID) :-
  685    package_class(Label, Class),
  686    rdf_global_id(Prefix:Name, Class),
  687    atomic_list_concat([Prefix, :, Name], TurtleID).
  688
  689package_class(Label, Class) :-
  690    rdf_has(Class, rdfs:label, literal(Label)),
  691    rdfs_subclass_of(Class, cpack:'Package'),
  692    !.
  693package_class(Label, _) :-
  694    domain_error(package_class, Label).
  695
  696default_bindings(Profile, Name, Bindings) :-
  697    findall(B, default_binding(Profile, Name, B), Bindings).
  698
  699default_binding(ProfileName, Name, B) :-
  700    rdf_has(Profile, cpack:name, literal(ProfileName)),
  701    (   rdf_has(Profile, cpack:defaultAuthor, Author),
  702        (   rdf_has(Author, foaf:name, literal(AuthorName)),
  703            B = foafname(AuthorName)
  704        ;   rdf_has(Author, foaf:mbox, MBOX),
  705            B = foafmbox(MBOX)
  706        )
  707    ;   rdf_has(Profile, cpack:fetchRepositoryTemplate, literal(GitTempl)),
  708        substitute(GitTempl, '@CPACK@', Name, GitRepo),
  709        B = fetchrepository(GitRepo)
  710    ;   rdf_has(Profile, cpack:pushRepositoryTemplate, literal(GitTempl)),
  711        substitute(GitTempl, '@CPACK@', Name, GitRepo),
  712        B = pushrepository(GitRepo)
  713    ).
  714
  715%!  git_setup_push(+Dir, +Vars) is det.
  716%
  717%   Set an origin for the newly  created repository. This also tries
  718%   to  setup  a  bare  repository  at   the  remote  machine  using
  719%   git_create_origin/2.
  720
  721git_setup_push(Dir, Vars) :-
  722    option(pushrepository(PushURL), Vars),
  723    !,
  724    option(title(Title), Vars, 'ClioPatria CPACK'),
  725    git([remote, add, origin, PushURL], [directory(Dir)]),
  726    directory_file_path(Dir, '.git/config', Config),
  727    setup_call_cleanup(open(Config, append, Out),
  728                       format(Out, '[branch "master"]\n\c
  729                                        \tremote = origin\n\c
  730                                        \tmerge = refs/heads/master\n', []),
  731                       close(Out)),
  732    catch(git_create_origin(Dir, PushURL, Title), E, true),
  733    (   var(E)
  734    ->  true
  735    ;   subsumes_term(error(existence_error(source_sink, path(Exe)), _), E)
  736    ->  print_message(error, cpack(missing_program(Exe)))
  737    ;   print_message(error, E)
  738    ).
  739git_setup_push(_,_).
  740
  741%!  git_create_origin(+Dir, +PushURL, +Title) is det.
  742%
  743%   Try to create the repository origin. As the user has setup push,
  744%   we hope he setup SSH appropriately. Note that this only works if
  745%   the remote user has a real shell and not a git-shell.
  746%
  747%   When using GitHub, PushURL is
  748%
  749%     ==
  750%     git@github.com:<user>/@CPACK@.git
  751%     https://github.com/<user>/@CPACK@.git
  752%     ==
  753
  754git_create_origin(Dir, PushURL, Title) :-
  755    (   atom_concat('git@github.com:', UserPath, PushURL)
  756    ->  true
  757    ;   atom_concat('https://github.com/', UserPath, PushURL)
  758    ),
  759    atomic_list_concat([_User, RepoGit], /, UserPath),
  760    file_name_extension(Repo, git, RepoGit),
  761    !,
  762    process_create(path(hub), [create, Repo, '-d', Title],
  763                   [ cwd(Dir)
  764                   ]).
  765git_create_origin(_Dir, PushURL, Title) :-
  766    uri_components(PushURL, Components),
  767    uri_data(scheme, Components, Scheme),
  768    (   Scheme == ssh
  769    ->  uri_data(authority, Components, Authority)
  770    ;   Authority = Scheme
  771    ),
  772    uri_data(path, Components, Path),
  773    file_directory_name(Path, Parent),
  774    file_base_name(Path, Repo),
  775    format(atom(Command),
  776           'cd "~w" && mkdir "~w" && cd "~w" && \c
  777               git init --bare && echo "~w" > description && \c
  778               touch git-daemon-export-ok',
  779           [Parent, Repo, Repo, Title]),
  780    process_create(path(ssh), [ Authority, Command ], []).
  781
  782
  783%!  make_cpack_dir(+BaseDir, +CPACKDir) is det.
  784%
  785%   Setup th directory structure for a new package.
  786
  787make_cpack_dir(Dir, SubDir) :-
  788    directory_file_path(Dir, SubDir, New),
  789    (   exists_directory(New)
  790    ->  true
  791    ;   make_directory_path(New),
  792        print_message(informational, cpack(create_directory(New)))
  793    ).
  794
  795install_template_file(In, Out, Vars) :-
  796    option(name(Name), Vars),
  797    absolute_file_name(In, InFile, [access(read)]),
  798    substitute(Out, '@NAME@', Name, OutFile),
  799    cpack_package_dir(Name, Dir, true),
  800    directory_file_path(Dir, OutFile, OutPath),
  801    copy_file_with_vars(InFile, OutPath, Vars),
  802    print_message(informational, cpack(installed_template(OutFile))).
  803
  804substitute(In, From, To, Out) :-
  805    sub_atom(In, B, _, A, From),
  806    !,
  807    sub_atom(In, 0, B, _, Start),
  808    sub_atom(In, _, A, 0, End),
  809    atomic_list_concat([Start, To, End], Out).
  810substitute(In, _, _, In).
  811
  812cpack_dir('rdf', _).
  813cpack_dir('rdf/cpack', _).
  814cpack_dir('config-available', _).
  815cpack_dir('entailment', _).
  816cpack_dir('applications', _).
  817cpack_dir('api', _).
  818cpack_dir('components', _).
  819cpack_dir('skin', _).
  820cpack_dir('lib', _).
  821cpack_dir('web', _).
  822cpack_dir('web/js', _).
  823cpack_dir('web/css', _).
  824cpack_dir('web/html', _).
  825
  826cpack_template(library('cpack/config-available.pl.in'),
  827               'config-available/@NAME@.pl').
  828cpack_template(library('cpack/DEFAULTS.in'),
  829               'config-available/DEFAULTS').
  830cpack_template(library('cpack/pack.ttl.in'),
  831               'rdf/cpack/@NAME@.ttl').
  832cpack_template(library('cpack/README.md.in'),
  833               'README.md').
  834
  835
  836                 /*******************************
  837                 *            PROFILE           *
  838                 *******************************/
  839
  840%!  cpack_load_profile is det.
  841%
  842%   Try to load the profile from user_profile('.cpack.ttl').
  843%
  844%   @tbd Prompt for a default profile (notably fill in the servers).
  845
  846cpack_load_profile :-
  847    absolute_file_name(user_profile('.cpack.ttl'), Path,
  848                       [ access(read),
  849                         file_errors(fail)
  850                       ]),
  851    !,
  852    rdf_load(Path).
  853cpack_load_profile.
  854
  855
  856%!  cpack_load_schema
  857%
  858%   Ensure the CPACK schema data is loaded.
  859
  860cpack_load_schema :-
  861    rdf_attach_library(rdf(cpack)),
  862    rdf_load_library(cpack).
  863
  864
  865
  866                 /*******************************
  867                 *             UTIL             *
  868                 *******************************/
  869
  870%!  cpack_package_dir(+PackageName, -Dir, +Create)
  871%
  872%   Installation directory for Package
  873
  874cpack_package_dir(Name, Dir, Create) :-
  875    setting(cpack:package_directory, PackageDir),
  876    directory_file_path(PackageDir, Name, Dir),
  877    (   (   Create == false
  878        ;   exists_directory(Dir)
  879        )
  880    ->  true
  881    ;   make_directory_path(Dir)
  882    ).
  883
  884:- multifile
  885    prolog:message//1,
  886    prolog:error_message//1.  887
  888prolog:message(cpack(Message)) -->
  889    message(Message).
  890
  891message(create_directory(New)) -->
  892    [ 'Created directory ~w'-[New] ].
  893message(installed_template(File)) -->
  894    [ 'Installed template ~w'-[File] ].
  895message(requires(Name, Packages)) -->
  896    (   { is_list(Name) }
  897    ->  [ 'Packages ~w require the following packages:'-[Name] ]
  898    ;   [ 'Package ~w requires the following packages:'-[Name] ]
  899    ),
  900    sub_packages(Packages),
  901    [ nl, 'Querying package status ...'-[] ].
  902message(no_change(Name, Version)) -->
  903    [ '   ~w: ~t~30|no change (~w)'-[Name, Version] ].
  904message(upgrade(Name, Old, New)) -->
  905    [ '   ~w: ~t~30|upgrading (~w..~w) ...'-[Name, Old, New] ].
  906message(download(Name, git(Url, _))) -->
  907    [ '   ~w: ~t~30|downloading from ~w ...'-[Name, Url] ].
  908message(probe(URL)) -->
  909    [ 'Trying CPACK server at ~w ...'-[URL] ].
  910message(probe_remote(URL)) -->
  911    [ 'Checking availability of GIT repository ~w ...'-[URL] ].
  912message(add_remote(Name, URL)) -->
  913    [ 'Running "git remote add ~w ~w ..."'-[Name, URL] ].
  914message(action(G)) -->
  915    [ '~q'-[G] ].
  916message(missing_program(hub)) -->
  917    !,
  918    [ 'Cannot find the GitHub command line utility "hub".'-[], nl,
  919      'See https://hub.github.com/ for installation instructions'-[]
  920    ].
  921message(missing_program(Prog)) -->
  922    [ 'Cannot find helper program "~w".'-[Prog] ].
  923sub_packages([]) --> [].
  924sub_packages([H|T]) --> sub_package(H), sub_packages(T).
  925
  926sub_package(cpack(Name, Options)) -->
  927    { option(title(Title), Options) },
  928    !,
  929    [ nl, '   ~w: ~t~30|~w'-[Name, Title] ].
  930sub_package(cpack(Name, _)) -->
  931    [ nl, '   ~w: ~t~30|~w'-[Name] ].
  932
  933prolog:error_message(cpack_error(Error)) -->
  934    cpack_error(Error).
  935
  936cpack_error(not_satisfied(Pack, Reasons)) -->
  937    [ 'Package not satisfied: ~p'-[Pack] ],
  938    not_satisfied_list(Reasons).
  939cpack_error(cannot_remove(Pack, Dependents)) -->
  940    [ 'Cannot remove "~p" because the following packs depend on it'-[Pack] ],
  941    pack_list(Dependents).
  942
  943not_satisfied_list([]) --> [].
  944not_satisfied_list([H|T]) --> not_satisfied(H), not_satisfied_list(T).
  945
  946not_satisfied(no_token(Token)) -->
  947    [ nl, '   Explicit requirement not found: ~w'-[Token] ].
  948not_satisfied(file(File, Problems)) -->
  949    [ nl, '   File ~p'-[File] ],
  950    file_problems(Problems).
  951
  952file_problems([]) --> [].
  953file_problems([H|T]) --> file_problem(H), file_problems(T).
  954
  955file_problem(predicate_not_found(PI)) -->
  956    [ nl, '        Predicate not resolved: ~w'-[PI] ].
  957
  958pack_list([]) --> [].
  959pack_list([H|T]) -->
  960    [ nl, '   ~p'-[H] ],
  961    pack_list(T)