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(setup,
   37          [ setup_scripts/2,            % +SrcDir, +DestDir
   38            setup_default_config/3,     % +SrcDir, +DestDir, +Options
   39            setup_prolog_executable/1,  % -Exec for #!
   40            setup_goodbye/0,
   41            copy_file_with_vars/3       % +In, +Out, +Vars
   42          ]).   43:- use_module(library(apply)).   44:- use_module(library(filesex)).   45:- use_module(library(option)).   46:- use_module(library(lists)).   47:- use_module(library(conf_d)).   48:- use_module(library(apply_macros), []).   49
   50
   51/** <module> Configuration (setup) of ClioPatria
   52*/
   53
   54:- multifile
   55    substitutions/1.   56
   57%!  setup_scripts(+SrcDir, +DstDir)
   58%
   59%   Copy all *.in files in SrcDir   into DstDir, replacing variables
   60%   denoted as @NAME@. Defined variables are:
   61%
   62%       $ SWIPL :
   63%       The SWI-Prolog executable as it must be used in #!
   64%       $ CLIOPATRIA :
   65%       Directory that holds the ClioPatria system
   66%       $ CWD :
   67%       The (current) installation directory
   68%       $ PARENTDIR :
   69%       Parent of CWD.  This can be useful if the startup-script
   70%       is located in a subdirectory of a project.
   71
   72setup_scripts(SrcDir, DstDir) :-
   73    substitutions(Vars),
   74    print_message(informational, setup(localize_dir(SrcDir))),
   75    atom_concat(SrcDir, '/*.in', Pattern),
   76    expand_file_name(Pattern, Files),
   77    maplist(install_file(Vars, DstDir), Files).
   78
   79install_file(Vars, Dest, InFile) :-
   80    (   exists_directory(Dest)
   81    ->  file_name_extension(File, in, InFile),
   82        file_base_name(File, Base0),
   83        rename_script(Base0, Base),
   84        directory_file_path(Dest, Base, DstFile)
   85    ;   DstFile = Dest
   86    ),
   87    copy_file_with_vars(InFile, DstFile, Vars),
   88    make_runnable(DstFile),
   89    print_message(informational, setup(install_file(DstFile))).
   90
   91%!  rename_script(+ScriptIn, -Script)
   92%
   93%   Rename scripts to satisfy the target file name association.
   94
   95rename_script(Run, Script) :-
   96    current_prolog_flag(associate, Ext),
   97    file_name_extension(run, _, Run),
   98    file_name_extension(run, Ext, Script),
   99    !.
  100rename_script(Script, Script).
  101
  102%!  make_runnable(+File)
  103%
  104%   Make a file executable if it starts with #!
  105
  106make_runnable(File) :-
  107    setup_call_cleanup(
  108        open(File, read, In),
  109        read_line_to_codes(In, Line),
  110        close(In)),
  111    phrase("#!", Line, _),
  112    !,
  113    '$mark_executable'(File).
  114make_runnable(_).
  115
  116
  117%!  setup_prolog_executable(?Var, ?Value)
  118%
  119%   Executable to put in #!Path. On Windows   this  is bogus, but it
  120%   may not contain spaces,  so  we   include  the  default Unix RPM
  121%   location.
  122
  123setup_prolog_executable(PL) :-
  124    catch(getenv('SWIPL', PL), _, fail),
  125    !.
  126setup_prolog_executable('/usr/bin/swipl') :-
  127    current_prolog_flag(windows, true),
  128    !.
  129setup_prolog_executable(PL) :-
  130    current_prolog_flag(executable, Exe),
  131    file_base_name(Exe, Base),
  132    (   which(Base, PL)
  133    ->  true
  134    ;   PL = Exe
  135    ).
  136
  137which(File, Path) :-
  138    catch(getenv('PATH', SearchPath), _, fail),
  139    atomic_list_concat(Parts, :, SearchPath),
  140    member(Dir, Parts),
  141    directory_file_path(Dir, File, Path),
  142    access_file(Path, execute).
  143
  144%!  setup_default_config(+ConfigEnabled, +ConfigAvail, +Options)
  145%
  146%   Setup  the  enabled  cofiguration  directory    from  the  given
  147%   ConfigAvail. If Options include help(true), this prints a set of
  148%   available options.
  149
  150setup_default_config(ConfigEnabled, ConfigAvail, Options) :-
  151    option(help(true), Options),
  152    !,
  153    setup_config_help(ConfigEnabled, ConfigAvail).
  154setup_default_config(ConfigEnabled, ConfigAvail, Options) :-
  155    setup_config_enabled(ConfigEnabled, Options),
  156    default_config(ConfigEnabled, ConfigAvail, Options).
  157
  158
  159setup_config_enabled(ConfigEnabled, Options) :-
  160    (   exists_directory(ConfigEnabled)
  161    ->  true
  162    ;   make_directory(ConfigEnabled)
  163    ),
  164    directory_file_path(ConfigEnabled, 'README.txt', Readme),
  165    (   exists_file(Readme)
  166    ->  true
  167    ;   option(readme(ReadMeIn), Options)
  168    ->  print_message(informational,
  169                      setup(install_file('README.txt', ConfigEnabled))),
  170        substitutions(Vars),
  171        install_file(Vars, Readme, ReadMeIn)
  172    ).
  173
  174%!  default_config(+ConfigEnabledDir, +ConfigAvailDir, +Options)
  175%
  176%   Install a default configuration in ConfigEnabledDir based on the
  177%   information from ConfigAvailDir.  Options:
  178%
  179%     * without(Base)
  180%     Skip this file from the installation
  181%     * with(Base)
  182%     Add this file to the installation
  183
  184default_config(ConfigEnabled, ConfigAvail, Options) :-
  185    directory_file_path(ConfigEnabled, 'config.done', DoneFile),
  186    (   exists_file(DoneFile)
  187    ->  read_file_to_terms(DoneFile, Installed, [])
  188    ;   Installed = []
  189    ),
  190    include(with, Options, Requests),
  191    maplist(with_file(ConfigAvail), Requests, With),
  192    config_defaults(ConfigAvail, Defaults0),
  193    exclude(without(Options), Defaults0, Defaults),
  194    append(Defaults, With, Install),
  195    (   Install \== []
  196    ->  setup_call_cleanup(open_done(DoneFile, Out),
  197                           maplist(install_config(Installed,
  198                                                  ConfigEnabled,
  199                                                  ConfigAvail,
  200                                                  Out, Options),
  201                                   Install),
  202                           close(Out))
  203    ;   true
  204    ).
  205
  206without(Options, file(Key,_,_)) :-
  207    memberchk(without(Key), Options).
  208
  209with(with(_)).
  210
  211with_file(ConfigAvail, with(Key), file(Key, Path, link)) :-
  212    directory_file_path(ConfigAvail, Key, FileBase),
  213    absolute_file_name(FileBase, Path,
  214                       [ access(read),
  215                         file_type(prolog)
  216                       ]).
  217
  218open_done(DoneFile, Out) :-
  219    exists_file(DoneFile),
  220    !,
  221    open(DoneFile, append, Out).
  222open_done(DoneFile, Out) :-
  223    open(DoneFile, write, Out),
  224    format(Out, '/* Generated file~n', []),
  225    format(Out, '   Keep track of installed config files~n', []),
  226    format(Out, '*/~n~n', []).
  227
  228install_config(Installed, ConfigEnabled, ConfigAvail, Out, Options,
  229               file(_Key, File, How0)) :-
  230    file_base_name(File, Base),
  231    \+ ( memberchk(file(IFile,_,_), Installed),
  232         file_base_name(IFile, Base)
  233       ),
  234    !,
  235    final_how(How0, How, Options),
  236    install_config_file(How, ConfigEnabled, File),
  237    get_time(Now),
  238    Stamp is round(Now),
  239    format(Out, '~q.~n', [file(Base, ConfigAvail, Stamp)]).
  240install_config(_, _, _, _, _, _).
  241
  242final_how(link, How, Options) :-
  243    !,
  244    (   option(link(true), Options)
  245    ->  How = link
  246    ;   How = include
  247    ).
  248final_how(How, How, _).
  249
  250
  251%!  config_defaults(+ConfigAvail, -Defaults) is det.
  252%
  253%   Defaults is a list of file(Key, File, How) that indicates which
  254%   available config files must be installed by default.
  255%
  256%   @param ConfigAvail is either a directory or an alias.
  257
  258config_defaults(ConfigAvail, Defaults) :-
  259    compound(ConfigAvail),
  260    !,
  261    findall(Defs,
  262            (   absolute_file_name(ConfigAvail, Dir,
  263                                   [ file_type(directory),
  264                                     solutions(all),
  265                                     access(read)
  266                                   ]),
  267                config_defaults_dir(Dir, Defs)
  268            ),
  269            AllDefs),
  270    append(AllDefs, Defaults).
  271config_defaults(ConfigAvail, Defaults) :-
  272    config_defaults_dir(ConfigAvail, Defaults).
  273
  274
  275config_defaults_dir(ConfigAvail, Defaults) :-
  276    directory_file_path(ConfigAvail, 'DEFAULTS', DefFile),
  277    access_file(DefFile, read),
  278    !,
  279    read_file_to_terms(DefFile, Terms, []),
  280    config_defaults(Terms, ConfigAvail, Defaults).
  281config_defaults_dir(_, []).
  282
  283config_defaults([], _, []).
  284config_defaults([H|T0], ConfigAvail, [F|T]) :-
  285    config_default(H, ConfigAvail, F),
  286    !,
  287    config_defaults(T0, ConfigAvail, T).
  288config_defaults([_|T0], ConfigAvail, T) :-
  289    config_defaults(T0, ConfigAvail, T).
  290
  291
  292config_default((Head :- Body), ConfigAvail, File) :-
  293    !,
  294    call(Body),
  295    config_default(Head, ConfigAvail, File).
  296config_default(config(FileBase, How), ConfigAvail,
  297               file(Key, Path, How)) :-
  298    !,
  299    (   File = FileBase
  300    ;   prolog_file_type(Ext, prolog),
  301        file_name_extension(FileBase, Ext, File)
  302    ),
  303    directory_file_path(ConfigAvail, File, Path),
  304    exists_file(Path),
  305    file_base_name(File, Base),
  306    file_name_extension(Key, _, Base).
  307config_default(Term, _, _) :-
  308    domain_error(config_term, Term).
  309
  310
  311%!  setup_config_help(+ConfigEnabled, +ConfigAvail) is det.
  312
  313setup_config_help(ConfigEnabled, ConfigAvail) :-
  314    doc_collect(true),
  315    config_defaults(ConfigAvail, Defaults),
  316    conf_d_configuration(ConfigAvail, ConfigEnabled, Configs),
  317    partition(default_config(Defaults), Configs, Default, NonDefault),
  318    maplist(config_help(without), Default, Without),
  319    maplist(config_help(with), NonDefault, With),
  320    print_message(informational, setup(general)),
  321    print_message(informational, setup(without(Without))),
  322    print_message(informational, setup(with(With))),
  323    print_message(informational, setup(advice)).
  324
  325default_config(Defaults, Key-_) :-
  326    memberchk(file(Key,_,_), Defaults).
  327
  328config_help(With, Key-[Example,_], Help) :-
  329    (   conf_d_member_data(title, Example, Title)
  330    ->  true
  331    ;   Title = 'no description'
  332    ),
  333    Help =.. [With,Key,Title].
  334
  335
  336%!  install_config_file(+How, +ConfDir, +File) is det.
  337%
  338%   Install  the  configuration  file  File   in  the  configuration
  339%   directory ConfDir. How dictates how the file is installed and is
  340%   one of:
  341%
  342%     * link
  343%     Link the file. This means that the configured system updates
  344%     the config file if it is updated in the package.
  345%     * include
  346%     As `link`, but avoiding the nead for symlinks
  347%     * copy
  348%     Copy the file.  This is used if the config file in the package
  349%     is merely a skeleton that needs to be instantiated for the
  350%     specific ClioPatria installation.
  351
  352install_config_file(_, ConfDir, Path) :-
  353    file_base_name(Path, File),
  354    directory_file_path(ConfDir, File, Dest),
  355    exists_file(Dest),
  356    !.
  357install_config_file(link, ConfDir, Source) :-
  358    file_base_name(Source, File),
  359    directory_file_path(ConfDir, File, Dest),
  360    print_message(informational, setup(install_file(File))),
  361    link_prolog_file(Source, Dest).
  362install_config_file(include, ConfDir, Source) :-
  363    file_base_name(Source, File),
  364    directory_file_path(ConfDir, File, Dest),
  365    print_message(informational, setup(install_file(File))),
  366    include_prolog_file(Source, Dest).
  367install_config_file(copy, ConfDir, Source) :-
  368    file_base_name(Source, File),
  369    directory_file_path(ConfDir, File, Dest),
  370    print_message(informational, setup(install_file(File))),
  371    copy_file(Source, Dest).
  372
  373%!  link_prolog_file(+SourcePath, +DestDir) is det.
  374%
  375%   Install a skeleton file by linking it.  If it is not possible to
  376%   create a symbolic link (typically on  system that do not support
  377%   proper links such as Windows), create  a Prolog `link' file that
  378%   loads the target.
  379
  380link_prolog_file(Source, Dest) :-
  381    relative_file_name(Source, Dest, Rel),
  382    catch(link_file(Rel, Dest, symbolic), Error, true),
  383    (   var(Error)
  384    ->  true
  385    ;   include_prolog_file(Source, Dest)
  386    ->  true
  387    ;   throw(Error)
  388    ).
  389
  390%!  include_prolog_file(+Source, +Dest) is det.
  391%
  392%   Creat a _|link file|_ for a Prolog file. Make sure to delete the
  393%   target first, to avoid an accidental   write  through a symbolic
  394%   link.
  395
  396include_prolog_file(Source, Dest) :-
  397    (   access_file(Dest, exist)
  398    ->  delete_file(Dest)
  399    ;   true
  400    ),
  401    file_base_name(Source, File),
  402    file_name_extension(Base, pl, File),
  403    atomic_list_concat([link_, Base, '_conf'], LinkModule),
  404    setup_call_cleanup(
  405        open(Dest, write, Out),
  406        ( format(Out, '/* Linked config file */~n', []),
  407          format(Out, ':- module(~q, []).~n', [LinkModule]),
  408          format(Out, ':- ~q.~n', [reexport(config_available(Base))])
  409        ),
  410        close(Out)).
  411
  412%!  setup_goodbye
  413%
  414%   Say we are done.  Waits for the user in Windows to allow the
  415%   user read messages.
  416
  417setup_goodbye :-
  418    current_prolog_flag(windows, true),
  419    !,
  420    format(user_error, '~N~nReady.  Press any key to exit. ', []),
  421    get_single_char(_),
  422    format(' Goodbye!~n'),
  423    halt.
  424setup_goodbye :-
  425    halt.
  426
  427
  428                 /*******************************
  429                 *             UTIL             *
  430                 *******************************/
  431
  432%!  copy_file_with_vars(+File, +DirOrFile, +Bindings) is det.
  433%
  434%   As =|cp File DirOrFile|=, while substituting =|@var@|=
  435%   from Bindings using copy_stream_with_vars/3.
  436
  437copy_file_with_vars(File, DirOrFile, Bindings) :-
  438    destination_file(DirOrFile, File, Dest),
  439    open(File, read, In),
  440    open(Dest, write, Out),
  441    call_cleanup(copy_stream_with_vars(In, Out, Bindings),
  442                 (close(In), close(Out))).
  443
  444destination_file(Dir, File, Dest) :-
  445    exists_directory(Dir),
  446    !,
  447    atomic_list_concat([Dir, File], /, Dest).
  448destination_file(Dest, _, Dest).
  449
  450
  451%!  copy_stream_with_vars(+In:stream, +Out:stream,
  452%!                        +Bindings:list(Var=Name)) is det.
  453%
  454%   Copy all data from In to Out,   while replacing =|@var@|= with a
  455%   binding from Bindings. In addition, =|!var!|= is replaced with a
  456%   Prolog-quoted version of the variable content.
  457%
  458%   @param Bindings List of Var=Name or Var(Name).  If exact case
  459%   match fails, the match is retried with the lowercase name.
  460
  461copy_stream_with_vars(In, Out, []) :-
  462    !,
  463    copy_stream_data(In, Out).
  464copy_stream_with_vars(In, Out, Bindings) :-
  465    get_code(In, C0),
  466    copy_with_vars(C0, In, Out, Bindings).
  467
  468copy_with_vars(-1, _, _, _) :- !.
  469copy_with_vars(0'@, In, Out, Bindings) :-
  470    !,
  471    insert_var(0'@, C2, In, Out, Bindings),
  472    copy_with_vars(C2, In, Out, Bindings).
  473copy_with_vars(0'!, In, Out, Bindings) :-
  474    !,
  475    insert_var(0'!, C2, In, Out, Bindings),
  476    copy_with_vars(C2, In, Out, Bindings).
  477copy_with_vars(C0, In, Out, Bindings) :-
  478    put_code(Out, C0),
  479    get_code(In, C1),
  480    copy_with_vars(C1, In, Out, Bindings).
  481
  482insert_var(Mark, C2, In, Out, Bindings) :-
  483    get_code(In, C0),
  484    read_var_name(C0, In, VarNameS, C1),
  485    atom_codes(VarName, VarNameS),
  486    (   C1 == Mark,
  487        var_value(VarName, Value, Bindings)
  488    ->  (   Mark == 0'@
  489        ->  format(Out, '~w', [Value])
  490        ;   format(Out, '~q', [Value])
  491        ),
  492        get_code(In, C2)
  493    ;   format(Out, '~c~w', [Mark, VarName]),
  494        C2 = C1
  495    ).
  496
  497read_var_name(C0, In, [C0|T], End) :-
  498    code_type(C0, alpha),
  499    !,
  500    get_code(In, C1),
  501    read_var_name(C1, In, T, End).
  502read_var_name(C0, _In, [], C0).
  503
  504var_value(Name, Value, Vars) :-
  505    memberchk(Name=Value, Vars),
  506    !.
  507var_value(Name, Value, Vars) :-
  508    Term =.. [Name,Value],
  509    memberchk(Term, Vars),
  510    !.
  511var_value(Name, Value, Vars) :-
  512    downcase_atom(Name, Lwr),
  513    Lwr \== Name,
  514    var_value(Lwr, Value, Vars).
  515
  516
  517                 /*******************************
  518                 *            MESSAGES          *
  519                 *******************************/
  520
  521:- multifile
  522    prolog:message//1.  523
  524prolog:message(setup(Term)) -->
  525    message(Term).
  526
  527message(localize_dir(SrcDir)) -->
  528    [ 'Localizing scripts from ~p ...'-[SrcDir] ].
  529message(install_file(File, Dir)) -->
  530    [ 'Installing ~w in ~w ...'-[File, Dir] ].
  531message(install_file(File)) -->
  532    { file_base_name(File, Base) },
  533    [ ' Installing ~w ...'-[Base] ].
  534message(without(List)) -->
  535    [ nl, 'Use --without-X to disable default components' ],
  536    help(List).
  537message(with(List)) -->
  538    [ nl, 'Use --with-X to enable non-default components' ],
  539    help(List).
  540message(general) -->
  541    [ 'ClioPatria setup program', nl, nl,
  542      'General options', nl,
  543      '  --link~t~28|Use symbolic links in config-enabled'-[]
  544    ].
  545message(advice) -->
  546    [ nl, 'Typical setup for local interactive usage', nl,
  547      '  --with-debug --with-localhost'-[]
  548    ].
  549
  550help([]) --> [].
  551help([H|T]) -->
  552    [nl],
  553    help(H),
  554    help(T).
  555help(without(Key, Title)) -->
  556    [ '  --without-~w~t~28|~w'-[Key, Title] ].
  557help(with(Key, Title)) -->
  558    [ '  --with-~w~t~28|~w'-[Key, Title] ]