-module(unxop).

%
% A quick and dirty XOP unraveller.
% (XOP = XML-binary Optimized Packaging, http://www.w3.org/TR/xop10/)
%
% Depends on xmerl and the mimemail module available as part of gen_smtp
%     (http://github.com/Vagabond/gen_smtp/tree/master).
%

-export([unxop/2, test/0]).

-include_lib("xmerl/include/xmerl.hrl").
-define(NS_XOP, "http://www.w3.org/2004/08/xop/include").

%
% unxop/2 returns the same result as xmerl_scan:string/2, but if the
% input was a XOP encoded XML document, then all xop:Include elements
% are "expanded" into their refernces text elements.
%
% The Header is meant to be [{"key", "value"}, ...] (the MIME headers, essentially).
% The Body is meant to be a MIME body.
%
unxop(Header, Body) ->
	try mimemail:decode(Header, Body) of
		{"multipart", "related", _Headers, Params, Parts} ->
			unxop_parts(Params, Parts);
		{Type, SubType, _Headers, _Params, _Parts} ->
			throw({unsupported_content, Type, SubType, "Multipart/Related was expected"})
	catch
		error: non_mime ->
			xmerl_scan:string(Body, [{quiet, true}])
	end.

unxop_parts(Params, Parts) ->
	case content_type_params(Params) of
		{"application/xop+xml", Start_ID} ->
			assemble_xml(Start_ID, Parts);
		{Type, _Start_ID} ->
			throw({unsupported_type, Type, "application/xop+xml was expected"})
	end.

content_type_params(Params) ->
	case proplists:get_value("content-type-params", Params) of
		undefined ->
			{undefined, undefined};
		L when is_list(L) ->
			{proplists:get_value("type", L), proplists:get_value("start", L)}
	end.

assemble_xml(undefined,
		[{_Type, _Subtype, _Headers, _Parameters, Content} | Rest] = Parts) ->
	{XML, Rest} = xmerl_scan:string(Content, [{quiet, true}]),
	{expand_xml(XML, Parts), Rest};
assemble_xml(Start_ID, Parts) ->
	{XML, Rest} = xmerl_scan:string(find_content(Start_ID, Parts), [{quiet, true}]),
	{expand_xml(XML, Parts), Rest}.

% No further sub elements.
expand_xml(#xmlElement{content = []} = XML, _Parts) ->
	XML;
% Have exactly one 'Include' sub element!
expand_xml(#xmlElement{ content = [
			#xmlElement{ nsinfo = {_NS, "Include"} } = Include
		] } = XML, Parts) ->
	case xmerl_xs:select("namespace-uri(.)", Include) of
		{xmlObj, string, ?NS_XOP} ->
			Parent = {XML#xmlElement.name, XML#xmlElement.pos},
			Text = #xmlText{
				parents = [Parent | XML#xmlElement.parents],
				pos = 1,
				value = replacement_part(Include, Parts)
			},
			XML#xmlElement{ content = [ Text ] };
		_Other ->
			XML
	end;
% Have a list of sub elements.
expand_xml(#xmlElement{content = L} = XML, Parts) ->
	XML#xmlElement{ content = [ expand_xml(E, Parts) || E <- L ] };
% Some other component, e.g., #xmlText.
expand_xml(XML, _Parts) ->
	XML.

replacement_part(Include, Parts) ->
	case xmerl_xs:select("@href", Include) of
		[] ->
			throw({xop_include_missing_href, Include});
		[#xmlAttribute{ value = "cid:" ++ Value }] ->
			find_content("<" ++ Value ++ ">", Parts);
		[#xmlAttribute{ value = Value }] ->
			find_content(Value, Parts);
		Other ->
			throw({xop_include_malformed, Include, Other})
	end.


find_content(ID, Parts) ->
	Found = [ Content || {_Type, _Subtype, Headers, _Parameters, Content} <- Parts,
			proplists:get_value("Content-ID", Headers) == ID ],
	case Found of
		[] ->
			throw({xop_part_not_found, ID});
		[C] ->
			C;
		Other ->
			throw({xop_part_malformed, ID, Other})
	end.


test1() ->
	Headers = [
		{"MIME-Version", "1.0"},
		{"Content-Type", "Multipart/Related;boundary=MIME_boundary; type=\"application/xop+xml\"; start=\"<mymessage.xml@example.org>\"; startinfo=\"application/soap+xml; action=\\\"ProcessData\\\"\""},
		{"Content-Description", "A SOAP message with my pic and sig in it"}
	],
	Body =
"--MIME_boundary\r\n"
"Content-Type: application/xop+xml; \r\n"
"	charset=UTF-8; \r\n"
"	type=\"application/soap+xml; action=\\\"ProcessData\\\"\"\r\n"
"Content-Transfer-Encoding: 8bit\r\n"
"Content-ID: <mymessage.xml@example.org>\r\n"
"\r\n"
"<soap:Envelope\r\n"
"    xmlns:soap='http://www.w3.org/2003/05/soap-envelope'\r\n"
"    xmlns:xmlmime='http://www.w3.org/2004/11/xmlmime'>\r\n"
"  <soap:Body>\r\n"
"    <m:data xmlns:m='http://example.org/stuff'>\r\n"
"      <m:photo \r\n"
"  xmlmime:contentType='image/png'><xop:Include \r\n"
"    xmlns:xop='http://www.w3.org/2004/08/xop/include' \r\n"
"    href='cid:http://example.org/me.png'/></m:photo>\r\n"
"      <m:sig \r\n"
"  xmlmime:contentType='application/pkcs7-signature'><xop:Include \r\n"
"    xmlns:xop='http://www.w3.org/2004/08/xop/include' \r\n"
"    href='cid:http://example.org/my.hsh'/></m:sig>\r\n"
"    </m:data>\r\n"
"  </soap:Body>\r\n"
"</soap:Envelope>\r\n"
"\r\n"
"--MIME_boundary\r\n"
"Content-Type: image/png\r\n"
"Content-Transfer-Encoding: binary\r\n"
"Content-ID: <http://example.org/me.png>\r\n"
"\r\n"
"// binary octets for png\r\n"
"\r\n"
"--MIME_boundary\r\n"
"Content-Type: application/pkcs7-signature\r\n"
"Content-Transfer-Encoding: binary\r\n"
"Content-ID: <http://example.org/my.hsh>\r\n"
"\r\n"
"// binary octets for signature\r\n"
"\r\n"
"--MIME_boundary--",
	{XML, _} = unxop(Headers, Body),
	"// binary octets for png\r\n" =
			lists:flatten(xmerl_xs:value_of(xmerl_xs:select("//m:photo", XML))),
	"// binary octets for signature\r\n" =
			lists:flatten(xmerl_xs:value_of(xmerl_xs:select("//m:sig", XML))),
	ok.

test() ->
	ok = test1().