WebGate

Check-in [c4ebab70b3]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Compression for suspensions
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:c4ebab70b3081c1fbef93bd8890d67c9bcac400b
User & Date: murphy 2015-05-04 14:57:08
Context
2015-05-04
14:58
Output remote address and port in the example script check-in: 80136f0ceb user: murphy tags: trunk
14:57
Compression for suspensions check-in: c4ebab70b3 user: murphy tags: trunk
14:56
Added BZip2 compression function wrappers check-in: b520ce0466 user: murphy tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to webgate-suspend.scm.

48
49
50
51
52
53
54
55

56
57
58
59
60
61
62

63

64
65
66
67
68
69
70
71
72
73
74
75
76
       "~a:~a/~a:~a"
       (getenv "REMOTE_ADDR") (getenv "REMOTE_PORT")
       (current-seconds) (current-milliseconds))))
   0 symmetric-box-noncebytes))

(define (wrap-suspension sk)
  (let* ((n (suspension-nonce))
	 (c ((symmetric-box (current-suspension-key)) sk (blob->u8vector/shared (string->blob n)))))

    (base64-encode (string-append n c) #t)))

(define (unwrap-suspension sk)
  (and-let* ((sk (condition-case (base64-decode sk) ((exn syntax) #f)))
	     ((> (string-length sk) symmetric-box-noncebytes))
	     (n (substring/shared sk 0 symmetric-box-noncebytes))
	     (c (substring/shared sk symmetric-box-noncebytes)))

    ((symmetric-unbox (current-suspension-key)) c (blob->u8vector/shared (string->blob n)))))


(define-resource (suspended "suspended" sk parameters)
  (cond
   ((unwrap-suspension sk)
    => (cut continuation-resume <> parameters))
   (else
    (make-error-response
     404 "The requested suspended resource was not found on the server."))))

(define (send/suspend proc)
  (continuation-suspend
   (lambda (sk)
     (proc (resource-uri suspended (wrap-suspension sk))))))







|
>






|
>
|
>













48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
       "~a:~a/~a:~a"
       (getenv "REMOTE_ADDR") (getenv "REMOTE_PORT")
       (current-seconds) (current-milliseconds))))
   0 symmetric-box-noncebytes))

(define (wrap-suspension sk)
  (let* ((n (suspension-nonce))
	 (c ((symmetric-box (current-suspension-key))
	     (compress sk) (blob->u8vector/shared (string->blob n)))))
    (base64-encode (string-append n c) #t)))

(define (unwrap-suspension sk)
  (and-let* ((sk (condition-case (base64-decode sk) ((exn syntax) #f)))
	     ((> (string-length sk) symmetric-box-noncebytes))
	     (n (substring/shared sk 0 symmetric-box-noncebytes))
	     (c (substring/shared sk symmetric-box-noncebytes))
	     (m ((symmetric-unbox (current-suspension-key))
		 c (blob->u8vector/shared (string->blob n)))))
    (decompress m)))

(define-resource (suspended "suspended" sk parameters)
  (cond
   ((unwrap-suspension sk)
    => (cut continuation-resume <> parameters))
   (else
    (make-error-response
     404 "The requested suspended resource was not found on the server."))))

(define (send/suspend proc)
  (continuation-suspend
   (lambda (sk)
     (proc (resource-uri suspended (wrap-suspension sk))))))