(* $Id$ *)
(** HTTP filesystem *)
(** This module makes an HTTP file server accessible via a {!Netfs.stream_fs}
object, supporting
- reading files
- identifying and reading directories (if the server generates
index pages for directories, see below for more information)
- writing files (if the server implements PUT)
- removing files (if the server implements DELETE)
One has to specify a base URL [b], and the access of a file with path [p]
is translated to the URL [b ^ p]. Note that [p] cannot include web
parameters ("?" strings), and hash marks are also not supported.
A directory is recognized by appending a slash to the URL, and
checking whether the URL exists.
The contents of a directory are determined by loading the directory
URL, analyzing the HTML page, and checking for the presence of
hyperlinks that do not contain slashes (or at most a trailing slash).
Only hyperlinks of "A" elements are accepted.
Almost every web server can be configured to generate directory
listings that conform to this format. For example, Apache provides
this through the module [mod_autoindex].
There is an extension to this class for WebDAV:
- {{:http://oss.wink.com/webdav/} Webdav} provides an extension of
{!Nethttp_fs} for the full WebDAV set of filesystem operations
*)
(** {2 Examples} *)
(** Read an HTTP directory:
{[
let fs = new http_fs ~streaming:true "http://localhost/~gerd"
let files = fs # readdir [] "/"
]}
Download a file into a string:
{[
let ch = fs # read [] "/file"
let s = Netchannels.string_of_in_obj_channels ch
]}
Copy a file hierarchy to the local disk:
{[
let lfs = Netfs.local_fs()
Netfs.copy_into (fs :> Netfs.stream_fs) "/tree" lfs "/tmp"
]}
Use globbing:
{[
let fsys = Netglob.of_stream_fs (fs :> Netfs.stream_fs)
let files = Netglob.glob ~fsys (`String "/*.gif")
]}
The "https" protocol is also supported, so far a TLS provider is
initialized (see {!Tls} for more information).
*)
(** {2 Extended [stream_fs] type} *)
(** There is the new flag [`Header] for [read] and [write], and the
new method [last_response_header] for getting the response
header of the most recently executed operation.
*)
type read_flag =
[ Netfs.read_flag | `Header of (string*string)list ]
type read_file_flag =
[ Netfs.read_file_flag | `Header of (string*string)list ]
type write_flag =
[ Netfs.write_flag | `Header of (string*string)list ]
type write_file_flag =
[ Netfs.write_file_flag | `Header of (string*string)list ]
class type http_stream_fs =
object
method read : read_flag list -> string -> Netchannels.in_obj_channel
(** Additional flag:
- [`Header h]: Set these headers in the submitted GET request
*)
method read_file : read_file_flag list -> string -> Netfs.local_file
(** Additional flag:
- [`Header h]: Set these headers in the submitted GET request
*)
method write : write_flag list -> string -> Netchannels.out_obj_channel
(** Additional flag:
- [`Header h]: Set these headers in the submitted PUT request
*)
method write_file : write_file_flag list -> string -> Netfs.local_file -> unit
(** Additional flag:
- [`Header h]: Set these headers in the submitted PUT request
*)
method last_response_header : Nethttp.http_header
(** Returns the header of the HTTP response of the last operation.
Generally, the
header is set when the last operation returns normally (no
exception was raised). In case of [write], the header is first set when
the stream is closed.
Raises [Not_found] if the last operation did not receive a header
(or not fully).
*)
method last_response_status : Nethttp.http_status * int * string
(** Return the response status of the last operation, as triple
[(symbolic_code,numeric_code,text)]. This triple is set in the
same way as the response header. Raises [Not_found] if unavailable.
*)
method pipeline : Nethttp_client.pipeline
(** The HTTP pipeline backing this file system *)
(** The following methods are the same as in {!Netfs.stream_fs}.
(For formal reasons we cannot inherit from this class type.)
*)
method translate : string -> string
(** Translates a path into a URL *)
method path_encoding : Netconversion.encoding option
method path_exclusions : (int * int) list
method nominal_dot_dot : bool
method size : Netfs.size_flag list -> string -> int64
method test : Netfs.test_flag list -> string -> Netfs.test_type -> bool
method test_list : Netfs.test_flag list -> string -> Netfs.test_type list -> bool list
method remove : Netfs.remove_flag list -> string -> unit
method rename : Netfs.rename_flag list -> string -> string -> unit
method symlink : Netfs.symlink_flag list -> string -> string -> unit
method readdir : Netfs.readdir_flag list -> string -> string list
method readlink : Netfs.readlink_flag list -> string -> string
method mkdir : Netfs.mkdir_flag list -> string -> unit
method rmdir : Netfs.rmdir_flag list -> string -> unit
method copy : Netfs.copy_flag list -> string -> string -> unit
method cancel : unit -> unit
end
(** {2 The class} *)
class http_fs : ?config_pipeline:(Nethttp_client.pipeline -> unit) ->
?streaming:bool ->
?tmp_directory:string ->
?tmp_prefix:string ->
?path_encoding:Netconversion.encoding ->
?enable_read_for_directories:bool ->
?enable_ftp:bool ->
string -> http_stream_fs
(** [http_fs base_url]: Accesses the HTTP file system rooted at
[base_url].
The following access methods are supported (compare with
{!Netfs.stream_fs}):
- [path_encoding]: Returns the passed [path_encoding]. Paths
are always encoded.
- [path_exclusions]: is just [0,0; 47,47]
- [nominal_dot_dot] is true
- [read]: is supported. All files are considered as binary.
The [`Skip] flag works, and is translated to a [Range] header.
- [write]: is supported and translated to [PUT]. It is assumed
that [PUT] truncates existing files, and creates new files.
Note that errors are often first reported when the returned
channel is closed!
- [size]: this works only if the server includes the [Content-length]
header in responses to [HEAD] requests.
- [test] and [test_list]: The tests [`N], [`E], [`D], [`F], and [`S]
should work. Files are never symlinks. [`R] is handled like [`E],
and [`X] is handled like [`X] (i.e. it is assumed that all
files are readable, and all directories can be entered). The
[`W] test is never successful.
- [remove]: is translated to a [DELETE] request.
- [readdir]: works if index pages are generated (see above)
There is no support for [rename], [symlink], [mkdir], [rmdir], and
[copy].
Options:
- [config_pipeline]: one can enable further features on the pipeline
object (e.g. authentication, proxies)
- [streaming]: if true, the [read] method only reads as much data
from the HTTP connection as requested by the user. This assumes
that the user does not pause stream accesses for longer periods
as this would risk a server timeout. Also, there is no way for
the client to automatically reconnect to the HTTP server after crashes.
If false (the default),
files are first downloaded to a temporary file before they are
made accessible as [in_obj_channel]. Streaming can also be
enabled for each [read] or [write] by including [`Streaming]
in the list of flags.
- [tmp_directory]: directory for temporary files
- [tmp_prefix]: file prefix for temporary files (w/o directory)
- [path_encoding]: The encoding that is used for the file names.
This must match the encoding the server assumes for translating
file names to hyperlinks. Unfortunately, there is no way to
query the server for this. The default, [`Enc_utf8], seems to be the
de-facto standard on the web (e.g. browsers use UTF-8 when
non-ASCII characters are entered in the address line).
- [enable_ftp]: This enables anonymous FTP via web proxies. In
this case the [base_url] is of the form [ftp://host:port/path].
This works only if the pipeline is configured to contact a
web proxy understanding FTP URLs.
*)
(*
- [is_error_response]: This function is invoked with the current
call object as soon as the response header arrives. It
looks at the response code, and checks whether the response
is successful or not. In the latter case the function returns
the exception to raise. This function can be called several
times during the execution of an operation. If it is called
at a moment where only the response header is available but
not the response body it is ensured that it will be called
again with the full response later.
Defaults to {!Nethttp_fs.is_error_response}.
*)
val http_fs : ?config_pipeline:(Nethttp_client.pipeline -> unit) ->
?streaming:bool ->
?tmp_directory:string ->
?tmp_prefix:string ->
?path_encoding:Netconversion.encoding ->
?enable_read_for_directories:bool ->
?enable_ftp:bool ->
string -> http_stream_fs
(** Same as normal function *)
(*
val is_error_response : string -> Nethttp_client.http_call -> exn option
(** Default implementation: The [status] [`Successful] (code in the range
200 to 299) is considered as successful, and:
- code 404 is mapped to [ENOENT]
- codes 401 and 403 are mapped to [EACCES]
- other codes from 300 to 599 are mapped to [EPERM]
*)
*)
(**/**)
val find_flag : ('a -> 'b option) -> 'a list -> 'b
