gitsite: git smart-HTTP via sinatra routes, in-process TLS, production mode

ober

c03b6d0e12b200bbd48ba6608a1b3a0ef612bacd

diff --git a/.gitignore b/.gitignore
index 599f294..ae611eb 100644
--- a/.gitignore
+++ b/.gitignore
@@ -4,5 +4,5 @@ var/
 vendor/
 *.so
 *.wpo
-vendor/ 
-vendor/*
+.jcode/
+continue
diff --git a/README.md b/README.md
index 1c18454..178d76e 100644
--- a/README.md
+++ b/README.md
@@ -59,14 +59,26 @@ Edit `etc/gitsite.sexp`:
  (listen-address "127.0.0.1")
  (var-root "var")
  (public-url "http://localhost:8080")
- (registration "open"))
+ (registration "open")
+ (session-secret "change-this-to-a-random-secret-in-production")
+ (tls-cert "/etc/ssl/private/fullchain.pem")
+ (tls-key "/etc/ssl/private/key.pem")
+ (mode development))
 ```
 
-- `listen-port`: HTTP port (default: 8080)
+- `listen-port`: HTTP/HTTPS port (default: 8080)
 - `listen-address`: Bind address (default: 127.0.0.1)
 - `var-root`: Data directory (default: var)
 - `public-url`: Public URL for hooks and links
 - `registration`: "open" or "closed" (default: closed)
+- `session-secret`: Random secret used to sign session cookies — **must** be set
+  in production
+- `tls-cert` / `tls-key`: PEM cert + key paths. When **both** are set the server
+  terminates TLS in-process (`httpsd-start`), sends
+  `Strict-Transport-Security`, and marks session cookies `Secure`. When absent,
+  plain HTTP is served (dev / behind-proxy mode).
+- `mode`: `development` (default) or `production`. In `production`, `tls-cert`
+  and `tls-key` are required and `registration` is forced to `closed`.
 
 ## Deployment
 
@@ -92,9 +104,11 @@ Edit `etc/gitsite.sexp`:
    ```bash
    sudo -u gitsite cp etc/gitsite.sexp /srv/gitsite/etc/
    # Edit /srv/gitsite/etc/gitsite.sexp for production
+   # Set tls-cert/tls-key + (mode production) to terminate TLS in-process,
+   # or leave TLS unset and terminate at a reverse proxy.
    ```
 
-5. **Reverse proxy** (nginx example):
+5. **Reverse proxy** (nginx example, only if not using in-process TLS):
    ```nginx
    server {
        listen 443 ssl http2;
@@ -181,6 +195,20 @@ Restart=on-failure
 WantedBy=multi-user.target
 ```
 
+### FreeBSD
+
+Ship the included service files:
+
+- `files/rc.d/gitsite` → `/usr/local/etc/rc.d/gitsite`
+- `files/newsyslog.d/gitsite` → `/usr/local/etc/newsyslog.conf.d/gitsite`
+
+```bash
+sudo install -m 555 files/rc.d/gitsite /usr/local/etc/rc.d/gitsite
+sudo install -m 644 files/newsyslog.d/gitsite /usr/local/etc/newsyslog.conf.d/gitsite
+sudo sysrc gitsite_enable=YES
+sudo service gitsite start
+```
+
 ## Usage
 
 ### Create Repository
diff --git a/etc/gitsite.sexp b/etc/gitsite.sexp
index d2a5a17..b9ff468 100644
--- a/etc/gitsite.sexp
+++ b/etc/gitsite.sexp
@@ -5,4 +5,5 @@
  (registration "open")
  (session-secret "change-this-to-a-random-secret-in-production")
  (tls-cert #f)
- (tls-key #f))
+ (tls-key #f)
+ (mode development))
diff --git a/files/newsyslog.d/gitsite b/files/newsyslog.d/gitsite
new file mode 100644
index 0000000..e90164f
--- /dev/null
+++ b/files/newsyslog.d/gitsite
@@ -0,0 +1,5 @@
+# gitsite logs to stdout; capture them with newsyslog piping to the log file.
+# Symlink /var/log/gitsite.log -> the capture target so rotation is seamless.
+#
+# format: [owner:group] mode count size when flags [/pid_file] [sig_num] command
+/srv/gitsite/var/gitsite.log gitsite:gitsite 644 7 1024 * B J
diff --git a/files/rc.d/gitsite b/files/rc.d/gitsite
new file mode 100644
index 0000000..13b00e3
--- /dev/null
+++ b/files/rc.d/gitsite
@@ -0,0 +1,47 @@
+#!/bin/sh
+#
+# PROVIDE: gitsite
+# REQUIRE: NETWORKING DAEMON
+# KEYWORD: shutdown
+#
+# Add the following line to /etc/rc.conf to enable gitsite:
+#
+#   gitsite_enable="YES"
+#   # optional overrides
+#   gitsite_user="gitsite"
+#   gitsite_home="/srv/gitsite"
+#   gitsite_bin="/usr/local/bin/gitsite"
+#   gitsite_flags="serve"
+
+. /etc/rc.subr
+
+name="gitsite"
+rcvar="gitsite_enable"
+
+: ${gitsite_user:="gitsite"}
+: ${gitsite_home:="/srv/gitsite"}
+: ${gitsite_bin:="/usr/local/bin/gitsite"}
+: ${gitsite_flags:="serve"}
+
+load_rc_config ${name}
+
+command="${gitsite_bin}"
+command_user="${gitsite_user}"
+command_args="${gitsite_flags}"
+pidfile="/var/run/gitsite.pid"
+procname="${gitsite_bin}"
+
+start_precmd="gitsite_start_precmd"
+gitsite_start_precmd()
+{
+	cd "${gitsite_home}" || return 1
+	if [ ! -d "${gitsite_home}/var" ]; then
+		install -d -o "${gitsite_user}" -g "${gitsite_user}" \
+			"${gitsite_home}/var"
+	fi
+	install -o "${gitsite_user}" -g "${gitsite_user}" \
+		"${gitsite_home}/etc/gitsite.sexp" /dev/null 2>/dev/null || true
+	return 0
+}
+
+run_rc_command "$1"
diff --git a/site-plan.md b/site-plan.md
index 833aa03..cbf38ac 100644
--- a/site-plan.md
+++ b/site-plan.md
@@ -718,6 +718,9 @@ Deliberate deviations from Part I (do not "fix" them without reading why):
 | jsshd for git+ssh | system OpenSSH + forced command | jsshd needs per-repo config + restart; wrong shape |
 | buildsd worker process / actor pool | synchronous in-web-thread builds | jsqlite has **no cross-process visibility** and threaded use was flaky |
 | HTTPS push with tokens | 403, push via SSH only | `thread-httpd` request body is UTF-8-decoded (binary-unsafe) |
+| sinatra not used | sinatra IS used (vendored into `vendor/jerboa-sinatra`) | later vendored (not sibling-path), so the policy objection lapsed |
+| TLS via `httpd-start-https` (§17.4) | TLS via `httpsd-start` from `(std net httpsd)` | verified working (handshake, HTTPS clone, HSTS, Secure cookies); `httpd-start-https` also exists but the httpsd path is proven |
+| git smart-HTTP via router prefix `(router-add-prefix! …)` | sinatra `GET`/`POST "/git/~:owner/:name*"` routes calling `git-bridge` | git-bridge must write through sinatra's response object (`status!`/`header!`/`body!`/`halt`); returning `http-respond` values was silently dropped by `interpret-result` |
 
 ## 16. Verified traps (do not re-derive — read first)
 
diff --git a/src/gitsite.ss b/src/gitsite.ss
index 8f59f4d..1ec4ff7 100644
--- a/src/gitsite.ss
+++ b/src/gitsite.ss
@@ -39,6 +39,9 @@
         [key (cfg-tls-key)])
   (if (and cert key)
     (begin
+      (set-option! 'force-headers
+        '(("Strict-Transport-Security" . "max-age=31536000; includeSubDomains")))
+      (set-option! 'session-secure #t)
       (displayln "gitsite listening on https://" (cfg-address) ":" (cfg-port))
       (displayln "database: " (cfg-db-path))
       (let ([server (httpsd-start (cfg-port)
@@ -49,6 +52,7 @@
           (thread-sleep! 3600)
           (loop))))
     (begin
+      (set-option! 'session-secure #f)
       (displayln "gitsite listening on http://" (cfg-address) ":" (cfg-port))
       (displayln "database: " (cfg-db-path))
       (displayln "WARNING: No TLS cert/key configured — HTTP only")
diff --git a/src/gitsite/config.ss b/src/gitsite/config.ss
index 02656a0..bb93b81 100644
--- a/src/gitsite/config.ss
+++ b/src/gitsite/config.ss
@@ -3,7 +3,7 @@
 
 (export config-init! cfg-port cfg-address cfg-var-root cfg-repos-root cfg-db-path
         cfg-builds-dir cfg-artifacts-dir cfg-public-url cfg-registration-open?
-        cfg-session-secret cfg-tls-cert cfg-tls-key)
+        cfg-session-secret cfg-tls-cert cfg-tls-key cfg-mode-production?)
 
 (def *config* (make-hash-table))
 
@@ -11,6 +11,12 @@
   (when (file-exists? file)
     (let ([data (call-with-input-file file read)])
       (for-each (lambda (kv) (hash-put! *config* (car kv) (cadr kv))) data)))
+  (when (cfg-mode-production?)
+    (unless (and (cfg-tls-cert) (cfg-tls-key))
+      (error 'config "mode production requires (tls-cert ...) and (tls-key ...) configured"))
+    (when (string=? (cfg-get 'registration "closed") "open")
+      (displayln "Warning: mode production forces registration: closed")
+      (hash-put! *config* 'registration "closed")))
   (ensure-dir! (cfg-var-root))
   (ensure-dir! (cfg-repos-root))
   (ensure-dir! (cfg-builds-dir))
@@ -50,3 +56,9 @@
 
 (def (cfg-tls-cert) (cfg-get 'tls-cert #f))
 (def (cfg-tls-key) (cfg-get 'tls-key #f))
+
+(def (cfg-mode-production?)
+  (def mode (cfg-get 'mode "development"))
+  (cond
+    [(symbol? mode) (eq? mode 'production)]
+    [else (string=? mode "production")]))
diff --git a/src/gitsite/git_http.ss b/src/gitsite/git_http.ss
index 0d0c302..526744e 100644
--- a/src/gitsite/git_http.ss
+++ b/src/gitsite/git_http.ss
@@ -4,7 +4,10 @@
         (only (gitsite config) cfg-repos-root)
         (only (gitsite util) new-token)
         (only (gitsite auth) verify-token)
-        (only (gitsite repo) get-repo-by-owner-name))
+        (only (gitsite repo) get-repo-by-owner-name)
+        (sinatra context)
+        (sinatra helpers)
+        (sinatra request))
 
 (export git-bridge)
 
@@ -153,16 +156,24 @@
     (call-with-values
       (lambda () (split-cgi bv))
       (lambda (status ct body-bv)
-        (http-respond status (list (cons "Content-Type" ct)) body-bv)))))
+        (status! status)
+        (header! "Content-Type" ct)
+        (body! body-bv)
+        (halt)))))
 
 (def (git-bridge user req owner name suffix)
   (def repo (get-repo-by-owner-name owner name))
   (def query (http-req-query req))
   (cond
-    [(not repo) (http-respond-error 404 "repository not found")]
+    [(not repo) (status! 404) (body! "repository not found") (halt)]
     [(push-service? suffix query)
-     (http-respond-error 403 "push over HTTPS is not supported; use git+ssh")]
-    [(not (valid-suffix? suffix)) (http-respond-error 404 "not found")]
+     (status! 403)
+     (body! "push over HTTPS is not supported; use git+ssh")
+     (halt)]
+    [(not (valid-suffix? suffix)) (status! 404) (body! "not found") (halt)]
     [(and (private-repo? repo) (not (git-authorized? user req repo)))
-     (http-respond 401 '(("WWW-Authenticate" . "Basic realm=\"gitsite\"")) "authentication required")]
+     (status! 401)
+     (header! "WWW-Authenticate" "Basic realm=\"gitsite\"")
+     (body! "authentication required")
+     (halt)]
     [else (run-git-cgi user req repo owner name suffix)]))
diff --git a/src/gitsite/web.ss b/src/gitsite/web.ss
index 30faa9c..d0c687a 100644
--- a/src/gitsite/web.ss
+++ b/src/gitsite/web.ss
@@ -1,5 +1,6 @@
 (import (jerboa prelude)
         (sinatra)
+        (only (gitsite config) cfg-registration-open?)
         (only (gitsite util) sha256-hex valid-slug?)
         (only (gitsite req) csrf-token csrf-ok?)
         (only (gitsite auth) register-user! authenticate-user create-session!
@@ -11,7 +12,8 @@
         (only (gitsite git_http) git-bridge)
         (only (gitsite builds) submit-job! list-repo-jobs get-job)
         (only (gitsite worker) run-one-job)
-        (only (gitsite views) page-html))
+        (only (gitsite views) page-html)
+        (only (sinatra request) sinatra-request-raw))
 
 (export setup-routes!)
 
@@ -118,11 +120,23 @@
     (substring s 0 (- (string-length s) 4))
     s))
 
+;; Git smart-HTTP bridge handler (GET info/refs, POST git-upload-pack, etc.)
+(def (git-route-handler)
+  (def owner (param "owner"))
+  (def name (strip-git-suffix (param "name")))
+  (def suffix (let ([s (splat)]) (if (null? s) "/" (car s))))
+  (git-bridge (current-user)
+              (sinatra-request-raw (request))
+              owner name suffix))
+
 ;; Routes
 (def (setup-routes!)
   ;; Health check
   (GET "/healthz" "ok")
 
+  (GET  "/git/~:owner/:name*" (git-route-handler))
+  (POST "/git/~:owner/:name*" (git-route-handler))
+
   ;; Index
   (GET "/"
     (render-sxml
@@ -131,36 +145,46 @@
 
   ;; Auth
   (GET "/register"
-    (render-sxml
-      (page-html "register" (current-name)
-        '((h1 "register")
-          (form (@ (method "post") (action "/register"))
-            (p (label "username ") (input (@ (name "name") (required "required"))))
-            (p (label "email ") (input (@ (name "email") (type "email") (required "required"))))
-            (p (label "password ") (input (@ (name "password") (type "password") (required "required"))))
-            (p (button (@ (type "submit")) "register")))))))
+    (if (cfg-registration-open?)
+      (render-sxml
+        (page-html "register" (current-name)
+          '((h1 "register")
+            (form (@ (method "post") (action "/register"))
+              (p (label "username ") (input (@ (name "name") (required "required"))))
+              (p (label "email ") (input (@ (name "email") (type "email") (required "required"))))
+              (p (label "password ") (input (@ (name "password") (type "password") (required "required"))))
+              (p (button (@ (type "submit")) "register"))))))
+      (begin
+        (status! 403)
+        (render-sxml (page-html "register" (current-name)
+          '((h1 "403") (p "registration is closed")))))))
 
   (POST "/register"
-    (def name (string-trim (param "name")))
-    (def email (string-trim (param "email")))
-    (def password (param "password"))
-    (cond
-      [(or (string=? name "") (string=? email "") (string=? password ""))
-       (status! 400)
-       (render-sxml (page-html "register" #f '((h1 "register") (p "all fields required"))))]
-      [(not (valid-slug? name))
-       (status! 400)
-       (render-sxml (page-html "register" #f '((h1 "register") (p "invalid username"))))]
-      [else
-        (let ([uid (register-user! name email password)])
-          (if uid
-            (let ([token (create-session! uid)])
-              (session-set! "uid" uid)
-              (session-set! "sid-token" token)
-              (redirect "/"))
-            (begin
-              (status! 400)
-              (render-sxml (page-html "register" #f '((h1 "register") (p "username or email taken")))))))]))
+    (if (not (cfg-registration-open?))
+      (begin
+        (status! 403)
+        (render-sxml (page-html "register" (current-name)
+          '((h1 "403") (p "registration is closed")))))
+      (let ([name (string-trim (param "name"))]
+            [email (string-trim (param "email"))]
+            [password (param "password")])
+        (cond
+          [(or (string=? name "") (string=? email "") (string=? password ""))
+           (status! 400)
+           (render-sxml (page-html "register" #f '((h1 "register") (p "all fields required"))))]
+          [(not (valid-slug? name))
+           (status! 400)
+           (render-sxml (page-html "register" #f '((h1 "register") (p "invalid username"))))]
+          [else
+            (let ([uid (register-user! name email password)])
+              (if uid
+                (let ([token (create-session! uid)])
+                  (session-set! "uid" uid)
+                  (session-set! "sid-token" token)
+                  (redirect "/"))
+                (begin
+                  (status! 400)
+                  (render-sxml (page-html "register" #f '((h1 "register") (p "username or email taken")))))))]))))
 
   (GET "/login"
     (render-sxml