extensions/ocsigen_LocalFiles.ml

   1 open Ocsigen_extensions
   2
   3 (* Displaying of a local file or directory. Currently used in
   4    staticmod and eliom_predefmod*)
   5
   6 exception Failed_403
   7 exception Failed_404
   8 exception NotReadableDirectory
   9
  10
  11 (* Policies for following symlinks *)
  12 type symlink_policy =
  13     stat:Unix.LargeFile.stats -> lstat:Unix.LargeFile.stats -> bool
  14
  15 let never_follow_symlinks : symlink_policy =
  16   fun ~stat ~lstat -> false
  17
  18 let follow_symlinks_if_owner_match : symlink_policy =
  19   fun ~stat ~lstat ->
  20     stat.Unix.LargeFile.st_uid = lstat.Unix.LargeFile.st_uid
  21
  22
  23 (* checks that [filename] can be followed depending on the predicate
  24    [policy] which must receives as argument both the results
  25    of calling [stat] and [lstat] on filenam.
  26    If supplied, [stat] must be the result of calling [Unix.stat] on
  27    [filename] *)
  28 let check_symlinks_aux
  29     filename ?(stat=Unix.LargeFile.stat filename) (policy : symlink_policy) =
  30   let lstat = Unix.LargeFile.lstat filename in
  31   if lstat.Unix.LargeFile.st_kind = Unix.S_LNK then
  32     policy ~stat ~lstat
  33   else
  34     true
  35
  36 (* Check that there are no invalid symlinks in the directories leading to
  37    [filename]. Paths upwards [no_check_for] are not checked. *)
  38 let rec check_symlinks_parent_directories ~filename ~no_check_for (policy : symlink_policy) =
  39   (* Ocsigen_messages.debug
  40     (fun () -> Printf.sprintf "Checking %s (until %s)"
  41        filename (match no_check_for with None -> "" | Some s -> s)); *)
  42   if filename = "/" || filename = "." || Some filename = no_check_for then
  43     true
  44   else
  45     let dirname = Filename.dirname filename in
  46     check_symlinks_aux dirname policy &&
  47     check_symlinks_parent_directories ~filename:dirname ~no_check_for policy
  48
  49
  50 (* Check that [filename] can be reached according to the given
  51    symlink policy  *)
  52 let check_symlinks ~no_check_for ~filename policy =
  53   let aux policy =
  54     if filename = "/" then
  55       (* The root cannot be a symlink, and this avoids some degenerate
  56          cases later on *)
  57       true
  58     else
  59       let filename =
  60         (* [filename] should start by at least a slash, as
  61            [Filename.is_relative filename] should be false. Hence the length
  62            should be at least 1 *)
  63         (* We remove an eventual trailing slash, in order to avoid a
  64            needless recursion in check_symlinks_parent_directories, and so
  65            that Unix.lstat returns the correct result (Unix.lstat "foo/" and
  66            Unix.lstat "foo" return two different results...)  *)
  67         let len = String.length filename - 1 in
  68         if filename.[len] = '/' then
  69           String.sub filename 0 len
  70         else
  71           filename
  72       in
  73       check_symlinks_aux filename policy &&
  74       check_symlinks_parent_directories filename no_check_for policy
  75   in
  76   match policy with
  77     | AlwaysFollowSymlinks -> true
  78     | DoNotFollowSymlinks -> aux never_follow_symlinks
  79     | FollowSymlinksIfOwnerMatch -> aux follow_symlinks_if_owner_match
  80
  81 let check_dotdot =
  82   let regexp = Netstring_pcre.regexp "(/\\.\\./)|(/\\.\\.$)" in
  83   fun ~filename ->
  84     (* We always reject .. in filenames.
  85        In URLs, .. have already been removed by the server,
  86        but the filename may come from somewhere else than URLs ... *)
  87     try ignore (Netstring_pcre.search_forward regexp filename 0); false
  88     with Not_found -> true
  89
  90 let can_send filename request =
  91   let filename =
  92     Neturl.join_path (Neturl.norm_path (Neturl.split_path filename)) in
  93   Ocsigen_messages.debug
  94     (fun () -> Printf.sprintf "--LocalFiles: checking if file %s can be sent"
  95        filename);
  96   let matches arg =
  97     Netstring_pcre.string_match (Ocsigen_extensions.do_not_serve_to_regexp arg)
  98       filename 0 <> None
  99   in
 100   if matches request.do_not_serve_403 then (
 101     Ocsigen_messages.debug2 "--LocalFiles: this file is forbidden";
 102     raise Failed_403)
 103   else
 104     if matches request.do_not_serve_404 then (
 105       Ocsigen_messages.debug2 "--LocalFiles: this file must be hidden";
 106       raise Failed_404)
 107
 108
 109 (* Return type of a request for a local file. The string argument
 110    represents the real file/directory to serve, eg. foo/index.html
 111    instead of foo *)
 112 type resolved =
 113   | RFile of string
 114   | RDir of string
 115
 116
 117 (* given [filename], we search for it in the local filesystem and
 118    - we return ["filename/index.html"] if [filename] corresponds to
 119    a directory, ["filename/index.html"] is valid, and ["index.html"]
 120    is one possible index (trying all possible indexes in order)
 121    - we raise [Failed_404] if [filename] corresponds to a directory,
 122    no index exists and [list_dir_content] is false.
 123    Warning: this behaviour is not the same as Apache's but it corresponds
 124    to a missing service in Eliom (answers 404). This also allows to have
 125    an Eliom service after a "forbidden" directory
 126    - we raise [Failed_403] if [filename] is a symlink that must
 127    not be followed
 128    - raises [Failed_404] if [filename] does not exist, or is a special file
 129    - otherwise returns [filename]
 130 *)
 131 (* See also module Files in eliom.ml *)
 132 let resolve ?no_check_for ~request ~filename =
 133   (* We only accept absolute filenames,
 134      as we do not really know what is the current directory *)
 135   let filename =
 136     if filename.[0] = '/'
 137     then filename
 138     else "/"^filename
 139   in
 140   try
 141     Ocsigen_messages.debug
 142       (fun () -> "--LocalFiles: Testing \""^filename^"\".");
 143     let stat = Unix.LargeFile.stat filename in
 144     let (filename, stat) =
 145       if stat.Unix.LargeFile.st_kind = Unix.S_DIR then
 146         if filename.[String.length filename - 1] <> '/' then begin
 147           (* In this case, [filename] is a directory but this is not visible in
 148              its name as there is no final slash. We signal this fact to
 149              Ocsigen, which will then issue a 301 redirection to "filename/" *)
 150           Ocsigen_messages.debug
 151             (fun () -> "--LocalFiles: "^filename^" is a directory");
 152           raise (Ocsigen_extensions.Ocsigen_Is_a_directory request)
 153         end
 154
 155         else
 156           let rec find_index = function
 157             | [] ->
 158                 (* No suitable index, we try to list the directory *)
 159                 if request.request_config.list_directory_content then (
 160                   Ocsigen_messages.debug2
 161                     "--LocalFiles: Displaying directory content";
 162                   (filename, stat))
 163                 else (
 164                   (* No suitable index *)
 165                   Ocsigen_messages.debug2 "--LocalFiles: No index and no listing";
 166                   raise NotReadableDirectory)
 167             | e :: q ->
 168                 let index = filename ^ e in
 169                 Ocsigen_messages.debug
 170                   (fun () -> "--LocalFiles: Testing \""^index
 171                      ^"\" as possible index.");
 172                 try
 173                   (index, Unix.LargeFile.stat index)
 174                 with
 175                   | Unix.Unix_error (Unix.ENOENT, _, _) -> find_index q
 176           in find_index request.request_config.default_directory_index
 177
 178       else (filename, stat)
 179     in
 180     if not (check_dotdot ~filename)
 181     then
 182       (Ocsigen_messages.debug
 183          (fun () -> "--Filenames cannot contain .. as in \""^filename^"\".");
 184        raise Failed_403)
 185     else if check_symlinks ~filename ~no_check_for
 186       request.request_config.follow_symlinks
 187     then (
 188         can_send filename request.request_config;
 189       (* If the previous function did not fail, we are authorized to
 190          send this file *)
 191       Ocsigen_messages.debug
 192         (fun () -> "--LocalFiles: Returning \""^filename^"\".");
 193       if stat.Unix.LargeFile.st_kind = Unix.S_REG then
 194         RFile filename
 195       else if stat.Unix.LargeFile.st_kind = Unix.S_DIR then
 196         RDir filename
 197       else raise Failed_404
 198     )
 199     else (
 200       (* [filename] is accessed through as symlink which we should not
 201          follow according to the current policy *)
 202       Ocsigen_messages.debug
 203         (fun () -> "--Failed symlink check for \""^filename^"\".");
 204       raise Failed_403)
 205   with
 206     (* We can get an EACCESS here, if are missing some rights on a directory *)
 207     | Unix.Unix_error (Unix.EACCES,_,_) -> raise Failed_403
 208     | Unix.Unix_error (Unix.ENOENT,_,_) -> raise Failed_404
 209
 210
 211 (* Given a local file or directory, we retrieve its content *)
 212 let content ~request ~file =
 213   try
 214     match file with
 215       | RDir dirname ->
 216           Ocsigen_senders.Directory_content.result_of_content
 217             (dirname, request.request_info.ri_full_path)
 218       | RFile filename ->
 219           Ocsigen_senders.File_content.result_of_content
 220             (filename,
 221              request.request_config.charset_assoc,
 222              request.request_config.mime_assoc
 223             )
 224
 225   with
 226     | Unix.Unix_error (Unix.EACCES,_,_) -> raise Failed_403