diff options
-rw-r--r-- | mumi/web/util.scm | 42 |
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)))) |