Split HTTP-signature functions into own package

Modularization!
This commit is contained in:
Jaidyn Ann 2024-06-10 18:10:19 -05:00
parent 6852d63a43
commit 566b5e696c
3 changed files with 179 additions and 152 deletions

View File

@ -1,5 +1,9 @@
(defsystem "activitypub-servist"
:depends-on ("alexandria" "clack" "dexador" "inferior-shell" "ironclad" "local-time" "purl" "str" "webtentacle" "yason")
:depends-on ("activitypub-servist/signatures"
"alexandria" "clack" "dexador"
"local-time" "purl" "str" "webtentacle" "yason")
:components ((:file "src/activitypub-servist")))
;; (ql:quickload '(alexandria clack dexador inferior-shell ironclad local-time purl str webtentacle yason))
(defsystem "activitypub-servist/signatures"
:depends-on ("cl-base64" "inferior-shell" "ironclad" "str")
:components ((:file "src/signatures")))

View File

@ -14,7 +14,7 @@
;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
(defpackage #:activitypub-servist
(:use #:cl)
(:use #:cl #:activitypub-servist/signatures)
(:export :server :start-server))
(in-package #:activitypub-servist)
@ -219,10 +219,10 @@ Mi ne estas knabino!!")
(format nil "host: ~A~%" (quri:uri-host inbox-uri))
(format nil "date: ~A~%" date-header)
(format nil "digest: ~A" digest-header)))
(signature (base64:usb8-array-to-base64-string
(ironclad:sign-message (openssl-shell-import-key-pair *privkey*)
(string-to-ub8-vector
(string-sha256sum signed-headers)))))
;; (signature (base64:usb8-array-to-base64-string
;; (ironclad:sign-message (openssl-shell-import-key-pair *privkey*)
;; (string-to-ub8-vector
;; (string-sha256sum signed-headers))))
(signature (openssl-shell-sign-string *privkey* signed-headers))
(signature-header (str:concat "keyId=\"" from "#main-key\","
"algorithm=\"rsa-sha256\","
@ -332,153 +332,9 @@ or “/bear/apple/” or “/bear/”, but not “/bear” (not a directory)."
(str:split #\/ pathname :omit-nulls 't))
(defun string-to-ub8-vector (string)
"Convert the given STRING into an unsigned 8-bit vector."
(coerce
(loop for char across string
collect (char-code char))
'(vector (unsigned-byte 8))))
(defun digest-string (digest-spec string)
"Compute the digest of a STRING, given an Ironclad DIGEST-SPEC."
(ironclad:digest-sequence digest-spec (string-to-ub8-vector string)))
(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)))
(defun sequence-hexadecimal-string (sequence)
(reduce #'str:concat
(loop for number across
sequence
collect (format nil "~X" number))))
;; ————————————————————————————————————————
;; RSA keys
;; ————————————————————————————————————————
;; 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 openssl-shell-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 openssl-shell-destructure-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 openssl-shell-import-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)))))
(defun openssl-shell-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)))))

167
src/signatures.lisp Normal file
View File

@ -0,0 +1,167 @@
;;; 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)
(:export :openssl-shell-generate-key-pair
:openssl-shell-sign-string :openssl-shell-import-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 openssl-shell-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 openssl-shell-destructure-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 openssl-shell-import-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 openssl-shell-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 (string-to-ub8-vector string)))
(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)))
(defun string-to-ub8-vector (string)
"Convert the given STRING into an unsigned 8-bit vector."
(coerce
(loop for char across string
collect (char-code char))
'(vector (unsigned-byte 8))))