From a7bccf4950d991375f6e045a03f15c921347e199 Mon Sep 17 00:00:00 2001 From: Vivien Kraus Date: Sat, 29 Jan 2022 12:55:08 +0100 Subject: Generate an RSA key pair --- disfluid/build/bootstrap.scm | 3 +- disfluid/jwk.scm | 186 +++++++++++++++++++++++++++++++++++++++++++ doc/disfluid.texi | 119 ++++++++++++++++++++++++--- guix.scm | 1 + po/disfluid.pot | 26 +++++- po/fr.po | 26 +++++- tests/jwk.scm | 58 ++++++++++++++ 7 files changed, 401 insertions(+), 18 deletions(-) create mode 100644 disfluid/jwk.scm create mode 100644 tests/jwk.scm diff --git a/disfluid/build/bootstrap.scm b/disfluid/build/bootstrap.scm index b4ee375..33fbb1c 100644 --- a/disfluid/build/bootstrap.scm +++ b/disfluid/build/bootstrap.scm @@ -53,7 +53,8 @@ (description "This package provides a Solid implementation, client and server.") (home-page "https://disfluid.planete-kraus.eu") (license gpl3+) - (dependencies `()) + (dependencies `(("guile-gcrypt" (gcrypt pk-crypto) ,guile-gcrypt) + ("guile-json" (json) ,guile-json-4))) (files (libraries ((scheme-file "disfluid") (directory "disfluid" ()))) diff --git a/disfluid/jwk.scm b/disfluid/jwk.scm new file mode 100644 index 0000000..6791e74 --- /dev/null +++ b/disfluid/jwk.scm @@ -0,0 +1,186 @@ +(define-module (disfluid jwk) + #:use-module (disfluid i18n) + #:use-module (json) + #:use-module (gcrypt pk-crypto) + #:use-module (gcrypt base64) + #:use-module (gcrypt hash) + #:use-module (oop goops) + #:use-module (ice-9 optargs) + #:use-module (ice-9 exceptions) + #:use-module (ice-9 receive) + #:use-module (rnrs bytevectors) + #:declarative? #t + #:export ( + jwk->json + jwk-public->json + + jkt + + &invalid-key-parameters)) + +(define-exception-type + &invalid-key-parameters + &error + make-invalid-key-parameters + invalid-key-parameters?) + +(define-class () + kid + key) + +(define-method (initialize (key ) initargs) + (let-keywords + initargs #t + ((n-size #f) + (e 0) + (canonical-sexp #f) + (kid #f)) + (when (string? e) + (with-exception-handler + (lambda (exn) + (raise-exception + (make-exception + (make-invalid-key-parameters) + (make-exception-with-message + (format #f (G_ "the value of e could not be decoded from base64-url (~s)") + e)) + exn))) + (lambda () + (let ((as-data (base64-decode e base64url-alphabet))) + (set! e + (car (bytevector->uint-list + as-data + (endianness little) + (bytevector-length as-data)))))))) + (cond + (canonical-sexp + (slot-set! key 'key canonical-sexp) + (unless kid + (set! kid (jkt key))) + (slot-set! key 'kid kid)) + (n-size + (begin + (with-exception-handler + (lambda (exn) + (raise-exception + (make-exception + (make-invalid-key-parameters) + (make-exception-with-message + (format #f (G_ "a key with n-size=~s (e=~s) could not be built") + n-size e)) + exn))) + (lambda () + ;; generate-key will abort complaining that n is less than + ;; 16 for n up to 64 (!) To avoid much trouble and unsafe + ;; keys, I’ll just require them to be at least 1024 bits + (unless (>= n-size 1024) + (raise-exception + (make-exception + (make-error) + (make-exception-with-message + (format #f (G_ "the key size is too small")))))) + (let ((parameters + (let ((n-size (number->string n-size)) + (e (number->string e))) + (string->canonical-sexp + (format #f "(genkey (rsa (nbits ~a:~a) (rsa-use-e ~a:~a)))" + (string-length n-size) n-size + (string-length e) e))))) + (let ((key-pair (generate-key parameters))) + (slot-set! key 'key key-pair))))) + (slot-set! key 'kid (jkt key)))) + (else + (raise-exception + (make-exception + (make-invalid-key-parameters) + (make-exception-with-message + (G_ "the key initialization requires at least #:n-size to generate it")))))))) + +(define (encode bv) + (base64-encode bv 0 (bytevector-length bv) #f #t base64url-alphabet)) + +(define-method (jkt (key )) + (let* ((required-fields + (let* ((sexp (slot-ref key 'key)) + (public-sexp (or (find-sexp-token sexp 'public-key) + (find-sexp-token sexp 'private-key)))) + (let ((rsa (find-sexp-token public-sexp 'rsa))) + (cond + (rsa + (let ((e (cadr (canonical-sexp->sexp (find-sexp-token rsa 'e)))) + (n (cadr (canonical-sexp->sexp (find-sexp-token rsa 'n))))) + `((kty . "rsa") + (e . ,(encode e)) + (n . ,(encode n))))) + (else + (error "jkt: not implemented for this key type.")))))) + (as-string (scm->json-string required-fields)) + (as-data (string->utf8 as-string)) + (hash (sha256 as-data)) + (encoded (encode hash))) + encoded)) + +(define-method (kid (key )) + (slot-ref key 'kid)) + +(define-method (public-rsa-parameter (key ) name) + (let* ((sexp (slot-ref key 'key)) + (public-sexp (or (find-sexp-token sexp 'public-key) + (find-sexp-token sexp 'private-key))) + (public-rsa (find-sexp-token sexp 'rsa))) + (and public-rsa + (let ((as-data (cadr (canonical-sexp->sexp (find-sexp-token public-rsa name))))) + (encode as-data))))) + +(define-method (n (key )) + (public-rsa-parameter key 'n)) + +(define-method (e (key )) + (public-rsa-parameter key 'e)) + +(define-method (private-rsa-parameters (key )) + (let* ((sexp (slot-ref key 'key)) + (private-sexp (find-sexp-token sexp 'private-key))) + (if private-sexp + (let ((rsa (find-sexp-token private-sexp 'rsa))) + (if rsa + (let ((d (canonical-sexp-nth-data (find-sexp-token rsa 'd) 1)) + ;; What libgcrypt calls p is in fact q and vice + ;; versa + (p (canonical-sexp-nth-data (find-sexp-token rsa 'q) 1)) + (q (canonical-sexp-nth-data (find-sexp-token rsa 'p) 1)) + ;; If this is the case, then u is what we want + ;; as q^{-1} mod p + (qi (canonical-sexp-nth-data (find-sexp-token rsa 'u) 1))) + ;; FIXME: gcrypt does not remember the dP and dQ + ;; parameters. + (values (encode d) (encode p) (encode q) (encode qi))) + (values #f #f #f #f))) + (values #f #f #f #f)))) + +(define-method (jwk-public->json (key )) + (let ((kid (slot-ref key 'kid)) + (n (n key)) + (e (e key))) + (cond + ((and n e) + `((kid . ,kid) + (kty . "RSA") + (n . ,n) + (e . ,e))) + (else + (error "unsupported conversion to json"))))) + +(define-method (jwk->json (key )) + ;; Make sure to only call this function if it doesn’t have a private + ;; key + (receive (d p q qi) (private-rsa-parameters key) + (cond + ((and d p q qi) + `(,@(jwk-public->json key) + (d . ,d) + (p . ,p) + (q . ,q) + (qi . ,qi))) + (else + (error "unsupported conversion to json"))))) diff --git a/doc/disfluid.texi b/doc/disfluid.texi index 9c152f6..862280d 100644 --- a/doc/disfluid.texi +++ b/doc/disfluid.texi @@ -4,7 +4,7 @@ @c %**start of header @setfilename disfluid.info @documentencoding UTF-8 -@settitle Disfluid Reference Manual +@settitle Demanding Interoperability to Strengthen the Free (Libre) Web: Introducing Disfluid @c %**end of header @include version.texi @@ -12,21 +12,23 @@ @copying Copyright @copyright{} 2022 Vivien Kraus +@quotation Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or any later version published by the Free Software Foundation; with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. A copy of the license is included in the section entitled ``GNU Free Documentation License''. +@end quotation @end copying @dircategory The Algorithmic Language Scheme @direntry -* Disfluid: (disfluid). +* Disfluid: (disfluid)Decentralized Authentication on the Web @end direntry @titlepage -@title The Disfluid Manual +@title Interoperability to Strengthen the Free (Libre) Web: Introducing Disfluid @author Vivien Kraus @page @@ -43,18 +45,117 @@ Edition @value{EDITION} @* @node Top @top Disfluid -This document describes Disfluid version @value{VERSION}. +Disfluid is an independent implementation of a web stack focusing on +interoperability. In this implementation, the users control what +programs run in their computers. They also choose who to trust for +online data storage and processing, without needing any permission, or +can self-host their data. + +The software is available at +@url{https://labo.planete-kraus.eu/disfluid.git}. @menu -* Introduction:: Why Disfluid? +* Decentralized Authentication on the Web:: What is Disfluid? +* Cryptography elements in Disfluid:: @end menu @c ********************************************************************* -@node Introduction -@chapter Introduction -INTRODUCTION HERE +@node Decentralized Authentication on the Web +@chapter Decentralized Authentication on the Web + +Authentication on the web is currently handled in the following way: +anyone can install a server that will authenticate users on the +web. The problem is interoperability. If a client (an application) +wants to authenticate a user, it has to be approved by the +authentication server. In other words, if @var{useful-program} wants +to authenticate @var{MegaCorp} users, then @var{useful-program} has to +register to @var{MegaCorp} first, and get approved. This goes against +the principle of permission-less innovation, which is at the heart of +the web. + +In the decentralized authentication web, the best attempt so far is +that of ActivityPub. All servers are interoperable with respect to +authentication: if user A emits an activity, it is forwarded by A's +server to its recipients, and A's server is responsible for A's +identity. + +The problem with that approach is that the data is tied to the +application. It is not possible to use another application to process +the data differently, or to use multiple data sources, in an +interoperable way (without the ActivityPub server knowing). This means +that on Activitypub, microblogging applications will not present +different activities correctly. This also means that it is difficult +to write a free replacement to a non-free application program, because +it would need to manage the data. + +In the Solid ecosystem, there is a clear distinction between servers +and applications. An application is free to read data from all places +at the same time, using a permission-less authentication system. Since +the applications do not need to store data, the cost of having users +is neglectible, so users do not need prior approval before using them +(making captchas and the like a thing of the past). Servers do not +have a say in which applications the user uses. + +The authentication used is a slight modification of the +well-established OpenID Connect. It is intended to work in a web +browser, but this package demonstrates that it also works without a +web browser. + +@node Cryptography elements in Disfluid +@chapter Cryptography elements in Disfluid +Disfluid works with the JWA algorithms (RFC 7518) for signatures. + +@menu +* Key management:: +@end menu -This documentation is a stub. +@node Key management +@section Key management + +The @emph{(disfluid jwk)} module provides tools to manage keys, +according to the conventions presented in RFC 7517. + +@deftp {Class} @var{kid} @var{key} +A class composed of a @var{key} (managed by gcrypt) and some +meta-data. For now, only the @dfn{key identifier} @var{kid}: a string +uniquely identifying a key or a key pair. A default value is always +provided. + +You can construct a new key with the following keyword arguments: +@table @code +@item #:n-size +This argument is used to generate a new RSA key pair. It is the number +of bits for the RSA key. Pass less than 1024 to raise an error. +@item #:e +This argument is used to generate a new RSA key pair, but it is +optional. Pass a value of 0 (the default) to let gcrypt pick a +suitable value. Pass 1 to set it to 65537. As with gcrypt, 2 is a +reserved value. Other than that, the value passed is used. If this is +a string, it is decoded from base64url first. +@item #:kid +Override the key identifier. By default, a new value is computed. +@end table +@end deftp + +@deftypefn {Generic method} @code{SRFI-180 alist} jwk->json (@var{key} @code{}) +@deftypefnx {Generic method} @code{SRFI-180 alist} jwk-public->json (@var{key} @code{}) +Extract and encode the key parameters of @var{key} into an +alist. @code{jwk->json} also encodes the private key, while +@code{jwk-public->json} only encodes the public key. Using +@code{jwk->json} is not recommended if you don’t need the private key, +because it leaks the private key to the guile garbage collection. +@end deftypefn + +@deftypefn {Generic method} @code{} jkt (@var{key} @code{}) +Compute the JWK Thumbprint (RFC 7638) of @var{key}. +@end deftypefn + +@deftp {Exception type} &invalid-key-parameters +An exception of this type is raised when the parameters cannot be used +to build a valid cryptographic key. It can also be raised when +generating a new key pair, if the key generation parameters are not +valid, or too unsafe. +@end deftp @bye diff --git a/guix.scm b/guix.scm index 1034b68..1246039 100644 --- a/guix.scm +++ b/guix.scm @@ -7,6 +7,7 @@ (gnu packages compression) (gnu packages emacs) (gnu packages gettext) + (gnu packages gnupg) (gnu packages guile) (gnu packages guile-xyz) (gnu packages version-control)) diff --git a/po/disfluid.pot b/po/disfluid.pot index 441b9d8..f2ac7ad 100644 --- a/po/disfluid.pot +++ b/po/disfluid.pot @@ -6,9 +6,9 @@ #, fuzzy msgid "" msgstr "" -"Project-Id-Version: disfluid SNAPSHOT\n" +"Project-Id-Version: disfluid 0.0.2-1-g470ac86\n" "Report-Msgid-Bugs-To: vivien@planete-kraus.eu\n" -"POT-Creation-Date: 2022-01-15 22:58+0100\n" +"POT-Creation-Date: 2022-01-29 16:42+0100\n" "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" "Last-Translator: FULL NAME \n" "Language-Team: LANGUAGE \n" @@ -17,12 +17,12 @@ msgstr "" "Content-Type: text/plain; charset=CHARSET\n" "Content-Transfer-Encoding: 8bit\n" -#: disfluid/build/bootstrap.scm:187 +#: disfluid/build/bootstrap.scm:190 #, scheme-format msgid "Warning: ~a: ~a~%" msgstr "" -#: disfluid/build/bootstrap.scm:223 +#: disfluid/build/bootstrap.scm:227 msgid "Cannot find guile, using /usr/local/bin/guile." msgstr "" @@ -75,3 +75,21 @@ msgstr "" #: disfluid/build/post-commit-hook.scm:112 msgid "cannot clean up the last commit files" msgstr "" + +#: disfluid/jwk.scm:45 +#, scheme-format +msgid "the value of e could not be decoded from base64-url (~s)" +msgstr "" + +#: disfluid/jwk.scm:69 +#, scheme-format +msgid "a key with n-size=~s (e=~s) could not be built" +msgstr "" + +#: disfluid/jwk.scm:81 +msgid "the key size is too small" +msgstr "" + +#: disfluid/jwk.scm:97 +msgid "the key initialization requires at least #:n-size to generate it" +msgstr "" diff --git a/po/fr.po b/po/fr.po index 3e1e180..7347649 100644 --- a/po/fr.po +++ b/po/fr.po @@ -8,8 +8,8 @@ msgid "" msgstr "" "Project-Id-Version: disfluid SNAPSHOT\n" "Report-Msgid-Bugs-To: vivien@planete-kraus.eu\n" -"POT-Creation-Date: 2022-01-15 22:58+0100\n" -"PO-Revision-Date: 2022-01-16 16:53+0100\n" +"POT-Creation-Date: 2022-01-29 16:42+0100\n" +"PO-Revision-Date: 2022-01-29 16:44+0100\n" "Last-Translator: Vivien \n" "Language-Team: French \n" "Language: fr\n" @@ -18,12 +18,12 @@ msgstr "" "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=2; plural=(n > 1);\n" -#: disfluid/build/bootstrap.scm:187 +#: disfluid/build/bootstrap.scm:190 #, scheme-format msgid "Warning: ~a: ~a~%" msgstr "Attention : ~a : ~a~%" -#: disfluid/build/bootstrap.scm:223 +#: disfluid/build/bootstrap.scm:227 msgid "Cannot find guile, using /usr/local/bin/guile." msgstr "Impossible de trouver guile, j’utilise /usr/local/bin/guile." @@ -76,3 +76,21 @@ msgstr "impossible de pousser la nouvelle version" #: disfluid/build/post-commit-hook.scm:112 msgid "cannot clean up the last commit files" msgstr "impossible de nettoyer les fichiers du dernier commit" + +#: disfluid/jwk.scm:45 +#, scheme-format +msgid "the value of e could not be decoded from base64-url (~s)" +msgstr "la valeur de e n’a pas pu être décodée en base64-url (~s)" + +#: disfluid/jwk.scm:69 +#, scheme-format +msgid "a key with n-size=~s (e=~s) could not be built" +msgstr "impossible de construire une clé avec n-size = ~s (e = ~s)" + +#: disfluid/jwk.scm:81 +msgid "the key size is too small" +msgstr "la taille de la clé est trop petite" + +#: disfluid/jwk.scm:97 +msgid "the key initialization requires at least #:n-size to generate it" +msgstr "l’initialisation de la clé requiert au moins #:n-size pour la générer" diff --git a/tests/jwk.scm b/tests/jwk.scm new file mode 100644 index 0000000..6750456 --- /dev/null +++ b/tests/jwk.scm @@ -0,0 +1,58 @@ +(define-module (tests jwk) + #:use-module (disfluid jwk) + #:use-module (oop goops) + #:use-module (srfi srfi-64) + #:declarative? #t) + +(test-group "Generating a key: RSA" + (let* ((key (make #:n-size 2048)) + (public (jwk-public->json key)) + (pair (jwk->json key))) + (test-group "Generating an RSA key: public and private parts" + (test-equal "RSA" (assq-ref pair 'kty)) + (test-equal (jkt key) (assq-ref pair 'kid)) + (test-assert (not (string-suffix? "=" (assq-ref pair 'kid)))) + (test-assert (string? (assq-ref pair 'n))) + (test-assert (string? (assq-ref pair 'e))) + (test-assert (string? (assq-ref pair 'd))) + (test-assert (string? (assq-ref pair 'p))) + (test-assert (string? (assq-ref pair 'q))) + ;; Fixme: find a way to compute dp and dq + (test-assert (not (assq-ref pair 'dp))) + (test-assert (not (assq-ref pair 'dq))) + (test-assert (string? (assq-ref pair 'qi)))) + (test-group "Generating an RSA key: public part" + (test-equal "RSA" (assq-ref public 'kty)) + (test-assert (string? (assq-ref public 'kid))) + (test-assert (string? (assq-ref public 'n))) + (test-assert (string? (assq-ref public 'e))) + (test-assert (not (assq-ref public 'd))) + (test-assert (not (assq-ref public 'p))) + (test-assert (not (assq-ref public 'q))) + (test-assert (not (assq-ref public 'dp))) + (test-assert (not (assq-ref public 'dq))) + (test-assert (not (assq-ref public 'qi)))) + (test-group "Generating a key: RSA with e=0" + (let ((key (jwk-public->json (make #:n-size 2048 #:e 0)))) + (test-equal "RSA" (assq-ref key 'kty)) + (test-assert (not (equal? (assq-ref key 'e) "AA"))))) + (test-group "Generating a key: RSA with e=1" + (let ((key (jwk-public->json (make #:n-size 2048 #:e 1)))) + (test-equal "RSA" (assq-ref key 'kty)) + (test-assert (not (equal? (assq-ref key 'e) "AQ"))))) + (test-group "Generating a key: RSA with e=3" + (let ((key (jwk-public->json (make #:n-size 2048 #:e 3)))) + (test-equal "RSA" (assq-ref key 'kty)) + (test-equal "Aw" (assq-ref key 'e)))) + (test-group "Generating a key: RSA with e=AQAB" + (let ((key (jwk-public->json (make #:n-size 2048 #:e "AQAB")))) + (test-equal "RSA" (assq-ref key 'kty)) + (test-equal "AQAB" (assq-ref key 'e)))))) + +(test-group "Generating a key with incorrect parameters: RSA" + (test-error &invalid-key-parameters (make #:n-size 8)) + (test-error &invalid-key-parameters (make #:n-size 16)) + (test-error &invalid-key-parameters (make #:n-size 64)) + (test-error &invalid-key-parameters (make #:n-size "garbage")) + (test-error &invalid-key-parameters (make #:n-size 2048 #:e "garbage")) + (test-error &invalid-key-parameters (make ))) -- cgit v1.2.3