diff options
Diffstat (limited to 'src/scm/webid-oidc/identity-provider.scm')
-rw-r--r-- | src/scm/webid-oidc/identity-provider.scm | 243 |
1 files changed, 0 insertions, 243 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))))))))))) |