]> matita.cs.unibo.it Git - helm.git/commitdiff
[svn-buildpackage] Tagging ocaml-http (0.1.4-2) ocaml-http
authorStefano Zacchiroli <zack@upsilon.cc>
Sun, 9 Sep 2007 10:37:16 +0000 (10:37 +0000)
committerStefano Zacchiroli <zack@upsilon.cc>
Sun, 9 Sep 2007 10:37:16 +0000 (10:37 +0000)
58 files changed:
0.1.4-2/.depend [new file with mode: 0644]
0.1.4-2/.ocamlinit [new file with mode: 0644]
0.1.4-2/INSTALL [new file with mode: 0644]
0.1.4-2/LICENSE [new file with mode: 0644]
0.1.4-2/META.in [new file with mode: 0644]
0.1.4-2/Makefile [new file with mode: 0644]
0.1.4-2/Makefile.defs [new file with mode: 0644]
0.1.4-2/README [new file with mode: 0644]
0.1.4-2/TODO [new file with mode: 0644]
0.1.4-2/cookie_lexer.mli [new file with mode: 0644]
0.1.4-2/cookie_lexer.mll [new file with mode: 0644]
0.1.4-2/debian/changelog [new file with mode: 0644]
0.1.4-2/debian/compat [new file with mode: 0644]
0.1.4-2/debian/control [new file with mode: 0644]
0.1.4-2/debian/copyright [new file with mode: 0644]
0.1.4-2/debian/dirs.in [new file with mode: 0644]
0.1.4-2/debian/examples [new file with mode: 0644]
0.1.4-2/debian/rules [new file with mode: 0755]
0.1.4-2/debian/svn-deblayout [new file with mode: 0644]
0.1.4-2/examples/Makefile [new file with mode: 0644]
0.1.4-2/examples/always_ok_daemon.ml [new file with mode: 0644]
0.1.4-2/examples/basic_auth.ml [new file with mode: 0644]
0.1.4-2/examples/chdir.ml [new file with mode: 0644]
0.1.4-2/examples/client_address.ml [new file with mode: 0644]
0.1.4-2/examples/damned_recursion.ml [new file with mode: 0644]
0.1.4-2/examples/dump_args.ml [new file with mode: 0644]
0.1.4-2/examples/highlander.ml [new file with mode: 0644]
0.1.4-2/examples/oo_daemon.ml [new file with mode: 0644]
0.1.4-2/examples/threads.ml [new file with mode: 0644]
0.1.4-2/examples/timeout.ml [new file with mode: 0644]
0.1.4-2/examples/webfsd.ml [new file with mode: 0644]
0.1.4-2/http_common.ml [new file with mode: 0644]
0.1.4-2/http_common.mli [new file with mode: 0644]
0.1.4-2/http_constants.ml [new file with mode: 0644]
0.1.4-2/http_constants.mli [new file with mode: 0644]
0.1.4-2/http_daemon.ml [new file with mode: 0644]
0.1.4-2/http_daemon.mli [new file with mode: 0644]
0.1.4-2/http_message.ml [new file with mode: 0644]
0.1.4-2/http_message.mli [new file with mode: 0644]
0.1.4-2/http_misc.ml [new file with mode: 0644]
0.1.4-2/http_misc.mli [new file with mode: 0644]
0.1.4-2/http_parser.ml [new file with mode: 0644]
0.1.4-2/http_parser.mli [new file with mode: 0644]
0.1.4-2/http_parser_sanity.ml [new file with mode: 0644]
0.1.4-2/http_parser_sanity.mli [new file with mode: 0644]
0.1.4-2/http_request.ml [new file with mode: 0644]
0.1.4-2/http_request.mli [new file with mode: 0644]
0.1.4-2/http_response.ml [new file with mode: 0644]
0.1.4-2/http_response.mli [new file with mode: 0644]
0.1.4-2/http_tcp_server.ml [new file with mode: 0644]
0.1.4-2/http_tcp_server.mli [new file with mode: 0644]
0.1.4-2/http_threaded_tcp_server.mli [new file with mode: 0644]
0.1.4-2/http_types.ml [new file with mode: 0644]
0.1.4-2/http_types.mli [new file with mode: 0644]
0.1.4-2/http_user_agent.ml [new file with mode: 0644]
0.1.4-2/http_user_agent.mli [new file with mode: 0644]
0.1.4-2/mt/http_threaded_tcp_server.ml [new file with mode: 0644]
0.1.4-2/non_mt/http_threaded_tcp_server.ml [new file with mode: 0644]

diff --git a/0.1.4-2/.depend b/0.1.4-2/.depend
new file mode 100644 (file)
index 0000000..b514ab3
--- /dev/null
@@ -0,0 +1,51 @@
+cookie_lexer.cmo: cookie_lexer.cmi 
+cookie_lexer.cmx: cookie_lexer.cmi 
+http_common.cmo: http_types.cmi http_constants.cmi http_common.cmi 
+http_common.cmx: http_types.cmx http_constants.cmx http_common.cmi 
+http_constants.cmo: http_constants.cmi 
+http_constants.cmx: http_constants.cmi 
+http_daemon.cmo: http_types.cmi http_tcp_server.cmi http_request.cmi \
+    http_parser_sanity.cmi http_parser.cmi http_misc.cmi http_constants.cmi \
+    http_common.cmi http_daemon.cmi 
+http_daemon.cmx: http_types.cmx http_tcp_server.cmx http_request.cmx \
+    http_parser_sanity.cmx http_parser.cmx http_misc.cmx http_constants.cmx \
+    http_common.cmx http_daemon.cmi 
+http_message.cmo: http_types.cmi http_parser_sanity.cmi http_misc.cmi \
+    http_constants.cmi http_common.cmi http_message.cmi 
+http_message.cmx: http_types.cmx http_parser_sanity.cmx http_misc.cmx \
+    http_constants.cmx http_common.cmx http_message.cmi 
+http_misc.cmo: http_types.cmi http_misc.cmi 
+http_misc.cmx: http_types.cmx http_misc.cmi 
+http_parser.cmo: http_types.cmi http_parser_sanity.cmi http_constants.cmi \
+    http_common.cmi cookie_lexer.cmi http_parser.cmi 
+http_parser.cmx: http_types.cmx http_parser_sanity.cmx http_constants.cmx \
+    http_common.cmx cookie_lexer.cmx http_parser.cmi 
+http_parser_sanity.cmo: http_types.cmi http_constants.cmi \
+    http_parser_sanity.cmi 
+http_parser_sanity.cmx: http_types.cmx http_constants.cmx \
+    http_parser_sanity.cmi 
+http_request.cmo: http_types.cmi http_parser.cmi http_misc.cmi \
+    http_message.cmi http_common.cmi http_request.cmi 
+http_request.cmx: http_types.cmx http_parser.cmx http_misc.cmx \
+    http_message.cmx http_common.cmx http_request.cmi 
+http_response.cmo: http_types.cmi http_misc.cmi http_message.cmi \
+    http_daemon.cmi http_constants.cmi http_common.cmi http_response.cmi 
+http_response.cmx: http_types.cmx http_misc.cmx http_message.cmx \
+    http_daemon.cmx http_constants.cmx http_common.cmx http_response.cmi 
+http_tcp_server.cmo: http_threaded_tcp_server.cmi http_tcp_server.cmi 
+http_tcp_server.cmx: http_threaded_tcp_server.cmi http_tcp_server.cmi 
+http_types.cmo: http_types.cmi 
+http_types.cmx: http_types.cmi 
+http_user_agent.cmo: http_parser.cmi http_misc.cmi http_common.cmi \
+    http_user_agent.cmi 
+http_user_agent.cmx: http_parser.cmx http_misc.cmx http_common.cmx \
+    http_user_agent.cmi 
+http_common.cmi: http_types.cmi 
+http_constants.cmi: http_types.cmi 
+http_daemon.cmi: http_types.cmi 
+http_message.cmi: http_types.cmi 
+http_parser.cmi: http_types.cmi 
+http_request.cmi: http_types.cmi 
+http_response.cmi: http_types.cmi 
+http_tcp_server.cmi: http_types.cmi 
+http_user_agent.cmi: http_types.cmi 
diff --git a/0.1.4-2/.ocamlinit b/0.1.4-2/.ocamlinit
new file mode 100644 (file)
index 0000000..64694a2
--- /dev/null
@@ -0,0 +1,5 @@
+#use "topfind";;
+#require "unix";;
+#require "pcre";;
+#require "netstring";;
+#load "http.cma";;
diff --git a/0.1.4-2/INSTALL b/0.1.4-2/INSTALL
new file mode 100644 (file)
index 0000000..dc1a772
--- /dev/null
@@ -0,0 +1,37 @@
+
+In order to build ocaml-http you will need:
+
+  - the ocaml compiler
+    [ http://caml.inria.fr ]
+
+  - findlib
+    [ http://www.ocaml-programming.de/packages/documentation/findlib/ ]
+
+  - ocamlnet
+    [ http://sourceforge.net/projects/ocamlnet ]
+
+  - pcre-ocaml
+    [ http://www.ai.univie.ac.at/~markus/home/ocaml_sources.html ]
+
+To build the bytecode library:
+
+  $ make all
+
+To build the nativecode library (only if you have an ocaml native code
+compiler):
+
+  $ make opt
+
+To install the built stuff in the OCaml standard library directory (as root):
+
+  # make install
+
+To install the built stuff in another directory:
+
+  $ make install DESTDIR=another_directory
+
+To build a debian package of the library (please note that to build a debian
+package you will also need some additional stuff like debhelper, fakeroot, ...):
+
+  $ fakeroot debian/rules binary
+
diff --git a/0.1.4-2/LICENSE b/0.1.4-2/LICENSE
new file mode 100644 (file)
index 0000000..f1c4ea8
--- /dev/null
@@ -0,0 +1,483 @@
+
+                 GNU LIBRARY GENERAL PUBLIC LICENSE
+                      Version 2, June 1991
+
+ Copyright (C) 1991 Free Software Foundation, Inc.
+                   59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+[This is the first released version of the library GPL.  It is
+ numbered 2 because it goes with version 2 of the ordinary GPL.]
+
+                           Preamble
+
+  The licenses for most software are designed to take away your
+freedom to share and change it.  By contrast, the GNU General Public
+Licenses are intended to guarantee your freedom to share and change
+free software--to make sure the software is free for all its users.
+
+  This license, the Library General Public License, applies to some
+specially designated Free Software Foundation software, and to any
+other libraries whose authors decide to use it.  You can use it for
+your libraries, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+  To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if
+you distribute copies of the library, or if you modify it.
+
+  For example, if you distribute copies of the library, whether gratis
+or for a fee, you must give the recipients all the rights that we gave
+you.  You must make sure that they, too, receive or can get the source
+code.  If you link a program with the library, you must provide
+complete object files to the recipients so that they can relink them
+with the library, after making changes to the library and recompiling
+it.  And you must show them these terms so they know their rights.
+
+  Our method of protecting your rights has two steps: (1) copyright
+the library, and (2) offer you this license which gives you legal
+permission to copy, distribute and/or modify the library.
+
+  Also, for each distributor's protection, we want to make certain
+that everyone understands that there is no warranty for this free
+library.  If the library is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original
+version, so that any problems introduced by others will not reflect on
+the original authors' reputations.
+\f
+  Finally, any free program is threatened constantly by software
+patents.  We wish to avoid the danger that companies distributing free
+software will individually obtain patent licenses, thus in effect
+transforming the program into proprietary software.  To prevent this,
+we have made it clear that any patent must be licensed for everyone's
+free use or not licensed at all.
+
+  Most GNU software, including some libraries, is covered by the ordinary
+GNU General Public License, which was designed for utility programs.  This
+license, the GNU Library General Public License, applies to certain
+designated libraries.  This license is quite different from the ordinary
+one; be sure to read it in full, and don't assume that anything in it is
+the same as in the ordinary license.
+
+  The reason we have a separate public license for some libraries is that
+they blur the distinction we usually make between modifying or adding to a
+program and simply using it.  Linking a program with a library, without
+changing the library, is in some sense simply using the library, and is
+analogous to running a utility program or application program.  However, in
+a textual and legal sense, the linked executable is a combined work, a
+derivative of the original library, and the ordinary General Public License
+treats it as such.
+
+  Because of this blurred distinction, using the ordinary General
+Public License for libraries did not effectively promote software
+sharing, because most developers did not use the libraries.  We
+concluded that weaker conditions might promote sharing better.
+
+  However, unrestricted linking of non-free programs would deprive the
+users of those programs of all benefit from the free status of the
+libraries themselves.  This Library General Public License is intended to
+permit developers of non-free programs to use free libraries, while
+preserving your freedom as a user of such programs to change the free
+libraries that are incorporated in them.  (We have not seen how to achieve
+this as regards changes in header files, but we have achieved it as regards
+changes in the actual functions of the Library.)  The hope is that this
+will lead to faster development of free libraries.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.  Pay close attention to the difference between a
+"work based on the library" and a "work that uses the library".  The
+former contains code derived from the library, while the latter only
+works together with the library.
+
+  Note that it is possible for a library to be covered by the ordinary
+General Public License rather than by this special one.
+\f
+                 GNU LIBRARY GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License Agreement applies to any software library which
+contains a notice placed by the copyright holder or other authorized
+party saying it may be distributed under the terms of this Library
+General Public License (also called "this License").  Each licensee is
+addressed as "you".
+
+  A "library" means a collection of software functions and/or data
+prepared so as to be conveniently linked with application programs
+(which use some of those functions and data) to form executables.
+
+  The "Library", below, refers to any such software library or work
+which has been distributed under these terms.  A "work based on the
+Library" means either the Library or any derivative work under
+copyright law: that is to say, a work containing the Library or a
+portion of it, either verbatim or with modifications and/or translated
+straightforwardly into another language.  (Hereinafter, translation is
+included without limitation in the term "modification".)
+
+  "Source code" for a work means the preferred form of the work for
+making modifications to it.  For a library, complete source code means
+all the source code for all modules it contains, plus any associated
+interface definition files, plus the scripts used to control compilation
+and installation of the library.
+
+  Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope.  The act of
+running a program using the Library is not restricted, and output from
+such a program is covered only if its contents constitute a work based
+on the Library (independent of the use of the Library in a tool for
+writing it).  Whether that is true depends on what the Library does
+and what the program that uses the Library does.
+  
+  1. You may copy and distribute verbatim copies of the Library's
+complete source code as you receive it, in any medium, provided that
+you conspicuously and appropriately publish on each copy an
+appropriate copyright notice and disclaimer of warranty; keep intact
+all the notices that refer to this License and to the absence of any
+warranty; and distribute a copy of this License along with the
+Library.
+
+  You may charge a fee for the physical act of transferring a copy,
+and you may at your option offer warranty protection in exchange for a
+fee.
+\f
+  2. You may modify your copy or copies of the Library or any portion
+of it, thus forming a work based on the Library, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+    a) The modified work must itself be a software library.
+
+    b) You must cause the files modified to carry prominent notices
+    stating that you changed the files and the date of any change.
+
+    c) You must cause the whole of the work to be licensed at no
+    charge to all third parties under the terms of this License.
+
+    d) If a facility in the modified Library refers to a function or a
+    table of data to be supplied by an application program that uses
+    the facility, other than as an argument passed when the facility
+    is invoked, then you must make a good faith effort to ensure that,
+    in the event an application does not supply such function or
+    table, the facility still operates, and performs whatever part of
+    its purpose remains meaningful.
+
+    (For example, a function in a library to compute square roots has
+    a purpose that is entirely well-defined independent of the
+    application.  Therefore, Subsection 2d requires that any
+    application-supplied function or table used by this function must
+    be optional: if the application does not supply it, the square
+    root function must still compute square roots.)
+
+These requirements apply to the modified work as a whole.  If
+identifiable sections of that work are not derived from the Library,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works.  But when you
+distribute the same sections as part of a whole which is a work based
+on the Library, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote
+it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Library.
+
+In addition, mere aggregation of another work not based on the Library
+with the Library (or with a work based on the Library) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+  3. You may opt to apply the terms of the ordinary GNU General Public
+License instead of this License to a given copy of the Library.  To do
+this, you must alter all the notices that refer to this License, so
+that they refer to the ordinary GNU General Public License, version 2,
+instead of to this License.  (If a newer version than version 2 of the
+ordinary GNU General Public License has appeared, then you can specify
+that version instead if you wish.)  Do not make any other change in
+these notices.
+\f
+  Once this change is made in a given copy, it is irreversible for
+that copy, so the ordinary GNU General Public License applies to all
+subsequent copies and derivative works made from that copy.
+
+  This option is useful when you wish to copy part of the code of
+the Library into a program that is not a library.
+
+  4. You may copy and distribute the Library (or a portion or
+derivative of it, under Section 2) in object code or executable form
+under the terms of Sections 1 and 2 above provided that you accompany
+it with the complete corresponding machine-readable source code, which
+must be distributed under the terms of Sections 1 and 2 above on a
+medium customarily used for software interchange.
+
+  If distribution of object code is made by offering access to copy
+from a designated place, then offering equivalent access to copy the
+source code from the same place satisfies the requirement to
+distribute the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+  5. A program that contains no derivative of any portion of the
+Library, but is designed to work with the Library by being compiled or
+linked with it, is called a "work that uses the Library".  Such a
+work, in isolation, is not a derivative work of the Library, and
+therefore falls outside the scope of this License.
+
+  However, linking a "work that uses the Library" with the Library
+creates an executable that is a derivative of the Library (because it
+contains portions of the Library), rather than a "work that uses the
+library".  The executable is therefore covered by this License.
+Section 6 states terms for distribution of such executables.
+
+  When a "work that uses the Library" uses material from a header file
+that is part of the Library, the object code for the work may be a
+derivative work of the Library even though the source code is not.
+Whether this is true is especially significant if the work can be
+linked without the Library, or if the work is itself a library.  The
+threshold for this to be true is not precisely defined by law.
+
+  If such an object file uses only numerical parameters, data
+structure layouts and accessors, and small macros and small inline
+functions (ten lines or less in length), then the use of the object
+file is unrestricted, regardless of whether it is legally a derivative
+work.  (Executables containing this object code plus portions of the
+Library will still fall under Section 6.)
+
+  Otherwise, if the work is a derivative of the Library, you may
+distribute the object code for the work under the terms of Section 6.
+Any executables containing that work also fall under Section 6,
+whether or not they are linked directly with the Library itself.
+\f
+  6. As an exception to the Sections above, you may also compile or
+link a "work that uses the Library" with the Library to produce a
+work containing portions of the Library, and distribute that work
+under terms of your choice, provided that the terms permit
+modification of the work for the customer's own use and reverse
+engineering for debugging such modifications.
+
+  You must give prominent notice with each copy of the work that the
+Library is used in it and that the Library and its use are covered by
+this License.  You must supply a copy of this License.  If the work
+during execution displays copyright notices, you must include the
+copyright notice for the Library among them, as well as a reference
+directing the user to the copy of this License.  Also, you must do one
+of these things:
+
+    a) Accompany the work with the complete corresponding
+    machine-readable source code for the Library including whatever
+    changes were used in the work (which must be distributed under
+    Sections 1 and 2 above); and, if the work is an executable linked
+    with the Library, with the complete machine-readable "work that
+    uses the Library", as object code and/or source code, so that the
+    user can modify the Library and then relink to produce a modified
+    executable containing the modified Library.  (It is understood
+    that the user who changes the contents of definitions files in the
+    Library will not necessarily be able to recompile the application
+    to use the modified definitions.)
+
+    b) Accompany the work with a written offer, valid for at
+    least three years, to give the same user the materials
+    specified in Subsection 6a, above, for a charge no more
+    than the cost of performing this distribution.
+
+    c) If distribution of the work is made by offering access to copy
+    from a designated place, offer equivalent access to copy the above
+    specified materials from the same place.
+
+    d) Verify that the user has already received a copy of these
+    materials or that you have already sent this user a copy.
+
+  For an executable, the required form of the "work that uses the
+Library" must include any data and utility programs needed for
+reproducing the executable from it.  However, as a special exception,
+the source code distributed need not include anything that is normally
+distributed (in either source or binary form) with the major
+components (compiler, kernel, and so on) of the operating system on
+which the executable runs, unless that component itself accompanies
+the executable.
+
+  It may happen that this requirement contradicts the license
+restrictions of other proprietary libraries that do not normally
+accompany the operating system.  Such a contradiction means you cannot
+use both them and the Library together in an executable that you
+distribute.
+\f
+  7. You may place library facilities that are a work based on the
+Library side-by-side in a single library together with other library
+facilities not covered by this License, and distribute such a combined
+library, provided that the separate distribution of the work based on
+the Library and of the other library facilities is otherwise
+permitted, and provided that you do these two things:
+
+    a) Accompany the combined library with a copy of the same work
+    based on the Library, uncombined with any other library
+    facilities.  This must be distributed under the terms of the
+    Sections above.
+
+    b) Give prominent notice with the combined library of the fact
+    that part of it is a work based on the Library, and explaining
+    where to find the accompanying uncombined form of the same work.
+
+  8. You may not copy, modify, sublicense, link with, or distribute
+the Library except as expressly provided under this License.  Any
+attempt otherwise to copy, modify, sublicense, link with, or
+distribute the Library is void, and will automatically terminate your
+rights under this License.  However, parties who have received copies,
+or rights, from you under this License will not have their licenses
+terminated so long as such parties remain in full compliance.
+
+  9. You are not required to accept this License, since you have not
+signed it.  However, nothing else grants you permission to modify or
+distribute the Library or its derivative works.  These actions are
+prohibited by law if you do not accept this License.  Therefore, by
+modifying or distributing the Library (or any work based on the
+Library), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Library or works based on it.
+
+  10. Each time you redistribute the Library (or any work based on the
+Library), the recipient automatically receives a license from the
+original licensor to copy, distribute, link with or modify the Library
+subject to these terms and conditions.  You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+\f
+  11. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Library at all.  For example, if a patent
+license would not permit royalty-free redistribution of the Library by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Library.
+
+If any portion of this section is held invalid or unenforceable under any
+particular circumstance, the balance of the section is intended to apply,
+and the section as a whole is intended to apply in other circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system which is
+implemented by public license practices.  Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+  12. If the distribution and/or use of the Library is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Library under this License may add
+an explicit geographical distribution limitation excluding those countries,
+so that distribution is permitted only in or among countries not thus
+excluded.  In such case, this License incorporates the limitation as if
+written in the body of this License.
+
+  13. The Free Software Foundation may publish revised and/or new
+versions of the Library General Public License from time to time.
+Such new versions will be similar in spirit to the present version,
+but may differ in detail to address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Library
+specifies a version number of this License which applies to it and
+"any later version", you have the option of following the terms and
+conditions either of that version or of any later version published by
+the Free Software Foundation.  If the Library does not specify a
+license version number, you may choose any version ever published by
+the Free Software Foundation.
+\f
+  14. If you wish to incorporate parts of the Library into other free
+programs whose distribution conditions are incompatible with these,
+write to the author to ask for permission.  For software which is
+copyrighted by the Free Software Foundation, write to the Free
+Software Foundation; we sometimes make exceptions for this.  Our
+decision will be guided by the two goals of preserving the free status
+of all derivatives of our free software and of promoting the sharing
+and reuse of software generally.
+
+                           NO WARRANTY
+
+  15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
+WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
+EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
+OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
+KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
+LIBRARY IS WITH YOU.  SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
+THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+  16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
+WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
+AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
+FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
+CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
+LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
+FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGES.
+
+                    END OF TERMS AND CONDITIONS
+\f
+           How to Apply These Terms to Your New Libraries
+
+  If you develop a new library, and you want it to be of the greatest
+possible use to the public, we recommend making it free software that
+everyone can redistribute and change.  You can do so by permitting
+redistribution under these terms (or, alternatively, under the terms of the
+ordinary General Public License).
+
+  To apply these terms, attach the following notices to the library.  It is
+safest to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least the
+"copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the library's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    This library 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
+    Library General Public License for more details.
+
+    You should have received a copy of the GNU Library General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+Also add information on how to contact you by electronic and paper mail.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the library, if
+necessary.  Here is a sample; alter the names:
+
+  Yoyodyne, Inc., hereby disclaims all copyright interest in the
+  library `Frob' (a library for tweaking knobs) written by James Random Hacker.
+
+  <signature of Ty Coon>, 1 April 1990
+  Ty Coon, President of Vice
+
+That's all there is to it!
+
diff --git a/0.1.4-2/META.in b/0.1.4-2/META.in
new file mode 100644 (file)
index 0000000..8c32546
--- /dev/null
@@ -0,0 +1,8 @@
+description = "OCaml HTTP daemon library"
+version = "@DISTVERSION@"
+requires = "unix,pcre,netstring"
+requires(mt) = "unix,pcre,netstring,threads"
+archive(byte) = "http.cma"
+archive(native) = "http.cmxa"
+archive(mt,byte) = "http_mt.cma"
+archive(mt,native) = "http_mt.cmxa"
diff --git a/0.1.4-2/Makefile b/0.1.4-2/Makefile
new file mode 100644 (file)
index 0000000..b3d74b1
--- /dev/null
@@ -0,0 +1,150 @@
+include Makefile.defs
+export SHELL=/bin/bash
+
+MODULES = \
+       http_constants \
+       http_types \
+       http_parser_sanity \
+       http_misc \
+       http_common \
+       http_tcp_server \
+       cookie_lexer \
+       http_parser \
+       http_message \
+       http_request \
+       http_daemon \
+       http_response \
+       http_user_agent \
+       $(NULL)
+
+THREADED_SRV = http_threaded_tcp_server
+MODULES_MT = $(patsubst http_tcp_server, mt/$(THREADED_SRV) http_tcp_server, $(MODULES))
+MODULES_NON_MT = $(patsubst http_tcp_server, non_mt/$(THREADED_SRV) http_tcp_server, $(MODULES))
+PUBLIC_MODULES = \
+       http_types      \
+       http_common     \
+       http_message    \
+       http_request    \
+       http_daemon     \
+       http_response   \
+       http_user_agent
+OCAMLDOC_STUFF = *.mli
+DOCDIR = doc/html
+DOTDIR = doc/dot
+TEXDIR = doc/latex
+DESTDIR = $(shell $(OCAMLFIND) printconf destdir) 
+
+all: all_non_mt all_mt
+opt: opt_non_mt opt_mt
+all_non_mt: http.cma
+opt_non_mt: http.cmxa
+all_mt: http_mt.cma
+opt_mt: http_mt.cmxa
+world: all opt
+doc: all $(DOCDIR)/index.html $(DOTDIR)/ocaml-http.ps $(TEXDIR)/ocaml-http.ps $(OCAMLDOC_STUFF)
+$(DOCDIR)/index.html:
+       $(OCAMLDOC) -html -d $(DOCDIR) $(OCAMLDOC_STUFF)
+$(TEXDIR)/ocaml-http.tex: $(OCAMLDOC_STUFF)
+       $(OCAMLDOC) -latex -o $@ $^
+$(TEXDIR)/ocaml-http.ps: $(TEXDIR)/ocaml-http.tex
+       cd $(TEXDIR);           \
+       latex ocaml-http;       \
+       latex ocaml-http;       \
+       dvips ocaml-http
+$(DOTDIR)/ocaml-http.ps: $(DOTDIR)/ocaml-http.dot
+       $(DOT) -Tps $< > $@
+$(DOTDIR)/ocaml-http.dot: *.ml *.mli
+       $(OCAMLDOC) -dot -o $(DOTDIR)/ocaml-http.dot *.ml *.mli
+
+examples:
+       $(MAKE) -C examples/
+examples.opt:
+       $(MAKE) -C examples/ opt
+
+include .depend
+
+depend:
+       $(OCAMLDEP) *.ml *.mli > .depend
+
+%.ml: %.mll
+       $(OCAMLLEX) $<
+%.cmi: %.mli
+       $(OCAMLC) -c $<
+%.cmo: %.ml %.cmi
+       $(OCAMLC) -c $<
+%.cmx: %.ml %.cmi
+       $(OCAMLOPT) -c $<
+
+non_mt/$(THREADED_SRV).cmo: non_mt/$(THREADED_SRV).ml $(THREADED_SRV).cmi
+       cp $(THREADED_SRV).{cmi,mli} non_mt/
+       $(OCAMLC) -c $<
+non_mt/$(THREADED_SRV).cmx: non_mt/$(THREADED_SRV).ml $(THREADED_SRV).cmi
+       cp $(THREADED_SRV).{cmi,mli} non_mt/
+       $(OCAMLOPT) -c $<
+
+mt/$(THREADED_SRV).cmo: mt/$(THREADED_SRV).ml $(THREADED_SRV).cmi
+       cp $(THREADED_SRV).{cmi,mli} mt/
+       $(OCAMLC) $(THREADS_FLAGS) -c $<
+mt/$(THREADED_SRV).cmx: mt/$(THREADED_SRV).ml $(THREADED_SRV).cmi
+       cp $(THREADED_SRV).{cmi,mli} mt/
+       $(OCAMLOPT) $(THREADS_FLAGS) -c $<
+
+http.cma: $(patsubst %,%.cmo,$(MODULES_NON_MT))
+       $(OCAMLC) -a -o $@ $^
+http.cmxa: $(patsubst %,%.cmx,$(MODULES_NON_MT))
+       $(OCAMLOPT) -a -o $@ $^
+http_mt.cma: $(patsubst %,%.cmo,$(MODULES_MT))
+       $(OCAMLC) -a -o $@ $^
+http_mt.cmxa: $(patsubst %,%.cmx,$(MODULES_MT))
+       $(OCAMLOPT) -a -o $@ $^
+
+meta: META
+META: META.in
+       cat META.in | sed -e 's/@DISTVERSION@/$(DISTVERSION)/' > META
+
+clean:
+       $(MAKE) -C examples/ clean
+       for d in . mt non_mt; do        \
+               rm -f $$d/*.cm[ioax] $$d/*.cmxa $$d/*.[ao] $$d/test{,.opt};     \
+       done
+       rm -f {mt,non_mt}/$(THREADED_SRV).mli
+docclean:
+       -rm -f  \
+               $(DOCDIR)/*.html $(DOCDIR)/*.css        \
+               $(DOTDIR)/*.dot $(DOTDIR)/*.ps  \
+               $(TEXDIR)/*.{dvi,ps,ps.gz,pdf,aux,log,out,toc,tmp,haux,sty,tex}
+distclean: clean
+       $(MAKE) -C examples/ distclean
+       rm -f META
+dist: distreal distrm
+distdoc: all doc
+       if [ -d $(DISTDIR) ]; then rm -rf $(DISTDIR); else true; fi
+       mkdir -p $(DISTDIR)/doc/
+       cp -r doc/html/ $(DISTDIR)/doc/
+       cp doc/dot/ocaml-http.ps $(DISTDIR)/doc/modules.ps
+       cp doc/latex/ocaml-http.ps $(DISTDIR)/doc/
+distreal: distdoc distclean depend
+       for f in        \
+                       $(patsubst %, %.ml, $(MODULES)) \
+                       $(patsubst %, %.mli, $(MODULES) $(THREADED_SRV))        \
+                       mt/ non_mt/ $(EXTRA_DIST) examples/ debian/;    \
+       do      \
+               cp -r $$f $(DISTDIR)/;  \
+       done
+       -find $(DISTDIR)/ -type d -name .svn -exec rm -rf {} \;
+       tar cvzf $(DISTDIR).tar.gz $(DISTDIR)/
+distrm:
+       rm -rf $(DISTDIR)/
+deb: docclean distreal
+       (cd $(DISTDIR)/ && debuild)
+       rm -rf $(DISTDIR)/
+install: META
+       $(OCAMLFIND) install -destdir $(DESTDIR) $(PKGNAME)     \
+               $(patsubst %, %.mli, $(PUBLIC_MODULES)) \
+               $(patsubst %, %.cmi, $(PUBLIC_MODULES)) \
+               $(wildcard *.cma *.cmxa *.a) META
+
+.PHONY:        \
+       all opt world all_non_mt all_mt opt_non_mt opt_mt       \
+       examples examples.opt depend clean distclean dist       \
+       install meta doc deb distreal distrm
diff --git a/0.1.4-2/Makefile.defs b/0.1.4-2/Makefile.defs
new file mode 100644 (file)
index 0000000..f174b02
--- /dev/null
@@ -0,0 +1,25 @@
+PKGNAME = http
+DISTVERSION = $(shell dpkg-parsechangelog | egrep '^Version: ' | sed 's/^Version: //' | sed 's/-.*//')
+
+DEBUG_FLAGS =
+REQUIRES = unix str pcre netstring
+COMMON_FLAGS = $(DEBUG_FLAGS) -pp camlp4o -package "$(REQUIRES)"
+THREADS_FLAGS = -package threads -thread
+OCAMLFIND = ocamlfind
+OCAMLC = $(OCAMLFIND) ocamlc $(COMMON_FLAGS)
+OCAMLOPT = $(OCAMLFIND) ocamlopt $(COMMON_FLAGS)
+OCAMLDEP = $(OCAMLFIND) ocamldep $(COMMON_FLAGS)
+OCAMLLEX = ocamllex
+OCAMLDOC :=                                                    \
+       ocamldoc -stars                                         \
+               $(shell $(OCAMLFIND) query -i-format unix)      \
+               $(shell $(OCAMLFIND) query -i-format pcre)      \
+               $(shell $(OCAMLFIND) query -i-format netstring)
+DOT = dot
+
+DISTNAME = ocaml-http
+DISTDIR = $(DISTNAME)-$(DISTVERSION)
+EXTRA_DIST =   \
+       INSTALL LICENSE README META.in Makefile Makefile.defs   \
+       .depend
+
diff --git a/0.1.4-2/README b/0.1.4-2/README
new file mode 100644 (file)
index 0000000..1566b8e
--- /dev/null
@@ -0,0 +1,4 @@
+
+OCaml HTTP is a simple OCaml library for creating HTTP daemons, it is largely
+inspired to the Perl's HTTP:: modules family.
+
diff --git a/0.1.4-2/TODO b/0.1.4-2/TODO
new file mode 100644 (file)
index 0000000..7fc3c6b
--- /dev/null
@@ -0,0 +1 @@
+- support for HTTPS
diff --git a/0.1.4-2/cookie_lexer.mli b/0.1.4-2/cookie_lexer.mli
new file mode 100644 (file)
index 0000000..4458d36
--- /dev/null
@@ -0,0 +1,29 @@
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2007> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library 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
+*)
+
+type cookie_token =
+  [ `QSTRING of string
+  | `SEP
+  | `TOKEN of string
+  | `ASSIGN
+  | `EOF ]
+
+val token : Lexing.lexbuf -> cookie_token
+
diff --git a/0.1.4-2/cookie_lexer.mll b/0.1.4-2/cookie_lexer.mll
new file mode 100644 (file)
index 0000000..e665e26
Binary files /dev/null and b/0.1.4-2/cookie_lexer.mll differ
diff --git a/0.1.4-2/debian/changelog b/0.1.4-2/debian/changelog
new file mode 100644 (file)
index 0000000..ee9ddb1
--- /dev/null
@@ -0,0 +1,232 @@
+ocaml-http (0.1.4-2) unstable; urgency=low
+
+  * change how the ocamldoc API reference is generated: no longer use upstream
+    Makefile, but rather rely on CDBS
+  * debian/control
+    - remove build-dep on texlive stuff and graphviz since now we only ship
+      HTML version of the API reference
+  * debian/docs, debian/doc-base
+    - file removed, the latter will be now automatically generated, the former
+      would only contain README and CDBS is smart enough to guess it
+
+ -- Stefano Zacchiroli <zack@debian.org>  Sun, 09 Sep 2007 12:34:07 +0200
+
+ocaml-http (0.1.4-1) experimental; urgency=low
+
+  * rebuild against OCaml 3.10 and ocamlnet 2.2
+  * send internally generated headers as lowercase strings, for consistency
+    with headers generated via setXXX methods
+  * add preliminary support for cookies (new "cookies" method added to an
+    http_request, cookies are parsed upon request creation if a "Cookie:"
+    header has been received)
+  * debian/rules
+    - use ocaml.mk CDBS class
+  * debian/rules
+    - build ocamldoc documentation at package build time
+  * debian/control
+    - add build-dep on camlp4, which is now in a separate package
+    - add build-dep for doc generation: graphviz, texlive-latex-recommended,
+      texlive-base-bin, texlive-latex-extra
+  * debian/svn-deblayout
+    - add repository layout information
+  - bump debhelper dep and compatibility level to 5
+
+ -- Stefano Zacchiroli <zack@debian.org>  Mon, 16 Jul 2007 16:19:48 +0200
+
+ocaml-http (0.1.3-2) unstable; urgency=low
+
+  * debian/control.in
+    - file removed, no longer needed
+  * debian/control
+    - bumped dependencies on pcre-ocaml and ocamlnet
+  * debian/rules
+    - binNMU safe substitution of variables in .in files
+  * debian/dirs
+    - file removed, will be generated at build time
+
+ -- Stefano Zacchiroli <zack@debian.org>  Fri, 15 Sep 2006 00:29:56 +0200
+
+ocaml-http (0.1.3-1) unstable; urgency=low
+
+  * force bash as SHELL in Makefile, since we rely on bashisms
+    (closes: bug#381915)
+  * removed Http_daemon.{start,start'}, they have been deprecated a while ago
+    in favour of Http_daemon.main
+  * added 'auto_close' to daemon specifications. When set to true (defaults to
+    false), makes ocaml-http close every connection with client just after
+    having executed a callback, no matter if that callback succeeds or fails
+    with an exception
+
+ -- Stefano Zacchiroli <zack@debian.org>  Sun, 20 Aug 2006 18:07:41 +0200
+
+ocaml-http (0.1.2-4) unstable; urgency=low
+
+  * Rebuilt against ocaml 3.09.2, bumped deps accordingly.
+  * debian/control
+    - Bumped Standards-Version to 3.7.2 (no changes needed)
+
+ -- Stefano Zacchiroli <zack@debian.org>  Wed, 17 May 2006 05:18:32 +0000
+
+ocaml-http (0.1.2-3) unstable; urgency=low
+
+  * Rebuilt against OCaml 3.09.1, bumped deps accordingly.
+
+ -- Stefano Zacchiroli <zack@debian.org>  Sun,  8 Jan 2006 13:13:07 +0100
+
+ocaml-http (0.1.2-2) unstable; urgency=low
+
+  * rebuilt with ocaml 3.09
+  * debian/*
+    - no more hardcoding of ocaml abi version anywhere
+  * debian/rules
+    - use cdbs
+
+ -- Stefano Zacchiroli <zack@debian.org>  Sat, 26 Nov 2005 20:28:26 +0100
+
+ocaml-http (0.1.2-1) unstable; urgency=low
+
+  * avoid exceptions for closing connection twice during finaliztion of
+    connection objects (thanks to Eric Strokes <eric.stokes@csun.edu>
+    for the patch)
+
+ -- Stefano Zacchiroli <zack@debian.org>  Wed, 14 Sep 2005 18:03:40 +0200
+
+ocaml-http (0.1.1-1) unstable; urgency=low
+
+  * added ?default parameter to "param" method
+  * fixed bug in response status line parsing
+  * integrated patch for HTTP/1.1 persistent connections from
+    Eric Cooper <ecc@cmu.edu>:
+    - added support for persistent connections to http_daemon.ml: server
+      now loops until End_of_file (or any exception) occurs when trying
+      to parse the next request
+  * debian/control
+    - bumped pcre and ocamlnet dependencies
+    - bumped standards-version to 3.6.2
+
+ -- Stefano Zacchiroli <zack@debian.org>  Wed, 16 Mar 2005 09:24:07 +0100
+
+ocaml-http (0.1.0-2) unstable; urgency=low
+
+  * rebuilt against ocaml 3.08.3
+
+ -- Stefano Zacchiroli <zack@debian.org>  Tue, 29 Mar 2005 11:39:24 +0200
+
+ocaml-http (0.1.0-1) unstable; urgency=low
+
+  * first debian official package
+
+ -- Stefano Zacchiroli <zack@debian.org>  Tue,  8 Feb 2005 22:45:54 +0100
+
+ocaml-http (0.1.0) unstable; urgency=low
+
+  * added "daemon specifications": a unified way of specifying daemons
+    behaviour including old parameters of Http_daemon.start together
+    with authentication requirements and exception handling
+  * added new way of building daemons starting from specifications, old
+    ways (e.g. Http_daemon.start) are now deprecated
+  * added sigpipe handling to avoid daemons dying for uncaught signals
+  * added exception handler (as part of a daemon specification), it can
+    be used to ensure that some code is execute before a process/thread
+    die for uncaught exception (e.g. unlocking a global mutex)
+  * added authentication requirements (as part of a daemon
+    specification): an handy way to specify required user name and
+    password for HTTP basic authentication
+  * added head_callback to Http_user_agent in order to have access to
+    response status and headers in HTTP requests
+  * changed license from GPL to LGPL
+  * improved ocamldoc documentation and debian packaging
+
+ -- Stefano Zacchiroli <zack@debian.org>  Thu,  3 Feb 2005 23:08:14 +0100
+
+ocaml-http (0.0.10) unstable; urgency=low
+
+  * renamed Http_client module to Http_user_agent to avoid compatibility
+    issues with Netclient. Renamed that module functions removing
+    "http_" prefix (e.g., summarizing, Http_client.http_get ->
+    Http_user_agent.get)
+  * ported to ocaml 3.08
+  * debian/control
+    - bumped standards version to 3.6.1.1
+    - changed deps to ocaml 3.08 and -nox
+
+ -- Stefano Zacchiroli <zack@debian.org>  Thu,  5 Aug 2004 15:06:49 +0200
+
+ocaml-http (0.0.9) unstable; urgency=low
+
+  * Added support for HTTP Basic authentication
+  * Restyled Http_daemon API so that correct invocations of them are
+    statically typechecked
+  * Added support for HEAD requests to Http_client
+  * ~addr parameter now support not only ip addresses but also hostnames
+  * debian/control
+    - bumped Standards-Version to 3.6.1.0
+  * debian/rules
+    - moved debhelper compatibility level to debian/compat
+
+ -- Stefano Zacchiroli <zack@debian.org>  Tue, 16 Dec 2003 18:01:41 +0100
+
+ocaml-http (0.0.8) unstable; urgency=low
+
+  * Added support for "ancient" HTTP requests which specify no HTTP
+    version
+    - 'version' method on message now has type 'version option'
+  * Http_daemon now use debugging prints from Http_common like other
+    modules
+  * Added debugging print of requests parse error
+  * Shutdown server socket on abnormal exit (actually: uncaught
+    exceptions or SIGTERM received)
+  * Added a lot of ocamldoc documentation
+  * Added minimal HTTP 1.0/1.1 client support
+
+ -- Stefano Zacchiroli <zack@debian.org>  Fri, 10 Jan 2003 10:36:53 +0100
+
+ocaml-http (0.0.7) unstable; urgency=low
+
+  * Added support for POST requests
+  * Implemented a commont 'message' class from which 'request' and
+    'response' inherit
+  * Changed constructor of 'request' objects, requests are now buildable
+    directly (and only) from an input channel
+  * Added client IP address information to Http_request.request class
+  * Added OO daemon interfaces ("daemon" and "connection" classes)
+  * Use Pcre to perform sanity test on headers instead of home made
+    parsing
+  * Callback functions can raise Http_types.Quit to have main daemon
+    quit
+  * Case-insensitive handling of header names
+
+ -- Stefano Zacchiroli <zack@debian.org>  Wed, 25 Dec 2002 16:22:31 +0100
+
+ocaml-http (0.0.6) unstable; urgency=low
+
+  * Ship multithreaded and non multithreaded cm{x,}aS
+  * Added support for multiple binding of the same parameter in request
+    objects (new method 'paramAll')
+  * Added support for 'empty' bindings in query arguments (e.g.
+    "/foo?b=" or "/foo?b")
+  * Added some sanity checks
+  * Bumped Standards-Version to 3.5.8
+  * Use versioned dependencies lib{pcre,ocamlnet}-ocaml-dev-<version>
+  * Added 'Provides libhttp-ocaml-dev-<version>'
+  * Removed GPL from debian/copyright, added reference to
+    /usr/share/common-licenses/GPL
+
+ -- Stefano Zacchiroli <zack@debian.org>  Mon, 25 Nov 2002 11:04:49 +0100
+
+ocaml-http (0.0.5) unstable; urgency=low
+
+  * Fixed bug for HTTP encoded GET parameters which contain '?' or '&'
+    characters
+  * Added support for chdir in a given document root before starting
+  * Added support for multi threaded daemons
+  * Added a generic 'Http_daemon.respond' function
+  * Added 'toString' method to response objects
+
+ -- Stefano Zacchiroli <zack@debian.org>  Fri, 22 Nov 2002 11:29:37 +0100
+
+ocaml-http (0.0.3) unstable; urgency=low
+
+  * First release.
+
+ -- Stefano Zacchiroli <zack@debian.org>  Sun, 17 Nov 2002 17:41:41 +0100
diff --git a/0.1.4-2/debian/compat b/0.1.4-2/debian/compat
new file mode 100644 (file)
index 0000000..7ed6ff8
--- /dev/null
@@ -0,0 +1 @@
+5
diff --git a/0.1.4-2/debian/control b/0.1.4-2/debian/control
new file mode 100644 (file)
index 0000000..7852467
--- /dev/null
@@ -0,0 +1,23 @@
+Source: ocaml-http
+Section: devel
+Priority: optional
+Maintainer: Stefano Zacchiroli <zack@debian.org>
+Build-Depends: debhelper (>> 5.0.0), cdbs, ocaml-nox (>= 3.10.0), camlp4 (>= 3.10.0), ocaml-findlib (>= 1.1), libpcre-ocaml-dev (>= 5.11.1), libocamlnet-ocaml-dev (>= 2.2)
+Standards-Version: 3.7.2
+
+Package: libhttp-ocaml-dev
+Architecture: any
+Depends: ocaml-nox-${F:OCamlABI}, libpcre-ocaml-dev (>= 5.11.1), libocamlnet-ocaml-dev (>= 2.2)
+Description: OCaml library for writing HTTP servers
+ OCaml HTTP is a library for the Objective Caml programming language,
+ used to build simple HTTP servers, largely inspired to Perl's
+ HTTP::Daemon module.
+ .
+ In order to implement an HTTP servers the programmer has to provide a
+ daemon specification which contains, among other parameters, a callback
+ function invoked by OCaml HTTP on well formed HTTP requests received.
+ HTTP responses could be sent over an out_channel connected with client
+ socket, accessible from the callback.
+ .
+ The library contains also facility functions that helps in creating
+ well formed HTTP responses and a tiny HTTP client.
diff --git a/0.1.4-2/debian/copyright b/0.1.4-2/debian/copyright
new file mode 100644 (file)
index 0000000..38cb08c
--- /dev/null
@@ -0,0 +1,15 @@
+
+Author: Stefano Zacchiroli <zack@cs.unibo.it>
+
+Copyright:
+
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  OCaml HTTP is distributed under the term of the GNU Library General
+  Public License version 2, on Debian systems you can find a copy of the
+  license in:
+
+    /usr/share/common-licenses/LGPL-2
+
diff --git a/0.1.4-2/debian/dirs.in b/0.1.4-2/debian/dirs.in
new file mode 100644 (file)
index 0000000..330aaf4
--- /dev/null
@@ -0,0 +1 @@
+/usr/lib/ocaml/@OCamlABI@
diff --git a/0.1.4-2/debian/examples b/0.1.4-2/debian/examples
new file mode 100644 (file)
index 0000000..6e72ae2
--- /dev/null
@@ -0,0 +1 @@
+examples/*.ml
diff --git a/0.1.4-2/debian/rules b/0.1.4-2/debian/rules
new file mode 100755 (executable)
index 0000000..b86c61d
--- /dev/null
@@ -0,0 +1,12 @@
+#!/usr/bin/make -f
+include /usr/share/cdbs/1/rules/debhelper.mk
+include /usr/share/cdbs/1/class/makefile.mk
+include /usr/share/cdbs/1/class/ocaml.mk
+
+PKGNAME = libhttp-ocaml-dev
+OCAML_OCAMLDOC_PACKAGES = $(OCAML_LIBDEV_PACKAGES)
+DEB_MAKE_BUILD_TARGET = all
+ifeq ($(OCAML_HAVE_OCAMLOPT),yes)
+DEB_MAKE_BUILD_TARGET += opt
+endif
+DEB_MAKE_INSTALL_TARGET = install DESTDIR=$(CURDIR)/debian/$(PKGNAME)$(OCAML_STDLIB_DIR)
diff --git a/0.1.4-2/debian/svn-deblayout b/0.1.4-2/debian/svn-deblayout
new file mode 100644 (file)
index 0000000..24b49c3
--- /dev/null
@@ -0,0 +1 @@
+tagsUrl=svn+ssh://zacchiro@mowgli.cs.unibo.it/local/svn/helm/tags/ocaml-http
diff --git a/0.1.4-2/examples/Makefile b/0.1.4-2/examples/Makefile
new file mode 100644 (file)
index 0000000..9209563
--- /dev/null
@@ -0,0 +1,41 @@
+include ../Makefile.defs
+OBJS_NON_MT = ../http.cma
+OBJS_NON_MT_OPT = ../http.cmxa
+OBJS_MT = ../http_mt.cma
+OBJS_MT_OPT = ../http_mt.cmxa
+EXAMPLES_FLAGS = -I .. -linkpkg
+
+EXAMPLES :=    \
+       always_ok_daemon.ml     \
+       basic_auth.ml           \
+       chdir.ml                \
+       client_address.ml       \
+       damned_recursion.ml     \
+       dump_args.ml            \
+       highlander.ml           \
+       oo_daemon.ml            \
+       threads.ml              \
+       timeout.ml              \
+       webfsd.ml
+EXAMPLES := $(patsubst %.ml,%,$(EXAMPLES))
+
+all: $(EXAMPLES)
+opt: $(patsubst %,%.opt,$(EXAMPLES))
+%: %.ml $(OBJS_NON_MT)
+       $(OCAMLC) $(EXAMPLES_FLAGS) $(OBJS_NON_MT) -o $@ $<
+%.opt: %.ml $(OBJS_NON_MT_OPT)
+       $(OCAMLOPT) $(EXAMPLES_FLAGS) $(OBJS_NON_MT_OPT) -o $@ $<
+
+threads: threads.ml $(OBJS_MT)
+       $(OCAMLC) $(EXAMPLES_FLAGS) $(OBJS_MT) $(THREADS_FLAGS) -o $@ $<
+threads.opt: threads.ml $(OBJS_MT_OPT)
+       $(OCAMLOPT) $(EXAMPLES_FLAGS) $(OBJS_MT_OPT) $(THREADS_FLAGS) -o $@ $<
+
+damned_recursion: damned_recursion.ml $(OBJS_MT)
+       $(OCAMLC) $(EXAMPLES_FLAGS) $(OBJS_MT) $(THREADS_FLAGS) -o $@ $<
+damned_recursion.opt: damned_recursion.ml $(OBJS_MT_OPT)
+       $(OCAMLOPT) $(EXAMPLES_FLAGS) $(OBJS_MT_OPT) $(THREADS_FLAGS) -o $@ $<
+
+distclean: clean
+clean:
+       -rm -f *.cm[ioax] *.o $(EXAMPLES) $(patsubst %,%.opt,$(EXAMPLES))
diff --git a/0.1.4-2/examples/always_ok_daemon.ml b/0.1.4-2/examples/always_ok_daemon.ml
new file mode 100644 (file)
index 0000000..caa0d45
--- /dev/null
@@ -0,0 +1,33 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2004> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 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 General Public License for more details.
+
+  You should have received a copy of the GNU 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
+*)
+
+open Http_types
+
+  (* start an http daemon that alway respond with a 200 status code and an empty
+  content *)
+let spec =
+  { Http_daemon.default_spec with
+      callback = (fun _ outchan -> Http_daemon.respond outchan);
+      port = 9999;
+  }
+
+let _ = Http_daemon.main spec
+
diff --git a/0.1.4-2/examples/basic_auth.ml b/0.1.4-2/examples/basic_auth.ml
new file mode 100644 (file)
index 0000000..bdfb2b9
--- /dev/null
@@ -0,0 +1,50 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2004> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 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 General Public License for more details.
+
+  You should have received a copy of the GNU 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
+*)
+
+open Http_types
+
+(* the easy way: specify authentication requirements within a daemon_spec *)
+let spec =
+  { Http_daemon.default_spec with
+        (* requires basic authentication, username "foo", password "bar" *)
+      auth = Some ("my realm", `Basic ("foo", "bar"));
+      callback = (fun _ outchan -> Http_daemon.respond ~body:"secret" outchan);
+      port = 9999;
+  }
+
+(*
+(* the hard^Wother way: manual handling of authorization *)
+let callback req outchan =
+  match req#authorization with
+  | Some (`Basic (username, password))
+    when username = "foo" && password = "bar" ->
+      Http_daemon.respond ~code:(`Code 200) ~body:"secret" outchan
+  | _ -> raise (Unauthorized "my secret site")
+
+let spec =
+  { Http_daemon.default_spec with
+      callback = callback;
+      port = 9999;
+  }
+*)
+
+let _ = Http_daemon.main spec
+
diff --git a/0.1.4-2/examples/chdir.ml b/0.1.4-2/examples/chdir.ml
new file mode 100644 (file)
index 0000000..bcba1eb
--- /dev/null
@@ -0,0 +1,34 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2004> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 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 General Public License for more details.
+
+  You should have received a copy of the GNU 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
+*)
+
+open Printf
+open Http_types
+
+let spec =
+  { Http_daemon.default_spec with
+      callback = (fun _ outchan ->
+        Http_daemon.respond ~body:(sprintf "%s\n" (Sys.getcwd ())) outchan);
+      port = 9999;
+      root_dir = Some "/etc";
+  }
+
+let _ = Http_daemon.main spec
+
diff --git a/0.1.4-2/examples/client_address.ml b/0.1.4-2/examples/client_address.ml
new file mode 100644 (file)
index 0000000..79d4ff8
--- /dev/null
@@ -0,0 +1,42 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2004> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 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 General Public License for more details.
+
+  You should have received a copy of the GNU 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
+*)
+
+open Printf
+open Http_types
+
+let callback req outchan =
+  let body =
+    sprintf
+      "Hi, this is your personal assistant, you are connected from %s:%d\n"
+      req#clientAddr
+      req#clientPort
+  in
+  let res = new Http_response.response ~body () in
+  Http_daemon.respond_with res outchan
+
+let spec =
+  { Http_daemon.default_spec with
+      callback = callback;
+      port = 9999
+  }
+
+let _ = Http_daemon.main spec
+
diff --git a/0.1.4-2/examples/damned_recursion.ml b/0.1.4-2/examples/damned_recursion.ml
new file mode 100644 (file)
index 0000000..be2e306
--- /dev/null
@@ -0,0 +1,51 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2004> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 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 General Public License for more details.
+
+  You should have received a copy of the GNU 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
+*)
+
+open Printf
+open Http_types
+
+let port = 9999
+
+let callback (req: Http_types.request) outchan =
+  let i = int_of_string (req#param "x") in
+  let body =
+    match i with
+    | 0 -> "0"
+    | x when x > 0 ->
+       let data =
+          Http_user_agent.get (sprintf "http://127.0.0.1:%d/foo?x=%d"
+                                port (x - 1))
+       in
+       sprintf "%s %d" data x
+    | _ -> assert false
+  in
+  Http_daemon.respond ~code:(`Code 200) ~body outchan;
+  close_out outchan  (* Http_user_agent relies on EOF, not Content-Length *)
+
+let spec =
+  { Http_daemon.default_spec with
+      callback = callback;
+      port = port;
+      mode = `Thread;
+  }
+
+let _ = Http_daemon.main spec
+
diff --git a/0.1.4-2/examples/dump_args.ml b/0.1.4-2/examples/dump_args.ml
new file mode 100644 (file)
index 0000000..e8a66a5
--- /dev/null
@@ -0,0 +1,57 @@
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2007> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 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 General Public License for more details.
+
+  You should have received a copy of the GNU 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
+*)
+
+open Printf
+open Http_types
+
+let callback req outchan =
+  let str = 
+    (sprintf "request path = %s\n"  req#path) ^
+    (sprintf "request GET params = %s\n"
+      (String.concat ";"
+        (List.map (fun (h,v) -> String.concat "=" [h;v]) req#params_GET))) ^
+    (sprintf "request POST params = %s\n"
+      (String.concat ";"
+        (List.map (fun (h,v) -> String.concat "=" [h;v]) req#params_POST))) ^
+    (sprintf "request ALL params = %s\n"
+      (String.concat ";"
+        (List.map (fun (h,v) -> String.concat "=" [h;v]) req#params))) ^
+    (sprintf "cookies = %s\n"
+      (match req#cookies with
+      | None ->
+          "NO COOKIES "
+          ^ (if req#hasHeader ~name:"cookie"
+             then "('Cookie:' header was '" ^ req#header ~name:"cookie" ^ "')"
+             else "(No 'Cookie:' header received)")
+      | Some cookies ->
+          (String.concat ";"
+            (List.map (fun (n,v) -> String.concat "=" [n;v]) cookies)))) ^
+    (sprintf "request BODY = '%s'\n\n" req#body)
+  in
+  Http_daemon.respond ~code:(`Code 200) ~body: str outchan
+
+let spec =
+  { Http_daemon.default_spec with
+      callback = callback;
+      port = 9999;
+  }
+
+let _ = Http_daemon.main spec
+
diff --git a/0.1.4-2/examples/highlander.ml b/0.1.4-2/examples/highlander.ml
new file mode 100644 (file)
index 0000000..d424454
--- /dev/null
@@ -0,0 +1,41 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2004> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 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 General Public License for more details.
+
+  You should have received a copy of the GNU 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
+*)
+
+(* test for fast rebinding of the tcp port *)
+
+open Printf
+open Http_types
+
+let spec =
+  { Http_daemon.default_spec with
+      callback = (fun _ outchan -> Http_daemon.respond ~body:"foo" outchan);
+      port = 9999;
+      mode = `Single;
+  }
+
+let _ =
+  Sys.catch_break true;
+  while true do
+    try
+      Http_daemon.main spec;
+    with Sys.Break -> prerr_endline "RESURRECTION!!!!"
+  done
+
diff --git a/0.1.4-2/examples/oo_daemon.ml b/0.1.4-2/examples/oo_daemon.ml
new file mode 100644 (file)
index 0000000..91197e3
--- /dev/null
@@ -0,0 +1,47 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2004> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 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 General Public License for more details.
+
+  You should have received a copy of the GNU 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
+*)
+
+open Http_daemon
+open Http_response
+
+  (* the simple way *)
+let d = new daemon ~addr:"127.0.0.1" ~port:9999 ()
+
+let _ =
+  while true do
+    let (req, conn) = d#getRequest in (* wait for valid request *)
+    conn#respond_with (new response ~body:"foo\n" ());
+    conn#close
+  done
+
+(*
+  (* the hard^Wother way *)
+let d = new daemon ~addr:"127.0.0.1" ~port:9999 () in
+let _ =
+  while true do
+    let conn = d#accept in (* wait for client connection *)
+    (match conn#getRequest with
+    | None -> ()  (* invalid request received *)
+    | Some req -> conn#respond_with (new response ~body:"foo\n" ()));
+    conn#close (* close socket *)
+  done
+*)
+
diff --git a/0.1.4-2/examples/threads.ml b/0.1.4-2/examples/threads.ml
new file mode 100644 (file)
index 0000000..01f6dae
--- /dev/null
@@ -0,0 +1,63 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2004> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 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 General Public License for more details.
+
+  You should have received a copy of the GNU 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
+*)
+
+open Http_types
+
+let m = Mutex.create ()
+let m_locked = ref true
+
+let critical f =
+  Mutex.lock m;
+    m_locked := true;
+    Lazy.force f;
+    m_locked := false;
+  Mutex.unlock m
+
+  (** ocaml's Thread.unlock suspend the invoking process if the mutex is already
+  * unlocked, therefore we unlock it only if we know that it's currently locked
+  *)
+let safe_unlock _ _ = if !m_locked then Mutex.unlock m
+
+let i = ref 10
+let dump_i outchan =
+  Http_daemon.respond ~body:(Printf.sprintf "i = %d\n" !i) outchan
+
+let callback req outchan =
+  match req#path with
+  | "/incr" -> critical (lazy (incr i; dump_i outchan; Unix.sleep 5))
+  | "/decr" -> critical (lazy (decr i; dump_i outchan; Unix.sleep 5))
+  | "/get"  -> critical (lazy (dump_i outchan))
+  | bad_request -> Http_daemon.respond_error outchan
+
+let spec =
+  { Http_daemon.default_spec with
+      port = 9999;
+      mode = `Thread;
+      callback = callback;
+      exn_handler = Some safe_unlock;
+        (** ocaml-http's default exn_handler is Pervasives.ignore. This means
+        * that threads holding the "m" mutex above may die without unlocking it.
+        * Using safe_unlock as an exception handler we ensure that "m" mutex is
+        * unlocked in case of exceptions (e.g. SIGPIPE) *)
+  }
+
+let _ = Http_daemon.main spec
+
diff --git a/0.1.4-2/examples/timeout.ml b/0.1.4-2/examples/timeout.ml
new file mode 100644 (file)
index 0000000..d39f6be
--- /dev/null
@@ -0,0 +1,31 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2004> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 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 General Public License for more details.
+
+  You should have received a copy of the GNU 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
+*)
+
+open Http_types
+
+let spec =
+  { Http_daemon.default_spec with
+      callback = (fun _ outchan -> Http_daemon.respond ~body:"foo" outchan);
+      timeout = Some 10;
+  }
+
+let _ = Http_daemon.main spec
+
diff --git a/0.1.4-2/examples/webfsd.ml b/0.1.4-2/examples/webfsd.ml
new file mode 100644 (file)
index 0000000..c7a984b
--- /dev/null
@@ -0,0 +1,50 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2004> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 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 General Public License for more details.
+
+  You should have received a copy of the GNU 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
+*)
+
+open Http_types
+
+let def_port = 80
+let def_addr = "0.0.0.0"
+let def_root = Sys.getcwd ()
+
+let port = ref def_port
+let addr = ref def_addr
+let root = ref def_root
+let argspec =
+  [ "-p", Arg.Int (fun p -> port := p),
+      "TCP port on which listen, default: " ^ string_of_int !port;
+    "-a", Arg.String (fun a -> addr := a),
+      "IP address on which listen, default: " ^ !addr;
+    "-r", Arg.String (fun r -> root := r),
+      "DocumentRoot, default: current working directory";
+  ]
+
+let _ =
+  Arg.parse argspec (fun _ -> ()) "";
+  let spec =
+    { Http_daemon.default_spec with
+        address = !addr;
+        port = !port;
+        root_dir = Some !root
+    }
+  in
+  Http_daemon.Trivial.main spec
+
diff --git a/0.1.4-2/http_common.ml b/0.1.4-2/http_common.ml
new file mode 100644 (file)
index 0000000..affbdb2
--- /dev/null
@@ -0,0 +1,162 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library 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
+*)
+
+open Http_types;;
+open Printf;;
+
+let debug = ref false
+let debug_print s =
+  if !debug then
+    prerr_endline (sprintf "[OCaml HTTP] DEBUG: %s" s)
+
+let http_version = Http_constants.version
+let server_string = Http_constants.server_string
+
+let string_of_version = function
+  | `HTTP_1_0 -> "HTTP/1.0"
+  | `HTTP_1_1 -> "HTTP/1.1"
+
+let version_of_string = function
+  | "HTTP/1.0" -> `HTTP_1_0
+  | "HTTP/1.1" -> `HTTP_1_1
+  | invalid_version -> raise (Invalid_HTTP_version invalid_version)
+
+let string_of_method = function
+  | `GET -> "GET"
+  | `POST -> "POST"
+
+let method_of_string = function
+  | "GET" -> `GET
+  | "POST" -> `POST
+  | invalid_method -> raise (Invalid_HTTP_method invalid_method)
+
+let status_of_code = function
+  | 100 -> `Informational `Continue
+  | 101 -> `Informational `Switching_protocols
+  | 200 -> `Success `OK
+  | 201 -> `Success `Created
+  | 202 -> `Success `Accepted
+  | 203 -> `Success `Non_authoritative_information
+  | 204 -> `Success `No_content
+  | 205 -> `Success `Reset_content
+  | 206 -> `Success `Partial_content
+  | 300 -> `Redirection `Multiple_choices
+  | 301 -> `Redirection `Moved_permanently
+  | 302 -> `Redirection `Found
+  | 303 -> `Redirection `See_other
+  | 304 -> `Redirection `Not_modified
+  | 305 -> `Redirection `Use_proxy
+  | 307 -> `Redirection `Temporary_redirect
+  | 400 -> `Client_error `Bad_request
+  | 401 -> `Client_error `Unauthorized
+  | 402 -> `Client_error `Payment_required
+  | 403 -> `Client_error `Forbidden
+  | 404 -> `Client_error `Not_found
+  | 405 -> `Client_error `Method_not_allowed
+  | 406 -> `Client_error `Not_acceptable
+  | 407 -> `Client_error `Proxy_authentication_required
+  | 408 -> `Client_error `Request_time_out
+  | 409 -> `Client_error `Conflict
+  | 410 -> `Client_error `Gone
+  | 411 -> `Client_error `Length_required
+  | 412 -> `Client_error `Precondition_failed
+  | 413 -> `Client_error `Request_entity_too_large
+  | 414 -> `Client_error `Request_URI_too_large
+  | 415 -> `Client_error `Unsupported_media_type
+  | 416 -> `Client_error `Requested_range_not_satisfiable
+  | 417 -> `Client_error `Expectation_failed
+  | 500 -> `Server_error `Internal_server_error
+  | 501 -> `Server_error `Not_implemented
+  | 502 -> `Server_error `Bad_gateway
+  | 503 -> `Server_error `Service_unavailable
+  | 504 -> `Server_error `Gateway_time_out
+  | 505 -> `Server_error `HTTP_version_not_supported
+  | invalid_code -> raise (Invalid_code invalid_code)
+
+let code_of_status = function
+  | `Informational `Continue -> 100
+  | `Informational `Switching_protocols -> 101
+  | `Success `OK -> 200
+  | `Success `Created -> 201
+  | `Success `Accepted -> 202
+  | `Success `Non_authoritative_information -> 203
+  | `Success `No_content -> 204
+  | `Success `Reset_content -> 205
+  | `Success `Partial_content -> 206
+  | `Redirection `Multiple_choices -> 300
+  | `Redirection `Moved_permanently -> 301
+  | `Redirection `Found -> 302
+  | `Redirection `See_other -> 303
+  | `Redirection `Not_modified -> 304
+  | `Redirection `Use_proxy -> 305
+  | `Redirection `Temporary_redirect -> 307
+  | `Client_error `Bad_request -> 400
+  | `Client_error `Unauthorized -> 401
+  | `Client_error `Payment_required -> 402
+  | `Client_error `Forbidden -> 403
+  | `Client_error `Not_found -> 404
+  | `Client_error `Method_not_allowed -> 405
+  | `Client_error `Not_acceptable -> 406
+  | `Client_error `Proxy_authentication_required -> 407
+  | `Client_error `Request_time_out -> 408
+  | `Client_error `Conflict -> 409
+  | `Client_error `Gone -> 410
+  | `Client_error `Length_required -> 411
+  | `Client_error `Precondition_failed -> 412
+  | `Client_error `Request_entity_too_large -> 413
+  | `Client_error `Request_URI_too_large -> 414
+  | `Client_error `Unsupported_media_type -> 415
+  | `Client_error `Requested_range_not_satisfiable -> 416
+  | `Client_error `Expectation_failed -> 417
+  | `Server_error `Internal_server_error -> 500
+  | `Server_error `Not_implemented -> 501
+  | `Server_error `Bad_gateway -> 502
+  | `Server_error `Service_unavailable -> 503
+  | `Server_error `Gateway_time_out -> 504
+  | `Server_error `HTTP_version_not_supported -> 505
+
+let is_informational code =
+  match status_of_code code with
+  | `Informational _ -> true
+  | _ -> false
+
+let is_success code =
+  match status_of_code code with
+  | `Success _ -> true
+  | _ -> false
+
+let is_redirection code =
+  match status_of_code code with
+  | `Redirection _ -> true
+  | _ -> false
+
+let is_client_error code =
+  match status_of_code code with
+  | `Client_error _ -> true
+  | _ -> false
+
+let is_server_error code =
+  match status_of_code code with
+  | `Server_error _ -> true
+  | _ -> false
+
+let is_error code = is_client_error code || is_server_error code
+
diff --git a/0.1.4-2/http_common.mli b/0.1.4-2/http_common.mli
new file mode 100644 (file)
index 0000000..6029a70
--- /dev/null
@@ -0,0 +1,80 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library 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
+*)
+
+(** Common functionalities shared by other OCaml HTTP modules *)
+
+open Http_types;;
+
+  (** whether debugging messages are enabled or not, can be changed at runtime
+  *)
+val debug: bool ref
+
+  (** print a string on stderr only if debugging is enabled *)
+val debug_print: string -> unit
+
+  (** see {!Http_constants.version} *)
+val http_version: version
+
+  (** see {!Http_constants.server_string} *)
+val server_string: string
+
+  (** pretty print an HTTP version *)
+val string_of_version: version -> string
+
+  (** parse an HTTP version from a string
+  @raise Invalid_HTTP_version if given string doesn't represent a supported HTTP
+  version *)
+val version_of_string: string -> version
+
+  (** pretty print an HTTP method *)
+val string_of_method: meth -> string
+
+  (** parse an HTTP method from a string
+  @raise Invalid_HTTP_method if given string doesn't represent a supported
+  method *)
+val method_of_string: string -> meth
+
+  (** converts an integer HTTP status to the corresponding status value
+  @raise Invalid_code if given integer isn't a valid HTTP status code *)
+val status_of_code: int -> status
+
+  (** converts an HTTP status to the corresponding integer value *)
+val code_of_status: [< status] -> int
+
+  (** @return true on "informational" status codes, false elsewhere *)
+val is_informational: int -> bool
+
+  (** @return true on "success" status codes, false elsewhere *)
+val is_success: int -> bool
+
+  (** @return true on "redirection" status codes, false elsewhere *)
+val is_redirection: int -> bool
+
+  (** @return true on "client error" status codes, false elsewhere *)
+val is_client_error: int -> bool
+
+  (** @return true on "server error" status codes, false elsewhere *)
+val is_server_error: int -> bool
+
+  (** @return true on "client error" and "server error" status code, false
+  elsewhere *)
+val is_error: int -> bool
+
diff --git a/0.1.4-2/http_constants.ml b/0.1.4-2/http_constants.ml
new file mode 100644 (file)
index 0000000..f45829d
--- /dev/null
@@ -0,0 +1,36 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library 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
+*)
+
+let version = `HTTP_1_1 ;;
+let server_string = "OCaml HTTP Daemon" ;;
+let crlf = "\r\n" ;;
+
+let default_addr = "0.0.0.0"
+let default_auth = None
+let default_auto_close = false
+let default_callback = fun _ _ -> ()
+let default_mode = `Fork
+let default_port = 80
+let default_root_dir = None
+let default_exn_handler = Some (fun exn outchan -> ())
+let default_timeout = Some 300
+
+
diff --git a/0.1.4-2/http_constants.mli b/0.1.4-2/http_constants.mli
new file mode 100644 (file)
index 0000000..03d2ee4
--- /dev/null
@@ -0,0 +1,44 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library 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
+*)
+
+(** Constants *)
+
+  (** default HTTP version *)
+val version: Http_types.version
+
+  (** string returned as value of "Server:" response header *)
+val server_string: string
+
+  (** "\r\n" string *)
+val crlf: string
+
+  (** {2 daemon default values} *)
+
+val default_addr: string
+val default_auth: (string * Http_types.auth_info) option
+val default_auto_close: bool
+val default_callback: Http_types.request -> out_channel -> unit
+val default_mode: Http_types.daemon_mode
+val default_port: int
+val default_root_dir: string option
+val default_exn_handler: (exn -> out_channel -> unit) option
+val default_timeout: int option
+
diff --git a/0.1.4-2/http_daemon.ml b/0.1.4-2/http_daemon.ml
new file mode 100644 (file)
index 0000000..f7c8495
--- /dev/null
@@ -0,0 +1,474 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library 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
+*)
+
+open Printf
+
+open Http_common
+open Http_types
+open Http_constants
+open Http_parser
+
+exception Http_daemon_failure of string
+
+  (** send raw data on outchan, flushing it afterwards *)
+let send_raw ~data outchan =
+  output_string outchan data;
+  flush outchan
+
+let send_CRLF = send_raw ~data:crlf
+
+let send_header ~header ~value =
+  let header = String.lowercase header in
+  Http_parser_sanity.heal_header (header, value);
+  send_raw ~data:(header ^ ": " ^ value ^ crlf)
+
+let send_headers ~headers outchan =
+  List.iter (fun (header, value) -> send_header ~header ~value outchan) headers
+
+  (** internal: low level for send_status_line *)
+let send_status_line' ~version code =
+  let status_line =
+    String.concat
+      " "
+      [ string_of_version version;
+      string_of_int code;
+      Http_misc.reason_phrase_of_code code ]
+  in
+  send_raw ~data:(status_line ^ crlf)
+
+let int_of_code = function
+  | `Code code -> code
+  | `Status status -> code_of_status status
+
+let send_status_line ?(version = http_version) ~(code: status_code) outchan =
+  send_status_line' ~version (int_of_code code) outchan
+
+  (* FIXME duplication of code between this and response#addBasicHeaders *)
+let send_basic_headers ?(version = http_version) ~(code: status_code) outchan =
+  send_status_line' ~version (int_of_code code) outchan;
+  send_headers
+    ~headers:["Date", Http_misc.date_822 (); "Server", server_string]
+    outchan
+
+  (** internal: given a status code and an additional body return a string
+  representing an HTML document that explains the meaning of given status code.
+  Additional data can be added to the body via 'body' argument *)
+let foo_body code body =
+  let reason_phrase = Http_misc.reason_phrase_of_code code in
+  sprintf
+"<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">
+<HTML><HEAD>
+<TITLE>%d %s</TITLE>
+</HEAD><BODY>
+<H1>%d - %s</H1>%s
+</BODY></HTML>"
+    code reason_phrase code reason_phrase body
+
+  (** internal: send a fooish body explaining in HTML form the 'reason phrase'
+  of an HTTP response; body, if given, will be appended to the body *)
+let send_foo_body code body = send_raw ~data:(foo_body code body)
+
+  (* Warning: keep default values in sync with Http_response.response class *)
+let respond ?(body = "") ?(headers = []) ?version ?(code = `Code 200) outchan =
+  send_basic_headers ?version ~code outchan;
+  send_headers ~headers outchan;
+  send_header "Content-Length" (string_of_int (String.length body)) outchan;
+  send_CRLF outchan;
+  send_raw ~data:body outchan
+
+  (** internal: low level for respond_redirect, respond_error, ...
+  This function send a status line corresponding to a given code, some basic
+  headers, the additional headers (if given) and an HTML page containing the
+  reason phrase; if body is given it will be included in the body of the HTML
+  page *)
+let send_empty_response
+  func_name ?(is_valid_status = fun _ -> true) ?(headers=[]) ?(body="") () =
+    fun ?version code outchan ->
+      if not (is_valid_status (int_of_code code)) then
+        failwith
+          (sprintf "'%d' isn't a valid status code for %s"
+            (int_of_code code) func_name)
+      else begin  (* status code suitable for answering *)
+        let headers =
+          [ "Content-Type", "text/html; charset=iso-8859-1" ] @ headers
+        in
+        let body = (foo_body (int_of_code code) body) ^ body in
+        respond ?version ~code ~headers ~body outchan
+      end
+
+let respond_redirect
+  ~location ?body ?version ?(code = `Code 301) outchan
+  =
+  send_empty_response "Daemon.respond_redirect" ~is_valid_status:is_redirection
+    ~headers:["Location", location] ?body () ?version code outchan
+
+let respond_error ?body ?version ?(code = `Code 400) outchan =
+  send_empty_response "Daemon.respond_error" ~is_valid_status:is_error
+    ?body () ?version code outchan
+
+let respond_not_found ~url ?version outchan =
+  send_empty_response "Daemon.respond_not_found" () ?version (`Code 404) outchan
+
+let respond_forbidden ~url ?version outchan =
+  send_empty_response "Daemon.respond_permission_denied" () ?version
+  (`Code 403) outchan
+
+let respond_unauthorized ?version ?(realm = server_string) outchan =
+  let body =
+    sprintf "401 - Unauthorized - Authentication failed for realm \"%s\"" realm
+  in
+  respond ~headers:["WWW-Authenticate", sprintf "Basic realm=\"%s\"" realm]
+    ~code:(`Code 401) ~body outchan
+
+let send_file ~src outchan =
+  let buflen = 1024 in
+  let buf = String.make buflen ' ' in
+
+  let (file, cleanup) =
+    match src with
+    | FileSrc fname -> (* if we open the file, we close it before returning *)
+        let f = open_in fname in
+        f, (fun () -> close_in f)
+    | InChanSrc inchan -> inchan, ignore
+  in
+  try
+    while true do
+      let bytes = input file buf 0 buflen in
+      if bytes = 0 then
+        raise End_of_file
+      else
+        output outchan buf 0 bytes
+    done;
+    assert false
+  with End_of_file ->
+    begin
+      flush outchan;
+      cleanup ()
+    end
+
+  (* TODO interface is too ugly to advertise this function in .mli *)
+  (** create a minimal HTML directory listing of a given directory and send it
+  over an out_channel, directory is passed as a dir_handle; name is the
+  directory name, used for pretty printing purposes; path is the opened dir
+  path, used to test its contents with stat *)
+let send_dir_listing ~dir ~name ~path outchan =
+  fprintf outchan "<html>\n<head><title>%s</title></head>\n<body>\n" name;
+  let (dirs, files) =
+    List.partition (fun e -> Http_misc.is_directory (path ^ e)) (Http_misc.ls dir)
+  in
+  List.iter
+    (fun d -> fprintf outchan "<a href=\"%s/\">%s/</a><br />\n" d d)
+    (List.sort compare dirs);
+  List.iter
+    (fun f -> fprintf outchan "<a href=\"%s\">%s</a><br />\n" f f)
+    (List.sort compare files);
+  fprintf outchan "</body>\n</html>";
+  flush outchan
+
+let respond_file ~fname ?(version = http_version) outchan =
+  (** ASSUMPTION: 'fname' doesn't begin with a "/"; it's relative to the current
+  document root (usually the daemon's cwd) *)
+  let droot = Sys.getcwd () in  (* document root *)
+  let path = droot ^ "/" ^ fname in (* full path to the desired file *)
+  if not (Sys.file_exists path) then (* file not found *)
+    respond_not_found ~url:fname outchan
+  else begin
+    try
+      if Http_misc.is_directory path then begin (* file found, is a dir *)
+        let dir = Unix.opendir path in
+        send_basic_headers ~version ~code:(`Code 200) outchan;
+        send_header "Content-Type" "text/html" outchan;
+        send_CRLF outchan;
+        send_dir_listing ~dir ~name:fname ~path outchan;
+        Unix.closedir dir
+      end else begin  (* file found, is something else *)
+        let file = open_in fname in
+        send_basic_headers ~version ~code:(`Code 200) outchan;
+        send_header
+          ~header:"Content-Length"
+          ~value:(string_of_int (Http_misc.filesize fname))
+          outchan;
+        send_CRLF outchan;
+        send_file ~src:(InChanSrc file) outchan;
+        close_in file
+      end
+    with
+    | Unix.Unix_error (Unix.EACCES, _, _)
+    | Sys_error _ ->
+        respond_forbidden ~url:fname ~version outchan
+  end
+
+let respond_with (res: Http_types.response) outchan =
+  res#serialize outchan;
+  flush outchan
+
+  (** internal: this exception is raised after a malformed request has been read
+  by a serving process to signal main server (or itself if mode = `Single) to
+  skip to next request *)
+exception Again;;
+
+let pp_parse_exc e =
+  sprintf "HTTP request parse error: %s" (Printexc.to_string e)
+
+  (* given a Http_parser.parse_request like function, wrap it in a function that
+  do the same and additionally catch parsing exception sending HTTP error
+  messages back to client as needed. Returned function raises Again when it
+  encounter a parse error (name 'Again' is intended for future versions that
+  will support http keep alive signaling that a new request has to be parsed
+  from client) *)
+let rec wrap_parse_request_w_safety parse_function inchan outchan =
+  (try
+    parse_function inchan
+  with
+  | (Malformed_request req) as e ->
+      debug_print (pp_parse_exc e);
+      respond_error ~code:(`Code 400)
+        ~body:("request 1st line format should be: " ^
+               "'&lt;method&gt; &lt;url&gt; &lt;version&gt;'" ^
+               "<br />\nwhile received request 1st line was:<br />\n" ^ req)
+        outchan;
+      raise Again
+  | (Invalid_HTTP_method meth) as e ->
+      debug_print (pp_parse_exc e);
+      respond_error ~code:(`Code 501)
+        ~body:("Method '" ^ meth ^ "' isn't supported (yet)")
+        outchan;
+      raise Again
+  | (Malformed_request_URI uri) as e ->
+      debug_print (pp_parse_exc e);
+      respond_error ~code:(`Code 400) ~body:("Malformed URL: '" ^ uri ^ "'")
+        outchan;
+      raise Again
+  | (Invalid_HTTP_version version) as e ->
+      debug_print (pp_parse_exc e);
+      respond_error ~code:(`Code 505)
+        ~body:("HTTP version '" ^ version ^ "' isn't supported (yet)")
+        outchan;
+      raise Again
+  | (Malformed_query query) as e ->
+      debug_print (pp_parse_exc e);
+      respond_error ~code:(`Code 400)
+        ~body:(sprintf "Malformed query string '%s'" query) outchan;
+      raise Again
+  | (Malformed_query_part (binding, query)) as e ->
+      debug_print (pp_parse_exc e);
+      respond_error ~code:(`Code 400)
+        ~body:(sprintf "Malformed query part '%s' in query '%s'" binding query)
+        outchan;
+      raise Again)
+
+  (* wrapper around Http_parser.parse_request which catch parsing exceptions and
+  return error messages to client as needed
+  @param inchan in_channel from which read incoming requests
+  @param outchan out_channl on which respond with error messages if needed
+  *)
+let safe_parse_request = wrap_parse_request_w_safety parse_request
+
+  (* as above but for OO version (Http_parser.parse_request') *)
+let safe_parse_request' = wrap_parse_request_w_safety (new Http_request.request)
+
+let chdir_to_document_root = function (* chdir to document root *)
+  | Some dir -> Sys.chdir dir
+  | None -> ()
+
+let server_of_mode = function
+  | `Single -> Http_tcp_server.simple
+  | `Fork   -> Http_tcp_server.fork
+  | `Thread -> Http_tcp_server.thread
+
+  (* TODO what happens when a Quit exception is raised by a callback? Do other
+  callbacks keep on living until the end or are them all killed immediatly?
+  The right semantics should obviously be the first one *)
+
+  (** - handle HTTP authentication
+   *  - handle automatic closures of client connections *)
+let invoke_callback req spec outchan =
+  let callback req outchan =
+    if spec.auto_close then
+      Http_misc.finally
+        (fun () ->
+          (* XXX the pair flush + shutdown is a temporary solution since double
+           * close on a socket make ocaml 3.09.2 segfault (see
+           * http://caml.inria.fr/mantis/view.php?id=4059). The right thing to
+           * do is probably invoke try_close outchan here *)
+          flush outchan;
+          try
+            Unix.shutdown (Unix.descr_of_out_channel outchan) Unix.SHUTDOWN_ALL
+          with Unix.Unix_error(_, "shutdown", "") -> ())
+        (fun () -> spec.callback req outchan) ()
+    else
+      spec.callback req outchan in
+  try
+    (match (spec.auth, req#authorization) with
+    | None, _ -> callback req outchan  (* no auth required *)
+    | Some (realm, `Basic (spec_username, spec_password)),
+      Some (`Basic (username, password))
+      when (username = spec_username) && (password = spec_password) ->
+        (* auth ok *)
+        callback req outchan
+    | Some (realm, _), _ -> raise (Unauthorized realm)) (* auth failure *)
+  with
+  | Unauthorized realm -> respond_unauthorized ~realm outchan
+  | Again -> ()
+
+let main spec =
+  chdir_to_document_root spec.root_dir;
+  let sockaddr = Http_misc.build_sockaddr (spec.address, spec.port) in
+  let daemon_callback inchan outchan =
+    let next_req () =
+      try Some (safe_parse_request' inchan outchan)
+      with _ -> None
+    in
+    let rec loop n =
+      match next_req () with
+      | Some req ->
+          debug_print (sprintf "request #%d" n);
+          invoke_callback req spec outchan;
+          flush outchan;
+          loop (n + 1)
+      | None ->
+          debug_print "server exiting";
+          ()
+    in
+    debug_print "server starting";
+    try loop 1
+    with exn ->
+      debug_print (sprintf "uncaught exception: %s" (Printexc.to_string exn));
+      (match spec.exn_handler with
+      | Some f ->
+          debug_print "executing handler";
+          f exn outchan
+      | None ->
+          debug_print "no handler given: re-raising";
+          raise exn)
+  in
+  try
+    (server_of_mode spec.mode) ~sockaddr ~timeout:spec.timeout daemon_callback 
+  with Quit -> ()
+
+module Trivial =
+  struct
+    let heading_slash_RE = Pcre.regexp "^/"
+
+    let trivial_callback req outchan =
+      let path = req#path in
+      if not (Pcre.pmatch ~rex:heading_slash_RE path) then
+        respond_error ~code:(`Code 400) outchan
+      else
+        respond_file ~fname:(Http_misc.strip_heading_slash path) outchan
+
+    let callback = trivial_callback
+
+    let main spec = main { spec with callback = trivial_callback }
+  end
+
+  (** @param inchan input channel connected to client
+     @param outchan output channel connected to client
+     @param sockaddr client socket address *)
+class connection inchan outchan sockaddr =
+  (* ASSUMPTION: inchan and outchan are channels built on top of the same
+  Unix.file_descr thus closing one of them will close also the other *)
+  let close' o = try o#close with Http_daemon_failure _ -> () in
+  object (self)
+
+    initializer Gc.finalise close' self
+
+    val mutable closed = false
+
+    method private assertNotClosed =
+      if closed then
+        raise (Http_daemon_failure
+          "Http_daemon.connection: connection is closed")
+
+    method getRequest =
+      self#assertNotClosed;
+      try
+        Some (safe_parse_request' inchan outchan)
+      with _ -> None
+
+    method respond_with res =
+      self#assertNotClosed;
+      respond_with res outchan
+
+    method close =
+      self#assertNotClosed;
+      close_in inchan;  (* this close also outchan *)
+      closed <- true
+
+  end
+
+class daemon ?(addr = "0.0.0.0") ?(port = 80) () =
+  object (self)
+
+    val suck =
+      Http_tcp_server.init_socket (Http_misc.build_sockaddr (addr, port))
+
+    method accept =
+      let (cli_suck, cli_sockaddr) = Unix.accept suck in  (* may block *)
+      let (inchan, outchan) =
+        (Unix.in_channel_of_descr cli_suck, Unix.out_channel_of_descr cli_suck)
+      in
+      new connection inchan outchan cli_sockaddr
+
+    method getRequest =
+      let conn = self#accept in
+      match conn#getRequest with
+      | None ->
+          conn#close;
+          self#getRequest
+      | Some req -> (req, conn)
+
+  end
+
+open Http_constants
+
+let default_spec = {
+  address = default_addr;
+  auth = default_auth;
+  auto_close = default_auto_close;
+  callback = default_callback;
+  mode = default_mode;
+  port = default_port;
+  root_dir = default_root_dir;
+  exn_handler = default_exn_handler;
+  timeout = default_timeout;
+}
+
+let daemon_spec
+  ?(address = default_addr) ?(auth = default_auth)
+  ?(auto_close = default_auto_close)
+  ?(callback = default_callback) ?(mode = default_mode) ?(port = default_port)
+  ?(root_dir = default_root_dir) ?(exn_handler = default_exn_handler)
+  ?(timeout = default_timeout)
+  ()
+=
+  { default_spec with
+      address = address;
+      auth = auth;
+      auto_close = auto_close;
+      callback = callback;
+      mode = mode;
+      port = port;
+      root_dir = root_dir;
+      exn_handler = exn_handler;
+      timeout = timeout;
+  }
+
diff --git a/0.1.4-2/http_daemon.mli b/0.1.4-2/http_daemon.mli
new file mode 100644 (file)
index 0000000..2b7be19
--- /dev/null
@@ -0,0 +1,186 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library 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
+*)
+
+(** Main OCaml HTTP module.
+    Here you can find two set of functions:
+    - functions which let you start an HTTP Daemon (start* functions)
+    - facility functions which let you sent responses back to clients *)
+
+  (** send a CRLF sequence on the given output channel, this is mandatory after
+  the last header was sent and before start sending the response body *)
+val send_CRLF: out_channel -> unit
+
+  (** send response status line, version is the http version used in response,
+  either code or status must be given (not both, not none) which represent the
+  HTTP response code, outchan is the output channel to which send status line *)
+val send_status_line:
+  ?version:Http_types.version -> code:Http_types.status_code ->
+  out_channel ->
+    unit
+
+  (** like send_status_line but additionally will also send "Date" and "Server"
+  standard headers *)
+val send_basic_headers:
+  ?version: Http_types.version -> code:Http_types.status_code ->
+  out_channel ->
+    unit
+
+  (** send an HTTP header on outchan *)
+val send_header: header: string -> value: string -> out_channel -> unit
+
+  (** as send_header, but for a list of pairs <header, value> *)
+val send_headers: headers:(string * string) list -> out_channel -> unit
+
+(*
+  (** send a file through an out_channel, file can be passed as an in_channel
+  (if 'file' is given) or as a file name (if 'name' is given) *)
+val send_file: ?name:string -> ?file:in_channel -> out_channel -> unit
+*)
+  (** send a file through an out_channel *)
+val send_file: src:Http_types.file_source -> out_channel -> unit
+
+  (** high level response function, respond on outchan sending: basic headers
+  (including Content-Length computed using 'body' argument), headers probided
+  via 'headers' argument, body given via 'body' argument.  Default response
+  status is 200, default response HTTP version is Http_common.http_version *)
+val respond:
+  ?body:string -> ?headers:(string * string) list ->
+  ?version:Http_types.version -> ?code:Http_types.status_code ->
+  out_channel ->
+    unit
+
+  (** send a 404 (not found) HTTP response *)
+val respond_not_found:
+  url:string -> ?version: Http_types.version -> out_channel -> unit
+
+  (** send a 403 (forbidden) HTTP response *)
+val respond_forbidden:
+  url:string -> ?version: Http_types.version -> out_channel -> unit
+
+  (** send a "redirection" class response, optional body argument contains data
+  that will be displayed in the body of the response, default response status is
+  301 (moved permanently), only redirection status are accepted by this
+  function, other values will raise Failure *)
+val respond_redirect:
+  location:string -> ?body:string ->
+  ?version: Http_types.version -> ?code:Http_types.status_code ->
+  out_channel ->
+    unit
+
+  (** respond with a 401 (Unauthorized) response asking for authentication
+  * against given realm (default is the server name) *)
+val respond_unauthorized:
+  ?version: Http_types.version -> ?realm:string -> out_channel -> unit
+
+  (** send an "error" response (i.e. 400 <= status < 600), optional body
+  argument as per send_redirect, default response status is 400 (bad request),
+  only error status are accepted by this function, other values will
+  raise Failure *)
+val respond_error:
+  ?body:string ->
+  ?version: Http_types.version -> ?code:Http_types.status_code ->
+  out_channel ->
+    unit
+
+  (** tipical static pages http daemon behaviour, if requested url is a file,
+  return it, it it is a directory return a directory listing of it *)
+val respond_file:
+  fname:string -> ?version: Http_types.version -> out_channel -> unit
+
+  (** respond using a prebuilt Http_types.response object *)
+val respond_with: Http_types.response -> out_channel -> unit
+
+  (** start an HTTP daemon
+  * @param spec specification of daemon behaviour
+  *)
+val main: Http_types.daemon_spec -> unit
+
+  (** default daemon specification:
+  * - listen on 0.0.0.0, port 80
+  * - "always ok" callback  (return an empty response, response code 200)
+  * - fork a child for each request
+  * - do not change to a root directory (i.e. keep cwd)
+  * - 300 seconds timeout
+  * - ignores exceptions
+  * - no authentication required
+  * - do not automatically close client connections after callback *)
+val default_spec: Http_types.daemon_spec
+
+  (** currified daemon_spec constructor. Each parameter of this function
+    * corresponds to one field of Http_types.daemon_spec and defaults to the
+    * corresponding field of Http_daemon.default_spec *)
+val daemon_spec:
+  ?address:string ->
+  ?auth:(string * Http_types.auth_info) option ->
+  ?auto_close:bool ->
+  ?callback:(Http_types.request -> out_channel -> unit) ->
+  ?mode:(Http_types.daemon_mode) ->
+  ?port:int ->
+  ?root_dir:string option ->
+  ?exn_handler:(exn -> out_channel -> unit) option ->
+  ?timeout:int option ->
+  unit ->
+    Http_types.daemon_spec
+
+(*
+(** XXX
+ * This function has been deprecated for a while. Now it has been removed! *)
+val start:
+  ?addr: string -> ?port: int ->
+  ?timeout: int option -> ?mode: Http_types.daemon_mode -> ?root: string ->
+  (string -> (string * string) list -> out_channel -> unit) ->
+    unit
+*)
+
+(*
+(** XXX
+ * This function has been deprecated for a while. Now it has been removed! *)
+val start':
+  ?addr: string -> ?port: int ->
+  ?timeout: int option -> ?mode: Http_types.daemon_mode -> ?root: string -> 
+  (Http_types.request -> out_channel -> unit) ->
+    unit
+*)
+
+  (** Object oriented interface to HTTP daemons.
+  * @param addr address on which daemon will listen for connections
+  * @param port port which daemon will bind
+  * see {!Http_types.daemon} *)
+class daemon:
+  ?addr: string -> ?port: int ->
+    unit ->
+      Http_types.daemon
+
+  (** Trivial static pages HTTP daemon.
+  * Daemons created using this module will serve directory indexes and files
+  * found starting from the working directory *)
+module Trivial :
+  sig
+      (** callback function, exposed if you like to use it as a basis to define
+      a more powerful daemon *)
+    val callback : Http_types.request -> out_channel -> unit
+
+      (** start the "trivial" HTTP daemon
+      * @param spec trivial HTTP daemon specification, "callback" field is
+      * ignored and set to the callback above *)
+    val main : Http_types.daemon_spec -> unit
+  end
+
diff --git a/0.1.4-2/http_message.ml b/0.1.4-2/http_message.ml
new file mode 100644 (file)
index 0000000..5dc0f04
--- /dev/null
@@ -0,0 +1,118 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library 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
+*)
+
+open Http_common;;
+open Http_constants;;
+open Http_types;;
+open Printf;;
+
+  (* remove all bindings of 'name' from hashtbl 'tbl' *)
+let rec hashtbl_remove_all tbl name =
+  if not (Hashtbl.mem tbl name) then
+    raise (Header_not_found name);
+  Hashtbl.remove tbl name;
+  if Hashtbl.mem tbl name then hashtbl_remove_all tbl name
+;;
+
+class virtual message ~body ~headers ~version ~clisockaddr ~srvsockaddr =
+
+  let ((cliaddr, cliport), (srvaddr, srvport)) =
+    (Http_misc.explode_sockaddr clisockaddr,
+     Http_misc.explode_sockaddr srvsockaddr)
+  in
+
+  object (self)
+
+    val _contentsBuf = Buffer.create 1024
+    val _headers = Hashtbl.create 11
+    val mutable _version: version option = version
+
+    initializer
+      self#setBody body;
+      self#addHeaders headers
+
+    method version = _version
+    method setVersion v = _version <- Some v
+
+    method body = Buffer.contents _contentsBuf
+    method setBody c =
+      Buffer.clear _contentsBuf;
+      Buffer.add_string _contentsBuf c
+    method bodyBuf = _contentsBuf
+    method setBodyBuf b =
+      Buffer.clear _contentsBuf;
+      Buffer.add_buffer _contentsBuf b
+    method addBody s = Buffer.add_string _contentsBuf s
+    method addBodyBuf b = Buffer.add_buffer _contentsBuf b
+
+    method addHeader ~name ~value =
+      let name = String.lowercase name in
+      Http_parser_sanity.heal_header (name, value);
+      Hashtbl.add _headers name value
+    method addHeaders =
+      List.iter (fun (name, value) -> self#addHeader ~name ~value)
+    method replaceHeader ~name ~value =
+      let name = String.lowercase name in
+      Http_parser_sanity.heal_header (name, value);
+      Hashtbl.replace _headers name value
+    method replaceHeaders =
+      List.iter (fun (name, value) -> self#replaceHeader ~name ~value)
+    method removeHeader ~name =
+      let name = String.lowercase name in
+      hashtbl_remove_all _headers name
+    method hasHeader ~name =
+      let name = String.lowercase name in
+      Hashtbl.mem _headers name
+    method header ~name =
+      if not (self#hasHeader name) then raise (Header_not_found name);
+      let name = String.lowercase name in
+      String.concat ", " (List.rev (Hashtbl.find_all _headers name))
+    method headers =
+      List.rev
+        (Hashtbl.fold
+          (fun name _ headers -> (name, self#header ~name)::headers)
+          _headers
+          [])
+
+    method clientSockaddr = clisockaddr
+    method clientAddr = cliaddr
+    method clientPort = cliport
+
+    method serverSockaddr = srvsockaddr
+    method serverAddr = srvaddr
+    method serverPort = srvport
+
+    method private virtual fstLineToString: string
+    method toString =
+      self#fstLineToString ^  (* {request,status} line *)
+      crlf ^
+      (String.concat  (* headers, crlf terminated *)
+        ""
+        (List.map (fun (h,v) -> h ^ ": " ^ v ^ crlf) self#headers)) ^
+      (sprintf "Content-Length: %d" (String.length self#body)) ^ crlf ^
+      crlf ^
+      self#body (* body *)
+    method serialize outchan =
+      output_string outchan self#toString;
+      flush outchan
+
+  end
+
diff --git a/0.1.4-2/http_message.mli b/0.1.4-2/http_message.mli
new file mode 100644 (file)
index 0000000..0a30b3e
--- /dev/null
@@ -0,0 +1,130 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library 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
+*)
+
+(** Object Oriented representation of HTTP messages *)
+
+open Http_types;;
+
+  (** OO representation of an HTTP message
+  @param entity body included in the message
+  @param headers message headers shipped with the message *)
+class virtual message:
+  body: string -> headers: (string * string) list -> version: version option ->
+  clisockaddr: Unix.sockaddr -> srvsockaddr: Unix.sockaddr ->
+    object
+
+        (** @return message HTTP version, it can be None because older version
+        of the HTTP protocol don't require HTTP version to be told between
+        message source and destination *)
+      method version: version option
+
+        (** set message HTTP version *)
+      method setVersion: version -> unit
+
+        (** @return message body *)
+      method body: string
+
+        (** set message body *)
+      method setBody: string -> unit
+
+        (** @return a Buffer.t connected to message body (Warning: changing this
+        buffer will change message body too) *)
+      method bodyBuf: Buffer.t
+
+        (** set a new Buffer.t used to keep message body *)
+      method setBodyBuf: Buffer.t -> unit
+
+        (** append a string to message body *)
+      method addBody: string -> unit
+
+        (** append a whole buffer to message body *)
+      method addBodyBuf: Buffer.t -> unit
+
+      (** {i header name comparison are performed in a case-insensitive manner
+      as required by RFC2616, actually the implementation works converting all
+      header names in lowercase} *)
+
+        (** add an HTTP header
+        @param name header's name
+        @param value header's value *)
+      method addHeader: name:string -> value:string -> unit
+
+        (** add a list of HTTP headers
+        @param headers a list of pairs: header_name, header_value *)
+      method addHeaders: (string * string) list -> unit
+
+        (** like addHeader but replace previous definition of the same header *)
+      method replaceHeader: name:string -> value:string -> unit
+
+        (** like addHeaders but replace previous definition of headers that were
+        already defined *)
+      method replaceHeaders: (string * string) list -> unit
+
+        (** remove _all_ occurences of an HTTP header from the message
+        @param name name of the header to be removed *)
+      method removeHeader: name:string -> unit
+
+        (** @return true if given header exists in message, false otherwise *)
+      method hasHeader: name:string -> bool
+
+        (** @return value associated to a given header
+        @param name name of the header to lookup
+        @raise Header_not_found if given header wasn't defined in message *)
+      method header: name:string -> string
+
+        (** @return the full set of headers defined for this message, the value
+        returned is an association list from headers name to headers value, an
+        header may occurs more that once in the list *)
+      method headers: (string * string) list
+
+
+        (** @return client Unix.sockaddr *)
+      method clientSockaddr: Unix.sockaddr
+
+        (** @return client address pretty printed *)
+      method clientAddr: string
+
+        (** @return client port *)
+      method clientPort: int
+
+        (** @return server Unix.sockaddr *)
+      method serverSockaddr: Unix.sockaddr
+
+        (** @return server address pretty printed *)
+      method serverAddr: string
+
+        (** @return server port *)
+      method serverPort: int
+
+
+        (** @return for requests first request line, for responses first
+        response line.
+        User by derived requests and responses to implement toString method *)
+      method private virtual fstLineToString: string
+
+        (** @return a string representation of the message *)
+      method toString: string
+
+        (** serialize the message over an output channel *)
+      method serialize: out_channel -> unit
+
+    end
+
diff --git a/0.1.4-2/http_misc.ml b/0.1.4-2/http_misc.ml
new file mode 100644 (file)
index 0000000..daa81f3
--- /dev/null
@@ -0,0 +1,154 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library 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
+*)
+
+open Printf
+
+open Http_types
+
+let date_822 () =
+  Netdate.mk_mail_date ~zone:Netdate.localzone (Unix.time ())
+
+let is_directory name =
+  match Unix.lstat name with
+  | { Unix.st_kind = Unix.S_DIR } -> true
+  | _ -> false
+
+let filesize fname = (Unix.stat fname).Unix.st_size
+
+let strip_trailing_slash =
+  let rex = Pcre.regexp "/$" in
+  fun s -> Pcre.replace ~rex ~templ:"" s
+
+let strip_heading_slash =
+  let rex = Pcre.regexp "^/" in
+  fun s -> Pcre.replace ~rex ~templ:"" s
+
+let ls dir =
+  let rec ls' entries =
+    try ls' ((Unix.readdir dir)::entries) with End_of_file -> entries
+  in
+  ls' []
+
+let string_explode s =
+  let rec string_explode' acc = function
+    | "" -> acc
+    | s -> string_explode' (s.[0] :: acc) (String.sub s 1 (String.length s - 1))
+  in
+  List.rev (string_explode' [] s)
+
+let string_implode = List.fold_left (fun s c -> s ^ (String.make 1 c)) ""
+
+let reason_phrase_of_code = function
+  | 100 -> "Continue"
+  | 101 -> "Switching protocols"
+  | 200 -> "OK"
+  | 201 -> "Created"
+  | 202 -> "Accepted"
+  | 203 -> "Non authoritative information"
+  | 204 -> "No content"
+  | 205 -> "Reset content"
+  | 206 -> "Partial content"
+  | 300 -> "Multiple choices"
+  | 301 -> "Moved permanently"
+  | 302 -> "Found"
+  | 303 -> "See other"
+  | 304 -> "Not modified"
+  | 305 -> "Use proxy"
+  | 307 -> "Temporary redirect"
+  | 400 -> "Bad request"
+  | 401 -> "Unauthorized"
+  | 402 -> "Payment required"
+  | 403 -> "Forbidden"
+  | 404 -> "Not found"
+  | 405 -> "Method not allowed"
+  | 406 -> "Not acceptable"
+  | 407 -> "Proxy authentication required"
+  | 408 -> "Request time out"
+  | 409 -> "Conflict"
+  | 410 -> "Gone"
+  | 411 -> "Length required"
+  | 412 -> "Precondition failed"
+  | 413 -> "Request entity too large"
+  | 414 -> "Request URI too large"
+  | 415 -> "Unsupported media type"
+  | 416 -> "Requested range not satisfiable"
+  | 417 -> "Expectation failed"
+  | 500 -> "Internal server error"
+  | 501 -> "Not implemented"
+  | 502 -> "Bad gateway"
+  | 503 -> "Service unavailable"
+  | 504 -> "Gateway time out"
+  | 505 -> "HTTP version not supported"
+  | invalid_code -> raise (Invalid_code invalid_code)
+
+let build_sockaddr (addr, port) =
+  try
+    Unix.ADDR_INET ((Unix.gethostbyname addr).Unix.h_addr_list.(0), port)
+  with Not_found -> failwith ("OCaml-HTTP, can't resolve hostname: " ^ addr)
+
+let explode_sockaddr = function
+  | Unix.ADDR_INET (addr, port) -> (Unix.string_of_inet_addr addr, port)
+  | _ -> assert false (* can explode only inet address *)
+
+let peername_of_out_channel outchan =
+  Unix.getpeername (Unix.descr_of_out_channel outchan)
+let peername_of_in_channel inchan =
+  Unix.getpeername (Unix.descr_of_in_channel inchan)
+let sockname_of_out_channel outchan =
+  Unix.getsockname (Unix.descr_of_out_channel outchan)
+let sockname_of_in_channel inchan =
+  Unix.getsockname (Unix.descr_of_in_channel inchan)
+
+let buf_of_inchan ?limit ic =
+  let buf = Buffer.create 10240 in
+  let tmp = String.make 1024 '\000' in
+  let rec buf_of_inchan' limit =
+    (match limit with
+    | None ->
+        let bytes = input ic tmp 0 1024 in
+        if bytes > 0 then begin
+          Buffer.add_substring buf tmp 0 bytes;
+          buf_of_inchan' None
+        end
+    | Some lim -> (* TODO what about using a single really_input call? *)
+        let bytes = input ic tmp 0 (min lim 1024) in
+        if bytes > 0 then begin
+          Buffer.add_substring buf tmp 0 bytes;
+          buf_of_inchan' (Some (lim - bytes))
+        end)
+  in
+  (try buf_of_inchan' limit with End_of_file -> ());
+  buf
+
+let list_assoc_all key pairs =
+  snd (List.split (List.filter (fun (k, v) -> k = key) pairs))
+
+let warn msg  = prerr_endline (sprintf "ocaml-http WARNING: %s" msg)
+let error msg = prerr_endline (sprintf "ocaml-http ERROR:   %s" msg)
+
+let finally at_end f arg =
+  let res =
+    try f arg
+    with exn -> at_end (); raise exn
+  in
+  at_end ();
+  res
+
diff --git a/0.1.4-2/http_misc.mli b/0.1.4-2/http_misc.mli
new file mode 100644 (file)
index 0000000..bb6a86f
--- /dev/null
@@ -0,0 +1,94 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library 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
+*)
+
+(** Helpers and other not better classified functions which should not be
+exposed in the final API *)
+
+  (** @return the current date compliant to RFC 1123, which updates RFC 822
+  zone info are retrieved from UTC *)
+val date_822: unit -> string
+
+  (** @return true if 'name' is a directory on the file system, false otherwise
+  *)
+val is_directory: string -> bool
+
+  (** @return the filesize of fname *)
+val filesize: string -> int
+
+  (** strip trailing '/', if any, from a string and @return the new string *)
+val strip_trailing_slash: string -> string
+
+  (** strip heading '/', if any, from a string and @return the new string *)
+val strip_heading_slash: string -> string
+
+  (** given a dir handle @return a list of entries contained *)
+val ls: Unix.dir_handle -> string list
+
+  (** explode a string in a char list *)
+val string_explode: string -> char list
+
+  (** implode a char list in a string *)
+val string_implode: char list -> string
+
+  (** given an HTTP response code return the corresponding reason phrase *)
+val reason_phrase_of_code: int -> string
+
+  (** build a Unix.sockaddr inet address from a string representation of an IP
+  address and a port number *)
+val build_sockaddr: string * int -> Unix.sockaddr
+
+  (** explode an _inet_ Unix.sockaddr address in a string representation of an
+  IP address and a port number *)
+val explode_sockaddr: Unix.sockaddr -> string * int
+
+  (** given an out_channel build on top of a socket, return peername related to
+  that socket *)
+val peername_of_out_channel: out_channel -> Unix.sockaddr
+
+  (** as above but works on in_channels *)
+val peername_of_in_channel: in_channel -> Unix.sockaddr
+
+  (** given an out_channel build on top of a socket, return sockname related to
+  that socket *)
+val sockname_of_out_channel: out_channel -> Unix.sockaddr
+
+  (** as above but works on in_channels *)
+val sockname_of_in_channel: in_channel -> Unix.sockaddr
+
+  (* TODO replace with Buffer.add_channel which does almost the same :-((( *)
+  (** reads from an input channel till it End_of_file and returns what has been
+  read; if limit is given returned buffer will contains at most first 'limit'
+  bytes read from input channel *)
+val buf_of_inchan: ?limit: int -> in_channel -> Buffer.t
+
+  (** like List.assoc but return all bindings of a given key instead of the
+  leftmost one only *)
+val list_assoc_all: 'a -> ('a * 'b) list -> 'b list
+
+val warn: string -> unit (** print a warning msg to stderr. Adds trailing \n *)
+val error: string -> unit (** print an error msg to stderr. Adds trailing \n *)
+
+  (** @param finalizer finalization function (execution both in case of success
+   * and in case of raised exception
+   * @param f function to be invoked
+   * @param arg argument to be passed to function *)
+val finally: (unit -> unit) -> ('a -> 'b) -> 'a -> 'b
+
diff --git a/0.1.4-2/http_parser.ml b/0.1.4-2/http_parser.ml
new file mode 100644 (file)
index 0000000..b92a844
--- /dev/null
@@ -0,0 +1,182 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library 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
+*)
+
+open Printf;;
+
+open Http_common;;
+open Http_types;;
+open Http_constants;;
+
+let (bindings_sep, binding_sep, pieces_sep, header_sep) =
+  (Pcre.regexp "&", Pcre.regexp "=", Pcre.regexp " ", Pcre.regexp ":")
+let header_RE = Pcre.regexp "([^:]*):(.*)"
+
+let url_decode url = Netencoding.Url.decode ~plus:true url
+
+let split_query_params query =
+  let bindings = Pcre.split ~rex:bindings_sep query in
+  match bindings with
+  | [] -> raise (Malformed_query query)
+  | bindings ->
+      List.map
+        (fun binding ->
+          match Pcre.split ~rex:binding_sep binding with
+          | [ ""; b ] -> (* '=b' *)
+              raise (Malformed_query_part (binding, query))
+          | [ a; b ]  -> (* 'a=b' *) (url_decode a, url_decode b)
+          | [ a ]     -> (* 'a=' || 'a' *) (url_decode a, "")
+          | _ -> raise (Malformed_query_part (binding, query)))
+        bindings
+
+  (** internal, used by generic_input_line *)
+exception Line_completed;;
+
+  (** given an input channel and a separator
+  @return a line read from it (like Pervasives.input_line)
+  line is returned only after reading a separator string; separator string isn't
+  included in the returned value
+  TODO what about efficiency?, input is performed char-by-char
+  *)
+let generic_input_line ~sep ~ic =
+  let sep_len = String.length sep in
+  if sep_len < 1 then
+    failwith ("Separator '" ^ sep ^ "' is too short!")
+  else  (* valid separator *)
+    let line = ref "" in
+    let sep_pointer = ref 0 in
+    try
+      while true do
+        if !sep_pointer >= String.length sep then (* line completed *)
+          raise Line_completed
+        else begin (* incomplete line: need to read more *)
+          let ch = input_char ic in
+          if ch = String.get sep !sep_pointer then  (* next piece of sep *)
+            incr sep_pointer
+          else begin  (* useful char *)
+            for i = 0 to !sep_pointer - 1 do
+              line := !line ^ (String.make 1 (String.get sep i))
+            done;
+            sep_pointer := 0;
+            line := !line ^ (String.make 1 ch)
+          end
+        end
+      done;
+      assert false  (* unreacheable statement *)
+    with Line_completed -> !line
+
+let patch_empty_path = function "" -> "/" | s -> s
+let debug_dump_request path params =
+  debug_print
+    (sprintf
+      "recevied request; path: %s; params: %s"
+      path
+      (String.concat ", " (List.map (fun (n, v) -> n ^ "=" ^ v) params)))
+
+let parse_request_fst_line ic =
+  let request_line = generic_input_line ~sep:crlf ~ic in
+  debug_print (sprintf "HTTP request line (not yet parsed): %s" request_line);
+  try
+    (match Pcre.split ~rex:pieces_sep request_line with
+    | [ meth_raw; uri_raw ] ->  (* ancient HTTP request line *)
+        (method_of_string meth_raw,                 (* method *)
+        Http_parser_sanity.url_of_string uri_raw,   (* uri *)
+        None)                                       (* no version given *)
+    | [ meth_raw; uri_raw; http_version_raw ] ->  (* HTTP 1.{0,1} *)
+          (method_of_string meth_raw,                 (* method *)
+          Http_parser_sanity.url_of_string uri_raw,   (* uri *)
+          Some (version_of_string http_version_raw))  (* version *)
+    | _ -> raise (Malformed_request request_line))
+  with Malformed_URL url -> raise (Malformed_request_URI url)
+
+let parse_response_fst_line ic =
+  let response_line = generic_input_line ~sep:crlf ~ic in
+  debug_print (sprintf "HTTP response line (not yet parsed): %s" response_line);
+  try
+    (match Pcre.split ~rex:pieces_sep response_line with
+    | version_raw :: code_raw :: _ ->
+        (version_of_string version_raw,             (* method *)
+        status_of_code (int_of_string code_raw))    (* status *)
+    | _ -> raise (Malformed_response response_line))
+  with
+  | Malformed_URL _ | Invalid_code _ | Failure "int_of_string" ->
+      raise (Malformed_response response_line)
+
+let parse_path uri = patch_empty_path (String.concat "/" (Neturl.url_path uri))
+let parse_query_get_params uri =
+  try (* act on HTTP encoded URIs *)
+    split_query_params (Neturl.url_query ~encoded:true uri)
+  with Not_found -> []
+
+let parse_headers ic =
+  (* consume also trailing "^\r\n$" line *)
+  let rec parse_headers' headers =
+    match generic_input_line ~sep:crlf ~ic with
+    | "" -> List.rev headers
+    | line ->
+        (let subs =
+          try
+            Pcre.extract ~rex:header_RE line
+          with Not_found -> raise (Invalid_header line)
+        in
+        let header =
+          try
+            subs.(1)
+          with Invalid_argument "Array.get" -> raise (Invalid_header line)
+        in
+        let value =
+          try
+            Http_parser_sanity.normalize_header_value subs.(2) 
+          with Invalid_argument "Array.get" -> ""
+        in
+        Http_parser_sanity.heal_header (header, value);
+        parse_headers' ((header, value) :: headers))
+  in
+  parse_headers' []
+
+let parse_cookies raw_cookies =
+  prerr_endline ("raw cookies: '" ^ raw_cookies ^ "'");
+  let tokens =
+    let lexbuf = Lexing.from_string raw_cookies in
+    let rec aux acc =
+      match Cookie_lexer.token lexbuf with
+      | `EOF -> acc
+      | token -> aux (token :: acc)
+    in
+    List.rev (aux [])
+  in
+  let rec aux = function
+    | [ `TOKEN n ; `ASSIGN ; (`TOKEN v | `QSTRING v) ] ->
+        prerr_endline ("found cookie " ^ n ^ " " ^ v);
+        [ (n,v) ]
+    | `TOKEN n :: `ASSIGN :: (`TOKEN v | `QSTRING v) :: `SEP :: tl ->
+        prerr_endline ("found cookie " ^ n ^ " " ^ v);
+        (n,v) :: aux tl
+    | _ -> raise (Malformed_cookies raw_cookies)
+  in
+  aux tokens
+
+let parse_request ic =
+  let (meth, uri, version) = parse_request_fst_line ic in
+  let path = parse_path uri in
+  let query_get_params = parse_query_get_params uri in
+  debug_dump_request path query_get_params;
+  (path, query_get_params)
+
diff --git a/0.1.4-2/http_parser.mli b/0.1.4-2/http_parser.mli
new file mode 100644 (file)
index 0000000..452d707
--- /dev/null
@@ -0,0 +1,75 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library 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
+*)
+
+(** HTTP messages parsing *)
+
+open Http_types;;
+
+  (** given an HTTP like query string (e.g. "name1=value1&name2=value2&...")
+  @return a list of pairs [("name1", "value1"); ("name2", "value2")]
+  @raise Malformed_query if the string isn't a valid query string
+  @raise Malformed_query_part if some piece of the query isn't valid
+  *)
+val split_query_params: string -> (string * string) list
+
+  (** parse 1st line of an HTTP request
+  @param inchan input channel from which parse request
+  @return a triple meth * url * version, meth is the HTTP method invoked, url is
+  the requested url, version is the HTTP version specified or None if no version
+  was specified
+  @raise Malformed_request if request 1st linst isn't well formed
+  @raise Malformed_request_URI if requested URI isn't well formed *)
+val parse_request_fst_line: in_channel -> meth * Neturl.url * version option
+
+  (** parse 1st line of an HTTP response
+   * @param inchan input channel from which parse response
+   * @raise Malformed_response if first line isn't well formed
+  *)
+val parse_response_fst_line: in_channel -> version * status
+
+  (** parse HTTP GET parameters from an URL; paramater which were passed with no
+  value (like 'x' in "/foo.cgi?a=10&x=&c=9") are returned associated with the
+  empty ("") string.
+  @return a list of pairs param_name * param_value *)
+val parse_query_get_params: Neturl.url -> (string * string) list
+
+  (** parse the base path (removing query string, fragment, ....) from an URL *)
+val parse_path: Neturl.url -> string
+
+  (** parse HTTP headers. Consumes also trailing CRLF at the end of header list
+  @param inchan input channel from which parse headers
+  @return a list of pairs header_name * header_value
+  @raise Invalid_header if a not well formed header is encountered *)
+val parse_headers: in_channel -> (string * string) list
+
+  (** parse a Cookie header, extracting an associative list <attribute name,
+   * attribute value>. See RFC 2965
+   * @param raw_cookies: value of a "Cookies:" header
+   * @return a list of pairs cookie_name * cookie_value
+   * @raise Malformed_cookies if raw_cookies does not conform to RFC 2965 *)
+val parse_cookies: string -> (string * string) list
+
+  (** given an input channel, reads from it a GET HTTP request and
+  @return a pair <path, query_params> where path is a string representing the
+  requested path and query_params is a list of pairs <name, value> (the GET
+  parameters) *)
+val parse_request: in_channel -> string * (string * string) list
+
diff --git a/0.1.4-2/http_parser_sanity.ml b/0.1.4-2/http_parser_sanity.ml
new file mode 100644 (file)
index 0000000..7fe08cf
--- /dev/null
@@ -0,0 +1,115 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library 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
+*)
+
+open Printf
+
+open Http_types
+open Http_constants
+
+(*
+type url_syntax_option =
+    Url_part_not_recognized
+  | Url_part_allowed
+  | Url_part_required
+
+* (1) scheme://user:password@host:port/path;params?query#fragment
+*)
+
+let request_uri_syntax =
+{
+  Neturl.url_enable_scheme  = Neturl.Url_part_not_recognized;
+  url_enable_user           = Neturl.Url_part_not_recognized;
+  url_enable_user_param     = Neturl.Url_part_not_recognized;
+  url_enable_password       = Neturl.Url_part_not_recognized;
+  url_enable_host           = Neturl.Url_part_not_recognized;
+  url_enable_port           = Neturl.Url_part_not_recognized;
+  url_enable_path           = Neturl.Url_part_required;
+  url_enable_param          = Neturl.Url_part_not_recognized;
+  url_enable_query          = Neturl.Url_part_allowed;
+  url_enable_fragment       = Neturl.Url_part_not_recognized;
+  url_enable_other          = Neturl.Url_part_not_recognized;
+  url_accepts_8bits         = false;
+  url_enable_relative       = true;
+  url_is_valid              = (fun _ -> true);
+}
+
+  (* convention:
+      foo_RE_raw  is the uncompiled regexp matching foo
+      foo_RE      is the compiled regexp matching foo
+      is_foo      is the predicate over string matching foo
+  *)
+
+let separators_RE_raw = "()<>@,;:\\\\\"/\\[\\]?={} \t"
+let ctls_RE_raw = "\\x00-\\x1F\\x7F"
+let token_RE_raw = "[^" ^ separators_RE_raw ^ ctls_RE_raw ^ "]+"
+let lws_RE_raw = "(\r\n)?[ \t]"
+let quoted_string_RE_raw = "\"(([^\"])|(\\\\\"))*\""
+let text_RE_raw = "(([^" ^ ctls_RE_raw ^ "])|(" ^ lws_RE_raw ^ "))+"
+let field_content_RE_raw =
+  sprintf
+    "^(((%s)|(%s)|(%s))|(%s))*$"
+    token_RE_raw
+    separators_RE_raw
+    quoted_string_RE_raw
+    text_RE_raw
+(*
+  (* following RFC 2616 specifications *)
+let field_value_RE_raw = "((" ^ field_content_RE_raw ^ ")|(" ^ lws_RE_raw^ "))*"
+*)
+  (* smarter implementation: TEXT production is included in the regexp below *)
+let field_value_RE_raw =
+  sprintf
+    "^((%s)|(%s)|(%s)|(%s))*$"
+    token_RE_raw
+    separators_RE_raw
+    quoted_string_RE_raw
+    lws_RE_raw
+
+let token_RE = Pcre.regexp ("^" ^ token_RE_raw ^ "$")
+let field_value_RE = Pcre.regexp ("^" ^ field_value_RE_raw ^ "$")
+let heading_lws_RE = Pcre.regexp (sprintf "^%s*" lws_RE_raw)
+let trailing_lws_RE = Pcre.regexp (sprintf "%s*$" lws_RE_raw)
+
+let is_token s = Pcre.pmatch ~rex:token_RE s
+let is_field_name = is_token
+let is_field_value s = Pcre.pmatch ~rex:field_value_RE s
+
+let heal_header_name s =
+  if not (is_field_name s) then raise (Invalid_header_name s) else ()
+
+let heal_header_value s =
+  if not (is_field_value s) then raise (Invalid_header_value s) else ()
+
+let normalize_header_value s =
+  Pcre.replace ~rex:trailing_lws_RE
+    (Pcre.replace ~rex:heading_lws_RE s)
+
+let heal_header (name, value) =
+  heal_header_name name;
+  heal_header_value name
+let url_of_string s =
+  try
+    Neturl.url_of_string request_uri_syntax s
+  with Neturl.Malformed_URL -> raise (Malformed_URL s)
+
+let string_of_url = Neturl.string_of_url
+
diff --git a/0.1.4-2/http_parser_sanity.mli b/0.1.4-2/http_parser_sanity.mli
new file mode 100644 (file)
index 0000000..a869f18
--- /dev/null
@@ -0,0 +1,46 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library 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
+*)
+
+(** Sanity test functions related to HTTP message parsing *)
+
+  (** @param name an HTTP header name
+  @raise Invalid_header_name if name isn't a valid HTTP header name *)
+val heal_header_name: string -> unit
+
+  (** @param value an HTTP header value
+  @raise Invalid_header_value if value isn't a valid HTTP header value *)
+val heal_header_value: string -> unit
+
+  (** @param header a pair header_name * header_value
+  @raise Invalid_header_name if name isn't a valid HTTP header name
+  @raise Invalid_header_value if value isn't a valid HTTP header value *)
+val heal_header: string * string -> unit
+
+  (** remove heading and/or trailing LWS sequences as per RFC2616 *)
+val normalize_header_value: string -> string
+
+  (** parse an URL from a string.
+  @raise Malformed_URL if an invalid URL is encountered *)
+val url_of_string: string -> Neturl.url
+
+  (** pretty print an URL *)
+val string_of_url: Neturl.url -> string
+
diff --git a/0.1.4-2/http_request.ml b/0.1.4-2/http_request.ml
new file mode 100644 (file)
index 0000000..93e6d88
--- /dev/null
@@ -0,0 +1,158 @@
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2007> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library 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
+*)
+
+open Printf;;
+
+open Http_common;;
+open Http_types;;
+
+let debug_dump_request path params =
+  debug_print ("request path = " ^ path);
+  debug_print (
+    sprintf"request params = %s"
+      (String.concat ";"
+        (List.map (fun (h,v) -> String.concat "=" [h;v]) params)))
+
+let auth_sep_RE = Pcre.regexp ":"
+let basic_auth_RE = Pcre.regexp "^Basic\\s+"
+
+exception Fallback;;  (* used internally by request class *)
+
+class request ic =
+  let (meth, uri, version) = Http_parser.parse_request_fst_line ic in
+  let uri_str = Neturl.string_of_url uri in
+  let path = Http_parser.parse_path uri in
+  let query_get_params = Http_parser.parse_query_get_params uri in
+  let (headers, body) =
+    (match version with
+    | None -> [], ""  (* No version given, use request's 1st line only *)
+    | Some version -> (* Version specified, parse also headers and body *)
+        let headers =
+          List.map  (* lowercase header names to ease lookups before having a
+                    request object *)
+            (fun (h,v) -> (String.lowercase h, v))
+            (Http_parser.parse_headers ic) (* trailing \r\n consumed! *)
+        in
+        let body =
+            (* TODO fallback on size defined in Transfer-Encoding if
+              Content-Length isn't defined *)
+          if meth = `POST then
+            Buffer.contents
+              (try  (* read only Content-Length bytes *)
+                let limit_raw =
+                  (try
+                    List.assoc "content-length" headers
+                  with Not_found -> raise Fallback)
+                in
+                let limit =
+                  (try  (* TODO supports only a maximum content-length of 1Gb *)
+                    int_of_string limit_raw
+                  with Failure "int_of_string" ->
+                    raise (Invalid_header ("content-length: " ^ limit_raw)))
+                in
+                Http_misc.buf_of_inchan ~limit ic
+              with Fallback -> Http_misc.buf_of_inchan ic)  (* read until EOF *)
+          else  (* TODO empty body for methods other than POST, is ok? *)
+            ""
+        in
+        (headers, body))
+  in
+  let cookies =
+    try
+      let _hdr, raw_cookies =
+        List.find
+          (fun (hdr, _cookie) -> String.lowercase hdr = "cookie")
+          headers
+      in
+      Some (Http_parser.parse_cookies raw_cookies)
+    with
+    | Not_found -> None
+    | Malformed_cookies _ -> None
+  in
+  let query_post_params =
+    match meth with
+    | `POST ->
+        let ct = try List.assoc "content-type" headers with Not_found -> "" in
+        if ct = "application/x-www-form-urlencoded" then
+          Http_parser.split_query_params body
+        else []
+    | _ -> []
+  in
+  let params = query_post_params @ query_get_params in (* prefers POST params *)
+  let _ = debug_dump_request path params in
+  let (clisockaddr, srvsockaddr) =
+    (Http_misc.peername_of_in_channel ic, Http_misc.sockname_of_in_channel ic)
+  in
+
+  object (self)
+
+    inherit
+      Http_message.message ~body ~headers ~version ~clisockaddr ~srvsockaddr
+
+    val params_tbl =
+      let tbl = Hashtbl.create (List.length params) in
+      List.iter (fun (n,v) -> Hashtbl.add tbl n v) params;
+      tbl
+
+    method meth = meth
+    method uri = uri_str
+    method path = path
+    method param ?(meth: meth option) ?(default: string option) name =
+      try
+        (match meth with
+        | None -> Hashtbl.find params_tbl name
+        | Some `GET -> List.assoc name query_get_params
+        | Some `POST -> List.assoc name query_post_params)
+      with Not_found ->
+        (match default with
+        | None -> raise (Param_not_found name)
+        | Some value -> value)
+    method paramAll ?meth name =
+      (match (meth: meth option) with
+      | None -> List.rev (Hashtbl.find_all params_tbl name)
+      | Some `GET -> Http_misc.list_assoc_all name query_get_params
+      | Some `POST -> Http_misc.list_assoc_all name query_post_params)
+    method params = params
+    method params_GET = query_get_params
+    method params_POST = query_post_params
+
+    method cookies = cookies
+
+    method private fstLineToString =
+      let method_string = string_of_method self#meth in
+      match self#version with
+      | Some version ->
+          sprintf "%s %s %s" method_string self#uri (string_of_version version)
+      | None -> sprintf "%s %s" method_string self#uri
+
+    method authorization: auth_info option =
+      try
+        let credentials =
+          Netencoding.Base64.decode
+            (Pcre.replace ~rex:basic_auth_RE (self#header "authorization"))
+        in
+        debug_print ("HTTP Basic auth credentials: " ^ credentials);
+        (match Pcre.split ~rex:auth_sep_RE credentials with
+        | [username; password] -> Some (`Basic (username, password))
+        | l -> raise Exit)
+      with Header_not_found _ | Invalid_argument _ | Exit -> None
+
+  end
+
diff --git a/0.1.4-2/http_request.mli b/0.1.4-2/http_request.mli
new file mode 100644 (file)
index 0000000..5c9c175
--- /dev/null
@@ -0,0 +1,28 @@
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2007> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library 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
+*)
+
+(** Object Oriented representation of HTTP requests *)
+
+open Http_types;;
+
+  (** OO representation of an HTTP request
+  @param inchan input channel from which parse an HTTP request *)
+class request: in_channel -> Http_types.request
+
diff --git a/0.1.4-2/http_response.ml b/0.1.4-2/http_response.ml
new file mode 100644 (file)
index 0000000..58308d3
--- /dev/null
@@ -0,0 +1,118 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library 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
+*)
+
+open Http_types;;
+open Http_constants;;
+open Http_common;;
+open Http_daemon;;
+open Printf;;
+
+let status_line_RE = Pcre.regexp "^(HTTP/\\d\\.\\d) (\\d{3}) (.*)$"
+
+let anyize = function
+  | Some addr -> addr
+  | None -> Unix.ADDR_INET (Unix.inet_addr_any, -1)
+
+class response
+  (* Warning: keep default values in sync with Http_daemon.respond function *)
+  ?(body = "") ?(headers = []) ?(version = http_version)
+  ?clisockaddr ?srvsockaddr (* optional because response have to be easily
+                            buildable in callback functions *)
+  ?(code = 200) ?status
+  ()
+  =
+
+    (** if no address were supplied for client and/or server, use a foo address
+    instead *)
+  let (clisockaddr, srvsockaddr) = (anyize clisockaddr, anyize srvsockaddr) in
+
+    (* "version code reason_phrase" *)
+  object (self)
+
+      (* note that response objects can't be created with a None version *)
+    inherit
+      Http_message.message
+        ~body ~headers ~version:(Some version) ~clisockaddr ~srvsockaddr
+
+    val mutable _code =
+      match status with
+      | None -> code
+      | Some (s: Http_types.status) -> code_of_status s
+    val mutable _reason: string option = None
+
+    method private getRealVersion =
+      match self#version with
+      | None ->
+          failwith ("Http_response.fstLineToString: " ^
+            "can't serialize an HTTP response with no HTTP version defined")
+      | Some v -> string_of_version v
+
+    method code = _code
+    method setCode c =
+      ignore (status_of_code c);  (* sanity check on c *)
+      _code <- c
+    method status = status_of_code _code
+    method setStatus (s: Http_types.status) = _code <- code_of_status s
+    method reason =
+      match _reason with
+      | None -> Http_misc.reason_phrase_of_code _code
+      | Some r -> r
+    method setReason r = _reason <- Some r
+    method statusLine =
+      String.concat " "
+        [self#getRealVersion; string_of_int self#code; self#reason]
+    method setStatusLine s =
+      try
+        let subs = Pcre.extract ~rex:status_line_RE s in
+        self#setVersion (version_of_string subs.(1));
+        self#setCode (int_of_string subs.(2));
+        self#setReason subs.(3)
+      with Not_found ->
+        raise (Invalid_status_line s)
+
+    method isInformational = is_informational _code
+    method isSuccess = is_success _code
+    method isRedirection = is_redirection _code
+    method isClientError = is_client_error _code
+    method isServerError = is_server_error _code
+    method isError = is_error _code
+
+      (* FIXME duplication of code between this and send_basic_headers *)
+    method addBasicHeaders =
+      self#addHeader ~name:"Date" ~value:(Http_misc.date_822 ());
+      self#addHeader ~name:"Server" ~value:server_string
+
+    method contentType = self#header "Content-Type"
+    method setContentType t = self#replaceHeader "Content-Type" t
+    method contentEncoding = self#header "Content-Encoding"
+    method setContentEncoding e = self#replaceHeader "Content-Encoding" e
+    method date = self#header "Date"
+    method setDate d = self#replaceHeader "Date" d
+    method expires = self#header "Expires"
+    method setExpires t = self#replaceHeader "Expires" t
+    method server = self#header "Server"
+    method setServer s = self#replaceHeader "Server" s
+
+    method private fstLineToString =
+      sprintf "%s %d %s" self#getRealVersion self#code self#reason
+
+  end
+
diff --git a/0.1.4-2/http_response.mli b/0.1.4-2/http_response.mli
new file mode 100644 (file)
index 0000000..694eb22
--- /dev/null
@@ -0,0 +1,33 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library 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
+*)
+
+(** Object Oriented representation of HTTP responses *)
+
+open Http_types;;
+
+  (** OO representation of an HTTP response. *)
+class response:
+  ?body:string -> ?headers:(string * string) list -> ?version: version ->
+  ?clisockaddr: Unix.sockaddr -> ?srvsockaddr: Unix.sockaddr ->
+  ?code:int -> ?status:Http_types.status ->
+  unit ->
+    Http_types.response
+
diff --git a/0.1.4-2/http_tcp_server.ml b/0.1.4-2/http_tcp_server.ml
new file mode 100644 (file)
index 0000000..cbe01ad
--- /dev/null
@@ -0,0 +1,172 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library 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
+*)
+
+
+  (** raised when a client timeouts *)
+exception Timeout
+
+let backlog = 10
+
+  (** if timeout is given (Some _) @return a new callback which establish
+  timeout_callback as callback for signal Sys.sigalrm and register an alarm
+  (expiring after timeout seconds) before invoking the real callback given. If
+  timeout is None, callback is returned unchanged. *)
+let wrap_callback_w_timeout ~callback ~timeout ~timeout_callback =
+  match timeout with
+  | None -> callback
+  | Some timeout -> (* wrap callback setting an handler for ALRM signal and an
+                    alarm that ring after timeout seconds *)
+      (fun inchan outchan ->
+        ignore (Sys.signal Sys.sigalrm (Sys.Signal_handle timeout_callback));
+        ignore (Unix.alarm timeout);
+        callback inchan outchan)
+
+  (* try to close nicely a socket *)
+let shutdown_socket suck =
+  try
+    Unix.shutdown suck Unix.SHUTDOWN_ALL
+  with Unix.Unix_error(_, "shutdown", "") -> ()
+
+let nice_unix_accept suck =
+  try
+    Unix.accept suck
+  with e -> (* clean up socket before exit *)
+    shutdown_socket suck;
+    raise e
+
+let init_socket sockaddr =
+  let suck = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
+    (* shutdown socket on SIGTERM *)
+  ignore (Sys.signal Sys.sigterm
+    (Sys.Signal_handle
+      (fun _ -> shutdown_socket suck; exit 17)));
+  Unix.setsockopt suck Unix.SO_REUSEADDR true;
+  Unix.bind suck sockaddr;
+  Unix.listen suck backlog;
+  suck
+
+let init_callback callback timeout =
+  let timeout_callback signo =
+    if signo = Sys.sigalrm then
+      raise Timeout
+  in
+  wrap_callback_w_timeout ~callback ~timeout ~timeout_callback
+
+  (** try to close an outchannel connected to a socket, ignore Sys_error since
+  * this probably means that socket is already closed (e.g. on sigpipe) *)
+let try_close_out ch = try close_out ch with Sys_error _ -> ()
+
+  (** like Unix.establish_server, but shutdown sockets when receiving SIGTERM
+  and before exiting for an uncaught exception *)
+let my_establish_server server_fun sockaddr =
+  let suck = init_socket sockaddr in
+  while true do
+    let (s, caller) = nice_unix_accept suck in
+      (** "double fork" trick, see {!Unix.establish_server} implementation *)
+    match Unix.fork() with
+    | 0 ->  (* parent *)
+        (try
+          if Unix.fork () <> 0 then
+            exit 0;  (* The son exits, the grandson works *)
+          let inchan = Unix.in_channel_of_descr s in
+          let outchan = Unix.out_channel_of_descr s in
+          server_fun inchan outchan;
+          try_close_out outchan;  (* closes also inchan: socket is the same *)
+          exit 0
+        with e ->
+          shutdown_socket suck; (* clean up socket before exit *)
+          raise e)
+    | child when (child > 0) -> (* child *)
+        Unix.close s;
+        ignore (Unix.waitpid [] child) (* Reclaim the son *)
+    | _ (* < 0 *) ->
+        failwith "Can't fork"
+  done
+
+  (** tcp_server which forks a new process for each request *)
+let fork ~sockaddr ~timeout callback =
+  let timeout_callback signo =
+    if signo = Sys.sigalrm then
+      exit 2
+  in
+  my_establish_server
+    (wrap_callback_w_timeout ~callback ~timeout ~timeout_callback)
+    sockaddr
+
+  (** tcp_server which doesn't fork, requests are server sequentially and in the
+  same address space of the calling process *)
+let simple ~sockaddr ~timeout callback =
+  let suck = init_socket sockaddr in
+  let callback = init_callback callback timeout in
+  try
+    while true do
+      let (client, _) = Unix.accept suck in
+        (* client is now connected *)
+      let (inchan, outchan) =
+        (Unix.in_channel_of_descr client, Unix.out_channel_of_descr client)
+      in
+      (try
+        callback inchan outchan;
+        ignore (Unix.alarm 0) (* reset alarm *)
+      with Timeout -> ());
+      try_close_out outchan (* this close also inchan: socket is the same *)
+    done
+  with e -> (* clean up socket before exit *)
+    shutdown_socket suck;
+    raise e
+
+  (** tcp_server which creates a new thread for each request to be served *)
+let thread ~sockaddr ~timeout callback =
+  let suck = init_socket sockaddr in
+  let callback = init_callback callback timeout in
+  let callback (i, o) =
+    (try
+      callback i o
+    with
+    | Timeout -> ()
+    | e ->
+        try_close_out o;
+        raise e);
+    try_close_out o
+  in
+  while true do
+    let (client, _) = nice_unix_accept suck in
+      (* client is now connected *)
+    let (inchan, outchan) =
+      (Unix.in_channel_of_descr client, Unix.out_channel_of_descr client)
+    in
+    Http_threaded_tcp_server.serve callback (inchan, outchan)
+  done
+
+  (** @param server an Http_types.tcp_server
+  * @return an Http_types.tcp_server which takes care of ignoring SIGPIPE during
+  * server execution and restoring previous handler when (if ever) the server
+  * returns *)
+let handle_sigpipe server =
+  fun ~sockaddr ~timeout callback ->
+    let old_sigpipe_behavior = Sys.signal Sys.sigpipe Sys.Signal_ignore in
+    server ~sockaddr ~timeout callback;
+    ignore (Sys.signal Sys.sigpipe old_sigpipe_behavior)
+
+let simple = handle_sigpipe simple
+let thread = handle_sigpipe thread
+let fork = handle_sigpipe fork
+
diff --git a/0.1.4-2/http_tcp_server.mli b/0.1.4-2/http_tcp_server.mli
new file mode 100644 (file)
index 0000000..e94f84f
--- /dev/null
@@ -0,0 +1,39 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library 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
+*)
+
+(** TCP servers used as low-levels for HTTP daemons *)
+
+(** {2 servers} *)
+
+  (** single process server *)
+val simple:         Http_types.tcp_server
+
+  (** multi threaded server *)
+val thread:         Http_types.tcp_server
+
+  (** multi process server *)
+val fork:           Http_types.tcp_server
+
+(** {2 low level functions} *)
+
+  (** initialize a passive socket listening on given Unix.sockaddr *)
+val init_socket:    Unix.sockaddr -> Unix.file_descr
+
diff --git a/0.1.4-2/http_threaded_tcp_server.mli b/0.1.4-2/http_threaded_tcp_server.mli
new file mode 100644 (file)
index 0000000..6504f7e
--- /dev/null
@@ -0,0 +1,26 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library 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
+*)
+
+(** Multithreaded part of Http_tcp_server *)
+
+  (** serve an HTTP request for a multi threaded TCP server *)
+val serve : ('a -> 'b) -> 'a -> unit
+
diff --git a/0.1.4-2/http_types.ml b/0.1.4-2/http_types.ml
new file mode 100644 (file)
index 0000000..216b9e0
--- /dev/null
@@ -0,0 +1,221 @@
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2007> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library 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
+*)
+
+(** Type definitions *)
+
+type version = [ `HTTP_1_0 | `HTTP_1_1 ]
+type meth = [ `GET | `POST ]
+type daemon_mode = [ `Single | `Fork | `Thread ]
+
+type tcp_server =
+  sockaddr:Unix.sockaddr -> timeout:int option ->
+  (in_channel -> out_channel -> unit) ->
+    unit
+
+type auth_info =
+  [ `Basic of string * string (* username, password *)
+  ]
+
+type informational_substatus =
+  [ `Continue
+  | `Switching_protocols
+  ]
+type success_substatus =
+  [ `OK
+  | `Created
+  | `Accepted
+  | `Non_authoritative_information
+  | `No_content
+  | `Reset_content
+  | `Partial_content
+  ]
+type redirection_substatus =
+  [ `Multiple_choices
+  | `Moved_permanently
+  | `Found
+  | `See_other
+  | `Not_modified
+  | `Use_proxy
+  | `Temporary_redirect
+  ]
+type client_error_substatus =
+  [ `Bad_request
+  | `Unauthorized
+  | `Payment_required
+  | `Forbidden
+  | `Not_found
+  | `Method_not_allowed
+  | `Not_acceptable
+  | `Proxy_authentication_required
+  | `Request_time_out
+  | `Conflict
+  | `Gone
+  | `Length_required
+  | `Precondition_failed
+  | `Request_entity_too_large
+  | `Request_URI_too_large
+  | `Unsupported_media_type
+  | `Requested_range_not_satisfiable
+  | `Expectation_failed
+  ]
+type server_error_substatus =
+  [ `Internal_server_error
+  | `Not_implemented
+  | `Bad_gateway
+  | `Service_unavailable
+  | `Gateway_time_out
+  | `HTTP_version_not_supported
+  ]
+type informational_status = [ `Informational of informational_substatus ]
+type success_status = [ `Success of success_substatus ]
+type redirection_status = [ `Redirection of redirection_substatus ]
+type client_error_status = [ `Client_error of client_error_substatus ]
+type server_error_status = [ `Server_error of server_error_substatus ]
+type error_status =
+  [ client_error_status
+  | server_error_status
+  ]
+type status =
+  [ informational_status
+  | success_status
+  | redirection_status
+  | client_error_status
+  | server_error_status
+  ]
+
+type status_code = [ `Code of int | `Status of status ]
+
+type file_source =
+  | FileSrc of string
+  | InChanSrc of in_channel
+
+exception Invalid_header of string
+exception Invalid_header_name of string
+exception Invalid_header_value of string
+exception Invalid_HTTP_version of string
+exception Invalid_HTTP_method of string
+exception Invalid_code of int
+exception Malformed_URL of string
+exception Malformed_query of string
+exception Malformed_query_part of string * string
+exception Malformed_request_URI of string
+exception Malformed_cookies of string
+exception Malformed_request of string
+exception Malformed_response of string
+exception Param_not_found of string
+exception Invalid_status_line of string
+exception Header_not_found of string
+exception Quit
+exception Unauthorized of string
+
+class type message = object
+    method version: version option
+    method setVersion: version -> unit
+    method body: string
+    method setBody: string -> unit
+    method bodyBuf: Buffer.t
+    method setBodyBuf: Buffer.t -> unit
+    method addBody: string -> unit
+    method addBodyBuf: Buffer.t -> unit
+    method addHeader: name:string -> value:string -> unit
+    method addHeaders: (string * string) list -> unit
+    method replaceHeader: name:string -> value:string -> unit
+    method replaceHeaders: (string * string) list -> unit
+    method removeHeader: name:string -> unit
+    method hasHeader: name:string -> bool
+    method header: name:string -> string
+    method headers: (string * string) list
+    method clientSockaddr: Unix.sockaddr
+    method clientAddr: string
+    method clientPort: int
+    method serverSockaddr: Unix.sockaddr
+    method serverAddr: string
+    method serverPort: int
+    method toString: string
+    method serialize: out_channel -> unit
+  end
+
+class type request = object
+    inherit message
+    method meth: meth
+    method uri: string
+    method path: string
+    method param: ?meth:meth -> ?default:string -> string -> string
+    method paramAll: ?meth:meth -> string -> string list
+    method params: (string * string) list
+    method params_GET: (string * string) list
+    method params_POST: (string * string) list
+    method cookies: (string * string) list option
+    method authorization: auth_info option
+  end
+
+class type response = object
+    inherit message
+    method code: int
+    method setCode: int -> unit
+    method status: status
+    method setStatus: status -> unit
+    method reason: string
+    method setReason: string -> unit
+    method statusLine: string
+    method setStatusLine: string -> unit
+    method isInformational: bool
+    method isSuccess: bool
+    method isRedirection: bool
+    method isClientError: bool
+    method isServerError: bool
+    method isError: bool
+    method addBasicHeaders: unit
+    method contentType: string
+    method setContentType: string -> unit
+    method contentEncoding: string
+    method setContentEncoding: string -> unit
+    method date: string
+    method setDate: string -> unit
+    method expires: string
+    method setExpires: string -> unit
+    method server: string
+    method setServer: string -> unit
+  end
+
+class type connection =
+  object
+    method getRequest: request option
+    method respond_with: response -> unit
+    method close: unit
+  end
+class type daemon =
+  object
+    method accept: connection
+    method getRequest: request * connection
+  end
+
+type daemon_spec = {
+  address: string;
+  auth: (string * auth_info) option;
+  callback: request -> out_channel -> unit;
+  mode: daemon_mode;
+  port: int;
+  root_dir: string option;
+  exn_handler: (exn -> out_channel -> unit) option;
+  timeout: int option;
+  auto_close: bool;
+}
+
diff --git a/0.1.4-2/http_types.mli b/0.1.4-2/http_types.mli
new file mode 100644 (file)
index 0000000..82967c5
--- /dev/null
@@ -0,0 +1,459 @@
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2007> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library 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
+*)
+
+(** Type definitions *)
+
+  (** HTTP version, actually only 1.0 and 1.1 are supported. Note that
+  'supported' here means only 'accepted inside a HTTP request line', no
+  different behaviours are actually implemented depending on HTTP version *)
+type version =
+  [ `HTTP_1_0
+  | `HTTP_1_1
+  ]
+
+  (** HTTP method, actually only GET and POST methods are supported *)
+type meth =
+  [ `GET
+  | `POST
+  ]
+
+  (** Daemon behaviour wrt request handling. `Single mode use a single process
+  to handle all requests, no request is served until a previous one has been
+  fully served. `Fork mode fork a new process for each request, the new process
+  will execute the callback function and then exit. `Thread mode create a new
+  thread for each request, the new thread will execute the callback function and
+  then exit, threads can communicate using standard OCaml Thread library. *)
+type daemon_mode = [ `Single | `Fork | `Thread ]
+
+  (** A TCP server is a function taking an address on which bind and listen for
+  connections, an optional timeout after which abort client connections and a
+  callback function which in turn takes an input and an output channel as
+  arguments. After receiving this argument a TCP server sits and waits for
+  connection, on each connection it apply the callback function to channels
+  connected to client. *)
+type tcp_server =
+  sockaddr:Unix.sockaddr -> timeout:int option ->
+  (in_channel -> out_channel -> unit) ->
+    unit
+
+  (** authentication information *)
+type auth_info =
+  [ `Basic of string * string (* username, password *)
+(*   | `Digest of ...  (* TODO digest authentication *) *)
+  ]
+
+  (** @see "RFC2616" informational HTTP status *)
+type informational_substatus =
+  [ `Continue
+  | `Switching_protocols
+  ]
+
+  (** @see "RFC2616" success HTTP status *)
+type success_substatus =
+  [ `OK
+  | `Created
+  | `Accepted
+  | `Non_authoritative_information
+  | `No_content
+  | `Reset_content
+  | `Partial_content
+  ]
+
+  (** @see "RFC2616" redirection HTTP status *)
+type redirection_substatus =
+  [ `Multiple_choices
+  | `Moved_permanently
+  | `Found
+  | `See_other
+  | `Not_modified
+  | `Use_proxy
+  | `Temporary_redirect
+  ]
+
+  (** @see "RFC2616" client error HTTP status *)
+type client_error_substatus =
+  [ `Bad_request
+  | `Unauthorized
+  | `Payment_required
+  | `Forbidden
+  | `Not_found
+  | `Method_not_allowed
+  | `Not_acceptable
+  | `Proxy_authentication_required
+  | `Request_time_out
+  | `Conflict
+  | `Gone
+  | `Length_required
+  | `Precondition_failed
+  | `Request_entity_too_large
+  | `Request_URI_too_large
+  | `Unsupported_media_type
+  | `Requested_range_not_satisfiable
+  | `Expectation_failed
+  ]
+
+  (** @see "RFC2616" server error HTTP status *)
+type server_error_substatus =
+  [ `Internal_server_error
+  | `Not_implemented
+  | `Bad_gateway
+  | `Service_unavailable
+  | `Gateway_time_out
+  | `HTTP_version_not_supported
+  ]
+
+type informational_status = [ `Informational of informational_substatus ]
+type success_status = [ `Success of success_substatus ]
+type redirection_status = [ `Redirection of redirection_substatus ]
+type client_error_status = [ `Client_error of client_error_substatus ]
+type server_error_status = [ `Server_error of server_error_substatus ]
+
+type error_status =
+  [ client_error_status
+  | server_error_status
+  ]
+
+  (** HTTP status *)
+type status =
+  [ informational_status
+  | success_status
+  | redirection_status
+  | client_error_status
+  | server_error_status
+  ]
+
+type status_code = [ `Code of int | `Status of status ]
+
+  (** File sources *)
+type file_source =
+  | FileSrc of string           (** filename *)
+  | InChanSrc of in_channel     (** input channel *)
+
+  (** {2 Exceptions} *)
+
+  (** invalid header encountered *)
+exception Invalid_header of string
+
+  (** invalid header name encountered *)
+exception Invalid_header_name of string
+
+  (** invalid header value encountered *)
+exception Invalid_header_value of string
+
+  (** unsupported or invalid HTTP version encountered *)
+exception Invalid_HTTP_version of string
+
+  (** unsupported or invalid HTTP method encountered *)
+exception Invalid_HTTP_method of string
+
+  (** invalid HTTP status code integer representation encountered *)
+exception Invalid_code of int
+
+  (** invalid URL encountered *)
+exception Malformed_URL of string
+
+  (** invalid query string encountered *)
+exception Malformed_query of string
+
+  (** invalid query string part encountered, arguments are parameter name and
+  parameter value *)
+exception Malformed_query_part of string * string
+
+  (** invalid request URI encountered *)
+exception Malformed_request_URI of string
+
+  (** malformed cookies *)
+exception Malformed_cookies of string
+
+  (** malformed request received *)
+exception Malformed_request of string
+
+  (** malformed response received, argument is response's first line *)
+exception Malformed_response of string
+
+  (** a parameter you were looking for was not found *)
+exception Param_not_found of string
+
+  (** invalid HTTP status line encountered *)
+exception Invalid_status_line of string
+
+  (** an header you were looking for was not found *)
+exception Header_not_found of string
+
+  (** raisable by callbacks to make main daemon quit, this is the only
+  * 'clean' way to make start functions return *)
+exception Quit
+
+  (** raisable by callbacks to force a 401 (unauthorized) HTTP answer.
+  * This exception should be raised _before_ sending any data over given out
+  * channel.
+  * @param realm authentication realm (usually needed to prompt user) *)
+exception Unauthorized of string
+
+  (** {2 OO representation of HTTP messages} *)
+
+  (** HTTP generic messages. See {! Http_message.message} *)
+class type message = object
+
+    method version: version option
+    method setVersion: version -> unit
+
+    method body: string
+    method setBody: string -> unit
+    method bodyBuf: Buffer.t
+    method setBodyBuf: Buffer.t -> unit
+    method addBody: string -> unit
+    method addBodyBuf: Buffer.t -> unit
+
+    method addHeader: name:string -> value:string -> unit
+    method addHeaders: (string * string) list -> unit
+    method replaceHeader: name:string -> value:string -> unit
+    method replaceHeaders: (string * string) list -> unit
+    method removeHeader: name:string -> unit
+    method hasHeader: name:string -> bool
+    method header: name:string -> string
+    method headers: (string * string) list
+
+    method clientSockaddr: Unix.sockaddr
+    method clientAddr: string
+    method clientPort: int
+
+    method serverSockaddr: Unix.sockaddr
+    method serverAddr: string
+    method serverPort: int
+
+    method toString: string
+    method serialize: out_channel -> unit
+
+  end
+
+  (** HTTP requests *)
+class type request = object
+
+      (** an HTTP request is a flavour of HTTP message *)
+    inherit message
+
+      (** @return request method *)
+    method meth: meth
+
+      (** @return requested URI (including query string, fragment, ...) *)
+    method uri: string
+
+      (** @return requested path *)
+    method path: string
+
+      (** lookup a given parameter
+      @param meth if given restrict the lookup area (e.g. if meth = POST than
+        only parameters received via POST are searched), if not given both GET
+        and POST parameter are searched in an unspecified order (actually the
+        implementation prefers POST parameters but this is not granted, you've
+        been warned)
+      @param default if provided, this value will be returned in case no
+        parameter of that name is available instead of raising Param_not_found
+      @param name name of the parameter to lookup
+      @return value associated to parameter name
+      @raise Param_not_found if parameter name was not found *)
+    method param: ?meth:meth -> ?default:string -> string -> string
+
+      (** like param above but return a list of values associated to given
+      parameter (a parameter could be defined indeed more than once: passed more
+      than once in a query string or passed both insider the url (the GET way)
+      and inside message body (the POST way)) *)
+    method paramAll: ?meth:meth -> string -> string list
+
+      (** @return the list of all received parameters *)
+    method params: (string * string) list
+
+      (** @return the list of all parameters received via GET *)
+    method params_GET: (string * string) list
+
+      (** @return the list of all parameter received via POST *)
+    method params_POST: (string * string) list
+
+    method cookies: (string * string) list option
+
+      (** @return authorization information, if given by the client *)
+    method authorization: auth_info option
+
+  end
+
+  (** HTTP responses *)
+class type response = object
+
+    inherit message
+
+      (** @return response code *)
+    method code: int
+
+      (** set response code *)
+    method setCode: int -> unit
+
+      (** @return response status *)
+    method status: status
+
+      (** set response status *)
+    method setStatus: status -> unit
+
+      (** @return reason string *)
+    method reason: string
+
+      (** set reason string *)
+    method setReason: string -> unit
+
+      (** @return status line *)
+    method statusLine: string
+
+      (** set status line
+      @raise Invalid_status_line if an invalid HTTP status line was passed *)
+    method setStatusLine: string -> unit
+
+      (** response is an informational one *)
+    method isInformational: bool
+
+      (** response is a success one *)
+    method isSuccess: bool
+
+      (** response is a redirection one *)
+    method isRedirection: bool
+
+      (** response is a client error one *)
+    method isClientError: bool
+
+      (** response is a server error one *)
+    method isServerError: bool
+
+      (** response is either a client error or a server error response *)
+    method isError: bool
+
+      (** add basic headers to response, see {!Http_daemon.send_basic_headers}
+      *)
+    method addBasicHeaders: unit
+
+      (** facilities to access some frequently used headers *)
+
+      (** @return Content-Type header value *)
+    method contentType: string
+
+      (** set Content-Type header value *)
+    method setContentType: string -> unit
+
+      (** @return Content-Encoding header value *)
+    method contentEncoding: string
+
+      (** set Content-Encoding header value *)
+    method setContentEncoding: string -> unit
+
+      (** @return Date header value *)
+    method date: string
+
+      (** set Date header value *)
+    method setDate: string -> unit
+
+      (** @return Expires header value *)
+    method expires: string
+
+      (** set Expires header value *)
+    method setExpires: string -> unit
+
+      (** @return Server header value *)
+    method server: string
+
+      (** set Server header value *)
+    method setServer: string -> unit
+
+  end
+
+  (** {2 Daemon specification} *)
+
+  (** daemon specification, describe the behaviour of an HTTP daemon.
+  *
+  * The default daemon specification is {!Http_daemon.default_spec}
+  *)
+type daemon_spec = {
+  address: string;
+    (** @param address adress on which daemon will be listening, can be both a
+    * numeric address (e.g. "127.0.0.1") and an hostname (e.g. "localhost") *)
+  auth: (string * auth_info) option;
+    (** authentication requirements (currently only basic authentication is
+    * supported). If set to None no authentication is required. If set to Some
+    * ("realm", `Basic ("foo", "bar")), only clients authenticated with baisc
+    * authentication, for realm "realm", providing username "foo" and password
+    * "bar" are accepted; others are rejected with a 401 response code *)
+  callback: request -> out_channel -> unit;
+    (** function which will be called each time a correct HTTP request will be
+    * received. 1st callback argument is an Http_types.request object
+    * corresponding to the request received; 2nd argument is an output channel
+    * corresponding to the socket connected to the client *)
+  mode: daemon_mode;
+    (** requests handling mode, it can have three different values:
+    * - `Single -> all requests will be handled by the same process,
+    * - `Fork   -> each request will be handled by a child process,
+    * - `Thread -> each request will be handled by a (new) thread *)
+  port: int;  (** TCP port on which the daemon will be listening *)
+  root_dir: string option;
+    (** directory to which ocaml http will chdir before starting handling
+    * requests; if None, no chdir will be performed (i.e. stay in the current
+    * working directory) *)
+  exn_handler: (exn -> out_channel -> unit) option;
+    (** what to do when executing callback raises an exception.  If None, the
+    * exception will be re-raised: in `Fork/`Thread mode the current
+    * process/thread will be terminated. in `Single mode the exception is
+    * ignored and the client socket closed. If Some callback, the callback will
+    * be executed before acting as per None; the callback is meant to perform
+    * some clean up actions, like releasing global mutexes in `Thread mode *)
+  timeout: int option;
+    (** timeout in seconds after which an incoming HTTP request will be
+    * terminated closing the corresponding TCP connection; None disable the
+    * timeout *)
+  auto_close: bool;
+    (** whether ocaml-http will automatically close the connection with the
+     * client after callback has completed its execution. If set to true, close
+     * will be attempted no matter if the callback raises an exception or not *)
+}
+
+  (** {2 OO representation of other HTTP entities} *)
+
+  (** an HTTP connection from a client to a server *)
+class type connection =
+  object
+      (** @return next request object, may block if client hasn't submitted any
+      request yet, may be None if client request was ill-formed *)
+    method getRequest: request option
+
+      (** respond to client sending it a response *)
+    method respond_with: response -> unit
+
+      (** close connection to client. Warning: this object can't be used any
+      longer after this method has been called *)
+    method close: unit
+  end
+
+  (** an HTTP daemon *)
+class type daemon =
+  object
+      (** @return a connection to a client, may block if no client has connected
+      yet *)
+    method accept: connection
+
+      (** shortcut method, blocks until a client has submit a request and
+      return a pair request * connection *)
+    method getRequest: request * connection
+  end
+
diff --git a/0.1.4-2/http_user_agent.ml b/0.1.4-2/http_user_agent.ml
new file mode 100644 (file)
index 0000000..f5317d6
--- /dev/null
@@ -0,0 +1,101 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library 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
+*)
+
+open Printf
+
+open Http_common
+
+exception Http_error of (int * string)  (* code, body *)
+
+let http_scheme_RE = Pcre.regexp ~flags:[`CASELESS] "^http://"
+let url_RE = Pcre.regexp "^([\\w.-]+)(:(\\d+))?(/.*)?$"
+
+let tcp_bufsiz = 4096 (* for TCP I/O *)
+
+let parse_url url =
+  try
+    let subs =
+      Pcre.extract ~rex:url_RE (Pcre.replace ~rex:http_scheme_RE url)
+    in
+    (subs.(1),
+    (if subs.(2) = "" then 80 else int_of_string subs.(3)),
+    (if subs.(4) = "" then "/" else subs.(4)))
+  with exc ->
+    failwith
+      (sprintf "Can't parse url: %s (exception: %s)"
+        url (Printexc.to_string exc))
+
+let init_socket addr port =
+  let inet_addr = (Unix.gethostbyname addr).Unix.h_addr_list.(0) in
+  let sockaddr = Unix.ADDR_INET (inet_addr, port) in
+  let suck = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
+  Unix.connect suck sockaddr;
+  let outchan = Unix.out_channel_of_descr suck in
+  let inchan = Unix.in_channel_of_descr suck in
+  (inchan, outchan)
+
+let submit_request kind url =
+  let (address, port, path) = parse_url url in
+  let (inchan, outchan) = init_socket address port in
+  let req_string = match kind with `GET -> "GET" | `HEAD -> "HEAD" in
+  output_string outchan (sprintf "%s %s HTTP/1.0\r\n" req_string path);
+  output_string outchan (sprintf "Host: %s\r\n\r\n" address);
+  flush outchan;
+  (inchan, outchan)
+
+let head url =
+  let (inchan, outchan) = submit_request `HEAD url in
+  let (_, status) = Http_parser.parse_response_fst_line inchan in
+  (match code_of_status status with
+  | 200 -> ()
+  | code -> raise (Http_error (code, "")));
+  let buf = Http_misc.buf_of_inchan inchan in
+  close_in inchan; (* close also outchan, same fd *)
+  Buffer.contents buf
+
+let get_iter ?(head_callback = fun _ _ -> ()) callback url =
+  let (inchan, outchan) = submit_request `GET url in
+  let buf = String.create tcp_bufsiz in
+  let (_, status) = Http_parser.parse_response_fst_line inchan in
+  (match code_of_status status with
+  | 200 -> ()
+  | code -> raise (Http_error (code, "")));
+  let headers = Http_parser.parse_headers inchan in
+  head_callback status headers;
+  (try
+    while true do
+      match input inchan buf 0 tcp_bufsiz with
+      | 0 -> raise End_of_file
+      | bytes when bytes = tcp_bufsiz ->  (* buffer full, no need to slice it *)
+          callback buf
+      | bytes when bytes < tcp_bufsiz ->  (* buffer not full, slice it *)
+          callback (String.sub buf 0 bytes)
+      | _ -> (* ( bytes < 0 ) || ( bytes > tcp_bufsiz ) *)
+          assert false
+    done
+  with End_of_file -> ());
+  close_in inchan (* close also outchan, same fd *)
+
+let get ?head_callback url =
+  let buf = Buffer.create 10240 in
+  get_iter ?head_callback (Buffer.add_string buf) url;
+  Buffer.contents buf
+
diff --git a/0.1.4-2/http_user_agent.mli b/0.1.4-2/http_user_agent.mli
new file mode 100644 (file)
index 0000000..79f2d69
--- /dev/null
@@ -0,0 +1,53 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU Library General Public License as
+  published by the Free Software Foundation, version 2.
+
+  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 Library General Public License for more details.
+
+  You should have received a copy of the GNU Library 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
+*)
+
+(** Minimal implementation of an HTTP 1.0/1.1 client. Interface is similar to
+ * Gerd Stoplmann's Http_client module. Implementation is simpler and doesn't
+ * handle HTTP redirection, proxies, ecc. The only reason for the existence of
+ * this module is for performances and incremental elaboration of response's
+ * bodies *)
+
+open Http_types
+
+exception Http_error of (int * string)  (* code, body *)
+
+  (** @param head_callback optional calllback invoked on response's status and
+   * headers. If not provided no callback will be invoked
+   * @param url an HTTP url
+   * @return HTTP response's body
+   * @raise Http_error when response code <> 200 *)
+val get:
+  ?head_callback:(status -> (string * string) list -> unit) ->
+  string ->
+    string
+
+  (** as above but iter callback function on HTTP response's body instead of
+   * returning it as a string *)
+val get_iter:
+  ?head_callback:(status -> (string * string) list -> unit) ->
+  (string -> unit) -> string ->
+    unit
+
+  (** @param url an HTTP url
+   * @return HTTP HEAD raw response
+   * @raise Http_error when response code <> 200 *)
+val head: string -> string
+
diff --git a/0.1.4-2/mt/http_threaded_tcp_server.ml b/0.1.4-2/mt/http_threaded_tcp_server.ml
new file mode 100644 (file)
index 0000000..acdef61
--- /dev/null
@@ -0,0 +1,23 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 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 General Public License for more details.
+
+  You should have received a copy of the GNU 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
+*)
+
+let serve callback arg = ignore (Thread.create callback arg)
+
diff --git a/0.1.4-2/non_mt/http_threaded_tcp_server.ml b/0.1.4-2/non_mt/http_threaded_tcp_server.ml
new file mode 100644 (file)
index 0000000..9c92d71
--- /dev/null
@@ -0,0 +1,26 @@
+
+(*
+  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
+
+  Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
+
+  This program is free software; you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation; either version 2 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 General Public License for more details.
+
+  You should have received a copy of the GNU 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
+*)
+
+let serve _ _ =
+  failwith
+    ("Threaded server not supported by the non threaded version " ^
+     "of ocaml-http, please link against http_mt.cm{,x}a")
+