diff --git a/.gitmodules b/.gitmodules index e3b4a82..e87a284 100644 --- a/.gitmodules +++ b/.gitmodules @@ -28,3 +28,6 @@ [submodule "submodules/concurrency"] path = submodules/concurrency url = git://github.com/dylan-foundry/concurrency.git +[submodule "submodules/tracing"] + path = submodules/tracing + url = https://github.com/dylan-foundry/tracing.git diff --git a/registry/generic/tracing-core b/registry/generic/tracing-core new file mode 100644 index 0000000..c53da56 --- /dev/null +++ b/registry/generic/tracing-core @@ -0,0 +1 @@ +abstract://dylan/submodules/tracing/tracing-core/tracing-core.lid \ No newline at end of file diff --git a/server/core/library.dylan b/server/core/library.dylan index 480146d..07c7367 100644 --- a/server/core/library.dylan +++ b/server/core/library.dylan @@ -24,6 +24,7 @@ define library http-server use strings; use system, import: { date, file-system, locators, operating-system }; + use tracing-core; use uncommon-dylan; use uri; use xml-parser; @@ -235,6 +236,7 @@ define module httpi // http internals use streams-internals; use strings; use threads; // from dylan lib + use tracing-core; use uncommon-dylan; use uri; use xml-parser, diff --git a/server/core/server.dylan b/server/core/server.dylan index dd5fd31..4fc6b28 100644 --- a/server/core/server.dylan +++ b/server/core/server.dylan @@ -40,7 +40,7 @@ define open class (, ) constant slot server-lock :: , required-init-keyword: lock:; - // lowercase fqdn -> + // lowercase fqdn (fully qualified domain name) -> constant slot virtual-hosts :: = make(), init-keyword: virtual-hosts:; @@ -116,6 +116,10 @@ define open class (, ) init-value: "http_server_session_id", init-keyword: session-id:; + /// Sampler for tracing + slot sampler :: , + init-keyword: sampler:; + end class ; define sealed method make @@ -674,45 +678,53 @@ define function %respond-top-level block (exit-respond-top-level) while (#t) // keep alive loop with-simple-restart("Skip this request and continue with the next") - *request* := make(client.client-server.request-class, client: client); - let request :: = *request*; - block (finish-request) - // More recently installed handlers take precedence... - let handler = rcurry(htl-error-handler, finish-request); - let handler - = rcurry(htl-error-handler, exit-respond-top-level, - send-response: #f, - decline-if-debugging: #f); - // This handler casts too wide of a net. There's no reason to catch - // all the subclasses of such as - // here. But it's not clear what it SHOULD be catching - // either. --cgay Feb 2009 - let handler - = rcurry(htl-error-handler, exit-respond-top-level, - send-response: #f, - decline-if-debugging: #f); - let handler = rcurry(htl-error-handler, finish-request, - decline-if-debugging: #f); - - read-request(request); - let headers = make(); - if (request.request-keep-alive?) - set-header(headers, "Connection", "Keep-Alive"); - end if; - dynamic-bind (*response* = make(, - request: request, - headers: headers), - // Bound to a when first requested. - *page-context* = #f) - route-request(*server*, request); - finish-response(*response*); + with-tracing("HTTP Request", sampler: client.client-server.sampler) + *request* := make(client.client-server.request-class, client: client); + let request :: = *request*; + block (finish-request) + // More recently installed handlers take precedence... + let handler = rcurry(htl-error-handler, finish-request); + let handler + = rcurry(htl-error-handler, exit-respond-top-level, + send-response: #f, + decline-if-debugging: #f); + // This handler casts too wide of a net. There's no reason to catch + // all the subclasses of such as + // here. But it's not clear what it SHOULD be catching + // either. --cgay Feb 2009 + let handler + = rcurry(htl-error-handler, exit-respond-top-level, + send-response: #f, + decline-if-debugging: #f); + let handler = rcurry(htl-error-handler, finish-request, + decline-if-debugging: #f); + + with-tracing("Reading Request", sampler: request.request-server.sampler) + trace-add-data("request-method", request.request-method); + trace-add-data("request-url", request.request-url); + read-request(request); + end with-tracing; + let headers = make(); + if (request.request-keep-alive?) + set-header(headers, "Connection", "Keep-Alive"); + end if; + dynamic-bind (*response* = make(, + request: request, + headers: headers), + // Bound to a when first requested. + *page-context* = #f) + with-tracing("Routing Request", sampler: request.request-server.sampler) + route-request(*server*, request); + end with-tracing; + finish-response(*response*); + end; + force-output(request.request-socket); + end block; // finish-request + if (client.client-listener.listener-exit-requested? + | ~request-keep-alive?(request)) + exit-respond-top-level(); end; - force-output(request.request-socket); - end block; // finish-request - if (client.client-listener.listener-exit-requested? - | ~request-keep-alive?(request)) - exit-respond-top-level(); - end; + end with-tracing; end with-simple-restart; end while; end block; // exit-respond-top-level diff --git a/submodules/tracing b/submodules/tracing new file mode 160000 index 0000000..6d34227 --- /dev/null +++ b/submodules/tracing @@ -0,0 +1 @@ +Subproject commit 6d3422786c94140c9aad48fba4f42ce0a656ff5c