web/util: Add timestamp! and reasonable-timestamp?.

1 files changed, 40 insertions, 2 deletions

diff --git a/mumi/web/util.scm b/mumi/web/util.scm
index 79c8c37..e968432 100644
--- a/mumi/web/util.scm
+++ b/mumi/web/util.scm
@@ -1,5 +1,5 @@
 ;;; mumi -- Mediocre, uh, mail interface
-;;; Copyright © 2016, 2017  Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2016, 2017, 2020 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2014  David Thompson <davet@gnu.org>
 ;;;
 ;;; This program is free software: you can redistribute it and/or
@@ -17,14 +17,22 @@
 ;;; <http://www.gnu.org/licenses/>.
 
 (define-module (mumi web util)
+  #:use-module (mumi config)
   #:use-module (ice-9 match)
+  #:use-module (srfi srfi-26)
+  #:use-module (rnrs bytevectors)
+  #:use-module (gcrypt hmac)
+  #:use-module (gcrypt base64)
   #:use-module (srfi srfi-1)
   #:use-module (web request)
   #:use-module (web uri)
   #:export (parse-query-string
             request-path-components
             file-extension
-            directory?))
+            directory?
+
+            timestamp!
+            reasonable-timestamp?))
 
 (define (parse-query-string query)
   "Parse and decode the URI query string QUERY and return an alist."
@@ -42,3 +50,33 @@
 
 (define (directory? filename)
   (string=? filename (dirname filename)))
+
+(define (timestamp!)
+  (let* ((seconds (current-time))
+         (key-file (string-append (%config 'key-dir) "/signing-key"))
+         (key (with-input-from-file key-file read))
+         (sig (sign-data-base64 key
+                                (call-with-output-string
+                                  (lambda (port)
+                                    (write seconds port)))
+                                #:algorithm 'sha512)))
+    (base64-encode
+     (string->utf8 (format #f "~a$~a" seconds sig)))))
+
+(define* (reasonable-timestamp? data #:optional (min 5) (max (* 60 10)))
+  "Validate the signature in DATA, extract the timestamp, and return
+#T if it is no older than MAX seconds and no more recent than MIN
+seconds."
+  (let* ((now (current-time))
+         (key-file (string-append (%config 'key-dir) "/signing-key"))
+         (key (with-input-from-file key-file read)))
+    (match (string-split (utf8->string (base64-decode data)) #\$)
+      ((decoded sig)
+       (and (verify-sig-base64 key
+                               (string->utf8 decoded) sig
+                               #:algorithm 'sha512)
+            (and=> (string->number decoded)
+                   (lambda (then)
+                     (let ((diff (- now then)))
+                       (and (> diff min) (< diff max)))))))
+      (_ #f))))