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