diff options
Diffstat (limited to 'src/scm/webid-oidc/program.scm')
| -rw-r--r-- | src/scm/webid-oidc/program.scm | 153 |
1 files changed, 120 insertions, 33 deletions
diff --git a/src/scm/webid-oidc/program.scm b/src/scm/webid-oidc/program.scm index 3582eaa..c53be5d 100644 --- a/src/scm/webid-oidc/program.scm +++ b/src/scm/webid-oidc/program.scm @@ -2,6 +2,7 @@ #:use-module (webid-oidc errors) #:use-module (webid-oidc reverse-proxy) #:use-module (webid-oidc identity-provider) + #:use-module (webid-oidc client) #:use-module (webid-oidc jti) #:use-module ((webid-oidc stubs) #:prefix stubs:) #:use-module ((webid-oidc config) #:prefix cfg:) @@ -42,6 +43,32 @@ (define cache-http-get (with-cache #:http-get http-get-with-log)) +(define (handler-with-log handler) + (lambda (request request-body) + (with-exception-handler + (lambda (error) + (format (current-error-port) + (G_ "~a: Internal server error: ~a\n") + (date->string (time-utc->date (current-time))) + (error->str error)) + (values + (build-response #:code 500 + #:reason-phrase "Internal Server Error") + "Sorry, there was an error.")) + (lambda () + (with-exception-handler + (lambda (error) + (format (current-error-port) + (G_ "The client locale ~s can’t be approximated by system locale ~s (because ~a), using C.\n") + ((record-accessor &unknown-client-locale 'web-locale) error) + ((record-accessor &unknown-client-locale 'c-locale) error) + (error->str error))) + (lambda () + (handler request request-body)) + #:unwind? #t + #:unwind-for-type &unknown-client-locale)) + #:unwind? #t))) + (define-public (main) (setvbuf (current-output-port) 'none) (setvbuf (current-error-port) 'none) @@ -72,6 +99,14 @@ (string->symbol (G_ "command-line|server|issuer|authorization-endpoint-uri"))) (token-endpoint-uri-sym (string->symbol (G_ "command-line|server|issuer|token-endpoint-uri"))) + (client-id-sym + (string->symbol (G_ "command-line|server|client-id"))) + (redirect-uri-sym + (string->symbol (G_ "command-line|server|redirect-uri"))) + (client-name-sym + (string->symbol (G_ "command-line|server|client-name"))) + (client-uri-sym + (string->symbol (G_ "command-line|server|client-uri"))) (log-file-sym (string->symbol (G_ "command-line|log-file"))) (error-file-sym @@ -88,6 +123,10 @@ (,jwks-uri-sym (single-char #\j) (value #t)) (,authorization-endpoint-uri-sym (single-char #\a) (value #t)) (,token-endpoint-uri-sym (single-char #\t) (value #t)) + (,client-id-sym (single-char #\c) (value #t)) + (,redirect-uri-sym (single-char #\r) (value #t)) + (,client-name-sym (single-char #\C) (value #t)) + (,client-uri-sym (single-char #\u) (value #t)) (,port-sym (single-char #\p) (value #t)) (,server-name-sym (single-char #\n) (value #t)) (,header-sym (single-char #\H) (value #t)) @@ -104,6 +143,8 @@ Available commands: run an authenticating reverse proxy. ~a: run an identity provider. + ~a: + serve the pages for a public application. General options: -h, --~a: @@ -144,6 +185,19 @@ Options for the identity provider: -t URI, --~a=URI: set the token endpoint of the issuer. +Options for the client service: + -c URI, --~a=URI: + set the web identifier of the client application, which is + dereferenced to a semantic resource. + -r URI, --~a=URI: + set the redirection URI to get the authorization code back. The + page is presented with the code to paste in the application. + -C NAME, --~a=NAME: + set the user-visible application name (may be misleading...). + -u URI, --~a=URI: + set an URI where someone would find more information about the + application (again, may be misleading). + Environment variables: LANG: set the locale of the user interface (for the server commands, @@ -197,6 +251,17 @@ invoked with the following options: --~a 'https://webid-oidc-demo.planete-kraus.eu/token' \\ --~a $PORT +Running the public pages for an application + +webid-oidc-demo.planete-kraus.eu is configured this way: + + ~a ~a \\ + --~a 'https://webid-oidc-demo.planete-kraus.eu/example-application#id' \\ + --~a 'https://webid-oidc-demo.planete-kraus.eu/authorized' \\ + --~a 'Example Solid Application' \\ + --~a 'https://webid-oidc.planete-kraus.eu/Running-a-client.html#Running-a-client' \\ + --~a $PORT + If you find a bug, then please send a report to ~a. ") ;; Usage: @@ -204,6 +269,7 @@ If you find a bug, then please send a report to ~a. ;; Available commands: (G_ "command-line|command|reverse-proxy") (G_ "command-line|command|identity-provider") + (G_ "command-line|command|client-service") ;; General options ;; help help-sym @@ -231,6 +297,11 @@ If you find a bug, then please send a report to ~a. jwks-uri-sym authorization-endpoint-uri-sym token-endpoint-uri-sym + ;; Options for the client service + client-id-sym + redirect-uri-sym + client-name-sym + client-uri-sym ;; Environment variables (if (getenv "LANG") (format #f (G_ "an environment variable| It is currently set to ~s.") @@ -262,6 +333,11 @@ If you find a bug, then please send a report to ~a. server-name-sym key-file-sym subject-sym password-sym jwks-uri-sym authorization-endpoint-uri-sym token-endpoint-uri-sym port-sym + ;; Running the public pages for an application + (car (command-line)) + (G_ "command-line|command|client-service") + client-id-sym redirect-uri-sym client-name-sym client-uri-sym + port-sym ;; Bug report cfg:package-bugreport)) ((option-ref options version-sym #f) @@ -319,7 +395,17 @@ If you find a bug, then please send a report to ~a. (and str (string->uri str)))) (token-endpoint-uri (let ((str (option-ref options token-endpoint-uri-sym #f))) - (and str (string->uri str))))) + (and str (string->uri str)))) + (client-id + (let ((str (option-ref options client-id-sym #f))) + (and str (string->uri str)))) + (redirect-uri + (let ((str (option-ref options redirect-uri-sym #f))) + (and str (string->uri str)))) + (client-name + (option-ref options client-name-sym #f)) + (client-uri + (option-ref options client-uri-sym #f))) (when (null? rest) (format (current-error-port) (G_ "Usage: ~a COMMAND [OPTIONS]...\nSee --~a (-h).\n") @@ -393,36 +479,37 @@ If you find a bug, then please send a report to ~a. (make-jti-list) #:current-time current-time #:http-get cache-http-get))) - (let ((handler-with-log - (lambda (request request-body) - (with-exception-handler - (lambda (error) - (format (current-error-port) - (G_ "~a: Internal server error: ~a\n") - (date->string (time-utc->date (current-time))) - (error->str error)) - (values - (build-response #:code 500 - #:reason-phrase "Internal Server Error") - "Sorry, there was an error.")) - (lambda () - (with-exception-handler - (lambda (error) - (format (current-error-port) - (G_ "The client locale ~s can’t be approximated by system locale ~s (because ~a), using C.\n") - ((record-accessor &unknown-client-locale 'web-locale) error) - ((record-accessor &unknown-client-locale 'c-locale) error) - (error->str error))) - (lambda () - (handler request request-body)) - #:unwind? #t - #:unwind-for-type &unknown-client-locale)) - #:unwind? #t)))) - (run-server - handler-with-log - 'http - (list #:port port)))))) + (run-server + (handler-with-log handler) + 'http + (list #:port port))))) + ((equal? command (G_ "command-line|command|client-service")) + (begin + (unless client-id + (format (current-error-port) (G_ "You must pass --~a to set the application web ID.\n") + client-id-sym) + (exit 1)) + (unless redirect-uri + (format (current-error-port) (G_ "You must pass --~a to set the redirection URI.\n") + redirect-uri-sym) + (exit 1)) + (unless client-name + (format (current-error-port) (G_ "You must pass --~a to set the informative client name.\n") + client-name-sym) + (exit 1)) + (unless client-uri + (format (current-error-port) (G_ "You must pass --~a to set the informative client URI.\n") + client-uri-sym) + (exit 1)) + (let ((handler + (serve-application client-id redirect-uri + #:client-name client-name + #:client-uri client-uri))) + (run-server + (handler-with-log handler) + 'http + (list #:port port))))) (else - (format (current-error-port) (G_ "Unknown command ~s\n") - command) - (exit 1)))))))))) + (format (current-error-port) (G_ "Unknown command ~s\n") + command) + (exit 1)))))))))) |