Use safe output procedures in the sqlite module

1 files changed, 30 insertions, 31 deletions

diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index bd321bb..d5662fc 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -195,14 +195,14 @@
                                                (exact->inexact seconds-delayed))
                                (log-delay "datastore write" seconds-delayed)
                                (when (> seconds-delayed 1)
-                                 (format
+                                 (format/safe
                                   (current-error-port)
                                   "warning: database write delayed by ~1,2f seconds~%"
                                   seconds-delayed))))
             #:duration-logger
             (lambda (duration proc)
               (when (> duration 10)
-                (format
+                (format/safe
                  (current-error-port)
                  "warning: database write took ~1,2f seconds (~a)~%"
                  duration
@@ -261,14 +261,14 @@
                                                (exact->inexact seconds-delayed))
                                (log-delay "datastore read" seconds-delayed)
                                (when (> seconds-delayed 1)
-                                 (format
+                                 (format/safe
                                   (current-error-port)
                                   "warning: database read delayed by ~1,2f seconds~%"
                                   seconds-delayed))))
             #:duration-logger
             (lambda (duration proc)
               (when (> duration 30)
-                (format
+                (format/safe
                  (current-error-port)
                  "warning: database read took ~1,2f seconds (~a)~%"
                  duration
@@ -334,12 +334,12 @@
                       (#(blocked? modified-page-count pages-moved-to-db)
                        (if (= blocked? 1)
                            (begin
-                             (simple-format
+                             (simple-format/safe
                               (current-error-port)
                               "warning: wal checkpoint blocked\n")
                              #f)
                            (begin
-                             (simple-format
+                             (simple-format/safe
                               (current-error-port)
                               "wal checkpoint completed (~A, ~A)\n"
                               modified-page-count
@@ -385,9 +385,9 @@ PRAGMA optimize;")
        (sleep 20)
        (vector-for-each
         (lambda (i proc)
-          (simple-format (current-error-port)
-                         "reader thread ~A running: ~A\n"
-                         i proc))
+          (simple-format/safe (current-error-port)
+                              "reader thread ~A running: ~A\n"
+                              i proc))
         (thread-pool-proc-vector
          (slot-ref datastore 'reader-thread-pool))))))
 
@@ -397,9 +397,9 @@ PRAGMA optimize;")
        (sleep (* 60 10))                ; 10 minutes
        (with-exception-handler
            (lambda (exn)
-             (simple-format (current-error-port)
-                            "exception when performing WAL checkpoint: ~A\n"
-                            exn))
+             (simple-format/safe (current-error-port)
+                                 "exception when performing WAL checkpoint: ~A\n"
+                                 exn))
          (lambda ()
            (with-time-logging
                "performing regular database maintenance"
@@ -574,14 +574,14 @@ PRAGMA optimize;")
           (lambda (exn)
             (match (exception-args exn)
               (('sqlite-exec 5 msg)
-               (simple-format
+               (simple-format/safe
                 (current-error-port)
                 "warning: issue starting transaction (code: 5, proc: ~A): ~A\n"
                 proc msg)
                #f)
               (_
-               (simple-format (current-error-port)
-                              "exception starting transaction\n")
+               (simple-format/safe (current-error-port)
+                                   "exception starting transaction\n")
                (raise-exception exn))))
         (lambda ()
           (sqlite-exec db (if immediate?
@@ -595,14 +595,14 @@ PRAGMA optimize;")
           (lambda (exn)
             (match (exception-args exn)
               (('sqlite-exec 5 msg)
-               (simple-format
+               (simple-format/safe
                 (current-error-port)
                 "warning: attempt commit (code: 5, proc: ~A): ~A\n"
                 proc msg)
                #f)
               (_
-               (simple-format (current-error-port)
-                              "exception committing transaction\n")
+               (simple-format/safe (current-error-port)
+                                   "exception committing transaction\n")
                (raise-exception exn))))
         (lambda ()
           (sqlite-exec db "COMMIT TRANSACTION;")
@@ -617,9 +617,10 @@ PRAGMA optimize;")
                     (sqlite-exec db "ROLLBACK TRANSACTION;")
                     (transaction-rollback-exception-return-value exn))
                   (begin
-                    (simple-format (current-error-port)
-                                   "error: sqlite rolling back transaction (~A)\n"
-                                   exn)
+                    (simple-format/safe
+                     (current-error-port)
+                     "error: sqlite rolling back transaction (~A)\n"
+                     exn)
                     (sqlite-exec db "ROLLBACK TRANSACTION;")
                     (raise-exception exn))))
           (lambda ()
@@ -660,13 +661,11 @@ PRAGMA optimize;")
    (lambda (duration-seconds)
      (when (and (not readonly?)
                 (> duration-seconds 2))
-       (display
-        (format
-         #f
-         "warning: ~a:\n  took ~4f seconds in transaction\n"
-         proc
-         duration-seconds)
-        (current-error-port))
+       (format/safe
+        (current-error-port)
+        "warning: ~a:\n  took ~4f seconds in transaction\n"
+        proc
+        duration-seconds)
 
        (when duration-metric-name
          (metric-observe-duration datastore
@@ -3632,11 +3631,11 @@ WHERE build_results.build_id = :build_id"
                              "_sqitch_registry.db")
                (string-append "db:sqlite:" database-file))))
 
-    (simple-format #t "running command: ~A\n"
-                   (string-join command))
+    (simple-format/safe #t "running command: ~A\n"
+                        (string-join command))
     (let ((pid (spawn (%config 'sqitch) command)))
       (unless (zero? (cdr (waitpid pid)))
-        (simple-format
+        (simple-format/safe
          (current-error-port)
          "error: sqitch command failed\n")
         (exit 1)))))