An API to manipulate contents on the server

6 files changed, 117 insertions, 5 deletions

diff --git a/src/Makefile.am b/src/Makefile.am
index 3dd6822..b61df70 100644
--- a/src/Makefile.am
+++ b/src/Makefile.am
@@ -14,6 +14,12 @@ godir = $(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache
 webidoidcmoddir = $(moddir)/webid-oidc
 webidoidcgodir = $(godir)/webid-oidc
 
+serverwebidoidcmoddir = $(webidoidcmoddir)/server
+serverwebidoidcgodir = $(webidoidcgodir)/server
+
+resourceserverwebidoidcmoddir = $(serverwebidoidcmoddir)/resource
+resourceserverwebidoidcgodir = $(serverwebidoidcgodir)/resource
+
 dist_mod_DATA =
 mod_DATA =
 go_DATA =
@@ -22,8 +28,14 @@ dist_webidoidcmod_DATA =
 webidoidcmod_DATA =
 webidoidcgo_DATA =
 
-install_go_targets = install-webidoidcgoDATA
-install_mod_targets = install-webidoidcmodDATA install-dist_webidoidcmodDATA
+dist_serverwebidoidcmod_DATA =
+serverwebidoidcgo_DATA =
+
+dist_resourceserverwebidoidcmod_DATA =
+resourceserverwebidoidcgo_DATA =
+
+install_go_targets = install-webidoidcgoDATA install-serverwebidoidcgoDATA install-resourceserverwebidoidcgoDATA
+install_mod_targets = install-webidoidcmodDATA install-dist_webidoidcmodDATA install-dist_serverwebidoidcmodDATA install-dist_resourceserverwebidoidcmodDATA
 
 include %reldir%/base64/Makefile.am
 include %reldir%/random/Makefile.am
@@ -34,14 +46,15 @@ include %reldir%/pre-inst/Makefile.am
 include %reldir%/inst/Makefile.am
 include %reldir%/scm/Makefile.am
 
-CLEANFILES += $(go_DATA) $(webidoidcgo_DATA) $(mod_DATA) $(webidoidcmod_DATA)
+CLEANFILES += $(go_DATA) $(webidoidcgo_DATA) $(mod_DATA) $(webidoidcmod_DATA) \
+  $(serverwebidoidcgo_DATA) $(resourceserverwebidoidcgo_DATA)
 
 %canon_reldir%_libwebidoidc_la_SOURCES = %reldir%/gettext.h %reldir%/libwebidoidc.c %reldir%/utilities.h
 %canon_reldir%_libwebidoidc_la_LIBADD = $(noinst_LTLIBRARIES) $(GUILE_LIBS) $(NETTLE_LIBS)
 
 INDENTED += $(%canon_reldir%_libwebidoidc_la_SOURCES)
 
-$(go_DATA) $(webidoidcgo_DATA): %reldir%/libwebidoidc.la
+$(go_DATA) $(webidoidcgo_DATA) $(serverwebidoidcgo_DATA) $(resourceserverwebidoidcgo_DATA): %reldir%/libwebidoidc.la
 
 SUFFIXES += .c .x .scm .go
 .c.x:
diff --git a/src/scm/webid-oidc/Makefile.am b/src/scm/webid-oidc/Makefile.am
index af8746f..11f1b8b 100644
--- a/src/scm/webid-oidc/Makefile.am
+++ b/src/scm/webid-oidc/Makefile.am
@@ -57,3 +57,5 @@ webidoidcgo_DATA += \
   %reldir%/rdf-index.go
 
 EXTRA_DIST += %reldir%/ChangeLog
+
+include %reldir%/server/Makefile.am
diff --git a/src/scm/webid-oidc/server/Makefile.am b/src/scm/webid-oidc/server/Makefile.am
new file mode 100644
index 0000000..e0ca8d6
--- /dev/null
+++ b/src/scm/webid-oidc/server/Makefile.am
@@ -0,0 +1 @@
+include %reldir%/resource/Makefile.am
diff --git a/src/scm/webid-oidc/server/resource/Makefile.am b/src/scm/webid-oidc/server/resource/Makefile.am
new file mode 100644
index 0000000..88103cc
--- /dev/null
+++ b/src/scm/webid-oidc/server/resource/Makefile.am
@@ -0,0 +1,5 @@
+dist_resourceserverwebidoidcmod_DATA += \
+  %reldir%/content.scm
+
+resourceserverwebidoidcgo_DATA += \
+  %reldir%/content.go
diff --git a/src/scm/webid-oidc/server/resource/content.scm b/src/scm/webid-oidc/server/resource/content.scm
new file mode 100644
index 0000000..2bbf4f0
--- /dev/null
+++ b/src/scm/webid-oidc/server/resource/content.scm
@@ -0,0 +1,91 @@
+(define-module (webid-oidc server resource content)
+  #:use-module (webid-oidc errors)
+  #:use-module ((webid-oidc stubs) #:prefix stubs:)
+  #:use-module (webid-oidc rdf-index)
+  #:use-module ((webid-oidc refresh-token) #:prefix refresh:)
+  #:use-module (web uri)
+  #:use-module (rnrs bytevectors)
+  #:use-module (ice-9 exceptions)
+  #:use-module (ice-9 receive)
+  #:use-module (ice-9 optargs)
+  #:use-module (ice-9 iconv)
+  #:use-module (ice-9 textual-ports)
+  #:use-module (ice-9 binary-ports)
+  #:use-module (rnrs bytevectors)
+  #:use-module (oop goops)
+  #:export
+  (
+
+   with-session
+
+   ))
+
+(define (default-dir)
+  (string-append (refresh:default-dir) "/server"))
+
+(define-class <content> ()
+  (content-type #:init-keyword #:content-type #:getter content-type)
+  (contained #:init-keyword #:contained #:getter contained)
+  (static-content #:init-keyword #:static-content #:getter static-content))
+
+(define (load-content session dir etag)
+  (let ((first-char (substring etag 0 1))
+        (rest (substring etag 1)))
+    (call-with-input-file (format #f "~a/content/~a/~a" dir first-char rest)
+      (lambda (port)
+        (let ((properties (read port)))
+          (set-port-encoding! port "ISO-8859-1")
+          (let ((ret
+                 (make <content>
+                   #:content-type (assq-ref properties 'content-type)
+                   #:contained (assq-ref properties 'contained)
+                   #:static-content
+                   (string->bytevector (get-string-all port) "ISO-8859-1"))))
+            (hash-set! session etag ret)
+            ret))))))
+
+(define (new-content session dir content-type contained static-content)
+  (when (string? static-content)
+    (set! static-content (string->utf8 static-content)))
+  (let ((etag (stubs:random 12)))
+    (let ((first-char (substring etag 0 1))
+          (rest (substring etag 1)))
+      (stubs:mkdir-p (format #f "~a/content/~a" dir first-char))
+      (let ((port (open (format #f "~a/content/~a/~a" dir first-char rest)
+                        (logior O_WRONLY O_CREAT O_EXCL))))
+        (write `((content-type . ,content-type)
+                 (contained . ,contained)) port)
+        (set-port-encoding! port "ISO-8859-1")
+        (display (bytevector->string static-content "ISO-8859-1") port)
+        (close-port port)
+        (hash-set! session
+                   etag
+                   (make <content>
+                     #:content-type content-type
+                     #:contained contained
+                     #:static-content static-content))
+        etag))))
+
+(define (delete-content dir etag)
+  (let ((first-char (substring etag 0 1))
+        (rest (substring etag 1)))
+    (delete-file (format #f "~a/content/~a/~a" dir first-char rest))))
+
+(define* (with-session f #:key (dir default-dir))
+  (when (thunk? dir)
+    (set! dir (dir)))
+  (let ((session (make-hash-table)))
+    (define (do-load etag)
+      (or (hash-ref session etag)
+          (load-content session dir etag)))
+    (define (get-content-type etag)
+      (content-type (do-load etag)))
+    (define (get-contained etag)
+      (contained (do-load etag)))
+    (define (get-static-content etag)
+      (static-content (do-load etag)))
+    (define (do-create content-type contained static-content)
+      (new-content session dir content-type contained static-content))
+    (define (do-delete etag)
+      (delete-content dir etag))
+    (f get-content-type get-contained get-static-content do-create do-delete)))
diff --git a/src/scm/webid-oidc/stubs.scm b/src/scm/webid-oidc/stubs.scm
index 6ac5c3c..54ba25e 100644
--- a/src/scm/webid-oidc/stubs.scm
+++ b/src/scm/webid-oidc/stubs.scm
@@ -121,7 +121,7 @@
 
 (export (fixed:scm->json . scm->json))
 
-(define (mkdir-p name)
+(define-public (mkdir-p name)
   (catch 'system-error
     (lambda ()
       (mkdir name))