fix: propagate Mach-O signing failures

docs/src/guide/core-concepts.md

@@ -74,10 +74,10 @@ first, and the one-shot functions grew keyword arguments (`:arch`, `:bss-size`,
 
 ## Diagnostics
 
-Some failure paths cannot signal. `write-mach-o-file` shells out to `codesign`,
-and a timeout or a non-zero exit there is not fatal to producing the file — the
-file is already written. Rather than either ignoring the failure or forcing a
-condition on every caller, the library reports it to an optional logger:
+`write-mach-o-file` shells out to `codesign` before replacing the target. A
+timeout or non-zero exit signals `macho-codesign-error`, leaving an existing
+target unchanged. Successful signing can still be observed through the
+optional logger:
 
 ```lisp
 (setf cl-cc/binary:*binary-logger* (log-kit:make-logger))

docs/src/reference/api.md

@@ -84,8 +84,8 @@ slice payloads are copied verbatim at aligned offsets.
 
 All four write bytes and do not set the execute bit. `write-mach-o-file`
 additionally invokes `codesign` unless `:codesign nil` is passed; a timeout or a
-failure there does not prevent the file from being written, and is reported
-through [`*binary-logger*`](#binary-logger) rather than signalled.
+failure there signals `macho-codesign-error` and leaves an existing target
+unchanged. The target is replaced only after signing succeeds.
 
 `write-mach-o-fat-file` takes slices rather than bytes, building the image
 itself.

src/conditions.lisp

@@ -10,6 +10,15 @@
 (define-condition cl-cc-binary-error (error) ()
   (:documentation "Base condition for every error cl-cc-binary signals."))
 
+(define-condition macho-codesign-error (cl-cc-binary-error)
+  ((filename :initarg :filename :reader macho-codesign-error-filename)
+   (reason :initarg :reason :reader macho-codesign-error-reason))
+  (:report (lambda (condition stream)
+             (format stream "Mach-O code signing failed for ~A: ~A"
+                     (namestring (macho-codesign-error-filename condition))
+                     (macho-codesign-error-reason condition))))
+  (:documentation "Mach-O code signing could not complete; the target was not replaced."))
+
 (define-condition value-out-of-range (cl-cc-binary-error)
   ((operation :initarg :operation :reader value-out-of-range-operation)
    (value :initarg :value :reader value-out-of-range-value)

src/macho-codesign.lisp

@@ -2,16 +2,14 @@
 
 (defparameter *macho-codesign-timeout-seconds* 30
   "Timeout in seconds for the external codesign invocation.
-codesign has been observed to hang (e.g. on keychain access); on timeout the
-binary is left unsigned, matching the existing best-effort semantics where a
-codesign failure is ignored.")
+codesign has been observed to hang (e.g. on keychain access); timeout and
+nonzero exit are reported as errors so callers cannot publish an unsigned file.")
 
 (defvar *binary-logger* nil
   "Optional CL-LOG-KIT logger for structured Mach-O/ELF/PE emission
 diagnostics. NIL (the default) keeps this library silent, mirroring
 CL-PROCESS-KIT's *PROCESS-LOGGER* convention: bind this to a
-LOG-KIT:MAKE-LOGGER instance to observe otherwise-silent failure paths, such
-as a timed-out or failed codesign invocation below.")
+LOG-KIT:MAKE-LOGGER instance to observe successful codesign diagnostics.")
 
 (defun %macho-log-codesign-outcome (outcome filename &key condition)
   "Log OUTCOME (:OK, :TIMEOUT, or :ERROR) for the codesign invocation on
@@ -49,22 +47,48 @@ function's return value."
     (process-kit:process-timeout-error () (funcall on-timeout))
     (process-kit:process-error (condition) (funcall on-error condition))))
 
-(defun write-mach-o-file (filename mach-o-bytes &key (codesign t))
-  "Write MACH-O-BYTES to FILENAME as a binary file."
-  (declare (type (or pathname string) filename)
-           (type (simple-array (unsigned-byte 8) (*)) mach-o-bytes))
+(defun %macho-codesign-program ()
+  "Return the host codesign program pathname, or NIL when unavailable."
+  (probe-file "/usr/bin/codesign"))
+
+(defun %macho-write-bytes (filename mach-o-bytes)
   (with-open-file (out filename
                         :direction :output
                         :element-type '(unsigned-byte 8)
                         :if-exists :supersede
                         :if-does-not-exist :create)
     (write-sequence mach-o-bytes out))
-  (when codesign
-    (let ((codesign-program (probe-file "/usr/bin/codesign")))
-      (when codesign-program
-        (%macho-codesign-cps
-         codesign-program filename
-         (lambda () (%macho-log-codesign-outcome :ok filename))
-         (lambda () (%macho-log-codesign-outcome :timeout filename))
-         (lambda (condition) (%macho-log-codesign-outcome :error filename :condition condition))))))
   filename)
+
+(defun write-mach-o-file (filename mach-o-bytes &key (codesign t))
+  "Write MACH-O-BYTES to FILENAME, replacing it only after signing succeeds."
+  (declare (type (or pathname string) filename)
+           (type (simple-array (unsigned-byte 8) (*)) mach-o-bytes))
+  (let ((target (pathname filename)))
+    (if codesign
+        (let ((staged (uiop:tmpize-pathname target)))
+          (unwind-protect
+               (progn
+                 (%macho-write-bytes staged mach-o-bytes)
+                 (let ((codesign-program (%macho-codesign-program)))
+                   (unless codesign-program
+                     (error 'macho-codesign-error
+                            :filename target
+                            :reason "codesign is unavailable"))
+                   (%macho-codesign-cps
+                    codesign-program staged
+                    (lambda ()
+                      (uiop:rename-file-overwriting-target staged target)
+                      (%macho-log-codesign-outcome :ok target))
+                    (lambda ()
+                      (error 'macho-codesign-error
+                             :filename target
+                             :reason "codesign timed out"))
+                    (lambda (condition)
+                      (error 'macho-codesign-error
+                             :filename target
+                             :reason condition))))
+                 target)
+            (when (probe-file staged)
+              (ignore-errors (delete-file staged)))))
+        (%macho-write-bytes target mach-o-bytes))))

src/package.lisp

@@ -7,6 +7,9 @@
   (:export
    ;; Conditions
    #:cl-cc-binary-error
+   #:macho-codesign-error
+   #:macho-codesign-error-filename
+   #:macho-codesign-error-reason
    #:value-out-of-range
    #:value-out-of-range-operation
    #:value-out-of-range-value

t/macho-build-assemble-logging-test.lisp

@@ -1,12 +1,7 @@
 ;;;; t/macho-build-assemble-logging-test.lisp — *binary-logger* structured diagnostics
 ;;;;
-;;;; write-mach-o-file's codesign step is the only currently-silent failure
-;;;; path in this library, and driving it end-to-end needs a real macOS
-;;;; /usr/bin/codesign plus a forced timeout or failure, neither of which is
-;;;; deterministic across CI hosts. %macho-log-codesign-outcome factors the
-;;;; "what to log for a given outcome" decision out of that untestable
-;;;; process invocation, so it is exercised directly here with a captured
-;;;; cl-log-kit function-handler instead.
+;;;; %macho-log-codesign-outcome retains structured success diagnostics while
+;;;; write-mach-o-file propagates timeout and nonzero-exit failures.
 
 (in-package :cl-cc-binary/test)
 
@@ -55,3 +50,44 @@ records are captured into a list, and return that list (oldest first)."
       (expect (log-kit:log-record-message (first records)) :to-match "codesign failed")
       (expect (log-kit:log-record-fields (first records))
               :to-have-property :reason "boom"))))
+
+(defun %with-replaced-function (name replacement thunk)
+  (let ((old (symbol-function name)))
+    (unwind-protect
+         (progn
+           (setf (symbol-function name) replacement)
+           (funcall thunk))
+      (setf (symbol-function name) old))))
+
+(defun %assert-codesign-failure-preserves-target (mode)
+  (uiop:with-temporary-file (:pathname path)
+    (with-open-file (out path :direction :output :if-exists :supersede)
+      (write-line "original" out))
+    (let ((bytes (make-array 1 :element-type '(unsigned-byte 8)
+                             :initial-element 0)))
+      (%with-replaced-function
+       'cl-cc/binary::%macho-codesign-program
+       (lambda () #P"/tmp/codesign")
+       (lambda ()
+         (%with-replaced-function
+          'cl-cc/binary::%macho-codesign-cps
+          (lambda (program staged on-ok on-timeout on-error)
+            (declare (ignore program staged on-ok))
+            (ecase mode
+              (:error
+               (funcall on-error
+                        (make-condition 'simple-error
+                                        :format-control "injected failure")))
+              (:timeout (funcall on-timeout))))
+          (lambda ()
+            (signals cl-cc/binary:macho-codesign-error
+              (cl-cc/binary:write-mach-o-file path bytes :codesign t))))))
+      (with-open-file (in path)
+        (expect (read-line in) :to-equal "original")))))
+
+(describe "write-mach-o-file codesign failure propagation"
+  (it "keeps the existing target when codesign returns a failure"
+    (%assert-codesign-failure-preserves-target :error))
+
+  (it "propagates a codesign timeout without replacing the target"
+    (%assert-codesign-failure-preserves-target :timeout)))