January 2008 - bknr-cvs@common-lisp.net - mailman3.common-lisp.net

[bknr-cvs] r2334 - branches/bos/projects/bos
by hhubner＠common-lisp.net 17 Jan '08

17 Jan '08

Author: hhubner Date: Thu Jan 17 10:56:30 2008 New Revision: 2334 Added: branches/bos/projects/bos/screenrc Log: Add screenrc used on the test server Added: branches/bos/projects/bos/screenrc ============================================================================== --- (empty file) +++ branches/bos/projects/bos/screenrc Thu Jan 17 10:56:30 2008 @@ -0,0 +1,20 @@ +multiuser on +acladd hans + +zombie qr +defscrollback 5000 +startup_message off +vbell on +vbellwait 0 +msgminwait 0 +msgwait 0 + +chdir /home/hans/bknr-svn/projects/bos + +screen -t webserver lisp -core bos.core -slime +#logfile screen.log +#log on +screen -t cert-daemon lisp -core bos.core -cert-daemon + +msgminwait 1 +msgwait 1

1 0

[bknr-cvs] r2332 - branches/bos/projects/bos/worldpay-test
by bknr＠bknr.net 17 Jan '08

17 Jan '08

Author: hhubner Date: 2008-01-17 10:50:04 -0500 (Thu, 17 Jan 2008) New Revision: 2332 Modified: branches/bos/projects/bos/worldpay-test/sponsor-handlers.lisp Log: Fix message after cert regeneration. Modified: branches/bos/projects/bos/worldpay-test/sponsor-handlers.lisp =================================================================== --- branches/bos/projects/bos/worldpay-test/sponsor-handlers.lisp 2008-01-17 15:24:19 UTC (rev 2331) +++ branches/bos/projects/bos/worldpay-test/sponsor-handlers.lisp 2008-01-17 15:50:04 UTC (rev 2332) @@ -324,10 +324,9 @@ (with-query-params (req name address language) (contract-issue-cert contract name :address address :language language)) (with-bos-cms-page (req :title "Certificate has been recreated") - (html "The certificates for the sponsor have been re-generated.") + (html "The certificates for the sponsor have been re-generated." :br) (unless (contract-download-only-p contract) (mail-print-pdf contract) - (let ((sponsor (contract-sponsor contract))) - (html "The print certificate has been sent to the relevant BOS office address by email." - :br - (cmslink #?"edit-sponsor/$((store-object-id sponsor))" "return to sponsor")))))) \ No newline at end of file + (html "The print certificate has been sent to the relevant BOS office address by email." :br)) + (let ((sponsor (contract-sponsor contract))) + (cmslink #?"edit-sponsor/$((store-object-id sponsor))" "return to sponsor")))) \ No newline at end of file

1 0

[bknr-cvs] r2331 - in branches/bos/projects/bos: . m2 payment-website/images worldpay-test
by bknr＠bknr.net 17 Jan '08

17 Jan '08

Author: hhubner Date: 2008-01-17 10:24:19 -0500 (Thu, 17 Jan 2008) New Revision: 2331 Modified: branches/bos/projects/bos/README branches/bos/projects/bos/m2/m2.lisp branches/bos/projects/bos/m2/mail-generator.lisp branches/bos/projects/bos/m2/packages.lisp branches/bos/projects/bos/payment-website/images/header_ganzneu.gif branches/bos/projects/bos/worldpay-test/sponsor-handlers.lisp Log: Send out re-generated print certificate by email. Tag mails by sponsor country for filtering. Modified: branches/bos/projects/bos/README =================================================================== --- branches/bos/projects/bos/README 2008-01-17 15:23:49 UTC (rev 2330) +++ branches/bos/projects/bos/README 2008-01-17 15:24:19 UTC (rev 2331) @@ -4,7 +4,7 @@ Vorbereitung ------------ - - CMUCL 19a installieren, so dass "lisp" im Pfad ist + - CMUCL 19c installieren, so dass "lisp" im Pfad ist - Komplettes cvs auschecken: $ cvs -d :ext:bknr.net:/home/bknr/cvs co -d bknr.net . Modified: branches/bos/projects/bos/m2/m2.lisp =================================================================== --- branches/bos/projects/bos/m2/m2.lisp 2008-01-17 15:23:49 UTC (rev 2330) +++ branches/bos/projects/bos/m2/m2.lisp 2008-01-17 15:24:19 UTC (rev 2331) @@ -286,20 +286,34 @@ (defmethod contract-pdf-url ((contract contract)) (format nil "/certificate/~A" (store-object-id contract))) +(defmethod contract-certificates-generated-p (contract) + (and (probe-file (contract-pdf-pathname contract)) + (or (contract-download-only-p contract) + (probe-file (contract-pdf-pathname contract :print t))))) + +(defmethod contract-delete-certificate-files (contract) + (ignore-errors + (delete-file (contract-pdf-pathname contract)) + (delete-file (contract-pdf-pathname contract :print t)))) + +(defun wait-for-certificates (contract) + "Wait until the PDF generating process has generated the certificates" + (dotimes (i 10) + (when (contract-certificates-generated-p contract) + (return)) + (sleep 1)) + (unless (contract-certificates-generated-p contract) + (error "Cannot generate certificate"))) + (defmethod contract-issue-cert ((contract contract) name &key address language) - (if (contract-cert-issued contract) - (warn "can't re-issue cert for ~A" contract) - (progn - (make-certificate contract name :address address :language language) - (unless (contract-download-only-p contract) - (make-certificate contract name :address address :language language :print t)) - (dotimes (i 10) - (when (probe-file (contract-pdf-pathname contract)) - (return)) - (sleep 1)) - (if (probe-file (contract-pdf-pathname contract)) - (change-slot-values contract 'cert-issued t) - (error "Cannot generate certificate"))))) + (when (contract-cert-issued contract) + (warn "re-issuing cert for ~A" contract)) + (contract-delete-certificate-files contract) + (make-certificate contract name :address address :language language) + (unless (contract-download-only-p contract) + (make-certificate contract name :address address :language language :print t)) + (wait-for-certificates contract) + (change-slot-values contract 'cert-issued t)) (defmethod contract-image-tiles ((contract contract)) (let (image-tiles) Modified: branches/bos/projects/bos/m2/mail-generator.lisp =================================================================== --- branches/bos/projects/bos/m2/mail-generator.lisp 2008-01-17 15:23:49 UTC (rev 2330) +++ branches/bos/projects/bos/m2/mail-generator.lisp 2008-01-17 15:24:19 UTC (rev 2331) @@ -214,14 +214,40 @@ :content-type nil :more-headers t :text (with-output-to-string (s) + (format s "X-BOS-Sponsor-Country: ~A~%" (sponsor-country (contract-sponsor contract))) (print-mime s (make-instance 'multipart-mime :subtype "mixed" :content parts) t t)))) - (unless (contract-download-only-p contract) + (when (contract-pdf-pathname contract :print t) (delete-file (contract-pdf-pathname contract :print t)))) +(defun mail-print-pdf (contract) + (send-system-mail + :to (contract-office-email contract) + :subject (format nil "PDF certificate (regenerated) - Sponsor-ID ~D Contract-ID ~D" + (store-object-id (contract-sponsor contract)) + (store-object-id contract)) + :content-type nil + :more-headers t + :text (with-output-to-string (s) + (format s "X-BOS-Sponsor-Country: ~A~%" (sponsor-country (contract-sponsor contract))) + (print-mime s + (make-instance + 'multipart-mime + :subtype "mixed" + :content (list + (make-instance + 'mime + :type "application" + :subtype (format nil "pdf; name=\"contract-~A.pdf\"" + (store-object-id contract)) + :encoding :base64 + :content (file-contents (contract-pdf-pathname contract :print t))))) + t t))) + (delete-file (contract-pdf-pathname contract :print t))) + (defun mail-backoffice-sponsor-data (contract req) (with-query-params (req numsqm country email name address date language) (let ((parts (list (make-html-part (format nil " Modified: branches/bos/projects/bos/m2/packages.lisp =================================================================== --- branches/bos/projects/bos/m2/packages.lisp 2008-01-17 15:23:49 UTC (rev 2330) +++ branches/bos/projects/bos/m2/packages.lisp 2008-01-17 15:24:19 UTC (rev 2331) @@ -195,6 +195,7 @@ #:mail-manual-sponsor-data #:mail-backoffice-sponsor-data #:mail-worldpay-sponsor-data + #:mail-print-pdf #:*cert-download-directory*)) Modified: branches/bos/projects/bos/payment-website/images/header_ganzneu.gif =================================================================== (Binary files differ) Modified: branches/bos/projects/bos/worldpay-test/sponsor-handlers.lisp =================================================================== --- branches/bos/projects/bos/worldpay-test/sponsor-handlers.lisp 2008-01-17 15:23:49 UTC (rev 2330) +++ branches/bos/projects/bos/worldpay-test/sponsor-handlers.lisp 2008-01-17 15:24:19 UTC (rev 2331) @@ -304,7 +304,8 @@ (t (error "invalid sponsor or contract id ~A" object-id-string))))) (defmethod handle-object-form ((handler cert-regen-handler) action (contract contract) req) - (with-bos-cms-page (req :title "Re-generate Certificate") + (with-bos-cms-page (req :title (format nil "Re-generate Certificate~@[~*s~]" + (not (contract-download-only-p contract)))) (html ((:form :name "form") ((:table) @@ -319,12 +320,14 @@ (html (:tr (:td (submit-button "regenerate" "regenerate"))))))))) -(defun confirm-cert-regen (req) - (with-bos-cms-page (req :title "Certificate generation request has been created") - (html - "Your certificate generation request has been created, please wait a few seconds before checking the PDF file"))) - (defmethod handle-object-form ((handler cert-regen-handler) (action (eql :regenerate)) (contract contract) req) (with-query-params (req name address language) - (bos.m2::make-certificate contract name :address address :language language)) - (confirm-cert-regen req)) \ No newline at end of file + (contract-issue-cert contract name :address address :language language)) + (with-bos-cms-page (req :title "Certificate has been recreated") + (html "The certificates for the sponsor have been re-generated.") + (unless (contract-download-only-p contract) + (mail-print-pdf contract) + (let ((sponsor (contract-sponsor contract))) + (html "The print certificate has been sent to the relevant BOS office address by email." + :br + (cmslink #?"edit-sponsor/$((store-object-id sponsor))" "return to sponsor")))))) \ No newline at end of file

1 0