summaryrefslogtreecommitdiff
path: root/src/scm/webid-oidc/jti.scm
diff options
context:
space:
mode:
Diffstat (limited to 'src/scm/webid-oidc/jti.scm')
-rw-r--r--src/scm/webid-oidc/jti.scm34
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)))))))