activity-servist/src/signatures.lisp

167 lines
6.8 KiB
Common Lisp
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;;; activitypub-servist/signatures: Handle AP-compatible HTTP signatures.
;; Copyright © 2023-2024 Jaidyn Levesque <jadedctrl@posteo.at>
;;
;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU Affero General Public License
;; as published by the Free Software Foundation, either version 3 of
;; the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
(defpackage #:activitypub-servist/signatures
(:use #:cl)
(:nicknames "AP-S/S")
(:export :generate-key-pair
:sign-string :import-pem-key-pair
:digest-string :string-sha256sum))
(in-package #:activitypub-servist/signatures)
;;; Key creation/parsing
;;; ————————————————————————————————————————
;; At the moment, Ive yet to use figure out how to create PEM representations of
;; a public keypair properly in Lisp.
;; So at the moment, keys are generated into PEM files by the openssl binary on
;; the hosts system; and the output of the openssl command is used to parse into
;; Ironclad keys.
;; Yes, I know, this is absolutely horrific. Actually disgusting.
;; But at the moment,I want to focus on other core parts of ActivityPub; Ive
;; tired of messing with ASN1 & co. Thats for another day! ^^
(defun generate-key-pair ()
"Generate a 2048-bit RSA key-pair in PEM-format using ones `openssl` binary.
It returns two values: The private key, then the public key."
(let* ((private-pem-key (inferior-shell:run/s "openssl genrsa 2048"))
(public-pem-key
(inferior-shell:run/s
`(inferior-shell:pipe (echo ,private-pem-key)
(openssl rsa -outform PEM -pubout)))))
(values private-pem-key
public-pem-key)))
(defun destructure-openssl-private-key (pem-string &optional results)
"When passed the output of the shell command `openssl rsa -text -noout`, will
parse the output into a plist containing relavent numbers:
:n (modulus), :e (public exponent), :d (private exponent), :p (1st prime),
:q (2nd prime), :e1 (1st exponent), :e2 (2nd exponent), and :c (coefficient)."
(let* ((lines (if (stringp pem-string)
(inferior-shell:run/lines
`(inferior-shell:pipe
(echo ,pem-string)
(openssl rsa -text -noout)))
pem-string))
(line (str:trim (car lines))))
(cond
((not lines)
(mapcar
(lambda (result-item)
(if (stringp result-item)
(parse-integer (str:replace-all ":" "" result-item) :radix 16)
result-item))
results))
((str:starts-with-p "Private" line)
(openssl-shell-destructure-private-key
(cdr lines) results))
((str:starts-with-p "modulus:" line)
(openssl-shell-destructure-private-key
(cdr lines) (nconc results '(:n))))
((str:starts-with-p "prime1" line)
(openssl-shell-destructure-private-key
(cdr lines) (nconc results '(:p))))
((str:starts-with-p "prime2" line)
(openssl-shell-destructure-private-key
(cdr lines) (nconc results '(:q))))
((str:starts-with-p "exponent1" line)
(openssl-shell-destructure-private-key
(cdr lines) (nconc results '(:e1))))
((str:starts-with-p "exponent2" line)
(openssl-shell-destructure-private-key
(cdr lines) (nconc results '(:e2))))
((str:starts-with-p "coefficient" line)
(openssl-shell-destructure-private-key
(cdr lines) (nconc results '(:c))))
((str:starts-with-p "privateExponent" line)
(openssl-shell-destructure-private-key
(cdr lines) (nconc results '(:d))))
((str:starts-with-p "publicExponent" line)
(openssl-shell-destructure-private-key
(cdr lines)
(nconc
results
(list
:e
(parse-integer
(car (str:split #\space
(str:replace-first
"publicExponent: "
""
line))))))))
('t
(let* ((last-element (car (last results)))
(total-string (if (stringp last-element)
(str:concat last-element line)
line)))
(openssl-shell-destructure-private-key
(cdr lines)
(if (stringp last-element)
(nconc (reverse (cdr (reverse results)))
(list total-string))
(nconc results
(list total-string)))))))))
(defun import-pem-key-pair (private-pem-string)
"Given the string value of a private RSA PEM file, this will parse it into two
returned values: An Ironclad private key, and an Ironclad public key."
(let ((key-values
(openssl-shell-destructure-private-key private-pem-string)))
(values (ironclad:make-private-key
:rsa
:n (getf key-values :n)
:e (getf key-values :e)
:d (getf key-values :d)
:p (getf key-values :p)
:q (getf key-values :q))
(ironclad:make-public-key
:rsa
:n (getf key-values :n)
:e (getf key-values :e)))))
;;; Signing
;;; ————————————————————————————————————————
(defun sign-string (private-pem-string string)
"Use the OpenSSL binary on the host system to RSS-SHA256 sign a STRING with a
private key."
(alexandria:write-string-into-file private-pem-string #p"/tmp/private.pem" :if-does-not-exist :create :if-exists :overwrite)
(apply #'str:concat
(inferior-shell:run/lines
`(inferior-shell:pipe
(printf ,string)
(openssl dgst -sha256 -sign /tmp/private.pem -)
(base64)))))
;;; Misc.
;;; ————————————————————————————————————————
(defun digest-string (digest-spec string)
"Compute the digest of a STRING, given an Ironclad DIGEST-SPEC."
(ironclad:digest-sequence
digest-spec
(flexi-streams:string-to-octets string :external-format 'utf-8)))
(defun string-sha256sum (string)
"Compute the sha256 checksum of a STRING, in hexadecimal string-format."
(base64:usb8-array-to-base64-string
(digest-string (ironclad:make-digest :sha256) string)))