diff options
Diffstat (limited to 'src/scm/webid-oidc/dpop-proof.scm')
| -rw-r--r-- | src/scm/webid-oidc/dpop-proof.scm | 90 |
1 files changed, 45 insertions, 45 deletions
diff --git a/src/scm/webid-oidc/dpop-proof.scm b/src/scm/webid-oidc/dpop-proof.scm index 54b338b..2ccbddc 100644 --- a/src/scm/webid-oidc/dpop-proof.scm +++ b/src/scm/webid-oidc/dpop-proof.scm @@ -20,6 +20,7 @@ #:use-module (webid-oidc jwk) #:use-module (webid-oidc jti) #:use-module ((webid-oidc stubs) #:prefix stubs:) + #:use-module ((webid-oidc parameters) #:prefix p:) #:use-module (web uri) #:use-module (ice-9 optargs) #:use-module (srfi srfi-19)) @@ -186,51 +187,51 @@ (uri-path b)))) (raise-dpop-uri-mismatch a b))) -(define*-public (dpop-proof-decode current-time jti-list method uri str cnf/check +(define*-public (dpop-proof-decode method uri str cnf/check #:key (access-token #f)) - (when (date? current-time) - (set! current-time (date->time-utc current-time))) - (when (time? current-time) - (set! current-time (time-second current-time))) - (with-exception-handler - (lambda (error) - (raise-cannot-decode-dpop-proof str error)) - (lambda () - (let ((decoded (the-dpop-proof (jws-decode str dpop-proof-jwk)))) - (unless (eq? method (dpop-proof-htm decoded)) - (raise-dpop-method-mismatch (dpop-proof-htm decoded) method)) - (uris-compatible (dpop-proof-htu decoded) - (if (string? uri) - (string->uri uri) - uri)) - (let ((iat (time-second (date->time-utc (dpop-proof-iat decoded))))) - (unless (>= current-time (- iat 5)) - (raise-dpop-signed-in-future iat current-time)) - (unless (<= current-time (+ iat 120)) ;; Valid for 2 min - (raise-dpop-too-old iat current-time))) - (when access-token - (let ((h (stubs:hash 'SHA-256 access-token))) - (unless (equal? (dpop-proof-ath decoded) h) - (raise-exception - (make-dpop-invalid-access-token-hash (dpop-proof-ath decoded) access-token))))) - (if (string? cnf/check) - (unless (equal? cnf/check (stubs:jkt (dpop-proof-jwk decoded))) - (raise-dpop-unconfirmed-key (dpop-proof-jwk decoded) cnf/check #f)) - (with-exception-handler - (lambda (error) - (raise-dpop-unconfirmed-key (dpop-proof-jwk decoded) #f error)) - (lambda () - (unless (cnf/check (stubs:jkt (dpop-proof-jwk decoded))) - ;; deprecated; throw an error instead! - (error "the cnf/check function returned #f"))))) - (unless (jti-check current-time (dpop-proof-jti decoded) jti-list 120) - (with-exception-handler - (lambda (error) - (raise-jti-found (dpop-proof-jti decoded) error)) - (lambda () - (error "the jti-check function returned #f")))) - decoded)))) + (let ((current-time + (time-second (date->time-utc ((p:current-date)))))) + (with-exception-handler + (lambda (error) + (raise-cannot-decode-dpop-proof str error)) + (lambda () + (let ((decoded (the-dpop-proof (jws-decode str dpop-proof-jwk)))) + (unless (eq? method (dpop-proof-htm decoded)) + (raise-dpop-method-mismatch (dpop-proof-htm decoded) method)) + (uris-compatible (dpop-proof-htu decoded) + (if (string? uri) + (string->uri uri) + uri)) + (let ((iat (time-second (date->time-utc (dpop-proof-iat decoded))))) + (unless (>= current-time (- iat 5)) + (raise-dpop-signed-in-future iat current-time)) + (unless (<= current-time (+ iat 120)) ;; Valid for 2 min + (raise-dpop-too-old iat current-time))) + (when access-token + (let ((h (stubs:hash 'SHA-256 access-token))) + (unless (equal? (dpop-proof-ath decoded) h) + (raise-exception + (make-dpop-invalid-access-token-hash (dpop-proof-ath decoded) access-token))))) + (if (string? cnf/check) + (unless (equal? cnf/check (stubs:jkt (dpop-proof-jwk decoded))) + (raise-dpop-unconfirmed-key (dpop-proof-jwk decoded) cnf/check #f)) + (with-exception-handler + (lambda (error) + (raise-dpop-unconfirmed-key (dpop-proof-jwk decoded) #f error)) + (lambda () + (unless (cnf/check (stubs:jkt (dpop-proof-jwk decoded))) + ;; deprecated; throw an error instead! + (error "the cnf/check function returned #f"))))) + (parameterize ((p:current-date current-time)) + ;; jti-check should use the same date. + (unless (jti-check (dpop-proof-jti decoded) 120) + (with-exception-handler + (lambda (error) + (raise-jti-found (dpop-proof-jti decoded) error)) + (lambda () + (error "the jti-check function returned #f")))) + decoded)))))) (define-public (dpop-proof-encode dpop-proof key) (with-exception-handler @@ -245,11 +246,10 @@ (alg #f) (htm #f) (htu #f) - (iat #f) (access-token #f)) (dpop-proof-encode (make-dpop-proof (make-dpop-proof-header alg client-key) - (make-dpop-proof-payload (stubs:random 12) htm htu iat + (make-dpop-proof-payload (stubs:random 12) htm htu ((p:current-date)) (and access-token (stubs:hash 'SHA-256 access-token)))) client-key)) |