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

[bknr-cvs] hans changed trunk/projects/bos/cert-daemon/cert-daemon.sh
by BKNR Commits 14 Oct '08

14 Oct '08

Revision: 3993 Author: hans URL: http://bknr.net/trac/changeset/3993 More pathname fixes. U trunk/projects/bos/cert-daemon/cert-daemon.sh Modified: trunk/projects/bos/cert-daemon/cert-daemon.sh =================================================================== --- trunk/projects/bos/cert-daemon/cert-daemon.sh 2008-10-14 20:15:23 UTC (rev 3992) +++ trunk/projects/bos/cert-daemon/cert-daemon.sh 2008-10-14 20:46:10 UTC (rev 3993) @@ -28,11 +28,11 @@ pdftk $tmp1_file cat 1 output $tmp2_file pdftk $tmp1_file cat 2 output $tmp3_file pdftk $m2s_pdf_file background $tmp3_file output $tmp4_file - pdftk $tmp2ww_file $tmp4_file output $print_pdf_file + pdftk $tmp2_file $tmp4_file output $print_pdf_file echo generated $print_pdf_file fi - pdftk urkunde-print-$language.pdf fill_form $download_fdf_file output $tmp1_file + pdftk urkunde-download-$language.pdf fill_form $download_fdf_file output $tmp1_file pdftk $m2s_pdf_file background $tmp1_file output $download_pdf_file echo generated $download_pdf_file rm -f $tmp1_file $tmp2_file $tmp3_file $tmp4_file $print_fdf_file $download_fdf_file

1 0

[bknr-cvs] hans changed trunk/projects/bos/cert-daemon/cert-daemon-driver.sh
by BKNR Commits 14 Oct '08

14 Oct '08

Revision: 3992 Author: hans URL: http://bknr.net/trac/changeset/3992 Fix pathnames again U trunk/projects/bos/cert-daemon/cert-daemon-driver.sh Modified: trunk/projects/bos/cert-daemon/cert-daemon-driver.sh =================================================================== --- trunk/projects/bos/cert-daemon/cert-daemon-driver.sh 2008-10-14 20:14:36 UTC (rev 3991) +++ trunk/projects/bos/cert-daemon/cert-daemon-driver.sh 2008-10-14 20:15:23 UTC (rev 3992) @@ -2,14 +2,14 @@ export PATH=/bin:/usr/bin:/usr/local/bin CERTS=/home/bknr/certs -CHECKOUT=/home/bknr/bknr-svn/projects/bos +CHECKOUT=/home/bknr/bknr-svn/projects/bos/cert-daemon hostname=`hostname` cd $HOME while true do - sh $CHECKOUT/gen-cert.sh + sh $CHECKOUT/cert-daemon.sh mail -s "Cert daemon on $hostname crashed" hans < /dev/null sleep 5 done \ No newline at end of file

1 0

[bknr-cvs] hans changed trunk/projects/bos/cert-daemon/cert-daemon-driver.sh
by BKNR Commits 14 Oct '08

14 Oct '08

Revision: 3991 Author: hans URL: http://bknr.net/trac/changeset/3991 Put some path names in. U trunk/projects/bos/cert-daemon/cert-daemon-driver.sh Modified: trunk/projects/bos/cert-daemon/cert-daemon-driver.sh =================================================================== --- trunk/projects/bos/cert-daemon/cert-daemon-driver.sh 2008-10-14 20:11:44 UTC (rev 3990) +++ trunk/projects/bos/cert-daemon/cert-daemon-driver.sh 2008-10-14 20:14:36 UTC (rev 3991) @@ -1,14 +1,15 @@ #!/bin/sh export PATH=/bin:/usr/bin:/usr/local/bin -HOME=/home/bknr/certs +CERTS=/home/bknr/certs +CHECKOUT=/home/bknr/bknr-svn/projects/bos hostname=`hostname` cd $HOME while true do - sh gen-cert.sh + sh $CHECKOUT/gen-cert.sh mail -s "Cert daemon on $hostname crashed" hans < /dev/null sleep 5 done \ No newline at end of file

1 0

[bknr-cvs] hans changed trunk/projects/bos/
by BKNR Commits 14 Oct '08

14 Oct '08

Revision: 3990 Author: hans URL: http://bknr.net/trac/changeset/3990 Rewrote cert daemon in bourne shell, handle two-page certificate. U trunk/projects/bos/Makefile A trunk/projects/bos/cert-daemon/ A trunk/projects/bos/cert-daemon/cert-daemon-driver.sh A trunk/projects/bos/cert-daemon/cert-daemon.sh D trunk/projects/bos/cert-daemon/fake-urkunde-testdaten.fdf D trunk/projects/bos/cert-daemon/fake-urkunde.pdf D trunk/projects/bos/cert-gen/ U trunk/projects/bos/m2/bos.m2.asd D trunk/projects/bos/m2/cert-daemon.lisp U trunk/projects/bos/screenrc Change set too large, please see URL above

1 0

[bknr-cvs] hans changed trunk/projects/bos/m2/
by BKNR Commits 14 Oct '08

14 Oct '08

Revision: 3989 Author: hans URL: http://bknr.net/trac/changeset/3989 Change CONTRACT-CERTIFICATES-GENERATED-P so that only the download certificate is checked for existence. The print certificate is deleted after is has been mailed out. U trunk/projects/bos/m2/cert-daemon.lisp U trunk/projects/bos/m2/m2.lisp Modified: trunk/projects/bos/m2/cert-daemon.lisp =================================================================== --- trunk/projects/bos/m2/cert-daemon.lisp 2008-10-14 10:37:34 UTC (rev 3988) +++ trunk/projects/bos/m2/cert-daemon.lisp 2008-10-14 12:21:45 UTC (rev 3989) @@ -47,6 +47,12 @@ (format "Error generating certificate from file ~A: ~A~%" fdf-pathname e))))) (defun generate-certs () + ;; Mail certificates need to be generated first, then download-only + ;; certificates, because the CONTRACT-CERTIFICATES-GENERATED-P + ;; function only checks for the existence of the download + ;; certificate file. The mail certificates are deleted after they + ;; have been sent by mail, so we cannot check for both files in said + ;; routine. (fill-forms *cert-mail-directory* *cert-mail-template*) (fill-forms *cert-download-directory* *cert-download-template*) (fill-forms *receipt-mail-directory* *receipt-mail-template*) Modified: trunk/projects/bos/m2/m2.lisp =================================================================== --- trunk/projects/bos/m2/m2.lisp 2008-10-14 10:37:34 UTC (rev 3988) +++ trunk/projects/bos/m2/m2.lisp 2008-10-14 12:21:45 UTC (rev 3989) @@ -359,9 +359,7 @@ (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))))) + (probe-file (contract-pdf-pathname contract))) (defmethod contract-delete-certificate-files (contract) (ignore-errors

1 0

[bknr-cvs] hans changed trunk/bknr/datastore/src/bknr.utils.asd
by BKNR Commits 14 Oct '08

14 Oct '08

Revision: 3988 Author: hans URL: http://bknr.net/trac/changeset/3988 Remove iconv dependency, which is no longer used. U trunk/bknr/datastore/src/bknr.utils.asd Modified: trunk/bknr/datastore/src/bknr.utils.asd =================================================================== --- trunk/bknr/datastore/src/bknr.utils.asd 2008-10-14 10:32:34 UTC (rev 3987) +++ trunk/bknr/datastore/src/bknr.utils.asd 2008-10-14 10:37:34 UTC (rev 3988) @@ -19,8 +19,7 @@ :depends-on (:cl-interpol :cl-ppcre :md5 :flexi-streams - :bordeaux-threads - :iconv) + :bordeaux-threads) :components ((:module "statistics" :components ((:file "package") (:file "runtime-statistics" :depends-on ("package"))))

1 0

[bknr-cvs] hans changed trunk/
by BKNR Commits 14 Oct '08

14 Oct '08

Revision: 3987 Author: hans URL: http://bknr.net/trac/changeset/3987 Minor cosmetical fixes Fix startup from Makefile Repair certificate generation (not yet complete) U trunk/bknr/datastore/src/utils/make-fdf-file.lisp U trunk/projects/bos/Makefile U trunk/projects/bos/m2/cert-daemon.lisp U trunk/projects/bos/payment-website/templates/da/toplevel.xml U trunk/projects/bos/payment-website/templates/de/toplevel.xml U trunk/projects/bos/payment-website/templates/de/toplevel_news.xml U trunk/projects/bos/payment-website/templates/en/toplevel.xml D trunk/thirdparty/iconv/ Modified: trunk/bknr/datastore/src/utils/make-fdf-file.lisp =================================================================== --- trunk/bknr/datastore/src/utils/make-fdf-file.lisp 2008-10-14 08:10:41 UTC (rev 3986) +++ trunk/bknr/datastore/src/utils/make-fdf-file.lisp 2008-10-14 10:32:34 UTC (rev 3987) @@ -3,7 +3,7 @@ ;; make-fdf-file.lisp ;; Funktion zum Erstellen von FDF-Dateien. Diese können mit Hilfe von -;; pdftk verwendet werden, um PDF-Formulare auszuföllen. Das +;; pdftk verwendet werden, um PDF-Formulare auszufuellen. Das ;; FDF-Format ist dabei ein Unterformat von Adobe PDF und wird in der ;; PDF-Spezifikation beschrieben. @@ -15,7 +15,7 @@ (regex-replace-all #?r"([\\])" string #?r"\\\1")) (defun make-fdf-file (file-name &rest keys-and-values) - (with-open-file (stream file-name :direction :output :if-does-not-exist :create :if-exists :supersede) + (with-open-file (stream file-name :direction :output :if-does-not-exist :create :if-exists :supersede :external-format :latin-1) (format stream "%FDF-1.2 1 0 obj <</FDF @@ -23,11 +23,10 @@ [ ") (loop for (key value) on keys-and-values by #'cddr - do (format stream " <</T(~(~a~))/V(~a)>>~%" key - (pdf-quote-string (iconv:iconv "UTF-8" "ISO-8859-1" - (if (stringp value) - value - (format nil "~a" value)))))) + do (format stream " <</T(~(~a~))/V(~a)>>~%" key + (pdf-quote-string (if (stringp value) + value + (format nil "~a" value))))) (format stream " ] >> >> Modified: trunk/projects/bos/Makefile =================================================================== --- trunk/projects/bos/Makefile 2008-10-14 08:10:41 UTC (rev 3986) +++ trunk/projects/bos/Makefile 2008-10-14 10:32:34 UTC (rev 3987) @@ -1,8 +1,11 @@ all: bos.core .PHONY: all +SBCL_BUILD=env LC_CTYPE=en_US.UTF-8 HOME=/home/bknr sbcl --dynamic-space-size 800 --no-userinit +SBCL_RUN=env LC_CTYPE=en_US.ISO8859-1 sbcl --core bos.core --dynamic-space-size 800 --no-userinit + bos.core: build.lisp - env LANG=en_US.UTF-8 sbcl --load build.lisp --eval '(sb-ext:save-lisp-and-die "bos.core")' + $(SBCL_BUILD) --load build.lisp --eval '(sb-ext:save-lisp-and-die "bos.core")' # various cleaning stuff .PHONY: cleancore @@ -11,7 +14,7 @@ .PHONY: cleanfasl cleanfasl: - (cd ../.. && sbcl --disable-debugger --load clean.lisp --eval '(quit)') + (cd ../.. && sbcl --no-userinit --disable-debugger --load clean.lisp --eval '(quit)') .PHONY: cleanall cleanall: cleancore cleanfasl @@ -21,11 +24,11 @@ .PHONY: start start: bos.core - sbcl --core bos.core --no-userinit --eval '(start)' + $(SBCL_RUN) --eval '(start)' .PHONY: start-cert-daemon start-cert-daemon: bos.core - sbcl --core bos.core --no-userinit --eval '(bos.m2.cert-generator:cert-daemon)' + $(SBCL_RUN) --eval '(bos.m2.cert-generator:cert-daemon)' # TAGS TAGS: Modified: trunk/projects/bos/m2/cert-daemon.lisp =================================================================== --- trunk/projects/bos/m2/cert-daemon.lisp 2008-10-14 08:10:41 UTC (rev 3986) +++ trunk/projects/bos/m2/cert-daemon.lisp 2008-10-14 10:32:34 UTC (rev 3987) @@ -25,9 +25,7 @@ (warn "While filling form ~A with ~A:~%~A" pdf-pathname fdf-pathname e)))) (defun fill-forms (directory template-pathname) - (dolist (fdf-pathname (remove "fdf" (cl-fad:list-directory directory) - :test (complement #'string-equal) - :key #'pathname-type)) + (dolist (fdf-pathname (directory (merge-pathnames "*.fdf" directory))) (handler-case (destructuring-bind (id &optional (country "en")) (split "-" (pathname-name fdf-pathname)) Modified: trunk/projects/bos/payment-website/templates/da/toplevel.xml =================================================================== --- trunk/projects/bos/payment-website/templates/da/toplevel.xml 2008-10-14 08:10:41 UTC (rev 3986) +++ trunk/projects/bos/payment-website/templates/da/toplevel.xml 2008-10-14 10:32:34 UTC (rev 3987) @@ -58,7 +58,6 @@ kontakt </a> </div> - <div>l</div> </div> </div>  Modified: trunk/projects/bos/payment-website/templates/de/toplevel.xml =================================================================== --- trunk/projects/bos/payment-website/templates/de/toplevel.xml 2008-10-14 08:10:41 UTC (rev 3986) +++ trunk/projects/bos/payment-website/templates/de/toplevel.xml 2008-10-14 10:32:34 UTC (rev 3987) @@ -66,7 +66,6 @@ Kontakt </a> </div> - <div>l</div> </div> </div>  Modified: trunk/projects/bos/payment-website/templates/de/toplevel_news.xml =================================================================== --- trunk/projects/bos/payment-website/templates/de/toplevel_news.xml 2008-10-14 08:10:41 UTC (rev 3986) +++ trunk/projects/bos/payment-website/templates/de/toplevel_news.xml 2008-10-14 10:32:34 UTC (rev 3987) @@ -63,7 +63,6 @@ Kontakt </a> </div> - <div>l</div> </div> <div id="menue_header_right" align="right"> <select name="language" style="width:125px;" Modified: trunk/projects/bos/payment-website/templates/en/toplevel.xml =================================================================== --- trunk/projects/bos/payment-website/templates/en/toplevel.xml 2008-10-14 08:10:41 UTC (rev 3986) +++ trunk/projects/bos/payment-website/templates/en/toplevel.xml 2008-10-14 10:32:34 UTC (rev 3987) @@ -68,7 +68,6 @@ contact </a> </div> - <div>l</div> </div> </div>

1 0

[bknr-cvs] hans changed trunk/projects/bos/m2/mail-generator.lisp
by BKNR Commits 14 Oct '08

14 Oct '08

Revision: 3986 Author: hans URL: http://bknr.net/trac/changeset/3986 Don't print stuff to the console that might contain non-ASCII characters. U trunk/projects/bos/m2/mail-generator.lisp Modified: trunk/projects/bos/m2/mail-generator.lisp =================================================================== --- trunk/projects/bos/m2/mail-generator.lisp 2008-10-13 16:34:22 UTC (rev 3985) +++ trunk/projects/bos/m2/mail-generator.lisp 2008-10-14 08:10:41 UTC (rev 3986) @@ -80,7 +80,7 @@ ")) (defun mail-fiscal-certificate-to-office (contract name address country) - (format t "mail-fiscal-certificate-to-office: ~a name: ~a address: ~a country: ~a~%" contract name address country)) + #+(or) (format t "mail-fiscal-certificate-to-office: ~a name: ~a address: ~a country: ~a~%" contract name address country)) (defun mail-template-directory (language) "Return the directory where the mail templates are stored"

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/web/kml-handlers.lisp
by BKNR Commits 13 Oct '08

13 Oct '08

Revision: 3985 Author: ksprotte URL: http://bknr.net/trac/changeset/3985 corrected small typo in last commit U trunk/projects/bos/web/kml-handlers.lisp Modified: trunk/projects/bos/web/kml-handlers.lisp =================================================================== --- trunk/projects/bos/web/kml-handlers.lisp 2008-10-13 16:21:39 UTC (rev 3984) +++ trunk/projects/bos/web/kml-handlers.lisp 2008-10-13 16:34:22 UTC (rev 3985) @@ -108,10 +108,10 @@ #?r"" string (if (and sponsor (first (sponsor-contracts sponsor))) - (let ((contract (first (sponsor-contracts sponsor))) - (node (find-contract-node *contract-tree* contract)) - (path (node-path node)) - (contract-id (store-object-id contract))) + (let* ((contract (first (sponsor-contracts sponsor))) + (node (find-contract-node *contract-tree* contract)) + (path (node-path node)) + (contract-id (store-object-id contract))) (format nil "<href>http://~a/contract-tree-kml?rmcid=~D&rmcpath=~{~D~}&lang=~A</href>" (website-host) contract-id path lang)) (format nil "<href>http://~A/contract-tree-kml?lang=~A</href>"

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/web/kml-handlers.lisp
by BKNR Commits 13 Oct '08

13 Oct '08

Revision: 3984 Author: ksprotte URL: http://bknr.net/trac/changeset/3984 added replace-contract-tree-placeholder U trunk/projects/bos/web/kml-handlers.lisp Modified: trunk/projects/bos/web/kml-handlers.lisp =================================================================== --- trunk/projects/bos/web/kml-handlers.lisp 2008-10-13 13:37:52 UTC (rev 3983) +++ trunk/projects/bos/web/kml-handlers.lisp 2008-10-13 16:21:39 UTC (rev 3984) @@ -98,11 +98,25 @@ (if (null sponsor) string (let ((contract (first (sponsor-contracts sponsor)))) - (ppcre:regex-replace #?r"" + (ppcre:regex-replace #?r"" string (cxml:with-xml-output (cxml:make-string-sink :omit-xml-declaration-p t) (write-personalized-contract-placemark-kml contract lang)))))) +(defun replace-contract-tree-placeholder (string sponsor lang) + (ppcre:regex-replace + #?r"" + string + (if (and sponsor (first (sponsor-contracts sponsor))) + (let ((contract (first (sponsor-contracts sponsor))) + (node (find-contract-node *contract-tree* contract)) + (path (node-path node)) + (contract-id (store-object-id contract))) + (format nil "<href>http://~a/contract-tree-kml?rmcid=~D&rmcpath=~{~D~}&lang=~A</href>" + (website-host) contract-id path lang)) + (format nil "<href>http://~A/contract-tree-kml?lang=~A</href>" + (website-host) lang)))) + (defun serve-kml-root-data (&optional sponsor) (with-query-params ((lang "en")) (let* ((kml-root-data (kml-root-data-with-language lang)) @@ -117,7 +131,8 @@ (let ((kml-string (kml-string kml-root-data))) (setq kml-string (replace-all-url-hosts kml-string (website-host)) kml-string (replace-lang-query-params kml-string lang) - kml-string (replace-personalized-contract-placeholder kml-string sponsor lang)))))) + kml-string (replace-personalized-contract-placeholder kml-string sponsor lang) + kml-string (replace-contract-tree-placeholder kml-string sponsor lang)))))) (defmethod handle-object ((handler kml-root-handler) (object sponsor)) (serve-kml-root-data object))

1 0