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