(module ugarit-mime (extension-from-filename mimetype->extension extension->mimetype) (import scheme) (import chicken) (use srfi-13) (use srfi-69) (define *mime-types* '( ;; Alphabetical order of (primary) extension (".avi" . "video/x-msvideo") (".c" . "text/x-c") (".class" . "application/java-vm") (".cpp" . "text/x-cpp") (".doc" . "application/msword") (".flag" . "audio/x-flac") (".gif" . "image/gif") (".h" . "text/x-c-header") ((".jpeg" ".jpg") . "image/jpeg") (".jar" . "application/java-archive") (".js" . "application/javascript") (".json" . "application/json") (".mng" . "video/x-mng") (".mov" . "video/quicktime") (".mp3" . "audio/mpeg") (".mp4" . "audio/mp4") ((".mpeg" ".mpg") . "video/mpeg") (".ogg" . "audio/ogg") (".ogv" . "video/ogg") (".pdf" . "application/pdf") (".pgp" . "application/pgp-encrypted") (".png" . "image/png") (".ps" . "application/postscript") (".rdf" . "application/rdf+xml") (".rtf" . "application/rtf") (".scm" . "text/x-scheme") (".sexpr" . "text/x-s-expression") (".sig" . "application/pgp-signature") (".svg" . "image/svg+xml") (".txt" . "text/plain") (".xml" . "text/xml") )) (define *extension-to-mimetype* ;; Expand multiple extensions to multiple entries (let ((ht (make-hash-table))) (for-each (lambda (e) (let ((ext (car e)) (mt (cdr e))) (if (list? ext) (for-each (lambda (ext) (hash-table-set! ht ext mt)) ext) (hash-table-set! ht ext mt)))) *mime-types*) ht)) (define *mimetype-to-extension* (alist->hash-table (map (lambda (aref) (cons (cdr aref) (if (list? (car aref)) (car (car aref)) ; Prefer first (car aref)))) *mime-types*))) (define *unknown-mimetype* "application/octet-stream") (define (extension-from-filename fn) (let ((dot-pos (string-index fn #\.))) (if dot-pos (substring/shared fn dot-pos) ""))) (define (mimetype->extension mt) (if (string=? mt "inode/directory") "" (if (hash-table-exists? *mimetype-to-extension* mt) (hash-table-ref *mimetype-to-extension* mt) (if (string-prefix? "text/" mt) ".txt" "")))) (define (extension->mimetype ext) (if (string=? ext "") *unknown-mimetype* (if (hash-table-exists? *extension-to-mimetype* ext) (hash-table-ref *extension-to-mimetype* ext) *unknown-mimetype*))) )