1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker and Richard O'Keefe
    4    E-mail:        J.Wielemaker@cs.vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2014-2019, VU University Amsterdam
    7                              CWI, 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(check_installation,
   37          [ check_installation/0,
   38            check_installation/1,               % -Issues
   39            check_config_files/0,
   40            update_config_files/0,
   41            test_installation/0,
   42            test_installation/1                 % +Options
   43          ]).   44:- autoload(library(apply),[maplist/2,maplist/3]).   45:- autoload(library(archive),[archive_open/3,archive_close/1]).   46:- autoload(library(lists),[append/3,member/2]).   47:- autoload(library(option),[option/2,merge_options/3]).   48:- autoload(library(pcre),[re_config/1]).   49:- autoload(library(prolog_source),[path_segments_atom/2]).   50:- use_module(library(settings),[setting/2]).   51
   52
   53/** <module> Check installation issues and features
   54
   55This library performs checks on  the   installed  system to verify which
   56optional components are available and  whether  all  libraries that load
   57shared objects/DLLs can be loaded.
   58*/
   59
   60%!  component(?Component, -Features) is nondet.
   61%
   62%   This predicate describes the test components. Features is a dict
   63%   with the following components:
   64%
   65%     - test:Goal
   66%     (Additional) test that must succeed for the component to be
   67%     functional.
   68%     - url:URL
   69%     URL with additional information, relative to
   70%     =|http://www.swi-prolog.org/build/issues/|=.  If not provided,
   71%     the library file with extension =|.html|= is used.
   72%     - optional:true
   73%     If the library does not exist, do not complain.
   74%     - os:OS
   75%     One of =windows=, =unix= or =linux=. If present, the component
   76%     is only checked for if we are running on a version of the
   77%     specified operating system.
   78%     - features:Goal
   79%     After successful evaluation that loading and basic operation
   80%     of the component succeeds, run this to check additional
   81%     features.
   82
   83% Feature tests
   84component(tcmalloc,
   85          _{ optional:true,
   86             test:test_tcmalloc,
   87             url:'tcmalloc.html'
   88           }).
   89component(gmp,
   90          _{ test:current_prolog_flag(bounded, false),
   91             url:'gmp.html'
   92           }).
   93% Packages that depend on foreign libraries
   94component(library(archive), _{features:archive_features}).
   95component(library(cgi), _{}).
   96component(library(crypt), _{}).
   97component(library(bdb), _{}).
   98component(library(double_metaphone), _{}).
   99component(library(filesex), _{}).
  100component(library(http/http_stream), _{}).
  101component(library(http/json), _{}).
  102component(library(http/jquery), _{features:jquery_file}).
  103component(library(isub), _{}).
  104component(library(jpl), _{}).
  105component(library(memfile), _{}).
  106component(library(odbc), _{}).
  107component(library(pce),
  108          _{pre:load_foreign_library(pce_principal:foreign(pl2xpce)),
  109            url:'xpce.html'}).
  110component(library(pcre), _{features:pcre_features}).
  111component(library(pdt_console), _{}).
  112component(library(porter_stem), _{}).
  113component(library(process), _{}).
  114component(library(protobufs), _{}).
  115component(library(editline), _{os:unix}).
  116component(library(readline), _{os:unix}).
  117component(library(readutil), _{}).
  118component(library(rlimit), _{os:unix}).
  119component(library(semweb/rdf_db), _{}).
  120component(library(semweb/rdf_ntriples), _{}).
  121component(library(semweb/turtle), _{}).
  122component(library(sgml), _{}).
  123component(library(sha), _{}).
  124component(library(snowball), _{}).
  125component(library(socket), _{}).
  126component(library(ssl), _{}).
  127component(library(crypto), _{}).
  128component(library(syslog), _{os:unix}).
  129component(library(table), _{}).
  130component(library(time), _{}).
  131component(library(tipc/tipc), _{os:linux}).
  132component(library(unicode), _{}).
  133component(library(uri), _{}).
  134component(library(uuid), _{}).
  135component(library(zlib), _{}).
  136component(library(yaml), _{}).
  137
  138issue_base('http://www.swi-prolog.org/build/issues/').
  139
  140:- thread_local
  141    issue/1.  142
  143:- meta_predicate
  144    run_silent(0, +).  145
  146%!  check_installation
  147%
  148%   Check features of the installed   system. Performs the following
  149%   tests:
  150%
  151%     1. Test whether features that depend on optional libraries
  152%        are present (e.g., unbounded arithmetic support)
  153%     2. Test that all standard libraries that depend on foreign
  154%        code are present.
  155%     3. provides a test_installation predicate to run the tests
  156%        at runtime if the system was built with -DINSTALL_TESTS
  157%
  158%   If issues are found it prints a   diagnostic message with a link
  159%   to a wiki page with additional information about the issue.
  160
  161check_installation :-
  162    print_message(informational, installation(checking)),
  163    check_installation_(InstallIssues),
  164    check_on_path,
  165    check_config_files(ConfigIssues),
  166    maplist(print_message(warning), ConfigIssues),
  167    append(InstallIssues, ConfigIssues, Issues),
  168    (   Issues == []
  169    ->  print_message(informational, installation(perfect))
  170    ;   length(Issues, Count),
  171        print_message(warning, installation(imperfect(Count)))
  172    ).
  173
  174%!  check_installation(-Issues:list(pair)) is det.
  175%
  176%   As check_installation/0, but additionally  returns   a  list  of
  177%   Component-Problem pairs. Problem is  one of `optional_not_found`
  178%   (optional component is not present),   `not_found` (component is
  179%   not present) or `failed` (component  is   present  but cannot be
  180%   loaded).
  181
  182check_installation(Issues) :-
  183    check_installation_(Issues0),
  184    maplist(public_issue, Issues0, Issues).
  185
  186public_issue(installation(Term), Source-Issue) :-
  187    functor(Term, Issue, _),
  188    arg(1, Term, Properties),
  189    Source = Properties.source.
  190
  191check_installation_(Issues) :-
  192    retractall(issue(_)),
  193    forall(component(Source, _Properties),
  194           check_component(Source)),
  195    findall(I, retract(issue(I)), Issues).
  196
  197check_component(Source) :-
  198    component(Source, Properties),
  199    !,
  200    check_component(Source, Properties.put(source,Source)).
  201
  202check_component(Source, Properties) :-
  203    compound(Source),
  204    !,
  205    check_source(Source, Properties).
  206check_component(Feature, Properties) :-
  207    print_message(informational, installation(checking(Feature))),
  208    (   call(Properties.test)
  209    ->  print_message(informational, installation(ok))
  210    ;   print_issue(installation(missing(Properties)))
  211    ).
  212
  213check_source(_Source, Properties) :-
  214    OS = Properties.get(os),
  215    \+ current_os(OS),
  216    !.
  217check_source(Source, Properties) :-
  218    exists_source(Source),
  219    !,
  220    print_message(informational, installation(loading(Source))),
  221    (   run_silent(( (   Pre = Properties.get(pre)
  222                     ->  call(Pre)
  223                     ;   true
  224                     ),
  225                     load_files(Source, [silent(true), if(not_loaded)])
  226                   ),
  227                   Properties.put(action, load))
  228    ->  test_component(Properties),
  229        print_message(informational, installation(ok)),
  230        check_features(Properties)
  231    ;   true
  232    ).
  233check_source(_Source, Properties) :-
  234    Properties.get(optional) == true,
  235    !,
  236    print_message(silent,
  237                  installation(optional_not_found(Properties))).
  238check_source(_Source, Properties) :-
  239    print_issue(installation(not_found(Properties))).
  240
  241current_os(unix)    :- current_prolog_flag(unix, true).
  242current_os(windows) :- current_prolog_flag(windows, true).
  243current_os(linux)   :- current_prolog_flag(arch, Arch), sub_atom(Arch, _, _, _, linux).
  244
  245%!  test_component(+Properties) is semidet.
  246%
  247%   Run additional tests to see whether the component really works.
  248
  249test_component(Dict) :-
  250    Test = Dict.get(test),
  251    !,
  252    call(Test).
  253test_component(_).
  254
  255%!  check_features(+Properties) is semidet.
  256%
  257%   Check for additional features of the components.
  258%
  259%   @see check_component/1 should be used for checking that the
  260%   component works.
  261
  262check_features(Dict) :-
  263    Test = Dict.get(features),
  264    !,
  265    call(Test).
  266check_features(_).
  267
  268
  269%!  run_silent(:Goal, +Properties) is semidet.
  270%
  271%   Succeed if Goal succeeds  and  does   not  print  any  errors or
  272%   warnings.
  273
  274run_silent(Goal, Properties) :-
  275    run_collect_messages(Goal, Result, Messages),
  276    (   Result == true,
  277        Messages == []
  278    ->  true
  279    ;   print_issue(installation(failed(Properties, Result, Messages))),
  280        fail
  281    ).
  282
  283%!  run_collect_messages(Goal, Result, Messages) is det.
  284%
  285%   Run Goal, unify Result with  =true=, =false= or exception(Error)
  286%   and  messages  with  a  list  of  generated  error  and  warning
  287%   messages. Each message is a term:
  288%
  289%       message(Term,Kind,Lines)
  290%
  291%   @see message_hook/3.
  292
  293:- thread_local
  294    got_message/1.  295
  296run_collect_messages(Goal, Result, Messages) :-
  297    setup_call_cleanup(
  298        asserta((user:thread_message_hook(Term,Kind,Lines) :-
  299                    error_kind(Kind),
  300                    assertz(got_message(message(Term,Kind,Lines)))), Ref),
  301        (   catch(Goal, E, true)
  302        ->  (   var(E)
  303            ->  Result0 = true
  304            ;   Result0 = exception(E)
  305            )
  306        ;   Result0 = false
  307        ),
  308        erase(Ref)),
  309    findall(Msg, retract(got_message(Msg)), Messages),
  310    Result = Result0.
  311
  312error_kind(warning).
  313error_kind(error).
  314
  315
  316                 /*******************************
  317                 *         SPECIAL TESTS        *
  318                 *******************************/
  319
  320%!  test_tcmalloc
  321
  322:- if(current_predicate(malloc_property/1)).  323test_tcmalloc :-
  324    malloc_property('generic.current_allocated_bytes'(Bytes)),
  325    Bytes > 1 000 000.
  326:- else.  327test_tcmalloc :-
  328    fail.
  329:- endif.  330
  331%!  archive_features
  332%
  333%   Report features supported by library(archive).
  334
  335archive_features :-
  336    tmp_file_stream(utf8, Name, Out),
  337    close(Out),
  338    findall(F, archive_filter(F, Name), Filters),
  339    print_message(informational, installation(archive(filters, Filters))),
  340    findall(F, archive_format(F, Name), Formats),
  341    print_message(informational, installation(archive(formats, Formats))),
  342    delete_file(Name).
  343
  344archive_filter(F, Name) :-
  345    a_filter(F),
  346    catch(archive_open(Name, A, [filter(F)]), E, true),
  347    (   var(E)
  348    ->  archive_close(A)
  349    ;   true
  350    ),
  351    \+ subsumes_term(error(domain_error(filter, _),_), E).
  352
  353archive_format(F, Name) :-
  354    a_format(F),
  355    catch(archive_open(Name, A, [format(F)]), E, true),
  356    (   var(E)
  357    ->  archive_close(A)
  358    ;   true
  359    ),
  360    \+ subsumes_term(error(domain_error(format, _),_), E).
  361
  362a_filter(bzip2).
  363a_filter(compress).
  364a_filter(gzip).
  365a_filter(grzip).
  366a_filter(lrzip).
  367a_filter(lzip).
  368a_filter(lzma).
  369a_filter(lzop).
  370a_filter(none).
  371a_filter(rpm).
  372a_filter(uu).
  373a_filter(xz).
  374
  375a_format('7zip').
  376a_format(ar).
  377a_format(cab).
  378a_format(cpio).
  379a_format(empty).
  380a_format(gnutar).
  381a_format(iso9660).
  382a_format(lha).
  383a_format(mtree).
  384a_format(rar).
  385a_format(raw).
  386a_format(tar).
  387a_format(xar).
  388a_format(zip).
  389
  390%!  pcre_features
  391
  392pcre_features :-
  393    findall(X, pcre_missing(X), Missing),
  394    (   Missing == []
  395    ->  true
  396    ;   print_message(warning, installation(pcre_missing(Missing)))
  397    ),
  398    (   re_config(compiled_widths(Widths)),
  399        1 =:= Widths /\ 1
  400    ->  true
  401    ;   print_message(warning, installation(pcre_missing('8-bit support')))
  402    ).
  403
  404pcre_missing(X) :-
  405    pcre_must_have(X),
  406    Term =.. [X,true],
  407    \+ catch(re_config(Term), _, fail).
  408
  409pcre_must_have(unicode).
  410
  411%!  jquery_file
  412%
  413%   Test whether jquery.js can be found
  414
  415jquery_file :-
  416    setting(jquery:version, File),
  417    (   absolute_file_name(js(File), Path, [access(read), file_errors(fail)])
  418    ->  print_message(informational, installation(jquery(found(Path))))
  419    ;   print_message(warning, installation(jquery(not_found(File))))
  420    ).
  421
  422
  423%!  check_on_path
  424%
  425%   Validate that Prolog is installed in $PATH
  426
  427check_on_path :-
  428    current_prolog_flag(executable, EXEFlag),
  429    prolog_to_os_filename(EXE, EXEFlag),
  430    file_base_name(EXE, Prog),
  431    absolute_file_name(EXE, AbsExe,
  432                       [ access(execute)
  433                       ]),
  434    prolog_to_os_filename(AbsExe, OsExe),
  435    (   absolute_file_name(path(Prog), OnPath,
  436                           [ access(execute),
  437                             file_errors(fail)
  438                           ])
  439    ->  (   same_file(EXE, OnPath)
  440        ->  true
  441        ;   absolute_file_name(path(Prog), OnPathAny,
  442                               [ access(execute),
  443                                 file_errors(fail),
  444                                 solutions(all)
  445                               ]),
  446            same_file(EXE, OnPathAny)
  447        ->  print_message(warning, installation(not_first_on_path(OsExe, OnPath)))
  448        ;   print_message(warning, installation(not_same_on_path(OsExe, OnPath)))
  449        )
  450    ;   print_message(warning, installation(not_on_path(OsExe, Prog)))
  451    ).
  452
  453
  454		 /*******************************
  455		 *           RUN TESTS		*
  456		 *******************************/
  457
  458%!  test_installation is semidet.
  459%!  test_installation(+Options) is semidet.
  460%
  461%   Run regression tests in the installed system. Requires the system to
  462%   be built using
  463%
  464%	cmake -DINSTALL_TESTS=ON
  465%
  466%   Options processed:
  467%
  468%     - packages(+Boolean)
  469%       When `false`, do not test the packages
  470%     - package(+Package)
  471%       Only test package package.
  472
  473test_installation :-
  474    test_installation([]).
  475
  476test_installation(Options) :-
  477    absolute_file_name(swi(test/test),
  478                       TestFile,
  479                       [ access(read),
  480                         file_errors(fail),
  481                         file_type(prolog)
  482                       ]),
  483    !,
  484    test_installation_run(TestFile, Options).
  485test_installation(_Options) :-
  486    print_message(warning, installation(testing(no_installed_tests))).
  487
  488test_installation_run(TestFile, Options) :-
  489    (   option(package(_), Options)
  490    ->  merge_options(Options,
  491                      [ core(false),
  492                        subdirs(false)
  493                      ], TestOptions)
  494    ;   merge_options(Options,
  495                      [ packages(true)
  496                      ], TestOptions)
  497    ),
  498    load_files(user:TestFile),
  499    current_prolog_flag(verbose, Old),
  500    setup_call_cleanup(
  501        set_prolog_flag(verbose, silent),
  502        user:test([], TestOptions),
  503        set_prolog_flag(verbose, Old)).
  504
  505
  506                 /*******************************
  507                 *            MESSAGES          *
  508                 *******************************/
  509
  510:- multifile
  511    prolog:message//1.  512
  513print_issue(Term) :-
  514    assertz(issue(Term)),
  515    print_message(warning, Term).
  516
  517issue_url(Properties, URL) :-
  518    Local = Properties.get(url),
  519    !,
  520    issue_base(Base),
  521    atom_concat(Base, Local, URL).
  522issue_url(Properties, URL) :-
  523    Properties.get(source) = library(Segments),
  524    !,
  525    path_segments_atom(Segments, Base),
  526    file_name_extension(Base, html, URLFile),
  527    issue_base(Issues),
  528    atom_concat(Issues, URLFile, URL).
  529
  530prolog:message(installation(Message)) -->
  531    message(Message).
  532
  533message(checking) -->
  534    { current_prolog_flag(address_bits, Bits) },
  535    { current_prolog_flag(arch, Arch) },
  536    { current_prolog_flag(home, Home) },
  537    { current_prolog_flag(cpu_count, Cores) },
  538    [ 'Checking your SWI-Prolog kit for common issues ...'-[], nl, nl ],
  539    [ 'Version: ~`.t~24| '-[] ], '$messages':prolog_message(version), [nl],
  540    [ 'Address bits: ~`.t~24| ~d'-[Bits] ], [nl],
  541    [ 'Architecture: ~`.t~24| ~w'-[Arch] ], [nl],
  542    [ 'Installed at: ~`.t~24| ~w'-[Home] ], [nl],
  543    [ 'Cores: ~`.t~24| ~w'-[Cores] ], [nl],
  544    [ nl ].
  545message(perfect) -->
  546    [ nl, 'Congratulations, your kit seems sound and complete!'-[] ].
  547message(imperfect(N)) -->
  548    [ 'Found ~w issues.'-[N] ].
  549message(checking(Feature)) -->
  550    [ 'Checking ~w ...'-[Feature], flush ].
  551message(missing(Properties)) -->
  552    [ at_same_line, '~`.t~48| not present'-[] ],
  553    details(Properties).
  554message(loading(Source)) -->
  555    [ 'Loading ~q ...'-[Source], flush ].
  556message(ok) -->
  557    [ at_same_line, '~`.t~48| ok'-[] ].
  558message(optional_not_found(Properties)) -->
  559    [ 'Optional ~q ~`.t~48| not present'-[Properties.source] ].
  560message(not_found(Properties)) -->
  561    [ '~q ~`.t~48| NOT FOUND'-[Properties.source] ],
  562    details(Properties).
  563message(failed(Properties, false, [])) -->
  564    !,
  565    [ at_same_line, '~`.t~48| FAILED'-[] ],
  566    details(Properties).
  567message(failed(Properties, exception(Ex0), [])) -->
  568    !,
  569    { strip_stack(Ex0, Ex),
  570      message_to_string(Ex, Msg) },
  571    [ '~w'-[Msg] ],
  572    details(Properties).
  573message(failed(Properties, true, Messages)) -->
  574    [ at_same_line, '~`.t~48| FAILED'-[] ],
  575    explain(Messages),
  576    details(Properties).
  577message(archive(What, Names)) -->
  578    [ '  Supported ~w: '-[What] ],
  579    list_names(Names).
  580message(pcre_missing(Features)) -->
  581    [ 'Missing libpcre features: '-[] ],
  582    list_names(Features).
  583message(not_first_on_path(EXE, OnPath)) -->
  584    { public_executable(EXE, PublicEXE),
  585      file_base_name(EXE, Prog)
  586    },
  587    [ 'The first ~w on '-[Prog] ], 'PATH', [ ' is ~p, while '-[OnPath], nl ],
  588    [ 'this version is ~p.'-[PublicEXE] ].
  589message(not_same_on_path(EXE, OnPath)) -->
  590    { public_executable(EXE, PublicEXE),
  591      file_base_name(EXE, Prog)
  592    },
  593    [ 'The ~w on '-[Prog] ], 'PATH', [ ' is ~p, while '-[OnPath], nl ],
  594    [ 'this version is ~p.'-[PublicEXE] ].
  595message(not_on_path(EXE, Prog)) -->
  596    { public_bin_dir(EXE, Dir),
  597      prolog_to_os_filename(Dir, OSDir)
  598    },
  599    [ 'Could not find ~w on '-[Prog] ], 'PATH', [ '. '-[], nl ],
  600    [ 'You may wish to add ~p to '-[OSDir] ], 'PATH', [ '. '-[], nl ].
  601message(jquery(found(Path))) -->
  602    [ '  jQuery from ~w'-[Path] ].
  603message(jquery(not_found(File))) -->
  604    [ '  Cannot find jQuery (~w)'-[File] ].
  605message(testing(no_installed_tests)) -->
  606    [ '  Runtime testing is not enabled.', nl],
  607    [ '  Please recompile the system with INSTALL_TESTS enabled.' ].
  608
  609
  610public_executable(EXE, PublicProg) :-
  611    file_base_name(EXE, Prog),
  612    file_directory_name(EXE, ArchDir),
  613    file_directory_name(ArchDir, BinDir),
  614    file_directory_name(BinDir, Home),
  615    file_directory_name(Home, Lib),
  616    file_directory_name(Lib, Prefix),
  617    atomic_list_concat([Prefix, bin, Prog], /, PublicProg),
  618    exists_file(PublicProg),
  619    same_file(EXE, PublicProg),
  620    !.
  621public_executable(EXE, EXE).
  622
  623public_bin_dir(EXE, Dir) :-
  624    public_executable(EXE, PublicEXE),
  625    file_directory_name(PublicEXE, Dir).
  626
  627
  628
  629'PATH' -->
  630    { current_prolog_flag(windows, true) },
  631    !,
  632    [ '%PATH%'-[] ].
  633'PATH' -->
  634    [ '$PATH'-[] ].
  635
  636strip_stack(error(Error, context(prolog_stack(S), Msg)),
  637            error(Error, context(_, Msg))) :-
  638    nonvar(S).
  639strip_stack(Error, Error).
  640
  641details(Properties) -->
  642    { issue_url(Properties, URL), !
  643    },
  644    [ nl, 'See ~w'-[URL] ].
  645details(_) --> [].
  646
  647explain(Messages) -->
  648    { Messages = [message(error(shared_object(open, _Message), _), _, _)|_]
  649    },
  650    !,
  651    [nl],
  652    (   { current_prolog_flag(windows, true) }
  653    ->  [ 'Cannot load required DLL'-[] ]
  654    ;   [ 'Cannot load required shared library'-[] ]
  655    ).
  656explain(Messages) -->
  657    print_messages(Messages).
  658
  659print_messages([]) --> [].
  660print_messages([message(_Term, _Kind, Lines)|T]) -->
  661    Lines, [nl],
  662    print_messages(T).
  663
  664list_names([]) --> [].
  665list_names([H|T]) -->
  666    [ '~w'-[H] ],
  667    (   {T==[]}
  668    ->  []
  669    ;   [ ', '-[] ],
  670        list_names(T)
  671    ).
  672
  673
  674		 /*******************************
  675		 *          CONFIG FILES	*
  676		 *******************************/
  677
  678%!  check_config_files
  679%
  680%   Examines the locations of config files.  The config files have moved
  681%   in version 8.1.15
  682
  683check_config_files :-
  684    check_config_files(Issues),
  685    maplist(print_message(warning), Issues).
  686
  687check_config_files(Issues) :-
  688    findall(Issue, check_config_file(Issue), Issues).
  689
  690check_config_file(config(Id, move(Type, OldFile, NewFile))) :-
  691    old_config(Type, Id, OldFile),
  692    access_file(OldFile, exist),
  693    \+ ( new_config(Type, Id, NewFile),
  694         access_file(NewFile, exist)
  695       ),
  696    once(new_config(Type, Id, NewFile)).
  697check_config_file(config(Id, different(Type, OldFile, NewFile))) :-
  698    old_config(Type, Id, OldFile),
  699    access_file(OldFile, exist),
  700    new_config(Type, Id, NewFile),
  701    access_file(NewFile, exist),
  702    \+ same_file(OldFile, NewFile).
  703
  704%!  update_config_files
  705%
  706%   Move config files from their old location to  the new if the file or
  707%   directory exists in the old location but not in the new.
  708
  709update_config_files :-
  710    old_config(Type, Id, OldFile),
  711    access_file(OldFile, exist),
  712    \+ ( new_config(Type, Id, NewFile),
  713         access_file(NewFile, exist)
  714       ),
  715    (   new_config(Type, Id, NewFile),
  716        \+ same_file(OldFile, NewFile),
  717        create_parent_dir(NewFile)
  718    ->  catch(rename_file(OldFile, NewFile), E,
  719              print_message(warning, E)),
  720        print_message(informational, config(Id, moved(Type, OldFile, NewFile)))
  721    ),
  722    fail.
  723update_config_files.
  724
  725old_config(file, init, File) :-
  726    current_prolog_flag(windows, true),
  727    win_folder(appdata, Base),
  728    atom_concat(Base, '/SWI-Prolog/swipl.ini', File).
  729old_config(file, init, File) :-
  730    expand_file_name('~/.swiplrc', [File]).
  731old_config(directory, lib, Dir) :-
  732    expand_file_name('~/lib/prolog', [Dir]).
  733old_config(directory, xpce, Dir) :-
  734    expand_file_name('~/.xpce', [Dir]).
  735old_config(directory, history, Dir) :-
  736    expand_file_name('~/.swipl-dir-history', [Dir]).
  737old_config(directory, pack, Dir) :-
  738    (   catch(expand_file_name('~/lib/swipl/pack', [Dir]), _, fail)
  739    ;   absolute_file_name(swi(pack), Dir,
  740                           [ file_type(directory), solutions(all) ])
  741    ).
  742
  743new_config(file, init, File) :-
  744    absolute_file_name(user_app_config('init.pl'), File,
  745                       [ solutions(all) ]).
  746new_config(directory, lib, Dir) :-
  747    config_dir(user_app_config(lib), Dir).
  748new_config(directory, xpce, Dir) :-
  749    config_dir(user_app_config(xpce), Dir).
  750new_config(directory, history, Dir) :-
  751    config_dir(user_app_config('dir-history'), Dir).
  752new_config(directory, pack, Dir) :-
  753    config_dir([app_data(pack), swi(pack)], Dir).
  754
  755config_dir(Aliases, Dir) :-
  756    is_list(Aliases),
  757    !,
  758    (   member(Alias, Aliases),
  759        absolute_file_name(Alias, Dir,
  760                           [ file_type(directory), solutions(all) ])
  761    *-> true
  762    ;   member(Alias, Aliases),
  763        absolute_file_name(Alias, Dir,
  764                           [ solutions(all) ])
  765    ).
  766config_dir(Alias, Dir) :-
  767    (   absolute_file_name(Alias, Dir,
  768                           [ file_type(directory), solutions(all) ])
  769    *-> true
  770    ;   absolute_file_name(Alias, Dir,
  771                           [ solutions(all) ])
  772    ).
  773
  774create_parent_dir(NewFile) :-
  775    file_directory_name(NewFile, Dir),
  776    create_parent_dir_(Dir).
  777
  778create_parent_dir_(Dir) :-
  779    exists_directory(Dir),
  780    '$my_file'(Dir),
  781    !.
  782create_parent_dir_(Dir) :-
  783    file_directory_name(Dir, Parent),
  784    Parent \== Dir,
  785    create_parent_dir_(Parent),
  786    make_directory(Dir).
  787
  788prolog:message(config(Id, Issue)) -->
  789    [ 'Config: '-[] ],
  790    config_description(Id),
  791    config_issue(Issue).
  792
  793config_description(init) -->
  794    [ '(user initialization file) '-[], nl ].
  795config_description(lib) -->
  796    [ '(user library) '-[], nl ].
  797config_description(pack) -->
  798    [ '(add-ons) '-[], nl ].
  799config_description(history) -->
  800    [ '(command line history) '-[], nl ].
  801config_description(xpce) -->
  802    [ '(gui) '-[], nl ].
  803
  804config_issue(move(Type, Old, New)) -->
  805    [ '  found ~w "~w"'-[Type, Old], nl ],
  806    [ '  new location is "~w"'-[New] ].
  807config_issue(moved(Type, Old, New)) -->
  808    [ '  found ~w "~w"'-[Type, Old], nl ],
  809    [ '  moved to new location "~w"'-[New] ].
  810config_issue(different(Type, Old, New)) -->
  811    [ '  found different ~w "~w"'-[Type, Old], nl ],
  812    [ '  new location is "~w"'-[New] ]