1%% ``Licensed under the Apache License, Version 2.0 (the "License");
2%% you may not use this file except in compliance with the License.
3%% You may obtain a copy of the License at
4%%
5%%     http://www.apache.org/licenses/LICENSE-2.0
6%%
7%% Unless required by applicable law or agreed to in writing, software
8%% distributed under the License is distributed on an "AS IS" BASIS,
9%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
10%% See the License for the specific language governing permissions and
11%% limitations under the License.
12%%
13%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
14%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
15%% AB. All Rights Reserved.''
16%%
17%%     $Id: mod_range.erl,v 1.1 2008/12/17 09:53:35 mikpe Exp $
18%%
19-module(mod_range).
20-export([do/1]).
21-include("httpd.hrl").
22
23%% do
24
25
26
27do(Info) ->
28    ?DEBUG("do -> entry",[]),
29    case Info#mod.method of
30	"GET" ->
31	    case httpd_util:key1search(Info#mod.data,status) of
32		%% A status code has been generated!
33		{StatusCode,PhraseArgs,Reason} ->
34		    {proceed,Info#mod.data};
35		%% No status code has been generated!
36		undefined ->
37		    case httpd_util:key1search(Info#mod.data,response) of
38			%% No response has been generated!
39			undefined ->
40			    case httpd_util:key1search(Info#mod.parsed_header,"range") of
41				undefined ->
42				    %Not a range response
43				    {proceed,Info#mod.data};
44				Range ->
45				    %%Control that there weren't a if-range field that stopped
46				    %%The range request in favor for the whole file
47				    case httpd_util:key1search(Info#mod.data,if_range) of
48					send_file ->
49					    {proceed,Info#mod.data};
50					_undefined ->
51					    do_get_range(Info,Range)
52				    end
53			    end;
54			%% A response has been generated or sent!
55			Response ->
56			    {proceed,Info#mod.data}
57		    end
58	    end;
59	%% Not a GET method!
60	_ ->
61	    {proceed,Info#mod.data}
62    end.
63
64do_get_range(Info,Ranges) ->
65    ?DEBUG("do_get_range -> Request URI: ~p",[Info#mod.request_uri]),
66     Path = mod_alias:path(Info#mod.data, Info#mod.config_db,
67			  Info#mod.request_uri),
68    {FileInfo, LastModified} =get_modification_date(Path),
69    send_range_response(Path,Info,Ranges,FileInfo,LastModified).
70
71
72send_range_response(Path,Info,Ranges,FileInfo,LastModified)->
73    case parse_ranges(Ranges) of
74	error->
75	    ?ERROR("send_range_response-> Unparsable range request",[]),
76	    {proceed,Info#mod.data};
77	{multipart,RangeList}->
78	    send_multi_range_response(Path,Info,RangeList);
79	{Start,Stop}->
80	    send_range_response(Path,Info,Start,Stop,FileInfo,LastModified)
81    end.
82%%More than one range specified
83%%Send a multipart response to the user
84%
85%%An example of an multipart range response
86
87% HTTP/1.1 206 Partial Content
88% Date:Wed 15 Nov 1995 04:08:23 GMT
89% Last-modified:Wed 14 Nov 1995 04:08:23 GMT
90% Content-type: multipart/byteranges; boundary="SeparatorString"
91%
92% --"SeparatorString"
93% Content-Type: application/pdf
94% Content-Range: bytes 500-600/1010
95% .... The data..... 101 bytes
96%
97% --"SeparatorString"
98% Content-Type: application/pdf
99% Content-Range: bytes 700-1009/1010
100% .... The data.....
101
102
103
104send_multi_range_response(Path,Info,RangeList)->
105    case file:open(Path, [raw,binary]) of
106	{ok, FileDescriptor} ->
107	    file:close(FileDescriptor),
108	    ?DEBUG("send_multi_range_response -> FileDescriptor: ~p",[FileDescriptor]),
109	    Suffix = httpd_util:suffix(Path),
110	    PartMimeType = httpd_util:lookup_mime_default(Info#mod.config_db,Suffix,"text/plain"),
111	    Date = httpd_util:rfc1123_date(),
112	    {FileInfo,LastModified}=get_modification_date(Path),
113	    case valid_ranges(RangeList,Path,FileInfo) of
114		{ValidRanges,true}->
115		    ?DEBUG("send_multi_range_response -> Ranges are valid:",[]),
116		    %Apache breaks the standard by sending the size field in the Header.
117		    Header = [{code,206},
118			      {content_type,"multipart/byteranges;boundary=RangeBoundarySeparator"},
119			      {etag,httpd_util:create_etag(FileInfo)},
120			      {last_modified,LastModified}
121			     ],
122		    ?DEBUG("send_multi_range_response -> Valid Ranges: ~p",[RagneList]),
123		    Body={fun send_multiranges/4,[ValidRanges,Info,PartMimeType,Path]},
124		    {proceed,[{response,{response,Header,Body}}|Info#mod.data]};
125		_ ->
126		    {proceed, [{status, {416,"Range not valid",bad_range_boundaries }}]}
127	    end;
128	{error, Reason} ->
129	    ?ERROR("do_get -> failed open file: ~p",[Reason]),
130	    {proceed,Info#mod.data}
131    end.
132
133send_multiranges(ValidRanges,Info,PartMimeType,Path)->
134    ?DEBUG("send_multiranges -> Start sending the ranges",[]),
135    case file:open(Path, [raw,binary]) of
136	{ok,FileDescriptor} ->
137	    lists:foreach(fun(Range)->
138				  send_multipart_start(Range,Info,PartMimeType,FileDescriptor)
139			  end,ValidRanges),
140	    file:close(FileDescriptor),
141	    %%Sends an end of the multipart
142	    httpd_socket:deliver(Info#mod.socket_type,Info#mod.socket,"\r\n--RangeBoundarySeparator--"),
143	    sent;
144	_ ->
145	    close
146    end.
147
148send_multipart_start({{Start,End},{StartByte,EndByte,Size}},Info,PartMimeType,FileDescriptor)when StartByte<Size->
149    PartHeader=["\r\n--RangeBoundarySeparator\r\n","Content-type: ",PartMimeType,"\r\n",
150                "Content-Range:bytes=",integer_to_list(StartByte),"-",integer_to_list(EndByte),"/",
151		integer_to_list(Size),"\r\n\r\n"],
152    send_part_start(Info#mod.socket_type,Info#mod.socket,PartHeader,FileDescriptor,Start,End);
153
154
155send_multipart_start({{Start,End},{StartByte,EndByte,Size}},Info,PartMimeType,FileDescriptor)->
156    PartHeader=["\r\n--RangeBoundarySeparator\r\n","Content-type: ",PartMimeType,"\r\n",
157                "Content-Range:bytes=",integer_to_list(Size-(StartByte-Size)),"-",integer_to_list(EndByte),"/",
158		integer_to_list(Size),"\r\n\r\n"],
159    send_part_start(Info#mod.socket_type,Info#mod.socket,PartHeader,FileDescriptor,Start,End).
160
161send_part_start(SocketType,Socket,PartHeader,FileDescriptor,Start,End)->
162    case httpd_socket:deliver(SocketType,Socket,PartHeader) of
163	ok ->
164	    send_part_start(SocketType,Socket,FileDescriptor,Start,End);
165	_ ->
166	    close
167    end.
168
169send_range_response(Path,Info,Start,Stop,FileInfo,LastModified)->
170    case file:open(Path, [raw,binary]) of
171	{ok, FileDescriptor} ->
172	    file:close(FileDescriptor),
173	    ?DEBUG("send_range_response -> FileDescriptor: ~p",[FileDescriptor]),
174	    Suffix = httpd_util:suffix(Path),
175	    MimeType = httpd_util:lookup_mime_default(Info#mod.config_db,Suffix,"text/plain"),
176	    Date = httpd_util:rfc1123_date(),
177	    Size = get_range_size(Start,Stop,FileInfo),
178	    case valid_range(Start,Stop,FileInfo) of
179		{true,StartByte,EndByte,TotByte}->
180		   Head=[{code,206},{content_type, MimeType},
181			 {last_modified, LastModified},
182			 {etag,httpd_util:create_etag(FileInfo)},
183			 {content_range,["bytes=",integer_to_list(StartByte),"-",
184					 integer_to_list(EndByte),"/",integer_to_list(TotByte)]},
185			 {content_length,Size}],
186		    BodyFunc=fun send_range_body/5,
187		    Arg=[Info#mod.socket_type, Info#mod.socket,Path,Start,Stop],
188		    {proceed,[{response,{response,Head,{BodyFunc,Arg}}}|Info#mod.data]};
189		{false,Reason} ->
190		    {proceed, [{status, {416,Reason,bad_range_boundaries }}]}
191	    end;
192	{error, Reason} ->
193	    ?ERROR("send_range_response -> failed open file: ~p",[Reason]),
194	    {proceed,Info#mod.data}
195    end.
196
197
198send_range_body(SocketType,Socket,Path,Start,End) ->
199    ?DEBUG("mod_range -> send_range_body",[]),
200    case file:open(Path, [raw,binary]) of
201	{ok,FileDescriptor} ->
202	    send_part_start(SocketType,Socket,FileDescriptor,Start,End),
203	    file:close(FileDescriptor);
204	_ ->
205	    close
206    end.
207
208send_part_start(SocketType,Socket,FileDescriptor,Start,End) ->
209    case Start of
210	from_end ->
211	    file:position(FileDescriptor,{eof,End}),
212	    send_body(SocketType,Socket,FileDescriptor);
213	from_start ->
214	    file:position(FileDescriptor,{bof,End}),
215	    send_body(SocketType,Socket,FileDescriptor);
216	Byte when integer(Byte) ->
217	    file:position(FileDescriptor,{bof,Start}),
218	    send_part(SocketType,Socket,FileDescriptor,End)
219    end,
220    sent.
221
222
223%%This function could replace send_body by calling it with Start=0 end =FileSize
224%% But i gues it would be stupid when we look at performance
225send_part(SocketType,Socket,FileDescriptor,End)->
226    case file:position(FileDescriptor,{cur,0}) of
227	{ok,NewPos} ->
228	   if
229	       NewPos > End ->
230		   ok;
231	       true ->
232		   Size=get_file_chunk_size(NewPos,End,?FILE_CHUNK_SIZE),
233		   case file:read(FileDescriptor,Size) of
234		       eof ->
235			   ok;
236		       {error,Reason} ->
237			   ok;
238		       {ok,Binary} ->
239			   case httpd_socket:deliver(SocketType,Socket,Binary) of
240			       socket_closed ->
241				   ?LOG("send_range of body -> socket closed while sending",[]),
242				   socket_close;
243			       _ ->
244				   send_part(SocketType,Socket,FileDescriptor,End)
245			   end
246		   end
247	   end;
248	_->
249	    ok
250    end.
251
252%% validate that the range is in the limits of the file
253valid_ranges(RangeList,Path,FileInfo)->
254    lists:mapfoldl(fun({Start,End},Acc)->
255			case Acc of
256			    true ->
257				case valid_range(Start,End,FileInfo) of
258				    {true,StartB,EndB,Size}->
259					{{{Start,End},{StartB,EndB,Size}},true};
260				    _ ->
261					false
262				end;
263			    _ ->
264				{false,false}
265			end
266		   end,true,RangeList).
267
268
269
270valid_range(from_end,End,FileInfo)->
271    Size=FileInfo#file_info.size,
272    if
273	End < Size ->
274	    {true,(Size+End),Size-1,Size};
275	true ->
276	    false
277    end;
278valid_range(from_start,End,FileInfo)->
279  Size=FileInfo#file_info.size,
280    if
281	End < Size ->
282	    {true,End,Size-1,Size};
283	true ->
284	    false
285    end;
286
287valid_range(Start,End,FileInfo)when Start=<End->
288    case FileInfo#file_info.size of
289	FileSize when Start< FileSize ->
290	    case FileInfo#file_info.size of
291		Size when End<Size ->
292		    {true,Start,End,FileInfo#file_info.size};
293		Size ->
294		    {true,Start,Size-1,Size}
295	    end;
296	_->
297	    {false,"The size of the range is negative"}
298    end;
299
300valid_range(Start,End,FileInfo)->
301    {false,"Range starts out of file boundaries"}.
302%% Find the modification date of the file
303get_modification_date(Path)->
304    case file:read_file_info(Path) of
305	{ok, FileInfo0} ->
306	    {FileInfo0, httpd_util:rfc1123_date(FileInfo0#file_info.mtime)};
307	_ ->
308	    {#file_info{},""}
309    end.
310
311%Calculate the size of the chunk to read
312
313get_file_chunk_size(Position,End,DefaultChunkSize)when (Position+DefaultChunkSize) =< End->
314    DefaultChunkSize;
315get_file_chunk_size(Position,End,DefaultChunkSize)->
316    (End-Position) +1.
317
318
319
320%Get the size of the range to send. Remember that
321%A range is from startbyte up to endbyte which means that
322%the nuber of byte in a range is (StartByte-EndByte)+1
323
324get_range_size(from_end,Stop,FileInfo)->
325    integer_to_list(-1*Stop);
326
327get_range_size(from_start,StartByte,FileInfo) ->
328    integer_to_list((((FileInfo#file_info.size)-StartByte)));
329
330get_range_size(StartByte,EndByte,FileInfo) ->
331    integer_to_list((EndByte-StartByte)+1).
332
333parse_ranges([$\ ,$b,$y,$t,$e,$s,$\=|Ranges])->
334    parse_ranges([$b,$y,$t,$e,$s,$\=|Ranges]);
335parse_ranges([$b,$y,$t,$e,$s,$\=|Ranges])->
336    case string:tokens(Ranges,", ") of
337       [Range] ->
338	   parse_range(Range);
339       [Range1|SplittedRanges]->
340	   {multipart,lists:map(fun parse_range/1,[Range1|SplittedRanges])}
341    end;
342%Bad unit
343parse_ranges(Ranges)->
344    io:format("Bad Ranges : ~p",[Ranges]),
345    error.
346%Parse the range  specification from the request to {Start,End}
347%Start=End : Numreric string | []
348
349parse_range(Range)->
350    format_range(split_range(Range,[],[])).
351format_range({[],BytesFromEnd})->
352    {from_end,-1*(list_to_integer(BytesFromEnd))};
353format_range({StartByte,[]})->
354    {from_start,list_to_integer(StartByte)};
355format_range({StartByte,EndByte})->
356    {list_to_integer(StartByte),list_to_integer(EndByte)}.
357%Last case return the splitted range
358split_range([],Current,Other)->
359    {lists:reverse(Other),lists:reverse(Current)};
360
361split_range([$-|Rest],Current,Other)->
362    split_range(Rest,Other,Current);
363
364split_range([N|Rest],Current,End) ->
365    split_range(Rest,[N|Current],End).
366
367send_body(SocketType,Socket,FileDescriptor) ->
368    case file:read(FileDescriptor,?FILE_CHUNK_SIZE) of
369	{ok,Binary} ->
370	    ?DEBUG("send_body -> send another chunk: ~p",[size(Binary)]),
371	    case httpd_socket:deliver(SocketType,Socket,Binary) of
372		socket_closed ->
373		    ?LOG("send_body -> socket closed while sending",[]),
374		    socket_close;
375		_ ->
376		    send_body(SocketType,Socket,FileDescriptor)
377	    end;
378	eof ->
379	    ?DEBUG("send_body -> done with this file",[]),
380	    eof
381    end.
382