Add comment closing window feature

* tekuti/config.scm (*comments-open-window*): New config, indicating
seconds for which to keep comments open.
* tekuti/page-helpers.scm (post-editing-form): Expose comments closed
date feature.
* tekuti/page.scm (page-new-comment): Oops -- we were missing a
server-side comments-open check!
* tekuti/post.scm (*post-spec*): Serialize comments-closed-timestamp.
(post-comments-open?): Return false if we are after the
comments-closed-timestamp.
(post-comments-closed-timestamp): New accessor.
(munge-post): Write comments-closed-timestamp.
(parse-post-data): Parse comments-closed-timestamp from form data.

tekuti/config.scm

@@ -1,5 +1,5 @@
 ;; Tekuti
-;; Copyright (C) 2008, 2010, 2012, 2014 Andy Wingo <wingo at pobox dot com>
+;; Copyright (C) 2008, 2010, 2012, 2014, 2021 Andy Wingo <wingo at pobox dot com>
 
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as
@@ -31,7 +31,7 @@
             *private-host* *private-port* *private-path-base*
             *git-dir* *git* *debug* *admin-user* *admin-pass*
             *css-file* *navbar-links* *navbar-infix*
-            *title* *subtitle* *name*
+            *title* *subtitle* *name* *comments-open-window*
             *server-impl* *server-impl-args*))
 
 (define *public-scheme* 'http)
@@ -54,6 +54,7 @@
 (define *title* "My blog")
 (define *subtitle* "Just a blog, ok")
 (define *name* "Joe Schmo")
+(define *comments-open-window* (* 60 60 24 21))
 
 (define *server-impl* 'http)
 (define *server-impl-args*

tekuti/page-helpers.scm

@@ -1,5 +1,5 @@
 ;; Tekuti
-;; Copyright (C) 2008, 2010, 2012, 2014, 2019 Andy Wingo <wingo at pobox dot com>
+;; Copyright (C) 2008, 2010, 2012, 2014, 2019, 2021 Andy Wingo <wingo at pobox dot com>
 
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as
@@ -337,6 +337,15 @@ present."
                        ,@(if (or (not post) (post-comments-open? post))
                              `((checked "checked")) '())))
              (label (@ (for "comments")) " comments open?"))
+          (p (input (@ (name "comments-closed-date") (type "text")
+                       (value ,(or (and=> (and=> post
+                                                 post-comments-closed-timestamp)
+                                          timestamp->rfc822-date)
+                                   ""))))
+             (label (@ (for "comments-closed-date"))
+                    " <- close comments on date (empty == in "
+                    ,(floor/ *comments-open-window* (* 24 60 60))
+                    " days)"))
           (div (textarea (@ (name "body") (rows "20") (cols "60"))
                          ,(if post (post-raw-content post) "")))
           (p (label (input (@ (type "radio") (name "status") (value "private")

tekuti/page.scm

@@ -1,5 +1,5 @@
 ;; Tekuti
-;; Copyright (C) 2008, 2010, 2011, 2012, 2019 Andy Wingo <wingo at pobox dot com>
+;; Copyright (C) 2008, 2010, 2011, 2012, 2019, 2021 Andy Wingo <wingo at pobox dot com>
 
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as
@@ -211,6 +211,8 @@
       => (lambda (post)
            (let ((comment (parse-new-comment data)))
              (cond
+              ((not (post-comments-open? post))
+               (respond `((p "Comments on this post are closed."))))
               ((bad-new-comment-post? data)
                => (lambda (reason)
                     (respond `((p "Bad post data: " ,(pk reason))))))

tekuti/post.scm

@@ -1,5 +1,5 @@
 ;; Tekuti
-;; Copyright (C) 2008, 2010, 2011, 2012, 2014 Andy Wingo <wingo at pobox dot com>
+;; Copyright (C) 2008, 2010, 2011, 2012, 2014, 2021 Andy Wingo <wingo at pobox dot com>
 
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as
@@ -39,7 +39,8 @@
 
             post-tags post-timestamp post-key
             post-public? post-draft? post-private?
-            post-comments-open? post-comments
+            post-comments-open? post-comments-closed-timestamp
+            post-comments
             post-sxml-content post-readable-date post-n-comments
             post-raw-content
             post-title
@@ -57,7 +58,11 @@
 (define *post-spec*
   `((timestamp . ,string->number)
     (tags . ,(lambda (v) (string-split/trimming v #\,)))
-    (title . ,identity)))
+    (title . ,identity)
+    (comments-closed-timestamp ,(lambda (str)
+                                  (if (string-null? str)
+                                      #f
+                                      string->number)))))
 
 (define (post-from-tree encoded-name sha1)
   (append `((key . ,encoded-name)
@@ -114,7 +119,15 @@
   (assq-ref post 'title))
 
 (define (post-comments-open? post)
-  (equal? (assq-ref post 'comment_status) "open"))
+  (and (equal? (assq-ref post 'comment_status) "open")
+       (cond
+        ((post-comments-closed-timestamp post)
+         => (lambda (at-timestamp)
+              (< at-timestamp (time-second (current-time)))))
+        (else #t))))
+
+(define (post-comments-closed-timestamp post)
+  (assq-ref post 'comments-closed-timestamp))
 
 (define (post-raw-content post)
   (git "show" (string-append (assq-ref post 'sha1) ":content")))
@@ -151,7 +164,8 @@
                    (for-each
                     (lambda (k)
                       (format #t "~a: ~a\n" k (assq-ref parsed k)))
-                    '(timestamp tags status title name comment_status))))
+                    '(timestamp tags status title name comment_status
+                                comments-closed-timestamp))))
         (content (with-output-to-blob (display (assq-ref parsed 'body))))
         (key (assq-ref parsed 'key))
         (message (format #f "~a: \"~a\""
@@ -193,16 +207,24 @@
         (tags (assoc-ref post-data "tags"))
         (status (assoc-ref post-data "status"))
         (comments-open? (assoc-ref post-data "comments"))
-        (date-str (assoc-ref post-data "date")))
-    (let ((timestamp (if (string-null? date-str)
-                         (time-second (current-time))
-                         (rfc822-date->timestamp date-str)))
-          (name (title->name title)))
+        (date-str (assoc-ref post-data "date"))
+        (comments-closed-date-str (assoc-ref post-data "comments-closed-date")))
+    (let* ((timestamp (if (string-null? date-str)
+                          (time-second (current-time))
+                          (rfc822-date->timestamp date-str)))
+           (comments-closed-timestamp
+            (if (string-null? comments-closed-date-str)
+                (if (post-public? (acons 'status status '()))
+                    (+ *comments-open-window* timestamp)
+                    #f)
+                (rfc822-date->timestamp comments-closed-date-str)))
+           (name (title->name title)))
       `((title . ,title)
         (body . ,body)
         (tags . ,tags)
         (status . ,status)
         (comment_status . ,(if comments-open? "open" "closed"))
+        (comments-closed-timestamp . ,comments-closed-timestamp)
         (timestamp . ,timestamp)
         (name . ,name)
         (key . ,(string-downcase