prog

frontpage - thread list - new thread - preferences - ?

How can I run my own instance of this

291 2020-06-16 02:47

[1/2]
Incremental HTML Generation

For threads with triple-digit post counts, like this one, the first page load after a new post starts to lag, because the page is rebuilt from scratch. There was a request for some timings in >>119 and a timing method in >>64, but in the intervening months no timings were forthcoming. That's OK, I hacked together my own. Here is the timing method:

$ cat test.scm
(define (timeit proc)
   (with-timings proc
      (lambda (run-time gc-time real-time)
         (write (internal-time/ticks->seconds run-time))
         (write-char #\space)
         (write (internal-time/ticks->seconds gc-time))
         (write-char #\space)
         (write (internal-time/ticks->seconds real-time))
         (newline))))

This diff comments out the server stuff and allows bbs.scm to be partially tested in the REPL of MIT/GNU Scheme 9.1.1. Serve-file and read-file are from deps/server.scm.

$ cat base.diff
--- bbs.scm	2020-06-14 19:41:25.881472281 +0000
+++ bbs-edit.scm	2020-06-14 23:20:48.760044390 +0000
@@ -11,14 +11,24 @@
 (load "lib/utils")
 (load "deps/irregex")
 (load "deps/srfi-26")
-(load "deps/httpio")
-(load "deps/server")
+;(load "deps/httpio")
+;(load "deps/server")
 (load "lib/html")
 (load "lib/parameters")
 (load "lib/markup")
 (load "templates")
 
 
+(define (serve-file path #!optional headers)
+  (if (default-object? headers) (set! headers '()))
+  (let ((content (read-file path)))
+    `(200 ,headers ,content)))
+
+(define (read-file filename)
+  (call-with-input-file filename
+                        (lambda (port)
+                          (read-string (char-set) port))))
+
 (define (get-form-hash)
   "TODO"
   (call-with-input-file "hash" read))
@@ -31,7 +41,7 @@
 (define (make-abs-path . args)
   (string-join (cons "" args) "/"))
 
-(define server (create-server))
+;(define server (create-server))
 
 (define (make-response template)
   `(200 ,(list (make-http-header 'content-type "text/html; charset=utf-8"))
@@ -43,11 +53,11 @@
 			 (make-http-header 'cache-control "Private"))))
 
 ;;; static files
-(get server (serve-static "static") '("static"))
+;(get server (serve-static "static") '("static"))
 
-(get server (lambda (req params) (serve-file "static/favicon.ico")) '("favicon.ico"))
+;(get server (lambda (req params) (serve-file "static/favicon.ico")) '("favicon.ico"))
 
-(add-handler server (lambda (req params) (route req)))
+;(add-handler server (lambda (req params) (route req)))
 
 (define (ignore-qstring fullpath)
   (let ((l (string-split fullpath #\?)))
@@ -414,4 +424,4 @@
                     (decode-formdata message)
                     (cdr validation)))))
 
-(listen server (string->number (car (command-line))))
+;(listen server (string->number (car (command-line))))

Here is the generation from scratch for https://textboard.org/sexp/prog/39 at 286, followed by serving from cache:

$ mit-scheme --load bbs-edit.scm --load test.scm 
MIT/GNU Scheme running under GNU/Linux
Type `^C' (control-C) followed by `H' to obtain information about interrupts.

Copyright (C) 2011 Massachusetts Institute of Technology
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

Image saved on Tuesday February 6, 2018 at 6:31:25 PM
  Release 9.1.1     || Microcode 15.3 || Runtime 15.7 || SF 4.41
  LIAR/x86-64 4.118 || Edwin 3.116
;Loading "bbs-edit.scm"...
;  Loading "format.com"... done
;  Loading "lib/utils.scm"... done
;  Loading "deps/irregex.scm"... done
;  Loading "deps/srfi-26.scm"... done
;  Loading "lib/html.scm"... done
;  Loading "lib/parameters.scm"... done
;  Loading "lib/markup.scm"... done
;  Loading "templates.scm"... done
;... done
;Loading "test.scm"... done

1 ]=> (timeit (lambda () (view-thread "prog" "39") 'ok))
1.02 .03 1.055
;Value: ok

1 ]=> (timeit (lambda () (view-thread "prog" "39") 'ok))
.1 0. .092
;Value: ok

First is one second, the other a tenth. Here is a diff for incremental generation. The old cache is renamed on post rather than deleted. Only the new posts go through templating and sxml conversion by controlling the filter, then plain string processing without regex is used to merge the old cache with the new content. The result is identical to the full uncached generation.

292 2020-06-16 02:47

[2/2]

$ cat full.diff
--- bbs.scm	2020-06-15 23:08:54.965513796 +0000
+++ bbs-edit.scm	2020-06-15 22:57:40.125009000 +0000
@@ -11,14 +11,24 @@
 (load "lib/utils")
 (load "deps/irregex")
 (load "deps/srfi-26")
-(load "deps/httpio")
-(load "deps/server")
+;(load "deps/httpio")
+;(load "deps/server")
 (load "lib/html")
 (load "lib/parameters")
 (load "lib/markup")
 (load "templates")
 
 
+(define (serve-file path #!optional headers)
+  (if (default-object? headers) (set! headers '()))
+  (let ((content (read-file path)))
+    `(200 ,headers ,content)))
+
+(define (read-file filename)
+  (call-with-input-file filename
+                        (lambda (port)
+                          (read-string (char-set) port))))
+
 (define (get-form-hash)
   "TODO"
   (call-with-input-file "hash" read))
@@ -31,7 +41,7 @@
 (define (make-abs-path . args)
   (string-join (cons "" args) "/"))
 
-(define server (create-server))
+;(define server (create-server))
 
 (define (make-response template)
   `(200 ,(list (make-http-header 'content-type "text/html; charset=utf-8"))
@@ -42,12 +52,19 @@
   (serve-file path (list (make-http-header 'content-type "text/html; charset=utf-8")
 			 (make-http-header 'cache-control "Private"))))
 
+(define (write-and-serve-text path text)
+  (with-output-to-file path (lambda () (write-string text)))
+  (list 200
+        (list (make-http-header 'content-type "text/html; charset=utf-8")
+              (make-http-header 'cache-control "Private"))
+        text))
+
 ;;; static files
-(get server (serve-static "static") '("static"))
+;(get server (serve-static "static") '("static"))
 
-(get server (lambda (req params) (serve-file "static/favicon.ico")) '("favicon.ico"))
+;(get server (lambda (req params) (serve-file "static/favicon.ico")) '("favicon.ico"))
 
-(add-handler server (lambda (req params) (route req)))
+;(add-handler server (lambda (req params) (route req)))
 
 (define (ignore-qstring fullpath)
   (let ((l (string-split fullpath #\?)))
@@ -149,7 +166,10 @@
 				   (lambda (e) (vector-ref rangeonce (car e))))))
 	     (cond (norange
 		    (if (not (file-exists? cache))
-			(write-and-serve cache (thread-template board thread posts headline filter-func))
+                        (let ((old (name-cache-old cache)))
+                          (if (file-exists? old)
+                              (view-thread-ihg cache old board thread posts headline)
+                              (write-and-serve cache (thread-template board thread posts headline filter-func))))
 			(serve-file cache)))
                    ((and (string->number range)
                          (> (string->number range) (length posts)))
@@ -185,6 +205,28 @@
               r3)
     vec))
 
+(define (name-cache-old cache)
+  (string-append cache "-old"))
+
+; incremental html generation
+(define (view-thread-ihg cachepath cacheoldpath board thread posts headline)
+  (let* ((oldtext   (read-file cacheoldpath))
+         (lastadt   (string-search-backward "</A></DT>" oldtext))
+         (adtpos    (- lastadt 9))
+         (prevgt    (substring-search-backward ">" oldtext 0 adtpos))
+         (postlimit (string->number (substring oldtext prevgt adtpos)))
+         (newfilter (lambda (e) (>= (car e) postlimit)))
+         (prevdt    (substring-search-backward "<DT>" oldtext 0 (- prevgt 1)))
+         (newsxml   (thread-template board thread posts headline newfilter))
+         (newtext   (with-output-to-string (lambda () (sxml->html newsxml))))
+         (firstdl   (string-search-forward "<DL>" newtext))
+         (merged    (string-append
+                      (string-head oldtext (- prevdt 4))
+                      (string-tail newtext (+ firstdl 5))))
+         (result    (write-and-serve-text cachepath merged)))
+    (delete-file cacheoldpath)
+    result))
+
 (define (view-list board)
   (let* ((path (make-path *sexp* board "list"))
          (cache (make-path *html* board "list"))
@@ -232,7 +274,7 @@
 							       (vip . ,vip)
 							       (content . ,sxml)))))
 			     (call-with-output-file path (lambda (port) (write t port)))
-			     (if (file-exists? cache) (delete-file cache))
+			     (if (file-exists? cache) (rename-file cache (name-cache-old cache)))
 			     (if vip
 				 (update-post-count board thread date post-number)
 				 (update-thread-list board (string->number thread) date post-number))
@@ -414,4 +456,4 @@
                     (decode-formdata message)
                     (cdr validation)))))
 
-(listen server (string->number (car (command-line))))
+;(listen server (string->number (car (command-line))))

Timing for adding one post, with a 39-old at 285:

$ rm data/html/prog/39
$ mit-scheme --load bbs-edit.scm --load test.scm 
[...]
1 ]=> (timeit (lambda () (view-thread "prog" "39") 'ok))
.12 .01 .12
;Value: ok

It's about 9 times faster and practically as fast as serving from cache. When this thread fills, we have a few other triple-digit post counts to test on. When the templates are updated, like when adding the board list, a drop-caches.sh of some sort will have to be run. If templates.scm:format-thread is drastically changed, bbs.scm:view-thread-ihg will need the equivalent update.

301