content-disposition.ss
#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MIME.plt
;;
;; an extensible MIME framework.
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; Licensed under LGPL.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; content-disposition.ss - reader/writer for content disposition.
;; yc 2/18/2010 - first version.
(require "depend.ss"
         "content-type.ss"
         "base.ss"
         )
;; content-disposition is defined in http://tools.ietf.org/html/rfc2183
;; type = inline | attachment | extension...
;; spairs = filename-p | creation-date-p | modification-date-p | read-date-p | size-p | extension...
;; filename-p = "filename" = value
;; creation-date-p = "creation-date" = quoted-date-time
;; modification-date-p = "modification-date" = quoted-date-time
;; read-date-p = "read-date" = quoted-date-time
;; size-p = "size" = 1*digit
;; quoted-date-time = quoted-string with rfc822 date inside...
(define-struct (content-disposition kvs) (type))

(define (build-content-disposition type kvs)
  (make-content-disposition kvs ;; time to convert the types here!!!... hmm...
                            (string->symbol (string-downcase type))))

(define read-content-disposition
  (make-reader (lambda (in) 
                 (parameterize ((kvs-readertable 
                                 `(("creation-date" . ,read-rfc822)
                                   ("modification-date" . ,read-rfc822)
                                   ("read-date" . ,read-rfc822)
                                   ("size" . ,(make-reader integer)))))
                   ((content-type-value build-content-disposition) in)))))

(define (content-disposition-filename cd)
  (kvs-ref cd "filename")) 

(define (content-disposition-ctime cd)
  (kvs-ref cd "creation-date" (current-date)))

(define (content-disposition-mtime cd)
  (kvs-ref cd "modification-date" (current-date)))

(define (content-disposition-atime cd)
  (kvs-ref cd "read-date" (current-date)))

(define (content-disposition-size cd)
  (kvs-ref cd "size" 0))

(mime-header-reader-set! "Content-Disposition" read-content-disposition)

(define (write-content-disposition cd)
  (write-content-type cd content-disposition-type))

(string-converter-set! content-disposition? write-content-disposition)

(provide/contract 
 (struct content-disposition ((inner any/c)
                              (type any/c)))
 (build-content-disposition (-> string? kvs/list? content-disposition?))
 (read-content-disposition Reader/c)
 (content-disposition-filename (-> content-disposition? (or/c false/c string?)))
 (content-disposition-ctime (-> content-disposition? (or/c false/c date? number?)))
 (content-disposition-mtime (-> content-disposition? (or/c false/c date? number?)))
 (content-disposition-atime (-> content-disposition? (or/c false/c date? number?)))
 (content-disposition-size (-> content-disposition? (or/c false/c number?)))
 )