From bknr at bknr.net Sun Mar 7 09:16:11 2010 From: bknr at bknr.net (BKNR Commits) Date: Sun, 07 Mar 2010 10:16:11 +0100 Subject: [bknr-cvs] hans changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4518 Author: hans URL: http://bknr.net/trac/changeset/4518 Debugging improved, patch supplied by Andrey Moskvitin. Introduces a new parameter: (defparameter *max-debugging-threads* 5 "Maximum number of simultaneous active calls invoke-debuger") This can be used to limit the number of debuggers that can be opened at once. U trunk/thirdparty/hunchentoot/conditions.lisp U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/specials.lisp Modified: trunk/thirdparty/hunchentoot/conditions.lisp =================================================================== --- trunk/thirdparty/hunchentoot/conditions.lisp 2010-02-26 11:39:21 UTC (rev 4517) +++ trunk/thirdparty/hunchentoot/conditions.lisp 2010-03-07 09:16:10 UTC (rev 4518) @@ -90,15 +90,55 @@ "Used to signal an error if an operation named NAME is not implemented." (error 'operation-not-implemented :operation name)) +(defun kill-all-debugging-threads () + "Used for destroy all debugging threads" + (with-lock-held (*debugging-threads-lock*) + (dolist (thread *debugging-threads*) + (when (ignore-errors + (bt:destroy-thread thread) + t) + (setf *debugging-threads* + (remove thread *debugging-threads*)))))) + +(defun debug-mode-on () + "Used to enable debug mode" + (setf *catch-errors-p* nil)) + +(defun debug-mode-off (&optional (kill-debuging-threads t)) + "Used to turn off debug mode" + (setf *catch-errors-p* t) + (when kill-debuging-threads + (kill-all-debugging-threads))) + +(defun after-close-swank-connection (connection) + "Turns off debug mode and destroy debugging threads after closing the connection with the swank-server" + (declare (ignore connection)) + (debug-mode-off t)) + +(when (find-package :swank) + (ignore-errors + (eval `(,(find-symbol (string '#:add-hook) :swank) + ,(find-symbol (string '#:*connection-closed-hook*) :swank) + 'after-close-swank-connection)))) + (defgeneric maybe-invoke-debugger (condition) (:documentation "This generic function is called whenever a condition CONDITION is signaled in Hunchentoot. You might want to specialize it on specific condition classes for debugging purposes.") (:method (condition) - "The default method invokes the debugger with CONDITION if + "The default method invokes the debugger with CONDITION if *CATCH-ERRORS-P* is NIL." - (unless *catch-errors-p* - (invoke-debugger condition)))) + (unless (or *catch-errors-p* + (< *max-debugging-threads* + (length *debugging-threads*))) + (let ((thread (bt:current-thread))) + (with-lock-held (*debugging-threads-lock*) + (push thread *debugging-threads*)) + (unwind-protect + (invoke-debugger condition) + (with-lock-held (*debugging-threads-lock*) + (setf *debugging-threads* + (remove thread *debugging-threads*)))))))) (defmacro with-debugger (&body body) "Executes BODY and invokes the debugger if an error is signaled and Modified: trunk/thirdparty/hunchentoot/packages.lisp =================================================================== --- trunk/thirdparty/hunchentoot/packages.lisp 2010-02-26 11:39:21 UTC (rev 4517) +++ trunk/thirdparty/hunchentoot/packages.lisp 2010-03-07 09:16:10 UTC (rev 4518) @@ -62,6 +62,7 @@ "*LOG-LISP-BACKTRACES-P*" "*LOG-LISP-ERRORS-P*" "*LOG-LISP-WARNINGS-P*" + "*MAX-DEBUGGING-THREADS*" "*MESSAGE-LOG-PATHNAME*" "*METHODS-FOR-POST-PARAMETERS*" "*REPLY*" @@ -264,5 +265,7 @@ "URL-DECODE" "URL-ENCODE" "USER-AGENT" - "WITHIN-REQUEST-P")) + "WITHIN-REQUEST-P" + "DEBUG-MODE-ON" + "DEBUG-MODE-OFF")) Modified: trunk/thirdparty/hunchentoot/specials.lisp =================================================================== --- trunk/thirdparty/hunchentoot/specials.lisp 2010-02-26 11:39:21 UTC (rev 4517) +++ trunk/thirdparty/hunchentoot/specials.lisp 2010-03-07 09:16:10 UTC (rev 4518) @@ -236,6 +236,16 @@ "Whether Hunchentoot should catch and log errors \(or rather invoke the debugger).") +(defparameter *max-debugging-threads* 5 + "Maximum number of simultaneous active calls invoke-debuger") + +(defvar *debugging-threads* nil + "List debugged threads") + +(defvar *debugging-threads-lock* (make-lock "debugging threads lock") + "A global lock to prevent two threads from modifying *debugging-threads* at +the same time") + (defvar-unbound *acceptor* "The current ACCEPTOR object while in the context of a request.") From bknr at bknr.net Tue Mar 9 16:47:24 2010 From: bknr at bknr.net (BKNR Commits) Date: Tue, 09 Mar 2010 17:47:24 +0100 Subject: [bknr-cvs] hans changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4519 Author: hans URL: http://bknr.net/trac/changeset/4519 Documentation update and typo fix from Andrey Moskvitin. U trunk/thirdparty/hunchentoot/conditions.lisp U trunk/thirdparty/hunchentoot/doc/index.xml Modified: trunk/thirdparty/hunchentoot/conditions.lisp =================================================================== --- trunk/thirdparty/hunchentoot/conditions.lisp 2010-03-07 09:16:10 UTC (rev 4518) +++ trunk/thirdparty/hunchentoot/conditions.lisp 2010-03-09 16:47:23 UTC (rev 4519) @@ -104,10 +104,10 @@ "Used to enable debug mode" (setf *catch-errors-p* nil)) -(defun debug-mode-off (&optional (kill-debuging-threads t)) +(defun debug-mode-off (&optional (kill-debugging-threads t)) "Used to turn off debug mode" (setf *catch-errors-p* t) - (when kill-debuging-threads + (when kill-debugging-threads (kill-all-debugging-threads))) (defun after-close-swank-connection (connection) @@ -129,8 +129,8 @@ "The default method invokes the debugger with CONDITION if *CATCH-ERRORS-P* is NIL." (unless (or *catch-errors-p* - (< *max-debugging-threads* - (length *debugging-threads*))) + (<= *max-debugging-threads* + (length *debugging-threads*))) (let ((thread (bt:current-thread))) (with-lock-held (*debugging-threads-lock*) (push thread *debugging-threads*)) Modified: trunk/thirdparty/hunchentoot/doc/index.xml =================================================================== --- trunk/thirdparty/hunchentoot/doc/index.xml 2010-03-07 09:16:10 UTC (rev 4518) +++ trunk/thirdparty/hunchentoot/doc/index.xml 2010-03-09 16:47:23 UTC (rev 4519) @@ -152,6 +152,12 @@ http://common-lisp.net/~loliveira/ediware/.

+

+ Andrey Moskvitin maintains a git + repository of Hunchentoot at + http://github.com/archimag/hunchentoot. +

+ If you're feeling unsecure about exposing Hunchentoot to the wild, @@ -2646,6 +2652,45 @@ + + +Enable debug mode: sets the value of *CATCH-ERRORS-P* to NIL. + + + + + optional kill-debugging-threads + + +Disable debug mode: sets the value +of *CATCH-ERRORS-P* to T. If the +value of kill-debugging-threads +is T, which is the default, all threads that are sent to +the debugger by MAYBE-INVOKE-DEBUGGER will be +terminated. If +a swank server is +present, (debug-mode-off t) will be automatically be +called after the connection to the swank server is established: this +provides some protection when debug mode has accidentially been +enabled in a production environment. + + + + + +This variable determines the maximum number of threads that are sent +to +the debugger +by MAYBE-INVOKE-DEBUGGER. The default for this +parameter is 5. Once this limit is +reached, MAYBE-INVOKE-DEBUGGER does not invoke +the debugger for new threads that signal an error. This behavior can +be helpful for safer debugging a production environment. +See MAYBE-INVOKE-DEBUGGER if you want to +fine-tune this behaviour. + + + condition @@ -2660,7 +2705,9 @@ method invokes the debugger with condition if -*CATCH-ERRORS-P* is NIL. +*CATCH-ERRORS-P* is NIL and the number of active debuggers +is less than *MAX-DEBUGGING-THREADS*. From bknr at bknr.net Tue Mar 23 10:54:58 2010 From: bknr at bknr.net (BKNR Commits) Date: Tue, 23 Mar 2010 11:54:58 +0100 Subject: [bknr-cvs] hans changed deployed/bos/projects/bos/ Message-ID: Revision: 4520 Author: hans URL: http://bknr.net/trac/changeset/4520 Make /reports-xml/all-contracts-m2s into a HTML table by default, requested by the SL team in Indonesia. A deployed/bos/projects/bos/payment-website/static/contracts.xsl U deployed/bos/projects/bos/web/reports-xml-handler.lisp Added: deployed/bos/projects/bos/payment-website/static/contracts.xsl =================================================================== --- deployed/bos/projects/bos/payment-website/static/contracts.xsl (rev 0) +++ deployed/bos/projects/bos/payment-website/static/contracts.xsl 2010-03-23 10:54:57 UTC (rev 4520) @@ -0,0 +1,34 @@ + + + + + + + + Samboja Lestari Donor List + + + + + + + + +
NameIDCountryCoordinate (x/y)qm
+ + + + + + + + + + / + + + + + + Modified: deployed/bos/projects/bos/web/reports-xml-handler.lisp =================================================================== --- deployed/bos/projects/bos/web/reports-xml-handler.lisp 2010-03-09 16:47:23 UTC (rev 4519) +++ deployed/bos/projects/bos/web/reports-xml-handler.lisp 2010-03-23 10:54:57 UTC (rev 4520) @@ -41,17 +41,19 @@ (defun all-contracts/internal (&key include-coords) (dolist (contract *contracts-to-process*) - (with-element "contract" - (attribute "id" (store-object-id contract)) - (attribute "sponsor-id" (store-object-id (contract-sponsor contract))) - (attribute "universal-time" (contract-date contract)) - (attribute "paid" (contract-paidp contract)) - (attribute "date-time" (format-date-time (contract-date contract) :xml-style t)) - (attribute "country" (sponsor-country (contract-sponsor contract))) - (attribute "sqm-count" (length (contract-m2s contract))) - (when include-coords - (dolist (m2 (contract-m2s contract)) - (with-element "m2" + (let ((sponsor (contract-sponsor contract))) + (with-element "contract" + (attribute "id" (store-object-id contract)) + (attribute "sponsor-id" (store-object-id sponsor)) + (when (user-full-name sponsor) + (attribute "sponsor-name" (user-full-name sponsor))) + (attribute "universal-time" (contract-date contract)) + (attribute "paid" (contract-paidp contract)) + (attribute "date-time" (format-date-time (contract-date contract) :xml-style t)) + (attribute "country" (sponsor-country sponsor)) + (attribute "sqm-count" (length (contract-m2s contract))) + (when include-coords + (let ((m2 (first (contract-m2s contract)))) (attribute "utm-x" (m2-x m2)) (attribute "utm-y" (m2-y m2)))))))) @@ -59,6 +61,7 @@ (all-contracts/internal)) (defreport all-contracts-m2s () + (sax:processing-instruction cxml::*sink* "xml-stylesheet" "href=\"/static/contracts.xsl\" type=\"text/xsl\"") (all-contracts/internal :include-coords t)) (defun week-of-contract (contract) From bknr at bknr.net Tue Mar 23 12:57:15 2010 From: bknr at bknr.net (BKNR Commits) Date: Tue, 23 Mar 2010 13:57:15 +0100 Subject: [bknr-cvs] hans changed deployed/bos/projects/bos/ Message-ID: Revision: 4521 Author: hans URL: http://bknr.net/trac/changeset/4521 Format tweaks in sponsor list. U deployed/bos/projects/bos/payment-website/static/contracts.xsl U deployed/bos/projects/bos/web/reports-xml-handler.lisp Modified: deployed/bos/projects/bos/payment-website/static/contracts.xsl =================================================================== --- deployed/bos/projects/bos/payment-website/static/contracts.xsl 2010-03-23 10:54:57 UTC (rev 4520) +++ deployed/bos/projects/bos/payment-website/static/contracts.xsl 2010-03-23 12:57:15 UTC (rev 4521) @@ -10,7 +10,7 @@ - + @@ -23,10 +23,10 @@ - - - - + + + + Modified: deployed/bos/projects/bos/web/reports-xml-handler.lisp =================================================================== --- deployed/bos/projects/bos/web/reports-xml-handler.lisp 2010-03-23 10:54:57 UTC (rev 4520) +++ deployed/bos/projects/bos/web/reports-xml-handler.lisp 2010-03-23 12:57:15 UTC (rev 4521) @@ -53,9 +53,8 @@ (attribute "country" (sponsor-country sponsor)) (attribute "sqm-count" (length (contract-m2s contract))) (when include-coords - (let ((m2 (first (contract-m2s contract)))) - (attribute "utm-x" (m2-x m2)) - (attribute "utm-y" (m2-y m2)))))))) + (destructuring-bind (lon lat) (m2-lon-lat (first (contract-m2s contract))) + (attribute "coords" (with-output-to-string (s) (geometry:format-lon-lat s lon lat))))))))) (defreport all-contracts () (all-contracts/internal)) From bknr at bknr.net Tue Mar 30 13:22:17 2010 From: bknr at bknr.net (BKNR Commits) Date: Tue, 30 Mar 2010 15:22:17 +0200 Subject: [bknr-cvs] edi changed trunk/thirdparty/hunchentoot/ Message-ID: Revision: 4522 Author: edi URL: http://bknr.net/trac/changeset/4522 Safeguard measures against XSS attacks (J.P. Larocque) U trunk/thirdparty/hunchentoot/CHANGELOG U trunk/thirdparty/hunchentoot/headers.lisp U trunk/thirdparty/hunchentoot/util.lisp Modified: trunk/thirdparty/hunchentoot/CHANGELOG =================================================================== --- trunk/thirdparty/hunchentoot/CHANGELOG 2010-03-23 12:57:15 UTC (rev 4521) +++ trunk/thirdparty/hunchentoot/CHANGELOG 2010-03-30 13:22:17 UTC (rev 4522) @@ -1,3 +1,4 @@ +Safeguard measures against XSS attacks (J.P. Larocque) Prevent potential leak when closing stream (Matt Lamari, Martin Simmons) Change some occurrences of HANDLER-CASE* to HANDLER-CASE (Hans H?bner, Allan Dee) Modified: trunk/thirdparty/hunchentoot/headers.lisp =================================================================== --- trunk/thirdparty/hunchentoot/headers.lisp 2010-03-23 12:57:15 UTC (rev 4521) +++ trunk/thirdparty/hunchentoot/headers.lisp 2010-03-30 13:22:17 UTC (rev 4522) @@ -157,15 +157,15 @@ ((#.+http-internal-server-error+) content) ((#.+http-moved-temporarily+ #.+http-moved-permanently+) (format nil "The document has moved here" - (header-out :location))) + (escape-for-html (header-out :location)))) ((#.+http-authorization-required+) "The server could not verify that you are authorized to access the document requested. Either you supplied the wrong credentials \(e.g., bad password), or your browser doesn't understand how to supply the credentials required.") ((#.+http-forbidden+) (format nil "You don't have permission to access ~A on this server." - (script-name request))) + (escape-for-html (script-name request)))) ((#.+http-not-found+) (format nil "The requested URL ~A was not found on this server." - (script-name request))) + (escape-for-html (script-name request)))) ((#.+http-bad-request+) "Your browser sent a request that this server could not understand.") (otherwise "")) Modified: trunk/thirdparty/hunchentoot/util.lisp =================================================================== --- trunk/thirdparty/hunchentoot/util.lisp 2010-03-23 12:57:15 UTC (rev 4521) +++ trunk/thirdparty/hunchentoot/util.lisp 2010-03-30 13:22:17 UTC (rev 4522) @@ -302,7 +302,7 @@ +implementation-link+ (escape-for-html (lisp-implementation-type)) (escape-for-html (lisp-implementation-version)) - (or (host *request*) (acceptor-address *acceptor*)) + (escape-for-html (or (host *request*) (acceptor-address *acceptor*))) (scan ":\\d+$" (or (host *request*) "")) (acceptor-port *acceptor*))) From bknr at bknr.net Wed Mar 31 13:41:12 2010 From: bknr at bknr.net (BKNR Commits) Date: Wed, 31 Mar 2010 15:41:12 +0200 Subject: [bknr-cvs] hans changed deployed/bos/projects/bos/payment-website/templates/da/bestellung.xml Message-ID: Revision: 4523 Author: hans URL: http://bknr.net/trac/changeset/4523 BOS Daenemark nimmt keine Ueberweisungen mehr an. U deployed/bos/projects/bos/payment-website/templates/da/bestellung.xml Modified: deployed/bos/projects/bos/payment-website/templates/da/bestellung.xml =================================================================== --- deployed/bos/projects/bos/payment-website/templates/da/bestellung.xml 2010-03-30 13:22:17 UTC (rev 4522) +++ deployed/bos/projects/bos/payment-website/templates/da/bestellung.xml 2010-03-31 13:41:11 UTC (rev 4523) @@ -130,8 +130,7 @@ betaling med kredit kort. Bem??rk, at onlinebetaling med kreditkort g??r via BOS Tyskland. Du kan derfor ikke f?? fradrag p?? sin selvangivelse, n??r du betaler - med kreditkort. For at opn?? skattefradrag, skal du - betale via bankoverf??rsel. + med kreditkort.
NameIDCountryCoordinate (x/y)qm
NameIDCountryCoordinateqm
/