Make a unique program with all commands

5 files changed, 261 insertions, 165 deletions

diff --git a/src/Makefile.am b/src/Makefile.am
index b61df70..1876a55 100644
--- a/src/Makefile.am
+++ b/src/Makefile.am
@@ -1,6 +1,6 @@
 lib_LTLIBRARIES += %reldir%/libwebidoidc.la
 
-dist_bin_SCRIPTS += %reldir%/webid-oidc-issuer %reldir%/webid-oidc-reverse-proxy %reldir%/webid-oidc-hello %reldir%/webid-oidc-client-service %reldir%/webid-oidc-example-app
+dist_bin_SCRIPTS += %reldir%/webid-oidc-issuer %reldir%/webid-oidc %reldir%/webid-oidc-hello %reldir%/webid-oidc-client-service %reldir%/webid-oidc-example-app
 
 AM_CPPFLAGS += -I %reldir% -I $(srcdir)/%reldir%
 
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)))))))))
diff --git a/src/webid-oidc-reverse-proxy b/src/webid-oidc
index 5b7855e..67affe4 100755
--- a/src/webid-oidc-reverse-proxy
+++ b/src/webid-oidc
@@ -2,6 +2,6 @@
 --no-auto-compile -s
 !#
 
-(use-modules (webid-oidc reverse-proxy))
+(use-modules (webid-oidc program))
 
 (main)