From a71a37b8c32b67f1565e620424598e1b196ac413 Mon Sep 17 00:00:00 2001 From: Vivien Kraus Date: Fri, 4 Dec 2020 19:23:04 +0100 Subject: Make an authorization endpoint --- src/scm/webid-oidc/Makefile.am | 6 +- src/scm/webid-oidc/authorization-endpoint.scm | 113 ++++++++++++++++++++++++++ tests/Makefile.am | 5 +- tests/authorization-endpoint-get-form.scm | 43 ++++++++++ tests/authorization-endpoint-no-args.scm | 36 ++++++++ tests/authorization-endpoint-submit-form.scm | 101 +++++++++++++++++++++++ 6 files changed, 301 insertions(+), 3 deletions(-) create mode 100644 src/scm/webid-oidc/authorization-endpoint.scm create mode 100644 tests/authorization-endpoint-get-form.scm create mode 100644 tests/authorization-endpoint-no-args.scm create mode 100644 tests/authorization-endpoint-submit-form.scm diff --git a/src/scm/webid-oidc/Makefile.am b/src/scm/webid-oidc/Makefile.am index 57bd1b1..0aea0d9 100644 --- a/src/scm/webid-oidc/Makefile.am +++ b/src/scm/webid-oidc/Makefile.am @@ -15,7 +15,8 @@ dist_webidoidcmod_DATA += \ %reldir%/refresh-token.scm \ %reldir%/oidc-id-token.scm \ %reldir%/authorization-page.scm \ - %reldir%/authorization-page-unsafe.scm + %reldir%/authorization-page-unsafe.scm \ + %reldir%/authorization-endpoint.scm webidoidcgo_DATA += \ %reldir%/errors.go \ @@ -34,6 +35,7 @@ webidoidcgo_DATA += \ %reldir%/refresh-token.go \ %reldir%/oidc-id-token.go \ %reldir%/authorization-page.go \ - %reldir%/authorization-page-unsafe.go + %reldir%/authorization-page-unsafe.go \ + %reldir%/authorization-endpoint.go EXTRA_DIST += %reldir%/ChangeLog diff --git a/src/scm/webid-oidc/authorization-endpoint.scm b/src/scm/webid-oidc/authorization-endpoint.scm new file mode 100644 index 0000000..8dfa71f --- /dev/null +++ b/src/scm/webid-oidc/authorization-endpoint.scm @@ -0,0 +1,113 @@ +(define-module (webid-oidc authorization-endpoint) + #:use-module (webid-oidc errors) + #:use-module (webid-oidc authorization-page) + #:use-module (webid-oidc jwk) + #:use-module (webid-oidc authorization-code) + #:use-module (webid-oidc client-manifest) + #:use-module (web uri) + #:use-module (web client) + #:use-module (web request) + #:use-module (web response) + #:use-module (rnrs bytevectors) + #:use-module (srfi srfi-19) + #:use-module (ice-9 receive) + #:use-module (ice-9 optargs)) + +(define*-public (make-authorization-endpoint subject the-password alg jwk validity + #:key + (http-get http-get) + (current-time current-time)) + (define (parse-arg x decode-plus-to-space?) + (map (lambda (x) (uri-decode + x + #:decode-plus-to-space? decode-plus-to-space?)) + (string-split x #\=))) + (lambda* (request request-body) + (when (bytevector? request-body) + (set! request-body (utf8->string request-body))) + (let* ((uri (request-uri request)) + (method (request-method request)) + (query (uri-query uri)) + (query-parts (if query + (string-split query #\&) + '())) + (get-args (map (lambda (x) (parse-arg x #f)) query-parts)) + (form-args + (if (and + (request-content-type request) + (eq? (car (request-content-type request)) + 'application/x-www-form-urlencoded)) + (let ((parts (string-split request-body #\&))) + (map (lambda (x) (parse-arg x #t)) parts)) + '())) + (accept-language + (sort (request-accept-language request) + (lambda (x y) (>= (car x) (car y))))) + (locale (if (null? accept-language) + "C" + (cdar accept-language)))) + (let ((client-id (assoc-ref get-args "client_id")) + (redirect-uri (assoc-ref get-args "redirect_uri")) + (password (assoc-ref form-args "password")) + (state (assoc-ref get-args "state"))) + (when client-id + (set! client-id (car client-id))) + (when redirect-uri + (set! redirect-uri (string->uri (car redirect-uri)))) + (when password + (set! password (car password))) + (when state + (set! state (car state))) + (cond + ((not client-id) + (error-no-client-id locale)) + ((not redirect-uri) + (error-no-redirect-uri locale)) + ((and (eq? method 'POST) + (string? password) + (string=? password the-password)) + (with-exception-handler + (lambda (error) + (error-application locale error)) + (lambda () + (let* ((current-time (if (thunk? current-time) + (current-time) + current-time)) + (current-sec + (cond ((date? current-time) + (time-second (date->time-utc current-time))) + ((time? current-time) + (time-second current-time)) + ((integer? current-time) + current-time))) + (exp-sec (+ current-sec validity)) + (exp (time-utc->date (make-time time-utc 0 exp-sec))) + (code (issue-authorization-code alg jwk exp subject client-id))) + (let ((mf (get-client-manifest (string->uri client-id) + #:http-get http-get))) + (client-manifest-check-redirect-uri mf redirect-uri) + (let ((query + (if state + (format #f "code=~a&state=~a" + (uri-encode code) + (uri-encode state)) + (format #f "code=~a" + (uri-encode code))))) + (let ((uri + (build-uri 'https + #:userinfo (uri-userinfo redirect-uri) + #:host (uri-host redirect-uri) + #:port (uri-port redirect-uri) + #:path (uri-path redirect-uri) + #:query query))) + (redirection locale + (string->uri client-id) + uri)))))) + #:unwind? #t)) + (else + (authorization-page locale + (not (and password + (string=? password the-password))) + client-id + uri))))))) + diff --git a/tests/Makefile.am b/tests/Makefile.am index 2d09363..457d462 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -30,7 +30,10 @@ TESTS = %reldir%/load-library.scm \ %reldir%/refresh-token.scm \ %reldir%/too-many-refresh-tokens.scm \ %reldir%/refresh-token-with-wrong-key.scm \ - %reldir%/unknown-client-locale.scm + %reldir%/unknown-client-locale.scm \ + %reldir%/authorization-endpoint-no-args.scm \ + %reldir%/authorization-endpoint-get-form.scm \ + %reldir%/authorization-endpoint-submit-form.scm EXTRA_DIST += $(TESTS) %reldir%/ChangeLog diff --git a/tests/authorization-endpoint-get-form.scm b/tests/authorization-endpoint-get-form.scm new file mode 100644 index 0000000..d6fabe9 --- /dev/null +++ b/tests/authorization-endpoint-get-form.scm @@ -0,0 +1,43 @@ +(use-modules (webid-oidc authorization-endpoint) + (webid-oidc jwk) + (webid-oidc testing) + (web uri) + (web request) + (web response) + (srfi srfi-19) + (web response) + (ice-9 optargs) + (ice-9 receive)) + +(with-test-environment + "authorization-endpoint-get-form" + (lambda () + (define alg 'RS256) + (define key (generate-key #:n-size 2048)) + (define subject (string->uri "https://authorization-endpoint-get-form.scm/profile/card#me")) + (define password "p4ssw0rd") + (define validity 120) + (define the-time 0) + (define (current-time) + (make-time time-utc 0 the-time)) + (define* (http-get uri #:key (headers '())) + (exit 2)) + (define endpoint + (make-authorization-endpoint + subject password alg key validity + #:http-get http-get + #:current-time current-time)) + (receive (response response-body) + (endpoint + (build-request (string->uri + (format #f "https://authorization-endpoint-get-form.scm/authorize?client_id=~a&redirect_uri=~a" + (uri-encode "https://authorization-endpoint-get-form.scm/client/card#app") + (uri-encode "https://authorization-endpoint-get-form.scm/client/redirect")))) + "") + (unless (eq? (response-code response) 200) + (exit 3)) + (unless (response-content-type response) + (exit 4)) + (unless (eq? (car (response-content-type response)) + 'application/xhtml+xml) + (exit 5))))) diff --git a/tests/authorization-endpoint-no-args.scm b/tests/authorization-endpoint-no-args.scm new file mode 100644 index 0000000..04ab575 --- /dev/null +++ b/tests/authorization-endpoint-no-args.scm @@ -0,0 +1,36 @@ +(use-modules (webid-oidc authorization-endpoint) + (webid-oidc jwk) + (webid-oidc testing) + (web uri) + (web request) + (web response) + (srfi srfi-19) + (web response) + (ice-9 optargs) + (ice-9 receive)) + +(with-test-environment + "authorization-endpoint-get-form" + (lambda () + (define alg 'RS256) + (define key (generate-key #:n-size 2048)) + (define subject (string->uri "https://authorization-endpoint-get-form.scm/profile/card#me")) + (define password "p4ssw0rd") + (define validity 120) + (define the-time 0) + (define (current-time) + (make-time time-utc 0 the-time)) + (define* (http-get uri #:key (headers '())) + (exit 2)) + (define endpoint + (make-authorization-endpoint + subject password alg key validity + #:http-get http-get + #:current-time current-time)) + (receive (response response-body) + (endpoint + (build-request (string->uri + "https://authorization-endpoint-get-form.scm/authorize")) + "") + (unless (eq? (response-code response) 400) + (exit 3))))) diff --git a/tests/authorization-endpoint-submit-form.scm b/tests/authorization-endpoint-submit-form.scm new file mode 100644 index 0000000..156bf4e --- /dev/null +++ b/tests/authorization-endpoint-submit-form.scm @@ -0,0 +1,101 @@ +(use-modules (webid-oidc authorization-endpoint) + (webid-oidc authorization-code) + (webid-oidc client-manifest) + (webid-oidc jwk) + (webid-oidc cache) + (webid-oidc jti) + (webid-oidc testing) + (web uri) + (web request) + (web response) + (srfi srfi-19) + (web response) + (ice-9 optargs) + (ice-9 receive)) + +(with-test-environment + "authorization-endpoint-submit-form" + (lambda () + (define alg 'RS256) + (define key (generate-key #:n-size 2048)) + (define subject (string->uri "https://authorization-endpoint-submit-form.scm/profile/card#me")) + (define client (string->uri "https://authorization-endpoint-submit-form.scm/client/card#app")) + (define redirect (string->uri "https://authorization-endpoint-submit-form.scm/client/redirect")) + (define password "p4ssw0rd") + (define validity 120) + (define the-time 0) + (define (current-time) + (make-time time-utc 0 the-time)) + (define what-uri-to-expect client) + (define served + (receive (response response-body) + (serve-client-manifest + (time-utc->date (make-time time-utc 0 3600)) + (make-client-manifest client (list redirect))) + (cons response response-body))) + (define the-response (car served)) + (define the-response-body (cdr served)) + (define* (http-get uri #:key (headers '())) + (unless (equal? uri what-uri-to-expect) + (exit 2)) + (values the-response the-response-body)) + (define cached-http-get + (with-cache #:http-get http-get + #:current-time current-time)) + (define jti-list (make-jti-list)) + (define endpoint + (make-authorization-endpoint + subject password alg key validity + #:http-get cached-http-get + #:current-time current-time)) + (receive (response response-body) + ;; The password is fake! + (endpoint + (build-request (string->uri + (format #f "https://authorization-endpoint-submit-form.scm/authorize?client_id=~a&redirect_uri=~a" + (uri-encode (uri->string client)) + (uri-encode (uri->string redirect)))) + #:headers '((content-type application/x-www-form-urlencoded)) + #:method 'POST + #:port #t) + "password=fake") + (when (eq? (response-code response) 302) + (exit 3))) + (receive (response response-body) + (endpoint + (build-request (string->uri + (format #f "https://authorization-endpoint-submit-form.scm/authorize?client_id=~a&redirect_uri=~a" + (uri-encode (uri->string client)) + (uri-encode (uri->string redirect)))) + #:headers '((content-type application/x-www-form-urlencoded)) + #:method 'POST + #:port #t) + "password=p4ssw0rd") + (unless (eq? (response-code response) 302) + (exit 4)) + (let ((loc (response-location response))) + (unless (uri? loc) + (exit 5)) + (let ((loc-scheme (uri-scheme loc)) + (loc-host (uri-host loc)) + (loc-path (uri-path loc)) + (loc-query (uri-query loc))) + (unless (eq? loc-scheme 'https) + (exit 6)) + (unless (string=? loc-host "authorization-endpoint-submit-form.scm") + (exit 7)) + (unless (string=? loc-path "/client/redirect") + (exit 8)) + (let* ((kv (string-split loc-query #\&)) + (args (map (lambda (x) + (map uri-decode (string-split x #\=))) + kv))) + (unless (assoc-ref args "code") + (exit 9)) + (let ((parsed (authorization-code-decode + 60 + jti-list + (car (assoc-ref args "code")) + key))) + (unless parsed + (exit 10))))))))) -- cgit v1.2.3