diff --git a/src/Makefile b/src/Makefile index d8b4f632b..d1548ed4a 100644 --- a/src/Makefile +++ b/src/Makefile @@ -53,6 +53,7 @@ MODULES=yaws \ yaws_vdir \ yaws_multipart \ yaws_shaper \ + yaws_dime \ $(BITSMODS) diff --git a/src/yaws_dime.erl b/src/yaws_dime.erl new file mode 100644 index 000000000..1364a4860 --- /dev/null +++ b/src/yaws_dime.erl @@ -0,0 +1,222 @@ +%%%------------------------------------------------------------------- +%%% File : dime.erl +%%% @author Anders Nygren +%%% @doc Encoding and decoding of DIME messages. +%%% The Direct Internet Message Encapsulation (DIME) specification +%%% defines a mechanism for packaging binary data with SOAP messages. +%%% http://bgp.potaroo.net/ietf/all-ids/draft-nielsen-dime-02.txt +%%% Layout of a DIME encoded message is like this +%%%
+%%%  0                   1                   2                   3
+%%%  0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1
+%%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+%%% |         |M|M|C|       |       |                               |
+%%% | VERSION |B|E|F| TYPE_T| RESRVD|         OPTIONS_LENGTH        |
+%%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+%%% |            ID_LENGTH          |           TYPE_LENGTH         |
+%%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+%%% |                          DATA_LENGTH                          |
+%%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+%%% |                                                               /
+%%% /                     OPTIONS + PADDING                         /
+%%% /                                                               |
+%%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+%%% |                                                               /
+%%% /                          ID + PADDING                         /
+%%% /                                                               |
+%%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+%%% |                                                               /
+%%% /                        TYPE + PADDING                         /
+%%% /                                                               |
+%%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+%%% |                                                               /
+%%% /                        DATA + PADDING                         /
+%%% /                                                               |
+%%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+%%%
+%%% @end
+%%%
+%%% Created :  7 Apr 2008 by Anders Nygren <>
+%%%-------------------------------------------------------------------
+-module(yaws_dime).
+
+%% API
+-export([encode/2,
+	 decode/1,
+	 pad_len/1]).
+
+
+-include_lib("kernel/include/file.hrl").
+
+-define(VERSION1, 1).
+-define(T_UNCHANGED, 0).
+-define(T_MEDIA_TYPE, 1).
+-define(T_ABS_URI, 2).
+-define(T_UNKNOWN, 3).
+-define(T_NONE, 4).
+-define(SOAP_URI, "http://schemas.xmlsoap.org/soap/envelope").
+%%====================================================================
+%% API
+%%====================================================================
+%%--------------------------------------------------------------------
+%% @spec (Req, Attachments) ->binary()
+%% Description:
+%%--------------------------------------------------------------------
+encode(Req, []) ->
+    encode_part(1, 1, 0, ?T_ABS_URI, <<"">>, <<"">>, <>, Req);
+encode(Req, As) ->
+	list_to_binary([encode_part(1, 0, 0, ?T_ABS_URI, <<"">>, <<"">>, <>, Req)|
+	encode_attachments(As)]).
+
+encode_attachments([{attachment, Id, Type, File}]) ->
+    [encode_part(0, 1, 0, ?T_ABS_URI, <<"">>, list_to_binary(Id), list_to_binary(Type), File)];
+encode_attachments([{attachment, Id, Type, File} | As]) ->
+    [encode_part(0, 0, 0, ?T_ABS_URI, <<"">>, list_to_binary(Id), list_to_binary(Type), File)|
+     encode_attachments(As)].
+
+encode_part(MB, ME, CF, TypeT, Opts, ID, Type, Data) ->
+    Opts_len = size_of(Opts),
+    Opts_pad = pad_len(Opts_len),
+    Id_len = size_of(ID),
+    Id_pad = pad_len(Id_len),
+    Type_len = size_of(Type),
+    Type_pad = pad_len(Type_len),
+    Data_len = size_of(Data),
+    Data_pad = pad_len(Data_len),
+    Data1 = get_data(Data),
+    <>.
+
+pad_len(Len) ->
+    case Len rem 4 of
+	0 ->
+	    0;
+	N ->
+	    4-N
+    end.
+
+size_of(X) when is_list(X) ->
+    length(X);
+size_of(X) when is_binary(X)->
+    size(X);
+size_of({file, File}) ->
+    {ok,R} = file:read_file_info(File),
+    R#file_info.size.
+
+get_data({file, File}) ->
+    {ok, Data} = file:read_file(File),
+    Data;
+get_data(Data) when is_list(Data) ->
+    list_to_binary(Data);
+
+get_data(Data) ->
+    Data.
+%%--------------------------------------------------------------------
+%% @spec (Msg::binary()) ->
+%% @doc Decode a DIME encoded message.
+%%--------------------------------------------------------------------
+decode(Msg) ->
+    decode_recs(Msg, [], []).
+
+decode_recs(<<>>, Acc, _Chunks) ->
+    Acc;
+decode_recs(Msg, Acc, Chunks) ->
+    case {decode_rec(Msg), Chunks} of
+	%% A normal record
+	{{_ME=0, _CF=0, Opts, ID, Type, Chunk, More}, []} ->
+	    decode_recs(More, [{Opts, ID, Type, Chunk}|Acc], []);
+
+	%% The last chunk of a block, but not the last record
+	{{_ME=0, _CF=0, Opts, ID, Type, Chunk, More}, Chunks} ->
+	    Cs = lists:reverse([{Opts, ID, Type, Chunk}|Chunks]),
+	    %% Only the first chunk has values for Opts, Id and Type
+	    {ROpts, RID, RType, _Chunk} = hd(Cs),
+	    Block = list_to_binary([Ch || {_Opts, _ID, _Type, Ch} <- Cs]),
+	    error_logger:info_report([?MODULE, decode_rec, merging,
+				      {id, ID},{type, Type},
+				      {chunks, length(Cs)}]),
+	    decode_recs(More, [{ROpts, RID, RType, Block}|Acc], []);
+
+	%% Last record, but not chunked
+	{{_ME=1, _CF=0, Opts, ID, Type, Data, _More}, []} ->
+	    lists:reverse([{Opts, ID, Type, Data}|Acc]);
+
+	%% Last record, and last chunk of block
+	{{_ME=1, _CF=0, Opts, ID, Type, Chunk, _More}, Chunks} ->
+	    Cs = lists:reverse([{Opts, ID, Type, Chunk}|Chunks]),
+	    {ROpts, RID, RType, _Chunk} = hd(Cs),
+	    Block = list_to_binary([Ch || {_Opts, _ID, _Type, Ch} <- Cs]),
+	    error_logger:info_report([?MODULE, decode_rec, merging,
+				      {id, ID},{type, Type},
+				      {chunks, length(Cs)}]),
+	    lists:reverse([{ROpts, RID, RType, Block}|Acc]);
+
+	%% First or intermediate chunk, but not the last
+	{{_ME=0, _CF=1, Opts, ID, Type, Data, More}, Chunks} ->
+	    decode_recs(More, Acc, [{Opts, ID, Type, Data}|Chunks]);
+
+	%% Something wrong, ME=1 and CF=1
+	ErrorResult ->
+	        error_logger:error_report([?MODULE, decode_recs,
+					   {result, ErrorResult}])
+    end.
+
+decode_rec(<>=Block) ->
+    error_logger:info_report([?MODULE, decode_rec,
+			      {version,1},
+			      {mb,_MB},{me,ME},{cf,CF},{type_t,_Type_T},
+			      {res,_Res},{opt_len,Opt_Len},{id_len,ID_Len},
+			      {type_len,Type_Len},{date_len,Data_Len},
+			      {total_rec_size,byte_size(Block)}]),
+    Opt_pad = pad_len(Opt_Len),
+    Id_pad = pad_len(ID_Len),
+    Type_pad = pad_len(Type_Len),
+    Data_pad = pad_len(Data_Len),
+    Header = Opt_Len+Opt_pad+ID_Len+Id_pad+Type_Len+Type_pad,
+    DataTot = Data_Len+Data_pad,
+    case byte_size(Rest) of
+	N when N >= Header+DataTot ->
+	    <> = Rest,
+	    {ME, CF, Opts, ID, Type, Data, More};
+	N when N > Header->
+ 	    <> = Rest,
+	    error_logger:error_report([?MODULE, decode_rec, short_record,
+				       {need, Header+DataTot},
+				       {has, N}]),
+	    {ME, CF, Opts, ID, Type, Data, <<>>};
+	N ->
+	    error_logger:error_report([?MODULE, decode_rec, short_record,
+				       {need, Header+DataTot},
+				       {has, N}]),
+	    {error, not_enough_data}
+    end;
+
+decode_rec(Bin) ->
+    error_logger:error_report([?MODULE, decode_rec, short_record,
+			       no_header,
+			       {has, byte_size(Bin)}]),
+    {error, no_header}.
+
+
+%%====================================================================
+%% Internal functions
+%%====================================================================
diff --git a/src/yaws_rpc.erl b/src/yaws_rpc.erl
index 36b2d2afd..5138e1832 100644
--- a/src/yaws_rpc.erl
+++ b/src/yaws_rpc.erl
@@ -120,6 +120,9 @@ handle_payload(Args, Handler, Type) ->
 	    T when T==haxe; T==json ->
                 ?Debug("rpc ~p call ~p~n", [T, PL]),
 		{PL, yaws_api:url_decode(PL)};
+	    soap_dime ->
+		[{_,_,_,Req}|As] = yaws_dime:decode(Args#arg.clidata),
+		{Args#arg.clidata, {binary_to_list(Req), As}};
 	    _ ->
                 ?Debug("rpc plaintext call ~p~n", [PL]),
                 {PL, PL}
@@ -196,9 +199,13 @@ check_decoded_payload(Args, Handler, DecodedResult, Payload, Type, RpcType) ->
 %%% "X-Haxe-Remoting" HTTP header, then the "SOAPAction" header,
 %%% and if those are absent we assume the request is JSON.
 recognize_rpc_type(Args) ->
-    OtherHeaders = ((Args#arg.headers)#headers.other),
-    recognize_rpc_hdr(
-      [{X,Y,yaws:to_lower(Z),Q,W} || {X,Y,Z,Q,W} <- OtherHeaders]).
+    case (Args#arg.headers)#headers.content_type of
+	"application/dime" -> soap_dime;
+	_ ->
+	    OtherHeaders = ((Args#arg.headers)#headers.other),
+	    recognize_rpc_hdr([{X,Y,yaws:to_lower(Z),Q,W} ||
+                                  {X,Y,Z,Q,W} <- OtherHeaders])
+    end.
 
 recognize_rpc_hdr([{_,_,"x-haxe-remoting",_,_}|_]) -> haxe;
 recognize_rpc_hdr([{_,_,"soapaction",_,_}|_])      -> soap;
@@ -312,7 +319,8 @@ get_expire(M, F) ->
         _                        -> false
     end.
 
-callback_fun(M, F, Args, Payload, SessionValue, soap) ->
+callback_fun(M, F, Args, Payload, SessionValue, RpcType)
+  when RpcType =:= soap; RpcType =:= soap_dime ->
     fun() -> yaws_soap_srv:handler(Args, {M,F}, Payload, SessionValue) end;
 callback_fun(M, F, Args, Payload, SessionValue, _RpcType) ->
     fun() -> M:F(Args#arg.state, Payload, SessionValue) end.
@@ -324,9 +332,14 @@ encode_send(Args, StatusCode, [Payload], AddOn, ID, RpcType) ->
 
 encode_send(Args, StatusCode, Payload, AddOn, ID, RpcType) ->
     ?Debug("rpc response ~p ~n", [Payload]),
-    EncodedPayload = encode_handler_payload(Payload, ID, RpcType),
-    ?Debug("rpc encoded response ~p ~n", [EncodedPayload]),
-    send(Args, StatusCode, EncodedPayload, AddOn, RpcType).
+    case encode_handler_payload(Payload, ID, RpcType) of
+        {ok, EncodedPayload, NewRpcType} ->
+            ?Debug("rpc encoded response ~p ~n", [EncodedPayload]),
+            send(Args, StatusCode, EncodedPayload, AddOn, NewRpcType);
+        {ok, EncodedPayload} ->
+            ?Debug("rpc encoded response ~p ~n", [EncodedPayload]),
+            send(Args, StatusCode, EncodedPayload, AddOn, RpcType)
+    end.
 
 send(Args, StatusCode) ->
     send(Args, StatusCode, json).
@@ -345,10 +358,20 @@ content_hdr(json, Payload) -> {content, "application/json", Payload};
 content_hdr(_, Payload)    -> {content, "application/xml", Payload}.
 %% FIXME  would like to add charset info here !!
 
+encode_handler_payload({Xml,[]}, _ID, soap_dime) ->
+    {ok, Xml, soap};
+encode_handler_payload({Xml,As}, _ID, soap_dime) ->
+    EncodedPayload = yaws_dime:encode(Xml, As),
+    {ok, EncodedPayload};
+encode_handler_payload(Xml, _ID, soap_dime) ->
+    {ok, Xml, soap};
 encode_handler_payload({Xml,[]}, _ID, soap) ->
-    Xml;
+    {ok, Xml};
+encode_handler_payload({Xml,As}, _ID, soap) ->
+    EncodedPayload = yaws_dime:encode(Xml, As),
+    {ok, EncodedPayload, soap_dime};
 encode_handler_payload(Xml, _ID, soap) ->
-    Xml;
+    {ok, Xml};
 encode_handler_payload({error, [ErlStruct]}, ID, RpcType) ->
     encode_handler_payload({error, ErlStruct}, ID, RpcType);
 encode_handler_payload({error, ErlStruct}, ID, RpcType) ->
@@ -358,7 +381,7 @@ encode_handler_payload({error, ErlStruct}, ID, RpcType) ->
                                            {"jsonrpc", "2.0"}]});
             haxe -> [$h, $x, $r | haxe:encode({exception, ErlStruct})]
         end,
-    StructStr;
+    {ok, StructStr};
 encode_handler_payload({response, [ErlStruct]}, ID, RpcType) ->
     encode_handler_payload({response, ErlStruct}, ID, RpcType);
 encode_handler_payload({response, ErlStruct}, ID, RpcType) ->
@@ -368,7 +391,7 @@ encode_handler_payload({response, ErlStruct}, ID, RpcType) ->
                                            {"jsonrpc", "2.0"}]});
             haxe -> [$h, $x, $r | haxe:encode(ErlStruct)]
         end,
-    StructStr.
+    {ok, StructStr}.
 
 decode_handler_payload(json, JSonStr) ->
     try
@@ -392,6 +415,9 @@ decode_handler_payload(haxe, [$_, $_, $x, $= | HaxeStr]) ->
     end;
 decode_handler_payload(haxe, _HaxeStr) ->
     {error, missing_haxe_prefix};
+
+decode_handler_payload(soap_dime, Payload) ->
+    {ok, Payload, undefined};
 decode_handler_payload(soap, Payload) ->
     {ok, Payload, undefined}.
 
diff --git a/src/yaws_soap_lib.erl b/src/yaws_soap_lib.erl
index 49d8854f5..b0c5c4031 100644
--- a/src/yaws_soap_lib.erl
+++ b/src/yaws_soap_lib.erl
@@ -485,8 +485,12 @@ rmsp(Str) -> string:strip(Str, left).
 
 
 make_request_body(Content, []) ->
-    {"text/xml; charset=utf-8", ""++
-         Content}.
+    {"application/xml; charset=utf-8",
+     ""++ Content};
+make_request_body(Content, AttachedFiles) ->
+    {"application/dime",
+     yaws_dime:encode("" ++ Content,
+                      AttachedFiles)}.
 
 makeFault(FaultCode, FaultString) ->
     try
diff --git a/src/yaws_soap_srv.erl b/src/yaws_soap_srv.erl
index b263a33d7..dea2a6e72 100644
--- a/src/yaws_soap_srv.erl
+++ b/src/yaws_soap_srv.erl
@@ -210,12 +210,12 @@ result(_Model, false) ->   % soap notify !
 result(_Model, Error) ->
     srv_error(io_lib:format("Error processing message: ~p", [Error])).
 
-return(#wsdl{model = Model}, ResHeader, ResBody, ResCode, SessVal, undefined) ->
-    return(Model, ResHeader, ResBody, ResCode, SessVal, undefined);
-return(Model, ResHeader, ResBody, ResCode, SessVal, undefined)
+return(#wsdl{model = Model}, ResHeader, ResBody, ResCode, SessVal, Files) ->
+    return(Model, ResHeader, ResBody, ResCode, SessVal, Files);
+return(Model, ResHeader, ResBody, ResCode, SessVal, Files)
   when not is_list(ResBody) ->
-    return(Model, ResHeader, [ResBody], ResCode, SessVal, undefined);
-return(Model, ResHeader, ResBody, ResCode, SessVal, undefined) ->
+    return(Model, ResHeader, [ResBody], ResCode, SessVal, Files);
+return(Model, ResHeader, ResBody, ResCode, SessVal, Files) ->
     %% add envelope
     Header2 = case ResHeader of
                   undefined -> undefined;
@@ -225,7 +225,13 @@ return(Model, ResHeader, ResBody, ResCode, SessVal, undefined) ->
                                 'Header' = Header2},
     case catch erlsom:write(Envelope, Model) of
         {ok, XmlDoc} ->
-            {ok, XmlDoc, ResCode, SessVal};
+	    case Files of
+		undefined ->
+		    {ok, XmlDoc, ResCode, SessVal};
+		_ ->
+		    DIME = yaws_dime:encode(XmlDoc, Files),
+		    {ok, DIME, ResCode, SessVal}
+	    end;
         {error, WriteError} ->
             srv_error(f("Error writing XML: ~p", [WriteError]));
         OtherWriteError ->