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