From 90a1f7d47525cfffe928e9a89becf622bd85a8a1 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Fri, 22 Jun 2018 22:22:24 +0200 Subject: Initial CHICKEN 5 port of intarweb 1.7 --- benchmarks/parsers.scm | 60 ++++++++++++++++++++++++++++++++++++++++++++++++ benchmarks/run.scm | 7 ++++++ benchmarks/unparsers.scm | 54 +++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 121 insertions(+) create mode 100644 benchmarks/parsers.scm create mode 100644 benchmarks/run.scm create mode 100644 benchmarks/unparsers.scm (limited to 'benchmarks') diff --git a/benchmarks/parsers.scm b/benchmarks/parsers.scm new file mode 100644 index 0000000..e4612e2 --- /dev/null +++ b/benchmarks/parsers.scm @@ -0,0 +1,60 @@ +(import intarweb chicken.string chicken.time chicken.time.posix + chicken.port srfi-13) + +(define (mk-headers . strs) + (string-append (string-join strs "\r\n") "\r\n\r\n")) + +(begin (newline) + (print "--- Request parsing ---") + (begin (print "Parsing a minimal HTTP/1.0 request many times") + (let* ((str (mk-headers "GET / HTTP/1.0" + "Host: 127.0.0.1:8080" + "User-Agent: ApacheBench/2.3")) + (p (open-input-string str))) + (time (do ((i 0 (add1 i))) + ((= i 100000)) + (##sys#setslot p 10 0) ; rewind + (read-request p))))) + + (begin (print "Parsing a realistic HTTP/1.1 request many times") + (let* ((str (mk-headers "GET /foo HTTP/1.1" + "Host: localhost:8080" + "User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20140722 Firefox/24.0 Iceweasel/24.7.0" + "Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8" + "Accept-Language: en-US,en;q=0.5" + "Accept-Encoding: gzip, deflate" + "Connection: keep-alive")) + (p (open-input-string str))) + (time (do ((i 0 (add1 i))) + ((= i 100000)) + (##sys#setslot p 10 0) ; rewind + (read-request p)))))) + +(begin (newline) + (print "--- Response parsing ---") + (begin (print "Parsing a minimal HTTP/1.0 response many times") + (let* ((str (mk-headers "HTTP/1.0 200 OK" + "Content-Length: 10")) + (p (open-input-string str))) + (time (do ((i 0 (add1 i))) + ((= i 100000)) + (##sys#setslot p 10 0) ; rewind + (read-response p))))) + + (begin (newline) + (print "Parsing a realistic HTTP/1.1 response many times") + (let* ((str (mk-headers + "HTTP/1.1 404 Not Found" + "Date: Tue, 19 Aug 2014 19:14:24 GMT" + "Server: Apache" + "Vary: Accept-Encoding" + "Content-Encoding: gzip" + "Content-Length: 176" + "Keep-Alive: timeout=15, max=100" + "Connection: Keep-Alive" + "Content-Type: text/html; charset=iso-8859-1")) + (p (open-input-string str))) + (time (do ((i 0 (add1 i))) + ((= i 100000)) + (##sys#setslot p 10 0) ; rewind + (read-response p)))))) diff --git a/benchmarks/run.scm b/benchmarks/run.scm new file mode 100644 index 0000000..c7d45c8 --- /dev/null +++ b/benchmarks/run.scm @@ -0,0 +1,7 @@ +(print "Unparsers:") +(print "==========\n") +(load "unparsers") + +(print "\nParsers:") +(print "==========\n") +(load "parsers") diff --git a/benchmarks/unparsers.scm b/benchmarks/unparsers.scm new file mode 100644 index 0000000..b8db0c8 --- /dev/null +++ b/benchmarks/unparsers.scm @@ -0,0 +1,54 @@ +(import chicken.port chicken.time chicken.time.posix intarweb uri-common) + +(define null-output-port + (make-output-port void void)) + +(begin (newline) + (print "--- Response unparsing ---") + (begin (print "Unparsing a minimal HTTP/1.1 response many times") + (let ((response (make-response port: null-output-port))) + (time (do ((i 0 (add1 i))) + ((= i 100000)) + (write-response response))))) + + (begin (print "Unparsing a realistic HTTP/1.1 response many times") + (let ((response + (make-response + port: null-output-port + headers: (headers + `((content-type text/css) + (etag (strong . "1234-0123456789")) + (content-length 1234) + (last-modified #(,(seconds->utc-time (current-seconds)) ())) + (date #(,(seconds->utc-time (current-seconds)) ()))))))) + (time (do ((i 0 (add1 i))) + ((= i 100000)) + (write-response response)))))) + +(begin (newline) + (print "--- Request unparsing ---") + (begin (print "Unparsing a minimal HTTP/1.1 request many times") + (let ((request + (make-request port: null-output-port))) + (time (do ((i 0 (add1 i))) + ((= i 100000)) + (write-request request))))) + + (begin (print "Unparsing a realistic HTTP/1.1 request many times") + (let ((request + (make-request + port: null-output-port + uri: (uri-reference "http://www.call-cc.org/test.example") + headers: (headers + `((user-agent (("Mozilla" "5.0" + "X11; U; NetBSD amd64; en-US; rv:1.9.0.3") + ("Gecko" "2008110501" #f) + ("Minefield" "3.0.3" #f))) + (host ("example.com" . 8080)) + (accept text/html application/xhtml+xml + #(application/xml ((q . 0.9))) #(*/* ((q . 0.8)))) + (accept-language en-US #(en ((q . 0.5)))) + (accept-encoding gzip deflate)))))) + (time (do ((i 0 (add1 i))) + ((= i 100000)) + (write-request request)))))) -- cgit v1.2.3