From 1cd51a1728a34aaf85b964bff7636733ef732999 Mon Sep 17 00:00:00 2001 From: Vivien Kraus Date: Mon, 7 Dec 2020 22:20:53 +0100 Subject: Create a hello world server --- src/Makefile.am | 2 +- src/scm/webid-oidc/Makefile.am | 6 +- src/scm/webid-oidc/hello-world.scm | 117 +++++++++++++++++++++++++++++++++++++ src/webid-oidc-hello | 12 ++++ 4 files changed, 134 insertions(+), 3 deletions(-) create mode 100644 src/scm/webid-oidc/hello-world.scm create mode 100644 src/webid-oidc-hello (limited to 'src') 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) -- cgit v1.2.3