View source with formatted comments or as raw
    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(cpa_config, []).   37:- use_bundle(html_page).   38:- use_module(library(conf_d)).   39:- use_module(library(pairs)).   40:- use_module(library(apply)).   41:- use_module(library(ordsets)).   42:- use_module(pldoc(doc_index)).   43:- use_module(cliopatria(hooks)).   44:- use_module(user(user_db)).   45:- use_module(components(messages)).   46:- if(exists_source(library(filesex))).   47:- use_module(library(filesex)).   48:- endif.   49
   50/** <module> ClioPatria configuration interface
   51
   52This application provides a web-interface   for configuration management
   53by adding files to =|config-enabled|=.
   54*/
   55
   56:- http_handler(cliopatria('admin/configuration'), configuration, []).   57:- http_handler(cliopatria('admin/reconfigure'),   reconfigure,	  []).   58
   59cliopatria:menu_item(250=admin/configuration,  'Plugins').
   60
   61%%	configuration(+Request)
   62%
   63%	HTTP handler that shows the  current   status  of  available and
   64%	installed configuration modules.
   65
   66configuration(_Request) :-
   67	authorized(admin(config)),
   68	reply_html_page(cliopatria(admin),
   69			title('Server plugin configuration'),
   70			[ h1('Server plugin configuration'),
   71			  \edit_config_table([edit(true)]),
   72			  \insert_html_file(html('help-config.html'))
   73			]).
   74
   75%%	edit_config_table(+Options)
   76%
   77%	HTML  Component  that  shows   the    available   and  installed
   78%	configuration components.
   79
   80edit_config_table(Options) -->
   81	{ option(edit(true), Options) }, !,
   82	html(form([ action(location_by_id(reconfigure)),
   83		    method('GET')
   84		  ],
   85		  \config_table(Options))).
   86edit_config_table(Options) -->
   87	config_table(Options).
   88
   89config_table(Options) -->
   90	{ config_files(Configs)
   91	},
   92	html(table(class(form),
   93		   [ \config_table_header
   94		   | \config_modules(Configs, 1, Options)
   95		   ])).
   96
   97config_table_header -->
   98	html(tr(class(header),
   99		[th('Config'), th('Title'), th('Status')])).
  100
  101config_modules([], _, Options) -->
  102	(   { option(edit(true), Options) }
  103	->  html(tr(class(buttons),
  104		    td([ colspan(3), align(right), style('padding-top:1em;')
  105		       ],
  106		       [ input(type(reset)),
  107			 input([type(submit),value('Update configuration')])
  108		       ])))
  109	;   []
  110	).
  111config_modules([H|T], OE, Options) -->
  112	{ config_module_status(H, Status) },
  113	odd_even_row(OE, OE1, \config_module(Status, H, Options)),
  114	config_modules(T, OE1, Options).
  115
  116config_module_status(_-[_,-], not) :- !.
  117config_module_status(_-[-,_], local) :- !.
  118config_module_status(_-[Templ,Installed], Status) :-
  119	conf_d_member_data(file, Templ, TemplFile),
  120	conf_d_member_data(file, Installed, InstalledFile),
  121	compare_files(TemplFile, InstalledFile, Status).
  122
  123config_module(Status, Data, Options) -->
  124	{ Data = Key-_Members,
  125	  prop_member(Status, Data, Props)
  126	},
  127	html([ td(\config_key(Key, Props)),
  128	       td(\config_title(Props)),
  129	       \config_installed(Status, Key, Options)
  130	     ]).
  131
  132prop_member(not, _-[Templ,_], Templ) :- !.
  133prop_member(_,	 _-[_,Installed], Installed).
  134
  135
  136config_key(Key, Data) -->
  137	{ conf_d_member_data(file, Data, File),
  138	  doc_file_href(File, HREF)
  139	},
  140	html(a(href(HREF), Key)).
  141
  142config_title(Data) -->
  143	{ conf_d_member_data(title, Data, Title) }, !,
  144	html([ Title ]).
  145config_title(_) -->
  146	html([]).
  147
  148config_installed(Value, Key, Options) -->
  149	{ option(edit(true), Options),
  150	  findall(o(O,L,LC), ( option(O,L,A,LC),
  151			       (   Value==O
  152			       ->  true
  153			       ;   memberchk(Value, A)
  154			       )
  155			     ),
  156		  Pairs)
  157	}, !,
  158	html(td(class(buttons),
  159		select([name(Key),style('width:100%')],
  160		       \installed_options(Pairs, Value)))).
  161config_installed(Value, _, _) -->
  162	{ option(Value, Label, _, _)
  163	},
  164	html(td(Label)).
  165
  166installed_options([], _) --> [].
  167installed_options([H|T], Value) -->
  168	installed_option(H, Value),
  169	installed_options(T, Value).
  170
  171installed_option(o(V,L,_LC), V) -->
  172	html(option([value(V),selected], L)).
  173installed_option(o(V,_L,LC), _) -->
  174	html(option([value(V),class(change)], LC)).
  175
  176option(not,				% Id
  177       'Not installed',			% Label if current status
  178       [linked,copied,modified],	% State that can be changed to me
  179       'Remove').			% Label to change
  180option(linked,
  181       'Installed (linked)',
  182       [not,copied,modified],
  183       'Link').
  184option(copied,
  185       'Installed (copied)',
  186       [not,linked,modified],
  187       'Copy').
  188option(modified,
  189       'Installed (modified)',
  190       [],
  191       '').
  192option(local,
  193       'Local',
  194       [],
  195       '').
  196
  197%%	compare_files(+File, +File2, -Status) is det.
  198%
  199%	Compare  two  files,  unifying  Status  with  one  of  =linked=,
  200%	=copied= or =modified=.
  201
  202compare_files(Templ, Installed, Status) :-
  203	(   same_file(Templ, Installed)
  204	->  Status = linked
  205	;   link_file(Installed)
  206	->  Status = linked
  207	;   same_file_content(Templ, Installed)
  208	->  Status = copied
  209	;   Status = modified
  210	).
  211
  212link_file(File) :-
  213	setup_call_cleanup(open(File, read, In),
  214			   read_line_to_codes(In, Line),
  215			   close(In)),
  216	atom_codes('/* Linked config file */', Line).
  217
  218same_file_content(File1, File2) :-
  219	setup_call_cleanup((open(File1, read, In1),
  220			    open(File2, read, In2)),
  221			   same_stream_content(In1, In2),
  222			   (close(In2), close(In1))).
  223
  224same_stream_content(In1, In2) :-
  225	get_code(In1, C1),
  226	get_code(In2, C2),
  227	same_stream_content(C1, C2, In1, In2).
  228
  229same_stream_content(C, C, In1, In2) :-
  230	(   C == -1
  231	->  true
  232	;   same_stream_content(In1, In2)
  233	).
  234
  235
  236%%	config_files(-Configs)
  237%
  238%	Get the current configuration status.
  239
  240config_files(Configs) :-
  241	conf_d_configuration(config_available(.),
  242			     'config-enabled',
  243			     Configs).
  244
  245
  246%%	reconfigure(+Request)
  247%
  248%	Update configuration on the basis of the menu.
  249
  250reconfigure(Request) :-
  251	authorized(admin(reconfigure)),
  252	http_link_to_id(configuration, [], HREF),
  253	http_parameters(Request, [], [form_data(Form)]),
  254	call_showing_messages(update_config(Form),
  255			      [ footer(h4(['Done. ',
  256					   a(href(HREF),
  257					     'back to configuration')]))
  258			      ]).
  259
  260update_config(Form) :-
  261	config_files(Configs),
  262	maplist(update_config_key(Form, Updated), Configs),
  263	(   var(Updated)
  264	->  print_message(informational, config(no_changes))
  265	;   conf_d_reload
  266	).
  267
  268update_config_key(Form, Updated, Config) :-
  269	Config = Key-Versions,
  270	config_module_status(Config, CurrentStatus),
  271	(   memberchk(Key=NewStatus, Form),
  272	    NewStatus \== CurrentStatus
  273	->  update_config_file(CurrentStatus, NewStatus, Versions),
  274	    Updated = true
  275	;   true
  276	).
  277
  278update_config_file(linked, not, [_,Installed]) :- !,
  279	conf_d_member_data(file, Installed, File),
  280	delete_file(File),
  281	print_message(informational, config(delete(File))).
  282update_config_file(_, not, [_,Installed]) :- !,
  283	conf_d_member_data(file, Installed, File),
  284	atom_concat(File, '.disabled', DisabledFile),
  285	catch(delete_file(DisabledFile), _, true),
  286	rename_file(File, DisabledFile),
  287	print_message(informational, config(rename(File, DisabledFile))).
  288update_config_file(not, linked, [Templ,_]) :-
  289	conf_d_member_data(file, Templ, File),
  290	file_base_name(File, Base),
  291	local_conf_dir(Dir),
  292	atomic_list_concat([Dir, /, Base], NewFile),
  293	link_prolog_file(File, NewFile),
  294	print_message(informational, config(link(NewFile))).
  295update_config_file(copied, linked, [Templ,Installed]) :-
  296	conf_d_member_data(file, Templ, TemplFile),
  297	conf_d_member_data(file, Installed, InstalledFile),
  298	delete_file(InstalledFile),
  299	link_prolog_file(TemplFile, InstalledFile),
  300	print_message(informational, config(link(InstalledFile))).
  301update_config_file(not, copied, [Templ,_]) :-
  302	conf_d_member_data(file, Templ, File),
  303	file_base_name(File, Base),
  304	local_conf_dir(Dir),
  305	atomic_list_concat([Dir, /, Base], NewFile),
  306	copy_file(File, NewFile),
  307	print_message(informational, config(copy(NewFile))).
  308update_config_file(linked, copied, [Templ,Installed]) :-
  309	conf_d_member_data(file, Templ, TemplFile),
  310	conf_d_member_data(file, Installed, InstalledFile),
  311	delete_file(InstalledFile),
  312	copy_file(TemplFile, InstalledFile),
  313	print_message(informational, config(copy(InstalledFile))).
  314
  315
  316%%	link_prolog_file(+SourcePath, +DestDir) is det.
  317%
  318%	Install a skeleton file by linking it.  If it is not possible to
  319%	create a symbolic link (typically on  system that do not support
  320%	proper links such as Windows), create  a Prolog `link' file that
  321%	loads the target.
  322%
  323%	@see	copied from library(setup). Do not alter without
  324%		synchronising.
  325
  326link_prolog_file(Source, Dest) :-
  327	relative_file_name(Source, Dest, Rel),
  328	catch(link_file(Rel, Dest, symbolic), Error, true),
  329	(   var(Error)
  330	->  true
  331	;   catch(create_link_file(Dest, Rel), E2, true)
  332	->  (   var(E2)
  333	    ->	true
  334	    ;	throw(E2)
  335	    )
  336	;   throw(Error)
  337	).
  338
  339%%	create_link_file(+Dest, +Rel) is det.
  340%
  341%	Creat a _|link file|_ for a Prolog file. Make sure to delete the
  342%	target first, to avoid an accidental   write  through a symbolic
  343%	link.
  344
  345create_link_file(Dest, Rel) :-
  346	(   access_file(Dest, exist)
  347	->  delete_file(Dest)
  348	;   true
  349	),
  350	setup_call_cleanup(open(Dest, write, Out),
  351			   ( format(Out, '/* Linked config file */~n', []),
  352			     format(Out, ':- ~q.~n', [consult(Rel)])
  353			   ),
  354			   close(Out)).
  355
  356
  357local_conf_dir(Dir) :-
  358	absolute_file_name('config-enabled', Dir,
  359			   [ file_type(directory),
  360			     access(write)
  361			   ]).
  362
  363
  364:- multifile prolog:message//1.  365
  366prolog:message(config(Action)) -->
  367	message(Action).
  368
  369message(delete(File)) --> ['Deleted '], file(File).
  370message(rename(Old, New)) --> ['Renamed '], file(Old), [' into '], file(New).
  371message(link(File)) --> ['Linked '], file(File).
  372message(copy(File)) --> ['Copied '], file(File).
  373message(no_changes) --> ['No changes; configuration is left untouched'].
  374
  375file(Path) -->
  376	{ working_directory(Dir,Dir),
  377	  ensure_slash(Dir, RelTo),
  378	  relative_file_name(Path, RelTo, Rel)
  379	},
  380	[ '~w'-[Rel] ].
  381
  382ensure_slash(Dir0, Dir) :-
  383	(   sub_atom(Dir0, _, _, 0, /)
  384	->  Dir = Dir0
  385	;   atom_concat(Dir0, /, Dir)
  386	)