35
36:- module(check_installation,
37 [ check_installation/0,
38 check_installation/1, 39 check_config_files/0,
40 update_config_files/0,
41 test_installation/0,
42 test_installation/1 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
59
82
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 }).
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
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
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
248
249test_component(Dict) :-
250 Test = Dict.get(test),
251 !,
252 call(Test).
253test_component(_).
254
261
262check_features(Dict) :-
263 Test = Dict.get(features),
264 !,
265 call(Test).
266check_features(_).
267
268
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
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 319
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
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
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
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
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 457
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 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 677
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
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] ]