diff options
| author | Ricardo Wurmus <rekado@elephly.net> | 2020-04-05 17:33:02 +0200 |
|---|---|---|
| committer | Ricardo Wurmus <rekado@elephly.net> | 2020-04-05 18:28:44 +0200 |
| commit | a872100b150b21d857d42b4bd0ce88fe19f48385 (patch) | |
| tree | fb0de9e78cdbad5030f112ea84e8ad521a5cc430 | |
| parent | fc8222ebb6b28098020dbd82e588ad46266f7982 (diff) | |
controller: Add session manager.
| -rw-r--r-- | mumi/config.scm.in | 9 | ||||
| -rw-r--r-- | mumi/web/controller.scm | 13 |
2 files changed, 21 insertions, 1 deletions
diff --git a/mumi/config.scm.in b/mumi/config.scm.in index 3daeace..23ca774 100644 --- a/mumi/config.scm.in +++ b/mumi/config.scm.in @@ -53,6 +53,15 @@ (string-replace dir "@prefix@" 0 (string-length "${prefix}")) dir))))) + (key-dir . ,(let ((maybe-dir (getcwd))) + (if (and (getenv "MUMI_UNINSTALLED") + (file-exists? maybe-dir)) + maybe-dir + (let ((dir "@localstatedir@/mumi/")) + (if (string-prefix? "${prefix}" dir) + (string-replace dir "@prefix@" + 0 (string-length "${prefix}")) + dir))))) (mail-dir . ,(let ((maybe-dir (string-append (getcwd) "/mails"))) (if (and (getenv "MUMI_UNINSTALLED") diff --git a/mumi/web/controller.scm b/mumi/web/controller.scm index 5487bd0..11ad714 100644 --- a/mumi/web/controller.scm +++ b/mumi/web/controller.scm @@ -1,5 +1,5 @@ ;;; mumi -- Mediocre, uh, mail interface -;;; Copyright © 2016, 2017, 2018, 2019 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This program is free software: you can redistribute it and/or ;;; modify it under the terms of the GNU Affero General Public License @@ -22,6 +22,10 @@ #:use-module (srfi srfi-26) #:use-module (web request) #:use-module (web uri) + #:use-module (webutils sessions) + #:use-module (gcrypt base64) + #:use-module (gcrypt mac) + #:use-module (mumi config) #:use-module (mumi messages) #:use-module (mumi web render) #:use-module (mumi web download) @@ -47,6 +51,13 @@ ;; (render-html (error-page message)))) ) +(define %session-manager + (let ((key-file (string-append (%config 'key-dir) "signing-key"))) + (if (file-exists? key-file) + (make-session-manager (with-input-from-file key-file read)) + (with-output-to-file key-file + (lambda () (write (base64-encode (generate-signing-key)))))))) + (define (controller request body) (match-lambda (('GET) |