summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorVivien Kraus <vivien@planete-kraus.eu>2020-12-07 22:20:53 +0100
committerVivien Kraus <vivien@planete-kraus.eu>2021-06-19 13:06:24 +0200
commit165348dcc4fefcf6d2d8c819759d846a74b89db8 (patch)
tree77199140d27dabc4580d0381a835893e9b1e9a24 /src
parentecbac72644b054f635bdf57e0f7d42131f1b3616 (diff)
Create a hello world server
Diffstat (limited to 'src')
-rw-r--r--src/Makefile.am2
-rw-r--r--src/scm/webid-oidc/Makefile.am6
-rw-r--r--src/scm/webid-oidc/hello-world.scm117
-rw-r--r--src/webid-oidc-hello12
4 files changed, 134 insertions, 3 deletions
diff --git a/src/Makefile.am b/src/Makefile.am
index 83d4a04..79ac441 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
+dist_bin_SCRIPTS += %reldir%/webid-oidc-issuer %reldir%/webid-oidc-hello
AM_CPPFLAGS += -I %reldir% -I $(srcdir)/%reldir%
diff --git a/src/scm/webid-oidc/Makefile.am b/src/scm/webid-oidc/Makefile.am
index 061af17..c2d4646 100644
--- a/src/scm/webid-oidc/Makefile.am
+++ b/src/scm/webid-oidc/Makefile.am
@@ -20,7 +20,8 @@ dist_webidoidcmod_DATA += \
%reldir%/token-endpoint.scm \
%reldir%/identity-provider.scm \
%reldir%/provider-confirmation.scm \
- %reldir%/resource-server.scm
+ %reldir%/resource-server.scm \
+ %reldir%/hello-world.scm
webidoidcgo_DATA += \
%reldir%/errors.go \
@@ -44,6 +45,7 @@ webidoidcgo_DATA += \
%reldir%/token-endpoint.go \
%reldir%/identity-provider.go \
%reldir%/provider-confirmation.go \
- %reldir%/resource-server.go
+ %reldir%/resource-server.go \
+ %reldir%/hello-world.go
EXTRA_DIST += %reldir%/ChangeLog
diff --git a/src/scm/webid-oidc/hello-world.scm b/src/scm/webid-oidc/hello-world.scm
new file mode 100644
index 0000000..cda88e4
--- /dev/null
+++ b/src/scm/webid-oidc/hello-world.scm
@@ -0,0 +1,117 @@
+(define-module (webid-oidc hello-world)
+ #:use-module (webid-oidc resource-server)
+ #:use-module (webid-oidc jti)
+ #:use-module ((webid-oidc config) #:prefix cfg:)
+ #:use-module (web request)
+ #:use-module (web response)
+ #:use-module (web uri)
+ #:use-module (web server)
+ #: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 (sxml simple)
+ #:use-module (srfi srfi-19))
+
+(define (G_ text)
+ (let ((out (gettext text)))
+ (if (string=? out text)
+ ;; No translation, disambiguate
+ (car (reverse (string-split text #\|)))
+ out)))
+
+(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_ "comand-line|help")))
+ (port-sym
+ (string->symbol (G_ "comand-line|port"))))
+ (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)))))
+ (getopt-long (command-line) option-spec))))
+ (cond
+ ((option-ref options help-sym #f)
+ (format #t (G_ "~a [OPTIONS]...
+
+Display your identity contained in the XXX-Agent header.
+
+Options:
+ -h, --~a:
+ display this help message and exit.
+ -v, --~a:
+ display the version information (~a) and exit.
+ -p PORT, --port=~a:
+ set the port to bind.
+")
+ (car (command-line))
+ help-sym version-sym
+ cfg:version
+ port-sym))
+ ((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"))
+ (jti-list (make-jti-list)))
+ (unless (and (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))
+ (let ((handler
+ (lambda (request request-body)
+ (if (eq? (request-method request) 'GET)
+ (let ((agent (assoc-ref (request-headers request) 'xxx-agent)))
+ (if (and agent (string->uri agent))
+ (values
+ (build-response
+ #:headers '((content-type application/xhtml+xml)))
+ (with-output-to-string
+ (lambda ()
+ (sxml->xml
+ `(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
+ (html (@ (xmlns "http://www.w3.org/1999/xhtml")
+ (xml:lang "en"))
+ (body
+ (h1 "Hello, "
+ (a (@ (href ,(uri->string (string->uri agent))))
+ ,(uri->string (string->uri agent))) "!"))))))))
+ (values
+ (build-response #:code 401
+ #:reason-phrase "Unauthorized"
+ #:headers '((content-type application/xhtml+xml)))
+ (with-output-to-string
+ (lambda ()
+ (sxml->xml
+ `(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
+ (html (@ (xmlns "http://www.w3.org/1999/xhtml")
+ (xml:lang "en"))
+ (body
+ (h1 "Please authenticate!"))))))))))
+ (values
+ (build-response #:code 405
+ #:reason-phrase "Method Not Allowed"
+ #:headers '((content-type application/xhtml+xml)))
+ (with-output-to-string
+ (lambda ()
+ (sxml->xml
+ `(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
+ (html (@ (xmlns "http://www.w3.org/1999/xhtml")
+ (xml:lang "en"))
+ (body
+ (h1 "Please issue a GET request."))))))))))))
+ (install-suspendable-ports!)
+ (run-server handler 'http (list #:port (string->number port-string))))))))))
diff --git a/src/webid-oidc-hello b/src/webid-oidc-hello
new file mode 100644
index 0000000..b19481f
--- /dev/null
+++ b/src/webid-oidc-hello
@@ -0,0 +1,12 @@
+#!/usr/local/bin/guile \
+--no-auto-compile -s
+!#
+
+(use-modules (webid-oidc hello-world))
+
+(format (current-error-port) "Logging to hello.log and hello.err.\n")
+
+(set-current-output-port (open-output-file "hello.log"))
+(set-current-error-port (open-output-file "hello.err"))
+
+(main)