diff options
Diffstat (limited to 'src/scm/webid-oidc/server/resource/content.scm')
| -rw-r--r-- | src/scm/webid-oidc/server/resource/content.scm | 31 |
1 files changed, 15 insertions, 16 deletions
diff --git a/src/scm/webid-oidc/server/resource/content.scm b/src/scm/webid-oidc/server/resource/content.scm index 29d8889..57c51dd 100644 --- a/src/scm/webid-oidc/server/resource/content.scm +++ b/src/scm/webid-oidc/server/resource/content.scm @@ -19,6 +19,7 @@ #:use-module ((webid-oidc stubs) #:prefix stubs:) #:use-module (webid-oidc rdf-index) #:use-module ((webid-oidc refresh-token) #:prefix refresh:) + #:use-module ((webid-oidc parameters) #:prefix p:) #:use-module (web uri) #:use-module (rnrs bytevectors) #:use-module (ice-9 exceptions) @@ -36,18 +37,18 @@ )) -(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) +(define (load-content session 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) + (call-with-input-file (format #f "~a/server/content/~a/~a" + (p:data-home) + first-char + rest) (lambda (port) (let ((properties (read port))) (set-port-encoding! port "ISO-8859-1") @@ -60,14 +61,14 @@ (hash-set! session etag ret) ret)))))) -(define (new-content session dir content-type contained static-content) +(define (new-content session 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) + (stubs:mkdir-p (format #f "~a/server/content/~a" (p:data-home) first-char)) + (let ((port (open (format #f "~a/server/content/~a/~a" (p:data-home) first-char rest) (logior O_WRONLY O_CREAT O_EXCL)))) (write `((content-type . ,content-type) (contained . ,contained)) port) @@ -82,18 +83,16 @@ #:static-content static-content)) etag)))) -(define (delete-content dir etag) +(define (delete-content etag) (let ((first-char (substring etag 0 1)) (rest (substring etag 1))) - (delete-file (format #f "~a/content/~a/~a" dir first-char rest)))) + (delete-file (format #f "~a/server/content/~a/~a" (p:data-home) first-char rest)))) -(define* (with-session f #:key (dir default-dir)) - (when (thunk? dir) - (set! dir (dir))) +(define (with-session f) (let ((session (make-hash-table))) (define (do-load etag) (or (hash-ref session etag) - (load-content session dir etag))) + (load-content session etag))) (define (get-content-type etag) (content-type (do-load etag))) (define (get-contained etag) @@ -101,7 +100,7 @@ (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)) + (new-content session content-type contained static-content)) (define (do-delete etag) - (delete-content dir etag)) + (delete-content etag)) (f get-content-type get-contained get-static-content do-create do-delete))) |