1:- module(jsonrpc_protocol, [
    2  read_message/1,
    3  read_message/2,
    4
    5  write_message/1,
    6  write_message/2,
    7
    8  message_json/2
    9  ]).   10
   11:- use_module(library(json)).   12:- use_module(library(json_convert)).   13:- use_module(library(dcg/basics)).   14:- use_module(library(prolog_stack)).   15:- use_module(library(readutil)).   16
   17:- use_module(library(log4p)).   18
   19:- multifile on_message_read/1.   20:- multifile on_message_write/1.   21
   22read_message(In, Message) :-
   23  setup_and_call_cleanup(
   24    (current_input(SaveIn), set_input(In)), 
   25    read_message(Message),
   26    set_input(SaveIn)
   27    ).
   28    
   29read_message(Message) :-
   30  % Note: not requiring that the jsonrpc key be present
   31  % with value 2.0
   32  catch(
   33    (
   34      read_header(Size),
   35      read_blank_line,
   36      read_content(Size, Content),
   37      message_json(Message, Content)
   38      ),
   39    error(syntax_error(json(illegal_json)),_),
   40    fail
   41    ),
   42  ignore(call_read_message_hooks(Message)).
   43
   44message_json(Message, Json) :-
   45  atom_json_dict(Json, Message, []).
   46
   47write_message(Out,Message) :-
   48  with_output_to(Out,write_message(Message)).
   49
   50write_message(Message) :-
   51  message_json(Message, Content),
   52  string_length(Content, Size),
   53  write_content_length(Size),
   54  write_blank_line,
   55  write_content(Content),
   56  flush_output,
   57  ignore(call_write_message_hooks(Message)).
   58  
   59read_blank_line(In) :-
   60  read_line_to_codes(In,Codes),
   61  Codes \== end_of_file,
   62  phrase(blank_line,Codes,[]).
   63
   64try_read_from(In, Goal) :-
   65  stream_property(In, position(Pos)), 
   66  catch(
   67    ( Goal -> true ; ( set_stream_position(In, Pos), fail ) ),
   68    Any,
   69    ( set_stream_position(In, Pos), throw(Any) )
   70    ).
   71
   72try_read(Goal) :-
   73  current_input(In),
   74  try_read_from(In, Goal).
   75
   76read_header(Size) :-
   77  current_input(In),
   78  read_header(In, Size).
   79
   80read_header(In, Size) :-
   81  try_read_from(
   82    In,
   83    (
   84      read_content_type,
   85      read_content_length(Size)
   86      )
   87    ),
   88  !.
   89
   90read_header(In, Size) :-
   91  try_read_from(
   92    In,
   93    (
   94      read_content_length(Size),
   95      read_content_type
   96      )
   97    ),
   98  !.
   99
  100read_header(In, Size) :-
  101  try_read_from(
  102    In,
  103    read_content_length(Size)
  104    ),
  105  !.
  106
  107read_content_type :-
  108  current_input(In),
  109  read_line_to_codes(In, Line),
  110  Line \== end_of_file,
  111  phrase(content_type, Line).
  112
  113read_content_length(Size) :-
  114  current_input(In),
  115  read_line_to_codes(In, Line),
  116  Line \== end_of_file,
  117  phrase(content_length(Size), Line).
  118
  119write_content_length(Size) :-
  120  format("Content-Length: ~w\r\n",[Size]).
  121
  122read_blank_line :-
  123  current_input(In),
  124  read_blank_line(In).
  125
  126write_blank_line :-
  127  format("\r\n").
  128
  129read_content(Size, Content) :-
  130  current_input(In),
  131  read_string(In, Size, Content).
  132
  133write_content(Content) :-
  134  format("~s",[Content]).
  135
  136content_length(Size) -->
  137  "Content-Length",
  138  whites,
  139  ":",
  140  whites,
  141  digits(Digits),
  142  { string_codes(String, Digits), number_string(Size,String)}.
  143
  144content_type -->
  145  "Content-Type",
  146  whites,
  147  ":",
  148  whites,
  149  remainder(_).
  150
  151blank_line -->
  152  whites.
  153
  154% --- hooks ---
  155
  156call_read_message_hooks(Message) :-
  157  forall(
  158    catch_with_backtrace(
  159      ignore(jsonrpc_protocol:on_message_read(Message)),
  160      Error,
  161      print_message(error, Error)
  162      ),
  163    true
  164    ).
  165
  166call_write_message_hooks(Message)  :-
  167  forall(
  168    catch_with_backtrace(
  169      ignore(jsonrpc_protocol:on_message_write(Message)),
  170      Error,
  171      print_message(error, Error)
  172      ),
  173    true
  174    )