Author: hhubner Date: Fri Jan 18 11:50:57 2008 New Revision: 2358
Modified: branches/bos/projects/bos/Makefile branches/bos/projects/bos/build.lisp branches/bos/projects/bos/m2/config.lisp branches/bos/projects/bos/m2/m2.lisp branches/bos/projects/bos/m2/mail-generator.lisp Log: suppress mail sending unless expressly enabled.
Modified: branches/bos/projects/bos/Makefile ============================================================================== --- branches/bos/projects/bos/Makefile (original) +++ branches/bos/projects/bos/Makefile Fri Jan 18 11:50:57 2008 @@ -16,7 +16,7 @@
.PHONY: test test: bos.core - lisp -core bos.core -test -slime + lisp -core bos.core -run-tests -slime
# various cleaning stuff .PHONY: cleancore
Modified: branches/bos/projects/bos/build.lisp ============================================================================== --- branches/bos/projects/bos/build.lisp (original) +++ branches/bos/projects/bos/build.lisp Fri Jan 18 11:50:57 2008 @@ -29,7 +29,7 @@ (define-toggle-switch "nostart" *webserver* t) (define-toggle-switch "slime" *slime* nil) (define-toggle-switch "cert-daemon" *cert-daemon* nil) -(define-toggle-switch "test" *run-tests* nil) +(define-toggle-switch "run-tests" *run-tests* nil)
(defun start-webserver () (apply #'bos.m2::reinit (read-configuration "m2.rc")) @@ -61,7 +61,7 @@ (format t "BOS Online-System~%") (when *run-tests* (asdf:oos 'asdf:load-op :bos.test) - (format t "Starting BOS tests...~%") + (format t "Starting BOS tests...~%") (eval (read-from-string "(5am:run! :bos.test)")) (terpri) (finish-output) @@ -73,13 +73,9 @@ (start-slime)) (when *webserver* (start-webserver)) - (cond - (*run-tests* - (asdf:oos 'asdf:load-op :bos.test) - (eval (read-from-string "(5am:run! :bos.test)"))) - (t (when (or *slime* *webserver*) - (mp::startup-idle-and-top-level-loops)) - (lisp::%top-level)))) + (when (or *slime* *webserver*) + (mp::startup-idle-and-top-level-loops)) + (lisp::%top-level))
(setf *default-pathname-defaults* #p"") (when (probe-file "bos.core")
Modified: branches/bos/projects/bos/m2/config.lisp ============================================================================== --- branches/bos/projects/bos/m2/config.lisp (original) +++ branches/bos/projects/bos/m2/config.lisp Fri Jan 18 11:50:57 2008 @@ -68,4 +68,7 @@ (defparameter *manual-contract-expiry-time* (* 42 24 3600)) (defparameter *online-contract-expiry-time* (* 3600))
-(defvar *website-url* "http://change-me") \ No newline at end of file +(defvar *website-url* "http://change-me") + +;; Einschalten des Mail-Versands (normalerweise aus) +(defvar *enable-mails* nil) \ No newline at end of file
Modified: branches/bos/projects/bos/m2/m2.lisp ============================================================================== --- branches/bos/projects/bos/m2/m2.lisp (original) +++ branches/bos/projects/bos/m2/m2.lisp Fri Jan 18 11:50:57 2008 @@ -445,9 +445,10 @@ #-(or allegro cmu sbcl) ...))
-(defun reinit (&key delete directory website-url) +(defun reinit (&key delete directory website-url enable-mails) (format t "~&; Startup Quadratmeterdatenbank...~%") (force-output) + (setf *enable-mails* enable-mails) (setf *website-url* website-url) (unless directory (error ":DIRECTORY parameter not set in m2.rc"))
Modified: branches/bos/projects/bos/m2/mail-generator.lisp ============================================================================== --- branches/bos/projects/bos/m2/mail-generator.lisp (original) +++ branches/bos/projects/bos/m2/mail-generator.lisp Fri Jan 18 11:50:57 2008 @@ -14,21 +14,23 @@ (country->office-email (sponsor-country (contract-sponsor contract))))
(defun send-system-mail (&key (to *office-mail-address*) (subject "(no subject") (text "(no text)") (content-type "text/plain; charset=UTF-8") more-headers) - (send-smtp "localhost" *mail-sender* to - (format nil "X-Mailer: BKNR-BOS-mailer + (if *enable-mails* + (send-smtp "localhost" *mail-sender* to + (format nil "X-Mailer: BKNR-BOS-mailer Date: ~A From: ~A To: ~A Subject: ~A ~@[Content-Type: ~A ~]~@[~*~%~]~A" - (format-date-time (get-universal-time) :mail-style t) - *mail-sender* - to - subject - content-type - (not more-headers) - text))) + (format-date-time (get-universal-time) :mail-style t) + *mail-sender* + to + subject + content-type + (not more-headers) + text)) + (format t "Mail with subject ~S to ~A not sent~%" subject to)))
(defun mail-info-request (email country) (send-system-mail :subject "Mailing list request"