Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Use TweetNaCl instead of Cryptlib for suspension encapsulation |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
1c90f0c41c6623fe2801304079009524 |
| User & Date: | murphy 2015-05-04 09:22:50 |
Context
|
2015-05-04
| ||
| 10:39 | Allow WebGate to work with the standard suspension egg check-in: d11a75d327 user: murphy tags: trunk | |
| 09:22 | Use TweetNaCl instead of Cryptlib for suspension encapsulation check-in: 1c90f0c41c user: murphy tags: trunk | |
| 09:15 | Moved suspension module into separate compilation unit, isolating disabled interrupts check-in: 72a7ba057e user: murphy tags: trunk | |
Changes
Changes to webgate-suspend.scm.
25 25 26 26 ;;; Support for suspended computations 27 27 28 28 (define current-suspension-key 29 29 (make-parameter 30 30 (sprintf 31 31 "~a:~a:~a" 32 - (current-user-id) (current-group-id) (current-directory)))) 32 + (current-user-id) (current-group-id) (current-directory)) 33 + (lambda (v) 34 + (cond 35 + ((blob? v) 36 + v) 37 + (else 38 + (let loop ([v (->string v)] [n 1000]) 39 + (if (positive? n) 40 + (loop (hash v) (fx- n 1)) 41 + (string->blob (substring/shared v 0 symmetric-box-keybytes))))))))) 42 + 43 +(define (suspension-nonce) 44 + (substring/shared 45 + (hash 46 + (let ((getenv (resource-context-getenv (current-resource-context)))) 47 + (sprintf 48 + "~a:~a/~a:~a" 49 + (getenv "REMOTE_ADDR") (getenv "REMOTE_PORT") 50 + (current-seconds) (current-milliseconds)))) 51 + 0 symmetric-box-noncebytes)) 33 52 34 53 (define (wrap-suspension sk) 35 - (let ((evp (create-envelope FORMAT-CRYPTLIB))) 36 - (dynamic-wind 37 - void 38 - (lambda () 39 - (attribute-set! evp OPTION-ENCR-ALGO ALGO-AES) 40 - (attribute-set! evp OPTION-ENCR-HASH ALGO-SHA2) 41 - (attribute-set! evp OPTION-ENCR-MAC ALGO-HMAC-SHA2) 42 - (attribute-set! evp ENVINFO-INTEGRITY INTEGRITY-FULL) 43 - (attribute-set!/string evp ENVINFO-PASSWORD (current-suspension-key)) 44 - (attribute-set! evp ENVINFO-DATASIZE (string-length sk)) 45 - (let ((port (open-output-object evp))) 46 - (write-string sk #f port) 47 - (close-output-port port)) 48 - (base64-encode (read-string #f (open-input-object evp #f #t)) #t)) 49 - (lambda () 50 - (destroy-object evp))))) 51 - 52 -(define crypt-condition? 53 - (condition-predicate 'crypt)) 54 - 55 -(define crypt-condition-code 56 - (condition-property-accessor 'crypt 'code #f)) 54 + (let* ((n (suspension-nonce)) 55 + (c ((symmetric-box (current-suspension-key)) sk (blob->u8vector/shared (string->blob n))))) 56 + (base64-encode (string-append n c) #t))) 57 57 58 58 (define (unwrap-suspension sk) 59 - (condition-case 60 - (let ((evp (create-envelope FORMAT-AUTO))) 61 - (dynamic-wind 62 - void 63 - (lambda () 64 - (with-exception-handler 65 - (let ((abort (current-exception-handler))) 66 - (lambda (exn) 67 - (if (and (crypt-condition? exn) 68 - (eqv? (crypt-condition-code exn) ENVELOPE-RESOURCE)) 69 - (attribute-set!/string 70 - evp ENVINFO-PASSWORD (current-suspension-key)) 71 - (abort exn)))) 72 - (lambda () 73 - (let ((port (open-output-object evp))) 74 - (write-string (base64-decode sk) #f port) 75 - (close-output-port port)) 76 - (and (eqv? (attribute evp ENVINFO-INTEGRITY) INTEGRITY-FULL) 77 - (read-string #f (open-input-object evp #f #t)))))) 78 - (lambda () 79 - (destroy-object evp)))) 80 - ((exn crypt) #f) 81 - ((exn syntax) #f))) 59 + (and-let* ((sk (condition-case (base64-decode sk) ((exn syntax) #f))) 60 + ((> (string-length sk) symmetric-box-noncebytes)) 61 + (n (substring/shared sk 0 symmetric-box-noncebytes)) 62 + (c (substring/shared sk symmetric-box-noncebytes))) 63 + ((symmetric-unbox (current-suspension-key)) c (blob->u8vector/shared (string->blob n))))) 82 64 83 65 (define-resource (suspended "suspended" sk parameters) 84 66 (cond 85 67 ((unwrap-suspension sk) 86 68 => (cut continuation-resume <> parameters)) 87 69 (else 88 70 (make-error-response 89 71 404 "The requested suspended resource was not found on the server.")))) 90 72 91 73 (define (send/suspend proc) 92 74 (continuation-suspend 93 75 (lambda (sk) 94 76 (proc (resource-uri suspended (wrap-suspension sk))))))
Changes to webgate.meta.
1 1 ;; -*- mode: Scheme; -*- 2 2 ((category net) 3 3 (license "BSD") 4 4 (author "Thomas Chust") 5 5 (synopsis "(S)CGI web application framework") 6 - (needs srfi-99 protobuf cryptlib) 6 + (needs srfi-99 protobuf tweetnacl) 7 7 (files "webgate.scm" 8 8 "at-expr.scm" 9 9 "suspension.scm" 10 10 "webgate-utils.scm" 11 11 "webgate-core.scm" 12 12 "webgate-suspend.scm" 13 13 "webgate-cgi.scm" 14 14 "webgate-scgi.scm"))
Changes to webgate.scm.
22 22 ;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 23 23 ;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 24 24 ;; SOFTWARE. 25 25 26 26 (require-library 27 27 srfi-1 srfi-4 srfi-13 srfi-14 srfi-18 srfi-69 srfi-99 28 28 data-structures ports extras lolevel irregex tcp posix 29 - suspension cryptlib) 29 + suspension tweetnacl) 30 30 31 31 (module webgate-utils 32 32 (write-netstring read-netstring 33 33 make-at-reader make-at-read-table use-at-read-table 34 34 uri-encode uri-decode 35 35 base64-encode base64-decode 36 36 write-html) ................................................................................ 71 71 72 72 (module webgate-suspend 73 73 (current-suspension-key 74 74 suspended 75 75 send/suspend) 76 76 (import 77 77 scheme chicken 78 - srfi-1 srfi-18 srfi-69 79 - extras suspension cryptlib webgate-utils webgate-core 78 + srfi-1 srfi-4 srfi-13 srfi-18 srfi-69 79 + data-structures extras suspension tweetnacl webgate-utils webgate-core 80 80 (only posix current-user-id current-group-id current-directory)) 81 81 (include 82 82 "webgate-suspend.scm")) 83 83 84 84 (module webgate-cgi 85 85 (cgi-main-loop) 86 86 (import