((section 2 "Outdated egg!" (p "This is an egg for CHICKEN 4, the unsupported old release.  You're almost certainly looking for " (int-link "/eggref/5/call-with-query" "the CHICKEN 5 version of this egg") ", if it exists.") (p "If it does not exist, there may be equivalent functionality provided by another egg; have a look at the " (link "https://wiki.call-cc.org/chicken-projects/egg-index-5.html" "egg index") ". Otherwise, please consider porting this egg to the current version of CHICKEN.")) (section 2 "call-with-query" (p "A reasonable abstraction around e.g. fastcgi server-invocations: ports, environment, query") (toc) (section 3 "Motivation" (p "Using FastCGI is relatively pain-in-the-ass; take this contrived example, for instance, where we'd like create a server that exports a database (given as a post-parameter) as JSON:") (highlight scheme "(fcgi-dynamic-server-accept-loop\n  (lambda (in out err env)\n    (out \"Content-type: application/json\\r\\n\\r\\n\")\n    (let* ((post-data (form-urldecode (fcgi-get-post-data in env)))\n           (database\n             (alist-ref/default post-data 'database (default-database))))\n      (out (with-output-to-string\n             (lambda () (json-write (database->json database))))))))") (p "With " (tt "call-with-query") ", however, we can do something like this:") (highlight scheme "(call-with-dynamic-fastcgi-query\n  (lambda (query)\n    (display-content-type-&c. 'json)\n    (json-write\n      (database->json (query-any query 'database (default-database))))))") (p "Anything written to stdout appears in the request; anything to stderr goes in the server logs; while " (tt "display-content-type-&c.") " takes care of the HTTP headers.")) (section 3 "Documentation" (section 4 (tt "display-content-type-&c.") (def (sig (procedure "(display-content-type-&c.) → unspecified" (id display-content-type-&c.)) (procedure "(display-content-type-&c. content-type-&c.) → unspecified" (id display-content-type-&c.))) (p "Write the content-type headers and e.g. XML prolog (if necessary); do not, however, write the status (see " (tt "display-status") " and " (tt "display-status-&c.") ").") (p "Valid content-types are " (tt "xhtml") ", " (tt "html") ", " (tt "text") ", " (tt "json") ", " (tt "png") ", " (tt "xml") ".") (dl (dt (tt "content-type-&c.")) (dd "The content-type-and--prolog, e.g. " (tt "xhtml"))) (highlight scheme "(define display-content-type-&c.\n  (case-lambda\n    (() (display-content-type-&c. (default-content-type-&c.)))\n    ((content-type-&c.) ((alist-ref content-type-&cs. content-type-&c.)))))"))) (section 4 (tt "display-status-&c.") (def (sig (procedure "(display-status-&c.) → unspecified" (id display-status-&c.)) (procedure "(display-status-&c. status) → unspecified" (id display-status-&c.)) (procedure "(display-status-&c. status content-type . rest) → unspecified" (id display-status-&c.))) (p "Display the status, content-type and prolog.") (dl (dt (tt "status")) (dd "Status code, e.g. " (tt "status-no-content") " or 204") (dt (tt "content-type")) (dd "Content-type, e.g. " (tt "xhtml")) (dt (tt "rest")) (dd "Optional arguments to the status, e.g. " (tt "location") " in the case of 300")) (highlight scheme "(define display-status-&c.\n  (case-lambda\n    (() (display-status-&c. (default-status)))\n    ((status) (display-status-&c. status (default-content-type)))\n    ((status content-type . rest)\n     (display-status status)\n     (apply (alist-ref/default statuses status void) rest)\n     (display-content-type-&c. content-type))))"))) (section 4 (tt "query-client-any") (def (sig (procedure "(query-client-any query key) → string" (id query-client-any)) (procedure "(query-client-any query key default) → string" (id query-client-any))) (p "Return the first client parameter (e.g. {get,post,cookie}-parameter) corresponding to the key.") (dl (dt (tt "key")) (dd "The key whose value to extract") (dt (tt "default")) (dd "A default value if " (tt "key") " doesn't exist")) (highlight scheme "(define query-client-any\n  (case-lambda\n    ((query key) (alist-any (query-client query) key))\n    ((query key default) (alist-any (query-client query) key default))))"))) (section 4 (tt "query-client-all") (def (sig (procedure "(query-client-all query key) → list" (id query-client-all)) (procedure "(query-client-all query key default) → list" (id query-client-all))) (p "Return a list of client parameters (e.g. {get,post,cookie}-parameters) corresponding to the key.") (dl (dt (tt "key")) (dd "The key whose value to extract") (dt (tt "default")) (dd "A default value if " (tt "key") " doesn't exist")) (highlight scheme "(define query-client-all\n  (case-lambda\n    ((query key) (alist-all (query-client query) key))\n    ((query key default) (alist-all (query-client query) key default))))"))) (section 4 (tt "query-server-any") (def (sig (procedure "(query-server-any query key) → string" (id query-server-any)) (procedure "(query-server-any query key default) → string" (id query-server-any))) (p "Return the first client parameter (e.g. environment-variable) corresponding to the key.") (dl (dt (tt "key")) (dd "The key whose value to extract") (dt (tt "default")) (dd "A default value if " (tt "key") " doesn't exist")) (highlight scheme "(define query-server-any\n  (case-lambda\n    ((query key) (alist-any (query-server query) key))\n    ((query key default) (alist-any (query-server query) key default))))"))) (section 4 (tt "query-server-all") (def (sig (procedure "(query-server-all query key) → list" (id query-server-all)) (procedure "(query-server-all query key default) → list" (id query-server-all))) (p "Return a list of client parameters (e.g. environment-variables) corresponding to the key.") (dl (dt (tt "key")) (dd "The key whose value to extract") (dt (tt "default")) (dd "A default value if " (tt "key") " doesn't exist")) (highlight scheme "(define query-server-all\n  (case-lambda\n    ((query key) (alist-all (query-server query) key))\n    ((query key default) (alist-all (query-server query) key default))))"))) (section 4 (tt "query-any") (def (sig (procedure "(query-any query key) → string" (id query-any)) (procedure "(query-any query key default) → string" (id query-any))) (p "Return the first client or server parameter (see above) corresponding to the key.") (dl (dt (tt "key")) (dd "The key whose value to extract") (dt (tt "default")) (dd "A default value if " (tt "key") " doesn't exist")) (highlight scheme "(define query-any\n  (case-lambda\n    ((query key) (alist-any (query-promiscuous query) key))\n    ((query key default) (alist-any (query-promiscuous query) key default))))"))) (section 4 (tt "query-all") (def (sig (procedure "(query-all query key) → list" (id query-all)) (procedure "(query-all query key default) → list" (id query-all))) (p "Return a list of client or server parameters (see above) corresponding to the key.") (dl (dt (tt "key")) (dd "The key whose value to extract") (dt (tt "default")) (dd "A default value if " (tt "key") " doesn't exist")) (highlight scheme "(define query-all\n  (case-lambda\n    ((query key) (alist-all (query-promiscuous query) key))\n    ((query key default) (alist-all (query-promiscuous query) key default))))"))) (section 4 (tt "call-with-dynamic-fastcgi-query") (def (sig (procedure "(call-with-dynamic-fastcgi-query quaerendum) → unspecified" (id call-with-dynamic-fastcgi-query))) (p "Start a dynamic FastCGI server where output is bound to stdout; and where a monadic function taking a query-record is called for every request.") (dl (dt (tt "quaerendum")) (dd "A monadic function receiving a query parameter")) (highlight scheme "(define (call-with-dynamic-fastcgi-query quaerendum)\n  (fcgi-dynamic-server-accept-loop\n    (lambda (in out err env)\n      (let ((environment\n              (map (match-lambda\n                     ((key . value) (cons (env-string->symbol key) value)))\n                   (env)))\n            (cookies\n              (form-urldecode\n                (let ((cookies\n                        (string-delete\n                          char-set:whitespace\n                          (env \"HTTP_COOKIE\" \"\"))))\n                  (and (not (string-null? cookies)) cookies))))\n            (cookies2\n              (form-urldecode\n                (let ((cookies\n                        (string-delete\n                          char-set:whitespace\n                          (env \"HTTP_COOKIE2\" \"\"))))\n                  (and (not (string-null? cookies)) cookies))))\n            (post-data (form-urldecode (fcgi-get-post-data in env)))\n            (query (form-urldecode\n                     (let ((query (env \"QUERY_STRING\")))\n                       (and (not (string-null? query)) query)))))\n        (parameterize\n          ((current-output-port\n             (make-output-port (lambda (scribendum) (out scribendum)) void))\n           (current-error-port\n             (make-output-port (lambda (errandum) (err errandum)) void)))\n          (quaerendum\n            (make-query\n              environment\n              (append cookies cookies2 post-data query))))))))")) (section 5 "Examples" (p "An authorization server") (pre "(call-with-auth-db \n  (lambda (connection)\n    (call-with-dynamic-fastcgi-query \n      (lambda (query)\n        (let ((user (query-server-any query 'remote-user))\n              (password (query-server-any query 'remote-passwd)))\n          (let ((status\n                 (if (valid? connection user password \"physician\")\n                     status-ok\n                     status-unauthorized)))\n            (display-status-&c. status)))))))"))) (section 4 (tt "call-with-cgi-query") (def (sig (procedure "(call-with-cgi-query quaerendum) → unspecified" (id call-with-cgi-query))) (p "Gather parameters (including post-variables, query-variables, cookies, server-variables) into an association-list when called as a CGI program.") (dl (dt (tt "quaerendum")) (dd "A monadic function receiving a query parameter")) (highlight scheme "(define (call-with-cgi-query quaerendum)\n  (let ((environment\n          (alist-map\n            (lambda (key value) (cons (env-string->symbol key) value))\n            (get-environment-variables))))\n    (quaerendum\n      (make-query\n        environment\n        (remove-null-artifacts\n          (append\n            (form-urldecode-environment environment 'http-cookie)\n            (form-urldecode-environment environment 'http-cookie2)\n            (form-urldecode-environment environment 'query-string)\n            (form-urldecode-with-separator (read-all))))))))")) (section 5 "Examples" (p "Prints out the environment.") (pre "(call-with-cgi-query \n  (lambda (query) (display-content-type-&c. 'text) (display query)))")))) (section 3 "About this egg" (section 4 "Author" (p (int-link "/users/klutometis" "Peter Danenberg"))) (section 4 "Repository" (p (link "https://github.com/klutometis/call-with-query"))) (section 4 "License" (p "GPL-3")) (section 4 "Dependencies" (ul (li (int-link "alist-lib")) (li (int-link "args")) (li (int-link "call-with-environment-variables")) (li (int-link "debug")) (li (int-link "define-record-and-printer")) (li (int-link "fastcgi")) (li (int-link "format")) (li (int-link "hahn")) (li (int-link "matchable")) (li (int-link "regex")) (li (int-link "setup-helper")) (li (int-link "uri-common")))) (section 4 "Versions" (dl (dt (link "https://github.com/klutometis/call-with-query/releases/tag/0.1" "0.1")) (dd "First release") (dt (link "https://github.com/klutometis/call-with-query/releases/tag/0.2" "0.2")) (dd "Record-printer for queries") (dt (link "https://github.com/klutometis/call-with-query/releases/tag/0.2.1" "0.2.1")) (dd "JSON and PNG") (dt (link "https://github.com/klutometis/call-with-query/releases/tag/0.2.2" "0.2.2")) (dd "HTML5") (dt (link "https://github.com/klutometis/call-with-query/releases/tag/0.2.3" "0.2.3")) (dd "Remove dependency on regex.") (dt (link "https://github.com/klutometis/call-with-query/releases/tag/0.2.4" "0.2.4")) (dd "Fix irregex.") (dt (link "https://github.com/klutometis/call-with-query/releases/tag/0.2.5" "0.2.5")) (dd "Add pdf.") (dt (link "https://github.com/klutometis/call-with-query/releases/tag/0.2.6" "0.2.6")) (dd "Add XML.") (dt (link "https://github.com/klutometis/call-with-query/releases/tag/0.2.7" "0.2.7")) (dd "Remove the dependency on setup-helper-cock.") (dt (link "https://github.com/klutometis/call-with-query/releases/tag/0.2.8" "0.2.8")) (dd "Remove debug.") (dt (link "https://github.com/klutometis/call-with-query/releases/tag/0.2.9" "0.2.9")) (dd "Add call-with-cgi-query.") (dt (link "https://github.com/klutometis/call-with-query/releases/tag/0.2.10" "0.2.10")) (dd "Remove null-artifacts.") (dt (link "https://github.com/klutometis/call-with-query/releases/tag/0.2.11" "0.2.11")) (dd "Use hahn."))) (section 4 "Colophon" (p "Documented by " (int-link "/egg/hahn" "hahn") ".")))))