Support downloading of attachments.
[software/mumi.git] / mumi / web / server.scm
1 ;;; mumi -- Mediocre, uh, mail interface
2 ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
3 ;;;
4 ;;; This program is free software: you can redistribute it and/or
5 ;;; modify it under the terms of the GNU Affero General Public License
6 ;;; as published by the Free Software Foundation, either version 3 of
7 ;;; the License, or (at your option) any later version.
8 ;;;
9 ;;; This program is distributed in the hope that it will be useful,
10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 ;;; Affero General Public License for more details.
13 ;;;
14 ;;; You should have received a copy of the GNU Affero General Public
15 ;;; License along with this program. If not, see
16 ;;; <http://www.gnu.org/licenses/>.
17
18 (define-module (mumi web server)
19 #:use-module (srfi srfi-1)
20 #:use-module (web http)
21 #:use-module (web request)
22 #:use-module (web server)
23 #:use-module (web uri)
24 #:use-module (mumi web controller)
25 #:use-module (mumi web util)
26 #:export (start-mumi-web-server))
27
28 (define (run-controller controller request body)
29 ((controller request body)
30 (cons (request-method request)
31 (request-path-components request))))
32
33 (define (handler request body controller)
34 (format #t "~a ~a\n"
35 (request-method request)
36 (uri-path (request-uri request)))
37 (apply values
38 (append
39 (run-controller controller request body)
40 (list controller))))
41
42 (define (start-mumi-web-server port)
43 (run-server (lambda args (apply handler args))
44 'http
45 `(#:addr ,INADDR_ANY
46 #:port ,port)
47 controller))