1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@cs.vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2009, VU University Amsterdam
    7
    8    This program is free software; you can redistribute it and/or
    9    modify it under the terms of the GNU General Public License
   10    as published by the Free Software Foundation; either version 2
   11    of the License, or (at your option) any later version.
   12
   13    This program is distributed in the hope that it will be useful,
   14    but WITHOUT ANY WARRANTY; without even the implied warranty of
   15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   16    GNU General Public License for more details.
   17
   18    You should have received a copy of the GNU General Public
   19    License along with this library; if not, write to the Free Software
   20    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   21
   22    As a special exception, if you link this library with other files,
   23    compiled with a Free Software compiler, to produce an executable, this
   24    library does not by itself cause the resulting executable to be covered
   25    by the GNU General Public License. This exception does not however
   26    invalidate any other reasons why the executable file might be covered by
   27    the GNU General Public License.
   28*/
   29
   30:- module(web_update,
   31	  [ db_sync_thread/0,
   32	    db_sync_thread/1			% +Time
   33	  ]).   34:- use_module(library(http/http_dispatch)).   35:- use_module(library(http/http_authenticate)).   36:- use_module(library(http/html_write)).   37:- use_module(library(readutil)).   38:- use_module(library(process)).   39:- use_module(library(persistency)).   40:- use_module(library(socket)).   41
   42:- use_module(parms).   43
   44:- http_handler(root(update), update, []).   45
   46:- meta_predicate
   47	collect_messages(0, -).   48
   49%%	update(+Request)
   50%
   51%	HTTP Handler for /update.  Performs  a   GIT  pull  and a Prolog
   52%	make/0.
   53
   54update(Request) :-
   55	(   http_authenticate(basic(private(passwd)), Request, _User)
   56	->  true
   57	;   throw(http_reply(authorise(basic, 'Admin user')))
   58	),
   59	reply_html_page(title('Server update'),
   60			[ h1('Server update'),
   61			  hr([]),
   62			  h2('GIT'),
   63			  \git_update,
   64			  h2('make'),
   65			  \make,
   66			  h2('Persistent file sync'),
   67			  \db_sync
   68			]).
   69
   70
   71%%	git_update//
   72%
   73%	Run =|git update|=, collecting the output
   74
   75git_update -->
   76	{ process_create(path(git), [pull],
   77			 [ stdout(pipe(Out)),
   78			   stderr(pipe(Error))
   79			 ]),
   80	  read_stream_to_codes(Out, OutCodes),
   81	  read_stream_to_codes(Error, ErrorCodes),
   82	  close(Out),
   83	  close(Error)
   84	},
   85	output('', informational, OutCodes),
   86	output('', error, ErrorCodes).
   87
   88output(_Prefix, _Class, Codes) -->
   89	{ Codes == [] }, !.
   90output(Prefix, Class, Codes) -->
   91	html(pre(class(Class),
   92		 [ Prefix, '~s'-[Codes] ])).
   93
   94%%	make//
   95%
   96%	Run make, collecting output
   97
   98make -->
   99	{ collect_messages(make, Messages)
  100	},
  101	messages(Messages).
  102
  103
  104:- thread_local
  105	message/2.  106
  107collect_messages(Goal, Messages) :-
  108	asserta((user:thread_message_hook(_Term, Level, Lines) :-
  109			assert(message(Level, Lines))), Ref),
  110	call_cleanup(Goal, erase(Ref)),
  111	findall(Level-Lines, retract(message(Level, Lines)), Messages).
  112
  113messages([]) -->
  114	[].
  115messages([H|T]) -->
  116	message(H),
  117	messages(T).
  118
  119message(Level-Lines) -->
  120	html(div(class(Level), \html_message_lines(Lines))).
  121
  122html_message_lines([]) -->
  123	[].
  124html_message_lines([nl|T]) --> !,
  125	html([br([])]),
  126	html_message_lines(T).
  127html_message_lines([flush]) -->
  128	[].
  129html_message_lines([Fmt-Args|T]) --> !,
  130	{ format(string(S), Fmt, Args)
  131	},
  132	html([S]),
  133	html_message_lines(T).
  134html_message_lines([Fmt|T]) --> !,
  135	{ format(string(S), Fmt, [])
  136	},
  137	html([S]),
  138	html_message_lines(T).
  139
  140db_sync -->
  141	{ db_sync_all(reload) }.
  142
  143db_sync_thread :-
  144	gethostname(HostName),
  145	server(slave, _, HostName), !,
  146	db_sync_thread(3600).
  147db_sync_thread.
  148
  149%%	db_sync_thread(+Time)
  150%
  151%	Sync the persistency database every Time seconds.
  152
  153db_sync_thread(Time) :-
  154	catch(thread_create(sync_loop(Time), _,
  155			    [ alias('__sync_db') ]),
  156	      E, print_message(warning, E)).
  157
  158sync_loop(Time) :-
  159	repeat,
  160	sleep(Time),
  161	catch(db_sync_all(reload),
  162	      E, print_message(warning, E)),
  163	fail