% ----------------------------------------------------------------------
% BEGIN LICENSE BLOCK
% Version: CMPL 1.1
%
% The contents of this file are subject to the Cisco-style Mozilla Public
% License Version 1.1 (the "License"); you may not use this file except
% in compliance with the License.  You may obtain a copy of the License
% at www.eclipseclp.org/license.
% 
% Software distributed under the License is distributed on an "AS IS"
% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
% the License for the specific language governing rights and limitations
% under the License. 
% 
% The Original Code is  The ECLiPSe Constraint Logic Programming System. 
% The Initial Developer of the Original Code is  Cisco Systems, Inc. 
% Portions created by the Initial Developer are
% Copyright (C) 2001-2006 Cisco Systems, Inc.  All Rights Reserved.
%
% Contributor(s): IC-Parc, Imperal College London
% Contributor(s): Kish Shen
% Contributor(s): Coninfer Ltd
% 
% END LICENSE BLOCK
%
% System:	ECLiPSe Constraint Logic Programming System
% Component:	Remote Socket Interface
%		Part of module(sepia_kernel)
% Description:	This was part of io.pl
% ----------------------------------------------------------------------

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Remote Socket Interface
%
% Recorded information:
%      recorded_list(peer_info, PeerInfos) - Information on all the peers
%
%  Each PeerInfos is a structure:
%
%         PeerName-peer_info(PeerType, Lang, Key, Connect)
%
%      PeerName: peer name (atom)
%      PeerType: either remote or embed. 
%      Lang:     programming language of the peer (atom).
%      Key:      the key used to access dynamic data associated with the peer.
%      Connect:  connection information. Either:
%                   remote(PeerHost,LocalHost,TimeOut)
%                   embed(PeerHost,LocalHost,TimeOut)
%
%            PeerHost is the hostname for the peer side. Used for verifying
%              that any accepted socket connection comes from the same host.
%            LocalHost is the ECLiPSe side hostname specification. This is
%              used in setting up a server connection to the peer side.
%              What is used has implications for what the remote side can
%              give for the server (ECLiPSe) hostname when making a client
%              connection:
%                   1) actual ECLiPSe side hostname: remote side must also 
%                      use this name for the server.
%                   2) localhost: remote side must used localhost for the
%                      server name. This restricts the connection to the 
%                      local machine.
%                   3) not instantiated: remote side can use either
%                      localhost or the actual server hostname. 
%              We use the same specification for all connections between
%              ECLiPSe and the peer for security reasons. 
%            TimeOut is the time-out (in seconds) for accepting any socket
%              connection, plus waiting time for the initial read of data
%              during attachment. Can be 'block' for no time-outs
%
% Currently, the only dynamic data associated with a peer are the peer queues.
% Each queue is an record item recorded under the Key for the peer as:
%
%         queue(StreamNum)
%
% From StreamNum, a queue key can be derived by calling get_peer_queue_key/2.
% Information for the queue is recorded under this key:
%
%         peer_queue(PeerType, PeerName, QueueType, Direction)
%
%      PeerType: peer type for the queue: Either embed or remote
%      PeerName: peer name for the queue.
%      QueueType: the type of the queue. This is either:
%             sync(SocketName): synchronous remote queue, with socket
%             async           : asynchronous remote queue
%             embed           : queue in a embedded peer
%      Direction: direction of queue. Either fromec, toec or bidirect
%
% The above information is used to clean up a remote side when it is 
% disconnected
%
% Embedded peer queues:
%	
%    Direction	Event	Device
%    fromec	ignored	queue(yield)	yields to C on flush/1
%    toec	''	queue(yield)	yields to C on empty input
%    toec	event	queue(event)	sync event when data available
%
% Remote peer queues:
%	
%    Direction	Event	Device
%    fromec	ignored	queue(yield)+sock  flush/1->remote_output/3
%    toec	''	queue(yield)+sock  read*/2->remote_input/2->copy(sock,queue)
%    toec	event	queue(event)+sock  rem_flushio->copy(sock,queue)->event
%
%
% Dealing with events:
% To ensure that the remote interface protocol is followed at all times,
% event handling is deferred during most of the code below. We only
% allow events during
%	- running rpcs
%	- running user goals, e.g. remote_init
%	- remote flush (but not if inside ec_waitio)
% but these goals must be safely wrapped in catch/3 to make sure the
% events are deferred again even on failure/throw.
% Note that, since we re-enable events temporarily from within events-deferred
% code, we cannot allow nesting, i.e. remote_accept, peer_queue_xxx and
% flush/waitio handlers must be called from non-events-deferred contexts.
%
% First clause is the current version of the remote protocol.
% The version information should not occur anywhere else on the ECLiPSe side.
%

:- pragma(nodebug).
:- pragma(expand).
:- pragma(skip).

:- export
	peer/1,
	peer_get_property/3,
	peer_queue_create/5,
	peer_queue_close/1,
	peer_queue_get_property/3,
        peer_multitask_confirm/0,
        peer_multitask_terminate/0,
        peer_register_multitask/2,
        peer_deregister_multitask/1,
        peer_do_multitask/1.
 
remote_version(1).

:- local variable(rpeer_count, 0).
:- local variable(in_ec_waitio, []).
:- local struct(peer_info(type,lang,key,connect)).
:- local struct(peer_queue(ptype,pname,qtype,dir)).


non_interruptable(Goal) :-
	( events_defer ->
	    call(Goal),
	    events_nodefer
	;
	    printf(warning_output, "Warning: Illegal events_defer nesting detected during remote protocol (%w)",[Goal]),
	    call(Goal)
	).


remote_connect(Address, Control, Init, Mod) :-
	remote_connect_setup(Address, Control, Soc), !,
	printf(log_output, "Socket created at address %w%n%b", [Address]),
        remote_connect_accept(Control, Soc, block, Init, "", _, Mod). 
remote_connect(Address, Control, Init, _Mod) :-
	error(5, remote_connect(Address, Control, Init)).

remote_connect_setup(Host/Port, Control, Soc) :-
	check_var_or_integer(Port),
	check_var_or_atom(Control),
	check_var(Soc),
	!,
        copy_term(Host,OrigHost), % OrigHost can be a variable
	new_socket_server(Soc, Host/Port, 2),
        (var(Control) ->
	    new_remote_peer_name(Control)
        ;   
	    not_existing_peer_name(Control)
	),
	recorda(remote_control_host, Control-OrigHost).
remote_connect_setup(Address, Control, Soc) :-
	bip_error(remote_connect_setup(Address, Control, Soc)).

new_remote_peer_name(Name) :-
	repeat,
	incval(rpeer_count),
	getval(rpeer_count, NPeer),
	concat_atom([peer, NPeer], Name),
	not_existing_peer_name(Name), !.

not_existing_peer_name(Name) :-
% fails if Name is either an existing or potential peer
	\+ peer(Name), \+ recorded(remote_control_host, Name-_).


remote_connect_accept(Control, Soc, TimeOut, Init, Pass, Res, Mod) :-
	check_nonvar(Pass),
	erase(remote_control_host, Control-Host), 
	get_rpcstream_names(Control, Rpc),
	timed_accept(Soc, TimeOut, RemoteHost, Control),
	check_remote_version(Control),
	timed_read_exdr(Control, TimeOut, Pass0), 
        (Pass == Pass0 -> true ; set_bip_error(1)),
	write_exdr(Control, Control), flush(Control),
	% Host is the host name that will be used in any subsequent connections
        timed_read_exdr(Control, TimeOut, RemoteLang),
	timed_accept(Soc, TimeOut, RemoteHost, Rpc),
	write_exdr(Rpc, Control), flush(Rpc),
	set_peer_property(Control, peer_info{type:remote,lang:RemoteLang,
                                     connect:remote(RemoteHost,Host,TimeOut)}),
	set_event_handler(Control, true/0),
	close(Soc),
	events_defer,	% fail if already deferred (can't handle nesting)
	!,
	catch((
		run_remote_init(Init, Res, Mod),
		remote_control_read(Control, Message),
		handle_ec_resume(Message, Control),
		events_nodefer
	    ), Tag, (
		events_nodefer,
		throw(Tag)
	    )).
remote_connect_accept(Control, Soc, TimeOut, Init, Pass, Res, Mod) :-
	(nonvar(Soc),current_stream(Soc) -> close(Soc) ; true),
	(nonvar(Control), current_stream(Control) -> close(Control) ; true),
	get_bip_error(Err),
	error(Err, remote_connect_accept(Control, Soc, TimeOut, Init, Pass, Res, Mod)).


check_remote_version(Control) :-
	(timed_read_exdr(Control, 100, RemoteVersion) -> 
             true ; set_bip_error(6)
        ),
	get_flag(remote_protocol_version, Version),
	(RemoteVersion == remote_protocol(Version) ->
	     write_exdr(Control, "yes"), flush(Control)
	;    write_exdr(Control, Version), flush(Control),
	     printf(error, "Incompatible remote protocol on remote side: %w%n",
                 [RemoteVersion]),
	     set_bip_error(141)
	).

timed_read_exdr(Stream, TimeOut, Data) :-
	stream_select([Stream], TimeOut, [Stream]),
	catch(read_exdr(Stream, Data), _, fail).

timed_accept(Server, TimeOut, RemoteHost, NewQueue) :-
	stream_select([Server], TimeOut, [Server]),
	accept(Server, RemoteHost0/_, NewQueue), 
	(RemoteHost = RemoteHost0 ->
            true ; close(NewQueue), fail
        ).


% events deferred!
run_remote_init(Init, Res, Mod) :-
	( nonvar(Init), var(Res) ->
	    catch((
		     events_nodefer,
		     (call(Init)@Mod -> Res = Init ; Res = fail),
		     events_defer
		 ),
		 _,
		 (events_defer, Res = throw)
            )
	; nonvar(Res) ->
	      printf(warning_output, "Warning: result argument %w for initial goal not a variable in remote_control_accept/5. Initial Goal not executed.", [Res])
	; true
	).

peer_info(Peer, Info) :-
	recorded(peer_info, Peer-Info).

peer(Peer) :- 
	( var(Peer) ->
	     peer_info(Peer, _)
	; atom(Peer) ->
	     once peer_info(Peer, _)
	; error(5, peer(Peer))
	).

peer_get_property(Peer, Property, Value) :-
	check_atom(Peer),
	check_var_or_atom(Property),
	!,
	once(peer_info(Peer, Info)),
	get_a_peer_property(Property, Info, Value).
peer_get_property(Peer, Property, Value) :-
	bip_error(peer_get_property(Peer,Property,Value)).

set_embed_peer(Peer, Lang) :-
	\+peer(Peer),
	get_flag(hostname, Host),
	set_peer_property(Peer, peer_info{type:embed,lang:Lang,connect:embed(Host,Host,block)}).

% all the predicates that access peer_info directly should be put here
get_embed_peer(Peer) :- 
	recorded(peer_info, Peer-(peer_info{type: embed})), !.

set_peer_property(Peer, Info) :-
	get_peer_dyn_info_key(Peer, Key),
        Info = peer_info{key: Key},
	recorda(peer_info, Peer-Info).

get_a_peer_property(type, peer_info{type:Type}, Type).
get_a_peer_property(language, peer_info{lang:Lang}, Lang).
get_a_peer_property(connect, peer_info{connect:Connect}, Connect).
get_a_peer_property(queues, peer_info{key:Key}, Qs) :-
	findall(Queue,(recorded(Key,queue(Nr)),get_stream(Nr,Queue)), Qs).


peer_queue_get_property(Queue, Prop, Value) :- 
	check_stream_spec(Queue),
	check_var_or_atom(Prop),
	!,
	get_queueinfo_st(Queue, _, QueueInfo),
	get_queueinfo_item(Prop, QueueInfo, Value).
peer_queue_get_property(Queue, Prop, Value) :- 
	bip_error(peer_queue_get_property(Queue,Prop,Value)).


get_queue_info(Name, Nr, Peer, QType, Dir) :-
	get_queueinfo_st(Name, Nr, QueueInfo),
	get_queueinfo_item(peer, QueueInfo, Peer),
	get_queueinfo_item(type, QueueInfo, QType),
	get_queueinfo_item(direction, QueueInfo, Dir).

get_queueinfo_st(Name, Nr, QueueInfo) :-
	current_stream(Name),
	get_stream_info(Name, physical_stream, Nr),
	get_peer_queue_key(Nr, Key),
	recorded(Key, QueueInfo), !.

get_queueinfo_item(peer_type,  peer_queue{ptype:PeerType}, PeerType).
get_queueinfo_item(peer_name,  peer_queue{pname:Peer}, Peer).
get_queueinfo_item(type,      peer_queue{qtype:Type}, Type).
get_queueinfo_item(direction, peer_queue{dir:Direction}, Direction).
get_queueinfo_item(peer,  peer_queue{ptype:PeerType,pname:Peer},
                   PInfo) :- % for backwards compatibility
        PInfo =.. [PeerType, Peer].
        

is_remote_sync_queue(PhysicalStream, Socket, ControlStream) :-
	peer_queue_get_property(PhysicalStream, peer, remote(ControlStream)),
	peer_queue_get_property(PhysicalStream, type, sync(Socket)).


deregister_queue(Stream, Control) :-
	get_stream_info(Stream, physical_stream, StreamNum),
	get_peer_queue_key(StreamNum, Key),
	erase_all(Key),
	get_peer_dyn_info_key(Control, ControlKey),
	recorded(ControlKey, queue(StreamNum), Ref), !,
	erase(Ref).

register_remote_queue(Name, Control, Type, Direction) :-
	get_stream_info(Name, physical_stream, Nr),
	get_peer_queue_key(Nr, Key),
	get_peer_dyn_info_key(Control, ControlKey),
	recorda(ControlKey, queue(Nr)),
	recorda(Key, peer_queue{ptype:remote, pname:Control, qtype:Type, dir:Direction}).


register_embed_queue(Name, Peer, Direction) :-
	get_stream_info(Name, physical_stream, Nr),
	get_peer_queue_key(Nr, Key),
	peer_get_property(Peer, type, embed),
	get_peer_dyn_info_key(Peer, PeerKey),
	recorda(PeerKey, queue(Nr)),
	recorda(Key, peer_queue{ptype:embed, pname:Peer, qtype:sync(Nr), dir:Direction}).
	
	
get_peer_dyn_info_key(Control, ControlKey) :-
	concat_atom([peer_dynamic_info, Control], ControlKey).

get_peer_queue_key(N, Key) :-
	concat_atom([peer_queue, N], Key).


new_socket_server(Soc, Address, N) :-
	socket(internet, stream, Soc), 
        bind(Soc, Address),
	listen(Soc, N).


peer_queue_close(Queue) :-
	check_stream_spec(Queue), !,
	get_queue_info(Queue, StreamNum, Peer, QType, _Direction),
	non_interruptable(
	    close_peer_queue_type(Peer, StreamNum, QType)
	).
peer_queue_close(Queue) :-
	bip_error(peer_queue_close(Queue)).


    close_peer_queue_type(remote(Peer), StreamNum, QType) :-
	remote_control_send(Peer, queue_close(StreamNum)),
	remote_control_read(Peer, ResumeMessage),
	close_remote_queue_eclipseside(Peer, StreamNum, QType),
	handle_ec_resume(ResumeMessage, Peer).
	close_peer_queue_type(embed(Peer), StreamNum, _QType) :-
	write_exdr(embed_info, queue_close(StreamNum)),
	flush(embed_info),
	close_embed_queue_eclipseside(Peer, StreamNum).

    close_embed_queue_eclipseside(Peer, StreamNum) :-
	deregister_queue(StreamNum, Peer),
	close(StreamNum).

    close_remote_queue_eclipseside(Control, StreamNum, QType) :-
	deregister_queue(StreamNum, Control),
	% If the queue to close is the target of stdin/stdout/stderr,
	% then redirect those to null, so the queue can be safely closed.
	% This should only happen in a remote/out_of_process eclipse.
	( default_stream(Default,Fixed), get_stream(StreamNum, Fixed) ->
	    set_stream(Default, null), set_stream(Fixed, null)
	;
	    true
	),
	close_remote_physical_streams(QType, StreamNum).

    close_remote_physical_streams(sync(Socket), StreamNum) :-
	(current_stream(StreamNum) ->
	    % disable queue yield to prevent unexpected effects during flush-on-close
	    set_stream_property(StreamNum, yield, off), 
	    close(StreamNum)
	; true),
	(current_stream(Socket) -> close(Socket) ; true).
    close_remote_physical_streams(async, StreamNum) :-
	(current_stream(StreamNum) -> close(StreamNum) ; true).



peer_queue_create(Name, Control, Sync, Direction, Event) :-
	non_interruptable(
	    peer_queue_create1(Name, Control, Sync, Direction, Event)
	).
	

peer_queue_create1(Name, Control, Sync, Direction, Event) :-
	(atom(Name), atom(Control), is_event(Event) -> 
            true ; set_bip_error(5)
        ),
	peer_get_property(Control, connect, Type),
	(Sync == sync ->
	    (Direction == fromec ; Direction == toec ; set_bip_error(6))
	;
	 (Sync == async,  functor(Type,remote,_))
        ;
	 set_bip_error(6)
        ), !,
	create_peer_queue_type(Type, Name, Control, Sync, Direction, Event).
peer_queue_create1(Name, Control, Sync, Direction, Event) :-
	get_bip_error(E),
	error(E, peer_queue_create(Name, Control, Sync, Direction, Event)).


    % events deferred!
    create_peer_queue_type(remote(PeerHost,LocalHost,TimeOut), Name, Control, Sync, Direction, Event) ?-
	new_socket_server(Soc, LocalHost/Port, 1),
	remote_control_send(Control, socket_client(Port, Name, Sync, Direction)),
	remote_control_read(Control, ResumeMessage),
	(is_disconnection(ResumeMessage) ->
	    close(Soc),
	    handle_ec_resume(ResumeMessage, Control)
	; 
	 ResumeMessage = socket_connect(Name,Status) ->
	    connect_remote_queue(Status, Soc, Name, Control, Sync, Direction, Event, TimeOut, PeerHost, Return),
	    Return \== fail % fails if connection failed
	;
	 printf(error, "Unexpected control message %w while creating peer queue %w on remote side %w; disconnecting.%n", [ResumeMessage, Name, Control]),
         close(Soc), 
	 handle_ec_resume(disconnect, Control)
        ).
    create_peer_queue_type(embed(_,_,_), Name, _Peer, _Sync, Direction, Event) ?-
	ecl_create_embed_queue(Name, Direction, Event),
	get_stream_info(Name, physical_stream, Nr),
	write_exdr(embed_info, queue_connect(Name, Nr, Direction)),
	flush(embed_info).


    ecl_create_embed_queue(Name, Direction, Event) :-
	get_embed_peer(Peer),
	(Direction == fromec ->
	    Options = [yield(on)],
	    Mode = write
	;
	    (Event == '' -> Options = [yield(on)] ; Options = [event(Event)]),
	    Mode = read
	), 
	open(queue(""), Mode, Name, Options),
	register_embed_queue(Name, Peer, Direction).


    is_disconnection(disconnect).
    is_disconnection(disconnect_resume).
    is_disconnection(end_of_file).

    % events deferred!
    connect_remote_queue(success, Soc, Name, Control, Sync, Direction, Event, TimeOut, RHost, StreamId) :-
	catch(
	      (create_remote_queue(Sync, Direction, Soc, Name, Control, TimeOut, RHost, Event) ->
                   get_stream_info(Name, physical_stream, StreamId)
	      ;    
		  % Timed out or other problem
		  close(Soc),
		  StreamId = fail
              ), _, ((current_stream(Soc) -> close(Soc);true), StreamId = fail)
	),
	remote_control_send(Control, socket_accept(Name,StreamId)),
	remote_control_read(Control, ResumeMessage),
	handle_ec_resume(ResumeMessage, Control).
    connect_remote_queue(fail, Soc, Name, Control, _, _, _, _, _, StreamId) :-
	close(Soc),
	StreamId = fail,
	remote_control_send(Control, socket_accept(Name, fail)),
	remote_control_read(Control, ResumeMessage),
	handle_ec_resume(ResumeMessage, Control).


    create_remote_queue(async, _, Soc, Name, Control, TimeOut, RHost, Event) ?-
	remote_create_async_queue(Soc, Name, Control, TimeOut, RHost, Event).
    create_remote_queue(sync, fromec, Soc, Name, Control, TimeOut, RHost, Event) ?-
	remote_create_fromec_queue(Soc, Name, Control, TimeOut, RHost, Event).
    create_remote_queue(sync, toec, Soc, Name, Control, TimeOut, RHost, Event) ?-
	remote_create_toec_queue(Soc, Name, Control, TimeOut, RHost, Event).

    % memory queue needed to allow eof event to be raised reading empty queue
    remote_create_toec_queue(Soc, Name, Control, TimeOut, RemoteHost, Event) :-
	open(queue(""), update, Name),
	concat_atom([Name, soc], SocName),
	timed_accept(Soc, TimeOut, RemoteHost, SocName),
	close(Soc),
	(Event == '' -> 
	    set_stream_property(Name, yield, on) 
        ;   set_stream_property(Name, event, Event)
        ),
	register_remote_queue(Name, Control, sync(SocName), toec).


    % memory queue needed for buffering output. 
    % Event is dummy for now, to be used for remote side requesting data
    remote_create_fromec_queue(Soc, Name, Control, TimeOut, RemoteHost, _Event) :-
	open(queue(""), update, Name, [yield(on)]),
	concat_atom([Name, soc], SocName),
	timed_accept(Soc, TimeOut, RemoteHost, SocName),
	close(Soc), 
	register_remote_queue(Name, Control, sync(SocName), fromec).

    remote_create_async_queue(Soc, Name, Control, TimeOut, RemoteHost, Event) :-
    % use Control to remember which remote process this stream is connected to
	timed_accept(Soc, TimeOut, RemoteHost, Name),
	(Event == '' -> 
	    true
        ;   set_stream_property(Name, event, Event)
        ),
	close(Soc),
	register_remote_queue(Name, Control, async, bidirect).


% returns end_of_file as a message if something goes wrong
remote_control_read(Control, Message) :-
	catch((read_exdr(Control, Message) -> true ; Message = end_of_file),
	           _, Message = end_of_file
	).

% catches any prblems before sending control message
remote_control_send(Control, Message) :-
	(stream_select([Control], 0, [Control]) ->
	    % unexpected message arrived on control stream
	    remote_control_read(Control, InMessage),
	    ((InMessage == disconnect_resume; InMessage == end_of_file) ->
		% unilateral disconnect from remote side; disconnect locally now
		remote_cleanup(Control),
		throw(peer_abort_disconnected)
	    ;   printf(error, "Unexpected incoming message %w on remote %w.\n", [InMessage,Control]),
	        throw(peer_abort_error)
	    )
	;
	    write_exdr(Control, Message),
	    flush(Control)
	).


:- local finalization(disconnect_remotes).

disconnect_remotes :-
	recorded_list(peer_info, Remotes),
	disconnect_remotes(Remotes).

disconnect_remotes([]).
disconnect_remotes([Control-_|Controls]) :-
	remote_disconnect(Control),
	disconnect_remotes(Controls).


remote_disconnect(Control) :-
	((nonvar(Control), current_stream(Control),
          peer_get_property(Control,type,remote)
         ) ->
	    remote_control_send(Control, disconnect),
	    (read_exdr(Control, disconnect_resume) ->
		remote_cleanup(Control)
	    ;   % if not resume, then problem....
	        true
	    )
	;   true  % Control is not a current remote peer...
	).


% events not deferred!
remote_output(PhysicalStream, ControlStream, RemoteStream) :-
	non_interruptable((
	    read_string(PhysicalStream, end_of_file, Len, Data), 
	    yield_to_remote(ControlStream, ec_flushio(PhysicalStream, Len), RemoteStream, Data)
	)).

    % events deferred!
    yield_to_remote(ControlStream, YieldMessage, DataStream, Data) :-
	remote_control_send(ControlStream, YieldMessage),
	write(DataStream, Data),
	flush(DataStream),
	remote_control_read(ControlStream, ResumeMessage),
	handle_ec_resume(ResumeMessage, ControlStream).


% events not deferred!
remote_input(PhysicalStream, ControlStream) :-
	non_interruptable((
	    remote_control_send(ControlStream, ec_waitio(PhysicalStream)),
	    wait_for_remote_input(PhysicalStream, ControlStream)
	)).

    % wait for remote input to arrive, handle any messages before this,
    % data is then copied from the socket to the queue stream (physical stream)
    % events deferred!
    wait_for_remote_input(PhysicalStream, ControlStream) :-
	% we expect at least one rem_flushio-message and a resume
	setval(in_ec_waitio, PhysicalStream),
	remote_control_read(ControlStream, Message0),
	expect_control(ControlStream,
		[rem_flushio(PhysicalStream, _), rem_flushio(PhysicalStream)],
		Message0, Message1),
	handle_control(Message1, ControlStream, Message2),
	setval(in_ec_waitio, []),
	expect_control(ControlStream, [resume], Message2, _).


remote_rpc_handler(Rpc, Control) :-
	% The socket rpc can only handle a single rpc 
	% the rpc goal corresponding to the control message must eventually
        % arrive on the Rpc socket stream
	stream_select([Rpc], block, [Rpc]), % wait until Rpc stream is ready..
	catch(execute_remote_rpc(Rpc, Control), _, handle_remote_rpc_throw(Rpc, Control)).

    execute_remote_rpc(Rpc, Control) :-
	read_exdr(Rpc, Goal),
	events_nodefer,
	execute_rpc(Rpc, Goal, (
		events_defer,
		remote_control_send(Control,yield)
	    )).

    handle_remote_rpc_throw(Rpc, Control) :-
	events_defer,
	remote_control_send(Control, yield),
	write_exdr(Rpc, throw), flush(Rpc).


% Handle initial message Message0 (and possibly further messages on Control)
% until we get one of the messages specified in the list Expected.
% The expected message itself is not handled, but returned as ExpectedMessage.

% events deferred!
expect_control(Control, Expected, Message0, ExpectedMessage) :-
	( nonmember(Message0, Expected) ->
	    ( Message0 = resume ->
		printf(warning_output,
		    "Unexpected resume from remote peer %w while waiting for %w%n%b",
		    [Control, Expected]),
		% yield back and hope for the best
		remote_yield(Control, Message1)
	    ;
		% some other message, try to process it
		handle_control(Message0, Control, Message1)
	    ),
	    expect_control(Control, Expected, Message1, ExpectedMessage)
	;
	    ExpectedMessage = Message0
	).


% Handle initial message Message (and possibly further messages on Control).
% Return as soon as we get a resume message.

% events deferred!
handle_ec_resume(Message, Control) :-
	expect_control(Control, [resume], Message, _Message).


% events deferred!
handle_control(rpc, Control, NextMsg) :- -?->  !, % rpc call
	get_rpcstream_names(Control, Rpc),
	remote_rpc_handler(Rpc, Control),
	remote_control_read(Control, NextMsg).
handle_control(disconnect, Control, _NextMsg) :- -?->  !, % disconnect request
	write_exdr(Control, disconnect_yield), % acknowledge disconnect
	flush(Control),
	remote_cleanup(Control),
	throw(peer_abort_disconnected).
handle_control(rem_flushio(Queue), Control, NextMsg) :- -?-> !, 
	get_stream_info(Queue, device, Device),
	deal_with_remote_flush(Device, Queue, unknown),
	remote_yield(Control, NextMsg).
handle_control(rem_flushio(Queue, Len), Control, NextMsg) :- -?-> !,
	get_stream_info(Queue, device, Device),
	deal_with_remote_flush(Device, Queue, Len),
	remote_yield(Control, NextMsg).
handle_control(queue_create(Name,Sync,Direction,Event), Control, NextMsg) :- -?-> !,
	catch((
	   peer_queue_create1(Name, Control, Sync, Direction, Event) -> true;true),
           _, true
        ),
	remote_yield(Control, NextMsg).
handle_control(queue_close(Queue), Control, NextMsg) :- -?-> !,
	((current_stream(Queue),get_queue_info(Queue, Queue, remote(Control), QType, _)) ->
	    close_remote_queue_eclipseside(Control, Queue, QType)
	;   % not a remote queue, just ignore
	    true
	), remote_yield(Control, NextMsg).
handle_control(disconnect_resume, Control, _NextMsg) :- -?-> !,
% remote side already disconnected, no acknowledgement
	remote_cleanup(Control),
	throw(peer_abort_disconnected).
handle_control(end_of_file, Control, _NextMsg) :- -?-> !,
% Control is disconnected. Assume remote side disconnected unexpectedly
	remote_cleanup(Control),
	throw(peer_abort_disconnected).
handle_control(Message, Control, NextMsg) :-
	printf(error, "Unrecognised control signal %w; disconnecting.%n",
            [Message]),
	handle_control(disconnect, Control, NextMsg).


% events deferred!
deal_with_remote_flush(Device, Queue, Len) :-
	( getval(in_ec_waitio, Queue) ->
	    % this flush is the input corresponding to a ec_waitio
	    % don't handle events
	    catch((
		deal_with_remote_flush1(Device, Queue, Len) -> true ; true
		), _, true)	% ignore any problems with the handler

	; events_nodefer ->     %%%% this can't fail!
	    % handle events during remote flush
	    catch((
		deal_with_remote_flush1(Device, Queue, Len) -> true ; true
		), _, true),	% ignore any problems with the handler
	    events_defer
	;
	    printf(error, "Unexpected events_nodefer state in remote flush %w%n", [Queue])
	).

    deal_with_remote_flush1(socket, Queue, Len) ?- !,
	% raw socket, is an asyn. queue; user process the data
	get_stream_info(Queue, event, Event),
	error(Event, rem_flushio(Queue, Len)).
    deal_with_remote_flush1(_, Queue, Len) :-
	% non-socket case, read data into a buffer
	peer_queue_get_property(Queue, type, sync(SockName)),
	read_sync_data_to_buffer(Len, Queue, SockName).

    read_sync_data_to_buffer(Len, Queue, SockName) :-
	(integer(Len) ->
	    (read_string(SockName, end_of_file, Len, Data) -> true ; Data = end_of_file),
	    write(Queue, Data)
	;   % Length unknown, read as exdr term	
	    (read_exdr(SockName, Data) -> true ; Data = end_of_file),
	    write_exdr(Queue, Data) 
	).


% make remote_cleanup more robust so that problems will not choke eclipse
% events deferred on entry, undeferred om exit
remote_cleanup(Control) :-
	catch(remote_cleanup_raw(Control), _, fail), !.
remote_cleanup(Control) :-
	printf(error, "Problem with cleaning up remote peer %w.%n", [Control]).


remote_cleanup_raw(Control) :-
	events_nodefer,			% to make next line work
	(event(Control) -> true ; true), % user defined cleanup 
	reset_event_handler(Control),
	get_peer_dyn_info_key(Control, ControlKey),
	% get all the socket streams associated with this remote process
	recorded_list(ControlKey, RemoteDynInfo), 
	cleanup_dynamic_infos(RemoteDynInfo, Control),
        cleanup_peer_multitask_infos(Control),
	erase_all(ControlKey),
	get_rpcstream_names(Control, Rpc),
	(erase(peer_info, Control-_) -> true;true), 
	close(Rpc), 
	close(Control).

cleanup_dynamic_infos([Item|Infos], Control) :-
	(Item = queue(Queue) -> 
             get_queue_info(Queue, StreamNum, remote(Peer), QType, _Dir),
	    close_remote_queue_eclipseside(Peer, StreamNum, QType)
	;
	    true
	),
	cleanup_dynamic_infos(Infos, Control).
cleanup_dynamic_infos([], _).


% events deferred!
remote_yield(Control, ResumeMessage) :-
	nonvar(Control), 
        peer(Control), 
	current_stream(Control),
	remote_control_send(Control, yield),
	remote_control_read(Control, ResumeMessage).

% events deferred or undeferred!
remote_yield(Control) :-
        ( events_defer -> Reset=events_nodefer ; Reset=true ),
        remote_yield(Control, ResumeMessage),
        handle_ec_resume(ResumeMessage, Control),
        Reset.


get_rpcstream_names(Control, Rpc) :-
	concat_atom([Control, '_rpc'], Rpc).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Peer Multitasking

:- local struct(mt_peer(peer,msgq)).
:- local variable(peer_mt_status).
:- setval(peer_mt_status, off).

peers_are_multitasking :-
        \+getval(peer_mt_status, off).

peers_should_cycle :-
        getval(peer_mt_status, mt_set).


peer_register_multitask(Peer, MsgQ) :-
        (peer(Peer) ->
             \+ recorded(multitask_peers, mt_peer{peer:Peer}),
             concat_atom([Peer, multifrom], MsgQ),
             peer_queue_create(MsgQ, Peer, sync, fromec, ''),
             record(multitask_peers, mt_peer{peer:Peer,msgq:MsgQ})
        ;
             error(6, peer_register_multitask(Peer, MsgQ))
        ).

peer_deregister_multitask(Peer) :-
        (peer(Peer) ->
             recorded(multitask_peers, mt_peer{peer:Peer,msgq:MsgQ}),
             cleanup_peer_multitask_infos(Peer),
             peer_queue_close(MsgQ)
        ;
             error(6, peer_deregister_multitask(Peer))
        ).
             
peer_do_multitask(Type) :-
        \+peers_are_multitasking,
        /* multitasking will terminate if peers do not confirm multitasking */
        catch(( (peer_multitask_terminate,
                 peer_multitask_phase(Type, Err)
                )-> true
              ;     peer_end_multitask(Err)
              ), 
              Tag, (peer_end_multitask(_Err2), Tag = Err)
        ),
        (nonvar(Err) -> throw(Err) ; true).

    peer_multitask_phase(Type, Err) :-
        peers_mt_broadcast_with_cleanup(start_multitask(Type), Err),
        (nonvar(Err) -> true ; peers_mt_cycle(Err)),
        peer_end_multitask(Err).

/* ensure that multitask phase is ended properly: if failure or 
   throw occurs, broadcast end_multitask again */
peer_end_multitask(Err) :-
        catch(( (peers_mt_broadcast_with_cleanup(end_multitask, Err),
                 peer_multitask_off
                 ) -> true
                ;     peer_end_multitask(Err)
              ), _, peer_end_multitask(_)).


peer_multitask_terminate :-    setval(peer_mt_status, mt_reset).
peer_multitask_confirm   :-    setval(peer_mt_status, mt_set).
peer_multitask_off   :-    setval(peer_mt_status, off).

% avoids pushing witness pword onto global stack by avoiding a CP here
% all peer_mt_status state must be given by the clauses
do_peers_mt_cycle(mt_set, Err) ?-
        sleep(0.01), 
        peers_mt_broadcast_with_cleanup(interact, Err),
        peers_mt_cycle(Err).
do_peers_mt_cycle(mt_reset, _Err) ?- true.
do_peers_mt_cycle(off, _Err) ?- true.

peers_mt_cycle(Err) :-
        getval(peer_mt_status, Status),
        do_peers_mt_cycle(Status, Err).

peers_mt_broadcast_with_cleanup(Msg, Err) :-
        % rollback the garbage generated by peers_mt_broadcast/2
        % if no error occurred
        (peers_mt_broadcast(Msg, Err), nonvar(Err) -> true ; true).


peers_mt_broadcast(Msg, Err) :- 
        recorded_list(multitask_peers, Ps),
        (Ps \== [] ->
             peers_mt_broadcast1(Ps, Msg, Err)
        ;
             peer_multitask_terminate,
             (Err = peer_multitask_empty -> true; true)
        ).

peers_mt_broadcast1([], _, _).
peers_mt_broadcast1([mt_peer{peer:Peer,msgq:MQ}|Ps], Msg, Err) :-
        catch(send_mt_message(MQ, Msg), Tag,
              peer_mt_error_recover(Tag,Peer,Err)),
        peers_mt_broadcast1(Ps, Msg, Err).


send_mt_message(ToPQ, Msg) :-
        % ignore failure (invalid terms substituted by _)
        (write_exdr(ToPQ, Msg) -> true;true),
        flush(ToPQ).

% First case happens if a remote peer has disconnected. In this case, the
% remote peer code should have cleaned up already
peer_mt_error_recover(peer_abort_disconnected, _, _) :- !. 
peer_mt_error_recover(abort, _Peer, Err) :- !,
        % abort raised. Stop multitasking and allow abort to continue
        peer_multitask_terminate,
        (Err = abort -> true ; true).
peer_mt_error_recover(Tag, Peer, Err) :- 
        % something went wrong, remove problematic peer from multitasking
        % list and end multitask, follow by aborting with first error
        peer(Peer), 
        cleanup_peer_multitask_infos(Peer),
        peer_multitask_terminate,
        (Tag = Err -> true ; true).

cleanup_peer_multitask_infos(Peer) :-
        (erase(multitask_peers, mt_peer{peer:Peer}) -> true ; true).

