├── priv
└── skel
│ ├── src
│ ├── skel.hrl
│ ├── skel.app
│ ├── skel_app.erl
│ ├── skel.erl
│ ├── Makefile
│ ├── skel_web.erl
│ ├── skel_sup.erl
│ └── skel_deps.erl
│ ├── start.sh
│ ├── priv
│ └── www
│ │ └── index.html
│ ├── start-dev.sh
│ ├── Makefile
│ └── support
│ ├── include.mk
│ └── run_tests.escript
├── .gitignore
├── src
├── internal.hrl
├── mochiweb.app.src
├── mochiweb_app.erl
├── Makefile
├── mochifmt_std.erl
├── mochiweb_sup.erl
├── mochifmt_records.erl
├── mochiweb_echo.erl
├── mochiweb_io.erl
├── mochiweb_acceptor.erl
├── mochiweb_response.erl
├── mochiweb_cover.erl
├── mochiweb_socket.erl
├── mochihex.erl
├── mochiweb_mime.erl
├── mochiweb_skel.erl
├── mochilists.erl
├── mochiglobal.erl
├── mochilogfile2.erl
├── reloader.erl
├── mochiweb_charref.erl
├── mochitemp.erl
├── mochiweb.erl
├── mochiweb_socket_server.erl
├── mochiweb_http.erl
├── mochiweb_cookies.erl
├── mochinum.erl
├── mochiweb_headers.erl
├── mochiutf8.erl
├── mochifmt.erl
└── mochijson.erl
├── Makefile
├── README
├── scripts
└── new_mochiweb.erl
├── LICENSE
├── support
├── include.mk
├── test-materials
│ ├── test_ssl_cert.pem
│ └── test_ssl_key.pem
├── make_app.escript
└── run_tests.escript
└── examples
├── https
├── server_cert.pem
├── server_key.pem
└── https_store.erl
└── keepalive
└── keepalive.erl
/priv/skel/src/skel.hrl:
--------------------------------------------------------------------------------
1 |
2 |
--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | /ebin
2 | /doc
3 | /_test
4 |
--------------------------------------------------------------------------------
/src/internal.hrl:
--------------------------------------------------------------------------------
1 |
2 | -define(RECBUF_SIZE, 8192).
3 |
4 |
--------------------------------------------------------------------------------
/priv/skel/start.sh:
--------------------------------------------------------------------------------
1 | #!/bin/sh
2 | cd `dirname $0`
3 | exec erl -pa $PWD/ebin $PWD/deps/*/ebin -boot start_sasl -s skel
4 |
--------------------------------------------------------------------------------
/priv/skel/priv/www/index.html:
--------------------------------------------------------------------------------
1 |
2 |
3 | It Worked
4 |
5 |
6 | MochiWeb running.
7 |
8 |
9 |
--------------------------------------------------------------------------------
/priv/skel/start-dev.sh:
--------------------------------------------------------------------------------
1 | #!/bin/sh
2 | cd `dirname $0`
3 |
4 | MAKE=make
5 | case `uname` in
6 | *BSD)
7 | MAKE=gmake
8 | ;;
9 | esac
10 |
11 | "${MAKE}"
12 | exec erl -pa $PWD/ebin $PWD/deps/*/ebin -boot start_sasl -s reloader -s skel
13 |
--------------------------------------------------------------------------------
/src/mochiweb.app.src:
--------------------------------------------------------------------------------
1 | %% This is generated from src/mochiweb.app.src
2 | {application, mochiweb,
3 | [{description, "MochiMedia Web Server"},
4 | {vsn, "1.3"},
5 | {modules, []},
6 | {registered, []},
7 | {mod, {mochiweb_app, []}},
8 | {env, []},
9 | {applications, [kernel, stdlib, crypto, inets]}]}.
10 |
--------------------------------------------------------------------------------
/Makefile:
--------------------------------------------------------------------------------
1 | all: ebin/
2 | (cd src;$(MAKE) all)
3 |
4 | edoc:
5 | (cd src;$(MAKE) edoc)
6 |
7 | test: ebin/
8 | (cd src;$(MAKE) test)
9 |
10 | clean:
11 | rm -rf ebin
12 |
13 | clean_plt:
14 | (cd src;$(MAKE) clean_plt)
15 |
16 | dialyzer:
17 | (cd src;$(MAKE) dialyzer)
18 |
19 | ebin/:
20 | @mkdir -p ebin
21 |
--------------------------------------------------------------------------------
/priv/skel/Makefile:
--------------------------------------------------------------------------------
1 | all: ebin/
2 | (cd src;$(MAKE) all)
3 |
4 | edoc:
5 | (cd src;$(MAKE) edoc)
6 |
7 | test:
8 | (cd src;$(MAKE) test)
9 |
10 | clean:
11 | (cd src;$(MAKE) clean)
12 |
13 | clean_plt:
14 | (cd src;$(MAKE) clean_plt)
15 |
16 | dialyzer:
17 | (cd src;$(MAKE) dialyzer)
18 |
19 | ebin/:
20 | @mkdir -p ebin
21 |
--------------------------------------------------------------------------------
/priv/skel/src/skel.app:
--------------------------------------------------------------------------------
1 | {application, skel,
2 | [{description, "skel"},
3 | {vsn, "0.01"},
4 | {modules, [
5 | skel,
6 | skel_app,
7 | skel_sup,
8 | skel_web,
9 | skel_deps
10 | ]},
11 | {registered, []},
12 | {mod, {skel_app, []}},
13 | {env, []},
14 | {applications, [kernel, stdlib, crypto]}]}.
15 |
--------------------------------------------------------------------------------
/README:
--------------------------------------------------------------------------------
1 | MochiWeb is an Erlang library for building lightweight HTTP servers.
2 |
3 | The latest version of MochiWeb is available at http://github.com/mochi/mochiweb
4 |
5 | R12B compatibility:
6 | The master of MochiWeb is tested with R13B04 and later. A branch compatible
7 | with R12B is maintained separately at http://github.com/lemenkov/mochiweb
8 | The R12B branch of that repository is mirrored in the official repository
9 | occasionally for convenience.
10 |
--------------------------------------------------------------------------------
/src/mochiweb_app.erl:
--------------------------------------------------------------------------------
1 | %% @author Bob Ippolito
2 | %% @copyright 2007 Mochi Media, Inc.
3 |
4 | %% @doc Callbacks for the mochiweb application.
5 |
6 | -module(mochiweb_app).
7 | -author('bob@mochimedia.com').
8 |
9 | -behaviour(application).
10 | -export([start/2,stop/1]).
11 |
12 | %% @spec start(_Type, _StartArgs) -> ServerRet
13 | %% @doc application start callback for mochiweb.
14 | start(_Type, _StartArgs) ->
15 | mochiweb_sup:start_link().
16 |
17 | %% @spec stop(_State) -> ServerRet
18 | %% @doc application stop callback for mochiweb.
19 | stop(_State) ->
20 | ok.
21 |
22 | %%
23 | %% Tests
24 | %%
25 | -include_lib("eunit/include/eunit.hrl").
26 | -ifdef(TEST).
27 | -endif.
28 |
--------------------------------------------------------------------------------
/priv/skel/src/skel_app.erl:
--------------------------------------------------------------------------------
1 | %% @author author
2 | %% @copyright YYYY author.
3 |
4 | %% @doc Callbacks for the skel application.
5 |
6 | -module(skel_app).
7 | -author('author ').
8 |
9 | -behaviour(application).
10 | -export([start/2, stop/1]).
11 |
12 |
13 | %% @spec start(_Type, _StartArgs) -> ServerRet
14 | %% @doc application start callback for skel.
15 | start(_Type, _StartArgs) ->
16 | skel_deps:ensure(),
17 | skel_sup:start_link().
18 |
19 | %% @spec stop(_State) -> ServerRet
20 | %% @doc application stop callback for skel.
21 | stop(_State) ->
22 | ok.
23 |
24 |
25 | %%
26 | %% Tests
27 | %%
28 | -include_lib("eunit/include/eunit.hrl").
29 | -ifdef(TEST).
30 | -endif.
31 |
--------------------------------------------------------------------------------
/priv/skel/src/skel.erl:
--------------------------------------------------------------------------------
1 | %% @author author
2 | %% @copyright YYYY author.
3 |
4 | %% @doc TEMPLATE.
5 |
6 | -module(skel).
7 | -author('author ').
8 | -export([start/0, stop/0]).
9 |
10 | ensure_started(App) ->
11 | case application:start(App) of
12 | ok ->
13 | ok;
14 | {error, {already_started, App}} ->
15 | ok
16 | end.
17 |
18 | %% @spec start() -> ok
19 | %% @doc Start the skel server.
20 | start() ->
21 | skel_deps:ensure(),
22 | ensure_started(crypto),
23 | application:start(skel).
24 |
25 | %% @spec stop() -> ok
26 | %% @doc Stop the skel server.
27 | stop() ->
28 | Res = application:stop(skel),
29 | application:stop(crypto),
30 | Res.
31 |
--------------------------------------------------------------------------------
/src/Makefile:
--------------------------------------------------------------------------------
1 | include ../support/include.mk
2 |
3 | APPLICATION=mochiweb
4 | DOC_OPTS={dir,\"../doc\"}
5 | TEST_PLT=$(TEST_DIR)/dialyzer_plt
6 |
7 | all: $(EBIN_FILES)
8 |
9 | debug:
10 | $(MAKE) DEBUG=-DDEBUG
11 |
12 | clean:
13 | rm -rf $(EBIN_FILES)
14 |
15 | edoc:
16 | $(ERL) -noshell -pa ../ebin \
17 | -eval "edoc:application($(APPLICATION), \".\", [$(DOC_OPTS)])" \
18 | -s init stop
19 |
20 | test: $(EBIN_FILES)
21 | mkdir -p $(TEST_DIR);
22 | @../support/run_tests.escript $(EBIN_DIR) | tee $(TEST_DIR)/test.log
23 |
24 | $(TEST_PLT):
25 | mkdir -p $(TEST_DIR)
26 | cp $(DIALYZER_PLT) $(TEST_PLT)
27 | dialyzer --plt $(TEST_PLT) --add_to_plt
28 |
29 | clean_plt:
30 | rm $(TEST_PLT)
31 |
32 | dialyzer: $(TEST_PLT)
33 | dialyzer --src --plt $(TEST_PLT) -DNOTEST -DDIALYZER -c ../src | tee $(TEST_DIR)/dialyzer.log
--------------------------------------------------------------------------------
/src/mochifmt_std.erl:
--------------------------------------------------------------------------------
1 | %% @author Bob Ippolito
2 | %% @copyright 2008 Mochi Media, Inc.
3 |
4 | %% @doc Template module for a mochifmt formatter.
5 |
6 | -module(mochifmt_std, []).
7 | -author('bob@mochimedia.com').
8 | -export([format/2, get_value/2, format_field/2, get_field/2, convert_field/2]).
9 |
10 | format(Format, Args) ->
11 | mochifmt:format(Format, Args, THIS).
12 |
13 | get_field(Key, Args) ->
14 | mochifmt:get_field(Key, Args, THIS).
15 |
16 | convert_field(Key, Args) ->
17 | mochifmt:convert_field(Key, Args).
18 |
19 | get_value(Key, Args) ->
20 | mochifmt:get_value(Key, Args).
21 |
22 | format_field(Arg, Format) ->
23 | mochifmt:format_field(Arg, Format, THIS).
24 |
25 | %%
26 | %% Tests
27 | %%
28 | -include_lib("eunit/include/eunit.hrl").
29 | -ifdef(TEST).
30 | -endif.
31 |
--------------------------------------------------------------------------------
/priv/skel/src/Makefile:
--------------------------------------------------------------------------------
1 | include ../support/include.mk
2 |
3 | APPLICATION=skel
4 | DOC_OPTS={dir,\"../doc\"}
5 | TEST_PLT=$(TEST_DIR)/dialyzer_plt
6 |
7 | all: $(EBIN_FILES)
8 |
9 | debug:
10 | $(MAKE) DEBUG=-DDEBUG
11 |
12 | clean:
13 | rm -rf $(EBIN_FILES)
14 |
15 | edoc:
16 | $(ERL) -noshell -pa ../ebin \
17 | -eval "edoc:application($(APPLICATION), \".\", [$(DOC_OPTS)])" \
18 | -s init stop
19 |
20 | test: $(EBIN_FILES)
21 | mkdir -p $(TEST_DIR);
22 | @../support/run_tests.escript $(EBIN_DIR) | tee $(TEST_DIR)/test.log
23 |
24 | $(TEST_PLT):
25 | mkdir -p $(TEST_DIR)
26 | cp $(DIALYZER_PLT) $(TEST_PLT)
27 | dialyzer --plt $(TEST_PLT) --add_to_plt -r ../deps/*/ebin
28 |
29 | clean_plt:
30 | rm $(TEST_PLT)
31 |
32 | dialyzer: $(TEST_PLT)
33 | dialyzer --src --plt $(TEST_PLT) -DNOTEST -DDIALYZER -c ../src | tee $(TEST_DIR)/dialyzer.log
--------------------------------------------------------------------------------
/scripts/new_mochiweb.erl:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env escript
2 | %% -*- mode: erlang -*-
3 | -export([main/1]).
4 |
5 | %% External API
6 |
7 | main([Name]) ->
8 | main([Name, "."]);
9 | main([Name, Dest]) ->
10 | ensure(),
11 | DestDir = filename:absname(Dest),
12 | case code:which(mochiweb_skel) of
13 | non_existing ->
14 | io:format("mochiweb not compiled, running make~n"),
15 | os:cmd("(cd \"" ++ filename:dirname(escript:script_name())
16 | ++ "/..\"; make)"),
17 | ensure(),
18 | code:rehash();
19 | _ ->
20 | ok
21 | end,
22 | ok = mochiweb_skel:skelcopy(DestDir, Name);
23 | main(_) ->
24 | usage().
25 |
26 | %% Internal API
27 |
28 | ensure() ->
29 | code:add_patha(filename:join(filename:dirname(escript:script_name()),
30 | "../ebin")).
31 |
32 | usage() ->
33 | io:format("usage: ~s name [destdir]~n",
34 | [filename:basename(escript:script_name())]),
35 | halt(1).
36 |
37 |
38 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | This is the MIT license.
2 |
3 | Copyright (c) 2007 Mochi Media, Inc.
4 |
5 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
6 |
7 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
8 |
9 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
10 |
--------------------------------------------------------------------------------
/src/mochiweb_sup.erl:
--------------------------------------------------------------------------------
1 | %% @author Bob Ippolito
2 | %% @copyright 2007 Mochi Media, Inc.
3 |
4 | %% @doc Supervisor for the mochiweb application.
5 |
6 | -module(mochiweb_sup).
7 | -author('bob@mochimedia.com').
8 |
9 | -behaviour(supervisor).
10 |
11 | %% External exports
12 | -export([start_link/0, upgrade/0]).
13 |
14 | %% supervisor callbacks
15 | -export([init/1]).
16 |
17 | %% @spec start_link() -> ServerRet
18 | %% @doc API for starting the supervisor.
19 | start_link() ->
20 | supervisor:start_link({local, ?MODULE}, ?MODULE, []).
21 |
22 | %% @spec upgrade() -> ok
23 | %% @doc Add processes if necessary.
24 | upgrade() ->
25 | {ok, {_, Specs}} = init([]),
26 | [supervisor:start_child(?MODULE, Spec) || Spec <- Specs],
27 | ok.
28 |
29 | %% @spec init([]) -> SupervisorTree
30 | %% @doc supervisor callback, ensures yaws is in embedded mode and then
31 | %% returns the supervisor tree.
32 | init([]) ->
33 | Processes = [],
34 | {ok, {{one_for_one, 10, 10}, Processes}}.
35 |
36 | %%
37 | %% Tests
38 | %%
39 | -include_lib("eunit/include/eunit.hrl").
40 | -ifdef(TEST).
41 | -endif.
42 |
--------------------------------------------------------------------------------
/src/mochifmt_records.erl:
--------------------------------------------------------------------------------
1 | %% @author Bob Ippolito
2 | %% @copyright 2008 Mochi Media, Inc.
3 |
4 | %% @doc Formatter that understands records.
5 | %%
6 | %% Usage:
7 | %%
8 | %% 1> M = mochifmt_records:new([{rec, record_info(fields, rec)}]),
9 | %% M:format("{0.bar}", [#rec{bar=foo}]).
10 | %% foo
11 |
12 | -module(mochifmt_records, [Recs]).
13 | -author('bob@mochimedia.com').
14 | -export([get_value/2]).
15 |
16 | get_value(Key, Rec) when is_tuple(Rec) and is_atom(element(1, Rec)) ->
17 | try begin
18 | Atom = list_to_existing_atom(Key),
19 | {_, Fields} = proplists:lookup(element(1, Rec), Recs),
20 | element(get_rec_index(Atom, Fields, 2), Rec)
21 | end
22 | catch error:_ -> mochifmt:get_value(Key, Rec)
23 | end;
24 | get_value(Key, Args) ->
25 | mochifmt:get_value(Key, Args).
26 |
27 | get_rec_index(Atom, [Atom | _], Index) ->
28 | Index;
29 | get_rec_index(Atom, [_ | Rest], Index) ->
30 | get_rec_index(Atom, Rest, 1 + Index).
31 |
32 |
33 | %%
34 | %% Tests
35 | %%
36 | -include_lib("eunit/include/eunit.hrl").
37 | -ifdef(TEST).
38 | -endif.
39 |
--------------------------------------------------------------------------------
/src/mochiweb_echo.erl:
--------------------------------------------------------------------------------
1 | %% @author Bob Ippolito
2 | %% @copyright 2007 Mochi Media, Inc.
3 |
4 | %% @doc Simple and stupid echo server to demo mochiweb_socket_server.
5 |
6 | -module(mochiweb_echo).
7 | -author('bob@mochimedia.com').
8 | -export([start/0, stop/0, loop/1]).
9 |
10 | stop() ->
11 | mochiweb_socket_server:stop(?MODULE).
12 |
13 | start() ->
14 | mochiweb_socket_server:start([{name, ?MODULE},
15 | {port, 6789},
16 | {ip, "127.0.0.1"},
17 | {max, 1},
18 | {loop, {?MODULE, loop}}]).
19 |
20 | loop(Socket) ->
21 | case mochiweb_socket:recv(Socket, 0, 30000) of
22 | {ok, Data} ->
23 | case mochiweb_socket:send(Socket, Data) of
24 | ok ->
25 | loop(Socket);
26 | _ ->
27 | exit(normal)
28 | end;
29 | _Other ->
30 | exit(normal)
31 | end.
32 |
33 | %%
34 | %% Tests
35 | %%
36 | -include_lib("eunit/include/eunit.hrl").
37 | -ifdef(TEST).
38 | -endif.
39 |
--------------------------------------------------------------------------------
/priv/skel/support/include.mk:
--------------------------------------------------------------------------------
1 | ## -*- makefile -*-
2 |
3 | ######################################################################
4 | ## Erlang
5 |
6 | ERL := erl
7 | ERLC := $(ERL)c
8 |
9 | INCLUDE_DIRS := ../include $(wildcard ../deps/*/include)
10 | EBIN_DIRS := $(wildcard ../deps/*/ebin)
11 | ERLC_FLAGS := -W $(INCLUDE_DIRS:../%=-I ../%) $(EBIN_DIRS:%=-pa %)
12 |
13 | ifndef no_debug_info
14 | ERLC_FLAGS += +debug_info
15 | endif
16 |
17 | ifdef debug
18 | ERLC_FLAGS += -Ddebug
19 | endif
20 |
21 | EBIN_DIR := ../ebin
22 | TEST_DIR := ../_test
23 | EMULATOR := beam
24 |
25 | ERL_SOURCES := $(wildcard *.erl)
26 | ERL_HEADERS := $(wildcard *.hrl) $(wildcard ../include/*.hrl)
27 | ERL_OBJECTS := $(ERL_SOURCES:%.erl=$(EBIN_DIR)/%.$(EMULATOR))
28 | ERL_OBJECTS_LOCAL := $(ERL_SOURCES:%.erl=./%.$(EMULATOR))
29 | APP_FILES := $(wildcard *.app)
30 | EBIN_FILES = $(ERL_OBJECTS) $(APP_FILES:%.app=../ebin/%.app)
31 | MODULES = $(ERL_SOURCES:%.erl=%)
32 |
33 | ../ebin/%.app: %.app
34 | cp $< $@
35 |
36 | $(EBIN_DIR)/%.$(EMULATOR): %.erl
37 | $(ERLC) $(ERLC_FLAGS) -o $(EBIN_DIR) $<
38 |
39 | ./%.$(EMULATOR): %.erl
40 | $(ERLC) $(ERLC_FLAGS) -o . $<
41 |
--------------------------------------------------------------------------------
/support/include.mk:
--------------------------------------------------------------------------------
1 | ## -*- makefile -*-
2 |
3 | ######################################################################
4 | ## Erlang
5 |
6 | ERL := erl
7 | ERLC := $(ERL)c
8 |
9 | INCLUDE_DIRS := ../include $(wildcard ../deps/*/include)
10 | EBIN_DIRS := $(wildcard ../deps/*/ebin)
11 | ERLC_FLAGS := -W $(INCLUDE_DIRS:../%=-I ../%) $(EBIN_DIRS:%=-pa %)
12 |
13 | ifndef no_debug_info
14 | ERLC_FLAGS += +debug_info
15 | endif
16 |
17 | ifdef debug
18 | ERLC_FLAGS += -Ddebug
19 | endif
20 |
21 | EBIN_DIR := ../ebin
22 | TEST_DIR := ../_test
23 | EMULATOR := beam
24 |
25 | ERL_SOURCES := $(wildcard *.erl)
26 | ERL_HEADERS := $(wildcard *.hrl) $(wildcard ../include/*.hrl)
27 | ERL_OBJECTS := $(ERL_SOURCES:%.erl=$(EBIN_DIR)/%.$(EMULATOR))
28 | ERL_OBJECTS_LOCAL := $(ERL_SOURCES:%.erl=./%.$(EMULATOR))
29 | APP_FILES := $(wildcard *.app.src)
30 | EBIN_FILES = $(ERL_OBJECTS) $(APP_FILES:%.app.src=../ebin/%.app)
31 | MODULES = $(ERL_SOURCES:%.erl=%)
32 |
33 | ../ebin/%.app: %.app.src
34 | ../support/make_app.escript $< $@ "" "$(MODULES)"
35 |
36 |
37 | $(EBIN_DIR)/%.$(EMULATOR): %.erl
38 | $(ERLC) $(ERLC_FLAGS) -o $(EBIN_DIR) $<
39 |
40 | ./%.$(EMULATOR): %.erl
41 | $(ERLC) $(ERLC_FLAGS) -o . $<
42 |
--------------------------------------------------------------------------------
/examples/https/server_cert.pem:
--------------------------------------------------------------------------------
1 | -----BEGIN CERTIFICATE-----
2 | MIIDIDCCAgigAwIBAgIJAJLkNZzERPIUMA0GCSqGSIb3DQEBBQUAMBQxEjAQBgNV
3 | BAMTCWxvY2FsaG9zdDAeFw0xMDAzMTgxOTM5MThaFw0yMDAzMTUxOTM5MThaMBQx
4 | EjAQBgNVBAMTCWxvY2FsaG9zdDCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoC
5 | ggEBAJeUCOZxbmtngF4S5lXckjSDLc+8C+XjMBYBPyy5eKdJY20AQ1s9/hhp3ulI
6 | 8pAvl+xVo4wQ+iBSvOzcy248Q+Xi6+zjceF7UNRgoYPgtJjKhdwcHV3mvFFrS/fp
7 | 9ggoAChaJQWDO1OCfUgTWXImhkw+vcDR11OVMAJ/h73dqzJPI9mfq44PTTHfYtgr
8 | v4LAQAOlhXIAa2B+a6PlF6sqDqJaW5jLTcERjsBwnRhUGi7JevQzkejujX/vdA+N
9 | jRBjKH/KLU5h3Q7wUchvIez0PXWVTCnZjpA9aR4m7YV05nKQfxtGd71czYDYk+j8
10 | hd005jetT4ir7JkAWValBybJVksCAwEAAaN1MHMwHQYDVR0OBBYEFJl9s51SnjJt
11 | V/wgKWqV5Q6jnv1ZMEQGA1UdIwQ9MDuAFJl9s51SnjJtV/wgKWqV5Q6jnv1ZoRik
12 | FjAUMRIwEAYDVQQDEwlsb2NhbGhvc3SCCQCS5DWcxETyFDAMBgNVHRMEBTADAQH/
13 | MA0GCSqGSIb3DQEBBQUAA4IBAQB2ldLeLCc+lxK5i0EZquLamMBJwDIjGpT0JMP9
14 | b4XQOK2JABIu54BQIZhwcjk3FDJz/uOW5vm8k1kYni8FCjNZAaRZzCUfiUYTbTKL
15 | Rq9LuIAODyP2dnTqyKaQOOJHvrx9MRZ3XVecXPS0Tib4aO57vCaAbIkmhtYpTWmw
16 | e3t8CAIDVtgvjR6Se0a1JA4LktR7hBu22tDImvCSJn1nVAaHpani6iPBPPdMuMsP
17 | TBoeQfj8VpqBUjCStqJGa8ytjDFX73YaxV2mgrtGwPNme1x3YNRR11yTu7tksyMO
18 | GrmgxNriqYRchBhNEf72AKF0LR1ByKwfbDB9rIsV00HtCgOp
19 | -----END CERTIFICATE-----
20 |
--------------------------------------------------------------------------------
/support/test-materials/test_ssl_cert.pem:
--------------------------------------------------------------------------------
1 | -----BEGIN CERTIFICATE-----
2 | MIIDIDCCAgigAwIBAgIJAJLkNZzERPIUMA0GCSqGSIb3DQEBBQUAMBQxEjAQBgNV
3 | BAMTCWxvY2FsaG9zdDAeFw0xMDAzMTgxOTM5MThaFw0yMDAzMTUxOTM5MThaMBQx
4 | EjAQBgNVBAMTCWxvY2FsaG9zdDCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoC
5 | ggEBAJeUCOZxbmtngF4S5lXckjSDLc+8C+XjMBYBPyy5eKdJY20AQ1s9/hhp3ulI
6 | 8pAvl+xVo4wQ+iBSvOzcy248Q+Xi6+zjceF7UNRgoYPgtJjKhdwcHV3mvFFrS/fp
7 | 9ggoAChaJQWDO1OCfUgTWXImhkw+vcDR11OVMAJ/h73dqzJPI9mfq44PTTHfYtgr
8 | v4LAQAOlhXIAa2B+a6PlF6sqDqJaW5jLTcERjsBwnRhUGi7JevQzkejujX/vdA+N
9 | jRBjKH/KLU5h3Q7wUchvIez0PXWVTCnZjpA9aR4m7YV05nKQfxtGd71czYDYk+j8
10 | hd005jetT4ir7JkAWValBybJVksCAwEAAaN1MHMwHQYDVR0OBBYEFJl9s51SnjJt
11 | V/wgKWqV5Q6jnv1ZMEQGA1UdIwQ9MDuAFJl9s51SnjJtV/wgKWqV5Q6jnv1ZoRik
12 | FjAUMRIwEAYDVQQDEwlsb2NhbGhvc3SCCQCS5DWcxETyFDAMBgNVHRMEBTADAQH/
13 | MA0GCSqGSIb3DQEBBQUAA4IBAQB2ldLeLCc+lxK5i0EZquLamMBJwDIjGpT0JMP9
14 | b4XQOK2JABIu54BQIZhwcjk3FDJz/uOW5vm8k1kYni8FCjNZAaRZzCUfiUYTbTKL
15 | Rq9LuIAODyP2dnTqyKaQOOJHvrx9MRZ3XVecXPS0Tib4aO57vCaAbIkmhtYpTWmw
16 | e3t8CAIDVtgvjR6Se0a1JA4LktR7hBu22tDImvCSJn1nVAaHpani6iPBPPdMuMsP
17 | TBoeQfj8VpqBUjCStqJGa8ytjDFX73YaxV2mgrtGwPNme1x3YNRR11yTu7tksyMO
18 | GrmgxNriqYRchBhNEf72AKF0LR1ByKwfbDB9rIsV00HtCgOp
19 | -----END CERTIFICATE-----
20 |
--------------------------------------------------------------------------------
/src/mochiweb_io.erl:
--------------------------------------------------------------------------------
1 | %% @author Bob Ippolito
2 | %% @copyright 2007 Mochi Media, Inc.
3 |
4 | %% @doc Utilities for dealing with IO devices (open files).
5 |
6 | -module(mochiweb_io).
7 | -author('bob@mochimedia.com').
8 |
9 | -export([iodevice_stream/3, iodevice_stream/2]).
10 | -export([iodevice_foldl/4, iodevice_foldl/3]).
11 | -export([iodevice_size/1]).
12 | -define(READ_SIZE, 8192).
13 |
14 | iodevice_foldl(F, Acc, IoDevice) ->
15 | iodevice_foldl(F, Acc, IoDevice, ?READ_SIZE).
16 |
17 | iodevice_foldl(F, Acc, IoDevice, BufferSize) ->
18 | case file:read(IoDevice, BufferSize) of
19 | eof ->
20 | Acc;
21 | {ok, Data} ->
22 | iodevice_foldl(F, F(Data, Acc), IoDevice, BufferSize)
23 | end.
24 |
25 | iodevice_stream(Callback, IoDevice) ->
26 | iodevice_stream(Callback, IoDevice, ?READ_SIZE).
27 |
28 | iodevice_stream(Callback, IoDevice, BufferSize) ->
29 | F = fun (Data, ok) -> Callback(Data) end,
30 | ok = iodevice_foldl(F, ok, IoDevice, BufferSize).
31 |
32 | iodevice_size(IoDevice) ->
33 | {ok, Size} = file:position(IoDevice, eof),
34 | {ok, 0} = file:position(IoDevice, bof),
35 | Size.
36 |
37 |
38 | %%
39 | %% Tests
40 | %%
41 | -include_lib("eunit/include/eunit.hrl").
42 | -ifdef(TEST).
43 |
44 |
45 |
46 | -endif.
47 |
--------------------------------------------------------------------------------
/priv/skel/src/skel_web.erl:
--------------------------------------------------------------------------------
1 | %% @author author
2 | %% @copyright YYYY author.
3 |
4 | %% @doc Web server for skel.
5 |
6 | -module(skel_web).
7 | -author('author ').
8 |
9 | -export([start/1, stop/0, loop/2]).
10 |
11 | %% External API
12 |
13 | start(Options) ->
14 | {DocRoot, Options1} = get_option(docroot, Options),
15 | Loop = fun (Req) ->
16 | ?MODULE:loop(Req, DocRoot)
17 | end,
18 | mochiweb_http:start([{name, ?MODULE}, {loop, Loop} | Options1]).
19 |
20 | stop() ->
21 | mochiweb_http:stop(?MODULE).
22 |
23 | loop(Req, DocRoot) ->
24 | "/" ++ Path = Req:get(path),
25 | case Req:get(method) of
26 | Method when Method =:= 'GET'; Method =:= 'HEAD' ->
27 | case Path of
28 | _ ->
29 | Req:serve_file(Path, DocRoot)
30 | end;
31 | 'POST' ->
32 | case Path of
33 | _ ->
34 | Req:not_found()
35 | end;
36 | _ ->
37 | Req:respond({501, [], []})
38 | end.
39 |
40 | %% Internal API
41 |
42 | get_option(Option, Options) ->
43 | {proplists:get_value(Option, Options), proplists:delete(Option, Options)}.
44 |
45 |
46 | %%
47 | %% Tests
48 | %%
49 | -include_lib("eunit/include/eunit.hrl").
50 | -ifdef(TEST).
51 | -endif.
52 |
--------------------------------------------------------------------------------
/src/mochiweb_acceptor.erl:
--------------------------------------------------------------------------------
1 | %% @author Bob Ippolito
2 | %% @copyright 2010 Mochi Media, Inc.
3 |
4 | %% @doc MochiWeb acceptor.
5 |
6 | -module(mochiweb_acceptor).
7 | -author('bob@mochimedia.com').
8 |
9 | -include("internal.hrl").
10 |
11 | -export([start_link/3, init/3]).
12 |
13 | start_link(Server, Listen, Loop) ->
14 | proc_lib:spawn_link(?MODULE, init, [Server, Listen, Loop]).
15 |
16 | init(Server, Listen, Loop) ->
17 | T1 = now(),
18 | case catch mochiweb_socket:accept(Listen) of
19 | {ok, Socket} ->
20 | gen_server:cast(Server, {accepted, self(), timer:now_diff(now(), T1)}),
21 | call_loop(Loop, Socket);
22 | {error, closed} ->
23 | exit(normal);
24 | {error, timeout} ->
25 | exit(normal);
26 | {error, esslaccept} ->
27 | exit(normal);
28 | Other ->
29 | error_logger:error_report(
30 | [{application, mochiweb},
31 | "Accept failed error",
32 | lists:flatten(io_lib:format("~p", [Other]))]),
33 | exit({error, accept_failed})
34 | end.
35 |
36 | call_loop({M, F}, Socket) ->
37 | M:F(Socket);
38 | call_loop({M, F, A}, Socket) ->
39 | erlang:apply(M, F, [Socket | A]);
40 | call_loop(Loop, Socket) ->
41 | Loop(Socket).
42 |
43 | %%
44 | %% Tests
45 | %%
46 | -include_lib("eunit/include/eunit.hrl").
47 | -ifdef(TEST).
48 | -endif.
49 |
--------------------------------------------------------------------------------
/examples/https/server_key.pem:
--------------------------------------------------------------------------------
1 | -----BEGIN RSA PRIVATE KEY-----
2 | MIIEpAIBAAKCAQEAl5QI5nFua2eAXhLmVdySNIMtz7wL5eMwFgE/LLl4p0ljbQBD
3 | Wz3+GGne6UjykC+X7FWjjBD6IFK87NzLbjxD5eLr7ONx4XtQ1GChg+C0mMqF3Bwd
4 | Xea8UWtL9+n2CCgAKFolBYM7U4J9SBNZciaGTD69wNHXU5UwAn+Hvd2rMk8j2Z+r
5 | jg9NMd9i2Cu/gsBAA6WFcgBrYH5ro+UXqyoOolpbmMtNwRGOwHCdGFQaLsl69DOR
6 | 6O6Nf+90D42NEGMof8otTmHdDvBRyG8h7PQ9dZVMKdmOkD1pHibthXTmcpB/G0Z3
7 | vVzNgNiT6PyF3TTmN61PiKvsmQBZVqUHJslWSwIDAQABAoIBACI8Ky5xHDFh9RpK
8 | Rn/KC7OUlTpADKflgizWJ0Cgu2F9L9mkn5HyFHvLHa+u7CootbWJOiEejH/UcBtH
9 | WyMQtX0snYCpdkUpJv5wvMoebGu+AjHOn8tfm9T/2O6rhwgckLyMb6QpGbMo28b1
10 | p9QiY17BJPZx7qJQJcHKsAvwDwSThlb7MFmWf42LYWlzybpeYQvwpd+UY4I0WXLu
11 | /dqJIS9Npq+5Y5vbo2kAEAssb2hSCvhCfHmwFdKmBzlvgOn4qxgZ1iHQgfKI6Z3Y
12 | J0573ZgOVTuacn+lewtdg5AaHFcl/zIYEr9SNqRoPNGbPliuv6k6N2EYcufWL5lR
13 | sCmmmHECgYEAxm+7OpepGr++K3+O1e1MUhD7vSPkKJrCzNtUxbOi2NWj3FFUSPRU
14 | adWhuxvUnZgTcgM1+KuQ0fB2VmxXe9IDcrSFS7PKFGtd2kMs/5mBw4UgDZkOQh+q
15 | kDiBEV3HYYJWRq0w3NQ/9Iy1jxxdENHtGmG9aqamHxNtuO608wGW2S8CgYEAw4yG
16 | ZyAic0Q/U9V2OHI0MLxLCzuQz17C2wRT1+hBywNZuil5YeTuIt2I46jro6mJmWI2
17 | fH4S/geSZzg2RNOIZ28+aK79ab2jWBmMnvFCvaru+odAuser4N9pfAlHZvY0pT+S
18 | 1zYX3f44ygiio+oosabLC5nWI0zB2gG8pwaJlaUCgYEAgr7poRB+ZlaCCY0RYtjo
19 | mYYBKD02vp5BzdKSB3V1zeLuBWM84pjB6b3Nw0fyDig+X7fH3uHEGN+USRs3hSj6
20 | BqD01s1OT6fyfbYXNw5A1r+nP+5h26Wbr0zblcKxdQj4qbbBZC8hOJNhqTqqA0Qe
21 | MmzF7jiBaiZV/Cyj4x1f9BcCgYEAhjL6SeuTuOctTqs/5pz5lDikh6DpUGcH8qaV
22 | o6aRAHHcMhYkZzpk8yh1uUdD7516APmVyvn6rrsjjhLVq4ZAJjwB6HWvE9JBN0TR
23 | bILF+sREHUqU8Zn2Ku0nxyfXCKIOnxlx/J/y4TaGYqBqfXNFWiXNUrjQbIlQv/xR
24 | K48g/MECgYBZdQlYbMSDmfPCC5cxkdjrkmAl0EgV051PWAi4wR+hLxIMRjHBvAk7
25 | IweobkFvT4TICulgroLkYcSa5eOZGxB/DHqcQCbWj3reFV0VpzmTDoFKG54sqBRl
26 | vVntGt0pfA40fF17VoS7riAdHF53ippTtsovHEsg5tq5NrBl5uKm2g==
27 | -----END RSA PRIVATE KEY-----
28 |
--------------------------------------------------------------------------------
/support/test-materials/test_ssl_key.pem:
--------------------------------------------------------------------------------
1 | -----BEGIN RSA PRIVATE KEY-----
2 | MIIEpAIBAAKCAQEAl5QI5nFua2eAXhLmVdySNIMtz7wL5eMwFgE/LLl4p0ljbQBD
3 | Wz3+GGne6UjykC+X7FWjjBD6IFK87NzLbjxD5eLr7ONx4XtQ1GChg+C0mMqF3Bwd
4 | Xea8UWtL9+n2CCgAKFolBYM7U4J9SBNZciaGTD69wNHXU5UwAn+Hvd2rMk8j2Z+r
5 | jg9NMd9i2Cu/gsBAA6WFcgBrYH5ro+UXqyoOolpbmMtNwRGOwHCdGFQaLsl69DOR
6 | 6O6Nf+90D42NEGMof8otTmHdDvBRyG8h7PQ9dZVMKdmOkD1pHibthXTmcpB/G0Z3
7 | vVzNgNiT6PyF3TTmN61PiKvsmQBZVqUHJslWSwIDAQABAoIBACI8Ky5xHDFh9RpK
8 | Rn/KC7OUlTpADKflgizWJ0Cgu2F9L9mkn5HyFHvLHa+u7CootbWJOiEejH/UcBtH
9 | WyMQtX0snYCpdkUpJv5wvMoebGu+AjHOn8tfm9T/2O6rhwgckLyMb6QpGbMo28b1
10 | p9QiY17BJPZx7qJQJcHKsAvwDwSThlb7MFmWf42LYWlzybpeYQvwpd+UY4I0WXLu
11 | /dqJIS9Npq+5Y5vbo2kAEAssb2hSCvhCfHmwFdKmBzlvgOn4qxgZ1iHQgfKI6Z3Y
12 | J0573ZgOVTuacn+lewtdg5AaHFcl/zIYEr9SNqRoPNGbPliuv6k6N2EYcufWL5lR
13 | sCmmmHECgYEAxm+7OpepGr++K3+O1e1MUhD7vSPkKJrCzNtUxbOi2NWj3FFUSPRU
14 | adWhuxvUnZgTcgM1+KuQ0fB2VmxXe9IDcrSFS7PKFGtd2kMs/5mBw4UgDZkOQh+q
15 | kDiBEV3HYYJWRq0w3NQ/9Iy1jxxdENHtGmG9aqamHxNtuO608wGW2S8CgYEAw4yG
16 | ZyAic0Q/U9V2OHI0MLxLCzuQz17C2wRT1+hBywNZuil5YeTuIt2I46jro6mJmWI2
17 | fH4S/geSZzg2RNOIZ28+aK79ab2jWBmMnvFCvaru+odAuser4N9pfAlHZvY0pT+S
18 | 1zYX3f44ygiio+oosabLC5nWI0zB2gG8pwaJlaUCgYEAgr7poRB+ZlaCCY0RYtjo
19 | mYYBKD02vp5BzdKSB3V1zeLuBWM84pjB6b3Nw0fyDig+X7fH3uHEGN+USRs3hSj6
20 | BqD01s1OT6fyfbYXNw5A1r+nP+5h26Wbr0zblcKxdQj4qbbBZC8hOJNhqTqqA0Qe
21 | MmzF7jiBaiZV/Cyj4x1f9BcCgYEAhjL6SeuTuOctTqs/5pz5lDikh6DpUGcH8qaV
22 | o6aRAHHcMhYkZzpk8yh1uUdD7516APmVyvn6rrsjjhLVq4ZAJjwB6HWvE9JBN0TR
23 | bILF+sREHUqU8Zn2Ku0nxyfXCKIOnxlx/J/y4TaGYqBqfXNFWiXNUrjQbIlQv/xR
24 | K48g/MECgYBZdQlYbMSDmfPCC5cxkdjrkmAl0EgV051PWAi4wR+hLxIMRjHBvAk7
25 | IweobkFvT4TICulgroLkYcSa5eOZGxB/DHqcQCbWj3reFV0VpzmTDoFKG54sqBRl
26 | vVntGt0pfA40fF17VoS7riAdHF53ippTtsovHEsg5tq5NrBl5uKm2g==
27 | -----END RSA PRIVATE KEY-----
28 |
--------------------------------------------------------------------------------
/priv/skel/src/skel_sup.erl:
--------------------------------------------------------------------------------
1 | %% @author author
2 | %% @copyright YYYY author.
3 |
4 | %% @doc Supervisor for the skel application.
5 |
6 | -module(skel_sup).
7 | -author('author ').
8 |
9 | -behaviour(supervisor).
10 |
11 | %% External exports
12 | -export([start_link/0, upgrade/0]).
13 |
14 | %% supervisor callbacks
15 | -export([init/1]).
16 |
17 | %% @spec start_link() -> ServerRet
18 | %% @doc API for starting the supervisor.
19 | start_link() ->
20 | supervisor:start_link({local, ?MODULE}, ?MODULE, []).
21 |
22 | %% @spec upgrade() -> ok
23 | %% @doc Add processes if necessary.
24 | upgrade() ->
25 | {ok, {_, Specs}} = init([]),
26 |
27 | Old = sets:from_list(
28 | [Name || {Name, _, _, _} <- supervisor:which_children(?MODULE)]),
29 | New = sets:from_list([Name || {Name, _, _, _, _, _} <- Specs]),
30 | Kill = sets:subtract(Old, New),
31 |
32 | sets:fold(fun (Id, ok) ->
33 | supervisor:terminate_child(?MODULE, Id),
34 | supervisor:delete_child(?MODULE, Id),
35 | ok
36 | end, ok, Kill),
37 |
38 | [supervisor:start_child(?MODULE, Spec) || Spec <- Specs],
39 | ok.
40 |
41 | %% @spec init([]) -> SupervisorTree
42 | %% @doc supervisor callback.
43 | init([]) ->
44 | Ip = case os:getenv("MOCHIWEB_IP") of false -> "0.0.0.0"; Any -> Any end,
45 | WebConfig = [
46 | {ip, Ip},
47 | {port, 8000},
48 | {docroot, skel_deps:local_path(["priv", "www"])}],
49 | Web = {skel_web,
50 | {skel_web, start, [WebConfig]},
51 | permanent, 5000, worker, dynamic},
52 |
53 | Processes = [Web],
54 | {ok, {{one_for_one, 10, 10}, Processes}}.
55 |
56 |
57 | %%
58 | %% Tests
59 | %%
60 | -include_lib("eunit/include/eunit.hrl").
61 | -ifdef(TEST).
62 | -endif.
63 |
--------------------------------------------------------------------------------
/src/mochiweb_response.erl:
--------------------------------------------------------------------------------
1 | %% @author Bob Ippolito
2 | %% @copyright 2007 Mochi Media, Inc.
3 |
4 | %% @doc Response abstraction.
5 |
6 | -module(mochiweb_response, [Request, Code, Headers]).
7 | -author('bob@mochimedia.com').
8 |
9 | -define(QUIP, "Any of you quaids got a smint?").
10 |
11 | -export([get_header_value/1, get/1, dump/0]).
12 | -export([send/1, write_chunk/1]).
13 |
14 | %% @spec get_header_value(string() | atom() | binary()) -> string() | undefined
15 | %% @doc Get the value of the given response header.
16 | get_header_value(K) ->
17 | mochiweb_headers:get_value(K, Headers).
18 |
19 | %% @spec get(request | code | headers) -> term()
20 | %% @doc Return the internal representation of the given field.
21 | get(request) ->
22 | Request;
23 | get(code) ->
24 | Code;
25 | get(headers) ->
26 | Headers.
27 |
28 | %% @spec dump() -> {mochiweb_request, [{atom(), term()}]}
29 | %% @doc Dump the internal representation to a "human readable" set of terms
30 | %% for debugging/inspection purposes.
31 | dump() ->
32 | [{request, Request:dump()},
33 | {code, Code},
34 | {headers, mochiweb_headers:to_list(Headers)}].
35 |
36 | %% @spec send(iodata()) -> ok
37 | %% @doc Send data over the socket if the method is not HEAD.
38 | send(Data) ->
39 | case Request:get(method) of
40 | 'HEAD' ->
41 | ok;
42 | _ ->
43 | Request:send(Data)
44 | end.
45 |
46 | %% @spec write_chunk(iodata()) -> ok
47 | %% @doc Write a chunk of a HTTP chunked response. If Data is zero length,
48 | %% then the chunked response will be finished.
49 | write_chunk(Data) ->
50 | case Request:get(version) of
51 | Version when Version >= {1, 1} ->
52 | Length = iolist_size(Data),
53 | send([io_lib:format("~.16b\r\n", [Length]), Data, <<"\r\n">>]);
54 | _ ->
55 | send(Data)
56 | end.
57 |
58 |
59 | %%
60 | %% Tests
61 | %%
62 | -include_lib("eunit/include/eunit.hrl").
63 | -ifdef(TEST).
64 | -endif.
65 |
--------------------------------------------------------------------------------
/src/mochiweb_cover.erl:
--------------------------------------------------------------------------------
1 | %% @author Bob Ippolito
2 | %% @copyright 2010 Mochi Media, Inc.
3 |
4 | %% @doc Workarounds for various cover deficiencies.
5 | -module(mochiweb_cover).
6 | -export([get_beam/1, get_abstract_code/1,
7 | get_clauses/2, clause_lookup_table/1]).
8 | -export([clause_lookup_table/2]).
9 |
10 | %% Internal
11 |
12 | get_beam(Module) ->
13 | {Module, Beam, _Path} = code:get_object_code(Module),
14 | Beam.
15 |
16 | get_abstract_code(Beam) ->
17 | {ok, {_Module,
18 | [{abstract_code,
19 | {raw_abstract_v1, L}}]}} = beam_lib:chunks(Beam, [abstract_code]),
20 | L.
21 |
22 | get_clauses(Function, Code) ->
23 | [L] = [Clauses || {function, _, FName, _, Clauses}
24 | <- Code, FName =:= Function],
25 | L.
26 |
27 | clause_lookup_table(Module, Function) ->
28 | clause_lookup_table(
29 | get_clauses(Function,
30 | get_abstract_code(get_beam(Module)))).
31 |
32 | clause_lookup_table(Clauses) ->
33 | lists:foldr(fun clause_fold/2, [], Clauses).
34 |
35 | clause_fold({clause, _,
36 | [InTerm],
37 | _Guards=[],
38 | [OutTerm]},
39 | Acc) ->
40 | try [{erl_parse:normalise(InTerm), erl_parse:normalise(OutTerm)} | Acc]
41 | catch error:_ -> Acc
42 | end;
43 | clause_fold(_, Acc) ->
44 | Acc.
45 |
46 | %%
47 | %% Tests
48 | %%
49 | -include_lib("eunit/include/eunit.hrl").
50 | -ifdef(TEST).
51 | foo_table(a) -> b;
52 | foo_table("a") -> <<"b">>;
53 | foo_table(123) -> {4, 3, 2};
54 | foo_table([list]) -> [];
55 | foo_table([list1, list2]) -> [list1, list2, list3];
56 | foo_table(ignored) -> some, code, ignored;
57 | foo_table(Var) -> Var.
58 |
59 | foo_table_test() ->
60 | T = clause_lookup_table(?MODULE, foo_table),
61 | [?assertEqual(V, foo_table(K)) || {K, V} <- T].
62 |
63 | clause_lookup_table_test() ->
64 | ?assertEqual(b, foo_table(a)),
65 | ?assertEqual(ignored, foo_table(ignored)),
66 | ?assertEqual('Var', foo_table('Var')),
67 | ?assertEqual(
68 | [{a, b},
69 | {"a", <<"b">>},
70 | {123, {4, 3, 2}},
71 | {[list], []},
72 | {[list1, list2], [list1, list2, list3]}],
73 | clause_lookup_table(?MODULE, foo_table)).
74 |
75 | -endif.
76 |
--------------------------------------------------------------------------------
/src/mochiweb_socket.erl:
--------------------------------------------------------------------------------
1 | %% @copyright 2010 Mochi Media, Inc.
2 |
3 | %% @doc MochiWeb socket - wrapper for plain and ssl sockets.
4 |
5 | -module(mochiweb_socket).
6 |
7 | -export([listen/4, accept/1, recv/3, send/2, close/1, port/1, peername/1,
8 | setopts/2, type/1]).
9 |
10 | -define(ACCEPT_TIMEOUT, 2000).
11 |
12 | listen(Ssl, Port, Opts, SslOpts) ->
13 | case Ssl of
14 | true ->
15 | case ssl:listen(Port, Opts ++ SslOpts) of
16 | {ok, ListenSocket} ->
17 | {ok, {ssl, ListenSocket}};
18 | {error, _} = Err ->
19 | Err
20 | end;
21 | false ->
22 | gen_tcp:listen(Port, Opts)
23 | end.
24 |
25 | accept({ssl, ListenSocket}) ->
26 | % There's a bug in ssl:transport_accept/2 at the moment, which is the
27 | % reason for the try...catch block. Should be fixed in OTP R14.
28 | try ssl:transport_accept(ListenSocket) of
29 | {ok, Socket} ->
30 | case ssl:ssl_accept(Socket) of
31 | ok ->
32 | {ok, {ssl, Socket}};
33 | {error, _} = Err ->
34 | Err
35 | end;
36 | {error, _} = Err ->
37 | Err
38 | catch
39 | error:{badmatch, {error, Reason}} ->
40 | {error, Reason}
41 | end;
42 | accept(ListenSocket) ->
43 | gen_tcp:accept(ListenSocket, ?ACCEPT_TIMEOUT).
44 |
45 | recv({ssl, Socket}, Length, Timeout) ->
46 | ssl:recv(Socket, Length, Timeout);
47 | recv(Socket, Length, Timeout) ->
48 | gen_tcp:recv(Socket, Length, Timeout).
49 |
50 | send({ssl, Socket}, Data) ->
51 | ssl:send(Socket, Data);
52 | send(Socket, Data) ->
53 | gen_tcp:send(Socket, Data).
54 |
55 | close({ssl, Socket}) ->
56 | ssl:close(Socket);
57 | close(Socket) ->
58 | gen_tcp:close(Socket).
59 |
60 | port({ssl, Socket}) ->
61 | case ssl:sockname(Socket) of
62 | {ok, {_, Port}} ->
63 | {ok, Port};
64 | {error, _} = Err ->
65 | Err
66 | end;
67 | port(Socket) ->
68 | inet:port(Socket).
69 |
70 | peername({ssl, Socket}) ->
71 | ssl:peername(Socket);
72 | peername(Socket) ->
73 | inet:peername(Socket).
74 |
75 | setopts({ssl, Socket}, Opts) ->
76 | ssl:setopts(Socket, Opts);
77 | setopts(Socket, Opts) ->
78 | inet:setopts(Socket, Opts).
79 |
80 | type({ssl, _}) ->
81 | ssl;
82 | type(_) ->
83 | plain.
84 |
85 |
--------------------------------------------------------------------------------
/src/mochihex.erl:
--------------------------------------------------------------------------------
1 | %% @author Bob Ippolito
2 | %% @copyright 2006 Mochi Media, Inc.
3 |
4 | %% @doc Utilities for working with hexadecimal strings.
5 |
6 | -module(mochihex).
7 | -author('bob@mochimedia.com').
8 |
9 | -export([to_hex/1, to_bin/1, to_int/1, dehex/1, hexdigit/1]).
10 |
11 | %% @type iolist() = [char() | binary() | iolist()]
12 | %% @type iodata() = iolist() | binary()
13 |
14 | %% @spec to_hex(integer | iolist()) -> string()
15 | %% @doc Convert an iolist to a hexadecimal string.
16 | to_hex(0) ->
17 | "0";
18 | to_hex(I) when is_integer(I), I > 0 ->
19 | to_hex_int(I, []);
20 | to_hex(B) ->
21 | to_hex(iolist_to_binary(B), []).
22 |
23 | %% @spec to_bin(string()) -> binary()
24 | %% @doc Convert a hexadecimal string to a binary.
25 | to_bin(L) ->
26 | to_bin(L, []).
27 |
28 | %% @spec to_int(string()) -> integer()
29 | %% @doc Convert a hexadecimal string to an integer.
30 | to_int(L) ->
31 | erlang:list_to_integer(L, 16).
32 |
33 | %% @spec dehex(char()) -> integer()
34 | %% @doc Convert a hex digit to its integer value.
35 | dehex(C) when C >= $0, C =< $9 ->
36 | C - $0;
37 | dehex(C) when C >= $a, C =< $f ->
38 | C - $a + 10;
39 | dehex(C) when C >= $A, C =< $F ->
40 | C - $A + 10.
41 |
42 | %% @spec hexdigit(integer()) -> char()
43 | %% @doc Convert an integer less than 16 to a hex digit.
44 | hexdigit(C) when C >= 0, C =< 9 ->
45 | C + $0;
46 | hexdigit(C) when C =< 15 ->
47 | C + $a - 10.
48 |
49 | %% Internal API
50 |
51 | to_hex(<<>>, Acc) ->
52 | lists:reverse(Acc);
53 | to_hex(<>, Acc) ->
54 | to_hex(Rest, [hexdigit(C2), hexdigit(C1) | Acc]).
55 |
56 | to_hex_int(0, Acc) ->
57 | Acc;
58 | to_hex_int(I, Acc) ->
59 | to_hex_int(I bsr 4, [hexdigit(I band 15) | Acc]).
60 |
61 | to_bin([], Acc) ->
62 | iolist_to_binary(lists:reverse(Acc));
63 | to_bin([C1, C2 | Rest], Acc) ->
64 | to_bin(Rest, [(dehex(C1) bsl 4) bor dehex(C2) | Acc]).
65 |
66 |
67 |
68 | %%
69 | %% Tests
70 | %%
71 | -include_lib("eunit/include/eunit.hrl").
72 | -ifdef(TEST).
73 |
74 | to_hex_test() ->
75 | "ff000ff1" = to_hex([255, 0, 15, 241]),
76 | "ff000ff1" = to_hex(16#ff000ff1),
77 | "0" = to_hex(16#0),
78 | ok.
79 |
80 | to_bin_test() ->
81 | <<255, 0, 15, 241>> = to_bin("ff000ff1"),
82 | <<255, 0, 10, 161>> = to_bin("Ff000aA1"),
83 | ok.
84 |
85 | to_int_test() ->
86 | 16#ff000ff1 = to_int("ff000ff1"),
87 | 16#ff000aa1 = to_int("FF000Aa1"),
88 | 16#0 = to_int("0"),
89 | ok.
90 |
91 | -endif.
92 |
--------------------------------------------------------------------------------
/src/mochiweb_mime.erl:
--------------------------------------------------------------------------------
1 | %% @author Bob Ippolito
2 | %% @copyright 2007 Mochi Media, Inc.
3 |
4 | %% @doc Gives a good MIME type guess based on file extension.
5 |
6 | -module(mochiweb_mime).
7 | -author('bob@mochimedia.com').
8 | -export([from_extension/1]).
9 |
10 | %% @spec from_extension(S::string()) -> string() | undefined
11 | %% @doc Given a filename extension (e.g. ".html") return a guess for the MIME
12 | %% type such as "text/html". Will return the atom undefined if no good
13 | %% guess is available.
14 | from_extension(".html") ->
15 | "text/html";
16 | from_extension(".xhtml") ->
17 | "application/xhtml+xml";
18 | from_extension(".xml") ->
19 | "application/xml";
20 | from_extension(".css") ->
21 | "text/css";
22 | from_extension(".js") ->
23 | "application/x-javascript";
24 | from_extension(".jpg") ->
25 | "image/jpeg";
26 | from_extension(".gif") ->
27 | "image/gif";
28 | from_extension(".png") ->
29 | "image/png";
30 | from_extension(".swf") ->
31 | "application/x-shockwave-flash";
32 | from_extension(".zip") ->
33 | "application/zip";
34 | from_extension(".bz2") ->
35 | "application/x-bzip2";
36 | from_extension(".gz") ->
37 | "application/x-gzip";
38 | from_extension(".tar") ->
39 | "application/x-tar";
40 | from_extension(".tgz") ->
41 | "application/x-gzip";
42 | from_extension(".txt") ->
43 | "text/plain";
44 | from_extension(".doc") ->
45 | "application/msword";
46 | from_extension(".pdf") ->
47 | "application/pdf";
48 | from_extension(".xls") ->
49 | "application/vnd.ms-excel";
50 | from_extension(".rtf") ->
51 | "application/rtf";
52 | from_extension(".mov") ->
53 | "video/quicktime";
54 | from_extension(".mp3") ->
55 | "audio/mpeg";
56 | from_extension(".z") ->
57 | "application/x-compress";
58 | from_extension(".wav") ->
59 | "audio/x-wav";
60 | from_extension(".ico") ->
61 | "image/x-icon";
62 | from_extension(".bmp") ->
63 | "image/bmp";
64 | from_extension(".m4a") ->
65 | "audio/mpeg";
66 | from_extension(".m3u") ->
67 | "audio/x-mpegurl";
68 | from_extension(".exe") ->
69 | "application/octet-stream";
70 | from_extension(".csv") ->
71 | "text/csv";
72 | from_extension(_) ->
73 | undefined.
74 |
75 | %%
76 | %% Tests
77 | %%
78 | -include_lib("eunit/include/eunit.hrl").
79 | -ifdef(TEST).
80 |
81 | exhaustive_from_extension_test() ->
82 | T = mochiweb_cover:clause_lookup_table(?MODULE, from_extension),
83 | [?assertEqual(V, from_extension(K)) || {K, V} <- T].
84 |
85 | from_extension_test() ->
86 | ?assertEqual("text/html",
87 | from_extension(".html")),
88 | ?assertEqual(undefined,
89 | from_extension("")),
90 | ?assertEqual(undefined,
91 | from_extension(".wtf")),
92 | ok.
93 |
94 | -endif.
95 |
--------------------------------------------------------------------------------
/support/make_app.escript:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env escript
2 | %% -*- erlang -*-
3 |
4 | main(Args) ->
5 | [AppSrc,AppF,Vsn,Modules] = Args,
6 | {Comments, L, App} = parse_appsrc(AppSrc),
7 | {application, A, Attrs} = App,
8 | Attrs1 = [vsn(Vsn, Attrs),
9 | descr(Attrs),
10 | {modules, lists:sort([list_to_atom(M) || M <- string:tokens(Modules," ")])} |
11 | [Attr || {K,_} = Attr <- Attrs,
12 | not lists:member(K, [vsn, modules, description])]],
13 | write_app(AppF, Comments, L, {application, A, Attrs1}).
14 |
15 | write_app(F, Comments, TermL, App) ->
16 | case file:open(F, [write]) of
17 | {ok, Fd} ->
18 | try L = write_comments(Comments, Fd),
19 | write_term(App, L, TermL, Fd)
20 | after
21 | file:close(Fd)
22 | end;
23 | Error ->
24 | error(Error)
25 | end.
26 |
27 | parse_appsrc(F) ->
28 | case file:read_file(F) of
29 | {ok, B} ->
30 | case erl_scan:string(binary_to_list(B), 1, [return_comments]) of
31 | {ok, Toks, _} ->
32 | Comments = lists:takewhile(
33 | fun({comment,_,_}) -> true;
34 | (_) -> false
35 | end, Toks),
36 | TermToks = [T || T <- Toks, element(1,T) =/= comment],
37 | TermL = element(2, hd(TermToks)),
38 | case erl_parse:parse_term(TermToks) of
39 | {ok, {application, _A, _Attrs} = App} ->
40 | {Comments, TermL, App};
41 | Error ->
42 | error(Error)
43 | end;
44 | ScanErr ->
45 | error(ScanErr)
46 | end;
47 | ReadErr ->
48 | error(ReadErr)
49 | end.
50 |
51 | write_comments(Comments, Fd) ->
52 | lists:foldl(
53 | fun({comment, L, C}, L0) ->
54 | S = ["\n" || _ <- lists:seq(1,L-L0)] ++ C,
55 | io:put_chars(Fd, S),
56 | L
57 | end, 1, Comments).
58 |
59 | write_term(T, L0, TermL, Fd) ->
60 | case ["\n" || _ <- lists:seq(1,TermL-L0)] of
61 | [] -> ok;
62 | S -> io:put_chars(Fd, S)
63 | end,
64 | io:fwrite(Fd, "~p.~n", [T]).
65 |
66 | vsn(Vsn, Attrs) when Vsn =:= '' orelse Vsn =:= "" ->
67 | case lists:keyfind(vsn, 1, Attrs) of
68 | false ->
69 | {vsn, "0.00"};
70 | V ->
71 | V
72 | end;
73 | vsn(Vsn, _Attrs) ->
74 | {vsn, Vsn}.
75 |
76 | descr(Attrs) ->
77 | case lists:keyfind(description, 1, Attrs) of
78 | false ->
79 | {description, "auto_generated .app file"};
80 | D ->
81 | D
82 | end.
83 |
84 | error(E) ->
85 | io:fwrite("*** ~p~n", [E]),
86 | halt(1).
87 |
--------------------------------------------------------------------------------
/src/mochiweb_skel.erl:
--------------------------------------------------------------------------------
1 | -module(mochiweb_skel).
2 | -export([skelcopy/2]).
3 |
4 | -include_lib("kernel/include/file.hrl").
5 |
6 | %% External API
7 |
8 | skelcopy(DestDir, Name) ->
9 | ok = ensuredir(DestDir),
10 | LDst = case length(filename:dirname(DestDir)) of
11 | 1 -> %% handle case when dirname returns "/"
12 | 0;
13 | N ->
14 | N + 1
15 | end,
16 | skelcopy(src(), DestDir, Name, LDst),
17 | DestLink = filename:join([DestDir, Name, "deps", "mochiweb-src"]),
18 | ok = filelib:ensure_dir(DestLink),
19 | ok = file:make_symlink(
20 | filename:join(filename:dirname(code:which(?MODULE)), ".."),
21 | DestLink).
22 |
23 | %% Internal API
24 |
25 | src() ->
26 | Dir = filename:dirname(code:which(?MODULE)),
27 | filename:join(Dir, "../priv/skel").
28 |
29 | skel() ->
30 | "skel".
31 |
32 | skelcopy(Src, DestDir, Name, LDst) ->
33 | Dest = re:replace(filename:basename(Src), skel(), Name,
34 | [global, {return, list}]),
35 | case file:read_file_info(Src) of
36 | {ok, #file_info{type=directory, mode=Mode}} ->
37 | Dir = DestDir ++ "/" ++ Dest,
38 | EDst = lists:nthtail(LDst, Dir),
39 | ok = ensuredir(Dir),
40 | ok = file:write_file_info(Dir, #file_info{mode=Mode}),
41 | case filename:basename(Src) of
42 | "ebin" ->
43 | ok;
44 | _ ->
45 | {ok, Files} = file:list_dir(Src),
46 | io:format("~s/~n", [EDst]),
47 | lists:foreach(fun ("." ++ _) -> ok;
48 | (F) ->
49 | skelcopy(filename:join(Src, F),
50 | Dir,
51 | Name,
52 | LDst)
53 | end,
54 | Files),
55 | ok
56 | end;
57 | {ok, #file_info{type=regular, mode=Mode}} ->
58 | OutFile = filename:join(DestDir, Dest),
59 | {ok, B} = file:read_file(Src),
60 | S = re:replace(binary_to_list(B), skel(), Name,
61 | [{return, list}, global]),
62 | ok = file:write_file(OutFile, list_to_binary(S)),
63 | ok = file:write_file_info(OutFile, #file_info{mode=Mode}),
64 | io:format(" ~s~n", [filename:basename(Src)]),
65 | ok;
66 | {ok, _} ->
67 | io:format("ignored source file: ~p~n", [Src]),
68 | ok
69 | end.
70 |
71 | ensuredir(Dir) ->
72 | case file:make_dir(Dir) of
73 | ok ->
74 | ok;
75 | {error, eexist} ->
76 | ok;
77 | E ->
78 | E
79 | end.
80 |
81 | %%
82 | %% Tests
83 | %%
84 | -include_lib("eunit/include/eunit.hrl").
85 | -ifdef(TEST).
86 | -endif.
87 |
--------------------------------------------------------------------------------
/src/mochilists.erl:
--------------------------------------------------------------------------------
1 | %% @copyright Copyright (c) 2010 Mochi Media, Inc.
2 | %% @author David Reid
3 |
4 | %% @doc Utility functions for dealing with proplists.
5 |
6 | -module(mochilists).
7 | -author("David Reid ").
8 | -export([get_value/2, get_value/3, is_defined/2, set_default/2, set_defaults/2]).
9 |
10 | %% @spec set_default({Key::term(), Value::term()}, Proplist::list()) -> list()
11 | %%
12 | %% @doc Return new Proplist with {Key, Value} set if not is_defined(Key, Proplist).
13 | set_default({Key, Value}, Proplist) ->
14 | case is_defined(Key, Proplist) of
15 | true ->
16 | Proplist;
17 | false ->
18 | [{Key, Value} | Proplist]
19 | end.
20 |
21 | %% @spec set_defaults([{Key::term(), Value::term()}], Proplist::list()) -> list()
22 | %%
23 | %% @doc Return new Proplist with {Key, Value} set if not is_defined(Key, Proplist).
24 | set_defaults(DefaultProps, Proplist) ->
25 | lists:foldl(fun set_default/2, Proplist, DefaultProps).
26 |
27 |
28 | %% @spec is_defined(Key::term(), Proplist::list()) -> bool()
29 | %%
30 | %% @doc Returns true if Propist contains at least one entry associated
31 | %% with Key, otherwise false is returned.
32 | is_defined(Key, Proplist) ->
33 | lists:keyfind(Key, 1, Proplist) =/= false.
34 |
35 |
36 | %% @spec get_value(Key::term(), Proplist::list()) -> term() | undefined
37 | %%
38 | %% @doc Return the value of Key or undefined
39 | get_value(Key, Proplist) ->
40 | get_value(Key, Proplist, undefined).
41 |
42 | %% @spec get_value(Key::term(), Proplist::list(), Default::term()) -> term()
43 | %%
44 | %% @doc Return the value of Key or Default
45 | get_value(_Key, [], Default) ->
46 | Default;
47 | get_value(Key, Proplist, Default) ->
48 | case lists:keyfind(Key, 1, Proplist) of
49 | false ->
50 | Default;
51 | {Key, Value} ->
52 | Value
53 | end.
54 |
55 | %%
56 | %% Tests
57 | %%
58 | -include_lib("eunit/include/eunit.hrl").
59 | -ifdef(TEST).
60 |
61 | set_defaults_test() ->
62 | ?assertEqual(
63 | [{k, v}],
64 | set_defaults([{k, v}], [])),
65 | ?assertEqual(
66 | [{k, v}],
67 | set_defaults([{k, vee}], [{k, v}])),
68 | ?assertEqual(
69 | lists:sort([{kay, vee}, {k, v}]),
70 | lists:sort(set_defaults([{k, vee}, {kay, vee}], [{k, v}]))),
71 | ok.
72 |
73 | set_default_test() ->
74 | ?assertEqual(
75 | [{k, v}],
76 | set_default({k, v}, [])),
77 | ?assertEqual(
78 | [{k, v}],
79 | set_default({k, vee}, [{k, v}])),
80 | ok.
81 |
82 | get_value_test() ->
83 | ?assertEqual(
84 | undefined,
85 | get_value(foo, [])),
86 | ?assertEqual(
87 | undefined,
88 | get_value(foo, [{bar, baz}])),
89 | ?assertEqual(
90 | bar,
91 | get_value(foo, [{foo, bar}])),
92 | ?assertEqual(
93 | default,
94 | get_value(foo, [], default)),
95 | ?assertEqual(
96 | default,
97 | get_value(foo, [{bar, baz}], default)),
98 | ?assertEqual(
99 | bar,
100 | get_value(foo, [{foo, bar}], default)),
101 | ok.
102 |
103 | -endif.
104 |
105 |
--------------------------------------------------------------------------------
/src/mochiglobal.erl:
--------------------------------------------------------------------------------
1 | %% @author Bob Ippolito
2 | %% @copyright 2010 Mochi Media, Inc.
3 | %% @doc Abuse module constant pools as a "read-only shared heap" (since erts 5.6)
4 | %% [1].
5 | -module(mochiglobal).
6 | -author("Bob Ippolito ").
7 | -export([get/1, get/2, put/2, delete/1]).
8 |
9 | -spec get(atom()) -> any() | undefined.
10 | %% @equiv get(K, undefined)
11 | get(K) ->
12 | get(K, undefined).
13 |
14 | -spec get(atom(), T) -> any() | T.
15 | %% @doc Get the term for K or return Default.
16 | get(K, Default) ->
17 | get(K, Default, key_to_module(K)).
18 |
19 | get(_K, Default, Mod) ->
20 | try Mod:term()
21 | catch error:undef ->
22 | Default
23 | end.
24 |
25 | -spec put(atom(), any()) -> ok.
26 | %% @doc Store term V at K, replaces an existing term if present.
27 | put(K, V) ->
28 | put(K, V, key_to_module(K)).
29 |
30 | put(_K, V, Mod) ->
31 | Bin = compile(Mod, V),
32 | code:purge(Mod),
33 | code:load_binary(Mod, atom_to_list(Mod) ++ ".erl", Bin),
34 | ok.
35 |
36 | -spec delete(atom()) -> boolean().
37 | %% @doc Delete term stored at K, no-op if non-existent.
38 | delete(K) ->
39 | delete(K, key_to_module(K)).
40 |
41 | delete(_K, Mod) ->
42 | code:purge(Mod),
43 | code:delete(Mod).
44 |
45 | -spec key_to_module(atom()) -> atom().
46 | key_to_module(K) ->
47 | list_to_atom("mochiglobal:" ++ atom_to_list(K)).
48 |
49 | -spec compile(atom(), any()) -> binary().
50 | compile(Module, T) ->
51 | {ok, Module, Bin} = compile:forms(forms(Module, T),
52 | [verbose, report_errors]),
53 | Bin.
54 |
55 | -spec forms(atom(), any()) -> [erl_syntax:syntaxTree()].
56 | forms(Module, T) ->
57 | [erl_syntax:revert(X) || X <- term_to_abstract(Module, term, T)].
58 |
59 | -spec term_to_abstract(atom(), atom(), any()) -> [erl_syntax:syntaxTree()].
60 | term_to_abstract(Module, Getter, T) ->
61 | [%% -module(Module).
62 | erl_syntax:attribute(
63 | erl_syntax:atom(module),
64 | [erl_syntax:atom(Module)]),
65 | %% -export([Getter/0]).
66 | erl_syntax:attribute(
67 | erl_syntax:atom(export),
68 | [erl_syntax:list(
69 | [erl_syntax:arity_qualifier(
70 | erl_syntax:atom(Getter),
71 | erl_syntax:integer(0))])]),
72 | %% Getter() -> T.
73 | erl_syntax:function(
74 | erl_syntax:atom(Getter),
75 | [erl_syntax:clause([], none, [erl_syntax:abstract(T)])])].
76 |
77 | %%
78 | %% Tests
79 | %%
80 | -include_lib("eunit/include/eunit.hrl").
81 | -ifdef(TEST).
82 | get_put_delete_test() ->
83 | K = '$$test$$mochiglobal',
84 | delete(K),
85 | ?assertEqual(
86 | bar,
87 | get(K, bar)),
88 | try
89 | ?MODULE:put(K, baz),
90 | ?assertEqual(
91 | baz,
92 | get(K, bar)),
93 | ?MODULE:put(K, wibble),
94 | ?assertEqual(
95 | wibble,
96 | ?MODULE:get(K))
97 | after
98 | delete(K)
99 | end,
100 | ?assertEqual(
101 | bar,
102 | get(K, bar)),
103 | ?assertEqual(
104 | undefined,
105 | ?MODULE:get(K)),
106 | ok.
107 | -endif.
108 |
--------------------------------------------------------------------------------
/priv/skel/src/skel_deps.erl:
--------------------------------------------------------------------------------
1 | %% @author author
2 | %% @copyright YYYY author.
3 |
4 | %% @doc Ensure that the relatively-installed dependencies are on the code
5 | %% loading path, and locate resources relative
6 | %% to this application's path.
7 |
8 | -module(skel_deps).
9 | -author('author ').
10 |
11 | -export([ensure/0, ensure/1]).
12 | -export([get_base_dir/0, get_base_dir/1]).
13 | -export([local_path/1, local_path/2]).
14 | -export([deps_on_path/0, new_siblings/1]).
15 |
16 | %% @spec deps_on_path() -> [ProjNameAndVers]
17 | %% @doc List of project dependencies on the path.
18 | deps_on_path() ->
19 | F = fun (X, Acc) ->
20 | ProjDir = filename:dirname(X),
21 | case {filename:basename(X),
22 | filename:basename(filename:dirname(ProjDir))} of
23 | {"ebin", "deps"} ->
24 | [filename:basename(ProjDir) | Acc];
25 | _ ->
26 | Acc
27 | end
28 | end,
29 | ordsets:from_list(lists:foldl(F, [], code:get_path())).
30 |
31 | %% @spec new_siblings(Module) -> [Dir]
32 | %% @doc Find new siblings paths relative to Module that aren't already on the
33 | %% code path.
34 | new_siblings(Module) ->
35 | Existing = deps_on_path(),
36 | SiblingEbin = filelib:wildcard(local_path(["deps", "*", "ebin"], Module)),
37 | Siblings = [filename:dirname(X) || X <- SiblingEbin,
38 | ordsets:is_element(
39 | filename:basename(filename:dirname(X)),
40 | Existing) =:= false],
41 | lists:filter(fun filelib:is_dir/1,
42 | lists:append([[filename:join([X, "ebin"]),
43 | filename:join([X, "include"])] ||
44 | X <- Siblings])).
45 |
46 |
47 | %% @spec ensure(Module) -> ok
48 | %% @doc Ensure that all ebin and include paths for dependencies
49 | %% of the application for Module are on the code path.
50 | ensure(Module) ->
51 | code:add_paths(new_siblings(Module)),
52 | code:clash(),
53 | ok.
54 |
55 | %% @spec ensure() -> ok
56 | %% @doc Ensure that the ebin and include paths for dependencies of
57 | %% this application are on the code path. Equivalent to
58 | %% ensure(?Module).
59 | ensure() ->
60 | ensure(?MODULE).
61 |
62 | %% @spec get_base_dir(Module) -> string()
63 | %% @doc Return the application directory for Module. It assumes Module is in
64 | %% a standard OTP layout application in the ebin or src directory.
65 | get_base_dir(Module) ->
66 | {file, Here} = code:is_loaded(Module),
67 | filename:dirname(filename:dirname(Here)).
68 |
69 | %% @spec get_base_dir() -> string()
70 | %% @doc Return the application directory for this application. Equivalent to
71 | %% get_base_dir(?MODULE).
72 | get_base_dir() ->
73 | get_base_dir(?MODULE).
74 |
75 | %% @spec local_path([string()], Module) -> string()
76 | %% @doc Return an application-relative directory from Module's application.
77 | local_path(Components, Module) ->
78 | filename:join([get_base_dir(Module) | Components]).
79 |
80 | %% @spec local_path(Components) -> string()
81 | %% @doc Return an application-relative directory for this application.
82 | %% Equivalent to local_path(Components, ?MODULE).
83 | local_path(Components) ->
84 | local_path(Components, ?MODULE).
85 |
86 |
87 | %%
88 | %% Tests
89 | %%
90 | -include_lib("eunit/include/eunit.hrl").
91 | -ifdef(TEST).
92 | -endif.
93 |
--------------------------------------------------------------------------------
/examples/keepalive/keepalive.erl:
--------------------------------------------------------------------------------
1 | -module(keepalive).
2 |
3 | %% your web app can push data to clients using a technique called comet long
4 | %% polling. browsers make a request and your server waits to send a
5 | %% response until data is available. see wikipedia for a better explanation:
6 | %% http://en.wikipedia.org/wiki/Comet_(programming)#Ajax_with_long_polling
7 | %%
8 | %% since the majority of your http handlers will be idle at any given moment,
9 | %% you might consider making them hibernate while they wait for more data from
10 | %% another process. however, since the execution stack is discarded when a
11 | %% process hibernates, the handler would usually terminate after your response
12 | %% code runs. this means http keep alives wouldn't work; the handler process
13 | %% would terminate after each response and close its socket rather than
14 | %% returning to the big @mochiweb_http@ loop and processing another request.
15 | %%
16 | %% however, if mochiweb exposes a continuation that encapsulates the return to
17 | %% the top of the big loop in @mochiweb_http@, we can call that after the
18 | %% response. if you do that then control flow returns to the proper place,
19 | %% and keep alives work like they would if you hadn't hibernated.
20 |
21 | -export([ start/1, loop/1
22 | ]).
23 |
24 | %% internal export (so hibernate can reach it)
25 | -export([ resume/3
26 | ]).
27 |
28 | -define(LOOP, {?MODULE, loop}).
29 |
30 | start(Options = [{port, _Port}]) ->
31 | mochiweb_http:start([{name, ?MODULE}, {loop, ?LOOP} | Options]).
32 |
33 | loop(Req) ->
34 | Path = Req:get(path),
35 | case string:tokens(Path, "/") of
36 | ["longpoll" | RestOfPath] ->
37 | %% the "reentry" is a continuation -- what @mochiweb_http@
38 | %% needs to do to start its loop back at the top
39 | Reentry = mochiweb_http:reentry(?LOOP),
40 |
41 | %% here we could send a message to some other process and hope
42 | %% to get an interesting message back after a while. for
43 | %% simplicity let's just send ourselves a message after a few
44 | %% seconds
45 | erlang:send_after(2000, self(), "honk honk"),
46 |
47 | %% since we expect to wait for a long time before getting a
48 | %% reply, let's hibernate. memory usage will be minimized, so
49 | %% we won't be wasting memory just sitting in a @receive@
50 | proc_lib:hibernate(?MODULE, resume, [Req, RestOfPath, Reentry]),
51 |
52 | %% we'll never reach this point, and this function @loop/1@
53 | %% won't ever return control to @mochiweb_http@. luckily
54 | %% @resume/3@ will take care of that.
55 | io:format("not gonna happen~n", []);
56 |
57 | _ ->
58 | ok(Req, io_lib:format("some other page: ~p", [Path]))
59 | end,
60 |
61 | io:format("restarting loop normally in ~p~n", [Path]),
62 | ok.
63 |
64 | %% this is the function that's called when a message arrives.
65 | resume(Req, RestOfPath, Reentry) ->
66 | receive
67 | Msg ->
68 | Text = io_lib:format("wake up message: ~p~nrest of path: ~p", [Msg, RestOfPath]),
69 | ok(Req, Text)
70 | end,
71 |
72 | %% if we didn't call @Reentry@ here then the function would finish and the
73 | %% process would exit. calling @Reentry@ takes care of returning control
74 | %% to @mochiweb_http@
75 | io:format("reentering loop via continuation in ~p~n", [Req:get(path)]),
76 | Reentry(Req).
77 |
78 | ok(Req, Response) ->
79 | Req:ok({_ContentType = "text/plain",
80 | _Headers = [],
81 | Response}).
82 |
--------------------------------------------------------------------------------
/support/run_tests.escript:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env escript
2 | %% -*- erlang -*-
3 | %%! -name mochiweb__test@127.0.0.1
4 | main([Ebin]) ->
5 | code:add_path(Ebin),
6 | code:add_paths(filelib:wildcard("../deps/*/ebin", Ebin)),
7 | code:add_paths(filelib:wildcard("../deps/*/deps/*/ebin", Ebin)),
8 |
9 | ModuleNames = [hd(string:tokens(M, "."))
10 | || "../src/" ++ M <- filelib:wildcard("../src/*.erl")],
11 |
12 | {ok, NonTestRe} = re:compile("_tests$"),
13 | Modules = [list_to_atom(M) ||
14 | M <- lists:filter(
15 | fun(M) ->
16 | nomatch == re:run(M, NonTestRe)
17 | end,
18 | ModuleNames)],
19 |
20 |
21 | crypto:start(),
22 | start_cover(Modules),
23 | eunit:test(Modules, [verbose,{report,{eunit_surefire,[{dir,"../_test"}]}}]),
24 | analyze_cover(Modules);
25 | main(_) ->
26 | io:format("usage: run_tests.escript EBIN_DIR~n"),
27 | halt(1).
28 |
29 | start_cover(Modules) ->
30 | {ok, _Cover} = cover:start(),
31 | io:format("Cover compiling...~n"),
32 | Compiled = [ M || {ok, M} <- [ cover:compile(
33 | M,
34 | [{i, "include"}
35 | ])
36 | || M <- Modules ] ],
37 | case length(Modules) == length(Compiled) of
38 | true -> ok;
39 | false ->
40 | io:format("Warning: the following modules were not"
41 | " cover-compiled:~n ~p~n", [Compiled])
42 | end.
43 |
44 | analyze_cover(Modules) ->
45 | io:format("Analyzing cover...~n"),
46 | CoverBase = filename:join(["..", "_test", "cover"]),
47 | ok = filelib:ensure_dir(filename:join([CoverBase, "fake"])),
48 | Coverages = lists:foldl(
49 | fun(M, Acc) ->
50 | [analyze_module(CoverBase, M)|Acc]
51 | end,
52 | [], Modules),
53 | IndexFilename = filename:join([CoverBase, "index.html"]),
54 | {ok, Index} = file:open(IndexFilename, [write]),
55 | {LineTotal, CoverTotal} =
56 | lists:foldl(fun({_,_,Lines,Covered}, {LineAcc, CovAcc}) ->
57 | {LineAcc+Lines, CovAcc+Covered}
58 | end, {0,0}, Coverages),
59 | file:write(Index,
60 | "Coverage\n"
61 | "Coverage
\n"),
62 | file:write(Index,
63 | io_lib:format("Total: ~.2f%
\n",
64 | [percentage(CoverTotal, LineTotal)])),
65 | [ file:write(Index,
66 | io_lib:format(
67 | "- ~p: ~.2f%
~n",
68 | [Filename, Module, percentage(Covered, Lines)]))
69 | || {Filename, Module, Lines, Covered} <- Coverages ],
70 | file:write(Index,"
"),
71 | file:close(Index),
72 | io:format("Cover analysis in ~s~n", [IndexFilename]).
73 |
74 | analyze_module(CoverBase, Module) ->
75 | {ok, Filename} =
76 | cover:analyze_to_file(
77 | Module,
78 | filename:join(CoverBase, atom_to_list(Module)++".COVER.html"),
79 | [html]),
80 | Lines = count_lines(Filename, "[[:digit:]]\.\.|"),
81 | Covered = count_lines(Filename, "[[:space:]]0\.\.|"),
82 | {filename:basename(Filename), Module, Lines, Lines-Covered}.
83 |
84 | count_lines(Filename, Pattern) ->
85 | {ok, [Lines],_} = io_lib:fread(
86 | "~d",
87 | os:cmd(io_lib:format("grep -e \"~s\" ~s | wc -l",
88 | [Pattern, Filename]))),
89 | Lines.
90 |
91 | percentage(_, 0) -> 1000.0;
92 | percentage(Part, Total) ->
93 | (Part/Total)*100.
94 |
95 |
--------------------------------------------------------------------------------
/priv/skel/support/run_tests.escript:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env escript
2 | %% -*- erlang -*-
3 | %%! -name mochiweb__test@127.0.0.1
4 | main([Ebin]) ->
5 | code:add_path(Ebin),
6 | code:add_paths(filelib:wildcard("../deps/*/ebin", Ebin)),
7 | code:add_paths(filelib:wildcard("../deps/*/deps/*/ebin", Ebin)),
8 |
9 | ModuleNames = [hd(string:tokens(M, "."))
10 | || "../src/" ++ M <- filelib:wildcard("../src/*.erl")],
11 |
12 | {ok, NonTestRe} = re:compile("_tests$"),
13 | Modules = [list_to_atom(M) ||
14 | M <- lists:filter(
15 | fun(M) ->
16 | nomatch == re:run(M, NonTestRe)
17 | end,
18 | ModuleNames)],
19 |
20 |
21 | crypto:start(),
22 | start_cover(Modules),
23 | eunit:test(Modules, [verbose,{report,{eunit_surefire,[{dir,"../_test"}]}}]),
24 | analyze_cover(Modules);
25 | main(_) ->
26 | io:format("usage: run_tests.escript EBIN_DIR~n"),
27 | halt(1).
28 |
29 | start_cover(Modules) ->
30 | {ok, _Cover} = cover:start(),
31 | io:format("Cover compiling...~n"),
32 | Compiled = [ M || {ok, M} <- [ cover:compile(
33 | M,
34 | [{i, "include"}
35 | ])
36 | || M <- Modules ] ],
37 | case length(Modules) == length(Compiled) of
38 | true -> ok;
39 | false ->
40 | io:format("Warning: the following modules were not"
41 | " cover-compiled:~n ~p~n", [Compiled])
42 | end.
43 |
44 | analyze_cover(Modules) ->
45 | io:format("Analyzing cover...~n"),
46 | CoverBase = filename:join(["..", "_test", "cover"]),
47 | ok = filelib:ensure_dir(filename:join([CoverBase, "fake"])),
48 | Coverages = lists:foldl(
49 | fun(M, Acc) ->
50 | [analyze_module(CoverBase, M)|Acc]
51 | end,
52 | [], Modules),
53 | IndexFilename = filename:join([CoverBase, "index.html"]),
54 | {ok, Index} = file:open(IndexFilename, [write]),
55 | {LineTotal, CoverTotal} =
56 | lists:foldl(fun({_,_,Lines,Covered}, {LineAcc, CovAcc}) ->
57 | {LineAcc+Lines, CovAcc+Covered}
58 | end, {0,0}, Coverages),
59 | file:write(Index,
60 | "Coverage\n"
61 | "Coverage
\n"),
62 | file:write(Index,
63 | io_lib:format("Total: ~.2f%
\n",
64 | [percentage(CoverTotal, LineTotal)])),
65 | [ file:write(Index,
66 | io_lib:format(
67 | "- ~p: ~.2f%
~n",
68 | [Filename, Module, percentage(Covered, Lines)]))
69 | || {Filename, Module, Lines, Covered} <- Coverages ],
70 | file:write(Index,"
"),
71 | file:close(Index),
72 | io:format("Cover analysis in ~s~n", [IndexFilename]).
73 |
74 | analyze_module(CoverBase, Module) ->
75 | {ok, Filename} =
76 | cover:analyze_to_file(
77 | Module,
78 | filename:join(CoverBase, atom_to_list(Module)++".COVER.html"),
79 | [html]),
80 | Lines = count_lines(Filename, "[[:digit:]]\.\.|"),
81 | Covered = count_lines(Filename, "[[:space:]]0\.\.|"),
82 | {filename:basename(Filename), Module, Lines, Lines-Covered}.
83 |
84 | count_lines(Filename, Pattern) ->
85 | {ok, [Lines],_} = io_lib:fread(
86 | "~d",
87 | os:cmd(io_lib:format("grep -e \"~s\" ~s | wc -l",
88 | [Pattern, Filename]))),
89 | Lines.
90 |
91 | percentage(_, 0) -> 1000.0;
92 | percentage(Part, Total) ->
93 | (Part/Total)*100.
94 |
95 |
--------------------------------------------------------------------------------
/src/mochilogfile2.erl:
--------------------------------------------------------------------------------
1 | %% @author Bob Ippolito
2 | %% @copyright 2010 Mochi Media, Inc.
3 |
4 | %% @doc Write newline delimited log files, ensuring that if a truncated
5 | %% entry is found on log open then it is fixed before writing. Uses
6 | %% delayed writes and raw files for performance.
7 | -module(mochilogfile2).
8 | -author('bob@mochimedia.com').
9 |
10 | -export([open/1, write/2, close/1, name/1]).
11 |
12 | %% @spec open(Name) -> Handle
13 | %% @doc Open the log file Name, creating or appending as necessary. All data
14 | %% at the end of the file will be truncated until a newline is found, to
15 | %% ensure that all records are complete.
16 | open(Name) ->
17 | {ok, FD} = file:open(Name, [raw, read, write, delayed_write, binary]),
18 | fix_log(FD),
19 | {?MODULE, Name, FD}.
20 |
21 | %% @spec name(Handle) -> string()
22 | %% @doc Return the path of the log file.
23 | name({?MODULE, Name, _FD}) ->
24 | Name.
25 |
26 | %% @spec write(Handle, IoData) -> ok
27 | %% @doc Write IoData to the log file referenced by Handle.
28 | write({?MODULE, _Name, FD}, IoData) ->
29 | ok = file:write(FD, [IoData, $\n]),
30 | ok.
31 |
32 | %% @spec close(Handle) -> ok
33 | %% @doc Close the log file referenced by Handle.
34 | close({?MODULE, _Name, FD}) ->
35 | ok = file:sync(FD),
36 | ok = file:close(FD),
37 | ok.
38 |
39 | fix_log(FD) ->
40 | {ok, Location} = file:position(FD, eof),
41 | Seek = find_last_newline(FD, Location),
42 | {ok, Seek} = file:position(FD, Seek),
43 | ok = file:truncate(FD),
44 | ok.
45 |
46 | %% Seek backwards to the last valid log entry
47 | find_last_newline(_FD, N) when N =< 1 ->
48 | 0;
49 | find_last_newline(FD, Location) ->
50 | case file:pread(FD, Location - 1, 1) of
51 | {ok, <<$\n>>} ->
52 | Location;
53 | {ok, _} ->
54 | find_last_newline(FD, Location - 1)
55 | end.
56 |
57 | %%
58 | %% Tests
59 | %%
60 | -include_lib("eunit/include/eunit.hrl").
61 | -ifdef(TEST).
62 | name_test() ->
63 | D = mochitemp:mkdtemp(),
64 | FileName = filename:join(D, "open_close_test.log"),
65 | H = open(FileName),
66 | ?assertEqual(
67 | FileName,
68 | name(H)),
69 | close(H),
70 | file:delete(FileName),
71 | file:del_dir(D),
72 | ok.
73 |
74 | open_close_test() ->
75 | D = mochitemp:mkdtemp(),
76 | FileName = filename:join(D, "open_close_test.log"),
77 | OpenClose = fun () ->
78 | H = open(FileName),
79 | ?assertEqual(
80 | true,
81 | filelib:is_file(FileName)),
82 | ok = close(H),
83 | ?assertEqual(
84 | {ok, <<>>},
85 | file:read_file(FileName)),
86 | ok
87 | end,
88 | OpenClose(),
89 | OpenClose(),
90 | file:delete(FileName),
91 | file:del_dir(D),
92 | ok.
93 |
94 | write_test() ->
95 | D = mochitemp:mkdtemp(),
96 | FileName = filename:join(D, "write_test.log"),
97 | F = fun () ->
98 | H = open(FileName),
99 | write(H, "test line"),
100 | close(H),
101 | ok
102 | end,
103 | F(),
104 | ?assertEqual(
105 | {ok, <<"test line\n">>},
106 | file:read_file(FileName)),
107 | F(),
108 | ?assertEqual(
109 | {ok, <<"test line\ntest line\n">>},
110 | file:read_file(FileName)),
111 | file:delete(FileName),
112 | file:del_dir(D),
113 | ok.
114 |
115 | fix_log_test() ->
116 | D = mochitemp:mkdtemp(),
117 | FileName = filename:join(D, "write_test.log"),
118 | file:write_file(FileName, <<"first line good\nsecond line bad">>),
119 | F = fun () ->
120 | H = open(FileName),
121 | write(H, "test line"),
122 | close(H),
123 | ok
124 | end,
125 | F(),
126 | ?assertEqual(
127 | {ok, <<"first line good\ntest line\n">>},
128 | file:read_file(FileName)),
129 | file:write_file(FileName, <<"first line bad">>),
130 | F(),
131 | ?assertEqual(
132 | {ok, <<"test line\n">>},
133 | file:read_file(FileName)),
134 | F(),
135 | ?assertEqual(
136 | {ok, <<"test line\ntest line\n">>},
137 | file:read_file(FileName)),
138 | ok.
139 |
140 | -endif.
141 |
--------------------------------------------------------------------------------
/examples/https/https_store.erl:
--------------------------------------------------------------------------------
1 |
2 | %% Trivial web storage app. It's available over both HTTP (port 8442)
3 | %% and HTTPS (port 8443). You use a PUT to store items, a GET to
4 | %% retrieve them and DELETE to delete them. The HTTP POST method is
5 | %% invalid for this application. Example (using HTTPS transport):
6 | %%
7 | %% $ curl -k --verbose https://localhost:8443/flintstones
8 | %% ...
9 | %% 404 Not Found
10 | %% ...
11 | %% $ echo -e "Fred\nWilma\nBarney" |
12 | %% curl -k --verbose https://localhost:8443/flintstones \
13 | %% -X PUT -H "Content-Type: text/plain" --data-binary @-
14 | %% ...
15 | %% 201 Created
16 | %% ...
17 | %% $ curl -k --verbose https://localhost:8443/flintstones
18 | %% ...
19 | %% Fred
20 | %% Wilma
21 | %% Barney
22 | %% ...
23 | %% $ curl -k --verbose https://localhost:8443/flintstones -X DELETE
24 | %% ...
25 | %% 200 OK
26 | %% ...
27 | %% $ curl -k --verbose https://localhost:8443/flintstones
28 | %% ...
29 | %% 404 Not Found
30 | %% ...
31 | %%
32 | %% All submitted data is stored in memory (in an ets table). Could be
33 | %% useful for ad-hoc testing.
34 |
35 | -module(https_store).
36 |
37 | -export([start/0,
38 | stop/0,
39 | dispatch/1,
40 | loop/1
41 | ]).
42 |
43 | -define(HTTP_OPTS, [
44 | {loop, {?MODULE, dispatch}},
45 | {port, 8442},
46 | {name, http_8442}
47 | ]).
48 |
49 | -define(HTTPS_OPTS, [
50 | {loop, {?MODULE, dispatch}},
51 | {port, 8443},
52 | {name, https_8443},
53 | {ssl, true},
54 | {ssl_opts, [
55 | {certfile, "server_cert.pem"},
56 | {keyfile, "server_key.pem"}]}
57 | ]).
58 |
59 | -record(sd, {http, https}).
60 | -record(resource, {type, data}).
61 |
62 | start() ->
63 | {ok, Http} = mochiweb_http:start(?HTTP_OPTS),
64 | {ok, Https} = mochiweb_http:start(?HTTPS_OPTS),
65 | SD = #sd{http=Http, https=Https},
66 | Pid = spawn_link(fun() ->
67 | ets:new(?MODULE, [named_table]),
68 | loop(SD)
69 | end),
70 | register(http_store, Pid),
71 | ok.
72 |
73 | stop() ->
74 | http_store ! stop,
75 | ok.
76 |
77 | dispatch(Req) ->
78 | case Req:get(method) of
79 | 'GET' ->
80 | get_resource(Req);
81 | 'PUT' ->
82 | put_resource(Req);
83 | 'DELETE' ->
84 | delete_resource(Req);
85 | _ ->
86 | Headers = [{"Allow", "GET,PUT,DELETE"}],
87 | Req:respond({405, Headers, "405 Method Not Allowed\r\n"})
88 | end.
89 |
90 | get_resource(Req) ->
91 | Path = Req:get(path),
92 | case ets:lookup(?MODULE, Path) of
93 | [{Path, #resource{type=Type, data=Data}}] ->
94 | Req:ok({Type, Data});
95 | [] ->
96 | Req:respond({404, [], "404 Not Found\r\n"})
97 | end.
98 |
99 | put_resource(Req) ->
100 | ContentType = case Req:get_header_value("Content-Type") of
101 | undefined ->
102 | "application/octet-stream";
103 | S ->
104 | S
105 | end,
106 | Resource = #resource{type=ContentType, data=Req:recv_body()},
107 | http_store ! {self(), {put, Req:get(path), Resource}},
108 | Pid = whereis(http_store),
109 | receive
110 | {Pid, created} ->
111 | Req:respond({201, [], "201 Created\r\n"});
112 | {Pid, updated} ->
113 | Req:respond({200, [], "200 OK\r\n"})
114 | end.
115 |
116 | delete_resource(Req) ->
117 | http_store ! {self(), {delete, Req:get(path)}},
118 | Pid = whereis(http_store),
119 | receive
120 | {Pid, ok} ->
121 | Req:respond({200, [], "200 OK\r\n"})
122 | end.
123 |
124 | loop(#sd{http=Http, https=Https} = SD) ->
125 | receive
126 | stop ->
127 | ok = mochiweb_http:stop(Http),
128 | ok = mochiweb_http:stop(Https),
129 | exit(normal);
130 | {From, {put, Key, Val}} ->
131 | Exists = ets:member(?MODULE, Key),
132 | ets:insert(?MODULE, {Key, Val}),
133 | case Exists of
134 | true ->
135 | From ! {self(), updated};
136 | false ->
137 | From ! {self(), created}
138 | end;
139 | {From, {delete, Key}} ->
140 | ets:delete(?MODULE, Key),
141 | From ! {self(), ok};
142 | _ ->
143 | ignore
144 | end,
145 | ?MODULE:loop(SD).
146 |
147 |
--------------------------------------------------------------------------------
/src/reloader.erl:
--------------------------------------------------------------------------------
1 | %% @copyright 2007 Mochi Media, Inc.
2 | %% @author Matthew Dempsky
3 | %%
4 | %% @doc Erlang module for automatically reloading modified modules
5 | %% during development.
6 |
7 | -module(reloader).
8 | -author("Matthew Dempsky ").
9 |
10 | -include_lib("kernel/include/file.hrl").
11 |
12 | -behaviour(gen_server).
13 | -export([start/0, start_link/0]).
14 | -export([stop/0]).
15 | -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]).
16 | -export([all_changed/0]).
17 | -export([is_changed/1]).
18 | -export([reload_modules/1]).
19 | -record(state, {last, tref}).
20 |
21 | %% External API
22 |
23 | %% @spec start() -> ServerRet
24 | %% @doc Start the reloader.
25 | start() ->
26 | gen_server:start({local, ?MODULE}, ?MODULE, [], []).
27 |
28 | %% @spec start_link() -> ServerRet
29 | %% @doc Start the reloader.
30 | start_link() ->
31 | gen_server:start_link({local, ?MODULE}, ?MODULE, [], []).
32 |
33 | %% @spec stop() -> ok
34 | %% @doc Stop the reloader.
35 | stop() ->
36 | gen_server:call(?MODULE, stop).
37 |
38 | %% gen_server callbacks
39 |
40 | %% @spec init([]) -> {ok, State}
41 | %% @doc gen_server init, opens the server in an initial state.
42 | init([]) ->
43 | {ok, TRef} = timer:send_interval(timer:seconds(1), doit),
44 | {ok, #state{last = stamp(), tref = TRef}}.
45 |
46 | %% @spec handle_call(Args, From, State) -> tuple()
47 | %% @doc gen_server callback.
48 | handle_call(stop, _From, State) ->
49 | {stop, shutdown, stopped, State};
50 | handle_call(_Req, _From, State) ->
51 | {reply, {error, badrequest}, State}.
52 |
53 | %% @spec handle_cast(Cast, State) -> tuple()
54 | %% @doc gen_server callback.
55 | handle_cast(_Req, State) ->
56 | {noreply, State}.
57 |
58 | %% @spec handle_info(Info, State) -> tuple()
59 | %% @doc gen_server callback.
60 | handle_info(doit, State) ->
61 | Now = stamp(),
62 | doit(State#state.last, Now),
63 | {noreply, State#state{last = Now}};
64 | handle_info(_Info, State) ->
65 | {noreply, State}.
66 |
67 | %% @spec terminate(Reason, State) -> ok
68 | %% @doc gen_server termination callback.
69 | terminate(_Reason, State) ->
70 | {ok, cancel} = timer:cancel(State#state.tref),
71 | ok.
72 |
73 |
74 | %% @spec code_change(_OldVsn, State, _Extra) -> State
75 | %% @doc gen_server code_change callback (trivial).
76 | code_change(_Vsn, State, _Extra) ->
77 | {ok, State}.
78 |
79 | %% @spec reload_modules([atom()]) -> [{module, atom()} | {error, term()}]
80 | %% @doc code:purge/1 and code:load_file/1 the given list of modules in order,
81 | %% return the results of code:load_file/1.
82 | reload_modules(Modules) ->
83 | [begin code:purge(M), code:load_file(M) end || M <- Modules].
84 |
85 | %% @spec all_changed() -> [atom()]
86 | %% @doc Return a list of beam modules that have changed.
87 | all_changed() ->
88 | [M || {M, Fn} <- code:all_loaded(), is_list(Fn), is_changed(M)].
89 |
90 | %% @spec is_changed(atom()) -> boolean()
91 | %% @doc true if the loaded module is a beam with a vsn attribute
92 | %% and does not match the on-disk beam file, returns false otherwise.
93 | is_changed(M) ->
94 | try
95 | module_vsn(M:module_info()) =/= module_vsn(code:get_object_code(M))
96 | catch _:_ ->
97 | false
98 | end.
99 |
100 | %% Internal API
101 |
102 | module_vsn({M, Beam, _Fn}) ->
103 | {ok, {M, Vsn}} = beam_lib:version(Beam),
104 | Vsn;
105 | module_vsn(L) when is_list(L) ->
106 | {_, Attrs} = lists:keyfind(attributes, 1, L),
107 | {_, Vsn} = lists:keyfind(vsn, 1, Attrs),
108 | Vsn.
109 |
110 | doit(From, To) ->
111 | [case file:read_file_info(Filename) of
112 | {ok, #file_info{mtime = Mtime}} when Mtime >= From, Mtime < To ->
113 | reload(Module);
114 | {ok, _} ->
115 | unmodified;
116 | {error, enoent} ->
117 | %% The Erlang compiler deletes existing .beam files if
118 | %% recompiling fails. Maybe it's worth spitting out a
119 | %% warning here, but I'd want to limit it to just once.
120 | gone;
121 | {error, Reason} ->
122 | io:format("Error reading ~s's file info: ~p~n",
123 | [Filename, Reason]),
124 | error
125 | end || {Module, Filename} <- code:all_loaded(), is_list(Filename)].
126 |
127 | reload(Module) ->
128 | io:format("Reloading ~p ...", [Module]),
129 | code:purge(Module),
130 | case code:load_file(Module) of
131 | {module, Module} ->
132 | io:format(" ok.~n"),
133 | case erlang:function_exported(Module, test, 0) of
134 | true ->
135 | io:format(" - Calling ~p:test() ...", [Module]),
136 | case catch Module:test() of
137 | ok ->
138 | io:format(" ok.~n"),
139 | reload;
140 | Reason ->
141 | io:format(" fail: ~p.~n", [Reason]),
142 | reload_but_test_failed
143 | end;
144 | false ->
145 | reload
146 | end;
147 | {error, Reason} ->
148 | io:format(" fail: ~p.~n", [Reason]),
149 | error
150 | end.
151 |
152 |
153 | stamp() ->
154 | erlang:localtime().
155 |
156 | %%
157 | %% Tests
158 | %%
159 | -include_lib("eunit/include/eunit.hrl").
160 | -ifdef(TEST).
161 | -endif.
162 |
--------------------------------------------------------------------------------
/src/mochiweb_charref.erl:
--------------------------------------------------------------------------------
1 | %% @author Bob Ippolito
2 | %% @copyright 2007 Mochi Media, Inc.
3 |
4 | %% @doc Converts HTML 4 charrefs and entities to codepoints.
5 | -module(mochiweb_charref).
6 | -export([charref/1]).
7 |
8 | %% External API.
9 |
10 | %% @spec charref(S) -> integer() | undefined
11 | %% @doc Convert a decimal charref, hex charref, or html entity to a unicode
12 | %% codepoint, or return undefined on failure.
13 | %% The input should not include an ampersand or semicolon.
14 | %% charref("#38") = 38, charref("#x26") = 38, charref("amp") = 38.
15 | charref(B) when is_binary(B) ->
16 | charref(binary_to_list(B));
17 | charref([$#, C | L]) when C =:= $x orelse C =:= $X ->
18 | try erlang:list_to_integer(L, 16)
19 | catch
20 | error:badarg -> undefined
21 | end;
22 | charref([$# | L]) ->
23 | try list_to_integer(L)
24 | catch
25 | error:badarg -> undefined
26 | end;
27 | charref(L) ->
28 | entity(L).
29 |
30 | %% Internal API.
31 |
32 | entity("nbsp") -> 160;
33 | entity("iexcl") -> 161;
34 | entity("cent") -> 162;
35 | entity("pound") -> 163;
36 | entity("curren") -> 164;
37 | entity("yen") -> 165;
38 | entity("brvbar") -> 166;
39 | entity("sect") -> 167;
40 | entity("uml") -> 168;
41 | entity("copy") -> 169;
42 | entity("ordf") -> 170;
43 | entity("laquo") -> 171;
44 | entity("not") -> 172;
45 | entity("shy") -> 173;
46 | entity("reg") -> 174;
47 | entity("macr") -> 175;
48 | entity("deg") -> 176;
49 | entity("plusmn") -> 177;
50 | entity("sup2") -> 178;
51 | entity("sup3") -> 179;
52 | entity("acute") -> 180;
53 | entity("micro") -> 181;
54 | entity("para") -> 182;
55 | entity("middot") -> 183;
56 | entity("cedil") -> 184;
57 | entity("sup1") -> 185;
58 | entity("ordm") -> 186;
59 | entity("raquo") -> 187;
60 | entity("frac14") -> 188;
61 | entity("frac12") -> 189;
62 | entity("frac34") -> 190;
63 | entity("iquest") -> 191;
64 | entity("Agrave") -> 192;
65 | entity("Aacute") -> 193;
66 | entity("Acirc") -> 194;
67 | entity("Atilde") -> 195;
68 | entity("Auml") -> 196;
69 | entity("Aring") -> 197;
70 | entity("AElig") -> 198;
71 | entity("Ccedil") -> 199;
72 | entity("Egrave") -> 200;
73 | entity("Eacute") -> 201;
74 | entity("Ecirc") -> 202;
75 | entity("Euml") -> 203;
76 | entity("Igrave") -> 204;
77 | entity("Iacute") -> 205;
78 | entity("Icirc") -> 206;
79 | entity("Iuml") -> 207;
80 | entity("ETH") -> 208;
81 | entity("Ntilde") -> 209;
82 | entity("Ograve") -> 210;
83 | entity("Oacute") -> 211;
84 | entity("Ocirc") -> 212;
85 | entity("Otilde") -> 213;
86 | entity("Ouml") -> 214;
87 | entity("times") -> 215;
88 | entity("Oslash") -> 216;
89 | entity("Ugrave") -> 217;
90 | entity("Uacute") -> 218;
91 | entity("Ucirc") -> 219;
92 | entity("Uuml") -> 220;
93 | entity("Yacute") -> 221;
94 | entity("THORN") -> 222;
95 | entity("szlig") -> 223;
96 | entity("agrave") -> 224;
97 | entity("aacute") -> 225;
98 | entity("acirc") -> 226;
99 | entity("atilde") -> 227;
100 | entity("auml") -> 228;
101 | entity("aring") -> 229;
102 | entity("aelig") -> 230;
103 | entity("ccedil") -> 231;
104 | entity("egrave") -> 232;
105 | entity("eacute") -> 233;
106 | entity("ecirc") -> 234;
107 | entity("euml") -> 235;
108 | entity("igrave") -> 236;
109 | entity("iacute") -> 237;
110 | entity("icirc") -> 238;
111 | entity("iuml") -> 239;
112 | entity("eth") -> 240;
113 | entity("ntilde") -> 241;
114 | entity("ograve") -> 242;
115 | entity("oacute") -> 243;
116 | entity("ocirc") -> 244;
117 | entity("otilde") -> 245;
118 | entity("ouml") -> 246;
119 | entity("divide") -> 247;
120 | entity("oslash") -> 248;
121 | entity("ugrave") -> 249;
122 | entity("uacute") -> 250;
123 | entity("ucirc") -> 251;
124 | entity("uuml") -> 252;
125 | entity("yacute") -> 253;
126 | entity("thorn") -> 254;
127 | entity("yuml") -> 255;
128 | entity("fnof") -> 402;
129 | entity("Alpha") -> 913;
130 | entity("Beta") -> 914;
131 | entity("Gamma") -> 915;
132 | entity("Delta") -> 916;
133 | entity("Epsilon") -> 917;
134 | entity("Zeta") -> 918;
135 | entity("Eta") -> 919;
136 | entity("Theta") -> 920;
137 | entity("Iota") -> 921;
138 | entity("Kappa") -> 922;
139 | entity("Lambda") -> 923;
140 | entity("Mu") -> 924;
141 | entity("Nu") -> 925;
142 | entity("Xi") -> 926;
143 | entity("Omicron") -> 927;
144 | entity("Pi") -> 928;
145 | entity("Rho") -> 929;
146 | entity("Sigma") -> 931;
147 | entity("Tau") -> 932;
148 | entity("Upsilon") -> 933;
149 | entity("Phi") -> 934;
150 | entity("Chi") -> 935;
151 | entity("Psi") -> 936;
152 | entity("Omega") -> 937;
153 | entity("alpha") -> 945;
154 | entity("beta") -> 946;
155 | entity("gamma") -> 947;
156 | entity("delta") -> 948;
157 | entity("epsilon") -> 949;
158 | entity("zeta") -> 950;
159 | entity("eta") -> 951;
160 | entity("theta") -> 952;
161 | entity("iota") -> 953;
162 | entity("kappa") -> 954;
163 | entity("lambda") -> 955;
164 | entity("mu") -> 956;
165 | entity("nu") -> 957;
166 | entity("xi") -> 958;
167 | entity("omicron") -> 959;
168 | entity("pi") -> 960;
169 | entity("rho") -> 961;
170 | entity("sigmaf") -> 962;
171 | entity("sigma") -> 963;
172 | entity("tau") -> 964;
173 | entity("upsilon") -> 965;
174 | entity("phi") -> 966;
175 | entity("chi") -> 967;
176 | entity("psi") -> 968;
177 | entity("omega") -> 969;
178 | entity("thetasym") -> 977;
179 | entity("upsih") -> 978;
180 | entity("piv") -> 982;
181 | entity("bull") -> 8226;
182 | entity("hellip") -> 8230;
183 | entity("prime") -> 8242;
184 | entity("Prime") -> 8243;
185 | entity("oline") -> 8254;
186 | entity("frasl") -> 8260;
187 | entity("weierp") -> 8472;
188 | entity("image") -> 8465;
189 | entity("real") -> 8476;
190 | entity("trade") -> 8482;
191 | entity("alefsym") -> 8501;
192 | entity("larr") -> 8592;
193 | entity("uarr") -> 8593;
194 | entity("rarr") -> 8594;
195 | entity("darr") -> 8595;
196 | entity("harr") -> 8596;
197 | entity("crarr") -> 8629;
198 | entity("lArr") -> 8656;
199 | entity("uArr") -> 8657;
200 | entity("rArr") -> 8658;
201 | entity("dArr") -> 8659;
202 | entity("hArr") -> 8660;
203 | entity("forall") -> 8704;
204 | entity("part") -> 8706;
205 | entity("exist") -> 8707;
206 | entity("empty") -> 8709;
207 | entity("nabla") -> 8711;
208 | entity("isin") -> 8712;
209 | entity("notin") -> 8713;
210 | entity("ni") -> 8715;
211 | entity("prod") -> 8719;
212 | entity("sum") -> 8721;
213 | entity("minus") -> 8722;
214 | entity("lowast") -> 8727;
215 | entity("radic") -> 8730;
216 | entity("prop") -> 8733;
217 | entity("infin") -> 8734;
218 | entity("ang") -> 8736;
219 | entity("and") -> 8743;
220 | entity("or") -> 8744;
221 | entity("cap") -> 8745;
222 | entity("cup") -> 8746;
223 | entity("int") -> 8747;
224 | entity("there4") -> 8756;
225 | entity("sim") -> 8764;
226 | entity("cong") -> 8773;
227 | entity("asymp") -> 8776;
228 | entity("ne") -> 8800;
229 | entity("equiv") -> 8801;
230 | entity("le") -> 8804;
231 | entity("ge") -> 8805;
232 | entity("sub") -> 8834;
233 | entity("sup") -> 8835;
234 | entity("nsub") -> 8836;
235 | entity("sube") -> 8838;
236 | entity("supe") -> 8839;
237 | entity("oplus") -> 8853;
238 | entity("otimes") -> 8855;
239 | entity("perp") -> 8869;
240 | entity("sdot") -> 8901;
241 | entity("lceil") -> 8968;
242 | entity("rceil") -> 8969;
243 | entity("lfloor") -> 8970;
244 | entity("rfloor") -> 8971;
245 | entity("lang") -> 9001;
246 | entity("rang") -> 9002;
247 | entity("loz") -> 9674;
248 | entity("spades") -> 9824;
249 | entity("clubs") -> 9827;
250 | entity("hearts") -> 9829;
251 | entity("diams") -> 9830;
252 | entity("quot") -> 34;
253 | entity("amp") -> 38;
254 | entity("lt") -> 60;
255 | entity("gt") -> 62;
256 | entity("OElig") -> 338;
257 | entity("oelig") -> 339;
258 | entity("Scaron") -> 352;
259 | entity("scaron") -> 353;
260 | entity("Yuml") -> 376;
261 | entity("circ") -> 710;
262 | entity("tilde") -> 732;
263 | entity("ensp") -> 8194;
264 | entity("emsp") -> 8195;
265 | entity("thinsp") -> 8201;
266 | entity("zwnj") -> 8204;
267 | entity("zwj") -> 8205;
268 | entity("lrm") -> 8206;
269 | entity("rlm") -> 8207;
270 | entity("ndash") -> 8211;
271 | entity("mdash") -> 8212;
272 | entity("lsquo") -> 8216;
273 | entity("rsquo") -> 8217;
274 | entity("sbquo") -> 8218;
275 | entity("ldquo") -> 8220;
276 | entity("rdquo") -> 8221;
277 | entity("bdquo") -> 8222;
278 | entity("dagger") -> 8224;
279 | entity("Dagger") -> 8225;
280 | entity("permil") -> 8240;
281 | entity("lsaquo") -> 8249;
282 | entity("rsaquo") -> 8250;
283 | entity("euro") -> 8364;
284 | entity(_) -> undefined.
285 |
286 |
287 | %%
288 | %% Tests
289 | %%
290 | -include_lib("eunit/include/eunit.hrl").
291 | -ifdef(TEST).
292 |
293 | exhaustive_entity_test() ->
294 | T = mochiweb_cover:clause_lookup_table(?MODULE, entity),
295 | [?assertEqual(V, entity(K)) || {K, V} <- T].
296 |
297 | charref_test() ->
298 | 1234 = charref("#1234"),
299 | 255 = charref("#xfF"),
300 | 255 = charref(<<"#XFf">>),
301 | 38 = charref("amp"),
302 | 38 = charref(<<"amp">>),
303 | undefined = charref("not_an_entity"),
304 | undefined = charref("#not_an_entity"),
305 | undefined = charref("#xnot_an_entity"),
306 | ok.
307 |
308 | -endif.
309 |
--------------------------------------------------------------------------------
/src/mochitemp.erl:
--------------------------------------------------------------------------------
1 | %% @author Bob Ippolito
2 | %% @copyright 2010 Mochi Media, Inc.
3 |
4 | %% @doc Create temporary files and directories. Requires crypto to be started.
5 |
6 | -module(mochitemp).
7 | -export([gettempdir/0]).
8 | -export([mkdtemp/0, mkdtemp/3]).
9 | -export([rmtempdir/1]).
10 | %% -export([mkstemp/4]).
11 | -define(SAFE_CHARS, {$a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l, $m,
12 | $n, $o, $p, $q, $r, $s, $t, $u, $v, $w, $x, $y, $z,
13 | $A, $B, $C, $D, $E, $F, $G, $H, $I, $J, $K, $L, $M,
14 | $N, $O, $P, $Q, $R, $S, $T, $U, $V, $W, $X, $Y, $Z,
15 | $0, $1, $2, $3, $4, $5, $6, $7, $8, $9, $_}).
16 | -define(TMP_MAX, 10000).
17 |
18 | -include_lib("kernel/include/file.hrl").
19 |
20 | %% TODO: An ugly wrapper over the mktemp tool with open_port and sadness?
21 | %% We can't implement this race-free in Erlang without the ability
22 | %% to issue O_CREAT|O_EXCL. I suppose we could hack something with
23 | %% mkdtemp, del_dir, open.
24 | %% mkstemp(Suffix, Prefix, Dir, Options) ->
25 | %% ok.
26 |
27 | rmtempdir(Dir) ->
28 | case file:del_dir(Dir) of
29 | {error, eexist} ->
30 | ok = rmtempdirfiles(Dir),
31 | ok = file:del_dir(Dir);
32 | ok ->
33 | ok
34 | end.
35 |
36 | rmtempdirfiles(Dir) ->
37 | {ok, Files} = file:list_dir(Dir),
38 | ok = rmtempdirfiles(Dir, Files).
39 |
40 | rmtempdirfiles(_Dir, []) ->
41 | ok;
42 | rmtempdirfiles(Dir, [Basename | Rest]) ->
43 | Path = filename:join([Dir, Basename]),
44 | case filelib:is_dir(Path) of
45 | true ->
46 | ok = rmtempdir(Path);
47 | false ->
48 | ok = file:delete(Path)
49 | end,
50 | rmtempdirfiles(Dir, Rest).
51 |
52 | mkdtemp() ->
53 | mkdtemp("", "tmp", gettempdir()).
54 |
55 | mkdtemp(Suffix, Prefix, Dir) ->
56 | mkdtemp_n(rngpath_fun(Suffix, Prefix, Dir), ?TMP_MAX).
57 |
58 |
59 |
60 | mkdtemp_n(RngPath, 1) ->
61 | make_dir(RngPath());
62 | mkdtemp_n(RngPath, N) ->
63 | try make_dir(RngPath())
64 | catch throw:{error, eexist} ->
65 | mkdtemp_n(RngPath, N - 1)
66 | end.
67 |
68 | make_dir(Path) ->
69 | case file:make_dir(Path) of
70 | ok ->
71 | ok;
72 | E={error, eexist} ->
73 | throw(E)
74 | end,
75 | %% Small window for a race condition here because dir is created 777
76 | ok = file:write_file_info(Path, #file_info{mode=8#0700}),
77 | Path.
78 |
79 | rngpath_fun(Prefix, Suffix, Dir) ->
80 | fun () ->
81 | filename:join([Dir, Prefix ++ rngchars(6) ++ Suffix])
82 | end.
83 |
84 | rngchars(0) ->
85 | "";
86 | rngchars(N) ->
87 | [rngchar() | rngchars(N - 1)].
88 |
89 | rngchar() ->
90 | rngchar(crypto:rand_uniform(0, tuple_size(?SAFE_CHARS))).
91 |
92 | rngchar(C) ->
93 | element(1 + C, ?SAFE_CHARS).
94 |
95 | %% @spec gettempdir() -> string()
96 | %% @doc Get a usable temporary directory using the first of these that is a directory:
97 | %% $TMPDIR, $TMP, $TEMP, "/tmp", "/var/tmp", "/usr/tmp", ".".
98 | gettempdir() ->
99 | gettempdir(gettempdir_checks(), fun normalize_dir/1).
100 |
101 | gettempdir_checks() ->
102 | [{fun os:getenv/1, ["TMPDIR", "TMP", "TEMP"]},
103 | {fun gettempdir_identity/1, ["/tmp", "/var/tmp", "/usr/tmp"]},
104 | {fun gettempdir_cwd/1, [cwd]}].
105 |
106 | gettempdir_identity(L) ->
107 | L.
108 |
109 | gettempdir_cwd(cwd) ->
110 | {ok, L} = file:get_cwd(),
111 | L.
112 |
113 | gettempdir([{_F, []} | RestF], Normalize) ->
114 | gettempdir(RestF, Normalize);
115 | gettempdir([{F, [L | RestL]} | RestF], Normalize) ->
116 | case Normalize(F(L)) of
117 | false ->
118 | gettempdir([{F, RestL} | RestF], Normalize);
119 | Dir ->
120 | Dir
121 | end.
122 |
123 | normalize_dir(False) when False =:= false orelse False =:= "" ->
124 | %% Erlang doesn't have an unsetenv, wtf.
125 | false;
126 | normalize_dir(L) ->
127 | Dir = filename:absname(L),
128 | case filelib:is_dir(Dir) of
129 | false ->
130 | false;
131 | true ->
132 | Dir
133 | end.
134 |
135 | %%
136 | %% Tests
137 | %%
138 | -include_lib("eunit/include/eunit.hrl").
139 | -ifdef(TEST).
140 | pushenv(L) ->
141 | [{K, os:getenv(K)} || K <- L].
142 | popenv(L) ->
143 | F = fun ({K, false}) ->
144 | %% Erlang doesn't have an unsetenv, wtf.
145 | os:putenv(K, "");
146 | ({K, V}) ->
147 | os:putenv(K, V)
148 | end,
149 | lists:foreach(F, L).
150 |
151 | gettempdir_fallback_test() ->
152 | ?assertEqual(
153 | "/",
154 | gettempdir([{fun gettempdir_identity/1, ["/--not-here--/"]},
155 | {fun gettempdir_identity/1, ["/"]}],
156 | fun normalize_dir/1)),
157 | ?assertEqual(
158 | "/",
159 | %% simulate a true os:getenv unset env
160 | gettempdir([{fun gettempdir_identity/1, [false]},
161 | {fun gettempdir_identity/1, ["/"]}],
162 | fun normalize_dir/1)),
163 | ok.
164 |
165 | gettempdir_identity_test() ->
166 | ?assertEqual(
167 | "/",
168 | gettempdir([{fun gettempdir_identity/1, ["/"]}], fun normalize_dir/1)),
169 | ok.
170 |
171 | gettempdir_cwd_test() ->
172 | {ok, Cwd} = file:get_cwd(),
173 | ?assertEqual(
174 | normalize_dir(Cwd),
175 | gettempdir([{fun gettempdir_cwd/1, [cwd]}], fun normalize_dir/1)),
176 | ok.
177 |
178 | rngchars_test() ->
179 | crypto:start(),
180 | ?assertEqual(
181 | "",
182 | rngchars(0)),
183 | ?assertEqual(
184 | 10,
185 | length(rngchars(10))),
186 | ok.
187 |
188 | rngchar_test() ->
189 | ?assertEqual(
190 | $a,
191 | rngchar(0)),
192 | ?assertEqual(
193 | $A,
194 | rngchar(26)),
195 | ?assertEqual(
196 | $_,
197 | rngchar(62)),
198 | ok.
199 |
200 | mkdtemp_n_failonce_test() ->
201 | crypto:start(),
202 | D = mkdtemp(),
203 | Path = filename:join([D, "testdir"]),
204 | %% Toggle the existence of a dir so that it fails
205 | %% the first time and succeeds the second.
206 | F = fun () ->
207 | case filelib:is_dir(Path) of
208 | true ->
209 | file:del_dir(Path);
210 | false ->
211 | file:make_dir(Path)
212 | end,
213 | Path
214 | end,
215 | try
216 | %% Fails the first time
217 | ?assertThrow(
218 | {error, eexist},
219 | mkdtemp_n(F, 1)),
220 | %% Reset state
221 | file:del_dir(Path),
222 | %% Succeeds the second time
223 | ?assertEqual(
224 | Path,
225 | mkdtemp_n(F, 2))
226 | after rmtempdir(D)
227 | end,
228 | ok.
229 |
230 | mkdtemp_n_fail_test() ->
231 | {ok, Cwd} = file:get_cwd(),
232 | ?assertThrow(
233 | {error, eexist},
234 | mkdtemp_n(fun () -> Cwd end, 1)),
235 | ?assertThrow(
236 | {error, eexist},
237 | mkdtemp_n(fun () -> Cwd end, 2)),
238 | ok.
239 |
240 | make_dir_fail_test() ->
241 | {ok, Cwd} = file:get_cwd(),
242 | ?assertThrow(
243 | {error, eexist},
244 | make_dir(Cwd)),
245 | ok.
246 |
247 | mkdtemp_test() ->
248 | crypto:start(),
249 | D = mkdtemp(),
250 | ?assertEqual(
251 | true,
252 | filelib:is_dir(D)),
253 | ?assertEqual(
254 | ok,
255 | file:del_dir(D)),
256 | ok.
257 |
258 | rmtempdir_test() ->
259 | crypto:start(),
260 | D1 = mkdtemp(),
261 | ?assertEqual(
262 | true,
263 | filelib:is_dir(D1)),
264 | ?assertEqual(
265 | ok,
266 | rmtempdir(D1)),
267 | D2 = mkdtemp(),
268 | ?assertEqual(
269 | true,
270 | filelib:is_dir(D2)),
271 | ok = file:write_file(filename:join([D2, "foo"]), <<"bytes">>),
272 | D3 = mkdtemp("suffix", "prefix", D2),
273 | ?assertEqual(
274 | true,
275 | filelib:is_dir(D3)),
276 | ok = file:write_file(filename:join([D3, "foo"]), <<"bytes">>),
277 | ?assertEqual(
278 | ok,
279 | rmtempdir(D2)),
280 | ?assertEqual(
281 | {error, enoent},
282 | file:consult(D3)),
283 | ?assertEqual(
284 | {error, enoent},
285 | file:consult(D2)),
286 | ok.
287 |
288 | gettempdir_env_test() ->
289 | Env = pushenv(["TMPDIR", "TEMP", "TMP"]),
290 | FalseEnv = [{"TMPDIR", false}, {"TEMP", false}, {"TMP", false}],
291 | try
292 | popenv(FalseEnv),
293 | popenv([{"TMPDIR", "/"}]),
294 | ?assertEqual(
295 | "/",
296 | os:getenv("TMPDIR")),
297 | ?assertEqual(
298 | "/",
299 | gettempdir()),
300 | {ok, Cwd} = file:get_cwd(),
301 | popenv(FalseEnv),
302 | popenv([{"TMP", Cwd}]),
303 | ?assertEqual(
304 | normalize_dir(Cwd),
305 | gettempdir())
306 | after popenv(Env)
307 | end,
308 | ok.
309 |
310 | -endif.
311 |
--------------------------------------------------------------------------------
/src/mochiweb.erl:
--------------------------------------------------------------------------------
1 | %% @author Bob Ippolito
2 | %% @copyright 2007 Mochi Media, Inc.
3 |
4 | %% @doc Start and stop the MochiWeb server.
5 |
6 | -module(mochiweb).
7 | -author('bob@mochimedia.com').
8 |
9 | -export([start/0, stop/0]).
10 | -export([new_request/1, new_response/1]).
11 | -export([all_loaded/0, all_loaded/1, reload/0]).
12 |
13 | %% @spec start() -> ok
14 | %% @doc Start the MochiWeb server.
15 | start() ->
16 | ensure_started(crypto),
17 | application:start(mochiweb).
18 |
19 | %% @spec stop() -> ok
20 | %% @doc Stop the MochiWeb server.
21 | stop() ->
22 | Res = application:stop(mochiweb),
23 | application:stop(crypto),
24 | Res.
25 |
26 | reload() ->
27 | [c:l(Module) || Module <- all_loaded()].
28 |
29 | all_loaded() ->
30 | all_loaded(filename:dirname(code:which(?MODULE))).
31 |
32 | all_loaded(Base) when is_atom(Base) ->
33 | [];
34 | all_loaded(Base) ->
35 | FullBase = Base ++ "/",
36 | F = fun ({_Module, Loaded}, Acc) when is_atom(Loaded) ->
37 | Acc;
38 | ({Module, Loaded}, Acc) ->
39 | case lists:prefix(FullBase, Loaded) of
40 | true ->
41 | [Module | Acc];
42 | false ->
43 | Acc
44 | end
45 | end,
46 | lists:foldl(F, [], code:all_loaded()).
47 |
48 |
49 | %% @spec new_request({Socket, Request, Headers}) -> MochiWebRequest
50 | %% @doc Return a mochiweb_request data structure.
51 | new_request({Socket, {Method, {abs_path, Uri}, Version}, Headers}) ->
52 | mochiweb_request:new(Socket,
53 | Method,
54 | Uri,
55 | Version,
56 | mochiweb_headers:make(Headers));
57 | % this case probably doesn't "exist".
58 | new_request({Socket, {Method, {absoluteURI, _Protocol, _Host, _Port, Uri},
59 | Version}, Headers}) ->
60 | mochiweb_request:new(Socket,
61 | Method,
62 | Uri,
63 | Version,
64 | mochiweb_headers:make(Headers));
65 | %% Request-URI is "*"
66 | %% From http://www.w3.org/Protocols/rfc2616/rfc2616-sec5.html#sec5.1.2
67 | new_request({Socket, {Method, '*'=Uri, Version}, Headers}) ->
68 | mochiweb_request:new(Socket,
69 | Method,
70 | Uri,
71 | Version,
72 | mochiweb_headers:make(Headers)).
73 |
74 | %% @spec new_response({Request, integer(), Headers}) -> MochiWebResponse
75 | %% @doc Return a mochiweb_response data structure.
76 | new_response({Request, Code, Headers}) ->
77 | mochiweb_response:new(Request,
78 | Code,
79 | mochiweb_headers:make(Headers)).
80 |
81 | %% Internal API
82 |
83 | ensure_started(App) ->
84 | case application:start(App) of
85 | ok ->
86 | ok;
87 | {error, {already_started, App}} ->
88 | ok
89 | end.
90 |
91 |
92 | %%
93 | %% Tests
94 | %%
95 | -include_lib("eunit/include/eunit.hrl").
96 | -ifdef(TEST).
97 |
98 | -record(treq, {path, body= <<>>, xreply= <<>>}).
99 |
100 | ssl_cert_opts() ->
101 | EbinDir = filename:dirname(code:which(?MODULE)),
102 | CertDir = filename:join([EbinDir, "..", "support", "test-materials"]),
103 | CertFile = filename:join(CertDir, "test_ssl_cert.pem"),
104 | KeyFile = filename:join(CertDir, "test_ssl_key.pem"),
105 | [{certfile, CertFile}, {keyfile, KeyFile}].
106 |
107 | with_server(Transport, ServerFun, ClientFun) ->
108 | ServerOpts0 = [{ip, "127.0.0.1"}, {port, 0}, {loop, ServerFun}],
109 | ServerOpts = case Transport of
110 | plain ->
111 | ServerOpts0;
112 | ssl ->
113 | ServerOpts0 ++ [{ssl, true}, {ssl_opts, ssl_cert_opts()}]
114 | end,
115 | {ok, Server} = mochiweb_http:start(ServerOpts),
116 | Port = mochiweb_socket_server:get(Server, port),
117 | Res = (catch ClientFun(Transport, Port)),
118 | mochiweb_http:stop(Server),
119 | Res.
120 |
121 | request_test() ->
122 | R = mochiweb_request:new(z, z, "/foo/bar/baz%20wibble+quux?qs=2", z, []),
123 | "/foo/bar/baz wibble quux" = R:get(path),
124 | ok.
125 |
126 | single_http_GET_test() ->
127 | do_GET(plain, 1).
128 |
129 | single_https_GET_test() ->
130 | do_GET(ssl, 1).
131 |
132 | multiple_http_GET_test() ->
133 | do_GET(plain, 3).
134 |
135 | multiple_https_GET_test() ->
136 | do_GET(ssl, 3).
137 |
138 | hundred_http_GET_test() ->
139 | do_GET(plain, 100).
140 |
141 | hundred_https_GET_test() ->
142 | do_GET(ssl, 100).
143 |
144 | single_128_http_POST_test() ->
145 | do_POST(plain, 128, 1).
146 |
147 | single_128_https_POST_test() ->
148 | do_POST(ssl, 128, 1).
149 |
150 | single_2k_http_POST_test() ->
151 | do_POST(plain, 2048, 1).
152 |
153 | single_2k_https_POST_test() ->
154 | do_POST(ssl, 2048, 1).
155 |
156 | single_100k_http_POST_test() ->
157 | do_POST(plain, 102400, 1).
158 |
159 | single_100k_https_POST_test() ->
160 | do_POST(ssl, 102400, 1).
161 |
162 | multiple_100k_http_POST_test() ->
163 | do_POST(plain, 102400, 3).
164 |
165 | multiple_100K_https_POST_test() ->
166 | do_POST(ssl, 102400, 3).
167 |
168 | hundred_128_http_POST_test() ->
169 | do_POST(plain, 128, 100).
170 |
171 | hundred_128_https_POST_test() ->
172 | do_POST(ssl, 128, 100).
173 |
174 | do_GET(Transport, Times) ->
175 | PathPrefix = "/whatever/",
176 | ReplyPrefix = "You requested: ",
177 | ServerFun = fun (Req) ->
178 | Reply = ReplyPrefix ++ Req:get(path),
179 | Req:ok({"text/plain", Reply})
180 | end,
181 | TestReqs = [begin
182 | Path = PathPrefix ++ integer_to_list(N),
183 | ExpectedReply = list_to_binary(ReplyPrefix ++ Path),
184 | #treq{path=Path, xreply=ExpectedReply}
185 | end || N <- lists:seq(1, Times)],
186 | ClientFun = new_client_fun('GET', TestReqs),
187 | ok = with_server(Transport, ServerFun, ClientFun),
188 | ok.
189 |
190 | do_POST(Transport, Size, Times) ->
191 | ServerFun = fun (Req) ->
192 | Body = Req:recv_body(),
193 | Headers = [{"Content-Type", "application/octet-stream"}],
194 | Req:respond({201, Headers, Body})
195 | end,
196 | TestReqs = [begin
197 | Path = "/stuff/" ++ integer_to_list(N),
198 | Body = crypto:rand_bytes(Size),
199 | #treq{path=Path, body=Body, xreply=Body}
200 | end || N <- lists:seq(1, Times)],
201 | ClientFun = new_client_fun('POST', TestReqs),
202 | ok = with_server(Transport, ServerFun, ClientFun),
203 | ok.
204 |
205 | new_client_fun(Method, TestReqs) ->
206 | fun (Transport, Port) ->
207 | client_request(Transport, Port, Method, TestReqs)
208 | end.
209 |
210 | client_request(Transport, Port, Method, TestReqs) ->
211 | Opts = [binary, {active, false}, {packet, http}],
212 | SockFun = case Transport of
213 | plain ->
214 | {ok, Socket} = gen_tcp:connect("127.0.0.1", Port, Opts),
215 | fun (recv) ->
216 | gen_tcp:recv(Socket, 0);
217 | ({recv, Length}) ->
218 | gen_tcp:recv(Socket, Length);
219 | ({send, Data}) ->
220 | gen_tcp:send(Socket, Data);
221 | ({setopts, L}) ->
222 | inet:setopts(Socket, L)
223 | end;
224 | ssl ->
225 | {ok, Socket} = ssl:connect("127.0.0.1", Port, [{ssl_imp, new} | Opts]),
226 | fun (recv) ->
227 | ssl:recv(Socket, 0);
228 | ({recv, Length}) ->
229 | ssl:recv(Socket, Length);
230 | ({send, Data}) ->
231 | ssl:send(Socket, Data);
232 | ({setopts, L}) ->
233 | ssl:setopts(Socket, L)
234 | end
235 | end,
236 | client_request(SockFun, Method, TestReqs).
237 |
238 | client_request(SockFun, _Method, []) ->
239 | {the_end, {error, closed}} = {the_end, SockFun(recv)},
240 | ok;
241 | client_request(SockFun, Method,
242 | [#treq{path=Path, body=Body, xreply=ExReply} | Rest]) ->
243 | Request = [atom_to_list(Method), " ", Path, " HTTP/1.1\r\n",
244 | client_headers(Body, Rest =:= []),
245 | "\r\n",
246 | Body],
247 | ok = SockFun({send, Request}),
248 | case Method of
249 | 'GET' ->
250 | {ok, {http_response, {1,1}, 200, "OK"}} = SockFun(recv);
251 | 'POST' ->
252 | {ok, {http_response, {1,1}, 201, "Created"}} = SockFun(recv)
253 | end,
254 | ok = SockFun({setopts, [{packet, httph}]}),
255 | {ok, {http_header, _, 'Server', _, "MochiWeb" ++ _}} = SockFun(recv),
256 | {ok, {http_header, _, 'Date', _, _}} = SockFun(recv),
257 | {ok, {http_header, _, 'Content-Type', _, _}} = SockFun(recv),
258 | {ok, {http_header, _, 'Content-Length', _, ConLenStr}} = SockFun(recv),
259 | ContentLength = list_to_integer(ConLenStr),
260 | {ok, http_eoh} = SockFun(recv),
261 | ok = SockFun({setopts, [{packet, raw}]}),
262 | {payload, ExReply} = {payload, drain_reply(SockFun, ContentLength, <<>>)},
263 | ok = SockFun({setopts, [{packet, http}]}),
264 | client_request(SockFun, Method, Rest).
265 |
266 | client_headers(Body, IsLastRequest) ->
267 | ["Host: localhost\r\n",
268 | case Body of
269 | <<>> ->
270 | "";
271 | _ ->
272 | ["Content-Type: application/octet-stream\r\n",
273 | "Content-Length: ", integer_to_list(byte_size(Body)), "\r\n"]
274 | end,
275 | case IsLastRequest of
276 | true ->
277 | "Connection: close\r\n";
278 | false ->
279 | ""
280 | end].
281 |
282 | drain_reply(_SockFun, 0, Acc) ->
283 | Acc;
284 | drain_reply(SockFun, Length, Acc) ->
285 | Sz = erlang:min(Length, 1024),
286 | {ok, B} = SockFun({recv, Sz}),
287 | drain_reply(SockFun, Length - Sz, <>).
288 |
289 | -endif.
290 |
--------------------------------------------------------------------------------
/src/mochiweb_socket_server.erl:
--------------------------------------------------------------------------------
1 | %% @author Bob Ippolito
2 | %% @copyright 2007 Mochi Media, Inc.
3 |
4 | %% @doc MochiWeb socket server.
5 |
6 | -module(mochiweb_socket_server).
7 | -author('bob@mochimedia.com').
8 | -behaviour(gen_server).
9 |
10 | -include("internal.hrl").
11 |
12 | -export([start/1, stop/1]).
13 | -export([init/1, handle_call/3, handle_cast/2, terminate/2, code_change/3,
14 | handle_info/2]).
15 | -export([get/2]).
16 |
17 | -record(mochiweb_socket_server,
18 | {port,
19 | loop,
20 | name=undefined,
21 | %% NOTE: This is currently ignored.
22 | max=2048,
23 | ip=any,
24 | listen=null,
25 | nodelay=false,
26 | backlog=128,
27 | active_sockets=0,
28 | acceptor_pool_size=16,
29 | ssl=false,
30 | ssl_opts=[{ssl_imp, new}],
31 | acceptor_pool=sets:new()}).
32 |
33 | start(State=#mochiweb_socket_server{}) ->
34 | start_server(State);
35 | start(Options) ->
36 | start(parse_options(Options)).
37 |
38 | get(Name, Property) ->
39 | gen_server:call(Name, {get, Property}).
40 |
41 | stop(Name) when is_atom(Name) ->
42 | gen_server:cast(Name, stop);
43 | stop(Pid) when is_pid(Pid) ->
44 | gen_server:cast(Pid, stop);
45 | stop({local, Name}) ->
46 | stop(Name);
47 | stop({global, Name}) ->
48 | stop(Name);
49 | stop(Options) ->
50 | State = parse_options(Options),
51 | stop(State#mochiweb_socket_server.name).
52 |
53 | %% Internal API
54 |
55 | parse_options(Options) ->
56 | parse_options(Options, #mochiweb_socket_server{}).
57 |
58 | parse_options([], State) ->
59 | State;
60 | parse_options([{name, L} | Rest], State) when is_list(L) ->
61 | Name = {local, list_to_atom(L)},
62 | parse_options(Rest, State#mochiweb_socket_server{name=Name});
63 | parse_options([{name, A} | Rest], State) when A =:= undefined ->
64 | parse_options(Rest, State#mochiweb_socket_server{name=A});
65 | parse_options([{name, A} | Rest], State) when is_atom(A) ->
66 | Name = {local, A},
67 | parse_options(Rest, State#mochiweb_socket_server{name=Name});
68 | parse_options([{name, Name} | Rest], State) ->
69 | parse_options(Rest, State#mochiweb_socket_server{name=Name});
70 | parse_options([{port, L} | Rest], State) when is_list(L) ->
71 | Port = list_to_integer(L),
72 | parse_options(Rest, State#mochiweb_socket_server{port=Port});
73 | parse_options([{port, Port} | Rest], State) ->
74 | parse_options(Rest, State#mochiweb_socket_server{port=Port});
75 | parse_options([{ip, Ip} | Rest], State) ->
76 | ParsedIp = case Ip of
77 | any ->
78 | any;
79 | Ip when is_tuple(Ip) ->
80 | Ip;
81 | Ip when is_list(Ip) ->
82 | {ok, IpTuple} = inet_parse:address(Ip),
83 | IpTuple
84 | end,
85 | parse_options(Rest, State#mochiweb_socket_server{ip=ParsedIp});
86 | parse_options([{loop, Loop} | Rest], State) ->
87 | parse_options(Rest, State#mochiweb_socket_server{loop=Loop});
88 | parse_options([{backlog, Backlog} | Rest], State) ->
89 | parse_options(Rest, State#mochiweb_socket_server{backlog=Backlog});
90 | parse_options([{nodelay, NoDelay} | Rest], State) ->
91 | parse_options(Rest, State#mochiweb_socket_server{nodelay=NoDelay});
92 | parse_options([{acceptor_pool_size, Max} | Rest], State) ->
93 | MaxInt = ensure_int(Max),
94 | parse_options(Rest,
95 | State#mochiweb_socket_server{acceptor_pool_size=MaxInt});
96 | parse_options([{max, Max} | Rest], State) ->
97 | error_logger:info_report([{warning, "TODO: max is currently unsupported"},
98 | {max, Max}]),
99 | MaxInt = ensure_int(Max),
100 | parse_options(Rest, State#mochiweb_socket_server{max=MaxInt});
101 | parse_options([{ssl, Ssl} | Rest], State) when is_boolean(Ssl) ->
102 | parse_options(Rest, State#mochiweb_socket_server{ssl=Ssl});
103 | parse_options([{ssl_opts, SslOpts} | Rest], State) when is_list(SslOpts) ->
104 | SslOpts1 = [{ssl_imp, new} | proplists:delete(ssl_imp, SslOpts)],
105 | parse_options(Rest, State#mochiweb_socket_server{ssl_opts=SslOpts1}).
106 |
107 | start_server(State=#mochiweb_socket_server{ssl=Ssl, name=Name}) ->
108 | case Ssl of
109 | true ->
110 | application:start(crypto),
111 | application:start(public_key),
112 | application:start(ssl);
113 | false ->
114 | void
115 | end,
116 | case Name of
117 | undefined ->
118 | gen_server:start_link(?MODULE, State, []);
119 | _ ->
120 | gen_server:start_link(Name, ?MODULE, State, [])
121 | end.
122 |
123 | ensure_int(N) when is_integer(N) ->
124 | N;
125 | ensure_int(S) when is_list(S) ->
126 | list_to_integer(S).
127 |
128 | ipv6_supported() ->
129 | case (catch inet:getaddr("localhost", inet6)) of
130 | {ok, _Addr} ->
131 | true;
132 | {error, _} ->
133 | false
134 | end.
135 |
136 | init(State=#mochiweb_socket_server{ip=Ip, port=Port, backlog=Backlog, nodelay=NoDelay}) ->
137 | process_flag(trap_exit, true),
138 | BaseOpts = [binary,
139 | {reuseaddr, true},
140 | {packet, 0},
141 | {backlog, Backlog},
142 | {recbuf, ?RECBUF_SIZE},
143 | {active, false},
144 | {nodelay, NoDelay}],
145 | Opts = case Ip of
146 | any ->
147 | case ipv6_supported() of % IPv4, and IPv6 if supported
148 | true -> [inet, inet6 | BaseOpts];
149 | _ -> BaseOpts
150 | end;
151 | {_, _, _, _} -> % IPv4
152 | [inet, {ip, Ip} | BaseOpts];
153 | {_, _, _, _, _, _, _, _} -> % IPv6
154 | [inet6, {ip, Ip} | BaseOpts]
155 | end,
156 | case listen(Port, Opts, State) of
157 | {stop, eacces} ->
158 | case Port < 1024 of
159 | true ->
160 | case fdsrv:start() of
161 | {ok, _} ->
162 | case fdsrv:bind_socket(tcp, Port) of
163 | {ok, Fd} ->
164 | listen(Port, [{fd, Fd} | Opts], State);
165 | _ ->
166 | {stop, fdsrv_bind_failed}
167 | end;
168 | _ ->
169 | {stop, fdsrv_start_failed}
170 | end;
171 | false ->
172 | {stop, eacces}
173 | end;
174 | Other ->
175 | Other
176 | end.
177 |
178 | new_acceptor_pool(Listen,
179 | State=#mochiweb_socket_server{acceptor_pool=Pool,
180 | acceptor_pool_size=Size,
181 | loop=Loop}) ->
182 | F = fun (_, S) ->
183 | Pid = mochiweb_acceptor:start_link(self(), Listen, Loop),
184 | sets:add_element(Pid, S)
185 | end,
186 | Pool1 = lists:foldl(F, Pool, lists:seq(1, Size)),
187 | State#mochiweb_socket_server{acceptor_pool=Pool1}.
188 |
189 | listen(Port, Opts, State=#mochiweb_socket_server{ssl=Ssl, ssl_opts=SslOpts}) ->
190 | case mochiweb_socket:listen(Ssl, Port, Opts, SslOpts) of
191 | {ok, Listen} ->
192 | {ok, ListenPort} = mochiweb_socket:port(Listen),
193 | {ok, new_acceptor_pool(
194 | Listen,
195 | State#mochiweb_socket_server{listen=Listen,
196 | port=ListenPort})};
197 | {error, Reason} ->
198 | {stop, Reason}
199 | end.
200 |
201 | do_get(port, #mochiweb_socket_server{port=Port}) ->
202 | Port;
203 | do_get(active_sockets, #mochiweb_socket_server{active_sockets=ActiveSockets}) ->
204 | ActiveSockets.
205 |
206 | handle_call({get, Property}, _From, State) ->
207 | Res = do_get(Property, State),
208 | {reply, Res, State};
209 | handle_call(_Message, _From, State) ->
210 | Res = error,
211 | {reply, Res, State}.
212 |
213 | handle_cast({accepted, Pid, _Timing},
214 | State=#mochiweb_socket_server{active_sockets=ActiveSockets}) ->
215 | State1 = State#mochiweb_socket_server{active_sockets=1 + ActiveSockets},
216 | {noreply, recycle_acceptor(Pid, State1)};
217 | handle_cast(stop, State) ->
218 | {stop, normal, State}.
219 |
220 | terminate(_Reason, #mochiweb_socket_server{listen=Listen, port=Port}) ->
221 | mochiweb_socket:close(Listen),
222 | case Port < 1024 of
223 | true ->
224 | catch fdsrv:stop(),
225 | ok;
226 | false ->
227 | ok
228 | end.
229 |
230 | code_change(_OldVsn, State, _Extra) ->
231 | State.
232 |
233 | recycle_acceptor(Pid, State=#mochiweb_socket_server{
234 | acceptor_pool=Pool,
235 | listen=Listen,
236 | loop=Loop,
237 | active_sockets=ActiveSockets}) ->
238 | case sets:is_element(Pid, Pool) of
239 | true ->
240 | Acceptor = mochiweb_acceptor:start_link(self(), Listen, Loop),
241 | Pool1 = sets:add_element(Acceptor, sets:del_element(Pid, Pool)),
242 | State#mochiweb_socket_server{acceptor_pool=Pool1};
243 | false ->
244 | State#mochiweb_socket_server{active_sockets=ActiveSockets - 1}
245 | end.
246 |
247 | handle_info({'EXIT', Pid, normal}, State) ->
248 | {noreply, recycle_acceptor(Pid, State)};
249 | handle_info({'EXIT', Pid, Reason},
250 | State=#mochiweb_socket_server{acceptor_pool=Pool}) ->
251 | case sets:is_element(Pid, Pool) of
252 | true ->
253 | %% If there was an unexpected error accepting, log and sleep.
254 | error_logger:error_report({?MODULE, ?LINE,
255 | {acceptor_error, Reason}}),
256 | timer:sleep(100);
257 | false ->
258 | ok
259 | end,
260 | {noreply, recycle_acceptor(Pid, State)};
261 | handle_info(Info, State) ->
262 | error_logger:info_report([{'INFO', Info}, {'State', State}]),
263 | {noreply, State}.
264 |
265 |
266 |
267 | %%
268 | %% Tests
269 | %%
270 | -include_lib("eunit/include/eunit.hrl").
271 | -ifdef(TEST).
272 | -endif.
273 |
--------------------------------------------------------------------------------
/src/mochiweb_http.erl:
--------------------------------------------------------------------------------
1 | %% @author Bob Ippolito
2 | %% @copyright 2007 Mochi Media, Inc.
3 |
4 | %% @doc HTTP server.
5 |
6 | -module(mochiweb_http).
7 | -author('bob@mochimedia.com').
8 | -export([start/0, start/1, stop/0, stop/1]).
9 | -export([loop/2, default_body/1]).
10 | -export([after_response/2, reentry/1]).
11 | -export([parse_range_request/1, range_skip_length/2]).
12 |
13 | -define(REQUEST_RECV_TIMEOUT, 300000). % timeout waiting for request line
14 | -define(HEADERS_RECV_TIMEOUT, 30000). % timeout waiting for headers
15 |
16 | -define(MAX_HEADERS, 1000).
17 | -define(DEFAULTS, [{name, ?MODULE},
18 | {port, 8888}]).
19 |
20 | parse_options(Options) ->
21 | {loop, HttpLoop} = proplists:lookup(loop, Options),
22 | Loop = fun (S) ->
23 | ?MODULE:loop(S, HttpLoop)
24 | end,
25 | Options1 = [{loop, Loop} | proplists:delete(loop, Options)],
26 | mochilists:set_defaults(?DEFAULTS, Options1).
27 |
28 | stop() ->
29 | mochiweb_socket_server:stop(?MODULE).
30 |
31 | stop(Name) ->
32 | mochiweb_socket_server:stop(Name).
33 |
34 | start() ->
35 | start([{ip, "127.0.0.1"},
36 | {loop, {?MODULE, default_body}}]).
37 |
38 | start(Options) ->
39 | mochiweb_socket_server:start(parse_options(Options)).
40 |
41 | frm(Body) ->
42 | [""
43 | ""
47 | "
"
48 | ""
54 | "", Body, "
"
55 | ""].
56 |
57 | default_body(Req, M, "/chunked") when M =:= 'GET'; M =:= 'HEAD' ->
58 | Res = Req:ok({"text/plain", [], chunked}),
59 | Res:write_chunk("First chunk\r\n"),
60 | timer:sleep(5000),
61 | Res:write_chunk("Last chunk\r\n"),
62 | Res:write_chunk("");
63 | default_body(Req, M, _Path) when M =:= 'GET'; M =:= 'HEAD' ->
64 | Body = io_lib:format("~p~n", [[{parse_qs, Req:parse_qs()},
65 | {parse_cookie, Req:parse_cookie()},
66 | Req:dump()]]),
67 | Req:ok({"text/html",
68 | [mochiweb_cookies:cookie("mochiweb_http", "test_cookie")],
69 | frm(Body)});
70 | default_body(Req, 'POST', "/multipart") ->
71 | Body = io_lib:format("~p~n", [[{parse_qs, Req:parse_qs()},
72 | {parse_cookie, Req:parse_cookie()},
73 | {body, Req:recv_body()},
74 | Req:dump()]]),
75 | Req:ok({"text/html", [], frm(Body)});
76 | default_body(Req, 'POST', _Path) ->
77 | Body = io_lib:format("~p~n", [[{parse_qs, Req:parse_qs()},
78 | {parse_cookie, Req:parse_cookie()},
79 | {parse_post, Req:parse_post()},
80 | Req:dump()]]),
81 | Req:ok({"text/html", [], frm(Body)});
82 | default_body(Req, _Method, _Path) ->
83 | Req:respond({501, [], []}).
84 |
85 | default_body(Req) ->
86 | default_body(Req, Req:get(method), Req:get(path)).
87 |
88 | loop(Socket, Body) ->
89 | mochiweb_socket:setopts(Socket, [{packet, http}]),
90 | request(Socket, Body).
91 |
92 | request(Socket, Body) ->
93 | case mochiweb_socket:recv(Socket, 0, ?REQUEST_RECV_TIMEOUT) of
94 | {ok, {http_request, Method, Path, Version}} ->
95 | mochiweb_socket:setopts(Socket, [{packet, httph}]),
96 | headers(Socket, {Method, Path, Version}, [], Body, 0);
97 | {error, {http_error, "\r\n"}} ->
98 | request(Socket, Body);
99 | {error, {http_error, "\n"}} ->
100 | request(Socket, Body);
101 | {error, closed} ->
102 | mochiweb_socket:close(Socket),
103 | exit(normal);
104 | {error, timeout} ->
105 | mochiweb_socket:close(Socket),
106 | exit(normal);
107 | _Other ->
108 | handle_invalid_request(Socket)
109 | end.
110 |
111 | reentry(Body) ->
112 | fun (Req) ->
113 | ?MODULE:after_response(Body, Req)
114 | end.
115 |
116 | headers(Socket, Request, Headers, _Body, ?MAX_HEADERS) ->
117 | %% Too many headers sent, bad request.
118 | mochiweb_socket:setopts(Socket, [{packet, raw}]),
119 | handle_invalid_request(Socket, Request, Headers);
120 | headers(Socket, Request, Headers, Body, HeaderCount) ->
121 | case mochiweb_socket:recv(Socket, 0, ?HEADERS_RECV_TIMEOUT) of
122 | {ok, http_eoh} ->
123 | mochiweb_socket:setopts(Socket, [{packet, raw}]),
124 | Req = mochiweb:new_request({Socket, Request,
125 | lists:reverse(Headers)}),
126 | call_body(Body, Req),
127 | ?MODULE:after_response(Body, Req);
128 | {ok, {http_header, _, Name, _, Value}} ->
129 | headers(Socket, Request, [{Name, Value} | Headers], Body,
130 | 1 + HeaderCount);
131 | {error, closed} ->
132 | mochiweb_socket:close(Socket),
133 | exit(normal);
134 | _Other ->
135 | handle_invalid_request(Socket, Request, Headers)
136 | end.
137 |
138 | call_body({M, F}, Req) ->
139 | M:F(Req);
140 | call_body(Body, Req) ->
141 | Body(Req).
142 |
143 | handle_invalid_request(Socket) ->
144 | handle_invalid_request(Socket, {'GET', {abs_path, "/"}, {0,9}}, []).
145 |
146 | handle_invalid_request(Socket, Request, RevHeaders) ->
147 | mochiweb_socket:setopts(Socket, [{packet, raw}]),
148 | Req = mochiweb:new_request({Socket, Request,
149 | lists:reverse(RevHeaders)}),
150 | Req:respond({400, [], []}),
151 | mochiweb_socket:close(Socket),
152 | exit(normal).
153 |
154 | after_response(Body, Req) ->
155 | Socket = Req:get(socket),
156 | case Req:should_close() of
157 | true ->
158 | mochiweb_socket:close(Socket),
159 | exit(normal);
160 | false ->
161 | Req:cleanup(),
162 | ?MODULE:loop(Socket, Body)
163 | end.
164 |
165 | parse_range_request("bytes=0-") ->
166 | undefined;
167 | parse_range_request(RawRange) when is_list(RawRange) ->
168 | try
169 | "bytes=" ++ RangeString = RawRange,
170 | Ranges = string:tokens(RangeString, ","),
171 | lists:map(fun ("-" ++ V) ->
172 | {none, list_to_integer(V)};
173 | (R) ->
174 | case string:tokens(R, "-") of
175 | [S1, S2] ->
176 | {list_to_integer(S1), list_to_integer(S2)};
177 | [S] ->
178 | {list_to_integer(S), none}
179 | end
180 | end,
181 | Ranges)
182 | catch
183 | _:_ ->
184 | fail
185 | end.
186 |
187 | range_skip_length(Spec, Size) ->
188 | case Spec of
189 | {none, R} when R =< Size, R >= 0 ->
190 | {Size - R, R};
191 | {none, _OutOfRange} ->
192 | {0, Size};
193 | {R, none} when R >= 0, R < Size ->
194 | {R, Size - R};
195 | {_OutOfRange, none} ->
196 | invalid_range;
197 | {Start, End} when 0 =< Start, Start =< End, End < Size ->
198 | {Start, End - Start + 1};
199 | {_OutOfRange, _End} ->
200 | invalid_range
201 | end.
202 |
203 | %%
204 | %% Tests
205 | %%
206 | -include_lib("eunit/include/eunit.hrl").
207 | -ifdef(TEST).
208 |
209 | range_test() ->
210 | %% valid, single ranges
211 | ?assertEqual([{20, 30}], parse_range_request("bytes=20-30")),
212 | ?assertEqual([{20, none}], parse_range_request("bytes=20-")),
213 | ?assertEqual([{none, 20}], parse_range_request("bytes=-20")),
214 |
215 | %% trivial single range
216 | ?assertEqual(undefined, parse_range_request("bytes=0-")),
217 |
218 | %% invalid, single ranges
219 | ?assertEqual(fail, parse_range_request("")),
220 | ?assertEqual(fail, parse_range_request("garbage")),
221 | ?assertEqual(fail, parse_range_request("bytes=-20-30")),
222 |
223 | %% valid, multiple range
224 | ?assertEqual(
225 | [{20, 30}, {50, 100}, {110, 200}],
226 | parse_range_request("bytes=20-30,50-100,110-200")),
227 | ?assertEqual(
228 | [{20, none}, {50, 100}, {none, 200}],
229 | parse_range_request("bytes=20-,50-100,-200")),
230 |
231 | %% no ranges
232 | ?assertEqual([], parse_range_request("bytes=")),
233 | ok.
234 |
235 | range_skip_length_test() ->
236 | Body = <<"012345678901234567890123456789012345678901234567890123456789">>,
237 | BodySize = byte_size(Body), %% 60
238 | BodySize = 60,
239 |
240 | %% these values assume BodySize =:= 60
241 | ?assertEqual({1,9}, range_skip_length({1,9}, BodySize)), %% 1-9
242 | ?assertEqual({10,10}, range_skip_length({10,19}, BodySize)), %% 10-19
243 | ?assertEqual({40, 20}, range_skip_length({none, 20}, BodySize)), %% -20
244 | ?assertEqual({30, 30}, range_skip_length({30, none}, BodySize)), %% 30-
245 |
246 | %% valid edge cases for range_skip_length
247 | ?assertEqual({BodySize, 0}, range_skip_length({none, 0}, BodySize)),
248 | ?assertEqual({0, BodySize}, range_skip_length({none, BodySize}, BodySize)),
249 | ?assertEqual({0, BodySize}, range_skip_length({0, none}, BodySize)),
250 | BodySizeLess1 = BodySize - 1,
251 | ?assertEqual({BodySizeLess1, 1},
252 | range_skip_length({BodySize - 1, none}, BodySize)),
253 |
254 | %% out of range, return whole thing
255 | ?assertEqual({0, BodySize},
256 | range_skip_length({none, BodySize + 1}, BodySize)),
257 | ?assertEqual({0, BodySize},
258 | range_skip_length({none, -1}, BodySize)),
259 |
260 | %% invalid ranges
261 | ?assertEqual(invalid_range,
262 | range_skip_length({-1, 30}, BodySize)),
263 | ?assertEqual(invalid_range,
264 | range_skip_length({0, BodySize + 1}, BodySize)),
265 | ?assertEqual(invalid_range,
266 | range_skip_length({-1, BodySize + 1}, BodySize)),
267 | ?assertEqual(invalid_range,
268 | range_skip_length({BodySize, 40}, BodySize)),
269 | ?assertEqual(invalid_range,
270 | range_skip_length({-1, none}, BodySize)),
271 | ?assertEqual(invalid_range,
272 | range_skip_length({BodySize, none}, BodySize)),
273 | ok.
274 |
275 | -endif.
276 |
--------------------------------------------------------------------------------
/src/mochiweb_cookies.erl:
--------------------------------------------------------------------------------
1 | %% @author Emad El-Haraty
2 | %% @copyright 2007 Mochi Media, Inc.
3 |
4 | %% @doc HTTP Cookie parsing and generating (RFC 2109, RFC 2965).
5 |
6 | -module(mochiweb_cookies).
7 | -export([parse_cookie/1, cookie/3, cookie/2]).
8 |
9 | -define(QUOTE, $\").
10 |
11 | -define(IS_WHITESPACE(C),
12 | (C =:= $\s orelse C =:= $\t orelse C =:= $\r orelse C =:= $\n)).
13 |
14 | %% RFC 2616 separators (called tspecials in RFC 2068)
15 | -define(IS_SEPARATOR(C),
16 | (C < 32 orelse
17 | C =:= $\s orelse C =:= $\t orelse
18 | C =:= $( orelse C =:= $) orelse C =:= $< orelse C =:= $> orelse
19 | C =:= $@ orelse C =:= $, orelse C =:= $; orelse C =:= $: orelse
20 | C =:= $\\ orelse C =:= $\" orelse C =:= $/ orelse
21 | C =:= $[ orelse C =:= $] orelse C =:= $? orelse C =:= $= orelse
22 | C =:= ${ orelse C =:= $})).
23 |
24 | %% @type proplist() = [{Key::string(), Value::string()}].
25 | %% @type header() = {Name::string(), Value::string()}.
26 |
27 | %% @spec cookie(Key::string(), Value::string()) -> header()
28 | %% @doc Short-hand for cookie(Key, Value, []).
29 | cookie(Key, Value) ->
30 | cookie(Key, Value, []).
31 |
32 | %% @spec cookie(Key::string(), Value::string(), Options::[Option]) -> header()
33 | %% where Option = {max_age, integer()} | {local_time, {date(), time()}}
34 | %% | {domain, string()} | {path, string()}
35 | %% | {secure, true | false} | {http_only, true | false}
36 | %%
37 | %% @doc Generate a Set-Cookie header field tuple.
38 | cookie(Key, Value, Options) ->
39 | Cookie = [any_to_list(Key), "=", quote(Value), "; Version=1"],
40 | %% Set-Cookie:
41 | %% Comment, Domain, Max-Age, Path, Secure, Version
42 | %% Set-Cookie2:
43 | %% Comment, CommentURL, Discard, Domain, Max-Age, Path, Port, Secure,
44 | %% Version
45 | ExpiresPart =
46 | case proplists:get_value(max_age, Options) of
47 | undefined ->
48 | "";
49 | RawAge ->
50 | When = case proplists:get_value(local_time, Options) of
51 | undefined ->
52 | calendar:local_time();
53 | LocalTime ->
54 | LocalTime
55 | end,
56 | Age = case RawAge < 0 of
57 | true ->
58 | 0;
59 | false ->
60 | RawAge
61 | end,
62 | ["; Expires=", age_to_cookie_date(Age, When),
63 | "; Max-Age=", quote(Age)]
64 | end,
65 | SecurePart =
66 | case proplists:get_value(secure, Options) of
67 | true ->
68 | "; Secure";
69 | _ ->
70 | ""
71 | end,
72 | DomainPart =
73 | case proplists:get_value(domain, Options) of
74 | undefined ->
75 | "";
76 | Domain ->
77 | ["; Domain=", quote(Domain)]
78 | end,
79 | PathPart =
80 | case proplists:get_value(path, Options) of
81 | undefined ->
82 | "";
83 | Path ->
84 | ["; Path=", quote(Path)]
85 | end,
86 | HttpOnlyPart =
87 | case proplists:get_value(http_only, Options) of
88 | true ->
89 | "; HttpOnly";
90 | _ ->
91 | ""
92 | end,
93 | CookieParts = [Cookie, ExpiresPart, SecurePart, DomainPart, PathPart, HttpOnlyPart],
94 | {"Set-Cookie", lists:flatten(CookieParts)}.
95 |
96 |
97 | %% Every major browser incorrectly handles quoted strings in a
98 | %% different and (worse) incompatible manner. Instead of wasting time
99 | %% writing redundant code for each browser, we restrict cookies to
100 | %% only contain characters that browsers handle compatibly.
101 | %%
102 | %% By replacing the definition of quote with this, we generate
103 | %% RFC-compliant cookies:
104 | %%
105 | %% quote(V) ->
106 | %% Fun = fun(?QUOTE, Acc) -> [$\\, ?QUOTE | Acc];
107 | %% (Ch, Acc) -> [Ch | Acc]
108 | %% end,
109 | %% [?QUOTE | lists:foldr(Fun, [?QUOTE], V)].
110 |
111 | %% Convert to a string and raise an error if quoting is required.
112 | quote(V0) ->
113 | V = any_to_list(V0),
114 | lists:all(fun(Ch) -> Ch =:= $/ orelse not ?IS_SEPARATOR(Ch) end, V)
115 | orelse erlang:error({cookie_quoting_required, V}),
116 | V.
117 |
118 | add_seconds(Secs, LocalTime) ->
119 | Greg = calendar:datetime_to_gregorian_seconds(LocalTime),
120 | calendar:gregorian_seconds_to_datetime(Greg + Secs).
121 |
122 | age_to_cookie_date(Age, LocalTime) ->
123 | httpd_util:rfc1123_date(add_seconds(Age, LocalTime)).
124 |
125 | %% @spec parse_cookie(string()) -> [{K::string(), V::string()}]
126 | %% @doc Parse the contents of a Cookie header field, ignoring cookie
127 | %% attributes, and return a simple property list.
128 | parse_cookie("") ->
129 | [];
130 | parse_cookie(Cookie) ->
131 | parse_cookie(Cookie, []).
132 |
133 | %% Internal API
134 |
135 | parse_cookie([], Acc) ->
136 | lists:reverse(Acc);
137 | parse_cookie(String, Acc) ->
138 | {{Token, Value}, Rest} = read_pair(String),
139 | Acc1 = case Token of
140 | "" ->
141 | Acc;
142 | "$" ++ _ ->
143 | Acc;
144 | _ ->
145 | [{Token, Value} | Acc]
146 | end,
147 | parse_cookie(Rest, Acc1).
148 |
149 | read_pair(String) ->
150 | {Token, Rest} = read_token(skip_whitespace(String)),
151 | {Value, Rest1} = read_value(skip_whitespace(Rest)),
152 | {{Token, Value}, skip_past_separator(Rest1)}.
153 |
154 | read_value([$= | Value]) ->
155 | Value1 = skip_whitespace(Value),
156 | case Value1 of
157 | [?QUOTE | _] ->
158 | read_quoted(Value1);
159 | _ ->
160 | read_token(Value1)
161 | end;
162 | read_value(String) ->
163 | {"", String}.
164 |
165 | read_quoted([?QUOTE | String]) ->
166 | read_quoted(String, []).
167 |
168 | read_quoted([], Acc) ->
169 | {lists:reverse(Acc), []};
170 | read_quoted([?QUOTE | Rest], Acc) ->
171 | {lists:reverse(Acc), Rest};
172 | read_quoted([$\\, Any | Rest], Acc) ->
173 | read_quoted(Rest, [Any | Acc]);
174 | read_quoted([C | Rest], Acc) ->
175 | read_quoted(Rest, [C | Acc]).
176 |
177 | skip_whitespace(String) ->
178 | F = fun (C) -> ?IS_WHITESPACE(C) end,
179 | lists:dropwhile(F, String).
180 |
181 | read_token(String) ->
182 | F = fun (C) -> not ?IS_SEPARATOR(C) end,
183 | lists:splitwith(F, String).
184 |
185 | skip_past_separator([]) ->
186 | [];
187 | skip_past_separator([$; | Rest]) ->
188 | Rest;
189 | skip_past_separator([$, | Rest]) ->
190 | Rest;
191 | skip_past_separator([_ | Rest]) ->
192 | skip_past_separator(Rest).
193 |
194 | any_to_list(V) when is_list(V) ->
195 | V;
196 | any_to_list(V) when is_atom(V) ->
197 | atom_to_list(V);
198 | any_to_list(V) when is_binary(V) ->
199 | binary_to_list(V);
200 | any_to_list(V) when is_integer(V) ->
201 | integer_to_list(V).
202 |
203 | %%
204 | %% Tests
205 | %%
206 | -include_lib("eunit/include/eunit.hrl").
207 | -ifdef(TEST).
208 |
209 | quote_test() ->
210 | %% ?assertError eunit macro is not compatible with coverage module
211 | try quote(":wq")
212 | catch error:{cookie_quoting_required, ":wq"} -> ok
213 | end,
214 | ?assertEqual(
215 | "foo",
216 | quote(foo)),
217 | ok.
218 |
219 | parse_cookie_test() ->
220 | %% RFC example
221 | C1 = "$Version=\"1\"; Customer=\"WILE_E_COYOTE\"; $Path=\"/acme\";
222 | Part_Number=\"Rocket_Launcher_0001\"; $Path=\"/acme\";
223 | Shipping=\"FedEx\"; $Path=\"/acme\"",
224 | ?assertEqual(
225 | [{"Customer","WILE_E_COYOTE"},
226 | {"Part_Number","Rocket_Launcher_0001"},
227 | {"Shipping","FedEx"}],
228 | parse_cookie(C1)),
229 | %% Potential edge cases
230 | ?assertEqual(
231 | [{"foo", "x"}],
232 | parse_cookie("foo=\"\\x\"")),
233 | ?assertEqual(
234 | [],
235 | parse_cookie("=")),
236 | ?assertEqual(
237 | [{"foo", ""}, {"bar", ""}],
238 | parse_cookie(" foo ; bar ")),
239 | ?assertEqual(
240 | [{"foo", ""}, {"bar", ""}],
241 | parse_cookie("foo=;bar=")),
242 | ?assertEqual(
243 | [{"foo", "\";"}, {"bar", ""}],
244 | parse_cookie("foo = \"\\\";\";bar ")),
245 | ?assertEqual(
246 | [{"foo", "\";bar"}],
247 | parse_cookie("foo=\"\\\";bar")),
248 | ?assertEqual(
249 | [],
250 | parse_cookie([])),
251 | ?assertEqual(
252 | [{"foo", "bar"}, {"baz", "wibble"}],
253 | parse_cookie("foo=bar , baz=wibble ")),
254 | ok.
255 |
256 | domain_test() ->
257 | ?assertEqual(
258 | {"Set-Cookie",
259 | "Customer=WILE_E_COYOTE; "
260 | "Version=1; "
261 | "Domain=acme.com; "
262 | "HttpOnly"},
263 | cookie("Customer", "WILE_E_COYOTE",
264 | [{http_only, true}, {domain, "acme.com"}])),
265 | ok.
266 |
267 | local_time_test() ->
268 | {"Set-Cookie", S} = cookie("Customer", "WILE_E_COYOTE",
269 | [{max_age, 111}, {secure, true}]),
270 | ?assertMatch(
271 | ["Customer=WILE_E_COYOTE",
272 | " Version=1",
273 | " Expires=" ++ _,
274 | " Max-Age=111",
275 | " Secure"],
276 | string:tokens(S, ";")),
277 | ok.
278 |
279 | cookie_test() ->
280 | C1 = {"Set-Cookie",
281 | "Customer=WILE_E_COYOTE; "
282 | "Version=1; "
283 | "Path=/acme"},
284 | C1 = cookie("Customer", "WILE_E_COYOTE", [{path, "/acme"}]),
285 | C1 = cookie("Customer", "WILE_E_COYOTE",
286 | [{path, "/acme"}, {badoption, "negatory"}]),
287 | C1 = cookie('Customer', 'WILE_E_COYOTE', [{path, '/acme'}]),
288 | C1 = cookie(<<"Customer">>, <<"WILE_E_COYOTE">>, [{path, <<"/acme">>}]),
289 |
290 | {"Set-Cookie","=NoKey; Version=1"} = cookie("", "NoKey", []),
291 | {"Set-Cookie","=NoKey; Version=1"} = cookie("", "NoKey"),
292 | LocalTime = calendar:universal_time_to_local_time({{2007, 5, 15}, {13, 45, 33}}),
293 | C2 = {"Set-Cookie",
294 | "Customer=WILE_E_COYOTE; "
295 | "Version=1; "
296 | "Expires=Tue, 15 May 2007 13:45:33 GMT; "
297 | "Max-Age=0"},
298 | C2 = cookie("Customer", "WILE_E_COYOTE",
299 | [{max_age, -111}, {local_time, LocalTime}]),
300 | C3 = {"Set-Cookie",
301 | "Customer=WILE_E_COYOTE; "
302 | "Version=1; "
303 | "Expires=Wed, 16 May 2007 13:45:50 GMT; "
304 | "Max-Age=86417"},
305 | C3 = cookie("Customer", "WILE_E_COYOTE",
306 | [{max_age, 86417}, {local_time, LocalTime}]),
307 | ok.
308 |
309 | -endif.
310 |
--------------------------------------------------------------------------------
/src/mochinum.erl:
--------------------------------------------------------------------------------
1 | %% @copyright 2007 Mochi Media, Inc.
2 | %% @author Bob Ippolito
3 |
4 | %% @doc Useful numeric algorithms for floats that cover some deficiencies
5 | %% in the math module. More interesting is digits/1, which implements
6 | %% the algorithm from:
7 | %% http://www.cs.indiana.edu/~burger/fp/index.html
8 | %% See also "Printing Floating-Point Numbers Quickly and Accurately"
9 | %% in Proceedings of the SIGPLAN '96 Conference on Programming Language
10 | %% Design and Implementation.
11 |
12 | -module(mochinum).
13 | -author("Bob Ippolito ").
14 | -export([digits/1, frexp/1, int_pow/2, int_ceil/1]).
15 |
16 | %% IEEE 754 Float exponent bias
17 | -define(FLOAT_BIAS, 1022).
18 | -define(MIN_EXP, -1074).
19 | -define(BIG_POW, 4503599627370496).
20 |
21 | %% External API
22 |
23 | %% @spec digits(number()) -> string()
24 | %% @doc Returns a string that accurately represents the given integer or float
25 | %% using a conservative amount of digits. Great for generating
26 | %% human-readable output, or compact ASCII serializations for floats.
27 | digits(N) when is_integer(N) ->
28 | integer_to_list(N);
29 | digits(0.0) ->
30 | "0.0";
31 | digits(Float) ->
32 | {Frac, Exp} = frexp(Float),
33 | Exp1 = Exp - 53,
34 | Frac1 = trunc(abs(Frac) * (1 bsl 53)),
35 | [Place | Digits] = digits1(Float, Exp1, Frac1),
36 | R = insert_decimal(Place, [$0 + D || D <- Digits]),
37 | case Float < 0 of
38 | true ->
39 | [$- | R];
40 | _ ->
41 | R
42 | end.
43 |
44 | %% @spec frexp(F::float()) -> {Frac::float(), Exp::float()}
45 | %% @doc Return the fractional and exponent part of an IEEE 754 double,
46 | %% equivalent to the libc function of the same name.
47 | %% F = Frac * pow(2, Exp).
48 | frexp(F) ->
49 | frexp1(unpack(F)).
50 |
51 | %% @spec int_pow(X::integer(), N::integer()) -> Y::integer()
52 | %% @doc Moderately efficient way to exponentiate integers.
53 | %% int_pow(10, 2) = 100.
54 | int_pow(_X, 0) ->
55 | 1;
56 | int_pow(X, N) when N > 0 ->
57 | int_pow(X, N, 1).
58 |
59 | %% @spec int_ceil(F::float()) -> integer()
60 | %% @doc Return the ceiling of F as an integer. The ceiling is defined as
61 | %% F when F == trunc(F);
62 | %% trunc(F) when F < 0;
63 | %% trunc(F) + 1 when F > 0.
64 | int_ceil(X) ->
65 | T = trunc(X),
66 | case (X - T) of
67 | Neg when Neg < 0 -> T;
68 | Pos when Pos > 0 -> T + 1;
69 | _ -> T
70 | end.
71 |
72 |
73 | %% Internal API
74 |
75 | int_pow(X, N, R) when N < 2 ->
76 | R * X;
77 | int_pow(X, N, R) ->
78 | int_pow(X * X, N bsr 1, case N band 1 of 1 -> R * X; 0 -> R end).
79 |
80 | insert_decimal(0, S) ->
81 | "0." ++ S;
82 | insert_decimal(Place, S) when Place > 0 ->
83 | L = length(S),
84 | case Place - L of
85 | 0 ->
86 | S ++ ".0";
87 | N when N < 0 ->
88 | {S0, S1} = lists:split(L + N, S),
89 | S0 ++ "." ++ S1;
90 | N when N < 6 ->
91 | %% More places than digits
92 | S ++ lists:duplicate(N, $0) ++ ".0";
93 | _ ->
94 | insert_decimal_exp(Place, S)
95 | end;
96 | insert_decimal(Place, S) when Place > -6 ->
97 | "0." ++ lists:duplicate(abs(Place), $0) ++ S;
98 | insert_decimal(Place, S) ->
99 | insert_decimal_exp(Place, S).
100 |
101 | insert_decimal_exp(Place, S) ->
102 | [C | S0] = S,
103 | S1 = case S0 of
104 | [] ->
105 | "0";
106 | _ ->
107 | S0
108 | end,
109 | Exp = case Place < 0 of
110 | true ->
111 | "e-";
112 | false ->
113 | "e+"
114 | end,
115 | [C] ++ "." ++ S1 ++ Exp ++ integer_to_list(abs(Place - 1)).
116 |
117 |
118 | digits1(Float, Exp, Frac) ->
119 | Round = ((Frac band 1) =:= 0),
120 | case Exp >= 0 of
121 | true ->
122 | BExp = 1 bsl Exp,
123 | case (Frac =/= ?BIG_POW) of
124 | true ->
125 | scale((Frac * BExp * 2), 2, BExp, BExp,
126 | Round, Round, Float);
127 | false ->
128 | scale((Frac * BExp * 4), 4, (BExp * 2), BExp,
129 | Round, Round, Float)
130 | end;
131 | false ->
132 | case (Exp =:= ?MIN_EXP) orelse (Frac =/= ?BIG_POW) of
133 | true ->
134 | scale((Frac * 2), 1 bsl (1 - Exp), 1, 1,
135 | Round, Round, Float);
136 | false ->
137 | scale((Frac * 4), 1 bsl (2 - Exp), 2, 1,
138 | Round, Round, Float)
139 | end
140 | end.
141 |
142 | scale(R, S, MPlus, MMinus, LowOk, HighOk, Float) ->
143 | Est = int_ceil(math:log10(abs(Float)) - 1.0e-10),
144 | %% Note that the scheme implementation uses a 326 element look-up table
145 | %% for int_pow(10, N) where we do not.
146 | case Est >= 0 of
147 | true ->
148 | fixup(R, S * int_pow(10, Est), MPlus, MMinus, Est,
149 | LowOk, HighOk);
150 | false ->
151 | Scale = int_pow(10, -Est),
152 | fixup(R * Scale, S, MPlus * Scale, MMinus * Scale, Est,
153 | LowOk, HighOk)
154 | end.
155 |
156 | fixup(R, S, MPlus, MMinus, K, LowOk, HighOk) ->
157 | TooLow = case HighOk of
158 | true ->
159 | (R + MPlus) >= S;
160 | false ->
161 | (R + MPlus) > S
162 | end,
163 | case TooLow of
164 | true ->
165 | [(K + 1) | generate(R, S, MPlus, MMinus, LowOk, HighOk)];
166 | false ->
167 | [K | generate(R * 10, S, MPlus * 10, MMinus * 10, LowOk, HighOk)]
168 | end.
169 |
170 | generate(R0, S, MPlus, MMinus, LowOk, HighOk) ->
171 | D = R0 div S,
172 | R = R0 rem S,
173 | TC1 = case LowOk of
174 | true ->
175 | R =< MMinus;
176 | false ->
177 | R < MMinus
178 | end,
179 | TC2 = case HighOk of
180 | true ->
181 | (R + MPlus) >= S;
182 | false ->
183 | (R + MPlus) > S
184 | end,
185 | case TC1 of
186 | false ->
187 | case TC2 of
188 | false ->
189 | [D | generate(R * 10, S, MPlus * 10, MMinus * 10,
190 | LowOk, HighOk)];
191 | true ->
192 | [D + 1]
193 | end;
194 | true ->
195 | case TC2 of
196 | false ->
197 | [D];
198 | true ->
199 | case R * 2 < S of
200 | true ->
201 | [D];
202 | false ->
203 | [D + 1]
204 | end
205 | end
206 | end.
207 |
208 | unpack(Float) ->
209 | <> = <>,
210 | {Sign, Exp, Frac}.
211 |
212 | frexp1({_Sign, 0, 0}) ->
213 | {0.0, 0};
214 | frexp1({Sign, 0, Frac}) ->
215 | Exp = log2floor(Frac),
216 | <> = <>,
217 | {Frac1, -(?FLOAT_BIAS) - 52 + Exp};
218 | frexp1({Sign, Exp, Frac}) ->
219 | <> = <>,
220 | {Frac1, Exp - ?FLOAT_BIAS}.
221 |
222 | log2floor(Int) ->
223 | log2floor(Int, 0).
224 |
225 | log2floor(0, N) ->
226 | N;
227 | log2floor(Int, N) ->
228 | log2floor(Int bsr 1, 1 + N).
229 |
230 |
231 | %%
232 | %% Tests
233 | %%
234 | -include_lib("eunit/include/eunit.hrl").
235 | -ifdef(TEST).
236 |
237 | int_ceil_test() ->
238 | 1 = int_ceil(0.0001),
239 | 0 = int_ceil(0.0),
240 | 1 = int_ceil(0.99),
241 | 1 = int_ceil(1.0),
242 | -1 = int_ceil(-1.5),
243 | -2 = int_ceil(-2.0),
244 | ok.
245 |
246 | int_pow_test() ->
247 | 1 = int_pow(1, 1),
248 | 1 = int_pow(1, 0),
249 | 1 = int_pow(10, 0),
250 | 10 = int_pow(10, 1),
251 | 100 = int_pow(10, 2),
252 | 1000 = int_pow(10, 3),
253 | ok.
254 |
255 | digits_test() ->
256 | ?assertEqual("0",
257 | digits(0)),
258 | ?assertEqual("0.0",
259 | digits(0.0)),
260 | ?assertEqual("1.0",
261 | digits(1.0)),
262 | ?assertEqual("-1.0",
263 | digits(-1.0)),
264 | ?assertEqual("0.1",
265 | digits(0.1)),
266 | ?assertEqual("0.01",
267 | digits(0.01)),
268 | ?assertEqual("0.001",
269 | digits(0.001)),
270 | ?assertEqual("1.0e+6",
271 | digits(1000000.0)),
272 | ?assertEqual("0.5",
273 | digits(0.5)),
274 | ?assertEqual("4503599627370496.0",
275 | digits(4503599627370496.0)),
276 | %% small denormalized number
277 | %% 4.94065645841246544177e-324
278 | <> = <<0,0,0,0,0,0,0,1>>,
279 | ?assertEqual("4.9406564584124654e-324",
280 | digits(SmallDenorm)),
281 | ?assertEqual(SmallDenorm,
282 | list_to_float(digits(SmallDenorm))),
283 | %% large denormalized number
284 | %% 2.22507385850720088902e-308
285 | <> = <<0,15,255,255,255,255,255,255>>,
286 | ?assertEqual("2.225073858507201e-308",
287 | digits(BigDenorm)),
288 | ?assertEqual(BigDenorm,
289 | list_to_float(digits(BigDenorm))),
290 | %% small normalized number
291 | %% 2.22507385850720138309e-308
292 | <> = <<0,16,0,0,0,0,0,0>>,
293 | ?assertEqual("2.2250738585072014e-308",
294 | digits(SmallNorm)),
295 | ?assertEqual(SmallNorm,
296 | list_to_float(digits(SmallNorm))),
297 | %% large normalized number
298 | %% 1.79769313486231570815e+308
299 | <> = <<127,239,255,255,255,255,255,255>>,
300 | ?assertEqual("1.7976931348623157e+308",
301 | digits(LargeNorm)),
302 | ?assertEqual(LargeNorm,
303 | list_to_float(digits(LargeNorm))),
304 | ok.
305 |
306 | frexp_test() ->
307 | %% zero
308 | {0.0, 0} = frexp(0.0),
309 | %% one
310 | {0.5, 1} = frexp(1.0),
311 | %% negative one
312 | {-0.5, 1} = frexp(-1.0),
313 | %% small denormalized number
314 | %% 4.94065645841246544177e-324
315 | <> = <<0,0,0,0,0,0,0,1>>,
316 | {0.5, -1073} = frexp(SmallDenorm),
317 | %% large denormalized number
318 | %% 2.22507385850720088902e-308
319 | <> = <<0,15,255,255,255,255,255,255>>,
320 | {0.99999999999999978, -1022} = frexp(BigDenorm),
321 | %% small normalized number
322 | %% 2.22507385850720138309e-308
323 | <> = <<0,16,0,0,0,0,0,0>>,
324 | {0.5, -1021} = frexp(SmallNorm),
325 | %% large normalized number
326 | %% 1.79769313486231570815e+308
327 | <> = <<127,239,255,255,255,255,255,255>>,
328 | {0.99999999999999989, 1024} = frexp(LargeNorm),
329 | ok.
330 |
331 | -endif.
332 |
--------------------------------------------------------------------------------
/src/mochiweb_headers.erl:
--------------------------------------------------------------------------------
1 | %% @author Bob Ippolito
2 | %% @copyright 2007 Mochi Media, Inc.
3 |
4 | %% @doc Case preserving (but case insensitive) HTTP Header dictionary.
5 |
6 | -module(mochiweb_headers).
7 | -author('bob@mochimedia.com').
8 | -export([empty/0, from_list/1, insert/3, enter/3, get_value/2, lookup/2]).
9 | -export([delete_any/2, get_primary_value/2]).
10 | -export([default/3, enter_from_list/2, default_from_list/2]).
11 | -export([to_list/1, make/1]).
12 | -export([from_binary/1]).
13 |
14 | %% @type headers().
15 | %% @type key() = atom() | binary() | string().
16 | %% @type value() = atom() | binary() | string() | integer().
17 |
18 | %% @spec empty() -> headers()
19 | %% @doc Create an empty headers structure.
20 | empty() ->
21 | gb_trees:empty().
22 |
23 | %% @spec make(headers() | [{key(), value()}]) -> headers()
24 | %% @doc Construct a headers() from the given list.
25 | make(L) when is_list(L) ->
26 | from_list(L);
27 | %% assume a tuple is already mochiweb_headers.
28 | make(T) when is_tuple(T) ->
29 | T.
30 |
31 | %% @spec from_binary(iolist()) -> headers()
32 | %% @doc Transforms a raw HTTP header into a mochiweb headers structure.
33 | %%
34 | %% The given raw HTTP header can be one of the following:
35 | %%
36 | %% 1) A string or a binary representing a full HTTP header ending with
37 | %% double CRLF.
38 | %% Examples:
39 | %% ```
40 | %% "Content-Length: 47\r\nContent-Type: text/plain\r\n\r\n"
41 | %% <<"Content-Length: 47\r\nContent-Type: text/plain\r\n\r\n">>'''
42 | %%
43 | %% 2) A list of binaries or strings where each element represents a raw
44 | %% HTTP header line ending with a single CRLF.
45 | %% Examples:
46 | %% ```
47 | %% [<<"Content-Length: 47\r\n">>, <<"Content-Type: text/plain\r\n">>]
48 | %% ["Content-Length: 47\r\n", "Content-Type: text/plain\r\n"]
49 | %% ["Content-Length: 47\r\n", <<"Content-Type: text/plain\r\n">>]'''
50 | %%
51 | from_binary(RawHttpHeader) when is_binary(RawHttpHeader) ->
52 | from_binary(RawHttpHeader, []);
53 | from_binary(RawHttpHeaderList) ->
54 | from_binary(list_to_binary([RawHttpHeaderList, "\r\n"])).
55 |
56 | from_binary(RawHttpHeader, Acc) ->
57 | case erlang:decode_packet(httph, RawHttpHeader, []) of
58 | {ok, {http_header, _, H, _, V}, Rest} ->
59 | from_binary(Rest, [{H, V} | Acc]);
60 | _ ->
61 | make(Acc)
62 | end.
63 |
64 | %% @spec from_list([{key(), value()}]) -> headers()
65 | %% @doc Construct a headers() from the given list.
66 | from_list(List) ->
67 | lists:foldl(fun ({K, V}, T) -> insert(K, V, T) end, empty(), List).
68 |
69 | %% @spec enter_from_list([{key(), value()}], headers()) -> headers()
70 | %% @doc Insert pairs into the headers, replace any values for existing keys.
71 | enter_from_list(List, T) ->
72 | lists:foldl(fun ({K, V}, T1) -> enter(K, V, T1) end, T, List).
73 |
74 | %% @spec default_from_list([{key(), value()}], headers()) -> headers()
75 | %% @doc Insert pairs into the headers for keys that do not already exist.
76 | default_from_list(List, T) ->
77 | lists:foldl(fun ({K, V}, T1) -> default(K, V, T1) end, T, List).
78 |
79 | %% @spec to_list(headers()) -> [{key(), string()}]
80 | %% @doc Return the contents of the headers. The keys will be the exact key
81 | %% that was first inserted (e.g. may be an atom or binary, case is
82 | %% preserved).
83 | to_list(T) ->
84 | F = fun ({K, {array, L}}, Acc) ->
85 | L1 = lists:reverse(L),
86 | lists:foldl(fun (V, Acc1) -> [{K, V} | Acc1] end, Acc, L1);
87 | (Pair, Acc) ->
88 | [Pair | Acc]
89 | end,
90 | lists:reverse(lists:foldl(F, [], gb_trees:values(T))).
91 |
92 | %% @spec get_value(key(), headers()) -> string() | undefined
93 | %% @doc Return the value of the given header using a case insensitive search.
94 | %% undefined will be returned for keys that are not present.
95 | get_value(K, T) ->
96 | case lookup(K, T) of
97 | {value, {_, V}} ->
98 | expand(V);
99 | none ->
100 | undefined
101 | end.
102 |
103 | %% @spec get_primary_value(key(), headers()) -> string() | undefined
104 | %% @doc Return the value of the given header up to the first semicolon using
105 | %% a case insensitive search. undefined will be returned for keys
106 | %% that are not present.
107 | get_primary_value(K, T) ->
108 | case get_value(K, T) of
109 | undefined ->
110 | undefined;
111 | V ->
112 | lists:takewhile(fun (C) -> C =/= $; end, V)
113 | end.
114 |
115 | %% @spec lookup(key(), headers()) -> {value, {key(), string()}} | none
116 | %% @doc Return the case preserved key and value for the given header using
117 | %% a case insensitive search. none will be returned for keys that are
118 | %% not present.
119 | lookup(K, T) ->
120 | case gb_trees:lookup(normalize(K), T) of
121 | {value, {K0, V}} ->
122 | {value, {K0, expand(V)}};
123 | none ->
124 | none
125 | end.
126 |
127 | %% @spec default(key(), value(), headers()) -> headers()
128 | %% @doc Insert the pair into the headers if it does not already exist.
129 | default(K, V, T) ->
130 | K1 = normalize(K),
131 | V1 = any_to_list(V),
132 | try gb_trees:insert(K1, {K, V1}, T)
133 | catch
134 | error:{key_exists, _} ->
135 | T
136 | end.
137 |
138 | %% @spec enter(key(), value(), headers()) -> headers()
139 | %% @doc Insert the pair into the headers, replacing any pre-existing key.
140 | enter(K, V, T) ->
141 | K1 = normalize(K),
142 | V1 = any_to_list(V),
143 | gb_trees:enter(K1, {K, V1}, T).
144 |
145 | %% @spec insert(key(), value(), headers()) -> headers()
146 | %% @doc Insert the pair into the headers, merging with any pre-existing key.
147 | %% A merge is done with Value = V0 ++ ", " ++ V1.
148 | insert(K, V, T) ->
149 | K1 = normalize(K),
150 | V1 = any_to_list(V),
151 | try gb_trees:insert(K1, {K, V1}, T)
152 | catch
153 | error:{key_exists, _} ->
154 | {K0, V0} = gb_trees:get(K1, T),
155 | V2 = merge(K1, V1, V0),
156 | gb_trees:update(K1, {K0, V2}, T)
157 | end.
158 |
159 | %% @spec delete_any(key(), headers()) -> headers()
160 | %% @doc Delete the header corresponding to key if it is present.
161 | delete_any(K, T) ->
162 | K1 = normalize(K),
163 | gb_trees:delete_any(K1, T).
164 |
165 | %% Internal API
166 |
167 | expand({array, L}) ->
168 | mochiweb_util:join(lists:reverse(L), ", ");
169 | expand(V) ->
170 | V.
171 |
172 | merge("set-cookie", V1, {array, L}) ->
173 | {array, [V1 | L]};
174 | merge("set-cookie", V1, V0) ->
175 | {array, [V1, V0]};
176 | merge(_, V1, V0) ->
177 | V0 ++ ", " ++ V1.
178 |
179 | normalize(K) when is_list(K) ->
180 | string:to_lower(K);
181 | normalize(K) when is_atom(K) ->
182 | normalize(atom_to_list(K));
183 | normalize(K) when is_binary(K) ->
184 | normalize(binary_to_list(K)).
185 |
186 | any_to_list(V) when is_list(V) ->
187 | V;
188 | any_to_list(V) when is_atom(V) ->
189 | atom_to_list(V);
190 | any_to_list(V) when is_binary(V) ->
191 | binary_to_list(V);
192 | any_to_list(V) when is_integer(V) ->
193 | integer_to_list(V).
194 |
195 | %%
196 | %% Tests.
197 | %%
198 | -include_lib("eunit/include/eunit.hrl").
199 | -ifdef(TEST).
200 |
201 | make_test() ->
202 | Identity = make([{hdr, foo}]),
203 | ?assertEqual(
204 | Identity,
205 | make(Identity)).
206 |
207 | enter_from_list_test() ->
208 | H = make([{hdr, foo}]),
209 | ?assertEqual(
210 | [{baz, "wibble"}, {hdr, "foo"}],
211 | to_list(enter_from_list([{baz, wibble}], H))),
212 | ?assertEqual(
213 | [{hdr, "bar"}],
214 | to_list(enter_from_list([{hdr, bar}], H))),
215 | ok.
216 |
217 | default_from_list_test() ->
218 | H = make([{hdr, foo}]),
219 | ?assertEqual(
220 | [{baz, "wibble"}, {hdr, "foo"}],
221 | to_list(default_from_list([{baz, wibble}], H))),
222 | ?assertEqual(
223 | [{hdr, "foo"}],
224 | to_list(default_from_list([{hdr, bar}], H))),
225 | ok.
226 |
227 | get_primary_value_test() ->
228 | H = make([{hdr, foo}, {baz, <<"wibble;taco">>}]),
229 | ?assertEqual(
230 | "foo",
231 | get_primary_value(hdr, H)),
232 | ?assertEqual(
233 | undefined,
234 | get_primary_value(bar, H)),
235 | ?assertEqual(
236 | "wibble",
237 | get_primary_value(<<"baz">>, H)),
238 | ok.
239 |
240 | set_cookie_test() ->
241 | H = make([{"set-cookie", foo}, {"set-cookie", bar}, {"set-cookie", baz}]),
242 | ?assertEqual(
243 | [{"set-cookie", "foo"}, {"set-cookie", "bar"}, {"set-cookie", "baz"}],
244 | to_list(H)),
245 | ok.
246 |
247 | headers_test() ->
248 | H = ?MODULE:make([{hdr, foo}, {"Hdr", "bar"}, {'Hdr', 2}]),
249 | [{hdr, "foo, bar, 2"}] = ?MODULE:to_list(H),
250 | H1 = ?MODULE:insert(taco, grande, H),
251 | [{hdr, "foo, bar, 2"}, {taco, "grande"}] = ?MODULE:to_list(H1),
252 | H2 = ?MODULE:make([{"Set-Cookie", "foo"}]),
253 | [{"Set-Cookie", "foo"}] = ?MODULE:to_list(H2),
254 | H3 = ?MODULE:insert("Set-Cookie", "bar", H2),
255 | [{"Set-Cookie", "foo"}, {"Set-Cookie", "bar"}] = ?MODULE:to_list(H3),
256 | "foo, bar" = ?MODULE:get_value("set-cookie", H3),
257 | {value, {"Set-Cookie", "foo, bar"}} = ?MODULE:lookup("set-cookie", H3),
258 | undefined = ?MODULE:get_value("shibby", H3),
259 | none = ?MODULE:lookup("shibby", H3),
260 | H4 = ?MODULE:insert("content-type",
261 | "application/x-www-form-urlencoded; charset=utf8",
262 | H3),
263 | "application/x-www-form-urlencoded" = ?MODULE:get_primary_value(
264 | "content-type", H4),
265 | H4 = ?MODULE:delete_any("nonexistent-header", H4),
266 | H3 = ?MODULE:delete_any("content-type", H4),
267 | HB = <<"Content-Length: 47\r\nContent-Type: text/plain\r\n\r\n">>,
268 | H_HB = ?MODULE:from_binary(HB),
269 | H_HB = ?MODULE:from_binary(binary_to_list(HB)),
270 | "47" = ?MODULE:get_value("Content-Length", H_HB),
271 | "text/plain" = ?MODULE:get_value("Content-Type", H_HB),
272 | L_H_HB = ?MODULE:to_list(H_HB),
273 | 2 = length(L_H_HB),
274 | true = lists:member({'Content-Length', "47"}, L_H_HB),
275 | true = lists:member({'Content-Type', "text/plain"}, L_H_HB),
276 | HL = [ <<"Content-Length: 47\r\n">>, <<"Content-Type: text/plain\r\n">> ],
277 | HL2 = [ "Content-Length: 47\r\n", <<"Content-Type: text/plain\r\n">> ],
278 | HL3 = [ <<"Content-Length: 47\r\n">>, "Content-Type: text/plain\r\n" ],
279 | H_HL = ?MODULE:from_binary(HL),
280 | H_HL = ?MODULE:from_binary(HL2),
281 | H_HL = ?MODULE:from_binary(HL3),
282 | "47" = ?MODULE:get_value("Content-Length", H_HL),
283 | "text/plain" = ?MODULE:get_value("Content-Type", H_HL),
284 | L_H_HL = ?MODULE:to_list(H_HL),
285 | 2 = length(L_H_HL),
286 | true = lists:member({'Content-Length', "47"}, L_H_HL),
287 | true = lists:member({'Content-Type', "text/plain"}, L_H_HL),
288 | [] = ?MODULE:to_list(?MODULE:from_binary(<<>>)),
289 | [] = ?MODULE:to_list(?MODULE:from_binary(<<"">>)),
290 | [] = ?MODULE:to_list(?MODULE:from_binary(<<"\r\n">>)),
291 | [] = ?MODULE:to_list(?MODULE:from_binary(<<"\r\n\r\n">>)),
292 | [] = ?MODULE:to_list(?MODULE:from_binary("")),
293 | [] = ?MODULE:to_list(?MODULE:from_binary([<<>>])),
294 | [] = ?MODULE:to_list(?MODULE:from_binary([<<"">>])),
295 | [] = ?MODULE:to_list(?MODULE:from_binary([<<"\r\n">>])),
296 | [] = ?MODULE:to_list(?MODULE:from_binary([<<"\r\n\r\n">>])),
297 | ok.
298 |
299 | -endif.
300 |
--------------------------------------------------------------------------------
/src/mochiutf8.erl:
--------------------------------------------------------------------------------
1 | %% @copyright 2010 Mochi Media, Inc.
2 | %% @author Bob Ippolito
3 |
4 | %% @doc Algorithm to convert any binary to a valid UTF-8 sequence by ignoring
5 | %% invalid bytes.
6 |
7 | -module(mochiutf8).
8 | -export([valid_utf8_bytes/1, codepoint_to_bytes/1, bytes_to_codepoints/1]).
9 | -export([bytes_foldl/3, codepoint_foldl/3, read_codepoint/1, len/1]).
10 |
11 | %% External API
12 |
13 | -type unichar_low() :: 0..16#d7ff.
14 | -type unichar_high() :: 16#e000..16#10ffff.
15 | -type unichar() :: unichar_low() | unichar_high().
16 |
17 | -spec codepoint_to_bytes(unichar()) -> binary().
18 | %% @doc Convert a unicode codepoint to UTF-8 bytes.
19 | codepoint_to_bytes(C) when (C >= 16#00 andalso C =< 16#7f) ->
20 | %% U+0000 - U+007F - 7 bits
21 | <>;
22 | codepoint_to_bytes(C) when (C >= 16#080 andalso C =< 16#07FF) ->
23 | %% U+0080 - U+07FF - 11 bits
24 | <<0:5, B1:5, B0:6>> = <>,
25 | <<2#110:3, B1:5,
26 | 2#10:2, B0:6>>;
27 | codepoint_to_bytes(C) when (C >= 16#0800 andalso C =< 16#FFFF) andalso
28 | (C < 16#D800 orelse C > 16#DFFF) ->
29 | %% U+0800 - U+FFFF - 16 bits (excluding UTC-16 surrogate code points)
30 | <> = <>,
31 | <<2#1110:4, B2:4,
32 | 2#10:2, B1:6,
33 | 2#10:2, B0:6>>;
34 | codepoint_to_bytes(C) when (C >= 16#010000 andalso C =< 16#10FFFF) ->
35 | %% U+10000 - U+10FFFF - 21 bits
36 | <<0:3, B3:3, B2:6, B1:6, B0:6>> = <>,
37 | <<2#11110:5, B3:3,
38 | 2#10:2, B2:6,
39 | 2#10:2, B1:6,
40 | 2#10:2, B0:6>>.
41 |
42 | -spec codepoints_to_bytes([unichar()]) -> binary().
43 | %% @doc Convert a list of codepoints to a UTF-8 binary.
44 | codepoints_to_bytes(L) ->
45 | <<<<(codepoint_to_bytes(C))/binary>> || C <- L>>.
46 |
47 | -spec read_codepoint(binary()) -> {unichar(), binary(), binary()}.
48 | read_codepoint(Bin = <<2#0:1, C:7, Rest/binary>>) ->
49 | %% U+0000 - U+007F - 7 bits
50 | <> = Bin,
51 | {C, B, Rest};
52 | read_codepoint(Bin = <<2#110:3, B1:5,
53 | 2#10:2, B0:6,
54 | Rest/binary>>) ->
55 | %% U+0080 - U+07FF - 11 bits
56 | case <> of
57 | <> when C >= 16#80 ->
58 | <> = Bin,
59 | {C, B, Rest}
60 | end;
61 | read_codepoint(Bin = <<2#1110:4, B2:4,
62 | 2#10:2, B1:6,
63 | 2#10:2, B0:6,
64 | Rest/binary>>) ->
65 | %% U+0800 - U+FFFF - 16 bits (excluding UTC-16 surrogate code points)
66 | case <> of
67 | <> when (C >= 16#0800 andalso C =< 16#FFFF) andalso
68 | (C < 16#D800 orelse C > 16#DFFF) ->
69 | <> = Bin,
70 | {C, B, Rest}
71 | end;
72 | read_codepoint(Bin = <<2#11110:5, B3:3,
73 | 2#10:2, B2:6,
74 | 2#10:2, B1:6,
75 | 2#10:2, B0:6,
76 | Rest/binary>>) ->
77 | %% U+10000 - U+10FFFF - 21 bits
78 | case <> of
79 | <> when (C >= 16#010000 andalso C =< 16#10FFFF) ->
80 | <> = Bin,
81 | {C, B, Rest}
82 | end.
83 |
84 | -spec codepoint_foldl(fun((unichar(), _) -> _), _, binary()) -> _.
85 | codepoint_foldl(F, Acc, <<>>) when is_function(F, 2) ->
86 | Acc;
87 | codepoint_foldl(F, Acc, Bin) ->
88 | {C, _, Rest} = read_codepoint(Bin),
89 | codepoint_foldl(F, F(C, Acc), Rest).
90 |
91 | -spec bytes_foldl(fun((binary(), _) -> _), _, binary()) -> _.
92 | bytes_foldl(F, Acc, <<>>) when is_function(F, 2) ->
93 | Acc;
94 | bytes_foldl(F, Acc, Bin) ->
95 | {_, B, Rest} = read_codepoint(Bin),
96 | bytes_foldl(F, F(B, Acc), Rest).
97 |
98 | -spec bytes_to_codepoints(binary()) -> [unichar()].
99 | bytes_to_codepoints(B) ->
100 | lists:reverse(codepoint_foldl(fun (C, Acc) -> [C | Acc] end, [], B)).
101 |
102 | -spec len(binary()) -> non_neg_integer().
103 | len(<<>>) ->
104 | 0;
105 | len(B) ->
106 | {_, _, Rest} = read_codepoint(B),
107 | 1 + len(Rest).
108 |
109 | -spec valid_utf8_bytes(B::binary()) -> binary().
110 | %% @doc Return only the bytes in B that represent valid UTF-8. Uses
111 | %% the following recursive algorithm: skip one byte if B does not
112 | %% follow UTF-8 syntax (a 1-4 byte encoding of some number),
113 | %% skip sequence of 2-4 bytes if it represents an overlong encoding
114 | %% or bad code point (surrogate U+D800 - U+DFFF or > U+10FFFF).
115 | valid_utf8_bytes(B) when is_binary(B) ->
116 | binary_skip_bytes(B, invalid_utf8_indexes(B)).
117 |
118 | %% Internal API
119 |
120 | -spec binary_skip_bytes(binary(), [non_neg_integer()]) -> binary().
121 | %% @doc Return B, but skipping the 0-based indexes in L.
122 | binary_skip_bytes(B, []) ->
123 | B;
124 | binary_skip_bytes(B, L) ->
125 | binary_skip_bytes(B, L, 0, []).
126 |
127 | %% @private
128 | -spec binary_skip_bytes(binary(), [non_neg_integer()], non_neg_integer(), iolist()) -> binary().
129 | binary_skip_bytes(B, [], _N, Acc) ->
130 | iolist_to_binary(lists:reverse([B | Acc]));
131 | binary_skip_bytes(<<_, RestB/binary>>, [N | RestL], N, Acc) ->
132 | binary_skip_bytes(RestB, RestL, 1 + N, Acc);
133 | binary_skip_bytes(<>, L, N, Acc) ->
134 | binary_skip_bytes(RestB, L, 1 + N, [C | Acc]).
135 |
136 | -spec invalid_utf8_indexes(binary()) -> [non_neg_integer()].
137 | %% @doc Return the 0-based indexes in B that are not valid UTF-8.
138 | invalid_utf8_indexes(B) ->
139 | invalid_utf8_indexes(B, 0, []).
140 |
141 | %% @private.
142 | -spec invalid_utf8_indexes(binary(), non_neg_integer(), [non_neg_integer()]) -> [non_neg_integer()].
143 | invalid_utf8_indexes(<>, N, Acc) when C < 16#80 ->
144 | %% U+0000 - U+007F - 7 bits
145 | invalid_utf8_indexes(Rest, 1 + N, Acc);
146 | invalid_utf8_indexes(<>, N, Acc)
147 | when C1 band 16#E0 =:= 16#C0,
148 | C2 band 16#C0 =:= 16#80 ->
149 | %% U+0080 - U+07FF - 11 bits
150 | case ((C1 band 16#1F) bsl 6) bor (C2 band 16#3F) of
151 | C when C < 16#80 ->
152 | %% Overlong encoding.
153 | invalid_utf8_indexes(Rest, 2 + N, [1 + N, N | Acc]);
154 | _ ->
155 | %% Upper bound U+07FF does not need to be checked
156 | invalid_utf8_indexes(Rest, 2 + N, Acc)
157 | end;
158 | invalid_utf8_indexes(<>, N, Acc)
159 | when C1 band 16#F0 =:= 16#E0,
160 | C2 band 16#C0 =:= 16#80,
161 | C3 band 16#C0 =:= 16#80 ->
162 | %% U+0800 - U+FFFF - 16 bits
163 | case ((((C1 band 16#0F) bsl 6) bor (C2 band 16#3F)) bsl 6) bor
164 | (C3 band 16#3F) of
165 | C when (C < 16#800) orelse (C >= 16#D800 andalso C =< 16#DFFF) ->
166 | %% Overlong encoding or surrogate.
167 | invalid_utf8_indexes(Rest, 3 + N, [2 + N, 1 + N, N | Acc]);
168 | _ ->
169 | %% Upper bound U+FFFF does not need to be checked
170 | invalid_utf8_indexes(Rest, 3 + N, Acc)
171 | end;
172 | invalid_utf8_indexes(<>, N, Acc)
173 | when C1 band 16#F8 =:= 16#F0,
174 | C2 band 16#C0 =:= 16#80,
175 | C3 band 16#C0 =:= 16#80,
176 | C4 band 16#C0 =:= 16#80 ->
177 | %% U+10000 - U+10FFFF - 21 bits
178 | case ((((((C1 band 16#0F) bsl 6) bor (C2 band 16#3F)) bsl 6) bor
179 | (C3 band 16#3F)) bsl 6) bor (C4 band 16#3F) of
180 | C when (C < 16#10000) orelse (C > 16#10FFFF) ->
181 | %% Overlong encoding or invalid code point.
182 | invalid_utf8_indexes(Rest, 4 + N, [3 + N, 2 + N, 1 + N, N | Acc]);
183 | _ ->
184 | invalid_utf8_indexes(Rest, 4 + N, Acc)
185 | end;
186 | invalid_utf8_indexes(<<_, Rest/binary>>, N, Acc) ->
187 | %% Invalid char
188 | invalid_utf8_indexes(Rest, 1 + N, [N | Acc]);
189 | invalid_utf8_indexes(<<>>, _N, Acc) ->
190 | lists:reverse(Acc).
191 |
192 | %%
193 | %% Tests
194 | %%
195 | -include_lib("eunit/include/eunit.hrl").
196 | -ifdef(TEST).
197 |
198 | binary_skip_bytes_test() ->
199 | ?assertEqual(<<"foo">>,
200 | binary_skip_bytes(<<"foo">>, [])),
201 | ?assertEqual(<<"foobar">>,
202 | binary_skip_bytes(<<"foo bar">>, [3])),
203 | ?assertEqual(<<"foo">>,
204 | binary_skip_bytes(<<"foo bar">>, [3, 4, 5, 6])),
205 | ?assertEqual(<<"oo bar">>,
206 | binary_skip_bytes(<<"foo bar">>, [0])),
207 | ok.
208 |
209 | invalid_utf8_indexes_test() ->
210 | ?assertEqual(
211 | [],
212 | invalid_utf8_indexes(<<"unicode snowman for you: ", 226, 152, 131>>)),
213 | ?assertEqual(
214 | [0],
215 | invalid_utf8_indexes(<<128>>)),
216 | ?assertEqual(
217 | [57,59,60,64,66,67],
218 | invalid_utf8_indexes(<<"Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; (",
219 | 167, 65, 170, 186, 73, 83, 80, 166, 87, 186, 217, 41, 41>>)),
220 | ok.
221 |
222 | codepoint_to_bytes_test() ->
223 | %% U+0000 - U+007F - 7 bits
224 | %% U+0080 - U+07FF - 11 bits
225 | %% U+0800 - U+FFFF - 16 bits (excluding UTC-16 surrogate code points)
226 | %% U+10000 - U+10FFFF - 21 bits
227 | ?assertEqual(
228 | <<"a">>,
229 | codepoint_to_bytes($a)),
230 | ?assertEqual(
231 | <<16#c2, 16#80>>,
232 | codepoint_to_bytes(16#80)),
233 | ?assertEqual(
234 | <<16#df, 16#bf>>,
235 | codepoint_to_bytes(16#07ff)),
236 | ?assertEqual(
237 | <<16#ef, 16#bf, 16#bf>>,
238 | codepoint_to_bytes(16#ffff)),
239 | ?assertEqual(
240 | <<16#f4, 16#8f, 16#bf, 16#bf>>,
241 | codepoint_to_bytes(16#10ffff)),
242 | ok.
243 |
244 | bytes_foldl_test() ->
245 | ?assertEqual(
246 | <<"abc">>,
247 | bytes_foldl(fun (B, Acc) -> <> end, <<>>, <<"abc">>)),
248 | ?assertEqual(
249 | <<"abc", 226, 152, 131, 228, 184, 173, 194, 133, 244,143,191,191>>,
250 | bytes_foldl(fun (B, Acc) -> <> end, <<>>,
251 | <<"abc", 226, 152, 131, 228, 184, 173, 194, 133, 244,143,191,191>>)),
252 | ok.
253 |
254 | bytes_to_codepoints_test() ->
255 | ?assertEqual(
256 | "abc" ++ [16#2603, 16#4e2d, 16#85, 16#10ffff],
257 | bytes_to_codepoints(<<"abc", 226, 152, 131, 228, 184, 173, 194, 133, 244,143,191,191>>)),
258 | ok.
259 |
260 | codepoint_foldl_test() ->
261 | ?assertEqual(
262 | "cba",
263 | codepoint_foldl(fun (C, Acc) -> [C | Acc] end, [], <<"abc">>)),
264 | ?assertEqual(
265 | [16#10ffff, 16#85, 16#4e2d, 16#2603 | "cba"],
266 | codepoint_foldl(fun (C, Acc) -> [C | Acc] end, [],
267 | <<"abc", 226, 152, 131, 228, 184, 173, 194, 133, 244,143,191,191>>)),
268 | ok.
269 |
270 | len_test() ->
271 | ?assertEqual(
272 | 29,
273 | len(<<"unicode snowman for you: ", 226, 152, 131, 228, 184, 173, 194, 133, 244, 143, 191, 191>>)),
274 | ok.
275 |
276 | codepoints_to_bytes_test() ->
277 | ?assertEqual(
278 | iolist_to_binary(lists:map(fun codepoint_to_bytes/1, lists:seq(1, 1000))),
279 | codepoints_to_bytes(lists:seq(1, 1000))),
280 | ok.
281 |
282 | valid_utf8_bytes_test() ->
283 | ?assertEqual(
284 | <<"invalid U+11ffff: ">>,
285 | valid_utf8_bytes(<<"invalid U+11ffff: ", 244, 159, 191, 191>>)),
286 | ?assertEqual(
287 | <<"U+10ffff: ", 244, 143, 191, 191>>,
288 | valid_utf8_bytes(<<"U+10ffff: ", 244, 143, 191, 191>>)),
289 | ?assertEqual(
290 | <<"overlong 2-byte encoding (a): ">>,
291 | valid_utf8_bytes(<<"overlong 2-byte encoding (a): ", 2#11000001, 2#10100001>>)),
292 | ?assertEqual(
293 | <<"overlong 2-byte encoding (!): ">>,
294 | valid_utf8_bytes(<<"overlong 2-byte encoding (!): ", 2#11000000, 2#10100001>>)),
295 | ?assertEqual(
296 | <<"mu: ", 194, 181>>,
297 | valid_utf8_bytes(<<"mu: ", 194, 181>>)),
298 | ?assertEqual(
299 | <<"bad coding bytes: ">>,
300 | valid_utf8_bytes(<<"bad coding bytes: ", 2#10011111, 2#10111111, 2#11111111>>)),
301 | ?assertEqual(
302 | <<"low surrogate (unpaired): ">>,
303 | valid_utf8_bytes(<<"low surrogate (unpaired): ", 237, 176, 128>>)),
304 | ?assertEqual(
305 | <<"high surrogate (unpaired): ">>,
306 | valid_utf8_bytes(<<"high surrogate (unpaired): ", 237, 191, 191>>)),
307 | ?assertEqual(
308 | <<"unicode snowman for you: ", 226, 152, 131>>,
309 | valid_utf8_bytes(<<"unicode snowman for you: ", 226, 152, 131>>)),
310 | ?assertEqual(
311 | <<"Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; (AISPW))">>,
312 | valid_utf8_bytes(<<"Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; (",
313 | 167, 65, 170, 186, 73, 83, 80, 166, 87, 186, 217, 41, 41>>)),
314 | ok.
315 |
316 | -endif.
317 |
--------------------------------------------------------------------------------
/src/mochifmt.erl:
--------------------------------------------------------------------------------
1 | %% @author Bob Ippolito
2 | %% @copyright 2008 Mochi Media, Inc.
3 |
4 | %% @doc String Formatting for Erlang, inspired by Python 2.6
5 | %% (PEP 3101).
6 | %%
7 | -module(mochifmt).
8 | -author('bob@mochimedia.com').
9 | -export([format/2, format_field/2, convert_field/2, get_value/2, get_field/2]).
10 | -export([tokenize/1, format/3, get_field/3, format_field/3]).
11 | -export([bformat/2, bformat/3]).
12 | -export([f/2, f/3]).
13 |
14 | -record(conversion, {length, precision, ctype, align, fill_char, sign}).
15 |
16 | %% @spec tokenize(S::string()) -> tokens()
17 | %% @doc Tokenize a format string into mochifmt's internal format.
18 | tokenize(S) ->
19 | {?MODULE, tokenize(S, "", [])}.
20 |
21 | %% @spec convert_field(Arg, Conversion::conversion()) -> term()
22 | %% @doc Process Arg according to the given explicit conversion specifier.
23 | convert_field(Arg, "") ->
24 | Arg;
25 | convert_field(Arg, "r") ->
26 | repr(Arg);
27 | convert_field(Arg, "s") ->
28 | str(Arg).
29 |
30 | %% @spec get_value(Key::string(), Args::args()) -> term()
31 | %% @doc Get the Key from Args. If Args is a tuple then convert Key to
32 | %% an integer and get element(1 + Key, Args). If Args is a list and Key
33 | %% can be parsed as an integer then use lists:nth(1 + Key, Args),
34 | %% otherwise try and look for Key in Args as a proplist, converting
35 | %% Key to an atom or binary if necessary.
36 | get_value(Key, Args) when is_tuple(Args) ->
37 | element(1 + list_to_integer(Key), Args);
38 | get_value(Key, Args) when is_list(Args) ->
39 | try lists:nth(1 + list_to_integer(Key), Args)
40 | catch error:_ ->
41 | {_K, V} = proplist_lookup(Key, Args),
42 | V
43 | end.
44 |
45 | %% @spec get_field(Key::string(), Args) -> term()
46 | %% @doc Consecutively call get_value/2 on parts of Key delimited by ".",
47 | %% replacing Args with the result of the previous get_value. This
48 | %% is used to implement formats such as {0.0}.
49 | get_field(Key, Args) ->
50 | get_field(Key, Args, ?MODULE).
51 |
52 | %% @spec get_field(Key::string(), Args, Module) -> term()
53 | %% @doc Consecutively call Module:get_value/2 on parts of Key delimited by ".",
54 | %% replacing Args with the result of the previous get_value. This
55 | %% is used to implement formats such as {0.0}.
56 | get_field(Key, Args, Module) ->
57 | {Name, Next} = lists:splitwith(fun (C) -> C =/= $. end, Key),
58 | Res = try Module:get_value(Name, Args)
59 | catch error:undef -> get_value(Name, Args) end,
60 | case Next of
61 | "" ->
62 | Res;
63 | "." ++ S1 ->
64 | get_field(S1, Res, Module)
65 | end.
66 |
67 | %% @spec format(Format::string(), Args) -> iolist()
68 | %% @doc Format Args with Format.
69 | format(Format, Args) ->
70 | format(Format, Args, ?MODULE).
71 |
72 | %% @spec format(Format::string(), Args, Module) -> iolist()
73 | %% @doc Format Args with Format using Module.
74 | format({?MODULE, Parts}, Args, Module) ->
75 | format2(Parts, Args, Module, []);
76 | format(S, Args, Module) ->
77 | format(tokenize(S), Args, Module).
78 |
79 | %% @spec format_field(Arg, Format) -> iolist()
80 | %% @doc Format Arg with Format.
81 | format_field(Arg, Format) ->
82 | format_field(Arg, Format, ?MODULE).
83 |
84 | %% @spec format_field(Arg, Format, _Module) -> iolist()
85 | %% @doc Format Arg with Format.
86 | format_field(Arg, Format, _Module) ->
87 | F = default_ctype(Arg, parse_std_conversion(Format)),
88 | fix_padding(fix_sign(convert2(Arg, F), F), F).
89 |
90 | %% @spec f(Format::string(), Args) -> string()
91 | %% @doc Format Args with Format and return a string().
92 | f(Format, Args) ->
93 | f(Format, Args, ?MODULE).
94 |
95 | %% @spec f(Format::string(), Args, Module) -> string()
96 | %% @doc Format Args with Format using Module and return a string().
97 | f(Format, Args, Module) ->
98 | case lists:member(${, Format) of
99 | true ->
100 | binary_to_list(bformat(Format, Args, Module));
101 | false ->
102 | Format
103 | end.
104 |
105 | %% @spec bformat(Format::string(), Args) -> binary()
106 | %% @doc Format Args with Format and return a binary().
107 | bformat(Format, Args) ->
108 | iolist_to_binary(format(Format, Args)).
109 |
110 | %% @spec bformat(Format::string(), Args, Module) -> binary()
111 | %% @doc Format Args with Format using Module and return a binary().
112 | bformat(Format, Args, Module) ->
113 | iolist_to_binary(format(Format, Args, Module)).
114 |
115 | %% Internal API
116 |
117 | add_raw("", Acc) ->
118 | Acc;
119 | add_raw(S, Acc) ->
120 | [{raw, lists:reverse(S)} | Acc].
121 |
122 | tokenize([], S, Acc) ->
123 | lists:reverse(add_raw(S, Acc));
124 | tokenize("{{" ++ Rest, S, Acc) ->
125 | tokenize(Rest, "{" ++ S, Acc);
126 | tokenize("{" ++ Rest, S, Acc) ->
127 | {Format, Rest1} = tokenize_format(Rest),
128 | tokenize(Rest1, "", [{format, make_format(Format)} | add_raw(S, Acc)]);
129 | tokenize("}}" ++ Rest, S, Acc) ->
130 | tokenize(Rest, "}" ++ S, Acc);
131 | tokenize([C | Rest], S, Acc) ->
132 | tokenize(Rest, [C | S], Acc).
133 |
134 | tokenize_format(S) ->
135 | tokenize_format(S, 1, []).
136 |
137 | tokenize_format("}" ++ Rest, 1, Acc) ->
138 | {lists:reverse(Acc), Rest};
139 | tokenize_format("}" ++ Rest, N, Acc) ->
140 | tokenize_format(Rest, N - 1, "}" ++ Acc);
141 | tokenize_format("{" ++ Rest, N, Acc) ->
142 | tokenize_format(Rest, 1 + N, "{" ++ Acc);
143 | tokenize_format([C | Rest], N, Acc) ->
144 | tokenize_format(Rest, N, [C | Acc]).
145 |
146 | make_format(S) ->
147 | {Name0, Spec} = case lists:splitwith(fun (C) -> C =/= $: end, S) of
148 | {_, ""} ->
149 | {S, ""};
150 | {SN, ":" ++ SS} ->
151 | {SN, SS}
152 | end,
153 | {Name, Transform} = case lists:splitwith(fun (C) -> C =/= $! end, Name0) of
154 | {_, ""} ->
155 | {Name0, ""};
156 | {TN, "!" ++ TT} ->
157 | {TN, TT}
158 | end,
159 | {Name, Transform, Spec}.
160 |
161 | proplist_lookup(S, P) ->
162 | A = try list_to_existing_atom(S)
163 | catch error:_ -> make_ref() end,
164 | B = try list_to_binary(S)
165 | catch error:_ -> make_ref() end,
166 | proplist_lookup2({S, A, B}, P).
167 |
168 | proplist_lookup2({KS, KA, KB}, [{K, V} | _])
169 | when KS =:= K orelse KA =:= K orelse KB =:= K ->
170 | {K, V};
171 | proplist_lookup2(Keys, [_ | Rest]) ->
172 | proplist_lookup2(Keys, Rest).
173 |
174 | format2([], _Args, _Module, Acc) ->
175 | lists:reverse(Acc);
176 | format2([{raw, S} | Rest], Args, Module, Acc) ->
177 | format2(Rest, Args, Module, [S | Acc]);
178 | format2([{format, {Key, Convert, Format0}} | Rest], Args, Module, Acc) ->
179 | Format = f(Format0, Args, Module),
180 | V = case Module of
181 | ?MODULE ->
182 | V0 = get_field(Key, Args),
183 | V1 = convert_field(V0, Convert),
184 | format_field(V1, Format);
185 | _ ->
186 | V0 = try Module:get_field(Key, Args)
187 | catch error:undef -> get_field(Key, Args, Module) end,
188 | V1 = try Module:convert_field(V0, Convert)
189 | catch error:undef -> convert_field(V0, Convert) end,
190 | try Module:format_field(V1, Format)
191 | catch error:undef -> format_field(V1, Format, Module) end
192 | end,
193 | format2(Rest, Args, Module, [V | Acc]).
194 |
195 | default_ctype(_Arg, C=#conversion{ctype=N}) when N =/= undefined ->
196 | C;
197 | default_ctype(Arg, C) when is_integer(Arg) ->
198 | C#conversion{ctype=decimal};
199 | default_ctype(Arg, C) when is_float(Arg) ->
200 | C#conversion{ctype=general};
201 | default_ctype(_Arg, C) ->
202 | C#conversion{ctype=string}.
203 |
204 | fix_padding(Arg, #conversion{length=undefined}) ->
205 | Arg;
206 | fix_padding(Arg, F=#conversion{length=Length, fill_char=Fill0, align=Align0,
207 | ctype=Type}) ->
208 | Padding = Length - iolist_size(Arg),
209 | Fill = case Fill0 of
210 | undefined ->
211 | $\s;
212 | _ ->
213 | Fill0
214 | end,
215 | Align = case Align0 of
216 | undefined ->
217 | case Type of
218 | string ->
219 | left;
220 | _ ->
221 | right
222 | end;
223 | _ ->
224 | Align0
225 | end,
226 | case Padding > 0 of
227 | true ->
228 | do_padding(Arg, Padding, Fill, Align, F);
229 | false ->
230 | Arg
231 | end.
232 |
233 | do_padding(Arg, Padding, Fill, right, _F) ->
234 | [lists:duplicate(Padding, Fill), Arg];
235 | do_padding(Arg, Padding, Fill, center, _F) ->
236 | LPadding = lists:duplicate(Padding div 2, Fill),
237 | RPadding = case Padding band 1 of
238 | 1 ->
239 | [Fill | LPadding];
240 | _ ->
241 | LPadding
242 | end,
243 | [LPadding, Arg, RPadding];
244 | do_padding([$- | Arg], Padding, Fill, sign_right, _F) ->
245 | [[$- | lists:duplicate(Padding, Fill)], Arg];
246 | do_padding(Arg, Padding, Fill, sign_right, #conversion{sign=$-}) ->
247 | [lists:duplicate(Padding, Fill), Arg];
248 | do_padding([S | Arg], Padding, Fill, sign_right, #conversion{sign=S}) ->
249 | [[S | lists:duplicate(Padding, Fill)], Arg];
250 | do_padding(Arg, Padding, Fill, sign_right, #conversion{sign=undefined}) ->
251 | [lists:duplicate(Padding, Fill), Arg];
252 | do_padding(Arg, Padding, Fill, left, _F) ->
253 | [Arg | lists:duplicate(Padding, Fill)].
254 |
255 | fix_sign(Arg, #conversion{sign=$+}) when Arg >= 0 ->
256 | [$+, Arg];
257 | fix_sign(Arg, #conversion{sign=$\s}) when Arg >= 0 ->
258 | [$\s, Arg];
259 | fix_sign(Arg, _F) ->
260 | Arg.
261 |
262 | ctype($\%) -> percent;
263 | ctype($s) -> string;
264 | ctype($b) -> bin;
265 | ctype($o) -> oct;
266 | ctype($X) -> upper_hex;
267 | ctype($x) -> hex;
268 | ctype($c) -> char;
269 | ctype($d) -> decimal;
270 | ctype($g) -> general;
271 | ctype($f) -> fixed;
272 | ctype($e) -> exp.
273 |
274 | align($<) -> left;
275 | align($>) -> right;
276 | align($^) -> center;
277 | align($=) -> sign_right.
278 |
279 | convert2(Arg, F=#conversion{ctype=percent}) ->
280 | [convert2(100.0 * Arg, F#conversion{ctype=fixed}), $\%];
281 | convert2(Arg, #conversion{ctype=string}) ->
282 | str(Arg);
283 | convert2(Arg, #conversion{ctype=bin}) ->
284 | erlang:integer_to_list(Arg, 2);
285 | convert2(Arg, #conversion{ctype=oct}) ->
286 | erlang:integer_to_list(Arg, 8);
287 | convert2(Arg, #conversion{ctype=upper_hex}) ->
288 | erlang:integer_to_list(Arg, 16);
289 | convert2(Arg, #conversion{ctype=hex}) ->
290 | string:to_lower(erlang:integer_to_list(Arg, 16));
291 | convert2(Arg, #conversion{ctype=char}) when Arg < 16#80 ->
292 | [Arg];
293 | convert2(Arg, #conversion{ctype=char}) ->
294 | xmerl_ucs:to_utf8(Arg);
295 | convert2(Arg, #conversion{ctype=decimal}) ->
296 | integer_to_list(Arg);
297 | convert2(Arg, #conversion{ctype=general, precision=undefined}) ->
298 | try mochinum:digits(Arg)
299 | catch error:undef -> io_lib:format("~g", [Arg]) end;
300 | convert2(Arg, #conversion{ctype=fixed, precision=undefined}) ->
301 | io_lib:format("~f", [Arg]);
302 | convert2(Arg, #conversion{ctype=exp, precision=undefined}) ->
303 | io_lib:format("~e", [Arg]);
304 | convert2(Arg, #conversion{ctype=general, precision=P}) ->
305 | io_lib:format("~." ++ integer_to_list(P) ++ "g", [Arg]);
306 | convert2(Arg, #conversion{ctype=fixed, precision=P}) ->
307 | io_lib:format("~." ++ integer_to_list(P) ++ "f", [Arg]);
308 | convert2(Arg, #conversion{ctype=exp, precision=P}) ->
309 | io_lib:format("~." ++ integer_to_list(P) ++ "e", [Arg]).
310 |
311 | str(A) when is_atom(A) ->
312 | atom_to_list(A);
313 | str(I) when is_integer(I) ->
314 | integer_to_list(I);
315 | str(F) when is_float(F) ->
316 | try mochinum:digits(F)
317 | catch error:undef -> io_lib:format("~g", [F]) end;
318 | str(L) when is_list(L) ->
319 | L;
320 | str(B) when is_binary(B) ->
321 | B;
322 | str(P) ->
323 | repr(P).
324 |
325 | repr(P) when is_float(P) ->
326 | try mochinum:digits(P)
327 | catch error:undef -> float_to_list(P) end;
328 | repr(P) ->
329 | io_lib:format("~p", [P]).
330 |
331 | parse_std_conversion(S) ->
332 | parse_std_conversion(S, #conversion{}).
333 |
334 | parse_std_conversion("", Acc) ->
335 | Acc;
336 | parse_std_conversion([Fill, Align | Spec], Acc)
337 | when Align =:= $< orelse Align =:= $> orelse Align =:= $= orelse Align =:= $^ ->
338 | parse_std_conversion(Spec, Acc#conversion{fill_char=Fill,
339 | align=align(Align)});
340 | parse_std_conversion([Align | Spec], Acc)
341 | when Align =:= $< orelse Align =:= $> orelse Align =:= $= orelse Align =:= $^ ->
342 | parse_std_conversion(Spec, Acc#conversion{align=align(Align)});
343 | parse_std_conversion([Sign | Spec], Acc)
344 | when Sign =:= $+ orelse Sign =:= $- orelse Sign =:= $\s ->
345 | parse_std_conversion(Spec, Acc#conversion{sign=Sign});
346 | parse_std_conversion("0" ++ Spec, Acc) ->
347 | Align = case Acc#conversion.align of
348 | undefined ->
349 | sign_right;
350 | A ->
351 | A
352 | end,
353 | parse_std_conversion(Spec, Acc#conversion{fill_char=$0, align=Align});
354 | parse_std_conversion(Spec=[D|_], Acc) when D >= $0 andalso D =< $9 ->
355 | {W, Spec1} = lists:splitwith(fun (C) -> C >= $0 andalso C =< $9 end, Spec),
356 | parse_std_conversion(Spec1, Acc#conversion{length=list_to_integer(W)});
357 | parse_std_conversion([$. | Spec], Acc) ->
358 | case lists:splitwith(fun (C) -> C >= $0 andalso C =< $9 end, Spec) of
359 | {"", Spec1} ->
360 | parse_std_conversion(Spec1, Acc);
361 | {P, Spec1} ->
362 | parse_std_conversion(Spec1,
363 | Acc#conversion{precision=list_to_integer(P)})
364 | end;
365 | parse_std_conversion([Type], Acc) ->
366 | parse_std_conversion("", Acc#conversion{ctype=ctype(Type)}).
367 |
368 |
369 | %%
370 | %% Tests
371 | %%
372 | -include_lib("eunit/include/eunit.hrl").
373 | -ifdef(TEST).
374 |
375 | tokenize_test() ->
376 | {?MODULE, [{raw, "ABC"}]} = tokenize("ABC"),
377 | {?MODULE, [{format, {"0", "", ""}}]} = tokenize("{0}"),
378 | {?MODULE, [{raw, "ABC"}, {format, {"1", "", ""}}, {raw, "DEF"}]} =
379 | tokenize("ABC{1}DEF"),
380 | ok.
381 |
382 | format_test() ->
383 | <<" -4">> = bformat("{0:4}", [-4]),
384 | <<" 4">> = bformat("{0:4}", [4]),
385 | <<" 4">> = bformat("{0:{0}}", [4]),
386 | <<"4 ">> = bformat("{0:4}", ["4"]),
387 | <<"4 ">> = bformat("{0:{0}}", ["4"]),
388 | <<"1.2yoDEF">> = bformat("{2}{0}{1}{3}", {yo, "DE", 1.2, <<"F">>}),
389 | <<"cafebabe">> = bformat("{0:x}", {16#cafebabe}),
390 | <<"CAFEBABE">> = bformat("{0:X}", {16#cafebabe}),
391 | <<"CAFEBABE">> = bformat("{0:X}", {16#cafebabe}),
392 | <<"755">> = bformat("{0:o}", {8#755}),
393 | <<"a">> = bformat("{0:c}", {97}),
394 | %% Horizontal ellipsis
395 | <<226, 128, 166>> = bformat("{0:c}", {16#2026}),
396 | <<"11">> = bformat("{0:b}", {3}),
397 | <<"11">> = bformat("{0:b}", [3]),
398 | <<"11">> = bformat("{three:b}", [{three, 3}]),
399 | <<"11">> = bformat("{three:b}", [{"three", 3}]),
400 | <<"11">> = bformat("{three:b}", [{<<"three">>, 3}]),
401 | <<"\"foo\"">> = bformat("{0!r}", {"foo"}),
402 | <<"2008-5-4">> = bformat("{0.0}-{0.1}-{0.2}", {{2008,5,4}}),
403 | <<"2008-05-04">> = bformat("{0.0:04}-{0.1:02}-{0.2:02}", {{2008,5,4}}),
404 | <<"foo6bar-6">> = bformat("foo{1}{0}-{1}", {bar, 6}),
405 | <<"-'atom test'-">> = bformat("-{arg!r}-", [{arg, 'atom test'}]),
406 | <<"2008-05-04">> = bformat("{0.0:0{1.0}}-{0.1:0{1.1}}-{0.2:0{1.2}}",
407 | {{2008,5,4}, {4, 2, 2}}),
408 | ok.
409 |
410 | std_test() ->
411 | M = mochifmt_std:new(),
412 | <<"01">> = bformat("{0}{1}", [0, 1], M),
413 | ok.
414 |
415 | records_test() ->
416 | M = mochifmt_records:new([{conversion, record_info(fields, conversion)}]),
417 | R = #conversion{length=long, precision=hard, sign=peace},
418 | long = M:get_value("length", R),
419 | hard = M:get_value("precision", R),
420 | peace = M:get_value("sign", R),
421 | <<"long hard">> = bformat("{length} {precision}", R, M),
422 | <<"long hard">> = bformat("{0.length} {0.precision}", [R], M),
423 | ok.
424 |
425 | -endif.
426 |
--------------------------------------------------------------------------------
/src/mochijson.erl:
--------------------------------------------------------------------------------
1 | %% @author Bob Ippolito
2 | %% @copyright 2006 Mochi Media, Inc.
3 |
4 | %% @doc Yet another JSON (RFC 4627) library for Erlang.
5 | -module(mochijson).
6 | -author('bob@mochimedia.com').
7 | -export([encoder/1, encode/1]).
8 | -export([decoder/1, decode/1]).
9 | -export([binary_encoder/1, binary_encode/1]).
10 | -export([binary_decoder/1, binary_decode/1]).
11 |
12 | % This is a macro to placate syntax highlighters..
13 | -define(Q, $\").
14 | -define(ADV_COL(S, N), S#decoder{column=N+S#decoder.column}).
15 | -define(INC_COL(S), S#decoder{column=1+S#decoder.column}).
16 | -define(INC_LINE(S), S#decoder{column=1, line=1+S#decoder.line}).
17 |
18 | %% @type iolist() = [char() | binary() | iolist()]
19 | %% @type iodata() = iolist() | binary()
20 | %% @type json_string() = atom | string() | binary()
21 | %% @type json_number() = integer() | float()
22 | %% @type json_array() = {array, [json_term()]}
23 | %% @type json_object() = {struct, [{json_string(), json_term()}]}
24 | %% @type json_term() = json_string() | json_number() | json_array() |
25 | %% json_object()
26 | %% @type encoding() = utf8 | unicode
27 | %% @type encoder_option() = {input_encoding, encoding()} |
28 | %% {handler, function()}
29 | %% @type decoder_option() = {input_encoding, encoding()} |
30 | %% {object_hook, function()}
31 | %% @type bjson_string() = binary()
32 | %% @type bjson_number() = integer() | float()
33 | %% @type bjson_array() = [bjson_term()]
34 | %% @type bjson_object() = {struct, [{bjson_string(), bjson_term()}]}
35 | %% @type bjson_term() = bjson_string() | bjson_number() | bjson_array() |
36 | %% bjson_object()
37 | %% @type binary_encoder_option() = {handler, function()}
38 | %% @type binary_decoder_option() = {object_hook, function()}
39 |
40 | -record(encoder, {input_encoding=unicode,
41 | handler=null}).
42 |
43 | -record(decoder, {input_encoding=utf8,
44 | object_hook=null,
45 | line=1,
46 | column=1,
47 | state=null}).
48 |
49 | %% @spec encoder([encoder_option()]) -> function()
50 | %% @doc Create an encoder/1 with the given options.
51 | encoder(Options) ->
52 | State = parse_encoder_options(Options, #encoder{}),
53 | fun (O) -> json_encode(O, State) end.
54 |
55 | %% @spec encode(json_term()) -> iolist()
56 | %% @doc Encode the given as JSON to an iolist.
57 | encode(Any) ->
58 | json_encode(Any, #encoder{}).
59 |
60 | %% @spec decoder([decoder_option()]) -> function()
61 | %% @doc Create a decoder/1 with the given options.
62 | decoder(Options) ->
63 | State = parse_decoder_options(Options, #decoder{}),
64 | fun (O) -> json_decode(O, State) end.
65 |
66 | %% @spec decode(iolist()) -> json_term()
67 | %% @doc Decode the given iolist to Erlang terms.
68 | decode(S) ->
69 | json_decode(S, #decoder{}).
70 |
71 | %% @spec binary_decoder([binary_decoder_option()]) -> function()
72 | %% @doc Create a binary_decoder/1 with the given options.
73 | binary_decoder(Options) ->
74 | mochijson2:decoder(Options).
75 |
76 | %% @spec binary_encoder([binary_encoder_option()]) -> function()
77 | %% @doc Create a binary_encoder/1 with the given options.
78 | binary_encoder(Options) ->
79 | mochijson2:encoder(Options).
80 |
81 | %% @spec binary_encode(bjson_term()) -> iolist()
82 | %% @doc Encode the given as JSON to an iolist, using lists for arrays and
83 | %% binaries for strings.
84 | binary_encode(Any) ->
85 | mochijson2:encode(Any).
86 |
87 | %% @spec binary_decode(iolist()) -> bjson_term()
88 | %% @doc Decode the given iolist to Erlang terms, using lists for arrays and
89 | %% binaries for strings.
90 | binary_decode(S) ->
91 | mochijson2:decode(S).
92 |
93 | %% Internal API
94 |
95 | parse_encoder_options([], State) ->
96 | State;
97 | parse_encoder_options([{input_encoding, Encoding} | Rest], State) ->
98 | parse_encoder_options(Rest, State#encoder{input_encoding=Encoding});
99 | parse_encoder_options([{handler, Handler} | Rest], State) ->
100 | parse_encoder_options(Rest, State#encoder{handler=Handler}).
101 |
102 | parse_decoder_options([], State) ->
103 | State;
104 | parse_decoder_options([{input_encoding, Encoding} | Rest], State) ->
105 | parse_decoder_options(Rest, State#decoder{input_encoding=Encoding});
106 | parse_decoder_options([{object_hook, Hook} | Rest], State) ->
107 | parse_decoder_options(Rest, State#decoder{object_hook=Hook}).
108 |
109 | json_encode(true, _State) ->
110 | "true";
111 | json_encode(false, _State) ->
112 | "false";
113 | json_encode(null, _State) ->
114 | "null";
115 | json_encode(I, _State) when is_integer(I) ->
116 | integer_to_list(I);
117 | json_encode(F, _State) when is_float(F) ->
118 | mochinum:digits(F);
119 | json_encode(L, State) when is_list(L); is_binary(L); is_atom(L) ->
120 | json_encode_string(L, State);
121 | json_encode({array, Props}, State) when is_list(Props) ->
122 | json_encode_array(Props, State);
123 | json_encode({struct, Props}, State) when is_list(Props) ->
124 | json_encode_proplist(Props, State);
125 | json_encode(Bad, #encoder{handler=null}) ->
126 | exit({json_encode, {bad_term, Bad}});
127 | json_encode(Bad, State=#encoder{handler=Handler}) ->
128 | json_encode(Handler(Bad), State).
129 |
130 | json_encode_array([], _State) ->
131 | "[]";
132 | json_encode_array(L, State) ->
133 | F = fun (O, Acc) ->
134 | [$,, json_encode(O, State) | Acc]
135 | end,
136 | [$, | Acc1] = lists:foldl(F, "[", L),
137 | lists:reverse([$\] | Acc1]).
138 |
139 | json_encode_proplist([], _State) ->
140 | "{}";
141 | json_encode_proplist(Props, State) ->
142 | F = fun ({K, V}, Acc) ->
143 | KS = case K of
144 | K when is_atom(K) ->
145 | json_encode_string_utf8(atom_to_list(K));
146 | K when is_integer(K) ->
147 | json_encode_string(integer_to_list(K), State);
148 | K when is_list(K); is_binary(K) ->
149 | json_encode_string(K, State)
150 | end,
151 | VS = json_encode(V, State),
152 | [$,, VS, $:, KS | Acc]
153 | end,
154 | [$, | Acc1] = lists:foldl(F, "{", Props),
155 | lists:reverse([$\} | Acc1]).
156 |
157 | json_encode_string(A, _State) when is_atom(A) ->
158 | json_encode_string_unicode(xmerl_ucs:from_utf8(atom_to_list(A)));
159 | json_encode_string(B, _State) when is_binary(B) ->
160 | json_encode_string_unicode(xmerl_ucs:from_utf8(B));
161 | json_encode_string(S, #encoder{input_encoding=utf8}) ->
162 | json_encode_string_utf8(S);
163 | json_encode_string(S, #encoder{input_encoding=unicode}) ->
164 | json_encode_string_unicode(S).
165 |
166 | json_encode_string_utf8(S) ->
167 | [?Q | json_encode_string_utf8_1(S)].
168 |
169 | json_encode_string_utf8_1([C | Cs]) when C >= 0, C =< 16#7f ->
170 | NewC = case C of
171 | $\\ -> "\\\\";
172 | ?Q -> "\\\"";
173 | _ when C >= $\s, C < 16#7f -> C;
174 | $\t -> "\\t";
175 | $\n -> "\\n";
176 | $\r -> "\\r";
177 | $\f -> "\\f";
178 | $\b -> "\\b";
179 | _ when C >= 0, C =< 16#7f -> unihex(C);
180 | _ -> exit({json_encode, {bad_char, C}})
181 | end,
182 | [NewC | json_encode_string_utf8_1(Cs)];
183 | json_encode_string_utf8_1(All=[C | _]) when C >= 16#80, C =< 16#10FFFF ->
184 | [?Q | Rest] = json_encode_string_unicode(xmerl_ucs:from_utf8(All)),
185 | Rest;
186 | json_encode_string_utf8_1([]) ->
187 | "\"".
188 |
189 | json_encode_string_unicode(S) ->
190 | [?Q | json_encode_string_unicode_1(S)].
191 |
192 | json_encode_string_unicode_1([C | Cs]) ->
193 | NewC = case C of
194 | $\\ -> "\\\\";
195 | ?Q -> "\\\"";
196 | _ when C >= $\s, C < 16#7f -> C;
197 | $\t -> "\\t";
198 | $\n -> "\\n";
199 | $\r -> "\\r";
200 | $\f -> "\\f";
201 | $\b -> "\\b";
202 | _ when C >= 0, C =< 16#10FFFF -> unihex(C);
203 | _ -> exit({json_encode, {bad_char, C}})
204 | end,
205 | [NewC | json_encode_string_unicode_1(Cs)];
206 | json_encode_string_unicode_1([]) ->
207 | "\"".
208 |
209 | dehex(C) when C >= $0, C =< $9 ->
210 | C - $0;
211 | dehex(C) when C >= $a, C =< $f ->
212 | C - $a + 10;
213 | dehex(C) when C >= $A, C =< $F ->
214 | C - $A + 10.
215 |
216 | hexdigit(C) when C >= 0, C =< 9 ->
217 | C + $0;
218 | hexdigit(C) when C =< 15 ->
219 | C + $a - 10.
220 |
221 | unihex(C) when C < 16#10000 ->
222 | <> = <>,
223 | Digits = [hexdigit(D) || D <- [D3, D2, D1, D0]],
224 | [$\\, $u | Digits];
225 | unihex(C) when C =< 16#10FFFF ->
226 | N = C - 16#10000,
227 | S1 = 16#d800 bor ((N bsr 10) band 16#3ff),
228 | S2 = 16#dc00 bor (N band 16#3ff),
229 | [unihex(S1), unihex(S2)].
230 |
231 | json_decode(B, S) when is_binary(B) ->
232 | json_decode(binary_to_list(B), S);
233 | json_decode(L, S) ->
234 | {Res, L1, S1} = decode1(L, S),
235 | {eof, [], _} = tokenize(L1, S1#decoder{state=trim}),
236 | Res.
237 |
238 | decode1(L, S=#decoder{state=null}) ->
239 | case tokenize(L, S#decoder{state=any}) of
240 | {{const, C}, L1, S1} ->
241 | {C, L1, S1};
242 | {start_array, L1, S1} ->
243 | decode_array(L1, S1#decoder{state=any}, []);
244 | {start_object, L1, S1} ->
245 | decode_object(L1, S1#decoder{state=key}, [])
246 | end.
247 |
248 | make_object(V, #decoder{object_hook=null}) ->
249 | V;
250 | make_object(V, #decoder{object_hook=Hook}) ->
251 | Hook(V).
252 |
253 | decode_object(L, S=#decoder{state=key}, Acc) ->
254 | case tokenize(L, S) of
255 | {end_object, Rest, S1} ->
256 | V = make_object({struct, lists:reverse(Acc)}, S1),
257 | {V, Rest, S1#decoder{state=null}};
258 | {{const, K}, Rest, S1} when is_list(K) ->
259 | {colon, L2, S2} = tokenize(Rest, S1),
260 | {V, L3, S3} = decode1(L2, S2#decoder{state=null}),
261 | decode_object(L3, S3#decoder{state=comma}, [{K, V} | Acc])
262 | end;
263 | decode_object(L, S=#decoder{state=comma}, Acc) ->
264 | case tokenize(L, S) of
265 | {end_object, Rest, S1} ->
266 | V = make_object({struct, lists:reverse(Acc)}, S1),
267 | {V, Rest, S1#decoder{state=null}};
268 | {comma, Rest, S1} ->
269 | decode_object(Rest, S1#decoder{state=key}, Acc)
270 | end.
271 |
272 | decode_array(L, S=#decoder{state=any}, Acc) ->
273 | case tokenize(L, S) of
274 | {end_array, Rest, S1} ->
275 | {{array, lists:reverse(Acc)}, Rest, S1#decoder{state=null}};
276 | {start_array, Rest, S1} ->
277 | {Array, Rest1, S2} = decode_array(Rest, S1#decoder{state=any}, []),
278 | decode_array(Rest1, S2#decoder{state=comma}, [Array | Acc]);
279 | {start_object, Rest, S1} ->
280 | {Array, Rest1, S2} = decode_object(Rest, S1#decoder{state=key}, []),
281 | decode_array(Rest1, S2#decoder{state=comma}, [Array | Acc]);
282 | {{const, Const}, Rest, S1} ->
283 | decode_array(Rest, S1#decoder{state=comma}, [Const | Acc])
284 | end;
285 | decode_array(L, S=#decoder{state=comma}, Acc) ->
286 | case tokenize(L, S) of
287 | {end_array, Rest, S1} ->
288 | {{array, lists:reverse(Acc)}, Rest, S1#decoder{state=null}};
289 | {comma, Rest, S1} ->
290 | decode_array(Rest, S1#decoder{state=any}, Acc)
291 | end.
292 |
293 | tokenize_string(IoList=[C | _], S=#decoder{input_encoding=utf8}, Acc)
294 | when is_list(C); is_binary(C); C >= 16#7f ->
295 | List = xmerl_ucs:from_utf8(iolist_to_binary(IoList)),
296 | tokenize_string(List, S#decoder{input_encoding=unicode}, Acc);
297 | tokenize_string("\"" ++ Rest, S, Acc) ->
298 | {lists:reverse(Acc), Rest, ?INC_COL(S)};
299 | tokenize_string("\\\"" ++ Rest, S, Acc) ->
300 | tokenize_string(Rest, ?ADV_COL(S, 2), [$\" | Acc]);
301 | tokenize_string("\\\\" ++ Rest, S, Acc) ->
302 | tokenize_string(Rest, ?ADV_COL(S, 2), [$\\ | Acc]);
303 | tokenize_string("\\/" ++ Rest, S, Acc) ->
304 | tokenize_string(Rest, ?ADV_COL(S, 2), [$/ | Acc]);
305 | tokenize_string("\\b" ++ Rest, S, Acc) ->
306 | tokenize_string(Rest, ?ADV_COL(S, 2), [$\b | Acc]);
307 | tokenize_string("\\f" ++ Rest, S, Acc) ->
308 | tokenize_string(Rest, ?ADV_COL(S, 2), [$\f | Acc]);
309 | tokenize_string("\\n" ++ Rest, S, Acc) ->
310 | tokenize_string(Rest, ?ADV_COL(S, 2), [$\n | Acc]);
311 | tokenize_string("\\r" ++ Rest, S, Acc) ->
312 | tokenize_string(Rest, ?ADV_COL(S, 2), [$\r | Acc]);
313 | tokenize_string("\\t" ++ Rest, S, Acc) ->
314 | tokenize_string(Rest, ?ADV_COL(S, 2), [$\t | Acc]);
315 | tokenize_string([$\\, $u, C3, C2, C1, C0 | Rest], S, Acc) ->
316 | % coalesce UTF-16 surrogate pair?
317 | C = dehex(C0) bor
318 | (dehex(C1) bsl 4) bor
319 | (dehex(C2) bsl 8) bor
320 | (dehex(C3) bsl 12),
321 | tokenize_string(Rest, ?ADV_COL(S, 6), [C | Acc]);
322 | tokenize_string([C | Rest], S, Acc) when C >= $\s; C < 16#10FFFF ->
323 | tokenize_string(Rest, ?ADV_COL(S, 1), [C | Acc]).
324 |
325 | tokenize_number(IoList=[C | _], Mode, S=#decoder{input_encoding=utf8}, Acc)
326 | when is_list(C); is_binary(C); C >= 16#7f ->
327 | List = xmerl_ucs:from_utf8(iolist_to_binary(IoList)),
328 | tokenize_number(List, Mode, S#decoder{input_encoding=unicode}, Acc);
329 | tokenize_number([$- | Rest], sign, S, []) ->
330 | tokenize_number(Rest, int, ?INC_COL(S), [$-]);
331 | tokenize_number(Rest, sign, S, []) ->
332 | tokenize_number(Rest, int, S, []);
333 | tokenize_number([$0 | Rest], int, S, Acc) ->
334 | tokenize_number(Rest, frac, ?INC_COL(S), [$0 | Acc]);
335 | tokenize_number([C | Rest], int, S, Acc) when C >= $1, C =< $9 ->
336 | tokenize_number(Rest, int1, ?INC_COL(S), [C | Acc]);
337 | tokenize_number([C | Rest], int1, S, Acc) when C >= $0, C =< $9 ->
338 | tokenize_number(Rest, int1, ?INC_COL(S), [C | Acc]);
339 | tokenize_number(Rest, int1, S, Acc) ->
340 | tokenize_number(Rest, frac, S, Acc);
341 | tokenize_number([$., C | Rest], frac, S, Acc) when C >= $0, C =< $9 ->
342 | tokenize_number(Rest, frac1, ?ADV_COL(S, 2), [C, $. | Acc]);
343 | tokenize_number([E | Rest], frac, S, Acc) when E == $e; E == $E ->
344 | tokenize_number(Rest, esign, ?INC_COL(S), [$e, $0, $. | Acc]);
345 | tokenize_number(Rest, frac, S, Acc) ->
346 | {{int, lists:reverse(Acc)}, Rest, S};
347 | tokenize_number([C | Rest], frac1, S, Acc) when C >= $0, C =< $9 ->
348 | tokenize_number(Rest, frac1, ?INC_COL(S), [C | Acc]);
349 | tokenize_number([E | Rest], frac1, S, Acc) when E == $e; E == $E ->
350 | tokenize_number(Rest, esign, ?INC_COL(S), [$e | Acc]);
351 | tokenize_number(Rest, frac1, S, Acc) ->
352 | {{float, lists:reverse(Acc)}, Rest, S};
353 | tokenize_number([C | Rest], esign, S, Acc) when C == $-; C == $+ ->
354 | tokenize_number(Rest, eint, ?INC_COL(S), [C | Acc]);
355 | tokenize_number(Rest, esign, S, Acc) ->
356 | tokenize_number(Rest, eint, S, Acc);
357 | tokenize_number([C | Rest], eint, S, Acc) when C >= $0, C =< $9 ->
358 | tokenize_number(Rest, eint1, ?INC_COL(S), [C | Acc]);
359 | tokenize_number([C | Rest], eint1, S, Acc) when C >= $0, C =< $9 ->
360 | tokenize_number(Rest, eint1, ?INC_COL(S), [C | Acc]);
361 | tokenize_number(Rest, eint1, S, Acc) ->
362 | {{float, lists:reverse(Acc)}, Rest, S}.
363 |
364 | tokenize([], S=#decoder{state=trim}) ->
365 | {eof, [], S};
366 | tokenize([L | Rest], S) when is_list(L) ->
367 | tokenize(L ++ Rest, S);
368 | tokenize([B | Rest], S) when is_binary(B) ->
369 | tokenize(xmerl_ucs:from_utf8(B) ++ Rest, S);
370 | tokenize("\r\n" ++ Rest, S) ->
371 | tokenize(Rest, ?INC_LINE(S));
372 | tokenize("\n" ++ Rest, S) ->
373 | tokenize(Rest, ?INC_LINE(S));
374 | tokenize([C | Rest], S) when C == $\s; C == $\t ->
375 | tokenize(Rest, ?INC_COL(S));
376 | tokenize("{" ++ Rest, S) ->
377 | {start_object, Rest, ?INC_COL(S)};
378 | tokenize("}" ++ Rest, S) ->
379 | {end_object, Rest, ?INC_COL(S)};
380 | tokenize("[" ++ Rest, S) ->
381 | {start_array, Rest, ?INC_COL(S)};
382 | tokenize("]" ++ Rest, S) ->
383 | {end_array, Rest, ?INC_COL(S)};
384 | tokenize("," ++ Rest, S) ->
385 | {comma, Rest, ?INC_COL(S)};
386 | tokenize(":" ++ Rest, S) ->
387 | {colon, Rest, ?INC_COL(S)};
388 | tokenize("null" ++ Rest, S) ->
389 | {{const, null}, Rest, ?ADV_COL(S, 4)};
390 | tokenize("true" ++ Rest, S) ->
391 | {{const, true}, Rest, ?ADV_COL(S, 4)};
392 | tokenize("false" ++ Rest, S) ->
393 | {{const, false}, Rest, ?ADV_COL(S, 5)};
394 | tokenize("\"" ++ Rest, S) ->
395 | {String, Rest1, S1} = tokenize_string(Rest, ?INC_COL(S), []),
396 | {{const, String}, Rest1, S1};
397 | tokenize(L=[C | _], S) when C >= $0, C =< $9; C == $- ->
398 | case tokenize_number(L, sign, S, []) of
399 | {{int, Int}, Rest, S1} ->
400 | {{const, list_to_integer(Int)}, Rest, S1};
401 | {{float, Float}, Rest, S1} ->
402 | {{const, list_to_float(Float)}, Rest, S1}
403 | end.
404 |
405 |
406 | %%
407 | %% Tests
408 | %%
409 | -include_lib("eunit/include/eunit.hrl").
410 | -ifdef(TEST).
411 |
412 | %% testing constructs borrowed from the Yaws JSON implementation.
413 |
414 | %% Create an object from a list of Key/Value pairs.
415 |
416 | obj_new() ->
417 | {struct, []}.
418 |
419 | is_obj({struct, Props}) ->
420 | F = fun ({K, _}) when is_list(K) ->
421 | true;
422 | (_) ->
423 | false
424 | end,
425 | lists:all(F, Props).
426 |
427 | obj_from_list(Props) ->
428 | Obj = {struct, Props},
429 | case is_obj(Obj) of
430 | true -> Obj;
431 | false -> exit(json_bad_object)
432 | end.
433 |
434 | %% Test for equivalence of Erlang terms.
435 | %% Due to arbitrary order of construction, equivalent objects might
436 | %% compare unequal as erlang terms, so we need to carefully recurse
437 | %% through aggregates (tuples and objects).
438 |
439 | equiv({struct, Props1}, {struct, Props2}) ->
440 | equiv_object(Props1, Props2);
441 | equiv({array, L1}, {array, L2}) ->
442 | equiv_list(L1, L2);
443 | equiv(N1, N2) when is_number(N1), is_number(N2) -> N1 == N2;
444 | equiv(S1, S2) when is_list(S1), is_list(S2) -> S1 == S2;
445 | equiv(true, true) -> true;
446 | equiv(false, false) -> true;
447 | equiv(null, null) -> true.
448 |
449 | %% Object representation and traversal order is unknown.
450 | %% Use the sledgehammer and sort property lists.
451 |
452 | equiv_object(Props1, Props2) ->
453 | L1 = lists:keysort(1, Props1),
454 | L2 = lists:keysort(1, Props2),
455 | Pairs = lists:zip(L1, L2),
456 | true = lists:all(fun({{K1, V1}, {K2, V2}}) ->
457 | equiv(K1, K2) and equiv(V1, V2)
458 | end, Pairs).
459 |
460 | %% Recursively compare tuple elements for equivalence.
461 |
462 | equiv_list([], []) ->
463 | true;
464 | equiv_list([V1 | L1], [V2 | L2]) ->
465 | equiv(V1, V2) andalso equiv_list(L1, L2).
466 |
467 | e2j_vec_test() ->
468 | test_one(e2j_test_vec(utf8), 1).
469 |
470 | issue33_test() ->
471 | %% http://code.google.com/p/mochiweb/issues/detail?id=33
472 | Js = {struct, [{"key", [194, 163]}]},
473 | Encoder = encoder([{input_encoding, utf8}]),
474 | "{\"key\":\"\\u00a3\"}" = lists:flatten(Encoder(Js)).
475 |
476 | test_one([], _N) ->
477 | %% io:format("~p tests passed~n", [N-1]),
478 | ok;
479 | test_one([{E, J} | Rest], N) ->
480 | %% io:format("[~p] ~p ~p~n", [N, E, J]),
481 | true = equiv(E, decode(J)),
482 | true = equiv(E, decode(encode(E))),
483 | test_one(Rest, 1+N).
484 |
485 | e2j_test_vec(utf8) ->
486 | [
487 | {1, "1"},
488 | {3.1416, "3.14160"}, % text representation may truncate, trail zeroes
489 | {-1, "-1"},
490 | {-3.1416, "-3.14160"},
491 | {12.0e10, "1.20000e+11"},
492 | {1.234E+10, "1.23400e+10"},
493 | {-1.234E-10, "-1.23400e-10"},
494 | {10.0, "1.0e+01"},
495 | {123.456, "1.23456E+2"},
496 | {10.0, "1e1"},
497 | {"foo", "\"foo\""},
498 | {"foo" ++ [5] ++ "bar", "\"foo\\u0005bar\""},
499 | {"", "\"\""},
500 | {"\"", "\"\\\"\""},
501 | {"\n\n\n", "\"\\n\\n\\n\""},
502 | {"\\", "\"\\\\\""},
503 | {"\" \b\f\r\n\t\"", "\"\\\" \\b\\f\\r\\n\\t\\\"\""},
504 | {obj_new(), "{}"},
505 | {obj_from_list([{"foo", "bar"}]), "{\"foo\":\"bar\"}"},
506 | {obj_from_list([{"foo", "bar"}, {"baz", 123}]),
507 | "{\"foo\":\"bar\",\"baz\":123}"},
508 | {{array, []}, "[]"},
509 | {{array, [{array, []}]}, "[[]]"},
510 | {{array, [1, "foo"]}, "[1,\"foo\"]"},
511 |
512 | % json array in a json object
513 | {obj_from_list([{"foo", {array, [123]}}]),
514 | "{\"foo\":[123]}"},
515 |
516 | % json object in a json object
517 | {obj_from_list([{"foo", obj_from_list([{"bar", true}])}]),
518 | "{\"foo\":{\"bar\":true}}"},
519 |
520 | % fold evaluation order
521 | {obj_from_list([{"foo", {array, []}},
522 | {"bar", obj_from_list([{"baz", true}])},
523 | {"alice", "bob"}]),
524 | "{\"foo\":[],\"bar\":{\"baz\":true},\"alice\":\"bob\"}"},
525 |
526 | % json object in a json array
527 | {{array, [-123, "foo", obj_from_list([{"bar", {array, []}}]), null]},
528 | "[-123,\"foo\",{\"bar\":[]},null]"}
529 | ].
530 |
531 | -endif.
532 |
--------------------------------------------------------------------------------