1%% @author Bob Ippolito <bob@mochimedia.com>
2%% @copyright 2007 Mochi Media, Inc.
3
4%% @doc Utilities for parsing and quoting.
5
6-module(mochiweb_util).
7-author('bob@mochimedia.com').
8-export([join/2, quote_plus/1, urlencode/1, parse_qs/1, unquote/1, unquote_path/1]).
9-export([path_split/1]).
10-export([urlsplit/1, urlsplit_path/1, urlunsplit/1, urlunsplit_path/1]).
11-export([guess_mime/1, parse_header/1]).
12-export([shell_quote/1, cmd/1, cmd_string/1, cmd_port/2, cmd_status/1, cmd_status/2]).
13-export([record_to_proplist/2, record_to_proplist/3]).
14-export([safe_relative_path/1, partition/2]).
15-export([parse_qvalues/1, pick_accepted_encodings/3]).
16-export([make_io/1]).
17-export([normalize_path/1]).
18-export([rand_uniform/2]).
19
20-define(PERCENT, 37).  % $\%
21-define(FULLSTOP, 46). % $\.
22-define(IS_HEX(C), ((C >= $0 andalso C =< $9) orelse
23                    (C >= $a andalso C =< $f) orelse
24                    (C >= $A andalso C =< $F))).
25-define(QS_SAFE(C), ((C >= $a andalso C =< $z) orelse
26                     (C >= $A andalso C =< $Z) orelse
27                     (C >= $0 andalso C =< $9) orelse
28                     (C =:= ?FULLSTOP orelse C =:= $- orelse C =:= $~ orelse
29                      C =:= $_))).
30
31hexdigit(C) when C < 10 -> $0 + C;
32hexdigit(C) when C < 16 -> $A + (C - 10).
33
34unhexdigit(C) when C >= $0, C =< $9 -> C - $0;
35unhexdigit(C) when C >= $a, C =< $f -> C - $a + 10;
36unhexdigit(C) when C >= $A, C =< $F -> C - $A + 10.
37unhexdigit(Hi, Lo) ->
38    unhexdigit(Lo) bor (unhexdigit(Hi) bsl 4).
39
40%% @spec partition(String, Sep) -> {String, [], []} | {Prefix, Sep, Postfix}
41%% @doc Inspired by Python 2.5's str.partition:
42%%      partition("foo/bar", "/") = {"foo", "/", "bar"},
43%%      partition("foo", "/") = {"foo", "", ""}.
44partition(String, Sep) ->
45    case partition(String, Sep, []) of
46        undefined ->
47            {String, "", ""};
48        Result ->
49            Result
50    end.
51
52partition("", _Sep, _Acc) ->
53    undefined;
54partition(S, Sep, Acc) ->
55    case partition2(S, Sep) of
56        undefined ->
57            [C | Rest] = S,
58            partition(Rest, Sep, [C | Acc]);
59        Rest ->
60            {lists:reverse(Acc), Sep, Rest}
61    end.
62
63partition2(Rest, "") ->
64    Rest;
65partition2([C | R1], [C | R2]) ->
66    partition2(R1, R2);
67partition2(_S, _Sep) ->
68    undefined.
69
70
71
72%% @spec safe_relative_path(string()) -> string() | undefined
73%% @doc Return the reduced version of a relative path or undefined if it
74%%      is not safe. safe relative paths can be joined with an absolute path
75%%      and will result in a subdirectory of the absolute path. Safe paths
76%%      never contain a backslash character.
77safe_relative_path("/" ++ _) ->
78    undefined;
79safe_relative_path(P) ->
80    case string:chr(P, $\\) of
81        0 ->
82           safe_relative_path(P, []);
83        _ ->
84           undefined
85    end.
86
87safe_relative_path("", Acc) ->
88    case Acc of
89        [] ->
90            "";
91        _ ->
92            string:join(lists:reverse(Acc), "/")
93    end;
94safe_relative_path(P, Acc) ->
95    case partition(P, "/") of
96        {"", "/", _} ->
97            %% /foo or foo//bar
98            undefined;
99        {"..", _, _} when Acc =:= [] ->
100            undefined;
101        {"..", _, Rest} ->
102            safe_relative_path(Rest, tl(Acc));
103        {Part, "/", ""} ->
104            safe_relative_path("", ["", Part | Acc]);
105        {Part, _, Rest} ->
106            safe_relative_path(Rest, [Part | Acc])
107    end.
108
109%% @spec shell_quote(string()) -> string()
110%% @doc Quote a string according to UNIX shell quoting rules, returns a string
111%%      surrounded by double quotes.
112shell_quote(L) ->
113    shell_quote(L, [$\"]).
114
115%% @spec cmd_port([string()], Options) -> port()
116%% @doc open_port({spawn, mochiweb_util:cmd_string(Argv)}, Options).
117cmd_port(Argv, Options) ->
118    open_port({spawn, cmd_string(Argv)}, Options).
119
120%% @spec cmd([string()]) -> string()
121%% @doc os:cmd(cmd_string(Argv)).
122cmd(Argv) ->
123    os:cmd(cmd_string(Argv)).
124
125%% @spec cmd_string([string()]) -> string()
126%% @doc Create a shell quoted command string from a list of arguments.
127cmd_string(Argv) ->
128    string:join([shell_quote(X) || X <- Argv], " ").
129
130%% @spec cmd_status([string()]) -> {ExitStatus::integer(), Stdout::binary()}
131%% @doc Accumulate the output and exit status from the given application,
132%%      will be spawned with cmd_port/2.
133cmd_status(Argv) ->
134    cmd_status(Argv, []).
135
136%% @spec cmd_status([string()], [atom()]) -> {ExitStatus::integer(), Stdout::binary()}
137%% @doc Accumulate the output and exit status from the given application,
138%%      will be spawned with cmd_port/2.
139cmd_status(Argv, Options) ->
140    Port = cmd_port(Argv, [exit_status, stderr_to_stdout,
141                           use_stdio, binary | Options]),
142    try cmd_loop(Port, [])
143    after catch port_close(Port)
144    end.
145
146%% @spec cmd_loop(port(), list()) -> {ExitStatus::integer(), Stdout::binary()}
147%% @doc Accumulate the output and exit status from a port.
148cmd_loop(Port, Acc) ->
149    receive
150        {Port, {exit_status, Status}} ->
151            {Status, iolist_to_binary(lists:reverse(Acc))};
152        {Port, {data, Data}} ->
153            cmd_loop(Port, [Data | Acc])
154    end.
155
156%% @spec join([iolist()], iolist()) -> iolist()
157%% @doc Join a list of strings or binaries together with the given separator
158%%      string or char or binary. The output is flattened, but may be an
159%%      iolist() instead of a string() if any of the inputs are binary().
160join([], _Separator) ->
161    [];
162join([S], _Separator) ->
163    lists:flatten(S);
164join(Strings, Separator) ->
165    lists:flatten(revjoin(lists:reverse(Strings), Separator, [])).
166
167revjoin([], _Separator, Acc) ->
168    Acc;
169revjoin([S | Rest], Separator, []) ->
170    revjoin(Rest, Separator, [S]);
171revjoin([S | Rest], Separator, Acc) ->
172    revjoin(Rest, Separator, [S, Separator | Acc]).
173
174%% @spec quote_plus(atom() | integer() | float() | string() | binary()) -> string()
175%% @doc URL safe encoding of the given term.
176quote_plus(Atom) when is_atom(Atom) ->
177    quote_plus(atom_to_list(Atom));
178quote_plus(Int) when is_integer(Int) ->
179    quote_plus(integer_to_list(Int));
180quote_plus(Binary) when is_binary(Binary) ->
181    quote_plus(binary_to_list(Binary));
182quote_plus(Float) when is_float(Float) ->
183    quote_plus(mochinum:digits(Float));
184quote_plus(String) ->
185    quote_plus(String, []).
186
187quote_plus([], Acc) ->
188    lists:reverse(Acc);
189quote_plus([C | Rest], Acc) when ?QS_SAFE(C) ->
190    quote_plus(Rest, [C | Acc]);
191quote_plus([$\s | Rest], Acc) ->
192    quote_plus(Rest, [$+ | Acc]);
193quote_plus([C | Rest], Acc) ->
194    <<Hi:4, Lo:4>> = <<C>>,
195    quote_plus(Rest, [hexdigit(Lo), hexdigit(Hi), ?PERCENT | Acc]).
196
197%% @spec urlencode([{Key, Value}]) -> string()
198%% @doc URL encode the property list.
199urlencode(Props) ->
200    Pairs = lists:foldr(
201              fun ({K, V}, Acc) ->
202                      [quote_plus(K) ++ "=" ++ quote_plus(V) | Acc]
203              end, [], Props),
204    string:join(Pairs, "&").
205
206%% @spec parse_qs(string() | binary()) -> [{Key, Value}]
207%% @doc Parse a query string or application/x-www-form-urlencoded.
208parse_qs(Binary) when is_binary(Binary) ->
209    parse_qs(binary_to_list(Binary));
210parse_qs(String) ->
211    parse_qs(String, []).
212
213parse_qs([], Acc) ->
214    lists:reverse(Acc);
215parse_qs(String, Acc) ->
216    {Key, Rest} = parse_qs_key(String),
217    {Value, Rest1} = parse_qs_value(Rest),
218    parse_qs(Rest1, [{Key, Value} | Acc]).
219
220parse_qs_key(String) ->
221    parse_qs_key(String, []).
222
223parse_qs_key([], Acc) ->
224    {qs_revdecode(Acc), ""};
225parse_qs_key([$= | Rest], Acc) ->
226    {qs_revdecode(Acc), Rest};
227parse_qs_key(Rest=[$; | _], Acc) ->
228    {qs_revdecode(Acc), Rest};
229parse_qs_key(Rest=[$& | _], Acc) ->
230    {qs_revdecode(Acc), Rest};
231parse_qs_key([C | Rest], Acc) ->
232    parse_qs_key(Rest, [C | Acc]).
233
234parse_qs_value(String) ->
235    parse_qs_value(String, []).
236
237parse_qs_value([], Acc) ->
238    {qs_revdecode(Acc), ""};
239parse_qs_value([$; | Rest], Acc) ->
240    {qs_revdecode(Acc), Rest};
241parse_qs_value([$& | Rest], Acc) ->
242    {qs_revdecode(Acc), Rest};
243parse_qs_value([C | Rest], Acc) ->
244    parse_qs_value(Rest, [C | Acc]).
245
246%% @spec unquote(string() | binary()) -> string()
247%% @doc Unquote a URL encoded string.
248unquote(Binary) when is_binary(Binary) ->
249    unquote(binary_to_list(Binary));
250unquote(String) ->
251    qs_revdecode(lists:reverse(String)).
252
253qs_revdecode(S) ->
254    qs_revdecode(S, []).
255
256qs_revdecode([], Acc) ->
257    Acc;
258qs_revdecode([$+ | Rest], Acc) ->
259    qs_revdecode(Rest, [$\s | Acc]);
260qs_revdecode([Lo, Hi, ?PERCENT | Rest], Acc) when ?IS_HEX(Lo), ?IS_HEX(Hi) ->
261    qs_revdecode(Rest, [(unhexdigit(Hi, Lo)) | Acc]);
262qs_revdecode([C | Rest], Acc) ->
263    qs_revdecode(Rest, [C | Acc]).
264
265%% @spec unquote_path(string() | binary()) -> string()
266%% @doc Unquote a URL encoded string, does not encode + into space.
267unquote_path(Binary) when is_binary(Binary) ->
268    unquote_path(binary_to_list(Binary));
269unquote_path(String) ->
270    qs_revdecode_path(lists:reverse(String)).
271
272qs_revdecode_path(S) ->
273    qs_revdecode_path(S, []).
274
275qs_revdecode_path([], Acc) ->
276    Acc;
277qs_revdecode_path([Lo, Hi, ?PERCENT | Rest], Acc) when ?IS_HEX(Lo), ?IS_HEX(Hi) ->
278    qs_revdecode_path(Rest, [(unhexdigit(Hi, Lo)) | Acc]);
279qs_revdecode_path([C | Rest], Acc) ->
280    qs_revdecode_path(Rest, [C | Acc]).
281
282%% @spec urlsplit(Url) -> {Scheme, Netloc, Path, Query, Fragment}
283%% @doc Return a 5-tuple, does not expand % escapes. Only supports HTTP style
284%%      URLs.
285urlsplit(Url) ->
286    {Scheme, Url1} = urlsplit_scheme(Url),
287    {Netloc, Url2} = urlsplit_netloc(Url1),
288    {Path, Query, Fragment} = urlsplit_path(Url2),
289    {Scheme, Netloc, Path, Query, Fragment}.
290
291urlsplit_scheme(Url) ->
292    case urlsplit_scheme(Url, []) of
293        no_scheme ->
294            {"", Url};
295        Res ->
296            Res
297    end.
298
299urlsplit_scheme([C | Rest], Acc) when ((C >= $a andalso C =< $z) orelse
300                                       (C >= $A andalso C =< $Z) orelse
301                                       (C >= $0 andalso C =< $9) orelse
302                                       C =:= $+ orelse C =:= $- orelse
303                                       C =:= $.) ->
304    urlsplit_scheme(Rest, [C | Acc]);
305urlsplit_scheme([$: | Rest], Acc=[_ | _]) ->
306    {string:to_lower(lists:reverse(Acc)), Rest};
307urlsplit_scheme(_Rest, _Acc) ->
308    no_scheme.
309
310urlsplit_netloc("//" ++ Rest) ->
311    urlsplit_netloc(Rest, []);
312urlsplit_netloc(Path) ->
313    {"", Path}.
314
315urlsplit_netloc("", Acc) ->
316    {lists:reverse(Acc), ""};
317urlsplit_netloc(Rest=[C | _], Acc) when C =:= $/; C =:= $?; C =:= $# ->
318    {lists:reverse(Acc), Rest};
319urlsplit_netloc([C | Rest], Acc) ->
320    urlsplit_netloc(Rest, [C | Acc]).
321
322
323%% @spec path_split(string()) -> {Part, Rest}
324%% @doc Split a path starting from the left, as in URL traversal.
325%%      path_split("foo/bar") = {"foo", "bar"},
326%%      path_split("/foo/bar") = {"", "foo/bar"}.
327path_split(S) ->
328    path_split(S, []).
329
330path_split("", Acc) ->
331    {lists:reverse(Acc), ""};
332path_split("/" ++ Rest, Acc) ->
333    {lists:reverse(Acc), Rest};
334path_split([C | Rest], Acc) ->
335    path_split(Rest, [C | Acc]).
336
337
338%% @spec urlunsplit({Scheme, Netloc, Path, Query, Fragment}) -> string()
339%% @doc Assemble a URL from the 5-tuple. Path must be absolute.
340urlunsplit({Scheme, Netloc, Path, Query, Fragment}) ->
341    lists:flatten([case Scheme of "" -> "";  _ -> [Scheme, "://"] end,
342                   Netloc,
343                   urlunsplit_path({Path, Query, Fragment})]).
344
345%% @spec urlunsplit_path({Path, Query, Fragment}) -> string()
346%% @doc Assemble a URL path from the 3-tuple.
347urlunsplit_path({Path, Query, Fragment}) ->
348    lists:flatten([Path,
349                   case Query of "" -> ""; _ -> [$? | Query] end,
350                   case Fragment of "" -> ""; _ -> [$# | Fragment] end]).
351
352%% @spec urlsplit_path(Url) -> {Path, Query, Fragment}
353%% @doc Return a 3-tuple, does not expand % escapes. Only supports HTTP style
354%%      paths.
355urlsplit_path(Path) ->
356    urlsplit_path(Path, []).
357
358urlsplit_path("", Acc) ->
359    {lists:reverse(Acc), "", ""};
360urlsplit_path("?" ++ Rest, Acc) ->
361    {Query, Fragment} = urlsplit_query(Rest),
362    {lists:reverse(Acc), Query, Fragment};
363urlsplit_path("#" ++ Rest, Acc) ->
364    {lists:reverse(Acc), "", Rest};
365urlsplit_path([C | Rest], Acc) ->
366    urlsplit_path(Rest, [C | Acc]).
367
368urlsplit_query(Query) ->
369    urlsplit_query(Query, []).
370
371urlsplit_query("", Acc) ->
372    {lists:reverse(Acc), ""};
373urlsplit_query("#" ++ Rest, Acc) ->
374    {lists:reverse(Acc), Rest};
375urlsplit_query([C | Rest], Acc) ->
376    urlsplit_query(Rest, [C | Acc]).
377
378extension(Name) ->
379    case filename:extension(Name) of
380        "" -> Name;
381        Ext -> Ext
382    end.
383
384%% @spec guess_mime(string()) -> string()
385%% @doc  Guess the mime type of a file by the extension of its filename.
386guess_mime(File) ->
387    case filename:basename(File) of
388        "crossdomain.xml" ->
389            "text/x-cross-domain-policy";
390        Name ->
391            case mochiweb_mime:from_extension(extension(Name)) of
392                undefined ->
393                    "text/plain";
394                Mime ->
395                    Mime
396            end
397    end.
398
399%% @spec parse_header(string()) -> {Type, [{K, V}]}
400%% @doc  Parse a Content-Type like header, return the main Content-Type
401%%       and a property list of options.
402parse_header(String) ->
403    %% TODO: This is exactly as broken as Python's cgi module.
404    %%       Should parse properly like mochiweb_cookies.
405    [Type | Parts] = [string:strip(S) || S <- string:tokens(String, ";")],
406    F = fun (S, Acc) ->
407                case lists:splitwith(fun (C) -> C =/= $= end, S) of
408                    {"", _} ->
409                        %% Skip anything with no name
410                        Acc;
411                    {_, ""} ->
412                        %% Skip anything with no value
413                        Acc;
414                    {Name, [$\= | Value]} ->
415                        [{string:to_lower(string:strip(Name)),
416                          unquote_header(string:strip(Value))} | Acc]
417                end
418        end,
419    {string:to_lower(Type),
420     lists:foldr(F, [], Parts)}.
421
422unquote_header("\"" ++ Rest) ->
423    unquote_header(Rest, []);
424unquote_header(S) ->
425    S.
426
427unquote_header("", Acc) ->
428    lists:reverse(Acc);
429unquote_header("\"", Acc) ->
430    lists:reverse(Acc);
431unquote_header([$\\, C | Rest], Acc) ->
432    unquote_header(Rest, [C | Acc]);
433unquote_header([C | Rest], Acc) ->
434    unquote_header(Rest, [C | Acc]).
435
436%% @spec record_to_proplist(Record, Fields) -> proplist()
437%% @doc calls record_to_proplist/3 with a default TypeKey of '__record'
438record_to_proplist(Record, Fields) ->
439    record_to_proplist(Record, Fields, '__record').
440
441%% @spec record_to_proplist(Record, Fields, TypeKey) -> proplist()
442%% @doc Return a proplist of the given Record with each field in the
443%%      Fields list set as a key with the corresponding value in the Record.
444%%      TypeKey is the key that is used to store the record type
445%%      Fields should be obtained by calling record_info(fields, record_type)
446%%      where record_type is the record type of Record
447record_to_proplist(Record, Fields, TypeKey)
448  when tuple_size(Record) - 1 =:= length(Fields) ->
449    lists:zip([TypeKey | Fields], tuple_to_list(Record)).
450
451
452shell_quote([], Acc) ->
453    lists:reverse([$\" | Acc]);
454shell_quote([C | Rest], Acc) when C =:= $\" orelse C =:= $\` orelse
455                                  C =:= $\\ orelse C =:= $\$ ->
456    shell_quote(Rest, [C, $\\ | Acc]);
457shell_quote([C | Rest], Acc) ->
458    shell_quote(Rest, [C | Acc]).
459
460%% @spec parse_qvalues(string()) -> [qvalue()] | invalid_qvalue_string
461%% @type qvalue() = {media_type() | encoding() , float()}.
462%% @type media_type() = string().
463%% @type encoding() = string().
464%%
465%% @doc Parses a list (given as a string) of elements with Q values associated
466%%      to them. Elements are separated by commas and each element is separated
467%%      from its Q value by a semicolon. Q values are optional but when missing
468%%      the value of an element is considered as 1.0. A Q value is always in the
469%%      range [0.0, 1.0]. A Q value list is used for example as the value of the
470%%      HTTP "Accept" and "Accept-Encoding" headers.
471%%
472%%      Q values are described in section 2.9 of the RFC 2616 (HTTP 1.1).
473%%
474%%      Example:
475%%
476%%      parse_qvalues("gzip; q=0.5, deflate, identity;q=0.0") ->
477%%          [{"gzip", 0.5}, {"deflate", 1.0}, {"identity", 0.0}]
478%%
479parse_qvalues(QValuesStr) ->
480    try
481        lists:map(
482            fun(Pair) ->
483                [Type | Params] = string:tokens(Pair, ";"),
484                NormParams = normalize_media_params(Params),
485                {Q, NonQParams} = extract_q(NormParams),
486                {string:join([string:strip(Type) | NonQParams], ";"), Q}
487            end,
488            string:tokens(string:to_lower(QValuesStr), ",")
489        )
490    catch
491        _Type:_Error ->
492            invalid_qvalue_string
493    end.
494
495normalize_media_params(Params) ->
496    {ok, Re} = re:compile("\\s"),
497    normalize_media_params(Re, Params, []).
498
499normalize_media_params(_Re, [], Acc) ->
500    lists:reverse(Acc);
501normalize_media_params(Re, [Param | Rest], Acc) ->
502    NormParam = re:replace(Param, Re, "", [global, {return, list}]),
503    normalize_media_params(Re, Rest, [NormParam | Acc]).
504
505extract_q(NormParams) ->
506    {ok, KVRe} = re:compile("^([^=]+)=([^=]+)$"),
507    {ok, QRe} = re:compile("^((?:0|1)(?:\\.\\d{1,3})?)$"),
508    extract_q(KVRe, QRe, NormParams, []).
509
510extract_q(_KVRe, _QRe, [], Acc) ->
511    {1.0, lists:reverse(Acc)};
512extract_q(KVRe, QRe, [Param | Rest], Acc) ->
513    case re:run(Param, KVRe, [{capture, [1, 2], list}]) of
514        {match, [Name, Value]} ->
515            case Name of
516            "q" ->
517                {match, [Q]} = re:run(Value, QRe, [{capture, [1], list}]),
518                QVal = case Q of
519                    "0" ->
520                        0.0;
521                    "1" ->
522                        1.0;
523                    Else ->
524                        list_to_float(Else)
525                end,
526                case QVal < 0.0 orelse QVal > 1.0 of
527                false ->
528                    {QVal, lists:reverse(Acc) ++ Rest}
529                end;
530            _ ->
531                extract_q(KVRe, QRe, Rest, [Param | Acc])
532            end
533    end.
534
535%% @spec pick_accepted_encodings([qvalue()], [encoding()], encoding()) ->
536%%    [encoding()]
537%%
538%% @doc Determines which encodings specified in the given Q values list are
539%%      valid according to a list of supported encodings and a default encoding.
540%%
541%%      The returned list of encodings is sorted, descendingly, according to the
542%%      Q values of the given list. The last element of this list is the given
543%%      default encoding unless this encoding is explicitily or implicitily
544%%      marked with a Q value of 0.0 in the given Q values list.
545%%      Note: encodings with the same Q value are kept in the same order as
546%%            found in the input Q values list.
547%%
548%%      This encoding picking process is described in section 14.3 of the
549%%      RFC 2616 (HTTP 1.1).
550%%
551%%      Example:
552%%
553%%      pick_accepted_encodings(
554%%          [{"gzip", 0.5}, {"deflate", 1.0}],
555%%          ["gzip", "identity"],
556%%          "identity"
557%%      ) ->
558%%          ["gzip", "identity"]
559%%
560pick_accepted_encodings(AcceptedEncs, SupportedEncs, DefaultEnc) ->
561    SortedQList = lists:reverse(
562        lists:sort(fun({_, Q1}, {_, Q2}) -> Q1 < Q2 end, AcceptedEncs)
563    ),
564    {Accepted, Refused} = lists:foldr(
565        fun({E, Q}, {A, R}) ->
566            case Q > 0.0 of
567                true ->
568                    {[E | A], R};
569                false ->
570                    {A, [E | R]}
571            end
572        end,
573        {[], []},
574        SortedQList
575    ),
576    Refused1 = lists:foldr(
577        fun(Enc, Acc) ->
578            case Enc of
579                "*" ->
580                    lists:subtract(SupportedEncs, Accepted) ++ Acc;
581                _ ->
582                    [Enc | Acc]
583            end
584        end,
585        [],
586        Refused
587    ),
588    Accepted1 = lists:foldr(
589        fun(Enc, Acc) ->
590            case Enc of
591                "*" ->
592                    lists:subtract(SupportedEncs, Accepted ++ Refused1) ++ Acc;
593                _ ->
594                    [Enc | Acc]
595            end
596        end,
597        [],
598        Accepted
599    ),
600    Accepted2 = case lists:member(DefaultEnc, Accepted1) of
601        true ->
602            Accepted1;
603        false ->
604            Accepted1 ++ [DefaultEnc]
605    end,
606    [E || E <- Accepted2, lists:member(E, SupportedEncs),
607        not lists:member(E, Refused1)].
608
609make_io(Atom) when is_atom(Atom) ->
610    atom_to_list(Atom);
611make_io(Integer) when is_integer(Integer) ->
612    integer_to_list(Integer);
613make_io(Io) when is_list(Io); is_binary(Io) ->
614    Io.
615
616%% @spec normalize_path(string()) -> string()
617%% @doc Remove duplicate slashes from an uri path ("//foo///bar////" becomes
618%%      "/foo/bar/").
619%%      Per RFC 3986, all but the last path segment must be non-empty.
620normalize_path(Path) ->
621	normalize_path(Path, []).
622
623normalize_path([], Acc) ->
624        lists:reverse(Acc);
625normalize_path("/" ++ Path, "/" ++ _ = Acc) ->
626        normalize_path(Path, Acc);
627normalize_path([C|Path], Acc) ->
628        normalize_path(Path, [C|Acc]).
629
630-ifdef(rand_mod_unavailable).
631rand_uniform(Start, End) ->
632    crypto:rand_uniform(Start, End).
633-else.
634rand_uniform(Start, End) ->
635    Start + rand:uniform(End - Start) - 1.
636-endif.
637
638%%
639%% Tests
640%%
641-ifdef(TEST).
642-include_lib("eunit/include/eunit.hrl").
643
644make_io_test() ->
645    ?assertEqual(
646       <<"atom">>,
647       iolist_to_binary(make_io(atom))),
648    ?assertEqual(
649       <<"20">>,
650       iolist_to_binary(make_io(20))),
651    ?assertEqual(
652       <<"list">>,
653       iolist_to_binary(make_io("list"))),
654    ?assertEqual(
655       <<"binary">>,
656       iolist_to_binary(make_io(<<"binary">>))),
657    ok.
658
659-record(test_record, {field1=f1, field2=f2}).
660record_to_proplist_test() ->
661    ?assertEqual(
662       [{'__record', test_record},
663        {field1, f1},
664        {field2, f2}],
665       record_to_proplist(#test_record{}, record_info(fields, test_record))),
666    ?assertEqual(
667       [{'typekey', test_record},
668        {field1, f1},
669        {field2, f2}],
670       record_to_proplist(#test_record{},
671                          record_info(fields, test_record),
672                          typekey)),
673    ok.
674
675shell_quote_test() ->
676    ?assertEqual(
677       "\"foo \\$bar\\\"\\`' baz\"",
678       shell_quote("foo $bar\"`' baz")),
679    ok.
680
681cmd_port_test_spool(Port, Acc) ->
682    receive
683        {Port, eof} ->
684            Acc;
685        {Port, {data, {eol, Data}}} ->
686            cmd_port_test_spool(Port, ["\n", Data | Acc]);
687        {Port, Unknown} ->
688            throw({unknown, Unknown})
689    after 1000 ->
690            throw(timeout)
691    end.
692
693cmd_port_test() ->
694    Port = cmd_port(["echo", "$bling$ `word`!"],
695                    [eof, stream, {line, 4096}]),
696    Res = try lists:append(lists:reverse(cmd_port_test_spool(Port, [])))
697          after catch port_close(Port)
698          end,
699    self() ! {Port, wtf},
700    try cmd_port_test_spool(Port, [])
701    catch throw:{unknown, wtf} -> ok
702    end,
703    try cmd_port_test_spool(Port, [])
704    catch throw:timeout -> ok
705    end,
706    ?assertEqual(
707       "$bling$ `word`!\n",
708       Res).
709
710cmd_test() ->
711    ?assertEqual(
712       "$bling$ `word`!\n",
713       cmd(["echo", "$bling$ `word`!"])),
714    ok.
715
716cmd_string_test() ->
717    ?assertEqual(
718       "\"echo\" \"\\$bling\\$ \\`word\\`!\"",
719       cmd_string(["echo", "$bling$ `word`!"])),
720    ok.
721
722cmd_status_test() ->
723    ?assertEqual(
724       {0, <<"$bling$ `word`!\n">>},
725       cmd_status(["echo", "$bling$ `word`!"])),
726    ok.
727
728
729parse_header_test() ->
730    ?assertEqual(
731       {"multipart/form-data", [{"boundary", "AaB03x"}]},
732       parse_header("multipart/form-data; boundary=AaB03x")),
733    %% This tests (currently) intentionally broken behavior
734    ?assertEqual(
735       {"multipart/form-data",
736        [{"b", ""},
737         {"cgi", "is"},
738         {"broken", "true\"e"}]},
739       parse_header("multipart/form-data;b=;cgi=\"i\\s;broken=true\"e;=z;z")),
740    ok.
741
742guess_mime_test() ->
743    ?assertEqual("text/plain", guess_mime("")),
744    ?assertEqual("text/plain", guess_mime(".text")),
745    ?assertEqual("application/zip", guess_mime(".zip")),
746    ?assertEqual("application/zip", guess_mime("x.zip")),
747    ?assertEqual("text/html", guess_mime("x.html")),
748    ?assertEqual("application/xhtml+xml", guess_mime("x.xhtml")),
749    ?assertEqual("text/x-cross-domain-policy", guess_mime("crossdomain.xml")),
750    ?assertEqual("text/x-cross-domain-policy", guess_mime("www/crossdomain.xml")),
751    ok.
752
753path_split_test() ->
754    {"", "foo/bar"} = path_split("/foo/bar"),
755    {"foo", "bar"} = path_split("foo/bar"),
756    {"bar", ""} = path_split("bar"),
757    ok.
758
759urlsplit_test() ->
760    {"", "", "/foo", "", "bar?baz"} = urlsplit("/foo#bar?baz"),
761    {"http", "host:port", "/foo", "", "bar?baz"} =
762        urlsplit("http://host:port/foo#bar?baz"),
763    {"http", "host", "", "", ""} = urlsplit("http://host"),
764    {"", "", "/wiki/Category:Fruit", "", ""} =
765        urlsplit("/wiki/Category:Fruit"),
766    ok.
767
768urlsplit_path_test() ->
769    {"/foo/bar", "", ""} = urlsplit_path("/foo/bar"),
770    {"/foo", "baz", ""} = urlsplit_path("/foo?baz"),
771    {"/foo", "", "bar?baz"} = urlsplit_path("/foo#bar?baz"),
772    {"/foo", "", "bar?baz#wibble"} = urlsplit_path("/foo#bar?baz#wibble"),
773    {"/foo", "bar", "baz"} = urlsplit_path("/foo?bar#baz"),
774    {"/foo", "bar?baz", "baz"} = urlsplit_path("/foo?bar?baz#baz"),
775    ok.
776
777urlunsplit_test() ->
778    "/foo#bar?baz" = urlunsplit({"", "", "/foo", "", "bar?baz"}),
779    "http://host:port/foo#bar?baz" =
780        urlunsplit({"http", "host:port", "/foo", "", "bar?baz"}),
781    ok.
782
783urlunsplit_path_test() ->
784    "/foo/bar" = urlunsplit_path({"/foo/bar", "", ""}),
785    "/foo?baz" = urlunsplit_path({"/foo", "baz", ""}),
786    "/foo#bar?baz" = urlunsplit_path({"/foo", "", "bar?baz"}),
787    "/foo#bar?baz#wibble" = urlunsplit_path({"/foo", "", "bar?baz#wibble"}),
788    "/foo?bar#baz" = urlunsplit_path({"/foo", "bar", "baz"}),
789    "/foo?bar?baz#baz" = urlunsplit_path({"/foo", "bar?baz", "baz"}),
790    ok.
791
792join_test() ->
793    ?assertEqual("foo,bar,baz",
794                  join(["foo", "bar", "baz"], $,)),
795    ?assertEqual("foo,bar,baz",
796                  join(["foo", "bar", "baz"], ",")),
797    ?assertEqual("foo bar",
798                  join([["foo", " bar"]], ",")),
799    ?assertEqual("foo bar,baz",
800                  join([["foo", " bar"], "baz"], ",")),
801    ?assertEqual("foo",
802                  join(["foo"], ",")),
803    ?assertEqual("foobarbaz",
804                  join(["foo", "bar", "baz"], "")),
805    ?assertEqual("foo" ++ [<<>>] ++ "bar" ++ [<<>>] ++ "baz",
806                 join(["foo", "bar", "baz"], <<>>)),
807    ?assertEqual("foobar" ++ [<<"baz">>],
808                 join(["foo", "bar", <<"baz">>], "")),
809    ?assertEqual("",
810                 join([], "any")),
811    ok.
812
813quote_plus_test() ->
814    "foo" = quote_plus(foo),
815    "1" = quote_plus(1),
816    "1.1" = quote_plus(1.1),
817    "foo" = quote_plus("foo"),
818    "foo+bar" = quote_plus("foo bar"),
819    "foo%0A" = quote_plus("foo\n"),
820    "foo%0A" = quote_plus("foo\n"),
821    "foo%3B%26%3D" = quote_plus("foo;&="),
822    "foo%3B%26%3D" = quote_plus(<<"foo;&=">>),
823    ok.
824
825unquote_test() ->
826    ?assertEqual("foo bar",
827                 unquote("foo+bar")),
828    ?assertEqual("foo bar",
829                 unquote("foo%20bar")),
830    ?assertEqual("foo\r\n",
831                 unquote("foo%0D%0A")),
832    ?assertEqual("foo\r\n",
833                 unquote(<<"foo%0D%0A">>)),
834    ok.
835
836urlencode_test() ->
837    "foo=bar&baz=wibble+%0D%0A&z=1" = urlencode([{foo, "bar"},
838                                                 {"baz", "wibble \r\n"},
839                                                 {z, 1}]),
840    ok.
841
842parse_qs_test() ->
843    ?assertEqual(
844       [{"foo", "bar"}, {"baz", "wibble \r\n"}, {"z", "1"}],
845       parse_qs("foo=bar&baz=wibble+%0D%0a&z=1")),
846    ?assertEqual(
847       [{"", "bar"}, {"baz", "wibble \r\n"}, {"z", ""}],
848       parse_qs("=bar&baz=wibble+%0D%0a&z=")),
849    ?assertEqual(
850       [{"foo", "bar"}, {"baz", "wibble \r\n"}, {"z", "1"}],
851       parse_qs(<<"foo=bar&baz=wibble+%0D%0a&z=1">>)),
852    ?assertEqual(
853       [],
854       parse_qs("")),
855    ?assertEqual(
856       [{"foo", ""}, {"bar", ""}, {"baz", ""}],
857       parse_qs("foo;bar&baz")),
858    ok.
859
860partition_test() ->
861    {"foo", "", ""} = partition("foo", "/"),
862    {"foo", "/", "bar"} = partition("foo/bar", "/"),
863    {"foo", "/", ""} = partition("foo/", "/"),
864    {"", "/", "bar"} = partition("/bar", "/"),
865    {"f", "oo/ba", "r"} = partition("foo/bar", "oo/ba"),
866    ok.
867
868safe_relative_path_test() ->
869    "foo" = safe_relative_path("foo"),
870    "foo/" = safe_relative_path("foo/"),
871    "foo" = safe_relative_path("foo/bar/.."),
872    "bar" = safe_relative_path("foo/../bar"),
873    "bar/" = safe_relative_path("foo/../bar/"),
874    "" = safe_relative_path("foo/.."),
875    "" = safe_relative_path("foo/../"),
876    undefined = safe_relative_path("/foo"),
877    undefined = safe_relative_path("../foo"),
878    undefined = safe_relative_path("foo/../.."),
879    undefined = safe_relative_path("foo//"),
880    undefined = safe_relative_path("foo\\bar"),
881    ok.
882
883parse_qvalues_test() ->
884    [] = parse_qvalues(""),
885    [{"identity", 0.0}] = parse_qvalues("identity;q=0"),
886    [{"identity", 0.0}] = parse_qvalues("identity ;q=0"),
887    [{"identity", 0.0}] = parse_qvalues(" identity; q =0 "),
888    [{"identity", 0.0}] = parse_qvalues("identity ; q = 0"),
889    [{"identity", 0.0}] = parse_qvalues("identity ; q= 0.0"),
890    [{"gzip", 1.0}, {"deflate", 1.0}, {"identity", 0.0}] = parse_qvalues(
891        "gzip,deflate,identity;q=0.0"
892    ),
893    [{"deflate", 1.0}, {"gzip", 1.0}, {"identity", 0.0}] = parse_qvalues(
894        "deflate,gzip,identity;q=0.0"
895    ),
896    [{"gzip", 1.0}, {"deflate", 1.0}, {"gzip", 1.0}, {"identity", 0.0}] =
897        parse_qvalues("gzip,deflate,gzip,identity;q=0"),
898    [{"gzip", 1.0}, {"deflate", 1.0}, {"identity", 0.0}] = parse_qvalues(
899        "gzip, deflate , identity; q=0.0"
900    ),
901    [{"gzip", 1.0}, {"deflate", 1.0}, {"identity", 0.0}] = parse_qvalues(
902        "gzip; q=1, deflate;q=1.0, identity;q=0.0"
903    ),
904    [{"gzip", 0.5}, {"deflate", 1.0}, {"identity", 0.0}] = parse_qvalues(
905        "gzip; q=0.5, deflate;q=1.0, identity;q=0"
906    ),
907    [{"gzip", 0.5}, {"deflate", 1.0}, {"identity", 0.0}] = parse_qvalues(
908        "gzip; q=0.5, deflate , identity;q=0.0"
909    ),
910    [{"gzip", 0.5}, {"deflate", 0.8}, {"identity", 0.0}] = parse_qvalues(
911        "gzip; q=0.5, deflate;q=0.8, identity;q=0.0"
912    ),
913    [{"gzip", 0.5}, {"deflate", 1.0}, {"identity", 1.0}] = parse_qvalues(
914        "gzip; q=0.5,deflate,identity"
915    ),
916    [{"gzip", 0.5}, {"deflate", 1.0}, {"identity", 1.0}, {"identity", 1.0}] =
917        parse_qvalues("gzip; q=0.5,deflate,identity, identity "),
918    [{"text/html;level=1", 1.0}, {"text/plain", 0.5}] =
919        parse_qvalues("text/html;level=1, text/plain;q=0.5"),
920    [{"text/html;level=1", 0.3}, {"text/plain", 1.0}] =
921        parse_qvalues("text/html;level=1;q=0.3, text/plain"),
922    [{"text/html;level=1", 0.3}, {"text/plain", 1.0}] =
923        parse_qvalues("text/html; level = 1; q = 0.3, text/plain"),
924    [{"text/html;level=1", 0.3}, {"text/plain", 1.0}] =
925        parse_qvalues("text/html;q=0.3;level=1, text/plain"),
926    invalid_qvalue_string = parse_qvalues("gzip; q=1.1, deflate"),
927    invalid_qvalue_string = parse_qvalues("gzip; q=0.5, deflate;q=2"),
928    invalid_qvalue_string = parse_qvalues("gzip, deflate;q=AB"),
929    invalid_qvalue_string = parse_qvalues("gzip; q=2.1, deflate"),
930    invalid_qvalue_string = parse_qvalues("gzip; q=0.1234, deflate"),
931    invalid_qvalue_string = parse_qvalues("text/html;level=1;q=0.3, text/html;level"),
932    ok.
933
934pick_accepted_encodings_test() ->
935    ["identity"] = pick_accepted_encodings(
936        [],
937        ["gzip", "identity"],
938        "identity"
939    ),
940    ["gzip", "identity"] = pick_accepted_encodings(
941        [{"gzip", 1.0}],
942        ["gzip", "identity"],
943        "identity"
944    ),
945    ["identity"] = pick_accepted_encodings(
946        [{"gzip", 0.0}],
947        ["gzip", "identity"],
948        "identity"
949    ),
950    ["gzip", "identity"] = pick_accepted_encodings(
951        [{"gzip", 1.0}, {"deflate", 1.0}],
952        ["gzip", "identity"],
953        "identity"
954    ),
955    ["gzip", "identity"] = pick_accepted_encodings(
956        [{"gzip", 0.5}, {"deflate", 1.0}],
957        ["gzip", "identity"],
958        "identity"
959    ),
960    ["identity"] = pick_accepted_encodings(
961        [{"gzip", 0.0}, {"deflate", 0.0}],
962        ["gzip", "identity"],
963        "identity"
964    ),
965    ["gzip"] = pick_accepted_encodings(
966        [{"gzip", 1.0}, {"deflate", 1.0}, {"identity", 0.0}],
967        ["gzip", "identity"],
968        "identity"
969    ),
970    ["gzip", "deflate", "identity"] = pick_accepted_encodings(
971        [{"gzip", 1.0}, {"deflate", 1.0}],
972        ["gzip", "deflate", "identity"],
973        "identity"
974    ),
975    ["gzip", "deflate"] = pick_accepted_encodings(
976        [{"gzip", 1.0}, {"deflate", 1.0}, {"identity", 0.0}],
977        ["gzip", "deflate", "identity"],
978        "identity"
979    ),
980    ["deflate", "gzip", "identity"] = pick_accepted_encodings(
981        [{"gzip", 0.2}, {"deflate", 1.0}],
982        ["gzip", "deflate", "identity"],
983        "identity"
984    ),
985    ["deflate", "deflate", "gzip", "identity"] = pick_accepted_encodings(
986        [{"gzip", 0.2}, {"deflate", 1.0}, {"deflate", 1.0}],
987        ["gzip", "deflate", "identity"],
988        "identity"
989    ),
990    ["deflate", "gzip", "gzip", "identity"] = pick_accepted_encodings(
991        [{"gzip", 0.2}, {"deflate", 1.0}, {"gzip", 1.0}],
992        ["gzip", "deflate", "identity"],
993        "identity"
994    ),
995    ["gzip", "deflate", "gzip", "identity"] = pick_accepted_encodings(
996        [{"gzip", 0.2}, {"deflate", 0.9}, {"gzip", 1.0}],
997        ["gzip", "deflate", "identity"],
998        "identity"
999    ),
1000    [] = pick_accepted_encodings(
1001        [{"*", 0.0}],
1002        ["gzip", "deflate", "identity"],
1003        "identity"
1004    ),
1005    ["gzip", "deflate", "identity"] = pick_accepted_encodings(
1006        [{"*", 1.0}],
1007        ["gzip", "deflate", "identity"],
1008        "identity"
1009    ),
1010    ["gzip", "deflate", "identity"] = pick_accepted_encodings(
1011        [{"*", 0.6}],
1012        ["gzip", "deflate", "identity"],
1013        "identity"
1014    ),
1015    ["gzip"] = pick_accepted_encodings(
1016        [{"gzip", 1.0}, {"*", 0.0}],
1017        ["gzip", "deflate", "identity"],
1018        "identity"
1019    ),
1020    ["gzip", "deflate"] = pick_accepted_encodings(
1021        [{"gzip", 1.0}, {"deflate", 0.6}, {"*", 0.0}],
1022        ["gzip", "deflate", "identity"],
1023        "identity"
1024    ),
1025    ["deflate", "gzip"] = pick_accepted_encodings(
1026        [{"gzip", 0.5}, {"deflate", 1.0}, {"*", 0.0}],
1027        ["gzip", "deflate", "identity"],
1028        "identity"
1029    ),
1030    ["gzip", "identity"] = pick_accepted_encodings(
1031        [{"deflate", 0.0}, {"*", 1.0}],
1032        ["gzip", "deflate", "identity"],
1033        "identity"
1034    ),
1035    ["gzip", "identity"] = pick_accepted_encodings(
1036        [{"*", 1.0}, {"deflate", 0.0}],
1037        ["gzip", "deflate", "identity"],
1038        "identity"
1039    ),
1040    ok.
1041
1042normalize_path_test() ->
1043	"" = normalize_path(""),
1044	"/" = normalize_path("/"),
1045	"/" = normalize_path("//"),
1046	"/" = normalize_path("///"),
1047	"foo" = normalize_path("foo"),
1048	"/foo" = normalize_path("/foo"),
1049	"/foo" = normalize_path("//foo"),
1050	"/foo" = normalize_path("///foo"),
1051	"foo/" = normalize_path("foo/"),
1052	"foo/" = normalize_path("foo//"),
1053	"foo/" = normalize_path("foo///"),
1054	"foo/bar" = normalize_path("foo/bar"),
1055	"foo/bar" = normalize_path("foo//bar"),
1056	"foo/bar" = normalize_path("foo///bar"),
1057	"foo/bar" = normalize_path("foo////bar"),
1058	"/foo/bar" = normalize_path("/foo/bar"),
1059	"/foo/bar" = normalize_path("/foo////bar"),
1060	"/foo/bar" = normalize_path("////foo/bar"),
1061	"/foo/bar" = normalize_path("////foo///bar"),
1062	"/foo/bar" = normalize_path("////foo////bar"),
1063	"/foo/bar/" = normalize_path("/foo/bar/"),
1064	"/foo/bar/" = normalize_path("////foo/bar/"),
1065	"/foo/bar/" = normalize_path("/foo////bar/"),
1066	"/foo/bar/" = normalize_path("/foo/bar////"),
1067	"/foo/bar/" = normalize_path("///foo////bar/"),
1068	"/foo/bar/" = normalize_path("////foo/bar////"),
1069	"/foo/bar/" = normalize_path("/foo///bar////"),
1070	"/foo/bar/" = normalize_path("////foo///bar////"),
1071	ok.
1072
1073-endif.
1074