stellarskylark
/
starvat
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Indentation fix 

Plus a couple changes I couldn't be bothered to isolate.
This commit is contained in:
Skylar Hill 2023-11-11 02:22:00 -06:00
parent 61e8ea172f
commit 7323235bd6
4 changed files with 277 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

186
.dir-locals.el Normal file
View File

@ -0,0 +1,186 @@
;; Per-directory local variables for GNU Emacs 23 and later.
((nil
. ((fill-column . 78)
(tab-width . 8)
(sentence-end-double-space . t)
;; For use with 'bug-reference-prog-mode'. Extra bug-reference
;; configuration should be done in your Emacs user configuration file;
;; refer to (info (guix) The Perfect Setup).
(bug-reference-bug-regexp
. "\\(<https?://\\bugs\\.gnu\\.org/\\([0-9]+\\)>\\)")
(bug-reference-url-format . "https://issues.guix.gnu.org/%s")
(eval . (add-to-list 'completion-ignored-extensions ".go"))
;; Emacs-Guix
(eval . (setq-local guix-directory
(locate-dominating-file default-directory
".dir-locals.el")))
;; YASnippet
(eval . (with-eval-after-load
'yasnippet
(let ((guix-yasnippets
(expand-file-name
"etc/snippets/yas"
(locate-dominating-file default-directory
".dir-locals.el"))))
(unless (member guix-yasnippets yas-snippet-dirs)
(add-to-list 'yas-snippet-dirs guix-yasnippets)
(yas-reload-all)))))
;; Geiser
;; This allows automatically setting the `geiser-guile-load-path'
;; variable when using various Guix checkouts (e.g., via git worktrees).
(geiser-repl-per-project-p . t)))
(c-mode . ((c-file-style . "gnu")))
(scheme-mode
.
((indent-tabs-mode . nil)
(eval . (put 'eval-when 'scheme-indent-function 1))
(eval . (put 'call-with-prompt 'scheme-indent-function 1))
(eval . (put 'test-assert 'scheme-indent-function 1))
(eval . (put 'test-assertm 'scheme-indent-function 1))
(eval . (put 'test-equalm 'scheme-indent-function 1))
(eval . (put 'test-equal 'scheme-indent-function 1))
(eval . (put 'test-eq 'scheme-indent-function 1))
(eval . (put 'call-with-input-string 'scheme-indent-function 1))
(eval . (put 'call-with-port 'scheme-indent-function 1))
(eval . (put 'guard 'scheme-indent-function 1))
(eval . (put 'lambda* 'scheme-indent-function 1))
(eval . (put 'substitute* 'scheme-indent-function 1))
(eval . (put 'match-record 'scheme-indent-function 3))
(eval . (put 'match-record-lambda 'scheme-indent-function 2))
;; TODO: Contribute these to Emacs' scheme-mode.
(eval . (put 'let-keywords 'scheme-indent-function 3))
;; 'modify-inputs' and its keywords.
(eval . (put 'modify-inputs 'scheme-indent-function 1))
(eval . (put 'replace 'scheme-indent-function 1))
;; 'modify-phases' and its keywords.
(eval . (put 'modify-phases 'scheme-indent-function 1))
(eval . (put 'replace 'scheme-indent-function 1))
(eval . (put 'add-before 'scheme-indent-function 2))
(eval . (put 'add-after 'scheme-indent-function 2))
(eval . (put 'modify-services 'scheme-indent-function 1))
(eval . (put 'with-directory-excursion 'scheme-indent-function 1))
(eval . (put 'with-file-lock 'scheme-indent-function 1))
(eval . (put 'with-file-lock/no-wait 'scheme-indent-function 1))
(eval . (put 'with-profile-lock 'scheme-indent-function 1))
(eval . (put 'with-writable-file 'scheme-indent-function 2))
(eval . (put 'package 'scheme-indent-function 0))
(eval . (put 'package/inherit 'scheme-indent-function 1))
(eval . (put 'origin 'scheme-indent-function 0))
(eval . (put 'build-system 'scheme-indent-function 0))
(eval . (put 'bag 'scheme-indent-function 0))
(eval . (put 'graft 'scheme-indent-function 0))
(eval . (put 'operating-system 'scheme-indent-function 0))
(eval . (put 'file-system 'scheme-indent-function 0))
(eval . (put 'manifest-entry 'scheme-indent-function 0))
(eval . (put 'manifest-pattern 'scheme-indent-function 0))
(eval . (put 'substitute-keyword-arguments 'scheme-indent-function 1))
(eval . (put 'with-store 'scheme-indent-function 1))
(eval . (put 'with-external-store 'scheme-indent-function 1))
(eval . (put 'with-error-handling 'scheme-indent-function 0))
(eval . (put 'with-mutex 'scheme-indent-function 1))
(eval . (put 'with-atomic-file-output 'scheme-indent-function 1))
(eval . (put 'call-with-compressed-output-port 'scheme-indent-function 2))
(eval . (put 'call-with-decompressed-port 'scheme-indent-function 2))
(eval . (put 'call-with-gzip-input-port 'scheme-indent-function 1))
(eval . (put 'call-with-gzip-output-port 'scheme-indent-function 1))
(eval . (put 'call-with-lzip-input-port 'scheme-indent-function 1))
(eval . (put 'call-with-lzip-output-port 'scheme-indent-function 1))
(eval . (put 'signature-case 'scheme-indent-function 1))
(eval . (put 'emacs-batch-eval 'scheme-indent-function 0))
(eval . (put 'emacs-batch-edit-file 'scheme-indent-function 1))
(eval . (put 'emacs-substitute-sexps 'scheme-indent-function 1))
(eval . (put 'emacs-substitute-variables 'scheme-indent-function 1))
(eval . (put 'with-derivation-narinfo 'scheme-indent-function 1))
(eval . (put 'with-derivation-substitute 'scheme-indent-function 2))
(eval . (put 'with-status-report 'scheme-indent-function 1))
(eval . (put 'with-status-verbosity 'scheme-indent-function 1))
(eval . (put 'with-build-handler 'scheme-indent-function 1))
(eval . (put 'mlambda 'scheme-indent-function 1))
(eval . (put 'mlambdaq 'scheme-indent-function 1))
(eval . (put 'syntax-parameterize 'scheme-indent-function 1))
(eval . (put 'with-monad 'scheme-indent-function 1))
(eval . (put 'mbegin 'scheme-indent-function 1))
(eval . (put 'mwhen 'scheme-indent-function 1))
(eval . (put 'munless 'scheme-indent-function 1))
(eval . (put 'mlet* 'scheme-indent-function 2))
(eval . (put 'mlet 'scheme-indent-function 2))
(eval . (put 'mparameterize 'scheme-indent-function 2))
(eval . (put 'run-with-store 'scheme-indent-function 1))
(eval . (put 'run-with-state 'scheme-indent-function 1))
(eval . (put 'wrap-program 'scheme-indent-function 1))
(eval . (put 'wrap-script 'scheme-indent-function 1))
(eval . (put 'with-imported-modules 'scheme-indent-function 1))
(eval . (put 'with-extensions 'scheme-indent-function 1))
(eval . (put 'with-parameters 'scheme-indent-function 1))
(eval . (put 'let-system 'scheme-indent-function 1))
(eval . (put 'with-build-variables 'scheme-indent-function 2))
(eval . (put 'with-database 'scheme-indent-function 2))
(eval . (put 'call-with-database 'scheme-indent-function 1))
(eval . (put 'call-with-transaction 'scheme-indent-function 1))
(eval . (put 'with-statement 'scheme-indent-function 3))
(eval . (put 'call-with-retrying-transaction 'scheme-indent-function 1))
(eval . (put 'call-with-savepoint 'scheme-indent-function 1))
(eval . (put 'call-with-retrying-savepoint 'scheme-indent-function 1))
(eval . (put 'call-with-container 'scheme-indent-function 1))
(eval . (put 'container-excursion 'scheme-indent-function 1))
(eval . (put 'eventually 'scheme-indent-function 1))
(eval . (put 'call-with-progress-reporter 'scheme-indent-function 1))
(eval . (put 'with-repository 'scheme-indent-function 2))
(eval . (put 'with-temporary-git-repository 'scheme-indent-function 2))
(eval . (put 'with-environment-variables 'scheme-indent-function 1))
(eval . (put 'with-fresh-gnupg-setup 'scheme-indent-function 1))
(eval . (put 'with-paginated-output-port 'scheme-indent-function 1))
(eval . (put 'with-shepherd-action 'scheme-indent-function 3))
(eval . (put 'with-http-server 'scheme-indent-function 1))
;; This notably allows '(' in Paredit to not insert a space when the
;; preceding symbol is one of these.
(eval . (modify-syntax-entry ?~ "'"))
(eval . (modify-syntax-entry ?$ "'"))
(eval . (modify-syntax-entry ?+ "'"))
;; Emacs 28 changed the behavior of 'lisp-fill-paragraph', which causes the
;; first line of package descriptions to extrude past 'fill-column', and
;; somehow that is deemed more correct upstream (see:
;; https://issues.guix.gnu.org/56197).
(eval . (progn
(require 'lisp-mode)
(defun emacs27-lisp-fill-paragraph (&optional justify)
(interactive "P")
(or (fill-comment-paragraph justify)
(let ((paragraph-start
(concat paragraph-start
"\\|\\s-*\\([(;\"]\\|\\s-:\\|`(\\|#'(\\)"))
(paragraph-separate
(concat paragraph-separate "\\|\\s-*\".*[,\\.]$"))
(fill-column (if (and (integerp emacs-lisp-docstring-fill-column)
(derived-mode-p 'emacs-lisp-mode))
emacs-lisp-docstring-fill-column
fill-column)))
(fill-paragraph justify))
;; Never return nil.
t))
(setq-local fill-paragraph-function #'emacs27-lisp-fill-paragraph)))))
(emacs-lisp-mode . ((indent-tabs-mode . nil)))
(texinfo-mode . ((indent-tabs-mode . nil)
(fill-column . 72))))

52
scripts/starvat.in
View File

@ -3,13 +3,13 @@
!# !#
(use-modules (config) (use-modules (config)
(config api) (config api)
(config licenses) (config licenses)
(config parser sexp) (config parser sexp)
(ice-9 sandbox) (ice-9 sandbox)
(goblins) (goblins)
(starvat listener) (starvat listener)
(starvat handler)) (starvat handler))
(define %configuration (define %configuration
(configuration (configuration
@ -20,18 +20,18 @@
(license @LICENSE@) (license @LICENSE@)
(synopsis "A Gemini server based on Spritely's Goblins") (synopsis "A Gemini server based on Spritely's Goblins")
(description (description
"TODO") "TODO")
(keywords (keywords
(list (list
(setting (setting
(name 'resources) (name 'resources)
(default `(("localhost" . ,(string-append (getenv "HOME") (default `(("localhost" . ,(string-append (getenv "HOME")
"/gemini")))) "/gemini"))))
(test list?) (test list?)
(handler eval-in-sandbox)))) (handler eval-in-sandbox))))
(directory (list (path (given "/etc/starvat/") (directory (list (path (given "/etc/starvat/")
(eager? #f)) (eager? #f))
(in-home ".config/starvat"))) (in-home ".config/starvat")))
(parser simple-sexp-parser) (parser simple-sexp-parser)
(generate-cmdtree? #t))) (generate-cmdtree? #t)))
@ -40,18 +40,16 @@
(define listener-vat (spawn-vat)) (define listener-vat (spawn-vat))
(define handler-vat (spawn-vat)) (define handler-vat (spawn-vat))
(define listener (define listener
(with-vat listener-vat (with-vat listener-vat
(spawn ^listener 1965 (spawn ^listener 1965
(string-append (getenv "HOME") "/localhost.crt") (string-append (getenv "HOME") "/localhost.crt")
(string-append (getenv "HOME") "/localhost.key")))) (string-append (getenv "HOME") "/localhost.key"))))
(display options)
(display (option-ref options 'resources))
(define handler (define handler
(with-vat handler-vat (with-vat handler-vat
(spawn ^handler options))) (spawn ^handler options)))
(with-vat listener-vat (with-vat listener-vat
($ listener 'init) ($ listener 'init)
($ listener 'listen handler))) ($ listener 'listen handler)))
;;; Local Variables: ;;; Local Variables:
;;; mode: scheme ;;; mode: scheme

75
starvat/handler.scm
View File

@ -9,53 +9,52 @@
(define (response-code code) (define (response-code code)
(case code (case code
((input) "10") ((input) "10")
((sensitive-input) "11") ((sensitive-input) "11")
((success) "20") ((success) "20")
((redirect-temporary) "30") ((redirect-temporary) "30")
((redirect-permanent) "31") ((redirect-permanent) "31")
((temporary-failure) "40") ((temporary-failure) "40")
((server-unavailable) "41") ((server-unavailable) "41")
((cgi-error) "42") ((cgi-error) "42")
((proxy-error) "43") ((proxy-error) "43")
((slow-down) "44") ((slow-down) "44")
((permanent-failure) "50") ((permanent-failure) "50")
((not-found) "51") ((not-found) "51")
((gone) "52") ((gone) "52")
((proxy-request-refused) "53") ((proxy-request-refused) "53")
((bad-request) "59") ((bad-request) "59")
((client-certificate-required) "60") ((client-certificate-required) "60")
((certificate-not-authorised) "61") ((certificate-not-authorised) "61")
((certificate-not-valid) "62"))) ((certificate-not-valid) "62")))
(define (resource-dir hostname resources) (define (resource-dir hostname resources)
(define dir (assoc hostname resources)) (define dir (assoc hostname resources))
(if dir (if dir
(cdr dir) (cdr dir)
#f)) #f))
(define* (build-response code meta #:optional body) (define* (build-response code meta #:optional body)
(if body (if body
(string-append (response-code code) " " meta "\r\n" body) (string-append (response-code code) " " meta "\r\n" body)
(string-append (response-code code) " " meta "\r\n"))) (string-append (response-code code) " " meta "\r\n")))
(define-public (^handler bcom config) (define-public (^handler bcom config)
(define conf (spawn ^cell config)) (define conf (spawn ^cell config))
(methods (methods
((handle raw-url) ((handle raw-url)
(define url (string->uri raw-url)) (define url (string->uri raw-url))
(if (not url) (if (not url)
(build-response 'bad-request "Could not parse URL") (build-response 'bad-request "Could not parse URL")
(let ((dir (resource-dir (uri-host url) (let ((dir (resource-dir (uri-host url)
(option-ref ($ conf) 'resources)))) (option-ref ($ conf) 'resources))))
(display dir) (if (not dir)
(if (not dir) (build-response 'not-found "Unknown host")
(build-response 'not-found "Unknown host") (if (not (file-exists? (string-append dir
(if (not (file-exists? (string-append dir (uri-path url))))
(uri-path url)))) (build-response 'not-found "Unknown path")
(build-response 'not-found "Unknown path") (build-response 'success "text/gemini"
(build-response 'success "text/gemini" (call-with-input-file
(call-with-input-file (string-append dir
(string-append dir (uri-path url))
(uri-path url)) get-string-all)))))))))
get-string-all)))))))))

56
starvat/listener.scm
View File

@ -10,9 +10,9 @@
(define* (get-request port #:optional (acc "")) (define* (get-request port #:optional (acc ""))
(define next-char (get-char port)) (define next-char (get-char port))
(if (and (eq? next-char #\return) (if (and (eq? next-char #\return)
(eq? (lookahead-char port) #\newline)) (eq? (lookahead-char port) #\newline))
acc acc
(get-request port (string-append acc (string next-char))))) (get-request port (string-append acc (string next-char)))))
(define* (^listener bcom port cert key #:key exposed?) (define* (^listener bcom port cert key #:key exposed?)
(define current-port (spawn ^cell port)) (define current-port (spawn ^cell port))
@ -25,31 +25,33 @@
(set-session-default-priority! ($ server)) (set-session-default-priority! ($ server))
(methods (methods
((set-port new-port) ((set-port new-port)
($ current-port new-port)) ($ current-port new-port))
((set-credentials cert key) ((set-credentials cert key)
(set-certificate-credentials-x509-key-files! (set-certificate-credentials-x509-key-files!
($ credentials) cert key x509-certificate-format/pem)) ($ credentials) cert key x509-certificate-format/pem))
((init) ((init)
($ listening-socket ($ listening-socket
(let ((s (socket PF_INET SOCK_STREAM 0))) (let ((s (socket PF_INET SOCK_STREAM 0)))
(setsockopt s SOL_SOCKET SO_REUSEADDR 1) (setsockopt s SOL_SOCKET SO_REUSEADDR 1)
(bind s AF_INET INADDR_ANY ($ current-port)) (bind s AF_INET INADDR_ANY ($ current-port))
(fcntl s F_SETFD FD_CLOEXEC) (fcntl s F_SETFD FD_CLOEXEC)
(listen s 5) (listen s 5)
s))) s)))
((listen handler) ((listen handler)
(display handler) (let* ((session (make-session connection-end/server))
(let* ((session (make-session connection-end/server)) (sock (car (accept ($ listening-socket))))
(sock (car (accept ($ listening-socket))))) (sess-port (session-record-port session)))
(set-session-credentials! session ($ credentials)) (set-session-credentials! session ($ credentials))
(set-session-default-priority! session) (set-session-default-priority! session)
(set-session-transport-fd! session (set-session-transport-fd! session
(fileno sock)) (fileno sock))
(set-port-encoding! sock "UTF-8") (set-port-encoding! sock "UTF-8")
(handshake session) (handshake session)
(define request (get-request (session-record-port session))) (define request (get-request sess-port))
(let-on ((response (<- handler 'handle request))) (on (<- handler 'handle request)
(put-string (session-record-port session) response)) (lambda (response)
(bye session close-request/rdwr))) (put-string sess-port response)))
(bye session close-request/rdwr)
(close-port sock)))
((close) ((close)
(close ($ listening-socket))))) (close ($ listening-socket)))))