From 2d57ff7d4a9ee756930748267ddcd15316d6f114 Mon Sep 17 00:00:00 2001 From: Vivien Kraus Date: Fri, 7 May 2021 14:37:34 +0200 Subject: Add a demonstration program --- src/Makefile.am | 2 +- src/scm/webid-oidc/Makefile.am | 6 +- src/scm/webid-oidc/example-app.scm | 214 +++++++++++++++++++++++++++++++++++++ src/webid-oidc-example-app | 7 ++ 4 files changed, 226 insertions(+), 3 deletions(-) create mode 100644 src/scm/webid-oidc/example-app.scm create mode 100755 src/webid-oidc-example-app (limited to 'src') diff --git a/src/Makefile.am b/src/Makefile.am index 527f201..3dd6822 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 +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 AM_CPPFLAGS += -I %reldir% -I $(srcdir)/%reldir% diff --git a/src/scm/webid-oidc/Makefile.am b/src/scm/webid-oidc/Makefile.am index 1f9cb5d..6aeadfc 100644 --- a/src/scm/webid-oidc/Makefile.am +++ b/src/scm/webid-oidc/Makefile.am @@ -23,7 +23,8 @@ dist_webidoidcmod_DATA += \ %reldir%/resource-server.scm \ %reldir%/hello-world.scm \ %reldir%/reverse-proxy.scm \ - %reldir%/client.scm + %reldir%/client.scm \ + %reldir%/example-app.scm webidoidcgo_DATA += \ %reldir%/errors.go \ @@ -50,6 +51,7 @@ webidoidcgo_DATA += \ %reldir%/resource-server.go \ %reldir%/hello-world.go \ %reldir%/reverse-proxy.go \ - %reldir%/client.go + %reldir%/client.go \ + %reldir%/example-app.go EXTRA_DIST += %reldir%/ChangeLog diff --git a/src/scm/webid-oidc/example-app.scm b/src/scm/webid-oidc/example-app.scm new file mode 100644 index 0000000..bb2faa6 --- /dev/null +++ b/src/scm/webid-oidc/example-app.scm @@ -0,0 +1,214 @@ +(define-module (webid-oidc example-app) + #:use-module (webid-oidc client) + #:use-module (webid-oidc errors) + #:use-module ((webid-oidc cache) #:prefix cache:) + #:use-module (webid-oidc dpop-proof) + #:use-module ((webid-oidc stubs) #:prefix stubs:) + #:use-module ((webid-oidc refresh-token) #:prefix refresh:) + #:use-module ((webid-oidc config) #:prefix cfg:) + #:use-module (web uri) + #:use-module (web client) + #:use-module (web response) + #:use-module (web server) + #:use-module (ice-9 optargs) + #:use-module (ice-9 receive) + #:use-module (srfi srfi-19) + #:use-module (ice-9 i18n) + #:use-module (ice-9 getopt-long) + #:use-module (ice-9 suspendable-ports) + #:use-module (ice-9 textual-ports) + #:use-module (ice-9 rdelim) + #:use-module (sxml simple) + #:use-module (rnrs bytevectors)) + +(define (G_ text) + (let ((out (gettext text))) + (if (string=? out text) + ;; No translation, disambiguate + (car (reverse (string-split text #\|))) + out))) + +(define (enumerate-profiles profiles) + (define (aux i) + (when (< i (vector-length profiles)) + (let ((prof (vector-ref profiles i))) + (format #t (G_ "~a.\t~a, certified by ~a;\n") + (+ i 1) + (uri->string (car prof)) + (uri->string (cadr prof)))) + (aux (+ i 1)))) + (aux 0)) + +(define (enumerate-providers providers) + (define (aux i) + (when (< i (vector-length providers)) + (let ((prov (vector-ref providers i))) + (format #t (G_ "~a – ~a\n") + (+ i 1) + (prov))) + (aux (+ i 1)))) + (aux 0)) + +(define (select-choice mini maxi question) + (format #t "~a" question) + (let* ((line + (read-line (current-input-port) 'trim)) + (number (false-if-exception (string->number line)))) + (cond + ((eof-object? line) + (exit 0)) + ((and (integer? number) + (>= number mini) + (<= number maxi)) + number) + (else + (format #t (G_ "I’m expecting a number between ~a and ~a.\n") + mini maxi) + (select-choice mini maxi question))))) + +(define cache-http-get (cache:with-cache)) + +(define (inner-main-loop http-request) + (format #t (G_ "Please enter an URI to GET: ")) + (let ((line (read-line (current-input-port) 'trim))) + (unless (eof-object? line) + (let ((uri (string->uri line))) + (receive (response response-body) + (http-request uri) + (let ((write-body + (write-response response (current-output-port)))) + (when (string? response-body) + (set! response-body (string->utf8 response-body))) + (when response-body + (write-response-body write-body response-body))))) + (inner-main-loop http-request)))) + +(define (main-loop id-token access-token key) + (let ((my-http-request + (make-client id-token access-token key + #:http-request + (lambda args + (format (current-error-port) (G_ "Sending a request: ~s\n") args) + (apply http-request args))))) + (inner-main-loop my-http-request))) + +(define-public (inner-main) + (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")))) + (let ((options + (let ((option-spec + `((,version-sym (single-char #\v) (value #f)) + (,help-sym (single-char #\h) (value #f))))) + (getopt-long (command-line) option-spec)))) + (cond + ((option-ref options help-sym #f) + (format #t (G_ "Usage: ~a [OPTIONS]... + +Demonstrate a webid-oidc application. + +Options: + -h, --~a: + display this help message and exit. + -v, --~a: + display the version information (~a) and exit. + +Environment variables: + + LANG: set the locale. Currently ~a. + + XDG_CACHE_HOME: where the seed for the key generator is +stored. Currently ~a. + + XDG_DATA_HOME: where the login credentials are stored. Currently ~a. + + HOME: to compute a default value for XDG_CACHE_HOME and +XDG_DATA_HOME, if missing. Currently ~a. + +If you find a bug, send a report to ~a. +") + (car (command-line)) + help-sym version-sym + cfg:version + (or (getenv "LANG") "") + (or (getenv "XDG_CACHE_HOME") "") + (or (getenv "XDG_DATA_HOME") "") + (or (getenv "HOME") "") + cfg:package-bugreport)) + ((option-ref options version-sym #f) + (format #t (G_ "~a version ~a\n") + cfg:package cfg:version)) + (else + (let ((profiles (list->vector (list-profiles)))) + (format #t (G_ "First, let’s log in. Here are your options:\n")) + (enumerate-profiles profiles) + (format #t (G_ "0.\tLog in with a different identity.\n")) + (let ((i-profile + (select-choice + 0 + (vector-length profiles) + (G_ "Please indicate your choice number: ")))) + (receive (id-token access-token key) + (if (eqv? i-profile 0) + (setup + (lambda () + (format #t (G_ "Please enter your webid, or identity server: ")) + (read-line (current-input-port) 'trim)) + (lambda (providers) + (cond + ((null? providers) + (error "No, this cannot happen.")) + ((null? (cdr providers)) + (car providers)) + (else + (set! providers (list->vector providers)) + (format #t (G_ "There are different possible identity providers for your webid:\n")) + (enumerate-providers providers) + (let ((i-provider + (select-choice 1 (- (vector-length providers) 1) + (G_ "Please indicate your choice number: ")))) + (vector-ref providers i-provider))))) + (lambda (uri) + (format #t (G_ "Please visit the following URI with a web browser:\n~a\n") + (uri->string uri)) + (format #t (G_ "Please paste your authorization code: ")) + (read-line (current-input-port) 'trim)) + #:client-id "https://webid-oidc-demo.planete-kraus.eu/example-application#id" + #:redirect-uri "https://webid-oidc-demo.planete-kraus.eu/authorized" + #:http-get cache-http-get) + (let ((profile (vector-ref profiles (- i-profile 1)))) + (let ((webid (car profile)) + (issuer (cadr profile)) + (refresh-token (caddr profile)) + (key (cadddr profile))) + (login webid issuer refresh-token key #:http-get cache-http-get)))) + (format #t (G_ "Log in success. Keep this identity token for yourself: + +~a + +Now, you can do authenticated request by presenting the following access token: + +~a + +and signing DPoP proofs with the following key: + +~a +") + (stubs:scm->json-string id-token #:pretty #t) + access-token + (stubs:scm->json-string key #:pretty #t)) + (main-loop id-token access-token key))))))))) + +(define-public (main) + (with-exception-handler + (lambda (error) + (format (current-error-port) + (G_ "There was an error: ~a\n") + (error->str error))) + (lambda () + (inner-main)) + #:unwind? #t)) diff --git a/src/webid-oidc-example-app b/src/webid-oidc-example-app new file mode 100755 index 0000000..ebf2da8 --- /dev/null +++ b/src/webid-oidc-example-app @@ -0,0 +1,7 @@ +#!/usr/local/bin/guile \ +--no-auto-compile -s +!# + +(use-modules (webid-oidc example-app)) + +(main) -- cgit v1.2.3