Mercurial > urweb
comparison src/settings.sml @ 2046:ced78ef1c82f
New .urp directive: file
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Thu, 31 Jul 2014 09:56:41 -0400 |
parents | 534577e429e1 |
children | 6b7749da1ddc 365727ff68f4 |
comparison
equal
deleted
inserted
replaced
2045:534577e429e1 | 2046:ced78ef1c82f |
---|---|
742 | 742 |
743 val less = ref false | 743 val less = ref false |
744 fun setLessSafeFfi b = less := b | 744 fun setLessSafeFfi b = less := b |
745 fun getLessSafeFfi () = !less | 745 fun getLessSafeFfi () = !less |
746 | 746 |
747 structure SM = BinaryMapFn(struct | |
748 type ord_key = string | |
749 val compare = String.compare | |
750 end) | |
751 | |
752 val noMimeFile = ref false | |
753 | |
754 fun noMime () = | |
755 (TextIO.output (TextIO.stdErr, "WARNING: Error opening /etc/mime.types. Static files will be served with no suggested MIME types.\n"); | |
756 noMimeFile := true; | |
757 SM.empty) | |
758 | |
759 fun readMimeTypes () = | |
760 let | |
761 val inf = TextIO.openIn "/etc/mime.types" | |
762 | |
763 fun loop m = | |
764 case TextIO.inputLine inf of | |
765 NONE => m | |
766 | SOME line => | |
767 if size line > 0 andalso String.sub (line, 0) = #"#" then | |
768 loop m | |
769 else | |
770 case String.tokens Char.isSpace line of | |
771 typ :: exts => | |
772 loop (foldl (fn (ext, m) => SM.insert (m, ext, typ)) m exts) | |
773 | _ => loop m | |
774 in | |
775 loop SM.empty | |
776 before TextIO.closeIn inf | |
777 end handle IO.Io _ => noMime () | |
778 | OS.SysErr _ => noMime () | |
779 | |
780 val mimeTypes = ref (NONE : string SM.map option) | |
781 | |
782 fun getMimeTypes () = | |
783 case !mimeTypes of | |
784 SOME m => m | |
785 | NONE => | |
786 let | |
787 val m = readMimeTypes () | |
788 in | |
789 mimeTypes := SOME m; | |
790 m | |
791 end | |
792 | |
793 fun mimeTypeOf filename = | |
794 case OS.Path.ext filename of | |
795 NONE => (if !noMimeFile then | |
796 () | |
797 else | |
798 TextIO.output (TextIO.stdErr, "WARNING: No extension found in filename '" ^ filename ^ "'. Header 'Content-Type' will be omitted in HTTP responses.\n"); | |
799 NONE) | |
800 | SOME ext => | |
801 let | |
802 val to = SM.find (getMimeTypes (), ext) | |
803 in | |
804 case to of | |
805 NONE => if !noMimeFile then | |
806 () | |
807 else | |
808 TextIO.output (TextIO.stdErr, "WARNING: No MIME type known for extension '" ^ ext ^ "'. Header 'Content-Type' will be omitted in HTTP responses.\n") | |
809 | _ => (); | |
810 to | |
811 end | |
812 | |
813 val files = ref (SM.empty : (string * {Uri : string, ContentType : string option, LastModified : Time.time, Bytes : Word8Vector.vector}) SM.map) | |
814 | |
815 val filePath = ref "." | |
816 | |
817 fun setFilePath path = filePath := path | |
818 | |
819 fun addFile {Uri, LoadFromFilename} = | |
820 let | |
821 val path = OS.Path.joinDirFile {dir = !filePath, file = LoadFromFilename} | |
822 in | |
823 case SM.find (!files, Uri) of | |
824 SOME (path', _) => | |
825 if path' = path then | |
826 () | |
827 else | |
828 ErrorMsg.error ("Two different files requested for URI " ^ Uri) | |
829 | NONE => | |
830 let | |
831 val inf = BinIO.openIn path | |
832 in | |
833 files := SM.insert (!files, | |
834 Uri, | |
835 (path, | |
836 {Uri = Uri, | |
837 ContentType = mimeTypeOf path, | |
838 LastModified = OS.FileSys.modTime path, | |
839 Bytes = BinIO.inputAll inf})); | |
840 BinIO.closeIn inf | |
841 end | |
842 end handle IO.Io _ => | |
843 ErrorMsg.error ("Error loading file " ^ LoadFromFilename) | |
844 | OS.SysErr (s, _) => | |
845 ErrorMsg.error ("Error loading file " ^ LoadFromFilename ^ " (" ^ s ^ ")") | |
846 | |
847 fun listFiles () = map #2 (SM.listItems (!files)) | |
848 | |
747 end | 849 end |