1(module windlldir racket/base
2  (require racket/port
3           racket/promise
4           "winutf16.rkt")
5
6  (provide update-dll-dir
7           get-current-dll-dir
8	   current-no-dlls?)
9
10  (define label (delay/sync (byte-regexp (bytes->utf-16-bytes #"dLl dIRECTORy:"))))
11  (define max-dir-len (* 512 2)) ; sizeof(wchar_t) is 2
12
13  (define (update-dll-dir dest path)
14    (let ([path-bytes (bytes->utf-16-bytes
15                       (cond [(eq? path #t) #"<system>"]
16                             [(path? path) (path->bytes path)]
17                             [else (string->bytes/locale path)]))])
18      (unless ((bytes-length path-bytes) . <= . max-dir-len)
19        (error 'update-dll-dir "path too long: ~e" path))
20      (let ([m (with-input-from-file dest
21                 (lambda ()
22                   (regexp-match-positions (force label) (current-input-port))))])
23        (unless m
24          (error 'update-ddl-dir "cannot find DLL path in file: ~e" dest))
25        (with-output-to-file dest
26          (lambda ()
27            (file-position (current-output-port) (cdar m))
28            (write-bytes path-bytes)
29            (write-byte 0))
30          #:exists 'update))))
31
32  (define (get-current-dll-dir dest)
33    (with-input-from-file dest
34      (lambda ()
35        (unless (regexp-match (force label) (current-input-port))
36          (error 'get-current-dll-dir "cannot find DLL path in file: ~e" dest))
37        (let ([p (make-limited-input-port (current-input-port) max-dir-len)])
38          (let ([m (regexp-match #rx#"(?:[^\0].|.[^\0])*" p)])
39            (bytes->path (utf-16-bytes->bytes (car m))))))))
40
41  (define (current-no-dlls? dest)
42    (regexp-match? #rx#"^<" (get-current-dll-dir dest))))
43