diff --git a/pkgs/distro-build/info.rkt b/pkgs/distro-build/info.rkt
index 1189b0aeaa..5c19cc897a 100644
--- a/pkgs/distro-build/info.rkt
+++ b/pkgs/distro-build/info.rkt
@@ -5,4 +5,5 @@
 (define deps '("base"
                "at-exp-lib"
                "web-server-lib"
-               "scribble-lib"))
+               "scribble-lib"
+               "ds-store-lib"))
diff --git a/pkgs/distro-build/installer-dmg.rkt b/pkgs/distro-build/installer-dmg.rkt
index 4657b9d372..0b9c880f09 100644
--- a/pkgs/distro-build/installer-dmg.rkt
+++ b/pkgs/distro-build/installer-dmg.rkt
@@ -2,9 +2,12 @@
 (require racket/system
          racket/file
          racket/format
-         racket/runtime-path)
+         racket/runtime-path
+         ds-store
+         ds-store/alias)
 
-(provide installer-dmg)
+(provide installer-dmg
+         make-dmg)
 
 (define hdiutil "/usr/bin/hdiutil")
 
@@ -27,7 +30,7 @@
   (copy-directory/files src-dir (build-path work-dir volname)
                         #:keep-modify-seconds? #t)
   (when bg
-    (copy-file bg (build-path work-dir "bg.png")))
+    (copy-file bg (build-path work-dir ".bg.png")))
   ;; The following command should work fine, but it looks like hdiutil in 10.4
   ;; is miscalculating the needed size, making it too big in our case (and too
   ;; small with >8GB images).  It seems that it works to first generate an
@@ -42,7 +45,7 @@
                   tmp-dmg))
   ;; Then do the expected dmg layout...
   (when bg
-    (dmg-layout tmp-dmg volname "bg.png"))
+    (dmg-layout tmp-dmg volname ".bg.png"))
   ;; And create the compressed image from the uncompressed image:
   (system*/show hdiutil
                 "convert" "-format" "UDBZ" "-imagekey" "zlib-level=9" "-ov"
@@ -50,68 +53,45 @@
   (delete-file tmp-dmg))
 
 (define (dmg-layout dmg volname bg)
-  (define mnt (make-temporary-file "~a-mnt" 'directory))
+  (define-values (mnt del?)
+    (let ([preferred (build-path "/Volumes/" volname)])
+      (if (not (directory-exists? preferred))
+          ;; Use the preferred path so that the alias is as
+          ;; clean as possible:
+          (values preferred #f)
+          ;; fall back to using a temporary directory
+          (values (make-temporary-file "~a-mnt" 'directory) #t))))
   (system*/show hdiutil
                 "attach" "-readwrite" "-noverify" "-noautoopen"
                 "-mountpoint" mnt dmg)
-  (define mnt-name (let-values ([(base name dir?) (split-path mnt)]) (path->string name)))
-  ;; See also https://github.com/andreyvit/yoursway-create-dmg
-  ;; First, give Finder a chance to see the new disk:
-  (define script
-    @~a{
-        tell application "Finder"
-          -- look for a single disk with the mount point as its name
-          -- (maybe this works only on newer osx versions?)
-          set theDMGDisk to ""
-          repeat while theDMGDisk = ""
-            set myDisks to every disk
-            repeat with d in myDisks
-              if name of d = "@mnt-name"
-                if theDMGDisk = ""
-                  set theDMGDisk to d
-                else
-                  error "Too many attached DMGs found!"
-                end if
-              end if
-            end repeat
-            -- not found? maybe Finder wasn't ready
-            if theDMGDisk = "" then delay 1
-          end repeat
-          if theDMGDisk = "" then error "Attached DMG not found!"
-          -- found a single matching disk, continue
-          tell theDMGDisk
-            open
-            set current view of container window to icon view
-            set toolbar visible of container window to false
-            set statusbar visible of container window to false
-            set bounds of container window to {320, 160, 1000, 540}
-            set theViewOptions to the icon view options of container window
-            set arrangement of theViewOptions to not arranged
-            set icon size of theViewOptions to 128
-            set text size of theViewOptions to 16
-            set background picture of theViewOptions to file "@bg"
-            make new alias file at container window to POSIX file "/Applications" with properties {name:"Applications"}
-            set position of item "@volname" of container window to {170, 180}
-            set position of item "@bg" of container window to {900, 180}
-            set position of item "Applications" of container window to {500, 180}
-            set name of file "@bg" to ".@bg"
-            close
-            open
-            update without registering applications
-            delay 5
-            close
-          end tell
-        end tell
-     })
-  (printf "~a\n" script)
-  (parameterize ([current-input-port (open-input-string script)])
-    (system* "/usr/bin/osascript"))
-  (system*/show "/bin/sync")
-  (system*/show "/bin/sync")
-  (system*/show "/bin/sync")
-  (system*/show "/bin/sync")
+  (define alias (path->alias-bytes (build-path mnt bg)
+                                   #:wrt mnt))
+  (make-file-or-directory-link "/Applications" (build-path mnt "Applications"))
+  (define (->path s) (string->path s))
+  (write-ds-store (build-path mnt ".DS_Store")
+                  (list
+                   (ds 'same 'BKGD 'blob 
+                       (bytes-append #"PctB"
+                                     (integer->integer-bytes (bytes-length alias) 4 #t #t)
+                                     (make-bytes 4 0)))
+                   (ds 'same 'ICVO 'bool #t)
+                   (ds 'same 'fwi0 'blob 
+                       ;; Window location (size overridden below), sideview off:
+                       (fwind 160 320 540 1000 'icnv #f))
+                   (ds 'same 'fwsw 'long 135) ; window sideview width?
+                   (ds 'same 'fwsh 'long 380) ; window sideview height?
+                   (ds 'same 'icgo 'blob #"\0\0\0\0\0\0\0\4") ; ???
+                   (ds 'same 'icvo 'blob
+                       ;; folder view options:
+                       #"icv4\0\200nonebotm\0\0\0\0\0\0\0\0\0\4\0\0")
+                   (ds 'same 'icvt 'shor 16) ; icon label size
+                   (ds 'same 'pict 'blob alias)
+                   (ds (->path ".bg.png") 'Iloc 'blob (iloc 900 180)) ; file is hidden, anway
+                   (ds (->path "Applications") 'Iloc 'blob (iloc 500 180))
+                   (ds (->path volname) 'Iloc 'blob (iloc 170 180))))
   (system*/show hdiutil "detach" mnt)
-  (delete-directory mnt))
+  (when del?
+    (delete-directory mnt)))
 
 (define (installer-dmg human-name base-name dist-suffix)
   (define dmg-name (format "bundle/~a-~a~a.dmg"
diff --git a/pkgs/ds-store-pkgs/ds-store-doc/ds-store.scrbl b/pkgs/ds-store-pkgs/ds-store-doc/ds-store.scrbl
new file mode 100644
index 0000000000..11709e873f
--- /dev/null
+++ b/pkgs/ds-store-pkgs/ds-store-doc/ds-store.scrbl
@@ -0,0 +1,98 @@
+#lang scribble/manual
+@(require (for-label ds-store
+                     ds-store/alias
+                     racket/base
+                     racket/contract/base))
+
+@title{Reading Writing @filepath{.DS_Store} Files}
+
+A @filepath{.DS_Store} file is a metadata file on Mac OS X that holds
+information about folder and icons as viewed and manipulated in
+Finder. One common reason to manipulate @filepath{.DS_Store} files
+is to create a nice-looking disk image for a Mac OS X installer.
+
+@filepath{.DS_Store} reading nd writing is based on a
+reverse-engineered description of the file format @cite["DS_Store"].
+
+@section[#:tag "ds-store-api"]{@filepath{.DS_Store} Files and Entries}
+
+@defmodule[ds-store]
+
+@defproc[(read-ds-store [path path-string?]
+                        [#:verbose verbose? any/c #f])
+         (listof ds?)]{
+
+Reads the @filepath{.DS_Store} file at @racket[path] returning a list
+of store items.}
+
+@defproc[(write-ds-store [path path-string?]
+                         [dses (listof ds?)])
+         void?]{
+
+Writes @racket[dses] to the @filepath{.DS_Store} file at
+@racket[path], replacing the file's current content.}
+
+@defstruct*[ds ([path (or/c path-element? 'same)]
+                [id symbol?]
+                [type (or/c 'long 'shor 'bool 'type 'ustr 'blob)]
+                [data (or/c exact-integer? boolean? symbol? string?
+                            bytes? iloc? fwind?)])
+            #:transparent]{
+
+Represents a entry in a @filepath{.DS_Store} file. A
+@filepath{.DS_Store} file typically has multiple entries for a single
+file or directory in the same directory as the @filepath{.DS_Store}.
+
+The @racket[path] should be @racket['same] only for a volume root
+directory; information about a directory is otherwise recorded in its
+parent directory's @filepath{.DS_Store} file.
+
+The @racket[id] symbols should each have four ASCII characters. See
+the @filepath{.DS_Store} format description @cite["DS_Store"] for more
+information @racket[id] and @racket[type] values.
+
+The @racket[data] field long should be an exact integer for
+@racket['long] and @racket['shor] types, a boolean for the
+@racket['bool] type, a 4-character ASCII symbol for the @racket['type]
+type, a string for the @racket['ustr] type, and either a byte string,
+@racket[iloc], or @racket[fwind] for the @racket['blob] type.}
+
+@defstruct*[iloc ([x exact-integer?] [y exact-integer?]) #:transparent]{
+
+Represents an icon location for an @racket['Iloc] entry.}
+
+@defstruct*[fwind ([t exact-integer?]
+                   [l exact-integer?]
+                   [b exact-integer?]
+                   [r exact-integer?]
+                   [mode symbol?]
+                   [sideview? any/c])
+            #:transparent]{
+
+Represent a window location for a @racket['fwi0] entry. The
+@racket[mode] field should have four ASCII characters, and recognized
+@racket[mode]s include @racket['icnv], @racket['clmv], and
+@racket['Nlsv].}
+
+@; ----------------------------------------
+
+@section[#:tag "aliases"]{Finder Aliases}
+
+A @racket['pict] entry in a @filepath{.DS_Store} file references a
+file through a Finder alias.
+
+@defmodule[ds-store/alias]
+
+@defproc[(path->alias-bytes [path path-string?]
+                            [#:wrt wrt-dir (or/c #f path-string?) #f])
+         (or/c bytes? #f)]{
+
+Constructs a byte string to represent a Finder alias but using the
+@filepath{CoreFoundation} library on Mac OS X.}
+
+@; ----------------------------------------
+
+@bibliography[(bib-entry #:key "DS_Store"
+                         #:title "DS_Store Format"
+                         #:author "Wim Lewis and Mark Mentovai"
+                         #:url "http://search.cpan.org/~wiml/Mac-Finder-DSStore/DSStoreFormat.pod")]
diff --git a/pkgs/ds-store-pkgs/ds-store-doc/info.rkt b/pkgs/ds-store-pkgs/ds-store-doc/info.rkt
new file mode 100644
index 0000000000..4d3a7e38e7
--- /dev/null
+++ b/pkgs/ds-store-pkgs/ds-store-doc/info.rkt
@@ -0,0 +1,10 @@
+#lang info
+
+(define collection "ds-store")
+(define deps '("base"
+               "scribble-lib"
+               "racket-doc"
+               "ds-store-lib"))
+
+(define scribblings '(("ds-store.scrbl")))
+
diff --git a/pkgs/ds-store-pkgs/ds-store-lib/alias.rkt b/pkgs/ds-store-pkgs/ds-store-lib/alias.rkt
new file mode 100644
index 0000000000..1f5ba90a4e
--- /dev/null
+++ b/pkgs/ds-store-pkgs/ds-store-lib/alias.rkt
@@ -0,0 +1,42 @@
+#lang racket/base
+(require ffi/unsafe)
+
+(provide path->alias-bytes)
+
+(define CoreServices
+  (ffi-lib "/System/Library/Frameworks/CoreServices.framework/CoreServices"
+           #:fail (lambda () #f)))
+
+(define (make-unavailable)
+  (lambda args (error "unavailable")))
+
+(define FSNewAliasFromPath
+  (get-ffi-obj 'FSNewAliasFromPath
+               CoreServices
+               (_fun _path _path _int (h : (_ptr o _pointer)) (_ptr io _int) -> (r : _int) -> (if (zero? r) h #f))
+               make-unavailable))
+(define GetAliasSize
+  (get-ffi-obj 'GetAliasSize
+               CoreServices
+               (_fun _pointer -> _long)
+               make-unavailable))
+(define DisposeHandle
+  (get-ffi-obj 'DisposeHandle
+               CoreServices
+               (_fun _pointer -> _void)
+               make-unavailable))
+
+(define (path->alias-bytes file
+                           #:wrt [wrt #f])
+  (define h
+    (FSNewAliasFromPath wrt
+                        file
+                        0
+                        0))
+  (and h
+       (let ([sz (GetAliasSize h)])
+         (define bstr (make-bytes sz))
+         (memcpy bstr (ptr-ref h _pointer) sz)
+         (begin0
+          bstr
+          (DisposeHandle h)))))
diff --git a/pkgs/ds-store-pkgs/ds-store-lib/info.rkt b/pkgs/ds-store-pkgs/ds-store-lib/info.rkt
new file mode 100644
index 0000000000..2216fa4112
--- /dev/null
+++ b/pkgs/ds-store-pkgs/ds-store-lib/info.rkt
@@ -0,0 +1,5 @@
+#lang info
+
+(define collection "ds-store")
+(define deps '("base"))
+
diff --git a/pkgs/ds-store-pkgs/ds-store-lib/main.rkt b/pkgs/ds-store-pkgs/ds-store-lib/main.rkt
new file mode 100644
index 0000000000..8ed8fa3ee8
--- /dev/null
+++ b/pkgs/ds-store-pkgs/ds-store-lib/main.rkt
@@ -0,0 +1,368 @@
+#lang racket/base
+
+(provide read-ds-store
+         write-ds-store
+         (struct-out ds)
+         (struct-out iloc)
+         (struct-out fwind))
+
+;; Based on 
+;;   http://search.cpan.org/~wiml/Mac-Finder-DSStore/DSStoreFormat.pod
+;; by Wim Lewis and Mark Mentovai
+
+(struct ds (path id type data) #:transparent)
+(struct iloc (x y) #:transparent)
+(struct fwind (t l b r mode sideview?) #:transparent)
+
+(define HEAD 4)
+
+(define (swap-bytes bstr)
+  (let ([s (make-bytes (bytes-length bstr))])
+    (for ([i (in-range 0 (bytes-length bstr) 2)])
+      (bytes-set! s i (bytes-ref bstr (add1 i)))
+      (bytes-set! s (add1 i) (bytes-ref bstr i)))
+    s))
+
+(define (bytes->string/utf-16 bstr)
+  (define bstr2 (if (system-big-endian?)
+                    bstr
+                    (swap-bytes bstr)))
+  (define c (bytes-open-converter "platform-UTF-16" "platform-UTF-8"))
+  (define-values (utf-8 got status) (bytes-convert c bstr2))
+  (bytes-close-converter c)
+  (bytes->string/utf-8 utf-8))
+
+(define (string->bytes/utf-16 s)
+  (define c (bytes-open-converter "platform-UTF-8" "platform-UTF-16"))
+  (define-values (utf-16 got status) (bytes-convert c (string->bytes/utf-8 s)))
+  (bytes-close-converter c)
+  (if (system-big-endian?)
+      utf-16
+      (swap-bytes utf-16)))
+
+(define (mac-path<? a b)
+  ;; A guess: alphabetic case-insensitively, but ties
+  ;; can be determined by case:
+  (define as (bytes->string/utf-16 a))
+  (define bs (bytes->string/utf-16 b))
+  (or (string-ci<? as bs)
+      (and (string-ci=? as bs)
+           (string<? as bs))))
+
+(define (read-ds-store path
+                       #:verbose? [verbose? #f])
+  (call-with-input-file*
+   path
+   (lambda (p)
+     (define (check b)
+       (unless (equal? b (read-bytes (bytes-length b) p))
+         (error "mismatch")))
+
+     (define (read-int)
+       (integer-bytes->integer (read-bytes 4 p) #f #t))
+     (define (read-short)
+       (integer-bytes->integer (read-bytes 2 p) #f #t))
+
+     (define (read-utf-16 len)
+       (define bstr (read-bytes (* 2 len) p))
+       (bytes->string/utf-16 bstr))
+
+     (define (read-four)
+       (string->symbol (bytes->string/utf-8 (read-bytes 4 p) #\?)))
+
+     (define (addr-offset o) (- o (bitwise-and o #x1F)))
+     (define (addr-size o) (expt 2 (bitwise-and o #x1F)))
+
+     (check #"\0\0\0\1")
+     (check #"Bud1")
+
+     (define bookkeeping-offset (read-int))
+     (define bookkeeping-size (read-int))
+
+     (when verbose?
+       (printf "Bookkeeping at ~a, size ~a\n"
+               bookkeeping-offset
+               bookkeeping-size))
+
+     (file-position p (+ bookkeeping-offset HEAD))
+     (define count (read-int))
+     (when verbose?
+       (printf "File has ~a blocks\n" count))
+     (void (read-int))
+     (define block-addresses
+       (for/vector ([i (in-range count)])
+         (read-int)))
+     (when verbose?
+       (printf "Block addresses:\n")
+       (for ([a (in-vector block-addresses)]
+             [i (in-naturals)])
+         (printf " ~a: ~a = ~a\n" 
+                 i
+                 (addr-offset a)
+                 (addr-size a))))
+     (void (read-bytes (* 4 (- 256 count)) p))
+     (define directory-count (read-int))
+     (define dirs (for/list ([i (in-range directory-count)])
+                    (cons (read-bytes (read-byte p) p)
+                          (read-int))))
+     (define free-lists (for/list ([i 32])
+                          (define c (read-int))
+                          (for/list ([i c])
+                            (read-int))))
+     (when verbose?
+       (printf "Free list:\n")
+       (for/list ([i 32]
+                  [l (in-list free-lists)])
+         (printf "~a: ~a\n" (expt 2 i) l)))
+
+     (define header-block (cdr (assoc #"DSDB" dirs)))
+
+     (define header-addr (vector-ref block-addresses header-block))
+
+     (when verbose?
+       (printf "Header block is ~a at ~a (size ~a)\n" 
+               header-block 
+               (addr-offset header-addr)
+               (addr-size header-addr)))
+
+     (file-position p (+ (addr-offset header-addr) HEAD))
+
+     (define root-block-number (read-int)) ; root node
+     (define more-root-data
+       (list
+        (read-int)   ; levels
+        (read-int)   ; records
+        (read-int))) ; nodes
+     (unless (equal? (read-int) #x1000)
+       (error "mismatch"))
+
+     (when verbose?
+       (printf "Root block is ~a ~s\n" root-block-number more-root-data))
+
+     (define (show-tree n accum)
+       (define addr (vector-ref block-addresses n))
+       (file-position p (+ (addr-offset addr) HEAD))
+       (define P (read-int))
+       (define count (read-int))
+       (when verbose?
+         (printf "block ~s ~s\n" P count))
+       (cond
+        [(zero? P)
+         (for/fold ([accum accum]) ([i (in-range count)])
+           (show-record accum))]
+        [else
+         (define a3
+           (for/fold ([accum accum]) ([i (in-range count)])
+             (define bn (read-int))
+             (define pos (file-position p))
+             (define a2 (show-tree bn accum))
+             (file-position p pos)
+             (show-record a2)))
+         (show-tree P a3)]))
+
+     (define (show-record accum)
+       (define len (read-int))
+       (define name (read-utf-16 len))
+       (define id (read-four))
+       (define type (read-four))
+       (define data
+         (case type
+           [(long shor) (read-int)]
+           [(bool) (positive? (read-byte p))]
+           [(blob) 
+            (define len (read-int))
+            (case id
+              [(fwi0) (begin0
+                       (fwind (read-short)
+                              (read-short)
+                              (read-short)
+                              (read-short)
+                              (read-four)
+                              (begin
+                                (read-byte p)
+                                (not (zero? (read-byte p)))))
+                       (read-bytes (- len 14) p))]
+              [(Iloc) (begin0
+                       (iloc (read-int)
+                             (read-int))
+                       (read-bytes (- len 8) p))]
+              [else (read-bytes len p)])]
+           [(type) (read-four)]
+           [(ustr) (read-utf-16 (read-int))]))
+       (when verbose?
+         (printf "~a '~a' '~a':\n  ~s\n" name id type data))
+       (cons (ds (if (equal? name ".")
+                     'same
+                     (string->path-element name))
+                 id
+                 type
+                 data)
+             accum))
+
+     (reverse (show-tree root-block-number null)))))
+
+(define (write-ds-store path dses)
+  (struct record (filename id type data))
+
+  (define (record<? a b)
+    (define af (record-filename a))
+    (define bf (record-filename b))
+    (if (equal? af bf)
+        (mac-path<? (record-id a) (record-id b))
+        (mac-path<? af bf)))
+
+  (define (record-size r)
+    (+ 4 ; filename length
+       (bytes-length (record-filename r))
+       4 ; id
+       4 ; type
+       (bytes-length (record-data r))))
+
+  (define (int->bytes i)
+    (integer->integer-bytes i 4 #t #t))
+  (define (short->bytes i)
+    (integer->integer-bytes i 2 #t #t))
+  
+  (define records
+    (sort (for/list ([ds (in-list dses)])
+            (define data (ds-data ds))
+            (record (if (eq? (ds-path ds) 'same)
+                        (string->bytes/utf-16 ".")
+                        (string->bytes/utf-16
+                         (path-element->string (ds-path ds))))
+                    (string->bytes/utf-8 (symbol->string (ds-id ds)))
+                    (string->bytes/utf-8 (symbol->string (ds-type ds)))
+                    (case (ds-type ds)
+                      [(long shor) (int->bytes data)]
+                      [(bool) (if data #"\1" #"\0")]
+                      [(blob)
+                       (define bstr
+                         (cond
+                          [(bytes? data) data]
+                          [(fwind? data) (bytes-append 
+                                          (short->bytes (fwind-t data))
+                                          (short->bytes (fwind-l data))
+                                          (short->bytes (fwind-b data))
+                                          (short->bytes (fwind-r data))
+                                          (string->bytes/utf-8 (symbol->string (fwind-mode data)))
+                                          (bytes 0
+                                                 (if (fwind-sideview? data) 1 0)
+                                                 0 
+                                                 0))]
+                          [(iloc? data) (bytes-append
+                                         (int->bytes (iloc-x data))
+                                         (int->bytes (iloc-y data))
+                                         (bytes #xff #xff #xff #xff #xff #xff 0 0))]
+                          [else (error "unrecognized block variant: ~s" data)]))
+                       (bytes-append
+                        (int->bytes (bytes-length bstr))
+                        bstr)]
+                      [(type)
+                       (string->bytes/utf-8 (symbol->string data))]
+                      [(ustr)
+                       (define bstr (string->bytes/utf-16 data))
+                       (string-append (int->bytes (quotient (bytes-length bstr) 2))
+                                      bstr)]
+                      [else (error "unrecognized data: ~s" (ds-type ds))])))
+          record<?))
+
+  (define records-block-size
+    (+ 4 ; P = 0
+       4 ; count 
+       (apply + (for/list ([r (in-list records)])
+                  (record-size r)))))
+
+  (define alloc-size (let ([v (max 64
+                                   (expt 2 (integer-length (add1 records-block-size))))])
+                       (if (= v 2048)
+                           4096 ; avoid collision with bookkeeping block
+                           v)))
+
+  (call-with-output-file*
+   path
+   #:exists 'truncate/replace
+   (lambda (p)
+     (define (write-records sz)
+       (write-int 0)
+       (write-int (length records))
+       (for ([r (in-list records)])
+         (write-int (quotient (bytes-length (record-filename r)) 2))
+         (write-bytes (record-filename r) p)
+         (write-bytes (record-id r) p)
+         (write-bytes (record-type r) p)
+         (write-bytes (record-data r) p))
+       (write-bytes (make-bytes (- sz records-block-size) 0) p))
+
+     (define (write-int i)
+       (write-bytes (int->bytes i) p))
+     (define (write-addr pos sz)
+       (write-int (bitwise-ior pos (sub1 (integer-length sz)))))
+
+     (write-bytes #"\0\0\0\1" p)
+
+     (write-bytes #"Bud1" p)     
+     ;; Bookeeping block always at 2048, since
+     ;; it needs 2048 bytes:
+     (write-int 2048) ; offset
+     (write-int 2048) ; size
+     (write-int 2048) ; offset, again
+     (write-bytes (make-bytes 16 0) p)
+
+     ;; Next 32-byte block (at offset 32) is used for the header block:
+     (write-int 2) ; block number for root
+     (write-int 0) ; level
+     (write-int (length records)) ; records
+     (write-int 1) ; nodes
+     (write-int #x1000)
+     (write-bytes (make-bytes 12 0) p)
+
+     ;; Starting with 64, need blocks up to size
+     ;; 1024. If any of those fit the records, then
+     ;; use it.
+     (let loop ([sz 64])
+       (if (= sz alloc-size)
+           (write-records sz)
+           (write-bytes (make-bytes sz 0) p))
+       (unless (= sz 1024)
+         (loop (* sz 2))))
+
+     ;; Write bookkeeping block
+     (write-int 3)     ; 3 blocks
+     (write-int 0)     ; unknown
+     (write-addr 2048 2048) ; bookkeeping
+     (write-addr 32 32) ; header block
+     ;; records block always lands at second buddy:
+     (write-addr alloc-size alloc-size)
+     (write-bytes (make-bytes (* 4 (- 256 3)) 0) p)
+     
+     ;; Single directory entry:
+     (write-int 1)
+     (write-byte 4 p)
+     (write-bytes #"DSDB" p)
+     (write-int 1) ; block 1 is header
+
+     ;; free lists:
+     (for/list ([i 32])
+       (define sz (expt 2 i))
+       (cond
+        [(= i 31) (write-int 0)]
+        [(or (sz . <= . 32) 
+             (sz . = . 2048))
+         (write-int 0)]
+        [(= sz alloc-size) (write-int 0)]
+        [else (write-int 1)
+              (write-int sz)]))
+
+     (file-truncate p (+ 4096 HEAD))
+     (file-position p (+ 4096 HEAD))
+
+     ;; write bytes as needed to reach records data
+     (let loop ([sz 4096])
+       (when (alloc-size . > . sz)
+         (write-bytes (make-bytes sz 0) p)
+         (loop (* 2 sz))))
+
+     (when (alloc-size . > . 2048)
+       (write-records alloc-size))
+
+     (void))))
diff --git a/pkgs/ds-store-pkgs/ds-store/info.rkt b/pkgs/ds-store-pkgs/ds-store/info.rkt
new file mode 100644
index 0000000000..ab66be112a
--- /dev/null
+++ b/pkgs/ds-store-pkgs/ds-store/info.rkt
@@ -0,0 +1,9 @@
+#lang info
+
+(define collection "ds-store")
+
+(define deps '("ds-store-lib"
+               "ds-store-doc"
+               "base"))
+(define implies '("ds-store-lib"
+                  "ds-store-doc"))
diff --git a/pkgs/main-distribution/info.rkt b/pkgs/main-distribution/info.rkt
index edc1f2fba5..331033022c 100644
--- a/pkgs/main-distribution/info.rkt
+++ b/pkgs/main-distribution/info.rkt
@@ -80,4 +80,5 @@
                "unstable-redex"
                "web-server"
                "wxme"
-               "xrepl"))
+               "xrepl"
+               "ds-store"))