blob: 86ef4fa985c17107f9d605b315b80934d5f14ba0 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
|
;;;; vampire.lisp
(in-package #:vampire)
;;; SYSTEM CONFIG COMPONENT
(defvar *config* nil)
(defclass/std config ()
((datastore-directory :ir :std #P"/srv/vampire/store/")
(static-directory :ir :std #P"/srv/vampire/static/")
(swank-port :std nil :doc "If set, swank is started on this port.")
(host :std "0.0.0.0")
(port :ir :std 4919)
(downloader-threads :ir :std 5)))
(defun config-from-file (path)
"PATH should be a path to a file containing a PLIST suitable for
passing as the keyword arguments to (MAKE-INSTANCE 'CONFIG ...)"
(apply #'make-instance 'config (read-from-file path)))
;;; MAIN
(defun main (body)
(if (session-user body)
(setf (url (location body)) "/home")
(setf (url (location body)) "/login")))
;;; STARTUP
(defun initialize-database (config)
(ensure-directories-exist (datastore-directory config))
(make-instance
'bknr.datastore:mp-store
:directory (datastore-directory config)
:subsystems (list (make-instance 'bknr.datastore:store-object-subsystem))))
(defun redirect-to-root (body)
(setf (url (location body)) "/"))
(defun when-logged-in? (fn)
(<?> 'session-user fn 'redirect-to-root))
(defvar *server*)
(setf (documentation '*server* 'variable)
"The hunchentoot acceptor instance")
(defun start-vampire (config)
(setf *config* config)
(initialize-database config )
(start-downloader-service config)
(setf *server* (make-instance 'hunchentoot:easy-acceptor
:port (port config)))
(hunchentoot:start *server*)
(when (swank-port config)
(swank:create-server :port (swank-port config) :dont-close t)))
(defun hacking-start ()
(start-vampire
(make-instance 'config
:static-directory (merge-pathnames "vampire-static/" (user-homedir-pathname))
:datastore-directory (merge-pathnames "vampire-store/" (user-homedir-pathname)))))
|
