Add a full server.

1 files changed, 84 insertions, 8 deletions

diff --git a/src/scm/webid-oidc/program.scm b/src/scm/webid-oidc/program.scm
index c53be5d..2ab1cbe 100644
--- a/src/scm/webid-oidc/program.scm
+++ b/src/scm/webid-oidc/program.scm
@@ -3,6 +3,8 @@
   #:use-module (webid-oidc reverse-proxy)
   #:use-module (webid-oidc identity-provider)
   #:use-module (webid-oidc client)
+  #:use-module (webid-oidc resource-server)
+  #:use-module (webid-oidc server create)
   #:use-module (webid-oidc jti)
   #:use-module ((webid-oidc stubs) #:prefix stubs:)
   #:use-module ((webid-oidc config) #:prefix cfg:)
@@ -145,6 +147,9 @@ Available commands:
     run an identity provider.
   ~a:
     serve the pages for a public application.
+  ~a:
+    run a full server, with identity provider and resource storage
+    facility.
 
 General options:
   -h, --~a:
@@ -162,10 +167,11 @@ General server-side options:
   -n URI, --~a=URI:
     set the public server URI (scheme, userinfo, host, and port).
 
-Options for the reverse proxy:
+Options for the resource server:
   -H HEADER, --~a=HEADER:
     the HEADER field contains the webid of the authenticated user,
-    XXX-Agent by default.
+    XXX-Agent by default. For the full server, disable webid-oidc
+    authentication.
   -b URI, --~a=URI:
     set the backend URI for the reverse proxy, only for the
     reverse-proxy command.
@@ -204,8 +210,9 @@ Environment variables:
 the user is the system administrator).~a
 
   XDG_DATA_HOME: where the program stores persistent data. The
-identity provider stores the refresh tokens. For a system service, it
-is recommended to set it to /var/lib.~a
+identity provider stores the refresh tokens. The full server stores
+the resources there. For a system service, it is recommended to set it
+to /var/lib.~a
 
   XDG_CACHE_HOME: where the program stores and updates the seed file,
 and the web client cache. You can remove this directory at any
@@ -270,6 +277,7 @@ If you find a bug, then please send a report to ~a.
                 (G_ "command-line|command|reverse-proxy")
                 (G_ "command-line|command|identity-provider")
                 (G_ "command-line|command|client-service")
+                (G_ "command-line|command|server")
                 ;; General options
                 ;; help
                 help-sym
@@ -509,7 +517,75 @@ If you find a bug, then please send a report to ~a.
                    (handler-with-log handler)
                    'http
                    (list #:port port)))))
-              (else
-               (format (current-error-port) (G_ "Unknown command ~s\n")
-                       command)
-               (exit 1))))))))))
+             ((equal? command (G_ "command-line|command|server"))
+              (unless server-name
+                (format (current-error-port) (G_ "You must pass --~a to set the server name.\n")
+                        server-name-sym)
+                (exit 1))
+              (unless key-file
+                (format (current-error-port) (G_ "You must pass --~a to set the file where to store the identity provider key.\n")
+                        key-file-sym)
+                (exit 1))
+              (unless subject
+                (format (current-error-port) (G_ "You must pass --~a to set the subject of the identity provider.\n")
+                        subject-sym)
+                (exit 1))
+              (unless password
+                (format (current-error-port) (G_ "You must pass --~a to set the subject’s password.\n")
+                        password-sym)
+                (exit 1))
+              (unless jwks-uri
+                (format (current-error-port) (G_ "You must pass --~a to set the JWKS URI.\n")
+                        jwks-uri-sym)
+                (exit 1))
+              (unless authorization-endpoint-uri
+                (format (current-error-port) (G_ "You must pass --~a to set the authorization endpoint URI.\n")
+                        authorization-endpoint-uri-sym)
+                (exit 1))
+              (unless token-endpoint-uri
+                (format (current-error-port) (G_ "You must pass --~a to set the token endpoint URI.\n")
+                        token-endpoint-uri-sym)
+                (exit 1))
+              (let ((jti-list (make-jti-list)))
+                (let ((resource-handler
+                       (make-resource-server
+                        #:server-uri server-name
+                        #:owner subject
+                        #:authenticator
+                        (if header
+                            (begin
+                              (set! header
+                                    (string->symbol
+                                     (string-downcase
+                                      (symbol->string header))))
+                              (lambda (request request-body)
+                                (let ((value (assq-ref (request-headers request) header)))
+                                  (and value (string->uri value)))))
+                            (make-authenticator
+                             jti-list
+                             #:server-uri server-name
+                             #:http-get cache-http-get))
+                        #:http-get cache-http-get))
+                      (identity-provider-handler
+                       (make-identity-provider
+                        server-name key-file subject password jwks-uri
+                        authorization-endpoint-uri token-endpoint-uri
+                        jti-list
+                        #:current-time current-time
+                        #:http-get cache-http-get)))
+                  (create-root server-name subject)
+                  (run-server
+                   (lambda (request request-body)
+                     (let ((path (uri-path (request-uri request))))
+                       (if (or (equal? path "/.well-known/openid-configuration")
+                               (equal? path (uri-path jwks-uri))
+                               (equal? path (uri-path authorization-endpoint-uri))
+                               (equal? path (uri-path token-endpoint-uri)))
+                           (identity-provider-handler request request-body)
+                           (resource-handler request request-body))))
+                   'http
+                   (list #:port port)))))
+             (else
+              (format (current-error-port) (G_ "Unknown command ~s\n")
+                      command)
+              (exit 1))))))))))