@@ -24,6 +24,210 @@ let name = "staticmod"
2424
2525let section = Lwt_log.Section. make " ocsigen:ext:staticmod"
2626
27+ exception Fail_403
28+ exception Fail_404
29+ exception Not_readable_directory
30+
31+ (* Policies for following symlinks *)
32+ type symlink_policy =
33+ stat :Unix.LargeFile .stats -> lstat :Unix.LargeFile .stats -> bool
34+
35+ let never_follow_symlinks : symlink_policy =
36+ fun ~stat ~lstat -> false
37+
38+ let follow_symlinks_if_owner_match : symlink_policy =
39+ fun ~stat ~lstat ->
40+ stat.Unix.LargeFile. st_uid = lstat.Unix.LargeFile. st_uid
41+
42+ (* checks that [filename] can be followed depending on the predicate
43+ [policy] which must receives as argument both the results
44+ of calling [stat] and [lstat] on filenam.
45+ If supplied, [stat] must be the result of calling [Unix.stat] on
46+ [filename] *)
47+ let check_symlinks_aux
48+ filename ?(stat =Unix.LargeFile. stat filename) (policy : symlink_policy ) =
49+ let lstat = Unix.LargeFile. lstat filename in
50+ if lstat.Unix.LargeFile. st_kind = Unix. S_LNK then
51+ policy ~stat ~lstat
52+ else
53+ true
54+
55+ (* Check that there are no invalid symlinks in the directories leading to
56+ [filename]. Paths upwards [no_check_for] are not checked. *)
57+ let rec check_symlinks_parent_directories
58+ ~filename ~no_check_for (policy : symlink_policy ) =
59+ if filename = " /" || filename = " ." || Some filename = no_check_for then
60+ true
61+ else
62+ let dirname = Filename. dirname filename in
63+ check_symlinks_aux dirname policy &&
64+ check_symlinks_parent_directories ~filename: dirname ~no_check_for policy
65+
66+ (* Check that [filename] can be reached according to the given
67+ symlink policy *)
68+ let check_symlinks ~no_check_for ~filename policy =
69+ let aux policy =
70+ if filename = " /" then
71+ (* The root cannot be a symlink, and this avoids some degenerate
72+ cases later on *)
73+ true
74+ else
75+ let filename =
76+ (* [filename] should start by at least a slash, as
77+ [Filename.is_relative filename] should be false. Hence the length
78+ should be at least 1 *)
79+ (* We remove an eventual trailing slash, in order to avoid a
80+ needless recursion in check_symlinks_parent_directories, and so
81+ that Unix.lstat returns the correct result (Unix.lstat "foo/" and
82+ Unix.lstat "foo" return two different results...) *)
83+ let len = String. length filename - 1 in
84+ if filename.[len] = '/' then
85+ String. sub filename 0 len
86+ else
87+ filename
88+ in
89+ check_symlinks_aux filename policy &&
90+ check_symlinks_parent_directories filename no_check_for policy
91+ in
92+ match policy with
93+ | `Always ->
94+ true
95+ | `No ->
96+ aux never_follow_symlinks
97+ | `Owner_match ->
98+ aux follow_symlinks_if_owner_match
99+
100+ let check_dotdot =
101+ let regexp = Ocsigen_lib.Netstring_pcre. regexp " (/\\ .\\ ./)|(/\\ .\\ .$)" in
102+ fun ~filename ->
103+ (* We always reject .. in filenames. In URLs, .. have already
104+ been removed by the server, but the filename may come from
105+ somewhere else than URLs ... *)
106+ try
107+ ignore
108+ (Ocsigen_lib.Netstring_pcre. search_forward regexp filename 0 );
109+ false
110+ with Not_found -> true
111+
112+ let can_send filename request =
113+ let filename =
114+ Ocsigen_lib.Url. split_path filename
115+ |> Ocsigen_lib.Url. norm_path
116+ |> Ocsigen_lib.Url. join_path
117+ in
118+ Lwt_log. ign_info_f ~section " checking if file %s can be sent"
119+ let matches arg =
120+ Ocsigen_lib.Netstring_pcre. string_match
121+ (Ocsigen_extensions. do_not_serve_to_regexp arg)
122+ filename 0 <>
123+ None
124+ in
125+ if matches request.Ocsigen_extensions. do_not_serve_403 then (
126+ Lwt_log. ign_info ~section " this file is forbidden"
127+ raise Fail_403 )
128+ else
129+ if matches request.Ocsigen_extensions. do_not_serve_404 then (
130+ Lwt_log. ign_info ~section " this file must be hidden"
131+ raise Fail_404 )
132+
133+ (* given [filename], we search for it in the local filesystem and
134+ - we return ["filename/index.html"] if [filename] corresponds to
135+ a directory, ["filename/index.html"] is valid, and ["index.html"]
136+ is one possible index (trying all possible indexes in order)
137+ - we raise [Fail_404] if [filename] corresponds to a directory,
138+ no index exists and [list_dir_content] is false.
139+ Warning: this behaviour is not the same as Apache's but it corresponds
140+ to a missing service in Eliom (answers 404). This also allows to have
141+ an Eliom service after a "forbidden" directory
142+ - we raise [Fail_403] if [filename] is a symlink that must
143+ not be followed
144+ - raises [Fail_404] if [filename] does not exist, or is a special file
145+ - otherwise returns [filename]
146+ *)
147+ (* See also module Files in eliom.ml *)
148+ let resolve
149+ ?no_check_for
150+ ~request :({Ocsigen_extensions. request_config} as request )
151+ ~filename () =
152+ (* We only accept absolute filenames in daemon mode,
153+ as we do not really know what is the current directory *)
154+ let filename =
155+ if Filename. is_relative filename && Ocsigen_config. get_daemon () then
156+ " /" ^ filename
157+ else
158+ filename
159+ in
160+ try
161+ Lwt_log. ign_info_f ~section " Testing \" %s\" ."
162+ let stat = Unix.LargeFile. stat filename in
163+ let (filename, stat) =
164+ if stat.Unix.LargeFile. st_kind = Unix. S_DIR then
165+ if filename.[String. length filename - 1 ] <> '/' then begin
166+ (* In this case, [filename] is a directory but this is not visible in
167+ its name as there is no final slash. We signal this fact to
168+ Ocsigen, which will then issue a 301 redirection to "filename/" *)
169+ Lwt_log. ign_info_f ~section " LocalFiles: %s is a directory"
170+ raise
171+ (Ocsigen_extensions. Ocsigen_is_dir
172+ (Ocsigen_extensions. new_url_of_directory_request request))
173+ end
174+
175+ else
176+ let rec find_index = function
177+ | [] ->
178+ (* No suitable index, we try to list the directory *)
179+ if request_config.Ocsigen_extensions. list_directory_content then (
180+ Lwt_log. ign_info ~section " Displaying directory content"
181+ (filename, stat)
182+ ) else (
183+ (* No suitable index *)
184+ Lwt_log. ign_info ~section " No index and no listing"
185+ raise Not_readable_directory )
186+ | e :: q ->
187+ let index = filename ^ e in
188+ Lwt_log. ign_info_f ~section " Testing \" %s\" as possible index."
189+ try
190+ (index, Unix.LargeFile. stat index)
191+ with
192+ | Unix. Unix_error (Unix. ENOENT, _ , _ ) -> find_index q
193+ in
194+ find_index
195+ request_config.Ocsigen_extensions. default_directory_index
196+
197+ else (filename, stat)
198+ in
199+ if not (check_dotdot ~filename )
200+ then
201+ (Lwt_log. ign_info_f ~section " Filenames cannot contain .. as in \" %s\" ."
202+ raise Fail_403 )
203+ else if check_symlinks ~filename ~no_check_for
204+ request_config.Ocsigen_extensions. follow_symlinks
205+ then (
206+ can_send filename request_config;
207+ (* If the previous function did not fail, we are authorized to
208+ send this file *)
209+ Lwt_log. ign_info_f ~section " Returning \" %s\" ."
210+ if stat.Unix.LargeFile. st_kind = Unix. S_REG then
211+ (* The string argument represents the real file/directory to
212+ serve, eg. foo/index.html instead of foo *)
213+ `File filename
214+ else if stat.Unix.LargeFile. st_kind = Unix. S_DIR then
215+ `Dir filename
216+ else
217+ raise Fail_404
218+ )
219+ else (
220+ (* [filename] is accessed through as symlink which we should not
221+ follow according to the current policy *)
222+ Lwt_log. ign_info_f ~section " Failed symlink check for \" %s\" ."
223+ raise Fail_403 )
224+ with
225+ (* We can get an EACCESS here, if are missing some rights on a directory *)
226+ | Unix. Unix_error (Unix. EACCES,_ ,_ ) ->
227+ raise Fail_403
228+ | Unix. Unix_error (Unix. ENOENT,_ ,_ ) ->
229+ raise Fail_404
230+
27231exception Not_concerned
28232
29233(* Structures describing the static pages a each virtual server *)
@@ -108,8 +312,7 @@ let find_static_page ~request ~usermode ~dir ~(err : Cohttp.Code.status) ~pathst
108312 | _ -> raise Not_concerned
109313 in
110314 if usermode = None || correct_user_local_file filename then
111- (status_filter,
112- Ocsigen_local_files. resolve ?no_check_for:root ~request ~filename () )
315+ status_filter, resolve ?no_check_for:root ~request ~filename ()
113316 else
114317 raise (Ocsigen_extensions. Error_in_user_config_file
115318 " Staticmod: cannot use '..' in user paths"
@@ -131,9 +334,9 @@ let gen ~usermode ?cache dir = function
131334 in
132335 let fname =
133336 match page with
134- | Ocsigen_local_files. RFile fname ->
337+ | `File fname ->
135338 fname
136- | Ocsigen_local_files. RDir _ ->
339+ | `Dir _ ->
137340 failwith " FIXME: staticmod dirs not implemented"
138341 in
139342 Cohttp_lwt_unix.Server. respond_file ~fname () >> = fun answer ->
@@ -164,15 +367,15 @@ let gen ~usermode ?cache dir = function
164367 in
165368 Lwt. return (Ocsigen_extensions. Ext_found (fun () -> Lwt. return answer))
166369 and catch_block = function
167- | Ocsigen_local_files. Failed_403 ->
370+ | Fail_403 ->
168371 Lwt. return (Ocsigen_extensions. Ext_next `Forbidden )
169372 (* XXX We should try to leave an information about this error
170373 for later *)
171- | Ocsigen_local_files. NotReadableDirectory ->
374+ | Not_readable_directory ->
172375 Lwt. return (Ocsigen_extensions. Ext_next err)
173376 | Ocsigen_extensions. NoSuchUser
174377 | Ocsigen_extensions. Not_concerned
175- | Ocsigen_local_files. Failed_404 ->
378+ | Fail_404 ->
176379 Lwt. return (Ocsigen_extensions. Ext_next err)
177380 | e ->
178381 Lwt. fail e
0 commit comments