hello-world.scm 2.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475
  1. #!/usr/bin/env -S guile -e main -s
  2. !#
  3. (add-to-load-path (string-append (dirname (dirname (current-filename))) "/src"))
  4. (use-modules (gemini request)
  5. (gemini response)
  6. (gemini server)
  7. (gemini util log)
  8. (gnutls)
  9. (ice-9 getopt-long)
  10. (rnrs bytevectors)
  11. (srfi srfi-11)
  12. (srfi srfi-41)
  13. (web uri))
  14. (define (print-help args)
  15. (display (string-append "\
  16. usage: " (car args) " [options]
  17. options:
  18. -h, --help Display this help
  19. -v, --verbose Enable additional log messages
  20. -l, --listen=HOST:PORT Listen on HOST:PORT (default localhost:1965)
  21. -c, --cert=path/to/cert.pem Server certificate file
  22. -k, --key=path/to/key.pem Server private key file
  23. Start a simple Gemini server.
  24. ")))
  25. (define (handle-request req)
  26. (build-gemini-response
  27. #:status 20
  28. #:meta "text/gemini"
  29. #:body "Hello, world!"))
  30. (define (parse-address address)
  31. (cond ((not address)
  32. (values #f #f))
  33. ((string-contains address ":")
  34. (apply values (string-split address #\:)))
  35. (else
  36. (values address #f))))
  37. (define (load-credentials cert key)
  38. (let ((creds (make-certificate-credentials)))
  39. (when (and cert key)
  40. (log-debug "Loading cert: ~a" cert)
  41. (log-debug "Loading key: ~a" key)
  42. (set-certificate-credentials-x509-key-files!
  43. creds cert key x509-certificate-format/pem))
  44. creds))
  45. (define (main args)
  46. (let* ((option-spec '((help (single-char #\h) (value #f))
  47. (verbose (single-char #\v) (value #f))
  48. (listen (single-char #\l) (value #t))
  49. (cert (single-char #\c) (value #t))
  50. (key (single-char #\k) (value #t))))
  51. (opts (getopt-long args option-spec))
  52. (help (option-ref opts 'help #f))
  53. (verbose (option-ref opts 'verbose #f))
  54. (listen (option-ref opts 'listen #f))
  55. (cert (option-ref opts 'cert #f))
  56. (key (option-ref opts 'key #f)))
  57. (cond (help
  58. (print-help args))
  59. (else
  60. (when verbose
  61. (set-gemini-log-level! 'debug))
  62. (let-values (((host port) (parse-address listen))
  63. ((creds) (load-credentials cert key)))
  64. (run-server handle-request
  65. #:host host
  66. #:port port
  67. #:credentials creds))))))