Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Improved encryption context cleanup code |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: | 63a4f6f07903514bf2df1ce2b3939da18ce9babe |
| User & Date: | murphy 2013-05-30 17:43:57 |
Context
|
2013-05-30
| ||
| 18:10 | Base the default suspension key on user identity and working directory check-in: 7ddd794862 user: murphy tags: trunk | |
| 17:43 | Improved encryption context cleanup code check-in: 63a4f6f079 user: murphy tags: trunk | |
| 17:00 | Protobuf and suspension based serialization of continuations, request parameter utilities, reader extension loader check-in: c29262e9f4 user: murphy tags: trunk | |
Changes
Changes to webgate-suspend.scm.
33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 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 80 81 82 83 84 85 86 87 88 89 |
(encrypt ctx "")
(let ((key (attribute/string ctx CTXINFO-HASHVALUE)))
(destroy-object ctx)
key))))
(define (wrap-suspension sk)
(let ((evp (create-envelope FORMAT-CRYPTLIB)))
(attribute-set! evp OPTION-ENCR-ALGO ALGO-AES)
(attribute-set! evp OPTION-ENCR-HASH ALGO-SHA2)
(attribute-set! evp OPTION-ENCR-MAC ALGO-HMAC-SHA2)
(attribute-set! evp ENVINFO-INTEGRITY INTEGRITY-FULL)
(attribute-set!/string evp ENVINFO-PASSWORD (current-suspension-key))
(attribute-set! evp ENVINFO-DATASIZE (string-length sk))
(let ((port (open-output-object evp #f)))
(write-string sk #f port)
(close-output-port port))
(let* ((port (open-input-object evp #f #t))
(sk (read-string #f port)))
(close-input-port port)
(base64-encode sk))))
(define (unwrap-suspension sk)
(let ((evp (create-envelope FORMAT-AUTO)))
(condition-case
(with-exception-handler
(let ((abort (current-exception-handler)))
(lambda (exn)
(if (and ((condition-predicate 'crypt) exn)
(eqv? ((condition-property-accessor 'crypt 'code #f) exn)
ENVELOPE-RESOURCE))
(attribute-set!/string
evp ENVINFO-PASSWORD (current-suspension-key))
(abort exn))))
(lambda ()
(let ((port (open-output-object evp #f)))
(write-string (base64-decode sk) #f port)
(close-output-port port))
(and (eqv? (attribute evp ENVINFO-INTEGRITY) INTEGRITY-FULL)
(let* ((port (open-input-object evp #f #t))
(sk (read-string #f port)))
(close-input-port port)
sk))))
((exn crypt) #f)
((exn syntax) #f))))
(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))))))
|
> > > | | | | | | | | | | < < < > > > > > > > > < | > > > > | | | < < > | | | | | | | | | | < < < > > | |
33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 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 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 |
(encrypt ctx "")
(let ((key (attribute/string ctx CTXINFO-HASHVALUE)))
(destroy-object ctx)
key))))
(define (wrap-suspension sk)
(let ((evp (create-envelope FORMAT-CRYPTLIB)))
(dynamic-wind
void
(lambda ()
(attribute-set! evp OPTION-ENCR-ALGO ALGO-AES)
(attribute-set! evp OPTION-ENCR-HASH ALGO-SHA2)
(attribute-set! evp OPTION-ENCR-MAC ALGO-HMAC-SHA2)
(attribute-set! evp ENVINFO-INTEGRITY INTEGRITY-FULL)
(attribute-set!/string evp ENVINFO-PASSWORD (current-suspension-key))
(attribute-set! evp ENVINFO-DATASIZE (string-length sk))
(let ((port (open-output-object evp)))
(write-string sk #f port)
(close-output-port port))
(base64-encode (read-string #f (open-input-object evp #f #t))))
(lambda ()
(destroy-object evp)))))
(define crypt-condition?
(condition-predicate 'crypt))
(define crypt-condition-code
(condition-property-accessor 'crypt 'code #f))
(define (unwrap-suspension sk)
(condition-case
(let ((evp (create-envelope FORMAT-AUTO)))
(dynamic-wind
void
(lambda ()
(with-exception-handler
(let ((abort (current-exception-handler)))
(lambda (exn)
(if (and (crypt-condition? exn)
(eqv? (crypt-condition-code exn) ENVELOPE-RESOURCE))
(attribute-set!/string
evp ENVINFO-PASSWORD (current-suspension-key))
(abort exn))))
(lambda ()
(let ((port (open-output-object evp)))
(write-string (base64-decode sk) #f port)
(close-output-port port))
(and (eqv? (attribute evp ENVINFO-INTEGRITY) INTEGRITY-FULL)
(read-string #f (open-input-object evp #f #t))))))
(lambda ()
(destroy-object evp))))
((exn crypt) #f)
((exn syntax) #f)))
(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))))))
|