%%% BEGIN openflax/handler/file.erl %%%
%%%
%%% openflax - Open Source web server for Erlang/OTP
%%% Copyright (c)2004 Cat's Eye Technologies.  All rights reserved.
%%%
%%% Redistribution and use in source and binary forms, with or without
%%% modification, are permitted provided that the following conditions
%%% are met:
%%%
%%%   Redistributions of source code must retain the above copyright
%%%   notice, this list of conditions and the following disclaimer.
%%%
%%%   Redistributions in binary form must reproduce the above copyright
%%%   notice, this list of conditions and the following disclaimer in
%%%   the documentation and/or other materials provided with the
%%%   distribution.
%%%
%%%   Neither the name of Cat's Eye Technologies nor the names of its
%%%   contributors may be used to endorse or promote products derived
%%%   from this software without specific prior written permission.
%%%
%%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
%%% CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
%%% INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
%%% MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
%%% DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE
%%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
%%% OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
%%% PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
%%% OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
%%% ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
%%% OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
%%% OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
%%% POSSIBILITY OF SUCH DAMAGE. 

%% @doc Plain file-serving handler for OpenFlax.
%%
%% <p>This handler serves plain files from a specified "document root"
%% directory.  It takes some measures to ensure that it cannot serve
%% files from anywhere outside that directory (with the notable exception of
%% symbolic and hard links.)</p>
%%
%% <p>This handler supports the following configuration options in
%% the <code>conf()</code> passed to it:</p>
%% <ul>
%% <li><code>cfg_document_root</code></li>
%% <p><code>filename()</code>.
%%    The root directory, from which to serve files.  Note that this setting
%%    is used by several handlers, and as such, it must be defined outside
%%    any specific handler (in the <code>openflax</code> section, or in
%%    one of the virtual hosts.)</p>
%% <li><code>cfg_file_options</code></li>
%% <p><code>[option()]</code>.
%%    Options to pass to <code>file:open/2</code>.  These are tweakable
%%    for maximizing performance.  A typical set would be
%%    <code>[raw, read_ahead, binary]</code>.</p>
%% <li><code>cfg_file_chunk_size</code></li>
%% <p><code>integer()</code>.
%%    Number of bytes per chunk of file sent to the HTTP client.  This is
%%    tweakable for maximizing performance.  A typical value would be
%%    16384.</p>
%% </ul>
%%
%% @end

%% <p>This handler may be removed from OpenFlax if the functionality it
%% provides is not desired.</p>
%%
%% @end

-module(openflax.handler.file).
-vsn('$Id: file.erl 31 2004-04-23 07:00:11Z catseye $').
-author('cpressey@catseye.mine.nu').
-copyright('Copyright (c)2004 Cat`s Eye Technologies. All rights reserved.').

-behaviour(openflax.handler).

-export([start/1, stop/1, serve/1]). % behaviour
-export([is_world_writeable/1, is_world_readable/1, is_world_executable/1]).
-export([is_binary/1, is_accessible/2]).
-export([fold_files/3]).
-export([document/1]).

-include_lib("kernel/include/file.hrl").

-import(calendar).
-import(lists).
-import(string).
-import(filename).
-import(file).
-import(filelib).

%% @spec start(conf()) -> conf()
%% @doc Initializes the file-serving handler.

start(Conf) ->
  openflax.conf:new().

%% @spec stop(conf()) -> conf()
%% @doc Shuts down the file-serving handler.

stop(Conf) ->
  Conf.

%% @spec serve(conf()) -> {response(), conf()}
%% @doc Serves a file from the filesystem to the connected user agent.

serve(Conf) ->
  % this isn't needed for any particular purpose; however, it
  % is necessary to call it, to unstick the Http process, before
  % we start a streaming response (below.)
  % Conf0 = openflax.http.request:collect_body(Conf),
  Conf0 = Conf,
  FileName = document(Conf0),
  % Ensure there is no .. or ~ in filename
  % openflax.app:debug(about_to_is_accessible, openflax.conf:dump(Conf)),
  case is_accessible(FileName, Conf0) of
    true ->
      serve0(Conf0, FileName);
    _ ->
      {not_found, Conf0}
  end.

serve0(Conf, FileName) ->
  % Serve a directory if that's what this is
  case filelib:is_dir(FileName) of
    true ->
      BasicResource = openflax.conf:get_string(sreq_basic_resource, Conf),
      case lists:last(BasicResource) of
        $/ ->
	  % The config file probably shouldn't have
	  % URI's that end in / go to openflax.handler.file! :)
          {not_found, Conf};
        _  ->
          DirName = BasicResource ++ "/",
          {{moved_permanently, DirName}, Conf}
      end;
    false ->
      serve1(Conf, FileName)
  end.

serve1(Conf, FileName) ->
  % check request method against allowable request methods for this resource
  Conf0 = openflax.conf:put_value(res_allow, "GET, HEAD", Conf),
  case openflax.conf:get_string(sreq_method, Conf0) of
    Method when Method == "GET"; Method == "HEAD" ->
      serve2(Conf0, FileName);
    Else ->
      {method_not_allowed, Conf0}
  end.

serve2(Conf, FileName) ->  
  % Upgrade the content-type from binary to text if it looks
  % like text (since we have no better idea anyway...)
  OctetStream = "application/octet-stream",
  ContentType = case openflax.conf:get_string(res_content_type, Conf) of
    R when R == ""; R == OctetStream ->
      case is_binary(FileName) of
        true  -> OctetStream;
        false -> "text/plain"
      end;
    Other ->
      Other
  end,
  Conf0 = openflax.conf:put_value(res_content_type, ContentType, Conf),
  % set last-modified header from file mod time
  ModTime = filelib:last_modified(FileName),
  [GMTModTime] = calendar:local_time_to_universal_time_dst(ModTime), % hmm
  LastModified = openflax.string:from_datetime_rfc_1123(GMTModTime),
  Conf1 = openflax.conf:put_value(res_last_modified, LastModified, Conf0),
  % Serve the file itself
  serve3(Conf1, FileName).

serve3(Conf, FileName) ->
  Pid = spawn_link(fun() -> send_file(Conf, FileName) end),
  % start streaming with a known size
  {{stream, Pid, filelib:file_size(FileName)}, Conf}.

%% @spec send_file(conf(), filename()) -> ok
%% @doc Dumps the given file to the HTTP unaltered.
%% Sends nothing if the Request-Method was HEAD.

send_file(Conf, FileName) ->
  case openflax.conf:get_string(sreq_method, Conf) of
    "HEAD" ->
      ok;
    _ ->
      {ok, FileOptions} = openflax.conf:get_value(cfg_file_options, Conf),
      {ok, ChunkSize} = openflax.conf:get_value(cfg_file_chunk_size, Conf),
      {ok, IoDevice} = file:open(FileName, [read] ++ FileOptions),
      send_file0(IoDevice, ChunkSize),
      file:close(IoDevice),
      ok
  end.
send_file0(IoDevice, ChunkSize) ->
  receive
    {Pid, stream_open} ->
      send_file1(Pid, IoDevice, ChunkSize),
      Pid ! {self(), stream_close}
  end.
send_file1(Pid, IoDevice, ChunkSize) ->  
  case file:read(IoDevice, ChunkSize) of
    {ok, Data} ->
      Pid ! {self(), stream_data, Data},
      receive
        {Pid, stream_acknowledge, data} ->
	  send_file1(Pid, IoDevice, ChunkSize);
	{Pid, stream_error, Error} ->
	  openflax.log:write("ERROR: ~p", [Error]),
	  ok
      end;
    _ ->
      ok
  end.

%%% UTILITY %%%

%% @spec is_world_readable(filename()) -> true | false
%% @doc Checks whether a file is readable by the entire world.

is_world_readable(Filename) ->
  case file:read_file_info(Filename) of
    {ok, Info} ->
      case Info#file_info.mode band 4 of
        4 -> true;
        _ -> false
      end;
    _ -> false
  end.

%% @spec is_world_writeable(filename()) -> true | false
%% @doc Checks whether a file is writeable by the entire world.

is_world_writeable(Filename) ->
  case file:read_file_info(Filename) of
    {ok, Info} ->
      case Info#file_info.mode band 2 of
        4 -> true;
        _ -> false
      end;
    _ ->
      false
  end.

%% @spec is_world_executable(filename()) -> true | false
%% @doc Checks whether a file is executable by the entire world.

is_world_executable(Filename) ->
  case file:read_file_info(Filename) of
    {ok, Info} ->
      case Info#file_info.mode band 1 of
        1 -> true;
        _ -> false
      end;
    _ -> false
  end.

%% @spec is_binary(filename()) -> true | false | {error, Reason}
%% @doc Makes an educated guess as to whether the file is binary (as
%% opposed to plain ASCII text).  The heuristic used is similar to that
%% of <code>grep</code> and Perl's <code>-B</code> operator.
%% The first 32K of the
%% file is examined for odd characters such as strange control codes or
%% characters with the high bit set.  If too many strange characters
%% (>30%) are found, or if any zero bytes (nulls) are encountered,
%% the file is considered binary.

is_binary(Filename) ->
  case file:open(Filename, [read]) of
    {ok, IoDevice} ->
      case file:read(IoDevice, 32768) of
        {ok, Block} ->
          Result = is_binary_block(Block, 0),
          file:close(IoDevice),
          Result;
        Other ->
          Other
      end;
    Other ->
      Other
  end.
is_binary_block([], A) -> false;
is_binary_block([0 | T], A) -> true;
is_binary_block(_, A) when A > 9830 -> true;
is_binary_block([9  | T], A) -> is_binary_block(T, A);
is_binary_block([10 | T], A) -> is_binary_block(T, A);
is_binary_block([12 | T], A) -> is_binary_block(T, A);
is_binary_block([13 | T], A) -> is_binary_block(T, A);
is_binary_block([H  | T], A) when H >= 32; H =< 126 -> is_binary_block(T, A);
is_binary_block([H  | T], A) -> is_binary_block(T, A+1).

%% @spec is_accessible(filename(), conf()) -> true | false
%% @doc Reports whether the file named by the specified
%% fully-qualified filename is accessible to the web server.

is_accessible(FileName, Conf) ->
  DocumentRoot = openflax.conf:get_string(cfg_document_root, Conf),
  DocumentRoot0 = openflax.string:substitute($\\, $/, DocumentRoot),
  FileName0 = openflax.string:substitute($\\, $/, FileName),
  {DocumentRoot1, FileName1} = case lists:nth(2, DocumentRoot0) of
    $: ->
      {openflax.string:to_upper(DocumentRoot0),
       openflax.string:to_upper(FileName0)};
    _ ->
      {DocumentRoot0, FileName0}
  end,
  case string:left(FileName1, length(DocumentRoot1)) of
    DocumentRoot1 ->
      case {string:str(FileName0, ".."),
            string:str(FileName0, "~")} of
        {0, 0} ->
          is_world_readable(FileName0) andalso
	    not is_world_writeable(FileName0);
        _ ->
          false
      end;
    _ ->
      false
  end.

%% @spec fold_files(Dir::string(), fun(), term()) -> term()
%% @doc Folds the function Fun(F, IsDir, Acc) -> {Recurse, Acc1} over
%% all files F in Dir that match the regular expression RegExp.
%% If Recursive is true all sub-directories of F are processed.
%% (This function is a modified version of the function of the
%% same name in <code>filelib.erl</code>.)

fold_files(Dir, Fun, Acc) ->
  case file:list_dir(Dir) of
    {ok, Files} ->
      fold_files0(Files, Dir, Fun, Acc);
    {error, _} ->
      Acc
  end.

fold_files0([File | Tail], Dir, Fun, Acc) ->
  FullName = filename:join([Dir, File]),
  IsDir = filelib:is_dir(FullName),
  {Recurse, NewAcc} = Fun(FullName, IsDir, Acc),
  fold_files0(FullName, Tail, Dir, Fun, IsDir, Recurse, NewAcc);
fold_files0([], Dir, Fun, Acc) ->
  Acc.

fold_files0(FullName, Tail, Dir, Fun, true, true, Acc) ->
  NewAcc = fold_files(FullName, Fun, Acc),
  fold_files0(Tail, Dir, Fun, NewAcc);
fold_files0(FullName, Tail, Dir, Fun, _, _, Acc) ->
  fold_files0(Tail, Dir, Fun, Acc).

%% @spec document(conf()) -> filename()
%% @doc Derives the name of the document (fully-qualified filename)
%% from the <code>cfg_document_root</code> and <code>sreq_basic_resource</code>
%% settings in the given <code>conf()</code>.  The returned filename is
%% not flattened.

document(Conf) ->
  DocumentRoot = openflax.conf:get_string(cfg_document_root, Conf),
  BasicResource = openflax.conf:get_string(sreq_basic_resource, Conf),
  lists:flatten([DocumentRoot | tl(BasicResource)]).

%%% END of openflax/handler/file.erl %%%