using new one-file-per-comment

9 files changed, 443 insertions, 70 deletions

diff --git a/tekuti/base64.scm b/tekuti/base64.scm
new file mode 100644
index 0000000..bde9c91
--- /dev/null
+++ b/tekuti/base64.scm
@@ -0,0 +1,110 @@
+;; Tekuti
+;; Copyright (C) 2008 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   
+;; published by the Free Software Foundation; either version 3 of   
+;; the License, or (at your option) any later version.              
+;;                                                                  
+;; This program is distributed in the hope that it will be useful,  
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of   
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the    
+;; GNU General Public License for more details.                     
+;;                                                                  
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, contact:
+;;
+;; Free Software Foundation           Voice:  +1-617-542-5942
+;; 59 Temple Place - Suite 330        Fax:    +1-617-542-2652
+;; Boston, MA  02111-1307,  USA       gnu@gnu.org
+
+;;; Commentary:
+;;
+;; base 64 y'all
+;;
+;;; Code:
+
+(define-module (tekuti base64)
+  #:export (base64-encode base64-decode))
+
+(define b64-chars
+  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwzyz0123456789+/")
+
+(define (int->b64-char i)
+  (string-ref b64-chars (logand i 63)))
+ 
+(define b64-char-ranges
+  (map cons
+       (map char->integer '(#\A #\a #\0 #\+ #\/))
+       (map char->integer '(#\Z #\z #\9 #\+ #\/))))
+
+(define (b64-char->int c)
+  (let ((i (char->integer c)))
+    (let lp ((ranges b64-char-ranges) (out 0))
+      (cond ((null? ranges)
+             (error "bad base64 char" c))
+            ((and (>= i (caar ranges)) (<= i (cdar ranges)))
+             (+ out (- i (caar ranges))))
+            (else
+             (lp (cdr ranges) (+ out (1+ (- (cdar ranges)
+                                            (caar ranges))))))))))
+
+(define make-bytevector make-string)
+(define bytevector-ref string-ref)
+(define bytevector-length string-length)
+(define bytevector-set! string-set!)
+(define bytevector-pad string-pad-right)
+(define byte->integer char->integer)
+(define integer->byte integer->char)
+
+(define-macro (bytevector-map-n-to-m n m)
+  `(lambda (proc s)
+     (let* ((len (bytevector-length s))
+            (out (make-bytevector (* len (/ ,m ,n)))))
+       (let lp ((i 0) (j 0))
+         (cond
+          ((< i len)
+           (let inner ((k 0) (bytes (proc ,@(map (lambda (x)
+                                                   `(bytevector-ref s (+ i ,x)))
+                                                 (iota n)))))
+             (if (not (null? bytes))
+                 (begin (bytevector-set! out (+ j k) (car bytes))
+                        (inner (1+ k) (cdr bytes)))))
+           (lp (+ i ,n) (+ j ,m)))
+          (else out))))))
+
+(define bytevector-map-3-to-4
+  (bytevector-map-n-to-m 3 4))
+(define bytevector-map-4-to-3
+  (bytevector-map-n-to-m 4 3))
+
+(define (base64-encode s)
+  (let* ((npad (remainder (- 3 (remainder (bytevector-length s) 3)) 3))
+         (out (bytevector-map-3-to-4
+               (lambda (x y z)
+                 (let ((n (logior (ash (byte->integer x) 16)
+                                  (ash (byte->integer y) 8)
+                                  (byte->integer z))))
+                   (map int->b64-char
+                        (list (ash n -18) (ash n -12) (ash n -6) n))))
+               (bytevector-pad s (+ (bytevector-length s) npad)
+                               (integer->byte 0)))))
+    (string-append (substring out 0 (- (string-length out) npad))
+                   (make-string npad #\=))))
+
+(define (base64-decode s)
+  (let* ((npad (cond ((string-suffix? "==" s) 2)
+                     ((string-suffix? "=" s) 1)
+                     (else 0)))
+         (out (bytevector-map-4-to-3
+               (lambda (w x y z)
+                 (let ((n (logior (ash (b64-char->int w) 18)
+                                  (ash (b64-char->int x) 12)
+                                  (ash (b64-char->int y) 6)
+                                  (b64-char->int z))))
+                   (map integer->byte
+                        (list (ash n -16) (logand (ash n -8) 255)
+                              (logand n 255)))))
+               (string-append (substring s 0 (- (string-length s) npad))
+                              (make-string npad #\A)))))
+    (substring out 0 (- (string-length out) npad))))
diff --git a/tekuti/comment.scm b/tekuti/comment.scm
index 7941434..93d519d 100644
--- a/tekuti/comment.scm
+++ b/tekuti/comment.scm
@@ -31,23 +31,34 @@
   #:use-module (tekuti filters)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-19)
-  #:export (comment-from-tree comment-sxml-content comment-timestamp build-comment-skeleton comment-readable-date))
-
-(use-modules (ice-9 rdelim)
-             (ice-9 popen)
-             (srfi srfi-1)
-             (sxml simple)
-             (tekuti url)
-             (match-bind)
-             (sxml transform))
+  #:use-module (sxml transform)
+  #:use-module (match-bind)
+  #:export (comment-from-object comment-sxml-content comment-timestamp build-comment-skeleton comment-readable-date
+            bad-new-comment-post?))
 
 (define *comment-spec*
   `((timestamp . ,string->number)))
-(define (comment-from-tree encoded-name sha1)
-  (acons 'encoded-name encoded-name
-         (acons 'sha1 sha1
-                (parse-metadata (string-append sha1 ":" "metadata")
-                                *comment-spec*))))
+(define (comment-from-object encoded-name sha1)
+  (let ((blob (git "show" sha1)))
+    (match-bind
+     "\n\n(.*)$" blob (_ content)
+     (fold cons
+           (filter
+            identity
+            (match-lines (substring blob 0 (- (string-length blob)
+                                              (string-length _)))
+                         "^([^: ]+): +(.*)$" (_ k v)
+                         (let* ((k (string->symbol k))
+                                (parse (assq-ref *comment-spec* k)))
+                           (if parse
+                               (catch 'parse-error
+                                      (lambda ()
+                                        (cons k (parse v)))
+                                      (lambda args #f))
+                               (cons k v)))))
+           `((raw-content . ,content)
+             (sha1 . ,sha1)
+             (key . ,encoded-name))))))
 
 (define (comment-readable-date comment)
   (let ((date (time-utc->date
@@ -55,7 +66,7 @@
     (date->string date "~e ~B ~Y ~l:~M ~p")))
 
 (define (comment-raw-content comment)
-  (git "show" (string-append (assq-ref comment 'sha1) ":content")))
+  (assq-ref comment 'raw-content))
 
 (define (comment-sxml-content comment)
   (let ((format (or (assq-ref comment 'format) 'wordpress)))
@@ -78,3 +89,201 @@
                    #:input "comment\n" #:env env))))
         #f
         comments))
+
+(define (emailish? x)
+  (match-bind "^([a-zA-Z0-9.+-]+)@([a-zA-Z0-9-]+\\.)+[a-zA-Z]+$"
+              x (_ . args)
+              x
+              #f))
+
+(define (bad-email? x)
+  (if (emailish? x)
+      #f
+      `(p "Please pretend to specify a valid email address.")))
+
+(define (urlish? x)
+  (match-bind "^https?://([a-zA-Z0-9-]+\\.)+[a-zA-Z]+/.*$"
+              x (_ . args)
+              x
+              #f))
+
+(define (bad-url? x)
+  (if (or (string-null? x) (urlish? x))
+      #f
+      `(p "Bad URL. (Only http and https are allowed.)")))
+
+(define *allowed-tags*
+  `((a (href . ,urlish?) title)
+    (abbr title)
+    (acronym title)
+    (b)
+    (br)
+    (blockquote (cite . ,urlish?))
+    (code)
+    (em)
+    (i)
+    (p)
+    (pre)
+    (strike)
+    (strong)))
+
+(define (compile-sxslt-rules tags)
+  (define (ok . body)
+    body)
+  `(,@(map (lambda (spec)
+             `(,(car spec)
+               ((@ (,@(map (lambda (attr)
+                             (if (symbol? attr)
+                                 `(,attr . ,ok)
+                                 `(,(car attr)
+                                   . ,(lambda (tag text)
+                                        (or ((cdr attr) text)
+                                            (throw 'bad-attr-value text))
+                                        (list tag text)))))
+                           (cdr spec)))
+                   . ,ok))
+               . ,ok))
+           *allowed-tags*)
+    (*text* . ,(lambda (tag text)
+                 text))
+    (@ . ,(lambda (tag text)
+            (throw 'bad-attr tag)))
+    (*default* . ,(lambda (tag . body)
+                    (throw 'bad-tag tag)))))
+
+;; could be better, reflect nesting rules...
+(define *valid-xhtml-rules*
+  `((div ,(compile-sxslt-rules *allowed-tags*)
+         . ,(lambda body body))))
+
+(use-modules (sxml transform) (tekuti filters))
+(define (bad-xhtml? x)
+  (catch #t
+         (lambda ()
+           (pre-post-order (wordpress->sxml x) *valid-xhtml-rules*)
+           #f)
+         (lambda (key . args)
+           `(div (p "Invalid XHTML")
+                 ,(case key
+                    ((parser-error)
+                     `(pre ,(with-output-to-string
+                              (lambda () (write args)))))
+                    ((bad-tag)
+                     `(p "XHTML tag disallowed: " ,(symbol->string (car args))))
+                    ((bad-attr)
+                     `(p "XHTML attribute disallowed: " ,(symbol->string (car args))))
+                    ((bad-attr-value)
+                     `(p "XHTML attribute has bad value: " ,(car args)))
+                    (else
+                     (pk key args)
+                     `(p "Jesus knows why, and so do you")))))))
+
+(define *new-comment-spec*
+  `(("author" ,(lambda (x) #f))
+    ("email" ,bad-email?)
+    ("url" ,bad-url?)
+    ("comment" ,bad-xhtml?)
+    ("submit" ,(lambda (x) #f))))
+
+(define (bad-new-comment-post? post-data)
+  (or (or-map (lambda (pair)
+                (and (not (assoc (car pair) *new-comment-spec*))
+                     `(p "Bad post data: " ,(car pair))))
+              post-data)
+      (or-map (lambda (pair)
+                (and (not (assoc (car pair) post-data))
+                     `(p "Incomplete post data:" ,(car pair))))
+              *new-comment-spec*)
+      (or-map (lambda (pair)
+                ((cadr pair) (assoc-ref post-data (car pair))))
+              *new-comment-spec*)))
+
+(use-modules (srfi srfi-11))
+(define (make-tree-deep treeish add remove change)
+  (define (local? x) (null? (car x)))
+  (define (assert-added-files-not-present names dents)
+    (for-each
+     (lambda (dent)
+       (if (member (car dent) names)
+           (error "file already added" dent)))
+     dents))
+  (define (assert-referenced-files-present names dents)
+    (for-each
+     (lambda (name)
+       (if (not (assoc name dent-names))
+           (error "file already removed" name)))
+     names))
+  (define (collect proc l)
+    (reverse! (fold (lambda (x y)
+                      (let ((foo (proc x)))
+                        (if foo (cons foo y) y)))
+                    '() l)))
+  (define (level-down x)
+    (cons (cdar x) (cdr x)))
+  
+  (let-values (((dents) (git-ls-tree treeish #f))
+               ((ladd dadd) (partition local? add))
+               ((lremove dremove) (partition local? remove))
+               ((lchange dchange) (partition local? change)))
+    (assert-added-files-not-present (map caadr ladd) dents)
+    (assert-referenced-files-present
+     (append (map cadr lremove) (map caadr lchange)) dents)
+    
+    (make-tree
+     (append
+      (map cdr ladd)
+      (collect
+       (lambda (dent)
+         (cond
+          ((member (car dent) (map cadr lremove))
+           #f)
+          ((member (car dent) (map caadr lchange))
+           (cadr lchange))
+          ((and (equal? (caddr dent) "tree")
+                (or (member (car dent)
+                            (map cadr (append dadd dremove dchange)))))
+           `(,(car dent) (make-tree-deep (cadr dent)
+                                         (map level-down dadd)
+                                         (map level-down dremove)
+                                         (map level-down dchange))
+             ,(caddr dent) ,(cadddr dent)))
+          (else dent))))))))
+  
+    
+(define (mutate-tree master add remove change message)
+  (let ((tree (make-tree-deep master add remove change)))
+    (string-trim-both
+     (git* `("commit-tree" ,tree "-p" ,master) #:input message
+           #:env '("GIT_COMMMITTER=tekuti")))))
+
+(define (update-master master proc)
+  (let lp ((master master))
+    (let ((commit (proc master)) (count 5))
+      (cond
+       ((zero? count)
+        (error "my god, we looped 5 times" commit))
+       ((false-if-git-error
+         (git "update-ref" "refs/heads/master" commit master))
+        commit)
+       (else
+        (pk "failed to update the master ref, trying again...")
+        (lp (git-rev-parse "master") (1- count)))))))
+
+(define (make-new-comment post content)
+  (let ((content-sha1 (make-blob 
+(assoc-ref post-data "comment")))
+        (metadata-sha1 (make-blob (with-output-to-string
+                                    (lambda ()
+                                      (write )
+                                      )
+) metadata)))
+    (update-master
+     master
+     (lambda (master)
+       (mutate-tree master
+                    `(((,(assq-ref post 'key) "comments" ,comment-key)
+                       ("content" ,content-sha1 "blob" "100644"))
+                      ((,(assq-ref post 'key) "metadata" ,comment-key)
+                       ("metadata" ,metadata-sha1 "blob" "100644")))
+                    '()
+                    '())))))
diff --git a/tekuti/config.scm b/tekuti/config.scm
index 71cfabe..3899f2d 100644
--- a/tekuti/config.scm
+++ b/tekuti/config.scm
@@ -27,7 +27,7 @@
 (define-module (tekuti config)
   #:use-module (tekuti util)
   #:export (*host* *port* *backlog* *git-dir* *git* *public-url-base*
-            *private-url-base* *debug*))
+            *private-url-base* *debug* *admin-user* *admin-pass*))
 
 (define *host* "127.0.0.1")
 (define *port* 8081)
@@ -37,3 +37,5 @@
 (define *public-url-base* "/blog/")
 (define *private-url-base* "/blog/")
 (define *debug* #t)
+(define *admin-user* "admin")
+(define *admin-pass* "totingiini")
diff --git a/tekuti/git.scm b/tekuti/git.scm
index 4d5e08f..09c12e2 100644
--- a/tekuti/git.scm
+++ b/tekuti/git.scm
@@ -38,7 +38,8 @@
 
             git git* ensure-git-repo git-ls-tree git-ls-subdirs
             parse-metadata parse-commit commit-utc-timestamp
-            commit-parents make-tree git-rev-parse
+            commit-parents make-tree git-rev-parse make-tree-full
+            create-blob
 
             write-indices read-indices))
 
@@ -129,10 +130,12 @@
         (chdir d))))
 
 (define (git-ls-tree treeish path)
-  (match-lines (git "ls-tree" treeish (or path "."))
-               "^(.+) (.+) (.+)\t(.+)$" (_ mode type object name)
-               ;; reversed for assoc
-               (list name object type mode)))
+  (or (false-if-git-error
+       (match-lines (git "ls-tree" treeish (or path "."))
+                    "^(.+) (.+) (.+)\t(.+)$" (_ mode type object name)
+                    ;; reversed for assoc
+                    (list name object type mode)))
+      '()))
 
 (define (git-ls-subdirs treeish path)
   (or (false-if-git-error
diff --git a/tekuti/page.scm b/tekuti/page.scm
index 44c4f50..dc26b43 100644
--- a/tekuti/page.scm
+++ b/tekuti/page.scm
@@ -29,6 +29,7 @@
   #:use-module (tekuti util)
   #:use-module (tekuti git)
   #:use-module (tekuti post)
+  #:use-module (tekuti comment)
   #:use-module (tekuti url)
   #:use-module (tekuti request)
   #:use-module (srfi srfi-34)
@@ -38,12 +39,12 @@
             page-admin-posts
             page-admin-post
             page-admin-new-post
-            page-admin-new-comment
             page-admin-modify-post 
             page-admin-delete-comment 
             page-admin-delete-post 
             page-index 
             page-show-post 
+            page-new-comment
             page-archives 
             page-show-tags
             page-show-tag
@@ -87,18 +88,13 @@
         (ul ,@body)))
 
 (define (with-authentication request thunk)
-  (let ((headers (rref request 'headers '())))
-    (define (authenticated?)
-      (let ((b64 (assoc-ref headers "Authorization")))
-        (pk b64) ;; FIXME, decode
-        ))
-    (if (authenticated?)
-        (thunk)
-        (rcons* (rpush 'output-headers
-                      '("WWW-Authenticate" . "Basic realm=\"Tekuti\"")
-                      request)
-                'status 401
-                'body `((p "Authentication required, yo"))))))
+  (if (request-authenticated? request)
+      (thunk)
+      (rcons* (rpush 'output-headers
+                     '("WWW-Authenticate" . "Basic realm=\"Tekuti\"")
+                     request)
+              'status 401
+              'body `((p "Authentication required, yo")))))
 
 (define (page-admin request index)
   (with-authentication
@@ -150,29 +146,11 @@
                'body `((h1 ,(assq-ref post 'title))
                        ,(post-editing-form post)))))))
 
-(define (decode-form-data request)
-  (let-request request (headers post-data)
-    (if (string-null? post-data)
-        '()
-        (let ((content-type (assoc-ref headers "content-type")))
-          (cond
-           ((equal? content-type "application/x-www-form-urlencoded")
-            (map
-             (lambda (piece)
-               (let ((equals (string-index piece #\=)))
-                 (if equals
-                     (cons (url:decode (substring piece 0 equals))
-                           (url:decode (substring piece (1+ equals))))
-                     (cons (url:decode piece) ""))))
-             (string-split post-data #\&)))
-           (else
-            (error "bad content-type" content-type)))))))
-
 (define (page-admin-new-post request index)
   (with-authentication
    request
    (lambda ()
-     (let ((form-data (decode-form-data request)))
+     (let ((form-data (request-form-data request)))
        (rcons* request
                'status 201              ; created
                'output-headers (acons "Location" *public-url-base*
@@ -205,7 +183,6 @@
    request
    (lambda ()
      (not-implemented request index))))
-(define page-new-comment not-implemented)
 (define page-delete-comment not-implemented)
 (define page-delete-post not-implemented)
 
@@ -265,13 +242,31 @@
        (git-rev-parse (string-append (assq-ref index 'master) ":" slug)))
       => (lambda (tree)
            (let ((post (post-from-tree slug tree)))
-             (pk post)
              (rcons* request
                      'title (assq-ref post 'title)
                      'body (show-post post #t)))))
      (else
       (page-not-found request index)))))
 
+(define (page-new-comment request index year month day post)
+  (let ((slug (make-post-key year month day post))
+        (data (request-form-data request)))
+    (cond
+     ((false-if-git-error
+       (git-rev-parse (string-append (assq-ref index 'master) ":" slug)))
+      => (lambda (tree)
+           (cond
+            ((bad-new-comment-post? data)
+             => (lambda (reason)
+                  (pk reason)
+                  (rcons* request
+                          'body `((p "Bad post data: " ,reason)))))
+            (else
+             (rcons* request
+                     'body `((p "hey hey hey like fat albert")))))))
+     (else
+      (page-not-found request index)))))
+
 (define/kwargs (date-increment date (day 0) (month 0) (year 0))
   (make-date (date-nanosecond date) (date-second date)
              (date-minute date) (date-minute date)
diff --git a/tekuti/post.scm b/tekuti/post.scm
index ec20c0a..7177d12 100644
--- a/tekuti/post.scm
+++ b/tekuti/post.scm
@@ -106,11 +106,32 @@
 (define (post-comments post)
   (dsu-sort
    (map (lambda (pair)
-          (comment-from-tree (car pair) (cdr pair)))
-        (git-ls-subdirs (assq-ref post 'sha1) "comments/"))
+          (comment-from-object (car pair) (cadr pair)))
+        (git-ls-tree (string-append (assq-ref post 'sha1) ":comments") #f))
    comment-timestamp
    <))
 
+(define (comment-form post author email url comment)
+  `(form
+    (@ (action ,(string-append *public-url-base* "archives/"
+                               (url:decode (assq-ref post 'key))))
+       (method "POST"))
+    (p (input (@ (type "text") (name "author") (value ,author)
+                 (size "22") (tabindex "1")))
+       " " (label (@ (for "author")) (small "Name")))
+    (p (input (@ (type "text") (name "email") (value ,email)
+                 (size "22") (tabindex "2")))
+       " " (label (@ (for "email")) (small "Mail (will not be published)")))
+    (p (input (@ (type "text") (name "url") (value ,url)
+                 (size "22") (tabindex "3")))
+       " " (label (@ (for "url")) (small "Website")))
+    ;(p (small "allowed tags: "))
+    (p (textarea (@ (name "comment") (id "comment") (cols "100%")
+                    (rows "10") (tabindex "4"))
+                 ,comment))
+    (p (input (@ (name "submit") (type "submit") (id "submit") (tabindex "5")
+                 (value "Submit Comment"))))))
+
 (define (post-sxml-comments post)
   (let ((comments (post-comments post))
         (comment-status (assq-ref post 'comment_status)))
@@ -123,7 +144,7 @@
                      ((1) "One response")
                      (else (format #f "~d responses" len)))))))
     (define (show-comment comment)
-      `(li (@ (class "alt") (id ,(assq-ref comment 'encoded-name)))
+      `(li (@ (class "alt") (id ,(assq-ref comment 'key)))
            (cite ,(let ((url (assq-ref comment 'author_url))
                         (name (assq-ref comment 'author)))
                     (if url
@@ -131,8 +152,7 @@
                         name)))
            " says:" (br)
            (small (@ (class "commentmetadata"))
-                  (a (@ (href ,(string-append
-                                "#" (assq-ref comment 'encoded-name))))
+                  (a (@ (href ,(string-append "#" (assq-ref comment 'key))))
                      ,(comment-readable-date comment)))
            ,(comment-sxml-content comment)))
     `(div
@@ -142,8 +162,8 @@
               `((ol (@ (class "commentlist")) ,@l))))
       ,(if (equal? comment-status "closed")
            `(p (@ (id "nocomments")) "Comments are closed.")
-           '(div (h3 "Leave a Reply")
-                 "...")))))
+           `(div (h3 "Leave a Reply")
+                 ,(comment-form post "" "" "" ""))))))
 
 (define (post-n-comments post)
   (length (git-ls-subdirs (assq-ref post 'sha1) "comments/")))
diff --git a/tekuti/request.scm b/tekuti/request.scm
index 7ac8117..acf5c2a 100644
--- a/tekuti/request.scm
+++ b/tekuti/request.scm
@@ -27,11 +27,14 @@
 (define-module (tekuti request)
   #:use-module ((srfi srfi-1) #:select (find-tail fold))
   #:use-module (scheme kwargs)
+  #:use-module (match-bind)
   #:use-module (tekuti util)
   #:use-module (tekuti url)
   #:use-module (tekuti config)
+  #:use-module (tekuti base64)
   #:export (make-request rcons rcons* rpush rpush* rref let-request
-            request-path-case))
+            request-path-case request-authenticated?
+            request-form-data))
 
 (define (header-ref headers key default)
   (let ((pair (assoc key headers)))
@@ -54,6 +57,24 @@
     (method . ,(lambda (r)
                  (header-ref (rref r 'headers '()) "method" "GET")))))
 
+(define (request-form-data request)
+  (let-request request (headers post-data)
+    (if (string-null? post-data)
+        '()
+        (let ((content-type (assoc-ref headers "content-type")))
+          (cond
+           ((equal? content-type "application/x-www-form-urlencoded")
+            (map
+             (lambda (piece)
+               (let ((equals (string-index piece #\=)))
+                 (if equals
+                     (cons (url:decode (substring piece 0 equals))
+                           (url:decode (substring piece (1+ equals))))
+                     (cons (url:decode piece) ""))))
+             (string-split post-data #\&)))
+           (else
+            (error "bad content-type" content-type)))))))
+
 (define (make-request . keys-and-values)
   (fold (lambda (pair r)
           (rcons (car pair) ((cdr pair) r) r))
@@ -86,6 +107,19 @@
      (default-proc (default-proc request k))
      (else default))))
 
+;; danger here, regarding the optional alternate clauses...
+(define (request-authenticated? request)
+  (let ((headers (rref request 'headers '())))
+    (let ((auth (assoc-ref headers "Authorization")))
+      (and auth
+           (match-bind "^Basic ([A-Za-z0-9+/=]*)$" auth (_ b64)
+                       (match-bind "^([^:]*):(.*)$"
+                                   (base64-decode b64) (_ user pass)
+                                   (and (equal? user *admin-user*)
+                                        (equal? pass *admin-pass*))
+                                   #f)
+                       #f)))))
+
 (define-macro (let-request request bindings . body)
   (let ((request-var (gensym)))
     (define (make-binding b)
diff --git a/tekuti/web.scm b/tekuti/web.scm
index d1c9750..278dd2f 100644
--- a/tekuti/web.scm
+++ b/tekuti/web.scm
@@ -88,7 +88,6 @@
    ((GET admin posts) page-admin-posts)
    ((GET admin posts post-key!) page-admin-post)
    ((POST admin new-post) page-admin-new-post)
-   ((POST admin new-comment post-key!) page-admin-new-comment)
    ;; would be fine to have e.g. (DELETE admin posts posts-key!), but
    ;; web browsers don't handle that
    ((POST admin modify-post post-key!) page-admin-modify-post)
@@ -98,6 +97,7 @@
    ((GET) page-index)
    ((GET archives year? month? day?) page-archives)
    ((GET archives year! month! day! post!) page-show-post)
+   ((POST archives year! month! day! post!) page-new-comment)
    ((GET tags) page-show-tags)
    ((GET tags tag!) page-show-tag)
    ((GET debug) page-debug)
diff --git a/wordpress-to-dir.py b/wordpress-to-dir.py
index f8710df..2c9f17a 100644
--- a/wordpress-to-dir.py
+++ b/wordpress-to-dir.py
@@ -63,9 +63,8 @@ def write_comment(comment, dir):
         out += 'timestamp: %s\n' % int(time.mktime(date.timetuple()))
         return out
 
-    d = make_dir(dir + str(comment['id']))
-    write_file(d + 'content', comment['content'])
-    write_file(d + 'metadata', make_metadata())
+    write_file(dir + str(comment['id']),
+               make_metadata() + '\n' + comment['content'])
 
 def make_post_key(post):
     d = post['date']
@@ -87,9 +86,10 @@ def write_post(post, categories, comments):
     write_file(d + 'content', post['content'])
     write_file(d + 'content-filtered', post['content_filtered'])
     write_file(d + 'metadata', make_metadata())
-    c = make_dir(d + 'comments')
-    for comment in comments:
-        write_comment(comment, c)
+    if comments:
+        c = make_dir(d + 'comments')
+        for comment in comments:
+            write_comment(comment, c)
 
 def main(args):
     global cxn