WebGate

Check-in [63a4f6f079]
Login

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
Hide Diffs Unified Diffs Ignore Whitespace Patch

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))))))