├── README ├── bin ├── erlware_release_start_helper └── gen_web_server ├── config └── sys.config ├── control ├── lib ├── gen_web_server │ ├── doc │ │ └── overview.edoc │ ├── ebin │ │ └── gen_web_server.app │ └── src │ │ ├── gen_web_server.erl │ │ ├── gws_connection_sup.erl │ │ ├── gws_server.erl │ │ └── gws_web_dav_util.erl └── gen_web_server_user │ ├── doc │ └── overview.edoc │ ├── ebin │ └── gen_web_server_user.app │ └── src │ ├── gwsu_app.erl │ ├── gwsu_sup.erl │ ├── gwsu_web_server.erl │ └── gwsu_webdav_server.erl └── sinan.cfg /README: -------------------------------------------------------------------------------- 1 | Generic web server behaviour. Makes it nice and easy to build REST based interfaces. 2 | 3 | To build run sinan 4 | to install run "sinan dist" and then "faxien ir" 5 | To run run /bin/gen_web_server this will bind to port 8080 6 | 7 | Any questions can be sent to martinjlogan@erlware.org 8 | 9 | TODO 10 | 11 | Support chunking 12 | Enable user socket control to allow for ajax and other such implmentations 13 | -------------------------------------------------------------------------------- /bin/erlware_release_start_helper: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | if [ $# -lt 3 ];then 4 | echo "usage $0 [extra-args]" 5 | exit 1 6 | fi 7 | 8 | REL_NAME=$1; shift 9 | REL_VSN=$1; shift 10 | ERTS_VSN=$1; shift 11 | CONFIG_FILE_NAME=$1 12 | 13 | ERTS_DIR=$ROOTDIR/erts-$ERTS_VSN 14 | export BINDIR=$ERTS_DIR/bin 15 | export EMU=beam 16 | export PROGNAME=erl 17 | export LD_LIBRARY_PATH=$ERTS_DIR/lib 18 | 19 | export REL_DIR=$ROOTDIR/releases/$REL_NAME-$REL_VSN 20 | 21 | if [ "$CONFIG_FILE_NAME" = "no_config" ];then 22 | $BINDIR/erlexec -boot $REL_DIR/$REL_NAME $@ 23 | else 24 | shift 25 | $BINDIR/erlexec -config $REL_DIR/$CONFIG_FILE_NAME -boot $REL_DIR/$REL_NAME $@ 26 | fi 27 | -------------------------------------------------------------------------------- /bin/gen_web_server: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | PROG=$0 4 | PROG_DIR=$(cd `dirname $0`; pwd) 5 | test -h $0 && PROG=$(readlink $0) 6 | export ROOTDIR=$(dirname $PROG_DIR) 7 | 8 | #### Fill in values for these variables #### 9 | REL_NAME=gen_web_server 10 | REL_VSN=0.4.0.0 11 | ERTS_VSN=5.8 12 | INVOCATION_SUFFIX="-prefix $ROOTDIR" 13 | ########################################### 14 | 15 | $ROOTDIR/bin/erlware_release_start_helper $REL_NAME $REL_VSN $ERTS_VSN sys.config $INVOCATION_SUFFIX 16 | -------------------------------------------------------------------------------- /config/sys.config: -------------------------------------------------------------------------------- 1 | %%% -*- mode:erlang -*- 2 | %%% Warning - this config file *must* end with 3 | 4 | [ {gen_web_server, []} ]. 5 | -------------------------------------------------------------------------------- /control: -------------------------------------------------------------------------------- 1 | {control,"gen_web_server", 2 | [{package_owner,"Martin Logan"}, 3 | {package_owner_email,"martinjlogan@erlware.org"}, 4 | {categories,["tool","web"]}, 5 | {description,"A generic web server behaviour good for RESTful web service authoring"}]}. 6 | 7 | -------------------------------------------------------------------------------- /lib/gen_web_server/doc/overview.edoc: -------------------------------------------------------------------------------- 1 | @author Martin Logan 2 | @copyright 2010 Martin Logan 3 | @version 4 | 5 | -------------------------------------------------------------------------------- /lib/gen_web_server/ebin/gen_web_server.app: -------------------------------------------------------------------------------- 1 | %% This is the application resource file (.app file) for the gen_web_server, 2 | %% application. 3 | {application, gen_web_server, 4 | [{description, "An application containing the gen_web_server behaviour container and interface"}, 5 | {vsn, "0.4.0.0"}, 6 | {modules, [gen_web_server, 7 | gws_connection_sup, 8 | gws_web_dav_util, 9 | gws_server]}, 10 | {registered,[]}, 11 | {applications, [kernel, stdlib, sasl, inets]}, 12 | {start_phases, []}]}. 13 | 14 | -------------------------------------------------------------------------------- /lib/gen_web_server/src/gen_web_server.erl: -------------------------------------------------------------------------------- 1 | %%%------------------------------------------------------------------- 2 | %%% @author Martin Logan 3 | %%% @copyright (C) 2010, Martin Logan 4 | %%% @doc 5 | %%% The main interface for the gen_web_server application 6 | %%% @end 7 | %%% Created : 10 Feb 2010 by Martin Logan 8 | %%%------------------------------------------------------------------- 9 | -module(gen_web_server). 10 | 11 | %% API 12 | -export([start_link/4, start_link/3, http_reply/1, http_reply/3]). 13 | 14 | -export([behaviour_info/1]). 15 | 16 | -include("eunit.hrl"). 17 | 18 | behaviour_info(callbacks) -> 19 | [{init,1}, 20 | {head, 3}, 21 | {get, 3}, 22 | {delete, 3}, 23 | {options, 4}, 24 | {post, 4}, 25 | {put, 4}, 26 | {trace, 4}, 27 | {other_methods, 4}, 28 | {terminate, 1}]; 29 | behaviour_info(_Other) -> 30 | undefined. 31 | 32 | %%%=================================================================== 33 | %%% API 34 | %%%=================================================================== 35 | 36 | %%-------------------------------------------------------------------- 37 | %% @doc Start a new gen_web_server behaviour container. 38 | %% @spec (Callback, IP, Port, UserArgs) -> {ok, Pid} 39 | %% @end 40 | %%-------------------------------------------------------------------- 41 | start_link(Callback, IP, Port, UserArgs) -> 42 | gws_connection_sup:start_link(Callback, IP, Port, UserArgs). 43 | 44 | %% @spec start_link(Callback, Port, UserArgs) -> {ok, Pid} | ignore | {error, Error} 45 | %% @equiv start_link(Callback, DefaultIP, Port, UserArgs) 46 | start_link(Callback, Port, UserArgs) -> 47 | start_link(Callback, default_ip, Port, UserArgs). 48 | 49 | %%-------------------------------------------------------------------- 50 | %% @doc helper function for creating a very minimally specified 51 | %% http message 52 | %% @spec (Code, Headers, Body) -> ok 53 | %% @end 54 | %%-------------------------------------------------------------------- 55 | http_reply(Code, Headers, Body) when is_list(Body) -> 56 | http_reply(Code, Headers, list_to_binary(Body)); 57 | http_reply(Code, Headers, Body) -> 58 | list_to_binary(["HTTP/1.1 ", code_to_code_and_string(Code), "\r\n", 59 | format_headers(Headers), 60 | "Content-Length: ", integer_to_list(size(Body)), 61 | "\r\n\r\n", Body]). 62 | 63 | %% @spec (Code) -> ok 64 | %% @equiv http_reply(Code, [{"Content-Type", "text/html"}], "") 65 | http_reply(Code) -> 66 | http_reply(Code, [{"Content-Type", "text/html"}], <<>>). 67 | 68 | format_headers([{Header, Value}|T]) -> 69 | [tos(Header), ": ", Value, "\r\n"|format_headers(T)]; 70 | format_headers([]) -> 71 | []. 72 | 73 | tos(Val) when is_atom(Val) -> atom_to_list(Val); 74 | tos(Val) -> Val. 75 | 76 | %%%=================================================================== 77 | %%% Internal functions 78 | %%%=================================================================== 79 | 80 | %% @private 81 | %% @doc Given a number of a standard HTTP response code, return 82 | %% a binary (string) of the number and name. 83 | %% 84 | %% Example: 85 | %% ```code_to_code_and_string(404) => "404 Not Found" 86 | %% ''' 87 | %% 88 | %% The supported status codes are taken from: 89 | %% ["http://en.wikipedia.org/wiki/List_of_HTTP_status_codes"] 90 | %% 91 | %% @spec (integer()) -> binary() 92 | code_to_code_and_string(100) -> "100 Continue"; 93 | code_to_code_and_string(101) -> "101 Switching Protocols"; 94 | code_to_code_and_string(102) -> "102 Processing"; 95 | code_to_code_and_string(200) -> "200 OK"; 96 | code_to_code_and_string(201) -> "201 Created"; 97 | code_to_code_and_string(202) -> "202 Accepted"; 98 | code_to_code_and_string(203) -> "203 Non-Authoritative Information"; 99 | code_to_code_and_string(204) -> "204 No Content"; 100 | code_to_code_and_string(205) -> "205 Reset Content"; 101 | code_to_code_and_string(206) -> "206 Partial Content"; 102 | code_to_code_and_string(207) -> "207 Multi-Status"; 103 | code_to_code_and_string(300) -> "300 Multiple Choices"; 104 | code_to_code_and_string(301) -> "301 Moved Permanently"; 105 | code_to_code_and_string(302) -> "302 Found"; 106 | code_to_code_and_string(303) -> "303 See Other"; 107 | code_to_code_and_string(304) -> "304 Not Modified"; 108 | code_to_code_and_string(305) -> "305 Use Proxy"; 109 | code_to_code_and_string(307) -> "307 Temporary Redirect"; 110 | code_to_code_and_string(400) -> "400 Bad Request"; 111 | code_to_code_and_string(401) -> "401 Unauthorized"; 112 | code_to_code_and_string(402) -> "402 Payment Required"; 113 | code_to_code_and_string(403) -> "403 Forbidden"; 114 | code_to_code_and_string(404) -> "404 Not Found"; 115 | code_to_code_and_string(405) -> "405 Method Not Allowed"; 116 | code_to_code_and_string(406) -> "406 Not Acceptable"; 117 | code_to_code_and_string(407) -> "407 Proxy Authentication Required"; 118 | code_to_code_and_string(408) -> "408 Request Time-out"; 119 | code_to_code_and_string(409) -> "409 Conflict"; 120 | code_to_code_and_string(410) -> "410 Gone"; 121 | code_to_code_and_string(411) -> "411 Length Required"; 122 | code_to_code_and_string(412) -> "412 Precondition Failed"; 123 | code_to_code_and_string(413) -> "413 Request Entity Too Large"; 124 | code_to_code_and_string(414) -> "414 Request-URI Too Large"; 125 | code_to_code_and_string(415) -> "415 Unsupported Media Type"; 126 | code_to_code_and_string(416) -> "416 Requested range not satisfiable"; 127 | code_to_code_and_string(417) -> "417 Expectation Failed"; 128 | code_to_code_and_string(421) -> 129 | "421 There are too many connections from your internet address"; 130 | code_to_code_and_string(422) -> "422 Unprocessable Entity"; 131 | code_to_code_and_string(423) -> "423 Locked"; 132 | code_to_code_and_string(424) -> "424 Failed Dependency"; 133 | code_to_code_and_string(425) -> "425 Unordered Collection"; 134 | code_to_code_and_string(426) -> "426 Upgrade Required"; 135 | code_to_code_and_string(449) -> "449 Retry With"; 136 | code_to_code_and_string(500) -> "500 Internal Server Error"; 137 | code_to_code_and_string(501) -> "501 Not Implemented"; 138 | code_to_code_and_string(502) -> "502 Bad Gateway"; 139 | code_to_code_and_string(503) -> "503 Service Unavailable"; 140 | code_to_code_and_string(504) -> "504 Gateway Time-out"; 141 | code_to_code_and_string(505) -> "505 HTTP Version not supported"; 142 | code_to_code_and_string(506) -> "506 Variant Also Negotiates"; 143 | code_to_code_and_string(507) -> "507 Insufficient Storage"; 144 | code_to_code_and_string(509) -> "509 Bandwidth Limit Exceeded"; 145 | code_to_code_and_string(510) -> "510 Not Extended"; 146 | code_to_code_and_string(Code) -> Code. 147 | 148 | http_reply_test() -> 149 | Reply = <<"HTTP/1.1 200 OK\r\nContent-Type: text/html\r\nContent-Length: 0\r\n\r\n">>, 150 | ?assertMatch(Reply, http_reply(200)), 151 | Reply2 = <<"HTTP/1.1 200 OK\r\nheader: value\r\nContent-Length: 8\r\n\r\nall good">>, 152 | ?assertMatch(Reply2, http_reply(200, [{"header", "value"}], "all good")), 153 | ?assertMatch(Reply2, http_reply(200, [{"header", "value"}], <<"all good">>)), 154 | ?assertMatch(Reply2, http_reply(200, [{"header", "value"}], ["all"," good"])). 155 | -------------------------------------------------------------------------------- /lib/gen_web_server/src/gws_connection_sup.erl: -------------------------------------------------------------------------------- 1 | %%%------------------------------------------------------------------- 2 | %%% @author Martin Logan 3 | %%% @copyright (C) 2009, Martin Logan 4 | %%% @doc 5 | %%% simple one for one supervisor for handling http connections. 6 | %%% @end 7 | %%% Created : 13 May 2009 by Martin Logan 8 | %%%------------------------------------------------------------------- 9 | -module(gws_connection_sup). 10 | 11 | -behaviour(supervisor). 12 | 13 | %% API 14 | -export([start_link/4, start_child/1]). 15 | 16 | %% Supervisor callbacks 17 | -export([init/1]). 18 | 19 | -define(SERVER, ?MODULE). 20 | -define(DEFAULT_PORT, 1156). 21 | 22 | %%%=================================================================== 23 | %%% API functions 24 | %%%=================================================================== 25 | 26 | %%-------------------------------------------------------------------- 27 | %% @doc 28 | %% Starts the supervisor 29 | %% 30 | %% @spec start_link(Callback, IP, Port, UserArgs) -> {ok, Pid} | ignore | {error, Error} 31 | %% where 32 | %% IP = tuple() | default_ip 33 | %% @end 34 | %%-------------------------------------------------------------------- 35 | start_link(Callback, IP, Port, UserArgs) -> 36 | {ok, Pid} = supervisor:start_link(?MODULE, [Callback, IP, Port, UserArgs]), 37 | start_child(Pid), 38 | {ok, Pid}. 39 | 40 | %%-------------------------------------------------------------------- 41 | %% @doc 42 | %% Start a child process, an sc_connection. 43 | %% 44 | %% @spec (Server) -> void() 45 | %% @end 46 | %%-------------------------------------------------------------------- 47 | start_child(Server) -> 48 | supervisor:start_child(Server, []). 49 | 50 | %%%=================================================================== 51 | %%% Supervisor callbacks 52 | %%%=================================================================== 53 | 54 | %%-------------------------------------------------------------------- 55 | %% @private 56 | %% @doc 57 | %% Whenever a supervisor is started using supervisor:start_link/[2,3], 58 | %% this function is called by the new process to find out about 59 | %% restart strategy, maximum restart frequency and child 60 | %% specifications. 61 | %% 62 | %% @spec init(Args) -> {ok, {SupFlags, [ChildSpec]}} | 63 | %% ignore | 64 | %% {error, Reason} 65 | %% @end 66 | %%-------------------------------------------------------------------- 67 | init([Callback, IP, Port, UserArgs]) -> 68 | RestartStrategy = simple_one_for_one, 69 | MaxRestarts = 1000, 70 | MaxSecondsBetweenRestarts = 3600, 71 | 72 | SupFlags = {RestartStrategy, MaxRestarts, MaxSecondsBetweenRestarts}, 73 | 74 | Restart = temporary, 75 | Shutdown = brutal_kill, 76 | Type = worker, 77 | 78 | case IP of 79 | default_ip -> 80 | error_logger:info_msg("Start connection supervisor with ~p ~p ~p~n", [Port, Callback, UserArgs]), 81 | {ok, LSock} = gen_tcp:listen(Port, [binary, {active, false}, {packet, http_bin}, {reuseaddr, true}]); 82 | IP -> 83 | error_logger:info_msg("Start connection supervisor with ~p ~p ~p ~p~n", [IP, Port, Callback, UserArgs]), 84 | {ok, LSock} = gen_tcp:listen(Port, [binary, {active, false}, {packet, http_bin}, {reuseaddr, true}, {ip, IP}]) 85 | end, 86 | 87 | WebSocket = {gws_server, {gws_server, start_link, [Callback, LSock, UserArgs]}, 88 | Restart, Shutdown, Type, [gws_server]}, 89 | 90 | {ok, {SupFlags, [WebSocket]}}. 91 | 92 | %%%=================================================================== 93 | %%% Internal functions 94 | %%%=================================================================== 95 | -------------------------------------------------------------------------------- /lib/gen_web_server/src/gws_server.erl: -------------------------------------------------------------------------------- 1 | %%%------------------------------------------------------------------- 2 | %%% @author Martin Logan 3 | %%% @copyright (C) 2009, Martin Logan 4 | %%% @doc 5 | %%% Handle a socket connection for incomming http packets. 6 | %%% @end 7 | %%% Created : 10 Sep 2009 by Martin Logan 8 | %%%------------------------------------------------------------------- 9 | -module(gws_server). 10 | 11 | %% API 12 | -export([start_link/3]). 13 | 14 | -record(state, {lsock, socket, request_line, headers = [], body = [], 15 | content_remaining = 0, callback, user_state, parent, 16 | connection}). 17 | 18 | %%%=================================================================== 19 | %%% API 20 | %%%=================================================================== 21 | 22 | %%-------------------------------------------------------------------- 23 | %% @doc 24 | %% Starts the server 25 | %% 26 | %% @spec start_link(Callback, LSock, UserArgs) -> {ok, Pid} | ignore | {error, Error} 27 | %% @end 28 | %%-------------------------------------------------------------------- 29 | start_link(Callback, LSock, UserArgs) -> 30 | % Not using proc lib for efficiency concerns 31 | Self = self(), 32 | {ok, spawn_link(fun() -> init(Callback, LSock, UserArgs, Self) end)}. 33 | 34 | %%%=================================================================== 35 | %%% Internal functions 36 | %%%=================================================================== 37 | 38 | init(Callback, LSock, UserArgs, Parent) -> 39 | {ok, UserState} = Callback:init(UserArgs), 40 | accept(#state{lsock = LSock, callback = Callback, user_state = UserState, parent = Parent}). 41 | 42 | accept(#state{lsock = LSock, parent = Parent} = State) -> 43 | {ok, Socket} = gen_tcp:accept(LSock), 44 | gws_connection_sup:start_child(Parent), 45 | inet:setopts(Socket,[{active,once}]), 46 | collect_request_line(State#state{socket = Socket}). 47 | 48 | collect_request_line(State) -> 49 | receive 50 | {http, _Socket, {http_request, _Method, _Path, {1,1}} = RequestLine} -> 51 | inet:setopts(State#state.socket, [{active,once}]), 52 | collect_headers(State#state{request_line = RequestLine, connection = persistent}); 53 | {http, _Socket, {http_request, _Method, _Path, _HTTPVersion} = RequestLine} -> 54 | inet:setopts(State#state.socket, [{active,once}]), 55 | collect_headers(State#state{request_line = RequestLine, connection = close}); 56 | {tcp_closed, _Socket} -> 57 | ok 58 | end. 59 | 60 | collect_headers(#state{headers = Headers} = State) -> 61 | receive 62 | {http, _Socket, {http_header, _Length, 'Connection', _, <<"close">>}} -> 63 | inet:setopts(State#state.socket, [{active,once}]), 64 | collect_headers(State#state{headers = [{'Connection', <<"close">>}|Headers], connection = close}); 65 | {http, _Socket, {http_header, _Length, Value, _, <<"100-continue">>}} -> 66 | gen_tcp:send(State#state.socket, gen_web_server:http_reply(100)), 67 | inet:setopts(State#state.socket, [{active,once}]), 68 | collect_headers(State#state{headers = [{Value, <<"100-continue">>}|Headers]}); 69 | {http, _Socket, {http_header, _Length, 'Content-Length', _, Value}} -> 70 | ContentRemaining = list_to_integer(binary_to_list(Value)), 71 | inet:setopts(State#state.socket, [{active,once}]), 72 | collect_headers(State#state{headers = [{'Content-Length', Value}|Headers], content_remaining = ContentRemaining}); 73 | {http, _Socket, {http_header, _Length, Key, _, Value}} -> 74 | inet:setopts(State#state.socket, [{active,once}]), 75 | collect_headers(State#state{headers = [{Key, Value}|Headers]}); 76 | {http, _Socket, http_eoh} when State#state.content_remaining == 0 -> 77 | handle_complete_packet(State); 78 | {http, _Socket, http_eoh} -> 79 | inet:setopts(State#state.socket, [{active,once}, {packet, raw}]), 80 | collect_body(State); 81 | {tcp_closed, _Socket} -> 82 | ok 83 | end. 84 | 85 | collect_body(State) -> 86 | receive 87 | {tcp, _Socket, Packet} -> 88 | ContentRemaining = State#state.content_remaining - byte_size(Packet), 89 | Body = [Packet|State#state.body], 90 | NewState = State#state{body = Body, content_remaining = ContentRemaining}, 91 | case ContentRemaining of 92 | 0 -> 93 | handle_complete_packet(NewState); 94 | ContentLeftOver when ContentLeftOver > 0 -> 95 | inet:setopts(State#state.socket, [{active,once}]), 96 | collect_body(NewState) 97 | end; 98 | {tcp_closed, _Socket} -> 99 | ok 100 | end. 101 | 102 | handle_complete_packet(#state{body = Body} = State) when State#state.connection == persistent -> 103 | % catch and handle the callback code and send errors to terminate 104 | {Disposition, Reply, NewUserState} = callback(State#state{body = list_to_binary(lists:reverse(Body))}), 105 | NewState = State#state{user_state = NewUserState, 106 | request_line = undefined, 107 | headers = [], 108 | body = []}, 109 | case Disposition of 110 | ok -> 111 | gen_tcp:send(State#state.socket, Reply), 112 | collect_request_line(NewState); 113 | stop -> 114 | gen_tcp:send(State#state.socket, Reply), 115 | terminate(NewState) 116 | end; 117 | handle_complete_packet(#state{body = Body} = State) -> 118 | % Close the connection no matter what if the connection is not persistent 119 | {_Disposition, Reply, NewUserState} = callback(State#state{body = list_to_binary(lists:reverse(Body))}), 120 | gen_tcp:send(State#state.socket, Reply), 121 | % We always terminate with a non persistent connection 122 | terminate(State#state{user_state = NewUserState}). 123 | 124 | 125 | callback(State) -> 126 | #state{callback = Callback, 127 | request_line = RequestLine, 128 | headers = Headers, 129 | body = Body, 130 | user_state = UserState} = State, 131 | handle_message(RequestLine, Headers, Body, Callback, UserState). 132 | 133 | handle_message({http_request, 'GET', _, _} = RequestLine, Headers, _Body, CallBack, UserState) -> 134 | CallBack:get(RequestLine, Headers, UserState); 135 | handle_message({http_request, 'DELETE', _, _} = RequestLine, Headers, _Body, CallBack, UserState) -> 136 | CallBack:delete(RequestLine, Headers, UserState); 137 | handle_message({http_request, 'HEAD', _, _} = RequestLine, Headers, _Body, CallBack, UserState) -> 138 | CallBack:head(RequestLine, Headers, UserState); 139 | 140 | handle_message({http_request, 'POST', _, _} = RequestLine, Headers, Body, CallBack, UserState) -> 141 | CallBack:post(RequestLine, Headers, Body, UserState); 142 | handle_message({http_request,'PUT',_,_} = RequestLine, Headers, Body, CallBack, UserState) -> 143 | CallBack:put(RequestLine, Headers, Body, UserState); 144 | handle_message({http_request, 'TRACE', _, _} = RequestLine, Headers, Body, CallBack, UserState) -> 145 | CallBack:head(RequestLine, Headers, Body, UserState); 146 | handle_message({http_request, 'OPTIONS', _, _} = RequestLine, Headers, Body, CallBack, UserState) -> 147 | CallBack:options(RequestLine, Headers, Body, UserState); 148 | handle_message(RequestLine, Headers, Body, CallBack, UserState) -> 149 | CallBack:other_methods(RequestLine, Headers, Body, UserState). 150 | 151 | terminate(State) -> 152 | #state{callback = Callback, 153 | user_state = UserState} = State, 154 | Callback:terminate(UserState). 155 | 156 | -------------------------------------------------------------------------------- /lib/gen_web_server/src/gws_web_dav_util.erl: -------------------------------------------------------------------------------- 1 | %%%------------------------------------------------------------------- 2 | %%% @author Martin Logan 3 | %%% @copyright (C) 2010, Martin Logan 4 | %%% @doc A helper module for doing WEBDAV (RFC 4918) interaction. This 5 | %%% is curretly only used for the Portius release and is very much 6 | %%% incomplete. 7 | %%% *** READ - the whole gws_web_dav_util module is a HACK use at 8 | %%% your own risk 9 | %%% @end 10 | %%% Created : 11 Feb 2010 by Martin Logan 11 | %%%------------------------------------------------------------------- 12 | -module(gws_web_dav_util). 13 | 14 | %% API 15 | -export([ 16 | mkcol/2, 17 | delete/2, 18 | propfind/4 19 | ]). 20 | 21 | -include_lib("kernel/include/file.hrl"). 22 | -include("eunit.hrl"). 23 | 24 | 25 | %%%=================================================================== 26 | %%% API 27 | %%%=================================================================== 28 | 29 | %%-------------------------------------------------------------------- 30 | %% @doc MKCOL method helper. Correct reponse after this is 201 created. 31 | %% @spec (DocumentRoot, AbsPath) -> ok 32 | %% @end 33 | %%-------------------------------------------------------------------- 34 | mkcol(DocumentRoot, AbsPath) -> 35 | mkdir_p(filename:join(DocumentRoot, string:strip(AbsPath, left, $\/))). 36 | 37 | %%-------------------------------------------------------------------- 38 | %% @doc DELETE method helper. If a failure occurs the response should 39 | %% be either 207 or a 4xx if the response failed entirely. If a lock 40 | %% got in the way of the delete then a 423 (locked) should be returned 41 | %% @spec (DocumentRoot, AbsPath) -> ok 42 | %% @end 43 | %%-------------------------------------------------------------------- 44 | delete(DocumentRoot, AbsPath) -> 45 | delete_dir(filename:join(DocumentRoot, string:strip(AbsPath, left, $\/))). 46 | 47 | %%-------------------------------------------------------------------- 48 | %% @doc PROPFIND method helper. 49 | %% @spec (DocumentRoot, AbsPath, Host, Depth) -> ok 50 | %% @end 51 | %%-------------------------------------------------------------------- 52 | propfind(DocumentRoot, AbsPath, Host, Depth) -> 53 | Path = filename:join(DocumentRoot, string:strip(AbsPath, left, $\/)), 54 | WildCard = lists:foldl(fun(_Num, Path_) -> Path_ ++ "/*" end, Path, lists:seq(1, Depth)), 55 | FilePaths = filelib:wildcard(WildCard), 56 | % returns {TruncatedPath, ReadFileInfo} 57 | create_multistatus_response(DocumentRoot, Host,[string:strip(Path, right, $\/)|FilePaths]). 58 | 59 | create_multistatus_response(DocumentRoot, Host, FilePaths) -> 60 | case create_responses(DocumentRoot, Host, FilePaths) of 61 | [] -> 62 | error; 63 | Responses -> 64 | lists:flatten(["", 65 | "", 66 | Responses, 67 | ""]) 68 | end. 69 | 70 | create_responses(DocumentRoot, Host, [FilePath|T]) -> 71 | TruncatedPath = string:substr(FilePath, length(DocumentRoot) + 1, length(FilePath)), 72 | case catch file:read_file_info(FilePath) of 73 | {ok, ReadFileInfo} -> 74 | URL = "http://" ++ Host ++ "/" ++ TruncatedPath, 75 | [ 76 | "", 77 | "", URL, "", 78 | "", 79 | "", 80 | "", date_string(element(7,ReadFileInfo)), "en512httpd/unix-directory", httpd_util:rfc1123_date(element(6,ReadFileInfo)), "", 81 | "", 82 | "HTTP/1.1 200 OK", 83 | "", 84 | "" 85 | ] ++ create_responses(DocumentRoot, Host, T); 86 | _Error -> 87 | create_responses(DocumentRoot, Host, T) 88 | end; 89 | create_responses(_DocumentRoot, _Host, []) -> 90 | []. 91 | 92 | 93 | 94 | 95 | 96 | 97 | %%%=================================================================== 98 | %%% Internal functions 99 | %%%=================================================================== 100 | %%------------------------------------------------------------------- 101 | %% @private 102 | %% @doc 103 | %% Makes a directory including parent dirs if they are missing. 104 | %% @spec mkdir_p(Path) -> ok | exit() 105 | %% @end 106 | %%------------------------------------------------------------------- 107 | mkdir_p(Path) -> 108 | case erlang:system_info(system_architecture) of 109 | "win32" -> 110 | filelib:ensure_dir(lists:flatten([filename:absname(Path), "\\"])); 111 | _SysArch -> 112 | filelib:ensure_dir(lists:flatten([filename:absname(Path), "/"])) 113 | end. 114 | 115 | %%-------------------------------------------------------------------- 116 | %% @private 117 | %% @doc delete a non empty directory. 118 | %% @spec delete_dir(Path) -> ok 119 | %% @end 120 | %%-------------------------------------------------------------------- 121 | delete_dir(Path) -> 122 | case filelib:is_dir(Path) of 123 | false -> 124 | case filelib:is_file(Path) of 125 | false -> 126 | case file:read_link_info(Path) of 127 | {ok, LinkInfo} -> 128 | %% XXX Exploiting the structure of a record, tisk, tisk, should probably include the proper .hrl file. 129 | symlink = element(3, LinkInfo), 130 | ok = file:delete(Path); 131 | _ -> 132 | error_logger:info_msg("delete_dir/1 file does not exist ~p~n", [Path]), ok 133 | end; 134 | true -> 135 | ok = file:delete(Path) 136 | end; 137 | true -> 138 | lists:foreach(fun(ChildPath) -> delete_dir(ChildPath) end, filelib:wildcard(Path ++ "/*")), 139 | ok = file:del_dir(Path) 140 | end. 141 | 142 | date_string({{Y,Mo,D},{H,Min,S}}) -> 143 | lists:concat([Y, "-", Mo, "-", D, "T", H, ":", Min, ":", S, "Z"]). 144 | -------------------------------------------------------------------------------- /lib/gen_web_server_user/doc/overview.edoc: -------------------------------------------------------------------------------- 1 | @author Martin Logan 2 | @copyright 2010 Martin Logan 3 | @version {@vsn} 4 | 5 | -------------------------------------------------------------------------------- /lib/gen_web_server_user/ebin/gen_web_server_user.app: -------------------------------------------------------------------------------- 1 | %% This is the application resource file (.app file) for the gen_web_server, 2 | %% application. 3 | {application, gen_web_server_user, 4 | [{description, "An application that uses the gen_web_server for test and demonstration purposes"}, 5 | {vsn, "0.1.0.0"}, 6 | {modules, [gwsu_app, 7 | gwsu_sup, 8 | gwsu_webdav_server, 9 | gwsu_web_server]}, 10 | {registered,[]}, 11 | {applications, [kernel, stdlib, gen_web_server]}, 12 | {mod, {gwsu_app, []}}, 13 | {start_phases, []}]}. 14 | 15 | -------------------------------------------------------------------------------- /lib/gen_web_server_user/src/gwsu_app.erl: -------------------------------------------------------------------------------- 1 | %%%------------------------------------------------------------------- 2 | %%% @author Martin Logan 3 | %%% @copyright (C) 2010, Martin Logan 4 | %%% @doc 5 | %%% 6 | %%% @end 7 | %%% Created : 11 Feb 2010 by Martin Logan 8 | %%%------------------------------------------------------------------- 9 | -module(gwsu_app). 10 | 11 | -behaviour(application). 12 | 13 | %% Application callbacks 14 | -export([start/2, stop/1]). 15 | 16 | %%%=================================================================== 17 | %%% Application callbacks 18 | %%%=================================================================== 19 | 20 | %%-------------------------------------------------------------------- 21 | %% @private 22 | %% @doc 23 | %% This function is called whenever an application is started using 24 | %% application:start/[1,2], and should start the processes of the 25 | %% application. If the application is structured according to the OTP 26 | %% design principles as a supervision tree, this means starting the 27 | %% top supervisor of the tree. 28 | %% 29 | %% @spec start(StartType, StartArgs) -> {ok, Pid} | 30 | %% {ok, Pid, State} | 31 | %% {error, Reason} 32 | %% StartType = normal | {takeover, Node} | {failover, Node} 33 | %% StartArgs = term() 34 | %% @end 35 | %%-------------------------------------------------------------------- 36 | start(_StartType, _StartArgs) -> 37 | case gwsu_sup:start_link() of 38 | {ok, Pid} -> 39 | {ok, Pid}; 40 | Error -> 41 | Error 42 | end. 43 | 44 | %%-------------------------------------------------------------------- 45 | %% @private 46 | %% @doc 47 | %% This function is called whenever an application has stopped. It 48 | %% is intended to be the opposite of Module:start/2 and should do 49 | %% any necessary cleaning up. The return value is ignored. 50 | %% 51 | %% @spec stop(State) -> void() 52 | %% @end 53 | %%-------------------------------------------------------------------- 54 | stop(_State) -> 55 | ok. 56 | 57 | %%%=================================================================== 58 | %%% Internal functions 59 | %%%=================================================================== 60 | -------------------------------------------------------------------------------- /lib/gen_web_server_user/src/gwsu_sup.erl: -------------------------------------------------------------------------------- 1 | %%%------------------------------------------------------------------- 2 | %%% @author Martin Logan 3 | %%% @copyright (C) 2010, Martin Logan 4 | %%% @doc 5 | %%% 6 | %%% @end 7 | %%% Created : 11 Feb 2010 by Martin Logan 8 | %%%------------------------------------------------------------------- 9 | -module(gwsu_sup). 10 | 11 | -behaviour(supervisor). 12 | 13 | %% API 14 | -export([start_link/0]). 15 | 16 | %% Supervisor callbacks 17 | -export([init/1]). 18 | 19 | -define(SERVER, ?MODULE). 20 | 21 | %%%=================================================================== 22 | %%% API functions 23 | %%%=================================================================== 24 | 25 | %%-------------------------------------------------------------------- 26 | %% @doc 27 | %% Starts the supervisor 28 | %% 29 | %% @spec start_link() -> {ok, Pid} | ignore | {error, Error} 30 | %% @end 31 | %%-------------------------------------------------------------------- 32 | start_link() -> 33 | supervisor:start_link({local, ?SERVER}, ?MODULE, []). 34 | 35 | %%%=================================================================== 36 | %%% Supervisor callbacks 37 | %%%=================================================================== 38 | 39 | %%-------------------------------------------------------------------- 40 | %% @private 41 | %% @doc 42 | %% Whenever a supervisor is started using supervisor:start_link/[2,3], 43 | %% this function is called by the new process to find out about 44 | %% restart strategy, maximum restart frequency and child 45 | %% specifications. 46 | %% 47 | %% @spec init(Args) -> {ok, {SupFlags, [ChildSpec]}} | 48 | %% ignore | 49 | %% {error, Reason} 50 | %% @end 51 | %%-------------------------------------------------------------------- 52 | init([]) -> 53 | RestartStrategy = one_for_one, 54 | MaxRestarts = 1000, 55 | MaxSecondsBetweenRestarts = 3600, 56 | 57 | SupFlags = {RestartStrategy, MaxRestarts, MaxSecondsBetweenRestarts}, 58 | 59 | Restart = permanent, 60 | Shutdown = 2000, 61 | Type = worker, 62 | 63 | Children = [{gwsu_web_server, {gwsu_web_server, start_link, []}, 64 | Restart, Shutdown, Type, [gwsu_web_server]}, 65 | {gwsu_webdav_server, {gwsu_webdav_server, start_link, []}, 66 | Restart, Shutdown, Type, [gwsu_webdav_server]}], 67 | 68 | {ok, {SupFlags, Children}}. 69 | 70 | %%%=================================================================== 71 | %%% Internal functions 72 | %%%=================================================================== 73 | -------------------------------------------------------------------------------- /lib/gen_web_server_user/src/gwsu_web_server.erl: -------------------------------------------------------------------------------- 1 | %%%------------------------------------------------------------------- 2 | %%% @author Martin Logan 3 | %%% @copyright (C) 2010, Martin Logan 4 | %%% @doc 5 | %%% gen web server implementation 6 | %%% @end 7 | %%% Created : 11 Feb 2010 by Martin Logan 8 | %%%------------------------------------------------------------------- 9 | -module(gwsu_web_server). 10 | 11 | -behaviour(gen_web_server). 12 | 13 | %% API 14 | -export([start_link/0]). 15 | 16 | %% callbacks 17 | -export([ 18 | init/1, 19 | head/3, 20 | get/3, 21 | delete/3, 22 | options/4, 23 | post/4, 24 | put/4, 25 | trace/4, 26 | other_methods/4 27 | ]). 28 | 29 | -record(state, {document_root}). 30 | 31 | %%%=================================================================== 32 | %%% API 33 | %%%=================================================================== 34 | 35 | %%-------------------------------------------------------------------- 36 | %% @doc 37 | %% @spec 38 | %% @end 39 | %%-------------------------------------------------------------------- 40 | start_link() -> 41 | gen_web_server:start_link(?MODULE, 8080, "/tmp/repo/"). 42 | 43 | %%%=================================================================== 44 | %%% gen_web_server callbacks 45 | %%%=================================================================== 46 | 47 | %%-------------------------------------------------------------------- 48 | %% @doc 49 | %% @spec (UserArgs) -> void() 50 | %% @end 51 | %%-------------------------------------------------------------------- 52 | init(DocumentRoot) -> 53 | {ok, #state{document_root = DocumentRoot}}. 54 | 55 | %%-------------------------------------------------------------------- 56 | %% @doc 57 | %% @spec (RequestLine, Headers) -> Response 58 | %% @end 59 | %%-------------------------------------------------------------------- 60 | get(_RequestLine, Headers, State) -> 61 | Body = "

Welcome to the gen_web_server

" 62 | "

Docs can be found at erlware.org or by" 63 | " generating edocs on the app

", 64 | {stop, gen_web_server:http_reply(200, Headers, Body), State}. 65 | 66 | head(_RequestLine, _Headers, _State) -> {stop, gen_web_server:http_reply(200), []}. 67 | delete(_RequestLine, _Headers, _State) -> {gen_web_server:http_reply(200), []}. 68 | 69 | %%-------------------------------------------------------------------- 70 | %% @doc 71 | %% @spec (RequestLine, Headers, Body, State) -> Response 72 | %% @end 73 | %%-------------------------------------------------------------------- 74 | put(_RequestLine, _Headers, _Body, _State) -> {stop, gen_web_server:http_reply(200), []}. 75 | trace(_RequestLine, _Headers, _Body, _State) -> {stop, gen_web_server:http_reply(200), []}. 76 | post(_RequestLine, _Headers, _Body, _State) -> {stop, gen_web_server:http_reply(200), []}. 77 | options(_RequestLine, _Headers, _Body, _State) -> {stop, gen_web_server:http_reply(200), []}. 78 | other_methods(_RequestLine, _Headers, _Body, _State) -> {stop, gen_web_server:http_reply(200), []}. 79 | 80 | %%%=================================================================== 81 | %%% Internal functions 82 | %%%=================================================================== 83 | -------------------------------------------------------------------------------- /lib/gen_web_server_user/src/gwsu_webdav_server.erl: -------------------------------------------------------------------------------- 1 | %%%------------------------------------------------------------------- 2 | %%% @author Martin Logan 3 | %%% @copyright (C) 2010, Martin Logan 4 | %%% @doc 5 | %%% gen web server implementation 6 | %%% @end 7 | %%% Created : 11 Feb 2010 by Martin Logan 8 | %%%------------------------------------------------------------------- 9 | -module(gwsu_webdav_server). 10 | 11 | -behaviour(gen_web_server). 12 | 13 | %% API 14 | -export([start_link/0]). 15 | 16 | %% callbacks 17 | -export([ 18 | init/1, 19 | head/3, 20 | get/3, 21 | delete/3, 22 | options/4, 23 | post/4, 24 | put/4, 25 | trace/4, 26 | other_methods/4 27 | ]). 28 | 29 | -record(state, {document_root}). 30 | 31 | %%%=================================================================== 32 | %%% API 33 | %%%=================================================================== 34 | 35 | %%-------------------------------------------------------------------- 36 | %% @doc 37 | %% @spec 38 | %% @end 39 | %%-------------------------------------------------------------------- 40 | start_link() -> 41 | gen_web_server:start_link(?MODULE, 8090, "/tmp/repo/"). 42 | 43 | %%%=================================================================== 44 | %%% gen_web_server callbacks 45 | %%%=================================================================== 46 | 47 | %%-------------------------------------------------------------------- 48 | %% @doc 49 | %% @spec (UserArgs) -> void() 50 | %% @end 51 | %%-------------------------------------------------------------------- 52 | init(DocumentRoot) -> 53 | {ok, #state{document_root = DocumentRoot}}. 54 | 55 | %%-------------------------------------------------------------------- 56 | %% @doc 57 | %% @spec (RequestLine, Headers, State) -> Response 58 | %% @end 59 | %%-------------------------------------------------------------------- 60 | get({http_request, _, {abs_path, AbsPathBin}, _}, Headers, State) -> 61 | AbsPath = binary_to_list(AbsPathBin), 62 | FilePath = filename:join(State#state.document_root, string:strip(AbsPath, left, $\/)), 63 | case catch file:read_file(FilePath) of 64 | {ok, TarFile} -> 65 | error_logger:info_msg("request is ~p~n", [FilePath]), 66 | gen_web_server:http_reply(200, Headers, TarFile); 67 | _Error -> 68 | gen_web_server:http_reply(404) 69 | end. 70 | 71 | head(_RequestLine, _Headers, _State) -> gen_web_server:http_reply(200). 72 | delete(_RequestLine, _Headers, _State) -> gen_web_server:http_reply(200). 73 | 74 | %%-------------------------------------------------------------------- 75 | %% @doc 76 | %% @spec (RequestLine, Headers, Body, State) -> Response 77 | %% @end 78 | %%-------------------------------------------------------------------- 79 | put({http_request, _, {abs_path, AbsPathBin}, _}, _Headers, Body, State) -> 80 | AbsPath = binary_to_list(AbsPathBin), 81 | To = filename:join(State#state.document_root, string:strip(AbsPath, left, $\/)), 82 | case catch write_data(Body, To) of 83 | ok -> 84 | gen_web_server:http_reply(201); 85 | _ -> 86 | gen_web_server:http_reply(405) 87 | end. 88 | trace(_RequestLine, _Headers, _Body, _State) -> gen_web_server:http_reply(200). 89 | post(_RequestLine, _Headers, _Body, _State) -> gen_web_server:http_reply(200). 90 | options(_RequestLine, _Headers, _Body, _State) -> gen_web_server:http_reply(200). 91 | 92 | %%-------------------------------------------------------------------- 93 | %% @doc 94 | %% @spec (RequestLine, Headers, Body) -> Response 95 | %% @end 96 | %%-------------------------------------------------------------------- 97 | other_methods({http_request, <<"PROPFIND">>, {abs_path, AbsPathBin}, _}, Headers, _Body, State) -> 98 | AbsPath = binary_to_list(AbsPathBin), 99 | {value, {'Host', Host}} = lists:keysearch('Host', 1, Headers), 100 | case gws_web_dav_util:propfind(State#state.document_root, AbsPath, binary_to_list(Host), 1) of 101 | error -> 102 | gen_web_server:http_reply(404); 103 | Resp -> 104 | error_logger:info_msg("request is ~p ~p~n", [AbsPath, Headers]), 105 | WebResp = gen_web_server:http_reply(207, Headers, Resp), 106 | error_logger:info_msg("response to propfind ~p~n", [WebResp]), 107 | WebResp 108 | end; 109 | other_methods({http_request, <<"MKCOL">>, {abs_path, AbsPathBin}, _}, _Headers, _Body, State) -> 110 | AbsPath = binary_to_list(AbsPathBin), 111 | gws_web_dav_util:mkcol(State#state.document_root, AbsPath), 112 | gen_web_server:http_reply(201); 113 | other_methods(RequestLine, Headers, Body, _State) -> 114 | error_logger:info_msg("request is ~p ~p ~p~n", [RequestLine, Headers, Body]), 115 | gen_web_server:http_reply(200). 116 | 117 | %%%=================================================================== 118 | %%% Internal functions 119 | %%%=================================================================== 120 | %%------------------------------------------------------------------- 121 | %% @spec write_data(Data, Location) -> ok | {error, Reason} 122 | %% @doc 123 | %% Write the data to the specified location. 124 | %% @end 125 | %% @private 126 | %%------------------------------------------------------------------- 127 | write_data(Data, To) -> 128 | case file:open(To, [write, raw]) of 129 | {ok, Fd} -> 130 | error_logger:info_msg("ewr_fetch:write_data writing to ~p~n", [To]), 131 | ok = file:write(Fd, Data), 132 | file:close(Fd), 133 | ok; 134 | {error, Reason} -> 135 | throw({file_open_error, Reason}) 136 | end. 137 | -------------------------------------------------------------------------------- /sinan.cfg: -------------------------------------------------------------------------------- 1 | project : { 2 | name : gen_web_server 3 | vsn : "0.4.0.0" 4 | }, 5 | 6 | build_dir : _build, 7 | 8 | ignore_dirs : ["_", 9 | "."], 10 | 11 | ignore_apps : [], 12 | 13 | 14 | 15 | --------------------------------------------------------------------------------