diff options
Diffstat (limited to 'src/scm/webid-oidc/client.scm')
| -rw-r--r-- | src/scm/webid-oidc/client.scm | 154 |
1 files changed, 0 insertions, 154 deletions
diff --git a/src/scm/webid-oidc/client.scm b/src/scm/webid-oidc/client.scm index 6fe9cc2..d8f438b 100644 --- a/src/scm/webid-oidc/client.scm +++ b/src/scm/webid-oidc/client.scm @@ -604,158 +604,4 @@ (body (p "This page does not exist on the server.")))))))))))))) -(define (G_ text) - (let ((out (gettext text))) - (if (string=? out text) - ;; No translation, disambiguate - (car (reverse (string-split text #\|))) - out))) -(define-public (main-server) - (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"))) - (client-id-sym - (string->symbol (G_ "comand-line|client-id"))) - (redirect-uri-sym - (string->symbol (G_ "comand-line|redirect-uri"))) - (client-name-sym - (string->symbol (G_ "comand-line|client-name"))) - (client-uri-sym - (string->symbol (G_ "comand-line|client-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)) - (,client-id-sym (single-char #\i) (value #t)) - (,redirect-uri-sym (single-char #\r) (value #t)) - (,client-name-sym (single-char #\n) (value #t)) - (,client-uri-sym (single-char #\u) (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]... - -Serve public pages for an application. - -Options: - -h, --~a: - display this help message and exit. - -v, --~a: - display the version information (~a) and exit. - -i URI, --~a=URI: - set the webid of the client. - -r FILE, --~a=URI: - set the redirection URI where to get the authorization code. - -n NAME, --~a=NAME: - set the name of the application. - -u URI, --~a=URI: - set the address of the application (informative). - -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, for log files -and command-line interface. It is currently ~a. - -Example used in webid-oidc-demo.planete-kraus.eu (except it’s managed -by shepherd in reality): - - export LANG=C - webid-oidc-client-service \\ - --client-id 'https://webid-oidc-demo.planete-kraus.eu/example-application#id' \\ - --redirect-uri 'https://webid-oidc-demo.planete-kraus.eu/authorized' \\ - --client-name 'Example Solid Application' \\ - --client-uri 'https://webid-oidc.planete-kraus.eu/Running-a-client.html#Running-a-client' \\ - --port $PORT - -If you find a bug, send a report to ~a. -") - (car (command-line)) - help-sym version-sym - cfg:version - client-id-sym redirect-uri-sym client-name-sym client-uri-sym port-sym - log-file-sym error-file-sym - (or (getenv "LANG") "") - cfg:package-bugreport)) - ((option-ref options version-sym #f) - (format #t (G_ "~a version ~a\n") - cfg:package cfg:version)) - (else - (let ((client-id (option-ref options client-id-sym #f)) - (redirect-uri (option-ref options redirect-uri-sym #f)) - (client-name (option-ref options client-name-sym "Example Solid App")) - (client-uri - (option-ref options client-uri-sym - "https://webid-oidc.planete-kraus.eu/Running-a-client.html#Running-a-client")) - (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))) - (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 client-id (string->uri client-id)) - (format (current-error-port) - (G_ "You need to set the client ID as an URI.\n")) - (exit 1)) - (unless (and redirect-uri (string->uri redirect-uri)) - (format (current-error-port) - (G_ "You need to set the redirect URI.\n")) - (exit 2)) - (unless (string->uri client-uri) - (format (current-error-port) - (G_ "The client URI should be an URI.\n")) - (exit 3)) - (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 - (serve-application client-id redirect-uri - #:client-name client-name - #:client-uri client-uri))) - (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 () - (handler request request-body)) - #:unwind? #t)))) - (install-suspendable-ports!) - (run-server handler 'http - (list #:port (string->number port-string))))))))))) |