Overview
| Comment: | updates |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA3-256: |
e82124aeb7366f10622ff5431f4b8101 |
| User & Date: | lexi on 2019-07-29 06:11:18 |
| Other Links: | manifest | tags |
Context
|
2019-07-29
| ||
| 06:11 | add fabulist stylesheet check-in: 689acafd82 user: lexi tags: trunk | |
| 06:11 | updates check-in: e82124aeb7 user: lexi tags: trunk | |
|
2019-07-28
| ||
| 12:40 | add fabulist collaborative interaction fiction server (keeping it here until it gets its own repo) check-in: 9259bf507d user: lexi tags: trunk | |
Changes
Modified fabulist.scm from [e734573397] to [189c348a0b].
4 4 (import (chicken tcp) 5 5 (chicken pretty-print) 6 6 (chicken io) 7 7 (chicken string) 8 8 (chicken bitwise) 9 9 (chicken random)) 10 10 11 +(begin-for-syntax (import (chicken io))) 12 +(include "scmlib/lisp-macro.scm") 13 +(define-macro (static-import-string . body) 14 + (call-with-input-file (car body) 15 + (cut read-string #f <>))) 16 +(define *stylesheet* (static-import-string "fabulist.css")) 17 + 11 18 (tcp-read-timeout 300) 12 19 13 20 (define-record db (setter stories) (setter pages)) 14 21 (define-record story title genre 15 22 desc key start) 16 23 (define-record page link story body choices) 17 24 (define *database* (make-db '() '())) ................................................................................ 79 86 (define-record netstr sz val rest) 80 87 (define-record netreq body method path 81 88 query origin accept 82 89 ref ua) 83 90 84 91 (define (netreq-post-params req) (map (cut string-split <> "=") 85 92 (string-split (netreq-body req) "&"))) 86 -(define (post-field arr p) (let ((v (assoc p arr))) 87 - (if (eq? #f v) "" (url-decode (cadr v))))) 93 +(define (post-field arr p) 94 + (let ((v (assoc p arr))) (if (or (null? v) 95 + (eq? #f v) 96 + (null? (cdr v))) "" 97 + (url-decode (cadr v))))) 88 98 (define (alist->netreq al body) 89 99 (define (method->symbol m) (cond [(equal? m "GET") 'get] 90 100 [(equal? m "POST") 'post] 91 101 [(equal? m "PUT") 'put] 92 102 [else 'unknown])) 93 103 (define (field key) 94 104 (let ((result (assoc key al))) ................................................................................ 222 232 223 233 (define (respond req code user-header text links) 224 234 (let* ([kind-pair (determine-response-kind (netreq-accept req) 225 235 (netreq-ua req))] 226 236 [kind (car kind-pair)] 227 237 [mime (cdr kind-pair)] 228 238 [header (string-append (if (equal? user-header "") "" 229 - " :: ") user-header)]) 239 + " :: ") user-header)]) 230 240 (define (open) 231 241 (case kind 232 242 ('html (string-append 233 243 "<!doctype html>\n<head>\n<title>fabulist" header "</title>\n" 234 244 "<link rel=\"stylesheet\" href=\"/style\" type=\"text/css\">" 235 245 "</head>\n<body>\n<h1> <a href=\"/\">fabulist</a>" header "</h1>\n")) 236 246 ('text (string-append "# " header "\n\n")))) ................................................................................ 256 266 final-text)]) 257 267 response))) 258 268 259 269 260 270 (define (get-new-story req) 0) 261 271 262 272 (define (get-stylesheet req) 263 - (define style #<<_END_ 264 - body { 265 - background: #370017; 266 - color: #FFE1ED; 267 - max-width: 35em; 268 - padding: 1em; 269 - margin: auto; 270 - font-family: Alegreya, Junicode, GaramondNo8, "Garamond Premier Pro", "Adobe Garamond", Garamond, serif; 271 - font-size: 15pt; 272 - } 273 - input, textarea { 274 - font-family: Alegreya, Junicode, GaramondNo8, "Garamond Premier Pro", "Adobe Garamond", Garamond, serif; 275 - font-size: 14pt; 276 - border: 1px solid #FF4C96; 277 - background: #610028; 278 - color: white; 279 - padding: 0.3em; 280 - flex-grow: 2; 281 - text-shadow: 0 0 10px #E84B8C; 282 - } 283 - code { 284 - font-family: Inconsolata, Monaco, monocode; 285 - padding: 0.2em 0.3em; 286 - background: #740C38; 287 - border: 1px solid #260010; 288 - } 289 - textarea { 290 - height: 6em; 291 - } 292 - input[type=submit] { 293 - position: absolute; 294 - flex-grow: 0; 295 - width: 30%; 296 - right: 0; 297 - top: 1em; 298 - text-shadow: 0 0 10px #E84B8C; 299 - } 300 - form > div { 301 - position: relative; 302 - display: flex; 303 - width: 100%; 304 - align-items: center; 305 - } 306 - form label { 307 - margin-right: 0.5em; 308 - margin-bottom: 0.5em; 309 - margin-top: 0.5em; 310 - font-weight: bold; 311 - } 312 - a[href] { 313 - color: #FF2E84; 314 - } 315 - h1 { 316 - font-weight: 100; 317 - margin-bottom: 0.0em; 318 - } 319 - h1 a[href] { 320 - color: #FF7AB1; 321 - text-decoration: none; 322 - } 323 -_END_ 324 - ) 325 - (make-netresp 'ok (list (cons "Server" "") 273 + (make-netresp 'ok (list (cons "Server" "fabulist") 326 274 (cons "Content-Type" "text/css") 327 275 (cons "Content-Length" (number->string 328 - (string-length style)))) 329 - style)) 276 + (string-length *stylesheet*)))) 277 + *stylesheet*)) 330 278 331 279 (define (get-new-chapter req) 332 280 (let* ([path (netreq-path req)] 333 281 [place (follow-path (cdr path))] 334 282 [params (netreq-post-params req)]) 335 - (if (eq? #f place) (error-not-found req) 283 + (if (or (eq? #f place) 284 + (eq? #f (text-path-story-rec place))) (error-not-found req) 336 285 (let* ([story-key (text-path-story-key place)] 337 286 [story (text-path-story-rec place)] 338 287 [chapter-key (text-path-chapter-key place)]) 339 288 (new-chapter-page req story-key story chapter-key))))) 340 289 341 290 (define (get-flag-chapter req) 0) 342 291 (define (post-flag-chapter req) 0) 343 292 344 293 (define (error-not-found req) 345 294 (respond req 'nofile "error" 346 295 '((p "the path you have entered is not meaningful.")) 347 296 '(("start over" . "/")))) 297 + 298 +(define (error-bad-request req back) 299 + (respond req 'badreq "error" 300 + '((p "the data you have supplied is not valid.")) 301 + `(("return to story" . ,back) 302 + ("start over" . "/")))) 348 303 349 304 (define (display-index-page req) 350 305 (respond req 'ok "" 351 306 '((p "welcome to this " (b "fabulist" ) " instance.") 352 307 (p "fabulist is a server for hosting collaborative interactive fiction." ) 353 308 (p "select one of the links below.")) 354 309 '(("start a new story" . "/init") 355 310 ("play an existing story" . "/find") 356 - ("start a random story" . "/rand")))) 311 + ("start a random story" . "/rand") 312 + ("set your author details" . "/auth") 313 + ))) 357 314 358 315 (define (new-chapter-page req key story last-page) 359 316 (let ([new-url (string-append "/new/" key (if (eq? #f last-page) "" 360 317 (string-append "/" last-page)))]) 361 318 (respond req 'ok (string-append (story-title story) " :: new chapter") 362 - (list 363 - '(p "write your chapter and hit " (b "commit") " to add it to the story") 364 - `(form "POST" ,new-url 365 - ,(if (eq? #f last-page) '(text "") 366 - (list 'field "choice that leads here" "choice-link" "text")) 367 - (field "chapter body" "chapter-body" "textarea"))) 319 + (list 320 + '(p "write your chapter and hit " (b "commit") " to add it to the story") 321 + `(form "POST" ,new-url 322 + ,(if (eq? #f last-page) '(text "") 323 + (list 'field "choice that leads here" "choice-link" "text")) 324 + (field "chapter body" "chapter-body" "textarea"))) 368 325 (if (eq? last-page #f) '() 369 - (list 370 - (cons "abandon chapter" 371 - (string-append "/p/" key "/" last-page)) 372 - (cons "link to existing chapter" 373 - (string-append "/link/" key "/" last-page))))))) 326 + (list 327 + (cons "abandon chapter" 328 + (string-append "/p/" key "/" last-page)) 329 + (cons "link to existing chapter" 330 + (string-append "/link/" key "/" last-page))))))) 374 331 375 332 (define-record text-path 376 333 story-key story-rec chapter-key) 377 334 378 335 (define (follow-path path) 379 336 (let* ([pathlen (length path)]) 380 337 (cond [(or (< pathlen 1) ................................................................................ 383 340 [story-ent (alist-ref story-key 384 341 (db-stories *database*) 385 342 equal?)] 386 343 [chapter-key (cond [(= pathlen 2) (cadr path)] 387 344 [(eq? #f story-ent) #f] 388 345 [else (story-start story-ent)])]) 389 346 (make-text-path story-key story-ent chapter-key))]))) 390 - 347 + 391 348 (define (format-user-text str) 392 349 (map (cut list 'p <>) 393 350 (string-split str "\n"))) 394 351 395 352 (define (post-new-chapter req) 396 353 (define (save-chapter key ch) 397 354 (set! (db-pages *database*) ................................................................................ 399 356 (define (save-to-start story chap) 400 357 (story-start-set! story chap)) 401 358 (define (add-to-page story-key dest new-key) 402 359 (let* ([destkey (string-append story-key "." dest)] 403 360 [dest-pg (alist-ref destkey (db-pages *database*) equal?)] 404 361 [old-choices (page-choices dest-pg)]) 405 362 (page-choices-set! dest-pg (append old-choices (list new-key))))) 406 - 363 + 407 364 (let* ([path (netreq-path req)] 408 365 [place (follow-path (cdr path))] 409 - [params (netreq-post-params req)]) 366 + [params (netreq-post-params req)] 367 + [raw-path (foldl string-append "" (intersperse (cdr path) "/"))]) 410 368 (if (eq? #f place) (error-not-found req) 411 369 (let* ([story-key (text-path-story-key place)] 412 370 [story (text-path-story-rec place)] 413 371 [chapter-key (text-path-chapter-key place)] 372 + [chapter-full-key (if (eq? #f chapter-key) #f 373 + (string-append story-key "." chapter-key))] 414 374 [choice-link (post-field params "choice-link")] 415 375 [chapter-body (post-field params "chapter-body")]) 416 - (let* ([new-key (generate-key 4)] 417 - [full-key (string-append story-key "." new-key)] 418 - [new-page 419 - (make-page choice-link 420 - story-key 421 - (format-user-text chapter-body) 422 - '())]) 423 - (if (= (length path) 2) 424 - (if (eq? #f (story-start story)) 425 - (begin (save-chapter full-key new-page) 426 - (save-to-start story new-key) 427 - (redirect (string-append "/p/" story-key "/" new-key))) 428 - (error-not-found req)) 429 - ; FIXME: insert error checking to make sure [chapter-key] 430 - ; really exists; right now this will crash the program! 431 - (begin (save-chapter full-key new-page) 432 - (add-to-page story-key chapter-key new-key) 433 - (redirect (string-append "/p/" story-key "/" chapter-key)))) 434 - 435 - ))))) 376 + (cond [(or (equal? chapter-body "") 377 + (and (equal? choice-link "") 378 + (not (eq? chapter-key #f)))) 379 + (error-bad-request req (string-append "/p/" raw-path))] 380 + [else 381 + (let* ([new-key (generate-key 4)] 382 + [full-key (string-append story-key "." new-key)] 383 + [new-page (make-page choice-link 384 + story-key 385 + (format-user-text chapter-body) 386 + '())]) 387 + (if (= (length path) 2); new story or new branch? 388 + (if (eq? #f (story-start story)) 389 + (begin (save-chapter full-key new-page) 390 + (save-to-start story new-key) 391 + (redirect (string-append "/p/" story-key "/" new-key))) 392 + (error-not-found req)) 393 + ; FIXME: insert error checking to make sure [chapter-key] 394 + ; really exists; right now this will crash the program! 395 + (if (eq? #f (alist-ref chapter-full-key (db-pages *database*) equal?)) 396 + (error-not-found req) 397 + (begin (save-chapter full-key new-page) 398 + (add-to-page story-key chapter-key new-key) 399 + (redirect (string-append "/p/" story-key "/" chapter-key)))) 400 + 401 + ))]))))) 436 402 437 403 438 404 (define (get-story-chapter req) 439 405 (define (render-chapter story-key story chapter) 440 406 (define (lookup-chapter ch) (alist-ref (string-append story-key "." ch) 441 407 (db-pages *database*) equal?)) 442 408 (define (format-choice ch) ................................................................................ 443 409 (let ([dest (lookup-chapter ch)]) 444 410 (cons (page-link dest) 445 411 (string-append "/p/" story-key "/" ch)))) 446 412 447 413 (let ([chap (lookup-chapter chapter)]) 448 414 (if (eq? #f chap) (error-not-found req) 449 415 (respond req 'ok (story-title story) 450 - (page-body chap) 451 - (append 452 - (map format-choice (page-choices chap)) 453 - (list (cons '(i "[branch]") 454 - (string-append 455 - "/new/" story-key 456 - "/" chapter)))))))) 416 + (page-body chap) 417 + (append 418 + (map format-choice (page-choices chap)) 419 + (list (cons '(i "[branch]") 420 + (string-append 421 + "/new/" story-key 422 + "/" chapter)))))))) 457 423 458 424 (let* ([path (netreq-path req)] 459 425 [place (follow-path (cdr path))]) 460 426 (if (eq? #f place) (error-not-found req) 461 427 (let* ([story-key (text-path-story-key place)] 462 428 [story-ent (text-path-story-rec place)] 463 429 [chapter-key (text-path-chapter-key place)]) ................................................................................ 615 581 (await-connections s))) 616 582 (let ([server (tcp-listen port 100 "127.0.0.1")]) 617 583 (await-connections server) 618 584 (tcp-close server))) 619 585 620 586 (serve 4056) 621 587 #;(cond-expand 622 - (chicken-script ) 623 - (else)) 588 +(chicken-script ) 589 +(else))
Modified nkvd.c from [6971590b48] to [ca4bf4ac94].
106 106 * 107 107 * TODO: support a mappings file/variable for those programs 108 108 * too special to simply name their config file 109 109 * "~/.(argv[0])". 110 110 * 111 111 * TODO: exempt xdg dirs beginning with ~/. from proscription 112 112 * in nkvd_interdict_all=1 mode 113 + * 114 + * TODO: instead of function passthrough, alter environment 115 + * to delete LD_PRELOAD and re-exec whitelisted apps 116 + * without nkvd loading at all 113 117 */ 114 118 115 119 #include <stdarg.h> 116 120 #include <unistd.h> 117 121 #include <sys/types.h> 118 122 #include <fcntl.h> 119 123 #include <limits.h>