cgi.scm (22255B)
1 ; Copyright (c) 2026, Natacha Porté 2 ; 3 ; Permission to use, copy, modify, and distribute this software for any 4 ; purpose with or without fee is hereby granted, provided that the above 5 ; copyright notice and this permission notice appear in all copies. 6 ; 7 ; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 8 ; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 9 ; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 10 ; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 11 ; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 12 ; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 13 ; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 14 15 (import 16 (chicken file posix) 17 (chicken io) 18 (chicken process-context) 19 (chicken string) 20 (chicken time) 21 comparse 22 sql-de-lite 23 sxml-serializer) 24 25 (define css-style #<<END-OF-CSS 26 h1 { text-align: center; } 27 .bad-post { background: #fcc; } 28 .marked-post { background: #ccf; } 29 .unmarked-post { } 30 .edit-post { } 31 form { 32 margin: 1rex 0; 33 display: grid; 34 gap: 0.5rex; 35 transition: all 0.5s ease-in; 36 } 37 .lsub { width: 4.5rem; height: 3rem; } 38 .rsub { width: 4.5rem; height: 3rem; } 39 textarea { display: block; max-width: 100%; } 40 .tag-list { column-width: 10rem; column-gap: 1rem; } 41 .tag-list label { display: block; } 42 span.ptime { font-size: 80%; } 43 span.section { font-size: 80%; } 44 span.title { font-weight: bold; display: block; } 45 @media (min-width: 60rem) { 46 form { 47 grid-template-columns: 5rem 1fr 5rem; 48 align-items: center; 49 } 50 51 .form-body { grid-column: 2; } 52 .lsub { grid-column: 1; justify-self: start; } 53 .rsub { grid-column: 3; justify-self: end; } 54 } 55 @media (max-width: 59.9rem) { 56 form { 57 grid-template-columns: 1fr 1fr; 58 grid-template-areas: \"c c\" \"l r\"; 59 } 60 61 .form-body { grid-area: c; } 62 .lsub { grid-area: l; justify-self: start; } 63 .rsub { grid-area: r; justify-self: end; } 64 #load-new input { grid-area: c; } 65 } 66 67 #load-new { text-align: center; grid-template-columns: auto; } 68 #load-new input { width: 4.5rem; height: 3rem; margin: auto; } 69 70 body { background: #F0ECE0; color: #000000; } 71 form { background: #FFFFFF; } 72 a:link { color: #007FBF; } 73 a:visited { color: #003F7F; } 74 a:hover { background: #007FBF; color: #F0E8E0; } 75 76 @media (prefers-color-scheme: dark) { 77 body { background: #103c48; color: #adbcbc; } 78 form { background: #184956; color: #cad8d9; } 79 a:link { color: #4695f7; } 80 a:visited { color: #af88eb; } 81 a:hover { background: #4695f7; color: #103c48; } 82 .bad-post { background: #783946; } 83 .marked-post { background: #1849a6; } 84 } 85 END-OF-CSS 86 ) 87 88 (define content-length 89 (let ((ct (get-environment-variable "CONTENT_LENGTH"))) 90 (if ct (string->number ct) 0))) 91 (define input-text (read-string content-length)) 92 (define input-list 93 (let* ((hdigit* (any-of (preceded-by (is #\0) (result 0)) 94 (preceded-by (is #\1) (result 1)) 95 (preceded-by (is #\2) (result 2)) 96 (preceded-by (is #\3) (result 3)) 97 (preceded-by (is #\4) (result 4)) 98 (preceded-by (is #\5) (result 5)) 99 (preceded-by (is #\6) (result 6)) 100 (preceded-by (is #\7) (result 7)) 101 (preceded-by (is #\8) (result 8)) 102 (preceded-by (is #\9) (result 9)) 103 (preceded-by (is #\a) (result 10)) 104 (preceded-by (is #\A) (result 10)) 105 (preceded-by (is #\b) (result 11)) 106 (preceded-by (is #\B) (result 11)) 107 (preceded-by (is #\c) (result 12)) 108 (preceded-by (is #\C) (result 12)) 109 (preceded-by (is #\d) (result 13)) 110 (preceded-by (is #\D) (result 13)) 111 (preceded-by (is #\e) (result 14)) 112 (preceded-by (is #\E) (result 14)) 113 (preceded-by (is #\f) (result 15)) 114 (preceded-by (is #\F) (result 15)))) 115 (pct* (sequence* ((_ (is #\%)) 116 (h hdigit*) 117 (l hdigit*)) 118 (result (integer->char (+ (* 16 h) l))))) 119 (value* (as-string (repeated (any-of pct* item) until: (is #\&)))) 120 (name* (as-string (repeated item until: (is #\=)))) 121 (pair* (sequence* ((n name*) 122 (_ (is #\=)) 123 (v value*) 124 (_ (is #\&))) 125 (result (list n (string-translate v "\r"))))) 126 (parser (zero-or-more pair*))) 127 (parse parser (string-append input-text "&")))) 128 (define (input-var name) 129 (let loop ((rest input-list)) 130 (cond ((null? rest) #f) 131 ((string=? (caar rest) name) (cadar rest)) 132 (else (loop (cdr rest)))))) 133 (define (required-input-var name) 134 (let ((val (input-var name))) 135 (if val val (bad-input (conc "missing " name))))) 136 137 (define start-html 138 "Content-Type: text/html\r\n\r\n<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">") 139 140 (define (html-output form) 141 (write-string start-html) 142 (serialize-sxml form 143 method: 'html 144 output: (current-output-port))) 145 146 (define (htmx-output form) 147 (write-string "Content-Type: text/html\r\n\r\n") 148 (serialize-sxml form 149 method: 'html 150 output: (current-output-port))) 151 152 (define (debug-output) 153 (html-output 154 `(html 155 (head (title "Variable dump")) 156 (body (h1 "Variable dump") 157 (p "Current directory: " ,(current-directory)) 158 (table 159 ,@(map 160 (lambda (pair) 161 `(tr (td ,(car pair)) (td ,(cdr pair)))) 162 (get-environment-variables))) 163 (h2 "Inputs") 164 (pre (code ,input-text)) 165 (table 166 ,@(map 167 (lambda (l) (cons 'tr (map (lambda (c) (list 'td c)) l))) 168 input-list)))))) 169 170 (define (die msg) 171 (write-string "Status: 500\r\n") 172 (when msg 173 (write-string "Content-Type: text/plain\r\n\r\n") 174 (write-string msg)) 175 (exit 1)) 176 (define (bad-input msg) 177 (write-string "Status: 400\r\n") 178 (when msg 179 (write-string "Content-Type: text/plain\r\n\r\n") 180 (write-string msg)) 181 (exit 0)) 182 183 (define irc-digit (in #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)) 184 (define irc-hex (in #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 185 #\8 #\9 #\a #\b #\c #\d #\e #\f)) 186 (define (irc-digits n) (repeated irc-digit n)) 187 (define irc-date 188 (as-string 189 (sequence (irc-digits 4) (is #\.) 190 (irc-digits 2) (is #\.) 191 (irc-digits 2) (is #\ ) 192 (irc-digits 2) (is #\:) 193 (irc-digits 2) (is #\:) 194 (irc-digits 2)))) 195 (define irc-nick 196 (as-string 197 (enclosed-by (is #\<) 198 (repeated item until: (is #\>)) 199 (is #\>)))) 200 (define irc-source 201 (as-string 202 (enclosed-by (char-seq " [") 203 (repeated item until: (is #\])) 204 (char-seq "] ")))) 205 (define irc-url 206 (as-string 207 (enclosed-by (char-seq " ") 208 (sequence (char-seq "http") 209 (repeated item until: (is #\space))) 210 (char-seq " ")))) 211 (define irc-hash 212 (as-string 213 (enclosed-by (char-seq "#") 214 (repeated irc-hex 8) 215 end-of-input))) 216 (define irc-suffix (sequence irc-url irc-hash)) 217 (define irc-line 218 (sequence irc-date 219 irc-nick 220 irc-source 221 (as-string (repeated item until: irc-suffix)) 222 irc-url 223 irc-hash)) 224 225 (define (read-line-pos fd) 226 (let loop ((acc "")) 227 (let ((c (file-read fd 1))) 228 (if (and (= 1 (cadr c)) 229 (not (string=? (car c) "\n"))) 230 (loop (string-append acc (car c))) 231 (list acc (file-position fd)))))) 232 233 234 235 (define root (get-environment-variable "DOCUMENT_ROOT")) 236 (when (not root) 237 (die "Missing $DOCUMENT_ROOT")) 238 (define db-name (string-append root "/./iens.sqlite")) 239 240 (define db (open-database db-name)) 241 (exec (sql/transient db "PRAGMA foreign_keys = ON;")) 242 (define (db-version) 243 (query fetch-value (sql db "PRAGMA user_version;"))) 244 245 (when (= 2 (db-version)) 246 (for-each 247 (lambda (s) (exec (sql/transient db s))) 248 (list "CREATE TABLE gruik 249 (id INTEGER PRIMARY KEY, 250 position INTEGER NOT NULL, 251 notes TEXT NOT NULL, 252 description TEXT, 253 ptime INTEGER NOT NULL, 254 section TEXT NOT NULL, 255 title TEXT NOT NULL, 256 url TEXT NOT NULL, 257 mark INTEGER NOT NULL DEFAULT FALSE, 258 ctime INTEGER NOT NULL, 259 mtime INTEGER NOT NULL);" 260 "CREATE UNIQUE INDEX i_gruik ON gruik(position);" 261 "CREATE INDEX i_gruik_time ON gruik(ptime);" 262 "CREATE TABLE gruik_tags 263 (gruik_id REFERENCES gruik(id) ON UPDATE CASCADE ON DELETE CASCADE, 264 tag_id REFERENCES tag(id) ON UPDATE CASCADE ON DELETE CASCADE);" 265 "CREATE UNIQUE INDEX i_gruik_rel ON gruik_tags(gruik_id,tag_id);" 266 "CREATE INDEX i_gruik_tags ON gruik_tags(tag_id,gruik_id);" 267 "INSERT INTO config(key, val) VALUES ('gruik-source', '/home/nat/irclogs/libera/#gcufeed.log');" 268 "INSERT INTO config(key, val) VALUES ('gruik-seen', 38678556);" 269 "INSERT INTO config(key, val) VALUES ('gruik-host', 'https://users.instinctive.eu');" 270 "INSERT INTO config(key, val) VALUES ('gruik-prefix', '/iens');" 271 "PRAGMA user_version = 3;"))) 272 273 (unless (= 3 (db-version)) 274 (die "Unexpectad database version")) 275 276 277 (define (get-config key) 278 (query fetch-value (sql db "SELECT val FROM config WHERE key = ?;") key)) 279 280 (define (get-config/default key default-value) 281 (let ((result (get-config key))) 282 (if result 283 result 284 default-value))) 285 286 (define (insert-line line offset) 287 (let ((parsed (parse irc-line line)) 288 (now (current-seconds))) 289 (when parsed 290 (exec 291 (sql db 292 "INSERT INTO gruik(position, notes, ptime, section, title, url, ctime, mtime) VALUES (?, ?, ?, ?, ?, ?, ?, ?);") 293 offset 294 line 295 (car parsed) 296 (list-ref parsed 2) 297 (list-ref parsed 3) 298 (list-ref parsed 4) 299 now 300 now)))) 301 302 (define (catch-up) 303 (let ((src-path (get-config "gruik-source"))) 304 (when (not src-path) (die "No source configured")) 305 (let* ((fd (file-open src-path open/rdonly)) 306 (so (get-config/default "gruik-seen" 0)) 307 (_ (set-file-position! fd so seek/set))) 308 (let loop ((offset so)) 309 (let ((rp (read-line-pos fd))) 310 (if (= (cadr rp) offset) 311 (exec 312 (sql/transient db "INSERT OR REPLACE INTO config VALUES (?,?);") 313 "gruik-seen" 314 offset) 315 (begin 316 (apply insert-line rp) 317 (loop (cadr rp))))))))) 318 319 (define (redirect location) 320 (write-string "Status: 302\r\nLocation: ") 321 (write-string (get-config/default "gruik-host" "")) 322 (write-string (get-config/default "gruik-prefix" "")) 323 (write-string location) 324 (write-string "\r\n\r\n")) 325 326 (define (post-p-fragment ptime section title url) 327 `(p 328 (span (@ (class "ptime")) ,ptime) 329 (span (@ (class "section")) ,section) 330 (span (@ (class "title")) ,title) 331 (a (@ (href ,url)) ,url))) 332 333 (define (edit-post-fragment id ptime section title url mark notes description) 334 `(form (@ (method "POST") (action "do-edit") 335 (id ,(conc "post-" id)) (class "edit-post") 336 (hx-swap "outerHTML") (hx-post "xdo-edit")) 337 (input (@ (type "submit") (name "submit") (class lsub) (value "Edit"))) 338 (div (@ (class "form-body")) 339 ,(post-p-fragment ptime section title url) 340 (p ,(conc "Mark: " mark)) 341 (pre (code ,notes)) 342 (p (label "Append to notes:" 343 (textarea (@ (name "notes") (cols 80) (rows 5)) ""))) 344 (p (label "Description:" 345 (textarea (@ (name "description") (cols 80) (rows 5)) ,description))) 346 (fieldset (legend "Tags") 347 (details (@ (class tag-list)) (summary "Tags") 348 ,@(query 349 (map-rows* 350 (lambda (tid name checked) 351 `(label 352 (input (@ (type checkbox) (name tags) (value ,tid) 353 ,@(if (= 0 checked) '() '((checked))))) 354 ,name))) 355 (sql db "SELECT id,name,EXISTS (SELECT * FROM gruik_tags WHERE gruik_id=? AND tag_id = tag.id) FROM tag;") 356 id)))) 357 (input (@ (type "hidden") (name "id") (value ,id))) 358 (input (@ (type "submit") (name "submit") (class rsub) (value "Cancel"))))) 359 360 (define (edit-post-fragment* id) 361 (query 362 (map-rows* edit-post-fragment) 363 (sql db "SELECT id,ptime,section,title,url,mark,notes,description FROM gruik WHERE mark=1 AND id=?;") 364 id)) 365 366 (define (db-edit) 367 (let ((id (string->number (required-input-var "id")))) 368 (when (string=? "Edit" (required-input-var "submit")) 369 (exec 370 (sql/transient db 371 "UPDATE gruik SET mtime=?,notes=trim(notes||char(10)||?,char(10)),description=? WHERE mark=1 AND id=?;") 372 (current-seconds) 373 (required-input-var "notes") 374 (required-input-var "description") 375 id)) 376 id)) 377 378 (define (bad-post-fragment id ptime section title url) 379 `(form (@ (method "POST") (action "do-undelete") 380 (id ,(conc "post-" id)) (class "bad-post") 381 (hx-swap "outerHTML") (hx-post "xdo-undelete")) 382 (input (@ (type "submit") (name "submit") (class lsub) (value "Restore"))) 383 (div (@ (class "form-body")) 384 ,(post-p-fragment ptime section title url)) 385 (input (@ (type "hidden") (name "id") (value ,id))))) 386 387 (define (marked-post-fragment id ptime section title url) 388 `(form (@ (method "POST") (action "do-marked") 389 (id ,(conc "post-" id)) (class "marked-post") 390 (hx-swap "outerHTML") (hx-post "xdo-marked")) 391 (input (@ (type "submit") (name "submit") (class lsub) (value "Edit"))) 392 (div (@ (class "form-body")) 393 ,(post-p-fragment ptime section title url)) 394 (input (@ (type "hidden") (name "id") (value ,id))) 395 (input (@ (type "submit") (name "submit") (class rsub) (value "Unmark"))))) 396 397 (define (unmarked-post-fragment id ptime section title url) 398 `(form (@ (method "POST") (action "do-unmarked") 399 (id ,(conc "post-" id)) (class "unmarked-post") 400 (hx-swap "outerHTML") (hx-post "xdo-unmarked")) 401 (input (@ (type "submit") (name "submit") (class lsub) (value "Mark"))) 402 (div (@ (class "form-body")) 403 ,(post-p-fragment ptime section title url)) 404 (input (@ (type "hidden") (name "id") (value ,id))) 405 (input (@ (type "submit") (name "submit") (class rsub) (value "Delete"))))) 406 407 (define (post-fragment id mark ptime section title url) 408 (case mark 409 ((0) (unmarked-post-fragment id ptime section title url)) 410 ((1) (marked-post-fragment id ptime section title url)) 411 (else (bad-post-fragment id ptime section title url)))) 412 413 (define (post-htmx id) 414 (htmx-output 415 (query 416 (map-rows* post-fragment) 417 (sql db "SELECT id,mark,ptime,section,title,url FROM gruik WHERE id=?;") 418 id))) 419 420 (define (gruik-list-view title q) 421 (html-output 422 `(html 423 (head 424 (meta (@ (charset "utf-8"))) 425 (meta (@ (name "viewport") 426 (content "width=device-width, initial-scale=1"))) 427 (meta (@ (name "color-scheme") (content "light dark"))) 428 (title ,title) 429 (script (@ (src "https://cdn.jsdelivr.net/npm/htmx.org@2.0.8/dist/htmx.min.js")) "") 430 (style ,css-style)) 431 (body (h1 ,title) 432 ,@(query 433 (map-rows* post-fragment) 434 (sql db q)) 435 (form (@ (method GET) (action "new") (id "load-new") 436 (hx-swap "outerHTML") (hx-post "x-new")) 437 (input (@ (type "hidden") (name "last-id") (value 438 ,(query fetch-value (sql db "SELECT MAX(id) FROM gruik;"))))) 439 (input (@ (type "submit") (name "submit") (value "Load")))) 440 )))) 441 442 (define (new-fragment) 443 (catch-up) 444 (let* ((last-id (string->number (required-input-var "last-id"))) 445 (frags (query 446 (map-rows* post-fragment) 447 (sql db "SELECT id,mark,ptime,section,title,url FROM gruik WHERE id > ? AND mark >= 0;") 448 last-id)) 449 (btn (if (null? frags) "Recheck" "More"))) 450 (htmx-output 451 `(,@frags 452 (form (@ (method GET) (action "new") (id "load-new") 453 (hx-swap "outerHTML") (hx-post "x-new")) 454 (input (@ (type "hidden") (name "last-id") (value 455 ,(query fetch-value (sql db "SELECT MAX(id) FROM gruik;"))))) 456 (input (@ (type "submit") (name "submit") (value ,btn)))) 457 )))) 458 459 (define (new-view) 460 (redirect "/")) 461 462 (define (deleted-view) 463 (catch-up) 464 (gruik-list-view 465 "Deleted gruiks" 466 "SELECT id,mark,ptime,section,title,url FROM gruik WHERE mark < 0 ORDER BY mtime;")) 467 468 (define (edit-view id) 469 (let ((title (conc "Gruik #" id))) 470 (html-output 471 `(html 472 (head 473 (meta (@ (charset "utf-8"))) 474 (meta (@ (name "viewport") 475 (content "width=device-width, initial-scale=1"))) 476 (meta (@ (name "color-scheme") (content "light dark"))) 477 (title ,title) 478 (script (@ (src "https://cdn.jsdelivr.net/npm/htmx.org@2.0.8/dist/htmx.min.js")) "") 479 (style ,css-style)) 480 (body (h1 ,title) 481 ,@(edit-post-fragment* id)))))) 482 483 (define (main-view) 484 (catch-up) 485 (gruik-list-view 486 "Latest gruiks" 487 "SELECT id,mark,ptime,section,title,url FROM gruik WHERE mark >= 0;")) 488 489 (define (db-set-mark id old-v new-v) 490 (exec (sql db "UPDATE gruik SET mtime=?, mark=? WHERE mark=? AND id=?;") 491 (current-seconds) new-v old-v id)) 492 493 (define (xdo-edit) 494 (let ((id (db-edit))) 495 (post-htmx id))) 496 497 (define (do-marked) 498 (let ((id (required-input-var "id")) 499 (submit (required-input-var "submit"))) 500 (cond 501 ((string=? submit "Edit") (redirect (conc "/gruik/" id))) 502 ((string=? submit "Unmark") (db-set-mark id 0 -1) (redirect "/")) 503 (else (bad-input "bad value for submit"))))) 504 505 (define (xdo-marked) 506 (let ((id (required-input-var "id")) 507 (submit (required-input-var "submit"))) 508 (cond 509 ((string=? submit "Edit") (htmx-output 510 (edit-post-fragment* (string->number id)))) 511 ((string=? submit "Unmark") (db-set-mark id 1 0) (post-htmx id)) 512 (else (bad-input "bad value for submit"))))) 513 514 (define (do-undelete) 515 (let ((id (required-input-var "id")) 516 (submit (required-input-var "submit"))) 517 (cond 518 ((string=? submit "Restore") (db-set-mark id -1 0) (redirect "/")) 519 (else (bad-input "bad value for submit"))))) 520 521 (define (xdo-undelete) 522 (let ((id (required-input-var "id")) 523 (submit (required-input-var "submit"))) 524 (cond 525 ((string=? submit "Restore") (db-set-mark id -1 0) (htmx-output '())) 526 (else (bad-input "bad value for submit"))))) 527 528 (define (do-unmarked) 529 (let ((id (required-input-var "id")) 530 (submit (required-input-var "submit"))) 531 (cond 532 ((string=? submit "Mark") (db-set-mark id 0 1) (redirect "/")) 533 ((string=? submit "Delete") (db-set-mark id 0 -1) (redirect "/")) 534 (else (bad-input "bad value for submit"))))) 535 536 (define (xdo-unmarked) 537 (let ((id (required-input-var "id")) 538 (submit (required-input-var "submit"))) 539 (cond 540 ((string=? submit "Mark") (db-set-mark id 0 1) (post-htmx id)) 541 ((string=? submit "Delete") (db-set-mark id 0 -1) (htmx-output '())) 542 (else (bad-input "bad value for submit"))))) 543 544 545 (define route-xdo-edit 546 (preceded-by (char-seq "xdo-edit") 547 (result xdo-edit))) 548 (define route-do-marked 549 (preceded-by (char-seq "do-marked") 550 (result do-marked))) 551 (define route-xdo-marked 552 (preceded-by (char-seq "xdo-marked") 553 (result xdo-marked))) 554 (define route-do-undelete 555 (preceded-by (char-seq "do-undelete") 556 (result do-undelete))) 557 (define route-xdo-undelete 558 (preceded-by (char-seq "xdo-undelete") 559 (result xdo-undelete))) 560 (define route-do-unmarked 561 (preceded-by (char-seq "do-unmarked") 562 (result do-unmarked))) 563 (define route-xdo-unmarked 564 (preceded-by (char-seq "xdo-unmarked") 565 (result xdo-unmarked))) 566 (define route-deleted 567 (preceded-by (char-seq "deleted") 568 (result deleted-view))) 569 (define route-new 570 (preceded-by (char-seq "new") 571 (result new-view))) 572 (define route-x-new 573 (preceded-by (char-seq "x-new") 574 (result new-fragment))) 575 (define route-edit 576 (sequence* ((_ (char-seq "gruik/")) 577 (id (as-string (one-or-more irc-digit)))) 578 (result (lambda () (edit-view (string->number id)))))) 579 (define route-main (result main-view)) 580 (define route-ok 581 (preceded-by (char-seq "ok") 582 (result (lambda () 583 (write-string "Content-Type: text/plain\r\n\r\nOK\n"))))) 584 585 (define router 586 (preceded-by (char-seq (get-config/default "gruik-prefix" "")) 587 (is #\/) 588 (apply any-of 589 (map (lambda (p) (followed-by p end-of-input)) 590 (list route-do-marked 591 route-do-undelete 592 route-do-unmarked 593 route-xdo-edit 594 route-xdo-marked 595 route-xdo-undelete 596 route-xdo-unmarked 597 route-deleted 598 route-edit 599 route-main 600 route-ok 601 route-new 602 route-x-new))))) 603 604 (let* ((uri (get-environment-variable "REQUEST_URI")) 605 (_ (if uri uri (die "Missing $REQUEST_URI"))) 606 (fn (parse router uri))) 607 (if fn 608 (fn) 609 (debug-output)))