Rotate SRS keys

7 files changed, 219 insertions, 18 deletions

diff --git a/email-key-rotation.scm b/email-key-rotation.scm
index 8324cf2..da6119e 100644
--- a/email-key-rotation.scm
+++ b/email-key-rotation.scm
@@ -5,6 +5,7 @@
   #:use-module (email-key-rotation serialize)
   #:use-module (email-key-rotation gandi)
   #:use-module (email-key-rotation rotation)
+  #:use-module (email-key-rotation prepare)
   #:use-module (ice-9 exceptions)
   #:use-module (ice-9 match)
   #:use-module (oop goops)
@@ -16,7 +17,7 @@
   #:declarative? #t
   #:duplicates (merge-generics))
 
-(define (initialize-keys state-file private-key-file selectors api-key domain)
+(define (initialize-keys state-file private-key-file private-opensmtpd-config selectors api-key domain)
   (parameterize ((gandi-api-key api-key)
 		 (gandi-domain domain))
     (with-exception-handler
@@ -24,15 +25,16 @@
 	  (raise-exception
 	   (make-exception
 	    (make-exception-with-origin 'initialize-keys)
-	    (make-exception-with-irritants (list state-file private-key-file selectors))
+	    (make-exception-with-irritants (list state-file private-key-file private-opensmtpd-config selectors))
 	    (make-exception-with-message
 	     (format #f "while initializing keys under ~s:" state-file))
 	    exn)))
       (lambda ()
-	(let ((state (initialize-rotation private-key-file selectors)))
+	(let ((state (initialize-rotation private-key-file private-opensmtpd-config selectors)))
 	  (call-with-output-file state-file
 	    (lambda (port)
 	      (write-state state port)))
+	  (prepare-opensmtpd-config state)
 	  (gandi-livedns state))))))
 
 (define (rotate-keys state-file api-key domain)
@@ -50,10 +52,11 @@
       (lambda ()
 	(let* ((state (call-with-input-file state-file
 			read-state))
-	       (rotated (rotate-dkim-key state)))
+	       (rotated (rotate-key state)))
 	  (call-with-output-file state-file
 	    (lambda (port)
 	      (write-state rotated port)))
+	  (prepare-opensmtpd-config rotated)
 	  (gandi-livedns rotated))))))
 
 (define (run-dkimproxy.out state-file input-port relay-port domain)
diff --git a/email-key-rotation/openssl.scm b/email-key-rotation/openssl.scm
index 1d1935b..c37c6cf 100644
--- a/email-key-rotation/openssl.scm
+++ b/email-key-rotation/openssl.scm
@@ -5,7 +5,8 @@
   #:use-module (oop goops)
   #:export (current-openssl-binary
 	    generate-key
-	    private-key->public-key)
+	    private-key->public-key
+	    random-hex)
   #:declarative? #t
   #:duplicates (merge-generics))
 
@@ -91,3 +92,43 @@
 	  (lambda ()
 	    (delete-file (port-filename input-port))
 	    (delete-file (port-filename output-port))))))))
+
+(define (random-hex nbytes)
+  (with-exception-handler
+      (lambda (exn)
+	(raise-exception
+	 (make-exception
+	  (make-exception-with-origin 'random-hex)
+	  (make-exception-with-irritants (list nbytes))
+	  (make-exception-with-message
+	   (format #f "cannot generate ~a random bytes."
+		   nbytes))
+	  exn)))
+    (lambda ()
+      (let ((output-port (mkstemp "/tmp/openssl-public-key-XXXXXX"))
+	    (openssl (current-openssl-binary)))
+	(dynamic-wind
+	  (lambda () #t)
+	  (lambda ()
+	    (chmod output-port #o600)
+	    (let ((ret (system* openssl
+				"rand"
+				"-out" (port-filename output-port)
+				"-hex"
+				(number->string nbytes))))
+	      (unless (eqv? 0 (status:exit-val ret))
+		(raise-exception
+		 (make-exception
+		  (make-error)
+		  (make-exception-with-origin 'generate-key)
+		  (make-exception-with-irritants
+		   (list openssl 
+			 "rand"
+			 "-out" "<deleted>"
+			 "-hex"
+			 (number->string nbytes)))
+		  (make-exception-with-message
+		   (format #f "openssl failed to generate random numbers."))))))
+	    (call-with-input-file (port-filename output-port) get-string-all))
+	  (lambda ()
+	    (delete-file (port-filename output-port))))))))
diff --git a/email-key-rotation/prepare.scm b/email-key-rotation/prepare.scm
index 4d91693..0677237 100644
--- a/email-key-rotation/prepare.scm
+++ b/email-key-rotation/prepare.scm
@@ -6,7 +6,7 @@
   #:use-module (srfi srfi-26)
   #:use-module (rnrs bytevectors)
   #:use-module (oop goops)
-  #:export (prepare)
+  #:export (prepare prepare-opensmtpd-config)
   #:declarative? #t
   #:duplicates (merge-generics))
 
@@ -45,3 +45,41 @@
 		(lambda (port)
 		  (chmod port #o600)
 		  (display private-key port))))))))))
+
+(define-method (prepare-opensmtpd-config (s <email-key-rotation-state>))
+  (with-exception-handler
+      (lambda (exn)
+	(raise-exception
+	 (make-exception
+	  (make-exception-with-origin 'prepare)
+	  (make-exception-with-irritants (list s))
+	  (make-exception-with-message
+	   "cannot write the SRS secrets to the opensmtpd config file.")
+	  exn)))
+    (lambda ()
+      (set! s (the-email-key-rotation-state s))
+      (let ((config (private-opensmtpd-config s)))
+	(with-exception-handler
+	    (lambda (exn)
+	      (raise-exception
+	       (make-exception
+		(make-exception-with-irritants (list config))
+		(make-exception-with-message
+		 (format #f
+			 "cannot write the private opensmtpd config file ~s."
+			 config))
+		exn)))
+	  (lambda ()
+	    (let ((current-secret (current-srs-secret s))
+		  (previous-secret (expired-srs-secret s)))
+	      (call-with-output-file config
+		(lambda (port)
+		  (chmod port #o600)
+		  (format port "# GENERATED AUTOMATICALLY, DO NOT EDIT!\n
+srs key ~s
+"
+			  current-secret)
+		  (when previous-secret
+		    (format port "srs key backup ~s
+"
+			    previous-secret)))))))))))
diff --git a/email-key-rotation/rotation.scm b/email-key-rotation/rotation.scm
index a34490f..a6e9593 100644
--- a/email-key-rotation/rotation.scm
+++ b/email-key-rotation/rotation.scm
@@ -4,17 +4,17 @@
   #:use-module (ice-9 exceptions)
   #:use-module (ice-9 match)
   #:use-module (oop goops)
-  #:export (initialize-rotation rotate-dkim-key)
+  #:export (initialize-rotation rotate-key)
   #:declarative? #t
   #:duplicates (merge-generics))
 
-(define (initialize-rotation private-key-file selectors)
+(define (initialize-rotation private-key-file private-opensmtpd-config selectors)
   (with-exception-handler
       (lambda (exn)
 	(raise-exception
 	 (make-exception
-	  (make-exception-with-origin 'initialize-dkim-key)
-	  (make-exception-with-irritants (list private-key-file selectors))
+	  (make-exception-with-origin 'initialize-key-rotation)
+	  (make-exception-with-irritants (list private-key-file private-opensmtpd-config selectors))
 	  (make-exception-with-message
 	   "cannot initialize the key rotation.")
 	  exn)))
@@ -22,12 +22,14 @@
       (the-email-key-rotation-state
        (make <email-key-rotation-state>
 	 #:private-key-file private-key-file
+	 #:private-opensmtpd-config private-opensmtpd-config
 	 #:selectors selectors
 	 #:current-dkim-selector (car selectors)
 	 #:current-dkim-private-key
-	 (generate-key 2048))))))
+	 (generate-key 2048)
+	 #:current-srs-secret (random-hex 32))))))
 
-(define-method (rotate-dkim-key (s <email-key-rotation-state>))
+(define-method (rotate-key (s <email-key-rotation-state>))
   (with-exception-handler
       (lambda (exn)
 	(raise-exception
@@ -35,7 +37,7 @@
 	  (make-exception-with-origin 'rotate-dkim-key)
 	  (make-exception-with-irritants (list s))
 	  (make-exception-with-message
-	   "cannot rotate the DKIM private key.")
+	   "cannot rotate the email keys.")
 	  exn)))
     (lambda ()
       (let ((ret (shallow-clone (the-email-key-rotation-state s))))
@@ -55,4 +57,8 @@
 	    (car (selectors s)))
 	   ((_ next _ ...)
 	    next)))
+	(slot-set! ret 'expired-srs-secret
+		   (slot-ref s 'current-srs-secret))
+	(slot-set! ret 'current-srs-secret
+		   (random-hex 32))
 	ret))))
diff --git a/email-key-rotation/serialize.scm b/email-key-rotation/serialize.scm
index e79d955..1e27183 100644
--- a/email-key-rotation/serialize.scm
+++ b/email-key-rotation/serialize.scm
@@ -25,17 +25,23 @@
       (match (read port)
 	(('email-key-rotation-state
 	  private-key-file
+	  private-opensmtpd-config
 	  (selectors ...)
 	  selector
 	  current-key
-	  expired-key)
+	  expired-key
+	  current-srs
+	  expired-srs)
 	 (the-email-key-rotation-state
 	  (make <email-key-rotation-state>
 	    #:private-key-file private-key-file
+	    #:private-opensmtpd-config private-opensmtpd-config
 	    #:selectors selectors
 	    #:current-dkim-selector selector
 	    #:current-dkim-private-key current-key
-	    #:expired-dkim-private-key expired-key)))))))
+	    #:expired-dkim-private-key expired-key
+	    #:current-srs-secret current-srs
+	    #:expired-srs-secret expired-srs)))))))
 
 (define* (write-state state #:optional (port (current-output-port)))
   (with-exception-handler
@@ -53,8 +59,11 @@
 	(let ((state (the-email-key-rotation-state state)))
 	  (write `(email-key-rotation-state
 		   ,(private-key-file state)
+		   ,(private-opensmtpd-config state)
 		   (,@(selectors state))
 		   ,(current-dkim-selector state)
 		   ,(current-dkim-private-key state)
-		   ,(expired-dkim-private-key state))
+		   ,(expired-dkim-private-key state)
+		   ,(current-srs-secret state)
+		   ,(expired-srs-secret state))
 		 port))))))
diff --git a/email-key-rotation/state.scm b/email-key-rotation/state.scm
index 26d7fbe..bf567cb 100644
--- a/email-key-rotation/state.scm
+++ b/email-key-rotation/state.scm
@@ -5,30 +5,43 @@
   #:re-export (make)
   #:export (<email-key-rotation-state>
 	    private-key-file
+	    private-opensmtpd-config
 	    selectors
 	    current-dkim-selector
 	    current-dkim-private-key
 	    expired-dkim-private-key
+	    current-srs-secret
+	    expired-srs-secret
 	    set-private-key-file
+	    set-private-opensmtpd-config
 	    set-selectors
 	    set-current-dkim-selector
 	    set-current-dkim-private-key
 	    set-expired-dkim-private-key
+	    set-current-srs-secret
+	    set-expired-srs-secret
 	    the-email-key-rotation-state)
   #:declarative? #t
   #:duplicates (merge-generics))
 
 (define-class <email-key-rotation-state> ()
   (private-key-file #:init-keyword #:private-key-file)
+  (private-opensmtpd-config #:init-keyword #:private-opensmtpd-config)
   (selectors #:init-keyword #:selectors)
   (current-dkim-selector #:init-keyword #:current-dkim-selector)
   (current-dkim-private-key #:init-keyword #:current-dkim-private-key)
   (expired-dkim-private-key #:init-keyword #:expired-dkim-private-key
-			    #:init-value #f))
+			    #:init-value #f)
+  (current-srs-secret #:init-keyword #:current-srs-secret)
+  (expired-srs-secret #:init-keyword #:expired-srs-secret
+		      #:init-value #f))
 
 (define-method (private-key-file (s <email-key-rotation-state>))
   (slot-ref s 'private-key-file))
 
+(define-method (private-opensmtpd-config (s <email-key-rotation-state>))
+  (slot-ref s 'private-opensmtpd-config))
+
 (define-method (selectors (s <email-key-rotation-state>))
   (slot-ref s 'selectors))
 
@@ -41,11 +54,22 @@
 (define-method (expired-dkim-private-key (s <email-key-rotation-state>))
   (slot-ref s 'expired-dkim-private-key))
 
+(define-method (current-srs-secret (s <email-key-rotation-state>))
+  (slot-ref s 'current-srs-secret))
+
+(define-method (expired-srs-secret (s <email-key-rotation-state>))
+  (slot-ref s 'expired-srs-secret))
+
 (define-method (set-private-key-file (s <email-key-rotation-state>) filename)
   (let ((ret (shallow-clone s)))
     (slot-set! ret 'private-key-file filename)
     ret))
 
+(define-method (set-private-opensmtpd-config (s <email-key-rotation-state>) filename)
+  (let ((ret (shallow-clone s)))
+    (slot-set! ret 'private-opensmtpd-config filename)
+    ret))
+
 (define-method (set-selectors (s <email-key-rotation-state>) selectors)
   (let ((ret (shallow-clone s)))
     (slot-set! ret 'selectors selectors)
@@ -56,11 +80,26 @@
     (slot-set! ret 'current-dkim-selector selector)
     ret))
 
+(define-method (set-current-dkim-private-key (s <email-key-rotation-state>) private-key)
+  (let ((ret (shallow-clone s)))
+    (slot-set! ret 'current-dkim-private-key private-key)
+    ret))
+
 (define-method (set-expired-dkim-private-key (s <email-key-rotation-state>) private-key)
   (let ((ret (shallow-clone s)))
     (slot-set! ret 'expired-dkim-private-key private-key)
     ret))
 
+(define-method (set-current-srs-secret (s <email-key-rotation-state>) private-key)
+  (let ((ret (shallow-clone s)))
+    (slot-set! ret 'current-srs-secret private-key)
+    ret))
+
+(define-method (set-expired-srs-secret (s <email-key-rotation-state>) private-key)
+  (let ((ret (shallow-clone s)))
+    (slot-set! ret 'expired-srs-secret private-key)
+    ret))
+
 (define-method (the-email-key-rotation-state (s <email-key-rotation-state>))
   (with-exception-handler
       (lambda (exn)
@@ -86,6 +125,19 @@
 	  (make-exception-with-irritants (list (private-key-file s)))
 	  (make-exception-with-message
 	   (format #f "the private key file name is not a string.")))))
+      (unless (slot-bound? s 'private-opensmtpd-config)
+	(raise-exception
+	 (make-exception
+	  (make-error)
+	  (make-exception-with-message
+	   (format #f "the private opensmtpd configuration file name is not bound.")))))
+      (unless (string? (private-opensmtpd-config s))
+	(raise-exception
+	 (make-exception
+	  (make-error)
+	  (make-exception-with-irritants (list (private-opensmtpd-config s)))
+	  (make-exception-with-message
+	   (format #f "the private opensmtpd configuration file name is not a string.")))))
       (unless (list? (selectors s))
 	(raise-exception
 	 (make-exception
@@ -152,5 +204,20 @@
 	  (make-error)
 	  (make-exception-with-irritants (list (current-dkim-private-key s)))
 	  (make-exception-with-message
-	   (format #f "the expired DKIM private key is set, but not a string.")))))))
+	   (format #f "the expired DKIM private key is set, but not a string.")))))
+      (unless (string? (current-srs-secret s))
+	(raise-exception
+	 (make-exception
+	  (make-error)
+	  (make-exception-with-irritants (list (current-srs-secret s)))
+	  (make-exception-with-message
+	   (format #f "the current srs secret is not set.")))))
+      (unless (or (not (expired-srs-secret s))
+		  (string? (expired-srs-secret s)))
+	(raise-exception
+	 (make-exception
+	  (make-error)
+	  (make-exception-with-irritants (list (expired-srs-secret s)))
+	  (make-exception-with-message
+	   (format #f "the expired srs secret is set, but not to a string.")))))))
   s)
diff --git a/email-key-rotation/tests.scm b/email-key-rotation/tests.scm
index 1243140..faba6af 100644
--- a/email-key-rotation/tests.scm
+++ b/email-key-rotation/tests.scm
@@ -51,6 +51,10 @@ blah blah public key
 blah blah blah with seed ~a
 END OF FAKE PUBLIC KEY"
 		     seed))))))
+    ((_ "rand" "-out" file "-hex" (= string->number n-bytes))
+     (call-with-output-file file
+       (lambda (port)
+	 (format port "hexdatawithseed~a" seed))))
     (cmdline
      (format (current-error-port) "Command-line: ~s\n" cmdline)
      (error "Wrong use of the fake openssl."))))
@@ -183,11 +187,22 @@ guile ~a.real \"$@\""
 			  (set! dkimB-notified #t)))))))
       (initialize-keys "current-state.scm"
 		       "current-private-key"
+		       "private-opensmtpd-config.conf"
 		       '(dkimA dkimB)
 		       "letmein"
 		       "awesome-domain.net")
       (unless (and dkimA-notified dkimB-notified)
 	(error "no gandi request"))))
+  ;; Check the private opensmtpd config
+  (call-with-input-file "private-opensmtpd-config.conf"
+    (lambda (port)
+      (let ((cfg (get-string-all port)))
+	(unless (equal? cfg "# GENERATED AUTOMATICALLY, DO NOT EDIT!
+
+srs key \"hexdatawithseed0\"
+")
+	  (format (current-error-port) "The configuration is: ~s\n" cfg)
+	  (error "wrong opensmtpd config")))))
   ;; Then run dkimproxy.out
   (parameterize
       ((current-dkimproxy.out-binary
@@ -229,6 +244,17 @@ guile ~a.real \"$@\""
 		   "awesome-domain.net")
       (unless (and dkimA-notified dkimB-notified)
 	(error "no gandi request"))))
+  ;; Check the private opensmtpd config
+  (call-with-input-file "private-opensmtpd-config.conf"
+    (lambda (port)
+      (let ((cfg (get-string-all port)))
+	(unless (equal? cfg "# GENERATED AUTOMATICALLY, DO NOT EDIT!
+
+srs key \"hexdatawithseed1\"
+srs key backup \"hexdatawithseed0\"
+")
+	  (format (current-error-port) "The configuration is: ~s\n" cfg)
+	  (error "wrong opensmtpd config")))))
   ;; Then run dkimproxy.out
   (parameterize
       ((current-dkimproxy.out-binary
@@ -270,6 +296,17 @@ guile ~a.real \"$@\""
 		   "awesome-domain.net")
       (unless (and dkimA-notified dkimB-notified)
 	(error "no gandi request"))))
+  ;; Check the private opensmtpd config
+  (call-with-input-file "private-opensmtpd-config.conf"
+    (lambda (port)
+      (let ((cfg (get-string-all port)))
+	(unless (equal? cfg "# GENERATED AUTOMATICALLY, DO NOT EDIT!
+
+srs key \"hexdatawithseed2\"
+srs key backup \"hexdatawithseed1\"
+")
+	  (format (current-error-port) "The configuration is: ~s\n" cfg)
+	  (error "wrong opensmtpd config")))))
   ;; Then run dkimproxy.out
   (parameterize
       ((current-dkimproxy.out-binary