couchdb-commits mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From cml...@apache.org
Subject svn commit: r642432 [13/16] - in /incubator/couchdb/trunk: ./ bin/ build-contrib/ etc/ etc/conf/ etc/default/ etc/init/ etc/launchd/ etc/logrotate.d/ share/ share/server/ share/www/ share/www/browse/ share/www/image/ share/www/script/ share/www/style/ ...
Date Fri, 28 Mar 2008 23:32:30 GMT
Added: incubator/couchdb/trunk/src/couch_inets/tftp_engine.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/tftp_engine.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/tftp_engine.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/tftp_engine.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,1121 @@
+%%%-------------------------------------------------------------------
+%%% File    : tftp_engine.erl
+%%% Author  : Hakan Mattsson <hakan@erix.ericsson.se>
+%%% Description : Protocol engine for trivial FTP
+%%%
+%%% Created : 18 May 2004 by Hakan Mattsson <hakan@erix.ericsson.se>
+%%%-------------------------------------------------------------------
+
+-module(tftp_engine).
+
+%%%-------------------------------------------------------------------
+%%% Interface
+%%%-------------------------------------------------------------------
+
+%% application internal functions
+-export([
+	 daemon_start/1,
+	 client_start/4,
+	 info/1,
+	 change_config/2
+	]).
+
+%% module internal
+-export([
+	 daemon_init/1, 
+	 server_init/2, 
+	 client_init/2,
+	 wait_for_msg/3
+	]).
+
+%% sys callback functions
+-export([
+	 system_continue/3,
+	 system_terminate/4,
+	 system_code_change/4
+	]).
+
+-include("tftp.hrl").
+
+-record(error, {what, code, text}).
+-define(ERROR(What, Code, Text), #error{what = What, code = Code, text = Text}).
+
+%%%-------------------------------------------------------------------
+%%% Info
+%%%-------------------------------------------------------------------
+
+info(ToPid) when is_pid(ToPid) ->
+    call(info, ToPid, timer:seconds(10)).
+
+change_config(ToPid, Options) when is_pid(ToPid) ->
+    BadKeys = [host, port, udp],
+    BadOptions = [{Key, Val} || {Key, Val} <- Options,
+				BadKey <- BadKeys,
+				Key =:= BadKey],
+    case BadOptions of
+	[] ->
+	    call({change_config, Options}, ToPid, timer:seconds(10));
+	[{Key, Val} | _] ->
+	    {error, {badarg, {Key, Val}}}
+    end.
+
+call(Req, ToPid, Timeout) when is_pid(ToPid) ->
+    Type = process,
+    Ref = erlang:monitor(Type, ToPid),
+    ToPid ! {Req, Ref, self()},
+    receive
+	{Reply, Ref, FromPid} when FromPid =:= ToPid ->
+	    erlang:demonitor(Ref),
+	    Reply;
+	{'DOWN', Ref, Type, FromPid, _Reason} when FromPid =:= ToPid ->
+	    {error, timeout}
+    after Timeout ->
+	    {error, timeout}
+    end.
+
+reply(Reply, Ref, ToPid) ->
+    ToPid ! {Reply, Ref, self()}.
+
+%%%-------------------------------------------------------------------
+%%% Daemon
+%%%-------------------------------------------------------------------
+
+%% Returns {ok, Port}
+daemon_start(Options) when is_list(Options) ->
+    Config = tftp_lib:parse_config(Options),
+    proc_lib:start_link(?MODULE, daemon_init, [Config], infinity).
+
+daemon_init(Config) when is_record(Config, config), 
+                         is_pid(Config#config.parent_pid) ->
+    process_flag(trap_exit, true),
+    UdpOptions = prepare_daemon_udp(Config),
+    case catch gen_udp:open(Config#config.udp_port, UdpOptions) of
+	{ok, Socket} ->
+	    {ok, ActualPort} = inet:port(Socket),
+	    proc_lib:init_ack({ok, self()}),
+	    Config2 = Config#config{udp_socket = Socket,
+				    udp_port   = ActualPort},
+	    print_debug_info(Config2, daemon, open, #tftp_msg_req{filename = ""}),
+	    daemon_loop(Config2, 0, []);
+	{error, Reason} ->
+	    Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [UdpOptions, Reason])),
+	    print_debug_info(Config, daemon, open, ?ERROR(open, undef, Text)),
+	    exit({gen_udp_open, UdpOptions, Reason});
+	Reason ->
+	    Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [UdpOptions, Reason])),
+	    print_debug_info(Config, daemon, open, ?ERROR(open, undef, Text)),
+	    exit({gen_udp_open, UdpOptions, Reason})
+    end.
+
+prepare_daemon_udp(#config{udp_port = Port, udp_options = UdpOptions}) ->
+    case lists:keymember(fd, 1, UdpOptions) of
+	true ->
+	    %% Use explicit fd
+	    UdpOptions;
+	false ->
+	    %% Use fd from setuid_socket_wrap, such as -tftpd_69
+	    InitArg = list_to_atom("tftpd_" ++ integer_to_list(Port)),
+	    case init:get_argument(InitArg) of
+		{ok, [[FdStr]] = Badarg} when is_list(FdStr) ->
+		    case catch list_to_integer(FdStr) of
+			Fd when is_integer(Fd) ->
+			    [{fd, Fd} | UdpOptions];
+			{'EXIT', _} ->
+			    exit({badarg, {prebound_fd, InitArg, Badarg}})
+		    end;
+		{ok, Badarg} ->
+		    exit({badarg, {prebound_fd, InitArg, Badarg}});
+		error ->
+		    UdpOptions
+	    end
+    end.
+
+daemon_loop(DaemonConfig, N, Servers) ->
+    receive
+	{info, Ref, FromPid} when is_pid(FromPid) ->
+	    ServerInfo = [{n_conn, N} | [{server, P} || P <- Servers]],
+	    Info = internal_info(DaemonConfig, daemon) ++ ServerInfo,
+	    reply({ok, Info}, Ref, FromPid),
+	    daemon_loop(DaemonConfig, N, Servers);
+	{{change_config, Options}, Ref, FromPid} when is_pid(FromPid) ->
+	    case catch tftp_lib:parse_config(Options, DaemonConfig) of
+		{'EXIT', Reason} ->
+		    reply({error, Reason}, Ref, FromPid),
+		    daemon_loop(DaemonConfig, N, Servers);
+		DaemonConfig2 when is_record(DaemonConfig2, config) ->
+		    reply(ok, Ref, FromPid),
+		    daemon_loop(DaemonConfig2, N, Servers)
+	    end;
+	{udp, Socket, RemoteHost, RemotePort, Bin} when is_binary(Bin) ->
+	    inet:setopts(Socket, [{active, once}]),
+	    ServerConfig = DaemonConfig#config{parent_pid = self(),
+					       udp_host   = RemoteHost,
+					       udp_port   = RemotePort},
+	    Msg = (catch tftp_lib:decode_msg(Bin)),
+	    print_debug_info(ServerConfig, daemon, recv, Msg),
+	    case Msg of
+		Req when is_record(Req, tftp_msg_req), 
+		N < DaemonConfig#config.max_conn ->
+		    Args = [ServerConfig, Req],
+		    Pid = proc_lib:spawn_link(?MODULE, server_init, Args),
+		    daemon_loop(DaemonConfig, N + 1, [Pid | Servers]);
+		Req when is_record(Req, tftp_msg_req) ->
+		    Reply = #tftp_msg_error{code = enospc,
+					    text = "Too many connections"},
+		    send_msg(ServerConfig, daemon, Reply),
+		    daemon_loop(DaemonConfig, N, Servers);
+		{'EXIT', Reply} when is_record(Reply, tftp_msg_error) ->
+		    send_msg(ServerConfig, daemon, Reply),
+		    daemon_loop(DaemonConfig, N, Servers);
+		Req  ->
+		    Reply = #tftp_msg_error{code = badop,
+					    text = "Illegal TFTP operation"},
+		    error("Daemon received: ~p from ~p:~p", [Req, RemoteHost, RemotePort]),
+		    send_msg(ServerConfig, daemon, Reply),
+		    daemon_loop(DaemonConfig, N, Servers)
+	    end;
+	{system, From, Msg} ->
+	    Misc = {daemon_loop, [DaemonConfig, N, Servers]},
+	    sys:handle_system_msg(Msg, From, DaemonConfig#config.parent_pid, ?MODULE, [], Misc);
+	{'EXIT', Pid, Reason} when DaemonConfig#config.parent_pid =:= Pid ->
+	    close_port(DaemonConfig, daemon, #tftp_msg_req{filename = ""}),
+	    exit(Reason);
+	{'EXIT', Pid, _Reason} = Info ->
+	    case lists:member(Pid, Servers) of
+		true ->
+		    daemon_loop(DaemonConfig, N - 1, Servers -- [Pid]);
+		false ->
+		    error("Daemon received: ~p", [Info]),
+		    daemon_loop(DaemonConfig, N, Servers)
+	    end;
+	Info ->
+	    error("Daemon received: ~p", [Info]),
+	    daemon_loop(DaemonConfig, N, Servers)
+    end.
+
+%%%-------------------------------------------------------------------
+%%% Server
+%%%-------------------------------------------------------------------
+
+server_init(Config, Req) when is_record(Config, config),
+                              is_pid(Config#config.parent_pid),
+                              is_record(Req, tftp_msg_req) ->
+    process_flag(trap_exit, true),
+    SuggestedOptions = Req#tftp_msg_req.options,
+    UdpOptions = Config#config.udp_options,
+    UdpOptions2 = lists:keydelete(fd, 1, UdpOptions),
+    Config1 = Config#config{udp_options = UdpOptions2},
+    Config2 = tftp_lib:parse_config(SuggestedOptions, Config1),
+    SuggestedOptions2 = Config2#config.user_options,
+    Req2 = Req#tftp_msg_req{options = SuggestedOptions2},
+    case open_free_port(Config2, server, Req2) of
+	{ok, Config3} ->
+	    Filename = Req#tftp_msg_req.filename,
+	    case match_callback(Filename, Config3#config.callbacks) of
+		{ok, Callback} ->
+		    print_debug_info(Config3, server, match, Callback),
+		    case pre_verify_options(Config3, Req2) of
+			ok ->
+			    case callback({open, server_open}, Config3, Callback, Req2) of
+				{Callback2, {ok, AcceptedOptions}} ->
+				    {LocalAccess,  _} = local_file_access(Req2),
+				    OptText = "Internal error. Not allowed to add new options.",
+				    case post_verify_options(Config3, Req2, AcceptedOptions, OptText) of
+					{ok, Config4, Req3} when AcceptedOptions /= [] ->
+					    Reply = #tftp_msg_oack{options = AcceptedOptions},
+					    {Config5, Callback3, Next} = 
+						transfer(Config4, Callback2, Req3, Reply, LocalAccess, undefined),
+					    BlockNo =
+						case LocalAccess of
+						    read  -> 0;
+						    write -> 1
+						end,
+					    common_loop(Config5, Callback3, Req3, Next, LocalAccess, BlockNo);
+					{ok, Config4, Req3} when LocalAccess =:= write ->
+					    BlockNo = 0,
+					    common_ack(Config4, Callback2, Req3, LocalAccess, BlockNo, undefined);
+					{ok, Config4, Req3} when LocalAccess =:= read ->
+					    BlockNo = 0,
+					    common_read(Config4, Callback2, Req3, LocalAccess, BlockNo, BlockNo, undefined);
+					{error, {Code, Text}} ->
+					    {undefined, Error} =
+						callback({abort, {Code, Text}}, Config3, Callback2, Req2),
+					    send_msg(Config3, Req, Error),
+					    terminate(Config3, Req2, ?ERROR(post_verify_options, Code, Text))
+				    end;
+				{undefined, #tftp_msg_error{code = Code, text = Text} = Error} ->
+				    send_msg(Config3, Req, Error),
+				    terminate(Config3, Req, ?ERROR(server_open, Code, Text))
+			    end;
+			{error, {Code, Text}} ->
+			    {undefined, Error} =
+				callback({abort, {Code, Text}}, Config2, Callback, Req2),
+			    send_msg(Config2, Req, Error),
+			    terminate(Config2, Req2, ?ERROR(pre_verify_options, Code, Text))
+		    end;
+		{error, #tftp_msg_error{code = Code, text = Text} = Error} ->
+		    send_msg(Config3, Req, Error),
+		    terminate(Config3, Req, ?ERROR(match_callback, Code, Text))
+	    end;
+	#error{} = Error ->
+	    terminate(Config2, Req, Error)
+    end.
+
+%%%-------------------------------------------------------------------
+%%% Client
+%%%-------------------------------------------------------------------
+
+%% LocalFilename = filename() | 'binary' | binary()
+%% Returns {ok, LastCallbackState} | {error, Reason}
+client_start(Access, RemoteFilename, LocalFilename, Options) ->
+    Config = tftp_lib:parse_config(Options),
+    Config2 = Config#config{parent_pid      = self(),
+			    udp_socket      = undefined},
+    Req = #tftp_msg_req{access         = Access, 
+			filename       = RemoteFilename, 
+			mode           = lookup_mode(Config2#config.user_options),
+			options        = Config2#config.user_options,
+			local_filename = LocalFilename},
+    Args = [Config2, Req],
+    case proc_lib:start_link(?MODULE, client_init, Args, infinity) of
+	{ok, LastCallbackState} ->
+	    {ok, LastCallbackState};
+	{error, Error} ->
+	    {error, Error}
+    end.
+
+client_init(Config, Req) when is_record(Config, config),
+                              is_pid(Config#config.parent_pid),
+                              is_record(Req, tftp_msg_req) ->
+    process_flag(trap_exit, true),
+    case open_free_port(Config, client, Req) of
+	{ok, Config2} ->
+	    Req2 =
+		case Config2#config.use_tsize of
+		    true ->
+			SuggestedOptions = Req#tftp_msg_req.options,
+			SuggestedOptions2 = tftp_lib:replace_val("tsize", "0", SuggestedOptions),
+			Req#tftp_msg_req{options = SuggestedOptions2};
+		    false ->
+			Req
+		end,
+	    LocalFilename = Req2#tftp_msg_req.local_filename,
+	    case match_callback(LocalFilename, Config2#config.callbacks) of
+		{ok, Callback} ->
+		    print_debug_info(Config2, client, match, Callback),
+		    client_prepare(Config2, Callback, Req2);		    
+		{error, #tftp_msg_error{code = Code, text = Text}} ->
+		    terminate(Config, Req, ?ERROR(match, Code, Text))
+	    end;
+	#error{} = Error ->
+	    terminate(Config, Req, Error)
+    end.
+
+client_prepare(Config, Callback, Req) ->
+    case pre_verify_options(Config, Req) of
+	ok ->
+	    case callback({open, client_prepare}, Config, Callback, Req) of
+		{Callback2, {ok, AcceptedOptions}} ->
+		    OptText = "Internal error. Not allowed to add new options.",
+		    case post_verify_options(Config, Req, AcceptedOptions, OptText) of
+			{ok, Config2, Req2} ->
+			    {LocalAccess, _} = local_file_access(Req2),
+			    {Config3, Callback3, Next} =
+				transfer(Config2, Callback2, Req2, Req2, LocalAccess, undefined),
+			    client_open(Config3, Callback3, Req2, Next);
+			{error, {Code, Text}} ->
+			    callback({abort, {Code, Text}}, Config, Callback2, Req),
+			    terminate(Config, Req, ?ERROR(post_verify_options, Code, Text))
+		    end;
+		{undefined, #tftp_msg_error{code = Code, text = Text}} ->
+		    terminate(Config, Req, ?ERROR(client_prepare, Code, Text))
+	    end;
+	{error, {Code, Text}} ->
+	    callback({abort, {Code, Text}}, Config, Callback, Req),
+	    terminate(Config, Req, ?ERROR(pre_verify_options, Code, Text))
+    end.
+
+client_open(Config, Callback, Req, Next) ->
+    {LocalAccess, _} = local_file_access(Req),
+    case Next of
+	{ok, DecodedMsg, undefined} ->
+	    case DecodedMsg of
+		Msg when record(Msg, tftp_msg_oack) ->
+		    ServerOptions = Msg#tftp_msg_oack.options,
+		    OptText = "Protocol violation. Server is not allowed new options",
+		    case post_verify_options(Config, Req, ServerOptions, OptText) of
+			{ok, Config2, Req2} ->		    
+			    {Config3, Callback2, Req3} =
+				do_client_open(Config2, Callback, Req2),
+			    case LocalAccess of
+				read ->
+				    BlockNo = 0,
+				    common_read(Config3, Callback2, Req3, LocalAccess, BlockNo, BlockNo, undefined);
+				write ->
+				    BlockNo = 0,
+				    common_ack(Config3, Callback2, Req3, LocalAccess, BlockNo, undefined)
+			    end;
+			{error, {Code, Text}} ->
+			    {undefined, Error} =
+				callback({abort, {Code, Text}}, Config, Callback, Req),
+			    send_msg(Config, Req, Error),
+			    terminate(Config, Req, ?ERROR(verify_server_options, Code, Text))
+		    end;
+		#tftp_msg_ack{block_no = ActualBlockNo} when LocalAccess =:= read ->
+		    Req2 = Req#tftp_msg_req{options = []},
+		    {Config2, Callback2, Req2} = do_client_open(Config, Callback, Req2),
+		    ExpectedBlockNo = 0,
+		    common_read(Config2, Callback2, Req2, LocalAccess, ExpectedBlockNo, ActualBlockNo, undefined);
+		#tftp_msg_data{block_no = ActualBlockNo, data = Data} when LocalAccess =:= write ->
+		    Req2 = Req#tftp_msg_req{options = []},
+		    {Config2, Callback2, Req2} = do_client_open(Config, Callback, Req2),
+		    ExpectedBlockNo = 1,
+		    common_write(Config2, Callback2, Req2, LocalAccess, ExpectedBlockNo, ActualBlockNo, Data, undefined);
+		%% #tftp_msg_error{code = Code, text = Text} when Req#tftp_msg_req.options /= [] ->
+                %%     %% Retry without options
+		%%     callback({abort, {Code, Text}}, Config, Callback, Req),
+		%%     Req2 = Req#tftp_msg_req{options = []},
+		%%     client_prepare(Config, Callback, Req2);
+		#tftp_msg_error{code = Code, text = Text} ->
+		    callback({abort, {Code, Text}}, Config, Callback, Req),
+		    terminate(Config, Req, ?ERROR(client_open, Code, Text));
+		{'EXIT', #tftp_msg_error{code = Code, text = Text}} ->
+		    callback({abort, {Code, Text}}, Config, Callback, Req),
+		    terminate(Config, Req, ?ERROR(client_open, Code, Text));
+		Msg when is_tuple(Msg) ->
+		    Code = badop,
+		    Text = "Illegal TFTP operation",
+		    {undefined, Error} =
+			callback({abort, {Code, Text}}, Config, Callback, Req),
+		    send_msg(Config, Req, Error),
+		    Text2 = lists:flatten([Text, ". ", io_lib:format("~p", [element(1, Msg)])]),
+		    terminate(Config, Req, ?ERROR(client_open, Code, Text2))
+	    end;
+	{error, #tftp_msg_error{code = Code, text = Text}} ->
+	    callback({abort, {Code, Text}}, Config, Callback, Req),
+	    terminate(Config, Req, ?ERROR(client_open, Code, Text))
+    end.
+
+do_client_open(Config, Callback, Req) ->
+    case callback({open, client_open}, Config, Callback, Req) of
+	{Callback2, {ok, FinalOptions}} ->
+	    OptText = "Internal error. Not allowed to change options.",
+	    case post_verify_options(Config, Req, FinalOptions, OptText) of
+		{ok, Config2, Req2} ->
+		    {Config2, Callback2, Req2};
+		{error, {Code, Text}} ->
+		    {undefined, Error} =
+			callback({abort, {Code, Text}}, Config, Callback, Req),
+		    send_msg(Config, Req, Error),
+		    terminate(Config, Req, ?ERROR(post_verify_options, Code, Text))
+	    end;
+	{undefined, #tftp_msg_error{code = Code, text = Text} = Error} ->
+	    send_msg(Config, Req, Error),
+	    terminate(Config, Req, ?ERROR(client_open, Code, Text))
+    end.
+
+%%%-------------------------------------------------------------------
+%%% Common loop for both client and server
+%%%-------------------------------------------------------------------
+
+common_loop(Config, Callback, Req, Next, LocalAccess, ExpectedBlockNo) ->
+    case Next of
+	{ok, DecodedMsg, Prepared} ->
+	    case DecodedMsg of
+		#tftp_msg_ack{block_no = ActualBlockNo} when LocalAccess =:= read ->
+		    common_read(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Prepared);
+		#tftp_msg_data{block_no = ActualBlockNo, data = Data} when LocalAccess =:= write ->
+		    common_write(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Data, Prepared);
+		#tftp_msg_error{code = Code, text = Text} ->
+		    callback({abort, {Code, Text}}, Config, Callback, Req),
+		    terminate(Config, Req, ?ERROR(common_loop, Code, Text));
+		{'EXIT', #tftp_msg_error{code = Code, text = Text} = Error} ->
+		    callback({abort, {Code, Text}}, Config, Callback, Req),
+		    send_msg(Config, Req, Error),
+		    terminate(Config, Req, ?ERROR(common_loop, Code, Text));
+		Msg when is_tuple(Msg) ->
+		    Code = badop,
+		    Text = "Illegal TFTP operation",
+		    {undefined, Error} =
+			callback({abort, {Code, Text}}, Config, Callback, Req),
+		    send_msg(Config, Req, Error),
+		    Text2 = lists:flatten([Text, ". ", io_lib:format("~p", [element(1, Msg)])]),
+		    terminate(Config, Req, ?ERROR(common_loop, Code, Text2))
+	    end;
+	{error, #tftp_msg_error{code = Code, text = Text} = Error} ->
+	    send_msg(Config, Req, Error),
+	    terminate(Config, Req, ?ERROR(transfer, Code, Text))
+    end.
+
+common_read(Config, _, Req, _, _, _, {terminate, Result}) ->
+    terminate(Config, Req, {ok, Result});
+common_read(Config, Callback, Req, LocalAccess, BlockNo, BlockNo, Prepared) ->
+    case early_read(Config, Callback, Req, LocalAccess, Prepared) of
+	{Callback2, {more, Data}} ->
+	    do_common_read(Config, Callback2, Req, LocalAccess, BlockNo, Data, undefined);
+	{undefined, {last, Data, Result}} ->
+	    do_common_read(Config, undefined, Req, LocalAccess, BlockNo, Data, {terminate, Result});
+	{undefined, #tftp_msg_error{code = Code, text = Text} = Reply} ->	
+	    send_msg(Config, Req, Reply),
+	    terminate(Config, Req, ?ERROR(read, Code, Text))
+    end;
+common_read(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Prepared) 
+  when ActualBlockNo < ExpectedBlockNo ->
+    do_common_read(Config, Callback, Req, LocalAccess, ExpectedBlockNo - 1, Prepared, undefined);
+common_read(Config, Callback, Req, _LocalAccess, ExpectedBlockNo, ActualBlockNo, _Prepared) ->
+    Code = badblk,
+    Text = "Unknown transfer ID = " ++ 
+	integer_to_list(ActualBlockNo) ++ " (" ++ integer_to_list(ExpectedBlockNo) ++ ")", 
+    {undefined, Error} =
+	callback({abort, {Code, Text}}, Config, Callback, Req),
+    send_msg(Config, Req, Error),
+    terminate(Config, Req, ?ERROR(read, Code, Text)).
+
+do_common_read(Config, Callback, Req, LocalAccess, BlockNo, Data, Prepared) ->
+    NextBlockNo = BlockNo + 1,
+    case NextBlockNo =< 65535 of
+	true ->
+	    Reply = #tftp_msg_data{block_no = NextBlockNo, data = Data},
+	    {Config2, Callback2, Next} =
+		transfer(Config, Callback, Req, Reply, LocalAccess, Prepared),
+	    common_loop(Config2, Callback2, Req, Next, LocalAccess, NextBlockNo);
+	false ->
+	    Code = badblk,
+	    Text = "Too big transfer ID = " ++ 
+		integer_to_list(NextBlockNo) ++ " > 65535", 
+	    {undefined, Error} =
+		callback({abort, {Code, Text}}, Config, Callback, Req),
+	    send_msg(Config, Req, Error),
+	    terminate(Config, Req, ?ERROR(read, Code, Text))
+    end.
+
+common_write(Config, _, Req, _, _, _, _, {terminate, Result}) ->
+    terminate(Config, Req, {ok, Result});
+common_write(Config, Callback, Req, LocalAccess, BlockNo, BlockNo, Data, undefined) ->
+    case callback({write, Data}, Config, Callback, Req) of
+	{Callback2, more} ->
+	    common_ack(Config, Callback2, Req, LocalAccess, BlockNo, undefined);
+	{undefined, {last, Result}} ->
+	    Config2 = pre_terminate(Config, Req, {ok, Result}),
+	    common_ack(Config2, undefined, Req, LocalAccess, BlockNo, {terminate, Result});
+	{undefined, #tftp_msg_error{code = Code, text = Text} = Reply} ->
+	    send_msg(Config, Req, Reply),
+	    terminate(Config, Req, ?ERROR(write, Code, Text))
+    end;
+common_write(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, _Data, undefined) 
+  when ActualBlockNo < ExpectedBlockNo ->
+    common_ack(Config, Callback, Req, LocalAccess, ExpectedBlockNo - 1, undefined);
+common_write(Config, Callback, Req, _, ExpectedBlockNo, ActualBlockNo, _, _) ->
+    Code = badblk,
+    Text = "Unknown transfer ID = " ++ 
+	integer_to_list(ActualBlockNo) ++ " (" ++ integer_to_list(ExpectedBlockNo) ++ ")", 
+    {undefined, Error} =
+	callback({abort, {Code, Text}}, Config, Callback, Req),
+    send_msg(Config, Req, Error),
+    terminate(Config, Req, ?ERROR(write, Code, Text)).
+
+common_ack(Config, Callback, Req, LocalAccess, BlockNo, Prepared) ->
+    Reply = #tftp_msg_ack{block_no = BlockNo},
+    {Config2, Callback2, Next} = 
+	transfer(Config, Callback, Req, Reply, LocalAccess, Prepared),
+    NextBlockNo = BlockNo + 1,
+    case NextBlockNo =< 65535 of
+	true ->   
+	    common_loop(Config2, Callback2, Req, Next, LocalAccess, NextBlockNo);
+	false ->
+	    Code = badblk,
+	    Text = "Too big transfer ID = " ++ 
+		integer_to_list(NextBlockNo) ++ " > 65535", 
+	    {undefined, Error} =
+		callback({abort, {Code, Text}}, Config, Callback, Req),
+	    send_msg(Config, Req, Error),
+	    terminate(Config, Req, ?ERROR(read, Code, Text))
+    end.
+
+pre_terminate(Config, Req, Result) ->
+    if
+	Req#tftp_msg_req.local_filename /= undefined,
+	Config#config.parent_pid /= undefined ->
+	    proc_lib:init_ack(Result),
+	    unlink(Config#config.parent_pid),
+	    Config#config{parent_pid = undefined, polite_ack = true};
+	true ->
+	    Config#config{polite_ack = true}
+    end.
+
+terminate(Config, Req, Result) ->
+    Result2 =
+	case Result of
+	    {ok, _} ->
+		Result;
+	    #error{what = What, code = Code, text = Text} = Error ->
+		print_debug_info(Config, Req, What, Error),
+		{error, {What, Code, Text}}
+    end,  
+    if
+	Config#config.parent_pid =:= undefined ->
+	    close_port(Config, client, Req),
+	    exit(normal);
+	Req#tftp_msg_req.local_filename /= undefined  ->
+	    %% Client
+	    close_port(Config, client, Req),
+	    proc_lib:init_ack(Result2),
+	    unlink(Config#config.parent_pid),
+	    exit(normal);
+	true ->
+	    %% Server
+	    close_port(Config, server, Req),
+	    exit(shutdown)		    
+    end.
+
+close_port(Config, Who, Data) ->
+    case Config#config.udp_socket of
+	undefined -> 
+	    ignore;
+	Socket    -> 
+	    print_debug_info(Config, Who, close, Data),
+	    gen_udp:close(Socket)
+    end.
+
+open_free_port(Config, Who, Data) when is_record(Config, config) ->
+    UdpOptions = Config#config.udp_options,
+    case Config#config.port_policy of
+	random ->
+	    %% BUGBUG: Should be a random port
+	    case catch gen_udp:open(0, UdpOptions) of
+		{ok, Socket} ->
+		    Config2 = Config#config{udp_socket = Socket},
+		    print_debug_info(Config2, Who, open, Data),
+		    {ok, Config2};
+		{error, Reason} ->
+		    Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [[0 | UdpOptions], Reason])),
+		    ?ERROR(open, undef, Text);
+		{'EXIT', _} = Reason ->
+		    Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [[0 | UdpOptions], Reason])),
+		    ?ERROR(open, undef, Text)
+	    end;
+	{range, Port, Max} when Port =< Max ->
+	    case catch gen_udp:open(Port, UdpOptions) of
+		{ok, Socket} ->
+		    Config2 = Config#config{udp_socket = Socket},
+		    print_debug_info(Config2, Who, open, Data),
+		    {ok, Config2};
+		{error, eaddrinuse} ->
+		    PortPolicy = {range, Port + 1, Max},
+		    Config2 = Config#config{port_policy = PortPolicy},
+		    open_free_port(Config2, Who, Data);
+		{error, Reason} ->
+		    Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [[Port | UdpOptions], Reason])),
+		    ?ERROR(open, undef, Text);
+		{'EXIT', _} = Reason->
+		    Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [[Port | UdpOptions], Reason])),
+		    ?ERROR(open, undef, Text)
+	    end;
+	{range, Port, _Max} ->
+	    Reason = "Port range exhausted",
+	    Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [[Port | UdpOptions], Reason])),
+	    ?ERROR(Who, undef, Text)
+    end.
+
+%%-------------------------------------------------------------------
+%% Transfer
+%%-------------------------------------------------------------------
+
+%% Returns {Config, Callback, Next}
+%% Next = {ok, Reply, Next} | {error, Error}
+transfer(Config, Callback, Req, Msg, LocalAccess, Prepared) ->
+    IoList = tftp_lib:encode_msg(Msg),
+    do_transfer(Config, Callback, Req, Msg, IoList, LocalAccess, Prepared, true).
+
+do_transfer(Config, Callback, Req, Msg, IoList, LocalAccess, Prepared, Retry) ->
+    case do_send_msg(Config, Req, Msg, IoList) of
+	ok ->
+	    {Callback2, Prepared2} = 
+		early_read(Config, Callback, Req, LocalAccess, Prepared),
+	    Code = undef,
+	    Text = "Transfer timed out.",
+	    case wait_for_msg(Config, Callback, Req) of
+		timeout when Config#config.polite_ack =:= true ->
+		    do_send_msg(Config, Req, Msg, IoList),
+		    case Prepared2 of
+			{terminate, Result} ->
+			    terminate(Config, Req, {ok, Result});
+			_ ->
+			    terminate(Config, Req, ?ERROR(transfer, Code, Text))
+		    end;
+		timeout when Retry =:= true ->
+		    Retry2 = false,
+		    do_transfer(Config, Callback2, Req, Msg, IoList, LocalAccess, Prepared2, Retry2);
+		timeout ->
+		    Error = #tftp_msg_error{code = Code, text = Text},
+		    {Config, Callback, {error, Error}};
+		{Config2, Reply} ->
+		    {Config2, Callback2, {ok, Reply, Prepared2}}
+	    end;
+        {error, _Reason} when Retry =:= true ->
+	    do_transfer(Config, Callback, Req, Msg, IoList, LocalAccess, Prepared, false);
+	{error, Reason} ->
+	    Code = undef,
+	    Text = lists:flatten(io_lib:format("Transfer failed twice - giving up -> ~p", [Reason])),
+	    {Config, Callback, {error, #tftp_msg_error{code = Code, text = Text}}}
+    end.
+
+send_msg(Config, Req, Msg) ->
+    case catch tftp_lib:encode_msg(Msg) of
+	{'EXIT', Reason} ->
+	    Code = undef,
+	    Text = "Internal error. Encode failed",
+	    Msg2 = #tftp_msg_error{code = Code, text = Text, details = Reason},
+	    send_msg(Config, Req, Msg2);
+	IoList ->
+	    do_send_msg(Config, Req, Msg, IoList)
+    end.
+
+do_send_msg(Config, Req, Msg, IoList) ->
+    print_debug_info(Config, Req, send, Msg),
+    gen_udp:send(Config#config.udp_socket,
+		 Config#config.udp_host,
+		 Config#config.udp_port,
+		 IoList).
+
+wait_for_msg(Config, Callback, Req) ->
+    receive
+	{info, Ref, FromPid} when is_pid(FromPid) ->
+	    Type =
+		case Req#tftp_msg_req.local_filename /= undefined of
+		    true  -> client;
+		    false -> server
+		end,
+	    Info = internal_info(Config, Type),
+	    reply({ok, Info}, Ref, FromPid),
+	    wait_for_msg(Config, Callback, Req);
+	{{change_config, Options}, Ref, FromPid} when is_pid(FromPid) ->
+	    case catch tftp_lib:parse_config(Options, Config) of
+		{'EXIT', Reason} ->
+		    reply({error, Reason}, Ref, FromPid),
+		    wait_for_msg(Config, Callback, Req);
+		Config2 when is_record(Config2, config) ->
+		    reply(ok, Ref, FromPid),
+		    wait_for_msg(Config2, Callback, Req)
+	    end;
+	{udp, Socket, RemoteHost, RemotePort, Bin} when is_binary(Bin),
+	                                     Callback#callback.block_no =:= undefined ->
+	    %% Client prepare
+	    inet:setopts(Socket, [{active, once}]),
+	    Config2 = Config#config{udp_host = RemoteHost,
+				    udp_port = RemotePort},
+	    DecodedMsg = (catch tftp_lib:decode_msg(Bin)),
+	    print_debug_info(Config2, Req, recv, DecodedMsg),
+	    {Config2, DecodedMsg};
+	{udp, Socket, Host, Port, Bin} when is_binary(Bin),
+                                            Config#config.udp_host =:= Host,
+	                                    Config#config.udp_port =:= Port ->
+	    inet:setopts(Socket, [{active, once}]),
+	    DecodedMsg = (catch tftp_lib:decode_msg(Bin)),
+	    print_debug_info(Config, Req, recv, DecodedMsg),
+	    {Config, DecodedMsg};
+	{system, From, Msg} ->
+	    Misc = {wait_for_msg, [Config, Callback, Req]},
+	    sys:handle_system_msg(Msg, From, Config#config.parent_pid, ?MODULE, [], Misc);
+	{'EXIT', Pid, _Reason} when Config#config.parent_pid =:= Pid ->
+	    Code = undef,
+	    Text = "Parent exited.",
+	    terminate(Config, Req, ?ERROR(wait_for_msg, Code, Text));
+	Msg when Req#tftp_msg_req.local_filename /= undefined ->
+	    error("Client received : ~p", [Msg]),
+	    wait_for_msg(Config, Callback, Req);
+	Msg when Req#tftp_msg_req.local_filename =:= undefined ->
+	    error("Server received : ~p", [Msg]),
+	    wait_for_msg(Config, Callback, Req)
+    after Config#config.timeout * 1000 ->
+	    print_debug_info(Config, Req, recv, timeout),
+	    timeout
+    end.
+
+early_read(Config, Callback, Req, read, undefined)
+  when Callback#callback.block_no /= undefined ->
+    callback(read, Config, Callback, Req);
+early_read(_Config, Callback, _Req, _LocalAccess, Prepared) ->
+    {Callback, Prepared}.
+
+%%-------------------------------------------------------------------
+%% Callback
+%%-------------------------------------------------------------------
+
+callback(Access, Config, Callback, Req) ->
+    {Callback2, Result} =
+	do_callback(Access, Config, Callback, Req),
+    print_debug_info(Config, Req, call, {Callback2, Result}),
+    {Callback2, Result}.
+
+do_callback(read = Fun, Config, Callback, Req) 
+  when is_record(Config, config),
+       is_record(Callback, callback),
+       is_record(Req, tftp_msg_req) ->
+    Args =  [Callback#callback.state],
+    case catch apply(Callback#callback.module, Fun, Args) of
+	{more, Bin, NewState} when is_binary(Bin) ->
+	    BlockNo = Callback#callback.block_no + 1,
+	    Count   = Callback#callback.count + size(Bin),
+	    Callback2 = Callback#callback{state    = NewState, 
+					  block_no = BlockNo,
+					  count    = Count},
+	    verify_count(Config, Callback2, Req, {more, Bin});
+        {last, Data, Result} ->
+	    {undefined, {last, Data, Result}};
+	{error, {Code, Text}} ->
+	    {undefined, #tftp_msg_error{code = Code, text = Text}};
+	Details ->
+	    Code = undef,
+	    Text = "Internal error. File handler error.",
+	    callback({abort, {Code, Text, Details}}, Config, Callback, Req)
+    end;
+do_callback({write = Fun, Bin}, Config, Callback, Req)
+  when is_record(Config, config),
+       is_record(Callback, callback),
+       is_record(Req, tftp_msg_req),
+       is_binary(Bin) ->
+    Args =  [Bin, Callback#callback.state],
+    case catch apply(Callback#callback.module, Fun, Args) of
+	{more, NewState} ->
+	    BlockNo = Callback#callback.block_no + 1,
+	    Count   = Callback#callback.count + size(Bin),
+	    Callback2 = Callback#callback{state    = NewState, 
+					  block_no = BlockNo,
+					  count    = Count}, 
+	    verify_count(Config, Callback2, Req, more);
+	{last, Result} ->
+	    {undefined, {last, Result}};
+	{error, {Code, Text}} ->
+	    {undefined, #tftp_msg_error{code = Code, text = Text}};
+	Details ->
+	    Code = undef,
+	    Text = "Internal error. File handler error.",
+	    callback({abort, {Code, Text, Details}}, Config, Callback, Req)
+    end;
+do_callback({open, Type}, Config, Callback, Req)
+  when is_record(Config, config),
+       is_record(Callback, callback),
+       is_record(Req, tftp_msg_req) ->
+    {Access, Filename} = local_file_access(Req),
+    {Fun, BlockNo} =
+	case Type of
+	    client_prepare -> {prepare, undefined};
+	    client_open    -> {open, 0};
+	    server_open    -> {open, 0}
+	end,
+    Mod = Callback#callback.module,
+    Args = [Access,
+	    Filename,
+	    Req#tftp_msg_req.mode,
+	    Req#tftp_msg_req.options,
+	    Callback#callback.state],
+    PeerInfo = peer_info(Config),
+    code:ensure_loaded(Mod),
+    Args2 =
+	case erlang:function_exported(Mod, Fun, length(Args)) of
+	    true  -> Args;
+	    false -> [PeerInfo | Args]
+	end,
+    case catch apply(Mod, Fun, Args2) of
+	{ok, AcceptedOptions, NewState} ->
+	    Callback2 = Callback#callback{state    = NewState, 
+					  block_no = BlockNo, 
+					  count    = 0}, 
+	    {Callback2, {ok, AcceptedOptions}};
+	{error, {Code, Text}} ->
+	    {undefined, #tftp_msg_error{code = Code, text = Text}};
+	Details ->
+	    Code = undef,
+	    Text = "Internal error. File handler error.",
+	    callback({abort, {Code, Text, Details}}, Config, Callback, Req)
+    end;
+do_callback({abort, {Code, Text}}, Config, Callback, Req) ->
+    Error = #tftp_msg_error{code = Code, text = Text},
+    do_callback({abort, Error}, Config, Callback, Req);
+do_callback({abort, {Code, Text, Details}}, Config, Callback, Req) ->
+    Error = #tftp_msg_error{code = Code, text = Text, details = Details},
+    do_callback({abort, Error}, Config, Callback, Req);
+do_callback({abort = Fun, #tftp_msg_error{code = Code, text = Text} = Error}, Config, Callback, Req)
+  when is_record(Config, config),
+       is_record(Callback, callback), 
+       is_record(Req, tftp_msg_req) ->
+    Args =  [Code, Text, Callback#callback.state],
+    catch apply(Callback#callback.module, Fun, Args),
+    {undefined, Error};
+do_callback({abort, Error}, _Config, undefined, _Req) when is_record(Error, tftp_msg_error) ->
+    {undefined, Error}.
+
+peer_info(#config{udp_host = Host, udp_port = Port}) ->
+    if
+	is_tuple(Host), size(Host) =:= 4 ->
+	    {inet, tftp_lib:host_to_string(Host), Port};
+	is_tuple(Host), size(Host) =:= 8 ->
+	    {inet6, tftp_lib:host_to_string(Host), Port};
+	true ->
+	    {undefined, Host, Port}
+    end.
+
+match_callback(Filename, Callbacks) ->
+    if
+	Filename =:= binary ->
+	    {ok, #callback{regexp   = "", 
+			   internal = "", 
+			   module   = tftp_binary,
+			   state    = []}};
+	is_binary(Filename) ->
+	    {ok, #callback{regexp   = "", 
+			   internal = "", 
+			   module   = tftp_binary, 
+			   state    = []}};  
+	Callbacks =:= []  ->
+	    {ok, #callback{regexp   = "", 
+			   internal = "",
+			   module   = tftp_file, 
+			   state    = []}};
+	true ->
+	    do_match_callback(Filename, Callbacks)
+    end.
+
+do_match_callback(Filename, [C | Tail]) when is_record(C, callback) ->
+    case catch regexp:match(Filename, C#callback.internal) of
+	{match, _, _} ->
+	    {ok, C};
+	nomatch ->
+	    do_match_callback(Filename, Tail);
+	Details ->
+	    Code = baduser,
+	    Text = "Internal error. File handler not found",
+	    {error, #tftp_msg_error{code = Code, text = Text, details = Details}}
+    end;
+do_match_callback(Filename, []) ->
+    Code = baduser,
+    Text = "Internal error. File handler not found",
+    {error, #tftp_msg_error{code = Code, text = Text, details = Filename}}.
+
+verify_count(Config, Callback, Req, Result) ->
+    case Config#config.max_tsize of
+	infinity ->
+	    {Callback, Result};
+	Max when Callback#callback.count =< Max ->
+	    {Callback, Result};
+	_Max ->
+	    Code = enospc,
+	    Text = "Too large file.",
+	    callback({abort, {Code, Text}}, Config, Callback, Req)
+    end.
+
+%%-------------------------------------------------------------------
+%% Miscellaneous
+%%-------------------------------------------------------------------
+
+internal_info(Config, Type) ->
+    {ok, ActualPort} = inet:port(Config#config.udp_socket),
+    [
+     {type, Type},
+     {host, tftp_lib:host_to_string(Config#config.udp_host)},
+     {port, Config#config.udp_port},
+     {local_port, ActualPort},
+     {port_policy, Config#config.port_policy},
+     {udp, Config#config.udp_options},
+     {use_tsize, Config#config.use_tsize},
+     {max_tsize, Config#config.max_tsize},
+     {max_conn, Config#config.max_conn},
+     {rejected, Config#config.rejected},
+     {timeout, Config#config.timeout},
+     {polite_ack, Config#config.polite_ack},
+     {debug, Config#config.debug_level},
+     {parent_pid, Config#config.parent_pid}
+    ] ++ Config#config.user_options ++ Config#config.callbacks.
+
+local_file_access(#tftp_msg_req{access = Access, 
+				local_filename = Local, 
+				filename = Filename}) ->
+    case Local =:= undefined of
+	true ->
+	    %% Server side
+	    {Access, Filename};
+	false ->
+	    %% Client side
+	    case Access of
+		read ->
+		    {write, Local};
+		write ->
+		    {read, Local}
+	    end
+    end.
+
+pre_verify_options(Config, Req) ->
+    Options = Req#tftp_msg_req.options,
+    case catch verify_reject(Config, Req, Options) of
+	ok ->
+	    case verify_integer("tsize", 0, Config#config.max_tsize, Options) of
+		true ->
+		    case verify_integer("blksize", 0, 65464, Options) of
+			true ->
+			    ok;
+			false ->
+			    {error, {badopt, "Too large blksize"}}
+		    end;
+		false ->
+		    {error, {badopt, "Too large tsize"}}
+	    end;
+	{error, Reason} ->
+	    {error, Reason}
+    end.
+    
+post_verify_options(Config, Req, NewOptions, Text) ->
+    OldOptions = Req#tftp_msg_req.options,
+    BadOptions  = 
+	[Key || {Key, _Val} <- NewOptions, 
+		not lists:keymember(Key, 1, OldOptions)],
+    case BadOptions =:= [] of
+	true ->
+	    {ok,
+	     Config#config{timeout = lookup_timeout(NewOptions)},
+	     Req#tftp_msg_req{options = NewOptions}};
+	false ->
+	    {error, {badopt, Text}}
+    end.
+
+verify_reject(Config, Req, Options) ->
+    Access = Req#tftp_msg_req.access,
+    Rejected = Config#config.rejected,
+    case lists:member(Access, Rejected) of
+	true ->
+	    {error, {eacces, atom_to_list(Access) ++ " mode not allowed"}};
+	false ->
+	    [throw({error, {badopt, Key ++ " not allowed"}}) ||
+		{Key, _} <- Options, lists:member(Key, Rejected)],
+	    ok
+    end.
+
+lookup_timeout(Options) ->
+    case lists:keysearch("timeout", 1, Options) of
+	{value, {_, Val}} ->
+	    list_to_integer(Val);
+	false ->
+	    3
+    end.
+
+lookup_mode(Options) ->
+    case lists:keysearch("mode", 1, Options) of
+	{value, {_, Val}} ->
+	    Val;
+	false ->
+	    "octet"
+    end.
+
+verify_integer(Key, Min, Max, Options) ->
+    case lists:keysearch(Key, 1, Options) of
+	{value, {_, Val}} when is_list(Val) ->
+	    case catch list_to_integer(Val) of
+		{'EXIT', _} ->
+		    false;
+		Int when Int >= Min, is_integer(Min),
+		         Max =:= infinity ->
+		    true;
+		Int when Int >= Min, is_integer(Min),
+                         Int =< Max, is_integer(Max) ->
+		    true;
+		_ ->
+		    false
+	    end;
+	false ->
+	    true
+    end.
+error(F, A) ->
+    ok = error_logger:format("~p(~p): " ++ F ++ "~n", [?MODULE, self() | A]).
+
+print_debug_info(#config{debug_level = Level} = Config, Who, What, Data) ->
+    if
+	Level =:= none ->
+	    ok;
+	is_record(Data, error) ->
+	    do_print_debug_info(Config, Who, What, Data);
+	Level =:= error ->
+	    ok;	
+	Level =:= all ->
+	    do_print_debug_info(Config, Who, What, Data);
+	What =:= open ->
+	    do_print_debug_info(Config, Who, What, Data);
+	What =:= close ->
+	    do_print_debug_info(Config, Who, What, Data);
+	Level =:= brief ->
+	    ok;	
+	What /= recv, What /= send ->
+	    ok;
+	is_record(Data, tftp_msg_data), Level =:= normal ->
+	    ok;	 
+	is_record(Data, tftp_msg_ack), Level =:= normal ->
+	    ok;
+	true ->
+	    do_print_debug_info(Config, Who, What, Data)
+    end.
+
+do_print_debug_info(Config, Who, What, #tftp_msg_data{data = Bin} = Msg) when is_binary(Bin) ->
+    Msg2 = Msg#tftp_msg_data{data = {bytes, size(Bin)}},
+    do_print_debug_info(Config, Who, What, Msg2);
+do_print_debug_info(Config, Who, What, #tftp_msg_req{local_filename = Filename} = Msg) when is_binary(Filename) ->
+    Msg2 = Msg#tftp_msg_req{local_filename = binary},
+    do_print_debug_info(Config, Who, What, Msg2);
+do_print_debug_info(Config, Who, What, Data) ->
+    Local = 
+	case catch inet:port(Config#config.udp_socket) of
+	    {'EXIT', _Reason} ->
+		0;
+	    {ok, Port} ->
+		Port
+	end,
+    %% Remote = Config#config.udp_port,
+    PeerInfo = peer_info(Config),
+    Side = 
+	if
+	    is_record(Who, tftp_msg_req),
+	    Who#tftp_msg_req.local_filename /= undefined ->
+		client;
+	    is_record(Who, tftp_msg_req),
+	    Who#tftp_msg_req.local_filename =:= undefined ->
+		server;
+	    is_atom(Who) ->
+		Who
+	end,
+    case {What, Data} of
+	{_, #error{what = What, code = Code, text = Text}} -> 
+	    io:format("~p(~p): ~p ~p -> ~p: ~s\n", [Side, Local, self(), What, Code, Text]);
+	{open, #tftp_msg_req{filename = Filename}} ->
+	    io:format("~p(~p): open  ~p -> ~p ~p\n", [Side, Local, PeerInfo, self(), Filename]);
+	{close, #tftp_msg_req{filename = Filename}} ->
+	    io:format("~p(~p): close ~p -> ~p ~p\n", [Side, Local, PeerInfo, self(), Filename]);
+	{recv, _} ->
+	    io:format("~p(~p): recv  ~p <- ~p\n", [Side, Local, PeerInfo, Data]);
+	{send, _} ->
+	    io:format("~p(~p): send  ~p -> ~p\n", [Side, Local, PeerInfo, Data]);
+	{match, _} when is_record(Data, callback) ->
+	    Mod = Data#callback.module,
+	    State = Data#callback.state,
+	    io:format("~p(~p): match ~p ~p => ~p\n", [Side, Local, PeerInfo, Mod, State]);
+	{call, _} ->
+	    case Data of
+		{Callback, _Result} when is_record(Callback, callback) ->
+		    Mod   = Callback#callback.module,
+		    State = Callback#callback.state,
+		    io:format("~p(~p): call ~p ~p => ~p\n", [Side, Local, PeerInfo, Mod, State]);
+		{undefined, Result}  ->
+		    io:format("~p(~p): call ~p result => ~p\n", [Side, Local, PeerInfo, Result])
+	    end
+    end.
+
+
+%%-------------------------------------------------------------------
+%% System upgrade
+%%-------------------------------------------------------------------
+
+system_continue(_Parent, _Debug, {Fun, Args}) ->
+    apply(?MODULE, Fun, Args).
+
+system_terminate(Reason, _Parent, _Debug, {_Fun, _Args}) ->
+    exit(Reason).
+
+system_code_change({Fun, Args}, _Module, _OldVsn, _Extra) ->
+    {ok, {Fun, Args}}.

Added: incubator/couchdb/trunk/src/couch_inets/tftp_file.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/tftp_file.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/tftp_file.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/tftp_file.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,338 @@
+%%%-------------------------------------------------------------------
+%%% File    : tft_file.erl
+%%% Author  : Hakan Mattsson <hakan@erix.ericsson.se>
+%%% Description : 
+%%%
+%%% Created : 24 May 2004 by Hakan Mattsson <hakan@erix.ericsson.se>
+%%%-------------------------------------------------------------------
+
+-module(tftp_file).
+
+%%%-------------------------------------------------------------------
+%%% Interface
+%%%-------------------------------------------------------------------
+
+-behaviour(tftp).
+
+-export([prepare/6, open/6, read/1, write/2, abort/3]).
+-export([prepare/5, open/5]).
+
+%%%-------------------------------------------------------------------
+%%% Defines
+%%%-------------------------------------------------------------------
+
+-include_lib("kernel/include/file.hrl").
+
+-record(state, {access,
+		filename,
+		root_dir,
+		options,
+		blksize,
+		fd,
+		count,
+		buffer}).
+
+%%-------------------------------------------------------------------
+%% prepare(Peer, Access, Filename, Mode, SuggestedOptions, InitialState) -> 
+%%    {ok, AcceptedOptions, NewState} | {error, Code, Text}
+%%
+%% Peer             = {PeerType, PeerHost, PeerPort}
+%% PeerType         = inet | inet6
+%% PeerHost         = ip_address()
+%% PeerPort         = integer()
+%% Acess            = read | write
+%% Filename         = string()
+%% Mode             = string()
+%% SuggestedOptions = [{Key, Value}]
+%% AcceptedOptions  = [{Key, Value}]
+%% Key              = string()
+%% Value            = string()
+%% InitialState     = [] | [{root_dir, string()}]
+%% NewState         = term()
+%% Code             = undef | enoent | eacces | enospc |
+%%                    badop | eexist | baduser | badopt |
+%%                    integer()
+%% Text             = string()
+%%
+%% Prepares open of a file on the client side.
+%% 
+%% Will be followed by a call to open/4 before any read/write access
+%% is performed. The AcceptedOptions will be sent to the server which
+%% will reply with those options that it accepts. The options that are
+%% accepted by the server will be forwarded to open/4 as SuggestedOptions.
+%%
+%% No new options may be added, but the ones that are present as
+%% SuggestedOptions may be omitted or replaced with new values
+%% in the AcceptedOptions.
+%%-------------------------------------------------------------------
+
+prepare(_Peer, Access, Filename, Mode, SuggestedOptions, Initial) ->
+    %% Kept for backwards compatibility 
+    prepare(Access, Filename, Mode, SuggestedOptions, Initial).
+
+prepare(Access, Filename, Mode, SuggestedOptions, Initial) when is_list(Initial) ->
+    %% Client side
+    case catch handle_options(Access, Filename, Mode, SuggestedOptions, Initial) of
+	{ok, Filename2, AcceptedOptions} ->
+	    State = #state{access           = Access,
+			   filename         = Filename2,
+			   options  	    = AcceptedOptions,
+			   blksize  	    = lookup_blksize(AcceptedOptions),
+			   count    	    = 0,
+			   buffer   	    = []},
+	    {ok, AcceptedOptions, State};
+	{error, {Code, Text}} ->
+	    {error, {Code, Text}}
+    end.
+
+%% ---------------------------------------------------------
+%% open(Peer, Access, Filename, Mode, SuggestedOptions, State) -> 
+%%    {ok, AcceptedOptions, NewState} | {error, Code, Text}
+%%
+%% Peer             = {PeerType, PeerHost, PeerPort}
+%% PeerType         = inet | inet6
+%% PeerHost         = ip_address()
+%% PeerPort         = integer()
+%% Acess            = read | write
+%% Filename         = string()
+%% Mode             = string()
+%% SuggestedOptions = [{Key, Value}]
+%% AcceptedOptions  = [{Key, Value}]
+%% Key              = string()
+%% Value            = string()
+%% State            = InitialState | #state{}
+%% InitialState     = [] | [{root_dir, string()}]
+%% NewState         = term()
+%% Code             = undef | enoent | eacces  | enospc |
+%%                    badop | eexist | baduser | badopt |
+%%                    integer()
+%% Text             = string()
+%%
+%% Opens a file for read or write access.
+%% 
+%% On the client side where the open/4 call has been preceeded by a
+%% call to prepare/4, all options must be accepted or rejected.
+%% On the server side, where there are no preceeding prepare/4 call,
+%% noo new options may be added, but the ones that are present as
+%% SuggestedOptions may be omitted or replaced with new values
+%% in the AcceptedOptions.
+%%-------------------------------------------------------------------
+
+open(_Peer, Access, Filename, Mode, SuggestedOptions, Initial) ->
+    %% Kept for backwards compatibility 
+    open(Access, Filename, Mode, SuggestedOptions, Initial).
+
+open(Access, Filename, Mode, SuggestedOptions, Initial) when is_list(Initial) ->
+    %% Server side
+    case prepare(Access, Filename, Mode, SuggestedOptions, Initial) of
+	{ok, AcceptedOptions, State} ->
+	    open(Access, Filename, Mode, AcceptedOptions, State);
+	{error, {Code, Text}} ->
+	    {error, {Code, Text}}
+    end;
+open(Access, Filename, Mode, NegotiatedOptions, State) when is_record(State, state) ->
+    %% Both sides
+    case catch handle_options(Access, Filename, Mode, NegotiatedOptions, State) of
+	{ok, _Filename2, Options} 
+	   when Options =:= NegotiatedOptions ->
+	    do_open(State);
+	{error, {Code, Text}} ->
+	    {error, {Code, Text}}
+    end.
+
+do_open(State) when is_record(State, state) ->
+    case file:open(State#state.filename, file_options(State)) of
+	{ok, Fd} ->
+	    {ok, State#state.options, State#state{fd = Fd}};
+	{error, Reason} when is_atom(Reason) ->
+	    {error, file_error(Reason)}
+    end.
+	
+file_options(State) ->
+    case State#state.access of
+	read  -> [read, read_ahead, raw, binary];
+	write -> [write, delayed_write, raw, binary]
+    end.
+
+file_error(Reason) when is_atom(Reason) ->
+    Details = file:format_error(Reason),
+    case Reason of
+	eexist -> {Reason, Details};
+	enoent -> {Reason, Details};
+	eacces -> {Reason, Details};
+	eperm  -> {eacces, Details};
+	enospc -> {Reason, Details};
+	_      -> {undef,  Details ++ " (" ++ atom_to_list(Reason) ++ ")"}
+    end.
+
+%%-------------------------------------------------------------------
+%% read(State) ->
+%%   {more, Bin, NewState} | {last, Bin, FileSize} | {error, {Code, Text}}
+%%
+%% State    = term()
+%% NewState = term()
+%% Bin      = binary()
+%% FileSize = integer()
+%% Code     = undef | enoent | eacces  | enospc |
+%%            badop | eexist | baduser | badopt |
+%%            integer()
+%% Text     = string()
+%%
+%% Reads a chunk from the file
+%% 
+%% The file is automatically closed when the last chunk is read.
+%%-------------------------------------------------------------------
+
+read(#state{access = read} = State) ->
+    BlkSize = State#state.blksize,
+    case file:read(State#state.fd, BlkSize) of
+	{ok, Bin} when is_binary(Bin), size(Bin) =:= BlkSize ->
+	    Count = State#state.count + size(Bin),
+	    {more, Bin, State#state{count = Count}};
+	{ok, Bin} when is_binary(Bin), size(Bin) < BlkSize ->
+	    file:close(State#state.fd),
+	    Count = State#state.count + size(Bin),
+	    {last, Bin, Count};
+	eof ->
+	    {last, <<>>, State#state.count};
+	{error, Reason} ->
+	    file:close(State#state.fd),
+	    {error, file_error(Reason)}
+    end.
+
+%%-------------------------------------------------------------------
+%% write(Bin, State) ->
+%%   {more, NewState} | {last, FileSize} | {error, {Code, Text}}
+%%
+%% State    = term()
+%% NewState = term()
+%% Bin      = binary()
+%% FileSize = integer()
+%% Code     = undef | enoent | eacces  | enospc |
+%%            badop | eexist | baduser | badopt |
+%%            integer()
+%% Text     = string()
+%%
+%% Writes a chunk to the file
+%%
+%% The file is automatically closed when the last chunk is written
+%%-------------------------------------------------------------------
+
+write(Bin, #state{access = write} = State) when is_binary(Bin) ->
+    Size = size(Bin),
+    BlkSize = State#state.blksize,
+    case file:write(State#state.fd, Bin) of
+	ok when Size =:= BlkSize->
+	    Count = State#state.count + Size,
+	    {more, State#state{count = Count}};
+	ok when Size < BlkSize->
+	    file:close(State#state.fd),
+	    Count = State#state.count + Size,
+	    {last, Count};
+	{error, Reason}  ->
+	    file:close(State#state.fd),
+	    file:delete(State#state.filename),
+	    {error, file_error(Reason)}
+    end.
+
+%%-------------------------------------------------------------------
+%% abort(Code, Text, State) -> ok
+%% 
+%% State    = term()
+%% Code     = undef  | enoent | eacces  | enospc |
+%%            badop  | eexist | baduser | badopt |
+%%            badblk | integer()
+%% Text     = string()
+%%
+%% Aborts the file transfer
+%%-------------------------------------------------------------------
+
+abort(_Code, _Text, #state{fd = Fd, access = Access} = State) ->
+    file:close(Fd),
+    case Access of
+	write ->
+	    ok = file:delete(State#state.filename);
+	read ->
+	    ok
+    end.
+
+%%-------------------------------------------------------------------
+%% Process options
+%%-------------------------------------------------------------------
+
+handle_options(Access, Filename, Mode, Options, InitialState) when Mode =:= "octet" ->
+    Filename2 = handle_filename(Filename, InitialState),
+    Options2 = do_handle_options(Access, Filename2, Options),
+    {ok, Filename2, Options2};
+handle_options(_Access, _Filename, Mode, _Options, _InitialState) ->
+    {error, {badop, "Illegal mode " ++ Mode}}.
+
+handle_filename(Filename, InitialState) when is_list(InitialState) ->
+    case lists:keysearch(root_dir, 1, InitialState) of
+	{value, {_, Dir}} ->
+	    case catch filename_join(Dir, Filename) of
+		{'EXIT', _} ->
+		    throw({error, {badop, "Internal error. root_dir is not a string"}});
+		Filename2 ->
+		    Filename2
+	    end;
+	false ->
+	    Filename
+    end;
+handle_filename(_Filename, State) when is_record(State, state) ->
+    State#state.filename.
+
+filename_join(Dir, Filename) ->
+    case filename:pathtype(Filename) of
+	absolute ->
+	    [_ | RelFilename] = filename:split(Filename),
+	    filename:join([Dir, RelFilename]);
+	_ ->
+	    filename:join([Dir, Filename])
+    end.
+
+do_handle_options(Access, Filename, [{Key, Val} | T]) ->
+    case Key of
+	"tsize" ->
+	    case Access of
+		read when Val =:= "0" ->
+		    case file:read_file_info(Filename) of
+			{ok, FI} ->
+			    Tsize = integer_to_list(FI#file_info.size),
+			    [{Key, Tsize} | do_handle_options(Access, Filename, T)];
+			{error, _} ->
+			    do_handle_options(Access, Filename, T)
+		    end;
+		_ ->
+		    handle_integer(Access, Filename, Key, Val, T, 0, infinity)
+	    end;
+	"blksize" ->
+	    handle_integer(Access, Filename, Key, Val, T, 8, 65464);
+	"timeout" ->
+	    handle_integer(Access, Filename, Key, Val, T, 1, 255);
+	_ ->
+	    do_handle_options(Access, Filename, T)
+    end;
+do_handle_options(_Access, _Filename, []) ->
+    [].
+
+
+handle_integer(Access, Filename, Key, Val, Options, Min, Max) ->
+    case catch list_to_integer(Val) of
+	{'EXIT', _} ->
+	    do_handle_options(Access, Filename, Options);
+	Int when Int >= Min, Int =< Max ->
+	    [{Key, Val} | do_handle_options(Access, Filename, Options)];
+	Int when Int >= Min, Max =:= infinity ->
+	    [{Key, Val} | do_handle_options(Access, Filename, Options)];
+	_Int ->
+	    throw({error, {badopt, "Illegal " ++ Key ++ " value " ++ Val}})
+    end.
+
+lookup_blksize(Options) ->
+    case lists:keysearch("blksize", 1, Options) of
+	{value, {_, Val}} ->
+	    list_to_integer(Val);
+	false ->
+	    512
+    end.

Added: incubator/couchdb/trunk/src/couch_inets/tftp_lib.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/tftp_lib.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/tftp_lib.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/tftp_lib.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,418 @@
+%%%-------------------------------------------------------------------
+%%% File    : tftp_lib.erl
+%%% Author  : Hakan Mattsson <hakan@erix.ericsson.se>
+%%% Description : Option parsing, decode, encode etc.
+%%%
+%%% Created : 18 May 2004 by Hakan Mattsson <hakan@erix.ericsson.se>
+%%%-------------------------------------------------------------------
+
+-module(tftp_lib).
+
+%%-------------------------------------------------------------------
+%% Interface
+%%-------------------------------------------------------------------
+
+%% application internal functions
+-export([
+	 parse_config/1,
+	 parse_config/2,
+	 decode_msg/1,
+	 encode_msg/1,
+	 replace_val/3,
+	 to_lower/1,
+	 host_to_string/1
+	]).
+
+%%-------------------------------------------------------------------
+%% Defines
+%%-------------------------------------------------------------------
+
+-include("tftp.hrl").
+
+-define(LOWER(Char),
+	if
+	    Char >= $A, Char =< $Z ->
+		Char - ($A - $a);
+	    true ->
+		Char
+	end).
+
+%%-------------------------------------------------------------------
+%% Config
+%%-------------------------------------------------------------------
+
+parse_config(Options) ->
+    parse_config(Options, #config{}).
+
+parse_config(Options, Config) ->
+    do_parse_config(Options, Config).
+
+do_parse_config([{Key, Val} | Tail], Config) when is_record(Config, config) ->
+    case Key of
+	debug ->
+	    case Val of
+		none ->
+		    do_parse_config(Tail, Config#config{debug_level = Val});
+		error ->
+		    do_parse_config(Tail, Config#config{debug_level = Val});
+		brief ->
+		    do_parse_config(Tail, Config#config{debug_level = Val});
+		normal ->
+		    do_parse_config(Tail, Config#config{debug_level = Val});
+		verbose ->
+		    do_parse_config(Tail, Config#config{debug_level = Val});
+		all ->
+		    do_parse_config(Tail, Config#config{debug_level = Val});
+		_ ->
+		    exit({badarg, {Key, Val}})
+	    end;
+	host ->
+	    if
+		is_list(Val) ->
+		    do_parse_config(Tail, Config#config{udp_host = Val});
+		is_tuple(Val), size(Val) =:= 4 ->
+		    do_parse_config(Tail, Config#config{udp_host = Val});
+		is_tuple(Val), size(Val) =:= 8 ->
+		    do_parse_config(Tail, Config#config{udp_host = Val});
+		true ->
+		    exit({badarg, {Key, Val}})
+	    end;
+	port ->
+	    if
+		is_integer(Val), Val >= 0 ->
+		    Config2 = Config#config{udp_port = Val, udp_options = Config#config.udp_options},
+		    do_parse_config(Tail, Config2);
+		true ->
+		    exit({badarg, {Key, Val}})
+	    end;
+	port_policy ->
+	    case Val of
+		random ->
+		    do_parse_config(Tail, Config#config{port_policy = Val});
+		0 ->
+		    do_parse_config(Tail, Config#config{port_policy = random});
+		MinMax when is_integer(MinMax), MinMax > 0 ->
+		    do_parse_config(Tail, Config#config{port_policy = {range, MinMax, MinMax}});
+		{range, Min, Max} when Max >= Min, 
+		integer(Min), Min > 0,
+		integer(Max), Max > 0 ->
+		    do_parse_config(Tail, Config#config{port_policy = Val});
+		true ->
+		    exit({badarg, {Key, Val}})
+	    end;
+	udp when is_list(Val) ->
+	    Fun =  
+		fun({K, V}, List) when K /= active -> 
+			replace_val(K, V, List);
+		   (V, List) when V /= list, V /= binary ->
+			List ++ [V];
+		   (V, _List) ->
+			exit({badarg, {udp, [V]}})
+		end,
+	    UdpOptions = lists:foldl(Fun, Config#config.udp_options, Val),
+	    do_parse_config(Tail, Config#config{udp_options = UdpOptions});
+	use_tsize ->
+	    case Val of
+		true ->
+		    do_parse_config(Tail, Config#config{use_tsize = Val});
+		false ->
+		    do_parse_config(Tail, Config#config{use_tsize = Val});
+		_ ->
+		    exit({badarg, {Key, Val}})
+	    end;
+	max_tsize ->
+	    if
+		Val =:= infinity ->
+		    do_parse_config(Tail, Config#config{max_tsize = Val});
+		integer(Val), Val >= 0 ->
+		    do_parse_config(Tail, Config#config{max_tsize = Val});
+		true ->
+		    exit({badarg, {Key, Val}})
+	    end;
+	max_conn ->
+	    if
+		Val =:= infinity ->
+		    do_parse_config(Tail, Config#config{max_conn = Val});
+		integer(Val), Val > 0 ->
+		    do_parse_config(Tail, Config#config{max_conn = Val});
+		true ->
+		    exit({badarg, {Key, Val}})
+	    end;
+	_ when is_list(Key), is_list(Val) ->
+	    Key2 = to_lower(Key),
+	    Val2 = to_lower(Val),
+	    TftpOptions = replace_val(Key2, Val2, Config#config.user_options),
+	    do_parse_config(Tail, Config#config{user_options = TftpOptions});
+	reject ->
+	    case Val of
+		read ->
+		    Rejected = [Val | Config#config.rejected],
+		    do_parse_config(Tail, Config#config{rejected = Rejected});
+		write ->
+		    Rejected = [Val | Config#config.rejected],
+		    do_parse_config(Tail, Config#config{rejected = Rejected});
+		_ when is_list(Val) ->
+		    Rejected = [Val | Config#config.rejected],
+		    do_parse_config(Tail, Config#config{rejected = Rejected});
+		_ ->
+		    exit({badarg, {Key, Val}})
+	    end;
+	callback ->
+	    case Val of
+		{RegExp, Mod, State} when is_list(RegExp), atom(Mod) ->
+		    case regexp:parse(RegExp) of
+			{ok, Internal} ->
+			    Callback = #callback{regexp   = RegExp,
+						 internal = Internal,
+						 module   = Mod,
+						 state    = State},
+			    Callbacks = Config#config.callbacks ++ [Callback],
+			    do_parse_config(Tail, Config#config{callbacks = Callbacks});
+			{error, Reason} ->
+			    exit({badarg, {Key, Val}, Reason})
+		    end;
+		_ ->
+		    exit({badarg, {Key, Val}})
+	    end;
+	_ ->
+	    exit({badarg, {Key, Val}})
+    end;
+do_parse_config([], Config) when is_record(Config, config) ->
+    UdpOptions = Config#config.udp_options,
+    IsInet6 = lists:member(inet6, UdpOptions),
+    IsInet  = lists:member(inet, UdpOptions),
+    Host    = Config#config.udp_host,
+    Host2 = 
+	if
+	    (IsInet and not IsInet6); (not IsInet and not IsInet6) -> 
+		case inet:getaddr(Host, inet) of
+		    {ok, Addr} ->
+			Addr;
+		    {error, Reason} ->
+			exit({badarg, {host, Reason}})
+		end;
+	    (IsInet6 and not IsInet)  ->
+		case inet:getaddr(Host, inet6) of
+		    {ok, Addr} ->
+			Addr;
+		    {error, Reason} ->
+			exit({badarg, {host, Reason}})
+		end;
+	    true ->
+		%% Conflicting options
+		exit({badarg, {udp, [inet]}})
+	end,
+    UdpOptions2 = lists:reverse(UdpOptions),
+    TftpOptions = lists:reverse(Config#config.user_options),
+    Config#config{udp_host = Host2, udp_options = UdpOptions2, user_options = TftpOptions};
+do_parse_config(Options, Config) when is_record(Config, config) ->
+    exit({badarg, Options}).
+
+host_to_string(Host) ->
+    case Host of
+	String when is_list(String) ->
+	    String;
+	{A1, A2, A3, A4} -> % inet
+	    lists:concat([A1, ".", A2, ".", A3, ".",A4]);
+	{A1, A2, A3, A4, A5, A6, A7, A8} -> % inet6
+	    lists:concat([
+			  int16_to_hex(A1), "::",
+			  int16_to_hex(A2), "::",
+			  int16_to_hex(A3), "::",
+			  int16_to_hex(A4), "::",
+			  int16_to_hex(A5), "::",
+			  int16_to_hex(A6), "::",
+			  int16_to_hex(A7), "::",
+			  int16_to_hex(A8)
+			 ])
+    end.
+
+int16_to_hex(0) ->
+    [$0];
+int16_to_hex(I) ->
+    N1 = ((I bsr 8) band 16#ff),
+    N2 = (I band 16#ff),
+    [code_character(N1 div 16), code_character(N1 rem 16),
+     code_character(N2 div 16), code_character(N2 rem 16)].
+
+code_character(N) when N < 10 ->
+    $0 + N;
+code_character(N) ->
+    $A + (N - 10).
+
+%%-------------------------------------------------------------------
+%% Decode
+%%-------------------------------------------------------------------
+
+decode_msg(Bin) when is_binary(Bin) ->
+    case Bin of
+	<<?TFTP_OPCODE_RRQ:16/integer, Tail/binary>> ->
+	    case decode_strings(Tail, [keep_case, lower_case]) of
+		[Filename, Mode | Strings] ->
+		    Options = decode_options(Strings),
+		    #tftp_msg_req{access = read,
+				  filename = Filename,
+				  mode = to_lower(Mode),
+				  options = Options};
+		[_Filename | _Strings] ->
+		    exit(#tftp_msg_error{code = undef,
+					 text = "Missing mode"});
+		_ ->
+		    exit(#tftp_msg_error{code = undef,
+					 text = "Missing filename"})
+	    end;
+	<<?TFTP_OPCODE_WRQ:16/integer, Tail/binary>> ->
+	    case decode_strings(Tail, [keep_case, lower_case]) of
+		[Filename, Mode | Strings] ->
+		    Options = decode_options(Strings),
+		    #tftp_msg_req{access = write,
+				  filename = Filename,
+				  mode = to_lower(Mode),
+				  options = Options};
+		[_Filename | _Strings] ->
+		    exit(#tftp_msg_error{code = undef,
+					 text = "Missing mode"});
+		_ ->
+		    exit(#tftp_msg_error{code = undef,
+					 text = "Missing filename"})
+	    end;
+	<<?TFTP_OPCODE_DATA:16/integer, SeqNo:16/integer, Data/binary>> ->
+	    #tftp_msg_data{block_no = SeqNo, data = Data};
+	<<?TFTP_OPCODE_ACK:16/integer, SeqNo:16/integer>> ->
+	    #tftp_msg_ack{block_no = SeqNo};
+	<<?TFTP_OPCODE_ERROR:16/integer, ErrorCode:16/integer, Tail/binary>> ->
+	    case decode_strings(Tail, [keep_case]) of
+		[ErrorText] ->
+		    ErrorCode2 = decode_error_code(ErrorCode),
+		    #tftp_msg_error{code = ErrorCode2,
+				    text = ErrorText};
+		_ ->
+		    exit(#tftp_msg_error{code = undef,
+					 text = "Trailing garbage"})
+	    end;
+	<<?TFTP_OPCODE_OACK:16/integer, Tail/binary>> ->
+	    Strings = decode_strings(Tail, [lower_case]),
+	    Options = decode_options(Strings),
+	    #tftp_msg_oack{options = Options};
+	_ ->
+	    exit(#tftp_msg_error{code = undef,
+				 text = "Invalid syntax"})
+    end.
+
+decode_strings(Bin, Cases) when is_binary(Bin), is_list(Cases) ->
+    do_decode_strings(Bin, Cases, []).
+
+do_decode_strings(<<>>, _Cases, Strings) ->
+    lists:reverse(Strings);
+do_decode_strings(Bin, [Case | Cases], Strings) ->
+    {String, Tail} = decode_string(Bin, Case, []),
+    if
+	Cases =:= [] ->
+	    do_decode_strings(Tail, [Case], [String | Strings]);
+	true ->
+	    do_decode_strings(Tail, Cases,  [String | Strings])
+    end.
+
+decode_string(<<Char:8/integer, Tail/binary>>, Case, String) ->
+    if
+	Char =:= 0 ->
+	    {lists:reverse(String), Tail};
+	Case =:= keep_case ->
+	    decode_string(Tail, Case, [Char | String]);
+	Case =:= lower_case ->
+	    Char2 = ?LOWER(Char),
+	    decode_string(Tail, Case, [Char2 | String])
+    end;
+decode_string(<<>>, _Case, _String) ->
+    exit(#tftp_msg_error{code = undef, text = "Trailing null missing"}).
+
+decode_options([Key, Value | Strings]) ->
+    [{to_lower(Key), Value} | decode_options(Strings)];
+decode_options([]) ->
+    [].
+
+decode_error_code(Int) ->
+    case Int of
+	?TFTP_ERROR_UNDEF   -> undef;
+	?TFTP_ERROR_ENOENT  -> enoent;
+        ?TFTP_ERROR_EACCES  -> eacces;
+        ?TFTP_ERROR_ENOSPC  -> enospc;
+        ?TFTP_ERROR_BADOP   -> badop;
+        ?TFTP_ERROR_BADBLK  -> badblk;
+        ?TFTP_ERROR_EEXIST  -> eexist;
+        ?TFTP_ERROR_BADUSER -> baduser;
+        ?TFTP_ERROR_BADOPT  -> badopt;
+        Int when is_integer(Int), Int >= 0, Int =< 65535 -> Int;
+	_ -> exit(#tftp_msg_error{code = undef, text = "Error code outside range."})
+    end.
+
+%%-------------------------------------------------------------------
+%% Encode
+%%-------------------------------------------------------------------
+
+encode_msg(#tftp_msg_req{access = Access,
+			 filename = Filename,
+			 mode = Mode, 
+			 options = Options}) ->
+    OpCode = case Access of
+		 read  -> ?TFTP_OPCODE_RRQ;
+		 write -> ?TFTP_OPCODE_WRQ
+	     end,
+    [
+     <<OpCode:16/integer>>,
+     Filename, 
+     0, 
+     Mode, 
+     0,
+     [[Key, 0, Val, 0] || {Key, Val} <- Options]
+    ];
+encode_msg(#tftp_msg_data{block_no = BlockNo, data = Data}) when BlockNo =< 65535 ->
+    [
+     <<?TFTP_OPCODE_DATA:16/integer, BlockNo:16/integer>>,
+     Data
+    ];
+encode_msg(#tftp_msg_ack{block_no = BlockNo}) when BlockNo =< 65535 ->
+    <<?TFTP_OPCODE_ACK:16/integer, BlockNo:16/integer>>;
+encode_msg(#tftp_msg_error{code = Code, text = Text}) ->
+    IntCode = encode_error_code(Code),
+    [
+     <<?TFTP_OPCODE_ERROR:16/integer, IntCode:16/integer>>, 
+     Text,
+     0
+    ];
+encode_msg(#tftp_msg_oack{options = Options}) ->
+    [
+     <<?TFTP_OPCODE_OACK:16/integer>>,
+     [[Key, 0, Val, 0] || {Key, Val} <- Options]
+    ].
+
+encode_error_code(Code) ->
+    case Code of
+	undef   -> ?TFTP_ERROR_UNDEF;
+	enoent  -> ?TFTP_ERROR_ENOENT;
+        eacces  -> ?TFTP_ERROR_EACCES;
+        enospc  -> ?TFTP_ERROR_ENOSPC;
+        badop   -> ?TFTP_ERROR_BADOP;
+        badblk  -> ?TFTP_ERROR_BADBLK;
+        eexist  -> ?TFTP_ERROR_EEXIST;
+        baduser -> ?TFTP_ERROR_BADUSER;
+        badopt  -> ?TFTP_ERROR_BADOPT;
+        Int when is_integer(Int), Int >= 0, Int =< 65535 -> Int
+    end.
+
+%%-------------------------------------------------------------------
+%% Miscellaneous
+%%-------------------------------------------------------------------
+
+replace_val(Key, Val, List) ->
+    case lists:keysearch(Key, 1, List) of
+	false ->
+	    List ++ [{Key, Val}];
+	{value, {_, OldVal}} when OldVal =:= Val ->
+	    List;
+	{value, {_, _}} ->
+	    lists:keyreplace(Key, 1, List, {Key, Val})
+    end.
+
+to_lower(Chars) ->
+    [?LOWER(Char) || Char <- Chars].

Added: incubator/couchdb/trunk/src/couch_inets/tftp_sup.erl
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couch_inets/tftp_sup.erl?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couch_inets/tftp_sup.erl (added)
+++ incubator/couchdb/trunk/src/couch_inets/tftp_sup.erl Fri Mar 28 16:32:19 2008
@@ -0,0 +1,81 @@
+%% ``The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved via the world wide web at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%% 
+%%     $Id$
+%%
+%%----------------------------------------------------------------------
+%% Purpose: The top supervisor for tftp hangs under inets_sup.
+%%----------------------------------------------------------------------
+
+-module(tftp_sup).
+
+-behaviour(supervisor).
+
+%% API
+-export([start_link/1]).
+-export([start_child/1]).
+
+%% Supervisor callback
+-export([init/1]).
+
+%%%=========================================================================
+%%%  API
+%%%=========================================================================
+
+start_link(TftpServices) ->
+    supervisor:start_link({local, ?MODULE}, ?MODULE, [TftpServices]).
+
+start_child(Args) ->
+    supervisor:start_child(?MODULE, Args).
+    
+%%%=========================================================================
+%%%  Supervisor callback
+%%%=========================================================================
+
+init([Services]) when is_list(Services) ->
+    RestartStrategy = one_for_one,
+    MaxR = 10,
+    MaxT = 3600,
+    KillAfter = timer:seconds(3),
+    Children = [worker_spec(KillAfter, Options) || {tftpd, Options} <- Services],
+    {ok, {{RestartStrategy, MaxR, MaxT}, Children}}.
+
+%%%=========================================================================
+%%%  Internal functions
+%%%=========================================================================
+
+worker_spec(KillAfter, Options) ->
+    Modules = [proc_lib, tftp, tftp_engine],
+    KA = supervisor_timeout(KillAfter),
+    Name = unique_name(Options),
+    {Name, {tftp, start, [Options]}, permanent, KA, worker, Modules}.
+
+unique_name(Options) ->
+    case lists:keysearch(port, 1, Options) of
+	{value, {_, Port}} when is_integer(Port), Port > 0 -> 
+	    {tftpd, Port};
+	_ ->
+	    {tftpd, erlang:now()}
+    end.
+
+%% supervisor_spec(Name) ->
+%%     {Name, {Name, start, []}, permanent, infinity, supervisor,
+%%      [Name, supervisor]}.
+    
+-ifdef(debug_shutdown).
+supervisor_timeout(_KillAfter) -> timer:hours(24).
+-else.
+supervisor_timeout(KillAfter) -> KillAfter.
+-endif.    

Propchange: incubator/couchdb/trunk/src/couchdb/
------------------------------------------------------------------------------
--- svn:ignore (added)
+++ svn:ignore Fri Mar 28 16:32:19 2008
@@ -0,0 +1,8 @@
+.deps
+.libs
+Makefile
+Makefile.in
+couch.app
+couch.app.tpl
+couchjs
+*.beam

Added: incubator/couchdb/trunk/src/couchdb/Makefile.am
URL: http://svn.apache.org/viewvc/incubator/couchdb/trunk/src/couchdb/Makefile.am?rev=642432&view=auto
==============================================================================
--- incubator/couchdb/trunk/src/couchdb/Makefile.am (added)
+++ incubator/couchdb/trunk/src/couchdb/Makefile.am Fri Mar 28 16:32:19 2008
@@ -0,0 +1,97 @@
+## Licensed under the Apache License, Version 2.0 (the "License"); you may not
+## use this file except in compliance with the License.  You may obtain a copy
+## of the License at
+##
+##   http://www.apache.org/licenses/LICENSE-2.0
+##
+## Unless required by applicable law or agreed to in writing, software
+## distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
+## WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.  See the
+## License for the specific language governing permissions and limitations under
+## the License.
+
+datarootdir = @prefix@/share
+
+ICU_LOCAL_FLAGS = $(ICU_LOCAL_CFLAGS) $(ICU_LOCAL_LDFLAGS)
+
+couchprivlibdir = $(erlanglibdir)/couch-$(version)/priv/lib
+
+couchprivlib_LTLIBRARIES = couch_erl_driver.la
+couch_erl_driver_la_SOURCES = couch_erl_driver.c
+couch_erl_driver_la_LDFLAGS = -module -avoid-version $(ICU_LOCAL_FLAGS)
+couch_erl_driver_la_CFLAGS = $(ICU_LOCAL_FLAGS)
+couch_erl_driver_la_LIBADD = -licuuc -licudata -licui18n
+
+libbin_PROGRAMS = couchjs
+couchjs_SOURCES = couch_js.c
+
+couchebindir = $(erlanglibdir)/couch-$(version)/ebin
+couchincludedir = $(erlanglibdir)/couch-$(version)/include
+
+couch_file_collection = \
+    cjson.erl \
+    couch_btree.erl \
+    couch_db.erl \
+    couch_db_update_notifier.erl \
+    couch_doc.erl \
+    couch_event_sup.erl \
+    couch_file.erl \
+    couch_ft_query.erl \
+    couch_key_tree.erl \
+    couch_log.erl \
+    couch_query_servers.erl \
+    couch_rep.erl \
+    couch_server.erl \
+    couch_server_sup.erl \
+    couch_stream.erl \
+    couch_util.erl \
+    couch_view.erl \
+    mod_couch.erl
+
+couchebin_DATA = \
+    cjson.beam \
+    couch.app \
+    couch_btree.beam \
+    couch_db.beam \
+    couch_db_update_notifier.beam \
+    couch_doc.beam \
+    couch_event_sup.beam \
+    couch_file.beam \
+    couch_ft_query.beam \
+    couch_key_tree.beam \
+    couch_log.beam \
+    couch_query_servers.beam \
+    couch_rep.beam \
+    couch_server.beam \
+    couch_server_sup.beam \
+    couch_stream.beam \
+    couch_util.beam \
+    couch_view.beam \
+    mod_couch.beam
+
+couchinclude_DATA = couch_db.hrl
+
+EXTRA_DIST = $(couch_file_collection) $(couchinclude_DATA)
+
+CLEANFILES = $(couchebin_DATA)
+
+couch.app: couch.app.tpl
+	sed -e "s|%package_name%|@package_name@|g" \
+	    -e "s|%version%|@version@|g" > \
+	$@ < $<
+	chmod +x $@
+
+%.beam: %.erl
+	erlc $<
+
+install-data-hook:
+	if test -f "$(DESTDIR)/$(couchprivlibdir)/couch_erl_driver"; then \
+	    rm -f "$(DESTDIR)/$(couchprivlibdir)/couch_erl_driver.so"; \
+	    cd "$(DESTDIR)/$(couchprivlibdir)" && \
+	        $(LN_S) couch_erl_driver couch_erl_driver.so; \
+	fi
+
+uninstall-local:
+	if test -f "$(DESTDIR)/$(couchprivlibdir)/couch_erl_driver"; then \
+	    rm -f "$(DESTDIR)/$(couchprivlibdir)/couch_erl_driver.so"; \
+	fi



Mime
View raw message