xmerl_uri.erl

OTP是开放电信平台的简称

%% Is Foo the way to go? This code needs further investigation. (As
%% does most of this module.) If we decide to keep it!
scan_parameters2([],Out, Foo) ->
    {lists:reverse(Foo), lists:reverse(Out)};
scan_parameters2(["transport"++Val|Rest],Out, Foo) ->
    scan_parameters2(Rest,[{transport,Val}|Out], Foo);
scan_parameters2(["user"++Val|Rest],Out, Foo) ->
    scan_parameters2(Rest,[{user,Val}|Out], Foo);
scan_parameters2(["method"++Val|Rest],Out, Foo) ->
    scan_parameters2(Rest,[{method,Val}|Out], Foo);
scan_parameters2(["ttl"++Val|Rest],Out, Foo) ->
    scan_parameters2(Rest,[{ttl,Val}|Out], Foo);
scan_parameters2(["maddr"++Val|Rest],Out, Foo) ->
    scan_parameters2(Rest,[{maddr,Val}|Out], Foo);
scan_parameters2(["lr"|Rest],Out, Foo) ->
    scan_parameters2(Rest,[{lr,""}|Out], Foo);
scan_parameters2([Other|Rest],Out, Foo) ->
    scan_parameters2(Rest,[Out], [Other |Foo]).

%%% FIXME!
scan_headers(C2) ->
    C2.

%%% ............................................................................
%%% SMS (Source draft-wilde-sms-uri-01, January 24 2002 and
%%%        draft-allocchio-gstn-01, November 2001)
%%% The syntax definition for "gstn-phone" is taken from
%%% [draft-allocchio-gstn-01], allowing global as well as local telephone
%%% numbers.
%%% Note: This BNF has been modified to better fit with RFC 2396
%%%   sms_URI               =  sms ":" 1*( sms-recipient ) [ sms-body ]
%%%   sms-recipient         =  gstn-phone sms-qualifier
%%%                            [ "," sms-recipient ]
%%%   sms-qualifier         =  *( smsc-qualifier / pid-qualifier )
%%%   smsc-qualifier        =  ";smsc=" SMSC-sub-addr
%%%   pid-qualifier         =  ";pid=" PID-sub-addr
%%%   sms-body              =  ";body=" *urlc
%%%   gstn-phone = ( global-phone / local-phone )
%%%   global-phone = "+" 1*( DIGIT / written-sep )
%%%   local-phone =  [ exit-code ] dial-number / exit-code [ dial-number ]
%%%   exit-code = phone-string
%%%   dial-number = phone-string
%%%   subaddr-string = phone-string
%%%   post-dial = phone-string
%%%   phone-string = 1*( DTMF / pause / tonewait / written-sep )
%%%   DTMF = ( DIGIT / "#" / "*" / "A" / "B" / "C" / "D" )
%%%   written-sep = ( "-" / "." )
%%%   pause = "p"
%%%   tonewait = "w"
parse_sms(Cont,Scheme) ->
    {Scheme,Cont}.
    

%%% ==========================================================================
%%% Generic URI parsing. BNF rules from RFC 2396

%%%      hostport      = host [ ":" port ]
scan_hostport(C0,Scheme) ->
    case scan_host(C0) of
	{error,Error} ->
	    {error,Error};
	{":"++C1,Host} ->
	    {C2,Port}=scan_port(C1,[]),
	    {C2,Host,list_to_integer(Port)};
	{C1,Host} when Scheme==http ->
	    {C1,Host,?HTTP_DEFAULT_PORT};
	{C1,Host} when Scheme==https ->
	    {C1,Host,?HTTPS_DEFAULT_PORT};
	{C1,Host} when Scheme==ftp ->
	    {C1,Host,?FTP_DEFAULT_PORT};
	{C1,Host} when Scheme==sip ->
	    {C1,Host,?SIP_DEFAULT_PORT}
    end.


%%%      host          = hostname | IPv4address | IPv6reference
%%%      hostname      = *( domainlabel "." ) toplabel [ "." ]
%%%      domainlabel   = alphanum | alphanum *( alphanum | "-" ) alphanum
%%%      toplabel      = alpha | alpha *( alphanum | "-" ) alphanum
%%%      IPv4address   = 1*3DIGIT "." 1*3DIGIT "." 1*3DIGIT "." 1*3DIGIT
%%%      ipv6reference = "[" IPv6address "]"
%%%      IPv6address = hexpart [ ":" IPv4address ]
%%%      hexpart = hexseq | hexseq "::" [ hexseq ] | "::" [ hexseq ]
%%%      hexseq  = hex4 *( ":" hex4)
%%%      hex4    = 1*4HEXDIG

%%% Note:
%%% Bitfields are set as follows:
%%%  Bit 0 = 0-9
%%%  Bit 1 = a-f
%%%  Bit 2 = g-z
-define(BIT1, 1).
-define(BIT2, 2).
-define(BIT3, 4).

%%% 1 = DIGIT are only digits
%%% 3 = HEX   are DIGITS + a-f 
%%% 6 = ALPHA are HEX    - DIGITS + g-z
-define(DIGIT, 1).
-define(HEX,   3).
-define(ALPHA, 6).


scan_host(C0) ->
    case scan_host2(C0,[],0,[],[]) of
	{C1,IPv4address,[?DIGIT,?DIGIT,?DIGIT,?DIGIT]} ->
	    {C1,lists:reverse(lists:append(IPv4address))};
%% 	{C1,IPv6address,[$[,Hex1,Hex2,Hex3,Hex4,$]]} when Hex1=<?HEX;
%% 							  Hex2=<?HEX;
%% 							  Hex3=<?HEX;
%% 							  Hex4=<?HEX ->
%% 	    {C1,lists:reverse(lists:append(IPv6address))};
	{C1,Hostname,[Alpha|_HostF]} when Alpha==?ALPHA ->
	    {C1,lists:reverse(lists:append(Hostname))};
	_ ->
	    {error,no_host}
    end.
    
scan_host2([H|C0],Acc,CurF,Host,HostF) when $0=<H,H=<$9 ->
    scan_host2(C0,[H|Acc],CurF bor ?BIT1,Host,HostF);
scan_host2([H|C0],Acc,CurF,Host,HostF) when $a=<H,H=<$f; $A=<H,H=<$F ->
    scan_host2(C0,[H|Acc],CurF bor ?BIT2,Host,HostF);
scan_host2([H|C0],Acc,CurF,Host,HostF) when $a=<H,H=<$z; $A=<H,H=<$Z ->
    scan_host2(C0,[H|Acc],CurF bor ?ALPHA,Host,HostF);
scan_host2([$-|C0],Acc,CurF,Host,HostF) when CurF=/=0 ->
    scan_host2(C0,[$-|Acc],CurF,Host,HostF);
scan_host2([$.|C0],Acc,CurF,Host,HostF) when CurF=/=0 ->
    scan_host2(C0,[],0,[".",Acc|Host],[CurF|HostF]);
scan_host2(C0,Acc,CurF,Host,HostF) ->
    {C0,[Acc|Host],[CurF|HostF]}.


%%%      port          = *digit
scan_port([H|C0],Acc) when $0=<H,H=<$9 ->
    scan_port(C0,[H|Acc]);
scan_port(C0,Acc) ->
    {C0,lists:reverse(Acc)}.

%%%      abs_path      = "/"  path_segments
scan_abspath([]) ->
    {[],[]};
scan_abspath("/"++C0) ->
    scan_pathsegments(C0,["/"]);
scan_abspath(_) ->
    {error,no_abspath}.

%%%      path_segments = segment *( "/" segment )
scan_pathsegments(C0,Acc) ->
    case scan_segment(C0,[]) of
	{"/"++C1,Segment} ->
	    scan_pathsegments(C1,["/",Segment|Acc]);
	{C1,Segment} ->
	    {C1,lists:reverse(lists:append([Segment|Acc]))}
    end.


%%%      segment       = *pchar *( ";" param )
%%%      param         = *pchar
scan_segment(";"++C0,Acc) ->
    {C1,ParamAcc}=scan_pchars(C0,";"++Acc),
    scan_segment(C1,ParamAcc);
scan_segment(C0,Acc) ->
    case scan_pchars(C0,Acc) of
	{";"++C1,Segment} ->
	    {C2,ParamAcc}=scan_pchars(C1,";"++Segment),
	    scan_segment(C2,ParamAcc);
	{C1,Segment} ->
	    {C1,Segment}
    end.

%%%      query         = *uric
%%%      uric          = reserved | unreserved | escaped
%%%      reserved      = ";" | "/" | "?" | ":" | "@" | "&" | "=" | "+" |
%%%                      "$" | "," | "[" | "]"
%%%      unreserved    = alphanum | mark
%%%      mark          = "-" | "_" | "." | "!" | "~" | "*" | "'" |
%%%                      "(" | ")"
%%%      escaped       = "%" hex hex
scan_query([],Acc) ->
    lists:reverse(Acc);
scan_query([$%,H1,H2|C0],Acc) -> % escaped
    scan_query([hex2dec(H1)*16+hex2dec(H2)|C0],Acc);
scan_query([H|C0],Acc) when $a=<H,H=<$z;$A=<H,H=<$Z;$0=<H,H=<$9 -> % alphanum
    scan_query(C0,[H|Acc]);
scan_query([H|C0],Acc) when H==$;; H==$/; H==$?; H==$:; H==$@; H==$[; H==$];
			    H==$&; H==$=; H==$+; H==$$; H==$, -> % reserved
    scan_query(C0,[H|Acc]);
scan_query([H|C0],Acc) when H==$-; H==$_; H==$.; H==$!; H==$~;
			    H==$*; H==$'; H==$(; H==$) -> % mark
    scan_query(C0,[H|Acc]);
scan_query([H|C0],Acc) when 0=<H,H=<127 -> % US ASCII
    {H1,H2}=dec2hex(H),
    scan_query(C0,[H2,H1,$%|Acc]);    
scan_query([_H|_C0],_Acc) ->
    {error,no_query}.


%%%      pchar         = unreserved | escaped |
%%%                      ":" | "@" | "&" | "=" | "+" | "$" | ","
scan_pchars([],Acc) ->
    {[],Acc};
scan_pchars([$%,H1,H2|C0],Acc) -> % escaped
    scan_pchars([hex2dec(H1)*16+hex2dec(H2)|C0],Acc);
scan_pchars([H|C0],Acc) when $a=<H,H=<$z;$A=<H,H=<$Z;$0=<H,H=<$9  -> % alphanum
    scan_pchars(C0,[H|Acc]);
scan_pchars([H|C0],Acc) when H==$-; H==$_; H==$.; H==$!; H==$~;
			     H==$*; H==$'; H==$(; H==$) -> % mark
    scan_pchars(C0,[H|Acc]);
scan_pchars([H|C0],Acc) when H==$:; H==$@; H==$&; H==$=; H==$+; H==$$; H==$, ->
    scan_pchars(C0,[H|Acc]);
scan_pchars([H|C0],Acc) when 0=<H,H=<127, % US ASCII
			     H=/=$?,H=/=$;,H=/=$/,H=/=$# -> 
    {H1,H2}=dec2hex(H),
    scan_pchars(C0,[H2,H1,$%|Acc]);    
scan_pchars(C0,Acc) ->
    {C0,Acc}.

hex2dec(X) when X>=$0,X=<$9 -> X-$0;
hex2dec(X) when X>=$A,X=<$F -> X-$A+10;
hex2dec(X) when X>=$a,X=<$f -> X-$a+10.

dec2hex(H) when H<256 ->
    <<H1:4,H2:4>> = <<H>>,
    {nibble2hex(H1),nibble2hex(H2)}.

nibble2hex(X) when 0=<X,X=<9 -> X+$0;
nibble2hex(10) -> $a;
nibble2hex(11) -> $b;
nibble2hex(12) -> $c;
nibble2hex(13) -> $d;
nibble2hex(14) -> $e;
nibble2hex(15) -> $f.