1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2005-2018. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20%%
21
22%%%-------------------------------------------------------------------
23%%% File    : tft_binary.erl
24%%% Author  : Hakan Mattsson <hakan@erix.ericsson.se>
25%%% Description :
26%%%
27%%% Created : 24 May 2004 by Hakan Mattsson <hakan@erix.ericsson.se>
28%%%-------------------------------------------------------------------
29
30-module(tftp_binary).
31
32%%%-------------------------------------------------------------------
33%%% Interface
34%%%-------------------------------------------------------------------
35
36-behaviour(tftp).
37
38-export([prepare/6, open/6, read/1, write/2, abort/3]).
39
40-record(read_state,  {options, blksize, bin,  is_native_ascii, is_network_ascii, count}).
41-record(write_state, {options, blksize, list, is_native_ascii, is_network_ascii}).
42
43%%-------------------------------------------------------------------
44%% Prepare
45%%-------------------------------------------------------------------
46
47prepare(_Peer, Access, Filename, Mode, SuggestedOptions, Initial) when is_list(Initial) ->
48    %% Client side
49    IsNativeAscii = is_native_ascii(Initial),
50    case catch handle_options(Access, Filename, Mode, SuggestedOptions, IsNativeAscii) of
51	{ok, IsNetworkAscii, AcceptedOptions} when Access =:= read, is_binary(Filename) ->
52	    State = #read_state{options  	 = AcceptedOptions,
53				blksize  	 = lookup_blksize(AcceptedOptions),
54				bin      	 = Filename,
55				is_network_ascii = IsNetworkAscii,
56			        count            = size(Filename),
57				is_native_ascii  = IsNativeAscii},
58	    {ok, AcceptedOptions, State};
59	{ok, IsNetworkAscii, AcceptedOptions} when Access =:= write, Filename =:= binary ->
60	    State = #write_state{options  	  = AcceptedOptions,
61				 blksize  	  = lookup_blksize(AcceptedOptions),
62				 list     	  = [],
63				 is_network_ascii = IsNetworkAscii,
64				 is_native_ascii  = IsNativeAscii},
65	    {ok, AcceptedOptions, State};
66	{ok, _, _} ->
67	    {error, {undef, "Illegal callback usage. Mode and filename is incompatible."}};
68	{error, {Code, Text}} ->
69	    {error, {Code, Text}}
70    end;
71prepare(_Peer, _Access, _Bin, _Mode, _SuggestedOptions, _Initial) ->
72    {error, {undef, "Illegal callback options."}}.
73
74%%-------------------------------------------------------------------
75%% Open
76%%-------------------------------------------------------------------
77
78open(Peer, Access, Filename, Mode, SuggestedOptions, Initial) when is_list(Initial) ->
79    %% Server side
80    case prepare(Peer, Access, Filename, Mode, SuggestedOptions, Initial) of
81	{ok, AcceptedOptions, State} ->
82	    open(Peer, Access, Filename, Mode, AcceptedOptions, State);
83	{error, {Code, Text}} ->
84	    {error, {Code, Text}}
85    end;
86open(_Peer, Access, Filename, Mode, NegotiatedOptions, State) when is_record(State, read_state) ->
87    %% Both sides
88    case catch handle_options(Access, Filename, Mode, NegotiatedOptions, State#read_state.is_native_ascii) of
89	{ok, IsNetworkAscii, Options}
90	when Options =:= NegotiatedOptions,
91	     IsNetworkAscii =:= State#read_state.is_network_ascii ->
92	    {ok, NegotiatedOptions, State};
93	{error, {Code, Text}} ->
94	    {error, {Code, Text}}
95    end;
96open(_Peer, Access, Filename, Mode, NegotiatedOptions, State) when is_record(State, write_state) ->
97    %% Both sides
98    case catch handle_options(Access, Filename, Mode, NegotiatedOptions, State#write_state.is_native_ascii) of
99	{ok, IsNetworkAscii, Options}
100	when Options =:= NegotiatedOptions,
101	     IsNetworkAscii =:= State#write_state.is_network_ascii ->
102	    {ok, NegotiatedOptions, State};
103	{error, {Code, Text}} ->
104	    {error, {Code, Text}}
105    end;
106open(Peer, Access, Filename, Mode, NegotiatedOptions, State) ->
107    %% Handle upgrade from old releases. Please, remove this clause in next release.
108    State2 = upgrade_state(State),
109    open(Peer, Access, Filename, Mode, NegotiatedOptions, State2).
110
111%%-------------------------------------------------------------------
112%% Read
113%%-------------------------------------------------------------------
114
115read(#read_state{bin = Bin} = State) when is_binary(Bin) ->
116    BlkSize = State#read_state.blksize,
117    if
118	size(Bin) >= BlkSize ->
119	    <<Block:BlkSize/binary, Bin2/binary>> = Bin,
120	    State2 = State#read_state{bin = Bin2},
121	    {more, Block, State2};
122	size(Bin) < BlkSize ->
123	    {last, Bin, State#read_state.count}
124    end;
125read(State) ->
126    %% Handle upgrade from old releases. Please, remove this clause in next release.
127    State2 = upgrade_state(State),
128    read(State2).
129
130%%-------------------------------------------------------------------
131%% Write
132%%-------------------------------------------------------------------
133
134write(Bin, #write_state{list = List} = State) when is_binary(Bin), is_list(List) ->
135    Size = size(Bin),
136    BlkSize = State#write_state.blksize,
137    if
138	Size =:= BlkSize ->
139	    {more, State#write_state{list = [Bin | List]}};
140	Size < BlkSize ->
141	    Bin2 = list_to_binary(lists:reverse([Bin | List])),
142	    {last, Bin2}
143    end;
144write(Bin, State) ->
145    %% Handle upgrade from old releases. Please, remove this clause in next release.
146    State2 = upgrade_state(State),
147    write(Bin, State2).
148
149%%-------------------------------------------------------------------
150%% Abort
151%%-------------------------------------------------------------------
152
153abort(_Code, _Text, #read_state{bin = Bin} = State)
154  when is_record(State, read_state), is_binary(Bin) ->
155    ok;
156abort(_Code, _Text, #write_state{list = List} = State)
157  when is_record(State, write_state), is_list(List) ->
158    ok;
159abort(Code, Text, State) ->
160    %% Handle upgrade from old releases. Please, remove this clause in next release.
161    State2 = upgrade_state(State),
162    abort(Code, Text, State2).
163
164%%-------------------------------------------------------------------
165%% Process options
166%%-------------------------------------------------------------------
167
168handle_options(Access, Bin, Mode, Options, IsNativeAscii) ->
169    IsNetworkAscii = handle_mode(Mode, IsNativeAscii),
170    Options2 = do_handle_options(Access, Bin, Options),
171    {ok, IsNetworkAscii, Options2}.
172
173handle_mode(Mode, IsNativeAscii) ->
174    case Mode of
175	"netascii" when IsNativeAscii =:= true -> true;
176	"octet" -> false;
177	_ -> throw({error, {badop, "Illegal mode " ++ Mode}})
178    end.
179
180do_handle_options(Access, Bin, [{Key, Val} | T]) ->
181    case Key of
182	"tsize" ->
183	    case Access of
184		read when Val =:= "0", is_binary(Bin) ->
185		    Tsize = integer_to_list(size(Bin)),
186		    [{Key, Tsize} | do_handle_options(Access, Bin, T)];
187		_ ->
188		    handle_integer(Access, Bin, Key, Val, T, 0, infinity)
189	    end;
190	"blksize" ->
191	    handle_integer(Access, Bin, Key, Val, T, 8, 65464);
192	"timeout" ->
193	    handle_integer(Access, Bin, Key, Val, T, 1, 255);
194	_ ->
195	    do_handle_options(Access, Bin, T)
196    end;
197do_handle_options(_Access, _Bin, []) ->
198    [].
199
200
201handle_integer(Access, Bin, Key, Val, Options, Min, Max) ->
202    case catch list_to_integer(Val) of
203	{'EXIT', _} ->
204	    do_handle_options(Access, Bin, Options);
205	Int when Int >= Min, Int =< Max ->
206	    [{Key, Val} | do_handle_options(Access, Bin, Options)];
207	Int when Int >= Min, Max =:= infinity ->
208	    [{Key, Val} | do_handle_options(Access, Bin, Options)];
209	_Int ->
210	    throw({error, {badopt, "Illegal " ++ Key ++ " value " ++ Val}})
211    end.
212
213lookup_blksize(Options) ->
214    case lists:keysearch("blksize", 1, Options) of
215	{value, {_, Val}} ->
216	    list_to_integer(Val);
217	false ->
218	    512
219    end.
220
221is_native_ascii([]) ->
222    is_native_ascii();
223is_native_ascii([{native_ascii, Bool}]) ->
224    case Bool of
225	true  -> true;
226	false -> false
227    end.
228
229is_native_ascii() ->
230    case os:type() of
231	{win32, _} -> true;
232	_          -> false
233    end.
234
235%% Handle upgrade from old releases. Please, remove this function in next release.
236upgrade_state({read_state,  Options, Blksize, Bin, IsNetworkAscii, Count}) ->
237    {read_state,  Options, Blksize, Bin, false, IsNetworkAscii, Count};
238upgrade_state({write_state, Options, Blksize, List, IsNetworkAscii}) ->
239    {write_state, Options, Blksize, List, false, IsNetworkAscii}.
240