1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253 |
- #!/usr/bin/guile -s
- !#
- (use-modules (web server)) ; you probably did this already
- (use-modules (web request)
- (web response)
- (sxml simple)
- (web uri))
- (define (request-path-components request)
- (split-and-decode-uri-path (uri-path (request-uri request))))
- (define (hello-hacker-handler request body)
- (cond ((equal? (request-path-components request)
- '("hacker"))
- (values '((content-type . (text/plain)))
- "Hello hacker!"))
- (else (not-found request))))
- ;;(run-server hello-hacker-handler)
- (define* (respond #:optional body #:key
- (status 200)
- (title "Hello hello!")
- (doctype "<!DOCTYPE html>\n")
- (content-type-params '((charset . "utf-8")))
- (content-type 'text/html)
- (extra-headers '())
- (sxml (and body (templatize title body))))
- (values (build-response
- #:code status
- #:headers `((content-type
- . (,content-type ,@content-type-params))
- ,@extra-headers))
- (lambda (port)
- (if sxml
- (begin
- (if doctype (display doctype port))
- (sxml->xml sxml port))))))
- (define (debug-page request body)
- (respond
- `((h1 "hello world!")
- (table
- (tr (th "header") (th "value"))
- ,@(map (lambda (pair)
- `(tr (td (tt ,(with-output-to-string
- (lambda () (display (car pair))))))
- (td (tt ,(with-output-to-string
- (lambda ()
- (write (cdr pair))))))))
- (request-headers request))))))
- (run-server debug-page)
|