web-server.scm 1.8 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253
  1. #!/usr/bin/guile -s
  2. !#
  3. (use-modules (web server)) ; you probably did this already
  4. (use-modules (web request)
  5. (web response)
  6. (sxml simple)
  7. (web uri))
  8. (define (request-path-components request)
  9. (split-and-decode-uri-path (uri-path (request-uri request))))
  10. (define (hello-hacker-handler request body)
  11. (cond ((equal? (request-path-components request)
  12. '("hacker"))
  13. (values '((content-type . (text/plain)))
  14. "Hello hacker!"))
  15. (else (not-found request))))
  16. ;;(run-server hello-hacker-handler)
  17. (define* (respond #:optional body #:key
  18. (status 200)
  19. (title "Hello hello!")
  20. (doctype "<!DOCTYPE html>\n")
  21. (content-type-params '((charset . "utf-8")))
  22. (content-type 'text/html)
  23. (extra-headers '())
  24. (sxml (and body (templatize title body))))
  25. (values (build-response
  26. #:code status
  27. #:headers `((content-type
  28. . (,content-type ,@content-type-params))
  29. ,@extra-headers))
  30. (lambda (port)
  31. (if sxml
  32. (begin
  33. (if doctype (display doctype port))
  34. (sxml->xml sxml port))))))
  35. (define (debug-page request body)
  36. (respond
  37. `((h1 "hello world!")
  38. (table
  39. (tr (th "header") (th "value"))
  40. ,@(map (lambda (pair)
  41. `(tr (td (tt ,(with-output-to-string
  42. (lambda () (display (car pair))))))
  43. (td (tt ,(with-output-to-string
  44. (lambda ()
  45. (write (cdr pair))))))))
  46. (request-headers request))))))
  47. (run-server debug-page)