diff --git a/.gitmodules b/.gitmodules index 8ddd1d5bf..8458041b2 100644 --- a/.gitmodules +++ b/.gitmodules @@ -10,3 +10,6 @@ [submodule "packages/zlib"] path = packages/zlib url = git://yap.git.sourceforge.net/gitroot/yap/zlib +[submodule "packages/http"] + path = packages/http + url = ssh://vsc@yap.git.sourceforge.net/gitroot/yap/http diff --git a/packages/http b/packages/http new file mode 160000 index 000000000..77744ad3a --- /dev/null +++ b/packages/http @@ -0,0 +1 @@ +Subproject commit 77744ad3a901eb97cafd95c1e0ac1b89d3859b18 diff --git a/packages/http/ChangeLog b/packages/http/ChangeLog deleted file mode 100644 index 14a930215..000000000 --- a/packages/http/ChangeLog +++ /dev/null @@ -1,792 +0,0 @@ -[Sep 13 2009] - - * ADDED: Process HTTP DELETE, OPTIONS and TRACE methods. Torbjörn Lager. - -[Aug 27 2009] - - * FIXED: JSON Mimetype handling. Matt Lilley. - -[Aug 25 2009] - - * ENHANCED: Made the detection of JSON more flexible. - - * ENHANCED: JSON indentation handling. Matt Lilley. - -[Aug 21 2009] - - * ENHANCED: Bug#414: Get rid of pool/4 in HTTP request structures. - Lourens van der Meij. - -[Aug 18 2009] - - * CLEANUP: Bug#413: Complete 'make distclean'. Feliks Kluzniak - -[Aug 16 2009] - - * DOC: Provide documentation of http_dispatch.pl through PlDoc - - * ADDED: http_redirect/3 to simplify writing redirect handlers and enhance the reflexive capabilities of the HTTP server. - -[Aug 14 2009] - - * ADDED: Allow grouping of HTTP parameters - - * ADDED: Support disjunctive types in HTTP parameter handling - - * CLEANUP: Use meta_predicate for json_convert.pl - -[Aug 13 2009] - - * ADDED: type nonneg to http_parameters/3. - - * ADDED: PlDoc wiki to handle references as module:name/arity. - - * ADDED: Allow hooking http_parameters type checking and conversion. - - * ADDED: &(Int) is written as &#Int; in html_write. Clarified the documentation. - - * ADDED: Types list(Type), boolean and atom to http_parameters/3. - -[Aug 12 2009] - - * ENHANCED: Better handing of \[...] in cross-referencer - -[Aug 10 2009] - - * FIXED: Properly deal with external resources - - * FIXED: Module-handling of body//1 and head//1 hooks in html_write.pl - - * FIXED: Actually handle timout of the threaded HTTP deamon. The connection is now dropped after 60 seconds inactivity of the client. - - * FIXED: HTTP server DoS if the clients sends an empty Cookie header. - -[Jul 21 2009] - - * MODIFIED: Make initialization/1 ISO compliant - This patch is a modest cleanup to the implementation of '$load_file'/3 - from init.pl and provides an ISO compatible implementation of - initialization/1. This executes the argument goal *after* loading the - file rather than when encountering the directive. Often this makes no - difference, but notably load_foreign_library/1 is an exception. - Therefore we added use_foreign_library/1,2 that act as a directive and - provides proper integration with saved-states automatically. Loading - code using initialization(load_foreign_library(...)) will load the - library immediately and issue a warning. - - See initialization/1,2 for details and further hints for dealing with - possible compatibility problems. -[Jul 1 2009] - - * ADDED: Allow \-escape inside html(\List). - - * ADDED: Return the fact that a handler is a prefix handler in http_current_handler/3. - - * ADDED: Allow for http_handler(root(find/concept), ...). I.e., allow for component/component without quotes, - -[Jun 29 2009] - - * FIXED: http_currect_session(-, ?) did not generate (all) sessions. - - * ADDED: http_close_session/1 - -[Jun 23 2009] - - * MODIFIED: Added option unsafe(Bool) to http_reply_file/3. This option is by default false, which causes this predicate to refuse serving files with an absolute path, a path outside the working directory or, if an alias(Path) is used, outside the root of the alias. - If you want to serve such files, you must provide unsafe(true) explicitely. - - * ADDED: Reply with 400 Bad Request on illegal HTTP requests - -[Mar 19 2009] - - * CLEANUP: Removed all trailing whitespace from all source-files. This avoids many GIT (merge) warnings. -[Mar 12 2009] - - * FIXED: Avoid race condition in session management. Jacco van Ossenbruggen. - - * MODIFIED: Renamed concat_atom/2,3 into atomic_list_concat/2,3 for compatibility. Moved the old predicates into library(backcomp). It is adviced to update your code, but 99% of the code will remain working because the old definitions are autoloaded. - -[Feb 27 2009] - - * FIXED: http_current_server/2 was broken with meta_predicate introduction. - -[Feb 25 2009] - - * ENHANCED: Use a cache for http_in_session/1 to avoid repetitive access to the CGI stream object. - - * FIXED: make http_current_request/1 semidet again. Added is_cgi_stream/1 for testing whether we are in a CGI context without raising an error. - -[Feb 23 2009] - - * ENHANCED: Allow the start broadcast-message of the HTTP server to throw an exception. This allows for defining additional policy-handlers as broadcast plugins. - -[Feb 20 2009] - - * ADDED: Use nlink property of stream to close the logfile - -[Feb 15 2009] - - * FIXED: Proper reply on partial content (use 206 reply; fix length computation) - -[Feb 3 2009] - - * ADDED: HTTP server support for byte-ranges of files. - - * ADDED: Parsing of HTTP Range field into a structured term - -[Jan 30 2009] - - * ENHANCED: HTTP error handler in formulating replies from a file. - -[Jan 29 2009] - - * CLEANUP: be careful, but to not crash on unexpected event on CGI streams. - -[Jan 28 2009] - - * ADDED: When matching a prefix-path in http_dispatch, makethe remainder - of the path available through path_info(PathInfo) in the request. - -[Jan 22 2009] - - * ADDED: http_in_session/1 to find the current session but do not raise an - exception if it doesn't exist. - - * ADDED: http_current_handler/3 to get access to accumulated options on a path - -[Jan 20 2009] - - * FIXED: ?- edit(HTTPLocation). Module-handling issue in locate/3 in http_dispatch.pl - - * CLEANUP: http_wrapper.pl: PlDoc and meta-predicate handler - - * FIXED: http_open/3: avoid leaking a socket-handle if the tcp_connect - raises an exception. - -[Jan 9 2009] - - * ADDED: library(http/html_head), tracking CSS and Javascript dependencies and - merging them automatically into the HTML element. Imported from - Cliopatria project. -[Dec 20 2008] - - * ADDED: http_log_close/1 to provide for cooperation with logrotate - -[Dec 18 2008] - - * MSFIX: Accept invalid cookie options sent by Microsoft (httponly). Matt Lilley. -[Nov 26 2008] - - * FIXED: Update HTTP header definition for a token to RFC 2616. Matt Lilley -[Oct 9 2008] - - * ADDED: More flexible support for HTTP 503 (service unavailable) replies. - -[Oct 8 2008] - - * FIXED: drop body of HTTP 304 response - -[Oct 7 2008] - - * MODIFIED: Generalized the HTTP dispatch module authentication interface. - * Instead of returning an atom representing the authenticated - user, the hook must deliver a list of options that is added to - the request. The new API allows for multiple authentication - hooks on the same location. It is used by PlDoc to provide host - access control. See doc_access.pl from the PlDoc package. - -[Oct 6 2008] - - * FIXED: Updated http_error to deal with new HTTP server - -[Oct 5 2008] - - * ADDED: Support http_path.pl specifications in http_handler/3. - - * MODIFIED: library(http/http_dispatch): Handler changes. - :- http_handler(prefix(Path), Action, Options) is now - translated into http_handler(Path, Action, [prefix|Options]) with a - warning. Future versions will drop the prefix(Path) syntax as it - becomes ambiguous after integrating http_path.pl with the handler - declarations. - - * ADDED: html_write.pl: Support href(loc+[name1(value1),name2(value2)]) - -[Oct 3 2008] - - * ADDED: Support encode(Value) and describe http location handling. - - * ADDED: http_location_by_id/2 and location_by_id(ID) to html_write values. - Suggested by Jacco van Ossenbruggen. - -[Oct 2 2008] - - * ADDED: Allow redefining the HTTP server address output of non-200 pages. - - * ADDED: Provide hostname in http error messages - - * FIXED: File descriptor leak in http session management. - -[Oct 1 2008] - - * FIXED: undefined parse_url_ex/3 in http_open.pl (deals with redirections) - -[Sep 30 2008] - - * ADDED: Support for proxy routes in HTTP session management. Also cleanup - and additional tests in library(http/http_session). - -[Sep 11 2008] - - * PORT: Add AC_PREREQ to configure.h for systems that auto-select autoconf - versions. After tip by Ulrich Neumerkel. - -[Aug 30 2008] - - * FIXED: use csym instead of csymf for valid HTTP fieldname characters. Edward Blake. - -[Aug 11 2008] - - * INSTALL: Remove all configure files from the git repository -[Aug 5 2008] - - * MODIFIED: http_read_request/3 throws error on illegal request and http_wrapper/5 - maps these to internal server errors. - - * MODIFIED: http_open/3 now raises an error if the URL is not well-formed - (used to fail silently). - -[Jul 31 2008] - - * FIXED: handling setting http:chunked_transfer(never). Yves Raimond. -[Jul 3 2008] - - * MODIFIED: Deleted the `after' option processing. Modern code can start a - thread to deal with formulating a reply and start procesing after the reply - has been sent. - -[Jul 2 2008] - - * ADDED: Support for HTTP 503 (service unavailable) - - * ADDED: Support for options chunked and spawn in http_handler/3. - -[Jun 27 2008] - - * FIXED: Read JSON reply when using chunked encoding - - * FIXED: Post header when using data in CGI format (used by JSON posts) - -[Jun 25 2008] - - * MODIFIED: http_get/3 using to(atom) or to(codes) perform UTF-8 decoding if - the content type is declared as UTF-8. - -[Jul 2 2008] - - * ADDED: Bug#365: timeout support for the HTTP client library. Keri Harris. -[Jun 16 2008] - - * ENHANCED: Reduce HTTP header parsing time - - * ENHANCED: Reduce overhead of deleting dead HTTP sessions - -[May 21 2008] - - * FIXED: atom_json_term(-,+,+): typo. Torbjörn Lager - -[Apr 28 2008] - - * ENHANCED: Perform a GC at the end of a communication with a client. Note that - at that moment we have little active memory (=cheap GC), while otherwise we may - remain idle for a long time with large stacks. -[Apr 2 2008] - - * FIXED: Throw an exception in illegal input wo json_write/3. - -[Apr 1 2008] - - * FIXED: Close the server socket in http_stop_server/2. John Stewart. - -[Mar 28 2008] - - * MODIFIED: html//1 interpretation of Module:Term. Previously this acted as - \(Module:Term), now it acts as Module:html(Term), interpreting an entire - specification relative to a module. - -[Mar 20 2008] - - * FIXED: Make HTTP status messages work when using the xhtml dialect - -[Mar 10 2008] - - * FIXED: HTTP accept loop to deal properly with termination - -[Mar 9 2008] - - * FIXED: Various issues around JSON booleans and null. Michiel Hildebrand. - -[Feb 26 2008] - - * FIXED: Avoid error on destroyed message queue in http_stop_server/3. - Ferreira Maurizio. -[Feb 8 2008] - - * ADDED: Hook to expand HTML head material. - -[Feb 7 2008] - - * ADDED: html_receive//2 to allow for post-processing of posted messages - - * MODIFIED: http_post//2 now executes embedded commands delayed. - -[Feb 1 2008] - - * FIXED: html_write.pl: avoid multiple receivers for xmlns. - -[Jan 23 2008] - - * PORT: Bug#346: Allow overriding COFLAGS and CWFLAGS in package - configuration. Keri Harris. - -[Jan 22 2008] - - * DOC: Applied various patches. Item#272, Ulrich Neumerkel. - -[Dec 22 2007] - - * FIXED: Write JSON newlines always as \n. Also write all control characters - that have no defined escape (< ' ') as \uXXXX. Michiel Hildebrand. - - * FIXED: json_read/2 for strings holding double-quotes. - -[Dec 18 2007] - - * WORKAROUND: Emit no DOCTYPE header of the doctype is set to ''. This avoids - a bug in Microsoft IE AJAX processing. - -[Dec 16 2007] - - * FIXED: recursive handling of lists in prolog_to_json/2. Michiel Hildebrand - -[Dec 15 2007] - - * FIXED: is_json_term/2 for pairs. Michiel Hildebrand. - -[Dec 13 2007] - - * ADDED: A predefined `head' receiver for http_post//2 and a predefined `xmlns' - receiver used by xhtml_ns//2 to define XML namespaces in xhml mode. Clarified - documentation of the html_write library with examples on how to deal with HTML - head material. - -[Dec 11 2007] - - * DOC: various enhancement to the presentation of pldoc @keywords - -[Dec 7 2007] - - * MODIFIED: renamed library(http/http_chunked) to library(http/http_stream). - Added range-limited streams - -[Dec 5 2007] - - * ADDED: library(http/http_json.pl), integrating JSON support into the - HTTP libraries. - -[Dec 4 2007] - - * ADDED: library(http/json), providing (still incomplete) JSON support - -[Nov 16 2007] - - * ENHANCED: Bug#323: no longer force bgcolor=white in pagebody//1. Chris Sutton. - -[Nov 9 2007] - - * ADDED: type between(Low, High) for numerical values - -[Nov 6 2007] - - * ADDED: post/receive mechanism to modularize CSS and Javascript support in - library(html_write). Documented using PlDoc LaTeX backend - -Oct 1, 2007 - - * ADDED: http_stop_server/2 to stop a running HTTP server. - -Sep 26, 2007 - - * ADDED: http_set_authorization/2 in library(http/http_open) to provide - authorization defauls. - - * ADDED: authorization(basic(User, Passowrd)) to the options of http_open/3. - Now generates a permission error for common applicable 4xx errors. - -Jun 21, 2007 - - * Avoid leaking stream handle in http_get/3 on chunked encoding. - -Jun 20, 2007 - - * ENHANCED: Support chunked encoding in http_get/3 and http_post/4 on the - new http_chunked library, reducing memory usage and overhead. - -Jun 19, 2007 - - * ADDED: Support chunked encoding through library(http/http_open) based on - new http_chunked library. - -Jun 16, 2007 - - * ADDED: library(http/http_chunked). - -Jun 7, 2007 - - * ADDED: http_dispatch and http_authenticate libraries. - -Jun 1, 2007 - - * FIXED: Use new predicate_indicator frame attribute for safe error - handling. - -May 23, 2007 - - * FIXED: Preserve extra request-headers over redirect. Yves Raimond. - -May 20, 2007 - - * FIXED: redirection issues. Yves Raimond. - -Apr 12, 2007 - - * ADDED: .svg to mimetypes - -Apr 10, 2007 - - * FIXED: Forcing UTF-8 character set. - -Mar 22, 2007 - - * FIXED: Bug#269: time-stamp was emitted in current locale. - -Mar 19, 2007 - - * ADDED: Include name of parameter in type-errors detected by - http_parameters/2. - -Mar 15, 2007 - - * ADDED: Include peer in session management for better security. - * ADDED: Broadcast session start/end to allow deletion of derived - data. - -Mar 11, 2007 - - * FIXED: http_open/3: send Host: : if port is not 80. - -Mar 9, 2007 - - * ADDED: reply_html_page/2. To be documented - - * ADDED: Pass protocol(http/https) into request. - -Mar 7, 2007 - - * FIXED: handle throw(http_reply(moved_temporary(URL))) properly. - -Mar 6, 2007 - - * ADDED: final_url option to http_open/3 - -Mar 5, 2007 - - * MODIFIED: debug(header, ...) --> debug(http(header), ...) - - * ADDED: codes([Type], Codes) to http_post_data. - -Feb 26, 2007 - - * ADDED: Keep connections open on not_modified and replying files. - -Feb 9, 2007 - - * ADDED: Support for 302 (moved temporary) HTTP replies to the server. - -Feb 8, 2007 - - * ADDED: Map existence_error(http_location, URL) and - permission_error(http_location, access, URL) to appropriate HTTP - headers. - -Feb 2, 2007 - - * ADDED: Report status of stopped worker. - -Jan 24, 2007 - - * ADDED: Support for 303 (see other) HTTP replies to the server. - Yves Raimond. - -Jan 18, 2007 - - * ADDED: html_set_options/1 and html_current_option/1 to html_write.pl. - Allows for changing the document type as well as writing XHTML output - from the same DCG rules. - -Jan 15, 2007 - - * ADDED: Redirect support for 301 and 303. Yves Raimond. - -Dec 13, 2006 - - * FIXED: avoid passing reply_header option to convert hooks (conflict - with SGML plugin). - -Dec 12, 2006 - - * FIXED: Properly close sockets on errors in http_open/3. - -Dec 8, 2006 - - * ADDED: support for HEAD to http_open/3. - -Oct 31, 2006 - - * ENHANCED: Documentation - -Oct 30, 2006 - - * ADDED: Allow for A+B in attribute values. - -Sep 18, 2006 - - * FIXED: inetd_httpd: set stream encoding to octet to be able to handle - binary data. Nicos Angelopoulos. - -Aug 21, 2006 - - * FIXED: Quote & inside attribute values. - -Aug 10, 2006 - - * ENHANCED: Time printing in http_header.pl to use format_time/3. Faster - and proper implementation of daylight saving time. - -Aug 8, 2006 - - * FIXED: http_relative_path/2. - -Aug 7, 2006 - - * DEBUG: Do not generate debug info for library html_write.pl, as it makes - code using the library very hard to debug. - -Jun 30, 2006 - - * FIXED: dangling choicepoint in http_open/3. - - * ADDED: zero_or_more as parameter option to http_parameters/[2,3] - -Apr 11, 2006 - - * ADDED: http_parameters library - - * FIXED: properly handle the server closing the connection if the connection - is specified as Keep-alive in the client (http_get/3 and http_post/4). - -Feb 24, 2006 - - * Added http_error.pl to generate nice looking stack-traces. - -Feb 23, 2006 - - * Added http_session.pl and http:request_expansion/2 hook. - -Feb 16, 2006 - - * Added http_current_request/1 to get access to the currently executing - request. - -Feb 10, 2006 - - * Make http_post deal with Unicode data. - -Jan 20, 2006 - - * Map Host: : into host(Host), port(Port) when reading - HTTP requests. - -Jan 16, 2006 - - * Fixed redirect handling if the option to(Stream) is given. - Jacco van Ossenbruggen. - -Jan 11, 2006 - - * Added: handling of 302 redirect messages in http_get/3. - * Fix http_get/3 with sgml plugin and proxy option. Usenet, `mans'. - -Dec 10, 2005 - - * Enhanced robustness of the server to malicious clients by using - call_cleanup wrappers around the code doing the actual reply. Old - code lead to memory and file-descriptor leaking. - -Dec 7, 2005 - - * Added http_timestamp/2 to http_header.pl. Also changed the time - representation to be compatible to the current RFC1132 standard. - -Nov 16, 2005 - - * Avoid XPCE http servers to be garbage collected. - -Oct 17, 2005 - - * ADDED: Pass peer from threaded HTTP server to request. - - * ENHANCED: Use UTF-8 encoding for text by default. - -Sep 28, 2005 - - * FIXED: Regular expressions in xpce_httpd frontend. Wouter Jansweijer. - -Sep 23, 2005 - - * ADDED: .class to mimetypes.pl. - -Sep 7, 2005 - - * FIXED: handle connection error in http_get/3 gracefully. - -Sep 6, 2005 - - * FIXED: handle error in tcp_accept/3 gracefully. - -Sep 5, 2005 - - * ADDED: method(head) --> "HEAD". Matt Lilley. - -Apr 26, 2005 - - * ADDED: debug(sgml_plugin) and some missing use_module calls. Simplifies - debugging automatic conversion. - -Mar 4, 2005 - - * FIXED: Bug#24: open files binary. Fabien Todescato. - -Feb 11, 2005 - - * FIXED: empy header field eats next line as value. Chris Ritchey. - -Jan 4, 2005 - - * FIXED: Bug#2: Disconnect from POST replies. - -Sep 23, 2004 - - * FIXED: Ignore minor types when deciding which plugin to use for the - SGML plugin. - -Aug 30, 2004 - - * FIXED: Bug#179: Avoid XPCE dependency on strip_module/3. Sandro Hawke. - -Aug 16, 2004 - - * FIXED: Remove " from boundary=... HTTP-POST requests. Appears necessary - for posting to Tomcat servers. Also added explicit MIME-Version: 1.0 - to the header. - -Aug 12, 2004 - - * ADDED: form_data(+List) alternative to http_post/4. - - * ADDED: option reply_header(-Header) to get the full replied header for - GET and POST methods. Also added decoding of the SetCookie field. - -Aug 5, 2004 - - * ADDED: request_header(Name=Value) to http_open/3 - -Aug 3, 2004 - - * ADDED: keep_alive_timeout(Seconds) for multi-threaded server. - - * FIXED: remove choicepoints in http_open/3 - -Jul 31, 2004 - - * ADDED: http_current_worker/2 - -Jul 30, 2004 - - * ADDED: Allow explicit head and body in page//1 and page//2 - -Jul 21, 2004 - - * FIXED: Bug#166: Allow alternative responses (Sandro Hawke). - - * FIXED: Bug#168: Close connection on timeout (Sandro Hawke). - - * FIXED: Bug#165: Added reuseaddr (Sandro Hawke). - -Jul 18, 2004 - - * ENHANCED: handle `normal' errors silent (David Reitter) - -Jun 28, 2004 - - * ENHANCED: print server errors and continue - - * ADDED: SSL interface to threaded HTTP server - -Jun 21, 2004 - - * FIXED: Handling continue header required for POST to MS IIS servers. - Also more patches sending \r\n where required. With patches from - Mike Elston. - -Jun 16, 2004 - - * FIXED: make HTTP client library write header line terminate with - \r\n. Mike Elston. - -Jun 15, 2004 - - * FIXED: Undefined predicate strip_module/2 in thread_httpd.pl when - there is no access to XPCE. Dmitry. - - * ADDED: request_header(Name=Value) option to the option list of - http_get/3 and http_post/4 for adding user request fields. - - * ADDED: Map body throw(status(not_modified)) onto a "304 Not Modified" - page. Mike Elston. - -May 20, 2003 - - * DOCS: Documented http_post_data/3 - - * ADDED: form([Name=Value, ...]) input type to http_post_data/3 - -May 12, 2003 - - * FIXED: problem in mime_pack/3 using Name=Value - -Mar 4, 2003 - - * ADDED: http_open/3: header(+Name, -Value) option. Wouter - Jansweijer. - -Jan 23, 2003 - - * ADDED: Provide User-Agent header for the client libraries - -Jan 8, 2003 - - * ADDED: Support for using proxy servers Option: proxy(Host, Port). - - * ADDED: Support for 302 (document moved) reply in http_open/3. - diff --git a/packages/http/Makefile.in b/packages/http/Makefile.in deleted file mode 100755 index dff4493c9..000000000 --- a/packages/http/Makefile.in +++ /dev/null @@ -1,224 +0,0 @@ -################################################################ -# SWI-Prolog `HTTP' package -# Author: Jan Wielemaker. J.Wielemaker@cs.vu.nl -# Copyright: GPL (see COPYING or www.gnu.org -################################################################ - -.SUFFIXES: .txt .tex .dvi .doc .pl - -ifeq (@PROLOG_SYSTEM@,yap) - -prefix = @prefix@ -exec_prefix = @exec_prefix@ -ROOTDIR = $(prefix) -EROOTDIR = @exec_prefix@ -abs_top_builddir = @abs_top_builddir@ - -srcdir=@srcdir@ - -BINDIR = $(EROOTDIR)/bin -LIBDIR=@libdir@ -YAPLIBDIR=@libdir@/Yap -SHAREDIR=$(ROOTDIR)/share/Yap - -SHELL=@SHELL@ -PL=@INSTALL_ENV@ $(DESTDIR)$(BINDIR)/yap $(DESTDIR)$(YAPLIBDIR)/startup.yss -EXDIR=$(YAPLIBDIR)/examples/http -LN_S=@LN_S@ -# -# -DEFS=@DEFS@ -D_YAP_NOT_INSTALLED_=1 -CC=@CC@ -CFLAGS= @SHLIB_CFLAGS@ $(YAP_EXTRAS) $(DEFS) -I$(srcdir) -I../.. -I$(srcdir)/../../include @CPPFLAGS@ -MKINDEX=true - - -SO=@SO@ -#4.1VPATH=@srcdir@:@srcdir@/OPTYap -CWD=$(PWD) -# - -LD=@DO_SECOND_LD@ @SHLIB_LD@ -LDFLAGS=@EXTRA_LIBS_FOR_SWIDLLS@ @LDFLAGS@ - -BINTARGET=$(DESTDIR)$(YAPLIBDIR) -PLTARGET=$(DESTDIR)$(SHAREDIR)/http - -FINAL_BINTARGET=$(YAPLIBDIR) -FINAL_PLTARGET=$(SHAREDIR) - -%.o: $(srcdir)/%.c - $(CC) -c $(CFLAGS) $< -o $@ - -else # SWI - -SHELL=@SHELL@ -PLBASE=@PLBASE@ -PLARCH=@PLARCH@ -PL=@PL@ -XPCEBASE=$(PLBASE)/xpce -PKGDOC=$(PLBASE)/doc/packages -PCEHOME=../xpce -LIBDIR=$(PLBASE)/library/http -EXDIR=$(PKGDOC)/examples/http - -CC=@CC@ -COFLAGS=@COFLAGS@ -CWFLAGS=@CWFLAGS@ -CMFLAGS=@CMFLAGS@ -CIFLAGS= -CFLAGS=$(COFLAGS) $(CWFLAGS) $(CMFLAGS) $(CIFLAGS) @DEFS@ -LIBS=@LIBS@ -LD=@LD@ -LDFLAGS=@LDSOFLAGS@ - -PUBLICPL=swipl -DOCTOTEX=$(PCEHOME)/bin/doc2tex -PLTOTEX=$(PUBLICPL) -q -s pltotex.pl -g pltotex -- -RUNTEX=../../man/runtex -LATEX=latex -DOC=http -TEX=$(DOC).tex -DVI=$(DOC).dvi -PDF=$(DOC).pdf -HTML=$(DOC).html - -endif - -INSTALL=@INSTALL@ -INSTALL_PROGRAM=@INSTALL_PROGRAM@ -INSTALL_DATA=@INSTALL_DATA@ - -include $(srcdir)/common.mk - -STREAMOBJ= http_stream.o -JSONOBJ= json.o -SOLIBS= http_stream.@SO@ json.@SO@ - -all: $(SOLIBS) - - -http_stream.@SO@: $(STREAMOBJ) - $(LD) $(LDFLAGS) -o $@ $(STREAMOBJ) $(LIBS) -json.@SO@: $(JSONOBJ) - $(LD) $(LDFLAGS) -o $@ $(JSONOBJ) $(LIBS) - -http_stream.o: $(srcdir)/http_error.c $(srcdir)/http_chunked.c $(srcdir)/cgi_stream.c $(srcdir)/stream_range.c - -install: $(LIBPL) $(SOLIBS) - mkdir -p $(BINTARGET) - rm -f $(BINTARGET)/http_chunked.@SO@ - $(INSTALL_PROGRAM) $(SOLIBS) $(BINTARGET) - mkdir -p $(PLTARGET) - mkdir -p $(PLTARGET)/web/icons - mkdir -p $(DESTDIR)$(LIBDIR)/web/css - $(INSTALL_DATA) $(LIBPL) $(PLTARGET) - $(INSTALL_DATA) $(srcdir)/README $(PLTARGET) - $(INSTALL_DATA) $(srcdir)/web/icons/*.png $(PLTARGET)/web/icons - $(INSTALL_DATA) $(srcdir)/web/css/*.css $(DESTDIR)$(LIBDIR)/web/css - $(PL) -f none -g make -t halt - -ln-install: $(LIBPL) - $(MAKE) INSTALL_DATA="../ln-install" INSTALL_PROGRAM="../ln-install" install - -rpm-install: install - -pdf-install: install-examples - $(INSTALL_DATA) $(DOC).pdf $(DESTDIR)$(PKGDOC) - -html-install: install-examples - $(INSTALL_DATA) $(DOC).html httpserver.gif $(DESTDIR)$(PKGDOC) - -install-examples:: - mkdir -p $(DESTDIR)$(EXDIR) - mkdir -p $(DESTDIR)$(EXDIR)/pwp - (cd examples && $(INSTALL_DATA) $(EXAMPLES) $(DESTDIR)$(EXDIR)) - (cd examples/pwp && $(INSTALL_DATA) *.pwp *.pl $(DESTDIR)$(EXDIR)/pwp) - (cd examples && $(INSTALL_PROGRAM) $(EXAMPLEEXE) $(DESTDIR)$(EXDIR)) - -uninstall:: - (cd $(LIBDIR) && rm -f $(LIBPL)) - $(PL) -f none -g make -t halt - -check:: - $(PL) -q -f $(srcdir)/test_http.pl -g test_http,halt -t 'halt(1)' - $(PL) -q -f $(srcdir)/test_json.pl -g test_json,halt -t 'halt(1)' - $(PL) -q -f $(srcdir)/test_cgi_stream.pl -g true -t test_cgi_stream - -################################################################ -# Documentation -################################################################ - -doc: $(PDF) $(HTML) -pdf: $(PDF) -html: $(HTML) - -SUBTEX= post.tex json.tex httplog.tex httppath.tex htmlhead.tex \ - httpsession.tex httpdispatch.tex httpdirindex.tex httppwp.tex \ - httpopen.tex httphost.tex httpopenid.tex jswrite.tex - -$(HTML): $(TEX) $(SUBTEX) - latex2html $(DOC) - mv html/index.html $@ - mv html/httpserver.gif . - rmdir html - -$(PDF): $(TEX) $(SUBTEX) - $(RUNTEX) --pdf $(DOC) - -$(TEX): $(DOCTOTEX) - -json.tex: json.pl json_convert.pl http_json.pl - -.txt.tex: - $(PUBLICPL) -q -s txttotex.pl -g txttotex,halt -t 'halt(1)' -- $*.txt - -httplog.tex: http_log.pl - $(PLTOTEX) --subsection 'library(http/http_log)' - -httphost.tex: http_host.pl - $(PLTOTEX) --subsection 'library(http/http_host)' - -httppath.tex: http_path.pl - $(PLTOTEX) --subsection 'library(http/http_path)' - -httpopen.tex: http_open.pl - $(PLTOTEX) --subsection 'library(http/http_open)' - -htmlhead.tex: html_head.pl - $(PLTOTEX) --subsection 'library(http/html_head)' - -httpsession.tex: http_session.pl - $(PLTOTEX) --subsection 'library(http/http_session)' - -httpdispatch.tex: http_dispatch.pl - $(PLTOTEX) --subsection 'library(http/http_dispatch)' - -httpopenid.tex: http_openid.pl - $(PLTOTEX) --subsection 'library(http/http_openid)' - -httpdirindex.tex: http_dirindex.pl - $(PLTOTEX) --subsection 'library(http/http_dirindex)' - -httppwp.tex: http_pwp.pl - $(PLTOTEX) --subsection 'library(http/http_pwp)' - -jswrite.tex: js_write.pl - $(PLTOTEX) --subsection 'library(http/js_write)' - -.doc.tex: - $(DOCTOTEX) $*.doc > $*.tex - -################################################################ -# Clean -################################################################ - -clean: - rm -f $(STREAMOBJ) $(JSONOBJ) - rm -f *~ *% config.log - rm -f $(TEX) $(SUBTEX) - $(RUNTEX) --clean $(DOC) - rm -rf html - -distclean: clean - rm -f $(SOLIBS) config.cache config.status config.h Makefile diff --git a/packages/http/Makefile.mak b/packages/http/Makefile.mak deleted file mode 100644 index 7f01f632f..000000000 --- a/packages/http/Makefile.mak +++ /dev/null @@ -1,82 +0,0 @@ -################################################################ -# Install the SWI-Prolog HTTP package for MS-Windows -# -# Author: Jan Wielemaker -# -# Use: -# nmake /f Makefile.mak -# nmake /f Makefile.mak install -################################################################ - -PLHOME=..\.. -!include $(PLHOME)\src\rules.mk -!include common.mk - -LIBDIR= $(PLBASE)\library\http -EXDIR= $(PKGDOC)\examples\http - -OBJ= http_stream.obj - -all: http_stream.dll json.dll - -http_stream.dll: $(OBJ) - $(LD) /dll /out:$@ $(LDFLAGS) $(OBJ) $(PLLIB) $(LIBS) -json.dll: json.obj - $(LD) /dll /out:$@ $(LDFLAGS) json.obj $(PLLIB) $(LIBS) - -http_stream.obj: http_error.c http_chunked.c cgi_stream.c stream_range.c - -all: - -!IF "$(CFG)" == "rt" -install:: -!ELSE -install:: - if not exist "$(LIBDIR)\$(NULL)" $(MKDIR) "$(LIBDIR)" - if not exist "$(LIBDIR)\web\$(NULL)" $(MKDIR) "$(LIBDIR)\web" - if not exist "$(LIBDIR)\web\icons\$(NULL)" $(MKDIR) "$(LIBDIR)\web\icons" - if not exist "$(LIBDIR)\web\css\$(NULL)" $(MKDIR) "$(LIBDIR)\web\css" - @echo Copying $(LIBPL) - @for %f in ($(LIBPL)) do @copy %f "$(LIBDIR)" - copy README "$(LIBDIR)\README.TXT" - copy web\icons\*.* "$(LIBDIR)\web\icons" - copy web\css\*.* "$(LIBDIR)\web\css" - copy http_stream.dll "$(BINDIR)" - copy json.dll "$(BINDIR)" -!IF "$(PDB)" == "true" - copy http_stream.pdb "$(BINDIR)" - copy json.pdb "$(BINDIR)" -!ENDIF - $(MAKEINDEX) -!ENDIF - -html-install: install-examples - copy http.html "$(PKGDOC)" - copy httpserver.gif "$(PKGDOC)" - -pdf-install: install-examples - copy http.pdf "$(PKGDOC)" - -install-examples:: - if not exist "$(EXDIR)\$(NULL)" $(MKDIR) "$(EXDIR)" - if not exist "$(EXDIR)\pwp\$(NULL)" $(MKDIR) "$(EXDIR)\pwp" - cd examples & @for %f in ($(EXAMPLES)) do @copy %f "$(EXDIR)" - cd examples & copy $(EXAMPLEEXE) "$(EXDIR)" - cd examples & copy pwp\*.* "$(EXDIR)\pwp" - -xpce-install:: - -uninstall:: - cd $(LIBDIR) & del $(LIBPL) README.TXT - del "$(BINDIR)\http_stream.dll" - $(MAKEINDEX) - -clean:: - if exist *~ del *~ - if exist *.obj del *.obj - -distclean: clean - if exist *.dll del *.dll - if exist *.pdb del *.pdb - - diff --git a/packages/http/README b/packages/http/README deleted file mode 100644 index 3e3e4454b..000000000 --- a/packages/http/README +++ /dev/null @@ -1,18 +0,0 @@ ----+ SWI-Prolog HTTP support library - -This directory provides the SWI-Prolog libraries for accessing and -providing HTTP services. The client libraries come in two forms: - - * The lightweight http_open.pl opens an HTTP location as a stream - * The more full-blown http_client.pl performs arbitrary HTTP - requests and, depending on loaded plugins, transforms the data - in a Prolog-friendly format. - -The primary server-library is thread_httpd.pl, providing full-blown -scalable embedded HTTP server. - ----++ Further reading - - * ../../packages/http.pdf - * ../../packages/examples/http contains some demos. - * http://www.swi-prolog.org/packages/http.html diff --git a/packages/http/TODO b/packages/http/TODO deleted file mode 100644 index 819146150..000000000 --- a/packages/http/TODO +++ /dev/null @@ -1,25 +0,0 @@ ----+ HTTP Server library todo list - ----++ Session handling - -Especially now that we store the current request as a record in the CGI -stream, it is now much too expensive to get the current session. How to -deal with that? Also store in the CGI object? - ----++ Debugging - -We plan to provide a in-core store for requests with predicates that -control what requests are stored. This allows for showing the requests -as well as replaying requests from the user-thread for easy debugging. - -Can we deal with HTTP POST requests? - ----++ JSON integration - -JavaScript Simple Object Notation is a simple and lightweight exchange -protocol for structured data. Support for it is progressing, with the -following items on our todo list. - - * Hook json_convert.pl into json.pl - * Deal with nested objects in conversion - * Documentation. diff --git a/packages/http/cgi_stream.c b/packages/http/cgi_stream.c deleted file mode 100644 index 6436506b0..000000000 --- a/packages/http/cgi_stream.c +++ /dev/null @@ -1,745 +0,0 @@ -/* Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: J.Wielemaker@uva.nl - WWW: http://www.swi-prolog.org - Copyright (C): 2009, University of Amsterdam - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 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 - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser 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 -*/ - -#include -#include -#include -#include -#include - -/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -The task of cgi_stream.c is to interface between the actual wrapper code -that implements an HTTP location and the socket sending a reply to the -client. In particular, we want to deal with: - - * Separating the header from the body of the reply - * Chunked or traditional transfer encoding - * Connection management (Keep-alife) - * Thread management - -The original HTTP infrastructure has an `accept thread' that accepts new -connections. The connection is handed to a thread that reads the HTTP -header and calls a handler with the output redirected to a memory file, -processing the reply-header and reply-data after the handler finished. -This is a clean and modular design, but it cannot deal with especially -chunked encoding and thread management. This module remedies these -issues. - -To do this, the stream provides a three call-backs. Initially, the -stream is in line-buffering mode (SIO_LBUF), waiting for the header to -become complete. At that moment it calls the hook, passing event type -'header' and the stream. This processes the head and combines the head -with the request, deciding on: - - * The final header - * The transfer encoding (chunked/none) - * The content encoding (octet/utf8) - * The connection (Keep-Alife/close) - -Now, the stream is placed in full buffering mode (SIO_FBUF). If the -transfer encoding is 'chunked' it immediately calls the hook using -'send_header' to emit the current header. Output continues. In chunked -mode sending the chunks, otherwisse collecting the data. On close, it -writes an empty block (chunked mode) or (normal mode) calls the hook -'send_header' which now has access to the content-length, followed by -the data. - -Note that the work-flow is kept with the stream. This allows passing the -cgi stream from thread to thread while keeping track of the work-flow. -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ - -/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -TODO - - * Error handling (many places) -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ - - - /******************************* - * CONSTANTS * - *******************************/ - -static atom_t ATOM_header; /* header */ -static atom_t ATOM_header_codes; /* header_codes */ -static atom_t ATOM_send_header; /* send_header */ -static atom_t ATOM_data; /* data */ -static atom_t ATOM_discarded; /* discarded */ -static atom_t ATOM_request; /* request */ -static atom_t ATOM_client; /* client */ -static atom_t ATOM_chunked; /* chunked */ -static atom_t ATOM_none; /* none */ -static atom_t ATOM_state; /* state */ -static atom_t ATOM_transfer_encoding; /* transfer_encoding */ -static atom_t ATOM_connection; /* connection */ -static atom_t ATOM_keep_alife; /* keep_alife */ -static atom_t ATOM_close; /* close */ -static atom_t ATOM_content_length; /* content_length */ -static atom_t ATOM_id; /* id */ -static predicate_t PREDICATE_call3; /* Goal, Event, Handle */ - - - /******************************* - * CONTEXT * - *******************************/ - -#define BUFSIZE SIO_BUFSIZE /* raw I/O buffer */ - -typedef enum -{ CGI_HDR = 0, - CGI_DATA, - CGI_DISCARDED -} cgi_state; - -#define CGI_MAGIC 0xa85ce042 - -typedef struct cgi_context -{ IOSTREAM *stream; /* Original stream */ - IOSTREAM *cgi_stream; /* Stream I'm handle of */ - IOENC parent_encoding; /* Saved encoding of parent */ - /* Prolog attributes */ - module_t module; /* Calling module */ - record_t hook; /* Hook called on action */ - record_t request; /* Associated request term */ - record_t header; /* Associated reply header term */ - atom_t transfer_encoding; /* Current transfer encoding */ - atom_t connection; /* Keep alife? */ - /* state */ - cgi_state state; /* Current state */ - /* data buffering */ - size_t data_offset; /* Start of real data */ - char *data; /* Buffered data */ - size_t datasize; /* #bytes buffered */ - size_t dataallocated; /* #bytes allocated */ - int id; /* Identifier */ - unsigned int magic; /* CGI_MAGIC */ -} cgi_context; - - -static int start_chunked_encoding(cgi_context *ctx); -static ssize_t cgi_chunked_write(cgi_context *ctx, char *buf, size_t size); - - - /******************************* - * ALLOC/FREE * - *******************************/ - -static cgi_context* -alloc_cgi_context(IOSTREAM *s) -{ cgi_context *ctx = PL_malloc(sizeof(*ctx)); - - memset(ctx, 0, sizeof(*ctx)); - ctx->magic = CGI_MAGIC; - ctx->stream = s; - - return ctx; -} - - -static void -free_cgi_context(cgi_context *ctx) -{ if ( ctx->stream->upstream ) - Sset_filter(ctx->stream, NULL); - else - PL_release_stream(ctx->stream); - - if ( ctx->data ) free(ctx->data); - if ( ctx->hook ) PL_erase(ctx->hook); - if ( ctx->request ) PL_erase(ctx->request); - if ( ctx->header ) PL_erase(ctx->header); - if ( ctx->connection ) PL_unregister_atom(ctx->connection); - - ctx->magic = 0; - PL_free(ctx); -} - - -static int -grow_data_buffer(cgi_context *ctx, size_t size) -{ size_t newsize; - - if ( ctx->dataallocated == 0 ) - newsize = SIO_BUFSIZE; - else - newsize = ctx->dataallocated; - - while(newsize < size) - newsize *= 2; - if ( ctx->data ) - { void *p; - - if ( !(p=realloc(ctx->data, newsize)) ) - return -1; - ctx->data = p; - ctx->dataallocated = newsize; - } else - { if ( !(ctx->data = malloc(newsize)) ) - return -1; - - ctx->dataallocated = newsize; - } - - return 0; -} - - - /******************************* - * PROPERTIES * - *******************************/ - -static IOFUNCTIONS cgi_functions; - -static int -get_cgi_stream(term_t t, IOSTREAM **sp, cgi_context **ctx) -{ IOSTREAM *s; - - if ( !PL_get_stream_handle(t, &s) ) - return FALSE; - if ( s->functions != &cgi_functions ) - { PL_release_stream(s); - return type_error(t, "cgi_stream"); - } - - *sp = s; - *ctx = s->handle; - - return TRUE; -} - - -static int -unify_record(term_t t, record_t r) -{ if ( r ) - { term_t t2 = PL_new_term_ref(); - PL_recorded(r, t2); - return PL_unify(t, t2); - } - return FALSE; -} - - -static foreign_t -is_cgi_stream(term_t cgi) -{ IOSTREAM *s; - int rc; - - if ( !PL_get_stream_handle(cgi, &s) ) - return FALSE; - rc = (s->functions == &cgi_functions); - PL_release_stream(s); - - return rc; -} - - -static foreign_t -cgi_property(term_t cgi, term_t prop) -{ IOSTREAM *s; - cgi_context *ctx; - term_t arg = PL_new_term_ref(); - atom_t name; - int arity; - int rc = TRUE; - - if ( !get_cgi_stream(cgi, &s, &ctx) ) - return FALSE; - - if ( !PL_get_name_arity(prop, &name, &arity) || arity != 1 ) - { rc = type_error(prop, "cgi_property"); - goto out; - } - - _PL_get_arg(1, prop, arg); - if ( name == ATOM_request ) - { if ( ctx->request ) - rc = unify_record(arg, ctx->request); - else - rc = PL_unify_nil(arg); - } else if ( name == ATOM_header ) - { if ( ctx->header ) - rc = unify_record(arg, ctx->header); - else - rc = PL_unify_nil(arg); - } else if ( name == ATOM_id ) - { rc = PL_unify_integer(arg, ctx->id); - } else if ( name == ATOM_client ) - { rc = PL_unify_stream(arg, ctx->stream); - } else if ( name == ATOM_transfer_encoding ) - { rc = PL_unify_atom(arg, ctx->transfer_encoding); - } else if ( name == ATOM_connection ) - { rc = PL_unify_atom(arg, ctx->connection ? ctx->connection : ATOM_close); - } else if ( name == ATOM_content_length ) - { rc = PL_unify_int64(arg, ctx->datasize - ctx->data_offset); - } else if ( name == ATOM_header_codes ) - { if ( ctx->data_offset > 0 ) - rc = PL_unify_chars(arg, PL_CODE_LIST, ctx->data_offset, ctx->data); - else - rc = existence_error(cgi, "header"); - } else if ( name == ATOM_state ) - { atom_t state; - - switch(ctx->state) - { case CGI_HDR: state = ATOM_header; break; - case CGI_DATA: state = ATOM_data; break; - case CGI_DISCARDED: state = ATOM_discarded; break; - default: - assert(0); - } - - rc = PL_unify_atom(arg, state); - } else - { rc = existence_error(prop, "cgi_property"); - } - -out: - PL_release_stream(s); - return rc; -} - - -static int -set_term(record_t *r, term_t t) -{ if ( *r ) - PL_erase(*r); - *r = PL_record(t); - - return TRUE; -} - - -static int -set_atom(atom_t *a, term_t t) -{ atom_t new; - - if ( !PL_get_atom(t, &new) ) - return type_error(t, "atom"); - - if ( *a != new ) - { if ( *a ) - PL_unregister_atom(*a); - *a = new; - PL_register_atom(new); - } - - return TRUE; -} - - -static foreign_t -cgi_set(term_t cgi, term_t prop) -{ IOSTREAM *s; - cgi_context *ctx; - term_t arg = PL_new_term_ref(); - atom_t name; - int arity; - int rc = TRUE; - - if ( !get_cgi_stream(cgi, &s, &ctx) ) - return FALSE; - - if ( !PL_get_name_arity(prop, &name, &arity) || arity != 1 ) - { rc = type_error(prop, "cgi_property"); - goto out; - } - - _PL_get_arg(1, prop, arg); - if ( name == ATOM_request ) - { rc = set_term(&ctx->request, arg); - } else if ( name == ATOM_header ) - { rc = set_term(&ctx->header, arg); - } else if ( name == ATOM_connection ) - { rc = set_atom(&ctx->connection, arg); - } else if ( name == ATOM_transfer_encoding ) - { atom_t enc; - - if ( !PL_get_atom(arg, &enc) ) - return type_error(arg, "atom"); - - if ( ctx->transfer_encoding != enc ) - { if ( enc == ATOM_chunked ) - { ctx->transfer_encoding = enc; - rc = start_chunked_encoding(ctx); - } else - { rc = domain_error(arg, "transfer_encoding"); - } - } - } else - { rc = existence_error(prop, "cgi_property"); - } - -out: - PL_release_stream(s); - return rc; -} - - -static foreign_t -cgi_discard(term_t cgi) -{ IOSTREAM *s; - cgi_context *ctx; - - if ( !get_cgi_stream(cgi, &s, &ctx) ) - return FALSE; - - ctx->state = CGI_DISCARDED; - /* empty buffer to avoid write */ - ctx->cgi_stream->bufp = ctx->cgi_stream->buffer; - PL_release_stream(s); - - return TRUE; -} - - - /******************************* - * HOOKS * - *******************************/ - -/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Call hook on the data we collected sofar. The hook is called with the -following additional arguments: - - * Event-type (header, data) - * An input stream pointing to the collected data -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ - -static int -call_hook(cgi_context *ctx, atom_t event) -{ fid_t fid = PL_open_foreign_frame(); - term_t av = PL_new_term_refs(3); - qid_t qid; - int rc; - - PL_recorded(ctx->hook, av+0); - PL_put_atom(av+1, event); - PL_unify_stream(av+2, ctx->cgi_stream); - qid = PL_open_query(ctx->module, PL_Q_CATCH_EXCEPTION, PREDICATE_call3, av); - rc = PL_next_solution(qid); - - if ( !rc ) - { term_t ex; - - if ( (ex = PL_exception(qid)) ) - { Sset_exception(ctx->cgi_stream, ex); - - } else - { char buf[256]; - Ssprintf(buf, "CGI Hook %s failed", PL_atom_chars(event)); - - Sseterr(ctx->cgi_stream, SIO_WARN, buf); - } - - PL_cut_query(qid); - PL_close_foreign_frame(fid); - - return FALSE; - } - PL_close_query(qid); - PL_discard_foreign_frame(fid); - - return TRUE; -} - - -static int -start_chunked_encoding(cgi_context *ctx) -{ if ( call_hook(ctx, ATOM_send_header) ) - { if ( ctx->datasize > ctx->data_offset ) - { int rc = cgi_chunked_write(ctx, - &ctx->data[ctx->data_offset], - ctx->datasize - ctx->data_offset); - if ( rc == -1 ) - return FALSE; - } - - return TRUE; - } - - return FALSE; -} - - -static size_t -find_data(cgi_context *ctx, size_t start) -{ const char *s = &ctx->data[start]; - const char *e = &ctx->data[ctx->datasize-2]; - - for(; s<=e; s++) - { if ( s[0] == '\r' && s[1] == '\n' && - s <= e-2 && - s[2] == '\r' && s[3] == '\n' ) - return &s[4] - ctx->data; - if ( s[0] == '\n' && s[1] == '\n' ) - return &s[2] - ctx->data; - } - - return (size_t)-1; -} - - - - /******************************* - * IO FUNCTIONS * - *******************************/ - -static ssize_t /* encode */ -cgi_chunked_write(cgi_context *ctx, char *buf, size_t size) -{ if ( Sfprintf(ctx->stream, "%x\r\n", size) < 0 ) - return -1; - if ( size > 0 && - Sfwrite(buf, sizeof(char), size, ctx->stream) != size ) - return -1; - if ( Sfprintf(ctx->stream, "\r\n") < 0 ) - return -1; - if ( Sflush(ctx->stream) < 0 ) - return -1; - - return size; -} - - -static ssize_t -cgi_write(void *handle, char *buf, size_t size) -{ cgi_context *ctx = handle; - - DEBUG(1, Sdprintf("cgi_write(%ld bytes)\n", (long)size)); - - if ( ctx->state == CGI_DISCARDED ) - { Sseterr(ctx->cgi_stream, SIO_FERR, "CGI stream was discarded"); - return -1; - } - - if ( ctx->transfer_encoding == ATOM_chunked ) - { return cgi_chunked_write(ctx, buf, size); - } else - { size_t osize = ctx->datasize; - size_t dstart; - - if ( osize+size > ctx->dataallocated ) - { if ( grow_data_buffer(ctx, osize+size) < 0 ) - return -1; /* no memory */ - } - memcpy(&ctx->data[osize], buf, size); - ctx->datasize = osize+size; - osize = (osize > 4 ? osize-4 : 0); /* 4 is max size of the separator */ - - if ( ctx->state == CGI_HDR && - (dstart=find_data(ctx, osize)) != ((size_t)-1) ) - { assert(dstart <= ctx->datasize); - ctx->data_offset = dstart; - ctx->state = CGI_DATA; - if ( !call_hook(ctx, ATOM_header) ) - { ctx->state = CGI_DISCARDED; - return -1; /* TBD: pass error kindly */ - } - ctx->cgi_stream->flags &= ~(SIO_FBUF|SIO_LBUF|SIO_NBUF); - ctx->cgi_stream->flags |= SIO_FBUF; - } - - return size; - } -} - - -static int -cgi_control(void *handle, int op, void *data) -{ cgi_context *ctx = handle; - - if ( ctx->magic != CGI_MAGIC ) - { DEBUG(0, Sdprintf("OOPS: cgi_control(%d): invalid handle\n", op)); - errno = EINVAL; - return -1; - } - - switch(op) - { case SIO_FLUSHOUTPUT: - case SIO_SETENCODING: - return 0; /* allow switching encoding */ - default: - if ( ctx->stream->functions->control ) - return (*ctx->stream->functions->control)(ctx->stream->handle, op, data); - return -1; - } -} - - -static int -cgi_close(void *handle) -{ cgi_context *ctx = handle; - int rc = 0; - - DEBUG(1, Sdprintf("cgi_close()\n")); - - switch( ctx->state ) - { case CGI_DATA: - { if ( ctx->transfer_encoding == ATOM_chunked ) - { if ( cgi_chunked_write(ctx, NULL, 0) < 0 ) - { rc = -1; - goto out; - } - } else - { size_t clen = ctx->datasize - ctx->data_offset; - const char *dstart = &ctx->data[ctx->data_offset]; - - if ( !call_hook(ctx, ATOM_send_header) ) - { rc = -1; - goto out; - } - if ( Sfwrite(dstart, sizeof(char), clen, ctx->stream) != clen || - Sflush(ctx->stream) < 0 ) - { rc = -1; - goto out; - } - } - - break; - } - case CGI_HDR: - break; - case CGI_DISCARDED: - goto out; - } - - if ( !call_hook(ctx, ATOM_close) ) /* what if we had no header sofar? */ - rc = -1; /* TBD: pass error kindly */ - -out: - ctx->stream->encoding = ctx->parent_encoding; - free_cgi_context(ctx); - - return rc; -} - - -static IOFUNCTIONS cgi_functions = -{ NULL, /* read */ - cgi_write, - NULL, /* seek */ - cgi_close, - cgi_control, /* control */ - NULL, /* seek64 */ -}; - - - /******************************* - * OPEN * - *******************************/ - -static int current_id = 0; /* TBD: MT: lock */ - -#define CGI_COPY_FLAGS (SIO_OUTPUT| \ - SIO_TEXT| \ - SIO_REPXML|SIO_REPPL|\ - SIO_RECORDPOS) - -static foreign_t -pl_cgi_open(term_t org, term_t new, term_t closure, term_t options) -{ term_t tail = PL_copy_term_ref(options); - term_t head = PL_new_term_ref(); - cgi_context *ctx; - IOSTREAM *s, *s2; - module_t module = NULL; - term_t hook = PL_new_term_ref(); - record_t request = 0; - - PL_strip_module(closure, &module, hook); - if ( !PL_is_callable(hook) ) - return type_error(closure, "callable"); - - while(PL_get_list(tail, head, tail)) - { atom_t name; - int arity; - term_t arg = PL_new_term_ref(); - - if ( !PL_get_name_arity(head, &name, &arity) || arity != 1 ) - return type_error(head, "option"); - _PL_get_arg(1, head, arg); - if ( name == ATOM_request ) - { request = PL_record(arg); - } else - return existence_error(head, "cgi_open_option"); - } - if ( !PL_get_nil(tail) ) - return type_error(tail, "list"); - - if ( !PL_get_stream_handle(org, &s) ) - return FALSE; /* Error */ - if ( !(s->flags&SIO_OUTPUT) ) /* only allow output stream */ - { PL_release_stream(s); - return permission_error("stream", "write", org); - } - - ctx = alloc_cgi_context(s); - ctx->hook = PL_record(hook); - ctx->module = module; - ctx->request = request; - ctx->transfer_encoding = ATOM_none; - if ( !(s2 = Snew(ctx, - (s->flags&CGI_COPY_FLAGS)|SIO_LBUF, - &cgi_functions)) ) - { free_cgi_context(ctx); /* no memory */ - - return FALSE; - } - - s2->encoding = ENC_ASCII; /* Header is ASCII only */ - ctx->parent_encoding = s->encoding; - s->encoding = ENC_OCTET; - ctx->cgi_stream = s2; - if ( PL_unify_stream(new, s2) ) - { Sset_filter(s, s2); - PL_release_stream(s); - ctx->id = ++current_id; - - return TRUE; - } else - { return instantiation_error(); - } -} - - -static void -install_cgi_stream() -{ ATOM_header = PL_new_atom("header"); - ATOM_header_codes = PL_new_atom("header_codes"); - ATOM_send_header = PL_new_atom("send_header"); - ATOM_data = PL_new_atom("data"); - ATOM_discarded = PL_new_atom("discarded"); - ATOM_request = PL_new_atom("request"); - ATOM_header = PL_new_atom("header"); - ATOM_client = PL_new_atom("client"); - ATOM_chunked = PL_new_atom("chunked"); - ATOM_state = PL_new_atom("state"); - ATOM_none = PL_new_atom("none"); - ATOM_transfer_encoding = PL_new_atom("transfer_encoding"); - ATOM_close = PL_new_atom("close"); - ATOM_keep_alife = PL_new_atom("keep_alife"); - ATOM_connection = PL_new_atom("connection"); - ATOM_content_length = PL_new_atom("content_length"); - ATOM_id = PL_new_atom("id"); - - PREDICATE_call3 = PL_predicate("call", 3, "system"); - - PL_register_foreign("cgi_open", 4, pl_cgi_open, PL_FA_TRANSPARENT); - PL_register_foreign("is_cgi_stream", 1, is_cgi_stream, 0); - PL_register_foreign("cgi_property", 2, cgi_property, 0); - PL_register_foreign("cgi_set", 2, cgi_set, 0); - PL_register_foreign("cgi_discard", 1, cgi_discard, 0); -} diff --git a/packages/http/common.mk b/packages/http/common.mk deleted file mode 100644 index fc378df6f..000000000 --- a/packages/http/common.mk +++ /dev/null @@ -1,28 +0,0 @@ -# Makefile fragments to are updated frequently and can be shared - -LIBPL= $(srcdir)/html_write.pl $(srcdir)/http_client.pl \ - $(srcdir)/http_header.pl \ - $(srcdir)/http_mime_plugin.pl $(srcdir)/http_sgml_plugin.pl \ - $(srcdir)/mimepack.pl $(srcdir)/mimetype.pl \ - $(srcdir)/dcg_basics.pl \ - $(srcdir)/thread_httpd.pl $(srcdir)/xpce_httpd.pl \ - $(srcdir)/inetd_httpd.pl \ - $(srcdir)/http_wrapper.pl $(srcdir)/http_open.pl \ - $(srcdir)/http_session.pl \ - $(srcdir)/http_error.pl $(srcdir)/http_parameters.pl \ - $(srcdir)/http_dispatch.pl \ - $(srcdir)/http_authenticate.pl $(srcdir)/http_stream.pl \ - $(srcdir)/http_log.pl \ - $(srcdir)/http_path.pl $(srcdir)/http_hook.pl \ - $(srcdir)/html_head.pl $(srcdir)/http_exception.pl \ - $(srcdir)/json.pl $(srcdir)/http_json.pl \ - $(srcdir)/json_convert.pl $(srcdir)/http_dirindex.pl \ - $(srcdir)/http_server_files.pl $(srcdir)/http_pwp.pl \ - $(srcdir)/http_host.pl \ - $(srcdir)/http_openid.pl $(srcdir)/js_write.pl -EXAMPLES= $(srcdir)/demo_body.pl $(srcdir)/demo_client.pl \ - $(srcdir)/demo_threads.pl $(srcdir)/demo_xpce.pl \ - $(srcdir)/calc.pl $(srcdir)/demo_files.pl \ - $(srcdir)/demo_pwp.pl $(srcdir)/demo_openid.pl -EXAMPLEEXE= demo_inetd -XPCEPL= $(srcdir)/http_image.pl diff --git a/packages/http/config.h.in b/packages/http/config.h.in deleted file mode 100644 index b84c2bdbb..000000000 --- a/packages/http/config.h.in +++ /dev/null @@ -1,90 +0,0 @@ -/* config.h.in. Generated from configure.in by autoheader. */ - -/* Define if building universal (internal helper macro) */ -#undef AC_APPLE_UNIVERSAL_BUILD - -/* Define to one of `_getb67', `GETB67', `getb67' for Cray-2 and Cray-YMP - systems. This function is required for `alloca.c' support on those systems. - */ -#undef CRAY_STACKSEG_END - -/* Define to 1 if using `alloca.c'. */ -#undef C_ALLOCA - -/* Define to 1 if you have `alloca', as a function or macro. */ -#undef HAVE_ALLOCA - -/* Define to 1 if you have and it should be used (not on Ultrix). - */ -#undef HAVE_ALLOCA_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_INTTYPES_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_MEMORY_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_STDINT_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_STDLIB_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_STRINGS_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_STRING_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_SYS_STAT_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_SYS_TYPES_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_UNISTD_H - -/* Define to the address where bug reports for this package should be sent. */ -#undef PACKAGE_BUGREPORT - -/* Define to the full name of this package. */ -#undef PACKAGE_NAME - -/* Define to the full name and version of this package. */ -#undef PACKAGE_STRING - -/* Define to the one symbol short name of this package. */ -#undef PACKAGE_TARNAME - -/* Define to the home page for this package. */ -#undef PACKAGE_URL - -/* Define to the version of this package. */ -#undef PACKAGE_VERSION - -/* If using the C implementation of alloca, define if you know the - direction of stack growth for your system; otherwise it will be - automatically deduced at runtime. - STACK_DIRECTION > 0 => grows toward higher addresses - STACK_DIRECTION < 0 => grows toward lower addresses - STACK_DIRECTION = 0 => direction of growth unknown */ -#undef STACK_DIRECTION - -/* Define to 1 if you have the ANSI C header files. */ -#undef STDC_HEADERS - -/* Define WORDS_BIGENDIAN to 1 if your processor stores words with the most - significant byte first (like Motorola and SPARC, unlike Intel). */ -#if defined AC_APPLE_UNIVERSAL_BUILD -# if defined __BIG_ENDIAN__ -# define WORDS_BIGENDIAN 1 -# endif -#else -# ifndef WORDS_BIGENDIAN -# undef WORDS_BIGENDIAN -# endif -#endif - -/* Define for multi-thread support */ -#undef _REENTRANT diff --git a/packages/http/config.log b/packages/http/config.log deleted file mode 100644 index ef540fffe..000000000 --- a/packages/http/config.log +++ /dev/null @@ -1,483 +0,0 @@ -This file contains any messages produced by compilers while -running configure, to aid debugging if configure makes a mistake. - -It was created by configure, which was -generated by GNU Autoconf 2.65. Invocation command line was - - $ ./configure --prefix=/home/vsc/Yap/pl-devel --prefix=/home/vsc/Yap/pl-devel - -## --------- ## -## Platform. ## -## --------- ## - -hostname = xato -uname -m = x86_64 -uname -r = 2.6.32-22-generic -uname -s = Linux -uname -v = #36-Ubuntu SMP Thu Jun 3 19:31:57 UTC 2010 - -/usr/bin/uname -p = unknown -/bin/uname -X = unknown - -/bin/arch = unknown -/usr/bin/arch -k = unknown -/usr/convex/getsysinfo = unknown -/usr/bin/hostinfo = unknown -/bin/machine = unknown -/usr/bin/oslevel = unknown -/bin/universe = unknown - -PATH: /home/vsc/Yap/pl-devel/bin -PATH: /home/vsc/bin -PATH: /usr/local/sbin -PATH: /usr/local/bin -PATH: /usr/sbin -PATH: /usr/bin -PATH: /sbin -PATH: /bin -PATH: /usr/games -PATH: /home/vsc/lgtsvn/xml -PATH: /home/vsc/lgtsvn/scripts -PATH: /home/vsc/lgtsvn/integration - - -## ----------- ## -## Core tests. ## -## ----------- ## - -configure:2132: checking for gmake -configure:2159: result: make -configure:2175: checking for etags -configure:2191: found /usr/bin/etags -configure:2202: result: etags -configure:2251: checking for a BSD-compatible install -configure:2319: result: /usr/bin/install -c -configure:2378: checking for gcc -configure:2405: result: ../swipl-ld.sh -configure:2634: checking for C compiler version -configure:2643: ../swipl-ld.sh --version >&5 -gcc (Ubuntu 4.4.3-4ubuntu5) 4.4.3 -Copyright (C) 2009 Free Software Foundation, Inc. -This is free software; see the source for copying conditions. There is NO -warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - -configure:2654: $? = 0 -configure:2643: ../swipl-ld.sh -v >&5 -Using built-in specs. -Target: x86_64-linux-gnu -Configured with: ../src/configure -v --with-pkgversion='Ubuntu 4.4.3-4ubuntu5' --with-bugurl=file:///usr/share/doc/gcc-4.4/README.Bugs --enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared --enable-multiarch --enable-linker-build-id --with-system-zlib --libexecdir=/usr/lib --without-included-gettext --enable-threads=posix --with-gxx-include-dir=/usr/include/c++/4.4 --program-suffix=-4.4 --enable-nls --enable-clocale=gnu --enable-libstdcxx-debug --enable-plugin --enable-objc-gc --disable-werror --with-arch-32=i486 --with-tune=generic --enable-checking=release --build=x86_64-linux-gnu --host=x86_64-linux-gnu --target=x86_64-linux-gnu -Thread model: posix -gcc version 4.4.3 (Ubuntu 4.4.3-4ubuntu5) -configure:2654: $? = 0 -configure:2643: ../swipl-ld.sh -V >&5 -/usr/bin/ld: /usr/lib/debug/usr/lib/crt1.o(.debug_info): relocation 0 has invalid symbol index 11 -/usr/bin/ld: /usr/lib/debug/usr/lib/crt1.o(.debug_info): relocation 1 has invalid symbol index 12 -/usr/bin/ld: /usr/lib/debug/usr/lib/crt1.o(.debug_info): relocation 2 has invalid symbol index 2 -/usr/bin/ld: /usr/lib/debug/usr/lib/crt1.o(.debug_info): relocation 3 has invalid symbol index 2 -/usr/bin/ld: /usr/lib/debug/usr/lib/crt1.o(.debug_info): relocation 4 has invalid symbol index 11 -/usr/bin/ld: /usr/lib/debug/usr/lib/crt1.o(.debug_info): relocation 5 has invalid symbol index 13 -/usr/bin/ld: /usr/lib/debug/usr/lib/crt1.o(.debug_info): relocation 6 has invalid symbol index 13 -/usr/bin/ld: /usr/lib/debug/usr/lib/crt1.o(.debug_info): relocation 7 has invalid symbol index 13 -/usr/bin/ld: /usr/lib/debug/usr/lib/crt1.o(.debug_info): relocation 8 has invalid symbol index 2 -/usr/bin/ld: /usr/lib/debug/usr/lib/crt1.o(.debug_info): relocation 9 has invalid symbol index 2 -... rest of stderr output deleted ... -configure:2654: $? = 1 -configure:2643: ../swipl-ld.sh -qversion >&5 -/usr/bin/ld: /usr/lib/debug/usr/lib/crt1.o(.debug_info): relocation 0 has invalid symbol index 11 -/usr/bin/ld: /usr/lib/debug/usr/lib/crt1.o(.debug_info): relocation 1 has invalid symbol index 12 -/usr/bin/ld: /usr/lib/debug/usr/lib/crt1.o(.debug_info): relocation 2 has invalid symbol index 2 -/usr/bin/ld: /usr/lib/debug/usr/lib/crt1.o(.debug_info): relocation 3 has invalid symbol index 2 -/usr/bin/ld: /usr/lib/debug/usr/lib/crt1.o(.debug_info): relocation 4 has invalid symbol index 11 -/usr/bin/ld: /usr/lib/debug/usr/lib/crt1.o(.debug_info): relocation 5 has invalid symbol index 13 -/usr/bin/ld: /usr/lib/debug/usr/lib/crt1.o(.debug_info): relocation 6 has invalid symbol index 13 -/usr/bin/ld: /usr/lib/debug/usr/lib/crt1.o(.debug_info): relocation 7 has invalid symbol index 13 -/usr/bin/ld: /usr/lib/debug/usr/lib/crt1.o(.debug_info): relocation 8 has invalid symbol index 2 -/usr/bin/ld: /usr/lib/debug/usr/lib/crt1.o(.debug_info): relocation 9 has invalid symbol index 2 -... rest of stderr output deleted ... -configure:2654: $? = 1 -configure:2674: checking whether the C compiler works -configure:2696: ../swipl-ld.sh conftest.c >&5 -% /home/vsc/Yap/pl-devel/library/listing compiled into prolog_listing 0.00 sec, 37,800 bytes -% halt -configure:2700: $? = 0 -configure:2749: result: yes -configure:2752: checking for C compiler default output file name -configure:2754: result: a.out -configure:2760: checking for suffix of executables -configure:2767: ../swipl-ld.sh -o conftest conftest.c >&5 -% /home/vsc/Yap/pl-devel/library/listing compiled into prolog_listing 0.01 sec, 37,800 bytes -% halt -configure:2771: $? = 0 -configure:2793: result: -configure:2815: checking whether we are cross compiling -configure:2823: ../swipl-ld.sh -o conftest conftest.c >&5 -% /home/vsc/Yap/pl-devel/library/listing compiled into prolog_listing 0.00 sec, 37,800 bytes -% halt -configure:2827: $? = 0 -configure:2834: ./conftest -configure:2838: $? = 0 -configure:2853: result: no -configure:2858: checking for suffix of object files -configure:2880: ../swipl-ld.sh -c conftest.c >&5 -configure:2884: $? = 0 -configure:2905: result: o -configure:2909: checking whether we are using the GNU C compiler -configure:2928: ../swipl-ld.sh -c conftest.c >&5 -configure:2928: $? = 0 -configure:2937: result: yes -configure:2946: checking whether ../swipl-ld.sh accepts -g -configure:2966: ../swipl-ld.sh -c -g conftest.c >&5 -configure:2966: $? = 0 -configure:3007: result: yes -configure:3024: checking for ../swipl-ld.sh option to accept ISO C89 -configure:3088: ../swipl-ld.sh -c -g -O2 conftest.c >&5 -configure:3088: $? = 0 -configure:3101: result: none needed -configure:3122: checking for library containing strerror -configure:3153: ../swipl-ld.sh -o conftest -g -O2 conftest.c >&5 -% /home/vsc/Yap/pl-devel/library/listing compiled into prolog_listing 0.00 sec, 37,800 bytes -% halt -configure:3153: $? = 0 -configure:3170: result: none required -configure:3183: checking how to run the C preprocessor -configure:3214: ../swipl-ld.sh -E conftest.c -configure:3214: $? = 0 -configure:3228: ../swipl-ld.sh -E conftest.c -conftest.c:9:28: error: ac_nonexistent.h: No such file or directory -gcc -E returned code 256 -*** /home/vsc/Yap/pl-devel/src/../src/swipl-ld exit status 1 -configure:3228: $? = 1 -configure: failed program was: -| /* confdefs.h */ -| #define PACKAGE_NAME "" -| #define PACKAGE_TARNAME "" -| #define PACKAGE_VERSION "" -| #define PACKAGE_STRING "" -| #define PACKAGE_BUGREPORT "" -| #define PACKAGE_URL "" -| /* end confdefs.h. */ -| #include -configure:3253: result: ../swipl-ld.sh -E -configure:3273: ../swipl-ld.sh -E conftest.c -configure:3273: $? = 0 -configure:3287: ../swipl-ld.sh -E conftest.c -conftest.c:9:28: error: ac_nonexistent.h: No such file or directory -gcc -E returned code 256 -*** /home/vsc/Yap/pl-devel/src/../src/swipl-ld exit status 1 -configure:3287: $? = 1 -configure: failed program was: -| /* confdefs.h */ -| #define PACKAGE_NAME "" -| #define PACKAGE_TARNAME "" -| #define PACKAGE_VERSION "" -| #define PACKAGE_STRING "" -| #define PACKAGE_BUGREPORT "" -| #define PACKAGE_URL "" -| /* end confdefs.h. */ -| #include -configure:3316: checking for grep that handles long lines and -e -configure:3374: result: /bin/grep -configure:3379: checking for egrep -configure:3441: result: /bin/grep -E -configure:3446: checking for ANSI C header files -configure:3466: ../swipl-ld.sh -c -g -O2 conftest.c >&5 -configure:3466: $? = 0 -configure:3539: ../swipl-ld.sh -o conftest -g -O2 conftest.c >&5 -% /home/vsc/Yap/pl-devel/library/listing compiled into prolog_listing 0.00 sec, 37,800 bytes -% halt -configure:3539: $? = 0 -configure:3539: ./conftest -configure:3539: $? = 0 -configure:3550: result: yes -configure:3564: checking for sys/types.h -configure:3564: ../swipl-ld.sh -c -fPIC conftest.c >&5 -configure:3564: $? = 0 -configure:3564: result: yes -configure:3564: checking for sys/stat.h -configure:3564: ../swipl-ld.sh -c -fPIC conftest.c >&5 -configure:3564: $? = 0 -configure:3564: result: yes -configure:3564: checking for stdlib.h -configure:3564: ../swipl-ld.sh -c -fPIC conftest.c >&5 -configure:3564: $? = 0 -configure:3564: result: yes -configure:3564: checking for string.h -configure:3564: ../swipl-ld.sh -c -fPIC conftest.c >&5 -configure:3564: $? = 0 -configure:3564: result: yes -configure:3564: checking for memory.h -configure:3564: ../swipl-ld.sh -c -fPIC conftest.c >&5 -configure:3564: $? = 0 -configure:3564: result: yes -configure:3564: checking for strings.h -configure:3564: ../swipl-ld.sh -c -fPIC conftest.c >&5 -configure:3564: $? = 0 -configure:3564: result: yes -configure:3564: checking for inttypes.h -configure:3564: ../swipl-ld.sh -c -fPIC conftest.c >&5 -configure:3564: $? = 0 -configure:3564: result: yes -configure:3564: checking for stdint.h -configure:3564: ../swipl-ld.sh -c -fPIC conftest.c >&5 -configure:3564: $? = 0 -configure:3564: result: yes -configure:3564: checking for unistd.h -configure:3564: ../swipl-ld.sh -c -fPIC conftest.c >&5 -configure:3564: $? = 0 -configure:3564: result: yes -configure:3579: checking for working alloca.h -configure:3596: ../swipl-ld.sh -o conftest -fPIC conftest.c >&5 -% /home/vsc/Yap/pl-devel/library/listing compiled into prolog_listing 0.00 sec, 37,800 bytes -% halt -configure:3596: $? = 0 -configure:3604: result: yes -configure:3612: checking for alloca -configure:3649: ../swipl-ld.sh -o conftest -fPIC conftest.c >&5 -% /home/vsc/Yap/pl-devel/library/listing compiled into prolog_listing 0.01 sec, 37,800 bytes -% halt -configure:3649: $? = 0 -configure:3657: result: yes -configure:3767: checking whether byte ordering is bigendian -configure:3782: ../swipl-ld.sh -c -fPIC conftest.c >&5 -conftest.c:22: error: expected '=', ',', ';', 'asm' or '__attribute__' before 'a' -gcc returned code 256 -*** /home/vsc/Yap/pl-devel/src/../src/swipl-ld exit status 1 -configure:3782: $? = 1 -configure: failed program was: -| /* confdefs.h */ -| #define PACKAGE_NAME "" -| #define PACKAGE_TARNAME "" -| #define PACKAGE_VERSION "" -| #define PACKAGE_STRING "" -| #define PACKAGE_BUGREPORT "" -| #define PACKAGE_URL "" -| #define STDC_HEADERS 1 -| #define HAVE_SYS_TYPES_H 1 -| #define HAVE_SYS_STAT_H 1 -| #define HAVE_STDLIB_H 1 -| #define HAVE_STRING_H 1 -| #define HAVE_MEMORY_H 1 -| #define HAVE_STRINGS_H 1 -| #define HAVE_INTTYPES_H 1 -| #define HAVE_STDINT_H 1 -| #define HAVE_UNISTD_H 1 -| #define HAVE_ALLOCA_H 1 -| #define HAVE_ALLOCA 1 -| /* end confdefs.h. */ -| #ifndef __APPLE_CC__ -| not a universal capable compiler -| #endif -| typedef int dummy; -| -configure:3827: ../swipl-ld.sh -c -fPIC conftest.c >&5 -configure:3827: $? = 0 -configure:3845: ../swipl-ld.sh -c -fPIC conftest.c >&5 -conftest.c: In function 'main': -conftest.c:28: error: 'not' undeclared (first use in this function) -conftest.c:28: error: (Each undeclared identifier is reported only once -conftest.c:28: error: for each function it appears in.) -conftest.c:28: error: expected ';' before 'big' -gcc returned code 256 -*** /home/vsc/Yap/pl-devel/src/../src/swipl-ld exit status 1 -configure:3845: $? = 1 -configure: failed program was: -| /* confdefs.h */ -| #define PACKAGE_NAME "" -| #define PACKAGE_TARNAME "" -| #define PACKAGE_VERSION "" -| #define PACKAGE_STRING "" -| #define PACKAGE_BUGREPORT "" -| #define PACKAGE_URL "" -| #define STDC_HEADERS 1 -| #define HAVE_SYS_TYPES_H 1 -| #define HAVE_SYS_STAT_H 1 -| #define HAVE_STDLIB_H 1 -| #define HAVE_STRING_H 1 -| #define HAVE_MEMORY_H 1 -| #define HAVE_STRINGS_H 1 -| #define HAVE_INTTYPES_H 1 -| #define HAVE_STDINT_H 1 -| #define HAVE_UNISTD_H 1 -| #define HAVE_ALLOCA_H 1 -| #define HAVE_ALLOCA 1 -| /* end confdefs.h. */ -| #include -| #include -| -| int -| main () -| { -| #if BYTE_ORDER != BIG_ENDIAN -| not big endian -| #endif -| -| ; -| return 0; -| } -configure:3973: result: no -configure:4105: creating ./config.status - -## ---------------------- ## -## Running config.status. ## -## ---------------------- ## - -This file was extended by config.status, which was -generated by GNU Autoconf 2.65. Invocation command line was - - CONFIG_FILES = - CONFIG_HEADERS = - CONFIG_LINKS = - CONFIG_COMMANDS = - $ ./config.status - -on xato - -config.status:822: creating Makefile -config.status:822: creating config.h - -## ---------------- ## -## Cache variables. ## -## ---------------- ## - -ac_cv_c_bigendian=no -ac_cv_c_compiler_gnu=yes -ac_cv_env_CC_set= -ac_cv_env_CC_value= -ac_cv_env_CFLAGS_set= -ac_cv_env_CFLAGS_value= -ac_cv_env_CPPFLAGS_set= -ac_cv_env_CPPFLAGS_value= -ac_cv_env_CPP_set= -ac_cv_env_CPP_value= -ac_cv_env_LDFLAGS_set= -ac_cv_env_LDFLAGS_value= -ac_cv_env_LIBS_set= -ac_cv_env_LIBS_value= -ac_cv_env_build_alias_set= -ac_cv_env_build_alias_value= -ac_cv_env_host_alias_set= -ac_cv_env_host_alias_value= -ac_cv_env_target_alias_set= -ac_cv_env_target_alias_value= -ac_cv_func_alloca_works=yes -ac_cv_header_inttypes_h=yes -ac_cv_header_memory_h=yes -ac_cv_header_stdc=yes -ac_cv_header_stdint_h=yes -ac_cv_header_stdlib_h=yes -ac_cv_header_string_h=yes -ac_cv_header_strings_h=yes -ac_cv_header_sys_stat_h=yes -ac_cv_header_sys_types_h=yes -ac_cv_header_unistd_h=yes -ac_cv_objext=o -ac_cv_path_EGREP='/bin/grep -E' -ac_cv_path_GREP=/bin/grep -ac_cv_prog_CPP='../swipl-ld.sh -E' -ac_cv_prog_ETAGS=etags -ac_cv_prog_MAKE=make -ac_cv_prog_ac_ct_CC=../swipl-ld.sh -ac_cv_prog_cc_c89= -ac_cv_prog_cc_g=yes -ac_cv_search_strerror='none required' -ac_cv_working_alloca_h=yes - -## ----------------- ## -## Output variables. ## -## ----------------- ## - -ALLOCA='' -CC='../swipl-ld.sh' -CFLAGS='-fPIC' -CIFLAGS='' -CMFLAGS='-fPIC' -COFLAGS='-O2 -fno-strict-aliasing' -CPP='../swipl-ld.sh -E' -CPPFLAGS='' -CWFLAGS='-Wall' -DEFS='-DHAVE_CONFIG_H' -ECHO_C='' -ECHO_N='-n' -ECHO_T='' -EGREP='/bin/grep -E' -ETAGS='etags' -EXEEXT='' -GREP='/bin/grep' -INSTALL_DATA='/usr/bin/install -c -m 644' -INSTALL_PROGRAM='${INSTALL}' -INSTALL_SCRIPT='${INSTALL}' -LD='../swipl-ld.sh' -LDFLAGS='' -LDSOFLAGS='-shared' -LIBOBJS='' -LIBS='' -LTLIBOBJS='' -MAKE='make' -OBJEXT='o' -PACKAGE_BUGREPORT='' -PACKAGE_NAME='' -PACKAGE_STRING='' -PACKAGE_TARNAME='' -PACKAGE_URL='' -PACKAGE_VERSION='' -PATH_SEPARATOR=':' -PL='../swipl.sh' -PLARCH='x86_64-linux' -PLBASE='/home/vsc/Yap/pl-devel/lib/swipl-5.11.1' -PLINCL='/home/vsc/Yap/pl-devel/include' -PLLD='../swipl-ld.sh' -PLLIBS='-lgmp -lrt -lreadline -lncurses -lm -lrt -ldl ' -SHELL='/bin/bash' -SO='so' -ac_ct_CC='../swipl-ld.sh' -bindir='${exec_prefix}/bin' -build_alias='' -datadir='${datarootdir}' -datarootdir='${prefix}/share' -docdir='${datarootdir}/doc/${PACKAGE}' -dvidir='${docdir}' -exec_prefix='${prefix}' -host_alias='' -htmldir='${docdir}' -includedir='${prefix}/include' -infodir='${datarootdir}/info' -libdir='${exec_prefix}/lib' -libexecdir='${exec_prefix}/libexec' -localedir='${datarootdir}/locale' -localstatedir='${prefix}/var' -mandir='${datarootdir}/man' -oldincludedir='/usr/include' -pdfdir='${docdir}' -prefix='/home/vsc/Yap/pl-devel' -program_transform_name='s,x,x,' -psdir='${docdir}' -sbindir='${exec_prefix}/sbin' -sharedstatedir='${prefix}/com' -sysconfdir='${prefix}/etc' -target_alias='' - -## ----------- ## -## confdefs.h. ## -## ----------- ## - -/* confdefs.h */ -#define PACKAGE_NAME "" -#define PACKAGE_TARNAME "" -#define PACKAGE_VERSION "" -#define PACKAGE_STRING "" -#define PACKAGE_BUGREPORT "" -#define PACKAGE_URL "" -#define STDC_HEADERS 1 -#define HAVE_SYS_TYPES_H 1 -#define HAVE_SYS_STAT_H 1 -#define HAVE_STDLIB_H 1 -#define HAVE_STRING_H 1 -#define HAVE_MEMORY_H 1 -#define HAVE_STRINGS_H 1 -#define HAVE_INTTYPES_H 1 -#define HAVE_STDINT_H 1 -#define HAVE_UNISTD_H 1 -#define HAVE_ALLOCA_H 1 -#define HAVE_ALLOCA 1 - -configure: exit 0 diff --git a/packages/http/configure.in b/packages/http/configure.in deleted file mode 100644 index d43d00378..000000000 --- a/packages/http/configure.in +++ /dev/null @@ -1,9 +0,0 @@ -dnl Process this file with autoconf to produce a configure script. - -AC_INIT(install-sh) -AC_PREREQ([2.50]) -AC_CONFIG_HEADER(config.h) - -m4_include([../ac_swi_c.m4]) - -AC_OUTPUT(Makefile) diff --git a/packages/http/dcg_basics.pl b/packages/http/dcg_basics.pl deleted file mode 100644 index cd48b4073..000000000 --- a/packages/http/dcg_basics.pl +++ /dev/null @@ -1,364 +0,0 @@ -/* $Id$ - - Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: wielemak@science.uva.nl - WWW: http://www.swi-prolog.org - Copyright (C): 1985-2007, University of Amsterdam - - 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 Lesser 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 - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(dcg_basics, - [ white//0, % - whites//0, % * - blank//0, % - blanks//0, % * - nonblank//1, % - nonblanks//1, % * --> chars (long) - blanks_to_nl//0, % [space,tab,ret]*nl - string//1, % * -->chars (short) - string_without//2, % Exclude, -->chars (long) - % Characters - alpha_to_lower//1, % Get lower|upper, return lower - % Decimal numbers - digits//1, % [0-9]* -->chars - digit//1, % [0-9] --> char - integer//1, % [+-][0-9]+ --> integer - float//1, % [+-]?[0-9]+(.[0-9]*)?(e[+-]?[0-9]+)? --> float - number//1, % integer | float - % Hexadecimal numbers - xdigits//1, % [0-9a-f]* --> 0-15* - xdigit//1, % [0-9a-f] --> 0-15 - xinteger//1, % [0-9a-f]+ --> integer - % Misc - eos//0, % demand end-of-string - % generation (TBD) - atom//1 % generate atom - ]). -:- use_module(library(lists)). - - -/** Various general DCG utilities - -This library provides various commonly used DCG primitives acting on -list of character codes. Character classification is based on -code_type/2. - -@tbd Try to achieve an accepted standard and move this into the - general SWI-Prolog library. None of this is HTTP specific. -*/ - -%% string_without(+End, -Codes)// is det. -% -% Take as many tokens from the input until the next token appears -% in End. End itself is left on the input. Typical use is to read -% upto a defined delimiter such as a newline or other reserved -% character. -% -% @see string//1. - -string_without(Not, [C|T]) --> - [C], - { \+ memberchk(C, Not) - }, !, - string_without(Not, T). -string_without(_, []) --> - []. - -%% string(-Codes)// is nondet. -% -% Take as few as possible tokens from the input, taking one more -% each time on backtracking. This code is normally followed by a -% test for a delimiter. E.g. -% -% == -% upto_colon(Atom) --> -% string(Codes), ":", !, -% { atom_codes(Atom, Codes) }. -% == - -string([]) --> - []. -string([H|T]) --> - [H], - string(T). - -%% blanks// is det. -% -% Skip zero or more white-space characters. - -blanks --> - blank, !, - blanks. -blanks --> - []. - -%% blank// is semidet. -% -% Take next =space= character from input. Space characters include -% newline. -% -% @see white//0 - -blank --> - [C], - { nonvar(C), - code_type(C, space) - }. - -%% nonblanks(-Codes)// is det. -% -% Take all =graph= characters - -nonblanks([H|T]) --> - [H], - { code_type(H, graph) - }, !, - nonblanks(T). -nonblanks([]) --> - []. - -%% nonblank(-Code)// is semidet. -% -% Code is the next non-blank (=graph=) character. - -nonblank(H) --> - [H], - { code_type(H, graph) - }. - -%% blanks_to_nl// is semidet. -% -% Take a sequence of blank//0 codes if banks are followed by a -% newline or end of the input. - -blanks_to_nl --> - "\n", !. -blanks_to_nl --> - blank, !, - blanks_to_nl. -blanks_to_nl --> - eos. - -%% whites// is det. -% -% Skip white space _inside_ a line. -% -% @see blanks//0 also skips newlines. - -whites --> - white, !, - whites. -whites --> - []. - -%% white// is semidet. -% -% Take next =white= character from input. White characters do -% _not_ include newline. - -white --> - [C], - { nonvar(C), - code_type(C, white) - }. - - - /******************************* - * CHARACTER STUFF * - *******************************/ - -%% alpha_to_lower(+C)// is det. -%% alpha_to_lower(-C)// is semidet. -% -% Read a letter (class =alpha=) and return it as a lowercase -% letter. In output mode this simply emits the character. - -alpha_to_lower(L) --> - { integer(L) }, !, - [L]. -alpha_to_lower(L) --> - [C], - { code_type(C, alpha), - code_type(C, to_upper(L)) - }. - - - /******************************* - * NUMBERS * - *******************************/ - -%% digits(?Chars)// is det. -%% digit(?Char)// is det. -%% integer(?Integer)// is det. -% -% Number processing. The predicate digits//1 matches a posibly -% empty set of digits, digit//1 processes a single digit and -% integer processes an optional sign followed by a non-empty -% sequence of digits into an integer. - -digits([H|T]) --> - digit(H), !, - digits(T). -digits([]) --> - []. - -digit(C) --> - [C], - { code_type(C, digit) - }. - -integer(I, Head, Tail) :- - integer(I), !, - format(codes(Head, Tail), '~w', [I]). -integer(I) --> - int_codes(Codes), - { number_codes(I, Codes) - }. - -int_codes([C,D0|D]) --> - sign(C), !, - digit(D0), - digits(D). -int_codes([D0|D]) --> - digit(D0), - digits(D). - - -%% float(?Float)// is det. -% -% Process a floating point number. The actual conversion is -% controlled by number_codes/2. - -float(F, Head, Tail) :- - float(F), !, - with_output_to(codes(Head, Tail), write(F)). -float(F) --> - number(F), - { float(F) }. - -%% number(+Number)// is det. -%% number(-Number)// is semidet. -% -% Generate extract a number. Handles both integers and floating -% point numbers. - -number(N, Head, Tail) :- - number(N), !, - format(codes(Head, Tail), '~w', N). -number(N) --> - int_codes(I), - ( dot, - digit(DF0), - digits(DF) - -> {F = [0'., DF0|DF]} - ; {F = ""} - ), - ( exp - -> int_codes(DI), - {E=[0'e|DI]} - ; {E = ""} - ), - { append([I, F, E], Codes), - number_codes(N, Codes) - }. - -sign(0'-) --> "-". -sign(0'+) --> "+". - -dot --> ".". - -exp --> "e". -exp --> "E". - - /******************************* - * HEX NUMBERS * - *******************************/ - -%% xinteger(+Integer)// is det. -%% xinteger(-Integer)// is semidet. -% -% Generate or extract an integer from a sequence of hexadecimal -% digits. - -xinteger(Val, Head, Tail) :- - integer(Val), - format(codes(Head, Tail), '~16r', [Val]). -xinteger(Val) --> - xdigit(D0), - xdigits(D), - { mkval([D0|D], 16, Val) - }. - -%% xdigit(-Weight)// is semidet. -% -% True if the next code is a hexdecimal digit with Weight. Weight -% is between 0 and 15. - -xdigit(D) --> - [C], - { code_type(C, xdigit(D)) - }. - -%% xdigits(-WeightList)// is det. -% -% List of weights of a sequence of hexadecimal codes. WeightList -% may be empty. - -xdigits([D0|D]) --> - xdigit(D0), !, - xdigits(D). -xdigits([]) --> - []. - -mkval([W0|Weights], Base, Val) :- - mkval(Weights, Base, W0, Val). - -mkval([], _, W, W). -mkval([H|T], Base, W0, W) :- - W1 is W0*Base+H, - mkval(T, Base, W1, W). - - - /******************************* - * END-OF-STRING * - *******************************/ - -%% eos// -% -% True if at end of input list. - -eos([], []). - - /******************************* - * GENERATION * - *******************************/ - -%% atom(+Atom)// is det. -% -% Generate codes of Atom. Current implementation uses write/1, -% dealing with any Prolog term. - -atom(Atom, Head, Tail) :- - format(codes(Head, Tail), '~w', [Atom]). diff --git a/packages/http/examples/README b/packages/http/examples/README deleted file mode 100644 index 81b85e73f..000000000 --- a/packages/http/examples/README +++ /dev/null @@ -1,68 +0,0 @@ -This is a simple demo of the HTTP server facilities, providing a simple -body and the three documented server instantiations. - ----+ The server main programs are: - - $ demo_threads.pl : - Run threaded server. Requires SWI-Prolog with thread-support. - The server is started at port 3000 using server/0. server/2 - allows to specify options. tm/0 provides a graphical display - of the runing threads. See source-file. - - $ demo_xpce.pl : - Run XPCE-based event-driven server. Requires XPCE. Use - ?- server(3000). to start the server at port 3000. - - $ demo_inetd : - To install this, adjust the first line of this file to point - to the installed Prolog executable and add the following line - to /etc/inetd.conf (adjust as needed): - - 4001 stream tcp nowait nobody /usr/sbin/tcpd /usr/lib/pl-5.1.4/library/http/demo/demo_inetd - ----+ Session management demo: - - $ calc.pl : - Multi-threaded server with session management using the - html_write.pl library. See source for usage. - ----+ File serving demo: - - $ demo_files.pl : - Is a multi-threaded server that serves static files and - directory indices. - ----+ Client demo - - $ demo_client.pl : - Simple multi-threaded client to test the server under - different conditions. Requires SWI-Prolog with thread-support. - See source for usage. - ----+ Performance testing - -A very early start of some routines to validate the server platform. -Eventually, stress_server.pl will serve different tests from multiple -locations and stress_client.pl will contain client code to run -individual tests as well as doing multi-threaded tests. - - $ stress_server.pl : - Server platform. - - $ stress_client.pl : - Client. - - - - - - - - - - - - - - - diff --git a/packages/http/examples/calc.pl b/packages/http/examples/calc.pl deleted file mode 100644 index 125b5fe86..000000000 --- a/packages/http/examples/calc.pl +++ /dev/null @@ -1,92 +0,0 @@ -/* $Id$ - - Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: wielemak@science.uva.nl - WWW: http://www.swi-prolog.org - Copyright (C): Public domain -*/ - -:- use_module(library('http/thread_httpd')). -:- use_module(library('http/html_write')). -:- use_module(library('http/http_session')). -:- use_module(library('http/http_error')). - -/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -This demo shows session state management in a very simple calculator -package. It also demonstrates the use of the html_write library. To use -it, start Prolog, load this file and run - - ?- server. - -Now direct your browser to http://localhost:3000/ -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ - -server :- - server(3000, []). - -server(Port, Options) :- - http_server(reply, - [ port(Port), - timeout(20) - | Options - ]). - -reply(Request) :- - memberchk(path(Path), Request), - reply(Path, Request). - -reply(/, _Request) :- - http_session_retractall(formula(_)), - Formula = 0, - http_session_assert(formula(Formula)), - page(Formula). - -reply('/calc', Request) :- - memberchk(search(Search), Request), - memberchk(operation=Op, Search), - memberchk(value=AtomVal, Search), - atom_number(AtomVal, Val), - http_session_retract(formula(Formula0)), - debug(calc, 'Formula0 = ~w', [Formula0]), - Formula =.. [Op, Formula0, Val], - http_session_assert(formula(Formula)), - page(Formula). - - -page(Formula) :- - reply_page('HTTP Session DEMO', - [ h2('Simple session demo'), - form([ action('/calc'), - method('GET') - ], - table([align(center), border(1)], - [ tr(td(\formula(Formula))), - tr(td([ \ops, - input([ name(value) ]), - input([ type(submit), - value('Calc!') - ]) - ])) - ])) - ]). - -formula(Formula) --> - { sformat(S, '~w', [Formula]), - Value is Formula - }, - html([ S, ' = ', Value ]). - -ops --> - html(select(name(operation), - [ option([selected], +), - option([], -), - option([], /), - option([], *) - ])). - -reply_page(Title, Content) :- - phrase(page(title(Title), Content), HTML), - format('Content-type: text/html~n~n'), - print_html(HTML). diff --git a/packages/http/examples/demo_body.pl b/packages/http/examples/demo_body.pl deleted file mode 100644 index f14b60317..000000000 --- a/packages/http/examples/demo_body.pl +++ /dev/null @@ -1,212 +0,0 @@ -/* $Id$ - - Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: jan@swi.psy.uva.nl - WWW: http://www.swi-prolog.org - Copyright (C): 1985-2002, University of Amsterdam - - 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 Lesser 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 - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(demo_body, - [ reply/1 - ]). -:- use_module(library('http/http_client')). -:- use_module(library('http/http_mime_plugin')). % Decode multipart data -:- use_module(library('http/http_image')). % make XPCE generate images - - -:- style_check(-atom). % allow long atoms - -reply(_) :- - flag(request, N, N+1), - fail. - -% /quit -% -% Explicitely close the connection - -reply(Request) :- - member(path('/quit'), Request), !, - format('Connection: close~n', []), - format('Content-type: text/html~n~n', []), - format('Bye Bye~n'). - -% /xpce?class=box -% -% Make XPCE reply with a graphics image. The demo-body pce_reply/1 -% is called embedded in a message to XPCE to force the XPCE -% incremental garbage collector to reclaim objects created while -% serving the request. pce_reply/1 replies to ?class=box using a -% blue box with rounded corners. - -reply(Request) :- - member(path('/xpce'), Request), !, - send(@prolog, call, demo_body:pce_reply(Request)). - -% /env -% -% Reply with the output of printenv (Unix systems only). - -reply(Request) :- - member(path('/env'), Request), !, - expand_file_name(~, Home), - format('Content-type: text/html~n~n', []), - format('~n', []), - flag(request, RN, RN), - format('Request ~d~n', [RN]), - format('
~n', []),
-	format('HOME = ~w~n~n', [Home]),
-	open(pipe(printenv), read, Fd),
-	copy_stream_data(Fd, current_output),
-	close(Fd),
-	format('
~n', []), - format('~n', []). - -% /upload -% /upload_reply -% -% Provide a form for uploading a file, and deal with the resulting -% upload. Contributed by Nicos Angelopoulos. - -reply(Request) :- - member(path('/upload'), Request), !, - format('Content-type: text/html~n~n', []), - format('~n', []), - format('
~n', []), - format(''), - format(''), - format('~n', []), - format('~n', []). - -reply(Request) :- - member(path('/upload_reply'), Request), !, - format('Content-type: text/html~n~n', []), - format('~n', []), - format('
~n', []),
-	write( req(Request) ), nl,
-	http_read_data(Request, Data, []),
-	write( data(Data) ), nl,
-	format('
'), - format('~n', []), - format('~n', []). - -% /xml -% -% Return a simple formatted XML message. - -reply(Request) :- - member(path('/xml'), Request), !, - format('Content-type: text/xml~n~n', []), - format('\ - - - Jan Wielemaker - Prolog users - The SWI-Prolog web-server - - -

-This is the first demo of the web-server serving an XML message -

- - -', []). - -% /foreign -% -% Test emitting text using UTF-8 encoding - -reply(Request) :- - member(path('/foreign'), Request), !, - format('Content-type: text/html~n~n', []), - format('\ - -Foreign characters - -

Chinese for book is ~s - - -', -[ [23398, 20064] -]). - - -% /work -% -% Do a lot of work and then say 'ok'. Can be used to test -% concurrent access using the multi-threaded server. - -reply(Request) :- - member(path('/work'), Request), - format(user_error, 'Starting work ...', []), - forall(between(1, 10000000, _), atom_codes(_, "hello")), - format(user_error, 'done!~n', []), - format('Content-type: text/plain~n~n', []), - format('ok~n'). - -% /error -% -% Produce an error. Load http_error to see the effect. - -reply(Request) :- - member(path('/error'), Request), - A is 1/0, - format('Content-type: text/plain~n~n', []), - format('A = ~w~n', [A]). - -% ... Otherwise -% -% Print the request itself. - -reply(Request) :- - format('Content-type: text/html~n~n', []), - format('~n', []), - format('~n'), - print_request(Request), - format('~n
~n'), - format('~n', []). - - -print_request([]). -print_request([H|T]) :- - H =.. [Name, Value], - format('~w~w~n', [Name, Value]), - print_request(T). - - - /******************************* - * PCE BASED REQUESTS * - *******************************/ - -pce_reply(Request) :- - memberchk(search(Search), Request), - memberchk(class=box, Search), - new(Box, box(200,200)), - send(Box, radius, 20), - send(Box, fill_pattern, colour(skyblue)), - reply_image(Box, []). - - - diff --git a/packages/http/examples/demo_client.pl b/packages/http/examples/demo_client.pl deleted file mode 100644 index 73a5f2732..000000000 --- a/packages/http/examples/demo_client.pl +++ /dev/null @@ -1,161 +0,0 @@ -/* $Id$ - - Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: jan@swi.psy.uva.nl - WWW: http://www.swi-prolog.org - Copyright (C): 1985-2002, University of Amsterdam - - 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 Lesser 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 - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- use_module(library('http/http_client')). -:- use_module(library(debug)). -:- use_module(library('http/http_sgml_plugin')). - - -% stress(+Times, +Threads, +URLOrAlias) -% -% Typical use: stress(1000, 3, 1): run the test 1000 times with -% 3 client threads on the /xml test from demo_body.pl and verify -% the parsed result. - -stress(Times, Parallel, Alias) :- - answer(Alias, URL, _), !, - stress(Times, Parallel, URL). -stress(Times, Parallel, URL) :- - ( pool(pool, _) - -> delete_pool(pool) - ; true - ), - create_pool(pool, Parallel), - stress(Times, URL), - wait_done(Times), - delete_pool(pool). - -wait_done(0) :- !. -wait_done(N) :- - thread_get_message(done, Result), - put(Result), flush, - N1 is N - 1, - wait_done(N1). - -stress(0, _) :- !. -stress(N, URL) :- - thread_send_message(pool, stress_url(URL)), - NN is N - 1, - stress(NN, URL). - -stress_url(URL) :- - thread_self(Me), - atom_number(N, Me), - ( catch(http_get(URL, X, [connection(close)]), E, true) - -> ( var(E) - -> ( answer(_, URL, Correct) - -> ( X == Correct - -> thread_send_message(done, N) - ; thread_send_message(done, !) - ) - ; thread_send_message(done, ?) - ) - ; print_message(error, E), - thread_send_message(done, 'E') - ) - ; thread_send_message(done, -) - ). - -:- dynamic - pool/2. % name, threads - -create_pool(Name, N) :- - message_queue_create(Name), - findall(Id, (between(1, N, _), - thread_create(worker(Name), Id, [])), Threads), - assert(pool(Name, Threads)). - - -delete_pool(Name) :- - pool(Name, Threads), - forall(member(_, Threads), thread_send_message(Name, thread_exit(ok))), - forall(member(Id, Threads), thread_join(Id, _)), - message_queue_destroy(Name), - retract(pool(Name, Threads)). - - - - - -worker(Queue) :- - repeat, - thread_get_message(Queue, Goal), - ( catch(Goal, E, true) - -> ( var(E) - -> true - ; print_message(error, E) - ) - ; print_message(error, goal_failed(Goal)) - ), - fail. - - - /******************************* - * CORRECT ANSWERS * - *******************************/ - - -answer(1, 'http://localhost:3000/xml', - [ element(message, - [], - [ '\n ', - element(head, - [], - [ '\n ', - element(from, - [], - [ 'Jan Wielemaker' - ]), - '\n ', - element(to, - [], - [ 'Prolog users' - ]), - '\n ', - element(subject, - [], - [ 'The SWI-Prolog web-server' - ]), - '\n ' - ]), - '\n ', - element(body, - [], - [ '\n', - element(p, - [], - [ '\nThis is the first demo of the web-server serving an XML message\n' - ]), - '\n ' - ]), - '\n' - ]) - ]). diff --git a/packages/http/examples/demo_files.pl b/packages/http/examples/demo_files.pl deleted file mode 100644 index ada22bd80..000000000 --- a/packages/http/examples/demo_files.pl +++ /dev/null @@ -1,50 +0,0 @@ -:- use_module(library(http/thread_httpd)). -:- use_module(library(http/html_write)). -:- use_module(library(http/http_dispatch)). -:- use_module(library(http/http_dirindex)). - -:- http_handler(root(.), serve_files, [prefix]). - -%% server(+Port, +DirSpec) is det. -% -% Start the server at port Port, serving directories below -% DirSpec. DirSpec may contain ~ and $var. -% -% This simple example defines a complete web-server for static -% pages. Note that more specific handlers than the bave (i.e. -% using a longer path) have priority over this handler and can -% thus be used to add dynamic parts to your server. - -server(Port, DirSpec) :- - expand_file_name(DirSpec, [Dir]), - assert(user:file_search_path(document_root, Dir)), - http_server(http_dispatch, [port(Port)]). - -%% serve_files(Request) -% -% Server a file or directory according to the path_info field, -% which contains the path *after* the http-location matched by the -% handler. If the handler is matched *exactly*, path_info is -% missing. -% -% http_safe_file/1 checks the path for attempts to escape from the -% hierarchy defined by the =document_root= alias. We find the path -% before calling one of the two reply functions because we want to -% know whether we are dealing with a directory or a file. After -% that, the path is absolute and we must pass unsafe(true) to -% avoid the path-checker in the reply-functions complaining. - -serve_files(Request) :- - ( memberchk(path_info(PathInfo), Request) - -> true - ; PathInfo = './' - ), - http_safe_file(document_root(PathInfo), []), - absolute_file_name(document_root(PathInfo), Path, - [ access(read)] ), - ( exists_directory(Path) - -> http_reply_dirindex(Path, [unsafe(true)], Request) - ; http_reply_file(Path, [unsafe(true)], Request) - ). - - diff --git a/packages/http/examples/demo_inetd b/packages/http/examples/demo_inetd deleted file mode 100755 index d3b820596..000000000 --- a/packages/http/examples/demo_inetd +++ /dev/null @@ -1,18 +0,0 @@ -#!/usr/bin/pl -t main -q -f -/* $Id$ - - Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: jan@swi.psy.uva.nl - WWW: http://www.swi.psy.uva.nl/projects/SWI-Prolog/ - Copying: GPL-2. See the file COPYING or http://www.gnu.org - - Copyright (C) 1990-2001 SWI, University of Amsterdam. All rights reserved. -*/ - -:- use_module(demo_body). -:- use_module(library('http/inetd_httpd')). - -main :- - http_server(reply, []). diff --git a/packages/http/examples/demo_openid.pl b/packages/http/examples/demo_openid.pl deleted file mode 100644 index 03ab5daea..000000000 --- a/packages/http/examples/demo_openid.pl +++ /dev/null @@ -1,173 +0,0 @@ -/* Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: J.Wielemaker@cs.vu.nl - WWW: http://www.swi-prolog.org - Copyright (C): 2007-2010, University of Amsterdam, - VU University Amsterdam - - 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 library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - - -:- asserta(file_search_path(library, '..')). - -:- use_module(library(uri)). -:- use_module(library(http/http_openid)). -:- use_module(library(http/http_host)). -:- use_module(library(http/http_dispatch)). -:- use_module(library(http/http_path)). -:- use_module(library(http/thread_httpd)). -:- use_module(library(http/html_write)). -:- use_module(library(http/http_error)). - -http:location(openid, root(openid), []). - -:- multifile - http_openid:openid_hook/1. - -http_openid:openid_hook(trusted(_OpenID, Server)) :- - debug(openid(test), 'Trusting server ~q', [Server]). - - -%% server -% -% Create demo server and client. After starting the server, -% contact http://localhost:8000/ - -server :- - debug(openid(_)), - Port = 8000, - http_server(http_dispatch, - [ port(Port) - ]), - debug(openid(test), 'Server started at http://localhost:~w/', [Port]). - - -assoc :- - openid_associate('http://localhost:8000/openid/server', Handle, Assoc), - writeln(Handle-Assoc). - -%% secret(+Request) is det. -% -% Example of a handler that requires an OpenID login. If the user -% is not logged it, it will be redirected to the login page, from -% there to the OpenID server and back here. All this is completely -% transparent to us. - -:- http_handler(root('secret'), secret, []). - -secret(Request) :- - openid_user(Request, User, []), - reply_html_page(title('Secret'), - [ 'You\'ve reached the secret page as user ', %' - a(href(User), User) - ]). - -%% root(+Request). -%% allow(+Request). -% -% Shows an indirect login. - -:- http_handler(root(.), root, []). -:- http_handler(root('test/verify'), openid_verify([return_to(allow)]), []). -:- http_handler(root('test/allow'), allow, []). - -root(_Request) :- - reply_html_page(title('Demo OpenID consumer'), - [ h1('OpenID consumer'), - form([ name(login), - action('/test/verify'), - method('GET') - ], - [ div([ 'OpenID: ', - input([ name(openid_url), - size(40), - value('http://localhost:8000/user/bob') % test - ]), - input([type(submit), value('Verify!')]) - ]) - ]), - p([ 'Or go directly to the ', a(href=secret, 'secret page') ]) - ]). - - -allow(Request) :- - openid_authenticate(Request, Server, Identity, _ReturnTo), - reply_html_page(title('Success'), - [ h1('OpenID login succeeded'), - p([ 'The OpenID server ', - a(href(Server),Server), - ' verified you as ', - a(href(Identity), Identity) - ]) - ]). - - - /******************************* - * OpenID SERVER * - *******************************/ - -:- http_handler(root('user/'), user_page, [prefix]). -:- http_handler(openid(server), openid_server([]), []). -:- http_handler(openid(grant), openid_grant, []). - -:- multifile - http_openid:openid_hook/1. - -http_openid:openid_hook(grant(_Request, Options)) :- - debug(openid(test), 'Granting access to ~p', [Options]). - -%% user_page(+Request) is det. -% -% Generate a page for user as /user/. - -user_page(Request) :- - http_current_host(Request, Host, Port, - [ global(true) - ]), - http_location_by_id(openid_server, ServerLocation), - uri_authority_data(host, AComp, Host), - uri_authority_data(port, AComp, Port), - uri_authority_components(Authority, AComp), - uri_data(scheme, Components, http), - uri_data(authority, Components, Authority), - uri_data(path, Components, ServerLocation), - uri_components(OpenIDServer, Components), - memberchk(path_info(User), Request), - reply_html_page([ link([ rel('openid.server'), - href(OpenIDServer) - ]), - title('OpenID page of ~w'-[User]) - ], - h1('OpenID page of ~w'-[User])). - - - /******************************* - * DEBUG * - *******************************/ - -:- http_handler(root(.), print_request, [prefix]). - -print_request(Request) :- - format('Content-type: text/plain~n~n'), - pp(Request). diff --git a/packages/http/examples/demo_pwp.pl b/packages/http/examples/demo_pwp.pl deleted file mode 100644 index 4ca81e6f6..000000000 --- a/packages/http/examples/demo_pwp.pl +++ /dev/null @@ -1,20 +0,0 @@ -:- use_module(library(http/thread_httpd)). -:- use_module(library(http/http_parameters)). -:- use_module(library(http/http_dispatch)). -:- use_module(library(http/http_error)). -:- use_module(library(http/html_write)). -:- use_module(library(http/http_pwp)). - -:- prolog_load_context(directory, Dir), - asserta(user:file_search_path(http_demo, Dir)). - -user:file_search_path(pwp_demo, http_demo(pwp)). - -:- http_handler(root(.), - pwp_handler([path_alias(pwp_demo), view(true)]), - [prefix]). - -server(Port) :- - http_server(http_dispatch, [port(Port)]). - - diff --git a/packages/http/examples/demo_threads.pl b/packages/http/examples/demo_threads.pl deleted file mode 100644 index 4de1d845e..000000000 --- a/packages/http/examples/demo_threads.pl +++ /dev/null @@ -1,30 +0,0 @@ -/* $Id$ - - Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: jan@swi.psy.uva.nl - WWW: http://www.swi.psy.uva.nl/projects/SWI-Prolog/ - Copying: GPL-2. See the file COPYING or http://www.gnu.org - - Copyright (C) 1990-2001 SWI, University of Amsterdam. All rights reserved. -*/ - -:- load_files([ demo_body, - library('http/thread_httpd') - ], - [ silent(true) - ]). - -server :- - server(3000, []). - -server(Port, Options) :- - http_server(reply, - [ port(Port), - timeout(20) - | Options - ]). - -tm :- - prolog_ide(thread_monitor). diff --git a/packages/http/examples/demo_xpce.pl b/packages/http/examples/demo_xpce.pl deleted file mode 100644 index ac0caf8fe..000000000 --- a/packages/http/examples/demo_xpce.pl +++ /dev/null @@ -1,40 +0,0 @@ -/* $Id$ - - Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: jan@swi.psy.uva.nl - WWW: http://www.swi-prolog.org - Copyright (C): 1985-2002, University of Amsterdam - - 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 Lesser 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 - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- use_module(library('http/xpce_httpd')). -:- use_module(demo_body). - -server(Port) :- - http_server(reply, - [ port(Port) - ]). - - diff --git a/packages/http/examples/pwp/context.pwp b/packages/http/examples/pwp/context.pwp deleted file mode 100644 index c2cd8565b..000000000 --- a/packages/http/examples/pwp/context.pwp +++ /dev/null @@ -1,23 +0,0 @@ - - - - - - - Context variables for PWP scripts - - -

This PWP demo lists the context-parameters that are passed into - the script. -

-
    -
  • - - = - -
    • -
- - - - diff --git a/packages/http/examples/pwp/index.pwp b/packages/http/examples/pwp/index.pwp deleted file mode 100644 index c38ee0ed8..000000000 --- a/packages/http/examples/pwp/index.pwp +++ /dev/null @@ -1,25 +0,0 @@ - - - - - - - Index for PWP demos - - - -

PWP scripts in this directory

- - - - - - diff --git a/packages/http/examples/pwp/pwp1.pwp b/packages/http/examples/pwp/pwp1.pwp deleted file mode 100644 index 8c081a50c..000000000 --- a/packages/http/examples/pwp/pwp1.pwp +++ /dev/null @@ -1,12 +0,0 @@ - - - - - - </head> - <body> - <p><span pwp:use="Greeting" pwp:tag='-'/></p> - </body> -</html> diff --git a/packages/http/examples/pwp/pwp2.pwp b/packages/http/examples/pwp/pwp2.pwp deleted file mode 100644 index fc0eaae27..000000000 --- a/packages/http/examples/pwp/pwp2.pwp +++ /dev/null @@ -1,10 +0,0 @@ -<?xml version="1.0"?> - -<html - xmlns:pwp="http://www.cs.otago.ac.nz/staffpriv/ok/pwp.pl"> - <head><title>Example 2 - -

-

The answer is .

- - diff --git a/packages/http/examples/pwp/pwp3.pwp b/packages/http/examples/pwp/pwp3.pwp deleted file mode 100644 index 752b2a21c..000000000 --- a/packages/http/examples/pwp/pwp3.pwp +++ /dev/null @@ -1,25 +0,0 @@ - - - - - Phone list for Full-Time staff. - - -

Phone list for Full-Time staff.

- - - - -
NamePhone
- -
- - diff --git a/packages/http/examples/pwp/pwp4.pwp b/packages/http/examples/pwp/pwp4.pwp deleted file mode 100644 index bba90bea9..000000000 --- a/packages/http/examples/pwp/pwp4.pwp +++ /dev/null @@ -1,23 +0,0 @@ - - - - - Phone list for Full-Time staff. - - -

Phone list for Full-Time staff.

- - - - - -
NameAddress
-
- - diff --git a/packages/http/examples/pwp/pwp5.pwp b/packages/http/examples/pwp/pwp5.pwp deleted file mode 100644 index 2608d8466..000000000 --- a/packages/http/examples/pwp/pwp5.pwp +++ /dev/null @@ -1,11 +0,0 @@ - - - - $SHELL - -

The default shell is .

-

There is no default shell.

- - diff --git a/packages/http/examples/pwp/pwp6.pwp b/packages/http/examples/pwp/pwp6.pwp deleted file mode 100644 index e1711df5a..000000000 --- a/packages/http/examples/pwp/pwp6.pwp +++ /dev/null @@ -1,3 +0,0 @@ - - -b diff --git a/packages/http/examples/pwp/pwp7.pwp b/packages/http/examples/pwp/pwp7.pwp deleted file mode 100644 index 670c1ef83..000000000 --- a/packages/http/examples/pwp/pwp7.pwp +++ /dev/null @@ -1,3 +0,0 @@ - - - diff --git a/packages/http/examples/pwp/pwp8.pwp b/packages/http/examples/pwp/pwp8.pwp deleted file mode 100644 index 4fa3b6bf4..000000000 --- a/packages/http/examples/pwp/pwp8.pwp +++ /dev/null @@ -1,3 +0,0 @@ - - - diff --git a/packages/http/examples/pwp/pwpdb.pl b/packages/http/examples/pwp/pwpdb.pl deleted file mode 100644 index aae523e1a..000000000 --- a/packages/http/examples/pwp/pwpdb.pl +++ /dev/null @@ -1,12 +0,0 @@ -% This is a tiny data base for testing PWP. - -msg('Hello, World!'). - -status(tom, full_time). -status(dick, part_time). -status(harry, full_time). - -staff(tom, 'Tom Cat', 1-21, 'x1234', 'tom@jerry.example.org'). -staff(dick, 'Dick Tater', 2-50, 'x9999', 'boss@hq.example.org'). -staff(harry, 'Harry Ett', 3-14, 'x7654', 'h.ett@kit.example.org'). - diff --git a/packages/http/examples/stress_client.pl b/packages/http/examples/stress_client.pl deleted file mode 100644 index 9ef937ca5..000000000 --- a/packages/http/examples/stress_client.pl +++ /dev/null @@ -1,52 +0,0 @@ -/* $Id$ - - Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: wielemak@science.uva.nl - WWW: http://www.swi-prolog.org - Copyright (C): 1985-2007, University of Amsterdam - - 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 library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(http_stress_client, - [ client/2, % +Port, +Test - client/3 % +Port, +Test, +Times - ]). - -:- use_module(library(http/http_client)). - -/** Sample HTTP client to run some stress tests - -*/ - -client(Port, Action, Times) :- - forall(between(1, Times, _), - client(Port, Action)). - - -client(Port, ping) :- - http_get([ host(localhost), - port(Port), - path('/ping') - ], _, []). diff --git a/packages/http/examples/stress_server.pl b/packages/http/examples/stress_server.pl deleted file mode 100644 index 1b0eec596..000000000 --- a/packages/http/examples/stress_server.pl +++ /dev/null @@ -1,129 +0,0 @@ -/* $Id$ - - Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: wielemak@science.uva.nl - WWW: http://www.swi-prolog.org - Copyright (C): 1985-2007, University of Amsterdam - - 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 library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(http_stress_server, - [ server/1, % +Port - profile/0 - ]). -:- load_files([ library(http/thread_httpd), - library(http/html_write), - library(http/http_session), - library(http/http_dispatch), - library(http/http_parameters), - library(http/http_error), - library(thread_pool) - ], - [ silent(true) - ]). - -/** Sample HTTP server to run some stress tests - -*/ - -%% server(+Port) is det. -% -% Start the server at Port. - -server(Port) :- - create_pools, - server(Port, - [ workers(1) - ]). - -server(Port, Options) :- - http_server(http_dispatch, - [ port(Port), - timeout(20) - | Options - ]). - -%% create_pools -% -% Create our thread pools. - -create_pools :- - thread_pool_create(single, 1, [backlog(0)]). - -%% profile -% -% Run thread profiler on the one and only server. - -profile :- - findall(Id, http_current_worker(_, Id), Ids), - ( Ids = [Id] - -> tprofile(Id) - ; Ids == [] - -> format(user_error, 'No HTTP server!~n', []), - fail - ; format(user_error, 'Multiple HTPP workers: ~p~n', [Ids]), - fail - ). - - - /******************************* - * METHODS * - *******************************/ - -:- http_handler('/ping', ping, []). -:- http_handler('/wait', wait, [chunked]). -:- http_handler(prefix('/spawn/'), spawn, [spawn(single)]). -:- http_handler(prefix('/spawn2/'), spawn, [spawn(single)]). - -ping(_Request) :- - format('Content-type: text/plain~n~n'), - format('alife~n'). - -wait(Request) :- - http_parameters(Request, - [ wait(Time, [default(1)]), - count(N, [default(10)]) - ]), - wait(Time, N). - -wait(Time, N) :- - format('Content-type: text/plain~n~n'), - forall(between(1, N, I), - ( sleep(Time), - format('~D~n', [I]), - flush_output - )). - -%% spawn(+Request) -% -% Run requests under /spawn/ in their own thread. - -spawn(Request) :- - selectchk(path(Path), Request, Request1), - ( sub_atom(Path, Start, _, _, /), Start > 0 - -> sub_atom(Path, Start, _, 0, NewPath) - ), - http_dispatch([path(NewPath)|Request1]). - diff --git a/packages/http/figs/.cvsignore b/packages/http/figs/.cvsignore deleted file mode 100644 index a13633799..000000000 --- a/packages/http/figs/.cvsignore +++ /dev/null @@ -1 +0,0 @@ -*.pdf diff --git a/packages/http/figs/httpserver.eps b/packages/http/figs/httpserver.eps deleted file mode 100644 index 6009f2488..000000000 --- a/packages/http/figs/httpserver.eps +++ /dev/null @@ -1,384 +0,0 @@ -%!PS-Adobe-3.0 EPSF-3.0 -%%Creator: PCE 6.6.35, June 2007 -%%CreationDate: (Thu Jun 7 16:13:39 2007) -%%Pages: 1 -%%DocumentFonts: (atend) -%%BoundingBox: 70 70 570 361 -%%Object: @2548888/draw_canvas -%%EndComments - -/draw - { 0 currentlinewidth ne - { currentdash 0 eq exch [] eq and not - { gsave nodash 1 setgray stroke grestore - } if - stroke - } if - } def - -/pspen - { 2 div - } def - -/pen - { pspen - setlinewidth - } def - -/boxpath - { /r exch def - /h exch def - /w exch def - /y exch def - /x exch def - /p exch def - - r 0 eq - { 2 setlinecap newpath - x p pspen add y p pspen add moveto - w p sub 0 rlineto - 0 h p sub rlineto - w p sub neg 0 rlineto - 0 h p sub neg rlineto - } - { newpath - /pr r p pspen add def - x pr add y p pspen add moveto - x w add pr sub y pr add r 270 360 arc - x w add pr sub y h add pr sub r 0 90 arc - x pr add y h add pr sub r 90 180 arc - x pr add y pr add r 180 270 arc - } ifelse - - p pen - } def - -/nodash - { [] 0 setdash - } def - -/text - { /s exch def - /w exch def - - gsave - 1 eq { invert } if - moveto s stringwidth pop w exch div -1 scale s show - grestore - } def - -/startpath - { newpath moveto pen - } def - -/linepath - { /h exch def - /w exch def - newpath moveto w h rlineto - pen - } def - -/dotted - { [1 5] 0 setdash - } def - -gsave - -70 70 translate -0.83 -0.83 scale --196 -425 translate -%%EndProlog -%%Page 0 1 - -%%Object: @2548888/draw_canvas -gsave 0 0 translate 0.00 0.00 0.00 setrgbcolor - -%%Object: @2787654/cml_drole -gsave 222 158 translate - -%%Object: @2744708/box -gsave nodash 1 0 0 100 50 0 boxpath -draw grestore - -%%Object: @2788290/draw_text -grestore - -%%Object: @2788418/cml_drole -gsave 222 158 translate - -%%Object: @2744846/box -gsave nodash 1 0 0 100 50 0 boxpath -draw grestore - -%%Object: @2788530/draw_text -gsave /Helvetica findfont 12 scalefont setfont -9 30 0 82 (thread_httpd.pl) text -grestore -grestore - -%%Object: @2788654/cml_drole -gsave 222 241 translate - -%%Object: @2795026/box -gsave nodash 1 0 0 100 50 0 boxpath -draw grestore - -%%Object: @2795084/draw_text -gsave /Helvetica findfont 12 scalefont setfont -13 30 0 73 (xpce_httpd.pl) text -grestore -grestore - -%%Object: @2790930/cml_drole -gsave 222 158 translate - -%%Object: @2791042/box -gsave nodash 1 0 0 100 50 0 boxpath -draw grestore - -%%Object: @2791100/draw_text -grestore - -%%Object: @2791312/cml_drole -gsave 222 325 translate - -%%Object: @2791424/box -gsave nodash 1 0 0 100 50 0 boxpath -draw grestore - -%%Object: @2791482/draw_text -gsave /Helvetica findfont 12 scalefont setfont -14 30 0 73 (inetd_httpd.pl) text -grestore -grestore - -%%Object: @2790756/cml_drole -gsave 390 241 translate - -%%Object: @2794830/box -gsave nodash 1 0 0 100 50 0 boxpath -draw grestore - -%%Object: @2794888/draw_text -gsave /Helvetica findfont 12 scalefont setfont -8 30 0 84 (http_wrapper.pl) text -grestore -grestore - -%%Object: @2790850/draw_rect_connection -gsave -grestore - -%%Object: @2795558/path -gsave 0 0 translate nodash 1 322 203 startpath - 356 203 lineto - 356 246 lineto 390 246 lineto -draw - -%%Object: @draw_default_arrow/arrow -gsave nodash 0 pen newpath 380 249 moveto 390 246 lineto 380 243 lineto closepath gsave 0.00 setgray fill grestore - grestore -grestore - -%%Object: @2790364/draw_rect_connection -gsave -grestore - -%%Object: @2795684/path -gsave 0 0 translate nodash 1 322 266 startpath - 390 266 lineto - -draw - -%%Object: @draw_default_arrow/arrow -gsave nodash 0 pen newpath 380 269 moveto 390 266 lineto 380 263 lineto closepath gsave 0.00 setgray fill grestore - grestore -grestore - -%%Object: @2791228/draw_rect_connection -gsave -grestore - -%%Object: @2795816/path -gsave 0 0 translate nodash 1 322 330 startpath - 356 330 lineto - 356 286 lineto 390 286 lineto -draw - -%%Object: @draw_default_arrow/arrow -gsave nodash 0 pen newpath 380 289 moveto 390 286 lineto 380 283 lineto closepath gsave 0.00 setgray fill grestore - grestore -grestore - -%%Object: @2793566/cml_function -gsave 681 165 translate - -%%Object: @2793678/box -gsave nodash 1 0 0 100 50 25 boxpath -draw grestore - -%%Object: @2793736/draw_text -gsave /Helvetica findfont 12 scalefont setfont -18 29 0 65 (handler_1/1) text -grestore -grestore - -%%Object: @2795976/draw_text -gsave /Helvetica findfont 12 scalefont setfont -205 387 0 134 (Unix inetd based servers) text -grestore - -%%Object: @2796080/draw_text -gsave /Helvetica findfont 12 scalefont setfont -199 303 0 147 (XPCE event-driven servers) text -grestore - -%%Object: @2796184/draw_text -gsave /Helvetica findfont 12 scalefont setfont -214 220 0 117 (Multi-threaded severs) text -grestore - -%%Object: @2796288/draw_text -gsave /Helvetica findfont 12 scalefont setfont -668 115 0 126 (User's application code) text -grestore - -%%Object: @2796392/draw_text -gsave /Helvetica findfont 12 scalefont setfont -385 115 0 77 (HTTP protocol) text -grestore - -%%Object: @2796556/draw_line -gsave -dotted 1 365 75 0 328 linepath draw -grestore - -%%Object: @2796618/draw_line -gsave -dotted 1 514 80 0 328 linepath draw -grestore - -%%Object: @2796684/draw_text -gsave /Helvetica findfont 12 scalefont setfont -223 115 0 97 (Select server-type) text -grestore - -%%Object: @2796788/draw_line -gsave -dotted 1 649 78 0 328 linepath draw -grestore - -%%Object: @2791796/cml_drole -gsave 533 241 translate - -%%Object: @2794634/box -gsave nodash 1 0 0 100 50 0 boxpath -draw grestore - -%%Object: @2794692/draw_text -gsave /Helvetica findfont 12 scalefont setfont -8 29 0 85 (http_dispatch.pl) text -grestore -grestore - -%%Object: @2791606/draw_rect_connection -gsave -grestore - -%%Object: @2796862/path -gsave 0 0 translate nodash 1 490 266 startpath - 533 266 lineto - -draw - -%%Object: @draw_default_arrow/arrow -gsave nodash 0 pen newpath 523 269 moveto 533 266 lineto 523 263 lineto closepath gsave 0.00 setgray fill grestore - grestore -grestore - -%%Object: @2791890/draw_rect_connection -gsave -grestore - -%%Object: @2797002/path -gsave 0 0 translate nodash 1 633 246 startpath - 657 246 lineto - 657 190 lineto 681 190 lineto -draw - -%%Object: @draw_default_arrow/arrow -gsave nodash 0 pen newpath 671 193 moveto 681 190 lineto 671 187 lineto closepath gsave 0.00 setgray fill grestore - grestore -grestore - -%%Object: @2793944/cml_function -gsave 681 241 translate - -%%Object: @2794056/box -gsave nodash 1 0 0 100 50 25 boxpath -draw grestore - -%%Object: @2794114/draw_text -gsave /Helvetica findfont 12 scalefont setfont -18 29 0 65 (handler_2/1) text -grestore -grestore - -%%Object: @2793860/draw_rect_connection -gsave -grestore - -%%Object: @2797162/path -gsave 0 0 translate nodash 1 633 266 startpath - 681 266 lineto - -draw - -%%Object: @draw_default_arrow/arrow -gsave nodash 0 pen newpath 671 269 moveto 681 266 lineto 671 263 lineto closepath gsave 0.00 setgray fill grestore - grestore -grestore - -%%Object: @2794322/cml_function -gsave 681 375 translate - -%%Object: @2794434/box -gsave nodash 1 0 0 100 50 25 boxpath -draw grestore - -%%Object: @2794492/draw_text -gsave /Helvetica findfont 12 scalefont setfont -18 29 0 65 (handler_n/1) text -grestore -grestore - -%%Object: @2794238/draw_rect_connection -gsave -grestore - -%%Object: @2797294/path -gsave 0 0 translate nodash 1 633 286 startpath - 657 286 lineto - 657 400 lineto 681 400 lineto -draw - -%%Object: @draw_default_arrow/arrow -gsave nodash 0 pen newpath 671 403 moveto 681 400 lineto 671 397 lineto closepath gsave 0.00 setgray fill grestore - grestore -grestore - -%%Object: @2797450/draw_line -gsave -dotted 1 731 305 0 50 linepath draw -grestore - -%%Object: @2797582/draw_text -gsave /Helvetica findfont 12 scalefont setfont -543 115 0 80 (Dispatch paths) text -grestore -grestore - -%%Trailer -grestore -%%DocumentFonts: -showpage diff --git a/packages/http/figs/httpserver.pd b/packages/http/figs/httpserver.pd deleted file mode 100644 index 5e0bb49eb..000000000 Binary files a/packages/http/figs/httpserver.pd and /dev/null differ diff --git a/packages/http/html_head.pl b/packages/http/html_head.pl deleted file mode 100644 index 5ef554bb5..000000000 --- a/packages/http/html_head.pl +++ /dev/null @@ -1,503 +0,0 @@ -/* Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: J.Wielemaker@uva.nl - WWW: http://www.swi-prolog.org - Copyright (C): 2009, University of Amsterdam - - 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 library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(html_head, - [ html_resource/2, % +Resource, +Attributes - html_requires//1 % +Resource - ]). -:- use_module(library(http/html_write)). -:- use_module(library(http/mimetype)). -:- use_module(library(http/http_path)). -:- use_module(library(error)). -:- use_module(library(settings)). -:- use_module(library(lists)). -:- use_module(library(occurs)). -:- use_module(library(option)). -:- use_module(library(ordsets)). -:- use_module(library(assoc)). -:- use_module(library(ugraphs)). -:- use_module(library(broadcast)). -:- use_module(library(apply)). -:- use_module(library(debug)). - - -/** Automatic inclusion of CSS and scripts links - -This library allows for abstract declaration of available CSS and -Javascript resources and their dependencies using html_resource/2. Based -on these declarations, html generating code can declare that it depends -on specific CSS or Javascript functionality, after which this library -ensures that the proper links appear in the HTML head. The -implementation is based on mail system implemented by html_post/2 of -library html_write.pl. - -Declarations come in two forms. First of all http locations are declared -using the http_path.pl library. Second, html_resource/2 specifies HTML -resources to be used in the =head= and their dependencies. Resources are -currently limited to Javascript files (.js) and style sheets (.css). It -is trivial to add support for other material in the head. See -html_include//1. - -For usage in HTML generation, there is the DCG rule html_requires//1 -that demands named resources in the HTML head. - ----++ About resource ordering - -All calls to html_requires//1 for the page are collected and duplicates -are removed. Next, the following steps are taken: - - 1. Add all dependencies to the set - 2. Replace multiple members by `aggregate' scripts or css files. - see use_agregates/4. - 3. Order all resources by demanding that their dependencies - preceede the resource itself. Note that the ordering of - resources in the dependency list is *ignored*. This implies - that if the order matters the dependency list must be split - and only the primary dependency must be added. - ----++ Debugging dependencies - -Use ?- debug(html(script)). to see the requested and final set of -resources. All declared resources are in html_resource/3. The edit/1 -command recognises the names of HTML resources. - -@tbd Possibly we should add img//2 to include images from symbolic - path notation. -@tbd It would be nice if the HTTP file server could use our location - declarations. -*/ - -:- dynamic - html_resource/3. % Resource, Source, Properties - -%% html_resource(+About, +Properties) is det. -% -% Register an HTML head resource. About is either an atom that -% specifies an HTTP location or a term Alias(Sub). This works -% similar to absolute_file_name/2. See http:location_path/2 for -% details. Recognised properties are: -% -% * requires(+Requirements) -% Other required script and css files. If this is a plain -% file name, it is interpreted relative to the declared -% resource. Requirements can be a list, which is equivalent -% to multiple requires properties. -% -% * virtual(+Bool) -% If =true= (default =false=), do not include About itself, -% but only its dependencies. This allows for defining an -% alias for one or more resources. -% -% * aggregate(+List) -% States that About is an aggregate of the resources in -% List. - -html_resource(About, Properties) :- - source_location(File, Line), !, - retractall(html_resource(About, File:Line, _)), - assert_resource(About, File:Line, Properties). -html_resource(About, Properties) :- - assert_resource(About, -, Properties). - -assert_resource(About, Location, Properties) :- - assert(html_resource(About, Location, Properties)), - clean_same_about_cache, - ( memberchk(aggregate(_), Properties) - -> clean_aggregate_cache - ; true - ). - - -%% html_requires(+ResourceOrList)// is det. -% -% Include ResourceOrList and all dependencies derived from it and -% add them to the HTML =head= using html_post/2. The actual -% dependencies are computed during the HTML output phase by -% html_insert_resource//1. - -html_requires(Required) --> - html_post(head, 'html required'(Required)). - -:- multifile - html_write:html_head_expansion/2. - -html_write:html_head_expansion(In, Out) :- - require_commands(In, Required, Rest), - Required \== [], !, - flatten(Required, Plain), - Out = [ html_head:(\html_insert_resource(Plain)) - | Rest - ]. - -require_commands([], [], []). -require_commands([_:('html required'(Required))|T0], [Required|TR], R) :- !, - require_commands(T0, TR, R). -require_commands([R|T0], TR, [R|T]) :- !, - require_commands(T0, TR, T). - - -%% html_insert_resource(+ResourceOrList)// is det. -% -% Actually include HTML head resources. Called through -% html_post//2 from html_requires//1 after rewrite by -% html_head_expansion/2. We are guaranteed we will only get one -% call that is passed a flat list of requested requirements. We -% have three jobs: -% -% 1. Figure out all indirect requirements -% 2. See whether we can use any `aggregate' resources -% 3. Put required resources before their requiree. - -html_insert_resource(Required) --> - { requirements(Required, Paths), - debug(html(script), 'Requirements: ~q~nFinal: ~q', [Required, Paths]) - }, - html_include(Paths). - -requirements(Required, Paths) :- - phrase(requires(Required), List), - sort(List, Paths0), % remove duplicates - use_agregates(Paths0, Paths1, AggregatedBy), - order_html_resources(Paths1, AggregatedBy, Paths). - -%% use_agregates(+Paths, -Aggregated, -AggregatedBy) is det. -% -% Try to replace sets of resources by an `aggregate', a large -% javascript or css file that combines the content of multiple -% small ones to reduce the number of files that must be -% transferred to the server. The current rule says that aggregates -% are used if at least half of the members are used. - -use_agregates(Paths, Aggregated, AggregatedBy) :- - empty_assoc(AggregatedBy0), - use_agregates(Paths, Aggregated, AggregatedBy0, AggregatedBy). - -use_agregates(Paths, Aggregated, AggregatedBy0, AggregatedBy) :- - current_aggregate(Aggregate, Parts, Size), - ord_subtract(Paths, Parts, NotCovered), - length(Paths, Len0), - length(NotCovered, Len1), - Covered is Len0-Len1, - Covered >= Size/2, !, - ord_add_element(NotCovered, Aggregate, NewPaths), - add_aggregated_by(Parts, AggregatedBy0, Aggregate, AggregatedBy1), - use_agregates(NewPaths, Aggregated, AggregatedBy1, AggregatedBy). -use_agregates(Paths, Paths, AggregatedBy, AggregatedBy). - -add_aggregated_by([], Assoc, _, Assoc). -add_aggregated_by([H|T], Assoc0, V, Assoc) :- - put_assoc(H, Assoc0, V, Assoc1), - add_aggregated_by(T, Assoc1, V, Assoc). - - -:- dynamic - aggregate_cache_filled/0, - aggregate_cache/3. -:- volatile - aggregate_cache_filled/0, - aggregate_cache/3. - -clean_aggregate_cache :- - retractall(aggregate_cache_filled). - -%% current_aggregate(-Aggregate, -Parts, -Size) is nondet. -% -% True if Aggregate is a defined aggregate with Size Parts. All -% parts are canonical absolute HTTP locations and Parts is sorted -% to allow for processing using ordered set predicates. - -current_aggregate(Path, Parts, Size) :- - aggregate_cache_filled, !, - aggregate_cache(Path, Parts, Size). -current_aggregate(Path, Parts, Size) :- - retractall(aggregate_cache(_,_, _)), - forall(uncached_aggregate(Path, Parts, Size), - assert(aggregate_cache(Path, Parts, Size))), - assert(aggregate_cache_filled), - aggregate_cache(Path, Parts, Size). - -uncached_aggregate(Path, APartsS, Size) :- - html_resource(Aggregate, _, Properties), - memberchk(aggregate(Parts), Properties), - http_absolute_location(Aggregate, Path, []), - absolute_paths(Parts, Path, AParts), - sort(AParts, APartsS), - length(APartsS, Size). - -absolute_paths([], _, []). -absolute_paths([H0|T0], Base, [H|T]) :- - http_absolute_location(H0, H, [relative_to(Base)]), - absolute_paths(T0, Base, T). - - -%% requires(+Spec)// is det. -%% requires(+Spec, +Base)// is det. -% -% True if Files is the set of files that need to be loaded for -% Spec. Note that Spec normally appears in Files, but this is not -% necessary (i.e. virtual resources or the usage of aggregate -% resources). - -requires(Spec) --> - requires(Spec, /). - -requires([], _) --> !, - []. -requires([H|T], Base) --> !, - requires(H, Base), - requires(T, Base). -requires(Spec, Base) --> - requires(Spec, Base, true). - -requires(Spec, Base, Virtual) --> - { res_properties(Spec, Properties), - http_absolute_location(Spec, File, [relative_to(Base)]) - }, - ( { option(virtual(true), Properties) - ; Virtual == false - } - -> [] - ; [File] - ), - requires_from_properties(Properties, File). - - -requires_from_properties([], _) --> - []. -requires_from_properties([H|T], Base) --> - requires_from_property(H, Base), - requires_from_properties(T, Base). - -requires_from_property(requires(What), Base) --> !, - requires(What, Base). -requires_from_property(_, _) --> - []. - - -%% order_html_resources(+Requirements, +AggregatedBy, -Ordered) is det. -% -% Establish a proper order for the collected (sorted and unique) -% list of Requirements. - -order_html_resources(Requirements, AggregatedBy, Ordered) :- - requirements_graph(Requirements, AggregatedBy, Graph), - ( top_sort(Graph, Ordered) - -> true - ; connect_graph(Graph, Start, Connected), - top_sort(Connected, Ordered0), - Ordered0 = [Start|Ordered] - ). - -%% requirements_graph(+Requirements, +AggregatedBy, -Graph) is det. -% -% Produce an S-graph (see library(ugraphs)) that represents the -% dependencies in the list of Requirements. Edges run from -% required to requirer. - -requirements_graph(Requirements, AggregatedBy, Graph) :- - phrase(prerequisites(Requirements, AggregatedBy, Vertices, []), Edges), - vertices_edges_to_ugraph(Vertices, Edges, Graph). - -prerequisites([], _, Vs, Vs) --> - []. -prerequisites([R|T], AggregatedBy, Vs, Vt) --> - prerequisites_for(R, AggregatedBy, Vs, Vt0), - prerequisites(T, AggregatedBy, Vt0, Vt). - -prerequisites_for(R, AggregatedBy, Vs, Vt) --> - { phrase(requires(R, /, false), Req) }, - ( {Req == []} - -> {Vs = [R|Vt]} - ; req_edges(Req, AggregatedBy, R), - {Vs = Vt} - ). - -req_edges([], _, _) --> - []. -req_edges([H|T], AggregatedBy, R) --> - ( { get_assoc(H, AggregatedBy, Aggregate) } - -> [Aggregate-R] - ; [H-R] - ), - req_edges(T, AggregatedBy, R). - - -%% connect_graph(+Graph, -Start, -Connected) is det. -% -% Turn Graph into a connected graph by putting a shared starting -% point before all vertices. - -connect_graph([], 0, []) :- !. -connect_graph(Graph, Start, [Start-Vertices|Graph]) :- - vertices(Graph, Vertices), - Vertices = [First|_], - before(First, Start). - -%% before(+Term, -Before) is det. -% -% Unify Before to a term that comes before Term in the standard -% order of terms. -% -% @error instantiation_error if Term is unbound. - -before(X, _) :- - var(X), !, - instantiation_error(X). -before(Number, Start) :- - number(Number), !, - Start is Number - 1. -before(_, 0). - - -%% res_properties(+Spec, -Properties) is det. -% -% True if Properties is the set of defined properties on Spec. - -res_properties(Spec, Properties) :- - findall(P, res_property(Spec, P), Properties0), - list_to_set(Properties0, Properties). - -res_property(Spec, Property) :- - same_about(Spec, About), - html_resource(About, _, Properties), - member(Property, Properties). - -:- dynamic - same_about_cache/2. -:- volatile - same_about_cache/2. - -clean_same_about_cache :- - retractall(same_about_cache(_,_)). - -same_about(Spec, About) :- - same_about_cache(Spec, Same), !, - member(About, Same). -same_about(Spec, About) :- - findall(A, uncached_same_about(Spec, A), List), - assert(same_about_cache(Spec, List)), - member(About, List). - -uncached_same_about(Spec, About) :- - html_resource(About, _, _), - same_resource(Spec, About). - - -%% same_resource(+R1, +R2) is semidet. -% -% True if R1 an R2 represent the same resource. R1 and R2 are -% resource specifications are defined by http_absolute_location/3. - -same_resource(R, R) :- !. -same_resource(R1, R2) :- - resource_base_name(R1, B), - resource_base_name(R2, B), - http_absolute_location(R1, Path, []), - http_absolute_location(R2, Path, []). - -:- dynamic - base_cache/2. -:- volatile - base_cache/2. - -resource_base_name(Spec, Base) :- - ( base_cache(Spec, Base0) - -> Base = Base0 - ; uncached_resource_base_name(Spec, Base0), - assert(base_cache(Spec, Base0)), - Base = Base0 - ). - -uncached_resource_base_name(Atom, Base) :- - atomic(Atom), !, - file_base_name(Atom, Base). -uncached_resource_base_name(Compound, Base) :- - arg(1, Compound, Base0), - file_base_name(Base0, Base). - -%% html_include(+PathOrList)// is det. -% -% Include to HTML resources that must be in the HTML -% element. Currently onlu supports =|.js|= and =|.css|= files. -% Extend this to support more header material. Do not use this -% predicate directly. html_requires//1 is the public interface to -% include HTML resources. -% -% @param HTTP location or list of these. - -html_include([]) --> !. -html_include([H|T]) --> !, - html_include(H), - html_include(T). -html_include(Path) --> - { file_mime_type(Path, Mime) }, !, - html_include(Mime, Path). - -html_include(text/css, Path) --> !, - html(link([ rel(stylesheet), - type('text/css'), - href(Path) - ], [])). -html_include(text/javascript, Path) --> !, - html(script([ type('text/javascript'), - src(Path) - ], [])). -html_include(Mime, Path) --> - { print_message(warning, html_include(dont_know, Mime, Path)) - }. - - - /******************************* - * CACHE CLEANUP * - *******************************/ - -:- multifile - user:message_hook/3. -:- dynamic - user:message_hook/3. - -user:message_hook(make(done(Reload)), _Level, _Lines) :- - Reload \== [], - clean_same_about_cache, - clean_aggregate_cache, - fail. - - - /******************************* - * EDIT * - *******************************/ - -% Allow edit(Location) to edit the :- html_resource declaration. -:- multifile - prolog_edit:locate/3. - -prolog_edit:locate(Path, html_resource(Spec), [file(File), line(Line)]) :- - atom(Path), - html_resource(Spec, File:Line, _Properties), - sub_term(Path, Spec). diff --git a/packages/http/html_write.pl b/packages/http/html_write.pl deleted file mode 100644 index 7745ce122..000000000 --- a/packages/http/html_write.pl +++ /dev/null @@ -1,1278 +0,0 @@ -/* $Id$ - - Part of SWI-Prolog - - Author: Jan Wielemaker and Anjo Anjewierden - E-mail: J.Wielemaker@cs.vu.nl - WWW: http://www.swi-prolog.org - Copyright (C): 1985-2010, University of Amsterdam - VU University Amsterdam - - 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 Lesser 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 - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(html_write, - [ reply_html_page/2, % :Head, :Body - reply_html_page/3, % +Style, :Head, :Body - - % Basic output routines - page//1, % :Content - page//2, % :Head, :Body - html//1, % :Content - - % Option processing - html_set_options/1, % +OptionList - html_current_option/1, % ?Option - - % repositioning HTML elements - html_post//2, % +Id, :Content - html_receive//1, % +Id - html_receive//2, % +Id, :Handler - xhtml_ns//2, % +Id, +Value - - % Useful primitives for expanding - html_begin//1, % +EnvName[(Attribute...)] - html_end//1, % +EnvName - html_quoted//1, % +Text - html_quoted_attribute//1, % +Attribute - - % Emitting the HTML code - print_html/1, % +List - print_html/2, % +Stream, +List - html_print_length/2 % +List, -Length - ]). -:- use_module(library(error)). -:- use_module(library(lists)). -:- use_module(library(option)). -:- use_module(library(pairs)). -:- use_module(library(sgml)). % Quote output -:- use_module(library(url)). -:- use_module(library(quintus)). % for meta_predicate/1 -:- set_prolog_flag(generate_debug_info, false). - -:- meta_predicate - reply_html_page(+, :, :), - reply_html_page(:, :), - html(:, -, +), - page(:, -, +), - page(:, :, -, +), - pagehead(+, :, -, +), - pagebody(+, :, -, +), - html_receive(+, 3, -, +), - html_post(+, :, -, +). - -/** Write HTML text - -The purpose of this library is to simplify writing HTML pages. Of -course, it is possible to use format/3 to write to the HTML stream -directly, but this is generally not very satisfactory: - - * It is a lot of typing - * It does not guarantee proper HTML syntax. You have to deal - with HTML quoting, proper nesting and reasonable layout. - * It is hard to use satisfactory abstraction - -This module tries to remedy these problems. The idea is to translate a -Prolog term into an HTML document. We use DCG for most of the -generation. - ----++ International documents - -The library supports the generation of international documents, but this -is currently limited to using UTF-8 encoded HTML or XHTML documents. It -is strongly recommended to use the following mime-type. - -== -Content-type: text/html; charset=UTF-8 -== - -When generating XHTML documents, the output stream must be in UTF-8 -encoding. -*/ - - - /******************************* - * SETTINGS * - *******************************/ - -%% html_set_options(+Options) is det. -% -% Set options for the HTML output. Options are stored in prolog -% flags to ensure with proper multi-threaded behaviour where -% setting an option is local to the thread and new threads start -% with the options from the parent thread. Defined options are: -% -% * dialect(Dialect) -% One of =html= (default) or =xhtml=. -% -% * doctype(+DocType) -% Set the =|<|DOCTYPE|= DocType =|>|= line for page//1 and -% page//2. -% -% * content_type(+ContentType) -% Set the =|Content-type|= for reply_html_page/3 -% -% Note that the doctype is covered by two prolog flags: -% =html_doctype= for the html dialect and =xhtml_doctype= for the -% xhtml dialect. Dialect muct be switched before doctype. - -html_set_options(Options) :- - must_be(list, Options), - set_options(Options). - -set_options([]). -set_options([H|T]) :- - html_set_option(H), - set_options(T). - -html_set_option(dialect(Dialect)) :- !, - must_be(oneof([html,xhtml]), Dialect), - set_prolog_flag(html_dialect, Dialect). -html_set_option(doctype(Atom)) :- !, - must_be(atom, Atom), - ( current_prolog_flag(html_dialect, html) - -> set_prolog_flag(html_doctype, Atom) - ; set_prolog_flag(xhtml_doctype, Atom) - ). -html_set_option(content_type(Atom)) :- !, - must_be(atom, Atom), - ( current_prolog_flag(html_dialect, html) - -> set_prolog_flag(html_content_type, Atom) - ; set_prolog_flag(xhtml_content_type, Atom) - ). -html_set_option(O) :- - domain_error(html_option, O). - - -%% html_current_option(?Option) is nondet. -% -% True if Option is an active option for the HTML generator. - -html_current_option(dialect(Dialect)) :- - current_prolog_flag(html_dialect, Dialect). -html_current_option(doctype(DocType)) :- - ( current_prolog_flag(html_dialect, html) - -> current_prolog_flag(html_doctype, DocType) - ; current_prolog_flag(xhtml_doctype, DocType) - ). -html_current_option(content_type(ContentType)) :- - ( current_prolog_flag(html_dialect, html) - -> current_prolog_flag(html_content_type, ContentType) - ; current_prolog_flag(xhtml_content_type, ContentType) - ). - - -option_default(html_dialect, html). -option_default(html_doctype, - 'HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" \ - "http://www.w3.org/TR/html4/loose.dtd"'). -option_default(xhtml_doctype, - 'html PUBLIC "-//W3C//DTD XHTML 1.0 \ - Transitional//EN" \ - "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"'). -option_default(html_content_type, 'text/html'). -option_default(xhtml_content_type, 'application/xhtml+xml; charset=UTF-8'). - -%% init_options is det. -% -% Initialise the HTML processing options. - -init_options :- - ( option_default(Name, Value), - ( current_prolog_flag(Name, _) - -> true - ; create_prolog_flag(Name, Value, []) - ), - fail - ; true - ). - -:- init_options. - -%% xml_header(-Header) -% -% First line of XHTML document. Added by print_html/1. - -xml_header(''). - -%% ns(?Which, ?Atom) -% -% Namespace declarations - -ns(xhtml, 'http://www.w3.org/1999/xhtml'). - - - /******************************* - * PAGE * - *******************************/ - -%% page(+Content:dom)// is det. -%% page(+Head:dom, +Body:dom)// is det. -% -% Generate a page including the HTML =||= header. The -% actual doctype is read from the option =doctype= as defined by -% html_set_options/1. - -page(Content) --> - doctype, - html(html(Content)). - -page(Head, Body) --> - page(default, Head, Body). - -page(Style, Head, Body) --> - doctype, - html_begin(html), - pagehead(Style, Head), - pagebody(Style, Body), - html_end(html). - -%% doctype// -% -% Emit the =| - { html_current_option(doctype(DocType)), - DocType \== '' - }, !, - [ '' ]. -doctype --> - []. - - -pagehead(_, Head) --> - { functor(Head, head, _) - }, !, - html(Head). -pagehead(Style, Head) --> - { strip_module(Head, M, _), - hook_module(M, HM, head//2) - }, - HM:head(Style, Head), !. -pagehead(_, Head) --> - { strip_module(Head, M, _), - hook_module(M, HM, head//1) - }, - HM:head(Head), !. -pagehead(_, Head) --> - html(head(Head)). - - -pagebody(_, Body) --> - { functor(Body, body, _) - }, !, - html(Body). -pagebody(Style, Body) --> - { strip_module(Body, M, _), - hook_module(M, HM, body//2) - }, - HM:body(Style, Body), !. -pagebody(_, Body) --> - { strip_module(Body, M, _), - hook_module(M, HM, body//1) - }, - HM:body(Body), !. -pagebody(_, Body) --> - html(body(Body)). - - -hook_module(M, M, PI) :- - current_predicate(M:PI), !. -hook_module(_, user, PI) :- - current_predicate(user:PI). - -%% html(+Content:dom)// is det -% -% Generate HTML from Content. Generates a token sequence for -% print_html/2. - -html(Spec) --> - { strip_module(Spec, M, T) }, - html(T, M). - -html([], _) --> !, - []. -html([H|T], M) --> !, - html_expand(H, M), - html(T, M). -html(X, M) --> - html_expand(X, M). - -html_expand(M:Term, _) --> !, - html(Term, M). -html_expand(Term, Module) --> - do_expand(Term, Module), !. -html_expand(Term, _Module) --> - { print_message(error, html(expand_failed(Term))) }. - - -:- multifile - expand/3. - -do_expand(Token, _) --> % call user hooks - expand(Token), !. -do_expand(Fmt-Args, _) --> !, - { format(string(String), Fmt, Args) - }, - html_quoted(String). -do_expand(\List, Module) --> - { is_list(List) - }, !, - raw(List, Module). -do_expand(\Term, Module, In, Rest) :- !, - call(Module:Term, In, Rest). -do_expand(Module:Term, _) --> !, - html(Term, Module). -do_expand(script(Content), _) --> !, % general CDATA declared content elements? - html_begin(script), - [ Content - ], - html_end(script). -do_expand(&(Entity), _) --> !, - { integer(Entity) - -> format(string(String), '&#~d;', [Entity]) - ; format(string(String), '&~w;', [Entity]) - }, - [ String ]. -do_expand(Token, _) --> - { atomic(Token) - }, !, - html_quoted(Token). -do_expand(element(Env, Attributes, Contents), M) --> !, - ( { Contents == [], - html_current_option(dialect(xhtml)) - } - -> xhtml_empty(Env, Attributes) - ; html_begin(Env, Attributes), - html(Contents, M), - html_end(Env) - ). -do_expand(Term, M) --> - { Term =.. [Env, Contents] - }, !, - ( { layout(Env, _, empty) - } - -> html_begin(Env, Contents) - ; ( { Contents == [], - html_current_option(dialect(xhtml)) - } - -> xhtml_empty(Env, []) - ; html_begin(Env), - html(Contents, M), - html_end(Env) - ) - ). -do_expand(Term, M) --> - { Term =.. [Env, Attributes, Contents], - check_non_empty(Contents, Env, Term) - }, !, - ( { Contents == [], - html_current_option(dialect(xhtml)) - } - -> xhtml_empty(Env, Attributes) - ; html_begin(Env, Attributes), - html(Contents, M), - html_end(Env) - ). - -check_non_empty([], _, _) :- !. -check_non_empty(_, Tag, Term) :- - layout(Tag, _, empty), !, - print_message(warning, format('Using empty element with content: ~p', [Term])). -check_non_empty(_, _, _). - -%% raw(+List, +Modules)// is det. -% -% Emit unquoted (raw) output used for scripts, etc. - -raw([], _) --> - []. -raw([H|T], Module) --> - raw_element(H, Module), - raw(T, Module). - -raw_element(Var, _) --> - { var(Var), !, - instantiation_error(Var) - }. -raw_element(\Term, Module, In, Rest) :- !, - call(Module:Term, In, Rest). -raw_element(Fmt-Args, _) --> !, - { format(string(S), Fmt, Args) }, - [S]. -raw_element(Value, _) --> - { must_be(atomic, Value) }, - [Value]. - - -%% html_begin(+Env)// is det. -%% html_end(+End)// is det -% -% For html_begin//1, Env is a term Env(Attributes); for -% html_end//1 it is the plain environment name. Used for -% exceptional cases. Normal applications use html//1. The -% following two fragments are identical, where we prefer the first -% as it is more concise and less error-prone. -% -% == -% html(table(border=1, \table_content)) -% == -% == -% html_begin(table(border=1) -% table_content, -% html_end(table) -% == - -html_begin(Env) --> - { Env =.. [Name|Attributes] - }, - html_begin(Name, Attributes). - -html_begin(Env, Attributes) --> - pre_open(Env), - [<], - [Env], - attributes(Env, Attributes), - ( { layout(Env, _, empty), - html_current_option(dialect(xhtml)) - } - -> ['/>'] - ; [>] - ), - post_open(Env). - -html_end(Env) --> % empty element or omited close - { layout(Env, _, -), - html_current_option(dialect(html)) - ; layout(Env, _, empty) - }, !, - []. -html_end(Env) --> - pre_close(Env), - [''], - post_close(Env). - -%% xhtml_empty(+Env, +Attributes)// is det. -% -% Emit element in xhtml mode with empty content. - -xhtml_empty(Env, Attributes) --> - pre_open(Env), - [<], - [Env], - attributes(Attributes), - ['/>']. - -%% xhtml_ns(Id, Value)// -% -% Demand an xmlns:id=Value in the outer html tag. This uses the -% html_post/2 mechanism to post to the =xmlns= channel. Rdfa -% (http://www.w3.org/2006/07/SWD/RDFa/syntax/), embedding RDF in -% (x)html provides a typical usage scenario where we want to -% publish the required namespaces in the header. We can define: -% -% == -% rdf_ns(Id) --> -% { rdf_global_id(Id:'', Value) }, -% xhtml_ns(Id, Value). -% == -% -% After which we can use rdf_ns//1 as a normal rule in html//1 to -% publish namespaces from library(semweb/rdf_db). Note that this -% macro only has effect if the dialect is set to =xhtml=. In -% =html= mode it is silently ignored. -% -% The required =xmlns= receiver is installed by html_begin//1 -% using the =html= tag and thus is present in any document that -% opens the outer =html= environment through this library. - -xhtml_ns(Id, Value) --> - { html_current_option(dialect(xhtml)) }, !, - html_post(xmlns, \attribute(xmlns:Id=Value)). -xhtml_ns(_, _) --> - []. - - -%% attributes(+Env, +Attributes)// is det. -% -% Emit attributes for Env. Adds XHTML namespace declaration to the -% html tag if not provided by the caller. - -attributes(html, L) --> !, - ( { html_current_option(dialect(xhtml)) } - -> ( { option(xmlns(_), L) } - -> attributes(L) - ; { ns(xhtml, NS) }, - attributes([xmlns(NS)|L]) - ), - html_receive(xmlns) - ; attributes(L), - html_noreceive(xmlns) - ). -attributes(_, L) --> - attributes(L). - -attributes([]) --> !, - []. -attributes([H|T]) --> !, - attribute(H), - attributes(T). -attributes(One) --> - attribute(One). - -attribute(Name=Value) --> !, - [' '], name(Name), [ '="' ], - attribute_value(Value), - ['"']. -attribute(NS:Term) --> !, - { Term =.. [Name, Value] - }, !, - attribute((NS:Name)=Value). -attribute(Term) --> - { Term =.. [Name, Value] - }, !, - attribute(Name=Value). -attribute(Atom) --> % Value-abbreviated attribute - { atom(Atom) - }, - [ ' ', Atom ]. - -name(NS:Name) --> !, - [NS, :, Name]. -name(Name) --> - [ Name ]. - -%% attribute_value(+Value) is det. -% -% Print an attribute value. Value is either atomic or one of the -% following terms: -% -% * A+B -% Concatenation of A and B -% * encode(V) -% Emit URL-encoded version of V. See www_form_encode/2. -% * An option list -% Emit ?Name1=encode(Value1)&Name2=encode(Value2) ... -% -% The hook html_write:expand_attribute_value//1 can be defined to -% provide additional `function like' translations. For example, -% http_dispatch.pl defines location_by_id(ID) to refer to a -% location on the current server based on the handler id. See -% http_location_by_id/2. - -:- multifile - expand_attribute_value//1. - -attribute_value(Var) --> - { var(Var), !, - instantiation_error(Var) - }. -attribute_value(A+B) --> !, - attribute_value(A), - attribute_value(B). -attribute_value([]) --> !. -attribute_value(List) --> - { is_list(List) }, !, - [ ? ], - search_parameters(List). -attribute_value(encode(Value)) --> !, - { www_form_encode(Value, Encoded) }, - [ Encoded ]. -attribute_value(Value) --> - expand_attribute_value(Value), !. -attribute_value(Value) --> - html_quoted_attribute(Value). - -search_parameters([H|T]) --> - search_parameter(H), - ( {T == []} - -> [] - ; [&], - search_parameters(T) - ). - -search_parameter(Var) --> - { var(Var), !, - instantiation_error(Var) - }. -search_parameter(Name=Value) --> - { www_form_encode(Value, Encoded) }, - [Name, =, Encoded]. -search_parameter(Term) --> - { Term =.. [Name, Value], !, - www_form_encode(Value, Encoded) - }, - [Name, =, Encoded]. -search_parameter(Term) --> - { domain_error(search_parameter, Term) - }. - - - /******************************* - * QUOTING RULES * - *******************************/ - -%% html_quoted(Text)// is det. -% -% Quote the value for normal (CDATA) text. Note that text -% appearing in the document structure is normally quoted using -% these rules. I.e. the following emits properly quoted bold text -% regardless of the content of Text: -% -% == -% html(b(Text)) -% == -% -% @tbd Assumes UTF-8 encoding of the output. - -html_quoted(Text) --> - { xml_quote_cdata(Text, Quoted, utf8) }, - [ Quoted ]. - -%% html_quoted_attribute(+Text)// is det. -% -% Quote the value according to the rules for tag-attributes -% included in double-quotes. Note that -like html_quoted//1-, -% attributed values printed through html//1 are quoted -% atomatically. -% -% @tbd Assumes UTF-8 encoding of the output. - -html_quoted_attribute(Text) --> - { xml_quote_attribute(Text, Quoted, utf8) }, - [ Quoted ]. - - - /******************************* - * REPOSITIONING HTML * - *******************************/ - -%% html_post(+Id, :HTML)// is det. -% -% Reposition HTML to the receiving Id. The http_post//2 call -% processes HTML using html//1. Embedded \-commands are executed -% by mainman/1 from print_html/1 or html_print_length/2. These -% commands are called in the calling context of the html_post//2 -% call. -% -% A typical usage scenario is to get required CSS links in the -% document head in a reusable fashion. First, we define css//1 as: -% -% == -% css(URL) --> -% html_post(css, -% link([ type('text/css'), -% rel('stylesheet'), -% href(URL) -% ])). -% == -% -% Next we insert the _unique_ CSS links, in the pagehead using the -% following call to reply_html_page/2: -% -% == -% reply_html_page([ title(...), -% \html_receive(css) -% ], -% ...) -% == - -html_post(Id, Content) --> - { strip_module(Content, M, C) }, - [ mailbox(Id, post(M, C)) ]. - -%% html_receive(+Id)// is det. -% -% Receive posted HTML tokens. Unique sequences of tokens posted -% with html_post//2 are inserted at the location where -% html_receive//1 appears. -% -% @see The local predicate sorted_html//1 handles the output of -% html_receive//1. -% @see html_receive//2 allows for post-processing the posted -% material. - -html_receive(Id) --> - html_receive(Id, sorted_html). - -%% html_receive(+Id, :Handler)// is det. -% -% This extended version of html_receive//1 causes Handler to be -% called to process all messages posted to the channal at the time -% output is generated. Handler is a grammar rule that is called -% with three extra arguments. -% -% 1. A list of Module:Term, of posted terms. Module is the -% contest module of html_post and Term is the unmodified -% term. Members are in the order posted and may contain -% duplicates. -% 2. DCG input list. The final output must be produced by a -% call to html//1. -% 3. DCG output list. -% -% Typically, Handler collects the posted terms, creating a term -% suitable for html//1 and finally calls html//1. - -html_receive(Id, Handler) --> - { strip_module(Handler, M, P) }, - [ mailbox(Id, accept(M:P, _)) ]. - -%% html_noreceive(+Id)// is det. -% -% As html_receive//1, but discard posted messages. - -html_noreceive(Id) --> - [ mailbox(Id, ignore(_,_)) ]. - -%% mailman(+Tokens) is det. -% -% Collect posted tokens and copy them into the receiving -% mailboxes. - -mailman(Tokens) :- - memberchk(mailbox(_, accept(_, Accepted)), Tokens), - var(Accepted), !, % not yet executed - mailboxes(Tokens, Boxes), - keysort(Boxes, Keyed), - group_pairs_by_key(Keyed, PerKey), - maplist(mail_id, PerKey). -mailman(_). - -mailboxes([], []). -mailboxes([mailbox(Id, Value)|T0], [Id-Value|T]) :- !, - mailboxes(T0, T). -mailboxes([_|T0], T) :- - mailboxes(T0, T). - -mail_id(Id-List) :- - mail_handlers(List, Boxes, Content), - ( Boxes = [accept(MH:Handler, In)] - -> extend_args(Handler, Content, Goal), - phrase(MH:Goal, In) - ; Boxes = [ignore(_, _)|_] - -> true - ; Boxes = [accept(_,_),accept(_,_)|_] - -> print_message(error, html(multiple_receivers(Id))) - ; print_message(error, html(no_receiver(Id))) - ). - -mail_handlers([], [], []). -mail_handlers([post(Module,HTML)|T0], H, [Module:HTML|T]) :- !, - mail_handlers(T0, H, T). -mail_handlers([H|T0], [H|T], C) :- - mail_handlers(T0, T, C). - -extend_args(Term, Extra, NewTerm) :- - Term =.. [Name|Args], - append(Args, [Extra], NewArgs), - NewTerm =.. [Name|NewArgs]. - -%% sorted_html(+Content:list)// is det. -% -% Default handlers for html_receive//1. It sorts the posted -% objects to create a unique list. -% -% @bug Elements can differ just on the module. Ideally we -% should phrase all members, sort the list of list of -% tokens and emit the result. Can we do better? - -sorted_html(List) --> - { sort(List, Unique) }, - html(Unique). - -%% head_html(+Content:list)// is det. -% -% Handler for html_receive(head). Unlike sorted_html//1, it calls -% a user hook html_write:html_head_expansion/2 to process the -% collected head material into a term suitable for html//1. -% -% @tbd This has been added to facilate html_head.pl, an -% experimental library for dealing with css and javascript -% resources. It feels a bit like a hack, but for now I do not know -% a better solution. - -head_html(List) --> - { html_expand_head(List, NewList) }, - html(NewList). - -:- multifile - html_head_expansion/2. - -html_expand_head(List0, List) :- - html_head_expansion(List0, List1), - List0 \== List1, !, - html_expand_head(List1, List). -html_expand_head(List, List). - - - /******************************* - * LAYOUT * - *******************************/ - -pre_open(Env) --> - { layout(Env, N-_, _) - }, !, - [ nl(N) ]. -pre_open(_) --> []. - -post_open(Env) --> - { layout(Env, _-N, _) - }, !, - [ nl(N) ]. -post_open(_) --> - []. - -pre_close(head) --> !, - html_receive(head, head_html), - { layout(head, _, N-_) }, - [ nl(N) ]. -pre_close(Env) --> - { layout(Env, _, N-_) - }, !, - [ nl(N) ]. -pre_close(_) --> - []. - -post_close(Env) --> - { layout(Env, _, _-N) - }, !, - [ nl(N) ]. -post_close(_) --> - []. - -%% layout(+Tag, -Open, -Close) is det. -% -% Define required newlines before and after tags. This table is -% rather incomplete. New rules can be added to this multifile -% predicate. -% -% @param Tag Name of the tag -% @param Open Tuple M-N, where M is the number of lines before -% the tag and N after. -% @param Close Either as Open, or the atom - (minus) to imit the -% close-tag or =empty= to indicate the element has -% no content model. -% -% @tbd Complete table - -:- multifile - layout/3. - -layout(table, 2-1, 1-2). -layout(blockquote, 2-1, 1-2). -layout(pre, 2-1, 1-2). -layout(center, 2-1, 1-2). -layout(dl, 2-1, 1-2). -layout(ul, 1-1, 1-1). -layout(ol, 2-1, 1-2). -layout(form, 2-1, 1-2). -layout(frameset, 2-1, 1-2). - -layout(head, 1-1, 1-1). -layout(body, 1-1, 1-1). -layout(script, 1-1, 1-1). -layout(select, 1-1, 1-1). -layout(map, 1-1, 1-1). -layout(html, 1-1, 1-1). -layout(caption, 1-1, 1-1). -layout(applet, 1-1, 1-1). - -layout(tr, 1-0, 0-1). -layout(option, 1-0, 0-1). -layout(li, 1-0, 0-1). -layout(dt, 1-0, -). -layout(dd, 0-0, -). -layout(title, 1-0, 0-1). - -layout(h1, 2-0, 0-2). -layout(h2, 2-0, 0-2). -layout(h3, 2-0, 0-2). -layout(h4, 2-0, 0-2). - -layout(hr, 1-1, empty). % empty elements -layout(br, 0-1, empty). -layout(img, 0-0, empty). -layout(meta, 1-1, empty). -layout(base, 1-1, empty). -layout(link, 1-1, empty). -layout(input, 0-0, empty). -layout(frame, 1-1, empty). -layout(col, 0-0, empty). -layout(area, 1-0, empty). -layout(input, 1-0, empty). -layout(param, 1-0, empty). - -layout(p, 2-1, -). % omited close -layout(td, 0-0, 0-0). - -layout(div, 1-0, 0-1). - - /******************************* - * PRINTING * - *******************************/ - -%% print_html(+List) is det. -%% print_html(+Out:stream, +List) is det. -% -% Print list of atoms and layout instructions. Currently used layout -% instructions: -% -% * nl(N) -% Use at minimum N newlines here. -% -% * mailbox(Id, Box) -% Repositioned tokens (see html_post//2 and -% html_receive//2) - -print_html(List) :- - current_output(Out), - mailman(List), - write_html(List, Out). -print_html(Out, List) :- - ( html_current_option(dialect(xhtml)) - -> stream_property(Out, encoding(Enc)), - ( Enc == utf8 - -> true - ; print_message(warning, html(wrong_encoding(Out, Enc))) - ), - xml_header(Hdr), - write(Out, Hdr), nl(Out) - ; true - ), - mailman(List), - write_html(List, Out), - flush_output(Out). - -write_html([], _). -write_html([nl(N)|T], Out) :- !, - join_nl(T, N, Lines, T2), - write_nl(Lines, Out), - write_html(T2, Out). -write_html([mailbox(_, Box)|T], Out) :- !, - ( Box = accept(_, Accepted) - -> write_html(Accepted, Out) - ; true - ), - write_html(T, Out). -write_html([H|T], Out) :- - write(Out, H), - write_html(T, Out). - -join_nl([nl(N0)|T0], N1, N, T) :- !, - N2 is max(N0, N1), - join_nl(T0, N2, N, T). -join_nl(L, N, N, L). - -write_nl(0, _) :- !. -write_nl(N, Out) :- - nl(Out), - N1 is N - 1, - write_nl(N1, Out). - -%% html_print_length(+List, -Len) is det. -% -% Determine the content length of a token list produced using -% html//1. Here is an example on how this is used to output an -% HTML compatible to HTTP: -% -% == -% phrase(html(DOM), Tokens), -% html_print_length(Tokens, Len), -% format('Content-type: text/html; charset=UTF-8~n'), -% format('Content-length: ~d~n~n', [Len]), -% print_html(Tokens) -% == - -html_print_length(List, Len) :- - mailman(List), - ( html_current_option(dialect(xhtml)) - -> xml_header(Hdr), - atom_length(Hdr, L0), - L1 is L0+1 % one for newline - ; L1 = 0 - ), - html_print_length(List, L1, Len). - -html_print_length([], L, L). -html_print_length([nl(N)|T], L0, L) :- !, - join_nl(T, N, Lines, T1), - L1 is L0 + Lines, % assume only \n! - html_print_length(T1, L1, L). -html_print_length([mailbox(_, Box)|T], L0, L) :- !, - ( Box = accept(_, Accepted) - -> html_print_length(Accepted, L0, L1) - ; L1 = L0 - ), - html_print_length(T, L1, L). -html_print_length([H|T], L0, L) :- - atom_length(H, Hlen), - L1 is L0+Hlen, - html_print_length(T, L1, L). - - -%% reply_html_page(:Head, :Body) is det. -%% reply_html_page(+Style, :Head, :Body) is det. -% -% Provide the complete reply as required by http_wrapper.pl for a -% page constructed from Head and Body. The HTTP =|Content-type|= -% is provided by html_current_option/1. - -reply_html_page(Head, Body) :- - reply_html_page(default, Head, Body). -reply_html_page(Style, Head, Body) :- - html_current_option(content_type(Type)), - phrase(page(Style, Head, Body), HTML), - format('Content-type: ~w~n~n', [Type]), - print_html(HTML). - - - /******************************* - * PCE EMACS SUPPORT * - *******************************/ - -:- multifile - emacs_prolog_colours:goal_colours/2, - emacs_prolog_colours:style/2, - emacs_prolog_colours:identify/2, - prolog:called_by/2. - -emacs_prolog_colours:goal_colours(html(HTML,_,_), - built_in-[Colours, classify, classify]) :- - html_colours(HTML, Colours). -emacs_prolog_colours:goal_colours(page(HTML,_,_), - built_in-[Colours, classify, classify]) :- - html_colours(HTML, Colours). -emacs_prolog_colours:goal_colours(page(Head, Body,_,_), - built_in-[HC, BC, classify, classify]) :- - html_colours(Head, HC), - html_colours(Body, BC). -emacs_prolog_colours:goal_colours(pagehead(HTML,_,_), - built_in-[Colours, classify, classify]) :- - html_colours(HTML, Colours). -emacs_prolog_colours:goal_colours(pagebody(HTML,_,_), - built_in-[Colours, classify, classify]) :- - html_colours(HTML, Colours). -emacs_prolog_colours:goal_colours(reply_html_page(Head, Body), - built_in-[HC, BC]) :- - html_colours(Head, HC), - html_colours(Body, BC). -emacs_prolog_colours:goal_colours(reply_html_page(_Style, Head, Body), - built_in-[identifier, HC, BC]) :- - html_colours(Head, HC), - html_colours(Body, BC). -emacs_prolog_colours:goal_colours(html_post(_Id, HTML, _, _), - built_in-[classify, Colours]) :- - html_colours(HTML, Colours). - - - % TBD: Check with do_expand! -html_colours(Var, classify) :- - var(Var), !. -html_colours(\List, built_in-Colours) :- - is_list(List), !, - list_colours(List, Colours). -html_colours(\_, built_in-[dcg]) :- !. -html_colours(_:Term, built_in-[classify,Colours]) :- !, - html_colours(Term, Colours). -html_colours(&(Entity), built_in-[entity(Entity)]) :- !. -html_colours(List, built_in-ListColours) :- - List = [_|_], !, - list_colours(List, ListColours). -html_colours(Term, TermColours) :- - compound(Term), !, - Term =.. [Name|Args], - ( Args = [One] - -> TermColours = html(Name)-ArgColours, - ( layout(Name, _, empty) - -> attr_colours(One, ArgColours) - ; html_colours(One, Colours), - ArgColours = [Colours] - ) - ; Args = [AList,Content] - -> TermColours = html(Name)-[AColours, Colours], - attr_colours(AList, AColours), - html_colours(Content, Colours) - ; TermColours = error - ). -html_colours(_, classify). - -list_colours(Var, classify) :- - var(Var), !. -list_colours([], []). -list_colours([H0|T0], [H|T]) :- !, - html_colours(H0, H), - list_colours(T0, T). -list_colours(Last, Colours) :- % improper list - html_colours(Last, Colours). - -attr_colours(Var, classify) :- - var(Var), !. -attr_colours([], classify) :- !. -attr_colours(Term, list-Elements) :- - Term = [_|_], !, - attr_list_colours(Term, Elements). -attr_colours(Name=Value, built_in-[html_attribute(Name), VColour]) :- !, - attr_value_colour(Value, VColour). -attr_colours(NS:Term, built_in-[html_xmlns(NS), html_attribute(Name)-[classify]]) :- - compound(Term), - Term =.. [Name,_], !. -attr_colours(Term, html_attribute(Name)-[VColour]) :- - compound(Term), - Term =.. [Name,Value], !, - attr_value_colour(Value, VColour). -attr_colours(Name, html_attribute(Name)) :- - atom(Name), !. -attr_colours(_, error). - -attr_list_colours(Var, classify) :- - var(Var), !. -attr_list_colours([], []). -attr_list_colours([H0|T0], [H|T]) :- - attr_colours(H0, H), - attr_list_colours(T0, T). - -attr_value_colour(Var, classify) :- - var(Var). -attr_value_colour(location_by_id(ID), sgml_attr_function-[Colour]) :- !, - location_id(ID, Colour). -attr_value_colour(A+B, sgml_attr_function-[CA,CB]) :- !, - attr_value_colour(A, CA), - attr_value_colour(B, CB). -attr_value_colour(encode(_), sgml_attr_function-[classify]) :- !. -attr_value_colour(Atom, classify) :- - atomic(Atom), !. -attr_value_colour(List, classify) :- - is_list(List), !. -attr_value_colour(_, error). - -location_id(ID, classify) :- - var(ID), !. -location_id(ID, Class) :- - current_predicate(http_dispatch:http_location_by_id/2), - ( catch(http_dispatch:http_location_by_id(ID, Location), _, fail) - -> Class = http_location_for_id(Location) - ; Class = http_no_location_for_id(ID) - ). -location_id(_, classify). - - -:- op(990, xfx, :=). % allow compiling without XPCE -:- op(200, fy, @). - -emacs_prolog_colours:style(html(_), style(bold := @on, - colour := magenta4)). -emacs_prolog_colours:style(entity(_), style(colour := magenta4)). -emacs_prolog_colours:style(html_attribute(_), style(colour := magenta4)). -emacs_prolog_colours:style(html_xmlns(_), style(colour := magenta4)). -emacs_prolog_colours:style(sgml_attr_function, style(colour := blue)). -emacs_prolog_colours:style(http_location_for_id(_), style(bold := @on)). -emacs_prolog_colours:style(http_no_location_for_id(_), style(colour := red, bold := @on)). - - -emacs_prolog_colours:identify(html(Element), Summary) :- - format(string(Summary), '~w: SGML element', [Element]). -emacs_prolog_colours:identify(entity(Entity), Summary) :- - format(string(Summary), '~w: SGML entity', [Entity]). -emacs_prolog_colours:identify(html_attribute(Attr), Summary) :- - format(string(Summary), '~w: SGML attribute', [Attr]). -emacs_prolog_colours:identify(sgml_attr_function, 'SGML Attribute function'). -emacs_prolog_colours:identify(http_location_for_id(Location), Summary) :- - format(string(Summary), 'ID resolves to ~w', [Location]). -emacs_prolog_colours:identify(http_no_location_for_id(ID), Summary) :- - format(string(Summary), '~w: no such ID', [ID]). - - -% prolog:called_by(+Goal, -Called) -% -% Hook into library(pce_prolog_xref). Called is a list of callable -% or callable+N to indicate (DCG) arglist extension. - - -prolog:called_by(html(HTML,_,_), Called) :- - phrase(called_by(HTML), Called). -prolog:called_by(page(HTML,_,_), Called) :- - phrase(called_by(HTML), Called). -prolog:called_by(page(Head,Body,_,_), Called) :- - phrase(called_by([Head,Body]), Called). -prolog:called_by(pagehead(HTML,_,_), Called) :- - phrase(called_by(HTML), Called). -prolog:called_by(pagebody(HTML,_,_), Called) :- - phrase(called_by(HTML), Called). -prolog:called_by(html_post(_,HTML,_,_), Called) :- - phrase(called_by(HTML), Called). -prolog:called_by(reply_html_page(Head,Body), Called) :- - phrase(called_by([Head,Body]), Called). -prolog:called_by(reply_html_page(_Style,Head,Body), Called) :- - phrase(called_by([Head,Body]), Called). - -called_by(Term) --> - called_by(Term, _). - -called_by(Var, _) --> - { var(Var) }, !, - []. -called_by(\G, M) --> !, - ( { is_list(G) } - -> called_by(G, M) - ; {atom(M)} - -> [M:G+2] - ; [G+2] - ). -called_by([], _) --> !, - []. -called_by([H|T], M) --> !, - called_by(H, M), - called_by(T, M). -called_by(M:Term, _) --> !, - ( {atom(M)} - -> called_by(Term, M) - ; [] - ). -called_by(Term, M) --> - { compound(Term), !, - Term =.. [_|Args] - }, - called_by(Args, M). -called_by(_, _) --> - []. - - - /******************************* - * MESSAGES * - *******************************/ - -:- multifile - prolog:message/3. - -prolog:message(html(expand_failed(What))) --> - [ 'Failed to translate to HTML: ~p'-[What] ]. -prolog:message(html(wrong_encoding(Stream, Enc))) --> - [ 'XHTML demands UTF-8 encoding; encoding of ~p is ~w'-[Stream, Enc] ]. -prolog:message(html(multiple_receivers(Id))) --> - [ 'html_post//2: multiple receivers for: ~p'-[Id] ]. -prolog:message(html(no_receiver(Id))) --> - [ 'html_post//2: no receivers for: ~p'-[Id] ]. diff --git a/packages/http/http.doc b/packages/http/http.doc deleted file mode 100644 index d5075a52c..000000000 --- a/packages/http/http.doc +++ /dev/null @@ -1,1837 +0,0 @@ -\documentclass[11pt]{article} -\usepackage{times} -\usepackage{pl} -\usepackage{plpage} -\usepackage{html} -\makeindex - -\onefile -\htmloutput{html} % Output directory -\htmlmainfile{index} % Main document file -\bodycolor{white} % Page colour -\sloppy - -\renewcommand{\runningtitle}{SWI-Prolog HTTP support} - -\begin{document} - -\title{SWI-Prolog HTTP support} -\author{Jan Wielemaker \\ - HCS, \\ - University of Amsterdam \\ - The Netherlands \\ - E-mail: \email{J.Wielemaker@uva.nl}} - -\maketitle - -\begin{abstract} -This article documents the package HTTP, a series of libraries for -accessing data on HTTP servers as well as providing HTTP server -capabilities from SWI-Prolog. Both server and client are modular -libraries. The server can be operated from the Unix \program{inetd} -super-daemon as well as as a stand-alone server that runs on all -platforms supported by SWI-Prolog. -\end{abstract} - -\vfill - -\pagebreak -\tableofcontents - -\vfill -\vfill - -\newpage - - -\section{Introduction} - -The HTTP (HyperText Transfer Protocol) is the W3C standard protocol for -transferring information between a web-client (browser) and a -web-server. The protocol is a simple \emph{envelope} protocol where -standard name/value pairs in the header are used to split the stream -into messages and communicate about the connection-status. Many -languages have client and or server libraries to deal with the HTTP -protocol, making it a suitable candidate for general purpose -client-server applications. - -In this document we describe a modular infra-structure to access -web-servers from SWI-Prolog and turn Prolog into a web-server. - - -\subsection*{Acknowledgements} - -This work has been carried out under the following projects: -\url[GARP]{http://hcs.science.uva.nl/projects/GARP/}, -\url[MIA]{http://www.ins.cwi.nl/projects/MIA/}, -\url[IBROW]{http://hcs.science.uva.nl/projects/ibrow/home.html}, -\url[KITS]{http://kits.edte.utwente.nl/} and -\url[MultiMediaN]{http://e-culture.multimedian.nl/} -The following people have pioneered parts of this library and -contributed with bug-report and suggestions for improvements: Anjo -Anjewierden, Bert Bredeweg, Wouter Jansweijer, Bob Wielinga, Jacco -van Ossenbruggen, Michiel Hildebrandt, Matt Lilley and Keri Harris. - - -\section{The HTTP client libraries} - -This package provides two packages for building HTTP clients. The first, -\pllib{http/http_open} is a lightweight library for opening a HTTP -URL address as a Prolog stream. It can only deal with the HTTP GET -protocol. The second, \pllib{http/http_client} is a more advanced -library dealing with \jargon{keep-alive}, \jargon{chunked transfer} and -a plug-in mechanism providing conversions based on the MIME content-type. - -\input{httpopen.tex} - -\subsection{The \pllib{http/http_client} library} \label{sec:httpclient} - -The \pllib{http/http_client} library provides more powerful access to -reading HTTP resources, providing \jargon{keep-alive} connections, -\jargon{chunked} transfer and conversion of the content, such as -breaking down \jargon{multipart} data, parsing HTML, etc. The library -announces itself as providing \const{HTTP/1.1}. - -\begin{description} - \predicate{http_get}{3}{+URL, -Reply, +Options} -Performs a HTTP GET request on the given URL and then reads the -reply using http_read_data/3. Defined options are: - - \begin{description} - \termitem{connection}{ConnectionType} -If \const{close} (default) a new connection is created for this request -and closed after the request has completed. If \const{'Keep-Alive'} the -library checks for an open connection on the requested host and port -and re-uses this connection. The connection is left open if the other -party confirms the keep-alive and closed otherwise. - - \termitem{http_version}{Major-Minor} -Indicate the HTTP protocol version used for the connection. Default is -\const{1.1}. - - \termitem{proxy}{+Host, +Port} -Use an HTTP proxy to connect to the outside world. - - \termitem{proxy_authorization}{+Authorization} -Send authorization to the proxy. Otherwise the same as the -\const{authorization} option. - - \termitem{timeout}{+Timeout} -If provided, set a timeout on the stream using set_stream/2. With this -option if no new data arrives within \arg{Timeout} seconds the -stream raises an exception. Default is to wait forever -(\const{infinite}). - - \termitem{user_agent}{+Agent} -Defines the value of the \const{User-Agent} field of the HTTP header. -Default is \const{SWI-Prolog (http://www.swi-prolog.org)}. - - \termitem{range}{+Range} -Ask for partial content. \arg{Range} is a term \term{\arg{Unit}}{From, -To}, where \arg{From} is an integer and \arg{To} is either an integer -or the atom \const{end}. HTTP 1.1 only supports \arg{Unit} = -\const{bytes}. E.g., to ask for bytes 1000-1999, use the option -\exam{range(bytes(1000,1999))}. - - \termitem{request_header}{Name = Value} -Add a line "\arg{Name}: \arg{Value}" to the HTTP request header. Both -name and value are added uninspected and literally to the request -header. This may be used to specify accept encodings, languages, etc. -Please check the RFC2616 (HTTP) document for available fields and their -meaning. - - \termitem{reply_header}{Header} -Unify \arg{Header} with a list of \arg{Name}=\arg{Value} pairs -expressing all header fields of the reply. See http_read_request/2 -for the result format. - \end{description} - -Remaining options are passed to http_read_data/3. - - \predicate{http_post}{4}{+URL, +In, -Reply, +Options} -Performs a HTTP POST request on the given URL. It is equivalent to -http_get/3, except for providing an \jargon{input document}, which is -posted using http_post_data/3. - - \predicate{http_read_data}{3}{+Header, -Data, +Options} -Read data from an HTTP stream. Normally called from http_get/3 or -http_post/4. When dealing with HTTP POST in a server this predicate can -be used to retrieve the posted data. \arg{Header} is the parsed header. -\arg{Options} is a list of \term{\arg{Name}}{Value} pairs to guide the -translation of the data. The following options are supported: - -\begin{description} - \termitem{to}{Target} -Do not try to interpret the data according to the MIME-type, but return -it literally according to \arg{Target}, which is one of: - \begin{description} - \termitem{stream}{Output} -Append the data to the given stream, which must be a Prolog stream open -for writing. This can be used to save the data in a (memory-)file, XPCE -object, forward it to process using a pipe, etc. - - \termitem{atom}{} -Return the result as an atom. Though SWI-Prolog has no limit on the -size of atoms and provides atom-garbage collection, this options should -be used with care.% - \footnote{Currently atom-garbage collection is activated after - the creation of 10,000 atoms.} - - \termitem{codes}{} -Return the page as a list of character-codes. This is especially useful -for parsing it using grammar rules. - \end{description} - \termitem{content_type}{Type} -Overrule the \const{Content-Type} as provided by the HTTP reply header. -Intended as a work-around for badly configured servers. -\end{description} - -If no \term{to}{Target} option is provided the library tries the -registered plug-in conversion filters. If none of these succeed it -tries the built-in content-type handlers or returns the content as an -atom. The builtin content filters are described below. The provided -plug-ins are described in the following sections. - -\begin{description} - \termitem{application/x-www-form-urlencoded}{} -This is the default encoding mechanism for POST requests issued by -a web-browser. It is broken down to a list of \arg{Name} = \arg{Value} -terms. -\end{description} - -Finally, if all else fails the content is returned as an atom. - - \predicate{http_post_data}{3}{+Data, +Stream, +ExtraHeader} -Write an HTTP POST request to \arg{Stream} using data from \arg{Data} -and passing the additional extra headers from \arg{ExtraHeader}. -\arg{Data} is one of: - - \begin{description} - \termitem{html}{+HTMLTokens} -Send an HTML token string as produced by the library \pllib{html_write} -described in section \secref{htmlwrite}. - - \termitem{file}{+File} -Send the contents of \arg{File}. The MIME type is derived from the -filename extension using file_mime_type/2. - - \termitem{file}{+Type, +File} -Send the contents of \arg{File} using the provided MIME type, -i.e.\ claiming the \const{Content-type} equals \arg{Type}. - - \termitem{codes}{+Codes} -Same as string(text/plain, Codes). - - \termitem{codes}{+Type, +Codes} -Send string (list of character codes) using the indicated MIME-type. - - \termitem{cgi_stream}{+Stream, +Len} -Read the input from \arg{Stream} which, like CGI data starts with a -partial HTTP header. The fields of this header are merged with the -provided \arg{ExtraHeader} fields. The first \arg{Len} characters -of \arg{Stream} are used. - - \termitem{form}{+ListOfParameter} -Send data of the MIME type \const{application/x-www-form-urlencoded} -as produced by browsers issuing a POST request from an HTML form. -\arg{ListOfParameter} is a list of \arg{Name}=\arg{Value} or -\mbox{\arg{Name}(\arg{Value})}. - - \termitem{form_data}{+ListOfData} -Send data of the MIME type \const{multipart/form-data} as produced by -browsers issuing a POST request from an HTML form using \const{enctype} -\const{multipart/form-data}. This is a somewhat simplified MIME -\const{multipart/mixed} encoding used by browser forms including -file input fields. \arg{ListOfData} is the same as for the \arg{List} -alternative described below. Below is an example from the SWI-Prolog -\url[Sesame]{http://www.openrdf.org} interface. \arg{Repository}, etc.\ -are atoms providing the value, while the last argument provides a value -from a file. - -\begin{code} - ..., - http_post([ protocol(http), - host(Host), - port(Port), - path(ActionPath) - ], - form_data([ repository = Repository, - dataFormat = DataFormat, - baseURI = BaseURI, - verifyData = Verify, - data = file(File) - ]), - _Reply, - []), - ..., -\end{code} - - \termitem{List}{} -If the argument is a plain list, it is sent using the MIME type -\const{multipart/mixed} and packed using mime_pack/3. See -mime_pack/3 for details on the argument format. - \end{description} -\end{description} - - -\subsubsection{The MIME client plug-in} \label{sec:httpmimeplugin} - -This plug-in library \pllib{http/http_mime_plugin} breaks multipart -documents that are recognised by the \exam{Content-Type: -multipart/form-data} or \exam{Mime-Version: 1.0} in the header into a -list of \arg{Name} = \arg{Value} pairs. This library deals with data -from web-forms using the \const{multipart/form-data} encoding as well as -the \url[FIPA]{http://www.fipa.org} agent-protocol messages. - - -\subsubsection{The SGML client plug-in} \label{sec:httpsgmlplugin} - -This plug-in library \pllib{http/http_sgml_plugin} provides a bridge -between the SGML/XML/HTML parser provided by \pllib{sgml} and the http -client library. After loading this hook the following mime-types are -automatically handled by the SGML parser. - -\begin{description} - \termitem{text/html}{} -Handed to \pllib{sgml} using W3C HTML 4.0 DTD, suppressing and -ignoring all HTML syntax errors. \arg{Options} is passed to -load_structure/3. - - \termitem{text/xml}{} -Handed to \pllib{sgml} using dialect \const{xmlns} (XML + namespaces). -\arg{Options} is passed to load_structure/3. In particular, -\term{dialect}{xml} may be used to suppress namespace handling. - - \termitem{text/x-sgml}{} -Handled to \pllib{sgml} using dialect \const{sgml}. \arg{Options} -is passed to load_structure/3. -\end{description} - - -\section{The HTTP server libraries} \label{sec:httpserver} - -The HTTP server library consists of two parts obligatory and one -optional part. The first deals with connection management and has three -different implementation depending on the desired type of server. The -second implements a generic wrapper for decoding the HTTP request, -calling user code to handle the request and encode the answer. The -optional \file{http_dispatch} module can be used to assign HTTP -\jargon{locations} (paths) to predicates. This design is summarised in -\figref{httpserver}. - -\postscriptfig[width=0.8\linewidth]{httpserver}{Design of the HTTP -server} - -The functional body of the user's code is independent from the selected -server-type, making it easy to switch between the supported server -types. - - -\subsection{The `Body'} \label{sec:body} - -The server-body is the code that handles the request and formulates a -reply. To facilitate all mentioned setups, the body is driven by -http_wrapper/5. The goal is called with the parsed request (see -\secref{request}) as argument and \const{current_output} set to a -temporary buffer. Its task is closely related to the task of a CGI -script; it must write a header declaring holding at least the -\const{Content-type} field and a body. Here is a simple body writing the -request as an HTML table. - -\begin{code} -reply(Request) :- - format('Content-type: text/html~n~n', []), - format('~n', []), - format('~n'), - print_request(Request), - format('~n
~n'), - format('~n', []). - -print_request([]). -print_request([H|T]) :- - H =.. [Name, Value], - format('~w~w~n', [Name, Value]), - print_request(T). -\end{code} - -The infrastructure recognises the header -\texttt{Transfer-encoding:~chunked}, causing it to use chunked encoding -if the client allows for it. See also \secref{transfer} and the -\const{chunked} option in http_handler/3. Other header lines are passed -verbatim to the client. Typical examples are \texttt{Set-Cookie} and -authentication headers (see \secref{auth}. - - -\subsubsection{Returning special status codes} \label{sec:httpspecials} - -Besides returning a page by writing it to the current output stream, -the server goal can raise an exception using throw/1 to generate special -pages such as \const{not_found}, \const{moved}, etc. The defined -exceptions are: - -\begin{description} - \termitem{http_reply}{+Reply, +HdrExtra} -Return a result page using http_reply/3. See http_reply/3 for details. - - \termitem{http_reply}{+Reply} -Equivalent to \term{http_reply}{Reply, []}. - - \termitem{http}{not_modified} -Equivalent to \term{http_reply}{not_modified, []}. This exception is -for backward compatibility and can be used by the server to indicate -the referenced resource has not been modified since it was requested -last time. -\end{description} - - -\input{httpdispatch.tex} -\input{httpdirindex.tex} -\input{httpsession.tex} - - -\subsection{HTTP Authentication} -\label{sec:auth} - -The module \file{http/http_authenticate} provides the basics to validate -an HTTP \const{Authorization} error. User and password information are -read from a Unix/Apache compatible password file. This information, as -well as the validation process is cached to achieve optimal performance. - -\begin{description} - \predicate{http_authenticate}{+Type, +Request, -User} -True if Request contains the information to continue according -to Type. Type identifies the required authentication technique: - - \begin{description} - \termitem{basic}{+PasswordFile} - Use HTTP \const{Basic} authentication and verify the password - from PasswordFile. PasswordFile is a file holding - usernames and passwords in a format compatible to - Unix and Apache. Each line is record with \verb$:$ - separated fields. The first field is the username and - the second the password _hash_. Password hashes are - validated using crypt/2. - \end{description} - -Successful authorization is cached for 60 seconds to avoid -overhead of decoding and lookup of the user and password data. - -http_authenticate/3 just validates the header. If authorization -is not provided the browser must be challenged, in response to -which it normally opens a user-password dialogue. Example code -realising this is below. The exception causes the HTTP wrapper -code to generate an HTTP 401 reply. - -\begin{code} - ..., - ( http_authenticate(basic(passwd), Request, User) - -> true - ; throw(http_reply(authorise(basic, Realm))) - ). -\end{code} - -Alternatively \term{basic}{+PasswordFile} can be passed as an option to -http_handler/3. -\end{description} - -\input{httpopenid.tex} - -%================================================================ -\subsection{Get parameters from HTML forms} -\label{sec:httpparam} - -The library \pllib{http/http_parameters} provides two predicates to -fetch HTTP request parameters as a type-checked list easily. The -library transparently handles both GET and POST requests. It builds -on top of the low-level request representation described in -\secref{request}. - -\begin{description} - \predicate{http_parameters}{2}{+Request, ?Parameters} -The predicate is passes the \arg{Request} as provided to the handler -goal by http_wrapper/5 as well as a partially instantiated lists -describing the requested parameters and their types. Each parameter -specification in \arg{Parameters} is a term of the format -\mbox{\arg{Name}(\arg{-Value}, \arg{+Options})}. \arg{Options} is -a list of option terms describing the type, default, etc. If no options -are specified the parameter must be present and its value is returned in -\arg{Value} as an atom. If a parameter is missing the exception -\term{error}{\term{existence_error}{form_data, Name}, _} is thrown. -Options fall into three categories: those that handle presence of -the parameter, those that guide conversion and restrict types and -those that support automatic generation of documention. First, -the presence-options: - -\begin{description} - \termitem{default}{Default} -If the named parameter is missing, \arg{Value} is unified to -\arg{Default}. - - \termitem{optional}{true} -If the named parameter is missing, \arg{Value} is left unbound and -no error is generated. - - \termitem{list}{Type} -The same parameter may not appear or appear multiple times. If this -option is present, \const{default} and \const{optional} are ignored and -the value is returned as a list. Type checking options are processed on -each value. - - \termitem{zero_or_more}{} -Deprecated. Use \term{List}{Type}. -\end{description} - -The type and conversion options are given below. The type-language can -be extended by providing clauses for the multifile hook -http:convert_parameter/3. - -\begin{description} - \termitem{;}{Type1, Type2} -Succeed if either \arg{Type1} or \arg{Type2} applies. It allows -for checks such as \exam{(nonneg;oneof([infinite]))} to specify -an integer or a symbolic value. - - \termitem{oneof}{List} -Succeeds if the value is member of the given list. - - \definition{length $> N$} -Succeeds if value is an atom of more than $N$ characters. - - \definition{length $>= N$} -Succeeds if value is an atom of more or than equal to $N$ characters. - - \definition{length $< N$} -Succeeds if value is an atom of less than $N$ characters. - - \definition{length $=< N$} -Succeeds if value is an atom of length than or equal to $N$ characters. - - \termitem{atom}{} -No-op. Allowed for consistency. - - \termitem{between}{+Low, +High} -Convert value to a number and if either \arg{Low} or \arg{High} is a -float, force value to be a float. Then check that the value is in the -given range, which includes the boundaries. - - \termitem{boolean}{} -Translate =true=, =yes=, =on= and '1' into =true=; =false=, =no=, -=off= and '0' into =false= and raises an error otherwise. - - \termitem{float}{} -Convert value to a float. Integers are transformed into float. Throws a -type-error otherwise. - - \termitem{integer}{} -Convert value to an integer. Throws a type-error otherwise. - - \termitem{nonneg}{} -Convert value to a non-negative integer. Throws a type-error -of the value cannot be converted to an integer and a domain-error -otherwise. - - \termitem{number}{} -Convert value to a number. Throws a type-error otherwise. -\end{description} - -The last set of options is to support automatic generation of HTTP -API documentation from the sources.\footnote{This facility is under -development in ClioPatria; see \file{http_help.pl}}. - -\begin{description} - \termitem{description}{+Atom} -Description of the parameter in plain text. - - \termitem{group}{+Parameters, +Options} -Define a logical group of parameters. \arg{Parameters} are processed -as normal. \arg{Options} may include a description of the group. Groups -can be nested. -\end{description} - -Below is an example - -\begin{code} -reply(Request) :- - http_parameters(Request, - [ title(Title, [ optional(true) ]), - name(Name, [ length >= 2 ]), - age(Age, [ between(0, 150) ]) - ]), - ... -\end{code} - -Same as \term{http_parameters}{Request, Parameters, []} - - \predicate{http_parameters}{3}{+Request, ?Parameters, +Options} -In addition to http_parameters/2, the following options are defined. - -\begin{description} - \termitem{form_data}{-Data} -Return the entire set of provided \arg{Name}=\arg{Value} pairs from -the GET or POST request. All values are returned as atoms. - - \termitem{attribute_declarations}{:Goal} -If a parameter specification lacks the parameter options, call -\term{call}{Goal, +ParamName, -Options} to find the options. Intended -to share declarations over many calls to http_parameters/3. Using -this construct the above can be written as below. - -\begin{code} -reply(Request) :- - http_parameters(Request, - [ title(Title), - name(Name), - age(Age) - ], - [ attribute_declarations(param) - ]), - ... - -param(title, [optional(true)]). -param(name, [length >= 2 ]). -param(age, [integer]). -\end{code} -\end{description} -\end{description} - - -\subsection{Request format} \label{sec:request} - -The body-code (see \secref{body}) is driven by a \arg{Request}. This -request is generated from http_read_request/2 defined in -\pllib{http/http_header}. - - -\begin{description} - \predicate{http_read_request}{2}{+Stream, -Request} -Reads an HTTP request from \arg{Stream} and unify \arg{Request} with -the parsed request. \arg{Request} is a list of \term{\arg{Name}}{Value} -elements. It provides a number of predefined elements for the result -of parsing the first line of the request, followed by the additional -request parameters. The predefined fields are: - -\begin{description} - \termitem{host}{Host} -If the request contains \verb$Host: $\arg{Host}, Host is unified -with the host-name. If \arg{Host} is of the format : -\arg{Host} only describes and a field \term{port}{Port} where -\arg{Port} is an integer is added. - - \termitem{input}{Stream} -The \arg{Stream} is passed along, allowing to read more data or -requests from the same stream. This field is always present. - - \termitem{method}{Method} -\arg{Method} is one of \const{get}, \const{put} or \const{post}. This -field is present if the header has been parsed successfully. - - \termitem{path}{Path} -Path associated to the request. This field is always present. - - \termitem{peer}{Peer} -\arg{Peer} is a term \term{ip}{A,B,C,D} containing the IP address of -the contacting host. - - \termitem{port}{Port} -Port requested. See \const{host} for details. - - \termitem{request_uri}{RequestURI} -This is the untranslated string that follows the method in the -request header. It is used to construct the path and search fields -of the \arg{Request}. It is provided because reconstructing this -string from the path and search fields may yield a different value -due to different usage of percent encoding. - - \termitem{search}{ListOfNameValue} -Search-specification of URI. This is the part after the \chr{?}, -normally used to transfer data from HTML forms that use the -`\const{GET}' protocol. In the URL it consists of a www-form-encoded -list of \arg{Name}=\arg{Value} pairs. This is mapped to a list of -Prolog \arg{Name}=\arg{Value} terms with decoded names and values. -This field is only present if the location contains a -search-specification. - - \termitem{http_version}{Major-Minor} -If the first line contains the \const{HTTP/}\arg{Major}.\arg{Minor} -version indicator this element indicate the HTTP version of the -peer. Otherwise this field is not present. - - \termitem{cookie}{ListOfNameValue} -If the header contains a \const{Cookie} line, the value of the -cookie is broken down in \arg{Name}=\arg{Value} pairs, where the -\arg{Name} is the lowercase version of the cookie name as used -for the HTTP fields. - - \termitem{set_cookie}{set_cookie(Name, Value, Options)} -If the header contains a \const{SetCookie} line, the cookie field -is broken down into the \arg{Name} of the cookie, the \arg{Value} -and a list of \arg{Name}=\arg{Value} pairs for additional options -such as \const{expire}, \const{path}, \const{domain} or \const{secure}. -\end{description} - -If the first line of the request is tagged with -\const{HTTP/}\arg{Major}.\arg{Minor}, http_read_request/2 reads all -input upto the first blank line. This header consists of -\arg{Name}:\arg{Value} fields. Each such field appears as a term -\term{\arg{Name}}{Value} in the \arg{Request}, where \arg{Name} is -canonised for use with Prolog. Canonisation implies that the -\arg{Name} is converted to lower case and all occurrences of the -\chr{-} are replaced by \chr{_}. The value for the -\const{Content-length} fields is translated into an integer. -\end{description} - -Here is an example: - -\begin{code} -?- http_read_request(user, X). -|: GET /mydb?class=person HTTP/1.0 -|: Host: gollem -|: -X = [ input(user), - method(get), - search([ class = person - ]), - path('/mydb'), - http_version(1-0), - host(gollem) - ]. -\end{code} - - -\subsubsection{Handling POST requests} - -Where the HTTP \const{GET} operation is intended to get a document, -using a \arg{path} and possibly some additional search information, -the \const{POST} operation is intended to hand potentially large -amounts of data to the server for processing. - -The \arg{Request} parameter above contains the term \term{method}{post}. -The data posted is left on the input stream that is available through -the term \term{input}{Stream} from the \arg{Request} header. This data -can be read using http_read_data/3 from the HTTP client library. Here is -a demo implementation simply returning the parsed posted data as plain -text (assuming pp/1 pretty-prints the data). - -\begin{code} -reply(Request) :- - member(method(post), Request), !, - http_read_data(Request, Data, []), - format('Content-type: text/plain~n~n', []), - pp(Data). -\end{code} - -If the POST is initiated from a browser, content-type is generally -either \const{application/x-www-form-urlencoded} or -\const{multipart/form-data}. The latter is broken down automatically -if the plug-in \pllib{http/http_mime_plugin} is loaded. - - -\subsection{Running the server} - -The functionality of the server should be defined in one Prolog file (of -course this file is allowed to load other files). Depending on the -wanted server setup this `body' is wrapped into a small Prolog file -combining the body with the appropriate server interface. There are -three supported server-setups. For most applications we advice the -multi-threaded server. Examples of this server architecture are the -\url[PlDoc]{http://www.swi-prolog.org/packages/pldoc.html} documentation -system and the \url[SeRQL]{http://www.swi-prolog.org/packages/SeRQL/} -Semantic Web server infrastructure. - -All the server setups may be wrapped in a \jargon{reverse proxy} to -make them available from the public web-server as described in -\secref{proxy}. - - -\begin{itemlist} - \item [Using \pllib{thread_httpd} for a multi-threaded server] -This server exploits the multi-threaded version of SWI-Prolog, running -the users body code parallel from a pool of worker threads. As it avoids -the state engine and copying required in the event-driven server it is -generally faster and capable to handle multiple requests concurrently. - -This server is harder to debug due to the involved threading, although -the GUI tracer provides reasonable support for multi-threaded -applications using the tspy/1 command. It can provide fast communication -to multiple clients and can be used for more demanding servers. - - \item [Using \pllib{xpce_httpd} for an event-driven server] -This approach provides a single-threaded event-driven application. The -clients talk to XPCE sockets that collect an HTTP request. The server -infra-structure can talk to multiple clients simultaneously, but once -a request is complete the wrappers call the user's goal and blocks all -further activity until the request is handled. Requests from multiple -clients are thus fully serialised in one Prolog process. - -This server setup is very suitable for debugging as well as embedded -server in simple applications in a fairly controlled environment. - - \item [Using \pllib{inetd_httpd} for server-per-client] -In this setup the Unix \program{inetd} user-daemon is used to initialise -a server for each connection. This approach is especially suitable for -servers that have a limited startup-time. In this setup a crashing -client does not influence other requests. - -This server is very hard to debug as the server is not connected to the -user environment. It provides a robust implementation for servers that -can be started quickly. -\end{itemlist} - - -\subsubsection{Common server interface options} - -All the server interfaces provide \term{http_server}{:Goal, +Options} -to create the server. The list of options differ, but the servers share -common options: - -\begin{description} - \termitem{port}{?Port} -Specify the port to listen to for stand-alone servers. \arg{Port} is -either an integer or unbound. If unbound, it is unified to the selected -free port. -\end{description} - - -\subsubsection{Multi-threaded Prolog} \label{sec:mthttpd} - -The \pllib{http/thread_httpd.pl} provides the infrastructure to manage -multiple clients using a pool of \jargon{worker-threads}. This realises -a popular server design, also seen in Java Tomcat and Microsoft .NET. -As a single persistent server process maintains communication to all -clients startup time is not an important issue and the server can -easily maintain state-information for all clients. - -In addition to the functionality provided by the other (XPCE and -inetd) servers, the threaded server can also be used to realise an -HTTPS server exploiting the \pllib{ssl} library. See option -\term{ssl}{+SSLOptions} below. - - -\begin{description} - \predicate{http_server}{3}{:Goal, +Options} -Create the server. \arg{Options} must provide the \term{port}{?Port} -option to specify the port the server should listen to. If \arg{Port} is -unbound an arbitrary free port is selected and \arg{Port} is unified to -this port-number. The server consists of a small Prolog thread -accepting new connection on \arg{Port} and dispatching these to a pool -of workers. Defined \arg{Options} are: - -\begin{description} - \termitem{port}{?Port} -Port the server should listen to. If unbound \arg{Port} is unified with -the selected free port. - - \termitem{workers}{+N} -Defines the number of worker threads in the pool. Default is to use -\arg{two} workers. Choosing the optimal value for best performance is a -difficult task depending on the number of CPUs in your system and how -much resources are required for processing a request. Too high numbers -makes your system switch too often between threads or even swap if there -is not enough memory to keep all threads in memory, while a too low -number causes clients to wait unnecessary for other clients to complete. -See also http_workers/2. - - \termitem{timeout}{+SecondsOrInfinite} -Determines the maximum period of inactivity handling a request. If no -data arrives within the specified time since the last data arrived the -connection raises an exception, the worker discards the client and -returns to the pool-queue for a new client. Default is \const{infinite}, -making each worker wait forever for a request to complete. Without a -timeout, a worker may wait forever on an a client that doesn't complete -its request. - - \termitem{keep_alive_timeout}{+SecondsOrInfinite} -Maximum time to wait for new activity on \emph{Keep-Alive} connections. -Choosing the correct value for this parameter is hard. Disabling -Keep-Alive is bad for performance if the clients request multiple -documents for a single page. This may ---for example-- be caused by HTML -frames, HTML pages with images, associated CSS files, etc. Keeping -a connection open in the threaded model however prevents the thread -servicing the client servicing other clients. The default is 5 seconds. - - \termitem{local}{+KBytes} -Size of the local-stack for the workers. Default is taken from the -commandline option. - - \termitem{global}{+KBytes} -Size of the global-stack for the workers. Default is taken from the -commandline option. - - \termitem{trail}{+KBytes} -Size of the trail-stack for the workers. Default is taken from the -commandline option. - - \termitem{ssl}{+SSLOptions} -Use SSL (Secure Socket Layer) rather than plan TCP/IP. A server created -this way is accessed using the \const{https://} protocol. SSL allows for -encrypted communication to avoid others from tapping the wire as well as -improved authentication of client and server. The \arg{SSLOptions} -option list is passed to ssl_init/3. The port option of the main option -list is forwarded to the SSL layer. See the \pllib{ssl} library for -details. -\end{description} - - \predicate{http_server_property}{2}{?Port, ?Property} -True if \arg{Property} is a property of the HTTP server running at -\arg{Port}. Defined properties are: - -\begin{description} - \termitem{goal}{:Goal} -Goal used to start the server. This is often http_dispatch/1. - \termitem{start_time}{?Time} -Time-stamp when the server was created. See format_time/3 for -creating a human-readable representation. -\end{description} - - \predicate{http_workers}{2}{:Port, ?Workers} -Query or manipulate the number of workers of the server identified by -\arg{Port}. If \arg{Workers} is unbound it is unified with the number -of running servers. If it is an integer greater than the current size -of the worker pool new workers are created with the same specification -as the running workers. If the number is less than the current size -of the worker pool, this predicate inserts a number of `quit' requests -in the queue, discarding the excess workers as they finish their jobs -(i.e.\ no worker is abandoned while serving a client). - -This can be used to tune the number of workers for performance. Another -possible application is to reduce the pool to one worker to facilitate -easier debugging. - - \predicate{http_stop_server}{2}{+Port, +Options} -Stop the HTTP server at Port. Halting a server is done -\textit{gracefully}, which means that requests being processed are not -abandoned. The \arg{Options} list is for future refinements of this -predicate such as a forced immediate abort of the server, but is -currently ignored. - - \predicate{http_current_worker}{2}{?Port, ?ThreadID} -True if \arg{ThreadID} is the identifier of a Prolog thread serving -\arg{Port}. This predicate is motivated to allow for the use of -arbitrary interaction with the worker thread for development and -statistics. - - \predicate{http_spawn}{2}{:Goal, +Spec} -Continue handling this request in a new thread running \arg{Goal}. After -http_spawn/2, the worker returns to the pool to process new requests. In -its simplest form, \arg{Spec} is the name of a thread pool as defined by -thread_pool_create/3. Alternatively it is an option list, whose options -are passed to thread_create_in_pool/4 if \arg{Spec} contains -\term{pool}{Pool} or to thread_create/3 of the pool option is not -present. If the dispatch module is used (see \secref{httpdispatch}), -spawning is normally specified as an option to the http_handler/3 -registration. - -We recomment the use of thread pools. They allow registration of a set -of threads using common characteristics, specify how many can be active -and what to do if all threads are active. A typical application may -define a small pool of threads with large stacks for computation -intensive tasks, and a large pool of threads with small stacks to serve -media. The declaration could be the one below, allowing for max 3 -concurrent solvers and a maximum backlog of 5 and 30 tasks creating -image thumbnails. - -\begin{code} -:- use_module(library(thread_pool)). - -:- thread_pool_create(compute, 3, - [ local(20000), global(100000), trail(50000), - backlog(5) - ]). -:- thread_pool_create(media, 30, - [ local(100), global(100), trail(100), - backlog(100) - ]). - -:- http_handler('/solve', solve, [spawn(compute)]). -:- http_handler('/thumbnail', thumbnail, [spawn(media)]). -\end{code} -\end{description} - - -\subsubsection{From an interactive Prolog session using XPCE} - -The \pllib{http/xpce_httpd.pl} provides the infrastructure to manage -multiple clients with an event-driven control-structure. This version -can be started from an interactive Prolog session, providing a -comfortable infra-structure to debug the body of your server. It also -allows the combination of an (XPCE-based) GUI with web-technology in one -application. - -\begin{description} - \predicate{http_server}{2}{:Goal, +Options} -Create an instance of \class{interactive_httpd}. \arg{Options} must -provide the \term{port}{?Port} option to specify the port the server -should listen to. If \arg{Port} is unbound an arbitrary free port is -selected and \arg{Port} is unified to this port-number. Currently -no options are defined. -\end{description} - -The file \file{demo_xpce} gives a typical example of this wrapper, -assuming \file{demo_body} defines the predicate reply/1. - -\begin{code} -:- use_module(xpce_httpd). -:- use_module(demo_body). - -server(Port) :- - http_server(reply, Port, []). -\end{code} - -The created server opens a server socket at the selected address and -waits for incoming connections. On each accepted connection it collects -input until an HTTP request is complete. Then it opens an input stream -on the collected data and using the output stream directed to the XPCE -\class{socket} it calls http_wrapper/5. This approach is fundamentally -different compared to the other approaches: - -\begin{itemlist} - \item [Server can handle multiple connections] -When \emph{inetd} will start a server for each \emph{client}, and CGI -starts a server for each \emph{request}, this approach starts a single -server handling multiple clients. - - \item [Requests are serialised] -All calls to \arg{Goal} are fully serialised, processing on behalf of a -new client can only start after all previous requests are answered. This -easier and quite acceptable if the server is mostly inactive and -requests take not very long to process. - - \item [Lifetime of the server] -The server lives as long as Prolog runs. -\end{itemlist} - - -\subsubsection{From (Unix) inetd} - -All modern Unix systems handle a large number of the services they run -through the super-server \emph{inetd}. This program reads -\file{/etc/inetd.conf} and opens server-sockets on all ports defined in -this file. As a request comes in it accepts it and starts the associated -server such that standard I/O refers to the socket. This approach has -several advantages: - -\begin{itemlist} - \item [Simplification of servers] -Servers don't have to know about sockets and -operations. - - \item [Centralised authorisation] -Using \emph{tcpwrappers} simple and effective firewalling of all -services is realised. - - \item [Automatic start and monitor] -The inetd automatically starts the server `just-in-time' and starts -additional servers or restarts a crashed server according to the -specifications. -\end{itemlist} - -The very small generic script for handling inetd based connections -is in \file{inetd_httpd}, defining http_server/1: - -\begin{description} - \predicate{http_server}{2}{:Goal, +Options} -Initialises and runs http_wrapper/5 in a loop until failure or -end-of-file. This server does not support the \arg{Port} option -as the port is specified with the \program{inetd} configuration. -The only supported option is \arg{After}. -\end{description} - -Here is the example from \file{demo_inetd} - -\begin{code} -#!/usr/bin/pl -t main -q -f -:- use_module(demo_body). -:- use_module(inetd_httpd). - -main :- - http_server(reply). -\end{code} - -With the above file installed in \file{/home/jan/plhttp/demo_inetd}, -the following line in \file{/etc/inetd} enables the server at port -4001 guarded by \emph{tcpwrappers}. After modifying inetd, send the -daemon the \const{HUP} signal to make it reload its configuration. -For more information, please check \manref{inetd.conf}{5}. - -\begin{code} -4001 stream tcp nowait nobody /usr/sbin/tcpd /home/jan/plhttp/demo_inetd -\end{code} - - -\subsubsection{MS-Windows} - -There are rumours that \emph{inetd} has been ported to Windows. - - -\subsubsection{As CGI script} - -To be done. - - -\subsubsection{Using a reverse proxy} -\label{sec:proxy} - -There are three options for public deployment of a service. One is to -run it on a dedicated machine on port 80, the standard HTTP port. The -machine may be a virtual machine running ---for example--- under -\url[VMWARE]{http://www.vmware.com} or -\url[XEN]{http://www.cl.cam.ac.uk/research/srg/netos/xen/}. The -(virtual) machine approach isolates security threads and allows for -using a standard port. The server can also be hosted on a non-standard -port such as 8000, or 8080. Using non-standard ports however may cause -problems with intermediate proxy- and/or firewall policies. Isolation -can be achieved using a Unix \jargon{chroot} environment. Another -option, also recommended for \jargon{Tomcat} servers, is the use of -Apache \jargon{reverse proxies}. This causes the main web-server to -relay requests below a given URL location to our Prolog based server. -This approach has several advantages: - -\begin{itemize} - \item We can access the server on port 80, just as for a dedicated - machine. We do not need a machine though and we only need - access to the Apache configuration. - \item As Apache is doing the front-line service, the Prolog server - is normally protected from malformed HTTP requests that could - result in denial of service or otherwise compromise the - server. In addition, Apache can provide encodings such as - compression to the outside world. -\end{itemize} - -Note that the proxy technology can be combined with isolation methods -such as dedicated machines, virtual machines and chroot jails. The -proxy can also provide load balancing. - -\paragraph{Setting up a reverse proxy} - -The Apache reverse proxy setup is really simple. Ensure the modules -\const{proxy} and \const{proxy_http} are loaded. Then add two simple -rules to the server configuration. Below is an example that makes a -PlDoc server on port 4000 available from the main Apache server at port -80. - -\begin{code} -ProxyPass /pldoc/ http://localhost:4000/pldoc/ -ProxyPassReverse /pldoc/ http://localhost:4000/pldoc/ -\end{code} - -Apache rewrites the HTTP headers passing by, but using the above rules -it does not examine the content. This implies that URLs embedded in the -(HTML) content must use relative addressing. If the locations on the -public and Prolog server are the same (as in the example above) it is -allowed to use absolute locations. I.e.\ \const{/pldoc/search} is ok, -but \const{http://myhost.com:4000/pldoc/search} is \emph{not}. If -the locations on the server differ, locations must be relative (i.e.\ -not start with \chr{/}. - -This problem can also be solved using the contributed Apache module -\const{proxy_html} that can be instructed to rewrite URLs embedded in -HTML documents. In our experience, this is not troublefree as URLs can -appear in many places in generated documents. JavaScript can create -URLs on the fly, which makes rewriting virtually impossible. - -\subsection{The wrapper library} - -The body is called by the module \pllib{http/http_wrapper.pl}. This -module realises the communication between the I/O streams and the body -described in \secref{body}. The interface is realised by -http_wrapper/5: - -\begin{description} - \predicate{http_wrapper}{5}{:Goal, +In, +Out, -Connection, +Options} -Handle an HTTP request where \arg{In} is an input stream from the -client, \arg{Out} is an output stream to the client and \arg{Goal} -defines the goal realising the body. \arg{Connection} is unified to -\const{'Keep-alive'} if both ends of the connection want to continue the -connection or \const{close} if either side wishes to close the -connection. - -This predicate reads an HTTP request-header from \arg{In}, redirects -current output to a memory file and then runs \exam{call(Goal, -Request)}, watching for exceptions and failure. If \arg{Goal} executes -successfully it generates a complete reply from the created output. -Otherwise it generates an HTTP server error with additional context -information derived from the exception. - -http_wrapper/5 supports the following options: - -\begin{description} - \termitem{request}{-Request} -Return the executed request to the caller. - - \termitem{peer}{+Peer} -Add peer(Peer) to the request header handed to \arg{Goal}. The format -of \arg{Peer} is defined by tcp_accept/3 from the clib package. -\end{description} - - \predicate{http:request_expansion}{2}{+RequestIn, -RequestOut} -This \jargon{multifile} hook predicate is called just before the goal -that produces the body, while the output is already redirected to -collect the reply. If it succeeds it must return a valid modified -request. It is allowed to throw exceptions as defined in -\secref{httpspecials}. It is intended for operations such as mapping -paths, deny access for certain requests or manage cookies. If it writes -output, these must be HTTP header fields that are added \emph{before} -header fields written by the body. The example below is from the -session management library (see \secref{httpsession}) sets a cookie. - -\begin{code} - ..., - format('Set-Cookie: ~w=~w; path=~w~n', [Cookie, SessionID, Path]), - ..., -\end{code} - - \predicate{http_current_request}{1}{-Request} -Get access to the currently executing request. \arg{Request} is the -same as handed to \arg{Goal} of http_wrapper/5 \emph{after} applying -rewrite rules as defined by http:request_expansion/2. Raises an -existence error if there is no request in progress. - - \predicate{http_relative_path}{2}{+AbsPath, -RelPath} -Convert an absolute path (without host, fragment or search) into a path -relative to the current page, defined as the path component from the -current request (see http_current_request/1). This call is intended to -create reusable components returning relative paths for easier support -of reverse proxies. - -If ---for whatever reason--- the conversion is not possible it simply -unifies \arg{RelPath} to \arg{AbsPath}. -\end{description} - -\input{httphost} - -\input{httplog} - -\subsection{Debugging Servers} \label{sec:debug} - -The library \pllib{http/http_error.pl} defines a hook that decorates -uncaught exceptions with a stack-trace. This will generate a \emph{500 -internal server error} document with a stack-trace. To enable this -feature, simply load this library. Please do note that providing -error information to the user simplifies the job of a hacker trying -to compromise your server. It is therefore not recommended to load -this file by default. - -The example program \file{calc.pl} has the error handler loaded which -can be triggered by forcing a divide-by-zero in the calculator. - - -\subsection{Handling HTTP headers} \label{sec:httpheader} - -The library \pllib{http/http_header} provides primitives for parsing and -composing HTTP headers. Its functionality is normally hidden by the -other parts of the HTTP server and client libraries. We provide a brief -overview of http_reply/3 which can be accessed from the reply body using -an exception as explain in \secref{httpspecials}. - - -\begin{description} - \predicate{http_reply}{3}{+Type, +Stream, +HdrExtra} -Compose a complete HTTP reply from the term \arg{Type} using additional -headers from \arg{HdrExtra} to the output stream \arg{Stream}. -\arg{ExtraHeader} is a list of \term{Field}{Value}. \arg{Type} is -one of: - - \begin{description} - \termitem{html}{+HTML} -Produce a HTML page using print_html/1, normally generated using the -\pllib{http/html_write} described in \secref{htmlwrite}. - - \termitem{file}{+MimeType, +Path} -Reply the content of the given file, indicating the given MIME type. - - \termitem{tmp_file}{+MimeType, +Path} -Similar to \term{File}{+MimeType, +Path}, but do not include a -modification time header. - - \termitem{stream}{+Stream, +Len} -Reply using the next \arg{Len} characters from \arg{Stream}. The -user must provides the MIME type and other attributes through the -\arg{ExtraHeader} argument. - - \termitem{cgi_stream}{+Stream, +Len} -Similar to \term{stream}{+Stream, +Len}, but the data on \arg{Stream} -must contain an HTTP header. - - \termitem{moved}{+URL} -Generate a ``301 Moved Permanently'' page with the given target -\arg{URL}. - - \termitem{moved_temporary}{+URL} -Generate a ``302 Moved Temporary'' page with the given target -\arg{URL}. - - \termitem{see_other}{+URL} -Generate a ``303 See Other'' page with the given target \arg{URL}. - - \termitem{not_found}{+URL} -Generate a ``404 Not Found'' page. - - \termitem{forbidden}{+URL} -Generate a ``403 Forbidden'' page, denying access without challenging -the client. - - \termitem{authorise}{+Method, +Realm} -Generate a ``401 Authorization Required'', requesting the client to -retry using proper credentials (i.e.\ user and password). - - \termitem{not_modified}{} -Generate a ``304 Not Modified'' page, indicating the requested resource -has not changed since the indicated time. - - \termitem{server_error}{+Error} -Generate a ``500 Internal server error'' page with a message generated -from a Prolog exception term (see print_message/2). - \end{description} -\end{description} - - -\subsection{The \pllib{http/html_write} library} \label{sec:htmlwrite} - -\newcommand{\elem}[1]{\const{#1}} - -Producing output for the web in the form of an HTML document is a -requirement for many Prolog programs. Just using format/2 is -satisfactory as it leads to poorly readable programs generating poor -HTML. This library is based on using DCG rules. - -The \pllib{http/html_write} structures the generation of HTML from a -program. It is an extensible library, providing a \jargon{DCG} framework -for generating legal HTML under (Prolog) program control. It is -especially useful for the generation of structured pages (e.g.\ tables) -from Prolog data structures. - -The normal way to use this library is through the DCG html//1. This -non-terminal provides the central translation from a structured term -with embedded calls to additional translation rules to a list of atoms -that can then be printed using print_html/[1,2]. - -\begin{description} - \dcg{html}{1}{:Spec} -The DCG non-terminal html//1 is the main predicate of this library. It translates -the specification for an HTML page into a list of atoms that can be -written to a stream using print_html/[1,2]. The expansion rules of this -predicate may be extended by defining the multifile DCG -html_write:expand//1. \arg{Spec} is either a single specification or a -list of single specifications. Using nested lists is not allowed to -avoid ambiguity caused by the atom \const{[]} - -\begin{itemlist} - \item [Atomic data] -Atomic data is quoted using html_quoted//1. - - \item [\arg{Fmt} - \arg{Args}] -\arg{Fmt} and \arg{Args} are used as format-specification and argument -list to format/3. The result is quoted and added to the output list. - - \item [\bsl\arg{List}] -Escape sequence to add atoms directly to the output list. This can be -used to embed external HTML code or emit script output. \arg{List} is -a list of the following terms: - - \begin{itemlist} - \item [\arg{Fmt} - \arg{Args}] - \arg{Fmt} and \arg{Args} are used as format-specification and argument - list to format/3. The result is added to the output list. - \item [\arg{Atomic}] - Atomic values are added directly to the output list. - \end{itemlist} - - \item [\bsl\arg{Term}] -Invoke the non-terminal \arg{Term} in the calling module. This is the -common mechanism to realise abstraction and modularisation in generating -HTML. - - \item [\arg{Module}:\arg{Term}] -Invoke the non-terminal :. This is similar to -\bsl\arg{Term} but allows for invoking grammar rules in external -packages. - - \item [\&(Entity)] -Emit {\tt\&;} or {\tt\&\#;} if \arg{Entity} is an -integer. SWI-Prolog atoms and strings are represented as Unicode. -Explicit use of this construct is rarely needed because code-points that -are not supported by the output encoding are automatically converted -into character-entities. - - \item [\term{Tag}{Content}] -Emit HTML element \arg{Tag} using \arg{Content} and no attributes. -\arg{Content} is handed to html//1. See \secref{htmllayout} for details -on the automatically generated layout. - - \item [\term{Tag}{Attributes, Content}] -Emit HTML element \arg{Tag} using \arg{Attributes} and \arg{Content}. -\arg{Attributes} is either a single attribute of a list of attributes. -Each attributes is of the format \term{Name}{Value} or -\mbox{\arg{Name}=\arg{Value}}. \arg{Value} is the atomic attribute -value but allows for a limited functional notation: - - \begin{itemlist} - \item [$A$ + $B$] -Concatenation of $A$ and $B$ - \item [\term{encode}{Atom}] -Use www_form_encode/2 to create a valid URL component. - \item [\term{location_by_id}{ID}] -HTTP location of the HTTP handler with given ID. See http_location_by_id/2. - \item [List] -A list is handled as a URL `search' component. The list members are -terms of the format \mbox{\arg{Name} = \arg{Value}} or -\term{Name}{Value}. Values are encoded as in the encode option -described above. -\end{itemlist} - -The example below generates a URL that references the predicate -set_lang/1 in the application with given parameters. The http_handler/3 -declaration binds \const{/setlang} to the predicate set_lang/1 for which -we provide a very simple implementation. The code between \const{...} -is part of an HTML page showing the english flag which, when pressed, -calls \term{set_lang}{Request} where \arg{Request} contains the search -parameter \mbox{\const{lang} = \const{en}}. Note that the HTTP location -(path) \const{/setlang} can be moved without affecting this code. - -\begin{code} -:- http_handler('/setlang', set_lang, []). - -set_lang(Request) :- - http_parameters(Request, - [ lang(Lang, []) - ]), - http_session_retractall(lang(_)), - http_session_assert(lang(Lang)), - reply_html_page(title('Switched language'), - p(['Switch language to ', Lang])). - - - ... - html(a(href(location_by_id(set_lang) + [lang(en)]), - img(src('/www/images/flags/en.png')))), - ... -\end{code} - - - -\end{itemlist} - - \dcg{page}{2}{:HeadContent, :BodyContent} -The DCG non-terminal page//2 generated a complete page, including the SGML -\const{DOCTYPE} declaration. \arg{HeadContent} are elements to be placed -in the \elem{head} element and \arg{BodyContent} are elements to be -placed in the \elem{body} element. - -To achieve common style (background, page header and footer), it is -possible to define DCG non-terminals head//1 and/or body//1. Non-terminal page//1 -checks for the definition of these non-terminals in the module it is called -from as well as in the \const{user} module. If no definition is found, it -creates a head with only the \arg{HeadContent} (note that the -\elem{title} is obligatory) and a \elem{body} with \const{bgcolor} set -to \const{white} and the provided \arg{BodyContent}. - -Note that further customisation is easily achieved using html//1 directly -as page//2 is (besides handling the hooks) defined as: - -\begin{code} -page(Head, Body) --> - html([ \['\n'], - html([ head(Head), - body(bgcolor(white), Body) - ]) - ]). -\end{code} - - \dcg{page}{1}{:Contents} -This version of the page/[1,2] only gives you the SGML \const{DOCTYPE} -and the \elem{HTML} element. \arg{Contents} is used to generate both the -head and body of the page. - - \dcg{html_begin}{1}{+Begin} -Just open the given element. \arg{Begin} is either an atom or a -compound term, In the latter case the arguments are used as arguments -to the begin-tag. Some examples: - -\begin{code} - html_begin(table) - html_begin(table(border(2), align(center))) -\end{code} - -This predicate provides an alternative to using the -\bsl\arg{Command} syntax in the html//1 specification. The -following two fragments are the same. The preferred solution depends on -your preferences as well as whether the specification is generated or -entered by the programmer. - -\begin{code} -table(Rows) --> - html(table([border(1), align(center), width('80%')], - [ \table_header, - \table_rows(Rows) - ])). - -% or - -table(Rows) --> - html_begin(table(border(1), align(center), width('80%'))), - table_header, - table_rows, - html_end(table). -\end{code} - - \dcg{html_end}{1}{+End} -End an element. See html_begin/1 for details. -\end{description} - - -\subsubsection{Emitting HTML documents} - -The non-terminal html//1 translates a specification into a list of -atoms and layout instructions. Currently the layout instructions are -terms of the format \term{nl}{N}, requesting at least \arg{N} -newlines. Multiple consecutive \term{nl}{1} terms are combined to an -atom containing the maximum of the requested number of newline -characters. - -To simplify handing the data to a client or storing it into a file, -the following predicates are available from this library: - -\begin{description} - \predicate{reply_html_page}{2}{:Head, :Body} -Same as \term{reply_html_page}{default, Head, Body}. - - \predicate{reply_html_page}{3}{+Style, :Head, :Body} -Writes an HTML page preceded by an HTTP header as required -by \pllib{http_wrapper} (CGI-style). Here is a simple typical -example: - -\begin{code} -reply(Request) :- - reply_html_page(title('Welcome'), - [ h1('Welcome'), - p('Welcome to our ...') - ]). -\end{code} - -The header and footer of the page can be hooked using the grammar-rules -user:head//2 and user:body//2. The first argument passed to these hooks -is the \arg{Style} argument of reply_html_page/3 and the second is the -2nd (for head//2) or 3rd (for body//2) argument of reply_html_page/3. -These hooks can be used to restyle the page, typically by embedding the -real body content in a \elem{div}. E.g., the following code provides a -menu on top of each page of that is identified using the style -\textit{myapp}. - -\begin{code} -:- multifile - user:body//2. - -user:body(myapp, Body) --> - html(body([ div(id(top), \application_menu), - div(id(content), Body) - ])). -\end{code} - -Redefining the \elem{head} can be used to pull in scripts, but -typically html_requires//1 provides a more modular approach for -pulling scripts and CSS-files. - - \predicate{print_html}{1}{+List} -Print the token list to the Prolog current output stream. - - \predicate{print_html}{2}{+Stream, +List} -Print the token list to the specified output stream - - \predicate{html_print_length}{2}{+List, -Length} -When calling html_print/[1,2] on \arg{List}, \arg{Length} -characters will be produced. Knowing the length is needed to -provide the \const{Content-length} field of an HTTP reply-header. -\end{description} - - -\input{post.tex} - -\subsubsection{Adding rules for html//1} - -In some cases it is practical to extend the translations imposed by -html//1. When using XPCE for example, it is comfortable to be able -defining default translation to HTML for objects. We also used this -technique to define translation rules for the output of the SWI-Prolog -\pllib{sgml} package. - -The html//1 non-terminal first calls the multifile ruleset html_write:expand//1. - -\begin{description} - \dcg{html_write:expand}{1}{+Spec} Hook to add additional -translation rules for html//1. - - \dcg{html_quoted}{1}{+Atom} Emit the text -in \arg{Atom}, inserting entity-references for the SGML special -characters \verb$<&>$. - - \dcg{html_quoted_attribute}{1}{+Atom} Emit the -text in \arg{Atom} suitable for use as an SGML attribute, inserting -entity-references for the SGML special characters \verb$<&>"$. -\end{description} - - -\subsubsection{Generating layout} \label{sec:htmllayout} - -Though not strictly necessary, the library attempts to generate -reasonable layout in SGML output. It does this only by inserting -newlines before and after tags. It does this on the basis of the -multifile predicate html_write:layout/3 - -\begin{description} - \predicate{html_write:layout}{3}{+Tag, -Open, -Close} -Specify the layout conventions for the element \arg{Tag}, which is a -lowercase atom. \arg{Open} is a term \arg{Pre}-\arg{Post}. It defines -that the element should have at least \arg{Pre} newline characters -before and \arg{Post} after the tag. The \arg{Close} specification is -similar, but in addition allows for the atom \const{-}, requesting the -output generator to omit the close-tag altogether or \const{empty}, -telling the library that the element has declared empty content. In this -case the close-tag is not emitted either, but in addition html//1 -interprets \arg{Arg} in \term{Tag}{Arg} as a list of attributes rather -than the content. - -A tag that does not appear in this table is emitted without additional -layout. See also print_html/[1,2]. Please consult the -library source for examples. -\end{description} - - -\subsubsection{Examples} - -In the following example we will generate a table of Prolog predicates -we find from the SWI-Prolog help system based on a keyword. The primary -database is defined by the predicate predicate/5 We will make hyperlinks -for the predicates pointing to their documentation. - -\begin{code} -html_apropos(Kwd) :- - findall(Pred, apropos_predicate(Kwd, Pred), Matches), - phrase(apropos_page(Kwd, Matches), Tokens), - print_html(Tokens). - -% emit page with title, header and table of matches - -apropos_page(Kwd, Matches) --> - page([ title(['Predicates for ', Kwd]) - ], - [ h2(align(center), - ['Predicates for ', Kwd]), - table([ align(center), - border(1), - width('80%') - ], - [ tr([ th('Predicate'), - th('Summary') - ]) - | \apropos_rows(Matches) - ]) - ]). - -% emit the rows for the body of the table. - -apropos_rows([]) --> - []. -apropos_rows([pred(Name, Arity, Summary)|T]) --> - html([ tr([ td(\predref(Name/Arity)), - td(em(Summary)) - ]) - ]), - apropos_rows(T). - -% predref(Name/Arity) -% -% Emit Name/Arity as a hyperlink to -% -% /cgi-bin/plman?name=Name&arity=Arity -% -% we must do form-encoding for the name as it may contain illegal -% characters. www_form_encode/2 is defined in library(url). - -predref(Name/Arity) --> - { www_form_encode(Name, Encoded), - sformat(Href, '/cgi-bin/plman?name=~w&arity=~w', - [Encoded, Arity]) - }, - html(a(href(Href), [Name, /, Arity])). - -% Find predicates from a keyword. '$apropos_match' is an internal -% undocumented predicate. - -apropos_predicate(Pattern, pred(Name, Arity, Summary)) :- - predicate(Name, Arity, Summary, _, _), - ( '$apropos_match'(Pattern, Name) - -> true - ; '$apropos_match'(Pattern, Summary) - ). -\end{code} - - - -\subsubsection{Remarks on the \pllib{http/html_write} library} - -This library is the result of various attempts to reach at a more -satisfactory and Prolog-minded way to produce HTML text from a program. -We have been using Prolog for the generation of web pages in a number of -projects. Just using format/2 never was a real -option, generating error-prone HTML from clumsy syntax. We started -with a layer on top of format/2, keeping track of the current nesting -and thus always capable of properly closing the environment. - -DCG based translation however naturally exploits Prolog's term-rewriting -primitives. If generation fails for whatever reason it is easy to -produce an alternative document (for example holding an error message). - -The approach presented in this library has been used in combination with -\pllib{http/httpd} in three projects: viewing RDF in a browser, -selecting fragments from an analysed document and presenting parts of -the XPCE documentation using a browser. It has proven to be -able to deal with generating pages quickly and comfortably. - -In a future version we will probably define a goal_expansion/2 to do -compile-time optimisation of the library. Quotation of known text and -invocation of sub-rules using the \bsl\arg{RuleSet} and -: operators are costly operations in the analysis -that can be done at compile-time. - -\input{jswrite} -\input{httppath} -\input{htmlhead} -\input{httppwp} - - -\subsection{Security} - -Writing servers is an inherently dangerous job that should be carried out -with some considerations. You have basically started a program on a -public terminal and invited strangers to use it. When using the -interactive server or inetd based server the server runs under your -privileges. Using CGI scripted it runs with the privileges of your -web-server. Though it should not be possible to fatally compromise a -Unix machine using user privileges, getting unconstrained access to the -system is highly undesirable. - -Symbolic languages have an additional handicap in their inherent -possibilities to modify the running program and dynamically create goals -(this also applies to the popular perl and java scripting languages). -Here are some guidelines. - -\begin{itemlist} - \item [Check your input] -Hardly anything can go wrong if you check the validity of -query-arguments before formulating an answer. - - \item [Check filenames] -If part of the query consists of filenames or directories, check -them. This also applies to files you only read. Passing names as -\file{/etc/passwd}, but also \file{../../../../../etc/passwd} are -tried by experienced hackers to learn about the system they want -to attack. So, expand provided names using absolute_file_name/[2,3] -and verify they are inside a folder reserved for the server. Avoid -symbolic links from this subtree to the outside world. The example -below checks validity of filenames. The first call ensures proper -canonisation of the paths to avoid an mismatch due to -symbolic links or other filesystem ambiguities. - -\begin{code} -check_file(File) :- - absolute_file_name('/path/to/reserved/area', Reserved), - absolute_file_name(File, Tried), - atom_concat(Reserved, _, Tried). -\end{code} - - \item [Check scripts] -Should input in any way activate external scripts using shell/1 -or \exam{open(pipe(Command), ...)}, verify the argument once more. - - \item [Check meta-calling] -\emph{The} attractive situation for you and your attacker is below: - -\begin{code} -reply(Query) :- - member(search(Args), Query), - member(action=Action, Query), - member(arg=Arg, Query), - call(Action, Arg). % NEVER EVER DO THIS! -\end{code} - -All your attacker has to do is specify \arg{Action} as \const{shell} -and \arg{Arg} as \const{/bin/sh} and he has an uncontrolled shell! -\end{itemlist} - - -\subsection{Tips and tricks} - -\begin{itemlist} - \item [URL Locations] -With an application in mind, it is tempting to make all URL -locations short and directly connected to the root (\const{/}). This is -\emph{not} a good idea. It is adviced to have all locations in a server -below a directory with an informative name. Consider to make the root -location something that can be changed using a global setting. - - \begin{itemize} - \item Page generating code can easily be reused. Using locations - directly below the root however increases the likelihood - of conflicts. - \item Multiple servers can be placed behind the same public - server as explained in \secref{proxy}. Using a common - and fairly unique root, redirection is much easier and - less likely to lead to conflicts. - \end{itemize} - - \item [Debugging] -Please check the section \url[``Thread-support -library(threadutil)'']{http://gollem.science.uva.nl/SWI-Prolog/Manual/thutil.html} -of the SWI-Prolog reference manual. -\end{itemlist} - - -\section{Transfer encodings} -\label{sec:transfer} - -\index{chunked,encoding}% -\index{deflate,encoding}% -The HTTP protocol provides for \jargon{transfer encodings}. These define -filters applied to the data described by the \const{Content-type}. The -two most popular transfer encodings are \const{chunked} and -\const{deflate}. The \const{chunked} encoding avoids the need for -a \const{Content-length} header, sending the data in chunks, each of -which is preceded by a length. The \const{deflate} encoding provides -compression. - -Transfer-encodings are supported by filters defined as foreign libraries -that realise an encoding/decoding stream on top of another stream. -Currently there are two such libraries: \pllib{http/http_chunked.pl} -and \pllib{zlib.pl}. - -There is an emerging hook interface dealing with transfer encodings. The -\pllib{http/http_chunked.pl} provides a hook used by -\pllib{http/http_open.pl} to support chunked encoding in http_open/3. -Note that both \file{http_open.pl} \emph{and} \file{http_chunked.pl} -must be loaded for http_open/3 to support chunked encoding. - -\subsection{The \pllib{http/http_chunked} library} - -\begin{description} - \predicate{http_chunked_open}{3}{+RawStream, -DataStream, +Options} -Create a stream to realise HTTP chunked encoding or decoding. The -technique is similar to library(zlib), using a Prolog stream as a filter -on another stream. See online documentation at -\url{http://gollem.science.uva.nl/SWI-Prolog/pldoc/} for details. -\end{description} - -\input{json.tex} - -\section{Status} - -The SWI-Prolog HTTP library is in active use in a large number of -projects. It is considered one of the SWI-Prolog core libraries that is -actively maintained and regularly extended with new features. This is -particularly true for the multi-threaded server. The XPCE and inetd based -servers are not widely used. - -This library is by no means complete and you are free to extend it. - -\printindex - -\end{document} - diff --git a/packages/http/http_authenticate.pl b/packages/http/http_authenticate.pl deleted file mode 100644 index 374b229c9..000000000 --- a/packages/http/http_authenticate.pl +++ /dev/null @@ -1,221 +0,0 @@ -/* $Id$ - - Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: wielemak@science.uva.nl - WWW: http://www.swi-prolog.org - Copyright (C): 2007, University of Amsterdam - - 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 Lesser 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 - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - - -:- module(authenticate, - [ http_authenticate/3 % +Check, +Header, -User - ]). -:- use_module(library(base64)). -:- use_module(library('http/dcg_basics')). -:- use_module(library(readutil)). -:- use_module(library(crypt)). -:- use_module(library(debug)). - -/** Authenticate HTTP connections using 401 headers - -This module provides the basics to validate an HTTP =Authorization= -error. User and password information are read from a Unix/Apache -compatible password file. This information, as well as the validation -process is cached to achieve optimal performance. - -@author Jan Wielemaker -*/ - -%% http_authenticate(+Type, +Request, -Fields) -% -% True if Request contains the information to continue according -% to Type. Type identifies the required authentication technique: -% -% * basic(+PasswordFile) -% Use HTTP =Basic= authetication and verify the password -% from PasswordFile. PasswordFile is a file holding -% usernames and passwords in a format compatible to -% Unix and Apache. Each line is record with =|:|= -% separated fields. The first field is the username and -% the second the password _hash_. Password hashes are -% validated using crypt/2. -% -% Successful authorization is cached for 60 seconds to avoid -% overhead of decoding and lookup of the user and password data. -% -% http_authenticate/3 just validates the header. If authorization -% is not provided the browser must be challenged, in response to -% which it normally opens a user-password dialogue. Example code -% realising this is below. The exception causes the HTTP wrapper -% code to generate an HTTP 401 reply. -% -% == -% ( http_authenticate(basic(passwd), Request, Fields) -% -> true -% ; throw(http_reply(authorise(basic, Realm))) -% ). -% == -% -% @tbd Should we also cache failures to reduce the risc of -% DoS attacks? - -http_authenticate(basic(File), Request, [user(User)]) :- - memberchk(authorization(Text), Request), - debug(http_authenticate, 'Authorization: ~w', [Text]), - ( cached_authenticated(Text, File, User) - -> true - ; user_and_passwd(Text, Method, UserChars, Password), - downcase_atom(Method, basic), - debug(http_authenticate, - 'User: ~s, Password: ~s', [UserChars, Password]), - atom_codes(User, UserChars), - validate(File, User, Password), - get_time(Now), - assert(authenticated(Text, File, User, Now)), - debug(http_authenticate, 'Authenticated ~w~n', [User]) - ). - -%% user_and_passwd(+AuthorizeText, -Method, -User, -Password) is det. -% -% Decode the HTTP =Authorization= header. - -user_and_passwd(Text, Method, User, Password) :- - atom_codes(Text, Codes), - phrase(authorization(Method, Cookie), Codes), - phrase(base64(UserPwd), Cookie), - phrase(ident(User, Password), UserPwd). - -authorization(Method, Cookie) --> - nonblanks(MethodChars), - { atom_codes(Method, MethodChars) - }, - blanks, - nonblanks(Cookie), - blanks. - -ident(User, Password) --> - string(User), - ":", - string(Password). - -%% cached_authenticated(+Authorization, +File, -User) -% -% Validate using the cache. If the entry is not in the cache, we -% also remove all outdated entries from the cache. - -:- dynamic - authenticated/4. % Authorization, File, User, Time - -cached_authenticated(Authorization, File, User) :- - authenticated(Authorization, File, User, Time), - get_time(Now), - Now-Time =< 60, !. % 60-second timeout -cached_authenticated(_, _, _) :- - get_time(Now), - ( clause(authenticated(_, _, _, Time), true, Ref), - Now-Time > 60, - erase(Ref), - fail - ). - - -%% validate(+File, +User, +Passwd) -% -% True if User and Passwd combination appears in File. File uses -% the same format as .htaccess files from Apache or Unix password -% files. I.e. it consists of one line per entry with fields -% separated by =|:|=. The first field is the User field, The -% second contains the Passwd in DES or MD5 encrypted format. See -% crypt/2 for details. - -validate(File, User, Password) :- - update_passwd(File, Path), - passwd(User, Path, Hash), - crypt(Password, Hash). - -%% update_passwd(+File, -Path) is det. -% -% Update passwd/3 to reflect the correct passwords for File. Path -% is the absolute path for File. - -:- dynamic - passwd/3, % User, File, Encrypted - last_modified/2. % File, Stamp - -update_passwd(File, Path) :- - absolute_file_name(File, Path, [access(read)]), - time_file(Path, Stamp), - ( last_modified(Path, Stamp) - -> true - ; with_mutex(http_passwd, reload_passwd_file(Path, Stamp)) - ). - -reload_passwd_file(Path, Stamp) :- - last_modified(Path, Stamp), !. % another thread did the work -reload_passwd_file(Path, Stamp) :- - retractall(last_modified(Path, _)), - retractall(passwd(_, Path, _)), - open(Path, read, Fd), - read_line_to_codes(Fd, Line), - read_passwd_file(Line, Fd, Path), - close(Fd), - assert(last_modified(Path, Stamp)). - -read_passwd_file(end_of_file, _, _) :- !. -read_passwd_file(Line, Fd, Path) :- - ( phrase(password_line(User, Hash), Line, _) - -> assert(passwd(User, Path, Hash)) - ; true % TBD: warning - ), - read_line_to_codes(Fd, Line2), - read_passwd_file(Line2, Fd, Path). - - -password_line(User, Hash) --> - string(UserCodes), - ":", - string(HashCodes), - ( ":" - ; eos - ), !, - { atom_codes(User, UserCodes), - atom_codes(Hash, HashCodes) - }. - - - /******************************* - * PLUGIN FOR HTTP_DISPATCH * - *******************************/ - -:- multifile - http:authenticate/3. - -http:authenticate(basic(File, Realm), Request, User) :- - ( http_authenticate(basic(File), Request, User) - -> true - ; throw(http_reply(authorise(basic, Realm))) - ). - diff --git a/packages/http/http_chunked.c b/packages/http/http_chunked.c deleted file mode 100644 index 93c83a8ef..000000000 --- a/packages/http/http_chunked.c +++ /dev/null @@ -1,293 +0,0 @@ -/* $Id$ - - Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: J.Wielemaker@uva.nl - WWW: http://www.swi-prolog.org - Copyright (C): 2007-2009, University of Amsterdam - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 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 - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser 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 -*/ - -#define O_DEBUG 1 -#include -#include -#include -#include -#include -#include -#include - -#define MAXHDR 1024 /* max size of chink header line */ - -static atom_t ATOM_close_parent; /* close_parent(Bool) */ -static atom_t ATOM_max_chunk_size; /* max_chunk_size(Int) */ - - - /******************************* - * TYPES * - *******************************/ - -#define BUFSIZE SIO_BUFSIZE /* raw I/O buffer */ - -typedef struct chunked_context -{ IOSTREAM *stream; /* Original stream */ - IOSTREAM *chunked_stream; /* Stream I'm handle of */ - int close_parent; /* close parent on close */ - IOENC parent_encoding; /* Saved encoding of parent */ - size_t avail; /* data available */ -} chunked_context; - - -static chunked_context* -alloc_chunked_context(IOSTREAM *s) -{ chunked_context *ctx = PL_malloc(sizeof(*ctx)); - - memset(ctx, 0, sizeof(*ctx)); - ctx->stream = s; - ctx->close_parent = FALSE; - - return ctx; -} - - -static void -free_chunked_context(chunked_context *ctx) -{ if ( ctx->stream->upstream ) - Sset_filter(ctx->stream, NULL); - else - PL_release_stream(ctx->stream); - - PL_free(ctx); -} - - - /******************************* - * CHUNKED I/O * - *******************************/ - -static ssize_t /* decode */ -chunked_read(void *handle, char *buf, size_t size) -{ chunked_context *ctx = handle; - - for(;;) - { if ( ctx->avail > 0 ) /* data waiting */ - { size_t max_rd = ctx->avail < size ? ctx->avail : size; - ssize_t rc; - - if ( (rc = Sfread(buf, sizeof(char), max_rd, ctx->stream)) > 0 ) - { ctx->avail -= rc; - - if ( ctx->avail == 0 ) - { if ( Sgetc(ctx->stream) != '\r' || - Sgetc(ctx->stream) != '\n' ) - { Sseterr(ctx->chunked_stream, 0, "Chunk not followed by \\r\\n"); - return -1; - } - } - - return rc; - } else if ( rc == 0 ) - { Sseterr(ctx->chunked_stream, 0, "Unexpected EOF in chunked data"); - return -1; - } else - { return -1; - } - } else - { char hdr[MAXHDR]; - char *s; - - - if ( (s = Sfgets(hdr, sizeof(hdr), ctx->stream)) ) - { char *ehdr; - long len; - - errno = 0; - len = strtol(hdr, &ehdr, 16); - if ( errno || len < 0 ) - { Sseterr(ctx->chunked_stream, 0, "Bad chunk length"); - return -1; - } - if ( len == 0 ) - { do - { s = Sfgets(hdr, sizeof(hdr), ctx->stream); - } while ( s && strcmp(s, "\r\n") != 0 ); - if ( s ) - return 0; - Sseterr(ctx->chunked_stream, 0, "Bad end-of-stream"); - return -1; - } - ctx->avail = len; - /*continue*/ - } - } - } -} - - -static ssize_t /* encode */ -chunked_write(void *handle, char *buf, size_t size) -{ chunked_context *ctx = handle; - - if ( Sfprintf(ctx->stream, "%x\r\n", size) >= 0 && - Sfwrite(buf, sizeof(char), size, ctx->stream) == size && - Sfprintf(ctx->stream, "\r\n") >= 0 ) - return size; - - return -1; -} - - -static int -chunked_control(void *handle, int op, void *data) -{ chunked_context *ctx = handle; - - switch(op) - { case SIO_FLUSHOUTPUT: - case SIO_SETENCODING: - return 0; /* allow switching encoding */ - default: - if ( ctx->stream->functions->control ) - return (*ctx->stream->functions->control)(ctx->stream->handle, op, data); - return -1; - } -} - - -static int -chunked_close(void *handle) -{ chunked_context *ctx = handle; - int rc = 0; - - DEBUG(1, Sdprintf("chunked_close() ...\n")); - - if ( (ctx->chunked_stream->flags & SIO_OUTPUT) ) - { if ( Sfprintf(ctx->stream, "0\r\n\r\n") < 0 ) - rc = -1; - } - - ctx->stream->encoding = ctx->parent_encoding; - - if ( ctx->close_parent ) - { IOSTREAM *parent = ctx->stream; - int rc2; - - free_chunked_context(ctx); - rc2 = Sclose(parent); - if ( rc == 0 ) - rc = rc2; - } else - { free_chunked_context(ctx); - } - - return rc; -} - - -static IOFUNCTIONS chunked_functions = -{ chunked_read, - chunked_write, - NULL, /* seek */ - chunked_close, - chunked_control, /* zcontrol */ - NULL, /* seek64 */ -}; - - - /******************************* - * PROLOG CONNECTION * - *******************************/ - -#define COPY_FLAGS (SIO_INPUT|SIO_OUTPUT| \ - SIO_TEXT| \ - SIO_REPXML|SIO_REPPL|\ - SIO_RECORDPOS) - -static foreign_t -pl_http_chunked_open(term_t org, term_t new, term_t options) -{ term_t tail = PL_copy_term_ref(options); - term_t head = PL_new_term_ref(); - chunked_context *ctx; - IOSTREAM *s, *s2; - int close_parent = FALSE; - int max_chunk_size = 0; - - while(PL_get_list(tail, head, tail)) - { atom_t name; - int arity; - term_t arg = PL_new_term_ref(); - - if ( !PL_get_name_arity(head, &name, &arity) || arity != 1 ) - return type_error(head, "option"); - _PL_get_arg(1, head, arg); - - if ( name == ATOM_max_chunk_size ) - { if ( !get_int_ex(arg, &max_chunk_size) ) - return FALSE; - if ( max_chunk_size <= 0 ) - return domain_error(arg, "positive_integer"); - } else if ( name == ATOM_close_parent ) - { if ( !get_bool_ex(arg, &close_parent) ) - return FALSE; - } - } - if ( !PL_get_nil(tail) ) - return type_error(tail, "list"); - - if ( !PL_get_stream_handle(org, &s) ) - return FALSE; /* Error */ - ctx = alloc_chunked_context(s); - ctx->close_parent = close_parent; - - if ( !(s2 = Snew(ctx, - (s->flags©_FLAGS)|SIO_FBUF, - &chunked_functions)) ) - { free_chunked_context(ctx); /* no memory */ - - return FALSE; - } - - if ( max_chunk_size > 0 ) - { char *buf = PL_malloc(max_chunk_size); - Ssetbuffer(s2, buf, max_chunk_size); - } - - s2->encoding = s->encoding; - ctx->parent_encoding = s->encoding; - s->encoding = ENC_OCTET; - ctx->chunked_stream = s2; - if ( PL_unify_stream(new, s2) ) - { Sset_filter(s, s2); - PL_release_stream(s); - - return TRUE; - } else - { return instantiation_error(); - } -} - - - /******************************* - * INSTALL * - *******************************/ - -static void -install_http_chunked() -{ ATOM_close_parent = PL_new_atom("close_parent"); - ATOM_max_chunk_size = PL_new_atom("max_chunk_size"); - - PL_register_foreign("http_chunked_open", 3, pl_http_chunked_open, 0); -} diff --git a/packages/http/http_client.pl b/packages/http/http_client.pl deleted file mode 100644 index d3fb29b3d..000000000 --- a/packages/http/http_client.pl +++ /dev/null @@ -1,483 +0,0 @@ -/* $Id$ - - Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: J.Wielemaker@cs.vu.nl - WWW: http://www.swi-prolog.org - Copyright (C): 1985-2010, University of Amsterdam, VU University Amsterdam - - 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 Lesser 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 - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - - -:- module(http_client, - [ http_get/3, % +URL, -Reply, +Options - http_delete/3, % +URL, -Reply, +Options - http_post/4, % +URL, +In, -Reply, +Options - http_put/4, % +URL, +In, -Reply, +Options - http_read_data/3, % +Header, -Data, +Options - http_disconnect/1 % +What - ]). -:- use_module(library(socket)). -:- use_module(library(url)). -:- use_module(http_header). -:- use_module(http_stream). -:- use_module(library(debug)). -:- use_module(library(memfile)). -:- use_module(library(lists)). -:- use_module(library(error)). -:- use_module(library(option)). -:- use_module(http_stream). -:- use_module(dcg_basics). - -:- multifile - http_convert_data/4, % http_read_data plugin-hook - post_data_hook/3, % http_post_data/3 hook - open_connection/4, % do_connect/5 hook - close_connection/4. - -%% open_connection(+Scheme, +Address, -In, -Out) is semidet. -% -% Hook to open a connection for the given URL-scheme to the given -% address. If successful, In and Out must be two valid Prolog -% streams that connect to the server. -% -% @param Scheme is the URL schema (=http= or =https=) -% @param Address is a term Host:Port as used by tcp_connect/4. - -%% close_connection(+Scheme, +Address, +In, +Out) is semidet. -% -% Hook to close a specific connection. If the hook succeeds, the -% HTTP client assumes that In and Out are no longer to be used. If -% the hook fails, the client calls close/2 on both streams. - -:- dynamic - connection/5. % Host:Port, Protocol, Thread, In, Out - -:- expects_dialect(swi). -:- assert(system:swi_io). - -user_agent('SWI-Prolog (http://www.swi-prolog.org)'). - -%% connect(+UrlParts, -Read, -Write, +Options) is det. -%% disconnect(+UrlParts) is det. -% -% Connect/disconnect on the basis of a parsed URL. - -connect(Parts, Read, Write, _) :- - memberchk(socket(Read, Write), Parts), !. -connect(Parts, Read, Write, Options) :- - address(Parts, Address, Protocol, Options), - with_mutex(http_client_connect, - connect2(Address, Protocol, Read, Write, Options)). - -connect2(Address, Protocol, In, Out, _) :- - thread_self(Self), - connection(Address, Protocol, Self, In, Out), !. -connect2(Address, Protocol, In, Out, Options) :- - thread_self(Self), - do_connect(Address, Protocol, In, Out, Options), - assert(connection(Address, Protocol, Self, In, Out)). - -do_connect(Address, Protocol, In, Out, Options) :- - debug(http(client), 'http_client: Connecting to ~p ...', [Address]), - ( open_connection(Protocol, Address, In, Out) - -> true - ; tcp_socket(Socket), - catch(tcp_connect(Socket, Address, In, Out), - E, - ( tcp_close_socket(Socket), - throw(E) - )) - ), - debug(http(client), '\tok ~p --> ~p', [In, Out]), - ( memberchk(timeout(Timeout), Options) - -> set_stream(In, timeout(Timeout)) - ; true - ), !. -do_connect(Address, _, _, _, _) :- % can this happen!? - throw(error(failed(connect, Address), _)). - - -disconnect(Parts) :- - protocol(Parts, Protocol), - address(Parts, Protocol, Address, []), !, - disconnect(Address, Protocol). - -disconnect(Address, Protocol) :- - with_mutex(http_client_connect, - disconnect_locked(Address, Protocol)). - -disconnect_locked(Address, Protocol) :- - thread_self(Me), - debug(connection, '~w: Closing connection to ~w~n', [Me, Address]), - thread_self(Self), - retract(connection(Address, Protocol, Self, In, Out)), !, - disconnect(Protocol, Address, In, Out). - -disconnect(Protocol, Address, In, Out) :- - close_connection(Protocol, Address, In, Out), !. -disconnect(_, _, In, Out) :- - close(Out, [force(true)]), - close(In, [force(true)]). - -%% http_disconnect(+Connections) is det. -% -% Close down some connections. Currently Connections must have the -% value =all=, closing all connections. - -http_disconnect(all) :- - ( thread_self(Self), - connection(Address, Protocol, Self, _, _), - disconnect(Address, Protocol), - fail - ; true - ). - -address(_Parts, Host:Port, Protocol, Options) :- - ( memberchk(proxy(Host, Port, Protocol), Options) - -> true - ; memberchk(proxy(Host, Port), Options), - Protocol = http - ). -address(Parts, Host:Port, Protocol, _Options) :- - memberchk(host(Host), Parts), - port(Parts, Port), - protocol(Parts, Protocol). - -port(Parts, Port) :- - memberchk(port(Port), Parts), !. -port(Parts, 80) :- - memberchk(protocol(http), Parts). - -protocol(Parts, Protocol) :- - memberchk(protocol(Protocol), Parts), !. -protocol(_, http). - - /******************************* - * GET * - *******************************/ - -%% http_delete(+URL, -Data, +Options) is det. -% -% Execute a DELETE method on the server. -% -% @tbd Properly map the 201, 202 and 204 replies. - -http_delete(URL, Data, Options) :- - http_get(URL, Data, [method('DELETE')|Options]). - - -%% http_get(+URL, -Data, +Options) is det. -% -% Get data from an HTTP server. - -http_get(URL, Data, Options) :- - atomic(URL), !, - parse_url(URL, Parts), - http_get(Parts, Data, Options). -http_get(Parts, Data, Options) :- - must_be(list, Options), - memberchk(connection(Connection), Options), - downcase_atom(Connection, 'keep-alive'), !, - between(0, 1, _), - catch(http_do_get(Parts, Data, Options), E, - ( message_to_string(E, Msg), - debug(keep_alive, 'Error: ~w; retrying~n', [Msg]), - disconnect(Parts), - fail - )), !. -http_get(Parts, Data, Options) :- - address(Parts, Address, Protocol, Options), - do_connect(Address, Protocol, Read, Write, Options), - call_cleanup(http_do_get([socket(Read, Write)|Parts], Data, Options), - disconnect(Protocol, Address, Read, Write)). - -http_do_get(Parts, Data, Options) :- - connect(Parts, Read, Write, Options), - ( select(proxy(_,_), Options, Options1) - -> parse_url(Location, Parts) - ; http_location(Parts, Location), - Options1 = Options - ), - memberchk(host(Host), Parts), - option(method(Method), Options, 'GET'), - http_write_header(Write, Method, Location, Host, - Options1, ReplyOptions), - write(Write, '\r\n'), - flush_output(Write), - http_read_reply(Read, Data0, ReplyOptions), !, - ( Data0 = redirect(Redirect), - nonvar(Redirect) - -> debug(http(redirect), 'Redirect to ~w', [Redirect]), - parse_url(Redirect, Parts, NewParts), - http_get(NewParts, Data, Options) - ; Data = Data0 - ). -http_do_get(Parts, _Data, _Options) :- - throw(error(failed(http_get, Parts), _)). - -http_read_reply(In, Data, Options) :- - between(0, 1, _), - http_read_reply_header(In, Fields), - \+ memberchk(status(continue, _), Fields), !, - ( memberchk(location(Location), Fields), - ( memberchk(status(moved, _), Fields) - ; memberchk(status(moved_temporary, _), Fields) - ; memberchk(status(see_other, _), Fields) - ) - -> Data = redirect(Location) - ; ( select(reply_header(Fields), Options, ReadOptions) - -> true - ; ReadOptions = Options - ), - http_read_data(In, Fields, Data, ReadOptions) - ), - ( memberchk(connection(Connection), Fields), - downcase_atom(Connection, 'keep-alive') - -> true - ; thread_self(Self), - connection(Address, Protocol, Self, In, _Out) - -> disconnect(Address, Protocol) - ; true - ). -http_read_reply(In, _Data, _Options) :- - format(user_error, 'Get FAILED~n', []), - throw(error(failed(read_reply, In), _)). - - -%% http_write_header(+Out, +Method, +Location, -%% +Host, +Options, -RestOptions) is det. -% -% Write the request header. It accepts the following options: -% -% * http_version(Major-Minor) -% * connection(Connection) -% * user_agent(Agent) -% * request_header(Name=Value) -% -% Remaining options are returned in RestOptions. - -http_write_header(Out, Method, Location, Host, Options, RestOptions) :- - ( select(http_version(Major-Minor), Options, Options1) - -> true - ; Major = 1, Minor = 1, - Options1 = Options - ), - format(Out, '~w ~w HTTP/~w.~w\r\n', [Method, Location, Major, Minor]), - format(Out, 'Host: ~w\r\n', [Host]), - ( select(connection(Connection), Options1, Options2) - -> true - ; Connection = 'Keep-Alive', - Options2 = Options1 - ), - ( select(user_agent(Agent), Options2, Options3) - -> true - ; user_agent(Agent), - Options3 = Options2 - ), - format(Out, 'User-Agent: ~w\r\n\ - Connection: ~w\r\n', [Agent, Connection]), - x_headers(Options3, Out, RestOptions). - -%% x_headers(+Options, +Out, -RestOptions) is det. -% -% Pass additional request options. For example: -% -% request_header('Accept-Language' = 'nl, en') -% -% No checking is performed on the fieldname or value. Both are -% copied literally and in the order of appearance to the request. - -x_headers([], _, []). -x_headers([H|T0], Out, Options) :- - x_header(H, Out), !, - x_headers(T0, Out, Options). -x_headers([H|T0], Out, [H|T]) :- - x_headers(T0, Out, T). - -x_header(request_header(Name=Value), Out) :- - format(Out, '~w: ~w\r\n', [Name, Value]). -x_header(proxy_authorization(ProxyAuthorization), Out) :- - proxy_auth_header(ProxyAuthorization, Out). -x_header(range(Spec), Out) :- - Spec =.. [Unit, From, To], - ( To == end - -> ToT = '' - ; must_be(integer, To), - ToT = To - ), - format(Out, 'Range: ~w=~d-~w\r\n', [Unit, From, ToT]). - -proxy_auth_header(basic(User, Password), Out) :- !, - format(codes(Codes), '~w:~w', [User, Password]), - phrase(base64(Codes), Base64Codes), - format(Out, 'Proxy-Authorization: basic ~s\r\n', [Base64Codes]). -proxy_auth_header(Auth, _) :- - domain_error(authorization, Auth). - -%% http_read_data(+Fields, -Data, +Options) is det. -% -% Read data from an HTTP connection. Options must contain a term -% input(In) that provides the input stream from the HTTP server. -% Fields is the parsed http reply-header. Options is one of: -% -% * to(stream(+WriteStream)) -% Append the content of the message to Stream -% * to(atom) -% Return the reply as an atom -% * to(codes) -% Return the reply as a list of codes - -http_read_data(Fields, Data, Options) :- - memberchk(input(In), Fields), - ( http_read_data(In, Fields, Data, Options) - -> true - ; throw(error(failed(http_read_data), _)) - ). - - -http_read_data(In, Fields, Data, Options) :- % Transfer-encoding: chunked - select(transfer_encoding(chunked), Fields, RestFields), !, - http_chunked_open(In, DataStream, []), - call_cleanup(http_read_data(DataStream, RestFields, Data, Options), - close(DataStream)). -http_read_data(In, Fields, Data, Options) :- - memberchk(to(X), Options), !, - ( X = stream(Stream) - -> ( memberchk(content_length(Bytes), Fields) - -> copy_stream_data(In, Stream, Bytes) - ; copy_stream_data(In, Stream) - ) - ; new_memory_file(MemFile), - open_memory_file(MemFile, write, Stream, [encoding(octet)]), - ( memberchk(content_length(Bytes), Fields) - -> copy_stream_data(In, Stream, Bytes) - ; copy_stream_data(In, Stream) - ), - close(Stream), - encoding(Fields, Encoding), - ( X == atom - -> memory_file_to_atom(MemFile, Data0, Encoding) - ; X == codes - -> memory_file_to_codes(MemFile, Data0, Encoding) - ; domain_error(return_type, X) - ), - free_memory_file(MemFile), - Data = Data0 - ). -http_read_data(In, Fields, Data, _) :- - memberchk(content_type('application/x-www-form-urlencoded'), Fields), !, - http_read_data(In, Fields, Codes, [to(codes)]), - parse_url_search(Codes, Data). -http_read_data(In, Fields, Data, Options) :- % call hook - ( select(content_type(Type), Options, Options1) - -> delete(Fields, content_type(_), Fields1), - http_convert_data(In, [content_type(Type)|Fields1], Data, Options1) - ; http_convert_data(In, Fields, Data, Options) - ), !. -http_read_data(In, Fields, Data, Options) :- - http_read_data(In, Fields, Data, [to(atom)|Options]). - - -encoding(Fields, utf8) :- - memberchk(content_type(Type), Fields), - ( sub_atom(Type, _, _, _, 'UTF-8') - -> true - ; sub_atom(Type, _, _, _, 'utf-8') - ), !. -encoding(_, octet). - - - /******************************* - * POST * - *******************************/ - -%% http_put(+URL, +In, -Out, +Options) -% -% Issue an HTTP PUT request. - -http_put(URL, In, Out, Options) :- - http_post(URL, In, Out, [method('PUT')|Options]). - - -%% http_post(+URL, +In, -Out, +Options) -% -% Issue an HTTP POST request, In is modelled after the reply -% from the HTTP server module. In is one of: -% -% * string(String) -% * string(MimeType, String) -% * html(Tokens) -% * file(MimeType, File) - -http_post(URL, In, Out, Options) :- - atomic(URL), !, - parse_url(URL, Parts), - http_post(Parts, In, Out, Options). -http_post(Parts, In, Out, Options) :- - memberchk(connection(Connection), Options), - downcase_atom(Connection, 'keep-alive'), !, - between(0, 1, _), - catch(http_do_post(Parts, In, Out, Options), error(io_error, _), - ( disconnect(Parts), - fail - )), !. -http_post(Parts, In, Out, Options) :- - address(Parts, Address, Protocol, Options), - do_connect(Address, Protocol, Read, Write, Options), - call_cleanup(http_do_post([socket(Read, Write)|Parts], - In, Out, Options), - disconnect(Protocol, Address, Read, Write)). - -http_do_post(Parts, In, Out, Options) :- - connect(Parts, Read, Write, Options), - ( memberchk(proxy(_,_), Options) - -> parse_url(Location, Parts) - ; http_location(Parts, Location) - ), - memberchk(host(Host), Parts), - split_options(Options, PostOptions, ReplyOptions), - write_post_header(Write, Location, Host, In, PostOptions), - http_read_reply(Read, Out, ReplyOptions). - -write_post_header(Out, Location, Host, In, Options) :- - option(method(Method), Options, 'POST'), - http_write_header(Out, Method, Location, Host, Options, DataOptions), - http_post_data(In, Out, DataOptions), - flush_output(Out). - -post_option(connection(_)). -post_option(http_version(_)). -post_option(cache_control(_)). -post_option(request_header(_)). - -split_options([], [], []). -split_options([H|T], [H|P], R) :- - post_option(H), !, - split_options(T, P, R). -split_options([H|T], P, [H|R]) :- - split_options(T, P, R). - -:- retract(system:swi_io). - diff --git a/packages/http/http_dirindex.pl b/packages/http/http_dirindex.pl deleted file mode 100644 index d89cec3df..000000000 --- a/packages/http/http_dirindex.pl +++ /dev/null @@ -1,202 +0,0 @@ -/* Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: J.Wielemaker@cs.vu.nl - WWW: http://www.swi-prolog.org - Copyright (C): 2009, VU University Amsterdam - - 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 library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(http_dirindex, - [ http_reply_dirindex/3 % +PhysicalDir, +Options, +Request - ]). -:- use_module(library(http/html_write)). -:- use_module(library(http/http_path)). -:- use_module(library(http/http_dispatch)). -:- use_module(library(http/http_server_files)). -:- use_module(library(http/html_head)). -:- use_module(library(apply)). -:- use_module(library(option)). - -/** HTTP directory listings - -This module provides a simple API to generate an index for a physical -directory. The index can be customised by overruling the dirindex.css -CSS file and by defining additional rules for icons using the hook -http:file_extension_icon/2. - -@tbd Provide more options (sorting, selecting columns, hiding files) -*/ - -%% http_reply_dirindex(+DirSpec, +Options, +Request) is det. -% -% Provide a directory listing for Request, assuming it is an index -% for the physical directrory Dir. If the request-path does not -% end with /, first return a moved (301 Moved Permanently) reply. -% -% The calling conventions allows for direct calling from -% http_handler/3. - -http_reply_dirindex(DirSpec, Options, Request) :- - http_safe_file(DirSpec, Options), - absolute_file_name(DirSpec, Dir, - [ file_type(directory), - access(read) - ]), - memberchk(path(Path), Request), - ( atom_concat(PlainPath, /, Path), - merge_options(Options, - [ title(['Index of ', PlainPath]) ], - Options1) - -> dir_index(Dir, Options1) - ; atom_concat(Path, /, NewLocation), - throw(http_reply(moved(NewLocation))) - ). - -dir_index(Dir, Options) :- - directory_members(Dir, SubDirs, Files), - option(title(Title), Options, Dir), - reply_html_page(title(Title), - [ \html_requires(http_dirindex), - h1(Title), - table(class(dirindex), - [ \dirindex_title, - \back - | \dirmembers(SubDirs, Files) - ]) - ]). - -directory_members(Dir, Dirs, Files) :- - atom_concat(Dir, '/*', Pattern), - expand_file_name(Pattern, Matches), - partition(exists_directory, Matches, Dirs, Files). - -dirindex_title --> - html(tr(class(dirindex_header), - [ th(class(icon), ''), - th(class(name), 'Name'), - th(class(modified), 'Last modified'), - th(class(size), 'Size') - ])). - -back --> - html(tr([ \icon_cell('back.png', '[UP]'), - \name_cell(.., 'Up'), - td(class(modified), -), - td(class(size), -) - ])). - -dirmembers(Dirs, Files) --> - dir_rows(Dirs, odd, End), - file_rows(Files, End, _). - -dir_rows([], OE, OE) --> []. -dir_rows([H|T], OE0, OE) --> - dir_row(H, OE0), - { oe(OE0, OE1) }, - dir_rows(T, OE1, OE). - -file_rows([], OE, OE) --> []. -file_rows([H|T], OE0, OE) --> - file_row(H, OE0), - {oe(OE0, OE1)}, - file_rows(T, OE1, OE). - -oe(odd, even). -oe(even, odd). - -dir_row(Dir, OE) --> - { file_base_name(Dir, Name) - }, - html(tr(class(OE), - [ \icon_cell('folder.png', '[DIR]'), - \name_cell(Name, Name), - \modified_cell(Dir), - td(class(size), -) - ])). - - -file_row(File, OE) --> - { file_base_name(File, Name), - file_name_extension(_, Ext, Name), - file_type_icon(Ext, IconName) - }, - html(tr(class(OE), - [ \icon_cell(IconName, '[FILE]'), - \name_cell(Name, Name), - \modified_cell(File), - td(class(size), \size(File)) - ])). - -icon_cell(IconName, Alt) --> - { http_absolute_location(icons(IconName), Icon, []) - }, - html(td(class(icon), img([src(Icon), alt(Alt)]))). - - -name_cell(Ref, Name) --> - html(td(class(name), a(href(Ref), Name))). - - -modified_cell(Name) --> - { time_file(Name, Stamp), - format_time(string(Date), '%+', Stamp) - }, - html(td(class(modified), Date)). - -size(Name) --> - { size_file(Name, Size) - }, - html('~D'-[Size]). - -%% file_type_icon(+Extension, -Icon) is det. -% -% Determine the icon that is used to show a file of the given -% extension. This predicate can be hooked using the multifile -% http:file_extension_icon/2 hook with the same signature. Icon is -% the plain name of an image file that appears in the -% file-search-path =icons=. - -file_type_icon(Ext, Icon) :- - http:file_extension_icon(Ext, Icon), !. -file_type_icon(_, 'generic.png'). - -:- multifile - http:file_extension_icon/2. - -http:file_extension_icon(pdf, 'layout.png'). -http:file_extension_icon(c, 'c.png'). -http:file_extension_icon(gz, 'compressed.png'). -http:file_extension_icon(tgz, 'compressed.png'). -http:file_extension_icon(zip, 'compressed.png'). - - - /******************************* - * RESOURCES * - *******************************/ - -:- html_resource(http_dirindex, - [ virtual(true), - requires([ css('dirindex.css') - ]) - ]). diff --git a/packages/http/http_dispatch.pl b/packages/http/http_dispatch.pl deleted file mode 100644 index c99b15bbc..000000000 --- a/packages/http/http_dispatch.pl +++ /dev/null @@ -1,855 +0,0 @@ -/* Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: J.Wielemaker@uva.nl - WWW: http://www.swi-prolog.org - Copyright (C): 2007-2009, University of Amsterdam - - 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 Lesser 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 - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(http_dispatch, - [ http_dispatch/1, % +Request - http_handler/3, % +Path, +Predicate, +Options - http_delete_handler/1, % +Path - http_reply_file/3, % +File, +Options, +Request - http_redirect/3, % +How, +Path, +Request - http_current_handler/2, % ?Path, ?Pred - http_current_handler/3, % ?Path, ?Pred - http_location_by_id/2, % +ID, -Location - http_link_to_id/3, % +ID, +Parameters, -HREF - http_safe_file/2 % +Spec, +Options - ]). -:- use_module(library(option)). -:- use_module(library(lists)). -:- use_module(library(time)). -:- use_module(library(error)). -:- use_module(library(settings)). -:- use_module(library(uri)). -:- use_module(library(http/mimetype)). -:- use_module(library(http/http_path)). -:- use_module(library(http/http_header)). -:- use_module(library(http/thread_httpd)). - -/** Dispatch requests in the HTTP server - -This module can be placed between http_wrapper.pl and the application -code to associate HTTP _locations_ to predicates that serve the pages. -In addition, it associates parameters with locations that deal with -timeout handling and user authentication. The typical setup is: - -== -server(Port, Options) :- - http_server(http_dispatch, - [ port(Port), - | Options - ]). - -:- http_handler('/index.html', write_index, []). - -write_index(Request) :- - ... -== -*/ - -:- setting(http:time_limit, nonneg, 300, - 'Time limit handling a single query (0=infinite)'). - -%% http_handler(+Path, :Closure, +Options) is det. -% -% Register Closure as a handler for HTTP requests. Path is a -% specification as provided by http_path.pl. If an HTTP -% request arrives at the server that matches Path, Closure -% is called with one extra argument: the parsed HTTP request. -% Options is a list containing the following options: -% -% * authentication(+Type) -% Demand authentication. Authentication methods are -% pluggable. The library http_authenticate.pl provides -% a plugin for user/password based =Basic= HTTP -% authentication. -% -% * chunked -% Use =|Transfer-encoding: chunked|= if the client -% allows for it. -% -% * id(+Term) -% Identifier of the handler. The default identifier is -% the predicate name. Used by http_location_by_id/2. -% -% * priority(+Integer) -% If two handlers handle the same path, the one with the -% highest priority is used. If equal, the last registered -% is used. Please be aware that the order of clauses in -% multifile predicates can change due to reloading files. -% The default priority is 0 (zero). -% -% * prefix -% Call Pred on any location that is a specialisation of -% Path. If multiple handlers match, the one with the -% longest path is used. -% -% * spawn(+SpawnOptions) -% Run the handler in a seperate thread. If SpawnOptions -% is an atom, it is interpreted as a thread pool name -% (see create_thread_pool/3). Otherwise the options -% are passed to http_spawn/2 and from there to -% thread_create/3. These options are typically used to -% set the stack limits. -% -% * time_limit(+Spec) -% One of =infinite=, =default= or a positive number -% (seconds) -% -% * content_type(+Term) -% Specifies the content-type of the reply. This value is -% currently not used by this library. It enhances the -% reflexive capabilities of this library through -% http_current_handler/3. -% -% Note that http_handler/3 is normally invoked as a directive and -% processed using term-expansion. Using term-expansion ensures -% proper update through make/0 when the specification is modified. -% We do not expand when the cross-referencer is running to ensure -% proper handling of the meta-call. -% -% @error existence_error(http_location, Location) -% @see http_reply_file/3 and http_redirect/3 are generic -% handlers to serve files and achieve redirects. - -:- dynamic handler/4. % Path, Action, IsPrefix, Options -:- multifile handler/4. -:- dynamic generation/1. - -:- meta_predicate - http_handler(+, :, +), - http_current_handler(?, :), - http_current_handler(?, :, ?). - -http_handler(Path, Pred, Options) :- - strip_module(Pred, M, P), - compile_handler(Path, M:P, Options, Clause), - next_generation, - assert(Clause). - -:- multifile - system:term_expansion/2. - -system:term_expansion((:- http_handler(Path, Pred, Options)), Clause) :- - \+ current_prolog_flag(xref, true), - prolog_load_context(module, M), - compile_handler(Path, M:Pred, Options, Clause), - next_generation. - - -%% http_delete_handler(+Path) is det. -% -% Delete handler for Path. Typically, this should only be used for -% handlers that are registered dynamically. - -http_delete_handler(Path) :- - retractall(handler(Path, _Pred, _, _Options)), - next_generation. - - -%% next_generation is det. -%% current_generation(-G) is det. -% -% Increment the generation count. - -next_generation :- - retractall(id_location_cache(_,_)), - with_mutex(http_dispatch, next_generation_unlocked). - -next_generation_unlocked :- - retract(generation(G0)), !, - G is G0 + 1, - assert(generation(G)). -next_generation_unlocked :- - assert(generation(1)). - -current_generation(G) :- - with_mutex(http_dispatch, generation(G)), !. -current_generation(0). - - -%% compile_handler(+Path, :Pred, +Options) is det. -% -% Compile a handler specification. For now we this is a no-op, but -% in the feature can make this more efficiently, especially in the -% presence of one or multiple prefix declarations. We can also use -% this to detect conflicts. - -compile_handler(prefix(Path), Pred, Options, - http_dispatch:handler(Path, Pred, true, Options)) :- !, - check_path(Path, Path1), - print_message(warning, http_dispatch(prefix(Path1))). -compile_handler(Path, Pred, Options0, - http_dispatch:handler(Path1, Pred, IsPrefix, Options)) :- - check_path(Path, Path1), - ( select(prefix, Options0, Options) - -> IsPrefix = true - ; IsPrefix = false, - Options = Options0 - ). - -%% check_path(+PathSpecIn, -PathSpecOut) is det. -% -% Validate the given path specification. We want one of -% -% * AbsoluteLocation -% * Alias(Relative) -% -% Similar to absolute_file_name/3, Relative can be a term -% _|Component/Component/...|_ -% -% @error domain_error, type_error -% @see http_absolute_location/3 - -check_path(Path, Path) :- - atom(Path), !, - ( sub_atom(Path, 0, _, _, /) - -> true - ; domain_error(absolute_http_location, Path) - ). -check_path(Alias, AliasOut) :- - compound(Alias), - Alias =.. [Name, Relative], !, - to_atom(Relative, Local), - ( sub_atom(Local, 0, _, _, /) - -> domain_error(relative_location, Relative) - ; AliasOut =.. [Name, Local] - ). -check_path(PathSpec, _) :- - type_error(path_or_alias, PathSpec). - -to_atom(Atom, Atom) :- - atom(Atom), !. -to_atom(Path, Atom) :- - phrase(path_to_list(Path), Components), !, - atomic_list_concat(Components, '/', Atom). -to_atom(Path, _) :- - ground(Path), !, - type_error(relative_location, Path). -to_atom(Path, _) :- - instantiation_error(Path). - -path_to_list(Var) --> - { var(Var), !, - fail - }. -path_to_list(A/B) --> - path_to_list(A), - path_to_list(B). -path_to_list(Atom) --> - { atom(Atom) }, - [Atom]. - - - -%% http_dispatch(Request) is det. -% -% Dispatch a Request using http_handler/3 registrations. - -http_dispatch(Request) :- - memberchk(path(Path), Request), - find_handler(Path, Pred, Options), - authentication(Options, Request, Fields), - append(Fields, Request, AuthRequest), - action(Pred, AuthRequest, Options). - - -%% http_current_handler(+Location, :Closure) is semidet. -%% http_current_handler(-Location, :Closure) is nondet. -% -% True if Location is handled by Closure. - -http_current_handler(Path, Closure) :- - atom(Path), !, - path_tree(Tree), - find_handler(Tree, Path, Closure, _). -http_current_handler(Path, M:C) :- - handler(Spec, M:C, _, _), - http_absolute_location(Spec, Path, []). - -%% http_current_handler(+Location, :Closure, -Options) is semidet. -%% http_current_handler(?Location, :Closure, ?Options) is nondet. -% -% Resolve the current handler and options to execute it. - -http_current_handler(Path, Closure, Options) :- - atom(Path), !, - path_tree(Tree), - find_handler(Tree, Path, Closure, Options). -http_current_handler(Path, M:C, Options) :- - handler(Spec, M:C, _, _), - http_absolute_location(Spec, Path, []), - path_tree(Tree), - find_handler(Tree, Path, _, Options). - - -%% http_location_by_id(+ID, -Location) is det. -% -% Find the HTTP Location of handler with ID. If the setting (see -% setting/2) http:prefix is active, Location is the handler -% location prefixed with the prefix setting. Handler IDs can be -% specified in two ways: -% -% * id(ID) -% If this appears in the option list of the handler, this -% it is used and takes preference over using the predicate. -% * M:PredName -% The module-qualified name of the predicate. -% * PredName -% The unqualified name of the predicate. -% -% @error existence_error(http_handler_id, Id). - -:- dynamic - id_location_cache/2. - -http_location_by_id(ID, Location) :- - must_be(ground, ID), - id_location_cache(ID, L0), !, - Location = L0. -http_location_by_id(ID, Location) :- - findall(P-L, location_by_id(ID, L, P), List), - keysort(List, RevSorted), - reverse(RevSorted, Sorted), - ( Sorted = [_-One] - -> assert(id_location_cache(ID, One)), - Location = One - ; List == [] - -> existence_error(http_handler_id, ID) - ; List = [P0-Best,P1-_|_] - -> ( P0 == P1 - -> print_message(warning, - http_dispatch(ambiguous_id(ID, Sorted, Best))) - ; true - ), - assert(id_location_cache(ID, Best)), - Location = Best - ). - -location_by_id(ID, Location, Priority) :- - location_by_id_raw(ID, L0, Priority), - to_path(L0, Location). - -to_path(prefix(Path0), Path) :- !, % old style prefix notation - add_prefix(Path0, Path). -to_path(Path0, Path) :- - atomic(Path0), !, % old style notation - add_prefix(Path0, Path). -to_path(Spec, Path) :- % new style notation - http_absolute_location(Spec, Path, []). - -add_prefix(P0, P) :- - ( catch(setting(http:prefix, Prefix), _, fail), - Prefix \== '' - -> atom_concat(Prefix, P0, P) - ; P = P0 - ). - -location_by_id_raw(ID, Location, Priority) :- - handler(Location, _, _, Options), - option(id(ID), Options), - option(priority(P0), Options, 0), - Priority is P0+1000. % id(ID) takes preference over predicate -location_by_id_raw(ID, Location, Priority) :- - handler(Location, M:C, _, Options), - option(priority(Priority), Options, 0), - functor(C, PN, _), - ( ID = M:PN - ; ID = PN - ), !. - - -%% http_link_to_id(+HandleID, +Parameters, -HREF) -% -% HREF is a link on the local server to a handler with given ID, -% passing the given Parameters. - -http_link_to_id(HandleID, Parameters, HREF) :- - http_location_by_id(HandleID, Location), - uri_data(path, Components, Location), - uri_query_components(String, Parameters), - uri_data(search, Components, String), - uri_components(HREF, Components). - - -% hook into html_write:attribute_value//1. - -:- multifile - html_write:expand_attribute_value//1. - -html_write:expand_attribute_value(location_by_id(ID)) --> - { http_location_by_id(ID, Location) }, - html_write:html_quoted_attribute(Location). - - -%% authentication(+Options, +Request, -Fields) is det. -% -% Verify authentication information. If authentication is -% requested through Options, demand it. The actual verification is -% done by the multifile predicate http_dispatch:authenticate/3. -% The library http_authenticate.pl provides an implementation -% thereof. -% -% @error permission_error(access, http_location, Location) - -:- multifile - http:authenticate/3. - -authentication([], _, []). -authentication([authentication(Type)|Options], Request, Fields) :- !, - ( http:authenticate(Type, Request, XFields) - -> append(XFields, More, Fields), - authentication(Options, Request, More) - ; memberchk(path(Path), Request), - throw(error(permission_error(access, http_location, Path), _)) - ). -authentication([_|Options], Request, Fields) :- - authentication(Options, Request, Fields). - - -%% find_handler(+Path, -Action, -Options) is det. -% -% Find the handler to call from Path. Rules: -% -% * If there is a matching handler, use this. -% * If there are multiple prefix(Path) handlers, use the -% longest. -% -% If there is a handler for =|/dir/|= and the requested path is -% =|/dir|=, find_handler/3 throws a http_reply exception, causing -% the wrapper to generate a 301 (Moved Permanently) reply. -% -% @error existence_error(http_location, Location) -% @throw http_reply(moved(Dir)) -% @tbd Introduce automatic redirection to indexes here? - -find_handler(Path, Action, Options) :- - path_tree(Tree), - ( find_handler(Tree, Path, Action, Options) - -> true - ; \+ sub_atom(Path, _, _, 0, /), - atom_concat(Path, /, Dir), - find_handler(Tree, Dir, Action, Options) - -> throw(http_reply(moved(Dir))) - ; throw(error(existence_error(http_location, Path), _)) - ). - - -find_handler([node(prefix(Prefix), PAction, POptions, Children)|_], - Path, Action, Options) :- - sub_atom(Path, 0, _, After, Prefix), !, - ( find_handler(Children, Path, Action, Options) - -> true - ; Action = PAction, - path_info(After, Path, POptions, Options) - ). -find_handler([node(Path, Action, Options, _)|_], Path, Action, Options) :- !. -find_handler([_|Tree], Path, Action, Options) :- - find_handler(Tree, Path, Action, Options). - -path_info(0, _, Options, - [prefix(true)|Options]) :- !. -path_info(After, Path, Options, - [path_info(PathInfo),prefix(true)|Options]) :- - sub_atom(Path, _, After, 0, PathInfo). - - -%% action(+Action, +Request, +Options) is det. -% -% Execute the action found. Here we take care of the options -% =time_limit=, =chunked= and =spawn=. -% -% @error goal_failed(Goal) - -action(Action, Request, Options) :- - memberchk(chunked, Options), !, - format('Transfer-encoding: chunked~n'), - spawn_action(Action, Request, Options). -action(Action, Request, Options) :- - spawn_action(Action, Request, Options). - -spawn_action(Action, Request, Options) :- - option(spawn(Spawn), Options), !, - spawn_options(Spawn, SpawnOption), - http_spawn(time_limit_action(Action, Request, Options), SpawnOption). -spawn_action(Action, Request, Options) :- - time_limit_action(Action, Request, Options). - -spawn_options([], []) :- !. -spawn_options(Pool, Options) :- - atom(Pool), !, - Options = [pool(Pool)]. -spawn_options(List, List). - -time_limit_action(Action, Request, Options) :- - ( option(time_limit(TimeLimit), Options), - TimeLimit \== default - -> true - ; setting(http:time_limit, TimeLimit) - ), - number(TimeLimit), - TimeLimit > 0, !, - call_with_time_limit(TimeLimit, call_action(Action, Request, Options)). -time_limit_action(Action, Request, Options) :- - call_action(Action, Request, Options). - - -%% call_action(+Action, +Request, +Options) -% -% @tbd reply_file is normal call? - -call_action(reply_file(File, FileOptions), Request, _Options) :- !, - http_reply_file(File, FileOptions, Request). -call_action(Pred, Request, Options) :- - memberchk(path_info(PathInfo), Options), !, - call_action(Pred, [path_info(PathInfo)|Request]). -call_action(Pred, Request, _Options) :- - call_action(Pred, Request). - -call_action(Pred, Request) :- - ( call(Pred, Request) - -> true - ; extend(Pred, [Request], Goal), - throw(error(goal_failed(Goal), _)) - ). - -extend(Var, _, Var) :- - var(Var), !. -extend(M:G0, Extra, M:G) :- - extend(G0, Extra, G). -extend(G0, Extra, G) :- - G0 =.. List, - append(List, Extra, List2), - G =.. List2. - -%% http_reply_file(+FileSpec, +Options, +Request) is det. -% -% Options is a list of -% -% * cache(+Boolean) -% If =true= (default), handle If-modified-since and send -% modification time. -% -% * mime_type(+Type) -% Overrule mime-type guessing from the filename as -% provided by file_mime_type/2. -% -% * unsafe(+Boolean) -% If =false= (default), validate that FileSpec does not -% contain references to parent directories. E.g., -% specifications such as =|www('../../etc/passwd')|= are -% not allowed. -% -% If caching is not disabled, it processed the request headers -% =|If-modified-since|= and =Range=. -% -% @throws http_reply(not_modified) -% @throws http_reply(file(MimeType, Path)) - -http_reply_file(File, Options, Request) :- - http_safe_file(File, Options), - absolute_file_name(File, Path, - [ access(read) - ]), - ( option(cache(true), Options, true) - -> ( memberchk(if_modified_since(Since), Request), - time_file(Path, Time), - catch(http_timestamp(Time, Since), _, fail) - -> throw(http_reply(not_modified)) - ; true - ), - ( memberchk(range(Range), Request) - -> Reply = file(Type, Path, Range) - ; Reply = file(Type, Path) - ) - ; Reply = tmp_file(Type, Path) - ), - ( option(mime_type(Type), Options) - -> true - ; file_mime_type(Path, Type) - -> true - ; Type = text/plain % fallback type - ), - throw(http_reply(Reply)). - -%% http_safe_file(+FileSpec, +Options) is det. -% -% True if FileSpec is considered _safe_. If it is an atom, it -% cannot be absolute and cannot have references to parent -% directories. If it is of the form alias(Sub), than Sub cannot -% have references to parent directories. -% -% @error instantiation_error -% @error permission_error(read, file, FileSpec) - -http_safe_file(File, _) :- - var(File), !, - instantiation_error(File). -http_safe_file(_, Options) :- - option(unsafe(true), Options, false), !. -http_safe_file(File, _) :- - http_safe_file(File). - -http_safe_file(File) :- - compound(File), - functor(File, _, 1), !, - arg(1, File, Name), - safe_name(Name, File). -http_safe_file(Name) :- - ( is_absolute_file_name(Name) - -> permission_error(read, file, Name) - ; true - ), - safe_name(Name, Name). - -safe_name(Name, _) :- - must_be(atom, Name), - \+ unsafe_name(Name), !. -safe_name(_, Spec) :- - permission_error(read, file, Spec). - -unsafe_name(Name) :- Name == '..'. -unsafe_name(Name) :- sub_atom(Name, 0, _, _, '../'). -unsafe_name(Name) :- sub_atom(Name, _, _, _, '/../'). -unsafe_name(Name) :- sub_atom(Name, _, _, 0, '/..'). - - -%% http_redirect(+How, +To, +Request) is det. -% -% Redirect to a new location. The argument order, using the -% Request as last argument, allows for calling this directly from -% the handler declaration: -% -% == -% :- http_handler(root(.), -% http_redirect(moved, myapp('index.html')), -% []). -% == -% -% @param How is one of =moved=, =moved_temporary= or =see_also= -% @param To is an atom, a aliased path as defined by -% http_absolute_location/3. or a term location_by_id(Id). If To is -% not absolute, it is resolved relative to the current location. - -http_redirect(How, To, Request) :- - ( To = location_by_id(Id) - -> http_location_by_id(Id, URL) - ; memberchk(path(Base), Request), - http_absolute_location(To, URL, [relative_to(Base)]) - ), - must_be(oneof([moved, moved_temporary, see_also]), How), - Term =.. [How,URL], - throw(http_reply(Term)). - - - /******************************* - * PATH COMPILATION * - *******************************/ - -%% path_tree(-Tree) is det. -% -% Compile paths into a tree. The treee is multi-rooted and -% represented as a list of nodes, where each node has the form: -% -% node(PathOrPrefix, Action, Options, Children) -% -% The tree is a potentially complicated structure. It is cached in -% a global variable. Note that this cache is per-thread, so each -% worker thread holds a copy of the tree. If handler facts are -% changed the _generation_ is incremented using next_generation/0 -% and each worker thread will re-compute the tree on the next -% ocasion. - -path_tree(Tree) :- - current_generation(G), - nb_current(http_dispatch_tree, G-Tree), !. % Avoid existence error -path_tree(Tree) :- - findall(Prefix, prefix_handler(Prefix, _, _), Prefixes0), - sort(Prefixes0, Prefixes), - prefix_tree(Prefixes, [], PTree), - prefix_options(PTree, [], OPTree), - add_paths_tree(OPTree, Tree), - current_generation(G), - nb_setval(http_dispatch_tree, G-Tree). - -prefix_handler(Prefix, Action, Options) :- - handler(Spec, Action, true, Options), - http_absolute_location(Spec, Prefix, []). - -%% prefix_tree(PrefixList, +Tree0, -Tree) -% -% @param Tree list(Prefix-list(Children)) - -prefix_tree([], Tree, Tree). -prefix_tree([H|T], Tree0, Tree) :- - insert_prefix(H, Tree0, Tree1), - prefix_tree(T, Tree1, Tree). - -insert_prefix(Prefix, Tree0, Tree) :- - select(P-T, Tree0, Tree1), - sub_atom(Prefix, 0, _, _, P), !, - insert_prefix(Prefix, T, T1), - Tree = [P-T1|Tree1]. -insert_prefix(Prefix, Tree, [Prefix-[]|Tree]). - - -%% prefix_options(+PrefixTree, +DefOptions, -OptionTree) -% -% Generate the option-tree for all prefix declarations. -% -% @tbd What to do if there are more? - -prefix_options([], _, []). -prefix_options([P-C|T0], DefOptions, - [node(prefix(P), Action, Options, Children)|T]) :- - once(prefix_handler(P, Action, Options0)), - merge_options(Options0, DefOptions, Options), - prefix_options(C, Options, Children), - prefix_options(T0, DefOptions, T). - - -%% add_paths_tree(+OPTree, -Tree) is det. -% -% Add the plain paths. - -add_paths_tree(OPTree, Tree) :- - findall(path(Path, Action, Options), - plain_path(Path, Action, Options), - Triples), - add_paths_tree(Triples, OPTree, Tree). - -add_paths_tree([], Tree, Tree). -add_paths_tree([path(Path, Action, Options)|T], Tree0, Tree) :- - add_path_tree(Path, Action, Options, [], Tree0, Tree1), - add_paths_tree(T, Tree1, Tree). - - -%% plain_path(-Path, -Action, -Options) is nondet. -% -% True if {Path,Action,Options} is registered and Path is a plain -% (i.e. not _prefix_) location. - -plain_path(Path, Action, Options) :- - handler(Spec, Action, false, Options), - http_absolute_location(Spec, Path, []). - - -%% add_path_tree(+Path, +Action, +Options, +Tree0, -Tree) is det. -% -% Add a path to a tree. If a handler for the same path is already -% defined, the one with the highest priority or the latest takes -% precedence. - -add_path_tree(Path, Action, Options0, DefOptions, [], - [node(Path, Action, Options, [])]) :- !, - merge_options(Options0, DefOptions, Options). -add_path_tree(Path, Action, Options, _, - [node(prefix(Prefix), PA, DefOptions, Children0)|RestTree], - [node(prefix(Prefix), PA, DefOptions, Children)|RestTree]) :- - sub_atom(Path, 0, _, _, Prefix), !, - add_path_tree(Path, Action, Options, DefOptions, Children0, Children). -add_path_tree(Path, Action, Options1, DefOptions, [H0|T], [H|T]) :- - H0 = node(Path, _, Options2, _), - option(priority(P1), Options1, 0), - option(priority(P2), Options2, 0), - P1 >= P2, !, - merge_options(Options1, DefOptions, Options), - H = node(Path, Action, Options, []). -add_path_tree(Path, Action, Options, DefOptions, [H|T0], [H|T]) :- - add_path_tree(Path, Action, Options, DefOptions, T0, T). - - - /******************************* - * MESSAGES * - *******************************/ - -:- multifile - prolog:message/3. - -prolog:message(http_dispatch(ambiguous_id(ID, _List, Selected))) --> - [ 'HTTP dispatch: ambiguous handler ID ~q (selected ~q)'-[ID, Selected] - ]. -prolog:message(http_dispatch(prefix(_Path))) --> - [ 'HTTP dispatch: prefix(Path) is replaced by the option prefix'-[] - ]. - - - /******************************* - * XREF * - *******************************/ - -:- multifile - prolog:meta_goal/2. -:- dynamic - prolog:meta_goal/2. - -prolog:meta_goal(http_handler(_, G, _), [G+1]). -prolog:meta_goal(http_current_handler(_, G), [G+1]). - - - /******************************* - * EDIT * - *******************************/ - -% Allow edit(Location) to edit the implementation for an HTTP location. - -:- multifile - prolog_edit:locate/3. - -prolog_edit:locate(Path, Spec, Location) :- - atom(Path), - Pred = _M:_H, - http_current_handler(Path, Pred), - closure_name_arity(Pred, 1, PI), - prolog_edit:locate(PI, Spec, Location). - -closure_name_arity(M:Term, Extra, M:Name/Arity) :- !, - callable(Term), - functor(Term, Name, Arity0), - Arity is Arity0 + Extra. -closure_name_arity(Term, Extra, Name/Arity) :- - callable(Term), - functor(Term, Name, Arity0), - Arity is Arity0 + Extra. - - - /******************************* - * CACHE CLEANUP * - *******************************/ - -:- listen(settings(changed(http:prefix, _, _)), - next_generation). - -:- multifile - user:message_hook/3. -:- dynamic - user:message_hook/3. - -user:message_hook(make(done(Reload)), _Level, _Lines) :- - Reload \== [], - next_generation, - fail. diff --git a/packages/http/http_error.c b/packages/http/http_error.c deleted file mode 100644 index 5a7d1be23..000000000 --- a/packages/http/http_error.c +++ /dev/null @@ -1,171 +0,0 @@ -/* $Id$ - - Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: wielemak@science.uva.nl - WWW: http://www.swi-prolog.org - Copyright (C): 2007, University of Amsterdam - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 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 - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser 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 -*/ - -#include -#include - -#define O_DEBUG 1 - -static functor_t FUNCTOR_error2; /* error(Formal, Context) */ -static functor_t FUNCTOR_type_error2; /* type_error(Term, Expected) */ -static functor_t FUNCTOR_domain_error2; /* domain_error(Term, Expected) */ -static functor_t FUNCTOR_permission_error3; /* permission_error(Op, Type, Term) */ -static functor_t FUNCTOR_existence_error2; /* existence_error(Type, Term) */ -static int debuglevel = 0; - -#define MKFUNCTOR(name, arity) PL_new_functor(PL_new_atom(name), arity) - -#ifdef O_DEBUG -#define DEBUG(n, g) if ( debuglevel >= n ) g -#else -#define DEBUG(n, g) (void)0 -#endif - - -#ifdef O_DEBUG -static foreign_t -http_stream_debug(term_t level) -{ return PL_get_integer(level, &debuglevel); -} -#endif - - - /******************************* - * ERRORS * - *******************************/ - -static int -type_error(term_t actual, const char *expected) -{ term_t ex; - - if ( (ex = PL_new_term_ref()) && - PL_unify_term(ex, - PL_FUNCTOR, FUNCTOR_error2, - PL_FUNCTOR, FUNCTOR_type_error2, - PL_CHARS, expected, - PL_TERM, actual, - PL_VARIABLE) ) - return PL_raise_exception(ex); - - return FALSE; -} - - -static int -domain_error(term_t actual, const char *domain) -{ term_t ex; - - if ( (ex = PL_new_term_ref()) && - PL_unify_term(ex, - PL_FUNCTOR, FUNCTOR_error2, - PL_FUNCTOR, FUNCTOR_domain_error2, - PL_CHARS, domain, - PL_TERM, actual, - PL_VARIABLE) ) - return PL_raise_exception(ex); - - return FALSE; -} - - -static int -existence_error(term_t actual, const char *type) -{ term_t ex; - - if ( (ex = PL_new_term_ref()) && - PL_unify_term(ex, - PL_FUNCTOR, FUNCTOR_error2, - PL_FUNCTOR, FUNCTOR_existence_error2, - PL_CHARS, type, - PL_TERM, actual, - PL_VARIABLE) ) - return PL_raise_exception(ex); - - return FALSE; -} - - -static int -permission_error(const char *op, const char *objtype, term_t obj) -{ term_t ex; - - if ( (ex = PL_new_term_ref()) && - PL_unify_term(ex, - PL_FUNCTOR, FUNCTOR_error2, - PL_FUNCTOR, FUNCTOR_permission_error3, - PL_CHARS, op, - PL_CHARS, objtype, - PL_TERM, obj, - PL_VARIABLE) ) - return PL_raise_exception(ex); - - return FALSE; -} - - -static int -instantiation_error() -{ term_t ex; - - if ( (ex = PL_new_term_ref()) && - PL_unify_term(ex, - PL_FUNCTOR, FUNCTOR_error2, - PL_CHARS, "instantiation_error", - PL_VARIABLE) ) - return PL_raise_exception(ex); - - return FALSE; -} - - -static int -get_int_ex(term_t t, int *i) -{ if ( PL_get_integer(t, i) ) - return TRUE; - - return type_error(t, "integer"); -} - - -static int -get_bool_ex(term_t t, int *i) -{ if ( PL_get_bool(t, i) ) - return TRUE; - - return type_error(t, "boolean"); -} - - -static void -init_errors() -{ FUNCTOR_error2 = MKFUNCTOR("error", 2); - FUNCTOR_type_error2 = MKFUNCTOR("type_error", 2); - FUNCTOR_domain_error2 = MKFUNCTOR("domain_error", 2); - FUNCTOR_existence_error2 = MKFUNCTOR("existence_error", 2); - FUNCTOR_permission_error3 = MKFUNCTOR("permission_error", 3); - -#ifdef O_DEBUG - PL_register_foreign("http_stream_debug", 1, http_stream_debug, 0); -#endif -} diff --git a/packages/http/http_error.pl b/packages/http/http_error.pl deleted file mode 100644 index 7c2498044..000000000 --- a/packages/http/http_error.pl +++ /dev/null @@ -1,100 +0,0 @@ -/* $Id$ - - Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: wielemak@science.uva.nl - WWW: http://www.swi-prolog.org - Copyright (C): 1985-2005, University of Amsterdam - - 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 Lesser 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 - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(http_error, - [ - ]). -:- use_module(library(debug)). -:- use_module(library(prolog_stack)). - -/** Decorate uncaught exceptions with stack-trace - -This module decorates uncaught exceptions of the user code with a full -stack-trace. It is based on a hook introduced in SWI-Prolog 5.6.5. -Please note that although loading this module greatly simplifies -debugging, it also provides clues for hackers on how to compromise your -site. The more information you give them, the easier it is to break into -your server! - -To use this file, simply load it. - -@author Jan Wielemaker -*/ - -:- multifile - user:prolog_exception_hook/4. -:- dynamic - user:prolog_exception_hook/4. - -guard(httpd_wrapper:call_handler/6). % old version -guard(httpd_wrapper:wrapper/5). -guard(httpd_wrapper:handler_with_output_to/5). - -user:prolog_exception_hook(error(E, context(Ctx0,Msg)), - error(E, context(prolog_stack(Stack),Msg)), - Fr, Guard) :- - Guard \== none, - prolog_frame_attribute(Guard, predicate_indicator, Goal), - debug(http_error, 'Got exception ~p (Ctx0=~p, Catcher=~p)', - [E, Ctx0, Goal]), - guard(Goal), - get_prolog_backtrace(Fr, 50, Stack0), - debug(http_error, 'Stack = ~w', [Stack0]), - clean_stack(Stack0, Stack). - -clean_stack([], []). -clean_stack([H|_], [H]) :- - guard_frame(H), !. -clean_stack([H|T0], [H|T]) :- - clean_stack(T0, T). - -guard_frame(frame(_,clause(ClauseRef, _))) :- - nth_clause(M:Head, _, ClauseRef), - functor(Head, Name, Arity), - guard(M:Name/Arity). - - - /******************************* - * MESSAGES * - *******************************/ - -:- multifile - prolog:message/3. - -prolog:message(error(Error, context(Stack, Message))) --> - { is_stack(Stack, Frames) }, !, - '$messages':translate_message(error(Error, context(_, Message))), - [ nl, 'In:', nl ], - prolog_stack:message(Frames). - -is_stack(Stack, Frames) :- - nonvar(Stack), - Stack = prolog_stack(Frames). diff --git a/packages/http/http_exception.pl b/packages/http/http_exception.pl deleted file mode 100644 index 9cd79bd12..000000000 --- a/packages/http/http_exception.pl +++ /dev/null @@ -1,112 +0,0 @@ -/* Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: J.Wielemaker@uva.nl - WWW: http://www.swi-prolog.org - Copyright (C): 2009, University of Amsterdam - - 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 library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(http_exception, - [ map_exception_to_http_status/3 - ]). - -/** Internal module of the HTTP server - -@see http_header.pl, http_wrapper.pl -*/ - -%% map_exception_to_http_status(+Exception, -Reply, -HdrExtra) -% -% Map certain defined exceptions to special reply codes. The -% http(not_modified) provides backward compatibility to -% http_reply(not_modified). - -map_exception_to_http_status(http(not_modified), - not_modified, - [connection('Keep-Alive')]) :- !. -map_exception_to_http_status(http_reply(Reply), - Reply, - [connection(Close)]) :- !, - ( keep_alive(Reply) - -> Close = 'Keep-Alive' - ; Close = close - ). -map_exception_to_http_status(http_reply(Reply, HdrExtra0), - Reply, - HdrExtra) :- !, - ( memberchk(close(_), HdrExtra0) - -> HdrExtra = HdrExtra0 - ; HdrExtra = [close(Close)|HdrExtra0], - ( keep_alive(Reply) - -> Close = 'Keep-Alive' - ; Close = close - ) - ). -map_exception_to_http_status(error(existence_error(http_location, Location), _), - not_found(Location), - [connection(close)]) :- !. -map_exception_to_http_status(error(permission_error(_, http_location, Location), _), - forbidden(Location), - [connection(close)]) :- !. -map_exception_to_http_status(error(threads_in_pool(_Pool), _), - busy, - [connection(close)]) :- !. -map_exception_to_http_status(E, - resource_error(E), - [connection(close)]) :- - resource_error(E), !. -map_exception_to_http_status(E, - bad_request(E), - [connection(close)]) :- - bad_request_error(E), !. -map_exception_to_http_status(E, - server_error(E), - [connection(close)]). - -resource_error(error(resource_error(_), _)). - -bad_request_error(error(domain_error(http_request, _), _)). - -%% keep_alive(+Reply) is semidet. -% -% If true for Reply, the default is to keep the connection open. - -keep_alive(not_modified). -keep_alive(file(_Type, _File)). -keep_alive(tmp_file(_Type, _File)). -keep_alive(stream(_In, _Len)). -keep_alive(cgi_stream(_In, _Len)). - - - /******************************* - * IDE SUPPORT * - *******************************/ - -% See library('trace/exceptions') - -:- multifile - prolog:general_exception/2. - -prolog:general_exception(http_reply(_), http_reply(_)). -prolog:general_exception(http_reply(_,_), http_reply(_,_)). diff --git a/packages/http/http_header.pl b/packages/http/http_header.pl deleted file mode 100644 index 1ee2559f5..000000000 --- a/packages/http/http_header.pl +++ /dev/null @@ -1,1519 +0,0 @@ -/* $Id$ - - Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: J.Wielemaker@uva.nl - WWW: http://www.swi-prolog.org - Copyright (C): 1985-2009, University of Amsterdam - - 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 Lesser 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 - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(http_header, - [ http_read_request/2, % +Stream, -Request - http_read_reply_header/2, % +Stream, -Reply - http_reply/2, % +What, +Stream - http_reply/3, % +What, +Stream, +HdrExtra - http_reply/4, % +What, +Stream, +HdrExtra, -Code - http_reply_header/3, % +Stream, +What, +HdrExtra - - http_timestamp/2, % +Time, -HTTP string - - http_post_data/3, % +Stream, +Data, +HdrExtra - - http_read_header/2, % +Fd, -Header - http_parse_header/2, % +Codes, -Header - http_join_headers/3, % +Default, +InHdr, -OutHdr - http_update_encoding/3, % +HeaderIn, -Encoding, -HeaderOut - http_update_connection/4, % +HeaderIn, +Request, -Connection, -HeaderOut - http_update_transfer/4 % +HeaderIn, +Request, -Transfer, -HeaderOut - ]). -:- use_module(library(readutil)). -:- use_module(library(debug)). -:- use_module(library(lists)). -:- use_module(library(url)). -:- use_module(library(memfile)). -:- use_module(library(settings)). -:- use_module(library(error)). -:- use_module(library(ctypes)). -:- use_module(dcg_basics). -:- use_module(html_write). -:- use_module(http_exception). -:- use_module(mimetype). -:- use_module(mimepack). - -% see http_update_transfer/4. - -:- setting(http:chunked_transfer, oneof([never,on_request,if_possible]), - on_request, 'When to use Transfer-Encoding: Chunked'). - - - /******************************* - * READ REQUEST * - *******************************/ - -%% http_read_request(+FdIn:stream, -Request) is det. -% -% Read an HTTP request-header from FdIn and return the broken-down -% request fields as +Name(+Value) pairs in a list. Request is -% unified to =end_of_file= if FdIn is at the end of input. - -http_read_request(In, Request) :- - read_line_to_codes(In, Codes), - ( Codes == end_of_file - -> debug(http(header), 'end-of-file', []), - Request = end_of_file - ; debug(http(header), 'First line: ~s~n', [Codes]), - Request = [input(In)|Request1], - phrase(request(In, Request1), Codes), - ( Request1 = [unknown(Text)|_] - -> atom_codes(S, Text), - syntax_error(http_request(S)) - ; true - ) - ). - - -%% http_read_reply_header(+FdIn, -Reply) -% -% Read the HTTP reply header. Throws an exception if the current -% input does not contain a valid reply header. - -http_read_reply_header(In, [input(In)|Reply]) :- - read_line_to_codes(In, Codes), - ( Codes == end_of_file - -> debug(http(header), 'end-of-file', []), - throw(error(syntax(http_reply_header, end_of_file), _)) - ; debug(http(header), 'First line: ~s~n', [Codes]), - ( phrase(reply(In, Reply), Codes) - -> true - ; atom_codes(Header, Codes), - syntax_error(http_reply_header(Header)) - ) - ). - - - /******************************* - * FORMULATE REPLY * - *******************************/ - -%% http_reply(+Data, +Out:stream) is det. -%% http_reply(+Data, +Out:stream, +HdrExtra) is det. -% -% Data is one of -% -% * html(HTML) -% HTML tokens as produced by html//1 from html_write.pl -% -% * file(+MimeType, +FileName) -% Reply content of FileName using MimeType -% -% * file(+MimeType, +FileName, +Range) -% Reply partial content of FileName with given MimeType -% -% * tmp_file(+MimeType, +FileName) -% Same as =file=, but do not include modification time -% -% * stream(+In, +Len) -% Reply content of stream. -% -% * cgi_stream(+In, +Len) -% Reply content of stream, which should start with an -% HTTP header, followed by a blank line. This is the -% typical output from a CGI script. -% -% * Status -% HTTP status report and defined by http_status_reply/3. -% -% @param HdrExtra provides additional reply-header fields, encoded -% as Name(Value). It can also contain a field -% content_length(-Len) to _retrieve_ the -% value of the Content-length header that is replied. -% -% @tbd Complete documentation - -http_reply(What, Out) :- - http_reply(What, Out, [connection(close)], _). - -http_reply(Data, Out, HdrExtra) :- - http_reply(Data, Out, HdrExtra, _Code). - -http_reply(Data, Out, HdrExtra, Code) :- - byte_count(Out, C0), - catch(http_reply_data(Data, Out, HdrExtra, Code), E, true), !, - ( var(E) - -> true - ; E = error(io_error(write, _), _) - -> byte_count(Out, C1), - Sent is C1 - C0, - throw(error(http_write_short(Data, Sent), _)) - ; map_exception_to_http_status(E, Status, NewHdr), - http_status_reply(Status, Out, NewHdr, Code) - ). -http_reply(Status, Out, HdrExtra, Code) :- - http_status_reply(Status, Out, HdrExtra, Code). - - -%% http_reply_data(+Data, +Out, +HdrExtra, -Code) is semidet. -% -% Fails if Data is not a defined reply-data format, but a status -% term. See http_reply/3 and http_status_reply/3. -% -% @error Various I/O errors. - -http_reply_data(html(HTML), Out, HrdExtra, Code) :- !, - phrase(reply_header(html(HTML), HrdExtra, Code), Header), - format(Out, '~s', [Header]), - print_html(Out, HTML). -http_reply_data(file(Type, File), Out, HrdExtra, Code) :- !, - phrase(reply_header(file(Type, File), HrdExtra, Code), Header), - reply_file(Out, File, Header). -http_reply_data(file(Type, File, Range), Out, HrdExtra, Code) :- !, - phrase(reply_header(file(Type, File, Range), HrdExtra, Code), Header), - reply_file_range(Out, File, Header, Range). -http_reply_data(tmp_file(Type, File), Out, HrdExtra, Code) :- !, - phrase(reply_header(tmp_file(Type, File), HrdExtra, Code), Header), - reply_file(Out, File, Header). -http_reply_data(stream(In, Len), Out, HdrExtra, Code) :- !, - phrase(reply_header(cgi_data(Len), HdrExtra, Code), Header), - copy_stream(Out, In, Header, 0, end). -http_reply_data(cgi_stream(In, Len), Out, HrdExtra, Code) :- !, - http_read_header(In, CgiHeader), - seek(In, 0, current, Pos), - Size is Len - Pos, - http_join_headers(HrdExtra, CgiHeader, Hdr2), - phrase(reply_header(cgi_data(Size), Hdr2, Code), Header), - copy_stream(Out, In, Header, 0, end). - -reply_file(Out, File, Header) :- - setup_call_cleanup(open(File, read, In, [type(binary)]), - copy_stream(Out, In, Header, 0, end), - close(In)). - -reply_file_range(Out, File, Header, bytes(From, To)) :- !, - setup_call_cleanup(open(File, read, In, [type(binary)]), - copy_stream(Out, In, Header, From, To), - close(In)). - -copy_stream(Out, In, Header, From, To) :- - ( From == 0 - -> true - ; seek(In, From, bof, _) - ), - peek_byte(In, _), - format(Out, '~s', [Header]), - ( To == end - -> copy_stream_data(In, Out) - ; Len is To - From, - copy_stream_data(In, Out, Len) - ), - flush_output(Out). - - -%% http_status_reply(+Status, +Out, +HdrExtra, -Code) is det. -% -% Emit HTML non-200 status reports. Such requests are always sent -% as UTF-8 documents. - -http_status_reply(Status, Out, HdrExtra, Code) :- - setup_call_cleanup(set_stream(Out, encoding(utf8)), - status_reply(Status, Out, HdrExtra, Code), - set_stream(Out, encoding(octet))), !. - - -status_reply(no_content, Out, HrdExtra, Code) :- !, - phrase(reply_header(status(no_content), HrdExtra, Code), Header), - format(Out, '~s', [Header]), - flush_output(Out). -status_reply(created(Location), Out, HrdExtra, Code) :- !, - phrase(page([ title('201 Created') - ], - [ h1('Created'), - p(['The document was created ', - a(href(Location), ' Here') - ]), - \address - ]), - HTML), - phrase(reply_header(created(Location, HTML), HrdExtra, Code), Header), - format(Out, '~s', [Header]), - print_html(Out, HTML). -status_reply(moved(To), Out, HrdExtra, Code) :- !, - phrase(page([ title('301 Moved Permanently') - ], - [ h1('Moved Permanently'), - p(['The document has moved ', - a(href(To), ' Here') - ]), - \address - ]), - HTML), - phrase(reply_header(moved(To, HTML), HrdExtra, Code), Header), - format(Out, '~s', [Header]), - print_html(Out, HTML). -status_reply(moved_temporary(To), Out, HrdExtra, Code) :- !, - phrase(page([ title('302 Moved Temporary') - ], - [ h1('Moved Temporary'), - p(['The document is currently ', - a(href(To), ' Here') - ]), - \address - ]), - HTML), - phrase(reply_header(moved_temporary(To, HTML), - HrdExtra, Code), Header), - format(Out, '~s', [Header]), - print_html(Out, HTML). -status_reply(see_other(To),Out,HdrExtra, Code) :- !, - phrase(page([ title('303 See Other') - ], - [ h1('See Other'), - p(['See other document ', - a(href(To), ' Here') - ]), - \address - ]), - HTML), - phrase(reply_header(see_other(To, HTML), HdrExtra, Code), Header), - format(Out, '~s', [Header]), - print_html(Out, HTML). -status_reply(bad_request(ErrorTerm), Out, HdrExtra, Code) :- !, - '$messages':translate_message(ErrorTerm, Lines, []), - phrase(page([ title('400 Bad Request') - ], - [ h1('Bad Request'), - p(\html_message_lines(Lines)), - \address - ]), - HTML), - phrase(reply_header(status(bad_request, HTML), - HdrExtra, Code), Header), - format(Out, '~s', [Header]), - print_html(Out, HTML). -status_reply(not_found(URL), Out, HrdExtra, Code) :- !, - phrase(page([ title('404 Not Found') - ], - [ h1('Not Found'), - p(['The requested URL ', tt(URL), - ' was not found on this server' - ]), - \address - ]), - HTML), - phrase(reply_header(status(not_found, HTML), HrdExtra, Code), Header), - format(Out, '~s', [Header]), - print_html(Out, HTML). -status_reply(forbidden(URL), Out, HrdExtra, Code) :- !, - phrase(page([ title('403 Forbidden') - ], - [ h1('Forbidden'), - p(['You don\'t have permission to access ', URL, - ' on this server' - ]), - \address - ]), - HTML), - phrase(reply_header(status(forbidden, HTML), HrdExtra, Code), Header), - format(Out, '~s', [Header]), - print_html(Out, HTML). -status_reply(authorise(Method, Realm), Out, HrdExtra, Code) :- !, - phrase(page([ title('401 Authorization Required') - ], - [ h1('Authorization Required'), - p(['This server could not verify that you ', - 'are authorized to access the document ', - 'requested. Either you supplied the wrong ', - 'credentials (e.g., bad password), or your ', - 'browser doesn\'t understand how to supply ', - 'the credentials required.' - ]), - \address - ]), - HTML), - phrase(reply_header(authorise(Method, Realm, HTML), - HrdExtra, Code), Header), - format(Out, '~s', [Header]), - print_html(Out, HTML). -status_reply(not_modified, Out, HrdExtra, Code) :- !, - phrase(reply_header(status(not_modified), HrdExtra, Code), Header), - format(Out, '~s', [Header]), - flush_output(Out). -status_reply(server_error(ErrorTerm), Out, HrdExtra, Code) :- - '$messages':translate_message(ErrorTerm, Lines, []), - phrase(page([ title('500 Internal server error') - ], - [ h1('Internal server error'), - p(\html_message_lines(Lines)), - \address - ]), - HTML), - phrase(reply_header(status(server_error, HTML), - HrdExtra, Code), Header), - format(Out, '~s', [Header]), - print_html(Out, HTML). -status_reply(not_acceptable(WhyHTML), Out, HdrExtra, Code) :- !, - phrase(page([ title('406 Not Acceptable') - ], - [ h1('Not Acceptable'), - WhyHTML, - \address - ]), - HTML), - phrase(reply_header(status(not_acceptable, HTML), HdrExtra, Code), Header), - format(Out, '~s', [Header]), - print_html(Out, HTML). -status_reply(unavailable(WhyHTML), Out, HdrExtra, Code) :- !, - phrase(page([ title('503 Service Unavailable') - ], - [ h1('Service Unavailable'), - WhyHTML, - \address - ]), - HTML), - phrase(reply_header(status(service_unavailable, HTML), HdrExtra, Code), Header), - format(Out, '~s', [Header]), - print_html(Out, HTML). -status_reply(resource_error(ErrorTerm), Out, HdrExtra, Code) :- !, - '$messages':translate_message(ErrorTerm, Lines, []), - status_reply(unavailable(p(\html_message_lines(Lines))), - Out, HdrExtra, Code). -status_reply(busy, Out, HdrExtra, Code) :- !, - HTML = p(['The server is temporarily out of resources, ', - 'please try again later']), - http_status_reply(unavailable(HTML), Out, HdrExtra, Code). - - -html_message_lines([]) --> - []. -html_message_lines([nl|T]) --> !, - html([br([])]), - html_message_lines(T). -html_message_lines([flush]) --> - []. -html_message_lines([Fmt-Args|T]) --> !, - { format(string(S), Fmt, Args) - }, - html([S]), - html_message_lines(T). -html_message_lines([Fmt|T]) --> !, - { format(string(S), Fmt, []) - }, - html([S]), - html_message_lines(T). - -%% http_join_headers(+Default, +Header, -Out) -% -% Append headers from Default to Header if they are not -% already part of it. - -http_join_headers([], H, H). -http_join_headers([H|T], Hdr0, Hdr) :- - functor(H, N, A), - functor(H2, N, A), - member(H2, Hdr0), !, - http_join_headers(T, Hdr0, Hdr). -http_join_headers([H|T], Hdr0, [H|Hdr]) :- - http_join_headers(T, Hdr0, Hdr). - - -%% http_update_encoding(+HeaderIn, -Encoding, -HeaderOut) -% -% Allow for rewrite of the header, adjusting the encoding. We -% distinguish three options. If the user announces `text', we -% always use UTF-8 encoding. If the user announces charset=utf-8 -% we use UTF-8 and otherwise we use octet (raw) encoding. -% Alternatively we could dynamically choose for ASCII, ISO-Latin-1 -% or UTF-8. - -http_update_encoding(Header0, utf8, [content_type(Type)|Header]) :- - select(content_type(Type0), Header0, Header), - sub_atom(Type0, 0, _, _, 'text/'), !, - ( sub_atom(Type0, S, _, _, ';') - -> sub_atom(Type0, 0, S, _, B) - ; B = Type0 - ), - atom_concat(B, '; charset=UTF-8', Type). -http_update_encoding(Header, Encoding, Header) :- - memberchk(content_type(Type), Header), - ( ( sub_atom(Type, _, _, _, 'UTF-8') - ; sub_atom(Type, _, _, _, 'utf-8') - ) - -> Encoding = utf8 - ; mime_type_encoding(Type, Encoding) - ). -http_update_encoding(Header, octet, Header). - -%% mime_type_encoding(+MimeType, -Encoding) is semidet. -% -% Encoding is the (default) character encoding for MimeType. - -mime_type_encoding('application/json', utf8). -mime_type_encoding('application/jsonrequest', utf8). - - -%% http_update_connection(+CGIHeader, +Request, -Connection, -Header) -% -% Merge keep-alive information from Request and CGIHeader into -% Header. - -http_update_connection(CgiHeader, Request, Connect, [connection(Connect)|Rest]) :- - select(connection(CgiConn), CgiHeader, Rest), !, - connection(Request, ReqConnection), - join_connection(ReqConnection, CgiConn, Connect). -http_update_connection(CgiHeader, Request, Connect, [connection(Connect)|CgiHeader]) :- - connection(Request, Connect). - -join_connection(Keep1, Keep2, Connection) :- - ( downcase_atom(Keep1, 'keep-alive'), - downcase_atom(Keep2, 'keep-alive') - -> Connection = 'Keep-Alive' - ; Connection = close - ). - - -%% connection(+Header, -Connection) -% -% Extract the desired connection from a header. - -connection(Header, Close) :- - ( memberchk(connection(Connection), Header) - -> Close = Connection - ; memberchk(http_version(1-X), Header), - X >= 1 - -> Close = 'Keep-Alive' - ; Close = close - ). - - -%% http_update_transfer(+Request, +CGIHeader, -Transfer, -Header) -% -% Decide on the transfer encoding from the Request and the CGI -% header. The behaviour depends on the setting -% http:chunked_transfer. If =never=, even explitic requests are -% ignored. If =on_request=, chunked encoding is used if requested -% through the CGI header and allowed by the client. If -% =if_possible=, chunked encoding is used whenever the client -% allows for it, which is interpreted as the client supporting -% HTTP 1.1 or higher. -% -% Chunked encoding is more space efficient and allows the client -% to start processing partial results. The drawback is that errors -% lead to incomplete pages instead of a nicely formatted complete -% page. - -http_update_transfer(Request, CgiHeader, Transfer, Header) :- - setting(http:chunked_transfer, When), - http_update_transfer(When, Request, CgiHeader, Transfer, Header). - -http_update_transfer(never, _, CgiHeader, none, Header) :- !, - delete(CgiHeader, transfer_encoding(_), Header). -http_update_transfer(_, Request, CgiHeader, Transfer, Header) :- - select(transfer_encoding(CgiTransfer), CgiHeader, Rest), !, - transfer(Request, ReqConnection), - join_transfer(ReqConnection, CgiTransfer, Transfer), - ( Transfer == none - -> Header = Rest - ; Header = [transfer_encoding(Transfer)|Rest] - ). -http_update_transfer(if_possible, Request, CgiHeader, Transfer, Header) :- - transfer(Request, Transfer), - Transfer \== none, !, - Header = [transfer_encoding(Transfer)|CgiHeader]. -http_update_transfer(_, _, CgiHeader, none, CgiHeader). - -join_transfer(chunked, chunked, chunked) :- !. -join_transfer(_, _, none). - - -%% transfer(+Header, -Connection) -% -% Extract the desired connection from a header. - -transfer(Header, Transfer) :- - ( memberchk(transfer_encoding(Transfer0), Header) - -> Transfer = Transfer0 - ; memberchk(http_version(1-X), Header), - X >= 1 - -> Transfer = chunked - ; Transfer = none - ). - - -%% content_length_in_encoding(+Encoding, +In, -Bytes) -% -% Determine hom much bytes are required to represent the data from -% stream In using the given encoding. Fails if the data cannot be -% represented with the given encoding. - -content_length_in_encoding(Enc, Stream, Bytes) :- - open_null_stream(Out), - set_stream(Out, encoding(Enc)), - stream_property(Stream, position(Here)), - ( catch((copy_stream_data(Stream, Out), - flush_output(Out)), _, fail) - -> byte_count(Out, Bytes0) - ; true - ), - close(Out), - set_stream_position(Stream, Here), - ( var(Bytes0) - -> fail - ; Bytes = Bytes0 - ). - - - /******************************* - * POST SUPPORT * - *******************************/ - -%% http_post_data(+Data, +Out:stream, +HdrExtra) is det. -% -% Send data on behalf on an HTTP POST request. This predicate is -% normally called by http_post/4 from http_client.pl to send the -% POST data to the server. Data is one of: -% -% * html(+Tokens) -% Result of html//1 from html_write.pl -% -% * file(+File) -% Send contents of a file. Mime-type is determined by -% file_mime_type/2. -% -% * file(+Type, +File) -% Send file with content of indicated mime-type. -% -% * codes(+Codes) -% As string(text/plain, Codes). -% -% * codes(+Type, +Codes) -% Send Codes using the indicated MIME-type. -% -% * cgi_stream(+Stream, +Len) -% Read the input from Stream which, like CGI data starts with a partial -% HTTP header. The fields of this header are merged with the provided -% HdrExtra fields. The first Len characters of Stream are used. -% -% * form(+ListOfParameter) -% Send data of the MIME type application/x-www-form-urlencoded as -% produced by browsers issuing a POST request from an HTML form. -% ListOfParameter is a list of Name=Value or Name(Value). -% -% * form_data(+ListOfData) -% Send data of the MIME type multipart/form-data. ListOfData is the same -% as for the List alternative described below. -% -% * List -% If the argument is a plain list, it is sent using the MIME type -% multipart/mixed and packed using mime_pack/3. See mime_pack/3 -% for details on the argument format. - -:- multifile - http_client:post_data_hook/3. - -http_post_data(Data, Out, HdrExtra) :- - http_client:post_data_hook(Data, Out, HdrExtra), !. -http_post_data(html(HTML), Out, HdrExtra) :- - phrase(post_header(html(HTML), HdrExtra), Header), - format(Out, '~s', [Header]), - print_html(Out, HTML). -http_post_data(file(File), Out, HdrExtra) :- !, - ( file_mime_type(File, Type) - -> true - ; Type = text/plain - ), - http_post_data(file(Type, File), Out, HdrExtra). -http_post_data(file(Type, File), Out, HdrExtra) :- !, - phrase(post_header(file(Type, File), HdrExtra), Header), - format(Out, '~s', [Header]), - open(File, read, In, [type(binary)]), - call_cleanup(copy_stream_data(In, Out), - close(In)). -http_post_data(codes(Codes), Out, HdrExtra) :- !, - http_post_data(codes(text/plain, Codes), Out, HdrExtra). -http_post_data(codes(Type, Codes), Out, HdrExtra) :- !, - phrase(post_header(codes(Type, Codes), HdrExtra), Header), - format(Out, '~s~s', [Header, Codes]). -http_post_data(cgi_stream(In, _Len), Out, HdrExtra) :- !, - debug(obsolete, 'Obsolete 2nd argument in cgi_stream(In,Len)', []), - http_post_data(cgi_stream(In), Out, HdrExtra). -http_post_data(cgi_stream(In), Out, HdrExtra) :- !, - http_read_header(In, Header0), - http_update_encoding(Header0, Encoding, Header), - content_length_in_encoding(Encoding, In, Size), - http_join_headers(HdrExtra, Header, Hdr2), - phrase(post_header(cgi_data(Size), Hdr2), HeaderText), - format(Out, '~s', [HeaderText]), - set_stream(Out, encoding(Encoding)), - call_cleanup(copy_stream_data(In, Out), - set_stream(Out, encoding(octet))). -http_post_data(form(Fields), Out, HdrExtra) :- !, - parse_url_search(Codes, Fields), - length(Codes, Size), - http_join_headers(HdrExtra, - [ content_type('application/x-www-form-urlencoded') - ], Header), - phrase(post_header(cgi_data(Size), Header), HeaderChars), - format(Out, '~s', [HeaderChars]), - format(Out, '~s', [Codes]). -http_post_data(form_data(Data), Out, HdrExtra) :- !, - new_memory_file(MemFile), - open_memory_file(MemFile, write, MimeOut), - mime_pack(Data, MimeOut, Boundary), - close(MimeOut), - size_memory_file(MemFile, Size), - format(string(ContentType), 'multipart/form-data; boundary=~w', [Boundary]), - http_join_headers(HdrExtra, - [ mime_version('1.0'), - content_type(ContentType) - ], Header), - phrase(post_header(cgi_data(Size), Header), HeaderChars), - format(Out, '~s', [HeaderChars]), - open_memory_file(MemFile, read, In), - copy_stream_data(In, Out), - close(In), - free_memory_file(MemFile). -http_post_data(List, Out, HdrExtra) :- % multipart-mixed - is_list(List), !, - new_memory_file(MemFile), - open_memory_file(MemFile, write, MimeOut), - mime_pack(List, MimeOut, Boundary), - close(MimeOut), - size_memory_file(MemFile, Size), - format(string(ContentType), 'multipart/mixed; boundary=~w', [Boundary]), - http_join_headers(HdrExtra, - [ mime_version('1.0'), - content_type(ContentType) - ], Header), - phrase(post_header(cgi_data(Size), Header), HeaderChars), - format(Out, '~s', [HeaderChars]), - open_memory_file(MemFile, read, In), - copy_stream_data(In, Out), - close(In), - free_memory_file(MemFile). - -%% post_header(+Data, +HeaderExtra)// -% -% Generate the POST header, emitting HeaderExtra, followed by the -% HTTP Content-length and Content-type fields. - -post_header(html(Tokens), HdrExtra) --> - header_fields(HdrExtra, Len), - content_length(html(Tokens), Len), - content_type(text/html), - "\r\n". -post_header(file(Type, File), HdrExtra) --> - header_fields(HdrExtra, Len), - content_length(file(File), Len), - content_type(Type), - "\r\n". -post_header(cgi_data(Size), HdrExtra) --> - header_fields(HdrExtra, Len), - content_length(Size, Len), - "\r\n". -post_header(codes(Type, Codes), HdrExtra) --> - header_fields(HdrExtra, Len), - content_length(ascii_string(Codes), Len), - content_type(Type), - "\r\n". - - - /******************************* - * OUTPUT HEADER DCG * - *******************************/ - -%% http_reply_header(+Out:stream, +What, +HdrExtra) is det. -% -% Create a reply header using reply_header//2 and send it to -% Stream. - -http_reply_header(Out, What, HdrExtra) :- - phrase(reply_header(What, HdrExtra, _Code), String), !, - format(Out, '~s', [String]). - - -reply_header(string(String), HdrExtra, Code) --> - reply_header(string(text/plain, String), HdrExtra, Code). -reply_header(string(Type, String), HdrExtra, Code) --> - vstatus(ok, Code), - date(now), - header_fields(HdrExtra, CLen), - content_length(ascii_string(String), CLen), - content_type(Type), - "\r\n". -reply_header(html(Tokens), HdrExtra, Code) --> - vstatus(ok, Code), - date(now), - header_fields(HdrExtra, CLen), - content_length(html(Tokens), CLen), - content_type(text/html), - "\r\n". -reply_header(file(Type, File), HdrExtra, Code) --> - vstatus(ok, Code), - date(now), - modified(file(File)), - header_fields(HdrExtra, CLen), - content_length(file(File), CLen), - content_type(Type), - "\r\n". -reply_header(file(Type, File, Range), HdrExtra, Code) --> - vstatus(partial_content, Code), - date(now), - modified(file(File)), - header_fields(HdrExtra, CLen), - content_length(file(File, Range), CLen), - content_type(Type), - "\r\n". -reply_header(tmp_file(Type, File), HdrExtra, Code) --> - vstatus(ok, Code), - date(now), - header_fields(HdrExtra, CLen), - content_length(file(File), CLen), - content_type(Type), - "\r\n". -reply_header(cgi_data(Size), HdrExtra, Code) --> - vstatus(ok, Code), - date(now), - header_fields(HdrExtra, CLen), - content_length(Size, CLen), - "\r\n". -reply_header(chunked_data, HdrExtra, Code) --> - vstatus(ok, Code), - date(now), - header_fields(HdrExtra, _), - ( {memberchk(transfer_encoding(_), HdrExtra)} - -> "" - ; transfer_encoding(chunked) - ), - "\r\n". -reply_header(moved(To, Tokens), HdrExtra, Code) --> - vstatus(moved, Code), - date(now), - header_field('Location', To), - header_fields(HdrExtra, CLen), - content_length(html(Tokens), CLen), - content_type(text/html, utf8), - "\r\n". -reply_header(created(Location, Tokens), HdrExtra, Code) --> - vstatus(moved, Code), - date(now), - header_field('Location', Location), - header_fields(HdrExtra, CLen), - content_length(html(Tokens), CLen), - content_type(text/html, utf8), - "\r\n". -reply_header(moved_temporary(To, Tokens), HdrExtra, Code) --> - vstatus(moved_temporary, Code), - date(now), - header_field('Location', To), - header_fields(HdrExtra, CLen), - content_length(html(Tokens), CLen), - content_type(text/html, utf8), - "\r\n". -reply_header(see_other(To,Tokens),HdrExtra, Code) --> - vstatus(see_other, Code), - date(now), - header_field('Location',To), - header_fields(HdrExtra, CLen), - content_length(html(Tokens), CLen), - content_type(text/html, utf8), - "\r\n". -reply_header(status(Status), HdrExtra, Code) --> % Empty messages: 1xx, 204 and 304 - vstatus(Status, Code), - header_fields(HdrExtra, Clen), - { Clen = 0 }, - "\r\n". -reply_header(status(Status, Tokens), HdrExtra, Code) --> - vstatus(Status, Code), - date(now), - header_fields(HdrExtra, CLen), - content_length(html(Tokens), CLen), - content_type(text/html, utf8), - "\r\n". -reply_header(authorise(Method, Realm, Tokens), HdrExtra, Code) --> - vstatus(authorise, Code), - date(now), - authenticate(Method, Realm), - header_fields(HdrExtra, CLen), - content_length(html(Tokens), CLen), - content_type(text/html, utf8), - "\r\n". - -vstatus(Status, Code) --> - "HTTP/1.1 ", - status_number(Status, Code), - " ", - status_comment(Status), - "\r\n". - -%% status_number(?Status, ?Code)// is semidet. -% -% Parse/generate the HTTP status numbers and return them as a code -% (atom). - -status_number(Status, Code) --> - { var(Status) }, !, - integer(Code), - { status_number(Status, Code) }, !. -status_number(Status, Code) --> - { status_number(Status, Code) }, - integer(Code). - -status_number(continue, 100). -status_number(ok, 200). -status_number(created, 201). -status_number(accepted, 202). -status_number(no_content, 204). -status_number(partial_content, 206). -status_number(moved, 301). -status_number(moved_temporary, 302). -status_number(see_other, 303). -status_number(not_modified, 304). -status_number(bad_request, 400). -status_number(authorise, 401). -status_number(forbidden, 403). -status_number(not_found, 404). -status_number(not_acceptable, 406). -status_number(server_error, 500). -status_number(service_unavailable, 503). - - -%% status_comment(+Code:atom)// is det. -% -% Emit standard HTTP human-readable comment on the reply-status. - -status_comment(continue) --> - "Continue". -status_comment(ok) --> - "OK". -status_comment(created) --> - "Created". -status_comment(accepted) --> - "Accepted". -status_comment(no_content) --> - "No Content". -status_comment(created) --> - "Created". -status_comment(partial_content) --> - "Partial content". -status_comment(moved) --> - "Moved Permanently". -status_comment(moved_temporary) --> - "Moved Temporary". -status_comment(see_other) --> - "See Other". -status_comment(not_modified) --> - "Not Modified". -status_comment(bad_request) --> - "Bad Request". -status_comment(not_found) --> - "Not Found". -status_comment(forbidden) --> - "Forbidden". -status_comment(authorise) --> - "Authorization Required". -status_comment(server_error) --> - "Internal Server Error". -status_comment(service_unavailable) --> - "Service Unavailable". -status_comment(not_acceptable) --> - "Not Acceptable". - -authenticate(Method, '') --> !, - "WWW-Authenticate: ", - atom(Method). -authenticate(Method, Realm) --> - authenticate(Method, ''), - " Realm=\"", atom(Realm), "\"\r\n". - -date(Time) --> - "Date: ", - ( { Time == now } - -> now - ; rfc_date(Time) - ), - "\r\n". - -modified(file(File)) --> !, - { time_file(File, Time) - }, - modified(Time). -modified(Time) --> - "Last-modified: ", - ( { Time == now } - -> now - ; rfc_date(Time) - ), - "\r\n". - - -%% content_length(+Object, ?Len)// is det. -% -% Emit the content-length field and (optionally) the content-range -% field. -% -% @param Len Number of bytes specified - -content_length(file(File, bytes(From, To)), Len) --> !, - { size_file(File, Size), - ( To == end - -> Len is Size - From, - RangeEnd is Size - 1 - ; Len is To+1 - From, % To is index of last byte - RangeEnd = To - ) - }, - content_range(bytes, From, RangeEnd, Size), - content_length(Len, Len). -content_length(Reply, Len) --> - { length_of(Reply, Len) - }, - "Content-Length: ", integer(Len), - "\r\n". - - -length_of(_, Len) :- - nonvar(Len), !. -length_of(ascii_string(String), Len) :- !, - length(String, Len). -length_of(file(File), Len) :- !, - size_file(File, Len). -length_of(html(Tokens), Len) :- !, - html_print_length(Tokens, Len). -length_of(Len, Len). - - -%% content_range(+Unit:atom, +From:int, +RangeEnd:int, +Size:int)// is det -% -% Emit the =|Content-Range|= header for partial content (206) -% replies. - -content_range(Unit, From, RangeEnd, Size) --> - "Content-Range: ", atom(Unit), " ", - integer(From), "-", integer(RangeEnd), "/", integer(Size), - "\r\n". - -transfer_encoding(Encoding) --> - "Transfer-Encoding: ", atom(Encoding), "\r\n". - -content_type(Type) --> - content_type(Type, _). - -content_type(Type, Charset) --> - ctype(Type), - charset(Charset), - "\r\n". - -ctype(Main/Sub) --> !, - "Content-Type: ", - atom(Main), - "/", - atom(Sub). -ctype(Type) --> !, - "Content-Type: ", - atom(Type). - -charset(Var) --> - { var(Var) }, !. -charset(utf8) --> !, - "; charset=UTF-8". -charset(CharSet) --> - "; charset=", - atom(CharSet). - -%% header_field(-Name, -Value)// is det. -%% header_field(+Name, +Value) is det. -% -% Process an HTTP request property. Request properties appear as a -% single line in an HTTP header. - -header_field(Name, Value) --> - { var(Name) }, !, % parsing - field_name(Name), - ":", - whites, - read_field_value(ValueChars), - blanks_to_nl, !, - { field_to_prolog(Name, ValueChars, Value) - -> true - ; atom_codes(Value, ValueChars), - domain_error(Name, Value) - }. -header_field(Name, Value) --> - field_name(Name), - ": ", - field_value(Value), - "\r\n". - -%% read_field_value(-Codes)// -% -% Read a field eagerly upto the next whitespace - -read_field_value([H|T]) --> - [H], - { \+ code_type(H, space) }, !, - read_field_value(T). -read_field_value([]) --> - "". -read_field_value([H|T]) --> - [H], - read_field_value(T). - - -field_to_prolog(content_length, ValueChars, ContentLength) :- !, - number_codes(ContentLength, ValueChars). -field_to_prolog(cookie, ValueChars, Cookies) :- !, - debug(cookie, 'Cookie: ~s', [ValueChars]), - phrase(cookies(Cookies), ValueChars). -field_to_prolog(set_cookie, ValueChars, SetCookie) :- !, - debug(cookie, 'SetCookie: ~s', [ValueChars]), - phrase(set_cookie(SetCookie), ValueChars). -field_to_prolog(host, ValueChars, Host) :- !, - ( append(HostChars, [0':|PortChars], ValueChars), % 0' - catch(number_codes(Port, PortChars), _, fail) - -> atom_codes(HostName, HostChars), - Host = HostName:Port - ; atom_codes(Host, ValueChars) - ). -field_to_prolog(range, ValueChars, Range) :- - phrase(range(Range), ValueChars), !. -field_to_prolog(_, ValueChars, Atom) :- - atom_codes(Atom, ValueChars). - -field_value(set_cookie(Name, Value, Options)) --> !, - atom(Name), "=", atom(Value), - set_cookie_options(Options). -field_value(Atomic) --> - atom(Atomic). - -set_cookie_options([]) --> - []. -set_cookie_options([secure=true|T]) --> !, - " ; secure", - set_cookie_options(T). -set_cookie_options([Name=Value|T]) --> - " ; ", field_name(Name), "=", - atom(Value), - set_cookie_options(T). - - -%% header_fields(+Fields, ?ContentLength)// is det. -% -% Process a sequence of [Name(Value), ...] attributes for the -% header. A term content_length(Len) is special. If instantiated -% it emits the header. If not it just unifies ContentLength with -% the argument of the content_length(Len) term. This allows for -% both sending and retrieving the content-length. - -header_fields([], _) --> - []. -header_fields([content_length(CLen)|T], CLen) --> !, - ( { var(CLen) } - -> "" - ; header_field(content_length, CLen) - ), - header_fields(T, CLen). % Continue or return first only? -header_fields([H|T], CLen) --> - { H =.. [Name, Value] }, - header_field(Name, Value), - header_fields(T, CLen). - - -%% field_name(?PrologName) -% -% Convert between prolog_name and HttpName. Field names are, -% aoording to RFC 2616, considered tokens and covered by the -% following definition: -% -% == -% token = 1* -% separators = "(" | ")" | "<" | ">" | "@" -% | "," | ";" | ":" | "\" | <"> -% | "/" | "[" | "]" | "?" | "=" -% | "{" | "}" | SP | HT -% == - -field_name(Name) --> - { var(Name) }, !, - rd_field_chars(Chars), - { atom_codes(Name, Chars) }. -field_name(mime_version) --> !, - "MIME-Version". -field_name(Name) --> - { atom_codes(Name, Chars) }, - wr_field_chars(Chars). - -rd_field_chars([C0|T]) --> - [C], - { rd_field_char(C, C0) }, !, - rd_field_chars(T). -rd_field_chars([]) --> - []. - -%% separators(-CharCodes) is det. -% -% CharCodes is a list of separators according to RFC2616 - -separators("()<>@,;:\\\"/[]?={} \t"). % \" - -term_expansion(rd_field_char(_,_), Clauses) :- - Clauses = [ rd_field_char(0'-, 0'_) - | Cls - ], - separators(Seps), - findall(rd_field_char(In, Out), - ( between(32, 127, In), - \+ memberchk(In, Seps), - In \== 0'-, % 0' - code_type(Out, to_lower(In))), - Cls). - -rd_field_char(_, _). - -wr_field_chars([C|T]) --> - [C2], !, - { to_lower(C2, C) }, - wr_field_chars2(T). -wr_field_chars([]) --> - []. - -wr_field_chars2([0'_|T]) --> !, % 0' - "-", - wr_field_chars(T). -wr_field_chars2([C|T]) --> !, - [C], - wr_field_chars2(T). -wr_field_chars2([]) --> - []. - -% now -%% rfc_date(+Time) - -now --> - { get_time(Time) - }, - rfc_date(Time). - -%% rfc_date(+Time)// is det. -% -% Write time according to RFC1123 specification as required by the -% RFC2616 HTTP protocol specs. - -rfc_date(Time, String, Tail) :- - stamp_date_time(Time, Date, 'UTC'), - format_time(codes(String, Tail), - '%a, %d %b %Y %H:%M:%S GMT', - Date, posix). - -%% http_timestamp(+Time:timestamp, -Text:atom) is det. -% -% Generate a description of a Time in HTTP format (RFC1123) - -http_timestamp(Time, Atom) :- - stamp_date_time(Time, Date, 'UTC'), - format_time(atom(Atom), - '%a, %d %b %Y %H:%M:%S GMT', - Date, posix). - - - /******************************* - * REQUEST DCG * - *******************************/ - -request(Fd, [method(Method),request_uri(ReqURI)|Header]) --> - method(Method), - blanks, - nonblanks(Query), - { atom_codes(ReqURI, Query), - http_location(Parts, Query), - append(Parts, Header0, Header) - }, - request_header(Fd, Header0), !. -request(Fd, [unknown(What)|Header]) --> - string(What), - eos, !, - { http_read_header(Fd, Header) - -> true - ; Header = "" - }. - -method(get) --> "GET", !. -method(put) --> "PUT", !. -method(head) --> "HEAD", !. -method(post) --> "POST", !. -method(delete) --> "DELETE", !. -method(options) --> "OPTIONS", !. -method(trace) --> "TRACE", !. - -request_header(_, []) --> % Old-style non-version header - blanks, - eos, !. -request_header(Fd, [http_version(Version)|Header]) --> - http_version(Version), - blanks, - eos, !, - { Version = 1-_ - -> http_read_header(Fd, Header) - ; Header = [] - }. - -http_version(Version) --> - blanks, - "HTTP/", - http_version_number(Version). - -http_version_number(Major-Minor) --> - integer(Major), - ".", - integer(Minor). - - - /******************************* - * COOKIES * - *******************************/ - -%% cookies(-List) is semidet. -% -% Translate a cookie description into a list Name=Value. - -cookies([Name=Value|T]) --> - blanks, - cookie(Name, Value), !, - blanks, - ( ";" - -> cookies(T) - ; { T = [] } - ). -cookies([]) --> - blanks. - -cookie(Name, Value) --> - cookie_name(Name), - "=", - cookie_value(Value). - -cookie_name(Name) --> - { var(Name) }, !, - rd_field_chars(Chars), - { atom_codes(Name, Chars) }. - -cookie_value(Value) --> - chars_to_semicolon_or_blank(Chars), - { atom_codes(Value, Chars) - }. - -chars_to_semicolon_or_blank([]) --> - peek(0';), !. % 0' -chars_to_semicolon_or_blank([]) --> - blank, !. -chars_to_semicolon_or_blank([H|T]) --> - [H], !, - chars_to_semicolon_or_blank(T). -chars_to_semicolon_or_blank([]) --> - []. - -peek(C, L, L) :- - L = [C|_]. - -set_cookie(set_cookie(Name, Value, Options)) --> - blanks, - cookie(Name, Value), - cookie_options(Options). - -cookie_options([H|T]) --> - blanks, - ";", - blanks, - cookie_option(H), !, - cookie_options(T). -cookie_options([]) --> - blanks. - - -%% cookie_option(-Option)// is semidet. -% -% True if input represents a valid Cookie option. Officially, all -% cookie options use the syntax =, except for -% =secure=. M$ decided to extend this to include at least -% =httponly= (only the Gods know what it means). -% -% @param Option Term of the form Name=Value -% @bug Incorrectly accepts options without = for M$ compatibility. - -cookie_option(Name=Value) --> - rd_field_chars(NameChars), whites, - { atom_codes(Name, NameChars) }, - ( "=" - -> blanks, - chars_to_semicolon(ValueChars), - { atom_codes(Value, ValueChars) - } - ; { Value = true } - ). - -chars_to_semicolon([]) --> - blanks, - peek(0';), !. % 0' -chars_to_semicolon([H|T]) --> - [H], !, - chars_to_semicolon(T). -chars_to_semicolon([]) --> - []. - -%% range(-Range)// is semidet. -% -% Process the range header value. Range is currently defined as: -% -% * bytes(From, To) -% Where From is an integer and To is either an integer or -% the atom =end=. - -range(bytes(From, To)) --> - "bytes", whites, "=", whites, integer(From), "-", - ( integer(To) - -> "" - ; { To = end } - ). - - - /******************************* - * REPLY DCG * - *******************************/ - -%% reply(+In, -Reply:list)// is semidet. -% -% Process the first line of an HTTP reply. After that, read the -% remainder of the header and parse it. After successful -% completion, Reply contains the following fields, followed by the -% fields produced by http_read_header/2. -% -% * http_version(Major-Minor) -% * status(StatusCode, Comment) -% -% StatusCode is one of the values provided by status_number//1. - -reply(Fd, [http_version(HttpVersion), status(Status, Comment)|Header]) --> - http_version(HttpVersion), - blanks, - ( status_number(Status, _Code) - -> [] - ; integer(Status) - ), - blanks, - string(CommentCodes), - blanks_to_nl, !, - blanks, - { atom_codes(Comment, CommentCodes), - http_read_header(Fd, Header) - }. - - - /******************************* - * READ HEADER * - *******************************/ - -%% http_read_header(+Fd, -Header) is det. -% -% Read Name: Value lines from FD until an empty line is encountered. -% Field-name are converted to Prolog conventions (all lower, _ instead -% of -): Content-Type: text/html --> content_type(text/html) - -http_read_header(Fd, Header) :- - read_header_data(Fd, Text), - http_parse_header(Text, Header). - -read_header_data(Fd, Header) :- - read_line_to_codes(Fd, Header, Tail), - read_header_data(Header, Fd, Tail), - debug(http(header), 'Header = ~n~s~n', [Header]). - -read_header_data("\r\n", _, _) :- !. -read_header_data("\n", _, _) :- !. -read_header_data("", _, _) :- !. -read_header_data(_, Fd, Tail) :- - read_line_to_codes(Fd, Tail, NewTail), - read_header_data(Tail, Fd, NewTail). - -%% http_parse_header(+Text:codes, -Header:list) is det. -% -% Header is a list of Name(Value)-terms representing the structure -% of the HTTP header in Text. -% -% @error domain_error(http_request_line, Line) - -http_parse_header(Text, Header) :- - phrase(header(Header), Text), - debug(http(header), 'Fields: ~w~n', [Header]). - -header(List) --> - header_field(Name, Value), !, - { mkfield(Name, Value, List, Tail) - }, - blanks, - header(Tail). -header([]) --> - blanks, - eos, !. -header(_) --> - string(S), blanks_to_nl, !, - { atom_codes(Line, S), - syntax_error(http_request_line(Line)) - }. - -%% address// -% -% Emit the HTML for the server address on behalve of error and -% status messages (non-200 replies). Default is -% -% == -% SWI-Prolog httpd at -% == -% -% The address can be modified by providing a definition for the -% multifile predicate http:http_address//0. - -:- multifile - http:http_address//0. - -address --> - http:http_address, !. -address --> - { gethostname(Host) }, - html(address([ a(href('http://www.swi-prolog.org'), 'SWI-Prolog'), - ' httpd at ', Host - ])). - -mkfield(host, Host:Port, [host(Host),port(Port)|Tail], Tail) :- !. -mkfield(Name, Value, [Att|Tail], Tail) :- - Att =.. [Name, Value]. - - - /******************************* - * MESSAGES * - *******************************/ - -:- multifile - prolog:message//1. - -prolog:message(error(http_write_short(Data, Sent), _)) --> - [ '~p: remote hangup after ~D bytes'-[Data, Sent] ]. diff --git a/packages/http/http_hook.pl b/packages/http/http_hook.pl deleted file mode 100644 index fda3bcf9b..000000000 --- a/packages/http/http_hook.pl +++ /dev/null @@ -1,84 +0,0 @@ -/* Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: J.Wielemaker@uva.nl - WWW: http://www.swi-prolog.org - Copyright (C): 2008, University of Amsterdam - - 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 library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(http_hook, - []). - -/** HTTP library hooks - -Get the declarations of the HTTP package using - - == - :- use_module(library(http/http_hook)). - == - -@tbd This should be using include, but then it cannot be a module - and this would cause more overhead in SWI-Prolog -@tbd Complete this and document the hooks. -*/ - - /******************************* - * HTTP-PATH * - *******************************/ - -:- multifile http:location/3. -:- dynamic http:location/3. - - - /******************************* - * HTML-WRITE * - *******************************/ - -:- multifile - html_write:expand//1, - html_write:expand_attribute_value//1, - html_write:html_head_expansion/2, - html_write:layout/3. - - - /******************************* - * HTTP-DISPATCH * - *******************************/ - -:- multifile - http:authenticate/3. - - - /******************************* - * HTTP-PARAMETERS * - *******************************/ - -:- multifile - http:convert_parameter/3. - -%% http:convert_parameter(+Type, +ValueIn, -ValueOut) is semidet. -% -% Hook to execute a step in the HTTP parameter conversion process. -% -% @see http_parameters:check_type/4. diff --git a/packages/http/http_host.pl b/packages/http/http_host.pl deleted file mode 100644 index 74ae7d6cd..000000000 --- a/packages/http/http_host.pl +++ /dev/null @@ -1,123 +0,0 @@ -/* Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: J.Wielemaker@cs.vu.nl - WWW: http://www.swi-prolog.org - Copyright (C): 2007-2010, University of Amsterdam, - VU University Amsterdam - - 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 library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(http_host, - [ http_current_host/4 % +Request, -Host, -Port, +Options - ]). -:- use_module(library('http/thread_httpd')). -:- use_module(library(socket)). -:- use_module(library(option)). -:- use_module(library(settings)). - -:- setting(http:public_host, atom, '', - 'Name the outside world can use to contact me'). -:- setting(http:public_port, integer, 80, - 'Port on the public server'). - - -/** Obtain public server location - -This library finds the public address of the running server. This can be -used to construct URLs that are visible from anywhere on the internet. -This module was introduced to deal with OpenID, where a reques is -redirected to the OpenID server, which in turn redirects to our server -(see http_openid.pl). - -The address is established from the settings http:public_host and -http:public_port if provided. Otherwise it is deduced from the request. -*/ - - -%% http_current_host(+Request, -Hostname, -Port, Options) is det. -% -% Current global host and port of the HTTP server. This is the -% basis to form absolute address, which we need for redirection -% based interaction such as the OpenID protocol. Options are: -% -% * global(+Bool) -% If =true= (default =false=), try to replace a local hostname -% by a world-wide accessible name. - -http_current_host(_, Host, Port, _) :- - setting(http:public_host, PublicHost), PublicHost \== '', !, - Host = PublicHost, - setting(http:public_port, Port). -http_current_host(Request, Host, Port, Options) :- - ( memberchk(x_forwarded_host(Forwarded), Request) - -> Port = 80, - primary_forwarded_host(Forwarded, Host) - ; memberchk(host(Host0), Request), - ( option(global(true), Options, false) - -> global_host(Host0, Host) - ; Host = Host0 - ), - option(port(Port), Request, 80) - -> true - ; gethostname(Host), - http_current_server(_Pred, Port) % TBD: May be more - ). - - -%% primary_forwarded_host(+Spec, -Host) is det. -% -% x_forwarded host contains multiple hosts seperated by ', ' if -% there are multiple proxy servers in between. The first one is -% the one the user's browser knows about. - -primary_forwarded_host(Spec, Host) :- - sub_atom(Spec, B, _, _, ','), !, - sub_atom(Spec, 0, B, _, Host). -primary_forwarded_host(Host, Host). - - -%% global_host(+HostIn, -Host) -% -% Globalize a hostname. Used if we need to pass our hostname to a -% client and expect the client to be able to contact us. In this -% case we cannot use a name such as `localhost' or the plain -% hostname of the machine. We assume (possibly wrongly) that if -% the host contains a '.', it is globally accessible. -% -% If the heuristics used by this predicate do not suffice, the -% setting http:public_host can be used to override. - -global_host(_, Host) :- - setting(http:public_host, PublicHost), PublicHost \== '', !, - Host = PublicHost. -global_host(localhost, Host) :- !, - gethostname(Host). -global_host(Local, Host) :- - sub_atom(Local, _, _, _, '.'), !, - Host = Local. -global_host(Local, Host) :- - tcp_host_to_address(Local, IP), - tcp_host_to_address(Host, IP). - - diff --git a/packages/http/http_json.pl b/packages/http/http_json.pl deleted file mode 100644 index c106146e6..000000000 --- a/packages/http/http_json.pl +++ /dev/null @@ -1,206 +0,0 @@ -/* $Id$ - - Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: wielemak@science.uva.nl - WWW: http://www.swi-prolog.org - Copyright (C): 1985-2007, University of Amsterdam - - 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 library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(http_json, - [ reply_json/1, % +JSON - reply_json/2, % +JSON, Options - http_read_json/2, % +Request, -JSON - http_read_json/3 % +Request, -JSON, +Options - ]). -:- use_module(http_client). -:- use_module(http_header). -:- use_module(http_stream). -:- use_module(json). -:- use_module(library(option)). -:- use_module(library(error)). -:- use_module(library(lists)). -:- use_module(library(memfile)). - -:- multifile - http_client:http_convert_data/4, - http_client:post_data_hook/3, - json_type/1. - - -/** HTTP JSON Plugin module - -This module inserts the JSON parser for documents of MIME type -=|application/jsonrequest|= and =|application/json|= requested through -the http_client.pl library. - -Typically JSON is used by Prolog HTTP servers. Below is a skeleton for -handling a JSON request, answering in JSON. - -== -handle(Request) :- - http_read_json(Request, JSONIn), - json_to_prolog(JSONIn, PrologIn), - (PrologIn, PrologOut), % application body - prolog_to_json(PrologOut, JSONOut), - reply_json(JSONOut). -== - -This module also integrates JSON support into the http client provided -by http_client.pl. Posting a JSON query and processing the JSON reply -(or any other reply understood by http_read_data/3) is as simple as -below, where Term is a JSON term as described in json.pl and reply is -of the same format if the server replies with JSON. - -== - ..., - http_post(URL, json(Term), Reply, []) -== - -@see JSON Requests are discussed in http://json.org/JSONRequest.html -@see json.pl describes how JSON objects are represented in Prolog terms. -@see json_convert.pl converts between more natural Prolog terms and json -terms. -*/ - -http_client:http_convert_data(In, Fields, Data, Options) :- - memberchk(content_type(Type), Fields), - is_json_type(Type), !, - ( memberchk(content_length(Bytes), Fields) - -> stream_range_open(In, Range, [size(Bytes)]), - set_stream(Range, encoding(utf8)), - call_cleanup(json_read(Range, Data, Options), close(Range)) - ; set_stream(In, encoding(utf8)), - json_read(In, Data, Options) - ). - - -is_json_type(Type) :- - json_type(Type), !. -is_json_type(ContentType) :- - json_type(Type), - sub_atom(ContentType, 0, _, _, Type), !, - strip_utf8(ContentType, Plain), - json_type(Plain). - - -%% strip_utf8(+ContentTypeIn, -ContentType) is det. -% -% Strip an optional =|; charset=UTF-8|=. JSON data is always -% UTF-8, but some clients seem to insist in sending this. - -strip_utf8(ContentType, Plain) :- - sub_atom(ContentType, B, _, A, ;), - sub_atom(ContentType, _, A, 0, Ext), - normalize_space(atom('charset=UTF-8'), Ext), !, - sub_atom(ContentType, 0, B, _, CT), - normalize_space(atom(Plain), CT). -strip_utf8(ContentType, ContentType). - - -%% json_type(?MIMEType:atom) is semidet. -% -% True if MIMEType is a JSON mimetype. http_json:json_type/1 is a -% multifile predicate and may be extended to facilitate -% non-conforming clients. - -json_type('application/jsonrequest'). -json_type('application/json'). - - -% http_client:post_data_hook(+Data, +Out:stream, +HdrExtra) is semidet. -% -% Hook into http_post_data/3 that allows for -% -% == -% http_post(URL, json(Term), Reply, Options) -% == -% -% @tbd avoid creation of intermediate data using chunked output. - -http_client:post_data_hook(json(Term), Out, HdrExtra) :- - http_client:post_data_hook(json(Term, []), Out, HdrExtra). -http_client:post_data_hook(json(Term, Options), Out, HdrExtra) :- - option(content_type(Type), HdrExtra, 'application/json'), - new_memory_file(MemFile), - open_memory_file(MemFile, write, Handle), - format(Handle, 'Content-type: ~w~n~n', [Type]), - json_write(Handle, Term, Options), - close(Handle), - open_memory_file(MemFile, read, RdHandle), - call_cleanup(http_post_data(cgi_stream(RdHandle), Out, HdrExtra), - ( close(RdHandle), - free_memory_file(MemFile))). - - -%% http_read_json(+Request, -JSON) is det. -%% http_read_json(+Request, -JSON, +Options) is det. -% -% Extract JSON data posted to this HTTP request. -% -% @error domain_error(mimetype, Found) if the mimetype is -% not known (see json_type/1). -% @error domain_error(method, Method) if the request is not -% a POST request. - -http_read_json(Request, JSON) :- - http_read_json(Request, JSON, []). - -http_read_json(Request, JSON, Options) :- - select_option(content_type(Type), Options, Rest), !, - delete(Request, content_type(_), Request2), - request_to_json([content_type(Type)|Request2], JSON, Rest). -http_read_json(Request, JSON, Options) :- - request_to_json(Request, JSON, Options). - -request_to_json(Request, JSON, Options) :- - memberchk(method(Method), Request), - memberchk(content_type(Type), Request), - ( Method == post - -> true - ; domain_error(method, Method) - ), - ( is_json_type(Type) - -> true - ; domain_error(mimetype, Type) - ), - http_read_data(Request, JSON, Options). - - -%% reply_json(+JSONTerm) is det. -%% reply_json(+JSONTerm, +Options) is det. -% -% Formulate a JSON HTTP reply. See json_write/2 for details. -% Options accepts content_type(+Type) and options accepted by -% json_write/3. - -reply_json(Term) :- - format('Content-type: application/json~n~n'), - json_write(current_output, Term). - -reply_json(Term, Options) :- - select_option(content_type(Type), Options, Rest, 'application/json'), - format('Content-type: ~w~n~n', [Type]), - json_write(current_output, Term, Rest). diff --git a/packages/http/http_log.pl b/packages/http/http_log.pl deleted file mode 100644 index 685a3e9ca..000000000 --- a/packages/http/http_log.pl +++ /dev/null @@ -1,263 +0,0 @@ -/* Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: J.Wielemaker@uva.nl - WWW: http://www.swi-prolog.org - Copyright (C): 2009, University of Amsterdam - - 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 library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(http_log, - [ http_log_stream/1, % -Stream - http_log/2, % +Format, +Args - http_log_close/1 % +Reason - ]). -:- use_module(library(settings)). -:- use_module(library(broadcast)). - -:- setting(http:logfile, atom, 'httpd.log', - 'File in which to log HTTP requests'). - -/** HTTP Logging module - -Simple module for logging HTTP requests to a file. Logging is enabled by -loading this file and ensure the setting http:logfile is not the empty -atom. The default file for writing the log is =|httpd.log|=. See -library(settings) for details. - -The level of logging can modified using the multifile predicate -http_log:nolog/1 to hide HTTP request fields from the logfile and -http_log:password_field/1 to hide passwords from HTTP search -specifications (e.g. =|/topsecret?password=secret|=). -*/ - -:- multifile - nolog/1, - password_field/1. - -% If the log settings change, simply close the log and it will be -% reopened with the new settings. - -:- listen(settings(changed(http:logfile, _, New)), - http_log_close(changed(New))). -:- listen(http(Message), - http_message(Message)). - - -http_message(request_start(Id, Request)) :- !, - http_log_stream(Stream), - log_started(Request, Id, Stream). -http_message(request_finished(Id, Code, Status, CPU, Bytes)) :- !, - http_log_stream(Stream), - log_completed(Code, Status, Bytes, Id, CPU, Stream). - - - /******************************* - * LOG ACTIVITY * - *******************************/ - -:- dynamic - log_stream/1. - -%% http_log_stream(-Stream) is semidet. -% -% Returns handle to open logfile. Fails if no logfile is open and -% none is defined. - -http_log_stream(Stream) :- - log_stream(Stream), !, - Stream \== []. -http_log_stream(Stream) :- - setting(http:logfile, File), - File \== '', !, - with_mutex(http_log, - ( open(File, append, Stream, - [ close_on_abort(false), - encoding(utf8), - buffer(line) - ]), - get_time(Time), - format(Stream, - 'server(started, ~0f).~n', - [ Time ]), - assert(log_stream(Stream)), - at_halt(close_log(stopped)) - )). -http_log_stream(_) :- - assert(log_stream([])). - -%% http_log_close(+Reason) is det. -% -% If there is a currently open HTTP logfile, close it after adding -% a term server(Reason, Time). to the logfile. This call is -% intended for cooperation with the Unix logrotate facility -% using the following schema: -% -% * Move logfile (the HTTP server keeps writing to the moved -% file) -% * Inform the server using an HTTP request that calls -% http_log_close/1 -% * Compress the moved logfile -% -% @author Suggested by Jacco van Ossenbruggen - -http_log_close(Reason) :- - with_mutex(http_log, close_log(Reason)). - -close_log(Reason) :- - retract(log_stream(Stream)), !, - ( Stream == [] - -> true - ; get_time(Time), - format(Stream, 'server(~q, ~0f).~n', [ Reason, Time ]), - close(Stream) - ). -close_log(_). - -%% http_log(+Format, +Args) is det. -% -% Write message from Format and Args to log-stream. See format/2 -% for details. Succeed without side effects if logging is not -% enabled. - -http_log(Format, Args) :- - ( http_log_stream(Stream) - -> format(Stream, Format, Args) - ; true - ). - - -%% log_started(+Request, +Id, +Stream) is det. -% -% Write log message that Request was started to Stream. -% -% @param Filled with sequence identifier for the request - -log_started(Request, Id, Stream) :- - get_time(Now), - log_request(Request, LogRequest), - format_time(string(HDate), '%+', Now), - format(Stream, - '/*~s*/ request(~q, ~3f, ~q).~n', - [HDate, Id, Now, LogRequest]). - -%% log_request(+Request, -Log) -% -% Remove passwords from the request to avoid sending them to the -% logfiles. - -log_request([], []). -log_request([search(Search0)|T0], [search(Search)|T]) :- !, - mask_passwords(Search0, Search), - log_request(T0, T). -log_request([H|T0], T) :- - nolog(H), !, - log_request(T0, T). -log_request([H|T0], [H|T]) :- - log_request(T0, T). - -mask_passwords([], []). -mask_passwords([Name=_|T0], [Name=xxx|T]) :- - password_field(Name), !, - mask_passwords(T0, T). -mask_passwords([H|T0], [H|T]) :- - mask_passwords(T0, T). - -%% password_field(+Field) is semidet. -% -% Multifile predicate that can be defined to hide passwords from -% the logfile. - -password_field(password). -password_field(pwd0). -password_field(pwd1). -password_field(pwd2). - - -%% nolog(+HTTPField) -% -% Multifile predicate that can be defined to hide request -% parameters from the request logfile. - -nolog(input(_)). -nolog(accept(_)). -nolog(accept_language(_)). -nolog(accept_encoding(_)). -nolog(accept_charset(_)). -nolog(pool(_)). -nolog(protocol(_)). -nolog(referer(R)) :- - sub_atom(R, _, _, _, password), !. - -%% log_completed(+Code, +Status, +Bytes, +Id, +CPU, +Stream) is det. -% -% Write log message to Stream from a call_cleanup/3 call. -% -% @param Status 2nd argument of call_cleanup/3 -% @param Id Term identifying the completed request -% @param CPU0 CPU time at time of entrance -% @param Stream Stream to write to (normally from http_log_stream/1). - -log_completed(Code, Status, Bytes, Id, CPU, Stream) :- - is_stream(Stream), - log_check_deleted(Stream), !, - log(Code, Status, Bytes, Id, CPU, Stream). -log_completed(Code, Status, Bytes, Id, CPU0, _) :- - http_log_stream(Stream), !, % Logfile has changed! - log_completed(Code, Status, Bytes, Id, CPU0, Stream). -log_completed(_,_,_,_,_,_). - - -%% log_check_deleted(+Stream) is semidet. -% -% If the link-count of the stream has dropped to zero, the file -% has been deleted/moved. In this case the log file is closed and -% log_check_deleted/6 will open a new one. This provides some -% support for cleaning up the logfile without shutting down the -% server. -% -% @see logrotate(1) to manage logfiles on Unix systems. - -log_check_deleted(Stream) :- - stream_property(Stream, nlink(Links)), - Links == 0, !, - http_log_close(log_file_deleted), - fail. -log_check_deleted(_). - - -log(Code, ok, Bytes, Id, CPU, Stream) :- !, - format(Stream, 'completed(~q, ~2f, ~q, ~q, ok).~n', - [ Id, CPU, Bytes, Code ]). -log(Code, Status, Bytes, Id, CPU, Stream) :- - ( map_exception(Status, Term) - -> true - ; message_to_string(Status, String), - Term = error(String) - ), - format(Stream, 'completed(~q, ~2f, ~q, ~q, ~q).~n', - [ Id, CPU, Bytes, Code, Term ]). - -map_exception(http_reply(Reply), Reply). -map_exception(error(existence_error(http_location, Location), _Stack), - error(404, Location)). diff --git a/packages/http/http_mime_plugin.pl b/packages/http/http_mime_plugin.pl deleted file mode 100644 index b5413bbab..000000000 --- a/packages/http/http_mime_plugin.pl +++ /dev/null @@ -1,79 +0,0 @@ -/* $Id$ - - Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: jan@swi.psy.uva.nl - WWW: http://www.swi-prolog.org - Copyright (C): 1985-2002, University of Amsterdam - - 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 Lesser 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 - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(http_mime_plugin, []). -:- use_module(http_client). -:- use_module(library(memfile)). -:- use_module(library(mime)). - -/** MIME client plugin - -This plugin for library(http_client) automatically translates messages -with content-type =|multipart/form-data|= into a list of Name = Value -pairs, greatly simplifying the processing of forms with this type. It -relies on library(mime), which in turn relies on a foreign -implementation of the rfc2045 (mime) specifications. -*/ - -:- multifile - http_client:http_convert_data/4, - http_parameters:form_data_content_type/1. - -http_client:http_convert_data(In, Fields, Data, Options) :- - memberchk(content_type(Type), Fields), - ( memberchk(mime_version(MimeVersion), Fields) - ; sub_atom(Type, 0, _, _, 'multipart/form-data'), - MimeVersion = '1.0' - ), !, - new_memory_file(MemFile), - open_memory_file(MemFile, write, Tmp), - format(Tmp, 'Mime-Version: ~w\n', [MimeVersion]), - format(Tmp, 'Content-Type: ~w\n\n', [Type]), - http_read_data(Fields, _, [in(In), to(stream(Tmp))|Options]), - close(Tmp), - open_memory_file(MemFile, read, MimeIn), - mime_parse(stream(MimeIn), Data0), - close(MimeIn), - free_memory_file(MemFile), - mime_to_form(Data0, Data). - -mime_to_form(mime(A,'',Parts), Form) :- - memberchk(type('multipart/form-data'), A), - mime_form_fields(Parts, Form), !. -mime_to_form(Mime, Mime). - -mime_form_fields([], []). -mime_form_fields([mime(A, V, [])|T0], [Name=V|T]) :- - memberchk(name(Name), A), - mime_form_fields(T0, T). - -http_parameters:form_data_content_type(ContentType) :- - sub_atom(ContentType, 0, _, _, 'multipart/form-data'). diff --git a/packages/http/http_open.pl b/packages/http/http_open.pl deleted file mode 100644 index 8e1d4b3ba..000000000 --- a/packages/http/http_open.pl +++ /dev/null @@ -1,644 +0,0 @@ -/* $Id$ - - Part of SWI-Prolog - - Author: Jan Wielemaker - E-mail: J.Wielemaker@uva.nl - WWW: http://www.swi-prolog.org - Copyright (C): 2008, University of Amsterdam - - 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 Lesser 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 - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - - -:- module(http_open, - [ http_open/3, % +URL, -Stream, +Options - http_set_authorization/2 % +URL, +Authorization - ]). - -:- use_module(library(url)). -:- use_module(library(readutil)). -:- use_module(library(socket)). -:- use_module(library(lists)). -:- use_module(library(option)). -:- use_module(library(error)). -:- use_module(library(base64)). -:- use_module(library(debug)). - -:- expects_dialect(swi). -:- assert(system:swi_io). - -user_agent('SWI-Prolog '). - -/** Simple HTTP client - -This library provides a light-weight HTTP client library to get the data -from a URL. The functionality of the library can be extended by loading -two additional modules that acts as plugins: - - * library(http/http_chunked) - Loading this library causes http_open/3 to support chunked - transfer encoding. - - * library(http/http_header) - Loading this library causes http_open/3 to support the =POST= method - in addition to =GET= and =HEAD=. - -Here is a simple example to fetch a web-page: - - == - ?- http_open('http://www.google.com/search?q=prolog', In, []), - copy_stream_data(In, user_output), - close(In). - prolog - Google Search