(define-module (email-key-rotation openssl)
  #:use-module (ice-9 exceptions)
  #:use-module (ice-9 rdelim)
  #:use-module (ice-9 textual-ports)
  #:use-module (ice-9 match)
  #:use-module (ice-9 i18n)
  #:export (current-openssl-binary
	    generate-key
	    private-key->public-key
	    random-hex)
  #:declarative? #t
  #:duplicates (merge-generics))

(define (G_ msg) (gettext msg "email-key-rotation"))

(define current-openssl-binary
  (make-parameter
   "/usr/bin/openssl"
   (match-lambda
     ((? string? interpreter)
      (lambda (arguments)
	(with-exception-handler
	    (lambda (exn)
	      (raise-exception
	       (make-exception
		(make-exception-with-irritants (list interpreter arguments))
		(make-exception-with-message
		 (G_ "cannot run openssl:"))
		exn)))
	  (lambda ()
	    (let ((ret (apply system* interpreter arguments)))
	      (unless (eqv? 0 (status:exit-val ret))
		(raise-exception
		 (make-exception
		  (make-error)
		  (make-exception-with-irritants (list (status:exit-val ret)))
		  (make-exception-with-message
		   (format #f (G_ "openssl failed with exit code ~s.")
			   (status:exit-val ret)))))))))))
     ((? procedure? p)
      p))))

(define (call-openssl . args)
  ((current-openssl-binary) args))

(define (generate-key rsa-strength)
  (with-exception-handler
      (lambda (exn)
	(raise-exception
	 (make-exception
	  (make-exception-with-origin 'generate-key)
	  (make-exception-with-irritants (list rsa-strength))
	  (make-exception-with-message
	   (G_ "cannot generate a private key."))
	  exn)))
    (lambda ()
      (let ((port (mkstemp "/tmp/generate-openssl-key-XXXXXX"))
	    (openssl (current-openssl-binary)))
	(dynamic-wind
	  (lambda () #t)
	  (lambda ()
	    (chmod port #o600)
	    (call-openssl
	     "genrsa"
	     "-out" (port-filename port)
	     (number->string rsa-strength))
	    (call-with-input-file (port-filename port)
	      get-string-all))
	  (lambda ()
	    (delete-file (port-filename port))))))))

(define (private-key->public-key key)
  (with-exception-handler
      (lambda (exn)
	(raise-exception
	 (make-exception
	  (make-exception-with-origin 'private-key->public-key)
	  (make-exception-with-irritants (list key))
	  (make-exception-with-message
	   (G_ "cannot convert the private key to public key."))
	  exn)))
    (lambda ()
      (let ((input-port (mkstemp "/tmp/openssl-private-key-XXXXXX"))
	    (output-port (mkstemp "/tmp/openssl-public-key-XXXXXX"))
	    (openssl (current-openssl-binary)))
	(dynamic-wind
	  (lambda () #t)
	  (lambda ()
	    (chmod input-port #o600)
	    (chmod output-port #o600)
	    (call-with-output-file (port-filename input-port)
	      (lambda (init-port)
		(display key init-port)))
	    (call-openssl
	     "rsa"
	     "-in" (port-filename input-port)
	     "-out" (port-filename output-port)
	     "-pubout")
	    (call-with-input-file (port-filename output-port)
	      get-string-all))
	  (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 (G_ "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)
	    (call-openssl
	     "rand"
	     "-out" (port-filename output-port)
	     "-hex"
	     (number->string nbytes))
	    (call-with-input-file (port-filename output-port)
	      get-string-all))
	  (lambda ()
	    (delete-file (port-filename output-port))))))))