Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Added a haXe remoting adapter with documentation

git-svn-id: https://erlyaws.svn.sourceforge.net/svnroot/erlyaws/trunk/yaws@986 9fbdc01b-0d2c-0410-bfb7-fb27d70d8b52
  • Loading branch information...
commit 1791e3dcc19748a280ee4267e3805e15964499d0 1 parent 4cec5f8
Yariv Sadan authored
View
3  src/Makefile
@@ -33,7 +33,8 @@ MODULES=yaws \
yaws_rss \
yaws_dav \
yaws_pam \
- json jsonrpc yaws_jsonrpc yaws_xmlrpc
+ json jsonrpc yaws_jsonrpc yaws_xmlrpc\
+ haxe yaws_rpc
EBIN_FILES=$(MODULES:%=../ebin/%.$(EMULATOR)) ../ebin/yaws.app
View
707 src/haxe.erl
@@ -0,0 +1,707 @@
+%%% Copyright (c) 2005-2006, A2Z Development USA, Inc. All Rights Reserved.
+%%%
+%%% The contents of this file are subject to the Erlang Public License,
+%%% Version 1.1, (the "License"); you may not use this file except in
+%%% compliance with the License. You should have received a copy of the
+%%% Erlang Public License along with this software. If not, it can be
+%%% retrieved via the world wide web at http://www.erlang.org/.
+%%%
+%%% Software distributed under the License is distributed on an "AS IS"
+%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%%% the License for the specific language governing rights and limitations
+%%% under the License.
+%%%
+%%% The Initial Developer of the Original Code is A2Z Development USA, Inc.
+%%% All Rights Reserved.
+
+%% This code was originally created for serializing/deserializing
+%% Erlang terms in JSON format. It was hacked to handle haXe
+%% (http://www.haxe.org) serialization/deserialization.
+%%
+%% Modified by Yariv Sadan (yarivvv@gmail.com)
+
+-module(haxe).
+-export([encode/1, decode_string/1, decode/2, decode_next/1]).
+-export([is_obj/1, obj_new/0, obj_fetch/2, obj_find/2, obj_is_key/2]).
+-export([obj_store/3, obj_from_list/1, obj_fold/3]).
+-compile(export_all).
+-author("Jim Larson <jalarson@amazon.com>, Robert Wai-Chi Chu <robchu@amazon.com>").
+-author("Gaspar Chilingarov <nm@web.am>, Gurgen Tumanyan <barbarian@armkb.com>").
+-autor("Yariv Sadan <yarivvv@gmail.com>").
+-vsn("1").
+
+%%% This module translates haXe types into the following Erlang types:
+%%%
+%%% haXe Erlang
+%%% ---- ------
+%%% int, float number
+%%% string (ascii, utf8) string
+%%% array {array, ElementList}
+%%% true, false, null atoms 't', 'f', and 'n'
+%%% Number.NaN atom 'nan'
+%%% Number.NEGATIVE_INFINITY atom 'neg_infinity'
+%%% Number.POSITIVE_INFINITY atom 'infinity'
+%%% object tagged proplist with string (or atom) keys
+%%% (e.g. {struct, [{foo, "bar"}, {baz, 4}]} )
+%%% class object NOT SUPPORTED
+%%% enum NOT SUPPORTED
+%%% reference {ref, Idx}, Idx -> int()
+%%% exception {exception, Obj}, Obj is any of the haXe types above
+%%%
+%%% Classs objects and Enums are currently not supported
+%%% because simulating such types in Erlang is quite cumbersome, plus
+%%% anonymous objects should be sufficient for most RPC needs.
+%%% (If you strongly believe otherwise, contact me at yarivvv@gmail.com
+%%% and I will consider adding class/enum support in a future version).
+%%%
+%%% References are handled transparently by the encoding/decoding
+%%% functions. The decoding functions automatically expand
+%%% references, and the encoding functions automatically serialize
+%%% a string as a reference if an equal string has already been
+%%% serialized (note: the haXe serializer can reference strings,
+%%% arrays and objects, but the Erlang encoder only references
+%%% strings due to the lack of address comparison in Erlang).
+%%%
+%%% If you wish to avoid expensive string comparisons
+%%% in the encoder, or to have references to non-string objects,
+%%% you can define a reference explicitly as a
+%%% {ref, Idx} tuple. However, this usage is confusing and
+%%% error prone, so it's better to avoid it except in extreme
+%%% cases.
+
+-define(Log(X, Y), io:format(X ++ "\n", Y)).
+
+encode({ref, _Idx} = Ref) -> encode_basic(Ref);
+encode(Obj) ->
+ {Result, _Cache} = encode(Obj, []),
+ Result.
+encode(L, Cache) when is_list(L) ->
+ case is_string(L) of
+ yes -> encode_string(L, $s, Cache);
+ unicode -> encode_string(xmerl_ucs:to_utf8(L), $j, Cache);
+ no -> exit({haxe_encode, {not_string, L}})
+ end;
+encode({array, Props}, Cache) -> encode_array(Props, Cache);
+encode({struct, Props}, Cache) -> encode_object(Props, Cache);
+encode({exception, E}, Cache) ->
+ {Result, Cache2} = encode(E, Cache),
+ {[$x | Result], Cache2};
+encode(Term, Cache) ->
+ case encode_basic(Term) of
+ error ->
+ exit({haxe_encode, {bad_term, Term}});
+ Result ->
+ {Result, Cache}
+ end.
+
+encode_basic(Term) ->
+ case Term of
+ true -> "t";
+ false -> "f";
+ null -> "n";
+ undefined -> "n";
+ {ref, Idx} -> [$r | integer_to_list(Idx)];
+ nan -> "k";
+ infinity -> "p";
+ neg_infinity -> "m";
+ 0 -> "z";
+ I when is_integer(I) -> [$i | integer_to_list(I)];
+ F when is_float(F) -> [$d | io_lib:format("~g", [F])];
+ _ ->
+ error
+ end.
+
+
+%% Find an object in the list of previously encoded objects
+%% end return {true, {ref, Idx}}, if the search succeeded,
+%% where Idx is the position of the object in the (reversed) list.
+%% Otherwise, return 'false'.
+find_ref(Obj, Cache) ->
+ find_ref(Obj, Cache, length(Cache) - 1).
+find_ref(_Obj, [], _) -> false;
+find_ref(Obj, [Other | _Rest], Idx) when Obj == Other -> {true, {ref, Idx}};
+find_ref(Obj, [_Other | Rest], Idx) -> find_ref(Obj, Rest, Idx - 1).
+
+
+%% Encode an Erlang string to haXe.
+%% Accumulate strings in reverse.
+encode_string(S, Cache) -> encode_string(S, $s, Cache).
+encode_string(S, FirstChar, Cache) ->
+ encode_string(S, FirstChar, [], Cache).
+encode_string([], FirstChar, Acc, Cache) ->
+ Str = lists:reverse(Acc),
+ Result = [FirstChar, integer_to_list(length(Acc)), $: | Str],
+ case find_ref(Str, Cache) of
+ {true, Ref} ->
+ {encode(Ref), Cache};
+ _ ->
+ {Result, [Str | Cache]}
+ end;
+encode_string([C | Cs], FirstChar, Acc, Cache) ->
+ case C of
+ $\\ -> encode_string(Cs, FirstChar, [$\\, $\\ | Acc]);
+ $\n -> encode_string(Cs, FirstChar, [$n, $\\ | Acc]);
+ $\r -> encode_string(Cs, FirstChar, [$r, $\\ | Acc]);
+ C when C =< 16#FFFF -> encode_string(Cs, FirstChar, [C | Acc], Cache);
+ _ -> exit({haxe_encode, {bad_char, C}})
+ end.
+
+encode_object(Props, Cache) ->
+ {Result, Cache2} = encode_object_rest(Props, [placeholder | Cache]),
+ {[$o | Result], Cache2}.
+encode_object_rest(Props, Cache) ->
+ {EncodedProps, Cache1} =
+ lists:foldl(
+ fun({Key, Value}, {Acc, Cache2}) ->
+ {EncodedKey, Cache3} =
+ case Key of
+ L when is_list(L) -> encode_string(L, Cache2);
+ A when is_atom(A) -> encode_string(atom_to_list(A), Cache2);
+ _ -> exit({haxe_encode, {bad_key, Key}})
+ end,
+ {EncodedVal, Cache4} = encode(Value, Cache3),
+ case Acc of
+ [] -> {[[EncodedKey, EncodedVal]], Cache4}; _ -> {[[EncodedKey, EncodedVal] | Acc], Cache4}
+ end
+ end,
+
+ % We insert 'placeholder' into the ref list to ensure its length
+ % matches the number of objects that have been serialized so far.
+
+ {[], Cache},
+ Props),
+
+ Result = [lists:reverse(EncodedProps), $g],
+
+ {Result, Cache1}.
+
+
+encode_array(Props, Cache) ->
+ {NullCount, Arr, Cache1} = lists:foldl(
+ fun
+ (Elem, {NullCount, Arr, Cache2}) when Elem == null;
+ Elem == undefined ->
+ {NullCount+1, Arr, Cache2};
+ (Elem, {0, Arr, Cache2}) ->
+ {Encoded, Cache3} = encode(Elem, Cache2),
+ {0, [Encoded | Arr], Cache3};
+ (Elem, {NullCount, Arr, Cache2}) ->
+ {Encoded, Cache3} = encode(Elem, Cache2),
+ {0, [Encoded, encode_nulls(NullCount) | Arr], Cache3}
+ end,
+ {0, [$a], [placholder | Cache]}, Props),
+ {lists:reverse([$h , encode_nulls(NullCount) | Arr]), Cache1}.
+
+encode_nulls(0) -> [];
+encode_nulls(1) -> [$n];
+encode_nulls(Num) -> [$u | integer_to_list(Num)].
+
+%%% SCANNING
+%%%
+%%% Scanning funs return either:
+%%% {done, Result, LeftOverChars}
+%%% if a complete token is recognized, or
+%%% {more, Continuation}
+%%% if more input is needed.
+%%% Result is {ok, Term}, 'eof', or {error, Reason}.
+%%% Here, the Continuation is a simple Erlang string.
+%%%
+%%% Currently, error handling is rather crude - errors are recognized
+%%% by match failures. EOF is handled only by number scanning, where
+%%% it can delimit a number, and otherwise causes a match failure.
+%%%
+
+token([]) -> {more, []};
+token(eof) -> {done, eof, []};
+
+token([C | Rest]) ->
+ case token_identifier(C) of
+ int -> scan_int(Rest);
+ float -> scan_float(Rest);
+ string -> scan_string(Rest);
+ utf8 -> scan_utf8(Rest);
+ Token -> {done, {ok, Token}, Rest}
+ end.
+
+token_identifier(C) ->
+ case C of
+ $i -> int;
+ $d -> float;
+ $s -> string;
+ $j -> utf8;
+ $n -> null;
+ $t -> true;
+ $f -> false;
+ $z -> 0;
+ $k -> nan;
+ $p -> infinity;
+ $m -> neg_infinity;
+ $a -> array;
+ $h -> array_end;
+ $o -> obj;
+ $c -> class;
+ $g -> obj_end;
+ $r -> ref;
+ $x -> exception;
+
+ %% this token is only valid as an element
+ %% of an array
+ $u -> null_seq;
+ _ -> error
+ end.
+
+scan_utf8(Chars) ->
+ scan_chars(Chars, true).
+
+scan_string(Chars) ->
+ scan_chars(Chars, false).
+
+scan_chars(Chars, IsUtf8) ->
+ case scan_int(Chars) of
+ {done, {ok, _NumBytes}, []} ->
+ {more, Chars};
+ {done, {ok, _NumBytes}, [C | _Rest]} when C /= $: ->
+ {done, {error, bad_char, C}, Chars};
+ {done, {ok, NumBytes}, [_ | Rest]} when length(Rest) >= NumBytes ->
+ {Str, NewLength} =
+ case IsUtf8 of
+ true ->
+ NewStr = xmerl_ucs:to_utf8(lists:sublist(Rest, NumBytes)),
+ {NewStr, length(NewStr)};
+ false ->
+ {Rest, NumBytes}
+ end,
+ scan_chars(Str, [], NewLength);
+ {done, {ok, _NumBytes}, _Rest} ->
+ {more, Chars};
+ Other ->
+ Other
+ end.
+
+scan_chars(eof, A, _NumLeft) ->
+ {done, {error, premature_eof}, A};
+scan_chars(Rest, A, 0) ->
+ {done, {ok, lists:reverse(A)}, Rest};
+scan_chars([$\\] = Chars, _A, 0) ->
+ {done, {error, missing_escape_character}, Chars};
+
+scan_chars([$\\, C | Rest], A, NumLeft) ->
+ scan_chars(Rest, [esc_to_char(C) | A], NumLeft - 2);
+scan_chars([C | Rest], A, NumLeft) ->
+ scan_chars(Rest, [C | A], NumLeft - 1).
+
+esc_to_char(C) ->
+ case C of
+ $n -> $\n;
+ $r -> $\r;
+ $\\ -> $\\
+ end.
+
+scan_float(Chars) ->
+ scan_number(Chars, float).
+
+scan_int(Chars) ->
+ scan_number(Chars, int).
+
+scan_number([], _Type) -> {more, []};
+scan_number(eof, _Type) -> {done, {error, incomplete_number}, []};
+scan_number([$-, $- | _Rest] = Input, _Type) -> {done, {error, invalid_number}, Input};
+scan_number([$- | Ds] = Input, Type) ->
+ case scan_number(Ds, Type) of
+ {more, _Cont} -> {more, Input};
+ {done, {ok, N}, CharList} -> {done, {ok, -1 * N}, CharList};
+ {done, Other, Chars} -> {done, Other, Chars}
+ end;
+scan_number([D | Ds] = Input, Type) when D >= $0, D =< $9 ->
+ scan_number(Ds, D - $0, Input, Type).
+
+%% Numbers don't have a terminator, so stop at the first non-digit,
+%% and ask for more if we run out.
+
+scan_number([], _Num, X, _Type) -> {more, X};
+scan_number(eof, Num, _X, _Type) -> {done, {ok, Num}, eof};
+scan_number([$.], _Num, X, float) -> {more, X};
+scan_number([$., D | Ds], Num, X, float) when D >= $0, D =< $9 ->
+ scan_fraction([D | Ds], Num, X);
+scan_number([D | Ds], Num, X, Type) when Num > 0, D >= $0, D =< $9 ->
+ % Note that nonzero numbers can't start with "0".
+ scan_number(Ds, 10 * Num + (D - $0), X, Type);
+scan_number([D | Ds], Num, X, float) when D == $E; D == $e ->
+ scan_exponent_begin(Ds, float(Num), X);
+scan_number([D | _] = Ds, Num, _X, _Type) when D < $0; D > $9 ->
+ {done, {ok, Num}, Ds}.
+
+scan_fraction(Ds, I, X) -> scan_fraction(Ds, [], I, X).
+scan_fraction([], _Fs, _I, X) -> {more, X};
+scan_fraction(eof, Fs, I, _X) ->
+ R = I + list_to_float("0." ++ lists:reverse(Fs)),
+ {done, {ok, R}, eof};
+scan_fraction([D | Ds], Fs, I, X) when D >= $0, D =< $9 ->
+ scan_fraction(Ds, [D | Fs], I, X);
+scan_fraction([D | Ds], Fs, I, X) when D == $E; D == $e ->
+ R = I + list_to_float("0." ++ lists:reverse(Fs)),
+ scan_exponent_begin(Ds, R, X);
+scan_fraction(Rest, Fs, I, _X) ->
+ R = I + list_to_float("0." ++ lists:reverse(Fs)),
+ {done, {ok, R}, Rest}.
+
+scan_exponent_begin(Ds, R, X) ->
+ scan_exponent_begin(Ds, [], R, X).
+scan_exponent_begin([], _Es, _R, X) -> {more, X};
+scan_exponent_begin(eof, _Es, _R, X) -> {done, {error, missing_exponent}, X};
+scan_exponent_begin([D | Ds], Es, R, X) when D == $-;
+ D == $+;
+ D >= $0, D =< $9 ->
+ scan_exponent(Ds, [D | Es], R, X).
+
+scan_exponent([], _Es, _R, X) -> {more, X};
+scan_exponent(eof, Es, R, _X) ->
+ X = R * math:pow(10, list_to_integer(lists:reverse(Es))),
+ {done, {ok, X}, eof};
+scan_exponent([D | Ds], Es, R, X) when D >= $0, D =< $9 ->
+ scan_exponent(Ds, [D | Es], R, X);
+scan_exponent(Rest, Es, R, _X) ->
+ X = R * math:pow(10, list_to_integer(lists:reverse(Es))),
+ {done, {ok, X}, Rest}.
+
+%%% PARSING
+%%%
+%%% The decode function takes a char list as input, but
+%%% interprets the end of the list as only an end to the available
+%%% input, and returns a "continuation" requesting more input.
+%%% When additional characters are available, they, and the
+%%% continuation, are fed into decode/2. You can use the atom 'eof'
+%%% as a character to signal a true end to the input stream, and
+%%% possibly flush out an unfinished number. The decode_string/1
+%%% function appends 'eof' to its input and calls decode/1.
+%%%
+%%% Parsing and scanning errors are handled only by match failures.
+%%% The external caller must take care to wrap the call in a "catch"
+%%% or "try" if better error-handling is desired. Eventually parse
+%%% or scan errors will be returned explicitly with a description,
+%%% and someday with line numbers too.
+%%%
+%%% The parsing code uses a continuation-passing style to allow
+%%% for the parsing to suspend at any point and be resumed when
+%%% more input is available.
+%%% See http://en.wikipedia.org/wiki/Continuation_passing_style
+
+
+%% Return the first haXe value decoded from the input string.
+%% The string must contain at least one complete haXe value.
+
+decode_string(CharList) ->
+ {done, V, _} = decode(CharList ++ [eof]),
+ V.
+
+%% Attempt to decode a haXe value from the input string
+%% and continuation, using an empty initial continuation.
+%% Return {done, Result, {LeftoverChars, Cache}} if a value is recognized,
+%% or {more, Continuation} if more input characters are needed.
+%% The Result can be {ok, Value}, eof, or {error, Reason}.
+%% The Continuation is then fed as an argument to decode/2 when
+%% more input is available.
+%% Use the atom 'eof' instead of a char list to signal
+%% a true end to the input, and may flush a final number.
+
+decode(CharList) ->
+ decode({{[], []}, fun first_cont_fun/2}, CharList).
+
+decode({{[], Cache}, Kv}, CharList) ->
+ get_token({CharList, Cache}, Kv);
+decode({{OldChars, Cache}, Kv}, CharList) ->
+ get_token({OldChars ++ CharList, Cache}, Kv).
+
+%% This function helps parse contiguous haXe terms
+%% that share the same cache.
+decode_next({OldChars, Cache}) ->
+ decode({{[], Cache}, fun first_cont_fun/2}, OldChars).
+
+first_cont_fun(eof, Cs) -> {done, eof, Cs};
+first_cont_fun(T, Cs) ->
+ parse_value(T, Cs,
+ fun(V, C2) ->
+ {done, {ok, V}, C2}
+ end).
+
+%% Continuation Kt must accept (TokenOrEof, {Chars, Cache})
+
+get_token({Chars, Cache}, Kt) ->
+ case token(Chars) of
+ {done, {ok, T}, Rest} -> Kt(T, {Rest, Cache});
+ {done, eof, Rest} -> Kt(eof, {Rest, Cache});
+ {done, {error, Reason}, Rest} -> {done, {error, Reason}, {Rest, Cache}};
+ {more, X} -> {more, {X, Kt}}
+ end.
+
+%% Continuation Kv must accept (Value, {Chars, Cache})
+
+parse_value(Token, C, Kv) ->
+ parse_value(Token, C, Kv, false).
+parse_value(Token, {Chars, Cache} = C, Kv, AcceptNullSeq)->
+ case Token of
+ eof -> {done, {error, premature_eof}, C};
+ T when T == null; T == true; T == false; T == nan;
+ T == infinity; T == neg_infinity ->
+ Kv(T, C);
+ obj -> parse_object(C, Kv);
+ class -> parse_class(C, Kv);
+ array -> parse_array(C, Kv);
+ enum -> parse_enum(C, Kv);
+ exception -> parse_exception(C, Kv);
+ ref -> parse_ref(C, Kv);
+ null_seq when AcceptNullSeq -> parse_null_seq(C, Kv);
+ S when is_list(S) -> Kv(S, {Chars, [S | Cache]});
+ N when is_number(N) -> Kv(N, C);
+ _ -> {done, {error, syntax_error}, C}
+ end.
+
+parse_class(Chars, _Kv) ->
+ {done, {error, class_objects_not_supported}, Chars}.
+
+parse_object(Chars, Kv) ->
+ parse_object(Chars, Kv, obj_new()).
+
+parse_object(C, Kv, Obj) ->
+ get_token(C,
+ fun(T, {Chars2, Cache2}) ->
+ case T of
+ obj_end ->
+ Kv(Obj, {Chars2, [Obj | Cache2]});
+ _ -> parse_object_field(Obj, T,
+ {Chars2,
+ [placeholder | Cache2]},
+ Cache2,
+ Kv)
+ end
+ end).
+
+parse_object_field(_Obj, eof, C, _OrigCache, _Kv) ->
+ {done, {error, premature_eof}, C};
+
+%% if the key is a reference, we deference it and continue
+parse_object_field(Obj, ref, C, OrigCache, Kv) ->
+ parse_ref(C,
+ fun(Key, C1) ->
+ parse_object_val(Obj, Key, C1, OrigCache, Kv)
+ end);
+
+%% if the key is a string, we put it in the cache and continue
+parse_object_field(Obj, Field, {Chars, Cache}, OrigCache, Kv)
+ when is_list(Field) ->
+ parse_object_val(Obj, Field, {Chars, [Field | Cache]}, OrigCache, Kv).
+
+parse_object_val(Obj, Field, {Chars, Cache}, OrigCache, Kv)
+ when is_list(Field) ->
+ get_token({Chars, Cache},
+ fun(T, C2) ->
+ parse_value
+ (T, C2,
+ fun(Val, C3) ->
+ Obj2 = obj_store(Field, Val, Obj),
+ parse_object_next(Obj2, C3, OrigCache, Kv)
+ end)
+ end);
+parse_object_val(_Obj, Field, C, _OrigCache, _Kv) ->
+ {done, {error, {member_name_not_string, Field}}, C}.
+
+parse_object_next(Obj, C, OrigCache, Kv) ->
+ get_token(C,
+ fun
+ (obj_end, {Chars1, Cache1}) ->
+ {struct, Props} = Obj,
+ Obj2 = {struct, lists:reverse(Props)},
+ Cache2 = append_new_elems(Cache1, [Obj2 | OrigCache]),
+ Kv(Obj2, {Chars1, Cache2});
+ (eof, C1) ->
+ {done, {error, premature_eof}, C1};
+ (T, C1) ->
+ parse_object_field(Obj, T, C1, OrigCache, Kv)
+ end).
+
+
+parse_array({Chars, Cache}, Kv) ->
+
+ %% We need to put a temporary placeholder in the cache
+ %% to comply with haXe's indexing scheme, which assumes
+ %% the array is put in the cache *before* its members.
+ %% When we finish parsing the array, we collect the new
+ %% cache entries and put them in the old cache after
+ %% first inserting the fully parsed array.
+ %%
+ %% If it sounds backwards, well, it is! :)
+
+ parse_array([], {Chars, [placeholder | Cache]}, Cache, Kv).
+
+parse_array(Elems, C, OrigCache, Kv) ->
+ get_token(C,
+ fun
+ (eof, C1) -> {done, {error, premature_eof}, C1};
+ (array_end, {Chars1, Cache1}) ->
+ Arr = {array, lists:reverse(Elems)},
+ Cache2 = append_new_elems(
+ Cache1,
+ [Arr | OrigCache]),
+ Kv(Arr, {Chars1, Cache2});
+ (T, C1) ->
+ parse_array_tok(Elems, T, C1, OrigCache, Kv)
+ end).
+
+parse_array_tok(Elems, T, Cont, OrigCache, Kv) ->
+ parse_value(T, Cont,
+ fun({null_seq, Nulls}, C1) ->
+ parse_array(Nulls ++ Elems, C1, OrigCache, Kv);
+ (V, C1) ->
+ parse_array([V | Elems], C1, OrigCache, Kv)
+ end,
+ true).
+
+append_new_elems(TempCache, Cache) ->
+ NumNewElts = length(TempCache) - length(Cache),
+ NewElts = lists:sublist(TempCache, NumNewElts),
+ Result = NewElts ++ Cache,
+ Result.
+
+parse_enum(Chars, _Kv) ->
+ {done, {error, enums_not_supported}, Chars}.
+
+%% it's safe to assume we'll never have to parse exceptions
+%% on the server side, but this function is here for completeness
+parse_exception(Cont, Kv) ->
+ get_token(Cont,
+ fun(T, C1) ->
+ parse_value(T, C1,
+ fun(Val, C2) ->
+ Kv({exception, Val}, C2)
+ end)
+ end).
+
+
+%%% The next three functions help with storing references
+%%% to deserialized objects for future lookup during decoding
+
+parse_ref({Chars, Cache}, Kv) ->
+ case scan_int(Chars) of
+ {done, {ok, Idx}, Chars1} when Idx > length(Cache) ->
+ {done, {error, {ref_idx_out_of_bounds, Idx}}, {Chars1, Cache}};
+ {done, {ok, Idx}, Chars1} ->
+ Kv(lists:nth(length(Cache) - Idx, Cache), {Chars1, Cache});
+ Other ->
+ Other
+ end.
+
+parse_null_seq({Chars, Cache}, Kv) ->
+ case scan_int(Chars) of
+ {done, {ok, Num}, C1} when Num > 0 ->
+ Kv({null_seq, lists:duplicate(Num, null)}, {C1, Cache});
+ Other ->
+ Other
+ end.
+
+%%% OBJECTS
+%%%
+%%% We'll use tagged property lists as the internal representation
+%%% of haXe objects. Unordered lists perform worse than trees for
+%%% lookup and modification of members, but we expect objects to be
+%%% have only a few members. Lists also print better.
+
+is_obj(_) ->
+ false.
+
+%% create a simple haXe object
+obj_new() ->
+ {struct, []}.
+
+%% Fetch an object member's value, expecting it to be in the object.
+%% Return value, runtime error if no member found with that name.
+obj_fetch(Key, {struct, Props}) ->
+ case proplists:get_value(Key, Props) of
+ undefined ->
+ exit({struct_no_key, Key});
+ Value ->
+ Value
+ end.
+
+%% Fetch an object member's value, or indicate that there is no such member.
+%% Return {ok, Value} or 'error'.
+
+obj_find(Key, {struct, Props}) ->
+ case proplists:get_value(Key, Props) of
+ undefined ->
+ error;
+ Value ->
+ {ok, Value}
+ end.
+
+obj_is_key(Key, {struct, Props}) ->
+ proplists:is_defined(Key, Props).
+
+%% Store a new member in an object. Returns a new object.
+
+obj_store(KeyStr, Value, {struct, Props}) ->
+ Key = list_to_atom(KeyStr),
+ NewProps = [{Key, Value} | proplists:delete(Key, Props)],
+ {struct, NewProps}.
+
+%% Create an object from a list of Key/Value pairs.
+
+obj_from_list(Props) ->
+ {struct, {Props}}.
+
+%% Fold Fun across object, with initial accumulator Acc.
+%% Fun should take (Value, Acc) as arguments and return Acc.
+
+obj_fold(Fun, Acc, {struct, Props}) ->
+ lists:foldl(Fun, Acc, Props).
+
+is_string([]) -> yes;
+is_string(List) -> is_string(List, non_unicode).
+
+is_string([C|Rest], non_unicode) when C >= 0, C =< 255 -> is_string(Rest, non_unicode);
+is_string([C|Rest], _) when C =< 65000 -> is_string(Rest, unicode);
+is_string([], non_unicode) -> yes;
+is_string([], unicode) -> unicode;
+is_string(_, _) -> no.
+
+
+test() ->
+ Tests = [
+ {1, "i1"},
+ {1.1, "d1.1"},
+ {"foo", "s3:foo"},
+ %% todo test utf8
+ {null, "n"},
+ {true, "t"},
+ {false, "f"},
+ {0, "z"},
+ {nan, "k"},
+ {infinity, "p"},
+ {neg_infinity, "m"},
+ {{array, [1,2,3]}, "ai1i2i3h"},
+ {{array, [null]}, "anh"},
+ {{array, [null, null]}, "au2h"},
+ {{array, [3, 4, null, null, null, 5, null]}, "ai3i4u3i5nh"},
+ {{struct, [{foo, "bar"}, {baz, "boing"}]}, "os3:foos3:bars3:bazs5:boingg"},
+ {{exception, "bad"}, "xs3:bad"},
+ {{array, ["foo", "bar", "foo"]}, "as3:foos3:barr1h"},
+ {{struct, [{foo, 34}, {bar, "foo"}]}, "os3:fooi34s3:barr1g"}
+ ],
+ {Passed, Failed} =
+ lists:foldl(
+ fun({Term, Str}, Agg) ->
+ Encoded = lists:flatten(encode(Term)),
+ {ok, Decoded} = decode_string(Str),
+ Check = fun(Val1, Val2, {P, F}) ->
+ case Val1 == Val2 of
+ true -> {P + 1, F};
+ _ -> {P, F + 1}
+ end
+ end,
+ Agg1 = Check(Str, Encoded, Agg),
+ Agg2 = Check(Term, Decoded, Agg1),
+ io:format("~s == ~s\n~w\n~w == ~w\n~w\n\n", [Str, Encoded, Str == Encoded,
+ Term, Decoded, Term == Decoded]),
+ Agg2
+ end,
+ {0, 0}, Tests),
+ io:format("passed: ~w, failed: ~w\n", [Passed, Failed]).
View
268 src/yaws_rpc.erl
@@ -0,0 +1,268 @@
+%% Copyright (C) 2003 Joakim Grebenö <jocke@gleipnir.com>.
+%% All rights reserved.
+%%
+%% Copyright (C) 2006 Gaspar Chilingarov <nm@web.am>
+%% Gurgen Tumanyan <barbarian@armkb.com>
+%% All rights reserved.
+%%
+%%
+%% Redistribution and use in source and binary forms, with or without
+%% modification, are permitted provided that the following conditions
+%% are met:
+%%
+%% 1. Redistributions of source code must retain the above copyright
+%% notice, this list of conditions and the following disclaimer.
+%% 2. Redistributions in binary form must reproduce the above
+%% copyright notice, this list of conditions and the following
+%% disclaimer in the documentation and/or other materials provided
+%% with the distribution.
+%%
+%% THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS
+%% OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+%% WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+%% ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+%% DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+%% DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+%% GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+%% WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+%% NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+%% SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+%% NOTE: This module was originally called yaws_jsonrpc.
+%% It was hacked to transparently supports haXe remoting as well,
+%% hence its name was changed to the more generic 'yaws_rpc'.
+%%
+%% modified by Yariv Sadan (yarivvv@gmail.com)
+
+-module(yaws_rpc).
+-author("Gaspar Chilingarov <nm@web.am>, Gurgen Tumanyan <barbarian@armkb.com>"). -modified_by("Yariv Sadan <yarivvv@gmail.com>").
+
+-export([handler/2]).
+-export([handler_session/2, handler_session/3]).
+
+%-define(debug, 1).
+%-include("../../yaws/src/yaws_debug.hrl").
+
+-include("../../yaws/include/yaws_api.hrl").
+
+%%% ######################################################################
+%%% public interface
+%%%
+
+%%%
+%%% use rpc handler which can automagically start sessions if we need
+%%%
+handler_session(Args, Handler) ->
+ handler_session(Args, Handler, 'SID').
+
+%%%
+%%% allow overriding session Cookie name
+%%%
+handler_session(Args, Handler, SID_NAME) when is_atom(SID_NAME) ->
+ handler_session(Args, Handler, atom_to_list(SID_NAME));
+
+handler_session(Args, Handler, SID_NAME) ->
+ handler(Args, Handler, {session, SID_NAME}). % go to generic handler
+
+%%%
+%%% xmlrpc:handler compatible call
+%%% no session support will be available
+handler(Args, Handler) ->
+ handler(Args, Handler, simple).
+
+
+%%% ######################################################################
+%%% private functions
+%%%
+
+%%% we should be called from yaws page or module
+handler(Args, Handler, Type) when is_record(Args, arg) -> % {{{
+ case parse_request(Args) of
+ ok ->
+ handle_payload(Args, Handler, Type);
+ {status, StatusCode} -> % cannot parse request
+ send(Args, StatusCode)
+ end. % }}}
+
+-define(ERROR_LOG(Reason),
+ error_logger:error_report({?MODULE, ?LINE, Reason})).
+
+-define(LOG(Reason), ?ERROR_LOG(Reason)).
+
+%%%
+%%% check that request come in reasonable protocol version and reasonable method
+%%%
+parse_request(Args) -> % {{{
+ Req = Args#arg.req,
+ case {Req#http_request.method, Req#http_request.version} of
+ {'POST', {1,0}} ->
+% ?Debug("HTTP Version 1.0~n", []),
+ ok;
+ {'POST', {1,1}} ->
+% ?Debug("HTTP Version 1.1~n", []),
+ ok;
+ {'POST', _HTTPVersion} -> {status, 505};
+ {_Method, {1,1}} -> {status, 501};
+ _ -> {status, 400}
+ end. % }}}
+
+handle_payload(Args, Handler, Type) -> % {{{
+ Payload = binary_to_list(Args#arg.clidata),
+% ?Debug("rpc plaintext call ~p ~n", [Payload]),
+
+ RpcType = recognize_rpc_type(Args),
+
+ % haXe parameters are URL encoded
+ DecodedStr = case RpcType of
+ haxe -> yaws_api:url_decode(Payload);
+ _ -> Payload
+ end,
+ case decode_handler_payload(RpcType, DecodedStr) of
+ {ok, DecodedPayload, ID} ->
+ % ?Debug("client2erl decoded call ~p ~n", [DecodedPayload]),
+ eval_payload(Args, Handler, DecodedPayload, Type, ID, RpcType);
+ {error, Reason} ->
+ ?ERROR_LOG({html, client2erl, Payload, Reason}),
+ send(Args, 400)
+ end. % }}}
+
+%%% Identify the RPC type. We first try recognize haXe by the
+%%% "X-Haxe-Remoting" HTTP header, and if it's absent we
+%%% assume the request is JSON.
+recognize_rpc_type(Args) ->
+ OtherHeaders = ((Args#arg.headers)#headers.other),
+ case lists:any(fun(A) -> element(3, A) == "X-Haxe-Remoting" end, OtherHeaders) of
+ true -> haxe;
+ _ -> json
+ end.
+
+%%%
+%%% call handler/3 and provide session support
+eval_payload(Args, {M, F}, Payload, {session, CookieName}, ID, RpcType) -> % {{{
+ {SessionValue, Cookie} =
+ case yaws_api:find_cookie_val(CookieName, (Args#arg.headers)#headers.cookie) of
+ [] -> % have no session started, just call handler
+ {undefined, undefined};
+ Cookie2 -> % get old session data
+ case yaws_api:cookieval_to_opaque(Cookie2) of
+ {ok, OP} ->
+ {OP, Cookie2};
+ {error, _ErrMsg} -> % cannot get corresponding session
+ {undefined, undefined}
+ end
+ end,
+ case catch M:F(Args#arg.state, Payload, SessionValue) of
+ {'EXIT', Reason} ->
+ ?ERROR_LOG({M, F, {'EXIT', Reason}}),
+ send(Args, 500);
+ {error, Reason} ->
+ ?ERROR_LOG({M, F, Reason}),
+ send(Args, 500);
+ {false, ResponsePayload} ->
+ % do not have updates in session data
+ encode_send(Args, 200, ResponsePayload, [], ID, RpcType);
+ {true, _NewTimeout, NewSessionValue, ResponsePayload} -> % be compatible with xmlrpc module
+ CO = case NewSessionValue of
+ undefined when Cookie == undefined -> []; % nothing to do
+ undefined -> % rpc handler requested session delete
+ yaws_api:delete_cookie_session(Cookie), []; % XXX: may be return set-cookie with empty val?
+ _ -> % any other value will stored in session
+ case SessionValue of
+ undefined -> % got session data and should start new session now
+ Cookie1 = yaws_api:new_cookie_session(NewSessionValue),
+ yaws_api:setcookie(CookieName, Cookie1, "/"); % return set_cookie header
+ _ ->
+ yaws_api:replace_cookie_session(Cookie, NewSessionValue),
+ [] % nothing to add to yaws data
+ end
+ end,
+ encode_send(Args, 200, ResponsePayload, CO, ID, RpcType)
+ end; % }}}
+
+%%%
+%%% call handler/2 without session support
+%%%
+eval_payload(Args, {M, F}, Payload, simple, ID, RpcType) -> % {{{
+ case catch M:F(Args#arg.state, Payload) of
+ {'EXIT', Reason} ->
+ ?ERROR_LOG({M, F, {'EXIT', Reason}}),
+ send(Args, 500);
+ {error, Reason} ->
+ ?ERROR_LOG({M, F, Reason}),
+ send(Args, 500);
+ {false, ResponsePayload} ->
+ encode_send(Args, 200, ResponsePayload, [], ID, RpcType);
+ {true, _NewTimeout, _NewState, ResponsePayload} ->
+ encode_send(Args, 200, ResponsePayload, [], ID, RpcType)
+ end. % }}}
+
+
+%%% XXX compatibility with XMLRPC handlers
+%%% XXX - potential bug here?
+encode_send(Args, StatusCode, [Payload], AddOn, ID, RpcType) -> % {{{
+ encode_send(Args, StatusCode, Payload, AddOn, ID, RpcType); % }}}
+
+encode_send(Args, StatusCode, Payload, AddOn, ID, RpcType) -> % {{{
+% ?Debug("rpc response ~p ~n", [Payload]),
+ case encode_handler_payload(Payload, ID, RpcType) of
+ {ok, EncodedPayload} ->
+% ?Debug("rpc encoded response ~p ~n", [EncodedPayload]),
+ send(Args, StatusCode, EncodedPayload, AddOn);
+ {error, Reason} ->
+ ?ERROR_LOG({rpc_encode, payload, Payload, Reason}),
+ send(Args, 500)
+ end. % }}}
+
+send(Args, StatusCode) -> send(Args, StatusCode, "", []). % {{{
+
+send(Args, StatusCode, Payload, AddOnData) when not is_list(AddOnData) ->
+ send(Args, StatusCode, Payload, [AddOnData]);
+
+send(_Args, StatusCode, Payload, AddOnData) ->
+ A = [
+ {status, StatusCode},
+ {content, "text/xml", Payload},
+ {header, {content_length, lists:flatlength(Payload) }}
+ ] ++ AddOnData,
+ A
+ . % }}}
+
+encode_handler_payload({response, [ErlStruct]}, ID, RpcType) -> % {{{
+ encode_handler_payload({response, ErlStruct}, ID, RpcType);
+
+encode_handler_payload({response, ErlStruct}, ID, RpcType) ->
+ StructStr =
+ case RpcType of
+ json -> json:encode({struct, [ {result, ErlStruct}, {id, ID}]});
+ haxe -> [$h, $x, $r | haxe:encode(ErlStruct)]
+ end,
+ {ok, StructStr}. % }}}
+
+decode_handler_payload(json, JSonStr) -> %{{{
+ try
+ {ok, Obj} = json:decode_string(JSonStr),
+ Method = list_to_atom(jsonrpc:s(Obj, method)),
+ {array, Args} = jsonrpc:s(Obj, params),
+ ID = jsonrpc:s(Obj, id),
+ {ok, {call, Method, Args}, ID}
+ catch
+ error:Err -> {error, Err}
+ end; %}}}
+
+decode_handler_payload(haxe, [$_, $_, $x, $= | HaxeStr]) ->
+ try
+ {done, {ok, {array, [MethodName | _]}}, Cont} = haxe:decode(HaxeStr),
+ {done, {ok, Args}, _Cont2} = haxe:decode_next(Cont),
+
+ %% ID is undefined because haXe remoting doesn't automagically handle
+ %% sessions.
+ {ok, {call, list_to_atom(MethodName), Args}, undefined}
+ catch
+ error:Err -> {error, Err}
+ end;
+decode_handler_payload(haxe, _HaxeStr) ->
+ {error, missing_haxe_prefix}.
+
+
+% vim: tabstop=4 ft=erlang
View
1  www/TAB.inc
@@ -51,6 +51,7 @@ PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
<a href="/shopingcart/index.yaws">Tiny shopping cart</a>
<div class="%%embed%%"> <a href="/embed.yaws">Embedding Yaws</a></div>
<div class="%%json_intro%%"> <a href="/json_intro.yaws">AJAX/Json RPC</a></div>
+<div class="%%haxe_intro%%"> <a href="/haxe_intro.yaws">haXe remoting</a></div>
<h4> Misc </h4>
<div class="%%internals%%"> <a href="/internals.yaws">Internals</a> </div>
View
128 www/haxe_intro.yaws
@@ -0,0 +1,128 @@
+
+<erl>
+
+
+box(Str) ->
+ {'div',[{class,"box"}],
+ {pre,[], yaws_api:htmlize(Str)}}.
+
+tbox(T) ->
+ box(lists:flatten(io_lib:format("~p",[T]))).
+
+
+ssi(File) ->
+ {'div',[{class,"box"}],
+ {pre,[],
+ {ssi, File,[],[]}}}.
+
+ss(A, File) ->
+ {ok, B} = file:read_file(
+ filename:join([A#arg.docroot, File])),
+ box(binary_to_list(B)).
+
+
+
+out(A) ->
+ [{ssi, "TAB.inc", "%%",[{"haxe_intro", "choosen"}]},
+ {ehtml,
+ {'div', [{id, "entry"}],
+
+ [{h1, [], "haXe remoting"},
+
+ {p, [],
+ ["The yaws_rpc module has a haXe remoting adapter that enables "
+ "Yaws to respond to respond to "
+ "RPC requests from a client written in ",
+ {a, [{href, "http://www.haxe.org"}], "haXe"},
+ ". haXe is a versatile open source language that compiles to "
+ "Flash, Javascript and NekoVM. With haXe, You can use "
+ "write advanced clients for your Yaws backend without "
+ "suffering with Javascript and/or Actionscript. "
+ "For more information on haXe, visit ",
+ {a, [{href, "http://www.haxe.org/intro"}], "www.haxe.org/intro"}, "."]},
+ {p, [],
+ ["Implementing the server side of a haXe remoting interaction "
+ "in Yaws is very similar to the one described in the ",
+ {a, [{href, "json_intro.yaws"}], "Ajax/JSON RPC"}, " page. "
+ "Most of the action takes place behind the scenes inside the "
+ "the yaws_rpc module. The same types (array, struct, number "
+ "and string) work for haXe remoting as for JSON RPC. "
+ "There are just a few new things to keep in mind when using "
+ "haXe remoting: "
+ ]},
+ {ol, [],
+ [
+ {li, [], {p, [], "Class objects and enums work with standard "
+ "haXe remoting, but are not supported in Yaws. "
+ "You should therefore rely on anonymous objects and "
+ "signatures when designing your haXe remoting calls."}},
+ {li, [], {p, [], "A Yaws RPC handler can \"throw an exception\" "
+ "by returning {exception, Obj}, where Obj is any valid "
+ "haXe remoting value."}},
+ {li, [], {p, [], "haXe remoting has a few extra "
+ "values, expressed by the atoms 'infinity', 'neg_infinity' "
+ "and 'nan', corresponding to infinity, negative infinity "
+ "and 'not a number.'"}}
+ ]
+ },
+ {p, [], "Following is an example demonstrating the use of haXe "
+ "remoting in yaws. The first code segment is the haXe client "
+ "code, which invokes the 'echo' method in haxe_sample.yaws "
+ "and displays the result:"},
+ ss(A,"haxe_sample.html"),
+ {p, [], ["On the server side, we have the file haxe_sample.yaws "
+ "with the following code: "]},
+ ss(A, "haxe_sample.yaws"),
+
+ {p,[], "The two important lines on the server side are:"},
+ {ol,[],
+ [
+ {li,[],
+ {pre,[],"yaws_rpc:handler(A1, {haxe_sample, respond})."}},
+ {li,[],
+ {pre,[],"respond(State, {call, echo, Value} = _Request)"}}]},
+
+ {p,[],
+ "The first line tells Yaws to forward all RPC calls (this "
+ "includes both haXe remoting and JSON RPC calls -- remember that "
+ "the yaws_rpc module handles both RPC mechanisms transparently) "
+ "to the \"respond\" function in the \"haxe_sample\" module. "},
+ {p, [],
+ "The second line tells Yaws to invoke this 'respond' function "
+ "when the client requests the method 'echo', while passing "
+ "the new state variable as the first argument to 'respond'."
+ "You should duplicate this line for every RPC method you "
+ "wish to implement, replacing 'echo' with the method's name."},
+ {p, [],
+ "yaws_rpc optionally handles sessions for both JSON RPC and "
+ "haXe remoting. To use sessions, invoke yaws_rpc:handler_seesion "
+ "as shown in the JSON RPC documentation page."},
+
+ {p, [],
+ "If the response is in the form of {expression, Obj}, "
+ "where Obj is any valid haXe remoting type, then the haXe client "
+ "will invoke the 'onError' handler, with Obj passed as the "
+ "parameter."},
+ {p, [],
+ "As with JSON RPC, both request and response values can be "
+ "composed of nested tuples of the form"},
+ box("{array, [Obj,...]}"),
+ {p, [], "and/or "},
+ box("{struct, [{prop, Val}...]}"),
+ {p, [], "Now go have fun! :)"}
+ ]}},
+
+ {ssi, "END2",[],[]}
+ ].
+
+
+
+
+</erl>
+
+
+
+
+
+
+
View
17 www/haxe_sample.html
@@ -0,0 +1,17 @@
+class Application {
+
+ public static function main():Void {
+ var URL = "http://localhost:8000/haxe_sample.yaws";
+ var cnx = haxe.remoting.AsyncConnection.urlConnect(URL);
+ cnx.onError = function(err) {
+ trace("Exception : " + Std.string(err));
+ };
+ var a = {a:"foo", b:"bar", c:[1,2,3]};
+ var b = "hello, Erlang!";
+ cnx.echo.call([a, b], display);
+ }
+
+ static function display(v) {
+ trace(v);
+ }
+}
View
8 www/json_intro.yaws
@@ -29,6 +29,12 @@ out(A) ->
[{h1, [], "AJAX through JSON RPC"},
+ {p, [],
+ {i, [], "Note: this documentation used to refer to the module "
+ "'yaws_jsonrpc'. This module has been depracated in favor "
+ "of 'yaws_rpc', which handles both JSON RPC and haXe "
+ "remoting. All references to 'yaws_jsonrpc' on this page "
+ "were therefore changed to 'yaws_rpc'."}},
{p, [],
["The Yaws Json binding is a way to have Javascript code in the "
"browser evaluate a remote procedure call in the Yaws server."
@@ -78,7 +84,7 @@ out(A) ->
{ol,[],
[
{li,[],
- {pre,[],"yaws_jsonrpc:handler_session(A2, {sample_mod, counter})."}},
+ {pre,[],"yaws_rpc:handler_session(A2, {sample_mod, counter})."}},
{li,[],
{pre,[],"counter([{ip, IP}] = _State, {call, test1, Value} = _Request, Session)"}}]},
View
2  www/json_sample.yaws
@@ -11,7 +11,7 @@ out(A) ->
{ok,{IP,_}} = Peer,
A2=A#arg{state = [{ip, IP}]},
- yaws_jsonrpc:handler_session(A2, {sample_mod, counter}).
+ yaws_rpc:handler_session(A2, {sample_mod, counter}).
Please sign in to comment.
Something went wrong with that request. Please try again.