com_tcp.pl

来自「SRI international 发布的OAA框架软件」· PL 代码 · 共 1,050 行 · 第 1/3 页

	| otherwise ->
	    Dialect = dontcare
	),
	!, 
	com_send_data_by_format(Dest, F, Data, Dialect, Version, Language).
	
	
% quintus_binary: for inter-quintus communication
com_send_data_by_format(Dest, quintus_binary, Data, _Dialect, _Version, _Language) :- 
        oaa:current_prolog(quintus),
	!,
	tcp_send(Dest, Data).
com_send_data_by_format(Dest, quintus_binary, Data, Dialect, Version, Language) :- 
        !,
    com_send_data_by_format(Dest, default, Data, Dialect, Version, Language).

% pure_ascii: don't wrap data in term() wrapper
com_send_data_by_format(Dest, pure_ascii, Data, _Dialect, _Version, _Language) :- !,
        current_output(CurrentOutput),
        flush_output(CurrentOutput),
        tcp_output_stream(Dest, TcpOutput),
        set_output(TcpOutput),
 
        com_write_term(Data),

        flush_output(TcpOutput),
        set_output(CurrentOutput), !.

% Default format:
com_send_data_by_format(Dest, _Format, Data, OtherDialect, Version, Language) :-
        current_output(CurrentOutput),
        flush_output(CurrentOutput),
        tcp_output_stream(Dest, TcpOutput),
        set_output(TcpOutput),
        com_write_term(term(Data)),

	   % (DLM, 2000/11/15): Now it appears that this first clause
	   % isn't needed, AND we can do without parent_dialect!  What
	   % was previously handled by this first clause is now handled by
	   % the second.
        ( OtherDialect == sicstus, false ->
           %# Ralph removed nl,nl after the write/1 and added a space
           %# after the '.', "since more than a single trailing
           %# whitespace does not get read by the Prolog parser, while
           %# it needs at least one to differentiate between '.' as a
           %# terminator and '.' as the first character in an
           %# operator". Let's assume he's right.
	     write('. ')
	| (OtherDialect == quintus ; OtherDialect == sicstus ;
	   (number(Version), Version < 3.0, Language == unknown) ) ->
	   % Version < 3.0 & Language == unknown probably implies that
	   % OtherDialect == quintus
           % The default case (2 nl's) does not work in writing to a QP agent.
           % (neither does a single nl, nor does it help to use nl(TcpOutput)),
           % so we use put/2 for this case.
	   % DLM, 05/2002: Note also that 2 such puts also cause problems 
	   % for other QP agents.
	     write('.'),
    	     put(TcpOutput, 10)
	     % This causes the agents to disconnect (at least under UNIX):
             % put(TcpOutput, 13)
	| (
	    % DLM, 05/2002 (commenting this): 
	    % oaa:current_prolog(sicstus), 
	      number(Version), Version < 3.0, 
	      (Language == c ; Language == java)) ->
           % Strange; the nl's written by the quintus fac don't seem to
           % get through to the client; at least not to older java and c 
           % clients.
           % With sicstus, they do get through, and they break the Java and
           % C clients.  So we won't write them with sicstus.  
           % (DLM, 2000/03)
	     write('.')
	% | otherwise ->
	% write('.'), nl, nl
	% DLM, 05/2002: Since the nl's don't get through, 
	% let's make this the default:
	| otherwise ->
	     write('.'), put(TcpOutput, 10)
        ),
        flush_output(TcpOutput),
        set_output(CurrentOutput), !.

% character_escapes has to be handled by a prolog_flag under Quintus.
% Also, this predicate localises the particular set of WriteParams we
% always use here. DMC.

com_write_term(Data) :-
   WriteParams =
      [quoted(true),            % make input acceptable for read
       portrayed(true),         % use user:portray/1 clauses if present
       ignore_ops(false),       % false so list will be printed as '[1,2]'
       % !!! could be a problem with +, other opts.
       numbervars(true),        % print vars as f(A).
       max_depth(0)],           % no depth limit
   % write actual character, not \255:
   (prolog_flag(source_info,_) ->
      %sicstus:
      prolog_flag(character_escapes,CE,off),
      write_term(Data,WriteParams),
      prolog_flag(character_escapes,_,CE)
   | otherwise ->
      write_term(Data, [character_escapes(false)|WriteParams])
   ).

% icl_goal_writer/2 can be specified using full_goal parameter with
% oaa_Solve.
user:portray(icl_goal_writer(UserTerm, Callback)) :-
    current_output(Stream),
    Call =.. [Callback, UserTerm, Stream],
    call(Call),
    !.
% In case the callback fails:
user:portray(icl_goal_writer(_UserTerm, _Callback)) :-
    write(true).

user:portray(icldataq(CharCodes)) :-
    write('icldataq("'),
    com_PortrayChars(CharCodes),
    write('")').

% RawLen is the length of the string without escape characters; that is,
% without doubling the double-quote characters.  NumQuotes is the number
% of double-quote characters in the string.  RawLen is the length of 
% the list CharCodes.  RawLen+NumQuotes = the length of the string on the
% wire (with escapes).
user:portray(icldataq(RawLen, NumQuotes, CharCodes)) :-
    write('icldataq('), 
    write(RawLen), write(','),
    write(NumQuotes), write(',"'),
    com_PortrayChars(CharCodes),
    write('")').
    
com_PortrayChars([]).
com_PortrayChars([Char|Chars]) :-
    integer(Char),
    Char >= 0,
    Char =< 255,
    !,
    (   Char =:= 0'" ->             % " is written doubled
	  put(0'"), put(0'")
    ;   put(Char)
    ),
    com_PortrayChars(Chars).
com_PortrayChars([Char|Chars]) :-
    format(user_error,
	   '~w: com_PortrayChars: invalid character code; omitting: ~w~n',
	   ['INTERNAL ERROR', Char]),
    com_PortrayChars(Chars).
    

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% name:    com_SelectEvent(+TimeOut, -Event)
% purpose: Waits and returns an incoming event, or 'timeout' if TimeOut expires
% remarks:
%  - TimeOut may be a real number, and represents seconds.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
com_SelectEvent(0, Event) :-
        on_exception(E,tcp_select_protected(Event),
                       com_handle_select_exception(E,Event)), !.
com_SelectEvent(Seconds, Event) :-
	on_exception(E,tcp_select_protected(Seconds, Event),
                       com_handle_select_exception(E,Event)).

tcp_select_protected(ReturnEvent) :-
   tcp_select(Event),
   !,
   tcp_check_num_connections(Event, ReturnEvent).
tcp_select_protected(Seconds, ReturnEvent) :-
   tcp_select(Seconds, Event),
   !,
   tcp_check_num_connections(Event, ReturnEvent).

tcp_check_num_connections(Event, timeout) :-
    Event = connected(Connection),
    num_connections(Num),
    max_connections(Max),
    Num >= Max,
    !,
    oaa:oaa_format('~w (~w): Rejecting incoming connection request~n', 
	   ['WARNING', com_tcp]),
    format('  so as not to exceed value of max_connections (~w).~n', 
	   [Max]),
    format('  Currently registered agents are:~n', []),
    listing(oaa:agent_data/6),
    tcp_shutdown(Connection).
tcp_check_num_connections(Event, Event).

num_connections(Num) :-
     findall(Connection,
 	    com_connection_info(Connection, _, _, _, _),
 	    Ids),
     length(Ids, Num).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% name:    com_handle_select_exception(+E, -Event).
% purpose: Handle any exceptions that might be raised through tcp_select.
%          Also, when appropriate, return an Event for further processing.
% remarks:
%    read_error's arise on the PC, when the other process has halted or died.  
%    Errno's that we've seen are 1004, 2, and 9.  In each case, it is appropriate 
%    AND ESSENTIAL to shutdown the connection.  We'll assume that EVERY 
%    read_error exception is such a situation.  What we do here is the same
%    as tcp.pl does for read_error's with errno 1001.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
com_handle_select_exception(blame_on(read_error(Stream, errno(_Num)), _Goal), 
			Event) :-
    tcp_input_stream(C, Stream),
    tcp_shutdown(C),

% trace flags no longer available here
%    if_trace_on('WARNING: (select_event) read_error [errno ~w] for Agt ~w~n',
%                [Num, C]),

    Event = end_of_file(C),
    !.
%# We try and do the same thing for Sicstus, where we get a past_end_of_stream
%# error; BUT we can't find out what the stream is. Also, tcp_shutdown does
%# nothing in Sicstus.
com_handle_select_exception(existence_error(_,_,_,_,past_end_of_stream), 
                            end_of_file(_)) :-
    !.

% If we don't have this, then ctrl-C doesn't get us back to the prompt.
% (Which I assume it should...DMC).
com_handle_select_exception(reserved(N), _Event) :-
  !,
  raise_exception(reserved(N)).

% (DLM, 2000/11/15) new clause
% We've found that too many connections at one time (more than about 58
% in Quintus/Solaris) leads to an infinite loop, calling com_Select,
% and then bouncing out with a tcp_mishap exception.  
% TBD: what about Sicstus?
com_handle_select_exception(E, timeout) :-
    E = tcp_mishap(tcp_accept,24),
    !,
    com_print_err(E),
    num_connections(Num),
    retractall(max_connections(_)),
    NewMax is Num - 1,
    assert(max_connections(NewMax)).
% Even this doesn't work when the connections are maxed out:
    % com_sleep(1).
% An idea that hasn't been used yet:
% We don't want
% to hardcode the max number of connections, so we'll determine it when
% the exception first occurs.  The exception seems to occur with the
% first incoming connection request above the Max.
%
%     % Shut down the last connection opened:
%     findall(ConnectionId,
% 	    com_connection_info(ConnectionId, _, _, _, _),
% 	    Ids),
%     reverse(Ids, [LastId]),
%     com_GetInfo(LastId, connection(Connection)), 
%     tcp_shutdown(Connection).
	    

% com_handle_select_exception(E, _Event) :-
%     com_print_err(E),
%     fail.
% (DLM, 2000/11/13) Changed to this:
com_handle_select_exception(E, timeout) :-
    com_print_err(E),
    !.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% name:    com_print_err
% purpose:  Print error message if problem reading the event
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
com_print_err(E) :-
   nl,
   oaa:oaa_format('=========== READ ERROR ============~n',[]),
   format('| Messages in this block are rejected~n',[]),
   format('| by the system.~n',[]),
   format('---------------------------------------~n',[]),
   print_message(error, E),
   flush_output(user_error),
   format('=======================================~n',[]),
   current_output(CO),
   flush_output(CO).




%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% name:    com_AddInfo
% purpose:  Adds or changes information about connection
% remarks:
%    Info may be status(S), type(T), protocol(P) or any element (or list
%    of elements) to be stored in InfoList.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
com_AddInfo(ConnectionId, NewInfo) :-
	retract(com_connection_info(ConnectionId, Protocol, Type,
		InfoList, Status)),
	(NewInfo = status(NewStatus), C = true ; NewStatus = Status),
	(NewInfo = protocol(NewProtocol), C = true ; NewProtocol = Protocol),
	(NewInfo = type(NewType), C = true ; NewType = Type),
	(NewInfo = [_H|_T] ->
	   union([InfoList, NewInfo], NewInfoList)
	 | (ground(C) ; union([InfoList, [NewInfo]], NewInfoList))
	),
	assert(com_connection_info(ConnectionId, NewProtocol, NewType,
		NewInfoList, NewStatus)), !.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% name:    com_GetInfo(+ConnectionId, ?Info)
% purpose:  Looks up information about connection
% remarks:
%    Info may be status(S), type(T), protocol(P) or any element stored
%    in InfoList.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
com_GetInfo(ConnectionId, Info) :-
	com_connection_info(ConnectionId, Protocol, Type,
		InfoList, Status),
	(Info = status(Status) ;
	 Info = type(Type) ;
	 Info = protocol(Protocol) ;
	 memberchk(Info, InfoList)),
	!.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% name:    com_sleep(+TimeInSeconds).
% purpose: returns after TimeInSeconds has elapsed.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

com_sleep(TimeInSeconds) :-
    prolog_flag(source_info, _),
    %sicstus
    !,
    % Using SleepCall just to avoid some warnings from xref:
    SleepCall = sleep(TimeInSeconds),
    call(SleepCall).
com_sleep(TimeInSeconds) :-
    number(TimeInSeconds),
    TimeInSeconds > 0,
    !,
    tcp_now(Now),
    tcp_time_plus(Now,TimeInSeconds,Soon),
    tcp_schedule_wakeup(Soon, Soon),
    repeat,
    tcp_select_from(Term),
    Term = wakeup(Soon),
    !.
com_sleep(_TimeInSeconds).