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(http/json)).   12:- use_module(library(http/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  phrase(blank_line,Codes,[]).
   62
   63try_read_from(In, Goal) :-
   64  stream_property(In, position(Pos)), 
   65  catch(
   66    ( Goal -> true ; set_stream_position(In, Pos) ),
   67    Any,
   68    ( set_stream_position(In, Pos), throw(Any) )
   69    ).
   70
   71try_read(Goal) :-
   72  current_input(In),
   73  try_read_from(In, Goal).
   74
   75read_header(Size) :-
   76  current_input(In),
   77  read_header(In, Size).
   78
   79read_header(In, Size) :-
   80  try_read_from(
   81    In,
   82    (
   83      read_content_type,
   84      read_content_length(Size),
   85      read_blank_line
   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  try_read_from(
  110    In,
  111    (
  112      read_line_to_codes(In, Line),
  113      phrase(content_type, Line)
  114      )
  115    ).
  116
  117read_content_length(Size) :-
  118  current_input(In),
  119  try_read_from(
  120    In,
  121    (
  122      read_line_to_codes(In, Line),
  123      phrase(content_length(Size), Line)
  124      )
  125    ).
  126
  127write_content_length(Size) :-
  128  format("Content-Length: ~w\r\n",[Size]).
  129
  130read_blank_line :-
  131  current_input(In),
  132  try_read_from(
  133    In,
  134    read_string(In, 2, "\r\n")
  135    ).
  136
  137write_blank_line :-
  138  format("\r\n").
  139
  140read_content(Size, Content) :-
  141  current_input(In),
  142  read_string(In, Size, Content).
  143
  144write_content(Content) :-
  145  format("~s",[Content]).
  146
  147content_length(Size) -->
  148  "Content-Length",
  149  whites,
  150  ":",
  151  whites,
  152  digits(Digits),
  153  { string_codes(String, Digits), number_string(Size,String)}.
  154
  155content_type -->
  156  "Content-Type",
  157  whites,
  158  ":",
  159  whites,
  160  remainder(_).
  161
  162blank_line -->
  163  whites.
  164
  165% --- hooks ---
  166
  167call_read_message_hooks(Message) :-
  168  forall(
  169    catch_with_backtrace(
  170      ignore(jsonrpc_protocol:on_message_read(Message)),
  171      Error,
  172      print_message(error, Error)
  173      ),
  174    true
  175    ).
  176
  177call_write_message_hooks(Message)  :-
  178  forall(
  179    catch_with_backtrace(
  180      ignore(jsonrpc_protocol:on_message_write(Message)),
  181      Error,
  182      print_message(error, Error)
  183      ),
  184    true
  185    )