1/*****************************************************************************
    2 * This file is part of the Prolog Development Tool (PDT)
    3 * 
    4 * Author: Lukas Degener (among others)
    5 * WWW: http://sewiki.iai.uni-bonn.de/research/pdt/start
    6 * Mail: pdt@lists.iai.uni-bonn.de
    7 * Copyright (C): 2004-2012, CS Dept. III, University of Bonn
    8 * 
    9 * All rights reserved. This program is  made available under the terms
   10 * of the Eclipse Public License v1.0 which accompanies this distribution,
   11 * and is available at http://www.eclipse.org/legal/epl-v10.html
   12 * 
   13 ****************************************************************************/
   14
   15/* NOTE: This file contains third-party code!
   16
   17   Most of this file was borrowed from the swi-prolog library 
   18   prolog_server. Many thanks to the original authors for making their 
   19   work available to the public. 
   20   
   21   I changed the following things:
   22   1) added a way to gracefully stop the console server accept loop
   23   2) changed the naming policy for thread alias names, so that more
   24      than one client may connect from the same host.
   25   
   26   The copyright header of the original file 
   27   follows.
   28   	--lu
   29*/
   30
   31/*  $Id$
   32
   33    Part of SWI-Prolog
   34
   35    Author:        Jan Wielemaker & Steve Prior
   36    E-mail:        jan@swi.psy.uva.nl
   37    WWW:           http://www.swi-prolog.org
   38    Copyright (C): 1985-2002, University of Amsterdam
   39
   40    This program is free software; you can redistribute it and/or
   41    modify it under the terms of the GNU General Public License
   42    as published by the Free Software Foundation; either version 2
   43    of the License, or (at your option) any later version.
   44
   45    This program is distributed in the hope that it will be useful,
   46    but WITHOUT ANY WARRANTY; without even the implied warranty of
   47    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   48    GNU General Public License for more details.
   49
   50    You should have received a copy of the GNU Lesser General Public
   51    License along with this library; if not, write to the Free Software
   52    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   53
   54    As a special exception, if you link this library with other files,
   55    compiled with a Free Software compiler, to produce an executable, this
   56    library does not by itself cause the resulting executable to be covered
   57    by the GNU General Public License. This exception does not however
   58    invalidate any other reasons why the executable file might be covered by
   59    the GNU General Public License.
   60*/
   61   
   62   
   63
   64:- module(pdt_console_server,[
   65	pdt_current_console_server/1,
   66	pdt_start_console_server/2,
   67	pdt_stop_console_server/0,
   68	console_thread_name/1
   69]).   70:- use_module(library(socket)).   71:- use_module(library(lists)).   72 
   73
   74console_thread_name(Name) :-
   75	console_thread_name__(Name).
   76
   77:- dynamic(console_thread_name__/1).   78
   79:- dynamic(pdt_console_client_id/1).   80
   81reset_pdt_console_client_id :-
   82	retractall(pdt_console_client_id(_)),
   83	assertz(pdt_console_client_id(0)).
   84
   85next_pdt_console_client_id(Id) :-
   86	retract(pdt_console_client_id(Id)),
   87	!,
   88	Next is Id + 1,
   89	asserta(pdt_console_client_id(Next)).
   90
   91prolog_server(Port, Name, Options) :-
   92	tcp_socket(ServerSocket),
   93	tcp_setopt(ServerSocket, reuseaddr),
   94	tcp_bind(ServerSocket, Port),
   95	tcp_listen(ServerSocket, 5),
   96	thread_create(server_loop(ServerSocket, Name, Options), _,
   97		      [ alias(pdt_console_server)
   98		      ]).
   99 
  100server_loop(ServerSocket, Name, Options):-
  101    server_loop_impl(ServerSocket, Name, Options),
  102    thread_exit(0).
  103server_loop_impl(ServerSocket, Name, Options) :-
  104	tcp_accept(ServerSocket, Slave, Peer),
  105	server_loop_impl_X(ServerSocket,Name,Options,Slave,Peer).
  106
  107server_loop_impl_X(ServerSocket,_,_,Slave,_) :-
  108	recorded(pdt_console_server_flag,shutdown,Ref),
  109	!,
  110	erase(Ref),
  111	% the accepted connection is just a "wakeup call" we can savely discard it.
  112    tcp_close_socket(Slave),
  113    % that's it, we are closing down business.
  114    tcp_close_socket(ServerSocket).	
  115server_loop_impl_X(ServerSocket,Name,Options,Slave,Peer):-	
  116	tcp_open_socket(Slave, InStream, OutStream),
  117	set_stream(InStream,encoding(utf8)),
  118    set_stream(OutStream,encoding(utf8)),
  119%	tcp_host_to_address(Host, Peer),
  120    next_pdt_console_client_id(Id),
  121	atomic_list_concat(['pdt_console_client_',Id,'_',Name],Alias),
  122	thread_create(service_client(InStream, OutStream, Peer, Options),
  123		      ID,
  124		      [ alias(Alias)
  125		      ]),
  126	retractall(console_thread_name__(_)),
  127	assertz(console_thread_name__(ID)),
  128	server_loop_impl(ServerSocket, Name, Options).
  129 
  130service_client(InStream, OutStream, Peer, Options) :-
  131	allow(Peer, Options), !,
  132	thread_self(Id),
  133	set_prolog_IO(InStream, OutStream, OutStream),
  134    set_stream(user_error,encoding(utf8)),
  135    catch(set_prolog_flag(color_term, false), _, true),
  136	format(user_error,
  137	       'Welcome to the SWI-Prolog server on thread ~w~n~n',
  138	       [Id]),
  139	run_prolog,
  140	close(InStream),
  141	close(OutStream),
  142	thread_detach(Id).
  143service_client(InStream, OutStream, _, _):-
  144	thread_self(Id),
  145	format(OutStream, 'Go away!!~n', []),
  146	close(InStream),
  147	close(OutStream),
  148	thread_detach(Id).
  149
  150
  151run_prolog :-
  152	catch(prolog, E,
  153	      ( print_message(error, E),
  154%		E = error(_, _),
  155		run_prolog)).
  156
  157
  158allow(Peer, Options) :-
  159	(   member(allow(Allow), Options)
  160	*-> Peer = Allow,
  161	    !
  162	;   Peer = ip(127,0,0,1)
  163	).
  164
  165% TODO make this dependency explicit!
  166%:- use_module(library('org/cs3/pdt/runtime/consult_server')).
  167
  168% server(-Port)
  169%
  170% used internally to store information about running servers
  171:- dynamic(server/1).  172
  173:- initialization(mutex_create(pdt_console_server_mux)).  174:- at_halt(mutex_destroy(pdt_console_server_mux)).  175
  176% pdt_current_console_server(-Port, -LockFile).
  177% retrieve information about running servers
  178pdt_current_console_server(Port) :-
  179    with_mutex(pdt_console_server_mux,
  180	    server(Port)
  181    ).
  182    
  183
  184% pdt_start_console_server(?TCPPort)
  185% starts a new console server.
  186% UDPPort is used for sending back a sync when the server is up.
  187pdt_start_console_server(Port, Name) :-
  188    with_mutex(pdt_console_server_mux,
  189    	start_server(Port, Name)
  190    ).
  191
  192% pdt_stop_console_server(+LockFile)
  193% stops the console server, removing the Lockfile.
  194pdt_stop_console_server:-
  195    with_mutex(pdt_console_server_mux,
  196    	stop_server
  197    ).
  198
  199:- multifile(consult_server:process_shutdown_hook/0).  200:- dynamic(consult_server:process_shutdown_hook/0).  201consult_server:process_shutdown_hook:-
  202    pdt_stop_console_server.
  203
  204start_server(Port, Name) :-
  205    \+ thread_property(_, alias(pdt_console_server)),
  206    reset_pdt_console_client_id,
  207    prolog_server(Port, Name, []),
  208    assertz(server(Port)).
  209
  210stop_server :-
  211	server(Port),
  212	!,
  213	do_stop_server(Port).
  214stop_server.
  215
  216do_stop_server(Port) :-
  217	recordz(pdt_console_server_flag, shutdown, _),
  218	tcp_socket(Socket),
  219	tcp_connect(Socket, localhost:Port),
  220	tcp_close_socket(Socket),
  221	retractall(server(Port))