diff options
Diffstat (limited to 'src/scm/webid-oidc/jti.scm')
-rw-r--r-- | src/scm/webid-oidc/jti.scm | 34 |
1 files changed, 34 insertions, 0 deletions
diff --git a/src/scm/webid-oidc/jti.scm b/src/scm/webid-oidc/jti.scm new file mode 100644 index 0000000..423382a --- /dev/null +++ b/src/scm/webid-oidc/jti.scm @@ -0,0 +1,34 @@ +(define-module (webid-oidc jti) + #:use-module (ice-9 atomic) + #:use-module (ice-9 threads) + #:use-module (srfi srfi-19)) + +(define-public (make-jti-list) + (make-atomic-box '())) + +(define-public (lookup list jti) + (if (null? list) + #f + (or (string=? (assq-ref (car list) 'jti) jti) + (lookup (cdr list) jti)))) + +(define-public (jti-check current-time jti list valid-time) + (when (date? current-time) + (set! current-time (date->time-utc current-time))) + (when (time? current-time) + (set! current-time (time-second current-time))) + (let* ((old (atomic-box-ref list)) + (new-entry `((exp . ,(+ current-time valid-time)) + (jti . ,jti))) + (new (filter + (lambda (entry) + (let ((exp (assq-ref entry 'exp))) + (>= exp current-time))) + (cons new-entry old)))) + (let ((present? (lookup old jti))) + (if present? + #f + (let ((discarded (atomic-box-compare-and-swap! list old new))) + (if (eq? discarded old) + #t + (jti-check current-time jti list valid-time))))))) |