Source file ocsigen_local_files.ml

(* Ocsigen
 * http://www.ocsigen.org
 * Copyright (C) 2009 Boris Yakobowski
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU Lesser General Public License as published by
 * the Free Software Foundation, with linking exception;
 * either version 2.1 of the License, or (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 *)

(* Display of a local file or directory. Currently used in staticmod
   and eliom_predefmod *)

let section = Lwt_log.Section.make "ocsigen:local-file"

exception Failed_403
exception Failed_404
exception NotReadableDirectory

(* Policies for following symlinks *)
type symlink_policy =
  stat:Unix.LargeFile.stats -> lstat:Unix.LargeFile.stats -> bool

let never_follow_symlinks : symlink_policy = fun ~stat:_ ~lstat:_ -> false

let follow_symlinks_if_owner_match : symlink_policy =
 fun ~stat ~lstat -> stat.Unix.LargeFile.st_uid = lstat.Unix.LargeFile.st_uid

(* checks that [filename] can be followed depending on the predicate
   [policy] which must receives as argument both the results
   of calling [stat] and [lstat] on filenam.
   If supplied, [stat] must be the result of calling [Unix.stat] on
   [filename] *)
let check_symlinks_aux filename ?(stat = Unix.LargeFile.stat filename)
    (policy : symlink_policy)
  =
  let lstat = Unix.LargeFile.lstat filename in
  if lstat.Unix.LargeFile.st_kind = Unix.S_LNK
  then policy ~stat ~lstat
  else true

(* Check that there are no invalid symlinks in the directories leading to
   [filename]. Paths upwards [no_check_for] are not checked. *)
let rec check_symlinks_parent_directories ~filename ~no_check_for
    (policy : symlink_policy)
  =
  if filename = "/" || filename = "." || Some filename = no_check_for
  then true
  else
    let dirname = Filename.dirname filename in
    check_symlinks_aux dirname policy
    && check_symlinks_parent_directories ~filename:dirname ~no_check_for policy

(* Check that [filename] can be reached according to the given
   symlink policy  *)
let check_symlinks ~no_check_for ~filename policy =
  let aux policy =
    if filename = "/"
    then
      (* The root cannot be a symlink, and this avoids some degenerate
         cases later on *)
      true
    else
      let filename =
        (* [filename] should start by at least a slash, as
           [Filename.is_relative filename] should be false. Hence the length
           should be at least 1 *)
        (* We remove an eventual trailing slash, in order to avoid a
           needless recursion in check_symlinks_parent_directories, and so
           that Unix.lstat returns the correct result (Unix.lstat "foo/" and
           Unix.lstat "foo" return two different results...)  *)
        let len = String.length filename - 1 in
        if filename.[len] = '/' then String.sub filename 0 len else filename
      in
      check_symlinks_aux filename policy
      && check_symlinks_parent_directories ~filename ~no_check_for policy
  in
  match policy with
  | `Always -> true
  | `No -> aux never_follow_symlinks
  | `Owner_match -> aux follow_symlinks_if_owner_match

let check_dotdot =
  let regexp = Ocsigen_lib.Netstring_pcre.regexp "(/\\.\\./)|(/\\.\\.$)" in
  fun ~filename ->
    (* We always reject .. in filenames.
       In URLs, .. have already been removed by the server,
       but the filename may come from somewhere else than URLs ... *)
    try
      ignore (Ocsigen_lib.Netstring_pcre.search_forward regexp filename 0);
      false
    with Not_found -> true

let can_send filename request =
  let filename =
    Ocsigen_lib.Url.split_path filename
    |> Ocsigen_lib.Url.norm_path |> Ocsigen_lib.Url.join_path
  in
  Lwt_log.ign_info_f ~section "checking if file %s can be sent" filename;
  let matches arg =
    Ocsigen_lib.Netstring_pcre.string_match
      (Ocsigen_extensions.do_not_serve_to_regexp arg)
      filename 0
    <> None
  in
  if matches request.Ocsigen_extensions.do_not_serve_403
  then (
    Lwt_log.ign_info ~section "this file is forbidden";
    raise Failed_403)
  else if matches request.Ocsigen_extensions.do_not_serve_404
  then (
    Lwt_log.ign_info ~section "this file must be hidden";
    raise Failed_404)

(* Return type of a request for a local file. The string argument
   represents the real file/directory to serve, eg. foo/index.html
   instead of foo *)
type resolved = RFile of string | RDir of string

(* given [filename], we search for it in the local filesystem and
   - we return ["filename/index.html"] if [filename] corresponds to
   a directory, ["filename/index.html"] is valid, and ["index.html"]
   is one possible index (trying all possible indexes in order)
   - we raise [Failed_404] if [filename] corresponds to a directory,
   no index exists and [list_dir_content] is false.
   Warning: this behaviour is not the same as Apache's but it corresponds
   to a missing service in Eliom (answers 404). This also allows to have
   an Eliom service after a "forbidden" directory
   - we raise [Failed_403] if [filename] is a symlink that must
   not be followed
   - raises [Failed_404] if [filename] does not exist, or is a special file
   - otherwise returns [filename]
*)
(* See also module Files in eliom.ml *)
let resolve ?no_check_for
    ~request:({Ocsigen_extensions.request_config; _} as request) ~filename ()
  =
  (* We only accept absolute filenames in daemon mode,
     as we do not really know what is the current directory *)
  let filename =
    if Filename.is_relative filename && Ocsigen_config.get_daemon ()
    then "/" ^ filename
    else filename
  in
  try
    Lwt_log.ign_info_f ~section "Testing \"%s\"." filename;
    let stat = Unix.LargeFile.stat filename in
    let filename, stat =
      if stat.Unix.LargeFile.st_kind = Unix.S_DIR
      then
        if filename.[String.length filename - 1] <> '/'
        then (
          (* In this case, [filename] is a directory but this is not visible in
             its name as there is no final slash. We signal this fact to
             Ocsigen, which will then issue a 301 redirection to "filename/" *)
          Lwt_log.ign_info_f ~section "LocalFiles: %s is a directory" filename;
          raise
            (Ocsigen_extensions.Ocsigen_is_dir
               (Ocsigen_extensions.new_url_of_directory_request request)))
        else
          let rec find_index = function
            | [] ->
                (* No suitable index, we try to list the directory *)
                if request_config.Ocsigen_extensions.list_directory_content
                then (
                  Lwt_log.ign_info ~section "Displaying directory content";
                  filename, stat)
                else (
                  (* No suitable index *)
                  Lwt_log.ign_info ~section "No index and no listing";
                  raise NotReadableDirectory)
            | e :: q -> (
                let index = filename ^ e in
                Lwt_log.ign_info_f ~section "Testing \"%s\" as possible index."
                  index;
                try index, Unix.LargeFile.stat index
                with Unix.Unix_error (Unix.ENOENT, _, _) -> find_index q)
          in
          find_index request_config.Ocsigen_extensions.default_directory_index
      else filename, stat
    in
    if not (check_dotdot ~filename)
    then (
      Lwt_log.ign_info_f ~section "Filenames cannot contain .. as in \"%s\"."
        filename;
      raise Failed_403)
    else if check_symlinks ~filename ~no_check_for
              request_config.Ocsigen_extensions.follow_symlinks
    then (
      can_send filename request_config;
      (* If the previous function did not fail, we are authorized to
         send this file *)
      Lwt_log.ign_info_f ~section "Returning \"%s\"." filename;
      if stat.Unix.LargeFile.st_kind = Unix.S_REG
      then RFile filename
      else if stat.Unix.LargeFile.st_kind = Unix.S_DIR
      then RDir filename
      else raise Failed_404)
    else (
      (* [filename] is accessed through as symlink which we should not
         follow according to the current policy *)
      Lwt_log.ign_info_f ~section "Failed symlink check for \"%s\"." filename;
      raise Failed_403)
  with
  (* We can get an EACCESS here, if are missing some rights on a directory *)
  | Unix.Unix_error (Unix.EACCES, _, _) -> raise Failed_403
  | Unix.Unix_error (Unix.ENOENT, _, _) -> raise Failed_404