[bknr-cvs] r2358 - in branches/bos/projects/bos: . m2

[hhubner at common-lisp.net]

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"