diff options
Diffstat (limited to 'src/scm/webid-oidc')
-rw-r--r-- | src/scm/webid-oidc/Makefile.am | 2 | ||||
-rw-r--r-- | src/scm/webid-oidc/program.scm | 257 | ||||
-rw-r--r-- | src/scm/webid-oidc/reverse-proxy.scm | 163 |
3 files changed, 259 insertions, 163 deletions
diff --git a/src/scm/webid-oidc/Makefile.am b/src/scm/webid-oidc/Makefile.am index 732fd3d..d96b63a 100644 --- a/src/scm/webid-oidc/Makefile.am +++ b/src/scm/webid-oidc/Makefile.am @@ -22,6 +22,7 @@ dist_webidoidcmod_DATA += \ %reldir%/provider-confirmation.scm \ %reldir%/resource-server.scm \ %reldir%/hello-world.scm \ + %reldir%/program.scm \ %reldir%/reverse-proxy.scm \ %reldir%/client.scm \ %reldir%/example-app.scm \ @@ -52,6 +53,7 @@ webidoidcgo_DATA += \ %reldir%/provider-confirmation.go \ %reldir%/resource-server.go \ %reldir%/hello-world.go \ + %reldir%/program.go \ %reldir%/reverse-proxy.go \ %reldir%/client.go \ %reldir%/example-app.go \ diff --git a/src/scm/webid-oidc/program.scm b/src/scm/webid-oidc/program.scm new file mode 100644 index 0000000..b8878b0 --- /dev/null +++ b/src/scm/webid-oidc/program.scm @@ -0,0 +1,257 @@ +(define-module (webid-oidc program) + #:use-module (webid-oidc errors) + #:use-module (webid-oidc reverse-proxy) + #:use-module ((webid-oidc stubs) #:prefix stubs:) + #:use-module ((webid-oidc config) #:prefix cfg:) + #:use-module (ice-9 optargs) + #:use-module (ice-9 receive) + #:use-module (ice-9 i18n) + #:use-module (ice-9 getopt-long) + #:use-module (ice-9 suspendable-ports) + #:use-module (srfi srfi-19) + #:use-module (rnrs bytevectors) + #:use-module (web uri) + #:use-module (web request) + #:use-module (web response) + #:use-module (web client) + #:use-module (webid-oidc cache) + #:use-module (web server)) + +(define (G_ text) + (let ((out (gettext text))) + (if (string=? out text) + ;; No translation, disambiguate + (car (reverse (string-split text #\|))) + out))) + +(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) + (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))) + (values response response-body))) + +(define cache-http-get + (with-cache #:http-get http-get-with-log)) + +(define-public (main) + (setvbuf (current-output-port) 'none) + (setvbuf (current-error-port) 'none) + (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_ "command-line|help"))) + (port-sym + (string->symbol (G_ "command-line|server|port"))) + (server-name-sym + (string->symbol (G_ "command-line|server|server-name"))) + (backend-uri-sym + (string->symbol (G_ "command-line|server|reverse-proxy|backend-uri"))) + (header-sym + (string->symbol (G_ "command-line|server|reverse-proxy|header"))) + (log-file-sym + (string->symbol (G_ "comand-line|log-file"))) + (error-file-sym + (string->symbol (G_ "comand-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)) + (,port-sym (single-char #\p) (value #t)) + (,server-name-sym (single-char #\n) (value #t)) + (,header-sym (single-char #\H) (value #t)) + (,backend-uri-sym (single-char #\b) (value #t))))) + (getopt-long (command-line) spec)))) + (cond + ((option-ref options help-sym #f) + (format #t (G_ "Usage: ~a COMMAND [OPTIONS]... + +Run the webid-oidc COMMAND. + +Available commands: + ~a: + run an authenticating reverse proxy. + +General options: + -h, --~a: + display a short help message and exit. + -v, --~a: + display the version information (~a) and exit. + -l FILE.log, --~a=FILE.log: + redirect the program standard output to FILE.log. + -e FILE.err, --~a=FILE.err: + redirect the program errors to FILE.err. + +General server-side options: + -p PORT, --~a=PORT: + set the server port to bind, 8080 by default. + -n URI, --~a=URI: + set the public server URI (scheme, userinfo, host, and port). + +Options for the reverse proxy: + -H HEADER, --~a=HEADER: + the HEADER field contains the webid of the authenticated user, + XXX-Agent by default. + -b URI, --~a=URI: + set the backend URI for the reverse proxy, only for the + reverse-proxy command. + +Environment variables: + + LANG: set the locale of the user interface (for the server commands, +the user is the system administrator).~a + +Running a reverse proxy + +Suppose that you operate data.provider.com. You want to run an +authenticating reverse proxy, that will receive incoming requests +through http://localhost:8080, and forward them to +https://private.data.provider.com. The backend will look for the +XXX-Agent header, and if it is found, then its value will be +considered the webid of the authenticated +user. https://private.data.provider.com should only accept requests +from this reverse proxy. + + ~a ~a \\ + --~a 8080 \\ + --~a 'https://data.provider.com' \\ + --~a 'https://private.data.provider.com' \\ + --~a 'XXX-Agent' \\ + --~a '/var/log/proxy.log' \\ + --~a '/var/log/proxy.err' + +If you find a bug, then please send a report to ~a. +") + ;; Usage: + (car (command-line)) + ;; Available commands: + (G_ "command-line|command|reverse-proxy") + ;; General options + ;; help + help-sym + ;; version + version-sym + cfg:version + ;; log-file + log-file-sym + ;; error-file + error-file-sym + ;; General server-side options + ;; port + port-sym + ;; server-name + server-name-sym + ;; Options for the reverse proxy + ;; header + header-sym + ;; backend-uri + backend-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.")) + ;; Running a reverse proxy + ;; Program name + (car (command-line)) + ;; command + (G_ "command-line|command|reverse-proxy") + ;; options + port-sym server-name-sym backend-uri-sym header-sym + log-file-sym error-file-sym + ;; Bug report + cfg:package-bugreport)) + ((option-ref options version-sym #f) + (format #t (G_ "~a version ~a\n") + cfg:package cfg:version)) + (else + (let ((rest (option-ref options '() '())) + (port + (let ((port (string->number (option-ref options port-sym "8080")))) + (unless port + (format (current-error-port) + (G_ "The --~a argument must be a number, not ~s.\n") + port-sym + (option-ref options port-sym "8080")) + (exit 1)) + (unless (integer? port) + (format (current-error-port) + (G_ "The --~a argument must be an integer, not ~s.\n") + port-sym + port) + (exit 1)) + (unless (> port 0) + (format (current-error-port) + (G_ "The --~a argument must be positive, ~s is invalid.\n") + port-sym port) + (exit 1)) + (unless (<= port 65535) + (format (current-error-port) + (G_ "The --~a argument must be less than 65536, ~s is invalid.\n") + port-sym port) + (exit 1)) + port)) + (server-name + (let ((str (option-ref options server-name-sym #f))) + (and str + (string->uri str)))) + (backend-uri + (let ((str (option-ref options backend-uri-sym #f))) + (and str + (string->uri str)))) + (header + (let ((str (option-ref options header-sym #f))) + (and str + (string->symbol str))))) + (when (null? rest) + (format (current-error-port) + (G_ "Usage: ~a COMMAND [OPTIONS]...\nSee --~a (-h).\n") + (car (command-line)) + help-sym) + (exit 1)) + (install-suspendable-ports!) + (when (option-ref options log-file-sym #f) + (set-current-output-port + (stubs:open-output-file* (option-ref options log-file-sym #f))) + (setvbuf (current-output-port) 'none)) + (when (option-ref options error-file-sym #f) + (set-current-error-port + (stubs:open-output-file* (option-ref options error-file-sym #f))) + (setvbuf (current-error-port) 'none)) + (let ((command (car rest)) + (non-options (cdr rest))) + (cond + ((equal? command (G_ "command-line|command|reverse-proxy")) + (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 backend-uri + (format (current-error-port) (G_ "You must pass --~a to set the backend URI.\n") + backend-uri-sym) + (exit 1)) + (run-server + (make-reverse-proxy + #:server-uri server-name + #:http-get cache-http-get + #:endpoint backend-uri + #:auth-header header) + 'http + (list #:port port)))) + (else + (format (current-error-port) (G_ "Unknown command ~s\n") + command) + (exit 1)))))))))) diff --git a/src/scm/webid-oidc/reverse-proxy.scm b/src/scm/webid-oidc/reverse-proxy.scm index 87588b9..cc4d46a 100644 --- a/src/scm/webid-oidc/reverse-proxy.scm +++ b/src/scm/webid-oidc/reverse-proxy.scm @@ -18,13 +18,6 @@ #:use-module (webid-oidc cache) #:use-module (web server)) -(define (G_ text) - (let ((out (gettext text))) - (if (string=? out text) - ;; No translation, disambiguate - (car (reverse (string-split text #\|))) - out))) - (define*-public (make-reverse-proxy #:key (jti-list #f) @@ -99,159 +92,3 @@ (response-headers response))))) (close-port port) (values adapted-response response-body)))))))))))) - -(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) - (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))) - (values response response-body))) - (define cache-http-get - (with-cache #:http-get http-get-with-log)) - (setvbuf (current-output-port) 'none) - (setvbuf (current-error-port) 'none) - (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_ "command-line|help"))) - (port-sym - (string->symbol (G_ "command-line|port"))) - (inbound-uri-sym - (string->symbol (G_ "command-line|inbound-uri"))) - (outbound-uri-sym - (string->symbol (G_ "command-line|outbound-uri"))) - (header-sym - (string->symbol (G_ "command-line|header"))) - (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)) - (,port-sym (single-char #\p) (value #t)) - (,inbound-uri-sym (single-char #\i) (value #t)) - (,outbound-uri-sym (single-char #\o) (value #t)) - (,header-sym (single-char #\H) (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 a reverse proxy, taking requests with webid-oidc authentication -and passing them to the outbound URI with an additional header -containing the webid of the agent. - -Options: - -h, --~a: - display this help message and exit. - -v, --~a: - display the version information (~a) and exit. - -p PORT, --~a=8080: - set the port to bind. - -i URI, --~a=URI: - set the public URI of the reverse proxy. - -o URI, --~a=URI: - pass the requests to the server running at URI. - -H HEADER, --~a=HEADER: - pass request with optional HEADER set to the webid, XXX-Agent by default. - -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. It is -currently ~a. - -Example: - -Suppose that you operate data.provider.com. Since everything is behind -a big global reverse proxy, the authenticated proxy listens on -http://localhost:8080. You have the data server running at -https://private.data.provider.com, set up so that only you can query -it. The private server needs the XXX-Agent header to contain the -authenticated webid of the user, if the user is authenticated. That’s -why you don’t want anyone to query it. You would run: - - export LANG=C - webid-oidc-reverse-proxy \\ - --port 8080 \\ - --inbound-uri https://data.provider.com \\ - --outbound-uri https://private.data.provider.com \\ - --header XXX-Agent \\ - --log-file /var/log/proxy.log \\ - --error-file /var/log/proxy.err - -If you find a bug, send a report to ~a. -") - (car (command-line)) - help-sym version-sym - cfg:version - port-sym inbound-uri-sym outbound-uri-sym header-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 ((port-string - (option-ref options port-sym "8080")) - (inbound-uri-string - (option-ref options inbound-uri-sym #f)) - (outbound-uri-string - (option-ref options outbound-uri-sym #f)) - (header-string - (option-ref options header-sym "XXX-Agent")) - (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 port-string - (string? port-string) - (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)) - (unless (and inbound-uri-string - (string->uri inbound-uri-string)) - (format (current-error-port) - (G_ "The public name of the server must be present (with scheme) as --inbound-uri.\n")) - (exit 1)) - (unless (and outbound-uri-string - (string->uri outbound-uri-string)) - (format (current-error-port) - (G_ "The address of the proxy must be present (with scheme) as --outbound-uri.\n")) - (exit 1)) - (install-suspendable-ports!) - (run-server (make-reverse-proxy - #:server-uri (string->uri inbound-uri-string) - #:http-get cache-http-get - #:endpoint (string->uri outbound-uri-string) - #:auth-header (string->symbol header-string)) - 'http - (list #:port (string->number port-string))))))))) |