[bknr-cvs] r1935 - branches/xml-class-rework/projects/bos/m2 - bknr-cvs@common-lisp.net - mailman3.common-lisp.net

17 Mar 2006

Author: hhubner
Date: 2006-03-17 13:41:27 -0500 (Fri, 17 Mar 2006)
New Revision: 1935
Modified:
   branches/xml-class-rework/projects/bos/m2/cert-daemon.lisp
Log:
Make certificate generation more robus
Modified: branches/xml-class-rework/projects/bos/m2/cert-daemon.lisp
===================================================================

--- branches/xml-class-rework/projects/bos/m2/cert-daemon.lisp	2006-03-17 15:59:16 UTC (rev 1934)
+++ branches/xml-class-rework/projects/bos/m2/cert-daemon.lisp	2006-03-17 18:41:27 UTC (rev 1935)
@@ -12,11 +12,13 @@
 (defun fill-form (fdf-pathname pdf-pathname output-pathname)
   (handler-case
       (progn
-        (run-tool "recode" (list "utf-8..latin-1" (unix-namestring fdf-pathname)))
-        (run-tool "pdftk" (list (unix-namestring pdf-pathname)
-                                "fill_form" (unix-namestring fdf-pathname)
-                                "output" (namestring output-pathname)
-                                "flatten"))
+        (ignore-errors (run-tool "recode" (list "utf-8..latin-1" (unix-namestring fdf-pathname))))
+        (if (unix-namestring pdf-pathname)
+            (run-tool "pdftk" (list (unix-namestring pdf-pathname)
+                                    "fill_form" (unix-namestring fdf-pathname)
+                                    "output" (namestring output-pathname)
+                                    "flatten"))
+            (warn "Warning, stray FDF file ~A deleted, no such contract exists" fdf-pathname))
         (delete-file fdf-pathname)
         (format t "; generated ~A~%" output-pathname))
     (error (e)
@@ -35,11 +37,15 @@
                                     template-pathname)
                    output-pathname)))))
+(defun generate-certs ()
+  (fill-forms *cert-mail-directory* *cert-mail-template*)
+  (fill-forms *cert-download-directory* *cert-download-template*)
+  (fill-forms *receipt-mail-directory* *receipt-mail-template*)
+  (fill-forms *receipt-download-directory* *receipt-download-template*))
+
 (defun cert-daemon ()
   (ensure-directories-exist *cert-mail-directory*)
   (ensure-directories-exist *cert-download-directory*)
-  (loop (fill-forms *cert-mail-directory* *cert-mail-template*)
-	(fill-forms *cert-download-directory* *cert-download-template*)
-	(fill-forms *receipt-mail-directory* *receipt-mail-template*)
-	(fill-forms *receipt-download-directory* *receipt-download-template*)
-	(sleep *cert-daemon-poll-seconds*)))
\ No newline at end of file
+  (loop
+     (generate-certs)
+     (sleep *cert-daemon-poll-seconds*)))
\ No newline at end of file

    