summaryrefslogtreecommitdiff
path: root/src/scm/webid-oidc/identity-provider.scm
diff options
context:
space:
mode:
Diffstat (limited to 'src/scm/webid-oidc/identity-provider.scm')
-rw-r--r--src/scm/webid-oidc/identity-provider.scm243
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)))))))))))
generated by cgit v1.2.3 (git 2.44.0) at 2024-06-03 05:21:30 +0000