diff --git a/collects/net/head-unit.rkt b/collects/net/head-unit.rkt
index 8f18233..1a1606b 100644
--- a/collects/net/head-unit.rkt
+++ b/collects/net/head-unit.rkt
@@ -1,345 +1,8 @@
-#lang racket/unit
+#lang racket/base
 
-(require racket/date racket/string "head-sig.rkt")
+(require racket/unit
+         "head-sig.rkt" "head.rkt")
 
-(import)
-(export head^)
+(define-unit-from-context head@ head^)
 
-;; NB: I've done a copied-code adaptation of a number of these definitions
-;; into "bytes-compatible" versions.  Finishing the rest will require some
-;; kind of interface decision---that is, when you don't supply a header,
-;; should the resulting operation be string-centric or bytes-centric?
-;; Easiest just to stop here.
-;; -- JBC 2006-07-31
-
-(define CRLF (string #\return #\newline))
-(define CRLF/bytes #"\r\n")
-
-(define empty-header CRLF)
-(define empty-header/bytes CRLF/bytes)
-
-(define re:field-start (regexp "^[^ \t\n\r\v:\001-\032\"]*:"))
-(define re:field-start/bytes #rx#"^[^ \t\n\r\v:\001-\032\"]*:")
-
-(define re:continue (regexp "^[ \t\v]"))
-(define re:continue/bytes #rx#"^[ \t\v]")
-
-(define (validate-header s)
-  (if (bytes? s)
-    ;; legal char check not needed per rfc 2822, IIUC.
-    (let ([len (bytes-length s)])
-      (let loop ([offset 0])
-        (cond
-          [(and (= (+ offset 2) len)
-                (bytes=? CRLF/bytes (subbytes s offset len)))
-           (void)] ; validated
-          [(= offset len) (error 'validate-header "missing ending CRLF")]
-          [(or (regexp-match re:field-start/bytes s offset)
-               (regexp-match re:continue/bytes s offset))
-           (let ([m (regexp-match-positions #rx#"\r\n" s offset)])
-             (if m
-               (loop (cdar m))
-               (error 'validate-header "missing ending CRLF")))]
-          [else (error 'validate-header "ill-formed header at ~s"
-                       (subbytes s offset (bytes-length s)))])))
-    ;; otherwise it should be a string:
-    (begin
-      (let ([m (regexp-match #rx"[^\000-\377]" s)])
-        (when m
-          (error 'validate-header "non-Latin-1 character in string: ~v" (car m))))
-      (let ([len (string-length s)])
-        (let loop ([offset 0])
-          (cond
-            [(and (= (+ offset 2) len)
-                  (string=? CRLF (substring s offset len)))
-             (void)] ; validated
-            [(= offset len) (error 'validate-header "missing ending CRLF")]
-            [(or (regexp-match re:field-start s offset)
-                 (regexp-match re:continue s offset))
-             (let ([m (regexp-match-positions #rx"\r\n" s offset)])
-               (if m
-                 (loop (cdar m))
-                 (error 'validate-header "missing ending CRLF")))]
-            [else (error 'validate-header "ill-formed header at ~s"
-                         (substring s offset (string-length s)))]))))))
-
-(define (make-field-start-regexp field)
-  (regexp (format "(^|[\r][\n])(~a: *)" (regexp-quote field #f))))
-
-(define (make-field-start-regexp/bytes field)
-  (byte-regexp (bytes-append #"(^|[\r][\n])("(regexp-quote field #f) #": *)")))
-
-(define (extract-field field header)
-  (if (bytes? header)
-    (let ([m (regexp-match-positions (make-field-start-regexp/bytes field)
-                                     header)])
-      (and m
-           (let ([s (subbytes header
-                              (cdaddr m)
-                              (bytes-length header))])
-             (let ([m (regexp-match-positions #rx#"[\r][\n][^: \r\n\"]*:" s)])
-               (if m
-                 (subbytes s 0 (caar m))
-                 ;; Rest of header is this field, but strip trailing CRLFCRLF:
-                 (regexp-replace #rx#"\r\n\r\n$" s ""))))))
-    ;; otherwise header & field should be strings:
-    (let ([m (regexp-match-positions (make-field-start-regexp field)
-                                     header)])
-      (and m
-           (let ([s (substring header
-                               (cdaddr m)
-                               (string-length header))])
-             (let ([m (regexp-match-positions #rx"[\r][\n][^: \r\n\"]*:" s)])
-               (if m
-                 (substring s 0 (caar m))
-                 ;; Rest of header is this field, but strip trailing CRLFCRLF:
-                 (regexp-replace #rx"\r\n\r\n$" s ""))))))))
-
-(define (replace-field field data header)
-  (if (bytes? header)
-    (let ([m (regexp-match-positions (make-field-start-regexp/bytes field)
-                                     header)])
-      (if m
-        (let* ([pre (subbytes header 0 (caaddr m))]
-               [s (subbytes header (cdaddr m))]
-               [m (regexp-match-positions #rx#"[\r][\n][^: \r\n\"]*:" s)]
-               [rest (if m (subbytes s (+ 2 (caar m))) empty-header/bytes)])
-          (bytes-append pre (if data (insert-field field data rest) rest)))
-        (if data (insert-field field data header) header)))
-    ;; otherwise header & field & data should be strings:
-    (let ([m (regexp-match-positions (make-field-start-regexp field) header)])
-      (if m
-        (let* ([pre (substring header 0 (caaddr m))]
-               [s (substring header (cdaddr m))]
-               [m (regexp-match-positions #rx"[\r][\n][^: \r\n\"]*:" s)]
-               [rest (if m (substring s (+ 2 (caar m))) empty-header)])
-          (string-append pre (if data (insert-field field data rest) rest)))
-        (if data (insert-field field data header) header)))))
-
-(define (remove-field field header)
-  (replace-field field #f header))
-
-(define (insert-field field data header)
-  (if (bytes? header)
-    (let ([field (bytes-append field #": "data #"\r\n")])
-      (bytes-append field header))
-    ;; otherwise field, data, & header should be strings:
-    (let ([field (format "~a: ~a\r\n" field data)])
-      (string-append field header))))
-
-(define (append-headers a b)
-  (if (bytes? a)
-    (let ([alen (bytes-length a)])
-      (if (> alen 1)
-        (bytes-append (subbytes a 0 (- alen 2)) b)
-        (error 'append-headers "first argument is not a header: ~a" a)))
-    ;; otherwise, a & b should be strings:
-    (let ([alen (string-length a)])
-      (if (> alen 1)
-        (string-append (substring a 0 (- alen 2)) b)
-        (error 'append-headers "first argument is not a header: ~a" a)))))
-
-(define (extract-all-fields header)
-  (if (bytes? header)
-    (let ([re #rx#"(^|[\r][\n])(([^\r\n:\"]*): *)"])
-      (let loop ([start 0])
-        (let ([m (regexp-match-positions re header start)])
-          (if m
-            (let ([start (cdaddr m)]
-                  [field-name (subbytes header (caaddr (cdr m))
-                                        (cdaddr (cdr m)))])
-              (let ([m2 (regexp-match-positions
-                         #rx#"\r\n[^: \r\n\"]*:"
-                         header
-                         start)])
-                (if m2
-                  (cons (cons field-name
-                              (subbytes header start (caar m2)))
-                        (loop (caar m2)))
-                  ;; Rest of header is this field, but strip trailing CRLFCRLF:
-                  (list
-                   (cons field-name
-                         (regexp-replace #rx#"\r\n\r\n$"
-                                         (subbytes header start (bytes-length header))
-                                         ""))))))
-            ;; malformed header:
-            null))))
-    ;; otherwise, header should be a string:
-    (let ([re #rx"(^|[\r][\n])(([^\r\n:\"]*): *)"])
-      (let loop ([start 0])
-        (let ([m (regexp-match-positions re header start)])
-          (if m
-            (let ([start (cdaddr m)]
-                  [field-name (substring header (caaddr (cdr m)) (cdaddr (cdr m)))])
-              (let ([m2 (regexp-match-positions
-                         #rx"\r\n[^: \r\n\"]*:" header start)])
-                (if m2
-                  (cons (cons field-name
-                              (substring header start (caar m2)))
-                        (loop (caar m2)))
-                  ;; Rest of header is this field, but strip trailing CRLFCRLF:
-                  (list
-                   (cons field-name
-                         (regexp-replace #rx"\r\n\r\n$"
-                                         (substring header start (string-length header))
-                                         ""))))))
-            ;; malformed header:
-            null))))))
-
-;; It's slightly less obvious how to generalize the functions that don't
-;; accept a header as input; for lack of an obvious solution (and free time),
-;; I'm stopping the string->bytes translation here.  -- JBC, 2006-07-31
-
-(define (standard-message-header from tos ccs bccs subject)
-  (let ([h (insert-field
-            "Subject" subject
-            (insert-field
-             "Date" (parameterize ([date-display-format 'rfc2822])
-                      (date->string (seconds->date (current-seconds)) #t))
-             CRLF))])
-    ;; NOTE: bccs don't go into the header; that's why they're "blind"
-    (let ([h (if (null? ccs)
-               h
-               (insert-field "CC" (assemble-address-field ccs) h))])
-      (let ([h (if (null? tos)
-                 h
-                 (insert-field "To" (assemble-address-field tos) h))])
-        (insert-field "From" from h)))))
-
-(define (splice l sep)
-  (if (null? l)
-    ""
-    (format "~a~a"
-            (car l)
-            (apply string-append
-                   (map (lambda (n) (format "~a~a" sep n))
-                        (cdr l))))))
-
-(define (data-lines->data datas)
-  (splice datas "\r\n\t"))
-
-;; Extracting Addresses ;;
-
-(define blank "[ \t\n\r\v]")
-(define nonblank "[^ \t\n\r\v]")
-(define re:all-blank (regexp (format "^~a*$" blank)))
-(define re:quoted (regexp "\"[^\"]*\""))
-(define re:parened (regexp "[(][^)]*[)]"))
-(define re:comma (regexp ","))
-(define re:comma-separated (regexp "([^,]*),(.*)"))
-
-(define (extract-addresses s form)
-  (unless (memq form '(name address full all))
-    (raise-type-error 'extract-addresses
-                      "form: 'name, 'address, 'full, or 'all"
-                      form))
-  (if (or (not s) (regexp-match re:all-blank s))
-    null
-    (let loop ([prefix ""][s s])
-      ;; Which comes first - a quote or a comma?
-      (let* ([mq1 (regexp-match-positions re:quoted s)]
-             [mq2 (regexp-match-positions re:parened s)]
-             [mq (if (and mq1 mq2)
-                   (if (< (caar mq1) (caar mq2)) mq1 mq2)
-                   (or mq1 mq2))]
-             [mc (regexp-match-positions re:comma s)])
-        (if (and mq mc (< (caar mq) (caar mc) (cdar mq)))
-          ;; Quote contains a comma
-          (loop (string-append
-                 prefix
-                 (substring s 0 (cdar mq)))
-                (substring s (cdar mq) (string-length s)))
-          ;; Normal comma parsing:
-          (let ([m (regexp-match re:comma-separated s)])
-            (if m
-              (let ([n (extract-one-name (string-append prefix (cadr m)) form)]
-                    [rest (extract-addresses (caddr m) form)])
-                (cons n rest))
-              (let ([n (extract-one-name (string-append prefix s) form)])
-                (list n)))))))))
-
-(define (select-result form name addr full)
-  (case form
-    [(name) name]
-    [(address) addr]
-    [(full) full]
-    [(all) (list name addr full)]))
-
-(define (one-result form s)
-  (select-result form s s s))
-
-(define re:quoted-name (regexp (format "^~a*(\"[^\"]*\")(.*)" blank)))
-(define re:parened-name (regexp (format "(.*)[(]([^)]*)[)]~a*$" blank)))
-(define re:simple-name (regexp (format "^~a*(~a.*)(<.*>)~a*$" blank nonblank blank)))
-(define re:normal-name (regexp (format "~a*<([^>]*)>~a*" blank blank)))
-(define re:double-less (regexp "<.*<"))
-(define re:double-greater (regexp ">.*>"))
-(define re:bad-chars (regexp "[,\"()<>]"))
-(define re:tail-blanks (regexp (format "~a+$" blank)))
-(define re:head-blanks (regexp (format "^~a+" blank)))
-
-(define (extract-one-name orig form)
-  (let loop ([s orig][form form])
-    (cond
-      ;; ?!?!? Where does the "addr (name)" standard come from ?!?!?
-      [(regexp-match re:parened-name s)
-       => (lambda (m)
-            (let ([name (caddr m)]
-                  [all (loop (cadr m) 'all)])
-              (select-result
-               form
-               (if (string=? (car all) (cadr all)) name (car all))
-               (cadr all)
-               (format "~a (~a)" (caddr all) name))))]
-      [(regexp-match re:quoted-name s)
-       => (lambda (m)
-            (let ([name (cadr m)]
-                  [addr (extract-angle-addr (caddr m) s)])
-              (select-result form name addr
-                             (format "~a <~a>" name addr))))]
-      [(regexp-match re:simple-name s)
-       => (lambda (m)
-            (let ([name (regexp-replace (format "~a*$" blank) (cadr m) "")]
-                  [addr (extract-angle-addr (caddr m) s)])
-              (select-result form name addr
-                             (format "~a <~a>" name addr))))]
-      [(or (regexp-match "<" s) (regexp-match ">" s))
-       (one-result form (extract-angle-addr s orig))]
-      [else (one-result form (extract-simple-addr s orig))])))
-
-(define (extract-angle-addr s orig)
-  (if (or (regexp-match re:double-less s) (regexp-match re:double-greater s))
-    (error 'extract-address "too many angle brackets: ~a" s)
-    (let ([m (regexp-match re:normal-name s)])
-      (if m
-        (extract-simple-addr (cadr m) orig)
-        (error 'extract-address "cannot parse address: ~a" orig)))))
-
-(define (extract-simple-addr s orig)
-  (cond [(regexp-match re:bad-chars s)
-         (error 'extract-address "cannot parse address: ~a" orig)]
-        [else
-         ;; final whitespace strip
-         (regexp-replace re:tail-blanks
-                         (regexp-replace re:head-blanks s "")
-                         "")]))
-
-(define (assemble-address-field addresses)
-  (if (null? addresses)
-    ""
-    (let loop ([addresses (cdr addresses)]
-               [s (car addresses)]
-               [len (string-length (car addresses))])
-      (if (null? addresses)
-        s
-        (let* ([addr (car addresses)]
-               [alen (string-length addr)])
-          (if (<= 72 (+ len alen))
-            (loop (cdr addresses)
-                  (format "~a,~a~a~a~a"
-                          s #\return #\linefeed
-                          #\tab addr)
-                  alen)
-            (loop (cdr addresses)
-                  (format "~a, ~a" s addr)
-                  (+ len alen 2))))))))
+(provide head@)