--- /dev/null
+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
+cookie_lexer.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_misc.cmi:
+http_parser.cmi: http_types.cmi
+http_parser_sanity.cmi:
+http_request.cmi: http_types.cmi
+http_response.cmi: http_types.cmi
+http_tcp_server.cmi: http_types.cmi
+http_threaded_tcp_server.cmi:
+http_types.cmi:
+http_user_agent.cmi: http_types.cmi
--- /dev/null
+#use "topfind";;
+#require "unix";;
+#require "pcre";;
+#require "netstring";;
+#load "http.cma";;
--- /dev/null
+
+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
+
--- /dev/null
+
+ 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!
+
--- /dev/null
+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"
--- /dev/null
+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
--- /dev/null
+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
+
--- /dev/null
+
+OCaml HTTP is a simple OCaml library for creating HTTP daemons, it is largely
+inspired to the Perl's HTTP:: modules family.
+
--- /dev/null
+- support for HTTPS
--- /dev/null
+(*
+ 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
+
--- /dev/null
+ocaml-http (0.1.4-3) unstable; urgency=low
+
+ * rebuild with OCaml 3.11
+ * debian/control
+ - refresh build-dependencies for the transition
+ - add Vcs-* fields pointing to HELM's repository and browser
+ - add missing ${misc:Depends}, thanks lintian!
+ - set package section to "ocaml"
+ - add Homepage field
+ * debian/rules: use ocaml.mk as a CDBS "rules" snippet
+ * debian/*.in: use more abstract substitution variable to avoid
+ hard-coding assumption on stdlib location
+
+ -- Stefano Zacchiroli <zack@debian.org> Thu, 19 Mar 2009 11:06:12 +0100
+
+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
--- /dev/null
+Source: ocaml-http
+Section: ocaml
+Priority: optional
+Maintainer: Stefano Zacchiroli <zack@debian.org>
+Build-Depends:
+ debhelper (>> 5.0.0),
+ cdbs,
+ dh-ocaml,
+ ocaml-nox,
+ camlp4,
+ ocaml-findlib,
+ libpcre-ocaml-dev,
+ libocamlnet-ocaml-dev (>= 2.2.9-6)
+Standards-Version: 3.7.2
+Vcs-Svn: svn://mowgli.cs.unibo.it/trunk/helm/software/DEVEL/ocaml-http
+Vcs-Browser: http://helm.cs.unibo.it/websvn/listing.php?path=/trunk/helm/software/DEVEL/ocaml-http/
+Homepage: http://upsilon.cc/~zack/hacking/software/ocaml-http/
+
+Package: libhttp-ocaml-dev
+Architecture: any
+Depends:
+ ocaml-nox-${F:OCamlABI},
+ libpcre-ocaml-dev,
+ libocamlnet-ocaml-dev,
+ ${misc:Depends}
+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.
--- /dev/null
+
+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
+
--- /dev/null
+@OCamlStdlibDir@
--- /dev/null
+examples/*.ml
--- /dev/null
+#!/usr/bin/make -f
+include /usr/share/cdbs/1/class/makefile.mk
+include /usr/share/cdbs/1/rules/debhelper.mk
+include /usr/share/cdbs/1/rules/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)
--- /dev/null
+tagsUrl=svn+ssh://zacchiro@mowgli.cs.unibo.it/local/svn/helm/tags/ocaml-http
--- /dev/null
+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))
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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
+*)
+
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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
+
+
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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: " ^
+ "'<method> <url> <version>'" ^
+ "<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;
+ }
+
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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)
+
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+(*
+ 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
+
--- /dev/null
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+(*
+ 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;
+}
+
--- /dev/null
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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
+
--- /dev/null
+
+(*
+ 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)
+
--- /dev/null
+
+(*
+ 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")
+
projects / helm.git / commitdiff