diff options
author | Vivien Kraus <vivien@planete-kraus.eu> | 2021-06-27 22:28:31 +0200 |
---|---|---|
committer | Vivien Kraus <vivien@planete-kraus.eu> | 2021-07-02 14:49:13 +0200 |
commit | 5231ab8d1680a66460f7d126d7092315ab0f9e23 (patch) | |
tree | 5325c07b26e92f1fc365a701cd0da99865d34b25 /src/scm/webid-oidc | |
parent | 394b62ceab778eb58e7eb8927068a7e1faab4add (diff) |
Merge the identity provider program with webid-oidc
Diffstat (limited to 'src/scm/webid-oidc')
-rw-r--r-- | src/scm/webid-oidc/identity-provider.scm | 243 | ||||
-rw-r--r-- | src/scm/webid-oidc/program.scm | 183 |
2 files changed, 177 insertions, 249 deletions
diff --git a/src/scm/webid-oidc/identity-provider.scm b/src/scm/webid-oidc/identity-provider.scm index 8df4386..6f96b44 100644 --- a/src/scm/webid-oidc/identity-provider.scm +++ b/src/scm/webid-oidc/identity-provider.scm @@ -122,246 +122,3 @@ (body (h1 "Resource not found") (p "This OpenID Connect identity provider does not know the resource you are requesting.")))))))))))))))) - -(define-public (main) - (define* (http-get-with-log uri #:key (headers '())) - (define date (date->string (time-utc->date (current-time)))) - (define uri-string (if (uri? uri) (uri->string uri) uri)) - (format (current-error-port) "~a: GET ~a ~s...\n" - date uri-string headers) - (receive (response response-body) (http-get uri #:headers headers) - (if response-body - (format (current-error-port) "~a: GET ~a ~s: ~s ~a bytes\n" - date uri-string headers response - (if (bytevector? response-body) - (bytevector-length response-body) - (string-length response-body))) - (format (current-error-port) "~a: GET ~a ~s: ~s\n" - date uri-string headers response)) - (values response response-body))) - (define cache-http-get - (with-cache #:http-get http-get-with-log)) - (setlocale LC_ALL "") - (bindtextdomain cfg:package cfg:localedir) - (textdomain cfg:package) - (let ((version-sym - (string->symbol (G_ "command-line|version"))) - (help-sym - (string->symbol (G_ "comand-line|help"))) - (issuer-sym - (string->symbol (G_ "comand-line|issuer"))) - (key-file-sym - (string->symbol (G_ "comand-line|key-file"))) - (subject-sym - (string->symbol (G_ "comand-line|subject"))) - (password-sym - (string->symbol (G_ "comand-line|password"))) - (jwks-uri-sym - (string->symbol (G_ "comand-line|jwks-uri"))) - (authorization-endpoint-uri-sym - (string->symbol (G_ "comand-line|authorization-endpoint-uri"))) - (token-endpoint-uri-sym - (string->symbol (G_ "comand-line|token-endpoint-uri"))) - (port-sym - (string->symbol (G_ "comand-line|port"))) - (log-file-sym - (string->symbol (G_ "comand-line|log-file"))) - (error-file-sym - (string->symbol (G_ "comand-line|error-file")))) - (let ((options - (let ((option-spec - `((,version-sym (single-char #\v) (value #f)) - (,help-sym (single-char #\h) (value #f)) - (,issuer-sym (single-char #\i) (value #t)) - (,key-file-sym (single-char #\k) (value #t)) - (,subject-sym (single-char #\s) (value #t)) - (,password-sym (single-char #\w) (value #t)) - (,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)) - (,port-sym (single-char #\p) (value #t)) - (,log-file-sym (single-char #\l) (value #t)) - (,error-file-sym (single-char #\e) (value #t))))) - (getopt-long (command-line) option-spec)))) - (cond - ((option-ref options help-sym #f) - (format #t (G_ "Usage: ~a [OPTIONS]... - -Run the Solid identity provider for a specific user. - -Options: - -h, --~a: - display this help message and exit. - -v, --~a: - display the version information (~a) and exit. - -i URI, --~a=URI: - set the public server host name. - -k FILE, --~a=FILE.jwk: - set the file name of the key file. If it does not exist, a new - key is generated. - -s WEBID, --~a=WEBID: - set the identity of the subject. - -w PASSWORD, --~a=PASSWORD: - set the password to recognize the user. - -j URI, --~a=URI: - set the URI to query the key of the server. - -a URI, --~a=URI: - set the authorization endpoint of the issuer. - -t URI, --~a=URI: - set the token endpoint of the issuer. - -p PORT, --~a=PORT: - set the port to bind (instead of 8080). - -l FILE.log, --~a=FILE.log: - dump the standard output to that file. - -e FILE.err, --~a=FILE.err: - dump the standard error to that file. - -Environment variables: - - LANG: set the locale of the sysadmin-facing interface (the user -pages are translated according to the user agent’s Accept-language -header), for log files and command-line interface. It is currently ~a. - - XDG_DATA_HOME: where to store the refresh tokens (under the -webid-oidc directory). For a system service, it is recommended to set -it to /var/lib. Currently set to ~a. - - XDG_CACHE_HOME: where to store and update the seed file for the -random number generator. If you remove it, you need to restart the -program to use a different seed. Currently set to ~a. - - HOME: if XDG_DATA_HOME or XDG_CACHE_HOME is not set, they are -computed from the value of the HOME environment variable. It is not -used otherwise. Currently set to ~a. - -Example used in webid-oidc-demo.planete-kraus.eu (except it’s managed -by shepherd in reality): - - export LANG=C - export XDG_DATA_HOME=/var/lib - export XDG_CACHE_HOME=/var/cache - webid-oidc-issuer \\ - --issuer https://webid-oidc-demo.planete-kraus.eu \\ - --key-file /var/lib/webid-oidc/issuer/key.jwk \\ - --subject https://webid-oidc-demo.planete-kraus.eu/profile/card#me \\ - --password \"$PASSWORD\" \\ - --jwks-uri https://webid-oidc-demo.planete-kraus.eu/keys \\ - --authorization-endpoint-uri https://webid-oidc-demo.planete-kraus.eu/authorize \\ - --token-endpoint-uri https://webid-oidc-demo.planete-kraus.eu/token \\ - --port $PORT - -If you find a bug, send a report to ~a. -") - (car (command-line)) - help-sym version-sym - cfg:version - issuer-sym key-file-sym subject-sym password-sym - jwks-uri-sym authorization-endpoint-uri-sym - token-endpoint-uri-sym port-sym log-file-sym error-file-sym - (or (getenv "LANG") "") - (or (getenv "XDG_DATA_HOME") "") - (or (getenv "XDG_CACHE_HOME") "") - (or (getenv "HOME") "") - cfg:package-bugreport)) - ((option-ref options version-sym #f) - (format #t (G_ "~a version ~a\n") - cfg:package cfg:version)) - (else - (let ((issuer (option-ref options issuer-sym #f)) - (key-file (option-ref options key-file-sym #f)) - (subject (option-ref options subject-sym #f)) - (password (option-ref options password-sym #f)) - (jwks-uri (option-ref options jwks-uri-sym #f)) - (authorization-endpoint-uri - (option-ref options authorization-endpoint-uri-sym #f)) - (token-endpoint-uri - (option-ref options token-endpoint-uri-sym #f)) - (port-string - (option-ref options port-sym "8080")) - (log-file-string - (option-ref options log-file-sym #f)) - (error-file-string - (option-ref options error-file-sym #f)) - (jti-list (make-jti-list))) - (when log-file-string - (set-current-output-port (stubs:open-output-file* log-file-string)) - (setvbuf (current-output-port) 'none)) - (when error-file-string - (set-current-error-port (stubs:open-output-file* error-file-string)) - (setvbuf (current-error-port) 'none)) - (unless (and issuer (string->uri issuer)) - (format (current-error-port) - (G_ "You need to set the issuer.\n")) - (exit 1)) - (unless key-file - (format (current-error-port) - (G_ "You need to set the file name of the key file.\n")) - (exit 1)) - (unless (and subject (string->uri subject)) - (format (current-error-port) - (G_ "You need to set the identity of the subject.\n")) - (exit 1)) - (unless password - (format (current-error-port) - (G_ "You need to set the password to verify the identity of the subject.\n")) - (exit 1)) - (unless (and jwks-uri (string->uri jwks-uri)) - (format (current-error-port) - (G_ "You need to set the JWKS URI.\n")) - (exit 1)) - (unless (and authorization-endpoint-uri - (string->uri authorization-endpoint-uri)) - (format (current-error-port) - (G_ "You need to set the authorization endpoint URI.\n")) - (exit 1)) - (unless (and token-endpoint-uri - (string->uri token-endpoint-uri)) - (format (current-error-port) - (G_ "You need to set the token endpoint URI.\n")) - (exit 1)) - (unless (and (string->number port-string) - (integer? (string->number port-string)) - (>= (string->number port-string) 0) - (<= (string->number port-string) 65535)) - (format (current-error-port) - (G_ "The port should be a number between 0 and 65535.\n")) - (exit 1)) - (let ((handler - (make-identity-provider - (string->uri issuer) - key-file - (string->uri subject) - password - (string->uri jwks-uri) - (string->uri authorization-endpoint-uri) - (string->uri token-endpoint-uri) - 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)))) - (install-suspendable-ports!) - (run-server handler-with-log 'http (list #:port (string->number port-string))))))))))) diff --git a/src/scm/webid-oidc/program.scm b/src/scm/webid-oidc/program.scm index b8878b0..3582eaa 100644 --- a/src/scm/webid-oidc/program.scm +++ b/src/scm/webid-oidc/program.scm @@ -1,6 +1,8 @@ (define-module (webid-oidc program) #:use-module (webid-oidc errors) #:use-module (webid-oidc reverse-proxy) + #:use-module (webid-oidc identity-provider) + #:use-module (webid-oidc jti) #:use-module ((webid-oidc stubs) #:prefix stubs:) #:use-module ((webid-oidc config) #:prefix cfg:) #:use-module (ice-9 optargs) @@ -58,16 +60,34 @@ (string->symbol (G_ "command-line|server|reverse-proxy|backend-uri"))) (header-sym (string->symbol (G_ "command-line|server|reverse-proxy|header"))) + (key-file-sym + (string->symbol (G_ "command-line|server|issuer|key-file"))) + (subject-sym + (string->symbol (G_ "command-line|server|issuer|subject"))) + (password-sym + (string->symbol (G_ "command-line|server|issuer|password"))) + (jwks-uri-sym + (string->symbol (G_ "command-line|server|issuer|jwks-uri"))) + (authorization-endpoint-uri-sym + (string->symbol (G_ "command-line|server|issuer|authorization-endpoint-uri"))) + (token-endpoint-uri-sym + (string->symbol (G_ "command-line|server|issuer|token-endpoint-uri"))) (log-file-sym - (string->symbol (G_ "comand-line|log-file"))) + (string->symbol (G_ "command-line|log-file"))) (error-file-sym - (string->symbol (G_ "comand-line|error-file")))) + (string->symbol (G_ "command-line|error-file")))) (let ((options (let ((spec `((,version-sym (single-char #\v) (value #f)) (,help-sym (single-char #\h) (value #f)) (,log-file-sym (single-char #\l) (value #t)) (,error-file-sym (single-char #\e) (value #t)) + (,key-file-sym (single-char #\k) (value #t)) + (,subject-sym (single-char #\s) (value #t)) + (,password-sym (single-char #\w) (value #t)) + (,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)) (,port-sym (single-char #\p) (value #t)) (,server-name-sym (single-char #\n) (value #t)) (,header-sym (single-char #\H) (value #t)) @@ -80,8 +100,10 @@ Run the webid-oidc COMMAND. Available commands: - ~a: + ~a: run an authenticating reverse proxy. + ~a: + run an identity provider. General options: -h, --~a: @@ -107,11 +129,38 @@ Options for the reverse proxy: set the backend URI for the reverse proxy, only for the reverse-proxy command. +Options for the identity provider: + -k FILE, --~a=FILE.jwk: + set the file name of the key file. If it does not exist, a new + key is generated. + -s WEBID, --~a=WEBID: + set the identity of the subject. + -w PASSWORD, --~a=PASSWORD: + set the password to recognize the user. + -j URI, --~a=URI: + set the URI to query the key of the server. + -a URI, --~a=URI: + set the authorization endpoint of the issuer. + -t URI, --~a=URI: + set the token endpoint of the issuer. + Environment variables: LANG: set the locale of the user interface (for the server commands, the user is the system administrator).~a + XDG_DATA_HOME: where the program stores persistent data. The +identity provider stores the refresh tokens. For a system service, it +is recommended to set it to /var/lib.~a + + XDG_CACHE_HOME: where the program stores and updates the seed file, +and the web client cache. You can remove this directory at any +time. The seed file will be initialized from /dev/random.~a + + HOME: if XDG_DATA_HOME or XDG_CACHE_HOME is not set, they are +computed from the value of the HOME environment variable. It is not +used otherwise.~a + Running a reverse proxy Suppose that you operate data.provider.com. You want to run an @@ -131,12 +180,30 @@ from this reverse proxy. --~a '/var/log/proxy.log' \\ --~a '/var/log/proxy.err' +Running an identity provider + +The identity provider running at webid-oidc-demo.planete-kraus.eu is +invoked with the following options: + + export XDG_DATA_HOME=/var/lib + export XDG_CACHE_HOME=/var/cache + ~a ~a \\ + --~a 'https://webid-oidc-demo.planete-kraus.eu' \\ + --~a '/var/lib/webid-oidc/issuer/key.jwk' \\ + --~a 'https://webid-oidc-demo.planete-kraus.eu/profile/card#me' \\ + --~a \"$PASSWORD\" \\ + --~a 'https://webid-oidc-demo.planete-kraus.eu/keys' \\ + --~a 'https://webid-oidc-demo.planete-kraus.eu/authorize' \\ + --~a 'https://webid-oidc-demo.planete-kraus.eu/token' \\ + --~a $PORT + If you find a bug, then please send a report to ~a. ") ;; Usage: (car (command-line)) ;; Available commands: (G_ "command-line|command|reverse-proxy") + (G_ "command-line|command|identity-provider") ;; General options ;; help help-sym @@ -157,12 +224,30 @@ If you find a bug, then please send a report to ~a. header-sym ;; backend-uri backend-uri-sym + ;; Options for the identity provider + key-file-sym + subject-sym + password-sym + jwks-uri-sym + authorization-endpoint-uri-sym + token-endpoint-uri-sym ;; Environment variables - ;; LANG (if (getenv "LANG") (format #f (G_ "an environment variable| It is currently set to ~s.") (getenv "LANG")) (G_ "an environment variable| It is currently unset.")) + (if (getenv "XDG_DATA_HOME") + (format #f (G_ "an environment variable| It is currently set to ~s.") + (getenv "XDG_DATA_HOME")) + (G_ "an environment variable| It is currently unset.")) + (if (getenv "XDG_CACHE_HOME") + (format #f (G_ "an environment variable| It is currently set to ~s.") + (getenv "XDG_CACHE_HOME")) + (G_ "an environment variable| It is currently unset.")) + (if (getenv "HOME") + (format #f (G_ "an environment variable| It is currently set to ~s.") + (getenv "HOME")) + (G_ "an environment variable| It is currently unset.")) ;; Running a reverse proxy ;; Program name (car (command-line)) @@ -171,6 +256,12 @@ If you find a bug, then please send a report to ~a. ;; options port-sym server-name-sym backend-uri-sym header-sym log-file-sym error-file-sym + ;; Running an identity provider + (car (command-line)) + (G_ "command-line|command|identity-provider") + server-name-sym key-file-sym subject-sym password-sym + jwks-uri-sym authorization-endpoint-uri-sym + token-endpoint-uri-sym port-sym ;; Bug report cfg:package-bugreport)) ((option-ref options version-sym #f) @@ -214,7 +305,21 @@ If you find a bug, then please send a report to ~a. (header (let ((str (option-ref options header-sym #f))) (and str - (string->symbol str))))) + (string->symbol str)))) + (key-file (option-ref options key-file-sym #f)) + (subject + (let ((str (option-ref options subject-sym #f))) + (and str (string->uri str)))) + (password (option-ref options password-sym #f)) + (jwks-uri + (let ((str (option-ref options jwks-uri-sym #f))) + (and str (string->uri str)))) + (authorization-endpoint-uri + (let ((str (option-ref options authorization-endpoint-uri-sym #f))) + (and str (string->uri str)))) + (token-endpoint-uri + (let ((str (option-ref options token-endpoint-uri-sym #f))) + (and str (string->uri str))))) (when (null? rest) (format (current-error-port) (G_ "Usage: ~a COMMAND [OPTIONS]...\nSee --~a (-h).\n") @@ -251,7 +356,73 @@ If you find a bug, then please send a report to ~a. #:auth-header header) 'http (list #:port port)))) - (else + ((equal? command (G_ "command-line|command|identity-provider")) + (begin + (unless server-name + (format (current-error-port) (G_ "You must pass --~a to set the server name.\n") + server-name-sym) + (exit 1)) + (unless key-file + (format (current-error-port) (G_ "You must pass --~a to set the file where to store the identity provider key.\n") + key-file-sym) + (exit 1)) + (unless subject + (format (current-error-port) (G_ "You must pass --~a to set the subject of the identity provider.\n") + subject-sym) + (exit 1)) + (unless password + (format (current-error-port) (G_ "You must pass --~a to set the subject’s password.\n") + password-sym) + (exit 1)) + (unless jwks-uri + (format (current-error-port) (G_ "You must pass --~a to set the JWKS URI.\n") + jwks-uri-sym) + (exit 1)) + (unless authorization-endpoint-uri + (format (current-error-port) (G_ "You must pass --~a to set the authorization endpoint URI.\n") + authorization-endpoint-uri-sym) + (exit 1)) + (unless token-endpoint-uri + (format (current-error-port) (G_ "You must pass --~a to set the token endpoint URI.\n") + token-endpoint-uri-sym) + (exit 1)) + (let ((handler + (make-identity-provider + server-name key-file subject password jwks-uri + authorization-endpoint-uri token-endpoint-uri + (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)))))) + (else (format (current-error-port) (G_ "Unknown command ~s\n") command) (exit 1)))))))))) |