Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Support for uri-safe or standard base64-encode |
|---|---|
| Downloads: | Tarball | ZIP archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
1b29946a75a939d669c10b59359a4171 |
| User & Date: | murphy 2013-05-31 12:21:09.139 |
Context
|
2013-05-31
| ||
| 12:24 | make-redirect-response utility procedure check-in: e1670c701e user: murphy tags: trunk | |
| 12:21 | Support for uri-safe or standard base64-encode check-in: 1b29946a75 user: murphy tags: trunk | |
|
2013-05-30
| ||
| 18:10 | Base the default suspension key on user identity and working directory check-in: 7ddd794862 user: murphy tags: trunk | |
Changes
Changes to webgate-suspend.scm.
| ︙ | ︙ | |||
41 42 43 44 45 46 47 | (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)) | | | 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 | (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)) #t)) (lambda () (destroy-object evp))))) (define crypt-condition? (condition-predicate 'crypt)) (define crypt-condition-code |
| ︙ | ︙ |
Changes to webgate-utils.scm.
| ︙ | ︙ | |||
222 223 224 225 226 227 228 229 230 | (string (integer->char (string->number (irregex-match-substring m 1) 16)))))))))) ;;; Base64URI encoding (define base64-alphabet "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_") | > > | > | | | | | < | < | > | | > > | | | | | | 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 |
(string
(integer->char
(string->number (irregex-match-substring m 1) 16))))))))))
;;; Base64URI encoding
(define base64-alphabet
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
(define base64-alphabet/uri
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_")
(define (base64-encode s #!optional uri-safe?)
(let* ((alphabet (if uri-safe? base64-alphabet/uri base64-alphabet))
(n (string-length s))
(e (make-string (inexact->exact (ceiling (* 4/3 n))))))
(do ((is 0 (fx+ is 3)) (ie 0 (fx+ ie 4))) ((fx>= is n) e)
(let ((i (fxior
(fxshl (char->integer (string-ref s is)) 16)
(if (fx< (fx+ is 1) n)
(fxior
(fxshl (char->integer (string-ref s (fx+ is 1))) 8)
(if (fx< (fx+ is 2) n)
(char->integer (string-ref s (fx+ is 2)))
0))
0))))
(string-set!
e ie
(string-ref alphabet (fxand (fxshr i 18) #b111111)))
(string-set!
e (fx+ ie 1)
(string-ref alphabet (fxand (fxshr i 12) #b111111)))
(when (fx< (fx+ is 1) n)
(string-set!
e (fx+ ie 2)
(string-ref alphabet (fxand (fxshr i 6) #b111111)))
(when (fx< (fx+ is 2) n)
(string-set!
e (fx+ ie 3)
(string-ref alphabet (fxand i #b111111)))))))))
(define base64-decode
(let ((alphabet-ref
(let* ((n (string-length base64-alphabet))
(alphabet (make-hash-table eqv? eqv?-hash (fx+ n 2))))
(do ((i 0 (fx+ i 1))) ((fx>= i n))
(hash-table-set! alphabet (string-ref base64-alphabet i) i))
(do ((i (fx- n 2) (fx+ i 1))) ((fx>= i n))
(hash-table-set! alphabet (string-ref base64-alphabet/uri i) i))
(lambda (chr)
(hash-table-ref
alphabet chr
(cut syntax-error 'base64-decode "illegal character" chr))))))
(lambda (e)
(let* ((n (string-length e))
(s (make-string (inexact->exact (floor (* 3/4 n))))))
(do ((ie 0 (fx+ ie 4)) (is 0 (fx+ is 3))) ((fx>= ie n) s)
(let ((i (fxior
(fxshl
(alphabet-ref (string-ref e ie)) 18)
(if (fx< (fx+ ie 1) n)
(fxior
(fxshl
(alphabet-ref (string-ref e (fx+ ie 1))) 12)
(if (fx< (fx+ ie 2) n)
(fxior
(fxshl
(alphabet-ref (string-ref e (fx+ ie 2))) 6)
(if (fx< (fx+ ie 3) n)
(alphabet-ref (string-ref e (fx+ ie 3)))
0))
0))
0))))
(string-set!
s is (integer->char (fxand (fxshr i 16) #xff)))
(when (fx< (fx+ ie 2) n)
(string-set!
|
| ︙ | ︙ |